Optionally allow substitution patterns in erc-prompt

* etc/ERC-NEWS: Add entry for `erc-prompt-format'.
* lisp/erc/erc-compat.el (erc-compat--defer-format-spec-in-buffer):
New macro to wrap `format-spec' specification values in functions that
run in the current buffer and fall back to the empty string.
* lisp/erc/erc.el (erc-prompt): Add predefined Custom choice for
function type in `erc-prompt-format'.
(erc--prompt-format-face-example): New "pre-propertized" value for
option `erc-prompt-format'.
(erc-prompt-format): New companion option for `erc-prompt' choice
`erc-prompt-format'.  New function of the same name to perform format
substitutions and serve as a Custom choice value for `erc-prompt'.
Based on work and ideas originally proposed by Stefan Kangas.
(erc--away-indicator, erc-away-status-indicator,
erc--format-away-indicator): New formatting function and helper
variables for displaying short away status.
(erc--user-modes-indicator): New variable.
(erc--format-user-modes): New function.
(erc--format-channel-status-prefix): New function.
(erc--format-modes): New function.
* test/lisp/erc/erc-scenarios-prompt-format.el: New file.  (Bug#51082)

Co-authored-by: Stefan Kangas <stefankangas@gmail.com>

2 files changed, 144 insertions, 1 deletions

diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 4c376cfbc22..e0f6e9b5134 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -459,6 +459,26 @@ If START or END is negative, it counts from the end."
       '(let (current-time-list) (current-time))
     '(current-time)))
 
+(defmacro erc-compat--defer-format-spec-in-buffer (&rest spec)
+  "Transform SPEC forms into functions that run in the current buffer.
+For convenience, ensure function wrappers return \"\" as a
+fallback."
+  (cl-check-type (car spec) cons)
+  (let ((buffer (make-symbol "buffer")))
+    `(let ((,buffer (current-buffer)))
+       ,(list '\`
+              (mapcar
+               (pcase-lambda (`(,k . ,v))
+                 (cons k
+                       (list '\,(if (>= emacs-major-version 29)
+                                    `(lambda ()
+                                       (or (if (eq ,buffer (current-buffer))
+                                               ,v
+                                             (with-current-buffer ,buffer
+                                               ,v))
+                                           ""))
+                                  `(or ,v "")))))
+               spec)))))
 
 (provide 'erc-compat)
 
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 8cd69d1431e..a2f4562d333 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -751,7 +751,74 @@ parameters are not included.")
 (defcustom erc-prompt "ERC>"
   "Prompt used by ERC.  Trailing whitespace is not required."
   :group 'erc-display
-  :type '(choice string function))
+  :type '(choice string
+                 (function-item :tag "Interpret format specifiers"
+                                erc-prompt-format)
+                 function))
+
+(defvar erc--prompt-format-face-example
+  #("%p%m%a\u00b7%b>"
+    0 2 (font-lock-face erc-my-nick-prefix-face)
+    2 4 (font-lock-face font-lock-keyword-face)
+    4 6 (font-lock-face erc-error-face)
+    6 7 (font-lock-face shadow)
+    7 9 (font-lock-face font-lock-constant-face)
+    9 10 (font-lock-face shadow))
+  "An example value for option `erc-prompt-format' with faces.")
+
+(defcustom erc-prompt-format erc--prompt-format-face-example
+  "Format string when `erc-prompt' is `erc-prompt-format'.
+ERC recognizes these substitution specifiers:
+
+ %a - away indicator
+ %b - buffer name
+ %t - channel or query target, server domain, or dialed address
+ %S - target@network or buffer name
+ %s - target@server or server
+ %N - current network, like Libera.Chat
+ %p - channel membership prefix, like @ or +
+ %n - current nickname
+ %c - channel modes with args for select modes
+ %C - channel modes with all args
+ %u - user modes
+ %m - channel modes sans args in channels, user modes elsewhere
+ %M - like %m but show nothing in query buffers
+
+To pick your own colors, do something like:
+
+  (setopt erc-prompt-format
+          (concat
+           (propertize \"%b\" \\='font-lock-face \\='erc-input-face)
+           (propertize \"%a\" \\='font-lock-face \\='erc-error-face)))
+
+Please remember that ERC ignores this option completely unless
+the \"parent\" option `erc-prompt' is set to `erc-prompt-format'."
+  :package-version '(ERC . "5.6")
+  :group 'erc-display
+  :type `(choice (const :tag "{Prefix}{Mode}{Away}{MIDDLE DOT}{Buffer}>"
+                        ,erc--prompt-format-face-example)
+                 string))
+
+(defun erc-prompt-format ()
+  "Make predefined `format-spec' substitutions.
+
+See option `erc-prompt-format' and option `erc-prompt'."
+  (format-spec erc-prompt-format
+               (erc-compat--defer-format-spec-in-buffer
+                (?C erc--channel-modes 3 ",")
+                (?M erc--format-modes 'no-query-p)
+                (?N erc-format-network)
+                (?S erc-format-target-and/or-network)
+                (?a erc--format-away-indicator)
+                (?b buffer-name)
+                (?c erc-format-channel-modes)
+                (?m erc--format-modes)
+                (?n erc-current-nick)
+                (?p erc--format-channel-status-prefix)
+                (?s erc-format-target-and/or-server)
+                (?t erc-format-target)
+                (?u erc--format-user-modes))
+               'ignore-missing)) ; formerly `only-present'
 
 (defun erc-prompt ()
   "Return the input prompt as a string.
@@ -8311,6 +8378,62 @@ shortened server name instead."
         (format-time-string erc-mode-line-away-status-format a)
       "")))
 
+(defvar-local erc--away-indicator nil
+  "Cons containing an away indicator for the connection.")
+
+(defvar erc-away-status-indicator "A"
+  "String shown by various formatting facilities to indicate away status.
+Currently only used by the option `erc-prompt-format'.")
+
+(defun erc--format-away-indicator ()
+  "Return char with `display' property of `erc--away-indicator'."
+  (and-let* ((indicator (erc-with-server-buffer
+                          (or erc--away-indicator
+                              (setq erc--away-indicator (list "")))))
+             (newcar (if (erc-away-time) erc-away-status-indicator "")))
+    ;; Inform other buffers of the change when necessary.
+    (let ((dispp (not erc--inhibit-prompt-display-property-p)))
+      (unless (eq newcar (car indicator))
+        (erc--refresh-prompt-continue (and dispp 'hooks-only-p))
+        (setcar indicator newcar))
+      (if dispp
+          (propertize "(away?)" 'display indicator)
+        newcar))))
+
+(defvar-local erc--user-modes-indicator nil
+  "Cons containing connection-wide indicator for user modes.")
+
+;; If adding more of these functions, should factor out commonalities.
+;; As of ERC 5.6, this is identical to the away variant aside from
+;; the var names and `eq', which isn't important.
+(defun erc--format-user-modes ()
+  "Return server's user modes as a string"
+  (and-let* ((indicator (erc-with-server-buffer
+                          (or erc--user-modes-indicator
+                              (setq erc--user-modes-indicator (list "")))))
+             (newcar (erc--user-modes 'string)))
+    (let ((dispp (not erc--inhibit-prompt-display-property-p)))
+      (unless (string= newcar (car indicator))
+        (erc--refresh-prompt-continue (and dispp 'hooks-only-p))
+        (setcar indicator newcar))
+      (if dispp
+          (propertize "(user-modes?)" 'display indicator)
+        newcar))))
+
+(defun erc--format-channel-status-prefix ()
+  "Return the current channel membership prefix."
+  (and (erc--target-channel-p erc--target)
+       (erc-get-user-mode-prefix (erc-current-nick))))
+
+(defun erc--format-modes (&optional no-query-p)
+  "Return a string of channel modes in channels and user modes elsewhere.
+With NO-QUERY-P, return nil instead of user modes in query
+buffers.  Also return nil when mode information is unavailable."
+  (cond ((erc--target-channel-p erc--target)
+         (erc--channel-modes 'string))
+        ((not (and erc--target no-query-p))
+         (erc--format-user-modes))))
+
 (defun erc-format-channel-modes ()
   "Return the current channel's modes."
   (concat (apply #'concat