bug#34052: Acknowledgement (27.0.50; New command gnus-summary-press-button)

[Eric Abrahamsen <eric@ericabrahamsen.net>]

[-- Attachment #1: Type: text/plain, Size: 128 bytes --]

Here's a new (lightly user-tested) version of the command. I guess if
there's no objection I'll push this in a few days.

Eric


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-New-command-gnus-summary-press-button.patch --]
[-- Type: text/x-patch, Size: 4669 bytes --]

From 6f9e518bccee479a11114a128bdafb95f80539b7 Mon Sep 17 00:00:00 2001
From: Eric Abrahamsen <eric@ericabrahamsen.net>
Date: Sat, 12 Jan 2019 13:44:23 -0800
Subject: [PATCH] New command gnus-summary-press-button

* lisp/gnus/gnus-sum.el (gnus-summary-press-button): Summary buffer
  command to press a button in the article buffer. Uses completion to
  choose one of the buttons.
* doc/misc/gnus.texi (Article Commands): Document.
---
 doc/misc/gnus.texi    | 11 +++++++
 lisp/gnus/gnus-sum.el | 70 +++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 81 insertions(+)

diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 2862264312..de7291b2a9 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -10156,6 +10156,17 @@ Article Commands
 the @kbd{A C} command (@code{gnus-summary-show-complete-article}) will
 do so.
 
+@item A l
+@cindex buttons
+@findex gnus-summary-press-button
+@kindex A l @r{(Summary)}
+Press one of the button widgets in the article buffer.  This behaves
+as if the user had navigated into the article buffer and pressed
+@key{RET} on a widget.  If there is more than one button widget, the
+button text is used for completion.  With a prefix arg, allow
+selection of buttons in the message headers, in addition to the
+message body.
+
 @end table
 
 
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 911bf89f23..d3e3ff1927 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -2101,6 +2101,7 @@ gnus-article-commands-menu
   "g" gnus-summary-show-article
   "s" gnus-summary-isearch-article
   "\t" gnus-summary-widget-forward
+  "l" gnus-summary-press-button
   [backtab] gnus-summary-widget-backward
   "P" gnus-summary-print-article
   "S" gnus-sticky-article
@@ -9368,6 +9369,75 @@ gnus-summary-widget-backward
     (goto-char (point-max)))
   (widget-backward arg))
 
+(defun gnus-summary-press-button (arg)
+  "Scan the current article body for buttons, and offer to press them.
+With prefix ARG, also collect buttons from message headers.
+
+Buttons are pressed using `widget-button-press'.  If only one
+button is found, press that directly, otherwise use completion to
+select a button."
+  (interactive "P")
+  (let ((opened (and (gnus-buffer-live-p gnus-article-buffer)
+		     (get-buffer-window gnus-article-buffer t)
+		     ;; We might have opened an article, but then moved to
+		     ;; a different summary line.
+		     (= gnus-current-article (gnus-summary-article-number))))
+	pt buttons target)
+    (unless opened
+      (gnus-summary-select-article)
+      (gnus-configure-windows 'article))
+    (gnus-with-article-buffer
+      (if arg
+	  (goto-char (point-min))
+	(article-goto-body)
+	;; Back up a char, in case body starts with a widget.
+	(backward-char))
+      (setq pt (point))
+      (while (progn (widget-forward 1)
+		    (> (point) pt))
+	(setq pt (point))
+	(when-let ((u (cond
+		       ((get-text-property (point) 'shr-url))
+		       ((get-text-property (point) 'gnus-string))
+		       ((let ((dat (get-text-property (point) 'gnus-data)))
+			  (pcase dat
+			    ('nil nil)
+			    ((and (pred stringp) (pred (string-match-p "^>")))
+			     ;; This is a "so-and-so wrote:" quote.
+			     (buffer-substring-no-properties
+			      (line-beginning-position) (line-end-position)))
+			    ;; Does a marker always signify the
+			    ;; signature?  We may never know.
+			    ((pred markerp)
+			     "<signature>")
+			    ;; Sometimes this is also a "so-and-so wrote" quote.
+			    (`(((,(and (pred markerp) start) .
+				 ,(and (pred markerp) end)))
+			       _)
+			     (buffer-substring-no-properties start end))
+			    ;; There are more weird cases, add as
+			    ;; necessary.
+			    ((pred stringp) dat)))))))
+	  (push (cons u pt) buttons)))
+      (setq target
+	    (assoc (cond ((= (length buttons) 1)
+			  (caar buttons))
+			 ((> (length buttons) 1)
+			  (completing-read
+			   "URL to browse: "
+			   (setq buttons (nreverse (delete-dups buttons)))
+			   nil t)))
+		   buttons))
+      (if target
+	  (funcall-interactively #'widget-button-press (1+ (cdr target)))
+	(message "No buttons found.")))
+    ;; Now what?  If we're not in the *Summary* buffer anymore (i.e.,
+    ;; pressing the button created a new buffer), do nothing.
+    ;; Otherwise, if the article wasn't opened to begin with, close it
+    ;; after we follow the link.
+    (when (get-buffer-window gnus-summary-buffer)
+      (gnus-summary-expand-window opened))))
+
 (defun gnus-summary-isearch-article (&optional regexp-p)
   "Do incremental search forward on the current article.
 If REGEXP-P (the prefix) is non-nil, do regexp isearch."
-- 
2.20.1