[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] emacs-25 ea512a7: * lisp/gnus/mm-decode.el (mm-convert-shr

From: Katsumi Yamaoka
Subject: [Emacs-diffs] emacs-25 ea512a7: * lisp/gnus/mm-decode.el (mm-convert-shr-links):
Date: Wed, 22 Jun 2016 10:33:20 +0000 (UTC)

branch: emacs-25
commit ea512a7c2cd30206dd509b193c9faaba25640180
Author: Katsumi Yamaoka <address@hidden>
Commit: Katsumi Yamaoka <address@hidden>

    * lisp/gnus/mm-decode.el (mm-convert-shr-links):
    Mask keys that launch `widget-button-click' (bug#22157).
 lisp/gnus/mm-decode.el |   14 +++++++++++---
 1 file changed, 11 insertions(+), 3 deletions(-)

diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 3ea63c7..bb8e203 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -1896,10 +1896,11 @@ If RECURSIVE, search recursively."
 (defvar shr-map)
 (autoload 'widget-convert-button "wid-edit")
+(defvar widget-keymap)
 (defun mm-convert-shr-links ()
   (let ((start (point-min))
-       end)
+       end keymap)
     (while (and start
                (< start (point-max)))
       (when (setq start (text-property-not-all start (point-max) 'shr-url nil))
@@ -1907,9 +1908,16 @@ If RECURSIVE, search recursively."
         'url-link start end
         :help-echo (get-text-property start 'help-echo)
-        :keymap shr-map
+        :keymap (setq keymap (copy-keymap shr-map))
         (get-text-property start 'shr-url))
-       (put-text-property start end 'local-map nil)
+       ;; Remove keymap that `shr-urlify' adds.
+       (put-text-property start end 'keymap nil)
+       ;; Mask keys that launch `widget-button-click'.
+       ;; Those bindings are provided by `widget-keymap'
+       ;; that is a parent of `gnus-article-mode-map'.
+       (dolist (key (where-is-internal #'widget-button-click widget-keymap))
+         (unless (lookup-key keymap key)
+           (define-key keymap key #'ignore)))
        (dolist (overlay (overlays-at start))
          (overlay-put overlay 'face nil))
        (setq start end)))))

reply via email to

[Prev in Thread] Current Thread [Next in Thread]