From be5936a745c91f51584fd6ab60472af39bd06ef3 Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Sat, 18 Jan 2003 23:34:14 +0000 Subject: [PATCH] (kill-new, kill-append, kill-region): New optional parameter yank-handler. (yank-excluded-properties): Add yank-handler to list. (yank-undo-function): New variable. (yank): Use it to undo previous yank or yank-pop command. Allow insert-for-yank to override this-command. --- lisp/simple.el | 52 ++++++++++++++++++++++++++++++++++---------------- 1 file changed, 36 insertions(+), 16 deletions(-) diff --git a/lisp/simple.el b/lisp/simple.el index fe92a0e367..a35269c120 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1756,12 +1756,19 @@ ring directly.") (defvar kill-ring-yank-pointer nil "The tail of the kill ring whose car is the last thing yanked.") -(defun kill-new (string &optional replace) +(defun kill-new (string &optional replace yank-handler) "Make STRING the latest kill in the kill ring. Set `kill-ring-yank-pointer' to point to it. If `interprogram-cut-function' is non-nil, apply it to STRING. Optional second argument REPLACE non-nil means that STRING will replace -the front of the kill ring, rather than being added to the list." +the front of the kill ring, rather than being added to the list. + +Optional third arguments YANK-HANDLER controls how the STRING is later +inserted into a buffer; see `insert-for-yank' for details." + (when (> (length string) 0) + (if yank-handler + (put-text-property 0 1 'yank-handler yank-handler string) + (remove-text-properties 0 1 '(yank-handler nil) string))) (and (fboundp 'menu-bar-update-yank-menu) (menu-bar-update-yank-menu string (and replace (car kill-ring)))) (if (and replace kill-ring) @@ -1773,15 +1780,20 @@ the front of the kill ring, rather than being added to the list." (if interprogram-cut-function (funcall interprogram-cut-function string (not replace)))) -(defun kill-append (string before-p) +(defun kill-append (string before-p &optional yank-handler) "Append STRING to the end of the latest kill in the kill ring. If BEFORE-P is non-nil, prepend STRING to the kill. -If `interprogram-cut-function' is set, pass the resulting kill to -it." - (kill-new (if before-p - (concat string (car kill-ring)) - (concat (car kill-ring) string)) - t)) +Optional third argument YANK-HANDLER specifies the yank-handler text +property to be set on the combined kill ring string. If the specified +yank-handler arg differs from the yank-handler property of the latest +kill string, STRING is added as a new kill ring element instead of +being appending to the last kill. +If `interprogram-cut-function' is set, pass the resulting kill to it." + (let* ((cur (car kill-ring))) + (kill-new (if before-p (concat string cur) (concat cur string)) + (or (= (length cur) 0) + (equal yank-handler (get-text-property 0 'yank-handler cur))) + yank-handler))) (defun current-kill (n &optional do-not-move) "Rotate the yanking point by N places, and then return that kill. @@ -1823,7 +1835,7 @@ yanking point; just return the Nth kill forward." '(text-read-only buffer-read-only error)) (put 'text-read-only 'error-message "Text is read-only") -(defun kill-region (beg end) +(defun kill-region (beg end &optional yank-handler) "Kill between point and mark. The text is deleted but saved in the kill ring. The command \\[yank] can retrieve it from there. @@ -1842,15 +1854,18 @@ Supply two arguments, character numbers indicating the stretch of text Any command that calls this function is a \"kill command\". If the previous command was also a kill command, the text killed this time appends to the text killed last time -to make one entry in the kill ring." +to make one entry in the kill ring. + +In lisp code, optional third arg YANK-HANDLER specifies the yank-handler +text property to be set on the killed text. See `insert-for-yank'." (interactive "r") (condition-case nil (let ((string (delete-and-extract-region beg end))) (when string ;STRING is nil if BEG = END ;; Add that string to the kill ring, one way or another. (if (eq last-command 'kill-region) - (kill-append string (< end beg)) - (kill-new string))) + (kill-append string (< end beg) yank-handler) + (kill-new string nil yank-handler))) (setq this-command 'kill-region)) ((buffer-read-only text-read-only) ;; The code above failed because the buffer, or some of the characters @@ -1941,13 +1956,16 @@ The argument is used for internal purposes; do not supply one." ;; This is actually used in subr.el but defcustom does not work there. (defcustom yank-excluded-properties - '(read-only invisible intangible field mouse-face help-echo local-map keymap) + '(read-only invisible intangible field mouse-face help-echo local-map keymap + yank-handler) "*Text properties to discard when yanking." :type '(choice (const :tag "All" t) (repeat symbol)) :group 'editing :version "21.4") (defvar yank-window-start nil) +(defvar yank-undo-function nil + "If non-nil, function used by `yank-pop' to delete last stretch of yanked text.") (defun yank-pop (arg) "Replace just-yanked stretch of killed text with a different stretch. @@ -1968,7 +1986,8 @@ comes the newest one." (setq this-command 'yank) (let ((inhibit-read-only t) (before (< (point) (mark t)))) - (delete-region (point) (mark t)) + (funcall (or yank-undo-function 'delete-region) (point) (mark t)) + (setq yank-undo-function nil) (set-marker (mark-marker) (point) (current-buffer)) (insert-for-yank (current-kill arg)) ;; Set the window start back where it was in the yank command, @@ -2007,7 +2026,8 @@ See also the command \\[yank-pop]." (goto-char (prog1 (mark t) (set-marker (mark-marker) (point) (current-buffer))))) ;; If we do get all the way thru, make this-command indicate that. - (setq this-command 'yank) + (if (eq this-command t) + (setq this-command 'yank)) nil) (defun rotate-yank-pointer (arg) -- 2.39.2