martin/emacs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

In mouse-drag-line don't exit tracking prematurely (Bug#12006).

Browse Source 
* mouse.el (popup-menu): Fix doc-string and re-indent code.
(mouse-drag-line): Don't exit tracking when a switch-frame or
switch-window event occurs (Bug#12006).
This commit is contained in:
Martin Rudalics
2012-07-26 10:32:25 +02:00
parent 1781b9e935
commit c8e5a42c4a
2 changed files with 53 additions and 24 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
lisp/ChangeLog
View File

@@ -1,3 +1,9 @@
2012-07-26 Martin Rudalics <rudalics@gmx.at>
* mouse.el (popup-menu): Fix doc-string and re-indent code.
(mouse-drag-line): Don't exit tracking when a switch-frame or
switch-window event occurs (Bug#12006).
2012-07-26 Stefan Monnier <monnier@iro.umontreal.ca>
* mouse.el (popup-menu): Fix last change.

71
lisp/mouse.el
View File

@@ -101,9 +101,11 @@ point at the click position."
"Popup the given menu and call the selected option.
MENU can be a keymap, an easymenu-style menu or a list of keymaps as for
`x-popup-menu'.
POSITION can be a click event or ((XOFFSET YOFFSET) WINDOW) and defaults to
the current mouse position. If POSITION is a symbol, `point' the current point
position is used.
POSITION can be a click event or ((XOFFSET YOFFSET) WINDOW) and
defaults to the current mouse position. If POSITION is the
symbol `point', the current point position is used.
PREFIX is the prefix argument (if any) to pass to the command."
(let* ((map (cond
((keymapp menu) menu)
@@ -113,17 +115,17 @@ PREFIX is the prefix argument (if any) to pass to the command."
(plist-get (get map 'menu-prop) :filter))))
(if filter (funcall filter (symbol-function map)) map)))))
event cmd)
(setq position
(cond
((eq position 'point)
(let* ((pp (posn-at-point))
(xy (posn-x-y pp)))
(list (list (car xy) (cdr xy)) (posn-window pp))))
((not position)
(let ((mp (mouse-pixel-position)))
(list (list (cadr mp) (cddr mp)) (car mp))))
(t
position)))
(setq position
(cond
((eq position 'point)
(let* ((pp (posn-at-point))
(xy (posn-x-y pp)))
(list (list (car xy) (cdr xy)) (posn-window pp))))
((not position)
(let ((mp (mouse-pixel-position)))
(list (list (cadr mp) (cddr mp)) (car mp))))
(t
position)))
;; The looping behavior was taken from lmenu's popup-menu-popup
(while (and map (setq event
;; map could be a prefix key, in which case
@@ -141,7 +143,7 @@ PREFIX is the prefix argument (if any) to pass to the command."
binding)
(while (and map (null binding))
(setq binding (lookup-key (car map) mouse-click))
(if (numberp binding) ; `too long'
(if (numberp binding) ; `too long'
(setq binding nil))
(setq map (cdr map)))
binding)
@@ -447,17 +449,39 @@ must be one of the symbols `header', `mode', or `vertical'."
;; Start tracking.
(track-mouse
;; 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)))
;; Loop reading events and sampling the position of the mouse.
(while draggable
(setq event (read-event))
(setq position (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 (Why? -- cyd)
;; (same as mouse movement for our purposes)
;; Quit if
;; - there is a keyboard event or some other unknown event.
(cond
((not (consp event))
(setq draggable nil))
((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 draggable nil))
((or (not (eq (car position) frame))
(null (cadr position)))
(null (car (cdr position))))
nil)
((eq line 'vertical)
;; Drag vertical divider.
@@ -489,7 +513,6 @@ must be one of the symbols `header', `mode', or `vertical'."
(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."
(interactive "e")