From c8e5a42c4ab4ce3f1712e69255da78000f6bde35 Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Thu, 26 Jul 2012 10:32:25 +0200 Subject: [PATCH] In mouse-drag-line don't exit tracking prematurely (Bug#12006). * 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). --- lisp/ChangeLog | 6 +++++ lisp/mouse.el | 71 +++++++++++++++++++++++++++++++++----------------- 2 files changed, 53 insertions(+), 24 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index e249b4ab759..c23079e1839 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2012-07-26 Martin Rudalics + + * 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 * mouse.el (popup-menu): Fix last change. diff --git a/lisp/mouse.el b/lisp/mouse.el index 07277a409ae..71336c08ee3 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -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") -- 2.39.2