From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Sat, 6 Nov 2021 23:08:36 +0000 (+0100)
Subject: Allow yanking images to html-mode
X-Git-Tag: emacs-29.0.90~3671^2~163
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=465cb1fff12b26059896bf8e2057d06a61bc7339;p=emacs.git

Allow yanking images to html-mode

* lisp/net/mailcap.el (mailcap-mime-type-to-extension): Autoload.
* lisp/textmodes/sgml-mode.el (html-mode--image-yank-handler): New
function.
(html-mode): Accept image/*.
---

diff --git a/etc/NEWS b/etc/NEWS
index 0d615b3793b..3dcaffeac46 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -220,7 +220,7 @@ If non-nil, 'C-c C-a' will put attached files at the end of the message.
 *** Message Mode now supports image yanking.
 
 ---
-*** HTML Mode now supports text/html yanking.
+*** HTML Mode now supports text/html and image/* yanking.
 
 ** Gnus
 
diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index 0ad1a53e846..2c687557181 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -1068,6 +1068,7 @@ For instance, \"foo.png\" will result in \"image/png\"."
        (match-string 1 file-name)
      "")))
 
+;;;###autoload
 (defun mailcap-mime-type-to-extension (mime-type)
   "Return a file name extension based on a mime type.
 For instance, `image/png' will result in `png'."
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index c9d43b6ef86..2b3db0bfeb2 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -2416,6 +2416,7 @@ To work around that, do:
 
   (setq imenu-create-index-function 'html-imenu-index)
   (register-yank-media-handler 'text/html #'html-mode--html-yank-handler)
+  (register-yank-media-handler "image/.*" #'html-mode--image-yank-handler)
 
   (setq-local sgml-empty-tags
 	      ;; From HTML-4.01's loose.dtd, parsed with
@@ -2436,6 +2437,24 @@ To work around that, do:
     (insert html)
     (sgml-pretty-print (point-min) (point-max))))
 
+(defun html-mode--image-yank-handler (type image)
+  (let ((file (read-file-name "Save %s image to: ")))
+    (when (file-directory-p file)
+      (user-error "%s is a directory"))
+    (when (and (file-exists-p file)
+               (not (yes-or-no-p "%s exists; overwrite?")))
+      (user-error "%s exists"))
+    (with-temp-buffer
+      (set-buffer-multibyte nil)
+      (insert image)
+      (write-region (point-min) (point-max) file))
+    (insert-image
+     (create-image file (mailcap-mime-type-to-extension type) nil
+		   :max-width 200
+		   :max-height 200)
+     " ")
+    (insert (format "<img src=%S>\n" (file-relative-name file)))))
+
 (defvar html-imenu-regexp
   "\\s-*<h\\([1-9]\\)[^\n<>]*>\\(<[^\n<>]*>\\)*\\s-*\\([^\n<>]*\\)"
   "A regular expression matching a head line to be added to the menu.