[Emacs-diffs] /srv/bzr/emacs/trunk r111979: Separate mouse-1-click-follows-link from mouse-drag-region.

[Stefan Monnier]

------------------------------------------------------------
revno: 111979
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Fri 2013-03-08 23:15:53 -0500
message:
  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.
modified:
  lisp/ChangeLog
  lisp/mouse.el
  src/ChangeLog
  src/keyboard.c
  src/keyboard.h

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2013-03-08 08:11:28 +0000
+++ b/lisp/ChangeLog    2013-03-09 04:15:53 +0000
@@ -1,10 +1,19 @@
+2013-03-09  Stefan Monnier  <address@hidden>
+
+       Separate mouse-1-click-follows-link from mouse-drag-region.
+       * 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.
+
 2013-03-08  Jambunathan K  <address@hidden>
 
        * hi-lock.el (hi-lock-read-regexp-defaults-function): New var.
        (hi-lock-read-regexp-defaults):  New defun.
        (hi-lock-line-face-buffer, hi-lock-face-buffer)
-       (hi-lock-face-phrase-buffer): Propagate above change.  Update
-       docstring (bug#13892).
+       (hi-lock-face-phrase-buffer): Propagate above change.
+       Update docstring (bug#13892).
 
        * subr.el (find-tag-default-as-regexp): New defun.
        * replace.el (read-regexp): Propagate above change.
@@ -45,13 +54,13 @@
 
 2013-03-07  Dmitry Gutov  <address@hidden>
 
-       * progmodes/js.el (js--multi-line-declaration-indentation): Merge
-       from js2-mode (https://github.com/mooz/js2-mode/issues/89).
+       * progmodes/js.el (js--multi-line-declaration-indentation):
+       Merge from js2-mode (https://github.com/mooz/js2-mode/issues/89).
 
 2013-03-06  Dmitry Gutov  <address@hidden>
 
-       * progmodes/ruby-mode.el (ruby-syntax-propertize-function): Only
-       propertize regexp when not inside a string (Bug#13885).
+       * progmodes/ruby-mode.el (ruby-syntax-propertize-function):
+       Only propertize regexp when not inside a string (Bug#13885).
 
 2013-03-06  Alan Mackenzie  <address@hidden>
 
@@ -62,8 +71,8 @@
 
 2013-03-05  Michael Albinus  <address@hidden>
 
-       * net/tramp-compat.el (tramp-compat-delete-directory): Implement
-       TRASH argument.
+       * net/tramp-compat.el (tramp-compat-delete-directory):
+       Implement TRASH argument.
 
 2013-03-05  Dmitry Gutov  <address@hidden>
 

=== modified file 'lisp/mouse.el'
--- a/lisp/mouse.el     2013-02-07 01:54:50 +0000
+++ b/lisp/mouse.el     2013-03-09 04:15:53 +0000
@@ -93,6 +93,49 @@
   :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 @@
         (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 @@
                                                (- 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 @@
   (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 @@
                     (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 @@
     (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 @@
     (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 @@
                     (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 address@hidden 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 @@
           (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.

=== modified file 'src/ChangeLog'
--- a/src/ChangeLog     2013-03-08 21:37:41 +0000
+++ b/src/ChangeLog     2013-03-09 04:15:53 +0000
@@ -1,3 +1,12 @@
+2013-03-09  Stefan Monnier  <address@hidden>
+
+       * 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.
+
+       * keyboard.c (access_keymap_keyremap): Accept nil return value from
+       functions to mean "no change".
+
 2013-03-08  Paul Eggert  <address@hidden>
 
        region-cache.c, scroll.c, search.c: Use bool for booleans.
@@ -19,8 +28,8 @@
        * lisp.h (find_newline, find_newline_no_quit): Adjust prototype.
        * bidi.c (bidi_find_paragraph_start): Pass byte position to
        find_newline_no_quit, thus eliminating CHAR_TO_BYTE.
-       * editfns.c (Fconstrain_to_field): Break long line.  Adjust
-       call to find_newline.
+       * editfns.c (Fconstrain_to_field): Break long line.
+       Adjust call to find_newline.
        * indent.c (vmotion): Adjust calls to find_newline_no_quit.
        Use DEC_BOTH to start next search from the previous buffer
        position, where appropriate.
@@ -270,8 +279,8 @@
 
 2013-03-02  Eli Zaretskii  <address@hidden>
 
-       * textprop.c (Fadd_text_properties, Fremove_text_properties): If
-       the interval tree changes as a side effect of calling
+       * textprop.c (Fadd_text_properties, Fremove_text_properties):
+       If the interval tree changes as a side effect of calling
        modify_region, re-do processing starting from the call to
        validate_interval_range.  (Bug#13743)
 
@@ -347,8 +356,8 @@
        * textprop.c (Fadd_text_properties, Fremove_text_properties)
        (Fremove_list_of_text_properties): Skip all of the intervals in
        the region between START and END that already have resp. don't
-       have the requested properties, not just the first one.  Add
-       assertions that the loop afterwards always modifies the
+       have the requested properties, not just the first one.
+       Add assertions that the loop afterwards always modifies the
        properties.  (Bug#13743)
 
 2013-02-25  Stefan Monnier  <address@hidden>

=== modified file 'src/keyboard.c'
--- a/src/keyboard.c    2013-03-07 03:01:17 +0000
+++ b/src/keyboard.c    2013-03-09 04:15:53 +0000
@@ -8699,7 +8699,7 @@
         barf--don't ignore it.
         (To ignore it safely, we would need to gcpro a bunch of
         other variables.)  */
-      if (! (VECTORP (next) || STRINGP (next)))
+      if (! (NILP (next) || VECTORP (next) || STRINGP (next)))
        error ("Function %s returns invalid key sequence",
               SSDATA (SYMBOL_NAME (tem)));
     }

=== modified file 'src/keyboard.h'
--- a/src/keyboard.h    2013-02-11 19:21:23 +0000
+++ b/src/keyboard.h    2013-03-09 04:15:53 +0000
@@ -421,18 +421,18 @@
   (EVENT_HAS_PARAMETERS (event) ? XCAR (event) : (event))
 
 /* Extract the starting and ending positions from a composite event.  */
-#define EVENT_START(event) (XCAR (XCDR (event)))
-#define EVENT_END(event) (XCAR (XCDR (XCDR (event))))
+#define EVENT_START(event) (CAR_SAFE (CDR_SAFE (event)))
+#define EVENT_END(event) (CAR_SAFE (CDR_SAFE (CDR_SAFE (event))))
 
 /* Extract the click count from a multi-click event.  */
 #define EVENT_CLICK_COUNT(event) (Fnth (make_number (2), (event)))
 
 /* Extract the fields of a position.  */
-#define POSN_WINDOW(posn) (XCAR (posn))
-#define POSN_POSN(posn) (XCAR (XCDR (posn)))
+#define POSN_WINDOW(posn) (CAR_SAFE (posn))
+#define POSN_POSN(posn) (CAR_SAFE (CDR_SAFE (posn)))
 #define POSN_SET_POSN(posn,x) (XSETCAR (XCDR (posn), (x)))
-#define POSN_WINDOW_POSN(posn) (XCAR (XCDR (XCDR (posn))))
-#define POSN_TIMESTAMP(posn) (XCAR (XCDR (XCDR (XCDR (posn)))))
+#define POSN_WINDOW_POSN(posn) (CAR_SAFE (CDR_SAFE (CDR_SAFE (posn))))
+#define POSN_TIMESTAMP(posn) (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (posn)))))
 #define POSN_SCROLLBAR_PART(posn)      (Fnth (make_number (4), (posn)))
 
 /* A cons (STRING . STRING-CHARPOS), or nil in mouse-click events.