diff options
author | Lars Ingebrigtsen <larsi@gnus.org> | 2018-04-13 23:49:58 +0200 |
---|---|---|
committer | Lars Ingebrigtsen <larsi@gnus.org> | 2018-04-13 23:49:58 +0200 |
commit | 4575ae5a9c5589ac903362486951f0d36c8ff8ee (patch) | |
tree | 116fdcc81ca8b803d9bd6d5b2d21fc0737ea71ad /lisp/gnus/mm-decode.el | |
parent | 52a5bc89c92cb4be88d9ec6eb2df178560559320 (diff) | |
download | emacs-4575ae5a9c5589ac903362486951f0d36c8ff8ee.tar.gz |
Don't bind image commands on non-image links in Gnus
* lisp/gnus/mm-decode.el (mm--images-in-region-p): New utility
function.
(mm-convert-shr-links): Only use the shr image map on links that
contain images. This avoids binding commands like `r' on links
that don't need it.
Diffstat (limited to 'lisp/gnus/mm-decode.el')
-rw-r--r-- | lisp/gnus/mm-decode.el | 21 |
1 files changed, 18 insertions, 3 deletions
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 7ab84c0c83d..d8753e5a1d5 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -25,6 +25,7 @@ (require 'mail-parse) (require 'mm-bodies) +(require 'shr) (eval-when-compile (require 'cl-lib)) (autoload 'gnus-map-function "gnus-util") @@ -1841,8 +1842,6 @@ text/html;\\s-*charset=\\([^\t\n\r \"'>]+\\)[^>]*>" nil t) (let ((inhibit-read-only t)) (delete-region min max)))))))) -(defvar shr-image-map) - (autoload 'widget-convert-button "wid-edit") (defvar widget-keymap) @@ -1856,7 +1855,10 @@ text/html;\\s-*charset=\\([^\t\n\r \"'>]+\\)[^>]*>" nil t) (widget-convert-button 'url-link start end :help-echo (get-text-property start 'help-echo) - :keymap (setq keymap (copy-keymap shr-image-map)) + :keymap (setq keymap (copy-keymap + (if (mm--images-in-region-p start end) + shr-image-map + shr-map))) (get-text-property start 'shr-url)) ;; Mask keys that launch `widget-button-click'. ;; Those bindings are provided by `widget-keymap' @@ -1872,6 +1874,19 @@ text/html;\\s-*charset=\\([^\t\n\r \"'>]+\\)[^>]*>" nil t) (overlay-put overlay 'face nil)) (setq start end))))) +(defun mm--images-in-region-p (start end) + (let ((found nil)) + (save-excursion + (goto-char start) + (while (and (not found) + (< (point) end)) + (let ((display (get-text-property (point) 'display))) + (when (and (consp display) + (eq (car display) 'image)) + (setq found t))) + (forward-char 1))) + found)) + (defun mm-handle-filename (handle) "Return filename of HANDLE if any." (or (mail-content-type-get (mm-handle-type handle) |