Skip to content

Commit 6aa5068

Browse files
author
Po Lu
committed
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.
1 parent 7be66d8 commit 6aa5068

File tree

3 files changed

+81
-37
lines changed

3 files changed

+81
-37
lines changed

lisp/emacs-lisp/rmc.el

Lines changed: 71 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -189,7 +189,7 @@ Usage example:
189189
"%s (%s): "
190190
prompt
191191
(mapconcat (lambda (e) (cdr e)) altered-names ", ")))
192-
tchar buf wrong-char answer)
192+
tchar buf wrong-char answer command)
193193
(save-window-excursion
194194
(save-excursion
195195
(if show-help
@@ -216,40 +216,76 @@ Usage example:
216216
(let ((cursor-in-echo-area t))
217217
(read-event))
218218
(error nil))))
219-
(setq answer (lookup-key query-replace-map (vector tchar) t))
220-
(setq tchar
221-
(cond
222-
((eq answer 'recenter)
223-
(recenter) t)
224-
((eq answer 'scroll-up)
225-
(ignore-errors (scroll-up-command)) t)
226-
((eq answer 'scroll-down)
227-
(ignore-errors (scroll-down-command)) t)
228-
((eq answer 'scroll-other-window)
229-
(ignore-errors (scroll-other-window)) t)
230-
((eq answer 'scroll-other-window-down)
231-
(ignore-errors (scroll-other-window-down)) t)
232-
((eq answer 'edit)
233-
(save-match-data
234-
(save-excursion
235-
(message "%s"
236-
(substitute-command-keys
237-
"Recursive edit; type \\[exit-recursive-edit] to return to help screen"))
238-
(recursive-edit))))
239-
(t tchar)))
240-
(when (eq tchar t)
241-
(setq wrong-char nil
242-
tchar nil))
243-
;; The user has entered an invalid choice, so display the
244-
;; help messages.
245-
(when (and (not (eq tchar nil))
246-
(not (assq tchar choices)))
247-
(setq wrong-char (not (memq tchar `(?? ,help-char)))
248-
tchar nil)
249-
(when wrong-char
250-
(ding))
251-
(setq buf (rmc--show-help prompt help-string show-help
252-
choices altered-names))))))
219+
(if (memq (car-safe tchar) '(touchscreen-begin
220+
touchscreen-end
221+
touchscreen-update))
222+
;; Execute commands generally bound to certain touchscreen
223+
;; events.
224+
(progn
225+
(when (setq command
226+
(let ((current-key-remap-sequence
227+
(vector tchar)))
228+
(touch-screen-translate-touch nil)))
229+
(setq command (if (> (length command) 0)
230+
(aref command 0)
231+
nil))
232+
(setq tchar nil)
233+
(cond
234+
((null command)) ; Read another event.
235+
((memq (car-safe command) '(mouse-1 mouse-2))
236+
;; Display the on-screen keyboard if a tap should be
237+
;; registered.
238+
(frame-toggle-on-screen-keyboard (selected-frame)
239+
nil))
240+
;; Respond to scroll and pinch events as if RMC were
241+
;; not in progress.
242+
((eq (car-safe command) 'touchscreen-scroll)
243+
(funcall #'touch-screen-scroll command))
244+
((eq (car-safe command) 'touchscreen-pinch)
245+
(funcall #'touch-screen-pinch command))
246+
;; Prevent other touchscreen-generated events from
247+
;; reaching the default conditional.
248+
((memq (or (and (symbolp command) command)
249+
(car-safe command))
250+
'(touchscreen-hold touchscreen-drag
251+
touchscreen-restart-drag))
252+
nil)
253+
(t (setq tchar command)))))
254+
(setq answer (lookup-key query-replace-map (vector tchar) t))
255+
(setq tchar
256+
(cond
257+
((eq answer 'recenter)
258+
(recenter) t)
259+
((eq answer 'scroll-up)
260+
(ignore-errors (scroll-up-command)) t)
261+
((eq answer 'scroll-down)
262+
(ignore-errors (scroll-down-command)) t)
263+
((eq answer 'scroll-other-window)
264+
(ignore-errors (scroll-other-window)) t)
265+
((eq answer 'scroll-other-window-down)
266+
(ignore-errors (scroll-other-window-down)) t)
267+
((eq answer 'edit)
268+
(save-match-data
269+
(save-excursion
270+
(message
271+
"%s"
272+
(substitute-command-keys
273+
"Recursive edit; type \\[exit-recursive-edit] to return to help screen"))
274+
(recursive-edit))))
275+
(t tchar)))
276+
(when (eq tchar t)
277+
(setq wrong-char nil
278+
tchar nil))
279+
;; The user has entered an invalid choice, so display the
280+
;; help messages.
281+
(when (and (not (eq tchar nil))
282+
(not (assq tchar choices)))
283+
(setq wrong-char (not (memq tchar `(?? ,help-char)))
284+
tchar nil)
285+
(when wrong-char
286+
(ding))
287+
(setq buf (rmc--show-help prompt help-string show-help
288+
choices altered-names)))))))
253289
(when (buffer-live-p buf)
254290
(kill-buffer buf))
255291
(assq tchar choices)))

lisp/net/nsm.el

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -826,7 +826,10 @@ protocol."
826826
(?n "next" "Next certificate")
827827
(?p "previous" "Previous certificate")
828828
(?q "quit" "Quit details view")))
829-
(done nil))
829+
(done nil)
830+
(old-use-dialog-box use-dialog-box)
831+
(use-dialog-box use-dialog-box)
832+
(use-dialog-box-override use-dialog-box-override))
830833
(save-window-excursion
831834
;; First format the certificate and warnings.
832835
(pop-to-buffer buffer)
@@ -859,14 +862,18 @@ protocol."
859862
(read-multiple-choice "Continue connecting?"
860863
accept-choices)))
861864
(setq buf (if show-details cert-buffer buffer))
862-
863865
(cl-case (car answer)
864866
(?q
867+
(setq use-dialog-box old-use-dialog-box)
865868
;; Exit the details window.
866869
(set-window-buffer (get-buffer-window cert-buffer) buffer)
867870
(setq show-details nil))
868871

869872
(?d
873+
;; Dialog boxes should be suppressed, as they
874+
;; obstruct the certificate details buffer.
875+
(setq use-dialog-box nil
876+
use-dialog-box-override nil)
870877
;; Enter the details window.
871878
(set-window-buffer (get-buffer-window buffer) cert-buffer)
872879
(with-current-buffer cert-buffer

lisp/touch-screen.el

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1751,6 +1751,7 @@ functions undertaking event management themselves to call
17511751

17521752
(put 'mouse-drag-region 'ignored-mouse-command t)
17531753

1754+
;;;###autoload
17541755
(defun touch-screen-translate-touch (prompt)
17551756
"Translate touch screen events into a sequence of mouse events.
17561757
PROMPT is the prompt string given to `read-key-sequence', or nil

0 commit comments

Comments
 (0)