[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] trunk r118175: * lisp/mouse.el (mouse-drag-line): Use set-
From: |
Stefan Monnier |
Subject: |
[Emacs-diffs] trunk r118175: * lisp/mouse.el (mouse-drag-line): Use set-transient-map. |
Date: |
Tue, 21 Oct 2014 20:11:28 +0000 |
User-agent: |
Bazaar (2.6b2) |
------------------------------------------------------------
revno: 118175
revision-id: address@hidden
parent: address@hidden
fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=18015
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Tue 2014-10-21 16:11:22 -0400
message:
* 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.
modified:
lisp/ChangeLog changelog-20091113204419-o5vbwnq5f7feedwu-1432
lisp/mouse.el mouse.el-20091113204419-o5vbwnq5f7feedwu-123
lisp/subr.el subr.el-20091113204419-o5vbwnq5f7feedwu-151
lisp/xt-mouse.el xtmouse.el-20091113204419-o5vbwnq5f7feedwu-905
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2014-10-21 16:05:13 +0000
+++ b/lisp/ChangeLog 2014-10-21 20:11:22 +0000
@@ -1,3 +1,16 @@
+2014-10-21 Stefan Monnier <address@hidden>
+
+ * 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 <address@hidden>
* 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 <address@hidden>
=== modified file 'lisp/mouse.el'
--- a/lisp/mouse.el 2014-10-02 03:19:32 +0000
+++ b/lisp/mouse.el 2014-10-21 20:11:22 +0000
@@ -102,8 +102,7 @@
(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 @@
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 @@
(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 @@
(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 @@
(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 @@
;; 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"))))
=== modified file 'lisp/subr.el'
--- a/lisp/subr.el 2014-10-06 07:00:33 +0000
+++ b/lisp/subr.el 2014-10-21 20:11:22 +0000
@@ -2008,7 +2008,14 @@
(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 @@
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 @@
(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.
=== modified file 'lisp/xt-mouse.el'
--- a/lisp/xt-mouse.el 2014-07-19 16:56:40 +0000
+++ b/lisp/xt-mouse.el 2014-10-21 20:11:22 +0000
@@ -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 @@
(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
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] trunk r118175: * lisp/mouse.el (mouse-drag-line): Use set-transient-map.,
Stefan Monnier <=