procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Improve treatment of touch screen input by rmc and its callers

Browse source 
* 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.
This commit is contained in:
Po Lu 2024-06-17 12:11:25 +08:00
parent 7be66d8223
commit 6aa5068ac7
3 changed files with 81 additions and 37 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

106
lisp/emacs-lisp/rmc.el
View file

@ -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)))

11
lisp/net/nsm.el
View file

@ -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

1
lisp/touch-screen.el
View file

@ -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