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

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  <cyd@gnu.org>
+
+        * 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  <juri@jurta.org>
 
         * 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.