bug#75116: [PATCH] Make 'yank-media' autoselect the best media type

[Visuwesh <visuweshm@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 691 bytes --]

Tags: patch

This is a continuation of the long thread in emacs-devel:
https://yhetil.org/emacs-devel/79fc91f3-c2c3-44db-9817-595808917f26@cas.cat/

This message provides a summary:
https://yhetil.org/87r06cj2nd.fsf@gmail.com

Ihor wrote:

> The only comment is that leaving an option to return a list of types
> rather than only a single type will make things more flexible.

And this is now done in the attached patch.

Before I go about writing NEWS and updating the manual, what do you
think about the attached instead?  I think the variable
yank-media-preferred-types gives a more granular control for major-mode
authors than (add-function (local 'yank-media-autoselect-function) ...)


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: yank-media-autoselect-other.diff --]
[-- Type: text/x-diff, Size: 4456 bytes --]

diff --git a/lisp/yank-media.el b/lisp/yank-media.el
index 17981c37c0e..010e942680d 100644
--- a/lisp/yank-media.el
+++ b/lisp/yank-media.el
@@ -29,19 +29,57 @@

 (defvar yank-media--registered-handlers nil)

+(defvar yank-media-preferred-types
+  `(;; Check first since LibreOffice also puts a PNG image in the
+    ;; clipboard when a table cell is copied.
+    application/x-libreoffice-tsvc
+    ;; Give PNG more priority.
+    image/png
+    image/jpeg
+    ;; These are files copied/cut to the clipboard from a file manager.
+    ,(lambda (mimetypes)
+       (seq-find (lambda (type)
+                (string-match-p "x-special/\\(gnome\\|KDE\\|mate\\)-files"
+                                (symbol-name type)))
+              mimetypes))
+    ;; FIXME: We should have a way to handle text/rtf.
+    text/html)
+  "List of mime types in the order of preference.
+Each element in the list should be a symbol to choose the mime type
+denoted by it, or a function of one argument, the mime types available,
+and should return the mime types to use.")
+
+(defvar yank-media-autoselect-function #'yank-media-autoselect-function
+  "Function to auto select the best mime types when many are available.
+The function is called with a list of mime types that have handler in
+the current buffer, and should return the type or a list of types to
+use, or nil if no preferred type is found.")
+
+(defun yank-media-autoselect-function (mimetypes)
+  (catch 'preferred
+    (dolist (typ yank-media-preferred-types)
+      (let ((ret (if (functionp typ)
+                     (funcall typ mimetypes)
+                   (and (memq typ mimetypes) typ))))
+        (when ret (throw 'preferred typ))))))
+
 ;;;###autoload
-(defun yank-media ()
+(defun yank-media (&optional noselect)
   "Yank media (images, HTML and the like) from the clipboard.
 This command depends on the current major mode having support for
 accepting the media type.  The mode has to register itself using
 the `yank-media-handler' mechanism.
+Optional argument NOSELECT non-nil (interactively, with a prefix
+argument) means to skip auto-selecting the best mimetype and ask
+for the media type to use when multiple are available.

 Also see `yank-media-types' for a command that lets you explore
 all the different selection types."
-  (interactive)
+  (interactive "P")
   (unless yank-media--registered-handlers
     (user-error "The `%s' mode hasn't registered any handlers" major-mode))
-  (let ((all-types nil))
+  (let ((all-types nil)
+        pref-type)
     (pcase-dolist (`(,handled-type . ,handler)
                    yank-media--registered-handlers)
       (dolist (type (yank-media--find-matching-media handled-type))
@@ -49,18 +87,28 @@ yank-media
     (unless all-types
       (user-error
        "No handler in the current buffer for anything on the clipboard"))
-    ;; We have a handler in the current buffer; if there's just
-    ;; matching type, just call the handler.
-    (if (length= all-types 1)
-        (funcall (cdar all-types) (caar all-types)
-                 (yank-media--get-selection (caar all-types)))
-      ;; More than one type the user for what type to insert.
+    (setq pref-type (and (null noselect)
+                         (funcall yank-media-autoselect-function
+                                  (mapcar #'car all-types))))
+    (cond
+     ;; We have one preferred mime type so use it unconditionally.
+     ((and pref-type (symbolp pref-type))
+      (funcall (cdr (assq pref-type all-types)) pref-type
+               (yank-media--get-selection pref-type)))
+     ;; The user chose to not autoselect and there's just a single type,
+     ;; just call the handler.
+     ((and (null pref-type) (length= all-types 1))
+      (funcall (cdar all-types) (caar all-types)
+               (yank-media--get-selection (caar all-types))))
+     ;; More than one type, ask the user for what type to insert.
+     (t
       (let ((type
              (intern
               (completing-read "Several types available, choose one: "
-                               (mapcar #'car all-types) nil t))))
+                               (or pref-type (mapcar #'car all-types))
+                               nil t))))
         (funcall (alist-get type all-types)
-                 type (yank-media--get-selection type))))))
+                 type (yank-media--get-selection type)))))))

 (defun yank-media--find-matching-media (handled-type)
   (seq-filter

[-- Attachment #3: Type: text/plain, Size: 629 bytes --]


I know that I have to update the Info node (info "(elisp) Yanking
Media").  Does (info "(emacs) Clipboard") need any update too?

In GNU Emacs 31.0.50 (build 27, x86_64-pc-linux-gnu, X toolkit, cairo
 version 1.18.2, Xaw scroll bars) of 2024-12-07 built on astatine
Repository revision: 9ddec89e422d0dd6e9069731b8f2dd2c90aa5607
Repository branch: master
Windowing system distributor 'The X.Org Foundation', version 11.0.12101014
System Description: Debian GNU/Linux trixie/sid

Configured using:
 'configure --with-sound=alsa --with-x-toolkit=lucid --without-xaw3d
 --without-gconf --without-libsystemd --with-cairo CFLAGS=-g3'

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0001-Make-yank-media-autoselect-the-best-media-type.patch --]
[-- Type: text/patch, Size: 4670 bytes --]

From b12ea40822eb0cacf67de514f273cba6f283e580 Mon Sep 17 00:00:00 2001
From: Visuwesh <visuweshm@gmail.com>
Date: Thu, 26 Dec 2024 17:50:13 +0530
Subject: [PATCH] Make 'yank-media' autoselect the best media type

* lisp/yank-media.el (yank-media-autoselect-function)
(yank-media-autoselect-function): Add new variable and function
to make 'yank-media' choose the best/preferred media type out of
the available ones.
(yank-media): Change to account for above.
---
 lisp/yank-media.el | 62 ++++++++++++++++++++++++++++++++++++++--------
 1 file changed, 51 insertions(+), 11 deletions(-)

diff --git a/lisp/yank-media.el b/lisp/yank-media.el
index 17981c37c0e..86dc05cd4f0 100644
--- a/lisp/yank-media.el
+++ b/lisp/yank-media.el
@@ -29,19 +29,49 @@
 
 (defvar yank-media--registered-handlers nil)
 
+(defvar yank-media-autoselect-function #'yank-media-autoselect-function
+  "Function to auto select the best mime types when many are available.
+The function is called with a list of mime types that have handler in
+the current buffer, and should return the type or a list of types to
+use, or nil if no preferred type is found.")
+
+(defun yank-media-autoselect-function (mimetypes)
+  (cond
+   ;; Check first since LibreOffice also puts a PNG image in the
+   ;; clipboard when a table cell is copied.
+   ((memq 'application/x-libreoffice-tsvc mimetypes)
+    'application/x-libreoffice-tsvc)
+   ;; Give PNG more priority.
+   ((memq 'image/png mimetypes)
+    'image/png)
+   ((memq 'image/jpeg mimetypes)
+    'image/jpeg)
+   ;; These are files copied/cut to the clipboard from a file manager.
+   ((seq-find (lambda (type)
+                (string-match-p "x-special/\\(gnome\\|KDE\\|mate\\)-files"
+                                (symbol-name type)))
+              mimetypes))
+   ;; FIXME: We should have a way to handle text/rtf.
+   ((memq 'text/html mimetypes)
+    'text/html)))
+
 ;;;###autoload
-(defun yank-media ()
+(defun yank-media (&optional noselect)
   "Yank media (images, HTML and the like) from the clipboard.
 This command depends on the current major mode having support for
 accepting the media type.  The mode has to register itself using
 the `yank-media-handler' mechanism.
+Optional argument NOSELECT non-nil (interactively, with a prefix
+argument) means to skip auto-selecting the best mimetype and ask
+for the media type to use when multiple are available.
 
 Also see `yank-media-types' for a command that lets you explore
 all the different selection types."
-  (interactive)
+  (interactive "P")
   (unless yank-media--registered-handlers
     (user-error "The `%s' mode hasn't registered any handlers" major-mode))
-  (let ((all-types nil))
+  (let ((all-types nil)
+        pref-type)
     (pcase-dolist (`(,handled-type . ,handler)
                    yank-media--registered-handlers)
       (dolist (type (yank-media--find-matching-media handled-type))
@@ -49,18 +79,28 @@ yank-media
     (unless all-types
       (user-error
        "No handler in the current buffer for anything on the clipboard"))
-    ;; We have a handler in the current buffer; if there's just
-    ;; matching type, just call the handler.
-    (if (length= all-types 1)
-        (funcall (cdar all-types) (caar all-types)
-                 (yank-media--get-selection (caar all-types)))
-      ;; More than one type the user for what type to insert.
+    (setq pref-type (and (null noselect)
+                         (funcall yank-media-autoselect-function
+                                  (mapcar #'car all-types))))
+    (cond
+     ;; We have one preferred mime type so use it unconditionally.
+     ((and pref-type (symbolp pref-type))
+      (funcall (cdr (assq pref-type all-types)) pref-type
+               (yank-media--get-selection pref-type)))
+     ;; The user chose to not autoselect and there's just a single type,
+     ;; just call the handler.
+     ((and (null pref-type) (length= all-types 1))
+      (funcall (cdar all-types) (caar all-types)
+               (yank-media--get-selection (caar all-types))))
+     ;; More than one type, ask the user for what type to insert.
+     (t
       (let ((type
              (intern
               (completing-read "Several types available, choose one: "
-                               (mapcar #'car all-types) nil t))))
+                               (or pref-type (mapcar #'car all-types))
+                               nil t))))
         (funcall (alist-get type all-types)
-                 type (yank-media--get-selection type))))))
+                 type (yank-media--get-selection type)))))))
 
 (defun yank-media--find-matching-media (handled-type)
   (seq-filter
-- 
2.45.2