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

[Eric Abrahamsen]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> Eric Abrahamsen <eric@ericabrahamsen.net> writes:
>
>> 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.
>
> *taps calendar*

Ahem...

> Looks good to me, but as I said over on the ding mailing list:
>
>> +@item A l
>
> I think this is such a useful command that we should bind it to `w'
> instead.  Or some other unused single key keystroke.

No objection here.

>> + (if target
>> + (funcall-interactively #'widget-button-press (1+ (cdr target)))
>
> And I didn't quite get why you're not just using browse-url directly
> here, which seems less fragile and more controllable.

I think once I was using widget-forward to collect buttons, it seemed
natural to be able to handle all the types of buttons, not just URLs.
For instance, I'd like to be able to start composing messages to mailto:
buttons. Then the only reliable way to "do" what the button does was to
press it. Later Eric Fraga posted a variant that checked if the URL was
a http URL, and used `browse-url' directly in that case. The whole
function could be a lot simpler if we only collected http links. Though
I'd still like to compose messages to email addresses...

I'm posting the most recent version of the function below. Another bad
thing is does is tries to manage window state, returning the
summary/article config to what it was before clicking links, and I think
that should be removed -- it's fragile, and none of the other
summary/article commands do that.

Anyway, let me know what you think about the button vs link issue...

#+begin_src elisp
(defun gnus-summary-press-button (arg)
  "Scan the current article body for links, and offer to browse them.
With prefix ARG, also collect links from message headers.

Links are opened using `widget-button-press'.  If only one link
is found, browse that directly, otherwise use completion to
select a link."
  (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))))
        (wc (current-window-configuration))
        pt urls 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) urls)))
      (setq target
            (assoc (cond ((= (length urls) 1)
                          (caar urls))
                         ((> (length urls) 1)
                          (completing-read "URL to browse: "
                                           (setq urls (nreverse (delete-dups 
urls)))
                                           nil t)))
                   urls))
      (if target
          (funcall-interactively #'widget-button-press (1+ (cdr target)))
        (message "No URLs found.")))
    ;; Now what?  If pressing the button changed our window layout, do
    ;; nothing.  Otherwise, if the article wasn't opened to begin
    ;; with, close it after we follow the link.
    (unless (equal wc (current-window-configuration))
      (gnus-summary-expand-window opened))))
#+end_src