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