changeset 4788:3182c0f7ace4

(mouse-delete-max-match): New function. (mouse-choose-completion): Use that. Now supports buffers other than minibuffer. (mouse-drag-region): Put the text on the kill ring. Don't set mark if region is empty. (mouse-yank-at-click): Set this-command. (mouse-start-end): Fix double-click-on-closeparen case. (mouse-save-then-kill): When used repeatedly at different places, alter the nearer end of the region. This applies regardless of how the previous selection was made. (mouse-drag-secondary, mouse-secondary-save-then-kill): Rewrite for xterm-style dragging and extending.

--- a/lisp/mouse.el	Sat Sep 25 22:46:34 1993 +0000
+++ b/lisp/mouse.el	Mon Sep 27 01:02:43 1993 +0000
@@ -243,8 +243,12 @@
 	       (numberp (posn-point (event-end event))))
 	  (let ((fun (key-binding (vector (car event)))))
 	    (if (memq fun '(mouse-set-region mouse-set-point))
-		(progn
-		  (push-mark (overlay-start mouse-drag-overlay) t t)
+		(if (not (= (overlay-start mouse-drag-overlay)
+			    (overlay-end mouse-drag-overlay)))
+		    (let (this-command)
+		      (push-mark (overlay-start mouse-drag-overlay) t t)
+		      (goto-char (overlay-end mouse-drag-overlay))
+		      (copy-region-as-kill (point) (mark t)))
 		  (goto-char (overlay-end mouse-drag-overlay)))
 	      (if (fboundp fun)
 		  (funcall fun event)))))
@@ -262,9 +266,9 @@
 	    (skip-syntax-backward syntax)
 	  (skip-syntax-forward syntax))
       (if (< dir 0)
-	  (while (= (preceding-char) char)
+	  (while (and (not (bobp)) (= (preceding-char) char))
 	    (forward-char -1))
-	(while (= (following-char) char)
+	(while (and (not (eobp)) (= (following-char) char))
 	  (forward-char 1))))))
 
 ;; Return a list of region bounds based on START and END according to MODE.
@@ -281,14 +285,17 @@
 	 (list start end))
         ((and (= mode 1)
               (= start end)
+	      (not (eobp))
               (= (char-syntax (char-after start)) ?\())
 	 (list start (save-excursion (forward-sexp 1) (point))))
         ((and (= mode 1)
               (= start end)
+	      (not (eobp))
               (= (char-syntax (char-after start)) ?\)))
 	 (list (save-excursion 
 		 (goto-char (1+ start))
-		 (backward-sexp 1))
+		 (backward-sexp 1)
+		 (point))
 	       (1+ start)))
         ((= mode 1)
 	 (list (save-excursion
@@ -351,6 +358,7 @@
 Prefix arguments are interpreted as with \\[yank]."
   (interactive "e\nP")
   (mouse-set-point click)
+  (setq this-command 'yank)
   (yank arg))
 
 (defun mouse-kill-ring-save (click)
@@ -408,22 +416,25 @@
 	(if (not (and (eq last-command 'mouse-save-then-kill)
 		      (equal click-posn
 			     (car (cdr-safe (cdr-safe mouse-save-then-kill-posn))))))
-	    (let* ((obeg (min (point) (mark t)))
-		   (oend (max (point) (mark t)))
-		   (beg (min obeg click-posn))
-		   (end (if (< click-posn obeg) oend click-posn))
-		   (range
-		    (mouse-start-end beg end mouse-selection-click-count))
-		   (nbeg (if (= beg obeg) obeg (car range)))
-		   (nend (if (= end oend) oend (nth 1 range))))
-	      (setq mouse-save-then-kill-posn
-		    (list (car kill-ring) (point) click-posn))
-	      (set-mark nbeg)
-	      (goto-char nend)
+	    ;; Find both ends of the object selected by this click.
+	    (let* ((range
+		    (mouse-start-end click-posn click-posn
+				     mouse-selection-click-count)))
+	      ;; Move whichever end is closer to the click.
+	      ;; That's what xterm does, and it seems reasonable.
+	      (if (< (abs (- click-posn (mark t)))
+		     (abs (- click-posn (point))))
+		  (set-mark (car range))
+		(goto-char (nth 1 range)))
 	      ;; We have already put the old region in the kill ring.
 	      ;; Replace it with the extended region.
 	      ;; (It would be annoying to make a separate entry.)
 	      (setcar kill-ring (buffer-substring (point) (mark t)))
+	      (if interprogram-cut-function
+		  (funcall interprogram-cut-function (car kill-ring)))
+	      ;; Arrange for a repeated mouse-3 to kill this region.
+	      (setq mouse-save-then-kill-posn
+		    (list (car kill-ring) (point) click-posn))
 	      (mouse-show-mark))
 	  ;; If we click this button again without moving it,
 	  ;; that time kill.
@@ -435,10 +446,31 @@
 	  ;; If this is the second time we've called
 	  ;; mouse-save-then-kill, delete the text from the buffer.
 	  (mouse-save-then-kill-delete-region)
-	;; Otherwise, save this region.
-	(mouse-set-mark-fast click)
-	(kill-ring-save (point) (mark t))
-	(mouse-show-mark)
+	(if (or (eq last-command 'mouse-save-then-kill)
+		mark-active
+		(and (eq last-command 'mouse-drag-region)
+		     (mark t)
+		     (or mark-even-if-inactive
+			 (not transient-mark-mode))))
+	    ;; We have a selection or suitable region, so adjust it.
+	    (let* ((posn (event-start click))
+		   (new (posn-point posn)))
+	      (select-window (posn-window posn))
+	      (if (numberp new)
+		  (progn
+		    ;; Move whichever end of the region is closer to the click.
+		    ;; That is what xterm does, and it seems reasonable.
+		    (if (< (abs (- new (point))) (abs (- new (mark t))))
+			(goto-char new)
+		      (set-mark new))
+		    (setq deactivate-mark nil)))
+	      (setcar kill-ring (buffer-substring (point) (mark t)))
+	      (if interprogram-cut-function
+		  (funcall interprogram-cut-function (car kill-ring))))
+	  ;; We just have point, so set mark here.
+	  (mouse-set-mark-fast click)
+	  (kill-ring-save (point) (mark t))
+	  (mouse-show-mark))
 	(setq mouse-save-then-kill-posn
 	      (list (car kill-ring) (point) click-posn))))))
 
@@ -490,19 +522,104 @@
 	(setq mouse-secondary-overlay (make-overlay beg (posn-point end))))
       (overlay-put mouse-secondary-overlay 'face 'secondary-selection))))
 
-(defun mouse-drag-secondary (click)
+(defun mouse-drag-secondary (start-event)
   "Set the secondary selection to the text that the mouse is dragged over.
+Highlight the drag area as you move the mouse.
 This must be bound to a button-down mouse event."
   (interactive "e")
-  (let ((posn (event-start click)))
-    (save-window-excursion
-      (select-window (posn-window posn))
-      ;; Set point temporarily, so user sees where it is.
-      (save-excursion
-	(if (numberp (posn-point posn))
-	    (goto-char (posn-point posn)))
-	(setq unread-command-events
-	      (cons (read-event) unread-command-events))))))
+  (let* ((start-posn (event-start start-event))
+	 (start-point (posn-point start-posn))
+	 (start-window (posn-window start-posn))
+	 (start-frame (window-frame start-window))
+	 (bounds (window-edges start-window))
+	 (top (nth 1 bounds))
+	 (bottom (if (window-minibuffer-p start-window)
+		     (nth 3 bounds)
+		   ;; Don't count the mode line.
+		   (1- (nth 3 bounds))))
+	 (click-count (1- (event-click-count start-event))))
+    (save-excursion
+      (set-buffer (window-buffer start-window))
+      (setq mouse-selection-click-count click-count)
+      ;; Cancel any preexisting secondary selection.
+      (or mouse-secondary-overlay
+	  (setq mouse-secondary-overlay
+		(make-overlay (point) (point))))
+      (if (> click-count 0)
+	  (let ((range (mouse-start-end start-point start-point click-count)))
+	    (set-marker mouse-secondary-start nil)
+	    (move-overlay mouse-secondary-overlay 1 1
+			  (window-buffer start-window))
+	    (move-overlay mouse-secondary-overlay (car range) (nth 1 range)
+			  (window-buffer start-window)))
+	(or mouse-secondary-start
+	    (setq mouse-secondary-start (make-marker)))
+	(set-marker mouse-secondary-start start-point)
+	(delete-overlay mouse-secondary-overlay))
+      (let (event end end-point)
+	(track-mouse
+	  (while (progn
+		   (setq event (read-event))
+		   (or (mouse-movement-p event)
+		       (eq (car-safe event) 'switch-frame)))
+
+	    (if (eq (car-safe event) 'switch-frame)
+		nil
+	      (setq end (event-end event)
+		    end-point (posn-point end))
+	      (cond
+
+	       ;; Ignore switch-frame events.
+	       ((eq (car-safe event) 'switch-frame))
+
+	       ;; Are we moving within the original window?
+	       ((and (eq (posn-window end) start-window)
+		     (integer-or-marker-p end-point))
+		(if (/= start-point end-point)
+		    (set-marker mouse-secondary-start nil))
+		(let ((range (mouse-start-end start-point end-point
+					      click-count)))
+		  (move-overlay mouse-secondary-overlay
+				(car range) (nth 1 range))))
+
+	       ;; Are we moving on a different window on the same frame?
+	       ((and (windowp (posn-window end))
+		     (eq (window-frame (posn-window end)) start-frame))
+		(let ((mouse-row
+		       (+ (nth 1 (window-edges (posn-window end)))
+			  (cdr (posn-col-row end)))))
+		  (cond
+		   ((< mouse-row top)
+		    (mouse-scroll-subr
+		     (- mouse-row top) mouse-secondary-overlay start-point))
+		   ((and (not (eobp))
+			 (>= mouse-row bottom))
+		    (mouse-scroll-subr (1+ (- mouse-row bottom))
+				       mouse-drag-overlay start-point)))))
+
+	       (t
+		(let ((mouse-y (cdr (cdr (mouse-position))))
+		      (menu-bar-lines (or (cdr (assq 'menu-bar-lines
+						     (frame-parameters)))
+					  0)))
+
+		  ;; Are we on the menu bar?
+		  (and (integerp mouse-y) (< mouse-y menu-bar-lines)
+		       (mouse-scroll-subr (- mouse-y menu-bar-lines)
+					  mouse-secondary-overlay start-point))))))))
+
+	(if (and (eq (get (event-basic-type event) 'event-kind) 'mouse-click)
+		 (eq (posn-window (event-end event)) start-window)
+		 (numberp (posn-point (event-end event))))
+	    (if (marker-position mouse-secondary-start)
+		(save-window-excursion
+		  (delete-overlay mouse-secondary-overlay)
+		  (select-window start-window)
+		  (save-excursion
+		    (goto-char mouse-secondary-start)
+		    (sit-for 1)))
+	      (kill-ring-save (overlay-start mouse-secondary-overlay)
+			      (overlay-end mouse-secondary-overlay))))))))
 
 (defun mouse-kill-secondary ()
   "Kill the text in the secondary selection."
@@ -513,43 +630,97 @@
   (setq mouse-secondary-overlay nil))
 
 (defun mouse-secondary-save-then-kill (click)
-  "Save text to secondary start point in kill ring; if twice, kill it.
-If the text between secondary start point and the mouse is the same as what's
+  "Save text to point in kill ring; the second time, kill the text.
+If the text between point and the mouse is the same as what's
 at the front of the kill ring, this deletes the text.
 Otherwise, it adds the text to the kill ring, like \\[kill-ring-save],
-which prepares for a second click to delete the text."
+which prepares for a second click to delete the text.
+
+If you have selected words or lines, this command extends the
+selection through the word or line clicked on.  If you do this
+again in a different position, it extends the selection again.
+If you do this twice in the same position, the selection is killed." 
   (interactive "e")
-  (let ((click-posn (posn-point (event-start click)))
-	(start (+ 0 mouse-secondary-start))
+  (let ((posn (event-start click))
+	(click-posn (posn-point (event-start click)))
 	;; Don't let a subsequent kill command append to this one:
 	;; prevent setting this-command to kill-region.
 	(this-command this-command))
-    (if (and (eq last-command 'mouse-secondary-save-then-kill)
-	     mouse-save-then-kill-posn
-	     (eq (car mouse-save-then-kill-posn) (car kill-ring))
-	     (equal (cdr mouse-save-then-kill-posn)
-		    (list start click-posn)))
-	;; If this is the second time we've called
-	;; mouse-save-then-kill, delete the text from the buffer.
-	(progn
-	  (let ((buffer-undo-list t))
+    (if (> mouse-selection-click-count 0)
+	(if (not (and (eq last-command 'mouse-secondary-save-then-kill)
+		      (equal click-posn
+			     (car (cdr-safe (cdr-safe mouse-save-then-kill-posn))))))
+	    ;; Find both ends of the object selected by this click.
+	    (let* ((range
+		    (mouse-start-end click-posn click-posn
+				     mouse-selection-click-count)))
+	      ;; Move whichever end is closer to the click.
+	      ;; That's what xterm does, and it seems reasonable.
+	      (if (< (abs (- click-posn (overlay-start mouse-secondary-overlay)))
+		     (abs (- click-posn (overlay-end mouse-secondary-overlay))))
+		  (move-overlay mouse-secondary-overlay (car range)
+				(overlay-end mouse-secondary-overlay))
+		  (move-overlay mouse-secondary-overlay
+				(overlay-start mouse-secondary-overlay)
+				(nth 1 range)))
+	      ;; We have already put the old region in the kill ring.
+	      ;; Replace it with the extended region.
+	      ;; (It would be annoying to make a separate entry.)
+	      (setcar kill-ring (buffer-substring
+				 (overlay-start mouse-secondary-overlay)
+				 (overlay-end mouse-secondary-overlay)))
+	      (if interprogram-cut-function
+		  (funcall interprogram-cut-function (car kill-ring)))
+	      ;; Arrange for a repeated mouse-3 to kill this region.
+	      (setq mouse-save-then-kill-posn
+		    (list (car kill-ring) (point) click-posn)))
+	  ;; If we click this button again without moving it,
+	  ;; that time kill.
+	  (progn
 	    (delete-overlay mouse-secondary-overlay)
-	    (delete-region start click-posn))
-	  ;; Make the undo list by hand so it is shared.
-	  (if (not (eq buffer-undo-list t))
-	      (setq buffer-undo-list
-		    (cons (cons (car kill-ring) (marker-position start))
-			  buffer-undo-list))))
-      ;; Otherwise, save this region.
-      (save-excursion
-	(set-buffer (window-buffer (posn-window (event-start click))))
-	(kill-ring-save start click-posn)
-	(if mouse-secondary-overlay
-	    (move-overlay mouse-secondary-overlay start click-posn)
-	  (setq mouse-secondary-overlay (make-overlay start click-posn)))
-	(overlay-put mouse-secondary-overlay 'face 'secondary-selection)
+	    (mouse-save-then-kill-delete-region)))
+      (if (and (eq last-command 'mouse-secondary-save-then-kill)
+	       mouse-save-then-kill-posn
+	       (eq (car mouse-save-then-kill-posn) (car kill-ring))
+	       (equal (cdr mouse-save-then-kill-posn) (list (point) click-posn)))
+	  ;; If this is the second time we've called
+	  ;; mouse-secondary-save-then-kill, delete the text from the buffer.
+	  (progn
+	    (delete-overlay mouse-secondary-overlay)
+	    (mouse-save-then-kill-delete-region))
+	(if (overlay-start mouse-secondary-overlay)
+	    ;; We have a selection, so adjust it.
+	    (progn
+	      (select-window (posn-window posn))
+	      (if (numberp click-posn)
+		  (progn
+		    ;; Move whichever end of the region is closer to the click.
+		    ;; That is what xterm does, and it seems reasonable.
+		    (if (< (abs (- click-posn (overlay-start mouse-secondary-overlay)))
+			   (abs (- click-posn (overlay-end mouse-secondary-overlay))))
+			(move-overlay mouse-secondary-overlay click-posn
+				      (overlay-end mouse-secondary-overlay))
+			(move-overlay mouse-secondary-overlay
+				      (overlay-start mouse-secondary-overlay)
+				      click-posn))
+		    (setq deactivate-mark nil)))
+	      (setcar kill-ring (buffer-substring
+				 (overlay-start mouse-secondary-overlay)
+				 (overlay-end mouse-secondary-overlay)))
+	      (if interprogram-cut-function
+		  (funcall interprogram-cut-function (car kill-ring))))
+	  (if mouse-secondary-start
+	      ;; All we have is one end of a selection,
+	      ;; so put the other end here.
+	      (let ((start (+ 0 mouse-secondary-start)))
+		(set-buffer (window-buffer (posn-window (event-start click))))
+		(kill-ring-save start click-posn)
+		(if mouse-secondary-overlay
+		    (move-overlay mouse-secondary-overlay start click-posn)
+		  (setq mouse-secondary-overlay (make-overlay start click-posn)))
+		(overlay-put mouse-secondary-overlay 'face 'secondary-selection))))
 	(setq mouse-save-then-kill-posn
-	      (list (car kill-ring) start click-posn))))))
+	      (list (car kill-ring) (point) click-posn))))))
 
 (defun mouse-buffer-menu (event)
   "Pop up a menu of buffers for selection with the mouse.
@@ -924,10 +1095,25 @@
 
 ;; Choose a completion with the mouse.
 
+;; Delete the longest partial match for STRING
+;; that can be found before POINT.
+(defun mouse-delete-max-match (string)
+  (let ((len (min (length string)
+		  (- (point-max) (point-min)))))
+    (goto-char (max (point-min) (- (point) (length string))))
+    (while (and (> len 0)
+		(let ((tail (buffer-substring (point)
+					      (+ (point) len))))
+		  (not (string= tail (substring string 0 len)))))
+      (setq len (1- len))
+      (forward-char 1))
+    (delete-char len)))
+
 (defun mouse-choose-completion (event)
   "Click on an alternative in the `*Completions*' buffer to choose it."
   (interactive "e")
-  (let (choice)
+  (let ((buffer (window-buffer))
+        choice)
     (save-excursion
       (set-buffer (window-buffer (posn-window (event-start event))))
       (save-excursion
@@ -936,15 +1122,11 @@
 	(let ((beg (point)))
 	  (skip-chars-forward "^ \t\n")
 	  (setq choice (buffer-substring beg (point))))))
-    (set-buffer (window-buffer (minibuffer-window)))
-    (goto-char (max (point-min) (- (point-max) (length choice))))
-    (while (and (not (eobp))
-		(let ((tail (buffer-substring (point) (point-max))))
-		  (not (string= tail (substring choice 0 (length tail))))))
-      (forward-char 1))
+    (set-buffer buffer)
+    (mouse-delete-max-match choice)
     (insert choice)
-    (delete-region (point) (point-max))
-    (minibuffer-complete-and-exit)))
+    (and (equal buffer (window-buffer (minibuffer-window)))
+	 (minibuffer-complete-and-exit))))
 
 ;; Font selection.