Commit 2549c068 authored by Chong Yidong's avatar Chong Yidong

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
parent d8efda90
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.
......
......@@ -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 ()
......
......@@ -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
......@@ -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.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment