* bug#51082: [PATCH] erc-prompt: support substitution patterns "%target" and "%network"
@ 2021-10-07 13:05 Stefan Kangas
2021-10-09 0:53 ` Amin Bandali
` (4 more replies)
0 siblings, 5 replies; 9+ messages in thread
From: Stefan Kangas @ 2021-10-07 13:05 UTC (permalink / raw)
To: 51082; +Cc: emacs-erc, Amin Bandali
[-- Attachment #1: Type: text/plain, Size: 267 bytes --]
Severity: wishlist
The attached patch adds substitution patterns "%target" and "%network"
so you can do stuff like
(setq erc-prompt "[%target]")
(setq erc-prompt "[%target@%network]")
to get prompts that looks like this:
[#erc]
[#erc@Libera.Chat]
[-- Attachment #2: 0001-Support-two-substitution-patterns-in-erc-prompt.patch --]
[-- Type: text/x-diff, Size: 2379 bytes --]
From d6ac0356afa366276f1a0be26b81cf2d4b076b8d Mon Sep 17 00:00:00 2001
From: Stefan Kangas <stefan@marxist.se>
Date: Thu, 7 Oct 2021 14:26:36 +0200
Subject: [PATCH] Support two substitution patterns in erc-prompt
* lisp/erc/erc.el (erc-prompt--subsitutions): New function to
support substitution patters "%target" and "%network".
(erc-prompt) <defun>: Use the above new function.
(erc-prompt) <defcustom>: Document the new substitution patterns.
---
lisp/erc/erc.el | 31 +++++++++++++++++++++++++++++--
1 file changed, 29 insertions(+), 2 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 308812f0eb..aa5002c2ea 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -640,17 +640,44 @@ erc-string-no-properties
newstring))
(defcustom erc-prompt "ERC>"
- "Prompt used by ERC. Trailing whitespace is not required."
+ "Prompt used by ERC. Trailing whitespace is not required.
+
+You can also use these substitution patterns:
+ \"%target\" - channel, user, or server
+ \"%network\" - IRC network"
:group 'erc-display
:type '(choice string function))
+(defun erc-prompt--subsitutions (prompt)
+ "Make \"%target\" substitutions in PROMPT.
+
+See also the variable `erc-prompt'."
+ (while (string-match (rx "%" (or "target"
+ "network"
+ ;; "modes"
+ ))
+ prompt)
+ (setq prompt
+ (replace-match
+ (pcase (match-string 0 prompt)
+ ("%target" (or (erc-format-target)
+ (erc-format-target-and/or-server)
+ "ERC"))
+ ("%network" (and (fboundp 'erc-network-name) (erc-network-name)))
+ ;; TODO: Maybe have one variable for the prompt in the
+ ;; server window and one for channels and queries?
+ ;;("%modes" (erc-format-channel-modes))
+ (_ ""))
+ nil nil prompt 0)))
+ prompt)
+
(defun erc-prompt ()
"Return the input prompt as a string.
See also the variable `erc-prompt'."
(let ((prompt (if (functionp erc-prompt)
(funcall erc-prompt)
- erc-prompt)))
+ (erc-prompt--subsitutions erc-prompt))))
(if (> (length prompt) 0)
(concat prompt " ")
prompt)))
--
2.30.2
^ permalink raw reply related [flat|nested] 9+ messages in thread
* bug#51082: [PATCH] erc-prompt: support substitution patterns "%target" and "%network"
2021-10-07 13:05 bug#51082: [PATCH] erc-prompt: support substitution patterns "%target" and "%network" Stefan Kangas
@ 2021-10-09 0:53 ` Amin Bandali
[not found] ` <871r4vc92w.fsf@gnu.org>
` (3 subsequent siblings)
4 siblings, 0 replies; 9+ messages in thread
From: Amin Bandali @ 2021-10-09 0:53 UTC (permalink / raw)
To: Stefan Kangas; +Cc: emacs-erc, 51082
Hi Stefan,
Thanks for the patch. :) Please see my comments below.
Stefan Kangas writes:
> Severity: wishlist
>
> The attached patch adds substitution patterns "%target" and "%network"
> so you can do stuff like
>
> (setq erc-prompt "[%target]")
> (setq erc-prompt "[%target@%network]")
>
> to get prompts that looks like this:
>
> [#erc]
> [#erc@Libera.Chat]
From a cursory look at Rcirc, it looks like they too support something
like this, though with shorter names -- which might be nice to have
along with the longer names -- and two other options: the user's
nick, and the server. I think these all would potentially be nice to
have, in addition to the two you've added in your patch.
How do you feel about adding those as well? Maybe something like:
%m or %modes: channel modes (do we want to support user modes too?)
%n or %nick: current nick
%N or %network: network name
%s or %server: server name/address
%t or %target: target
Other ones I'd find useful would be %o, %v, etc., corresponding to the
'op' or 'voice' status of the user and so on (see `erc-format-@nick').
Also, for v2 please add an accompanying etc/ERC-NEWS entry for the
change.
> From d6ac0356afa366276f1a0be26b81cf2d4b076b8d Mon Sep 17 00:00:00 2001
> From: Stefan Kangas <stefan@marxist.se>
> Date: Thu, 7 Oct 2021 14:26:36 +0200
> Subject: [PATCH] Support two substitution patterns in erc-prompt
>
> * lisp/erc/erc.el (erc-prompt--subsitutions): New function to
> support substitution patters "%target" and "%network".
> (erc-prompt) <defun>: Use the above new function.
> (erc-prompt) <defcustom>: Document the new substitution patterns.
> ---
> lisp/erc/erc.el | 31 +++++++++++++++++++++++++++++--
> 1 file changed, 29 insertions(+), 2 deletions(-)
>
> diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
> index 308812f0eb..aa5002c2ea 100644
> --- a/lisp/erc/erc.el
> +++ b/lisp/erc/erc.el
> @@ -640,17 +640,44 @@ erc-string-no-properties
> newstring))
>
> (defcustom erc-prompt "ERC>"
> - "Prompt used by ERC. Trailing whitespace is not required."
> + "Prompt used by ERC. Trailing whitespace is not required.
> +
> +You can also use these substitution patterns:
> + \"%target\" - channel, user, or server
> + \"%network\" - IRC network"
> :group 'erc-display
> :type '(choice string function))
>
> +(defun erc-prompt--subsitutions (prompt)
> + "Make \"%target\" substitutions in PROMPT.
Per (info "(elisp) Coding Conventions") I believe the name may better
be `erc--prompt-substitutions'?
Also, since this function supports substitutions other than "%target",
the first sentence of the doc string should be reworded to reflect
that, or instead be more generic and enumerate them in subsequent
lines rather than the first line.
> +See also the variable `erc-prompt'."
> + (while (string-match (rx "%" (or "target"
> + "network"
> + ;; "modes"
> + ))
> + prompt)
> + (setq prompt
> + (replace-match
> + (pcase (match-string 0 prompt)
> + ("%target" (or (erc-format-target)
> + (erc-format-target-and/or-server)
> + "ERC"))
> + ("%network" (and (fboundp 'erc-network-name) (erc-network-name)))
> + ;; TODO: Maybe have one variable for the prompt in the
> + ;; server window and one for channels and queries?
> + ;;("%modes" (erc-format-channel-modes))
Why leave "%modes" commented out? Would using
`erc-format-channel-modes' not work here?
> + (_ ""))
> + nil nil prompt 0)))
> + prompt)
> +
> (defun erc-prompt ()
> "Return the input prompt as a string.
>
> See also the variable `erc-prompt'."
> (let ((prompt (if (functionp erc-prompt)
> (funcall erc-prompt)
> - erc-prompt)))
> + (erc-prompt--subsitutions erc-prompt))))
> (if (> (length prompt) 0)
> (concat prompt " ")
> prompt)))
Thanks,
amin
--
https://bndl.org
^ permalink raw reply [flat|nested] 9+ messages in thread
* bug#51082: [PATCH] erc-prompt: support substitution patterns "%target" and "%network"
[not found] ` <871r4vc92w.fsf@gnu.org>
@ 2021-10-09 8:03 ` J.P.
0 siblings, 0 replies; 9+ messages in thread
From: J.P. @ 2021-10-09 8:03 UTC (permalink / raw)
To: Amin Bandali; +Cc: emacs-erc, Stefan Kangas, 51082
Amin Bandali <bandali@gnu.org> writes:
> How do you feel about adding those as well? Maybe something like:
>
> %m or %modes: channel modes (do we want to support user modes too?)
> %n or %nick: current nick
> %N or %network: network name
> %s or %server: server name/address
> %t or %target: target
>
> Other ones I'd find useful would be %o, %v, etc., corresponding to the
> 'op' or 'voice' status of the user and so on (see `erc-format-@nick').
This may be my lack of a forebrain talking, but I thought the prompt
only gets updated after sending input.
(setq erc-prompt (lambda () (format-time-string "[%T.%3N]>")))
IOW, I don't think it's currently driven by response handlers, so it
won't react right away after a nick change or upon receiving a MODE or a
221. The mode line, OTOH, is updated more or less constantly (though
possibly too often). And as far as user modes go, ERC doesn't currently
remember them (AFAIK), a point I rather poorly tried to raise here:
https://lists.gnu.org/archive/html/emacs-erc/2021-10/msg00012.html
But with Stefan's current changes, none of this really matters (right?)
because target and network are effectively read-only once set (ignoring
a few edge cases).
> Also, for v2 please add an accompanying etc/ERC-NEWS entry for the
> change.
As an aside, one pleasant effect of having our own NEWS file is the
absence of constant merge conflicts on account of etc/NEWS' popularity.
For example, when trying to integrate older #48598 stuff with Olivier's
last services patch (in the months leading up to its installation), I
got annoyed enough by all the repeated manual merging of etc/NEWS that I
ended up replacing his changes to that file with a FIXME/IOU in his
commit message. But I guess the days of resorting to such shenanigans
are over!
>> +(defun erc-prompt--subsitutions (prompt)
>> + "Make \"%target\" substitutions in PROMPT.
>
> Per (info "(elisp) Coding Conventions") I believe the name may better
> be `erc--prompt-substitutions'?
Fearing similar feedback, I recently mass-renamed my `erc-foo--' stuff
in #48598 to `erc--foo-'. But I was wondering if an exception couldn't
be made for seasoned subprojects like ERC, with its longish primary
library file housing groups of related items sharing longer, more
qualified prefixes (than what's offered by the file/feature). I tried
searching the help list for this a while back but failed to find
anything.
> Why leave "%modes" commented out? Would using
> `erc-format-channel-modes' not work here?
If we do end up redrawing the prompt more often, which uncommenting this
seems to imply, would it not make sense to also address the occasional
double vision "ERC> ERC>" thing? Just thought I'd mention it in case
anyone already has a patch handy. Otherwise, forget I said anything,
especially if this doesn't ring a bell. We'll just deal with it later,
hopefully after facing down some of ERC's scarier demons.
^ permalink raw reply [flat|nested] 9+ messages in thread
* bug#51082: [PATCH] erc-prompt: support substitution patterns "%target" and "%network"
2021-10-07 13:05 bug#51082: [PATCH] erc-prompt: support substitution patterns "%target" and "%network" Stefan Kangas
2021-10-09 0:53 ` Amin Bandali
[not found] ` <871r4vc92w.fsf@gnu.org>
@ 2022-09-10 5:20 ` Lars Ingebrigtsen
2023-11-20 21:17 ` J.P.
[not found] ` <875y1wi0q2.fsf@neverwas.me>
4 siblings, 0 replies; 9+ messages in thread
From: Lars Ingebrigtsen @ 2022-09-10 5:20 UTC (permalink / raw)
To: Stefan Kangas; +Cc: emacs-erc, Amin Bandali, 51082
Stefan Kangas <stefan@marxist.se> writes:
> The attached patch adds substitution patterns "%target" and "%network"
> so you can do stuff like
>
> (setq erc-prompt "[%target]")
> (setq erc-prompt "[%target@%network]")
I think using the normal `format-spec' syntax would be nicer here.
^ permalink raw reply [flat|nested] 9+ messages in thread
* bug#51082: [PATCH] erc-prompt: support substitution patterns "%target" and "%network"
2021-10-07 13:05 bug#51082: [PATCH] erc-prompt: support substitution patterns "%target" and "%network" Stefan Kangas
` (2 preceding siblings ...)
2022-09-10 5:20 ` Lars Ingebrigtsen
@ 2023-11-20 21:17 ` J.P.
[not found] ` <875y1wi0q2.fsf@neverwas.me>
4 siblings, 0 replies; 9+ messages in thread
From: J.P. @ 2023-11-20 21:17 UTC (permalink / raw)
To: 51082; +Cc: Amin Bandali, Lars Ingebrigtsen, emacs-erc, Stefan Kangas
[-- Attachment #1: Type: text/plain, Size: 1558 bytes --]
Hi people,
I'd like to take this feature over, in case anyone cares. To summarize,
it initially stalled out because an underlying facility to support the
dynamic updating of rich UI elements wasn't available at the time. Most
of it has since been added, and the attached changes (once complete)
should fill in any remaining gaps.
Thus, I've gone ahead and integrated everyone's suggestions, for the
most part, with the only caveat being the feature won't be enabled by
default. Rather, there's an added step involved where a user must first
(setopt erc-prompt #erc-prompt-format)
before ERC will consider the companion option that contains the actual
template (also called `erc-prompt-format'). Such indirection may be
regrettable from a UX standpoint, but I'd rather hold off on improving
things until we've brought batch processing fully into the fold and have
tuned it to perform respectably with ERC's default configuration.
For anyone unfamiliar, ERC will soon be needing to process incoming
messages in rapid succession all the way to insertion as fast as it can
manage. Like normal messages, these will also influence the state of UI
elements, like the prompt, the mode line, etc. Because such processing
will be foundational to ERC's basic operations going forward, it's
important to prioritize über alles. To that end, I'm hoping we can
revisit this feature again at some later date if folks end up wanting to
expand `erc-prompt' to accommodate format specifiers directly, as
originally envisioned.
Thanks.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-5.6-Don-t-inherit-properties-when-refreshing-ERC-s-p.patch --]
[-- Type: text/x-patch, Size: 8368 bytes --]
From d29cd6fd8db3c9f1b78f273994022e0a1e1b29c1 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 1/4] [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 f4c3f77593c..0fbf6976d45 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 8dbe44ce5ed..af80194352c 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1838,6 +1838,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 #3: 0002-5.6-Use-overlay-instead-of-text-prop-to-hide-ERC-pro.patch --]
[-- Type: text/x-patch, Size: 13752 bytes --]
From b16774c76ee16cb342098a0e69a2b1688a44813b 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 2/4] [5.6] Use overlay instead of text prop to hide ERC 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 af80194352c..2782460eec8 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 #4: 0003-5.6-Optionally-align-prompt-to-prefix-in-erc-fill-wr.patch --]
[-- Type: text/x-patch, Size: 4262 bytes --]
From 723ac8a094709ffbebb39d0cb3222516d72c0791 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 3/4] [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.
(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.
(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 | 35 ++++++++++++++++++++++++++++++++++-
1 file changed, 34 insertions(+), 1 deletion(-)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index e48d5540c86..adbe1c4e5f2 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
@@ -448,6 +453,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 +472,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,7 +530,10 @@ 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."
+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 (and erc-fill-wrap-use-pixels (fboundp 'buffer-text-pixel-size))
;; `buffer-text-pixel-size' can move point!
(save-excursion
@@ -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 #5: 0004-5.6-Optionally-allow-substitution-patterns-in-erc-pr.patch --]
[-- Type: text/x-patch, Size: 9647 bytes --]
From cb28b38e96b873f210b128065901578aad69f4f5 Mon Sep 17 00:00:00 2001
From: Stefan Kangas <stefankangas@gmail.com>
Date: Thu, 7 Oct 2021 14:26:36 +0200
Subject: [PATCH 4/4] [5.6] Optionally allow substitution patterns in
erc-prompt
* etc/ERC-NEWS: Add entry for `erc-prompt-format'.
* lisp/erc/erc-compat.el
(erc-compat--format-spec-function-values-in-current-buffer): New
convenience macro to wrap prompt-format substitutions in functions
that remember the current buffer.
* lisp/erc/erc.el (erc-prompt): Add predefined choice for function
`erc-prompt-format'.
(erc-prompt-format-face-example): New example value for option
`erc-prompt-format'.
(erc-prompt-format): New companion option for `erc-prompt' choice
`erc-prompt-format'. New function of the same name to perform format
substitutions and serve as a Custom choice value for `erc-prompt'.
(erc--away-indicator, erc-away-status-indicator,
erc--format-away-indicator): New formatting function for away status
and helper variables.
(erc--user-modes-indicator): New variable.
(erc--format-user-modes): New function.
(erc--format-channel-status-prefix): New function. (Bug#51082)
Co-authored-by: F. Jason Park <jp@neverwas.me>
---
etc/ERC-NEWS | 10 ++++
lisp/erc/erc-compat.el | 24 +++++++++
lisp/erc/erc.el | 118 ++++++++++++++++++++++++++++++++++++++++-
3 files changed, 151 insertions(+), 1 deletion(-)
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 3bb9a30cfb2..04e9e99a0fd 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -191,6 +191,16 @@ been restored with a slightly revised role contingent on a few
assumptions explained in its doc string. For clarity, it has been
renamed 'erc-ensure-target-buffer-on-privmsg'.
+** A smarter, more responsive prompt.
+ERC's prompt can be told to respond dynamically to incoming and
+outgoing messages by leveraging the familiar function variant of the
+option 'erc-prompt'. With this release, only predefined functions can
+take full advantage of this new dynamism, but an interface to empower
+third-parties with the same possibilities may follow suit. To get
+started, customize 'erc-prompt' to 'erc-prompt-format', and see the
+option of the same name ('erc-prompt-format') for a rudimentary
+templating facility reminiscent of 'erc-mode-line-format'.
+
** Module 'scrolltobottom' now optionally more aggressive.
Enabling the experimental option 'erc-scrolltobottom-all' makes ERC
more vigilant about staking down the input area in all ERC windows.
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 4c376cfbc22..fe1fc328c7d 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -459,6 +459,30 @@ erc-compat--current-lisp-time
'(let (current-time-list) (current-time))
'(current-time)))
+(defmacro erc-compat--format-spec-function-values-in-current-buffer
+ (format specification &rest rest)
+ "Call `format-spec' with SPECIFICATION function values in current buffer.
+For simplicity, expect the SPECIFICATION alist (1) to only have
+function values and (2) to be quoted, so the entire form looks
+like a normal `format-spec' function call, with FORMAT and REST
+being passed along unmolested. For convenience, ensure functions
+return \"\" as a fallback and that each runs in the current
+buffer when deferred for lazy invocation on Emacs 29 and greater."
+ (cl-check-type (car specification) symbol)
+ (cl-check-type (cadr specification) cons)
+ (cl-check-type (nth 2 specification) null)
+ (let* ((buffer (make-symbol "buffer"))
+ (specs (mapcar (pcase-lambda (`(,k . ,v))
+ (cons k (list '\, (if (>= emacs-major-version 29)
+ `(lambda ()
+ (with-current-buffer ,buffer
+ (or (,v) "")))
+ `(or (,v) "")))))
+ (cadr specification))))
+ `(format-spec ,format
+ (let ((,buffer (current-buffer)))
+ ,(list '\` specs))
+ ,@rest)))
(provide 'erc-compat)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 0fbf6976d45..64179cd3408 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -751,7 +751,76 @@ erc-string-no-properties
(defcustom erc-prompt "ERC>"
"Prompt used by ERC. Trailing whitespace is not required."
:group 'erc-display
- :type '(choice string function))
+ :type '(choice string
+ (function-item :tag "Interpret format specifiers"
+ erc-prompt-format)
+ function))
+
+(defvar erc-prompt-format-face-example
+ #("%p%u%a\u00b7%b>"
+ 0 2 (font-lock-face erc-my-nick-prefix-face)
+ 2 4 (font-lock-face font-lock-keyword-face)
+ 4 6 (font-lock-face erc-error-face)
+ 6 7 (font-lock-face shadow)
+ 7 9 (font-lock-face font-lock-constant-face)
+ 9 10 (font-lock-face shadow))
+ "An example value for option `erc-prompt-format' with faces.")
+
+(defcustom erc-prompt-format "%p[%b]%a"
+ "Format string when `erc-prompt' is `erc-prompt-format'.
+ERC recognizes these substitution specifiers:
+
+ %a - away indicator
+ %b - buffer name
+ %t - channel or query target, server domain, or dialed address
+ %T - target@network or buffer name
+ %s - target@server or server
+ %N - current network, like Libera.Chat
+ %p - channel membership prefix, like @ or +
+ %n - current nickname
+ %c - channel modes traditional
+ %u - user modes
+
+To pick your own colors, do something like:
+
+ (setopt erc-prompt-format
+ (concat
+ (propertize \"%p\" \\='font-lock-face \\='erc-notice-face)
+ (propertize \"%b\" \\='font-lock-face \\='erc-input-face)
+ (propertize \"%a\" \\='font-lock-face \\='erc-error-face)))
+
+For a quick preview of this effect, try setting this option to
+`erc-prompt-format-face-example' and loading a theme that sets
+`erc-prompt-face' to a light or unspecified background. Lastly,
+please remember that ERC ignores this option completely unless
+the \"parent\" option `erc-prompt' is set to `erc-prompt-format'."
+ :package-version '(ERC . "5.6")
+ :group 'erc-display
+ :type '(choice (const :tag "prefix[buffer]away" "%p[%b]%a")
+ (variable-item :tag "Example with varied faces"
+ erc-prompt-format-face-example)
+ string))
+
+(defun erc-prompt-format ()
+ "Make predefined `format-spec' substitutions.
+
+See option `erc-prompt-format' and option `erc-prompt'."
+ (erc-compat--format-spec-function-values-in-current-buffer
+ (if (and (symbolp erc-prompt-format)
+ (special-variable-p erc-prompt-format))
+ (symbol-value erc-prompt-format)
+ erc-prompt-format)
+ '((?N . erc-format-network)
+ (?T . erc-format-target-and/or-network)
+ (?a . erc--format-away-indicator)
+ (?b . buffer-name)
+ (?c . erc-format-channel-modes)
+ (?n . erc-current-nick)
+ (?p . erc--format-channel-status-prefix)
+ (?s . erc-format-target-and/or-server)
+ (?t . erc-format-target)
+ (?u . erc--format-user-modes))
+ 'ignore-missing)) ; formerly `only-present'
(defun erc-prompt ()
"Return the input prompt as a string.
@@ -8245,6 +8314,53 @@ erc-format-away-status
(format-time-string erc-mode-line-away-status-format a)
"")))
+(defvar-local erc--away-indicator nil
+ "Cons containing an away indicator for the connection.")
+
+(defvar erc-away-status-indicator "A"
+ "String shown by various formatting facilities to indicate away status.
+Currently only used by the option `erc-prompt-format'.")
+
+(defun erc--format-away-indicator ()
+ "Return char with `display' property of `erc--away-indicator'."
+ (and-let* ((indicator (erc-with-server-buffer
+ (or erc--away-indicator
+ (setq erc--away-indicator (list "")))))
+ (newcar (if (erc-away-time) erc-away-status-indicator "")))
+ ;; Inform other buffers of the change when necessary.
+ (let ((dispp (not erc--inhibit-prompt-display-property-p)))
+ (unless (eq newcar (car indicator))
+ (erc--refresh-prompt-continue (and dispp 'hooks-only-p))
+ (setcar indicator newcar))
+ (if dispp
+ (propertize "(away?)" 'display indicator)
+ newcar))))
+
+(defvar-local erc--user-modes-indicator nil
+ "Cons containing connection-wide indicator for user modes.")
+
+;; If adding more of these functions, should factor out commonalities.
+;; As of ERC 5.6, this is identical to the away variant aside from
+;; the var names and `eq', which isn't important.
+(defun erc--format-user-modes ()
+ "Return server's user modes as a string"
+ (and-let* ((indicator (erc-with-server-buffer
+ (or erc--user-modes-indicator
+ (setq erc--user-modes-indicator (list "")))))
+ (newcar (erc--user-modes 'string)))
+ (let ((dispp (not erc--inhibit-prompt-display-property-p)))
+ (unless (string= newcar (car indicator))
+ (erc--refresh-prompt-continue (and dispp 'hooks-only-p))
+ (setcar indicator newcar))
+ (if dispp
+ (propertize "(user-modes?)" 'display indicator)
+ newcar))))
+
+(defun erc--format-channel-status-prefix ()
+ "Return the current channel membership prefix."
+ (and (erc--target-channel-p erc--target)
+ (erc-get-user-mode-prefix (erc-current-nick))))
+
(defun erc-format-channel-modes ()
"Return the current channel's modes."
(concat (apply #'concat
--
2.41.0
^ permalink raw reply related [flat|nested] 9+ messages in thread
* 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-20 21:22 UTC (permalink / raw)
To: 51082; +Cc: Stefan Kangas, Lars Ingebrigtsen, emacs-erc, Amin Bandali
Screenshot:
https://debbugs.gnu.org/cgi/bugreport.cgi?att=1;msg=18;bug=51082;filename=erc-prompt-format_demo.webm
^ permalink raw reply [flat|nested] 9+ messages in thread
* 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
* bug#51082: [PATCH] erc-prompt: support substitution patterns "%target" and "%network"
[not found] ` <87pm01d1yy.fsf@neverwas.me>
@ 2023-11-24 22:12 ` J.P.
[not found] ` <87plzy2433.fsf@neverwas.me>
1 sibling, 0 replies; 9+ messages in thread
From: J.P. @ 2023-11-24 22:12 UTC (permalink / raw)
To: 51082-done; +Cc: Amin Bandali, Lars Ingebrigtsen, emacs-erc, Stefan Kangas
"J.P." <jp@neverwas.me> writes:
> 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.
A version of this has been installed as
2ed9c9f1b32 * Optionally allow substitution patterns in erc-prompt
Thanks and closing.
^ permalink raw reply [flat|nested] 9+ messages in thread
* bug#51082: [PATCH] erc-prompt: support substitution patterns "%target" and "%network"
[not found] ` <87plzy2433.fsf@neverwas.me>
@ 2023-12-15 1:18 ` Stefan Kangas
0 siblings, 0 replies; 9+ messages in thread
From: Stefan Kangas @ 2023-12-15 1:18 UTC (permalink / raw)
To: J.P., 51082-done; +Cc: Lars Ingebrigtsen, emacs-erc, Amin Bandali
"J.P." <jp@neverwas.me> writes:
> A version of this has been installed as
>
> 2ed9c9f1b32 * Optionally allow substitution patterns in erc-prompt
>
> Thanks and closing.
Thanks!
^ permalink raw reply [flat|nested] 9+ messages in thread
end of thread, other threads:[~2023-12-15 1:18 UTC | newest]
Thread overview: 9+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-10-07 13:05 bug#51082: [PATCH] erc-prompt: support substitution patterns "%target" and "%network" Stefan Kangas
2021-10-09 0:53 ` Amin Bandali
[not found] ` <871r4vc92w.fsf@gnu.org>
2021-10-09 8:03 ` J.P.
2022-09-10 5:20 ` Lars Ingebrigtsen
2023-11-20 21:17 ` J.P.
[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>
2023-11-24 22:12 ` J.P.
[not found] ` <87plzy2433.fsf@neverwas.me>
2023-12-15 1:18 ` Stefan Kangas
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).