[Emacs-diffs] master 211cdd3 2/3: Allow accessing the image commands via shr

[Lars Ingebrigtsen]

branch: master
commit 211cdd3ff29e345c4986d9f8c9f04a90a3446742
Author: Lars Ingebrigtsen <address@hidden>
Commit: Lars Ingebrigtsen <address@hidden>

    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.
---
 lisp/gnus/mm-decode.el |    3 ++-
 lisp/net/eww.el        |    2 +-
 lisp/net/shr.el        |   18 +++++++++++++++---
 3 files changed, 18 insertions(+), 5 deletions(-)

diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index c45258e..598ae94 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 fdac464..7f9f4fa 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 9064b96..339f877 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