From: Lars Ingebrigtsen Date: Sat, 6 Nov 2021 20:59:22 +0000 (+0100) Subject: Add a framework for yanking media into Emacs X-Git-Tag: emacs-29.0.90~3671^2~170 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=48ca3c99c8121007eef38d457ddc25158118a8d3;p=emacs.git 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. --- diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi index 76fccdbdfec..5e8b33f291b 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 6057691239f..d0bfd8c9019 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 56ac7118135..a706dc76d25 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 8aba24ac5ee..c9133195e9d 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 133f8424aea..b7d98d52de5 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 00000000000..5cc5e366e9c --- /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 +;; 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 . + +;;; 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