1
0
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:
F. Jason Park 2021-10-07 14:26:36 +02:00
parent 7cbe6ae712
commit 2ed9c9f1b3
4 changed files with 271 additions and 1 deletions

View File

@ -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.

View File

@ -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)

View File

@ -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

View 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