From 3d5e31eceb9dc1fb62b2b27bcab549df3bd04ce9 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 30 Jan 2018 12:41:29 -0500 Subject: [PATCH] * lisp/mouse.el: Rework the mouse-1-click remapping Avoid peeking ahead at the next event because this had undesirable effects, such as making 'this-single-command-raw-keys' return bogus information. (mouse--last-down): New variable. (mouse--down-1-maybe-follows-link): Don't do the remapping here. Instead, just keep track of the time when the down happened. (mouse--down-1-maybe-follows-link): Do the remapping here. (key-translation-map): Add bindings for (double-)mouse-1. --- lisp/mouse.el | 100 ++++++++++++++++++++++++-------------------------- 1 file changed, 48 insertions(+), 52 deletions(-) diff --git a/lisp/mouse.el b/lisp/mouse.el index 9a3e2235ece..6a98ee7353f 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -58,8 +58,8 @@ addition to mouse drags." With the default setting, an ordinary Mouse-1 click on a link performs the same action as Mouse-2 on that link, while a longer -Mouse-1 click \(hold down the Mouse-1 button for more than 450 -milliseconds) performs the original Mouse-1 binding \(which +Mouse-1 click (hold down the Mouse-1 button for more than 450 +milliseconds) performs the original Mouse-1 binding (which typically sets point where you click the mouse). If value is an integer, the time elapsed between pressing and @@ -96,55 +96,55 @@ point at the click position." :version "22.1" :group 'mouse) +(defvar mouse--last-down nil) + (defun mouse--down-1-maybe-follows-link (&optional _prompt) + (when mouse-1-click-follows-link + (setq mouse--last-down (cons (car-safe last-input-event) (float-time)))) + nil) + +(defun mouse--click-1-maybe-follows-link (&optional _prompt) "Turn `mouse-1' events into `mouse-2' events if follows-link. -Expects to be bound to `down-mouse-1' in `key-translation-map'." - (when (and mouse-1-click-follows-link - (eq (if (eq mouse-1-click-follows-link 'double) - 'double-down-mouse-1 'down-mouse-1) - (car-safe last-input-event))) - (let ((action (mouse-on-link-p (event-start last-input-event)))) - (when (and action - (or mouse-1-click-in-non-selected-windows - (eq (selected-window) - (posn-window (event-start last-input-event))))) - (let ((timedout - (sit-for (if (numberp mouse-1-click-follows-link) - (/ (abs mouse-1-click-follows-link) 1000.0) - 0)))) - (if (if (and (numberp mouse-1-click-follows-link) - (>= mouse-1-click-follows-link 0)) - timedout (not timedout)) - nil - ;; Use read-key so it works for xterm-mouse-mode! - (let ((event (read-key))) - (if (eq (car-safe event) - (if (eq mouse-1-click-follows-link 'double) - 'double-mouse-1 'mouse-1)) - (progn - ;; Turn the mouse-1 into a mouse-2 to follow links, - ;; but only if ‘mouse-on-link-p’ hasn’t returned a - ;; string or vector (see its docstring). - (if (or (stringp action) (vectorp action)) - (push (aref action 0) unread-command-events) - (let ((newup (if (eq mouse-1-click-follows-link 'double) - 'double-mouse-2 'mouse-2))) - ;; If mouse-2 has never been done by the user, it - ;; doesn't have the necessary property to be - ;; interpreted correctly. - (unless (get newup 'event-kind) - (put newup 'event-kind (get (car event) 'event-kind))) - (push (cons newup (cdr event)) unread-command-events))) - ;; Don't change the down event, only the up-event - ;; (bug#18212). - nil) - (push event unread-command-events) - nil)))))))) +Expects to be bound to `(double-)mouse-1' in `key-translation-map'." + (and mouse--last-down + (pcase mouse-1-click-follows-link + ('nil nil) + ('double (eq 'double-mouse-1 (car-safe last-input-event))) + (_ (and (eq 'mouse-1 (car-safe last-input-event)) + (or (not (numberp mouse-1-click-follows-link)) + (funcall (if (< mouse-1-click-follows-link 0) #'> #'<) + (- (float-time) (cdr mouse--last-down)) + (/ (abs mouse-1-click-follows-link) 1000.0)))))) + (eq (car mouse--last-down) + (event-convert-list (list 'down (car-safe last-input-event)))) + (let* ((action (mouse-on-link-p (event-start last-input-event)))) + (when (and action + (or mouse-1-click-in-non-selected-windows + (eq (selected-window) + (posn-window (event-start last-input-event))))) + ;; Turn the mouse-1 into a mouse-2 to follow links, + ;; but only if ‘mouse-on-link-p’ hasn’t returned a + ;; string or vector (see its docstring). + (if (arrayp action) + (vector (aref action 0)) + (let ((newup (if (eq mouse-1-click-follows-link 'double) + 'double-mouse-2 'mouse-2))) + ;; If mouse-2 has never been done by the user, it + ;; doesn't have the necessary property to be + ;; interpreted correctly. + (unless (get newup 'event-kind) + (put newup 'event-kind + (get (car last-input-event) 'event-kind))) + (vector (cons newup (cdr last-input-event))))))))) (define-key key-translation-map [down-mouse-1] #'mouse--down-1-maybe-follows-link) (define-key key-translation-map [double-down-mouse-1] #'mouse--down-1-maybe-follows-link) +(define-key key-translation-map [mouse-1] + #'mouse--click-1-maybe-follows-link) +(define-key key-translation-map [double-mouse-1] + #'mouse--click-1-maybe-follows-link) ;; Provide a mode-specific menu on a mouse button. @@ -1144,19 +1144,15 @@ The resulting value determine whether POS is inside a link: is a non-nil `mouse-face' property at POS. Return t in this case. - If the value is a function, FUNC, POS is inside a link if -the call \(FUNC POS) returns non-nil. Return the return value -from that call. Arg is \(posn-point POS) if POS is a mouse event. +the call (FUNC POS) returns non-nil. Return the return value +from that call. Arg is (posn-point POS) if POS is a mouse event. - Otherwise, return the value itself. The return value is interpreted as follows: -- If it is a string, the mouse-1 event is translated into the -first character of the string, i.e. the action of the mouse-1 -click is the local or global binding of that character. - -- If it is a vector, the mouse-1 event is translated into the -first element of that vector, i.e. the action of the mouse-1 +- If it is an array, the mouse-1 event is translated into the +first element of that array, i.e. the action of the mouse-1 click is the local or global binding of that event. - Otherwise, the mouse-1 event is translated into a mouse-2 event -- 2.39.2