changeset 15613:4c646bed64d0

(mouse-show-mark): In transient mark mode, delete mouse-drag-overlay. (mouse-undouble-last-event): New function. (mouse-show-mark): Call mouse-undouble-last-event.
author Miles Bader <miles@gnu.org>
date Sun, 07 Jul 1996 01:59:10 +0000
parents 9b55a88233d1
children 6fb29f91d5ec
files lisp/mouse.el
diffstat 1 files changed, 36 insertions(+), 16 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/mouse.el	Sun Jul 07 01:59:04 1996 +0000
+++ b/lisp/mouse.el	Sun Jul 07 01:59:10 1996 +0000
@@ -704,25 +704,45 @@
     (if (numberp (posn-point posn))
 	(push-mark (posn-point posn) t t))))
 
+(defun mouse-undouble-last-event (events)
+  (let* ((index (1- (length events)))
+	 (last (nthcdr index events))
+	 (event (car last))
+	 (basic (event-basic-type event))
+	 (modifiers (delq 'double (delq 'triple (copy-sequence (event-modifiers event)))))
+	 (new
+	  (if (consp event)
+	      (cons (event-convert-list (nreverse (cons basic modifiers)))
+		    (cdr event))
+	    event)))
+    (setcar last new)
+    (if (key-binding (apply 'vector events))
+	t
+      (setcar last event)
+      nil)))
+
 ;; Momentarily show where the mark is, if highlighting doesn't show it. 
 (defun mouse-show-mark ()
-  (or transient-mark-mode
+  (if transient-mark-mode
       (if window-system
-	  (let ((inhibit-quit t)
-		(echo-keystrokes 0)
-		event events)
-	    (move-overlay mouse-drag-overlay (point) (mark t))
-	    (while (progn (setq event (read-event))
-			  (setq events (append events (list event)))
-			  (and (memq 'down (event-modifiers event))
-			       (not (key-binding (apply 'vector events))))))
-	    (setq unread-command-events
-		  (nconc events unread-command-events))
-	    (setq quit-flag nil)
-	    (delete-overlay mouse-drag-overlay))
-	(save-excursion
-	 (goto-char (mark t))
-	 (sit-for 1)))))
+	  (delete-overlay mouse-drag-overlay))
+    (if window-system
+	(let ((inhibit-quit t)
+	      (echo-keystrokes 0)
+	      event events)
+	  (move-overlay mouse-drag-overlay (point) (mark t))
+	  (while (progn (setq event (read-event))
+			(setq events (append events (list event)))
+			(and (memq 'down (event-modifiers event))
+			     (not (key-binding (apply 'vector events)))
+			     (not (mouse-undouble-last-event events)))))
+	  (setq unread-command-events
+		(nconc events unread-command-events))
+	  (setq quit-flag nil)
+	  (delete-overlay mouse-drag-overlay))
+      (save-excursion
+       (goto-char (mark t))
+       (sit-for 1)))))
 
 (defun mouse-set-mark (click)
   "Set mark at the position clicked on with the mouse.