diff options
| -rw-r--r-- | lisp/mouse.el | 100 |
1 files 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." | |||
| 58 | 58 | ||
| 59 | With the default setting, an ordinary Mouse-1 click on a link | 59 | With the default setting, an ordinary Mouse-1 click on a link |
| 60 | performs the same action as Mouse-2 on that link, while a longer | 60 | performs the same action as Mouse-2 on that link, while a longer |
| 61 | Mouse-1 click \(hold down the Mouse-1 button for more than 450 | 61 | Mouse-1 click (hold down the Mouse-1 button for more than 450 |
| 62 | milliseconds) performs the original Mouse-1 binding \(which | 62 | milliseconds) performs the original Mouse-1 binding (which |
| 63 | typically sets point where you click the mouse). | 63 | typically sets point where you click the mouse). |
| 64 | 64 | ||
| 65 | If value is an integer, the time elapsed between pressing and | 65 | If value is an integer, the time elapsed between pressing and |
| @@ -96,55 +96,55 @@ point at the click position." | |||
| 96 | :version "22.1" | 96 | :version "22.1" |
| 97 | :group 'mouse) | 97 | :group 'mouse) |
| 98 | 98 | ||
| 99 | (defvar mouse--last-down nil) | ||
| 100 | |||
| 99 | (defun mouse--down-1-maybe-follows-link (&optional _prompt) | 101 | (defun mouse--down-1-maybe-follows-link (&optional _prompt) |
| 102 | (when mouse-1-click-follows-link | ||
| 103 | (setq mouse--last-down (cons (car-safe last-input-event) (float-time)))) | ||
| 104 | nil) | ||
| 105 | |||
| 106 | (defun mouse--click-1-maybe-follows-link (&optional _prompt) | ||
| 100 | "Turn `mouse-1' events into `mouse-2' events if follows-link. | 107 | "Turn `mouse-1' events into `mouse-2' events if follows-link. |
| 101 | Expects to be bound to `down-mouse-1' in `key-translation-map'." | 108 | Expects to be bound to `(double-)mouse-1' in `key-translation-map'." |
| 102 | (when (and mouse-1-click-follows-link | 109 | (and mouse--last-down |
| 103 | (eq (if (eq mouse-1-click-follows-link 'double) | 110 | (pcase mouse-1-click-follows-link |
| 104 | 'double-down-mouse-1 'down-mouse-1) | 111 | ('nil nil) |
| 105 | (car-safe last-input-event))) | 112 | ('double (eq 'double-mouse-1 (car-safe last-input-event))) |
| 106 | (let ((action (mouse-on-link-p (event-start last-input-event)))) | 113 | (_ (and (eq 'mouse-1 (car-safe last-input-event)) |
| 107 | (when (and action | 114 | (or (not (numberp mouse-1-click-follows-link)) |
| 108 | (or mouse-1-click-in-non-selected-windows | 115 | (funcall (if (< mouse-1-click-follows-link 0) #'> #'<) |
| 109 | (eq (selected-window) | 116 | (- (float-time) (cdr mouse--last-down)) |
| 110 | (posn-window (event-start last-input-event))))) | 117 | (/ (abs mouse-1-click-follows-link) 1000.0)))))) |
| 111 | (let ((timedout | 118 | (eq (car mouse--last-down) |
| 112 | (sit-for (if (numberp mouse-1-click-follows-link) | 119 | (event-convert-list (list 'down (car-safe last-input-event)))) |
| 113 | (/ (abs mouse-1-click-follows-link) 1000.0) | 120 | (let* ((action (mouse-on-link-p (event-start last-input-event)))) |
| 114 | 0)))) | 121 | (when (and action |
| 115 | (if (if (and (numberp mouse-1-click-follows-link) | 122 | (or mouse-1-click-in-non-selected-windows |
| 116 | (>= mouse-1-click-follows-link 0)) | 123 | (eq (selected-window) |
| 117 | timedout (not timedout)) | 124 | (posn-window (event-start last-input-event))))) |
| 118 | nil | 125 | ;; Turn the mouse-1 into a mouse-2 to follow links, |
| 119 | ;; Use read-key so it works for xterm-mouse-mode! | 126 | ;; but only if ‘mouse-on-link-p’ hasn’t returned a |
| 120 | (let ((event (read-key))) | 127 | ;; string or vector (see its docstring). |
| 121 | (if (eq (car-safe event) | 128 | (if (arrayp action) |
| 122 | (if (eq mouse-1-click-follows-link 'double) | 129 | (vector (aref action 0)) |
| 123 | 'double-mouse-1 'mouse-1)) | 130 | (let ((newup (if (eq mouse-1-click-follows-link 'double) |
| 124 | (progn | 131 | 'double-mouse-2 'mouse-2))) |
| 125 | ;; Turn the mouse-1 into a mouse-2 to follow links, | 132 | ;; If mouse-2 has never been done by the user, it |
| 126 | ;; but only if ‘mouse-on-link-p’ hasn’t returned a | 133 | ;; doesn't have the necessary property to be |
| 127 | ;; string or vector (see its docstring). | 134 | ;; interpreted correctly. |
| 128 | (if (or (stringp action) (vectorp action)) | 135 | (unless (get newup 'event-kind) |
| 129 | (push (aref action 0) unread-command-events) | 136 | (put newup 'event-kind |
| 130 | (let ((newup (if (eq mouse-1-click-follows-link 'double) | 137 | (get (car last-input-event) 'event-kind))) |
| 131 | 'double-mouse-2 'mouse-2))) | 138 | (vector (cons newup (cdr last-input-event))))))))) |
| 132 | ;; If mouse-2 has never been done by the user, it | ||
| 133 | ;; doesn't have the necessary property to be | ||
| 134 | ;; interpreted correctly. | ||
| 135 | (unless (get newup 'event-kind) | ||
| 136 | (put newup 'event-kind (get (car event) 'event-kind))) | ||
| 137 | (push (cons newup (cdr event)) unread-command-events))) | ||
| 138 | ;; Don't change the down event, only the up-event | ||
| 139 | ;; (bug#18212). | ||
| 140 | nil) | ||
| 141 | (push event unread-command-events) | ||
| 142 | nil)))))))) | ||
| 143 | 139 | ||
| 144 | (define-key key-translation-map [down-mouse-1] | 140 | (define-key key-translation-map [down-mouse-1] |
| 145 | #'mouse--down-1-maybe-follows-link) | 141 | #'mouse--down-1-maybe-follows-link) |
| 146 | (define-key key-translation-map [double-down-mouse-1] | 142 | (define-key key-translation-map [double-down-mouse-1] |
| 147 | #'mouse--down-1-maybe-follows-link) | 143 | #'mouse--down-1-maybe-follows-link) |
| 144 | (define-key key-translation-map [mouse-1] | ||
| 145 | #'mouse--click-1-maybe-follows-link) | ||
| 146 | (define-key key-translation-map [double-mouse-1] | ||
| 147 | #'mouse--click-1-maybe-follows-link) | ||
| 148 | 148 | ||
| 149 | 149 | ||
| 150 | ;; Provide a mode-specific menu on a mouse button. | 150 | ;; Provide a mode-specific menu on a mouse button. |
| @@ -1144,19 +1144,15 @@ The resulting value determine whether POS is inside a link: | |||
| 1144 | is a non-nil `mouse-face' property at POS. Return t in this case. | 1144 | is a non-nil `mouse-face' property at POS. Return t in this case. |
| 1145 | 1145 | ||
| 1146 | - If the value is a function, FUNC, POS is inside a link if | 1146 | - If the value is a function, FUNC, POS is inside a link if |
| 1147 | the call \(FUNC POS) returns non-nil. Return the return value | 1147 | the call (FUNC POS) returns non-nil. Return the return value |
| 1148 | from that call. Arg is \(posn-point POS) if POS is a mouse event. | 1148 | from that call. Arg is (posn-point POS) if POS is a mouse event. |
| 1149 | 1149 | ||
| 1150 | - Otherwise, return the value itself. | 1150 | - Otherwise, return the value itself. |
| 1151 | 1151 | ||
| 1152 | The return value is interpreted as follows: | 1152 | The return value is interpreted as follows: |
| 1153 | 1153 | ||
| 1154 | - If it is a string, the mouse-1 event is translated into the | 1154 | - If it is an array, the mouse-1 event is translated into the |
| 1155 | first character of the string, i.e. the action of the mouse-1 | 1155 | first element of that array, i.e. the action of the mouse-1 |
| 1156 | click is the local or global binding of that character. | ||
| 1157 | |||
| 1158 | - If it is a vector, the mouse-1 event is translated into the | ||
| 1159 | first element of that vector, i.e. the action of the mouse-1 | ||
| 1160 | click is the local or global binding of that event. | 1156 | click is the local or global binding of that event. |
| 1161 | 1157 | ||
| 1162 | - Otherwise, the mouse-1 event is translated into a mouse-2 event | 1158 | - Otherwise, the mouse-1 event is translated into a mouse-2 event |