From: Stefan Monnier Date: Tue, 21 Oct 2014 20:11:22 +0000 (-0400) Subject: * lisp/mouse.el (mouse-drag-line): Use set-transient-map. X-Git-Tag: emacs-25.0.90~2635^2~678 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=18b8557f5ab154625d72891bdb982da14091da4d;p=emacs.git * lisp/mouse.el (mouse-drag-line): Use set-transient-map. (mouse--down-1-maybe-follows-link): Remove unused var `this-event'. (mouse-yank-secondary): Use gui-get-selection. (mouse--down-1-maybe-follows-link): Use read-key. * lisp/subr.el (read-key): Fix clicks on the mode-line. (set-transient-map): Return exit function. * lisp/xt-mouse.el: Add `event-kind' property on the fly from xterm-mouse-translate-1 rather than statically at the outset. Fixes: debbugs:18015 --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f066327c9b9..fb516323ee0 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,16 @@ +2014-10-21 Stefan Monnier + + * subr.el (read-key): Fix clicks on the mode-line. + (set-transient-map): Return exit function. + + * mouse.el (mouse-drag-line): Use set-transient-map (bug#18015). + (mouse--down-1-maybe-follows-link): Remove unused var `this-event'. + (mouse-yank-secondary): Use gui-get-selection. + (mouse--down-1-maybe-follows-link): Use read-key. + + * xt-mouse.el: Add `event-kind' property on the fly from + xterm-mouse-translate-1 rather than statically at the outset. + 2014-10-21 Daniel Colascione * vc/vc-dispatcher.el (vc-resynch-window): Tell view-mode not to @@ -106,7 +119,7 @@ * mouse.el (mouse--down-1-maybe-follows-link): Remove unused var `this-event'. - (mouse-drag-line): Use there's no actual mouse, use the event's + (mouse-drag-line): Unless there's no actual mouse, use the event's position info. 2014-10-20 Stefan Monnier diff --git a/lisp/mouse.el b/lisp/mouse.el index f569ec3577d..c69c944092b 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -102,8 +102,7 @@ Expects to be bound to `down-mouse-1' in `key-translation-map'." (or mouse-1-click-in-non-selected-windows (eq (selected-window) (posn-window (event-start last-input-event))))) - (let ((this-event last-input-event) - (timedout + (let ((timedout (sit-for (if (numberp mouse-1-click-follows-link) (/ (abs mouse-1-click-follows-link) 1000.0) 0)))) @@ -112,7 +111,7 @@ Expects to be bound to `down-mouse-1' in `key-translation-map'." timedout (not timedout)) nil - (let ((event (read-event))) + (let ((event (read-key))) ;Use read-key so it works for xterm-mouse-mode! (if (eq (car-safe event) (if (eq mouse-1-click-follows-link 'double) 'double-mouse-1 'mouse-1)) ;; Turn the mouse-1 into a mouse-2 to follow links. @@ -390,7 +389,7 @@ must be one of the symbols `header', `mode', or `vertical'." (frame-parameters frame))) 'right))) (draggable t) - height finished event position growth dragged) + height growth dragged) (cond ((eq line 'header) ;; Check whether header-line can be dragged at all. @@ -435,65 +434,81 @@ must be one of the symbols `header', `mode', or `vertical'." (not (zerop (window-right-divider-width window)))) (setq window (window-in-direction 'left window t))))) + (let* ((exitfun nil) + (move + (lambda (event) (interactive "e") + (let ((position + ;; For graphic terminals, we're better off using + ;; mouse-pixel-position for the following reasons: + ;; - when the mouse has moved outside of the frame, `event' + ;; does not contain any useful pixel position any more. + ;; - mouse-pixel-position is a bit more uptodate (the mouse + ;; may have moved still a bit further since the event was + ;; generated). + (if (display-mouse-p) + (mouse-pixel-position) + (let* ((posn (event-end event)) + (pos (posn-x-y posn)) + (w (posn-window posn)) + (pe (if (windowp w) (window-pixel-edges w)))) + (cons (if (windowp w) (window-frame w) w) + (if pe + (cons (+ (car pos) (nth 0 pe)) + (+ (cdr pos) (nth 1 pe))))))))) + (cond + ((not (and (eq (car position) frame) + (cadr position))) + nil) + ((eq line 'vertical) + ;; Drag vertical divider. This must be probably fixed like + ;; for the mode-line. + (setq growth (- (cadr position) + (if (eq side 'right) 0 2) + (nth 2 (window-pixel-edges window)) + -1)) + (unless (zerop growth) + (setq dragged t) + (adjust-window-trailing-edge window growth t t))) + (draggable + ;; Drag horizontal divider. + (setq growth + (if (eq line 'mode) + (- (+ (cddr position) height) + (nth 3 (window-pixel-edges window))) + ;; The window's top includes the header line! + (- (+ (nth 3 (window-pixel-edges window)) height) + (cddr position)))) + (unless (zerop growth) + (setq dragged t) + (adjust-window-trailing-edge + window (if (eq line 'mode) growth (- growth)) nil t)))))))) + ;; Start tracking. - (track-mouse - ;; Loop reading events and sampling the position of the mouse. - (while (not finished) - (setq event (read-event)) - (setq position (mouse-pixel-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 finished 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 finished t)) - ((not (and (eq (car position) frame) - (cadr position))) - nil) - ((eq line 'vertical) - ;; Drag vertical divider. This must be probably fixed like - ;; for the mode-line. - (setq growth (- (cadr position) - (if (eq side 'right) 0 2) - (nth 2 (window-pixel-edges window)) - -1)) - (unless (zerop growth) - (setq dragged t) - (adjust-window-trailing-edge window growth t t))) - (draggable - ;; Drag horizontal divider. - (setq growth - (if (eq line 'mode) - (- (+ (cddr position) height) - (nth 3 (window-pixel-edges window))) - ;; The window's top includes the header line! - (- (+ (nth 3 (window-pixel-edges window)) height) - (cddr position)))) - (unless (zerop growth) - (setq dragged t) - (adjust-window-trailing-edge - window (if (eq line 'mode) growth (- growth)) nil t)))))))) + (setq track-mouse t) + ;; Loop reading events and sampling the position of the mouse. + (setq exitfun + (set-transient-map + (let ((map (make-sparse-keymap))) + (define-key map [switch-frame] #'ignore) + (define-key map [select-window] #'ignore) + (define-key map [mouse-movement] move) + (define-key map [scroll-bar-movement] move) + ;; Swallow drag-mouse-1 events to avoid selecting some other window. + (define-key map [drag-mouse-1] + (lambda () (interactive) (funcall exitfun))) + ;; For vertical line dragging swallow also a mouse-1 + ;; event (but only if we dragged at least once to allow mouse-1 + ;; clicks to get through). + (when (eq line 'vertical) + (define-key map [mouse-1] + `(menu-item "" ,(lambda () (interactive) (funcall exitfun)) + :filter ,(lambda (cmd) (if dragged cmd))))) + ;; Some of the events will of course end up looked up + ;; with a mode-line or header-line prefix. + (define-key map [mode-line] map) + (define-key map [header-line] map) + map) + t (lambda () (setq track-mouse nil))))))) (defun mouse-drag-mode-line (start-event) "Change the height of a window by dragging on the mode line." @@ -1292,6 +1307,7 @@ The function returns a non-nil value if it creates a secondary selection." (setq mouse-secondary-start (make-marker))) (set-marker mouse-secondary-start start-point) (delete-overlay mouse-secondary-overlay)) + ;; FIXME: Use mouse-drag-track! (let (event end end-point) (track-mouse (while (progn @@ -1350,7 +1366,7 @@ regardless of where you click." ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) (or mouse-yank-at-point (mouse-set-point click)) - (let ((secondary (x-get-selection 'SECONDARY))) + (let ((secondary (gui-get-selection 'SECONDARY))) (if secondary (insert-for-yank secondary) (error "No secondary selection")))) diff --git a/lisp/subr.el b/lisp/subr.el index 585f9368c53..edf59b88941 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2008,7 +2008,14 @@ some sort of escape sequence, the ambiguity is resolved via `read-key-delay'." (or (cdr (assq 'tool-bar global-map)) (lookup-key global-map [tool-bar]))) map)) - (aref (catch 'read-key (read-key-sequence-vector prompt nil t)) 0)) + (let* ((keys + (catch 'read-key (read-key-sequence-vector prompt nil t))) + (key (aref keys 0))) + (if (and (> (length keys) 1) + (memq key '(mode-line header-line + left-fringe right-fringe))) + (aref keys 1) + key))) (cancel-timer timer) (use-global-map old-global-map)))) @@ -4348,20 +4355,27 @@ use `called-interactively-p'." Normally, MAP is used only once, to look up the very next key. However, if the optional argument KEEP-PRED is t, MAP stays active if a key from MAP is used. KEEP-PRED can also be a -function of no arguments: if it returns non-nil, then MAP stays -active. +function of no arguments: it is called from `pre-command-hook' and +if it returns non-nil, then MAP stays active. Optional arg ON-EXIT, if non-nil, specifies a function that is called, with no arguments, after MAP is deactivated. This uses `overriding-terminal-local-map' which takes precedence over all other keymaps. As usual, if no match for a key is found in MAP, the normal key -lookup sequence then continues." - (let ((clearfun (make-symbol "clear-transient-map"))) +lookup sequence then continues. + +This returns an \"exit function\", which can be called with no argument +to deactivate this transient map, regardless of KEEP-PRED." + (let* ((clearfun (make-symbol "clear-transient-map")) + (exitfun + (lambda () + (internal-pop-keymap map 'overriding-terminal-local-map) + (remove-hook 'pre-command-hook clearfun) + (when on-exit (funcall on-exit))))) ;; Don't use letrec, because equal (in add/remove-hook) would get trapped ;; in a cycle. (fset clearfun - (suspicious-object (lambda () (with-demoted-errors "set-transient-map PCH: %S" (unless (cond @@ -4382,15 +4396,10 @@ lookup sequence then continues." (eq this-command (lookup-key map (this-command-keys-vector)))) (t (funcall keep-pred))) - (internal-pop-keymap map 'overriding-terminal-local-map) - (remove-hook 'pre-command-hook clearfun) - (when on-exit (funcall on-exit)) - ;; Comment out the fset if you want to debug the GC bug. -;;; (fset clearfun nil) -;;; (set clearfun nil) - ))))) + (funcall exitfun))))) (add-hook 'pre-command-hook clearfun) - (internal-push-keymap map 'overriding-terminal-local-map))) + (internal-push-keymap map 'overriding-terminal-local-map) + exitfun)) ;;;; Progress reporters. diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index cad3151b244..b933936f128 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -42,13 +42,6 @@ (defvar xterm-mouse-debug-buffer nil) -;; Mouse events symbols must have an 'event-kind property with -;; the value 'mouse-click. -(dolist (event '(mouse-1 mouse-2 mouse-3 mouse-4 mouse-5)) - (let ((M-event (intern (concat "M-" (symbol-name event))))) - (put event 'event-kind 'mouse-click) - (put M-event 'event-kind 'mouse-click))) - (defun xterm-mouse-translate (_event) "Read a click and release event from XTerm." (xterm-mouse-translate-1)) @@ -69,6 +62,10 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)." (vec (vector event)) (is-down (string-match "down-" (symbol-name ev-command)))) + ;; Mouse events symbols must have an 'event-kind property with + ;; the value 'mouse-click. + (when ev-command (put ev-command 'event-kind 'mouse-click)) + (cond ((null event) nil) ;Unknown/bogus byte sequence! (is-down