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

"J.P." <[email protected]>
Newsgroups gmane.emacs.erc.general
Message-ID <[email protected]>
v3. Expand `erc-button-alist' pattern to recognize inline (info "...")
forms. Autoload button helpers (locally, in ERC's own loaddefs).
0000-v2-v3.diff (text/x-patch, 3.1 KB)
From 28517cf23b5ed65f8a421dddcffec6a0aecd7fe5 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email protected]>
Date: Thu, 9 Mar 2023 06:28:53 -0800
Subject: [PATCH 0/3] *** NOT A PATCH ***

*** BLURB HERE ***

F. Jason Park (3):
  [5.6] Replace Info-goto-node with info in erc-button-alist
  [5.6] Add erc-button helper for substituting command keys
  [5.6] Allow erc-button-add-face to take an object

 lisp/erc/erc-button.el     | 172 +++++++++++++++++++++++++++++++++----
 lisp/erc/erc-networks.el   |  22 ++---
 test/lisp/erc/erc-tests.el |  56 ++++++++++++
 3 files changed, 220 insertions(+), 30 deletions(-)

Interdiff:
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 49e3caf49a1..c94a412eea8 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -134,7 +134,7 @@ erc-button-alist
     ("[`‘]\\([a-zA-Z][-a-zA-Z_0-9!*<=>+]+\\)['’]"
      1 t erc-button-describe-symbol 1)
     ;; pseudo links
-    ("\\bInfo:[\"]\\([^\"]+\\)[\"]" 0 t info 1)
+    ("\\(?:\\bInfo: ?\\|(info \\)[\"]\\(([^\"]+\\)[\"])?" 0 t info 1)
     ("\\b\\(Ward\\|Wiki\\|WardsWiki\\|TheWiki\\):\\([A-Z][a-z]+\\([A-Z][a-z]+\\)+\\)"
      0 t (lambda (page)
            (browse-url (concat "http://c2.com/cgi-bin/wiki?" page)))
@@ -600,25 +600,39 @@ erc-button--substitute-command-keys-in-region
     (insert s))
   (cons beg (point)))
 
-(defun erc-button--display-error-notice-with-keys (parsed &rest strings)
-  "Add help keys to STRINGS for corner-case admonishments.
-Return inserted result."
+;;;###autoload
+(defun erc-button--display-error-notice-with-keys (&optional parsed buffer
+                                                             &rest strings)
+  "Add help keys to STRINGS for configuration-related admonishments.
+Return inserted result.  PARSED can be an `erc-response' object,
+a string, or nil.  BUFFER can be a buffer, a string, or nil.  As
+a special case, PARSED can also be a buffer as long as BUFFER is
+a string or nil."
+  (when (stringp buffer)
+    (push buffer strings)
+    (setq buffer nil))
   (when (stringp parsed)
     (push parsed strings)
     (setq parsed nil))
+  (when (bufferp parsed)
+    (cl-assert (null buffer))
+    (setq buffer parsed
+          parsed nil))
   (let* ((string (apply #'concat strings))
          (erc-insert-post-hook
           (cons (lambda ()
-                  (setq string (buffer-substring (point-min) (1- (point-max)))))
+                  (setq string (buffer-substring (point-min)
+                                                 (1- (point-max)))))
                 erc-insert-post-hook))
          (erc-button-alist
           `((,(rx "\\[" (group (+ (not "]"))) "]") 0
              erc-button--substitute-command-keys-in-region
              erc-button-describe-symbol 1)
             ,@erc-button-alist)))
-    (erc-display-error-notice parsed string)
+    (erc-display-message parsed '(notice error) (or buffer 'active) string)
     string))
 
+;;;###autoload
 (defun erc-button--display-error-notice-with-keys-and-warn (&rest args)
   "Like `erc-button--display-error-notice-with-keys' but also warn."
   (let ((string (apply #'erc-button--display-error-notice-with-keys args)))
-- 
2.39.2
0001-5.6-Replace-Info-goto-node-with-info-in-erc-button-a.patch (text/x-patch, 2.2 KB)
From f61bd6bb6129571327cdb9e68b38e8221b72d91e Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email protected]>
Date: Sun, 18 Dec 2022 19:01:40 -0800
Subject: [PATCH 1/3] [5.6] Replace Info-goto-node with info in
 erc-button-alist

* lisp/erc/erc-button.el (erc-button-alist): Replace `Info-goto-node'
with plain `info', which is autoloaded.  Expand regexp to recognize
inline `info' function calls.
* lisp/erc/erc-networks.el (erc-networks--set-name,
erc-networks--warn-on-connect): Don't require `info'.  (Bug#60933.)
---
 lisp/erc/erc-button.el   | 2 +-
 lisp/erc/erc-networks.el | 2 --
 2 files changed, 1 insertion(+), 3 deletions(-)

diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index c28dddefa0e..891b453466f 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -133,7 +133,7 @@ erc-button-alist
     ("[`‘]\\([a-zA-Z][-a-zA-Z_0-9!*<=>+]+\\)['’]"
      1 t erc-button-describe-symbol 1)
     ;; pseudo links
-    ("\\bInfo:[\"]\\([^\"]+\\)[\"]" 0 t Info-goto-node 1)
+    ("\\(?:\\bInfo: ?\\|(info \\)[\"]\\(([^\"]+\\)[\"])?" 0 t info 1)
     ("\\b\\(Ward\\|Wiki\\|WardsWiki\\|TheWiki\\):\\([A-Z][a-z]+\\([A-Z][a-z]+\\)+\\)"
      0 t (lambda (page)
            (browse-url (concat "http://c2.com/cgi-bin/wiki?" page)))
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index 95fd8990c99..4337d633cfa 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -1292,7 +1292,6 @@ erc-networks--set-name
                      erc-server-announced-name "\" in `erc-networks-alist'"
                      " or consider calling `erc-tls' with the keyword `:id'."
                      "  See Info:\"(erc) Network Identifier\" for more.")))
-     (require 'info)
      (erc-display-error-notice parsed m)
      (if erc-networks--allow-unknown-network
          (progn
@@ -1514,7 +1513,6 @@ erc-networks--warn-on-connect
   "Emit warning when the `networks' module hasn't been loaded.
 Ideally, do so upon opening the network process."
   (unless (or erc--target erc-networks-mode)
-    (require 'info nil t)
     (let ((m (concat "Required module `networks' not loaded.  If this "
                      " was unexpected, please add it to `erc-modules'.")))
       ;; Assume the server buffer has been marked as active.
-- 
2.39.2
0002-5.6-Add-erc-button-helper-for-substituting-command-k.patch (text/x-patch, 16.5 KB)
From 5fb14bbc6535acfabcec5afe89613528e1b405b5 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email protected]>
Date: Sun, 18 Dec 2022 19:01:40 -0800
Subject: [PATCH 2/3] [5.6] Add erc-button helper for substituting command keys

TODO: add ERC-NEWS entry for `erc-button-alist' field-type deprecation
once ERC 5.5 is released and a new section for 5.6 is added.

* lisp/erc/erc-button.el (erc-button-mode, erc-button-enable): Warn if
`erc-button-alist' contains deprecated FORM field in `nicknames'
entry.
(erc-button-alist): Deprecate arbitrary sexp form for third item of
entries and offer more useful bounds-modifying function in its place.
Mention that anything other than `erc-button-buttonize-nicks' is
deprecated as the FORM field in a `nicknames' entry.
(erc-button--maybe-warn-arbitrary-sexp): Add helper for validating
third `erc-button-alist' field.
(erc-button--check-nicknames-entry): Add helper to check for
deprecated items in `erc-button-alist'.
(erc-button--modify-nick-function): Add new variable to hold a
function that filters nickname bounds when buttonizing.
(erc-button--preserve-bounds): Add function to serve as default value
for `erc-button--modify-nick-function).
(erc-button-add-nickname-buttons): Accommodate function variant for
"form" field of `erc-button-alist' entries.  Minor optimizations.
(erc-button-add-buttons-1): Show warning when arbitrary sexp for third
"form" field encountered.  Accommodate binary function instead.
(erc-button--substitute-command-keys-in-region): Add new function to
serve as default key-substitution function item in `erc-button-alist'.
(erc-button--display-error-notice-with-keys): Add new helper function
for displaying ad hoc warnings that possibly require key substitution.
* lisp/erc/erc-networks.el (erc-networks--ensure-announced,
erc-networks--on-MOTD-end): Use new key-substitutions helper from
erc-button.
(erc-button--display-error-notice-with-keys-and-warn): Add new
function to both display an ERC error message and show a warning.
* test/lisp/erc/erc-tests.el
(erc-button--display-error-notice-with-keys): New test.  (Bug#60933.)
---
 lisp/erc/erc-button.el     | 151 ++++++++++++++++++++++++++++++++++---
 lisp/erc/erc-networks.el   |  20 ++---
 test/lisp/erc/erc-tests.el |  56 ++++++++++++++
 3 files changed, 207 insertions(+), 20 deletions(-)

diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 891b453466f..eca3df44892 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -52,7 +52,8 @@ erc-button
 ;;;###autoload(autoload 'erc-button-mode "erc-button" nil t)
 (define-erc-module button nil
   "This mode buttonizes all messages according to `erc-button-alist'."
-  ((add-hook 'erc-insert-modify-hook #'erc-button-add-buttons 'append)
+  ((erc-button--check-nicknames-entry)
+   (add-hook 'erc-insert-modify-hook #'erc-button-add-buttons 'append)
    (add-hook 'erc-send-modify-hook #'erc-button-add-buttons 'append)
    (add-hook 'erc-complete-functions #'erc-button-next-function)
    (add-hook 'erc-mode-hook #'erc-button-setup))
@@ -165,8 +166,17 @@ 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 expression which must eval to true for the button to
-  be added.
+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.
 
 CALLBACK is the function to call when the user push this button.
   CALLBACK can also be a symbol.  Its variable value will be used
@@ -176,7 +186,7 @@ erc-button-alist
   CALLBACK.  There can be several PAR arguments.  If REGEXP is
   `nicknames', these are ignored, and CALLBACK will be called with
   the nickname matched as the argument."
-  :package-version '(ERC . "5.5")
+  :package-version '(ERC . "5.6") ; FIXME sync on release
   :type '(repeat
           (list :tag "Button"
                 (choice :tag "Matches"
@@ -275,22 +285,79 @@ erc-button-add-buttons
                         (concat "\\<" (regexp-quote (car elem)) "\\>")
                         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)))
+
+(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))
+      (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 _ _ _)
+  "Return BOUNDS.\n\n(fn BOUNDS NICKNAME SERVER-USER CHANNEL-USER)"
+  bounds)
+
+;; This variable is intended to serve as a "core" to be wrapped by
+;; (built-in) modules during setup.  It's unclear whether
+;; `add-function's practice of removing existing advice before
+;; re-adding it is desirable when integrating modules since we're
+;; mostly concerned with ensuring one "piece" precedes or follows
+;; another (specific piece), which may not yet (or ever) be present.
+
+(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.  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.")
+
 (defun erc-button-add-nickname-buttons (entry)
   "Search through the buffer for nicknames, and add buttons."
   (let ((form (nth 2 entry))
         (fun (nth 3 entry))
         bounds word)
-    (when (or (eq t form)
-              (eval form t))
+    (when (eq form 'erc-button-buttonize-nicks)
+      (setq form (and (symbol-value form) erc-button--modify-nick-function)))
+    (when (or (functionp form)
+              (eq t form)
+              (and form (erc-button--maybe-warn-arbitrary-sexp form)))
       (goto-char (point-min))
       (while (erc-forward-word)
         (when (setq bounds (erc-bounds-of-word-at-point))
           (setq word (buffer-substring-no-properties
                       (car bounds) (cdr bounds)))
-          (when (or (and (erc-server-buffer-p) (erc-get-server-user word))
-                    (and erc-channel-users (erc-get-channel-user word)))
-            (erc-button-add-button (car bounds) (cdr bounds)
-                                   fun t (list word))))))))
+          (let* ((erc-button-face erc-button-face)
+                 (erc-button-mouse-face erc-button-mouse-face)
+                 (erc-button-nickname-face erc-button-nickname-face)
+                 (down (erc-downcase word))
+                 (cuser (and erc-channel-users
+                             (gethash down erc-channel-users)))
+                 (user (or (and cuser (car cuser))
+                           (and erc-server-users
+                                (gethash down erc-server-users)))))
+            (when (and user
+                       (or (not (functionp form))
+                           (setq bounds
+                                 (funcall form bounds down user (cdr cuser)))))
+              (erc-button-add-button (car bounds) (cdr bounds)
+                                     fun t (list word)))))))))
 
 (defun erc-button-add-buttons-1 (regexp entry)
   "Search through the buffer for matches to ENTRY and add buttons."
@@ -302,7 +369,14 @@ erc-button-add-buttons-1
           (fun (nth 3 entry))
           (data (mapcar #'match-string-no-properties (nthcdr 4 entry))))
       (when (or (eq t form)
-                (eval form t))
+                (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)))))
 
 (defun erc-button-remove-old-buttons ()
@@ -511,6 +585,61 @@ 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)
+  "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)))
+
+;;;###autoload
+(defun erc-button--display-error-notice-with-keys (&optional parsed buffer
+                                                             &rest strings)
+  "Add help keys to STRINGS for configuration-related admonishments.
+Return inserted result.  PARSED can be an `erc-response' object,
+a string, or nil.  BUFFER can be a buffer, a string, or nil.  As
+a special case, PARSED can also be a buffer as long as BUFFER is
+a string or nil."
+  (when (stringp buffer)
+    (push buffer strings)
+    (setq buffer nil))
+  (when (stringp parsed)
+    (push parsed strings)
+    (setq parsed nil))
+  (when (bufferp parsed)
+    (cl-assert (null buffer))
+    (setq buffer parsed
+          parsed nil))
+  (let* ((string (apply #'concat strings))
+         (erc-insert-post-hook
+          (cons (lambda ()
+                  (setq string (buffer-substring (point-min)
+                                                 (1- (point-max)))))
+                erc-insert-post-hook))
+         (erc-button-alist
+          `((,(rx "\\[" (group (+ (not "]"))) "]") 0
+             erc-button--substitute-command-keys-in-region
+             erc-button-describe-symbol 1)
+            ,@erc-button-alist)))
+    (erc-display-message parsed '(notice error) (or buffer 'active) string)
+    string))
+
+;;;###autoload
+(defun erc-button--display-error-notice-with-keys-and-warn (&rest args)
+  "Like `erc-button--display-error-notice-with-keys' but also warn."
+  (let ((string (apply #'erc-button--display-error-notice-with-keys args)))
+    (with-temp-buffer
+      (insert string)
+      (goto-char (point-min))
+      (with-syntax-table lisp-mode-syntax-table
+        (skip-syntax-forward "^-"))
+      (forward-char)
+      (display-warning
+       'erc (buffer-substring-no-properties (point) (point-max))))))
+
 (provide 'erc-button)
 
 ;;; erc-button.el ends here
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index 4337d633cfa..dd481032e7e 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -67,6 +67,9 @@ erc-session-server
 (declare-function erc-server-process-alive "erc-backend" (&optional buffer))
 (declare-function erc-set-active-buffer "erc" (buffer))
 
+(declare-function erc-button--display-error-notice-with-keys
+                  (parsed &rest strings))
+
 ;; Variables
 
 (defgroup erc-networks nil
@@ -1310,12 +1313,11 @@ erc-networks--ensure-announced
 Copy source (prefix) from MOTD-ish message as a last resort."
   ;; The 004 handler never ran; see 2004-03-10 Diane Murray in change log
   (unless erc-server-announced-name
-    (setq erc-server-announced-name (erc-response.sender parsed))
-    (erc-display-error-notice
-     parsed (concat "Failed to determine server name. Using \""
-                    erc-server-announced-name "\" instead."
-                    "  If this was unexpected, consider reporting it via "
-                    (substitute-command-keys "\\[erc-bug]") ".")))
+    (require 'erc-button)
+    (erc-button--display-error-notice-with-keys
+     parsed "Failed to determine server name.  Using \""
+     (setq erc-server-announced-name (erc-response.sender parsed)) "\" instead"
+     ".  If this was unexpected, consider reporting it via \\[erc-bug]" "."))
   nil)
 
 (defun erc-unset-network-name (_nick _ip _reason)
@@ -1493,9 +1495,9 @@ erc-networks-on-MOTD-end
                                       (memq (erc--target-symbol erc--target)
                                             erc-networks--bouncer-targets)))
                                proc)
-      (let ((m (concat "Unexpected state detected. Please report via "
-                       (substitute-command-keys "\\[erc-bug]") ".")))
-        (erc-display-error-notice parsed m))))
+      (require 'erc-button)
+      (erc-button--display-error-notice-with-keys
+       parsed "Unexpected state detected.  Please report via \\[erc-bug].")))
 
   ;; For now, retain compatibility with erc-server-NNN-functions.
   (or (erc-networks--ensure-announced proc parsed)
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index d6c63934163..05f0de6b195 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1370,4 +1370,60 @@ define-erc-module--local
                       (put 'erc-mname-enable 'definition-name 'mname)
                       (put 'erc-mname-disable 'definition-name 'mname))))))
 
+
+;; XXX move erc-button tests to new file if more added.
+(require 'erc-button)
+
+;; See also `erc-scenarios-networks-announced-missing' in
+;; erc-scenarios-misc.el for a more realistic example.
+(ert-deftest erc-button--display-error-notice-with-keys ()
+  (with-current-buffer (get-buffer-create "*fake*")
+    (let ((mode erc-button-mode)
+          (inhibit-message noninteractive)
+          erc-modules
+          erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+      (erc-mode)
+      (erc-tests--set-fake-server-process "sleep" "1")
+      (erc--initialize-markers (point) nil)
+      (erc-button-mode +1)
+      (should (equal (erc-button--display-error-notice-with-keys
+                      "If \\[erc-bol] fails, "
+                      "see \\[erc-bug] or `erc-mode-map'.")
+                     "*** If C-a fails, see M-x erc-bug or `erc-mode-map'."))
+      (goto-char (point-min))
+
+      (ert-info ("Keymap substitution succeeds")
+        (erc-button-next)
+        (should (looking-at "C-a"))
+        (should (eq (get-text-property (point) 'mouse-face) 'highlight))
+        (erc-button-press-button)
+        (with-current-buffer "*Help*"
+          (goto-char (point-min))
+          (should (search-forward "erc-bol" nil t)))
+        (erc-button-next)
+        (erc-button-previous) ; end of interval correct
+        (should (looking-at "a fails")))
+
+      (ert-info ("Extended command mapping succeeds")
+        (erc-button-next)
+        (should (looking-at "M-x erc-bug"))
+        (erc-button-press-button)
+        (should (eq (get-text-property (point) 'mouse-face) 'highlight))
+        (with-current-buffer "*Help*"
+          (goto-char (point-min))
+          (should (search-forward "erc-bug" nil t))))
+
+      (ert-info ("Symbol-description face preserved") ; mutated by d-e-n-w-k
+        (erc-button-next)
+        (should (equal (get-text-property (point) 'font-lock-face)
+                       '(erc-button erc-error-face)))
+        (should (eq (get-text-property (point) 'mouse-face) 'highlight))
+        (should (eq erc-button-face 'erc-button))) ; extent evaporates
+
+      (when noninteractive
+        (unless mode
+          (erc-button-mode -1))
+        (kill-buffer "*Help*")
+        (kill-buffer)))))
+
 ;;; erc-tests.el ends here
-- 
2.39.2
0003-5.6-Allow-erc-button-add-face-to-take-an-object.patch (text/x-patch, 3.4 KB)
From 28517cf23b5ed65f8a421dddcffec6a0aecd7fe5 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email protected]>
Date: Fri, 13 Jan 2023 05:13:06 -0800
Subject: [PATCH 3/3] [5.6] Allow erc-button-add-face to take an object

* lisp/erc/erc-button.el
(erc-button--add-nickname-face-function): New internal var.
(erc-button-add-button): Call `erc-button--add-nickname-face-function'
when it's a function for applying `erc-button-nickname-face'.
(erc-button-add-face): Add optional `object' param.  (Bug#60933.)
---
 lisp/erc/erc-button.el | 19 ++++++++++++-------
 1 file changed, 12 insertions(+), 7 deletions(-)

diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index eca3df44892..c94a412eea8 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -391,6 +391,8 @@ erc-button-remove-old-buttons
                   mouse-face nil
                   keymap nil)))
 
+(defvar erc-button--add-nickname-face-function nil)
+
 (defun erc-button-add-button (from to fun nick-p &optional data regexp)
   "Create a button between FROM and TO with callback FUN and data DATA.
 NICK-P specifies if this is a nickname button.
@@ -417,7 +419,10 @@ erc-button-add-button
           (move-marker pos (point))))))
   (if nick-p
       (when erc-button-nickname-face
-        (erc-button-add-face from to erc-button-nickname-face))
+        (if erc-button--add-nickname-face-function
+            (funcall erc-button--add-nickname-face-function
+                     from to erc-button-nickname-face)
+          (erc-button-add-face from to erc-button-nickname-face)))
     (when erc-button-face
       (erc-button-add-face from to erc-button-face)))
   (add-text-properties
@@ -429,16 +434,16 @@ erc-button-add-button
           (list 'rear-nonsticky t)
           (and data (list 'erc-data data)))))
 
-(defun erc-button-add-face (from to face)
+(defun erc-button-add-face (from to face &optional object)
   "Add FACE to the region between FROM and TO."
   ;; If we just use `add-text-property', then this will overwrite any
   ;; face text property already used for the button.  It will not be
   ;; merged correctly.  If we use overlays, then redisplay will be
   ;; very slow with lots of buttons.  This is why we manually merge
   ;; face text properties.
-  (let ((old (erc-list (get-text-property from 'font-lock-face)))
+  (let ((old (erc-list (get-text-property from 'font-lock-face object)))
         (pos from)
-        (end (next-single-property-change from 'font-lock-face nil to))
+        (end (next-single-property-change from 'font-lock-face object to))
         new)
     ;; old is the face at pos, in list form.  It is nil if there is no
     ;; face at pos.  If nil, the new face is FACE.  If not nil, the
@@ -446,10 +451,10 @@ erc-button-add-face
     ;; where this face changes.
     (while (< pos to)
       (setq new (if old (cons face old) face))
-      (put-text-property pos end 'font-lock-face new)
+      (put-text-property pos end 'font-lock-face new object)
       (setq pos end
-            old (erc-list (get-text-property pos 'font-lock-face))
-            end (next-single-property-change pos 'font-lock-face nil to)))))
+            old (erc-list (get-text-property pos 'font-lock-face object))
+            end (next-single-property-change pos 'font-lock-face object to)))))
 
 ;; widget-button-click calls with two args, we ignore the first.
 ;; Since Emacs runs this directly, rather than with
-- 
2.39.2
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.