master 48ca3c9 3/3: Add a framework for yanking media into Emacs

[Lars Ingebrigtsen]

branch: master
commit 48ca3c99c8121007eef38d457ddc25158118a8d3
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Add a framework for yanking media into Emacs
    
    * doc/emacs/killing.texi (Clipboard): Refer to it.
    * doc/lispref/frames.texi (Yanking Media): Document the mechanism.
    
    * lisp/yank-media.el: New file.
    
    * lisp/gnus/message.el (message-mode): Register a yank handler for
    images.
    (message-insert-screenshot): Factor out image code from here...
    (message--yank-media-image-handler): ... to here.
---
 doc/emacs/killing.texi  |  8 +++++
 doc/lispref/elisp.texi  |  1 +
 doc/lispref/frames.texi | 36 +++++++++++++++++++
 etc/NEWS                |  9 +++++
 lisp/gnus/message.el    | 41 ++++++++++++---------
 lisp/yank-media.el      | 95 +++++++++++++++++++++++++++++++++++++++++++++++++
 6 files changed, 173 insertions(+), 17 deletions(-)

diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi
index 76fccdb..5e8b33f 100644
--- a/doc/emacs/killing.texi
+++ b/doc/emacs/killing.texi
@@ -562,6 +562,14 @@ new yank to the clipboard.
   To prevent kill and yank commands from accessing the clipboard,
 change the variable @code{select-enable-clipboard} to @code{nil}.
 
+@findex yank-media
+  Programs can put other things than plain text on the clipboard.  For
+instance, a web browser will usually let you choose ``Copy Image'' on
+images, and this image will be put on the clipboard.  Emacs can yank
+these objects with the @code{yank-media} command---but only in modes
+that have support for it (@pxref{Yanking Media,,, elisp, The Emacs
+Lisp Reference Manual}).
+
 @cindex clipboard manager
 @vindex x-select-enable-clipboard-manager
   Many X desktop environments support a feature called the
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi
index 6057691..d0bfd8c 100644
--- a/doc/lispref/elisp.texi
+++ b/doc/lispref/elisp.texi
@@ -1123,6 +1123,7 @@ Frames
 * Dialog Boxes::            Displaying a box to ask yes or no.
 * Pointer Shape::           Specifying the shape of the mouse pointer.
 * Window System Selections::Transferring text to and from other X clients.
+* Yanking Media::           Yanking things that aren't plain text.
 * Drag and Drop::           Internals of Drag-and-Drop implementation.
 * Color Names::             Getting the definitions of color names.
 * Text Terminal Colors::    Defining colors for text terminals.
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index 56ac711..a706dc7 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -105,6 +105,7 @@ window of another Emacs frame.  @xref{Child Frames}.
 * Dialog Boxes::                Displaying a box to ask yes or no.
 * Pointer Shape::               Specifying the shape of the mouse pointer.
 * Window System Selections::    Transferring text to and from other X clients.
+* Yanking Media::           Yanking things that aren't plain text.
 * Drag and Drop::               Internals of Drag-and-Drop implementation.
 * Color Names::                 Getting the definitions of color names.
 * Text Terminal Colors::        Defining colors for text terminals.
@@ -3923,6 +3924,41 @@ For backward compatibility, there are obsolete aliases
 names of @code{gui-get-selection} and @code{gui-set-selection} before
 Emacs 25.1.
 
+@node Yanking Media
+@subsection Yanking Media
+
+  If you choose, for instance, ``Copy Image'' in a web browser, that
+image is put onto the clipboard, and Emacs can access it via
+@code{gui-get-selection}.  But in general, inserting image data into
+an arbitrary buffer isn't very useful---you can't really do much with
+it by default.
+
+  So Emacs has a system to let modes register handlers for these
+``complicated'' selections.
+
+@defun register-yank-media-handler types handler
+@var{types} can be a @acronym{MIME} media type symbol, a regexp to
+match these, or a list of these symbols and regexps.  For instance:
+
+@example
+(register-yank-media-handler 'text/html #'my-html-handler)
+(register-yank-media-handler "image/.*" #'my-image-handler)
+@end example
+
+A mode can register as many handlers as required.
+
+  The @var{handler} function is called with two parameters: The
+@acronym{MIME} media type symbol and the data (as a string).  The
+handler should then insert the object into the buffer, or save it, or
+do whatever is appropriate for the mode.
+@end defun
+
+  The @code{yank-media} command will consult the registered handlers in
+the current buffer, compare that with the available media types on the
+clipboard, and then pass on the matching selection to the handler (if
+any).  If there's more than one matching selection, the user is
+queried first.
+
 @node Drag and Drop
 @section Drag and Drop
 @cindex drag and drop
diff --git a/etc/NEWS b/etc/NEWS
index 8aba24a..c913319 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -216,6 +216,9 @@ consistent with 'vc-responsible-backend'.
 *** New user option 'mml-attach-file-at-the-end'.
 If non-nil, 'C-c C-a' will put attached files at the end of the message.
 
+---
+*** Message Mode now supports image yanking.
+
 ** Gnus
 
 +++
@@ -553,12 +556,18 @@ Use 'exif-parse-file' and 'exif-field' instead.
 
 * Lisp Changes in Emacs 29.1
 
+*** New command 'yank-media'.
+This command supports yanking non-plain-text media like images and
+HTML from other applications into Emacs.  It is only supported in
+modes that have registered support for it.
+
 +++
 *** New text property 'inhibit-isearch'.
 If set, 'isearch' will skip these areas, which can be useful (for
 instance) when covering huge amounts of data (that has no meaningful
 searchable data, like image data) with a 'display' text property.
 
++++
 *** 'insert-image' now takes an INHIBIT-ISEARCH optional parameter.
 It marks the image with the 'inhibit-isearch' text parameter, which
 inhibits 'isearch' matching the STRING parameter.
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 133f842..b7d98d5 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -48,6 +48,8 @@
 (require 'puny)
 (require 'rmc)                          ; read-multiple-choice
 (require 'subr-x)
+(require 'yank-media)
+(require 'mailcap)
 
 (autoload 'mailclient-send-it "mailclient")
 
@@ -3155,6 +3157,7 @@ Like `text-mode', but with these additional commands:
   (setq-local message-checksum nil)
   (setq-local message-mime-part 0)
   (message-setup-fill-variables)
+  (register-yank-media-handler "image/.*" #'message--yank-media-image-handler)
   (when message-fill-column
     (setq fill-column message-fill-column)
     (turn-on-auto-fill))
@@ -8873,25 +8876,29 @@ used to take the screenshot."
                  (car message-screenshot-command) nil (current-buffer) nil
                  (cdr message-screenshot-command))
           (buffer-string))))
-    (set-mark (point))
-    (insert-image
-     (create-image image 'png t
-                  :max-width (truncate (* (frame-pixel-width) 0.8))
-                  :max-height (truncate (* (frame-pixel-height) 0.8))
-                  :scale 1)
-     (format "<#part type=\"image/png\" disposition=inline 
data-encoding=base64 raw=t>\n%s\n<#/part>"
-            ;; Get a base64 version of the image -- this avoids later
-            ;; complications if we're auto-saving the buffer and
-            ;; restoring from a file.
-            (with-temp-buffer
-              (set-buffer-multibyte nil)
-              (insert image)
-              (base64-encode-region (point-min) (point-max) t)
-              (buffer-string)))
-     nil nil t)
-    (insert "\n\n")
+    (message--yank-media-image-handler 'image/png image)
     (message "")))
 
+(defun message--yank-media-image-handler (type image)
+  (set-mark (point))
+  (insert-image
+   (create-image image (mailcap-mime-type-to-extension type) t
+                :max-width (truncate (* (frame-pixel-width) 0.8))
+                :max-height (truncate (* (frame-pixel-height) 0.8))
+                :scale 1)
+   (format "<#part type=\"%s\" disposition=inline data-encoding=base64 
raw=t>\n%s\n<#/part>"
+           type
+          ;; Get a base64 version of the image -- this avoids later
+          ;; complications if we're auto-saving the buffer and
+          ;; restoring from a file.
+          (with-temp-buffer
+            (set-buffer-multibyte nil)
+            (insert image)
+            (base64-encode-region (point-min) (point-max) t)
+            (buffer-string)))
+   nil nil t)
+  (insert "\n\n"))
+
 (declare-function gnus-url-unhex-string "gnus-util")
 
 (defun message-parse-mailto-url (url)
diff --git a/lisp/yank-media.el b/lisp/yank-media.el
new file mode 100644
index 0000000..5cc5e36
--- /dev/null
+++ b/lisp/yank-media.el
@@ -0,0 +1,95 @@
+;;; yank-media.el --- Yanking images and HTML  -*- lexical-binding:t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; Author: Lars Ingebrigtsen <larsi@gnus.org>
+;; Keywords: utility
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'cl-lib)
+
+(defvar yank-media--registered-handlers nil)
+
+;;;###autoload
+(defun yank-media ()
+  "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 `register-yank-media-handler' mechanism."
+  (interactive)
+  (unless yank-media--registered-handlers
+    (user-error "The `%s' mode hasn't registered any handlers" major-mode))
+  (catch 'found
+    (pcase-dolist (`(,handled-type . ,handler)
+                   yank-media--registered-handlers)
+      (when-let ((types (yank-media--find-matching-media handled-type)))
+        ;; We have a handler in the current buffer; if there's just
+        ;; matching type, just call the handler.
+        (if (length= types 1)
+            (funcall handler (car types)
+                     (yank-media--get-selection (car types)))
+          ;; More than one type the user for what type to insert.
+          (let ((type
+                 (intern
+                  (completing-read "Several types available, choose one: "
+                                   types nil t))))
+            (funcall handler type (yank-media--get-selection type))))
+        (throw 'found nil)))
+    (user-error
+     "No handler in the current buffer for anything on the clipboard")))
+
+(defun yank-media--find-matching-media (handled-type)
+  (seq-filter
+   (lambda (type)
+     (pcase-let ((`(,major ,minor) (split-string (symbol-name type) "/")))
+       (if (and (equal major "image")
+                (not (image-type-available-p (intern minor))))
+           ;; Just filter out all the image types that Emacs doesn't
+           ;; support, because the clipboard is full of things like
+           ;; `image/x-win-bitmap'.
+           nil
+         ;; Check that the handler wants this type.
+         (and (if (symbolp handled-type)
+                  (eq handled-type type)
+                (string-match-p handled-type (symbol-name type)))
+              ;; An element may be in TARGETS but be empty.
+              (yank-media--get-selection type)))))
+   (gui-get-selection 'CLIPBOARD 'TARGETS)))
+
+(defun yank-media--get-selection (type)
+  (when-let ((data (gui-get-selection 'CLIPBOARD type)))
+    (if-let ((charset (get-text-property 0 'charset data)))
+        (encode-coding-string data charset)
+      data)))
+
+;;;###autoload
+(defun register-yank-media-handler (types handler)
+  "Register HANDLER for dealing with `yank-media' actions for TYPES.
+TYPES should be a MIME media type symbol, a regexp, or a list
+that can contain both symbols and regexps."
+  (make-local-variable 'yank-media--registered-handlers)
+  (dolist (type (ensure-list types))
+    (setf (alist-get type yank-media--registered-handlers nil nil #'equal)
+          handler)))
+
+(provide 'yank-media)
+
+;;; yank-media.el ends here