* bug#51082: [PATCH] erc-prompt: support substitution patterns "%target" and "%network"
[not found] ` <875y1wi0q2.fsf@neverwas.me>
2023-11-20 21:22 ` J.P.
@ 2023-11-22 19:25 ` J.P.
[not found] ` <87pm01d1yy.fsf@neverwas.me>
2 siblings, 0 replies; 9+ messages in thread
From: J.P. @ 2023-11-22 19:25 UTC (permalink / raw)
To: 51082; +Cc: Amin Bandali, Lars Ingebrigtsen, emacs-erc, Stefan Kangas
[-- Attachment #1: Type: text/plain, Size: 418 bytes --]
v2. Simplify `format-spec' helper. Demote `erc-fill-wrap-use-pixels' to
normal variable. Simplify option `erc-prompt-format' and make example
value default. Add substitution for showing channel or user mode based
on context. Add tests.
(Also, make myself primary author of last patch to spare others from
unwanted attribution.) Note that a patch from bug#67220 is also now
included because it's become a dependency.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v1-v2.diff --]
[-- Type: text/x-patch, Size: 24057 bytes --]
From 8a2b414e30ba6325e9d716b5d7b09db31b6cad75 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 22 Nov 2023 06:53:45 -0800
Subject: [PATCH 0/5] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (5):
[5.6] Don't associate type D channel modes with args in ERC
[5.6] Don't inherit properties when refreshing ERC's prompt
[5.6] Use overlay instead of text prop to hide ERC's prompt
[5.6] Optionally align prompt to prefix in erc-fill-wrap
[5.6] Optionally allow substitution patterns in erc-prompt
etc/ERC-NEWS | 10 +
lisp/erc/erc-backend.el | 21 +-
lisp/erc/erc-compat.el | 20 ++
lisp/erc/erc-fill.el | 47 +++-
lisp/erc/erc-stamp.el | 38 ++-
lisp/erc/erc.el | 279 ++++++++++++++++---
test/lisp/erc/erc-scenarios-prompt-format.el | 117 ++++++++
test/lisp/erc/erc-tests.el | 94 +++++--
8 files changed, 542 insertions(+), 84 deletions(-)
create mode 100644 test/lisp/erc/erc-scenarios-prompt-format.el
Interdiff:
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 04e9e99a0fd..9b3e62120fe 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -196,7 +196,7 @@ 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
+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'.
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index fe1fc328c7d..e0f6e9b5134 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -459,30 +459,26 @@ 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)))
+(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-fill.el b/lisp/erc/erc-fill.el
index adbe1c4e5f2..50b5aefd27a 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -228,13 +228,11 @@ erc-fill-variable
(defvar-local erc-fill--wrap-value nil)
(defvar-local erc-fill--wrap-visual-keys nil)
-(defcustom erc-fill-wrap-use-pixels t
+(defvar erc-fill-wrap-use-pixels t
"Whether to calculate padding in pixels when possible.
A value of nil means ERC should use columns, which may happen
regardless, depending on the Emacs version. This option only
-matters when `erc-fill-wrap-mode' is enabled."
- :package-version '(ERC . "5.6")
- :type 'boolean)
+matters when `erc-fill-wrap-mode' is enabled.")
(defcustom erc-fill-wrap-visual-keys 'non-input
"Whether to retain keys defined by `visual-line-mode'.
@@ -534,14 +532,16 @@ erc-fill--wrap-measure
Expect the target region to be free of `line-prefix' and
`wrap-prefix' properties, and expect `display-line-numbers-mode'
to be disabled."
- (if (and erc-fill-wrap-use-pixels (fboundp 'buffer-text-pixel-size))
+ (if (fboundp 'buffer-text-pixel-size)
;; `buffer-text-pixel-size' can move point!
(save-excursion
(save-restriction
(narrow-to-region beg end)
(let* ((buffer-invisibility-spec)
(rv (car (buffer-text-pixel-size))))
- (if (zerop rv) 0 (list rv)))))
+ (if erc-fill-wrap-use-pixels
+ (if (zerop rv) 0 (list rv))
+ (/ rv (frame-char-width))))))
(- end beg)))
;; An escape hatch for third-party code expecting speakers of ACTION
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 64179cd3408..780ae343d95 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -756,8 +756,8 @@ erc-prompt
erc-prompt-format)
function))
-(defvar erc-prompt-format-face-example
- #("%p%u%a\u00b7%b>"
+(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)
@@ -766,61 +766,59 @@ erc-prompt-format-face-example
9 10 (font-lock-face shadow))
"An example value for option `erc-prompt-format' with faces.")
-(defcustom erc-prompt-format "%p[%b]%a"
+(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
- %T - target@network or buffer name
+ %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 traditional
+ %c - channel modes, including parameters for select modes
+ %C - channel modes, including all parameters
%u - user modes
+ %m - channel modes in channel buffers and user modes elsewhere
+ %M - channel modes in channels and user modes in server buffers
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
+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)
+ :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'."
- (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'
+ (format-spec erc-prompt-format
+ (erc-compat--defer-format-spec-in-buffer
+ (?C erc--channel-modes 4)
+ (?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.
@@ -6800,7 +6798,8 @@ erc--process-channel-modes
(erc--update-membership-prefix (pop args) c (if +p 'on 'off)))
((and-let* ((group (or (aref table c) (and fallbackp ?d))))
(erc--handle-channel-mode group c +p
- (and (or (/= group ?c) +p)
+ (and (/= group ?d)
+ (or (/= group ?c) +p)
(pop args)))
t))
((not fallbackp)
@@ -6817,16 +6816,52 @@ erc--user-modes
"Return user \"MODE\" letters in a form described by AS-TYPE.
When AS-TYPE is the symbol `strings' (plural), return a list of
strings. When it's `string' (singular), return the same list
-concatenated into a single string. When it's a single char, like
-?+, return the same value as `string' but with AS-TYPE prepended.
-When AS-TYPE is nil, return a list of chars."
+concatenated into a single string. When AS-TYPE is nil, return a
+list of chars."
(let ((modes (or erc--user-modes (erc-with-server-buffer erc--user-modes))))
(pcase as-type
('strings (mapcar #'char-to-string modes))
('string (apply #'string modes))
- ((and (pred characterp) c) (apply #'string (cons c modes)))
(_ modes))))
+(defun erc--channel-modes (&optional as-type sep)
+ "Return channel \"MODE\" settings in a form described by AS-TYPE.
+When AS-TYPE is the symbol `strings' (plural), return letter keys
+as a list of sorted string. When it's `string' (singular),
+return keys as a single string. When it's a number N, return a
+single string consisting of the concatenated and sorted keys
+followed by a space and then their corresponding args, each
+truncated to N chars max. ERC joins these args together with
+SEP, which defaults to a single space. Otherwise, return a
+sorted alist of letter and arg pairs. In all cases that include
+values, respect `erc-show-channel-key-p' and optionally omit the
+secret key associated with the letter k."
+ (and-let* ((modes erc--channel-modes)
+ (types (erc--channel-mode-types-table (erc--channel-mode-types))))
+ (let (out)
+ (maphash (lambda (k v)
+ (unless (eq ?a (aref types k))
+ (push (cons k
+ (and (not (eq t v))
+ (not (and (eq k ?k)
+ (not (bound-and-true-p
+ erc-show-channel-key-p))))
+ v))
+ out)))
+ modes)
+ (setq out (cl-sort out #'< :key #'car))
+ (pcase as-type
+ ('strings (mapcar (lambda (o) (char-to-string (car o))) out))
+ ('string (apply #'string (mapcar #'car out)))
+ ((and (pred natnump) c)
+ (let (keys vals)
+ (pcase-dolist (`(,k . ,v) out)
+ (when v (push (truncate-string-to-width v c 0 nil t) vals))
+ (push k keys))
+ (concat (apply #'string (nreverse keys)) (and vals " ")
+ (string-join (nreverse vals) (or sep " ")))))
+ (_ out)))))
+
(defun erc--parse-user-modes (string &optional current extrap)
"Return lists of chars from STRING to add to and drop from CURRENT.
Expect STRING to be a so-called \"modestring\", the second
@@ -6905,14 +6940,24 @@ erc--handle-channel-mode
(erc-log (format "Channel-mode %c (type %s, arg %S) %s"
letter type arg (if state 'enabled 'disabled))))
-(cl-defmethod erc--handle-channel-mode :before (_ c state arg)
- "Record STATE change and ARG, if enabling, for mode letter C."
+(cl-defmethod erc--handle-channel-mode :before (type c state arg)
+ "Record STATE change for mode letter C.
+When STATE is non-nil, add or update C's mapping in
+`erc--channel-modes', associating it with ARG if C takes a
+parameter and t otherwise. When STATE is nil, forget the
+mapping. For type A, add up update a permanent mapping for C,
+associating it with an integer indicating a running total of
+STATE changes since joining the channel. In most cases, this
+won't match the number known to the server."
(unless erc--channel-modes
(cl-assert (erc--target-channel-p erc--target))
(setq erc--channel-modes (make-hash-table)))
- (if state
- (puthash c (or arg t) erc--channel-modes)
- (remhash c erc--channel-modes)))
+ (if (= type ?a)
+ (cl-callf (lambda (s) (+ (or s 0) (if state +1 -1)))
+ (gethash c erc--channel-modes))
+ (if state
+ (puthash c (or arg t) erc--channel-modes)
+ (remhash c erc--channel-modes))))
(cl-defmethod erc--handle-channel-mode :before ((_ (eql ?d)) c state _)
"Update `erc-channel-modes' for any character C of nullary type D.
@@ -8361,6 +8406,15 @@ erc--format-channel-status-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
diff --git a/test/lisp/erc/erc-scenarios-prompt-format.el b/test/lisp/erc/erc-scenarios-prompt-format.el
new file mode 100644
index 00000000000..7eccb859dbc
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-prompt-format.el
@@ -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
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 2782460eec8..06485bafabc 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -796,13 +796,42 @@ erc--update-channel-modes
(erc--update-channel-modes "+qu" "fool!*@*")
(should (equal (pop calls) '(?d ?u t nil)))
(should (equal (pop calls) '(?a ?q t "fool!*@*")))
- (should (equal "fool!*@*" (gethash ?q erc--channel-modes)))
+ (should (equal 1 (gethash ?q erc--channel-modes)))
(should (eq t (gethash ?u erc--channel-modes)))
(should (equal erc-channel-modes '("u")))
- (should-not (erc-channel-user-owner-p "bob")))
+ (should-not (erc-channel-user-owner-p "bob"))
+
+ ;; Remove fool!*@* from list mode "q".
+ (erc--update-channel-modes "-uq" "fool!*@*")
+ (should (equal (pop calls) '(?a ?q nil "fool!*@*")))
+ (should (equal (pop calls) '(?d ?u nil nil)))
+ (should-not (gethash ?u erc--channel-modes))
+ (should-not erc-channel-modes)
+ (should (equal 0 (gethash ?q erc--channel-modes))))
(should-not calls))))
+(ert-deftest erc--channel-modes ()
+ (setq erc--isupport-params (make-hash-table)
+ erc--target (erc--target-from-string "#test")
+ erc-server-parameters
+ '(("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz")))
+
+ (erc-tests--set-fake-server-process "sleep" "1")
+
+ (cl-letf (((symbol-function 'erc-update-mode-line) #'ignore))
+ (erc--update-channel-modes "+bltk" "fool!*@*" "3" "h2"))
+
+ (should (equal (erc--channel-modes 'string) "klt"))
+ (should (equal (erc--channel-modes 'strings) '("k" "l" "t")))
+ (should (equal (erc--channel-modes) '((?k . "h2") (?l . "3") (?t))))
+ (should (equal (erc--channel-modes 3 ",") "klt h2,3"))
+ (should (equal (erc--channel-modes 1 ",") "klt h,3"))
+ (should (equal (erc--channel-modes 0 ",") "klt ,"))
+ (should (equal (erc--channel-modes 2) "klt h2 3"))
+ (should (equal (erc--channel-modes 1) "klt h 3"))
+ (should (equal (erc--channel-modes 0) "klt "))) ; 2 spaces
+
(ert-deftest erc--update-user-modes ()
(let ((erc--user-modes (list ?a)))
(should (equal (erc--update-user-modes "+a") '(?a)))
@@ -818,8 +847,7 @@ erc--user-modes
(let ((erc--user-modes '(?a ?b)))
(should (equal (erc--user-modes) '(?a ?b)))
(should (equal (erc--user-modes 'string) "ab"))
- (should (equal (erc--user-modes 'strings) '("a" "b")))
- (should (equal (erc--user-modes '?+) "+ab"))))
+ (should (equal (erc--user-modes 'strings) '("a" "b")))))
(ert-deftest erc--parse-user-modes ()
(should (equal (erc--parse-user-modes "a" '(?a)) '(() ())))
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-5.6-Don-t-associate-type-D-channel-modes-with-args-i.patch --]
[-- Type: text/x-patch, Size: 8884 bytes --]
From 2700d2f873d2fa782d6fea4f2a3fa4853680e558 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 20 Nov 2023 19:45:30 -0800
Subject: [PATCH 1/5] [5.6] Don't associate type D channel modes with args in
ERC
* lisp/erc/erc.el (erc--process-channel-modes): Don't associate args
with group 4/D, which are all nullary modes.
(erc--user-modes): Simplify slightly by removing likely useless
variant for overloaded arg AS-TYPE. This function is new in ERC 5.6.
(erc--channel-modes): New function. A higher-level getter for
current channel mode representation to complement `erc--user-modes'.
(erc--handle-channel-mode): Change model to associate modes of type A
with a running plus/minus tally of state changes since joining the
channel.
* test/lisp/erc/erc-tests.el (erc--update-channel-modes): Update to
reflect new running tally associations for type A modes.
(erc--channel-modes): New test.
(erc--user-modes): Update to reflect parameter simplification.
(Bug#67220)
---
lisp/erc/erc.el | 67 ++++++++++++++++++++++++++++++++------
test/lisp/erc/erc-tests.el | 36 +++++++++++++++++---
2 files changed, 89 insertions(+), 14 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index f4c3f77593c..0e2e9d543bd 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -6686,7 +6686,8 @@ erc--process-channel-modes
(erc--update-membership-prefix (pop args) c (if +p 'on 'off)))
((and-let* ((group (or (aref table c) (and fallbackp ?d))))
(erc--handle-channel-mode group c +p
- (and (or (/= group ?c) +p)
+ (and (/= group ?d)
+ (or (/= group ?c) +p)
(pop args)))
t))
((not fallbackp)
@@ -6703,16 +6704,52 @@ erc--user-modes
"Return user \"MODE\" letters in a form described by AS-TYPE.
When AS-TYPE is the symbol `strings' (plural), return a list of
strings. When it's `string' (singular), return the same list
-concatenated into a single string. When it's a single char, like
-?+, return the same value as `string' but with AS-TYPE prepended.
-When AS-TYPE is nil, return a list of chars."
+concatenated into a single string. When AS-TYPE is nil, return a
+list of chars."
(let ((modes (or erc--user-modes (erc-with-server-buffer erc--user-modes))))
(pcase as-type
('strings (mapcar #'char-to-string modes))
('string (apply #'string modes))
- ((and (pred characterp) c) (apply #'string (cons c modes)))
(_ modes))))
+(defun erc--channel-modes (&optional as-type sep)
+ "Return channel \"MODE\" settings in a form described by AS-TYPE.
+When AS-TYPE is the symbol `strings' (plural), return letter keys
+as a list of sorted string. When it's `string' (singular),
+return keys as a single string. When it's a number N, return a
+single string consisting of the concatenated and sorted keys
+followed by a space and then their corresponding args, each
+truncated to N chars max. ERC joins these args together with
+SEP, which defaults to a single space. Otherwise, return a
+sorted alist of letter and arg pairs. In all cases that include
+values, respect `erc-show-channel-key-p' and optionally omit the
+secret key associated with the letter k."
+ (and-let* ((modes erc--channel-modes)
+ (types (erc--channel-mode-types-table (erc--channel-mode-types))))
+ (let (out)
+ (maphash (lambda (k v)
+ (unless (eq ?a (aref types k))
+ (push (cons k
+ (and (not (eq t v))
+ (not (and (eq k ?k)
+ (not (bound-and-true-p
+ erc-show-channel-key-p))))
+ v))
+ out)))
+ modes)
+ (setq out (cl-sort out #'< :key #'car))
+ (pcase as-type
+ ('strings (mapcar (lambda (o) (char-to-string (car o))) out))
+ ('string (apply #'string (mapcar #'car out)))
+ ((and (pred natnump) c)
+ (let (keys vals)
+ (pcase-dolist (`(,k . ,v) out)
+ (when v (push (truncate-string-to-width v c 0 nil t) vals))
+ (push k keys))
+ (concat (apply #'string (nreverse keys)) (and vals " ")
+ (string-join (nreverse vals) (or sep " ")))))
+ (_ out)))))
+
(defun erc--parse-user-modes (string &optional current extrap)
"Return lists of chars from STRING to add to and drop from CURRENT.
Expect STRING to be a so-called \"modestring\", the second
@@ -6791,14 +6828,24 @@ erc--handle-channel-mode
(erc-log (format "Channel-mode %c (type %s, arg %S) %s"
letter type arg (if state 'enabled 'disabled))))
-(cl-defmethod erc--handle-channel-mode :before (_ c state arg)
- "Record STATE change and ARG, if enabling, for mode letter C."
+(cl-defmethod erc--handle-channel-mode :before (type c state arg)
+ "Record STATE change for mode letter C.
+When STATE is non-nil, add or update C's mapping in
+`erc--channel-modes', associating it with ARG if C takes a
+parameter and t otherwise. When STATE is nil, forget the
+mapping. For type A, add up update a permanent mapping for C,
+associating it with an integer indicating a running total of
+STATE changes since joining the channel. In most cases, this
+won't match the number known to the server."
(unless erc--channel-modes
(cl-assert (erc--target-channel-p erc--target))
(setq erc--channel-modes (make-hash-table)))
- (if state
- (puthash c (or arg t) erc--channel-modes)
- (remhash c erc--channel-modes)))
+ (if (= type ?a)
+ (cl-callf (lambda (s) (+ (or s 0) (if state +1 -1)))
+ (gethash c erc--channel-modes))
+ (if state
+ (puthash c (or arg t) erc--channel-modes)
+ (remhash c erc--channel-modes))))
(cl-defmethod erc--handle-channel-mode :before ((_ (eql ?d)) c state _)
"Update `erc-channel-modes' for any character C of nullary type D.
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 8dbe44ce5ed..0c03a12864a 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -796,13 +796,42 @@ erc--update-channel-modes
(erc--update-channel-modes "+qu" "fool!*@*")
(should (equal (pop calls) '(?d ?u t nil)))
(should (equal (pop calls) '(?a ?q t "fool!*@*")))
- (should (equal "fool!*@*" (gethash ?q erc--channel-modes)))
+ (should (equal 1 (gethash ?q erc--channel-modes)))
(should (eq t (gethash ?u erc--channel-modes)))
(should (equal erc-channel-modes '("u")))
- (should-not (erc-channel-user-owner-p "bob")))
+ (should-not (erc-channel-user-owner-p "bob"))
+
+ ;; Remove fool!*@* from list mode "q".
+ (erc--update-channel-modes "-uq" "fool!*@*")
+ (should (equal (pop calls) '(?a ?q nil "fool!*@*")))
+ (should (equal (pop calls) '(?d ?u nil nil)))
+ (should-not (gethash ?u erc--channel-modes))
+ (should-not erc-channel-modes)
+ (should (equal 0 (gethash ?q erc--channel-modes))))
(should-not calls))))
+(ert-deftest erc--channel-modes ()
+ (setq erc--isupport-params (make-hash-table)
+ erc--target (erc--target-from-string "#test")
+ erc-server-parameters
+ '(("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz")))
+
+ (erc-tests--set-fake-server-process "sleep" "1")
+
+ (cl-letf (((symbol-function 'erc-update-mode-line) #'ignore))
+ (erc--update-channel-modes "+bltk" "fool!*@*" "3" "h2"))
+
+ (should (equal (erc--channel-modes 'string) "klt"))
+ (should (equal (erc--channel-modes 'strings) '("k" "l" "t")))
+ (should (equal (erc--channel-modes) '((?k . "h2") (?l . "3") (?t))))
+ (should (equal (erc--channel-modes 3 ",") "klt h2,3"))
+ (should (equal (erc--channel-modes 1 ",") "klt h,3"))
+ (should (equal (erc--channel-modes 0 ",") "klt ,"))
+ (should (equal (erc--channel-modes 2) "klt h2 3"))
+ (should (equal (erc--channel-modes 1) "klt h 3"))
+ (should (equal (erc--channel-modes 0) "klt "))) ; 2 spaces
+
(ert-deftest erc--update-user-modes ()
(let ((erc--user-modes (list ?a)))
(should (equal (erc--update-user-modes "+a") '(?a)))
@@ -818,8 +847,7 @@ erc--user-modes
(let ((erc--user-modes '(?a ?b)))
(should (equal (erc--user-modes) '(?a ?b)))
(should (equal (erc--user-modes 'string) "ab"))
- (should (equal (erc--user-modes 'strings) '("a" "b")))
- (should (equal (erc--user-modes '?+) "+ab"))))
+ (should (equal (erc--user-modes 'strings) '("a" "b")))))
(ert-deftest erc--parse-user-modes ()
(should (equal (erc--parse-user-modes "a" '(?a)) '(() ())))
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-5.6-Don-t-inherit-properties-when-refreshing-ERC-s-p.patch --]
[-- Type: text/x-patch, Size: 8368 bytes --]
From fc9dac78c91a13f87b996dcc3857d4544e473bee Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sat, 18 Nov 2023 23:04:50 -0800
Subject: [PATCH 2/5] [5.6] Don't inherit properties when refreshing ERC's
prompt
* lisp/erc/erc.el (erc--merge-prop-behind-p): New variable to be
dynamically bound around rare calls to `erc--merge-props' when the
latter should append to existing list-valued text properties instead
of push.
(erc--inhibit-prompt-display-property-p): New variable to be non-nil
in buffers where an active module needs to reserve all uses of the
`display' text property in the prompt region for itself.
(erc--prompt-properties): Collect all common prompt properties in one
place for code reuse and maintenance purposes.
(erc--refresh-prompt-continue, erc--refresh-prompt-continue-request):
New function and state variable for custom `erc-prompt' functions to
indicate to ERC that they need the prompt to be refreshed in all
buffers and not just the current one.
(erc--refresh-prompt): Merge `font-lock-face' to support legacy code
that uses `font-lock-face' to detect the prompt. Crucially, don't
inherit properties at the beginning of the prompt because doing so may
clobber any added by a custom `erc-prompt' function. Instead, apply
known properties from `erc-display-prompt' manually. Integrate
`erc--refresh-prompt-continue' logic.
(erc--merge-prop): Recognize flag to activate `append' behavior in
which new prop values are appended to lists of existing ones rather
than consed in front. This functionality could be extended to
arbitrary splices as well.
(erc-display-prompt): Use common text properties defined elsewhere.
* test/lisp/erc/erc-tests.el (erc--merge-prop): Add assertion for
`erc--merge-prop-behind-p' non-nil behavior. (Bug#51082)
---
lisp/erc/erc.el | 87 +++++++++++++++++++++++++++++---------
test/lisp/erc/erc-tests.el | 12 ++++++
2 files changed, 78 insertions(+), 21 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 0e2e9d543bd..aefa9e0fc3f 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2993,23 +2993,70 @@ erc--assert-input-bounds
(cl-assert (< erc-insert-marker erc-input-marker))
(cl-assert (= (field-end erc-insert-marker) erc-input-marker)))))
-(defvar erc--refresh-prompt-hook nil)
+(defvar erc--merge-prop-behind-p nil
+ "When non-nil, put merged prop(s) behind existing.")
+
+(defvar erc--refresh-prompt-hook nil
+ "Hook called after refreshing the prompt in the affected buffer.")
+
+(defvar-local erc--inhibit-prompt-display-property-p nil
+ "Tell `erc-prompt' related functions to avoid the `display' text prop.
+Modules can enable this when needing to reserve the prompt's
+display property for some other purpose, such as displaying it
+elsewhere, abbreviating it, etc.")
+
+(defconst erc--prompt-properties '( rear-nonsticky t
+ erc-prompt t ; t or `hidden'
+ field erc-prompt
+ front-sticky t
+ read-only t)
+ "Mandatory text properties added to ERC's prompt.")
+
+(defvar erc--refresh-prompt-continue-request nil
+ "State flag for refreshing prompt in all buffers.
+When the value is zero, functions assigned to the variable
+`erc-prompt' can set this to run `erc--refresh-prompt-hook' (1)
+or `erc--refresh-prompt' (2) in all buffers of the server.")
+
+(defun erc--refresh-prompt-continue (&optional hooks-only-p)
+ "Ask ERC to refresh the prompt in all buffers.
+Functions assigned to `erc-prompt' can call this if needing to
+recreate the prompt in other buffers as well. With HOOKS-ONLY-P,
+run `erc--refresh-prompt-hook' in other buffers instead of doing
+a full refresh."
+ (when (zerop erc--refresh-prompt-continue-request)
+ (setq erc--refresh-prompt-continue-request (if hooks-only-p 1 2))))
(defun erc--refresh-prompt ()
"Re-render ERC's prompt when the option `erc-prompt' is a function."
(erc--assert-input-bounds)
(unless (erc--prompt-hidden-p)
- (when (functionp erc-prompt)
- (save-excursion
- (goto-char erc-insert-marker)
- (set-marker-insertion-type erc-insert-marker nil)
- ;; Avoid `erc-prompt' (the named function), which appends a
- ;; space, and `erc-display-prompt', which propertizes all but
- ;; that space.
- (insert-and-inherit (funcall erc-prompt))
- (set-marker-insertion-type erc-insert-marker t)
- (delete-region (point) (1- erc-input-marker))))
- (run-hooks 'erc--refresh-prompt-hook)))
+ (let ((erc--refresh-prompt-continue-request
+ (or erc--refresh-prompt-continue-request 0)))
+ (when (functionp erc-prompt)
+ (save-excursion
+ (goto-char erc-insert-marker)
+ (set-marker-insertion-type erc-insert-marker nil)
+ ;; Avoid `erc-prompt' (the named function), which appends a
+ ;; space, and `erc-display-prompt', which propertizes all
+ ;; but that space.
+ (let ((s (funcall erc-prompt))
+ (erc--merge-prop-behind-p t))
+ (erc--merge-prop 0 (length s) 'font-lock-face 'erc-prompt-face s)
+ (add-text-properties 0 (length s) erc--prompt-properties s)
+ (insert s))
+ (set-marker-insertion-type erc-insert-marker t)
+ (delete-region (point) (1- erc-input-marker))))
+ (run-hooks 'erc--refresh-prompt-hook)
+ (when-let (((> erc--refresh-prompt-continue-request 0))
+ (n erc--refresh-prompt-continue-request)
+ (erc--refresh-prompt-continue-request -1)
+ (b (current-buffer)))
+ (erc-with-all-buffers-of-server erc-server-process
+ (lambda () (not (eq b (current-buffer))))
+ (if (= n 1)
+ (run-hooks 'erc--refresh-prompt-hook)
+ (erc--refresh-prompt)))))))
(defun erc--check-msg-prop (prop &optional val)
"Return PROP's value in `erc--msg-props' when populated.
@@ -3247,9 +3294,12 @@ erc--merge-prop
new)
(while (< pos to)
(setq new (if old
- (if (listp val)
- (append val (ensure-list old))
- (cons val (ensure-list old)))
+ ;; Can't `nconc' without more info.
+ (if erc--merge-prop-behind-p
+ `(,@(ensure-list old) ,@(ensure-list val))
+ (if (listp val)
+ (append val (ensure-list old))
+ (cons val (ensure-list old))))
val))
(put-text-property pos end prop new object)
(setq pos end
@@ -5209,12 +5259,7 @@ erc-display-prompt
;; Do not extend the text properties when typing at the end
;; of the prompt, but stuff typed in front of the prompt
;; shall remain part of the prompt.
- (setq prompt (propertize prompt
- 'rear-nonsticky t
- 'erc-prompt t ; t or `hidden'
- 'field 'erc-prompt
- 'front-sticky t
- 'read-only t))
+ (setq prompt (apply #'propertize prompt erc--prompt-properties))
(erc-put-text-property 0 (1- (length prompt))
'font-lock-face (or face 'erc-prompt-face)
prompt)
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 0c03a12864a..cd8e6ca7b24 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1866,6 +1866,18 @@ erc--merge-prop
(buffer-substring 1 4)
#("ghi" 0 1 (erc-test (w x)) 1 2 (erc-test (w x y z)))))
+ ;; Flag `erc--merge-prop-behind-p'.
+ (goto-char (point-min))
+ (insert "jkl\n")
+ (erc--merge-prop 2 3 'erc-test '(y z))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("jkl" 1 2 (erc-test (y z)))))
+ (let ((erc--merge-prop-behind-p t))
+ (erc--merge-prop 1 3 'erc-test '(w x)))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4)
+ #("jkl" 0 1 (erc-test (w x)) 1 2 (erc-test (y z w x)))))
+
(when noninteractive
(kill-buffer))))
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-5.6-Use-overlay-instead-of-text-prop-to-hide-ERC-s-p.patch --]
[-- Type: text/x-patch, Size: 13755 bytes --]
From 0dcac98dc08d74454a33c81e516f2e721675600c Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sat, 18 Nov 2023 23:44:20 -0800
Subject: [PATCH 3/5] [5.6] Use overlay instead of text prop to hide ERC's
prompt
* lisp/erc/erc-backend.el (erc--hidden-prompt-overlay):
New variable, a buffer-local handle for the prompt overlay.
(erc--reveal-prompt): Delete overlay instead of text prop.
(erc--conceal-prompt): Add overlay instead of text prop.
(erc--unhide-prompt): Run `erc--refresh-prompt-hook' after revealing.
(erc--hide-prompt): Run `erc--refresh-prompt-hook' after hiding.
* lisp/erc/erc-stamp.el (erc-stamp--adjust-margin): Attempt a more
accurate estimate of the prompt's width in columns when setting
left-margin.
(erc-stamp--skip-left-margin-prompt-p): New variable to inhibit normal
behavior of displaying prompt in left margin.
(erc-stamp--display-margin-mode): Allow opting out of
prompt-in-left-margin behavior.
(erc--reveal-prompt): Delete unneeded implementation.
(erc--conceal-prompt): Put overlay in margin.
* test/lisp/erc/erc-tests.el (erc-hide-prompt): Use
`get-char-property' instead of `get-text-property' in order to
accommodate overlay-based prompt hiding. (Bug#51082)
---
lisp/erc/erc-backend.el | 21 ++++++++++++-----
lisp/erc/erc-stamp.el | 38 +++++++++++++++++++++----------
test/lisp/erc/erc-tests.el | 46 +++++++++++++++++++-------------------
3 files changed, 64 insertions(+), 41 deletions(-)
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 371b4591915..7ff55de0d0c 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -1043,13 +1043,20 @@ erc-process-sentinel-1
;; unexpected disconnect
(erc-process-sentinel-2 event buffer))))
+(defvar-local erc--hidden-prompt-overlay nil
+ "Overlay for hiding the prompt when disconnected.")
+
(cl-defmethod erc--reveal-prompt ()
- (remove-text-properties erc-insert-marker erc-input-marker
- '(display nil)))
+ (when erc--hidden-prompt-overlay
+ (delete-overlay erc--hidden-prompt-overlay)
+ (setq erc--hidden-prompt-overlay nil)))
(cl-defmethod erc--conceal-prompt ()
- (add-text-properties erc-insert-marker (1- erc-input-marker)
- `(display ,erc-prompt-hidden)))
+ (when-let (((null erc--hidden-prompt-overlay))
+ (ov (make-overlay erc-insert-marker (1- erc-input-marker)
+ nil 'front-advance)))
+ (overlay-put ov 'display erc-prompt-hidden)
+ (setq erc--hidden-prompt-overlay ov)))
(defun erc--prompt-hidden-p ()
(and (marker-position erc-insert-marker)
@@ -1061,7 +1068,8 @@ erc--unhide-prompt
(marker-position erc-input-marker))
(with-silent-modifications
(put-text-property erc-insert-marker (1- erc-input-marker) 'erc-prompt t)
- (erc--reveal-prompt))))
+ (erc--reveal-prompt)
+ (run-hooks 'erc--refresh-prompt-hook))))
(defun erc--unhide-prompt-on-self-insert ()
(when (and (eq this-command #'self-insert-command)
@@ -1086,7 +1094,8 @@ erc--hide-prompt
(with-silent-modifications
(put-text-property erc-insert-marker (1- erc-input-marker)
'erc-prompt 'hidden)
- (erc--conceal-prompt))
+ (erc--conceal-prompt)
+ (run-hooks 'erc--refresh-prompt-hook))
(add-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert 80 t))))
(defun erc-process-sentinel (cproc event)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 6eeb7706a61..e6a8f36c332 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -360,7 +360,18 @@ erc-stamp--adjust-margin
(if resetp
(or (and (not (zerop cols)) cols)
erc-stamp--margin-width
- (max (if leftp (string-width (erc-prompt)) 0)
+ (max (if leftp
+ (cond ((fboundp 'erc-fill--wrap-measure)
+ (let* ((b erc-insert-marker)
+ (e (1- erc-input-marker))
+ (w (erc-fill--wrap-measure b e)))
+ (/ (if (consp w) (car w) w)
+ (frame-char-width))))
+ ((fboundp 'string-pixel-width)
+ (/ (string-pixel-width (erc-prompt))
+ (frame-char-width)))
+ (t (string-width (erc-prompt))))
+ 0)
(1+ (string-width
(or (if leftp
erc-timestamp-last-inserted
@@ -407,6 +418,9 @@ erc-stamp-prefix-log-filter
(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix)
"Extant properties at the start of a message inherited by the stamp.")
+(defvar-local erc-stamp--skip-left-margin-prompt-p nil
+ "Don't display prompt in left margin.")
+
(declare-function erc--remove-text-properties "erc" (string))
;; Currently, `erc-insert-timestamp-right' hard codes its display
@@ -437,7 +451,8 @@ erc-stamp--display-margin-mode
#'erc--remove-text-properties)
(add-hook 'erc--setup-buffer-hook
#'erc-stamp--refresh-left-margin-prompt nil t)
- (when erc-stamp--margin-left-p
+ (when (and erc-stamp--margin-left-p
+ (not erc-stamp--skip-left-margin-prompt-p))
(add-hook 'erc--refresh-prompt-hook
#'erc-stamp--display-prompt-in-left-margin nil t)))
(remove-function (local 'filter-buffer-substring-function)
@@ -451,6 +466,7 @@ erc-stamp--display-margin-mode
(kill-local-variable (if erc-stamp--margin-left-p
'left-margin-width
'right-margin-width))
+ (kill-local-variable 'erc-stamp--skip-left-margin-prompt-p)
(kill-local-variable 'fringes-outside-margins)
(kill-local-variable 'erc-stamp--margin-left-p)
(kill-local-variable 'erc-stamp--margin-width)
@@ -485,18 +501,16 @@ erc-stamp--refresh-left-margin-prompt
(setq erc-stamp--last-prompt nil))
(erc--refresh-prompt)))
-(cl-defmethod erc--reveal-prompt
- (&context (erc-stamp--display-margin-mode (eql t))
- (erc-stamp--margin-left-p (eql t)))
- (put-text-property erc-insert-marker (1- erc-input-marker)
- 'display `((margin left-margin) ,erc-stamp--last-prompt)))
-
(cl-defmethod erc--conceal-prompt
(&context (erc-stamp--display-margin-mode (eql t))
- (erc-stamp--margin-left-p (eql t)))
- (let ((prompt (string-pad erc-prompt-hidden left-margin-width nil 'start)))
- (put-text-property erc-insert-marker (1- erc-input-marker)
- 'display `((margin left-margin) ,prompt))))
+ (erc-stamp--margin-left-p (eql t))
+ (erc-stamp--skip-left-margin-prompt-p null))
+ (when-let (((null erc--hidden-prompt-overlay))
+ (prompt (string-pad erc-prompt-hidden left-margin-width nil 'start))
+ (ov (make-overlay erc-insert-marker (1- erc-input-marker)
+ nil 'front-advance)))
+ (overlay-put ov 'display `((margin left-margin) ,prompt))
+ (setq erc--hidden-prompt-overlay ov)))
(defun erc-insert-timestamp-left (string)
"Insert timestamps at the beginning of the line."
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index cd8e6ca7b24..06485bafabc 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -187,101 +187,101 @@ erc-hide-prompt
(with-current-buffer "ServNet"
(should (= (point) erc-insert-marker))
(erc--hide-prompt erc-server-process)
- (should (string= ">" (get-text-property (point) 'display))))
+ (should (string= ">" (get-char-property (point) 'display))))
(with-current-buffer "#chan"
(goto-char erc-insert-marker)
- (should (string= ">" (get-text-property (point) 'display)))
+ (should (string= ">" (get-char-property (point) 'display)))
(should (memq #'erc--unhide-prompt-on-self-insert pre-command-hook))
(goto-char erc-input-marker)
(ert-simulate-command '(self-insert-command 1 ?/))
(goto-char erc-insert-marker)
- (should-not (get-text-property (point) 'display))
+ (should-not (get-char-property (point) 'display))
(should-not (memq #'erc--unhide-prompt-on-self-insert
pre-command-hook)))
(with-current-buffer "bob"
(goto-char erc-insert-marker)
- (should (string= ">" (get-text-property (point) 'display)))
+ (should (string= ">" (get-char-property (point) 'display)))
(should (memq #'erc--unhide-prompt-on-self-insert pre-command-hook))
(goto-char erc-input-marker)
(ert-simulate-command '(self-insert-command 1 ?/))
(goto-char erc-insert-marker)
- (should-not (get-text-property (point) 'display))
+ (should-not (get-char-property (point) 'display))
(should-not (memq #'erc--unhide-prompt-on-self-insert
pre-command-hook)))
(with-current-buffer "ServNet"
- (should (get-text-property erc-insert-marker 'display))
+ (should (get-char-property erc-insert-marker 'display))
(should (memq #'erc--unhide-prompt-on-self-insert pre-command-hook))
(erc--unhide-prompt)
(should-not (memq #'erc--unhide-prompt-on-self-insert
pre-command-hook))
- (should-not (get-text-property erc-insert-marker 'display))))
+ (should-not (get-char-property erc-insert-marker 'display))))
(ert-info ("Value: server")
(setq erc-hide-prompt '(server))
(with-current-buffer "ServNet"
(erc--hide-prompt erc-server-process)
(should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden))
- (should (string= ">" (get-text-property erc-insert-marker 'display))))
+ (should (string= ">" (get-char-property erc-insert-marker 'display))))
(with-current-buffer "#chan"
- (should-not (get-text-property erc-insert-marker 'display)))
+ (should-not (get-char-property erc-insert-marker 'display)))
(with-current-buffer "bob"
- (should-not (get-text-property erc-insert-marker 'display)))
+ (should-not (get-char-property erc-insert-marker 'display)))
(with-current-buffer "ServNet"
(erc--unhide-prompt)
(should (eq (get-text-property erc-insert-marker 'erc-prompt) t))
- (should-not (get-text-property erc-insert-marker 'display))))
+ (should-not (get-char-property erc-insert-marker 'display))))
(ert-info ("Value: channel")
(setq erc-hide-prompt '(channel))
(with-current-buffer "ServNet"
(erc--hide-prompt erc-server-process)
- (should-not (get-text-property erc-insert-marker 'display)))
+ (should-not (get-char-property erc-insert-marker 'display)))
(with-current-buffer "bob"
- (should-not (get-text-property erc-insert-marker 'display)))
+ (should-not (get-char-property erc-insert-marker 'display)))
(with-current-buffer "#chan"
- (should (string= ">" (get-text-property erc-insert-marker 'display)))
+ (should (string= ">" (get-char-property erc-insert-marker 'display)))
(should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden))
(erc--unhide-prompt)
(should (eq (get-text-property erc-insert-marker 'erc-prompt) t))
- (should-not (get-text-property erc-insert-marker 'display))))
+ (should-not (get-char-property erc-insert-marker 'display))))
(ert-info ("Value: query")
(setq erc-hide-prompt '(query))
(with-current-buffer "ServNet"
(erc--hide-prompt erc-server-process)
- (should-not (get-text-property erc-insert-marker 'display)))
+ (should-not (get-char-property erc-insert-marker 'display)))
(with-current-buffer "bob"
- (should (string= ">" (get-text-property erc-insert-marker 'display)))
+ (should (string= ">" (get-char-property erc-insert-marker 'display)))
(should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden))
(erc--unhide-prompt)
(should (eq (get-text-property erc-insert-marker 'erc-prompt) t))
- (should-not (get-text-property erc-insert-marker 'display)))
+ (should-not (get-char-property erc-insert-marker 'display)))
(with-current-buffer "#chan"
- (should-not (get-text-property erc-insert-marker 'display))))
+ (should-not (get-char-property erc-insert-marker 'display))))
(ert-info ("Value: nil")
(setq erc-hide-prompt nil)
(with-current-buffer "ServNet"
(erc--hide-prompt erc-server-process)
- (should-not (get-text-property erc-insert-marker 'display)))
+ (should-not (get-char-property erc-insert-marker 'display)))
(with-current-buffer "bob"
- (should-not (get-text-property erc-insert-marker 'display)))
+ (should-not (get-char-property erc-insert-marker 'display)))
(with-current-buffer "#chan"
- (should-not (get-text-property erc-insert-marker 'display))
+ (should-not (get-char-property erc-insert-marker 'display))
(erc--unhide-prompt) ; won't blow up when prompt already showing
- (should-not (get-text-property erc-insert-marker 'display))))
+ (should-not (get-char-property erc-insert-marker 'display))))
(when noninteractive
(kill-buffer "#chan")
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0004-5.6-Optionally-align-prompt-to-prefix-in-erc-fill-wr.patch --]
[-- Type: text/x-patch, Size: 5849 bytes --]
From a6d33eb399c95a4efec3ffdab65c349f930a6a4d Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 19 Nov 2023 17:18:29 -0800
Subject: [PATCH 4/5] [5.6] Optionally align prompt to prefix in erc-fill-wrap
* lisp/erc/erc-fill.el (erc-fill-wrap-align-prompt): New option for
aligning prompt with leading portion of messages at the common "static
center" pivot column, so it appears "dedented" along with all the
speakers. Tests for this functionality appear in the subsequent
patch of this same change set.
(erc-fill-wrap-use-pixels): Demote from user option to normal variable
because it has no practical use other than for testing. Don't rename
as internal variable to spare the improbable user of ERC on HEAD who's
already customized this some minor churn.
(erc-fill-wrap-mode, erc-fill-wrap-enable): Take care to disable
prompt-in-left-margin behavior when option
`erc-fill-wrap-align-prompt' is non-nil.
(erc-fill--wrap-measure): Improve doc string and always attempt to
leverage `buffer-text-pixel-size', even when the variable
`erc-fill-wrap-use-pixels' is nil.
(erc-fill--wrap-indent-prompt): New function to massage prompt
`line-prefix' after updates, such as changes to away status.
(Bug#51082)
---
lisp/erc/erc-fill.el | 47 +++++++++++++++++++++++++++++++++++++-------
1 file changed, 40 insertions(+), 7 deletions(-)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index e48d5540c86..50b5aefd27a 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -138,6 +138,11 @@ erc-fill-wrap-margin-side
:package-version '(ERC . "5.6")
:type '(choice (const nil) (const left) (const right)))
+(defcustom erc-fill-wrap-align-prompt nil
+ "Whether to align the prompt at the common `wrap-prefix'."
+ :package-version '(ERC . "5.6")
+ :type 'boolean)
+
(defcustom erc-fill-line-spacing nil
"Extra space between messages on graphical displays.
Its value should be larger than that of the variable
@@ -223,13 +228,11 @@ erc-fill-variable
(defvar-local erc-fill--wrap-value nil)
(defvar-local erc-fill--wrap-visual-keys nil)
-(defcustom erc-fill-wrap-use-pixels t
+(defvar erc-fill-wrap-use-pixels t
"Whether to calculate padding in pixels when possible.
A value of nil means ERC should use columns, which may happen
regardless, depending on the Emacs version. This option only
-matters when `erc-fill-wrap-mode' is enabled."
- :package-version '(ERC . "5.6")
- :type 'boolean)
+matters when `erc-fill-wrap-mode' is enabled.")
(defcustom erc-fill-wrap-visual-keys 'non-input
"Whether to retain keys defined by `visual-line-mode'.
@@ -448,6 +451,13 @@ fill-wrap
(or (eq erc-fill-wrap-margin-side 'left)
(eq (default-value 'erc-insert-timestamp-function)
#'erc-insert-timestamp-left)))
+ (when erc-fill-wrap-align-prompt
+ (add-hook 'erc--refresh-prompt-hook
+ #'erc-fill--wrap-indent-prompt nil t))
+ (when erc-stamp--margin-left-p
+ (if erc-fill-wrap-align-prompt
+ (setq erc-stamp--skip-left-margin-prompt-p t)
+ (setq erc--inhibit-prompt-display-property-p t)))
(setq erc-fill--function #'erc-fill-wrap)
(when erc-fill-wrap-merge
(add-hook 'erc-button--prev-next-predicate-functions
@@ -460,6 +470,9 @@ fill-wrap
(kill-local-variable 'erc-fill--function)
(kill-local-variable 'erc-fill--wrap-visual-keys)
(kill-local-variable 'erc-fill--wrap-last-msg)
+ (kill-local-variable 'erc--inhibit-prompt-display-property-p)
+ (remove-hook 'erc--refresh-prompt-hook
+ #'erc-fill--wrap-indent-prompt)
(remove-hook 'erc-button--prev-next-predicate-functions
#'erc-fill--wrap-merged-button-p t))
'local)
@@ -515,15 +528,20 @@ erc-fill--wrap-continued-message-p
(defun erc-fill--wrap-measure (beg end)
"Return display spec width for inserted region between BEG and END.
-Ignore any `invisible' props that may be present when figuring."
- (if (and erc-fill-wrap-use-pixels (fboundp 'buffer-text-pixel-size))
+Ignore any `invisible' props that may be present when figuring.
+Expect the target region to be free of `line-prefix' and
+`wrap-prefix' properties, and expect `display-line-numbers-mode'
+to be disabled."
+ (if (fboundp 'buffer-text-pixel-size)
;; `buffer-text-pixel-size' can move point!
(save-excursion
(save-restriction
(narrow-to-region beg end)
(let* ((buffer-invisibility-spec)
(rv (car (buffer-text-pixel-size))))
- (if (zerop rv) 0 (list rv)))))
+ (if erc-fill-wrap-use-pixels
+ (if (zerop rv) 0 (list rv))
+ (/ rv (frame-char-width))))))
(- end beg)))
;; An escape hatch for third-party code expecting speakers of ACTION
@@ -575,6 +593,21 @@ erc-fill-wrap
'erc-fill--wrap-value))
wrap-prefix (space :width erc-fill--wrap-value))))))
+(defun erc-fill--wrap-indent-prompt ()
+ "Recompute the `line-prefix' of the prompt."
+ ;; Clear an existing `line-prefix' before measuring (bug#64971).
+ (remove-text-properties erc-insert-marker erc-input-marker
+ '(line-prefix nil wrap-prefix nil))
+ ;; Restoring window configuration seems to prevent unwanted
+ ;; recentering reminiscent of `scrolltobottom'-related woes.
+ (let ((c (and (get-buffer-window) (current-window-configuration)))
+ (len (erc-fill--wrap-measure erc-insert-marker erc-input-marker)))
+ (when c
+ (set-window-configuration c))
+ (put-text-property erc-insert-marker erc-input-marker
+ 'line-prefix
+ `(space :width (- erc-fill--wrap-value ,len)))))
+
(defvar erc-fill--wrap-rejigger-last-message nil
"Temporary working instance of `erc-fill--wrap-last-msg'.")
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #7: 0005-5.6-Optionally-allow-substitution-patterns-in-erc-pr.patch --]
[-- Type: text/x-patch, Size: 15437 bytes --]
From 8a2b414e30ba6325e9d716b5d7b09db31b6cad75 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 7 Oct 2021 14:26:36 +0200
Subject: [PATCH 5/5] [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--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 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.
(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>
---
etc/ERC-NEWS | 10 ++
lisp/erc/erc-compat.el | 20 +++
lisp/erc/erc.el | 125 ++++++++++++++++++-
test/lisp/erc/erc-scenarios-prompt-format.el | 117 +++++++++++++++++
4 files changed, 271 insertions(+), 1 deletion(-)
create mode 100644 test/lisp/erc/erc-scenarios-prompt-format.el
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 3bb9a30cfb2..9b3e62120fe 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..e0f6e9b5134 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -459,6 +459,26 @@ erc-compat--current-lisp-time
'(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 aefa9e0fc3f..780ae343d95 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -751,7 +751,74 @@ 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%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, including parameters for select modes
+ %C - channel modes, including all parameters
+ %u - user modes
+ %m - channel modes in channel buffers and user modes elsewhere
+ %M - channel modes in channels and user modes in server 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 4)
+ (?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.
@@ -8292,6 +8359,62 @@ 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-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
diff --git a/test/lisp/erc/erc-scenarios-prompt-format.el b/test/lisp/erc/erc-scenarios-prompt-format.el
new file mode 100644
index 00000000000..7eccb859dbc
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-prompt-format.el
@@ -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
--
2.41.0
^ permalink raw reply related [flat|nested] 9+ messages in thread