From 3c7f42bf70d84b41409107a7696f3c5b4297cbbc Mon Sep 17 00:00:00 2001 From: Jared Finder Date: Sat, 2 Jan 2021 14:10:17 -0800 Subject: [PATCH] Make libraries works with xterm-mouse-mode. Change calls from 'read-event' to 'read-key' in libraries expecting mouse events. Do this only when 'xterm-mouse-mode' is enabled. That way those libraries read decoded mouse events instead of the underlying escape sequence. Add a parameter to 'read-key' that avoids running any of the unbound fallbacks in 'read-key-sequence' so the libraries can read mouse button-down events. For backward compatibility purposes, the above logic is contained in a new internal-only function: 'read--potential-mouse-event'. * doc/lispref/commands.texi (Reading One Event): Document new parameter to 'read-key'. Mention that non-character events on terminals need 'read-key'. * lisp/subr.el (read-key-full-map): Add new keymap used by 'read-key'. (read-key): Add new parameter 'fallbacks-disabled' to prevent running any of the unbound fallbacks normally run by 'read-key-sequence'. (read--potential-mouse-event): Add new function that calls 'read-key' or 'read-event' depending on if 'xterm-mouse-mode' is set. * lisp/foldout.el (foldout-mouse-swallow-events): * lisp/isearch.el (isearch-pre-command-hook): * lisp/mouse-drag.el (mouse-drag-throw, mouse-drag-drag): * lisp/mouse.el (mouse-drag-secondary): * lisp/ruler-mode.el (ruler-mode-mouse-grab-any-column) (ruler-mode-mouse-drag-any-column-iteration): * lisp/strokes.el (strokes-read-stroke, strokes-read-complex-stroke): * lisp/textmodes/artist.el (artist-mouse-draw-continously) (artist-mouse-draw-poly, artist-mouse-draw-2points): * lisp/vc/ediff-wind.el (ediff-get-window-by-clicking): * lisp/wid-edit.el (widget-button--check-and-call-button) (widget-button-click): Call 'read--potential-mouse-event' instead of 'read-event'. * lisp/wid-edit.el (widget-key-sequence-read-event): Call 'read-key' with 'fallbacks-disabled' set instead of 'read-event'. Unlike above changes, this is unconditionally applied so it works for function keys too. Apply 'local-function-key-map' instead of 'function-key-map' as that contains the full terminal translations. * lisp/vc/ediff.el (ediff-windows): Use 'display-mouse-p' to check if a mouse is available. * src/lread.c (Fread_event): Recommend 'read-key' in docstring for 'read-event' for non-character events. --- doc/lispref/commands.texi | 14 ++++++++-- lisp/foldout.el | 2 +- lisp/isearch.el | 2 +- lisp/mouse-drag.el | 4 +-- lisp/mouse.el | 2 +- lisp/ruler-mode.el | 4 +-- lisp/strokes.el | 23 +++++++++-------- lisp/subr.el | 54 ++++++++++++++++++++++++++++++++++++--- lisp/textmodes/artist.el | 6 ++--- lisp/vc/ediff-wind.el | 5 ++-- lisp/vc/ediff.el | 2 +- lisp/wid-edit.el | 14 +++++----- src/lread.c | 6 +++++ 13 files changed, 102 insertions(+), 36 deletions(-) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 6c68f70482..3a2c7d019e 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2696,9 +2696,11 @@ Reading One Event @code{read-event}, @code{read-char}, and @code{read-char-exclusive} do not perform the translations described in @ref{Translation Keymaps}. If you wish to read a single key taking these translations into -account, use the function @code{read-key}: +account (for example, to read @ref{Function Keys} in a terminal or +@ref{Mouse Events} from @code{xterm-mouse-mode}), use the function +@code{read-key}: -@defun read-key &optional prompt +@defun read-key &optional prompt disable-fallbacks This function reads a single key. It is intermediate between @code{read-key-sequence} and @code{read-event}. Unlike the former, it reads a single key, not a key sequence. Unlike the latter, it does @@ -2708,6 +2710,14 @@ Reading One Event The argument @var{prompt} is either a string to be displayed in the echo area as a prompt, or @code{nil}, meaning not to display a prompt. + +If argument @var{disable-fallbacks} is non-@code{nil} then the usual +fallback logic for unbound keys in @code{read-key-sequence} is not +applied. This means that mouse button-down and multi-click events +will not be discarded and @code{local-function-key-map} and +@code{key-translation-map} will not get applied. If @code{nil} or +unspecified, the only fallback disabled is downcasing of the last +event. @end defun @defun read-char-choice prompt chars &optional inhibit-quit diff --git a/lisp/foldout.el b/lisp/foldout.el index 771b81e5be..4c479d68e9 100644 --- a/lisp/foldout.el +++ b/lisp/foldout.el @@ -487,7 +487,7 @@ foldout-mouse-swallow-events Signal an error if the final event isn't the same type as the first one." (let ((initial-event-type (event-basic-type event))) (while (null (sit-for (/ double-click-time 1000.0) 'nodisplay)) - (setq event (read-event))) + (setq event (read--potential-mouse-event))) (or (eq initial-event-type (event-basic-type event)) (error ""))) event) diff --git a/lisp/isearch.el b/lisp/isearch.el index 67cc7bed15..0c805b6546 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -2997,7 +2997,7 @@ isearch-pre-command-hook ((and (eq (car-safe main-event) 'down-mouse-1) (window-minibuffer-p (posn-window (event-start main-event)))) ;; Swallow the up-event. - (read-event) + (read--potential-mouse-event) (setq this-command 'isearch-edit-string)) ;; Don't terminate the search for motion commands. ((and isearch-yank-on-move diff --git a/lisp/mouse-drag.el b/lisp/mouse-drag.el index f6612600bd..907ef06159 100644 --- a/lisp/mouse-drag.el +++ b/lisp/mouse-drag.el @@ -225,7 +225,7 @@ mouse-drag-throw ;; Don't change the mouse pointer shape while we drag. (setq track-mouse 'dragging) (while (progn - (setq event (read-event) + (setq event (read--potential-mouse-event) end (event-end event) row (cdr (posn-col-row end)) col (car (posn-col-row end))) @@ -286,7 +286,7 @@ mouse-drag-drag window-last-col (- (window-width) 2)) (track-mouse (while (progn - (setq event (read-event) + (setq event (read--potential-mouse-event) end (event-end event) row (cdr (posn-col-row end)) col (car (posn-col-row end))) diff --git a/lisp/mouse.el b/lisp/mouse.el index 0da82882fc..8732fb8086 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -1792,7 +1792,7 @@ mouse-drag-secondary (let (event end end-point) (track-mouse (while (progn - (setq event (read-event)) + (setq event (read--potential-mouse-event)) (or (mouse-movement-p event) (memq (car-safe event) '(switch-frame select-window)))) diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el index 7cda6c96af..1e81904419 100644 --- a/lisp/ruler-mode.el +++ b/lisp/ruler-mode.el @@ -429,7 +429,7 @@ ruler-mode-mouse-grab-any-column ;; `ding' flushes the next messages about setting goal ;; column. So here I force fetch the event(mouse-2) and ;; throw away. - (read-event) + (read--potential-mouse-event) ;; Ding BEFORE `message' is OK. (when ruler-mode-set-goal-column-ding-flag (ding)) @@ -460,7 +460,7 @@ ruler-mode-mouse-drag-any-column-iteration (track-mouse ;; Signal the display engine to freeze the mouse pointer shape. (setq track-mouse 'dragging) - (while (mouse-movement-p (setq event (read-event))) + (while (mouse-movement-p (setq event (read--potential-mouse-event))) (setq drags (1+ drags)) (when (eq window (posn-window (event-end event))) (ruler-mode-mouse-drag-any-column event) diff --git a/lisp/strokes.el b/lisp/strokes.el index b0ab4f990f..55f2ae8cc4 100644 --- a/lisp/strokes.el +++ b/lisp/strokes.el @@ -756,12 +756,12 @@ strokes-read-stroke (strokes-fill-current-buffer-with-whitespace)) (when prompt (message "%s" prompt) - (setq event (read-event)) + (setq event (read--potential-mouse-event)) (or (strokes-button-press-event-p event) (error "You must draw with the mouse"))) (unwind-protect (track-mouse - (or event (setq event (read-event) + (or event (setq event (read--potential-mouse-event) safe-to-draw-p t)) (while (not (strokes-button-release-event-p event)) (if (strokes-mouse-event-p event) @@ -776,7 +776,7 @@ strokes-read-stroke (setq safe-to-draw-p t)) (push (cdr (mouse-pixel-position)) pix-locs))) - (setq event (read-event))))) + (setq event (read--potential-mouse-event))))) ;; protected ;; clean up strokes buffer and then bury it. (when (equal (buffer-name) strokes-buffer-name) @@ -787,16 +787,16 @@ strokes-read-stroke ;; Otherwise, don't use strokes buffer and read stroke silently (when prompt (message "%s" prompt) - (setq event (read-event)) + (setq event (read--potential-mouse-event)) (or (strokes-button-press-event-p event) (error "You must draw with the mouse"))) (track-mouse - (or event (setq event (read-event))) + (or event (setq event (read--potential-mouse-event))) (while (not (strokes-button-release-event-p event)) (if (strokes-mouse-event-p event) (push (cdr (mouse-pixel-position)) pix-locs)) - (setq event (read-event)))) + (setq event (read--potential-mouse-event)))) (setq grid-locs (strokes-renormalize-to-grid (nreverse pix-locs))) (strokes-fill-stroke (strokes-eliminate-consecutive-redundancies grid-locs))))) @@ -817,10 +817,10 @@ strokes-read-complex-stroke (if prompt (while (not (strokes-button-press-event-p event)) (message "%s" prompt) - (setq event (read-event)))) + (setq event (read--potential-mouse-event)))) (unwind-protect (track-mouse - (or event (setq event (read-event))) + (or event (setq event (read--potential-mouse-event))) (while (not (and (strokes-button-press-event-p event) (eq 'mouse-3 (car (get (car event) @@ -834,14 +834,15 @@ strokes-read-complex-stroke ?\s strokes-character)) (push (cdr (mouse-pixel-position)) pix-locs))) - (setq event (read-event))) + (setq event (read--potential-mouse-event))) (push strokes-lift pix-locs) (while (not (strokes-button-press-event-p event)) - (setq event (read-event)))) + (setq event (read--potential-mouse-event)))) ;; ### KLUDGE! ### sit and wait ;; for some useless event to ;; happen to fix the minibuffer bug. - (while (not (strokes-button-release-event-p (read-event)))) + (while (not (strokes-button-release-event-p + (read--potential-mouse-event)))) (setq pix-locs (nreverse (cdr pix-locs)) grid-locs (strokes-renormalize-to-grid pix-locs)) (strokes-fill-stroke diff --git a/lisp/subr.el b/lisp/subr.el index 260202945b..ab41d6836a 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2543,23 +2543,52 @@ memory-limit ;;;; Input and display facilities. -(defconst read-key-empty-map (make-sparse-keymap)) +;; The following maps are used by `read-key' to remove all key +;; bindings while calling `read-key-sequence'. This way the keys +;; returned are independent of the key binding state. + +(defconst read-key-empty-map (make-sparse-keymap) + "Used internally by `read-key'.") + +(defconst read-key-full-map + (let ((map (make-sparse-keymap))) + (define-key map [t] 'dummy) + + ;; ESC needs to be unbound so that escape sequences in + ;; `input-decode-map' are still processed by `read-key-sequence'. + (define-key map [?\e] nil) + map) + "Used internally by `read-key'.") (defvar read-key-delay 0.01) ;Fast enough for 100Hz repeat rate, hopefully. -(defun read-key (&optional prompt) +(defun read-key (&optional prompt disable-fallbacks) "Read a key from the keyboard. Contrary to `read-event' this will not return a raw event but instead will obey the input decoding and translations usually done by `read-key-sequence'. So escape sequences and keyboard encoding are taken into account. When there's an ambiguity because the key looks like the prefix of -some sort of escape sequence, the ambiguity is resolved via `read-key-delay'." +some sort of escape sequence, the ambiguity is resolved via `read-key-delay'. + +If the optional argument PROMPT is non-nil, display that as a +prompt. + +If the optional argument DISABLE-FALLBACKS is non-nil, all +unbound fallbacks usually done by `read-key-sequence' are +disabled such as discarding mouse down events. This is generally +what you want as `read-key' temporarily removes all bindings +while calling `read-key-sequence'. If nil or unspecified, the +only unbound fallback disabled is downcasing of the last event." ;; This overriding-terminal-local-map binding also happens to ;; disable quail's input methods, so although read-key-sequence ;; always inherits the input method, in practice read-key does not ;; inherit the input method (at least not if it's based on quail). (let ((overriding-terminal-local-map nil) - (overriding-local-map read-key-empty-map) + (overriding-local-map + ;; FIXME: Audit existing uses of `read-key' to see if they + ;; should always specify disable-fallbacks to be more in line + ;; with `read-event'. + (if disable-fallbacks read-key-full-map read-key-empty-map)) (echo-keystrokes 0) (old-global-map (current-global-map)) (timer (run-with-idle-timer @@ -2613,6 +2642,23 @@ read-key (message nil) (use-global-map old-global-map)))) +;; FIXME: Once there's a safe way to transition away from read-event, +;; callers to this function should be updated to that way and this +;; function should be deleted. +(defun read--potential-mouse-event () + "Read an event that might be a mouse event. + +This function exists for backward compatibility in code packaged +with Emacs. Do not call it directly in your own packages." + ;; `xterm-mouse-mode' events must go through `read-key' as they + ;; are decoded via `input-decode-map'. + (if xterm-mouse-mode + (read-key nil + ;; Normally `read-key' discards all mouse button + ;; down events. However, we want them here. + t) + (read-event))) + (defvar read-passwd-map ;; BEWARE: `defconst' would purecopy it, breaking the sharing with ;; minibuffer-local-map along the way! diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el index ce620821d6..50c00c9532 100644 --- a/lisp/textmodes/artist.el +++ b/lisp/textmodes/artist.el @@ -5004,7 +5004,7 @@ artist-mouse-draw-continously (setq timer (run-at-time interval interval draw-fn x1 y1)))) ;; Read next event - (setq ev (read-event)))) + (setq ev (read--potential-mouse-event)))) ;; Cleanup: get rid of any active timer. (if timer (cancel-timer timer))) @@ -5212,7 +5212,7 @@ artist-mouse-draw-poly ;; Read next event (only if we should not stop) (if (not done) - (setq ev (read-event))))) + (setq ev (read--potential-mouse-event))))) ;; Reverse point-list (last points are cond'ed first) (setq point-list (reverse point-list)) @@ -5339,7 +5339,7 @@ artist-mouse-draw-2points ;; Read next event - (setq ev (read-event)))) + (setq ev (read--potential-mouse-event)))) ;; If we are not rubber-banding (that is, we were moving around the `2') ;; draw the shape diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el index 72b345874f..47ef37a19e 100644 --- a/lisp/vc/ediff-wind.el +++ b/lisp/vc/ediff-wind.el @@ -262,11 +262,12 @@ ediff-get-window-by-clicking (let (event) (message "Select windows by clicking. Please click on Window %d " wind-number) - (while (not (ediff-mouse-event-p (setq event (read-event)))) + (while (not (ediff-mouse-event-p (setq event + (read--potential-mouse-event)))) (if (sit-for 1) ; if sequence of events, wait till the final word (beep 1)) (message "Please click on Window %d " wind-number)) - (read-event) ; discard event + (read--potential-mouse-event) ; discard event (posn-window (event-start event)))) diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el index e3612dd8e3..ed375738b4 100644 --- a/lisp/vc/ediff.el +++ b/lisp/vc/ediff.el @@ -939,7 +939,7 @@ ediff-windows-linewise ;; If WIND-A is nil, use selected window. ;; If WIND-B is nil, use window next to WIND-A. (defun ediff-windows (dumb-mode wind-A wind-B startup-hooks job-name word-mode) - (if (or dumb-mode (not (ediff-window-display-p))) + (if (or dumb-mode (not (display-mouse-p))) (setq wind-A (ediff-get-next-window wind-A nil) wind-B (ediff-get-next-window wind-B wind-A)) (setq wind-A (ediff-get-window-by-clicking wind-A nil 1) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 8b10d71dcb..7dda04eda2 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -1104,7 +1104,7 @@ widget-button--check-and-call-button (unless (widget-apply button :mouse-down-action event) (let ((track-mouse t)) (while (not (widget-button-release-event-p event)) - (setq event (read-event)) + (setq event (read--potential-mouse-event)) (when (and mouse-1 (mouse-movement-p event)) (push event unread-command-events) (setq event oevent) @@ -1169,7 +1169,7 @@ widget-button-click (when up ;; Don't execute up events twice. (while (not (widget-button-release-event-p event)) - (setq event (read-event)))) + (setq event (read--potential-mouse-event)))) (when command (call-interactively command))))) (message "You clicked somewhere weird."))) @@ -3486,14 +3486,16 @@ 'key-sequence :help-echo "C-q: insert KEY, EVENT, or CODE; RET: enter value" :tag "Key sequence") +;; FIXME: Consider combining this with help--read-key-sequence which +;; can also read double and triple mouse events. (defun widget-key-sequence-read-event (ev) (interactive (list (let ((inhibit-quit t) quit-flag) - (read-event "Insert KEY, EVENT, or CODE: ")))) + (read-key "Insert KEY, EVENT, or CODE: " t)))) (let ((ev2 (and (memq 'down (event-modifiers ev)) - (read-event))) - (tr (and (keymapp function-key-map) - (lookup-key function-key-map (vector ev))))) + (read-key nil t))) + (tr (and (keymapp local-function-key-map) + (lookup-key local-function-key-map (vector ev))))) (when (and (integerp ev) (or (and (<= ?0 ev) (< ev (+ ?0 (min 10 read-quoted-char-radix)))) (and (<= ?a (downcase ev)) diff --git a/src/lread.c b/src/lread.c index 1ff0828e85..67a0217a13 100644 --- a/src/lread.c +++ b/src/lread.c @@ -782,6 +782,12 @@ DEFUN ("read-char", Fread_char, Sread_char, 0, 3, 0, DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0, doc: /* Read an event object from the input stream. + +If you want to read non-character events, consider calling `read-key' +instead. `read-key' will decode events via `input-decode-map' that +`read-event' will not. On a terminal this includes function keys such +as and , or mouse events generated by `xterm-mouse-mode'. + If the optional argument PROMPT is non-nil, display that as a prompt. If PROMPT is nil or the string \"\", the key sequence/events that led to the current command is used as the prompt. -- 2.20.1