Separate mouse-1-click-follows-link from mouse-drag-region.

* lisp/mouse.el (mouse--down-1-maybe-follows-link): New function.
(key-translation-map): Use it to implement mouse-1-click-follows-link.
(mouse-drag-line, mouse-drag-track): Remove mouse-1-click-follows-link code.
(mouse--remap-link-click-p): Remove.
* src/keyboard.c (access_keymap_keyremap): Accept nil return value from
functions to mean "no change".
* src/keyboard.h (EVENT_START, EVENT_END, POSN_WINDOW, POSN_POSN)
(POSN_WINDOW_POSN, POSN_TIMESTAMP): Be careful since events may come
from Elisp via unread-command-events.

1 files changed, 44 insertions, 50 deletions

diff --git a/lisp/mouse.el b/lisp/mouse.el
index bd7242e3b20..f820d3aa6d7 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -93,6 +93,49 @@ point at the click position."
   :version "22.1"
   :group 'mouse)
 
+(defun mouse--down-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'."
+  (if (or (null mouse-1-click-follows-link)
+          (not (eq (if (eq mouse-1-click-follows-link 'double)
+                       'double-down-mouse-1 'down-mouse-1)
+                   (car-safe last-input-event)))
+          (not (mouse-on-link-p (event-start last-input-event)))
+          (and (not mouse-1-click-in-non-selected-windows)
+               (not (eq (selected-window)
+                        (posn-window (event-start last-input-event))))))
+      nil
+    (let ((this-event last-input-event)
+          (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
+
+        (let ((event (read-event)))
+          (if (eq (car-safe event) (if (eq mouse-1-click-follows-link 'double)
+                                       'double-mouse-1 'mouse-1))
+              ;; Turn the mouse-1 into a mouse-2 to follow links.
+              (let ((newup (if (eq mouse-1-click-follows-link 'double)
+                                'double-mouse-2 'mouse-2))
+                    (newdown (if (eq mouse-1-click-follows-link 'double)
+                                 'double-down-mouse-2 'down-mouse-2)))
+                ;; If mouse-2 has never been done by the user, it doesn't have
+                ;; the necessary property to be interpreted correctly.
+                (put newup 'event-kind (get (car event) 'event-kind))
+                (put newdown 'event-kind (get (car this-event) 'event-kind))
+                (push (cons newup (cdr event)) unread-command-events)
+                (vector (cons newdown (cdr this-event))))
+            (push event unread-command-events)
+            nil))))))
+
+(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)
 
 
 ;; Provide a mode-specific menu on a mouse button.
@@ -418,8 +461,6 @@ must be one of the symbols `header', `mode', or `vertical'."
 	 (window (posn-window start))
 	 (frame (window-frame window))
 	 (minibuffer-window (minibuffer-window frame))
-         (on-link (and mouse-1-click-follows-link
-		       (mouse-on-link-p start)))
 	 (side (and (eq line 'vertical)
 		    (or (cdr (assq 'vertical-scroll-bars
 				   (frame-parameters frame)))
@@ -507,12 +548,6 @@ must be one of the symbols `header', `mode', or `vertical'."
 						(- growth)))))))
     ;; Process the terminating event.
     (unless dragged
-      (when (and (mouse-event-p event) on-link
-                 (mouse--remap-link-click-p start-event event))
-        ;; If mouse-2 has never been done by the user, it doesn't have
-        ;; the necessary property to be interpreted correctly.
-        (put 'mouse-2 'event-kind 'mouse-click)
-        (setcar event 'mouse-2))
       (push event unread-command-events))))
 
 (defun mouse-drag-mode-line (start-event)
@@ -770,7 +805,6 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by
   (setq mouse-selection-click-count-buffer (current-buffer))
   (deactivate-mark)
   (let* ((scroll-margin 0) ; Avoid margin scrolling (Bug#9541).
-	 (original-window (selected-window))
          ;; We've recorded what we needed from the current buffer and
          ;; window, now let's jump to the place of the event, where things
          ;; are happening.
@@ -788,15 +822,7 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by
 		     (nth 3 bounds)
 		   ;; Don't count the mode line.
 		   (1- (nth 3 bounds))))
-	 (on-link (and mouse-1-click-follows-link
-                       ;; Use start-point before the intangibility
-                       ;; treatment, in case we click on a link inside
-                       ;; intangible text.
-                       (mouse-on-link-p start-posn)))
 	 (click-count (1- (event-click-count start-event)))
-	 (remap-double-click (and on-link
-				  (eq mouse-1-click-follows-link 'double)
-				  (= click-count 1)))
 	 ;; Suppress automatic hscrolling, because that is a nuisance
 	 ;; when setting point near the right fringe (but see below).
 	 (auto-hscroll-mode-saved auto-hscroll-mode)
@@ -809,8 +835,6 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by
     (if (< (point) start-point)
 	(goto-char start-point))
     (setq start-point (point))
-    (if remap-double-click
-	(setq click-count 0))
 
     ;; Activate the region, using `mouse-start-end' to determine where
     ;; to put point and mark (e.g., double-click will select a word).
@@ -826,6 +850,7 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by
     (track-mouse
       (while (progn
 	       (setq event (read-event))
+               (trace-values event)
 	       (or (mouse-movement-p event)
 		   (memq (car-safe event) '(switch-frame select-window))))
 	(unless (memq (car-safe event) '(switch-frame select-window))
@@ -900,21 +925,6 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by
 		     (or end-point
 			 (= (window-start start-window)
 			    start-window-start)))
-	    (when (and on-link
-		       (= start-point (point))
-		       (mouse--remap-link-click-p start-event event))
-	      ;; If we rebind to mouse-2, reselect previous selected
-	      ;; window, so that the mouse-2 event runs in the same
-	      ;; situation as if user had clicked it directly.  Fixes
-	      ;; the bug reported by juri@jurta.org on 2005-12-27.
-	      (if (or (vectorp on-link) (stringp on-link))
-		  (setq event (aref on-link 0))
-		(select-window original-window)
-		(setcar event 'mouse-2)
-		;; If this mouse click has never been done by the
-		;; user, it doesn't have the necessary property to be
-		;; interpreted correctly.
-		(put 'mouse-2 'event-kind 'mouse-click)))
 	    (push event unread-command-events)))))))
 
 (defun mouse--drag-set-mark-and-point (start click click-count)
@@ -932,22 +942,6 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by
 	   (set-mark beg)
 	   (goto-char end)))))
 
-(defun mouse--remap-link-click-p (start-event end-event)
-  (or (and (eq mouse-1-click-follows-link 'double)
-	   (= (event-click-count start-event) 2))
-      (and
-       (not (eq mouse-1-click-follows-link 'double))
-       (= (event-click-count start-event) 1)
-       (= (event-click-count end-event) 1)
-       (or (not (integerp mouse-1-click-follows-link))
-	   (let ((t0 (posn-timestamp (event-start start-event)))
-		 (t1 (posn-timestamp (event-end   end-event))))
-	     (and (integerp t0) (integerp t1)
-		  (if (> mouse-1-click-follows-link 0)
-		      (<= (- t1 t0) mouse-1-click-follows-link)
-		    (< (- t0 t1) mouse-1-click-follows-link))))))))
-
-
 ;; Commands to handle xterm-style multiple clicks.
 (defun mouse-skip-word (dir)
   "Skip over word, over whitespace, or over identical punctuation.