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 0d615b3793b5f0f5bdf815d2abfba0822a934b27..3dcaffeac463edeeae9ee9fcc82ff06f4ff45937 100644 (file)
--- 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 0ad1a53e846fd669832bd155a2fde35e3352f24d..2c6875571816a344d6b5af3dad05f817dce2c20d 100644 (file)
--- 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 c9d43b6ef865eb3677ae8f43ba5cf1ce2e7d4d5e..2b3db0bfeb27cd07054d39b39b782082498d0ba6 100644 (file)
--- 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.