mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-03 11:33:37 +00:00
Code Issues Releases Activity

Treat the "Link" link in gnus-summary-browse-urls specially

Browse Source 
* lisp/gnus/gnus-sum.el (gnus-collect-urls): Make sure that
the URL labeled "Link" is the first in the return list.
(gnus-summary-browse-url): Use the 1st URL as the default.
* lisp/wid-edit.el (widget-text): New function.
This commit is contained in:
Sam Steingold 2019-07-16 17:23:27 -04:00
parent 585fb95739
commit 5aa6a15e20
2 changed files with 23 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
lisp/gnus/gnus-sum.el
View File

@ -9435,17 +9435,24 @@ With optional ARG, move across that many fields."
(widget-backward arg)))
(defun gnus-collect-urls ()
"Return the list of URLs in the buffer after (point)."
(let ((pt (point)) urls)
(while (progn (widget-forward 1)
;; `widget-forward' wraps around to top of buffer.
"Return the list of URLs in the buffer after (point).
The 1st element is the one named 'Link', if any."
(let ((pt (point)) urls link)
(while (progn (widget-move 1)
;; `widget-move' wraps around to top of buffer.
(> (point) pt))
(setq pt (point))
(when-let ((u (or (get-text-property (point) 'shr-url)
(get-text-property (point) 'gnus-string))))
(when-let ((w (widget-at pt))
(u (or (widget-value w)
(get-text-property pt 'gnus-string))))
(when (string-match-p "\\`[[:alpha:]]+://" u)
(push u urls))))
(nreverse (delete-dups urls))))
(if (and (null link) (string= "Link" (widget-text w)))
(setq link u)
(push u urls)))))
(setq urls (nreverse urls))
(when link
(push link urls))
(delete-dups urls)))
(defun gnus-summary-browse-url (arg)
"Scan the current article body for links, and offer to browse them.
@ -9468,7 +9475,7 @@ browse that directly, otherwise use completion to select a link."
(cond ((= (length urls) 1)
(car urls))
((> (length urls) 1)
(completing-read "URL to browse: " urls nil t))))
(completing-read "URL to browse: " urls nil t (car urls)))))
(if target
(browse-url target)
(message "No URLs found.")))))

7
lisp/wid-edit.el
View File

@ -831,6 +831,13 @@ button end points."
(delete-overlay field))
(mapc 'widget-leave-text (widget-get widget :children))))
(defun widget-text (widget)
"Get the text representation of the widget."
(when-let ((from (widget-get widget :from))
(to (widget-get widget :to)))
(when (eq (marker-buffer from) (marker-buffer to)) ; is this check necessary?
(buffer-substring-no-properties from to))))
;;; Keymap and Commands.
;; This alias exists only so that one can choose in doc-strings (e.g.