aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/mouse.el100
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
59With the default setting, an ordinary Mouse-1 click on a link 59With the default setting, an ordinary Mouse-1 click on a link
60performs the same action as Mouse-2 on that link, while a longer 60performs the same action as Mouse-2 on that link, while a longer
61Mouse-1 click \(hold down the Mouse-1 button for more than 450 61Mouse-1 click (hold down the Mouse-1 button for more than 450
62milliseconds) performs the original Mouse-1 binding \(which 62milliseconds) performs the original Mouse-1 binding (which
63typically sets point where you click the mouse). 63typically sets point where you click the mouse).
64 64
65If value is an integer, the time elapsed between pressing and 65If 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.
101Expects to be bound to `down-mouse-1' in `key-translation-map'." 108Expects 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:
1144is a non-nil `mouse-face' property at POS. Return t in this case. 1144is 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
1147the call \(FUNC POS) returns non-nil. Return the return value 1147the call (FUNC POS) returns non-nil. Return the return value
1148from that call. Arg is \(posn-point POS) if POS is a mouse event. 1148from 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
1152The return value is interpreted as follows: 1152The 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
1155first character of the string, i.e. the action of the mouse-1 1155first element of that array, i.e. the action of the mouse-1
1156click is the local or global binding of that character.
1157
1158- If it is a vector, the mouse-1 event is translated into the
1159first element of that vector, i.e. the action of the mouse-1
1160click is the local or global binding of that event. 1156click 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