Add erc-button helper for substituting command keys

* 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): Discourage 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.  Bump
package-version even though this doesn't introduce a visible change in
the default value.
(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--preserve-bounds): Add function to serve as default value
for `erc-button--modify-nick-function).
(erc-button--modify-nick-function): Add new variable to hold a
function that filters nickname bounds when buttonizing.
(erc-button--phantom-users, erc-button--add-phantom-speaker,
erc-button--phantom-users-mode): Add new internal minor mode for
treating unseen speakers of PRIVMSGs as known members of the server
for things like coloring nicks during buffer playback.
(erc-button--get-user-from-speaker-naive): Add temporary utility
function to scrape nick from speaker in narrowed buffer.  This will be
replaced by an account-aware version in next major ERC release.
(erc-button-add-nickname-buttons): Accommodate function variant for
"form" field of `erc-button-alist' entries.  Minor optimizations.
This function will likely become the primary juncture for applying
text properties that support nickname-related user-intelligence
features.
(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 helper function
for applying key substitutions in ERC warning messages.
(erc-button--display-error-notice-with-keys): Add new helper function
for displaying ad hoc warnings that possibly require key substitution.
(erc-button--display-error-notice-with-keys-and-warn): Add variant of
`erc-button--display-error-notice-with-keys' that also emits warnings.
* lisp/erc/erc-networks.el (erc-networks--ensure-announced,
erc-networks--on-MOTD-end): Use new key-substitutions helper from
erc-button.
* test/lisp/erc/erc-tests.el
(erc-button--display-error-notice-with-keys): New test.
* test/lisp/erc/resources/base/assoc/bouncer-history/foonet.eld: Add
unknown speaker in channel for phantom store to handle.  Currently
requires manual intervention to leverage.  (Bug#60933.)

4 files changed, 270 insertions, 20 deletions

diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 48f6a5d1794..33e69f3b0b8 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -52,7 +52,8 @@
 ;;;###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)
    (erc--modify-local-map t "<backtab>" #'erc-button-previous))
@@ -165,8 +166,17 @@ 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 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 @@ PAR is a number of a regexp grouping whose text will be passed to
   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"
@@ -277,22 +287,127 @@ specified by `erc-button-alist'."
                         (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 _ server-user _)
+  "Return BOUNDS.\n\n(fn BOUNDS NICKNAME SERVER-USER CHANNEL-USER)"
+  (and server-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.  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.")
+
+(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))
+    (_ args)))
+
+(define-minor-mode erc-button--phantom-users-mode
+  "Minor mode to recognize unknown speakers.
+Expect to be used by module setup code for creating placeholder
+users on the fly during history playback.  Treat an unknown
+PRIVMSG speaker, like <bob>, as if they were present in a 353 and
+are thus a member of the channel.  However, don't bother creating
+an actual `erc-channel-user' object because their status prefix
+is unknown.  Instead, just spoof an `erc-server-user' by applying
+early (outer), args-filtering advice wrapping
+`erc-button--modify-nick-function'."
+  :interactive nil
+  (if erc-button--phantom-users-mode
+      (progn
+        (add-function :filter-args (local 'erc-button--modify-nick-function)
+                      #'erc-button--add-phantom-speaker '((depth . -90)))
+        (setq erc-button--phantom-users (make-hash-table :test #'equal)))
+    (remove-function (local 'erc-button--modify-nick-function)
+                     #'erc-button--add-phantom-speaker)
+    (kill-local-variable 'erc-nicks--phantom-users)))
+
+;; FIXME replace this after making ERC account-aware.
+(defun erc-button--get-user-from-speaker-naive (point)
+  "Return `erc-server-user' object for nick at POINT."
+  (when-let*
+      (((eql ?< (char-before point)))
+       ((eq (get-text-property point 'font-lock-face) 'erc-nick-default-face))
+       (parsed (erc-get-parsed-vector point)))
+    (pcase-let* ((`(,nick ,login ,host)
+                  (erc-parse-user (erc-response.sender parsed))))
+      (make-erc-server-user
+       :nickname nick
+       :host (and (not (string-empty-p host)) host)
+       :login (and (not (string-empty-p login)) login)))))
+
 (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 (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."
@@ -304,7 +419,14 @@ specified by `erc-button-alist'."
           (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 ()
@@ -513,6 +635,70 @@ 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)
+  "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.  Expect PARSED to be an `erc-response'
+object, a string, or nil.  Expect BUFFER to be a buffer, a string,
+or nil.  As a special case, allow PARSED to be a buffer as long
+as BUFFER is a string or nil.  If STRINGS contains any trailing
+non-strings, concatenate leading string members before applying
+`format'.  Otherwise, just concatenate everything."
+  (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* ((op (if (seq-every-p #'stringp (cdr strings))
+                 #'concat
+               (let ((head (pop strings)))
+                 (while (stringp (car strings))
+                   (setq head (concat head (pop strings))))
+                 (push head strings))
+               #'format))
+         (string (apply op 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 @@
 (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 @@ shutting down the connection."
 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 @@ to be a false alarm.  If `erc-reuse-buffers' is nil, let
                                       (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 6e66de53edd..b155f85ab8a 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1790,4 +1790,65 @@ connection."
                       (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
+
+      (ert-info ("Format when trailing args include non-strings")
+        (should (equal (erc-button--display-error-notice-with-keys
+                        "abc" " %d def" " 45%s" 123 '\6)
+                       "*** abc 123 def 456")))
+
+      (when noninteractive
+        (unless mode
+          (erc-button-mode -1))
+        (kill-buffer "*Help*")
+        (kill-buffer)))))
+
 ;;; erc-tests.el ends here
diff --git a/test/lisp/erc/resources/base/assoc/bouncer-history/foonet.eld b/test/lisp/erc/resources/base/assoc/bouncer-history/foonet.eld
index 58df79e19fa..f34ae02f4e4 100644
--- a/test/lisp/erc/resources/base/assoc/bouncer-history/foonet.eld
+++ b/test/lisp/erc/resources/base/assoc/bouncer-history/foonet.eld
@@ -27,6 +27,7 @@
  (0 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #chan :[07:04:02] alice: Here come the lovers, full of joy and mirth.")
  (0 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #chan :[07:04:07] bob: According to the fool's bolt, sir, and such dulcet diseases.")
  (0 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #chan :[07:04:10] alice: And hang himself. I pray you, do my greeting.")
+ (0 ":someone!~u@abcdefg.irc PRIVMSG #chan :[07:04:10] hi everyone.")
  (0 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #chan :[07:04:18] bob: And you sat smiling at his cruel prey.")
  (0 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #chan :[07:04:21] alice: Or never after look me in the face.")
  (0 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #chan :[07:04:25] bob: If that may be, than all is well. Come, sit down, every mother's son, and rehearse your parts. Pyramus, you begin: when you have spoken your speech, enter into that brake; and so every one according to his cue.")