[Emacs-diffs] /srv/bzr/emacs/trunk r108951: Fix interaction of line-dragging with mouse-1-click-follows-link.

[Chong Yidong]

------------------------------------------------------------
revno: 108951
fixes bug: http://debbugs.gnu.org/374
committer: Chong Yidong <address@hidden>
branch nick: trunk
timestamp: Sun 2012-07-08 16:26:21 +0800
message:
  Fix interaction of line-dragging with mouse-1-click-follows-link.
  
  * lisp/mouse.el (mouse-drag-line): Rewrite the track-mouse loop.
  Implement the mouse-1-click-follows-link handling properly.
  
  * lisp/info.el (Info-link-keymap): Use follow-link mechanism for
  header-line links.
modified:
  lisp/ChangeLog
  lisp/info.el
  lisp/mouse.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-07-08 06:09:21 +0000
+++ b/lisp/ChangeLog    2012-07-08 08:26:21 +0000
@@ -1,5 +1,11 @@
 2012-07-08  Chong Yidong  <address@hidden>
 
+       * mouse.el (mouse-drag-line): Rewrite the track-mouse loop.
+       Implement the mouse-1-click-follows-link handling properly.
+
+       * info.el (Info-link-keymap): Use follow-link mechanism for
+       header-line links (Bug#374).
+
        * simple.el (deactivate-mark): Do not set the primary selection
        if another program has acquired it (Bug#11772).
 

=== modified file 'lisp/info.el'
--- a/lisp/info.el      2012-06-27 07:47:56 +0000
+++ b/lisp/info.el      2012-07-08 08:26:21 +0000
@@ -4361,9 +4361,9 @@
 
 (defvar Info-link-keymap
   (let ((keymap (make-sparse-keymap)))
-    (define-key keymap [header-line mouse-1] 'Info-mouse-follow-link)
+    (define-key keymap [header-line down-mouse-1] 'mouse-drag-header-line)
+    (define-key keymap [header-line mouse-1] 'mouse-select-window)
     (define-key keymap [header-line mouse-2] 'Info-mouse-follow-link)
-    (define-key keymap [header-line down-mouse-1] 'ignore)
     (define-key keymap [mouse-2] 'Info-mouse-follow-link)
     (define-key keymap [follow-link] 'mouse-face)
     keymap)

=== modified file 'lisp/mouse.el'
--- a/lisp/mouse.el     2012-06-23 12:54:59 +0000
+++ b/lisp/mouse.el     2012-07-08 08:26:21 +0000
@@ -388,10 +388,11 @@
 
 ;; Note that `window-in-direction' replaces `mouse-drag-window-above'
 ;; and `mouse-drag-vertical-line-rightward-window' with Emacs 24.1.
+
 (defun mouse-drag-line (start-event line)
-  "Drag some line with the mouse.
+  "Drag a mode line, header line, or vertical line with the mouse.
 START-EVENT is the starting mouse-event of the drag action.  LINE
-must be one of the symbols header, mode, or vertical."
+must be one of the symbols `header', `mode', or `vertical'."
   ;; Give temporary modes such as isearch a chance to turn off.
   (run-hooks 'mouse-leave-buffer-hook)
   (let* ((echo-keystrokes 0)
@@ -400,122 +401,85 @@
         (frame (window-frame window))
         (minibuffer-window (minibuffer-window frame))
          (on-link (and mouse-1-click-follows-link
-                      (or mouse-1-click-in-non-selected-windows
-                          (eq window (selected-window)))
                       (mouse-on-link-p start)))
-        (resize-minibuffer
-         ;; Resize the minibuffer window if it's on the same frame as
-         ;; and immediately below the position window and it's either
-         ;; active or `resize-mini-windows' is nil.
-         (and (eq line 'mode)
-              (eq (window-frame minibuffer-window) frame)
-              (= (nth 1 (window-edges minibuffer-window))
-                 (nth 3 (window-edges window)))
-              (or (not resize-mini-windows)
-                  (eq minibuffer-window (active-minibuffer-window)))))
-        (which-side
-         (and (eq line 'vertical)
-              (or (cdr (assq 'vertical-scroll-bars (frame-parameters frame)))
-                  'right)))
-        done event mouse growth dragged)
+        (side (and (eq line 'vertical)
+                   (or (cdr (assq 'vertical-scroll-bars
+                                  (frame-parameters frame)))
+                       'right)))
+        (draggable t)
+        event position growth dragged)
     (cond
      ((eq line 'header)
       ;; Check whether header-line can be dragged at all.
       (if (window-at-side-p window 'top)
-         (setq done t)
+         (setq draggable nil)
        (setq window (window-in-direction 'above window t))))
      ((eq line 'mode)
       ;; Check whether mode-line can be dragged at all.
-      (when (and (window-at-side-p window 'bottom)
-                (not resize-minibuffer))
-       (setq done t)))
+      (and (window-at-side-p window 'bottom)
+          ;; Allow resizing the minibuffer window if it's on the same
+          ;; frame as and immediately below the clicked window, and
+          ;; it's active or `resize-mini-windows' is nil.
+          (not (and (eq (window-frame minibuffer-window) frame)
+                    (= (nth 1 (window-edges minibuffer-window))
+                       (nth 3 (window-edges window)))
+                    (or (not resize-mini-windows)
+                        (eq minibuffer-window
+                            (active-minibuffer-window)))))
+          (setq draggable nil)))
      ((eq line 'vertical)
-      ;; Get the window to adjust for the vertical case.
-      (setq window
-           (if (eq which-side 'right)
-               ;; If the scroll bar is on the window's right or there's
-               ;; no scroll bar at all, adjust the window where the
-               ;; start-event occurred.
-               window
-             ;; If the scroll bar is on the start-event window's left,
-             ;; adjust the window on the left of it.
-             (window-in-direction 'left window t)))))
+      ;; Get the window to adjust for the vertical case.  If the
+      ;; scroll bar is on the window's right or there's no scroll bar
+      ;; at all, adjust the window where the start-event occurred.  If
+      ;; the scroll bar is on the start-event window's left, adjust
+      ;; the window on the left of it.
+      (unless (eq side 'right)
+       (setq window (window-in-direction 'left window t)))))
 
     ;; Start tracking.
     (track-mouse
-      ;; Loop reading events and sampling the position of the mouse.
-      (while (not done)
-       (setq event (read-event))
-       (setq mouse (mouse-position))
-       ;; Do nothing if
-       ;;   - there is a switch-frame event.
-       ;;   - the mouse isn't in the frame that we started in
-       ;;   - the mouse isn't in any Emacs frame
-       ;; Drag if
-       ;;   - there is a mouse-movement event
-       ;;   - there is a scroll-bar-movement event (??)
-       ;;     (same as mouse movement for our purposes)
-       ;; Quit if
-       ;;   - there is a keyboard event or some other unknown event.
+      ;; Loop reading events and sampling the position of the mouse,
+      ;; until there is a non-mouse-movement event.  Also,
+      ;; scroll-bar-movement events are the same as mouse movement for
+      ;; our purposes.  (Why? -- cyd)
+      (while (progn
+              (setq event (read-event))
+              (memq (car-safe event) '(mouse-movement scroll-bar-movement)))
+       (setq position (mouse-position))
        (cond
-        ((not (consp event))
-         (setq done t))
-        ((memq (car event) '(switch-frame select-window))
-         nil)
-        ((not (memq (car event) '(mouse-movement scroll-bar-movement)))
-         (when (consp event)
-           ;; Do not unread a drag-mouse-1 event to avoid selecting
-           ;; some other window.  For vertical line dragging do not
-           ;; unread mouse-1 events either (but only if we dragged at
-           ;; least once to allow mouse-1 clicks get through.
-           (unless (and dragged
-                        (if (eq line 'vertical)
-                            (memq (car event) '(drag-mouse-1 mouse-1))
-                          (eq (car event) 'drag-mouse-1)))
-             (push event unread-command-events)))
-         (setq done t))
-        ((or (not (eq (car mouse) frame)) (null (car (cdr mouse))))
+        ((or (not (eq (car position) frame))
+             (null (cadr position)))
          nil)
         ((eq line 'vertical)
-         ;; Drag vertical divider (the calculations below are those
-         ;; from Emacs 23).
-         (setq growth
-               (- (- (cadr mouse)
-                     (if (eq which-side 'right) 0 2))
-                  (nth 2 (window-edges window))
-                  -1))
+         ;; Drag vertical divider.
+         (setq growth (- (cadr position)
+                         (if (eq side 'right) 0 2)
+                         (nth 2 (window-edges window))
+                         -1))
          (unless (zerop growth)
-           ;; Remember that we dragged.
            (setq dragged t))
          (adjust-window-trailing-edge window growth t))
-        (t
-         ;; Drag horizontal divider (the calculations below are those
-         ;; from Emacs 23).
+        (draggable
+         ;; Drag horizontal divider.
          (setq growth
                (if (eq line 'mode)
-                   (- (cddr mouse) (nth 3 (window-edges window)) -1)
+                   (- (cddr position) (nth 3 (window-edges window)) -1)
                  ;; The window's top includes the header line!
-                 (- (nth 3 (window-edges window)) (cddr mouse))))
-
+                 (- (nth 3 (window-edges window)) (cddr position))))
          (unless (zerop growth)
-           ;; Remember that we dragged.
            (setq dragged t))
-
-         (if (eq line 'mode)
-             (adjust-window-trailing-edge window growth)
-           (adjust-window-trailing-edge window (- growth))))))
-
-      ;; Presumably, if this was just a click, the last event should be
-      ;; `mouse-1', whereas if this did move the mouse, it should be a
-      ;; `drag-mouse-1'.  `dragged' nil tells us that we never dragged
-      ;; and `on-link' tells us that there is a link to follow.
-      (when (and on-link (not dragged)
-                (eq 'mouse-1 (car-safe (car unread-command-events))))
-       ;; 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 unread-command-events
-               (cons 'mouse-2 (cdar unread-command-events)))))))
+         (adjust-window-trailing-edge window (if (eq line 'mode)
+                                                 growth
+                                               (- growth)))))))
+    ;; Process the terminating event.
+    (when (and (mouse-event-p event) on-link (not dragged)
+              (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)
   "Change the height of a window by dragging on the mode line."
@@ -791,10 +755,8 @@
                   ;; Don't count the mode line.
                   (1- (nth 3 bounds))))
         (on-link (and mouse-1-click-follows-link
-                      (or mouse-1-click-in-non-selected-windows
-                          (eq start-window original-window))
                        ;; Use start-point before the intangibility
-                       ;; treatment, in case we click on a link inside an
+                       ;; 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)))