aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorSam Steingold2019-07-16 17:23:27 -0400
committerSam Steingold2019-07-16 17:24:32 -0400
commit5aa6a15e20f6e97febff45bb291fac59c11ec1ac (patch)
treea7a5d78f8776a36128c698419d83edfa30f9b530
parent585fb957399f21a93cbfabd182b76262466797e3 (diff)
downloademacs-5aa6a15e20f6e97febff45bb291fac59c11ec1ac.tar.gz
emacs-5aa6a15e20f6e97febff45bb291fac59c11ec1ac.zip
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."
9435 (widget-backward arg))) 9435 (widget-backward arg)))
9436 9436
9437(defun gnus-collect-urls () 9437(defun gnus-collect-urls ()
9438 "Return the list of URLs in the buffer after (point)." 9438 "Return the list of URLs in the buffer after (point).
9439 (let ((pt (point)) urls) 9439The 1st element is the one named 'Link', if any."
9440 (while (progn (widget-forward 1) 9440 (let ((pt (point)) urls link)
9441 ;; `widget-forward' wraps around to top of buffer. 9441 (while (progn (widget-move 1)
9442 ;; `widget-move' wraps around to top of buffer.
9442 (> (point) pt)) 9443 (> (point) pt))
9443 (setq pt (point)) 9444 (setq pt (point))
9444 (when-let ((u (or (get-text-property (point) 'shr-url) 9445 (when-let ((w (widget-at pt))
9445 (get-text-property (point) 'gnus-string)))) 9446 (u (or (widget-value w)
9447 (get-text-property pt 'gnus-string))))
9446 (when (string-match-p "\\`[[:alpha:]]+://" u) 9448 (when (string-match-p "\\`[[:alpha:]]+://" u)
9447 (push u urls)))) 9449 (if (and (null link) (string= "Link" (widget-text w)))
9448 (nreverse (delete-dups urls)))) 9450 (setq link u)
9451 (push u urls)))))
9452 (setq urls (nreverse urls))
9453 (when link
9454 (push link urls))
9455 (delete-dups urls)))
9449 9456
9450(defun gnus-summary-browse-url (arg) 9457(defun gnus-summary-browse-url (arg)
9451 "Scan the current article body for links, and offer to browse them. 9458 "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."
9468 (cond ((= (length urls) 1) 9475 (cond ((= (length urls) 1)
9469 (car urls)) 9476 (car urls))
9470 ((> (length urls) 1) 9477 ((> (length urls) 1)
9471 (completing-read "URL to browse: " urls nil t)))) 9478 (completing-read "URL to browse: " urls nil t (car urls)))))
9472 (if target 9479 (if target
9473 (browse-url target) 9480 (browse-url target)
9474 (message "No URLs found."))))) 9481 (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."
831 (delete-overlay field)) 831 (delete-overlay field))
832 (mapc 'widget-leave-text (widget-get widget :children)))) 832 (mapc 'widget-leave-text (widget-get widget :children))))
833 833
834(defun widget-text (widget)
835 "Get the text representation of the widget."
836 (when-let ((from (widget-get widget :from))
837 (to (widget-get widget :to)))
838 (when (eq (marker-buffer from) (marker-buffer to)) ; is this check necessary?
839 (buffer-substring-no-properties from to))))
840
834;;; Keymap and Commands. 841;;; Keymap and Commands.
835 842
836;; This alias exists only so that one can choose in doc-strings (e.g. 843;; This alias exists only so that one can choose in doc-strings (e.g.