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

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> 2012-07-29 Juri Linkov <juri@jurta.org>
   
* simple.el (async-shell-command-buffer): New defcustom. * simple.el (async-shell-command-buffer): New defcustom.
......
...@@ -219,6 +219,7 @@ even beep.)" ...@@ -219,6 +219,7 @@ even beep.)"
(condition-case nil (condition-case nil
(setq killed-rectangle (delete-extract-rectangle start end fill)) (setq killed-rectangle (delete-extract-rectangle start end fill))
((buffer-read-only text-read-only) ((buffer-read-only text-read-only)
(setq deactivate-mark t)
(setq killed-rectangle (extract-rectangle start end)) (setq killed-rectangle (extract-rectangle start end))
(if kill-read-only-ok (if kill-read-only-ok
(progn (message "Read only text copied to kill ring") nil) (progn (message "Read only text copied to kill ring") nil)
...@@ -230,7 +231,9 @@ even beep.)" ...@@ -230,7 +231,9 @@ even beep.)"
"Copy the region-rectangle and save it as the last killed one." "Copy the region-rectangle and save it as the last killed one."
(interactive "r") (interactive "r")
(setq killed-rectangle (extract-rectangle start end)) (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 ;;;###autoload
(defun yank-rectangle () (defun yank-rectangle ()
......
...@@ -336,7 +336,11 @@ Called from program, takes four args: REGISTER, START, END and DELETE-FLAG. ...@@ -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." START and END are buffer positions indicating what to copy."
(interactive "cCopy to register: \nr\nP") (interactive "cCopy to register: \nr\nP")
(set-register register (filter-buffer-substring start end)) (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) (defun append-to-register (register start end &optional delete-flag)
"Append region to text in register REGISTER. "Append region to text in register REGISTER.
...@@ -350,7 +354,10 @@ START and END are buffer positions indicating what to append." ...@@ -350,7 +354,10 @@ START and END are buffer positions indicating what to append."
register (cond ((not reg) text) register (cond ((not reg) text)
((stringp reg) (concat reg text)) ((stringp reg) (concat reg text))
(t (error "Register does not contain 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) (defun prepend-to-register (register start end &optional delete-flag)
"Prepend region to text in register REGISTER. "Prepend region to text in register REGISTER.
...@@ -364,7 +371,10 @@ START and END are buffer positions indicating what to prepend." ...@@ -364,7 +371,10 @@ START and END are buffer positions indicating what to prepend."
register (cond ((not reg) text) register (cond ((not reg) text)
((stringp reg) (concat text reg)) ((stringp reg) (concat text reg))
(t (error "Register does not contain 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 copy-rectangle-to-register (register start end &optional delete-flag) (defun copy-rectangle-to-register (register start end &optional delete-flag)
"Copy rectangular region into register REGISTER. "Copy rectangular region into register REGISTER.
...@@ -374,10 +384,15 @@ To insert this register in the buffer, use \\[insert-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. Called from a program, takes four args: REGISTER, START, END and DELETE-FLAG.
START and END are buffer positions giving two corners of rectangle." START and END are buffer positions giving two corners of rectangle."
(interactive "cCopy rectangle to register: \nr\nP") (interactive "cCopy rectangle to register: \nr\nP")
(set-register register (let ((rectangle (if delete-flag
(if delete-flag (delete-extract-rectangle start end)
(delete-extract-rectangle start end) (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) (provide 'register)
;;; register.el ends here ;;; register.el ends here
...@@ -3408,38 +3408,50 @@ This command is similar to `copy-region-as-kill', except that it gives ...@@ -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." visual feedback indicating the extent of the region being copied."
(interactive "r") (interactive "r")
(copy-region-as-kill beg end) (copy-region-as-kill beg end)
;; This use of called-interactively-p is correct ;; This use of called-interactively-p is correct because the code it
;; because the code it controls just gives the user visual feedback. ;; controls just gives the user visual feedback.
(if (called-interactively-p 'interactive) (if (called-interactively-p 'interactive)
(let ((other-end (if (= (point) beg) end beg)) (indicate-copied-region)))
(opoint (point))
;; Inhibit quitting so we can make a quit here (defun indicate-copied-region (&optional message-len)
;; look like a C-g typed as a command. "Indicate that the region text has been copied interactively.
(inhibit-quit t)) If the mark is visible in the selected window, blink the cursor
(if (pos-visible-in-window-p other-end (selected-window)) between point and mark if there is currently no active region
;; Swap point-and-mark quickly so as to show the region that highlighting.
;; was selected. Don't do it if the region is highlighted.
(unless (and (region-active-p) If the mark lies outside the selected window, display an
(face-background 'region)) informative message containing a sample of the copied text. The
;; Swap point and mark. optional argument MESSAGE-LEN, if non-nil, specifies the length
(set-marker (mark-marker) (point) (current-buffer)) of this sample text; it defaults to 40."
(goto-char other-end) (let ((mark (mark t))
(sit-for blink-matching-delay) (point (point))
;; Swap back. ;; Inhibit quitting so we can make a quit here
(set-marker (mark-marker) other-end (current-buffer)) ;; look like a C-g typed as a command.
(goto-char opoint) (inhibit-quit t))
;; If user quit, deactivate the mark (if (pos-visible-in-window-p mark (selected-window))
;; as C-g would as a command. ;; Swap point-and-mark quickly so as to show the region that
(and quit-flag mark-active ;; was selected. Don't do it if the region is highlighted.
(deactivate-mark))) (unless (and (region-active-p)
(let* ((killed-text (current-kill 0)) (face-background 'region))
(message-len (min (length killed-text) 40))) ;; Swap point and mark.
(if (= (point) beg) (set-marker (mark-marker) (point) (current-buffer))
;; Don't say "killed"; that is misleading. (goto-char mark)
(message "Saved text until \"%s\"" (sit-for blink-matching-delay)
(substring killed-text (- message-len))) ;; Swap back.
(message "Saved text from \"%s\"" (set-marker (mark-marker) mark (current-buffer))
(substring killed-text 0 message-len)))))))) (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) (defun append-next-kill (&optional interactive)
"Cause following command, if it kills, to append to previous kill. "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