* 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>
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.
'(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)
(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.
(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
--- /dev/null
+;;; erc-scenarios-prompt-format.el --- erc-prompt-format-mode -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert-x)
+(eval-and-compile
+ (let ((load-path (cons (ert-resource-directory) load-path)))
+ (require 'erc-scenarios-common)))
+
+(defvar erc-fill-wrap-align-prompt)
+(defvar erc-fill-wrap-use-pixels)
+
+(defun erc-scenarios-prompt-format--assert (needle &rest props)
+ (save-excursion
+ (goto-char erc-insert-marker)
+ (should (search-forward needle nil t))
+ (pcase-dolist (`(,k . ,v) props)
+ (should (equal (get-text-property (point) k) v)))))
+
+;; This makes assertions about the option `erc-fill-wrap-align-prompt'
+;; as well as the standard value of `erc-prompt-format'. One minor
+;; omission is that this doesn't check behavior in query buffers.
+(ert-deftest erc-scenarios-prompt-format ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/modes")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'chan-changed))
+ (erc-modules (cons 'fill-wrap erc-modules))
+ (erc-fill-wrap-align-prompt t)
+ (erc-fill-wrap-use-pixels nil)
+ (erc-prompt #'erc-prompt-format)
+ (erc-autojoin-channels-alist '((Libera.Chat "#chan")))
+ (expect (erc-d-t-make-expecter))
+ ;; Collect samples of `line-prefix' to verify deltas as the
+ ;; prompt grows and shrinks.
+ (line-prefixes nil)
+ (stash-pfx (lambda ()
+ (pcase (get-text-property erc-insert-marker 'line-prefix)
+ (`(space :width (- erc-fill--wrap-value ,n))
+ (car (push n line-prefixes)))))))
+
+ (ert-info ("Connect to Libera.Chat")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port (process-contact dumb-server :service)
+ :nick "tester"
+ :full-name "tester")
+ (funcall expect 5 "Welcome to the Libera.Chat")
+ (funcall stash-pfx)
+ (funcall expect 5 "changed mode")
+ ;; New prompt is shorter than default with placeholders, like
+ ;; "(foo?)(bar?)" (assuming we win the inherent race).
+ (should (>= (car line-prefixes) (funcall stash-pfx)))
+ (erc-scenarios-prompt-format--assert "user-" '(display . ("Ziw")))))
+
+ (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
+ (should-not erc-channel-key)
+ (should-not erc-channel-user-limit)
+
+ (ert-info ("Receive notice that mode has changed")
+ (erc-d-t-wait-for 10 (equal erc-channel-modes '("n" "t")))
+ (funcall stash-pfx)
+ (erc-scenarios-common-say "ready before")
+ (funcall expect 10 " has changed mode for #chan to +Qu")
+ (erc-d-t-wait-for 10 (equal erc-channel-modes '("Q" "n" "t" "u")))
+ ;; Prompt is longer now, so too is the `line-prefix' subtrahend.
+ (should (< (car line-prefixes) (funcall stash-pfx)))
+ (erc-scenarios-prompt-format--assert "Qntu")
+ (erc-scenarios-prompt-format--assert "#chan>"))
+
+ (ert-info ("Key stored locally")
+ (erc-scenarios-common-say "ready key")
+ (funcall expect 10 " has changed mode for #chan to +k hunter2")
+ ;; Prompt has grown by 1.
+ (should (< (car line-prefixes) (funcall stash-pfx)))
+ (erc-scenarios-prompt-format--assert "Qkntu"))
+
+ (ert-info ("Limit stored locally")
+ (erc-scenarios-common-say "ready limit")
+ (funcall expect 10 " has changed mode for #chan to +l 3")
+ (erc-d-t-wait-for 10 (eql erc-channel-user-limit 3))
+ (should (equal erc-channel-modes '("Q" "n" "t" "u")))
+ ;; Prompt has grown by 1 again.
+ (should (< (car line-prefixes) (funcall stash-pfx)))
+ (erc-scenarios-prompt-format--assert "Qklntu"))
+
+ (ert-info ("Modes removed and local state deletion succeeds")
+ (erc-scenarios-common-say "ready drop")
+ (funcall expect 10 " has changed mode for #chan to -lu")
+ (funcall expect 10 " has changed mode for #chan to -Qk *")
+ (erc-d-t-wait-for 10 (equal erc-channel-modes '("n" "t")))
+ ;; Prompt has shrunk.
+ (should (> (car line-prefixes) (funcall stash-pfx)))
+ (erc-scenarios-prompt-format--assert "nt"))
+
+ (should-not erc-channel-key)
+ (should-not erc-channel-user-limit)
+ (funcall expect 10 "<Chad> after"))))
+
+;;; erc-scenarios-prompt-format.el ends here
projects / emacs.git / commitdiff