bug#60933: 30.0.50; ERC >5.5: Make buttonizing more extensible

["J.P." <jp@neverwas.me>]

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

This bug's main contribution has been the introduction of a function
variant for the FORM field of `erc-button-alist' entries. It was meant
to offer a more natural way to influence buttonizing than the boolean
sexps it was displacing while still retaining enough structure to
encourage maintainability (for example, by highlighting which elements
invite modification, like a button's faces and its bounds, and which are
off limits, like certain required text properties).

However, in the short term, I feel that locking this down too cleverly
will only hamstring us as we inch closer to adopting various protocol
extensions for ERC 5.7. As requirements shift beneath us, the current
design will always end up seeming overly restrictive or permissive. As
such, I think it's best to partially revert these changes and instead
look to an existing interface we already know (but don't love), namely
`erc-button-add-button'. From now on, I think we should just interpret
any function occupying the FORM field as a replacement "buttonizer" to
be called in its place.

The same general thinking applies to the nicks-specific buttonizer as
well, though it being intrinsically special and, for now, internal means
we can take more liberties in inconveniencing its consumers (which are
all built-in modules). Thus, I'm proposing we replace the slightly
unwieldy set of positional params with a single passed-around struct,
which members of the interface's "advice stack" can modify at will. See
implementation for details.

Note that these changes currently require those from "bug#62834: Make
erc-button navigation more flexible". Thanks.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-5.6-Improve-erc-button-modify-nick-function-interfac.patch --]
[-- Type: text/x-patch, Size: 7624 bytes --]

From 190a77266d27e490dad7bda84d6790827f9e3953 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sat, 15 Apr 2023 09:52:05 -0700
Subject: [PATCH 1/2] [5.6] Improve erc-button--modify-nick-function interface

* lisp/erc/erc-button.el (erc-button--check-nicknames-entry): Remove
unused let binding.
(erc-button--nick): New struct.
(erc-button--preserve-bounds): Rework to expect `erc-button--nick'
object.
(erc-button--modify-nick-function): Reexplain interface base on
`erc-button--nick' object.
(erc-button--add-phantom-speaker): Redo to expect `erc-button--nick'
object.
(erc-button-add-nickname-buttons): Rework slightly to use
`erc-button--nick' when calling `erc-button--modify-nick-function'.
(Bug#60933.)
---
 lisp/erc/erc-button.el | 91 +++++++++++++++++++++++++++++-------------
 1 file changed, 63 insertions(+), 28 deletions(-)

diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index e2447deecde..5d8fd03615b 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -300,16 +300,42 @@ erc-button--maybe-warn-arbitrary-sexp
 
 (defun erc-button--check-nicknames-entry ()
   ;; This helper exists because the module is defined after its options.
-  (when-let (((eq major-mode 'erc-mode))
-             (entry (alist-get 'nicknames erc-button-alist)))
-    (unless (eq 'erc-button-buttonize-nicks (nth 1 entry))
+  (when (eq major-mode 'erc-mode)
+    (unless (eq (nth 1 (alist-get 'nicknames erc-button-alist))
+                'erc-button-buttonize-nicks)
       (erc-button--display-error-notice-with-keys-and-warn
        "Values other than `erc-button-buttonize-nicks' in the third slot of "
        "the `nicknames' entry of `erc-button-alist' are deprecated."))))
 
-(defun erc-button--preserve-bounds (bounds _ server-user _)
-  "Return BOUNDS.\n\n(fn BOUNDS NICKNAME SERVER-USER CHANNEL-USER)"
-  (and server-user bounds))
+(cl-defstruct erc-button--nick
+  ;; Indicates the nick's position in the current message.  BEG is
+  ;; normally also point.
+  ( bounds nil :type cons
+    :documentation "A cons of (BEG . END).")
+  ;; NICK is the original, non-casemapped nickname and REST is a
+  ;; possibly empty list of opaque objects.  If non-nil, the entire
+  ;; cons should be mutated rather than replaced because it's used as
+  ;; a key in hash tables and text-property searches.
+  ( data nil :type (or null cons)
+    :documentation "A unique cons of (NICK . REST).")
+  ( downcased nil :type (or null string)
+    :documentation "The case-mapped nickname sans text properties.")
+  ;; Not necessarily present in `erc-server-users'.
+  ( user nil :type (or null erc-server-user)
+    :documentation "A possibly nil or spoofed `erc-server-user'.")
+  ;; The CDR of a value from an `erc-channel-users' table.
+  ( cuser nil :type (or null erc-channel-user)
+    :documentation "A possibly nil `erc-channel-user'.")
+  ( erc-button-face erc-button-face :type symbol
+    :documentation "Temp `erc-button-face' while buttonizing.")
+  ( erc-button-nickname-face erc-button-nickname-face :type symbol
+    :documentation "Temp `erc-button-nickname-face' while buttonizing.")
+  ( erc-button-mouse-face erc-button-mouse-face :type symbol
+    :documentation "Temp `erc-button-mouse-face' while buttonizing."))
+
+(defun erc-button--preserve-bounds (nick-object)
+  "Return NICK-OBJECT when its user slot is non-empty."
+  (and (erc-button--nick-user nick-object) nick-object))
 
 ;; This variable is intended to serve as a "core" to be wrapped by
 ;; (built-in) modules during setup.  It's unclear whether
@@ -320,29 +346,27 @@ erc-button--preserve-bounds
 
 (defvar erc-button--modify-nick-function #'erc-button--preserve-bounds
   "Function to possibly modify aspects of nick being buttonized.
-Called with four args: BOUNDS NICKNAME SERVER-USER CHANNEL-USER.
-BOUNDS is a cons of (BEG . END) marking the position of the nick
-in the current message, which occupies the whole of the narrowed
-buffer.  BEG is normally also point.  NICKNAME is a case-mapped
-string without text properties.  SERVER-USER and CHANNEL-USER are
-the nick's `erc-server-users' entry and its associated (though
-possibly nil) `erc-channel-user' object.  The function should
-return BOUNDS or a suitable replacement to indicate that
-buttonizing ought to proceed, and nil if it should be inhibited.")
+Called with one argument, an `erc-button--nick' object, or nil.
+The function should return the same (or similar) object when
+buttonizing ought to proceed and nil otherwise.  While running,
+all faces defined in `erc-button' are bound temporarily and can
+be updated at will.")
 
 (defvar-local erc-button--phantom-users nil)
 
 (defun erc-button--add-phantom-speaker (args)
   "Maybe substitute fake `server-user' for speaker at point."
-  (pcase args
-    (`(,bounds ,downcased-nick nil ,channel-user)
-     (list bounds downcased-nick
-           ;; Like `with-memoization' but don't cache when value is nil.
-           (or (gethash downcased-nick erc-button--phantom-users)
-               (and-let* ((user (erc-button--get-user-from-speaker-naive
-                                 (car bounds))))
-                 (puthash downcased-nick user erc-button--phantom-users)))
-           channel-user))
+  (pcase (car args)
+    ((and obj (cl-struct erc-button--nick bounds downcased (user 'nil)))
+     ;; Like `with-memoization' but don't cache when value is nil.
+     (when-let ((user (or (gethash downcased erc-button--phantom-users)
+                          (erc-button--get-user-from-speaker-naive
+                           (car bounds)))))
+       (cl-assert (null (erc-button--nick-data obj)))
+       (puthash downcased user erc-button--phantom-users)
+       (setf (erc-button--nick-data obj) (list (erc-server-user-nickname user))
+             (erc-button--nick-user obj) user))
+     (list obj))
     (_ args)))
 
 (define-minor-mode erc-button--phantom-users-mode
@@ -402,12 +426,23 @@ erc-button-add-nickname-buttons
                              (gethash down erc-channel-users)))
                  (user (or (and cuser (car cuser))
                            (and erc-server-users
-                                (gethash down erc-server-users)))))
+                                (gethash down erc-server-users))))
+                 (data (list word)))
             (when (or (not (functionp form))
-                      (setq bounds
-                            (funcall form bounds down user (cdr cuser))))
+                      (and-let* ((obj (funcall form (make-erc-button--nick
+                                                     :bounds bounds :data data
+                                                     :downcased down :user user
+                                                     :cuser (cdr cuser)))))
+                        (setq bounds (erc-button--nick-bounds obj)
+                              data (erc-button--nick-data obj)
+                              erc-button-mouse-face
+                              (erc-button--nick-erc-button-mouse-face obj)
+                              erc-button-nickname-face
+                              (erc-button--nick-erc-button-nickname-face obj)
+                              erc-button-face
+                              (erc-button--nick-erc-button-face obj))))
               (erc-button-add-button (car bounds) (cdr bounds)
-                                     fun t (list word)))))))))
+                                     fun t data))))))))
 
 (defun erc-button-add-buttons-1 (regexp entry)
   "Search through the buffer for matches to ENTRY and add buttons."
-- 
2.39.2


[-- Attachment #3: 0002-5.6-Revise-FORM-as-function-interface-in-erc-button-.patch --]
[-- Type: text/x-patch, Size: 13410 bytes --]

From 513ea7d6034d6bc0c44955dcda4c7724699b52b9 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sat, 15 Apr 2023 09:52:05 -0700
Subject: [PATCH 2/2] [5.6] Revise FORM-as-function interface in
 erc-button-alist

* lisp/erc/erc-button.el (erc-button-alist): Remove redundant "<URL:
foo>" entry, which adds nothing beyond highlighting the surrounding
bookends at the expense of doubling up on face properties for no
reason.  Revise the FORM-as-function interface by removing
the dynamic binding of face options and weird bounds-as-a-cons
parameter.  Instead, just treat any such function, when present, as a
replacement for `erc-button-add-button'.
(erc-button--maybe-warn-arbitrary-sexp): Make more robust by having it
handle all accepted FORM types other than booleans.
(erc-button-add-buttons-1): Rework to only check FORM field once.
(erc-button--substitute-command-keys-in-region,
erc-button--display-error-with-buttons): Rename former as latter and
change signature to conform to new `erc-button-add-buttons' interface.
(erc-button--display-error-notice-with-keys): Call renamed helper.
* test/lisp/erc/erc-button-tests.el (erc-button-alist--url,
erc-button-tests--form, erc-button-tests--some-var,
erc-button-tests--erc-button-alist--function-as-form,
erc-button-alist--function-as-form,
erc-button-tests--erc-button-alist--nil-form,
erc-button-alist---nil-form): Add tests and helpers.  (Bug#60933.)
---
 lisp/erc/erc-button.el            |  91 +++++++++++++------------
 test/lisp/erc/erc-button-tests.el | 106 ++++++++++++++++++++++++++++++
 2 files changed, 151 insertions(+), 46 deletions(-)

diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 5d8fd03615b..4829e8b7be2 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -128,7 +128,6 @@ erc-button-alist
   ;; things hard to maintain.
   '((nicknames 0 erc-button-buttonize-nicks erc-nick-popup 0)
     (erc-button-url-regexp 0 t browse-url-button-open-url 0)
-    ("<URL: *\\([^<> ]+\\) *>" 0 t browse-url-button-open-url 1)
 ;;; ("(\\(\\([^~\n \t@][^\n \t@]*\\)@\\([a-zA-Z0-9.:-]+\\)\\)" 1 t finger 2 3)
     ;; emacs internal
     ("[`‘]\\([a-zA-Z][-a-zA-Z_0-9!*<=>+]+\\)['’]"
@@ -166,17 +165,14 @@ erc-button-alist
 BUTTON is the number of the regexp grouping actually matching the
   button.  This is ignored if REGEXP is `nicknames'.
 
-FORM is a Lisp symbol for a special variable whose value must be
-  true for the button to be added.  Alternatively, when REGEXP is
-  not `nicknames', FORM can be a function whose arguments are BEG
-  and END, the bounds of the button in the current buffer.  It's
-  expected to return a cons of (possibly identical) bounds or
-  nil, to deny.  For the extent of the call, all face options
-  defined for the button module are re-bound, shadowing
-  themselves, so the function is free to change their values.
-  When regexp is the special symbol `nicknames', FORM must be the
-  symbol `erc-button-buttonize-nicks'.  Specifying anything else
-  is deprecated.
+FORM is either a boolean or a special variable whose value must
+  be non-nil for the button to be added.  When REGEXP is the
+  special symbol `nicknames', FORM must be the symbol
+  `erc-button-buttonize-nicks'.  Anything else is deprecated.
+  For all other entries, FORM can also be a function to call in
+  place of `erc-button-add-button' with the exact same arguments.
+  When FORM is also a special variable, ERC disregards the
+  variable and calls the function.
 
 CALLBACK is the function to call when the user push this button.
   CALLBACK can also be a symbol.  Its variable value will be used
@@ -288,15 +284,18 @@ erc-button-add-buttons
                         entry)))))))))))
 
 (defun erc-button--maybe-warn-arbitrary-sexp (form)
-  (if (and (symbolp form) (special-variable-p form))
-      (symbol-value form)
-    (unless (get 'erc-button--maybe-warn-arbitrary-sexp 'warned-arbitrary-sexp)
-      (put 'erc-button--maybe-warn-arbitrary-sexp 'warned-arbitrary-sexp t)
-      (lwarn 'erc :warning
-             (concat "Arbitrary sexps for the third FORM"
-                     " slot of `erc-button-alist' entries"
-                     " have been deprecated.")))
-    (eval form t)))
+  (cl-assert (not (booleanp form))) ; covered by caller
+  ;; If a special-variable is also a function, favor the function.
+  (cond ((functionp form) form)
+        ((and (symbolp form) (special-variable-p form)) (symbol-value form))
+        (t (unless (get 'erc-button--maybe-warn-arbitrary-sexp
+                        'warned-arbitrary-sexp)
+             (put 'erc-button--maybe-warn-arbitrary-sexp
+                  'warned-arbitrary-sexp t)
+             (lwarn 'erc :warning (concat "Arbitrary sexps for the third FORM"
+                                          " slot of `erc-button-alist' entries"
+                                          " have been deprecated.")))
+           (eval form t))))
 
 (defun erc-button--check-nicknames-entry ()
   ;; This helper exists because the module is defined after its options.
@@ -447,22 +446,22 @@ erc-button-add-nickname-buttons
 (defun erc-button-add-buttons-1 (regexp entry)
   "Search through the buffer for matches to ENTRY and add buttons."
   (goto-char (point-min))
-  (while (re-search-forward regexp nil t)
-    (let ((start (match-beginning (nth 1 entry)))
-          (end (match-end (nth 1 entry)))
-          (form (nth 2 entry))
-          (fun (nth 3 entry))
-          (data (mapcar #'match-string-no-properties (nthcdr 4 entry))))
-      (when (or (eq t form)
-                (and (functionp form)
-                     (let* ((erc-button-face erc-button-face)
-                            (erc-button-mouse-face erc-button-mouse-face)
-                            (erc-button-nickname-face erc-button-nickname-face)
-                            (rv (funcall form start end)))
-                       (when rv
-                         (setq end (cdr rv) start (car rv)))))
-                (erc-button--maybe-warn-arbitrary-sexp form))
-        (erc-button-add-button start end fun nil data regexp)))))
+  (let (buttonizer)
+    (while
+        (and (re-search-forward regexp nil t)
+             (or buttonizer
+                 (setq buttonizer
+                       (and-let*
+                           ((raw-form (nth 2 entry))
+                            (res (or (eq t raw-form)
+                                     (erc-button--maybe-warn-arbitrary-sexp
+                                      raw-form))))
+                         (if (functionp res) res #'erc-button-add-button)))))
+      (let ((start (match-beginning (nth 1 entry)))
+            (end (match-end (nth 1 entry)))
+            (fun (nth 3 entry))
+            (data (mapcar #'match-string-no-properties (nthcdr 4 entry))))
+        (funcall buttonizer start end fun nil data regexp)))))
 
 (defun erc-button-remove-old-buttons ()
   "Remove all existing buttons.
@@ -717,15 +716,15 @@ erc-button-beats-to-time
     (message "@%s is %d:%02d local time"
              beats hours minutes)))
 
-(defun erc-button--substitute-command-keys-in-region (beg end)
+(defun erc-button--display-error-with-buttons
+    (from to fun nick-p &optional data regexp)
   "Replace command in region with keys and return new bounds"
-  (let* ((o (buffer-substring beg end))
-         (s (substitute-command-keys o)))
-    (unless (equal o s)
-      (setq erc-button-face nil))
-    (delete-region beg end)
-    (insert s))
-  (cons beg (point)))
+  (let* ((o (buffer-substring from to))
+         (s (substitute-command-keys o))
+         (erc-button-face (and (equal o s) erc-button-face)))
+    (delete-region from to)
+    (insert s)
+    (erc-button-add-button from (point) fun nick-p data regexp)))
 
 ;;;###autoload
 (defun erc-button--display-error-notice-with-keys (&optional parsed buffer
@@ -762,7 +761,7 @@ erc-button--display-error-notice-with-keys
                 erc-insert-post-hook))
          (erc-button-alist
           `((,(rx "\\[" (group (+ (not "]"))) "]") 0
-             erc-button--substitute-command-keys-in-region
+             erc-button--display-error-with-buttons
              erc-button-describe-symbol 1)
             ,@erc-button-alist)))
     (erc-display-message parsed '(notice error) (or buffer 'active) string)
diff --git a/test/lisp/erc/erc-button-tests.el b/test/lisp/erc/erc-button-tests.el
index ced08d117bc..6a6f6934389 100644
--- a/test/lisp/erc/erc-button-tests.el
+++ b/test/lisp/erc/erc-button-tests.el
@@ -23,6 +23,112 @@
 
 (require 'erc-button)
 
+(ert-deftest erc-button-alist--url ()
+  (setq erc-server-process
+        (start-process "sleep" (current-buffer) "sleep" "1"))
+  (set-process-query-on-exit-flag erc-server-process nil)
+  (with-current-buffer (erc--open-target "#chan")
+    (let ((verify
+           (lambda (p url)
+             (should (equal (get-text-property p 'erc-data) (list url)))
+             (should (equal (get-text-property p 'mouse-face) 'highlight))
+             (should (eq (get-text-property p 'font-lock-face) 'erc-button))
+             (should (eq (get-text-property p 'erc-callback)
+                         'browse-url-button-open-url)))))
+      (goto-char (point-min))
+
+      ;; Most common (unbracketed)
+      (erc-display-message nil nil (current-buffer)
+                           "Foo https://example.com bar.")
+      (search-forward "https")
+      (funcall verify (point) "https://example.com")
+
+      ;; The <URL: form> still works despite being removed in ERC 5.6.
+      (erc-display-message nil nil (current-buffer)
+                           "Foo <URL: https://gnu.org> bar.")
+      (search-forward "https")
+      (funcall verify (point) "https://gnu.org")
+
+      ;; Bracketed
+      (erc-display-message nil nil (current-buffer) "Foo <ftp://gnu.org> bar.")
+      (search-forward "ftp")
+      (funcall verify (point) "ftp://gnu.org"))
+
+    (when noninteractive
+      (kill-buffer))))
+
+(defvar erc-button-tests--form nil)
+(defvar erc-button-tests--some-var nil)
+
+(defun erc-button-tests--form (&rest rest)
+  (push rest erc-button-tests--form)
+  (apply #'erc-button-add-button rest))
+
+(defun erc-button-tests--erc-button-alist--function-as-form (func)
+  (setq erc-server-process
+        (start-process "sleep" (current-buffer) "sleep" "1"))
+  (set-process-query-on-exit-flag erc-server-process nil)
+
+  (with-current-buffer (erc--open-target "#chan")
+    (let* ((erc-button-tests--form nil)
+           (entry (list (rx "+1") 0 func #'ignore 0))
+           (erc-button-alist (cons entry erc-button-alist)))
+
+      (erc-display-message nil 'notice (current-buffer) "Foo bar baz")
+      (erc-display-message nil nil (current-buffer) "+1")
+      (erc-display-message nil 'notice (current-buffer) "Spam")
+      (should (equal (pop erc-button-tests--form)
+                     '(53 55 ignore nil ("+1") "\\+1")))
+      (should-not erc-button-tests--form)
+      (goto-char (point-min))
+      (search-forward "+")
+      (should (equal (get-text-property (point) 'erc-data) '("+1")))
+      (should (equal (get-text-property (point) 'mouse-face) 'highlight))
+      (should (eq (get-text-property (point) 'font-lock-face) 'erc-button))
+      (should (eq (get-text-property (point) 'erc-callback) 'ignore)))
+
+    (when noninteractive
+      (kill-buffer))))
+
+(ert-deftest erc-button-alist--function-as-form ()
+  (erc-button-tests--erc-button-alist--function-as-form
+   #'erc-button-tests--form)
+
+  (erc-button-tests--erc-button-alist--function-as-form
+   (symbol-function #'erc-button-tests--form))
+
+  (erc-button-tests--erc-button-alist--function-as-form
+   (lambda (&rest r) (push r erc-button-tests--form)
+     (apply #'erc-button-add-button r))))
+
+(defun erc-button-tests--erc-button-alist--nil-form (form)
+  (setq erc-server-process
+        (start-process "sleep" (current-buffer) "sleep" "1"))
+  (set-process-query-on-exit-flag erc-server-process nil)
+
+  (with-current-buffer (erc--open-target "#chan")
+    (let* ((erc-button-tests--form nil)
+           (entry (list (rx "+1") 0 form #'ignore 0))
+           (erc-button-alist (cons entry erc-button-alist)))
+
+      (erc-display-message nil 'notice (current-buffer) "Foo bar baz")
+      (erc-display-message nil nil (current-buffer) "+1")
+      (erc-display-message nil 'notice (current-buffer) "Spam")
+      (should-not erc-button-tests--form)
+      (goto-char (point-min))
+      (search-forward "+")
+      (should-not (get-text-property (point) 'erc-data))
+      (should-not (get-text-property (point) 'mouse-face))
+      (should-not (get-text-property (point) 'font-lock-face))
+      (should-not (get-text-property (point) 'erc-callback)))
+
+    (when noninteractive
+      (kill-buffer))))
+
+(ert-deftest erc-button-alist--nil-form ()
+  (erc-button-tests--erc-button-alist--nil-form nil)
+  (erc-button-tests--erc-button-alist--nil-form 'erc-button-tests--some-var))
+
 (defun erc-button-tests--insert-privmsg (speaker &rest msg-parts)
   (declare (indent 1))
   (let ((msg (erc-format-privmessage speaker
-- 
2.39.2