From f90ef53aa05e407dbae1b497f74b002ff8341f33 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 30 Jul 2019 15:24:55 +0200 Subject: [PATCH] Convert Emacs article buffers from widget.el to button.el * lisp/gnus/gnus-art.el (gnus-mime-button-map) (gnus-url-button-commands, gnus-insert-mime-button) (gnus-mime-display-alternative) (gnus-article-extend-url-button, gnus-article-add-button) (gnus-insert-prev-page-button, gnus-insert-next-page-button) (gnus-mime-security-button-map) (gnus-insert-mime-security-button): Ditto. * lisp/gnus/gnus-html.el (gnus-html-displayed-image-map) (gnus-html-wash-images, gnus-html-put-image): Ditto. * lisp/gnus/gnus-icalendar.el (gnus-icalendar-insert-button): Ditto. * lisp/gnus/gnus-sum.el (gnus-summary-widget-forward) (gnus-summary-button-forward, gnus-summary-widget-backward) (gnus-summary-button-backward, gnus-collect-urls-primary-text) (gnus-collect-urls, gnus-summary-browse-url): Stop using widgets and star using button.el buttons instead. * lisp/gnus/mm-decode.el (mm-shr, mm-handle-filename): Don't convert shr buttons into widgets. --- lisp/gnus/gnus-art.el | 91 ++++++++++++------------------------- lisp/gnus/gnus-html.el | 36 ++++++--------- lisp/gnus/gnus-icalendar.el | 5 +- lisp/gnus/gnus-sum.el | 30 ++++++------ lisp/gnus/mm-decode.el | 35 -------------- 5 files changed, 60 insertions(+), 137 deletions(-) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index a38300ef66a..6d297d4c1d4 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -4381,7 +4381,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is ;;; Gnus article mode ;;; -(set-keymap-parent gnus-article-mode-map widget-keymap) +(set-keymap-parent gnus-article-mode-map button-buffer-map) (gnus-define-keys gnus-article-mode-map " " gnus-article-goto-next-page @@ -4874,6 +4874,7 @@ General format specifiers can also be used. See Info node (defvar gnus-mime-button-map (let ((map (make-sparse-keymap))) + (define-key map "\r" 'gnus-article-push-button) (define-key map [mouse-2] 'gnus-article-push-button) (define-key map [down-mouse-3] 'gnus-mime-button-menu) (dolist (c gnus-mime-button-commands) @@ -4888,7 +4889,9 @@ General format specifiers can also be used. See Info node gnus-mime-button-commands))) (defvar gnus-url-button-commands - '((gnus-article-copy-string "u" "Copy URL to kill ring"))) + '((gnus-article-copy-string "u" "Copy URL to kill ring") + (push-button "\r" "Push the button") + (push-button [mouse-2] "Push the button"))) (defvar gnus-url-button-map (let ((map (make-sparse-keymap))) @@ -5849,26 +5852,12 @@ all parts." ;; Exclude a newline. (1- (point)) (point))) - (when gnus-article-button-face - (overlay-put (make-overlay b e nil t) - 'face gnus-article-button-face)) - (widget-convert-button - 'link b e - :mime-handle handle - :action 'gnus-widget-press-button - :button-keymap gnus-mime-button-map - :help-echo - (lambda (widget) - (format - "%S: %s the MIME part; %S: more options" - 'mouse-2 - (if (mm-handle-displayed-p (widget-get widget :mime-handle)) - "hide" "show") - 'down-mouse-3))))) - -(defun gnus-widget-press-button (elems _el) - (goto-char (widget-get elems :from)) - (gnus-article-press-button)) + (make-text-button + b e + 'keymap gnus-mime-button-map + 'face gnus-article-button-face + 'help-echo + "mouse-2: toggle the MIME part; down-mouse-3: more options"))) (defvar gnus-displaying-mime nil) @@ -6151,10 +6140,9 @@ If nil, don't show those extra buttons." mouse-face ,gnus-article-mouse-face face ,gnus-article-button-face gnus-part ,id + button t article-type multipart rear-nonsticky t)) - (widget-convert-button 'link from (point) - :action 'gnus-widget-press-button) ;; Do the handles (while (setq handle (pop handles)) (add-text-properties @@ -6175,10 +6163,9 @@ If nil, don't show those extra buttons." mouse-face ,gnus-article-mouse-face face ,gnus-article-button-face gnus-part ,id + button t gnus-data ,handle rear-nonsticky t)) - (widget-convert-button 'link from (point) - :action 'gnus-widget-press-button) (insert " ")) (insert "\n\n")) (when preferred @@ -8025,7 +8012,7 @@ url is put as the `gnus-button-url' overlay property on the button." (match-beginning 1)) points))))) (match-beginning 2))) - (let (gnus-article-mouse-face widget-mouse-face) + (let (gnus-article-mouse-face) (while points (gnus-article-add-button (pop points) (pop points) 'gnus-button-push @@ -8074,18 +8061,19 @@ url is put as the `gnus-button-url' overlay property on the button." (defun gnus-article-add-button (from to fun &optional data text) "Create a button between FROM and TO with callback FUN and data DATA." - (when gnus-article-button-face - (overlay-put (make-overlay from to nil t) - 'face gnus-article-button-face)) (add-text-properties from to (nconc (and gnus-article-mouse-face (list 'mouse-face gnus-article-mouse-face)) - (list 'gnus-callback fun) + (list 'gnus-callback fun + 'button-data data + 'action fun + 'keymap gnus-url-button-map + 'category t + 'button t) (and data (list 'gnus-data data)))) - (widget-convert-button 'link from to :action 'gnus-widget-press-button - :help-echo (or text "Follow the link") - :keymap gnus-url-button-map)) + (when gnus-article-button-face + (add-face-text-property from to gnus-article-button-face t))) (defun gnus-article-copy-string () "Copy the string in the button to the kill ring." @@ -8413,13 +8401,8 @@ url is put as the `gnus-button-url' overlay property on the button." ;; Exclude a newline. (1- (point)) (point))) - (when gnus-article-button-face - (overlay-put (make-overlay b e nil t) - 'face gnus-article-button-face)) - (widget-convert-button - 'link b e - :action 'gnus-button-prev-page - :button-keymap gnus-prev-page-map))) + (make-text-button b e 'keymap gnus-prev-page-map + 'face gnus-article-button-face))) (defun gnus-button-next-page (&optional _args _more-args) "Go to the next page." @@ -8449,13 +8432,8 @@ url is put as the `gnus-button-url' overlay property on the button." ;; Exclude a newline. (1- (point)) (point))) - (when gnus-article-button-face - (overlay-put (make-overlay b e nil t) - 'face gnus-article-button-face)) - (widget-convert-button - 'link b e - :action 'gnus-button-next-page - :button-keymap gnus-next-page-map))) + (make-text-button b e 'keymap gnus-next-page-map + 'face gnus-article-button-face))) (defun gnus-article-button-next-page (_arg) "Go to the next page." @@ -8708,6 +8686,7 @@ For example: (defvar gnus-mime-security-button-map (let ((map (make-sparse-keymap))) + (define-key map "\r" 'gnus-article-push-button) (define-key map [mouse-2] 'gnus-article-push-button) (define-key map [down-mouse-3] 'gnus-mime-security-button-menu) (dolist (c gnus-mime-security-button-commands) @@ -8843,20 +8822,8 @@ For example: ;; Exclude a newline. (1- (point)) (point))) - (when gnus-article-button-face - (overlay-put (make-overlay b e nil t) - 'face gnus-article-button-face)) - (widget-convert-button - 'link b e - :mime-handle handle - :action 'gnus-widget-press-button - :button-keymap gnus-mime-security-button-map - :help-echo - (lambda (_widget) - (format - "%S: show detail; %S: more options" - 'mouse-2 - 'down-mouse-3))))) + (make-text-button b e 'keymap gnus-mime-security-button-map + 'face gnus-article-button-face))) (defun gnus-mime-display-security (handle) (save-restriction diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el index f36c3897876..92d760f4bf7 100644 --- a/lisp/gnus/gnus-html.el +++ b/lisp/gnus/gnus-html.el @@ -84,7 +84,7 @@ fit these criteria." (define-key map "i" 'gnus-html-browse-image) (define-key map "\r" 'gnus-html-browse-url) (define-key map "u" 'gnus-article-copy-string) - (define-key map [tab] 'widget-forward) + (define-key map [tab] 'button-forward) map)) (defun gnus-html-encode-url (url) @@ -180,12 +180,10 @@ fit these criteria." 'image-displayer `(lambda (url start end) (gnus-html-display-image url start end ,alt-text)) + 'help-echo alt-text + 'button t + 'keymap gnus-html-image-map 'gnus-image (list url start end alt-text))) - (widget-convert-button - 'url-link start (point) - :help-echo alt-text - :keymap gnus-html-image-map - url) (if (string-match "\\`cid:" url) ;; URLs with cid: have their content stashed in other ;; parts of the MIME structure, so just insert them @@ -207,21 +205,15 @@ fit these criteria." (delete-region start end)) "*") 'cid)) - (widget-convert-button - 'link start end - :action 'gnus-html-insert-image - :help-echo url - :keymap gnus-html-image-map - :button-keymap gnus-html-image-map))) + (make-text-button start end + 'help-echo url + 'keymap gnus-html-image-map))) ;; Normal, external URL. (if (or inhibit-images (gnus-html-image-url-blocked-p url blocked-images)) - (widget-convert-button - 'link start end - :action 'gnus-html-insert-image - :help-echo url - :keymap gnus-html-image-map - :button-keymap gnus-html-image-map) + (make-text-button start end + 'help-echo url + 'keymap gnus-html-image-map) ;; Non-blocked url (let ((width (when (string-match "width=\"?\\([0-9]+\\)" parameters) @@ -444,11 +436,9 @@ Return a string with image data." (let ((image (gnus-rescale-image image (gnus-html-maximum-image-size)))) (delete-region start end) (gnus-put-image image alt-text 'external) - (widget-convert-button - 'url-link start (point) - :help-echo alt-text - :keymap gnus-html-displayed-image-map - url) + (make-text-button start (point) + 'help-echo alt-text + 'keymap gnus-html-displayed-image-map) (put-text-property start (point) 'gnus-alt-text alt-text) (when url (add-text-properties diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el index 402e233d7fd..529cafe23e8 100644 --- a/lisp/gnus/gnus-icalendar.el +++ b/lisp/gnus/gnus-icalendar.el @@ -777,9 +777,8 @@ These will be used to retrieve the RSVP information from ical events." ,callback keymap ,gnus-mime-button-map face ,gnus-article-button-face - gnus-data ,data)) - (widget-convert-button 'link start (point) - :action 'gnus-widget-press-button))) + button t + gnus-data ,data)))) (defun gnus-icalendar-send-buffer-by-mail (buffer-name subject) (let ((message-signature nil)) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 320130f49bc..73f0eb39184 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -9410,7 +9410,9 @@ Obeys the standard process/prefix convention." (t (error "Couldn't select virtual nndoc group"))))) -(defun gnus-summary-widget-forward (arg) +(define-obsolete-function-alias 'gnus-summary-widget-forward + #'gnus-summary-button-forward "27.1") +(defun gnus-summary-button-forward (arg) "Move point to the next field or button in the article. With optional ARG, move across that many fields." (interactive "p") @@ -9420,9 +9422,11 @@ With optional ARG, move across that many fields." (error "No article window found")))) (select-window win) (select-frame-set-input-focus (window-frame win)) - (widget-forward arg))) + (forward-button arg))) -(defun gnus-summary-widget-backward (arg) +(define-obsolete-function-alias 'gnus-summary-widget-backward + #'gnus-summary-button-backward "27.1") +(defun gnus-summary-button-backward (arg) "Move point to the previous field or button in the article. With optional ARG, move across that many fields." (interactive "p") @@ -9432,30 +9436,28 @@ With optional ARG, move across that many fields." (error "No article window found")))) (select-window win) (select-frame-set-input-focus (window-frame win)) - (unless (widget-at (point)) + (unless (button-at (point)) (goto-char (point-max))) - (widget-backward arg))) + (backward-button arg))) (defcustom gnus-collect-urls-primary-text "Link" - "The widget text for the default link in `gnus-summary-browse-url'." + "The button text for the default link in `gnus-summary-browse-url'." :version "27.1" :type 'string :group 'gnus-article-various) (defun gnus-collect-urls () "Return the list of URLs in the buffer after (point). -The 1st element is the widget named by `gnus-collect-urls-primary-text'." +The 1st element is the button named by `gnus-collect-urls-primary-text'." (let ((pt (point)) urls primary) - (while (progn (widget-move 1 t) ; no echo - ;; `widget-move' wraps around to top of buffer. - (> (point) pt)) + (while (forward-button 1 nil nil t) (setq pt (point)) - (when-let ((w (widget-at pt)) - (u (or (widget-value w) + (when-let ((w (button-at pt)) + (u (or (button-get w 'shr-url) (get-text-property pt 'gnus-string)))) (when (string-match-p "\\`[[:alpha:]]+://" u) (if (and gnus-collect-urls-primary-text (null primary) - (string= gnus-collect-urls-primary-text (widget-text w))) + (string= gnus-collect-urls-primary-text (button-label w))) (setq primary u) (push u urls))))) (setq urls (nreverse urls)) @@ -9489,7 +9491,7 @@ default." (gnus-summary-select-article) (gnus-with-article-buffer (article-goto-body) - ;; Back up a char, in case body starts with a widget. + ;; Back up a char, in case body starts with a button. (backward-char) (setq urls (gnus-collect-urls)) (setq target diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index c73bec0f19f..cba9633b539 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -1829,7 +1829,6 @@ text/html;\\s-*charset=\\([^\t\n\r \"'>]+\\)[^>]*>" nil t) (shr-insert-document document) (unless (bobp) (insert "\n")) - (mm-convert-shr-links) (mm-handle-set-undisplayer handle (let ((min (point-min-marker)) @@ -1838,40 +1837,6 @@ text/html;\\s-*charset=\\([^\t\n\r \"'>]+\\)[^>]*>" nil t) (let ((inhibit-read-only t)) (delete-region min max)))))))) -(defvar shr-image-map) -(defvar shr-map) -(autoload 'widget-convert-button "wid-edit") -(defvar widget-keymap) - -(defun mm-convert-shr-links () - (let ((start (point-min)) - end keymap) - (while (and start - (< start (point-max))) - (when (setq start (text-property-not-all start (point-max) 'shr-url nil)) - (setq end (next-single-property-change start 'shr-url nil (point-max))) - (widget-convert-button - 'url-link start end - :help-echo (get-text-property start 'help-echo) - :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' - ;; 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))) - ;; Avoid `shr-next-link' and `shr-previous-link' in `keymap' so - ;; TAB and M-TAB run `widget-forward' and `widget-backward' instead. - (substitute-key-definition 'shr-next-link nil keymap) - (substitute-key-definition 'shr-previous-link nil keymap) - (dolist (overlay (overlays-at start)) - (overlay-put overlay 'face nil)) - (setq start end))))) - (defun mm-handle-filename (handle) "Return filename of HANDLE if any." (or (mail-content-type-get (mm-handle-type handle) -- 2.39.2