[Emacs-diffs] trunk r118175: * lisp/mouse.el (mouse-drag-line): Use set-transient-map.

[Stefan Monnier]

------------------------------------------------------------
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