master 5adda2f4683 12/14: Revise FORM-as-function interface in erc-button-alist

[F. Jason Park]

branch: master
commit 5adda2f4683fe23efd659fc7418044c8230772c5
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>

    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 treating all implementers as replacements
    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)
---
 etc/ERC-NEWS                      |   3 +-
 lisp/erc/erc-button.el            |  91 ++++++++++++++++----------------
 test/lisp/erc/erc-button-tests.el | 106 ++++++++++++++++++++++++++++++++++++++
 3 files changed, 153 insertions(+), 47 deletions(-)

diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 3907b7bc5f2..f2a8eb72b95 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -209,7 +209,8 @@ changes are encouraged to voice their concerns on the bug 
list.
 Two helper macros from GNU ELPA's Compat library are now available to
 third-party modules as 'erc-compat-call' and 'erc-compat-function'.
 In the area of buttons, 'Info-goto-node' has been supplanted by plain
-old 'info' in 'erc-button-alist', primarily for autoloading purposes.
+old 'info' in 'erc-button-alist', and the bracketed "<URL:...>"
+pattern entry has been removed because it was more or less redundant.
 And the "TAB" key is now bound to a new command, 'erc-tab', that only
 calls 'completion-at-point' when point is in the input area and
 module-specific commands, like 'erc-button-next', otherwise.
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index e2447deecde..7376c18ad4c 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -128,7 +128,6 @@ longer than `erc-fill-column'."
   ;; 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 @@ REGEXP is the string matching text around the button or a 
symbol
 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 @@ specified by `erc-button-alist'."
                         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.
@@ -412,22 +411,22 @@ early (outer), args-filtering advice wrapping
 (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.
@@ -682,15 +681,15 @@ and `apropos' for other symbols."
     (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
@@ -727,7 +726,7 @@ non-strings, concatenate leading string members before 
applying
                 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