mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-02-08 00:33:13 -08:00
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.
This commit is contained in:
Lars Ingebrigtsen
parent
e619a6b338
commit
f90ef53aa0
5 changed files with 60 additions and 137 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue