summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSam Steingold <sds@gnu.org>2019-07-16 17:23:27 -0400
committerSam Steingold <sds@gnu.org>2019-07-16 17:24:32 -0400
commit5aa6a15e20f6e97febff45bb291fac59c11ec1ac (patch)
treea7a5d78f8776a36128c698419d83edfa30f9b530
parent585fb957399f21a93cbfabd182b76262466797e3 (diff)
downloademacs-5aa6a15e20f6e97febff45bb291fac59c11ec1ac.tar.gz
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.
-rw-r--r--lisp/gnus/gnus-sum.el25
-rw-r--r--lisp/wid-edit.el7
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.