Commit 18b8557f authored by Stefan Monnier's avatar Stefan Monnier
Browse files

* 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
parent be5722e9
2014-10-21 Stefan Monnier <monnier@iro.umontreal.ca>
* 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 <dancol@dancol.org> 2014-10-21 Daniel Colascione <dancol@dancol.org>
   
* vc/vc-dispatcher.el (vc-resynch-window): Tell view-mode not to * vc/vc-dispatcher.el (vc-resynch-window): Tell view-mode not to
...@@ -106,7 +119,7 @@ ...@@ -106,7 +119,7 @@
   
* mouse.el (mouse--down-1-maybe-follows-link): Remove unused var * mouse.el (mouse--down-1-maybe-follows-link): Remove unused var
`this-event'. `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. position info.
   
2014-10-20 Stefan Monnier <monnier@iro.umontreal.ca> 2014-10-20 Stefan Monnier <monnier@iro.umontreal.ca>
......
...@@ -102,8 +102,7 @@ Expects to be bound to `down-mouse-1' in `key-translation-map'." ...@@ -102,8 +102,7 @@ Expects to be bound to `down-mouse-1' in `key-translation-map'."
(or mouse-1-click-in-non-selected-windows (or mouse-1-click-in-non-selected-windows
(eq (selected-window) (eq (selected-window)
(posn-window (event-start last-input-event))))) (posn-window (event-start last-input-event)))))
(let ((this-event last-input-event) (let ((timedout
(timedout
(sit-for (if (numberp mouse-1-click-follows-link) (sit-for (if (numberp mouse-1-click-follows-link)
(/ (abs mouse-1-click-follows-link) 1000.0) (/ (abs mouse-1-click-follows-link) 1000.0)
0)))) 0))))
...@@ -112,7 +111,7 @@ Expects to be bound to `down-mouse-1' in `key-translation-map'." ...@@ -112,7 +111,7 @@ Expects to be bound to `down-mouse-1' in `key-translation-map'."
timedout (not timedout)) timedout (not timedout))
nil 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) (if (eq (car-safe event) (if (eq mouse-1-click-follows-link 'double)
'double-mouse-1 'mouse-1)) 'double-mouse-1 'mouse-1))
;; Turn the mouse-1 into a mouse-2 to follow links. ;; 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'." ...@@ -390,7 +389,7 @@ must be one of the symbols `header', `mode', or `vertical'."
(frame-parameters frame))) (frame-parameters frame)))
'right))) 'right)))
(draggable t) (draggable t)
height finished event position growth dragged) height growth dragged)
(cond (cond
((eq line 'header) ((eq line 'header)
;; Check whether header-line can be dragged at all. ;; Check whether header-line can be dragged at all.
...@@ -435,65 +434,81 @@ must be one of the symbols `header', `mode', or `vertical'." ...@@ -435,65 +434,81 @@ must be one of the symbols `header', `mode', or `vertical'."
(not (zerop (window-right-divider-width window)))) (not (zerop (window-right-divider-width window))))
(setq window (window-in-direction 'left window t))))) (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. ;; Start tracking.
(track-mouse (setq track-mouse t)
;; Loop reading events and sampling the position of the mouse. ;; Loop reading events and sampling the position of the mouse.
(while (not finished) (setq exitfun
(setq event (read-event)) (set-transient-map
(setq position (mouse-pixel-position)) (let ((map (make-sparse-keymap)))
;; Do nothing if (define-key map [switch-frame] #'ignore)
;; - there is a switch-frame event. (define-key map [select-window] #'ignore)
;; - the mouse isn't in the frame that we started in (define-key map [mouse-movement] move)
;; - the mouse isn't in any Emacs frame (define-key map [scroll-bar-movement] move)
;; Drag if ;; Swallow drag-mouse-1 events to avoid selecting some other window.
;; - there is a mouse-movement event (define-key map [drag-mouse-1]
;; - there is a scroll-bar-movement event (Why? -- cyd) (lambda () (interactive) (funcall exitfun)))
;; (same as mouse movement for our purposes) ;; For vertical line dragging swallow also a mouse-1
;; Quit if ;; event (but only if we dragged at least once to allow mouse-1
;; - there is a keyboard event or some other unknown event. ;; clicks to get through).
(cond (when (eq line 'vertical)
((not (consp event)) (define-key map [mouse-1]
(setq finished t)) `(menu-item "" ,(lambda () (interactive) (funcall exitfun))
((memq (car event) '(switch-frame select-window)) :filter ,(lambda (cmd) (if dragged cmd)))))
nil) ;; Some of the events will of course end up looked up
((not (memq (car event) '(mouse-movement scroll-bar-movement))) ;; with a mode-line or header-line prefix.
(when (consp event) (define-key map [mode-line] map)
;; Do not unread a drag-mouse-1 event to avoid selecting (define-key map [header-line] map)
;; some other window. For vertical line dragging do not map)
;; unread mouse-1 events either (but only if we dragged at t (lambda () (setq track-mouse nil)))))))
;; 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))))))))
(defun mouse-drag-mode-line (start-event) (defun mouse-drag-mode-line (start-event)
"Change the height of a window by dragging on the mode line." "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." ...@@ -1292,6 +1307,7 @@ The function returns a non-nil value if it creates a secondary selection."
(setq mouse-secondary-start (make-marker))) (setq mouse-secondary-start (make-marker)))
(set-marker mouse-secondary-start start-point) (set-marker mouse-secondary-start start-point)
(delete-overlay mouse-secondary-overlay)) (delete-overlay mouse-secondary-overlay))
;; FIXME: Use mouse-drag-track!
(let (event end end-point) (let (event end end-point)
(track-mouse (track-mouse
(while (progn (while (progn
...@@ -1350,7 +1366,7 @@ regardless of where you click." ...@@ -1350,7 +1366,7 @@ regardless of where you click."
;; Give temporary modes such as isearch a chance to turn off. ;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook) (run-hooks 'mouse-leave-buffer-hook)
(or mouse-yank-at-point (mouse-set-point click)) (or mouse-yank-at-point (mouse-set-point click))
(let ((secondary (x-get-selection 'SECONDARY))) (let ((secondary (gui-get-selection 'SECONDARY)))
(if secondary (if secondary
(insert-for-yank secondary) (insert-for-yank secondary)
(error "No secondary selection")))) (error "No secondary selection"))))
......
...@@ -2008,7 +2008,14 @@ some sort of escape sequence, the ambiguity is resolved via `read-key-delay'." ...@@ -2008,7 +2008,14 @@ some sort of escape sequence, the ambiguity is resolved via `read-key-delay'."
(or (cdr (assq 'tool-bar global-map)) (or (cdr (assq 'tool-bar global-map))
(lookup-key global-map [tool-bar]))) (lookup-key global-map [tool-bar])))
map)) 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) (cancel-timer timer)
(use-global-map old-global-map)))) (use-global-map old-global-map))))
...@@ -4348,20 +4355,27 @@ use `called-interactively-p'." ...@@ -4348,20 +4355,27 @@ use `called-interactively-p'."
Normally, MAP is used only once, to look up the very next key. Normally, MAP is used only once, to look up the very next key.
However, if the optional argument KEEP-PRED is t, MAP stays 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 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 function of no arguments: it is called from `pre-command-hook' and
active. if it returns non-nil, then MAP stays active.
Optional arg ON-EXIT, if non-nil, specifies a function that is Optional arg ON-EXIT, if non-nil, specifies a function that is
called, with no arguments, after MAP is deactivated. called, with no arguments, after MAP is deactivated.
This uses `overriding-terminal-local-map' which takes precedence over all other 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 keymaps. As usual, if no match for a key is found in MAP, the normal key
lookup sequence then continues." lookup sequence then continues.
(let ((clearfun (make-symbol "clear-transient-map")))
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 ;; Don't use letrec, because equal (in add/remove-hook) would get trapped
;; in a cycle. ;; in a cycle.
(fset clearfun (fset clearfun
(suspicious-object
(lambda () (lambda ()
(with-demoted-errors "set-transient-map PCH: %S" (with-demoted-errors "set-transient-map PCH: %S"
(unless (cond (unless (cond
...@@ -4382,15 +4396,10 @@ lookup sequence then continues." ...@@ -4382,15 +4396,10 @@ lookup sequence then continues."
(eq this-command (eq this-command
(lookup-key map (this-command-keys-vector)))) (lookup-key map (this-command-keys-vector))))
(t (funcall keep-pred))) (t (funcall keep-pred)))
(internal-pop-keymap map 'overriding-terminal-local-map) (funcall exitfun)))))
(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)
)))))
(add-hook 'pre-command-hook clearfun) (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. ;;;; Progress reporters.
......
...@@ -42,13 +42,6 @@ ...@@ -42,13 +42,6 @@
(defvar xterm-mouse-debug-buffer nil) (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) (defun xterm-mouse-translate (_event)
"Read a click and release event from XTerm." "Read a click and release event from XTerm."
(xterm-mouse-translate-1)) (xterm-mouse-translate-1))
...@@ -69,6 +62,10 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)." ...@@ -69,6 +62,10 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)."
(vec (vector event)) (vec (vector event))
(is-down (string-match "down-" (symbol-name ev-command)))) (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 (cond
((null event) nil) ;Unknown/bogus byte sequence! ((null event) nil) ;Unknown/bogus byte sequence!
(is-down (is-down
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment