summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPo Lu <luangruo@yahoo.com>2024-06-17 12:11:25 +0800
committerPo Lu <luangruo@yahoo.com>2024-06-17 17:45:48 +0800
commit6aa5068ac71cb1b8e46c299138f99fea44319146 (patch)
tree591cb40ab9c6e43f03b6d1e7c84d38a16f0ae85e
parent7be66d8223e49489b2803c0ff027f1824d774441 (diff)
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.
-rw-r--r--lisp/emacs-lisp/rmc.el106
-rw-r--r--lisp/net/nsm.el11
-rw-r--r--lisp/touch-screen.el1
3 files changed, 81 insertions, 37 deletions
diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el
index 378687c0326..883f8bf187f 100644
--- 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 830dc9372ab..ab655dbb13b 100644
--- 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 dd6bbf8ccce..9efbb59926e 100644
--- 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