From 01ac65bd7c0df6c895bf18810ee5c8d24704681a Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sun, 8 Jul 2012 16:26:21 +0800 Subject: [PATCH] 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. Fixes: debbugs:374 --- lisp/ChangeLog | 6 +++ lisp/info.el | 4 +- lisp/mouse.el | 156 ++++++++++++++++++++++----------------------------------- 3 files changed, 67 insertions(+), 99 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 8a608ea7b10..dbe37763d7a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,11 @@ 2012-07-08 Chong Yidong + * 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). diff --git a/lisp/info.el b/lisp/info.el index 9a62bc23fd0..0afb3f01339 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -4361,9 +4361,9 @@ the variable `Info-file-list-for-emacs'." (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) diff --git a/lisp/mouse.el b/lisp/mouse.el index c130a27a8e4..a0d10a64945 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -388,10 +388,11 @@ This command must be bound to a mouse click." ;; 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 @@ must be one of the symbols header, mode, or vertical." (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)) + (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))) - (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))))))) (defun mouse-drag-mode-line (start-event) "Change the height of a window by dragging on the mode line." @@ -791,10 +755,8 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by ;; 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))) -- 2.11.4.GIT