* 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

4 files changed, 120 insertions, 85 deletions

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  <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>
 
 	* 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  <monnier@iro.umontreal.ca>
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