master 465cb1f 1/2: Allow yanking images to html-mode

[Lars Ingebrigtsen]

branch: master
commit 465cb1fff12b26059896bf8e2057d06a61bc7339
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    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/*.
---
 etc/NEWS                    |  2 +-
 lisp/net/mailcap.el         |  1 +
 lisp/textmodes/sgml-mode.el | 19 +++++++++++++++++++
 3 files changed, 21 insertions(+), 1 deletion(-)

diff --git a/etc/NEWS b/etc/NEWS
index 0d615b3..3dcaffe 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 0ad1a53..2c68755 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 c9d43b6..2b3db0b 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.