From 5aa6a15e20f6e97febff45bb291fac59c11ec1ac Mon Sep 17 00:00:00 2001 From: Sam Steingold Date: Tue, 16 Jul 2019 17:23:27 -0400 Subject: Treat the "Link" link in gnus-summary-browse-urls specially * 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. --- lisp/gnus/gnus-sum.el | 25 ++++++++++++++++--------- lisp/wid-edit.el | 7 +++++++ 2 files changed, 23 insertions(+), 9 deletions(-) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 019b47d67ef..1f330e3ebf3 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -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."))))) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 376e3e5526f..5dee898991b 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -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. -- cgit v1.2.1