aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1993-09-20 17:36:49 +0000
committerRichard M. Stallman1993-09-20 17:36:49 +0000
commiteb6ff46fa1c735e3fb30d43d9203cafc859b68e5 (patch)
treeeb12d50541ccd1541c5d5280decbb4c45467d2a9
parentfe0b3356d939e9843973ff91611d5174609006ec (diff)
downloademacs-eb6ff46fa1c735e3fb30d43d9203cafc859b68e5.tar.gz
emacs-eb6ff46fa1c735e3fb30d43d9203cafc859b68e5.zip
(mouse-save-then-kill): If follows a multi-click selection,
extend the selection. (mouse-save-then-kill-delete-region): New subroutine. (mouse-selection-click-count): New variable. (mouse-drag-region): Set it.
-rw-r--r--lisp/mouse.el99
1 files changed, 66 insertions, 33 deletions
diff --git a/lisp/mouse.el b/lisp/mouse.el
index a226c26c420..0d730beeb1d 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -162,6 +162,8 @@ Upon exit, point is at the far edge of the newly visible text."
162(defvar mouse-drag-overlay (make-overlay 1 1)) 162(defvar mouse-drag-overlay (make-overlay 1 1))
163(overlay-put mouse-drag-overlay 'face 'region) 163(overlay-put mouse-drag-overlay 'face 'region)
164 164
165(defvar mouse-selection-click-count nil)
166
165(defun mouse-drag-region (start-event) 167(defun mouse-drag-region (start-event)
166 "Set the region to the text that the mouse is dragged over. 168 "Set the region to the text that the mouse is dragged over.
167Highlight the drag area as you move the mouse. 169Highlight the drag area as you move the mouse.
@@ -180,6 +182,7 @@ release the mouse button. Otherwise, it does not."
180 ;; Don't count the mode line. 182 ;; Don't count the mode line.
181 (1- (nth 3 bounds)))) 183 (1- (nth 3 bounds))))
182 (click-count (1- (event-click-count start-event)))) 184 (click-count (1- (event-click-count start-event))))
185 (setq mouse-selection-click-count click-count)
183 (mouse-set-point start-event) 186 (mouse-set-point start-event)
184 (let ((range (mouse-start-end start-point start-point click-count))) 187 (let ((range (mouse-start-end start-point start-point click-count)))
185 (move-overlay mouse-drag-overlay (car range) (nth 1 range) 188 (move-overlay mouse-drag-overlay (car range) (nth 1 range)
@@ -269,8 +272,7 @@ If DIR is positive skip forward; if negative, skip backward."
269;; If MODE is 1 then set point to start of word at (min START END), 272;; If MODE is 1 then set point to start of word at (min START END),
270;; mark to end of word at (max START END). 273;; mark to end of word at (max START END).
271;; If MODE is 2 then do the same for lines. 274;; If MODE is 2 then do the same for lines.
272;; Optional KEEP-END if non-nil means do not change end. 275(defun mouse-start-end (start end mode)
273(defun mouse-start-end (start end mode &optional keep-end)
274 (if (> start end) 276 (if (> start end)
275 (let ((temp start)) 277 (let ((temp start))
276 (setq start end 278 (setq start end
@@ -367,47 +369,78 @@ This does not delete the region; it acts like \\[kill-ring-save]."
367;;; invocation of mouse-save-then-kill. 369;;; invocation of mouse-save-then-kill.
368(defvar mouse-save-then-kill-posn nil) 370(defvar mouse-save-then-kill-posn nil)
369 371
372(defun mouse-save-then-kill-delete-region ()
373 ;; Delete just one char, so in case buffer is being modified
374 ;; for the first time, the undo list records that fact.
375 (delete-region (point)
376 (+ (point) (if (> (mark) (point)) 1 -1)))
377 ;; Now delete the rest of the specified region,
378 ;; but don't record it.
379 (let ((buffer-undo-list t))
380 (delete-region (point) (mark)))
381 (if (not (eq buffer-undo-list t))
382 (let ((tail buffer-undo-list))
383 ;; Search back in buffer-undo-list for the string
384 ;; that came from the first delete-region.
385 (while (and tail (not (stringp (car (car tail)))))
386 (setq tail (cdr tail)))
387 ;; Replace it with an entry for the entire deleted text.
388 (and tail
389 (setcar tail (cons (car kill-ring) (point)))))))
390
370(defun mouse-save-then-kill (click) 391(defun mouse-save-then-kill (click)
371 "Save text to point in kill ring; the second time, kill the text. 392 "Save text to point in kill ring; the second time, kill the text.
372If the text between point and the mouse is the same as what's 393If the text between point and the mouse is the same as what's
373at the front of the kill ring, this deletes the text. 394at the front of the kill ring, this deletes the text.
374Otherwise, it adds the text to the kill ring, like \\[kill-ring-save], 395Otherwise, it adds the text to the kill ring, like \\[kill-ring-save],
375which prepares for a second click to delete the text." 396which prepares for a second click to delete the text.
397
398If you have selected words or lines, this command extends the
399selection through the word or line clicked on. If you do this
400again in a different position, it extends the selection again.
401If you do this twice in the same position, the selection is killed."
376 (interactive "e") 402 (interactive "e")
377 (let ((click-posn (posn-point (event-start click))) 403 (let ((click-posn (posn-point (event-start click)))
378 ;; Don't let a subsequent kill command append to this one: 404 ;; Don't let a subsequent kill command append to this one:
379 ;; prevent setting this-command to kill-region. 405 ;; prevent setting this-command to kill-region.
380 (this-command this-command)) 406 (this-command this-command))
381 (if (and (eq last-command 'mouse-save-then-kill) 407 (if (> mouse-selection-click-count 0)
382 mouse-save-then-kill-posn 408 (if (not (and (eq last-command 'mouse-save-then-kill)
383 (eq (car mouse-save-then-kill-posn) (car kill-ring)) 409 (equal click-posn
384 (equal (cdr mouse-save-then-kill-posn) (list (point) click-posn))) 410 (car (cdr-safe (cdr-safe mouse-save-then-kill-posn))))))
385 ;; If this is the second time we've called 411 (let* ((obeg (min (point) (mark t)))
386 ;; mouse-save-then-kill, delete the text from the buffer. 412 (oend (max (point) (mark t)))
387 (progn 413 (beg (min obeg click-posn))
388 ;; Delete just one char, so in case buffer is being modified 414 (end (if (< click-posn obeg) oend click-posn))
389 ;; for the first time, the undo list records that fact. 415 (range
390 (delete-region (point) 416 (mouse-start-end beg end mouse-selection-click-count))
391 (+ (point) (if (> (mark) (point)) 1 -1))) 417 (nbeg (if (= beg obeg) obeg (car range)))
392 ;; Now delete the rest of the specified region, 418 (nend (if (= end oend) oend (nth 1 range))))
393 ;; but don't record it. 419 (setq mouse-save-then-kill-posn
394 (let ((buffer-undo-list t)) 420 (list (car kill-ring) (point) click-posn))
395 (delete-region (point) (mark))) 421 (set-mark nbeg)
396 (if (not (eq buffer-undo-list t)) 422 (goto-char nend)
397 (let ((tail buffer-undo-list)) 423 ;; We have already put the old region in the kill ring.
398 ;; Search back in buffer-undo-list for the string 424 ;; Replace it with the extended region.
399 ;; that came from the first delete-region. 425 ;; (It would be annoying to make a separate entry.)
400 (while (and tail (not (stringp (car (car tail))))) 426 (setcar kill-ring (buffer-substring (point) (mark t)))
401 (setq tail (cdr tail))) 427 (mouse-show-mark))
402 ;; Replace it with an entry for the entire deleted text. 428 ;; If we click this button again without moving it,
403 (and tail 429 ;; that time kill.
404 (setcar tail (cons (car kill-ring) (point))))))) 430 (mouse-save-then-kill-delete-region))
405 ;; Otherwise, save this region. 431 (if (and (eq last-command 'mouse-save-then-kill)
406 (mouse-set-mark-fast click) 432 mouse-save-then-kill-posn
407 (kill-ring-save (point) (mark t)) 433 (eq (car mouse-save-then-kill-posn) (car kill-ring))
408 (mouse-show-mark) 434 (equal (cdr mouse-save-then-kill-posn) (list (point) click-posn)))
409 (setq mouse-save-then-kill-posn 435 ;; If this is the second time we've called
410 (list (car kill-ring) (point) click-posn))))) 436 ;; mouse-save-then-kill, delete the text from the buffer.
437 (mouse-save-then-kill-delete-region)
438 ;; Otherwise, save this region.
439 (mouse-set-mark-fast click)
440 (kill-ring-save (point) (mark t))
441 (mouse-show-mark)
442 (setq mouse-save-then-kill-posn
443 (list (car kill-ring) (point) click-posn))))))
411 444
412(global-set-key [M-mouse-1] 'mouse-start-secondary) 445(global-set-key [M-mouse-1] 'mouse-start-secondary)
413(global-set-key [M-drag-mouse-1] 'mouse-set-secondary) 446(global-set-key [M-drag-mouse-1] 'mouse-set-secondary)