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

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

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

v3. Expand `erc-button-alist' pattern to recognize inline (info "...")
forms. Autoload button helpers (locally, in ERC's own loaddefs).


[-- Attachment #2: 0000-v2-v3.diff --]
[-- Type: text/x-patch, Size: 3269 bytes --]

From 28517cf23b5ed65f8a421dddcffec6a0aecd7fe5 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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


[-- Attachment #3: 0001-5.6-Replace-Info-goto-node-with-info-in-erc-button-a.patch --]
[-- Type: text/x-patch, Size: 2345 bytes --]

From f61bd6bb6129571327cdb9e68b38e8221b72d91e Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-5.6-Add-erc-button-helper-for-substituting-command-k.patch --]
[-- Type: text/x-patch, Size: 16850 bytes --]

From 5fb14bbc6535acfabcec5afe89613528e1b405b5 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-5.6-Allow-erc-button-add-face-to-take-an-object.patch --]
[-- Type: text/x-patch, Size: 3448 bytes --]

From 28517cf23b5ed65f8a421dddcffec6a0aecd7fe5 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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