From 2549c068e14ab1ddfb1f1ea38ca7736c16db7296 Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sun, 29 Jul 2012 12:45:48 +0800 Subject: [PATCH] Deactivate the mark on more copy operations, and indicate the copied region. * lisp/simple.el (indicate-copied-region): New function. (kill-ring-save): Split off from here. * lisp/rect.el (copy-rectangle-as-kill): Call indicate-copied-region. (kill-rectangle): Set deactivate-mark to t on read-only error. * lisp/register.el (copy-to-register, copy-rectangle-to-register): Deactivate the mark, and use indicate-copied-region. (append-to-register, prepend-to-register): Call Fixes: debbugs:10056 --- lisp/ChangeLog | 12 ++++++++ lisp/rect.el | 5 +++- lisp/register.el | 29 ++++++++++++++----- lisp/simple.el | 74 ++++++++++++++++++++++++++++-------------------- 4 files changed, 81 insertions(+), 39 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index e0d6cb825f0..2d737a38f69 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,15 @@ +2012-07-29 Chong Yidong + + * simple.el (indicate-copied-region): New function. + (kill-ring-save): Split off from here. + + * rect.el (copy-rectangle-as-kill): Call indicate-copied-region. + (kill-rectangle): Set deactivate-mark to t on read-only error. + + * register.el (copy-to-register, copy-rectangle-to-register): + Deactivate the mark, and use indicate-copied-region (Bug#10056). + (append-to-register, prepend-to-register): Call + 2012-07-29 Juri Linkov * simple.el (async-shell-command-buffer): New defcustom. diff --git a/lisp/rect.el b/lisp/rect.el index 1bf7364e20d..c5e9a790ca2 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -219,6 +219,7 @@ even beep.)" (condition-case nil (setq killed-rectangle (delete-extract-rectangle start end fill)) ((buffer-read-only text-read-only) + (setq deactivate-mark t) (setq killed-rectangle (extract-rectangle start end)) (if kill-read-only-ok (progn (message "Read only text copied to kill ring") nil) @@ -230,7 +231,9 @@ even beep.)" "Copy the region-rectangle and save it as the last killed one." (interactive "r") (setq killed-rectangle (extract-rectangle start end)) - (setq deactivate-mark t)) + (setq deactivate-mark t) + (if (called-interactively-p 'interactive) + (indicate-copied-region (length (car killed-rectangle))))) ;;;###autoload (defun yank-rectangle () diff --git a/lisp/register.el b/lisp/register.el index 52c236e49be..2816c9831de 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -336,7 +336,11 @@ Called from program, takes four args: REGISTER, START, END and DELETE-FLAG. START and END are buffer positions indicating what to copy." (interactive "cCopy to register: \nr\nP") (set-register register (filter-buffer-substring start end)) - (if delete-flag (delete-region start end))) + (setq deactivate-mark t) + (cond (delete-flag + (delete-region start end)) + ((called-interactively-p 'interactive) + (indicate-copied-region)))) (defun append-to-register (register start end &optional delete-flag) "Append region to text in register REGISTER. @@ -350,7 +354,10 @@ START and END are buffer positions indicating what to append." register (cond ((not reg) text) ((stringp reg) (concat reg text)) (t (error "Register does not contain text"))))) - (if delete-flag (delete-region start end))) + (cond (delete-flag + (delete-region start end)) + ((called-interactively-p 'interactive) + (indicate-copied-region)))) (defun prepend-to-register (register start end &optional delete-flag) "Prepend region to text in register REGISTER. @@ -364,7 +371,10 @@ START and END are buffer positions indicating what to prepend." register (cond ((not reg) text) ((stringp reg) (concat text reg)) (t (error "Register does not contain text"))))) - (if delete-flag (delete-region start end))) + (cond (delete-flag + (delete-region start end)) + ((called-interactively-p 'interactive) + (indicate-copied-region)))) (defun copy-rectangle-to-register (register start end &optional delete-flag) "Copy rectangular region into register REGISTER. @@ -374,10 +384,15 @@ To insert this register in the buffer, use \\[insert-register]. Called from a program, takes four args: REGISTER, START, END and DELETE-FLAG. START and END are buffer positions giving two corners of rectangle." (interactive "cCopy rectangle to register: \nr\nP") - (set-register register - (if delete-flag - (delete-extract-rectangle start end) - (extract-rectangle start end)))) + (let ((rectangle (if delete-flag + (delete-extract-rectangle start end) + (extract-rectangle start end)))) + (set-register register rectangle) + (when (and (null delete-flag) + (called-interactively-p 'interactive)) + (setq deactivate-mark t) + (indicate-copied-region (length (car rectangle)))))) + (provide 'register) ;;; register.el ends here diff --git a/lisp/simple.el b/lisp/simple.el index cfcc63e9285..4b6d6c7a73b 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -3408,38 +3408,50 @@ This command is similar to `copy-region-as-kill', except that it gives visual feedback indicating the extent of the region being copied." (interactive "r") (copy-region-as-kill beg end) - ;; This use of called-interactively-p is correct - ;; because the code it controls just gives the user visual feedback. + ;; This use of called-interactively-p is correct because the code it + ;; controls just gives the user visual feedback. (if (called-interactively-p 'interactive) - (let ((other-end (if (= (point) beg) end beg)) - (opoint (point)) - ;; Inhibit quitting so we can make a quit here - ;; look like a C-g typed as a command. - (inhibit-quit t)) - (if (pos-visible-in-window-p other-end (selected-window)) - ;; Swap point-and-mark quickly so as to show the region that - ;; was selected. Don't do it if the region is highlighted. - (unless (and (region-active-p) - (face-background 'region)) - ;; Swap point and mark. - (set-marker (mark-marker) (point) (current-buffer)) - (goto-char other-end) - (sit-for blink-matching-delay) - ;; Swap back. - (set-marker (mark-marker) other-end (current-buffer)) - (goto-char opoint) - ;; If user quit, deactivate the mark - ;; as C-g would as a command. - (and quit-flag mark-active - (deactivate-mark))) - (let* ((killed-text (current-kill 0)) - (message-len (min (length killed-text) 40))) - (if (= (point) beg) - ;; Don't say "killed"; that is misleading. - (message "Saved text until \"%s\"" - (substring killed-text (- message-len))) - (message "Saved text from \"%s\"" - (substring killed-text 0 message-len)))))))) + (indicate-copied-region))) + +(defun indicate-copied-region (&optional message-len) + "Indicate that the region text has been copied interactively. +If the mark is visible in the selected window, blink the cursor +between point and mark if there is currently no active region +highlighting. + +If the mark lies outside the selected window, display an +informative message containing a sample of the copied text. The +optional argument MESSAGE-LEN, if non-nil, specifies the length +of this sample text; it defaults to 40." + (let ((mark (mark t)) + (point (point)) + ;; Inhibit quitting so we can make a quit here + ;; look like a C-g typed as a command. + (inhibit-quit t)) + (if (pos-visible-in-window-p mark (selected-window)) + ;; Swap point-and-mark quickly so as to show the region that + ;; was selected. Don't do it if the region is highlighted. + (unless (and (region-active-p) + (face-background 'region)) + ;; Swap point and mark. + (set-marker (mark-marker) (point) (current-buffer)) + (goto-char mark) + (sit-for blink-matching-delay) + ;; Swap back. + (set-marker (mark-marker) mark (current-buffer)) + (goto-char point) + ;; If user quit, deactivate the mark + ;; as C-g would as a command. + (and quit-flag mark-active + (deactivate-mark))) + (let ((len (min (abs (- mark point)) + (or message-len 40)))) + (if (< point mark) + ;; Don't say "killed"; that is misleading. + (message "Saved text until \"%s\"" + (buffer-substring-no-properties (- mark len) mark)) + (message "Saved text from \"%s\"" + (buffer-substring-no-properties mark (+ mark len)))))))) (defun append-next-kill (&optional interactive) "Cause following command, if it kills, to append to previous kill. -- 2.39.2