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).

3 files changed, 65 insertions, 32 deletions

diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi
index 4291afec56f..6e4fd77e8b9 100644
--- a/doc/emacs/killing.texi
+++ b/doc/emacs/killing.texi
@@ -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
diff --git a/etc/NEWS b/etc/NEWS
index 701b9a73a8f..55e8b6a7c24 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -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.
 
diff --git a/lisp/simple.el b/lisp/simple.el
index 71db7ffe5d1..f746d738a62 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -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