* 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
+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.
(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)
"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 ()
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.
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.
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.
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
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.
projects / emacs.git / commitdiff