mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-01 08:17:38 +00:00
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>
This commit is contained in:
parent
7cbe6ae712
commit
2ed9c9f1b3
10
etc/ERC-NEWS
10
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.
|
||||
|
@ -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)
|
||||
|
||||
|
125
lisp/erc/erc.el
125
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
|
||||
|
117
test/lisp/erc/erc-scenarios-prompt-format.el
Normal file
117
test/lisp/erc/erc-scenarios-prompt-format.el
Normal file
@ -0,0 +1,117 @@
|
||||
;;; 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
|
Loading…
Reference in New Issue
Block a user