Improve treatment of touch screen input by rmc and its callers

* lisp/emacs-lisp/rmc.el (read-multiple-choice--short-answers):
Run touch screen event translation on touch screen events
received, and respond to pinch, tap and scrolling gestures.

* lisp/net/nsm.el (nsm-query-user): Disable use-dialog-box in
the details window.

* lisp/touch-screen.el (touch-screen-translate-touch): Autoload.

diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el
index 378687c03263aefef89621f4dcd33952bd11f701..883f8bf187ff64cae0ce77cf72e50cf22cccf8cc 100644 (file)
--- a/lisp/emacs-lisp/rmc.el
+++ b/lisp/emacs-lisp/rmc.el
@@ -189,7 +189,7 @@ Usage example:
            "%s (%s): "
            prompt
            (mapconcat (lambda (e) (cdr e)) altered-names ", ")))
-         tchar buf wrong-char answer)
+         tchar buf wrong-char answer command)
     (save-window-excursion
       (save-excursion
         (if show-help
@@ -216,40 +216,76 @@ Usage example:
                       (let ((cursor-in-echo-area t))
                         (read-event))
                     (error nil))))
-          (setq answer (lookup-key query-replace-map (vector tchar) t))
-          (setq tchar
-                (cond
-                 ((eq answer 'recenter)
-                  (recenter) t)
-                 ((eq answer 'scroll-up)
-                  (ignore-errors (scroll-up-command)) t)
-                 ((eq answer 'scroll-down)
-                  (ignore-errors (scroll-down-command)) t)
-                 ((eq answer 'scroll-other-window)
-                  (ignore-errors (scroll-other-window)) t)
-                 ((eq answer 'scroll-other-window-down)
-                  (ignore-errors (scroll-other-window-down)) t)
-                 ((eq answer 'edit)
-                  (save-match-data
-                    (save-excursion
-                      (message "%s"
-                               (substitute-command-keys
-                                "Recursive edit; type \\[exit-recursive-edit] to return to help screen"))
-                      (recursive-edit))))
-                 (t tchar)))
-          (when (eq tchar t)
-            (setq wrong-char nil
-                  tchar nil))
-          ;; The user has entered an invalid choice, so display the
-          ;; help messages.
-          (when (and (not (eq tchar nil))
-                     (not (assq tchar choices)))
-           (setq wrong-char (not (memq tchar `(?? ,help-char)))
-                  tchar nil)
-            (when wrong-char
-              (ding))
-            (setq buf (rmc--show-help prompt help-string show-help
-                                      choices altered-names))))))
+          (if (memq (car-safe tchar) '(touchscreen-begin
+                                       touchscreen-end
+                                       touchscreen-update))
+              ;; Execute commands generally bound to certain touchscreen
+              ;; events.
+              (progn
+                (when (setq command
+                            (let ((current-key-remap-sequence
+                                   (vector tchar)))
+                              (touch-screen-translate-touch nil)))
+                  (setq command (if (> (length command) 0)
+                                    (aref command 0)
+                                  nil))
+                  (setq tchar nil)
+                  (cond
+                   ((null command)) ; Read another event.
+                   ((memq (car-safe command) '(mouse-1 mouse-2))
+                    ;; Display the on-screen keyboard if a tap should be
+                    ;; registered.
+                    (frame-toggle-on-screen-keyboard (selected-frame)
+                                                     nil))
+                   ;; Respond to scroll and pinch events as if RMC were
+                   ;; not in progress.
+                   ((eq (car-safe command) 'touchscreen-scroll)
+                    (funcall #'touch-screen-scroll command))
+                   ((eq (car-safe command) 'touchscreen-pinch)
+                    (funcall #'touch-screen-pinch command))
+                   ;; Prevent other touchscreen-generated events from
+                   ;; reaching the default conditional.
+                   ((memq (or (and (symbolp command) command)
+                              (car-safe command))
+                          '(touchscreen-hold touchscreen-drag
+                                             touchscreen-restart-drag))
+                    nil)
+                   (t (setq tchar command)))))
+            (setq answer (lookup-key query-replace-map (vector tchar) t))
+            (setq tchar
+                  (cond
+                   ((eq answer 'recenter)
+                    (recenter) t)
+                   ((eq answer 'scroll-up)
+                    (ignore-errors (scroll-up-command)) t)
+                   ((eq answer 'scroll-down)
+                    (ignore-errors (scroll-down-command)) t)
+                   ((eq answer 'scroll-other-window)
+                    (ignore-errors (scroll-other-window)) t)
+                   ((eq answer 'scroll-other-window-down)
+                    (ignore-errors (scroll-other-window-down)) t)
+                   ((eq answer 'edit)
+                    (save-match-data
+                      (save-excursion
+                        (message
+                         "%s"
+                         (substitute-command-keys
+                          "Recursive edit; type \\[exit-recursive-edit] to return to help screen"))
+                        (recursive-edit))))
+                   (t tchar)))
+            (when (eq tchar t)
+              (setq wrong-char nil
+                    tchar nil))
+            ;; The user has entered an invalid choice, so display the
+            ;; help messages.
+            (when (and (not (eq tchar nil))
+                       (not (assq tchar choices)))
+             (setq wrong-char (not (memq tchar `(?? ,help-char)))
+                    tchar nil)
+              (when wrong-char
+                (ding))
+              (setq buf (rmc--show-help prompt help-string show-help
+                                        choices altered-names)))))))
     (when (buffer-live-p buf)
       (kill-buffer buf))
     (assq tchar choices)))

diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index 830dc9372abc42baccc358cc592b7f0affc746bf..ab655dbb13b166dccb7d2780fd3bca8beec40e1a 100644 (file)
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -826,7 +826,10 @@ protocol."
            (?n "next" "Next certificate")
            (?p "previous" "Previous certificate")
            (?q "quit" "Quit details view")))
-        (done nil))
+        (done nil)
+       (old-use-dialog-box use-dialog-box)
+       (use-dialog-box use-dialog-box)
+       (use-dialog-box-override use-dialog-box-override))
     (save-window-excursion
       ;; First format the certificate and warnings.
       (pop-to-buffer buffer)
@@ -859,14 +862,18 @@ protocol."
                              (read-multiple-choice "Continue connecting?"
                                                    accept-choices)))
               (setq buf (if show-details cert-buffer buffer))
-
               (cl-case (car answer)
                 (?q
+                (setq use-dialog-box old-use-dialog-box)
                  ;; Exit the details window.
                  (set-window-buffer (get-buffer-window cert-buffer) buffer)
                  (setq show-details nil))
 
                 (?d
+                ;; Dialog boxes should be suppressed, as they
+                ;; obstruct the certificate details buffer.
+                (setq use-dialog-box nil
+                      use-dialog-box-override nil)
                  ;; Enter the details window.
                  (set-window-buffer (get-buffer-window buffer) cert-buffer)
                  (with-current-buffer cert-buffer

diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el
index dd6bbf8ccce1f23c6f1c1651add9203a75735700..9efbb59926eaafaa15b5a625b4a876767f051b68 100644 (file)
--- a/lisp/touch-screen.el
+++ b/lisp/touch-screen.el
@@ -1751,6 +1751,7 @@ functions undertaking event management themselves to call
 
 (put 'mouse-drag-region 'ignored-mouse-command t)
 
+;;;###autoload
 (defun touch-screen-translate-touch (prompt)
   "Translate touch screen events into a sequence of mouse events.
 PROMPT is the prompt string given to `read-key-sequence', or nil