procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix interaction of line-dragging with mouse-1-click-follows-link.

Browse source 
* 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
This commit is contained in:
Chong Yidong 2012-07-08 16:26:21 +08:00
parent d75be97d54
commit 01ac65bd7c
3 changed files with 67 additions and 99 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
lisp/ChangeLog
View file

@ -1,5 +1,11 @@
2012-07-08 Chong Yidong <cyd@gnu.org>
* 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).

4
lisp/info.el
View file

@ -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)

156
lisp/mouse.el
View file

@ -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)))