* lisp/mouse.el: Use the normal toplevel loop while dragging.

(mouse-set-point): Handle multi-clicks.
(mouse-set-region): Handle multi-clicks for drags.
(mouse-drag-region): Update call accordingly.
(mouse-drag-track): Remove `do-mouse-drag-region-post-process' hack.
Use the normal event loop instead of a local while/read-event loop.
(global-map): Remove redundant bindings for double/triple-mouse-1.
* lisp/xt-mouse.el (xterm-mouse-translate-1): Only process one event at a time.
Generate synthetic down events when the protocol only sends up events.
(xterm-mouse-last): Remove.
(xterm-mouse--read-event-sequence-1000): Use xterm-mouse-last-down
terminal parameter instead.
(xterm-mouse--set-click-count): New function.
(xterm-mouse-event): Detect/generate double/triple clicks.
* lisp/reveal.el (reveal-close-old-overlays): Don't close while dragging.

1 files changed, 94 insertions, 75 deletions

diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el
index fc515974036..54fd1a44d5b 100644
--- a/lisp/xt-mouse.el
+++ b/lisp/xt-mouse.el
@@ -42,13 +42,12 @@
 
 (defvar xterm-mouse-debug-buffer nil)
 
-(defvar xterm-mouse-last)
-
 ;; Mouse events symbols must have an 'event-kind property with
 ;; the value 'mouse-click.
-(dolist (event-type '(mouse-1 mouse-2 mouse-3
-		      M-down-mouse-1 M-down-mouse-2 M-down-mouse-3))
-  (put event-type 'event-kind '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."
@@ -65,59 +64,47 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)."
   (save-excursion
     (save-window-excursion              ;FIXME: Why?
       (deactivate-mark)                 ;FIXME: Why?
-      (let* ((xterm-mouse-last nil)
-	     (down (xterm-mouse-event extension))
-	     (down-command (nth 0 down))
-	     (down-data    (nth 1 down))
-	     (down-where   (nth 1 down-data))
-	     (down-binding (key-binding (if (symbolp down-where)
-					    (vector down-where down-command)
-					  (vector down-command))))
-	     (is-down (string-match "down" (symbol-name (car down)))))
-
-	;; Retrieve the expected preface for the up-event.
-	(unless is-down
-	  (unless (cond ((null extension)
-			 (and (eq (read-event) ?\e)
-			      (eq (read-event) ?\[)
-			      (eq (read-event) ?M)))
-			((eq extension 1006)
-			 (and (eq (read-event) ?\e)
-			      (eq (read-event) ?\[)
-			      (eq (read-event) ?<))))
-	    (error "Unexpected escape sequence from XTerm")))
-
-	;; Process the up-event.
-	(let* ((click (if is-down (xterm-mouse-event extension) down))
-	       (click-data  (nth 1 click))
-	       (click-where (nth 1 click-data)))
+      (let* ((event (xterm-mouse-event extension))
+	     (ev-command (nth 0 event))
+	     (ev-data    (nth 1 event))
+	     (ev-where   (nth 1 ev-data))
+             (vec (if (and (symbolp ev-where) (consp ev-where))
+                      ;; FIXME: This condition can *never* be non-nil!?!
+                      (vector (list ev-where ev-data) event)
+                    (vector event)))
+	     (is-down (string-match "down-" (symbol-name ev-command))))
+
           (cond
-           ((null down) nil)
-           ((memq down-binding '(nil ignore))
-            (if (and (symbolp click-where)
-                     (consp click-where))
-                (vector (list click-where click-data) click)
-              (vector click)))
+         ((null event) nil)           ;Unknown/bogus byte sequence!
+         (is-down
+          (setf (terminal-parameter nil 'xterm-mouse-last-down) event)
+          vec)
+         (t
+          (let* ((down (terminal-parameter nil 'xterm-mouse-last-down))
+                 (down-data (nth 1 down))
+                 (down-where (nth 1 down-data)))
+            (setf (terminal-parameter nil 'xterm-mouse-last-down) nil)
+            (cond
+             ((null down)
+              ;; This is an "up-only" event.  Pretend there was an up-event
+              ;; right before and keep the up-event for later.
+              (push event unread-command-events)
+              (vector (cons (intern (replace-regexp-in-string
+                                     "\\`\\([ACMHSs]-\\)*" "\\&down-"
+                                     (symbol-name ev-command) t))
+                            (cdr event))))
+             ((equal ev-where down-where) vec)
            (t
-	    (setq unread-command-events
-		  (append (if (eq down-where click-where)
-			      (list click)
-			    (list
-			     ;; Cheat `mouse-drag-region' with move event.
-			     (list 'mouse-movement click-data)
-			     ;; Generate a drag event.
-			     (if (symbolp down-where)
-				 0
-			       (list (intern (format "drag-mouse-%d"
-						     (1+ xterm-mouse-last)))
-				     down-data click-data))))
-			  unread-command-events))
-	    (if xterm-mouse-debug-buffer
-		(print unread-command-events xterm-mouse-debug-buffer))
-	    (if (and (symbolp down-where)
-		     (consp down-where))
-		(vector (list down-where down-data) down)
-	      (vector down)))))))))
+              (let ((drag (if (symbolp ev-where)
+                                 0      ;FIXME: Why?!?
+                               (list (replace-regexp-in-string
+                                      "\\`\\([ACMHSs]-\\)*" "\\&drag-"
+                                      (symbol-name ev-command) t)
+                                     down-data ev-data))))
+                (if (null track-mouse)
+                    (vector drag)
+                  (push drag unread-command-events)
+                  (vector (list 'mouse-movement ev-data)))))))))))))
 
 ;; These two variables have been converted to terminal parameters.
 ;;
@@ -165,16 +152,14 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)."
 	   (cond ((>= code 64)
 		  (format "mouse-%d" (- code 60)))
 		 ((memq code '(8 9 10))
-		  (setq xterm-mouse-last (- code 8))
 		  (format "M-down-mouse-%d" (- code 7)))
-		 ((and (= code 11) xterm-mouse-last)
-		  (format "M-mouse-%d" (1+ xterm-mouse-last)))
-		 ((and (= code 3) xterm-mouse-last)
-		  ;; For buttons > 5 xterm only reports a button-release event.
-		  ;; Drop them since they're not usable and can be spurious.
-		  (format "mouse-%d" (1+ xterm-mouse-last)))
+		 ((memq code '(3 11))
+                  (let ((down (car (terminal-parameter
+                                    nil 'xterm-mouse-last-down))))
+                    (when (and down (string-match "[0-9]" (symbol-name down)))
+                      (format (if (eq code 3) "mouse-%s" "M-mouse-%s")
+                              (match-string 0 (symbol-name down))))))
 		 ((memq code '(0 1 2))
-		  (setq xterm-mouse-last code)
 		  (format "down-mouse-%d" (+ 1 code))))))
          (x (- (read-event) 33))
          (y (- (read-event) 33)))
@@ -212,10 +197,20 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)."
 			    (if down "down-" "")
 			    (if wheel
 				(- code 60)
-			      (1+ (setq xterm-mouse-last (mod code 4)))))))
+			      (1+ (mod code 4))))))
 	  (1- (string-to-number (apply 'string (nreverse x-bytes))))
 	  (1- (string-to-number (apply 'string (nreverse y-bytes)))))))
 
+(defun xterm-mouse--set-click-count (event click-count)
+  (setcdr (cdr event) (list click-count))
+  (let ((name (symbol-name (car event))))
+    (when (string-match "\\(.*?\\)\\(\\(?:down-\\)?mouse-.*\\)" name)
+      (setcar event
+              (intern (concat (match-string 1 name)
+                              (if (= click-count 2)
+                                  "double-" "triple-")
+                              (match-string 2 name)))))))
+
 (defun xterm-mouse-event (&optional extension)
   "Convert XTerm mouse event to Emacs mouse event.
 EXTENSION, if non-nil, means to use an extension to the usual
@@ -241,18 +236,42 @@ which is the \"1006\" extension implemented in Xterm >= 277."
              (w (window-at x y))
              (ltrb (window-edges w))
              (left (nth 0 ltrb))
-             (top (nth 1 ltrb)))
-        (set-terminal-parameter nil 'xterm-mouse-x x)
-        (set-terminal-parameter nil 'xterm-mouse-y y)
-        (setq
-         last-input-event
-         (list type
-               (let ((event (if w
+             (top (nth 1 ltrb))
+             (posn (if w
                                 (posn-at-x-y (- x left) (- y top) w t)
                               (append (list nil 'menu-bar)
-                                      (nthcdr 2 (posn-at-x-y x y))))))
-                 (setcar (nthcdr 3 event) timestamp)
-                 event)))))))
+                             (nthcdr 2 (posn-at-x-y x y)))))
+             (event (list type posn)))
+        (setcar (nthcdr 3 posn) timestamp)
+
+        ;; Try to handle double/triple clicks.
+        (let* ((last-click (terminal-parameter nil 'xterm-mouse-last-click))
+               (last-type (nth 0 last-click))
+               (last-name (symbol-name last-type))
+               (last-time (nth 1 last-click))
+               (click-count (nth 2 last-click))
+               (this-time (float-time))
+               (name (symbol-name type)))
+          (cond
+           ((not (string-match "down-" name))
+            ;; For up events, make the up side match the down side.
+            (setq this-time last-time)
+            (when (and (> click-count 1)
+                       (string-match "down-" last-name)
+                       (equal name (replace-match "" t t last-name)))
+              (xterm-mouse--set-click-count event click-count)))
+           ((not last-time) nil)
+           ((and (> double-click-time (* 1000 (- this-time last-time)))
+                 (equal last-name (replace-match "" t t name)))
+            (setq click-count (1+ click-count))
+            (xterm-mouse--set-click-count event click-count))
+           (t (setq click-count 1)))
+          (set-terminal-parameter nil 'xterm-mouse-last-click
+                                  (list type this-time click-count)))
+
+        (set-terminal-parameter nil 'xterm-mouse-x x)
+        (set-terminal-parameter nil 'xterm-mouse-y y)
+        (setq last-input-event event)))))
 
 ;;;###autoload
 (define-minor-mode xterm-mouse-mode