[Emacs-diffs] /srv/bzr/emacs/trunk r109255: Deactivate the mark on more copy operations, and indicate the copied region.

[Chong Yidong]

------------------------------------------------------------
revno: 109255
fixes bug: http://debbugs.gnu.org/10056
committer: Chong Yidong <address@hidden>
branch nick: trunk
timestamp: Sun 2012-07-29 12:45:48 +0800
message:
  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
modified:
  lisp/ChangeLog
  lisp/rect.el
  lisp/register.el
  lisp/simple.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-07-29 00:03:26 +0000
+++ b/lisp/ChangeLog    2012-07-29 04:45:48 +0000
@@ -1,3 +1,15 @@
+2012-07-29  Chong Yidong  <address@hidden>
+
+       * 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  <address@hidden>
 
        * simple.el (async-shell-command-buffer): New defcustom.

=== modified file 'lisp/rect.el'
--- a/lisp/rect.el      2012-07-14 02:19:07 +0000
+++ b/lisp/rect.el      2012-07-29 04:45:48 +0000
@@ -219,6 +219,7 @@
   (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 @@
   "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 ()

=== modified file 'lisp/register.el'
--- a/lisp/register.el  2012-07-14 02:19:07 +0000
+++ b/lisp/register.el  2012-07-29 04:45:48 +0000
@@ -336,7 +336,11 @@
 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 @@
      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 @@
      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 @@
 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

=== modified file 'lisp/simple.el'
--- a/lisp/simple.el    2012-07-29 00:03:26 +0000
+++ b/lisp/simple.el    2012-07-29 04:45:48 +0000
@@ -3408,38 +3408,50 @@
 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.