;;; 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
(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)
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)))
;; 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)
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
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
(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
(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."
;; 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."
;; 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."
(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)
;; 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
(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)
'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
(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)
(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
,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))
(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")
(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")
(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))
(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
(shr-insert-document document)
(unless (bobp)
(insert "\n"))
- (mm-convert-shr-links)
(mm-handle-set-undisplayer
handle
(let ((min (point-min-marker))
(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)