diff options
| author | Sam Steingold | 2019-07-16 17:23:27 -0400 |
|---|---|---|
| committer | Sam Steingold | 2019-07-16 17:24:32 -0400 |
| commit | 5aa6a15e20f6e97febff45bb291fac59c11ec1ac (patch) | |
| tree | a7a5d78f8776a36128c698419d83edfa30f9b530 | |
| parent | 585fb957399f21a93cbfabd182b76262466797e3 (diff) | |
| download | emacs-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.el | 25 | ||||
| -rw-r--r-- | 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." | |||
| 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) | 9439 | The 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. |