feature/android 5268f8476fc: Improve behavior of Gnus on Android

[Po Lu]

branch: feature/android
commit 5268f8476fc3e1bb2ead05a75390dbe9ef852d09
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>

    Improve behavior of Gnus on Android
    
    * etc/NEWS: Fix typo.
    * lisp/gnus/gnus-score.el (gnus-read-char): New function.
    (gnus-summary-increase-score): Use it to display a dialog box on
    Android, where input methods have trouble with plain old
    read-char.
---
 etc/NEWS                |  1 -
 lisp/gnus/gnus-score.el | 70 ++++++++++++++++++++++++++++++++++++++-----------
 2 files changed, 54 insertions(+), 17 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 1ed492b2e47..efe480b5be0 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -102,7 +102,6 @@ plus, minus, check-mark, start, etc.
 Many touch screen gestures are now implemented, as is support for
 tapping buttons and opening menus.
 
-
 ---
 ** On X, Emacs now supports input methods which perform "string conversion".
 This means an input method can now ask Emacs to delete text
diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index 05459ffae88..8bdfccf7eb8 100644
--- a/lisp/gnus/gnus-score.el
+++ b/lisp/gnus/gnus-score.el
@@ -517,6 +517,35 @@ of the last successful match.")
     "t" #'gnus-score-find-trace
     "w" #'gnus-score-find-favorite-words))
 
+
+
+;; Touch screen ``character reading'' routines for
+;; `gnus-summary-increase-score' and friends.
+
+(defun gnus-read-char (prompt options)
+  "Read a character from the keyboard.
+
+On Android, if `use-dialog-box-p' returns non-nil, display a
+dialog box containing PROMPT, with buttons representing each of
+item in the list of characters OPTIONS instead.
+
+Value is the character read, as with `read-char', or nil upon
+failure."
+  (if (and (display-graphic-p) (featurep 'android)
+           (use-dialog-box-p))
+      ;; Set up the dialog box.
+      (let ((dialog (cons prompt ; Message displayed in dialog box.
+                          (mapcar (lambda (arg)
+                                    (cons (char-to-string arg)
+                                          arg))
+                                  options))))
+        ;; Display the dialog box.
+        (x-popup-dialog t dialog))
+    ;; Fall back to read-char.
+    (read-char)))
+
+
+
 ;; Summary score file commands
 
 ;; Much modification of the kill (ahem, score) code and lots of the
@@ -588,21 +617,23 @@ current score file."
                     (aref (symbol-name gnus-score-default-type) 0)))
         (pchar (and gnus-score-default-duration
                     (aref (symbol-name gnus-score-default-duration) 0)))
-        entry temporary type match extra)
+        entry temporary type match extra header-string)
 
     (unwind-protect
        (progn
-
+          (setq header-string
+                (format "%s header (%s?): " (if increase "Increase" "Lower")
+                       (mapconcat (lambda (s) (char-to-string (car s)))
+                                  char-to-header "")))
          ;; First we read the header to score.
          (while (not hchar)
            (if mimic
                (progn
                  (sit-for 1)
                  (message "%c-" prefix))
-             (message "%s header (%s?): " (if increase "Increase" "Lower")
-                      (mapconcat (lambda (s) (char-to-string (car s)))
-                                 char-to-header "")))
-           (setq hchar (read-char))
+             (message header-string))
+           (setq hchar (gnus-read-char header-string
+                                        (mapcar #'car char-to-header)))
            (when (or (= hchar ??) (= hchar ?\C-h))
              (setq hchar nil)
              (gnus-score-insert-help "Match on header" char-to-header 1)))
@@ -625,17 +656,20 @@ current score file."
                                         (nth 3 s))
                                     s nil))
                               char-to-type))))
+            (setq header-string
+                  (format "%s header `%s' with match type (%s?): "
+                         (if increase "Increase" "Lower")
+                         (nth 1 entry)
+                         (mapconcat (lambda (s) (char-to-string (car s)))
+                                    legal-types "")))
            ;; We continue reading - the type.
            (while (not tchar)
              (if mimic
                  (progn
                    (sit-for 1) (message "%c %c-" prefix hchar))
-               (message "%s header `%s' with match type (%s?): "
-                        (if increase "Increase" "Lower")
-                        (nth 1 entry)
-                        (mapconcat (lambda (s) (char-to-string (car s)))
-                                   legal-types "")))
-             (setq tchar (read-char))
+               (message header-string))
+             (setq tchar (gnus-read-char header-string
+                                          (mapcar #'car legal-types)))
              (when (or (= tchar ??) (= tchar ?\C-h))
                (setq tchar nil)
                (gnus-score-insert-help "Match type" legal-types 2)))
@@ -651,15 +685,19 @@ current score file."
              (message ""))
            (setq pchar (or pchar ?t)))
 
+          (setq header-string
+                (format "%s permanence (%s?): " (if increase "Increase" 
"Lower")
+                       (mapconcat (lambda (s) (char-to-string (car s)))
+                                  char-to-perm "")))
+
          ;; We continue reading.
          (while (not pchar)
            (if mimic
                (progn
                  (sit-for 1) (message "%c %c %c-" prefix hchar tchar))
-             (message "%s permanence (%s?): " (if increase "Increase" "Lower")
-                      (mapconcat (lambda (s) (char-to-string (car s)))
-                                 char-to-perm "")))
-           (setq pchar (read-char))
+             (message header-string))
+           (setq pchar (gnus-read-char header-string
+                                        (mapcar #'car char-to-perm)))
            (when (or (= pchar ??) (= pchar ?\C-h))
              (setq pchar nil)
              (gnus-score-insert-help "Match permanence" char-to-perm 2)))