From cb28b38e96b873f210b128065901578aad69f4f5 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 7 Oct 2021 14:26:36 +0200 Subject: [PATCH 4/4] [5.6] Optionally allow substitution patterns in erc-prompt * etc/ERC-NEWS: Add entry for `erc-prompt-format'. * lisp/erc/erc-compat.el (erc-compat--format-spec-function-values-in-current-buffer): New convenience macro to wrap prompt-format substitutions in functions that remember the current buffer. * lisp/erc/erc.el (erc-prompt): Add predefined choice for function `erc-prompt-format'. (erc-prompt-format-face-example): New example 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'. (erc--away-indicator, erc-away-status-indicator, erc--format-away-indicator): New formatting function for away status and helper variables. (erc--user-modes-indicator): New variable. (erc--format-user-modes): New function. (erc--format-channel-status-prefix): New function. (Bug#51082) Co-authored-by: F. Jason Park --- etc/ERC-NEWS | 10 ++++ lisp/erc/erc-compat.el | 24 +++++++++ lisp/erc/erc.el | 118 ++++++++++++++++++++++++++++++++++++++++- 3 files changed, 151 insertions(+), 1 deletion(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 3bb9a30cfb2..04e9e99a0fd 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -191,6 +191,16 @@ been restored with a slightly revised role contingent on a few assumptions explained in its doc string. For clarity, it has been renamed 'erc-ensure-target-buffer-on-privmsg'. +** A smarter, more responsive prompt. +ERC's prompt can be told to respond dynamically to incoming and +outgoing messages by leveraging the familiar function variant of the +option 'erc-prompt'. With this release, only predefined functions can +take full advantage of this new dynamism, but an interface to empower +third-parties with the same possibilities may follow suit. To get +started, customize 'erc-prompt' to 'erc-prompt-format', and see the +option of the same name ('erc-prompt-format') for a rudimentary +templating facility reminiscent of 'erc-mode-line-format'. + ** Module 'scrolltobottom' now optionally more aggressive. Enabling the experimental option 'erc-scrolltobottom-all' makes ERC more vigilant about staking down the input area in all ERC windows. diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 4c376cfbc22..fe1fc328c7d 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -459,6 +459,30 @@ erc-compat--current-lisp-time '(let (current-time-list) (current-time)) '(current-time))) +(defmacro erc-compat--format-spec-function-values-in-current-buffer + (format specification &rest rest) + "Call `format-spec' with SPECIFICATION function values in current buffer. +For simplicity, expect the SPECIFICATION alist (1) to only have +function values and (2) to be quoted, so the entire form looks +like a normal `format-spec' function call, with FORMAT and REST +being passed along unmolested. For convenience, ensure functions +return \"\" as a fallback and that each runs in the current +buffer when deferred for lazy invocation on Emacs 29 and greater." + (cl-check-type (car specification) symbol) + (cl-check-type (cadr specification) cons) + (cl-check-type (nth 2 specification) null) + (let* ((buffer (make-symbol "buffer")) + (specs (mapcar (pcase-lambda (`(,k . ,v)) + (cons k (list '\, (if (>= emacs-major-version 29) + `(lambda () + (with-current-buffer ,buffer + (or (,v) ""))) + `(or (,v) ""))))) + (cadr specification)))) + `(format-spec ,format + (let ((,buffer (current-buffer))) + ,(list '\` specs)) + ,@rest))) (provide 'erc-compat) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 0fbf6976d45..64179cd3408 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -751,7 +751,76 @@ erc-string-no-properties (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%u%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 "%p[%b]%a" + "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 + %T - 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 traditional + %u - user modes + +To pick your own colors, do something like: + + (setopt erc-prompt-format + (concat + (propertize \"%p\" \\='font-lock-face \\='erc-notice-face) + (propertize \"%b\" \\='font-lock-face \\='erc-input-face) + (propertize \"%a\" \\='font-lock-face \\='erc-error-face))) + +For a quick preview of this effect, try setting this option to +`erc-prompt-format-face-example' and loading a theme that sets +`erc-prompt-face' to a light or unspecified background. Lastly, +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[buffer]away" "%p[%b]%a") + (variable-item :tag "Example with varied faces" + erc-prompt-format-face-example) + string)) + +(defun erc-prompt-format () + "Make predefined `format-spec' substitutions. + +See option `erc-prompt-format' and option `erc-prompt'." + (erc-compat--format-spec-function-values-in-current-buffer + (if (and (symbolp erc-prompt-format) + (special-variable-p erc-prompt-format)) + (symbol-value erc-prompt-format) + erc-prompt-format) + '((?N . erc-format-network) + (?T . erc-format-target-and/or-network) + (?a . erc--format-away-indicator) + (?b . buffer-name) + (?c . erc-format-channel-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. @@ -8245,6 +8314,53 @@ erc-format-away-status (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-channel-modes () "Return the current channel's modes." (concat (apply #'concat -- 2.41.0