Add new user option to transform kill ring contents

* doc/emacs/killing.texi (Kill Options): Document it.
* lisp/simple.el (kill-new): Use it.
(kill-transform-function): New user option (bug#29013).
This commit is contained in:
Lars Ingebrigtsen 2021-06-30 15:55:50 +02:00
parent 46a66c6248
commit bb56f6c768
3 changed files with 65 additions and 32 deletions

View file

@ -269,6 +269,21 @@ happens. But if you set the variable @code{kill-read-only-ok} to a
non-@code{nil} value, they just print a message in the echo area to
explain why the text has not been erased.
@vindex kill-transform-function
Before saving the kill to the kill ring, you can transform the
string using @code{kill-transform-function}. It's called with the
string to be killed, and it should return the string you want to be
saved. It can also return @code{nil}, in which case the string won't
be saved to the kill ring. For instance, if you never want to save
a pure white space string to the kill ring, you can say:
@lisp
(setq kill-transform-function
(lambda (string)
(and (not (string-blank-p string))
string)))
@end lisp
@vindex kill-do-not-save-duplicates
If you change the variable @code{kill-do-not-save-duplicates} to a
non-@code{nil} value, identical subsequent kills yield a single

View file

@ -2142,6 +2142,11 @@ summaries will include the failing condition.
** Miscellaneous
+++
*** New user option 'kill-transform-function'.
This can be used to transform (and suppress) strings from entering the
kill ring.
---
*** `C-u M-x dig' will now prompt for a query type to use.

View file

@ -5060,6 +5060,16 @@ The comparison is done using `equal-including-properties'."
:group 'killing
:version "23.2")
(defcustom kill-transform-function nil
"Function to call to transform a string before it's put on the kill ring.
The function is called with one parameter (the string that's to
be put on the kill ring). It should return a string or nil. If
the latter, the string is not put on the kill ring."
:type '(choice (const :tag "No transform" nil)
function)
:group 'killing
:version "28.1")
(defun kill-new (string &optional replace)
"Make STRING the latest kill in the kill ring.
Set `kill-ring-yank-pointer' to point to it.
@ -5075,38 +5085,41 @@ When the yank handler has a non-nil PARAM element, the original STRING
argument is not used by `insert-for-yank'. However, since Lisp code
may access and use elements from the kill ring directly, the STRING
argument should still be a \"useful\" string for such uses."
(unless (and kill-do-not-save-duplicates
;; Due to text properties such as 'yank-handler that
;; can alter the contents to yank, comparison using
;; `equal' is unsafe.
(equal-including-properties string (car kill-ring)))
(if (fboundp 'menu-bar-update-yank-menu)
(menu-bar-update-yank-menu string (and replace (car kill-ring)))))
(when save-interprogram-paste-before-kill
(let ((interprogram-paste (and interprogram-paste-function
(funcall interprogram-paste-function))))
(when interprogram-paste
(setq interprogram-paste
(if (listp interprogram-paste)
;; Use `reverse' to avoid modifying external data.
(reverse interprogram-paste)
(list interprogram-paste)))
(when (or (not (numberp save-interprogram-paste-before-kill))
(< (seq-reduce #'+ (mapcar #'length interprogram-paste) 0)
save-interprogram-paste-before-kill))
(dolist (s interprogram-paste)
(unless (and kill-do-not-save-duplicates
(equal-including-properties s (car kill-ring)))
(push s kill-ring)))))))
(unless (and kill-do-not-save-duplicates
(equal-including-properties string (car kill-ring)))
(if (and replace kill-ring)
(setcar kill-ring string)
(let ((history-delete-duplicates nil))
(add-to-history 'kill-ring string kill-ring-max t))))
(setq kill-ring-yank-pointer kill-ring)
(if interprogram-cut-function
(funcall interprogram-cut-function string)))
;; Allow the user to transform or ignore the string.
(when (or (not kill-transform-function)
(setq string (funcall kill-transform-function string)))
(unless (and kill-do-not-save-duplicates
;; Due to text properties such as 'yank-handler that
;; can alter the contents to yank, comparison using
;; `equal' is unsafe.
(equal-including-properties string (car kill-ring)))
(if (fboundp 'menu-bar-update-yank-menu)
(menu-bar-update-yank-menu string (and replace (car kill-ring)))))
(when save-interprogram-paste-before-kill
(let ((interprogram-paste (and interprogram-paste-function
(funcall interprogram-paste-function))))
(when interprogram-paste
(setq interprogram-paste
(if (listp interprogram-paste)
;; Use `reverse' to avoid modifying external data.
(reverse interprogram-paste)
(list interprogram-paste)))
(when (or (not (numberp save-interprogram-paste-before-kill))
(< (seq-reduce #'+ (mapcar #'length interprogram-paste) 0)
save-interprogram-paste-before-kill))
(dolist (s interprogram-paste)
(unless (and kill-do-not-save-duplicates
(equal-including-properties s (car kill-ring)))
(push s kill-ring)))))))
(unless (and kill-do-not-save-duplicates
(equal-including-properties string (car kill-ring)))
(if (and replace kill-ring)
(setcar kill-ring string)
(let ((history-delete-duplicates nil))
(add-to-history 'kill-ring string kill-ring-max t))))
(setq kill-ring-yank-pointer kill-ring)
(if interprogram-cut-function
(funcall interprogram-cut-function string))))
;; It has been argued that this should work like `self-insert-command'
;; which merges insertions in `buffer-undo-list' in groups of 20