From 8a2cc39ab17a1e2e6f8ea0294b538a8971146a68 Mon Sep 17 00:00:00 2001 From: Jared Finder Date: Sat, 14 Nov 2020 21:42:34 -0800 Subject: [PATCH 2/2] Options for making libraries work with xt-mouse. Libraries changed by making them call `read-key' instead of `read-event'. --- 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 | 22 +++++++++++----------- lisp/subr.el | 23 +++++++++++++++++++++++ lisp/textmodes/artist.el | 6 +++--- lisp/vc/ediff-wind.el | 4 ++-- lisp/vc/ediff.el | 2 +- lisp/wid-edit.el | 9 ++++++--- src/keyboard.c | 10 +++++++++- src/lread.c | 6 ++++++ 13 files changed, 68 insertions(+), 28 deletions(-) diff --git a/lisp/foldout.el b/lisp/foldout.el index 0d7a7a88a6..0a33099daf 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-key))) (or (eq initial-event-type (event-basic-type event)) (error ""))) event) diff --git a/lisp/isearch.el b/lisp/isearch.el index 4fba4370d9..aa623652b3 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -2967,7 +2967,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-key) (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 e80ebba28d..dcffbf0875 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-key) 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-key) 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 9d4492f1bd..d0cd2f7769 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-key)) (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 82e6178da1..29afa44323 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-key) ;; 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-key))) (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 c2f03cac0f..788930c105 100644 --- a/lisp/strokes.el +++ b/lisp/strokes.el @@ -757,12 +757,12 @@ strokes-read-stroke (strokes-fill-current-buffer-with-whitespace)) (when prompt (message "%s" prompt) - (setq event (read-event)) + (setq event (read-key)) (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-key) safe-to-draw-p t)) (while (not (strokes-button-release-event-p event)) (if (strokes-mouse-event-p event) @@ -777,7 +777,7 @@ strokes-read-stroke (setq safe-to-draw-p t)) (push (cdr (mouse-pixel-position)) pix-locs))) - (setq event (read-event))))) + (setq event (read-key))))) ;; protected ;; clean up strokes buffer and then bury it. (when (equal (buffer-name) strokes-buffer-name) @@ -788,16 +788,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-key)) (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-key))) (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-key)))) (setq grid-locs (strokes-renormalize-to-grid (nreverse pix-locs))) (strokes-fill-stroke (strokes-eliminate-consecutive-redundancies grid-locs))))) @@ -818,10 +818,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-key)))) (unwind-protect (track-mouse - (or event (setq event (read-event))) + (or event (setq event (read-key))) (while (not (and (strokes-button-press-event-p event) (eq 'mouse-3 (car (get (car event) @@ -835,14 +835,14 @@ strokes-read-complex-stroke ?\s strokes-character)) (push (cdr (mouse-pixel-position)) pix-locs))) - (setq event (read-event))) + (setq event (read-key))) (push strokes-lift pix-locs) (while (not (strokes-button-press-event-p event)) - (setq event (read-event)))) + (setq event (read-key)))) ;; ### 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-key)))) (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 6e9f66fe97..36381dc4e6 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2446,6 +2446,9 @@ read-key (overriding-local-map read-key-empty-map) (echo-keystrokes 0) (old-global-map (current-global-map)) + ;; Option 1: New variable that prevents mouse events from + ;; being transformed or discarded. + (inhibit--unbound-mouse-fallback t) (timer (run-with-idle-timer ;; Wait long enough that Emacs has the time to receive and ;; process all the raw events associated with the single-key. @@ -2481,6 +2484,26 @@ read-key ;; This hack avoids evaluating the :filter (Bug#9922). (or (cdr (assq 'tool-bar global-map)) (lookup-key global-map [tool-bar]))) + ;; Option 2: Bind all the mouse events to prevent + ;; dropping / transformation. + ;; + ;; Note: this is not an exhaustive list. To fully work, + ;; this should bind all possible prefix combinations (the + ;; power set of A-, C-, H-, S-, s-) for all possible + ;; mouse events. For example, this currently does not + ;; bind C-S-down-mouse-1. + ;; (define-key map [down-mouse-1] 'ignore) + ;; (define-key map [C-down-mouse-1] 'ignore) + ;; (define-key map [M-down-mouse-1] 'ignore) + ;; (define-key map [C-M-down-mouse-1] 'ignore) + ;; (define-key map [down-mouse-2] 'ignore) + ;; (define-key map [C-down-mouse-2] 'ignore) + ;; (define-key map [M-down-mouse-2] 'ignore) + ;; (define-key map [C-M-down-mouse-3] 'ignore) + ;; (define-key map [down-mouse-3] 'ignore) + ;; (define-key map [C-down-mouse-3] 'ignore) + ;; (define-key map [M-down-mouse-3] 'ignore) + ;; (define-key map [C-M-down-mouse-3] 'ignore) map)) (let* ((keys (catch 'read-key (read-key-sequence-vector prompt nil t))) diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el index 5ce9a90ea6..5155d4100c 100644 --- a/lisp/textmodes/artist.el +++ b/lisp/textmodes/artist.el @@ -5016,7 +5016,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-key)))) ;; Cleanup: get rid of any active timer. (if timer (cancel-timer timer))) @@ -5224,7 +5224,7 @@ artist-mouse-draw-poly ;; Read next event (only if we should not stop) (if (not done) - (setq ev (read-event))))) + (setq ev (read-key))))) ;; Reverse point-list (last points are cond'ed first) (setq point-list (reverse point-list)) @@ -5351,7 +5351,7 @@ artist-mouse-draw-2points ;; Read next event - (setq ev (read-event)))) + (setq ev (read-key)))) ;; 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 a23d72070a..9843669e78 100644 --- a/lisp/vc/ediff-wind.el +++ b/lisp/vc/ediff-wind.el @@ -269,11 +269,11 @@ 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-key)))) (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-key) ; discard event (posn-window (event-start event)))) diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el index ae2f8ad6c1..bf35cd2bd1 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 4e2cf7416d..bdcf8255a1 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -1088,7 +1088,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-key)) (when (and mouse-1 (mouse-movement-p event)) (push event unread-command-events) (setq event oevent) @@ -1153,6 +1153,9 @@ widget-button-click (when up ;; Don't execute up events twice. (while (not (widget-button-release-event-p event)) + ;; FIXME: This should probably be read-key to get + ;; mouse events through xterm-mouse-mode, but it is + ;; unclear how to trigger this code path normally. (setq event (read-event)))) (when command (call-interactively command))))) @@ -3465,9 +3468,9 @@ 'key-sequence (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: ")))) (let ((ev2 (and (memq 'down (event-modifiers ev)) - (read-event))) + (read-key))) (tr (and (keymapp function-key-map) (lookup-key function-key-map (vector ev))))) (when (and (integerp ev) diff --git a/src/keyboard.c b/src/keyboard.c index 45e9abc229..483af75158 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -9827,7 +9827,7 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, new_binding = follow_key (current_binding, key); /* If KEY wasn't bound, we'll try some fallbacks. */ - if (!NILP (new_binding)) + if (!NILP (new_binding) || inhibit_unbound_mouse_fallback) /* This is needed for the following scenario: event 0: a down-event that gets dropped by calling replay_key. event 1: some normal prefix like C-h. @@ -12393,6 +12393,14 @@ syms_of_keyboard (void) macros, dribble file, and `recent-keys'. Internal use only. */); + DEFVAR_BOOL ("inhibit--unbound-mouse-fallback", + inhibit_unbound_mouse_fallback, + doc: /* If non-nil, `read-key-sequence' does not +transform any unbound mouse events. +This prevents the usual behavior in `read-key-sequence' where unbound +button-down events, drag events, and multiple-click events get +transformed or dropped. Internal use only. */); + pdumper_do_now_and_after_load (syms_of_keyboard_for_pdumper); } diff --git a/src/lread.c b/src/lread.c index a3d5fd7bb8..e811de47c1 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 mouse events (for example, to discard an expected +button up event inside a button down command), call `read-key' which +can return events via `input-decode-map' such as all 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