From 5268f8476fc3e1bb2ead05a75390dbe9ef852d09 Mon Sep 17 00:00:00 2001
From: Po Lu <luangruo@yahoo.com>
Date: Tue, 13 Jun 2023 16:20:58 +0800
Subject: [PATCH] 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)))
-- 
2.39.2