Allow accessing the image commands via shr

* lisp/gnus/mm-decode.el (mm-convert-shr-links): Allow
accessing the image commands.

* lisp/net/shr.el (shr-image-map): New map used for images.
(shr-urlify): Don't overwrite image maps when applying URL maps.

3 files changed, 18 insertions, 5 deletions

diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index c45258e987c..598ae948d99 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -1906,7 +1906,8 @@ If RECURSIVE, search recursively."
 	(widget-convert-button
 	 'url-link start end
 	 :help-echo (get-text-property start 'help-echo)
-	 :keymap shr-map
+	 ;;; FIXME Should only use the image map on images.
+	 :keymap shr-image-map
 	 (get-text-property start 'shr-url))
 	(put-text-property start end 'local-map nil)
 	(dolist (overlay (overlays-at start))
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index fdac46483c7..7f9f4fad414 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -223,7 +223,7 @@ See also `eww-form-checkbox-selected-symbol'."
   "When this regex is found in the URL, it's not a keyword but an address.")
 
 (defvar eww-link-keymap
-  (let ((map (copy-keymap shr-map)))
+  (let ((map (copy-keymap shr-image-map)))
     (define-key map "\r" 'eww-follow-link)
     map))
 
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 9064b9668f4..339f877beff 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -189,6 +189,11 @@ and other things:
     (define-key map "\r" 'shr-browse-url)
     map))
 
+(defvar shr-image-map
+  (let ((map (copy-keymap shr-map)))
+    (set-keymap-parent map image-map)
+    map))
+
 ;; Public functions and commands.
 (declare-function libxml-parse-html-region "xml.c"
 		  (start end &optional base-url discard-comments))
@@ -1076,8 +1081,15 @@ START, and END.  Note that START and END should be markers."
 				   url)))
 		      (if title (format "%s (%s)" iri title) iri))
 	 'follow-link t
-	 'mouse-face 'highlight
-	 'keymap shr-map)))
+	 'mouse-face 'highlight))
+  ;; Don't overwrite any keymaps that are already in the buffer (i.e.,
+  ;; image keymaps).
+  (while (and start
+              (< start (point)))
+    (let ((next (next-single-property-change start 'keymap nil (point))))
+      (if (get-text-property start 'keymap)
+          (setq start next)
+        (put-text-property start (or next (point)) 'keymap shr-map)))))
 
 (defun shr-encode-url (url)
   "Encode URL."
@@ -1457,7 +1469,7 @@ The preference is a float determined from `shr-prefer-media-type'."
 	   (list (current-buffer) start (set-marker (make-marker) (1- (point))))
 	   t t)))
 	(when (zerop shr-table-depth) ;; We are not in a table.
-	  (put-text-property start (point) 'keymap shr-map)
+	  (put-text-property start (point) 'keymap shr-image-map)
 	  (put-text-property start (point) 'shr-alt alt)
 	  (put-text-property start (point) 'image-url url)
 	  (put-text-property start (point) 'image-displayer