From: "J.P." <jp@neverwas.me>
To: 67677@debbugs.gnu.org
Cc: emacs-erc@gnu.org
Subject: bug#67677: 30.0.50; ERC 5.6: Use templates for formatting chat messages
Date: Fri, 12 Jan 2024 08:19:15 -0800 [thread overview]
Message-ID: <87a5paa5j0.fsf__25588.5717504256$1705076448$gmane$org@neverwas.me> (raw)
In-Reply-To: <87jzpq7apw.fsf@neverwas.me> (J. P.'s message of "Wed, 06 Dec 2023 23:06:35 -0800")
[-- Attachment #1: Type: text/plain, Size: 4092 bytes --]
Earlier work for this bug extended ERC's existing template catalog
system with an internal framework for dictating (hopefully more
explicitly and resolutely) how messages materialize in chat buffers.
Modules can make use of this framework to shape most aspects of message
formatting, which opens the door to radically contrasting styles, such
as "multi-part" messages with header/body/footer sections and messages
with integrated time stamps (meaning you can finally ditch that blessed
`stamp' module for good).
However, this approach remains awkward when it comes to
1. minor modifications
2. modularity itself (keeping modules loosely coupled)
At present, making use of the framework involves defining an entire
format catalog (although inheritance helps a bit in this regard). But
the boilerplate issue really begins to compound when trying to integrate
with other modules because the process is somewhat dependent on defining
yet more catalogs to serve the various combinations, and more still if
trying to keep things abstract.
To alleviate some of this awkwardness and cut down on the verbosity, I'm
proposing we introduce a more practical extension to this framework.
It'll be reserved for internal use at first, but with an eye toward
eventual export (likely in 5.7). The basic idea is that we define a
single abnormal hook per speaker catalog that runs just prior to
insertion, and we allow its members to influence the parameters passed
to `format-spec'. And, we do so in a convenient and structured (and
reusable) way, so members don't have to twiddle plists in search of a
single ingredient to manually splice into format strings based on the
verdict of some flimsy heuristic.
I'm tentatively calling this hook system "msgfspc" (one word), short for
"message format-spec." It works by defining a struct to accompany each
hook, with slots based on the catalog's common set of template
specifiers. Subscribing code then has the freedom to modify the template
itself and add or subtract specifiers as needed by mutating the struct
instance for that particular formatting pass. The client API looks like
this:
;; Module activation body
(add-hook 'erc-msgfspec-speaker-hook
#my-maybe-transform-on-msgfspec-speaker nil t)
(setq my-state "foo")
;; Top level of package
(defun my-maybe-transform-on-msgfspec-speaker (spec)
(pcase spec
;; Modify an outgoing message template.
((cl-struct erc-msgfspec-speaker
(key (or 'input-chan-privmsg 'input-query-privmsg)))
(erc-msgfspec-insert-spec-after
spec ?n ?i (propertize "%i" 'font-lock-face 'my-face))
(push `(?i . ,my-state) (erc-msgfspec-alist spec)))
;; Modify an incoming message body.
((cl-struct erc-msgfspec-speaker
(key (or 'chan-privmsg 'query-privmsg))
(\?m msg))
(setf (erc-msgfspec-speaker-?m spec)
(decode-coding-string (my-transform-message msg)
'utf-8)))))
;; Note that at present, all the "erc-foo" symbols above are actually
;; "erc--foo" (internal)
There's at least one unfortunate aspect to the API scheme above: the
buffer where the working version of a template resides isn't current
when hooks run. This happens because members still need access to local
state in the ERC buffer where the actual insertion takes place. I've
experimented a bit with using the virtual buffer facility (via
`buffer-swap-text') to get around this, and it appears to work great
(even seemingly shaving a second or two off runs of ERC's extended test
suite). However, I'm quite reticent to introduce something I've never
used before and almost never see in the wild. Thus, this approach will
have to wait pending further investigation.
The current version of the proposed implementation can be found in the
second of the attached patches. The first is from bug#68265 but included
here because the associated demo addressing a real-world use case
requires both. Please see that bug's recent posts for links and
instructions.
Thanks.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v1-v2.diff --]
[-- Type: text/x-patch, Size: 53311 bytes --]
From 9bb8693156326cf3ef33f9ccf1e6b4bbbcf9ed61 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 12 Jan 2024 06:48:18 -0800
Subject: [PATCH 0/2] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (2):
[5.6] Add replacement-text field to erc-input struct
[5.6] Expose catalog-specific message formatter in ERC
etc/ERC-NEWS | 14 +-
lisp/erc/erc-common.el | 126 +++++++-
lisp/erc/erc-goodies.el | 7 +-
lisp/erc/erc.el | 289 ++++++++++++------
test/lisp/erc/erc-tests.el | 174 +++++++++++
.../fill/snapshots/merge-wrap-01.eld | 2 +-
.../merge-wrap-indicator-post-01.eld | 2 +-
.../snapshots/merge-wrap-indicator-pre-01.eld | 2 +-
8 files changed, 513 insertions(+), 103 deletions(-)
Interdiff:
diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index 30ce0a0bb1a..eee06a3fde9 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -165,6 +165,113 @@ erc--isupport-data
(table (make-char-table 'erc--channel-mode-types) :type char-table)
(shortargs (make-hash-table :test #'equal)))
+(cl-defstruct erc--msgfspec
+ "Abstract struct for object shared among message-format hook members."
+ ( key nil :type symbol
+ :documentation "Catalog entry key, a symbol.")
+ ( buffer nil :type (or buffer null)
+ :documentation "Buffer with catalog entry value, a template string.")
+ ( alist nil :type list
+ :documentation "Extra items for `format-spec' SPECIFICATION."))
+
+(defmacro erc--define-msgfspec (catalog &rest slots)
+ "Define items that satisfy the \"erc-msgfspec\" interface.
+Expect symbol CATALOG to be the name of a message-format catalog
+and SLOTS to be an alist of (CHAR . DOC), where CHAR is a
+`format-spec' character and DOC is a string explaining its role.
+Using these, define a \"msgfspec\" data struct named
+\"erc-msgfspec-CATALOG\", with massaged SLOTS becoming its
+string-typed fields. Arrange for each field to be DOC'umented
+and accessed by a function named \"erc-msgfspec-CATALOG-?CHAR\"
+\(note the question mark). Additionally, create a constructor
+for the struct, named \"erc-msgfspec-CATALOG-from-args\", along
+with a hook variable named \"erc-msgfspec-CATALOG-hook\". Also
+define a wrapper named \"erc-msgfspec-CATALOG-apply-spec\" to
+allow the `erc-display-message' machinery to call `format-spec'
+with a specification alist derived from the struct instance
+passed around and potentially influenced by each hook member."
+ (declare (indent 1)
+ (debug (symbolp (&rest &or symbolp (symbolp &rest sexp)))))
+ (let* ((chars)
+ (specs (let (out)
+ (while-let (((characterp (car-safe (car-safe slots))))
+ (spec (pop slots))
+ (char (car spec)))
+ (cl-assert (stringp (cdr spec)))
+ (push `(,(intern (format "?%c" char)) ""
+ :type 'string :documentation ,(cdr spec))
+ out)
+ (push char chars))
+ (setq chars (nreverse chars))
+ (nreverse out)))
+ (internalp (eq ?- (aref (symbol-name catalog) 0)))
+ (name (if internalp
+ (substring (symbol-name catalog) 1)
+ (symbol-name catalog)))
+ (full-name (concat "erc-" (if internalp "-" "") "msgfspec-" name))
+ (hook (intern (concat full-name "-hook")))
+ (makr (intern (concat full-name "-from-args")))
+ (fmtr (intern (concat full-name "-apply-spec")))
+ (setters (mapcar (lambda (letr)
+ (list letr '\,
+ `(,(intern (format "%s-?%c" full-name letr))
+ msgfspec-obj)))
+ chars))
+ (choices (mapcar (lambda (letr)
+ (list letr (intern (format ":?%c" letr))))
+ chars)))
+ `(progn
+
+ (cl-defstruct (,(intern full-name) (:include erc--msgfspec))
+ ,(concat "Shared object for `" name
+ "' catalog message-format hook.")
+ ,@specs
+ ,@slots)
+
+ (defvar ,hook nil
+ ,(concat "Hook run before formatting a `" name "' catalog entry."
+ "\nCalled by `erc-format-message' with an `"
+ full-name "'\nobject."))
+
+ (defun ,makr (key format &rest spec-plist)
+ ,(concat "Create a `" full-name "' object from catalog entry."
+ "\nExpect KEY to be the entry's key, FORMAT its value, and"
+ "\nSPEC-PLIST the plist of `format-spec' args originally"
+ " given" ; continued
+ "\nto `erc-display-message'.")
+ (let ((buffer (get-buffer-create
+ (format ,(concat " *" full-name "-%s*") key)
+ ,@(and (>= emacs-major-version 28) '(t))))
+ args)
+ (with-current-buffer buffer (insert format))
+ (while-let ((spec-plist)
+ (key (pop spec-plist))
+ (val (pop spec-plist)))
+ (setq args (nconc (list (pcase key ,@choices) val) args)))
+ (apply #',(intern (concat "make-" full-name))
+ :key key :buffer buffer args)))
+ (defun ,fmtr (msgfspec-obj)
+ ,(concat "Massage MSGFSPEC-OBJ into args for `format-spec'."
+ "\nApply the latter after incorporating the `alist' slot"
+ "\nfor the current `" full-name "' object.")
+ (format-spec (with-current-buffer (erc--msgfspec-buffer msgfspec-obj)
+ (remove-text-properties (point-min) (point-max)
+ '(erc--% nil))
+ (prog1 (buffer-string) (kill-buffer)))
+ (,'\`(,@setters
+ (,'\,@ (,(intern (concat full-name "-alist"))
+ msgfspec-obj))))
+ 'ignore))
+ (put ',catalog 'erc-msgfspec-makr #',makr)
+ (put ',catalog 'erc-msgfspec-fmtr ',fmtr)
+ (put ',catalog 'erc-msgfspec-hook ',hook))))
+
+(erc--define-msgfspec -speaker
+ (?n . "Nickname.")
+ (?m . "Message body.")
+ (?p . "Channel-membership prefix.")
+ (?s . "STATUSMSG prefix."))
+
;; After dropping 28, we can use prefixed "erc-autoload" cookies.
(defun erc--normalize-module-symbol (symbol)
"Return preferred SYMBOL for `erc--modules'."
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 00963d24a32..f80bafa42b9 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -5924,121 +5924,134 @@ erc-format-privmessage
;; The format strings in the following `-speaker' catalog shouldn't
;; contain any non-protocol words, so they make sense in any language.
+;; Intervals with a format-spec specifier % ... c must have the text
+;; property (erc--% . ?c) so that msgfspec-related code can find it.
(defvar erc--message-speaker-statusmsg
#("(%p%n%s) %m"
0 1 (font-lock-face erc-default-face)
- 1 3 (font-lock-face erc-nick-prefix-face)
- 3 5 (font-lock-face erc-nick-default-face)
- 5 7 (font-lock-face erc-notice-face)
- 7 11 (font-lock-face erc-default-face))
+ 1 3 (erc--% ?p font-lock-face erc-nick-prefix-face)
+ 3 5 (erc--% ?n font-lock-face erc-nick-default-face)
+ 5 7 (erc--% ?s font-lock-face erc-notice-face)
+ 7 9 (font-lock-face erc-default-face)
+ 9 11 (erc--% ?m font-lock-face erc-default-face))
"Message template for in-channel status messages.")
(defvar erc--message-speaker-statusmsg-input
#("(%p%n%s) %m"
0 1 (font-lock-face erc-default-face)
- 1 3 (font-lock-face erc-my-nick-prefix-face)
- 3 5 (font-lock-face erc-my-nick-face)
- 5 7 (font-lock-face erc-notice-face)
+ 1 3 (erc--% ?p font-lock-face erc-my-nick-prefix-face)
+ 3 5 (erc--% ?n font-lock-face erc-my-nick-face)
+ 5 7 (erc--% ?s font-lock-face erc-notice-face)
7 8 (font-lock-face erc-default-face)
- 8 11 (font-lock-face erc-input-face))
+ 8 9 (font-lock-face erc-input-face)
+ 9 11 (erc--% ?m font-lock-face erc-input-face))
"Message template for echoed status messages.")
(defvar erc--message-speaker-input-chan-privmsg
#("<%p%n> %m"
0 1 (font-lock-face erc-default-face)
- 1 3 (font-lock-face erc-my-nick-prefix-face)
- 3 5 (font-lock-face erc-my-nick-face)
+ 1 3 (erc--% ?p font-lock-face erc-my-nick-prefix-face)
+ 3 5 (erc--% ?n font-lock-face erc-my-nick-face)
5 7 (font-lock-face erc-default-face)
- 7 9 (font-lock-face erc-input-face))
+ 7 9 (erc--% ?m font-lock-face erc-input-face))
"Message template for prompt input or echoed PRIVMSG from own nick.")
(defvar erc--message-speaker-input-query-privmsg
#("*%n* %m"
0 1 (font-lock-face erc-direct-msg-face)
- 1 3 (font-lock-face erc-my-nick-face)
+ 1 3 (erc--% ?n font-lock-face erc-my-nick-face)
3 5 (font-lock-face erc-direct-msg-face)
- 5 7 (font-lock-face erc-input-face))
+ 5 7 (erc--% ?m font-lock-face erc-input-face))
"Message template for prompt input or echoed PRIVMSG query from own nick.")
(defvar erc--message-speaker-input-query-notice
#("-%n- %m"
0 1 (font-lock-face erc-direct-msg-face)
- 1 3 (font-lock-face erc-my-nick-face)
+ 1 3 (erc--% ?n font-lock-face erc-my-nick-face)
3 5 (font-lock-face erc-direct-msg-face)
- 5 7 (font-lock-face erc-input-face))
+ 5 7 (erc--% ?m font-lock-face erc-input-face))
"Message template for echoed or spoofed query NOTICE from own nick.")
(defvar erc--message-speaker-input-chan-notice
#("-%p%n- %m"
0 1 (font-lock-face erc-default-face)
- 1 3 (font-lock-face erc-my-nick-prefix-face)
- 3 5 (font-lock-face erc-my-nick-face)
+ 1 3 (erc--% ?p font-lock-face erc-my-nick-prefix-face)
+ 3 5 (erc--% ?n font-lock-face erc-my-nick-face)
5 7 (font-lock-face erc-default-face)
- 7 9 (font-lock-face erc-input-face))
+ 7 9 (erc--% ?m font-lock-face erc-input-face))
"Message template for prompt input or echoed NOTICE from own nick.")
(defvar erc--message-speaker-chan-privmsg
#("<%p%n> %m"
0 1 (font-lock-face erc-default-face)
- 1 3 (font-lock-face erc-nick-prefix-face)
- 3 5 (font-lock-face erc-nick-default-face)
- 5 9 (font-lock-face erc-default-face))
+ 1 3 (erc--% ?p font-lock-face erc-nick-prefix-face)
+ 3 5 (erc--% ?n font-lock-face erc-nick-default-face)
+ 5 7 (font-lock-face erc-default-face)
+ 7 9 (erc--% ?m font-lock-face erc-default-face))
"Message template for a PRIVMSG in a channel.")
(defvar erc--message-speaker-query-privmsg
#("*%n* %m"
0 1 (font-lock-face erc-direct-msg-face)
- 1 3 (font-lock-face erc-nick-msg-face)
- 3 7 (font-lock-face erc-direct-msg-face))
+ 1 3 (erc--% ?n font-lock-face erc-nick-msg-face)
+ 3 5 (font-lock-face erc-direct-msg-face)
+ 5 7 (erc--% ?m font-lock-face erc-direct-msg-face))
"Message template for a PRIVMSG in query buffer.")
(defvar erc--message-speaker-chan-notice
#("-%p%n- %m"
0 1 (font-lock-face erc-default-face)
- 1 3 (font-lock-face erc-nick-prefix-face)
- 3 5 (font-lock-face erc-nick-default-face)
- 5 9 (font-lock-face erc-default-face))
+ 1 3 (erc--% ?p font-lock-face erc-nick-prefix-face)
+ 3 5 (erc--% ?n font-lock-face erc-nick-default-face)
+ 5 7 (font-lock-face erc-default-face)
+ 7 9 (erc--% ?m font-lock-face erc-default-face))
"Message template for a NOTICE in a channel.")
(defvar erc--message-speaker-query-notice
#("-%n- %m"
0 1 (font-lock-face erc-direct-msg-face)
- 1 3 (font-lock-face erc-nick-msg-face)
- 3 7 (font-lock-face erc-direct-msg-face))
+ 1 3 (erc--% 110 font-lock-face erc-nick-msg-face)
+ 3 5 (font-lock-face erc-direct-msg-face)
+ 5 7 (erc--% 109 font-lock-face erc-direct-msg-face))
"Message template for a NOTICE in a query buffer.")
(defvar erc--message-speaker-ctcp-action
#("* %p%n %m"
0 2 (font-lock-face erc-action-face)
- 2 4 (font-lock-face (erc-nick-prefix-face erc-action-face))
- 4 9 (font-lock-face erc-action-face))
+ 2 4 (erc--% ?p font-lock-face (erc-nick-prefix-face erc-action-face))
+ 4 6 (erc--% ?n font-lock-face erc-action-face)
+ 6 7 (font-lock-face erc-action-face)
+ 7 9 (erc--% ?m font-lock-face erc-action-face))
"Message template for a CTCP ACTION from another user.")
(defvar erc--message-speaker-ctcp-action-input
#("* %p%n %m"
0 2 (font-lock-face #1=(erc-input-face erc-action-face))
- 2 4 (font-lock-face (erc-my-nick-prefix-face . #1#))
- 4 6 (font-lock-face (erc-my-nick-face . #1#))
- 6 9 (font-lock-face #1#))
+ 2 4 (erc--% ?p font-lock-face (erc-my-nick-prefix-face . #1#))
+ 4 6 (erc--% ?n font-lock-face (erc-my-nick-face . #1#))
+ 6 7 (font-lock-face #1#)
+ 7 9 (erc--% ?m font-lock-face #1#))
"Message template for a CTCP ACTION from current client.")
(defvar erc--message-speaker-ctcp-action-statusmsg
#("* (%p%n%s) %m"
0 3 (font-lock-face erc-action-face)
- 3 5 (font-lock-face (erc-nick-prefix-face erc-action-face))
- 5 7 (font-lock-face erc-action-face)
- 7 9 (font-lock-face (erc-notice-face erc-action-face))
- 9 13 (font-lock-face erc-action-face))
+ 3 5 (erc--% ?p font-lock-face (erc-nick-prefix-face erc-action-face))
+ 5 7 (erc--% ?n font-lock-face erc-action-face)
+ 7 9 (erc--% ?s font-lock-face (erc-notice-face erc-action-face))
+ 9 11 (font-lock-face erc-action-face)
+ 11 13 (erc--% ?m font-lock-face erc-action-face))
"Template for a CTCP ACTION status message from another chan op.")
(defvar erc--message-speaker-ctcp-action-statusmsg-input
#("* (%p%n%s) %m"
0 3 (font-lock-face #1=(erc-input-face erc-action-face))
- 3 5 (font-lock-face (erc-my-nick-prefix-face . #1#))
- 5 7 (font-lock-face (erc-my-nick-face . #1#))
- 7 9 (font-lock-face (erc-notice-face . #1#))
- 9 13 (font-lock-face #1#))
+ 3 5 (erc--% ?p font-lock-face (erc-my-nick-prefix-face . #1#))
+ 5 7 (erc--% ?n font-lock-face (erc-my-nick-face . #1#))
+ 7 9 (erc--% ?s font-lock-face (erc-notice-face . #1#))
+ 9 11 (font-lock-face #1#)
+ 11 13 (erc--% ?m font-lock-face #1#))
"Template for a CTCP ACTION status message from current client.")
(defun erc--speakerize-nick (nick &optional disp)
@@ -6099,6 +6112,87 @@ erc--determine-speaker-message-format-args
?p (or prefix "") ?n (erc--speakerize-nick nick disp-nick)
?s (or statusmsg "") ?m message))
+(defun erc--mfs-get-bounds (char &optional from-pos)
+ "Return a cons cell with the bounds of CHAR's format specifier if found.
+Begin searching at FROM-POS if given. On success, ensure the
+returned pair can be used to obtain CHAR's associated specifier
+via `buffer-substring', meaning the pair's CDR is one position
+beyond the end of the substring itself."
+ (and-let* ((beg (text-property-any (or from-pos (point-min)) (point-max)
+ 'erc--% char))
+ (end (next-single-property-change beg 'erc--% nil (point-max))))
+ (cons beg end)))
+
+(defun erc--mfs-get-nth-bounds (char &optional n)
+ "Return bounds of CHAR's Nth occurrence, N=1 being the first/default."
+ (unless n (setq n 1))
+ (let (bounds)
+ (while (and (natnump (cl-decf n))
+ (setq bounds (erc--mfs-get-bounds char (cdr bounds)))))
+ bounds))
+
+(defun erc--mfs-insert-before (target string &optional afterp)
+ "Insert STRING before TARGET's format specifier.
+Expect TARGET to be the character associated with the format
+specifier to insert in front of. Or, if multiple specifiers for
+the same character exist, and the first among them isn't desired,
+expect a cons of (CHAR . N) instead. Assume STRING is either a
+plain string lacking any format specifiers or a cons of (CHAR
+. STRING-SPEC) designating exactly one character-specifier
+association for ERC to remember while formatting the current
+message, an example being (?a . \"%a\"). Move point as needed
+before inserting STRING, and return its updated value on success."
+ (let ((nth (cdr-safe target))
+ (char (car-safe string)))
+ (when nth
+ (setq target (car target)))
+ (when char
+ (setq string (cdr string)))
+ (when-let ((bounds (erc--mfs-get-nth-bounds target nth)))
+ (goto-char (if afterp (cdr bounds) (car bounds)))
+ (insert (if char (propertize string 'erc--% char) string))
+ (point))))
+
+(defun erc--msgfspec-insert-plain-before
+ (msgfspec target-char string &optional nth)
+ "Insert STRING before the first (or NTH) of TARGET-CHAR's format specifiers.
+Assume STRING does not contain a format specifier, and expect
+MSGFSPEC to be an `erc--msgfspec' object. Return point on
+success."
+ (with-current-buffer (erc--msgfspec-buffer msgfspec)
+ (erc--mfs-insert-before (if nth (cons target-char nth) target-char)
+ string)))
+
+(defun erc--msgfspec-insert-spec-before
+ (msgfspec target-char spec-char spec-string &optional nth)
+ "Insert SPEC-STRING before TARGET-CHAR's first (or NTH) format specifier.
+Assume SPEC-STRING contains a format specifier for SPEC-CHAR, and
+expect MSGFSPEC to be an `erc--msgfspec' object. Return point on
+success."
+ (with-current-buffer (erc--msgfspec-buffer msgfspec)
+ (erc--mfs-insert-before (if nth (cons target-char nth) target-char)
+ (cons spec-char spec-string))))
+
+(defun erc--msgfspec-insert-plain-after
+ (msgfspec target-char string &optional nth)
+ "Insert STRING after the first (or NTH) of TARGET-CHAR's format specifiers.
+Assume STRING does not contain a format specifier, and expect
+MSGFSPEC to be an `erc--msgfspec' object. Return point on
+success."
+ (with-current-buffer (erc--msgfspec-buffer msgfspec)
+ (erc--mfs-insert-before (if nth (cons target-char nth) target-char)
+ string 'afterp)))
+
+(defun erc--msgfspec-insert-spec-after
+ (msgfspec target-char spec-char spec-string &optional nth)
+ "Insert SPEC-STRING after TARGET-CHAR's first (or NTH) format specifier.
+Assume SPEC-STRING contains a format specifier for SPEC-CHAR, and
+expect MSGFSPEC to be an `erc--msgfspec' object. Return point on
+success."
+ (with-current-buffer (erc--msgfspec-buffer msgfspec)
+ (erc--mfs-insert-before (if nth (cons target-char nth) target-char)
+ (cons spec-char spec-string) 'afterp)))
+
(defcustom erc-show-speaker-membership-status nil
"Whether to prefix speakers with their channel status.
For example, when this option is non-nil and some nick \"Alice\"
@@ -9121,17 +9215,25 @@ erc-popup-input-buffer
;;; Message catalog
+(defvar erc--matched-message-catalog (gensym "erc-"))
+
(define-inline erc--make-message-variable-name (catalog key softp)
"Return variable name conforming to ERC's message-catalog interface.
Given a CATALOG symbol `mycat' and format-string KEY `mykey',
also a symbol, return the symbol `erc-message-mycat-mykey'. With
-SOFTP, only do so when defined as a variable."
+SOFTP, only do so when defined as a variable. As a side effect
+of SOFTP, when `erc--matched-message-catalog' is nil, set it to
+CATALOG if KEY is found."
(inline-quote
(let* ((catname (symbol-name ,catalog))
(prefix (if (eq ?- (aref catname 0)) "erc--message" "erc-message-"))
(name (concat prefix catname "-" (symbol-name ,key))))
(if ,softp
- (and-let* ((s (intern-soft name)) ((boundp s))) s)
+ (and-let* ((s (intern-soft name))
+ ((boundp s)))
+ (unless erc--matched-message-catalog
+ (setq erc--matched-message-catalog ,catalog))
+ s)
(intern name)))))
(defun erc-make-message-variable-name (catalog entry)
@@ -9331,12 +9433,20 @@ erc-format-message
See also `format-spec'."
(when (eq (logand (length args) 1) 1) ; oddp
(error "Obscure usage of this function appeared"))
- (let ((entry (erc-retrieve-catalog-entry msg)))
+ (let* ((erc--matched-message-catalog nil)
+ (entry (erc-retrieve-catalog-entry msg)))
(when (not entry)
(error "No format spec for message %s" msg))
(when (functionp entry)
(setq entry (apply entry args)))
- (format-spec entry (apply #'format-spec-make args) 'ignore)))
+ (if-let ((catalog erc--matched-message-catalog)
+ (spec-makr (get catalog 'erc-msgfspec-makr))
+ (spec-hook (get catalog 'erc-msgfspec-hook))
+ (spec-fmtr (get catalog 'erc-msgfspec-fmtr))
+ (obj (apply spec-makr msg entry args)))
+ (progn (run-hook-with-args spec-hook obj)
+ (funcall spec-fmtr obj))
+ (format-spec entry (apply #'format-spec-make args) 'ignore))))
;;; Various hook functions
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index b3912cab33d..b6bc4962a2e 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -2560,6 +2560,180 @@ erc--format-speaker-input-message
(should (equal (erc-tests--format-my-nick "oh my") expect))
(should (equal (erc--format-speaker-input-message "oh my") expect))))
+(ert-deftest erc--define-msgfspec ()
+ (when (< emacs-major-version 28)
+ (ert-skip "`get-buffer-create' lacks `inhibit-buffer-hooks'"))
+ (should
+ (equal
+ (macroexpand-1 '(erc--define-msgfspec foo
+ (?a . "Ay.")
+ (?b . "Bee.")
+ (?c . "See.")
+ (my-slot nil :type list :documentation "OK.")))
+
+ '(progn
+
+ (cl-defstruct (erc-msgfspec-foo (:include erc--msgfspec))
+ "Shared object for `foo' catalog message-format hook."
+ (\?a "" :type 'string :documentation "Ay.")
+ (\?b "" :type 'string :documentation "Bee.")
+ (\?c "" :type 'string :documentation "See.")
+ (my-slot nil :type list :documentation "OK."))
+
+ (defvar erc-msgfspec-foo-hook nil
+ "Hook run before formatting a `foo' catalog entry.
+Called by `erc-format-message' with an `erc-msgfspec-foo'
+object.")
+
+ (defun erc-msgfspec-foo-from-args (key format &rest spec-plist)
+ "Create a `erc-msgfspec-foo' object from catalog entry.
+Expect KEY to be the entry's key, FORMAT its value, and
+SPEC-PLIST the plist of `format-spec' args originally given
+to `erc-display-message'."
+ (let ((buffer (get-buffer-create
+ (format " *erc-msgfspec-foo-%s*" key) t))
+ args)
+ (with-current-buffer buffer (insert format))
+ (while-let ((spec-plist)
+ (key (pop spec-plist))
+ (val (pop spec-plist)))
+ (setq args (nconc (list (pcase key (?a :?a) (?b :?b) (?c :?c))
+ val)
+ args)))
+ (apply #'make-erc-msgfspec-foo :key key :buffer buffer args)))
+
+ (defun erc-msgfspec-foo-apply-spec (msgfspec-obj)
+ "Massage MSGFSPEC-OBJ into args for `format-spec'.
+Apply the latter after incorporating the `alist' slot
+for the current `erc-msgfspec-foo' object."
+ (format-spec (with-current-buffer (erc--msgfspec-buffer msgfspec-obj)
+ (remove-text-properties (point-min) (point-max)
+ '(erc--% nil))
+ (prog1 (buffer-string) (kill-buffer)))
+ `((?a . ,(erc-msgfspec-foo-?a msgfspec-obj))
+ (?b . ,(erc-msgfspec-foo-?b msgfspec-obj))
+ (?c . ,(erc-msgfspec-foo-?c msgfspec-obj))
+ ,@(erc-msgfspec-foo-alist msgfspec-obj))
+ 'ignore))
+
+ (put 'foo 'erc-msgfspec-makr #'erc-msgfspec-foo-from-args)
+ (put 'foo 'erc-msgfspec-fmtr 'erc-msgfspec-foo-apply-spec)
+ (put 'foo 'erc-msgfspec-hook 'erc-msgfspec-foo-hook)))))
+
+(ert-deftest erc--mfs-get-bounds ()
+ (erc-mode)
+ (should-not (erc--mfs-get-bounds ?a))
+
+ (insert (propertize "%a" 'erc--% ?a))
+ (should (equal (erc--mfs-get-bounds ?a) '(1 . 3)))
+ (should (equal (buffer-substring 1 3) "%a"))
+ (should (= (point-max) 3))
+
+ (insert (propertize "%<010b" 'erc--% ?b))
+ (should (equal (erc--mfs-get-bounds ?b) '(3 . 9)))
+ (should (equal (buffer-substring 3 9) "%<010b"))
+ (should (= (point-max) 9))
+
+ (insert (propertize "%c" 'erc--% ?c))
+ (should (equal (erc--mfs-get-bounds ?c) '(9 . 11)))
+ (should (equal (buffer-substring 9 11) "%c"))
+ (should (= (point-max) 11))
+
+ ;; With start pos.
+ (insert (propertize "%^a" 'erc--% ?a))
+ (should (equal (erc--mfs-get-bounds ?a 3) '(11 . 14)))
+ (should (equal (buffer-substring 11 14) "%^a"))
+ (should (= (point-max) 14)))
+
+(ert-deftest erc--mfs-get-nth-bounds ()
+ (erc-mode)
+
+ (should-not (erc--mfs-get-nth-bounds ?a 0))
+ (should-not (erc--mfs-get-nth-bounds ?a 1))
+
+ (insert #("%a %a" 0 2 (erc--% 97) 3 5 (erc--% 97)))
+ (should (equal (erc--mfs-get-nth-bounds ?a 1) '(1 . 3)))
+ (should (equal (erc--mfs-get-nth-bounds ?a 2) '(4 . 6))))
+
+(ert-deftest erc--mfs-insert-before () ; and *-after
+ (erc-mode)
+ (should-not (erc--mfs-insert-before ?a ""))
+
+ (insert (propertize "%a" 'erc--% ?a))
+ (should (= 2 (erc--mfs-insert-before ?a "[")))
+ (should (= 5 (erc--mfs-insert-before ?a "]" 'afterp)))
+ (should (equal (buffer-string) "[%a]"))
+
+ (should (= 10 (erc--mfs-insert-before ?a '(?b . "%<010b") 'afterp)))
+ (should (equal (buffer-string) "[%a%<010b]"))
+
+ (should (= 13 (erc--mfs-insert-before ?b '(?a . "%^a") 'afterp)))
+ (should (equal (buffer-string) "[%a%<010b%^a]"))
+
+ ;; With start pos.
+ (should (= 11 (erc--mfs-insert-before '(?a . 2) "@")))
+ (should (equal (buffer-string) "[%a%<010b@%^a]")))
+
+(ert-deftest erc--msgfspec-speaker-from-args ()
+ (erc-mode)
+ (let ((obj (erc--msgfspec-speaker-from-args
+ 'input-chan-privmsg erc--message-speaker-input-chan-privmsg
+ ?p "@" ?n "bob" ?s "" ?m "Hi.")))
+
+ (ert-info ("Plain")
+ (with-current-buffer (erc--msgfspec-buffer obj)
+ (should (equal "<%p%n> %m" (buffer-string)))
+ (should (eql 3 (erc--msgfspec-insert-plain-before obj ?p "_")))
+ (should (equal "<_%p%n> %m" (buffer-string)))
+
+ ;; Does not inherit.
+ (should (= ?_ (char-after 2)))
+ (should-not (text-properties-at 2))
+ (should (eql 6 (erc--msgfspec-insert-plain-after obj ?p "_")))
+ (should (= ?_ (char-after 5)))
+ (should-not (text-properties-at 5))
+ (should (equal "<_%p_%n> %m" (buffer-string)))))
+
+ (ert-info ("Spec")
+ (with-current-buffer (erc--msgfspec-buffer obj)
+ ;; Before.
+ (should (equal "<_%p_%n> %m" (buffer-string)))
+ (should (eql 8 (erc--msgfspec-insert-spec-before
+ obj ?n ?i (propertize "%i" 'font-lock-face 'my-face))))
+ (should (equal "<_%p_%i%n> %m" (buffer-string)))
+ (should (looking-at (rx "%n> %m")))
+ (should (erc-tests-common-equal-with-props
+ (buffer-substring 6 8)
+ #("%i" 0 2 (erc--% ?i font-lock-face my-face))))
+
+ ;; After.
+ (should (eql 12 (erc--msgfspec-insert-spec-after obj ?n ?i "%i")))
+ (should (looking-at (rx "> %m")))
+ (should (equal "<_%p_%i%n%i> %m" (buffer-string)))
+ (should (erc-tests-common-equal-with-props
+ (buffer-substring 10 12) #("%i" 0 2 (erc--% ?i))))
+
+ ;; Seek.
+ (should (eql 13 (erc--msgfspec-insert-plain-after obj ?i "_" 2)))
+ (should (looking-at (rx "> %m")))
+ (should (equal "<_%p_%i%n%i_> %m" (buffer-string)))))
+
+ (ert-info ("Render")
+ (push '(?i . "~") (erc--msgfspec-alist obj))
+ (should (erc-tests-common-equal-with-props
+ (erc--msgfspec-speaker-apply-spec obj)
+ #("<_@_~bob~_> Hi."
+ 0 1 (font-lock-face erc-default-face)
+ ;; 1 2 _
+ 2 3 (font-lock-face erc-my-nick-prefix-face)
+ ;; 3 4 _
+ 4 5 (font-lock-face my-face)
+ 5 8 (font-lock-face erc-my-nick-face)
+ ;; 8 10 ~_
+ 10 12 (font-lock-face erc-default-face)
+ 12 15 (font-lock-face erc-input-face))))
+ (should-not (buffer-live-p (erc--msgfspec-buffer obj))))))
+
(ert-deftest erc--route-insertion ()
(erc-tests-common-prep-for-insertion)
(erc-tests-common-init-server-proc "sleep" "1")
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
index feaba85ec90..2da225223ca 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero.[07:00]\n<bob> 0.5\n* bob one.\n<bob> two.\n<bob> 2.5\n* bob three\n<bob> four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 455 456 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #6#) 459 466 (wrap-prefix #1# line-prefix #6#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) display #8="") 475 478 (wrap-prefix #1# line-prefix #7# display #8#) 478 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 485 486 (wrap-prefix #1# line-prefix #9#) 486 489 (wrap-prefix #1# line-prefix #9#) 489 494 (wrap-prefix #1# line-prefix #9#) 495 496 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 496 499 (wrap-prefix #1# line-prefix #10#) 499 505 (wrap-prefix #1# line-prefix #10#) 506 507 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #8#) 507 510 (wrap-prefix #1# line-prefix #11# display #8#) 510 512 (wrap-prefix #1# line-prefix #11# display #8#) 512 515 (wrap-prefix #1# line-prefix #11#) 516 517 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #12=(space :width (- 27 (2)))) 517 518 (wrap-prefix #1# line-prefix #12#) 518 521 (wrap-prefix #1# line-prefix #12#) 521 527 (wrap-prefix #1# line-prefix #12#) 528 529 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 529 532 (wrap-prefix #1# line-prefix #13#) 532 539 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file
+#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero.[07:00]\n<bob> 0.5\n* bob one.\n<bob> two.\n<bob> 2.5\n* bob three\n<bob> four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 455 456 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #6#) 459 466 (wrap-prefix #1# line-prefix #6#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) display #8="") 475 478 (wrap-prefix #1# line-prefix #7# display #8#) 478 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 485 486 (wrap-prefix #1# line-prefix #9#) 486 489 (wrap-prefix #1# line-prefix #9#) 489 490 (wrap-prefix #1# line-prefix #9#) 490 494 (wrap-prefix #1# line-prefix #9#) 495 496 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 496 499 (wrap-prefix #1# line-prefix #10#) 499 505 (wrap-prefix #1# line-prefix #10#) 506 507 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #8#) 507 510 (wrap-prefix #1# line-prefix #11# display #8#) 510 512 (wrap-prefix #1# line-prefix #11# display #8#) 512 515 (wrap-prefix #1# line-prefix #11#) 516 517 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #12=(space :width (- 27 (2)))) 517 518 (wrap-prefix #1# line-prefix #12#) 518 521 (wrap-prefix #1# line-prefix #12#) 521 522 (wrap-prefix #1# line-prefix #12#) 522 527 (wrap-prefix #1# line-prefix #12#) 528 529 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 529 532 (wrap-prefix #1# line-prefix #13#) 532 539 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld
index ed1488c8595..d3704aa7ed9 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero.[07:00]\n<bob> 0.5\n* bob one.\n<bob> two.\n<bob> 2.5\n* bob three\n<bob> four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 455 456 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #6#) 459 466 (wrap-prefix #1# line-prefix #6#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) display #8="") 475 478 (wrap-prefix #1# line-prefix #7# display #8#) 478 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 485 486 (wrap-prefix #1# line-prefix #9#) 486 489 (wrap-prefix #1# line-prefix #9#) 489 494 (wrap-prefix #1# line-prefix #9#) 495 496 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 496 499 (wrap-prefix #1# line-prefix #10#) 499 505 (wrap-prefix #1# line-prefix #10#) 505 506 (display #("~\n" 0 2 (font-lock-face shadow))) 506 507 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #8#) 507 510 (wrap-prefix #1# line-prefix #11# display #8#) 510 512 (wrap-prefix #1# line-prefix #11# display #8#) 512 515 (wrap-prefix #1# line-prefix #11#) 516 517 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #12=(space :width (- 27 (2)))) 517 518 (wrap-prefix #1# line-prefix #12#) 518 521 (wrap-prefix #1# line-prefix #12#) 521 527 (wrap-prefix #1# line-prefix #12#) 528 529 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 529 532 (wrap-prefix #1# line-prefix #13#) 532 539 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file
+#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero.[07:00]\n<bob> 0.5\n* bob one.\n<bob> two.\n<bob> 2.5\n* bob three\n<bob> four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 455 456 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #6#) 459 466 (wrap-prefix #1# line-prefix #6#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) display #8="") 475 478 (wrap-prefix #1# line-prefix #7# display #8#) 478 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 485 486 (wrap-prefix #1# line-prefix #9#) 486 489 (wrap-prefix #1# line-prefix #9#) 489 490 (wrap-prefix #1# line-prefix #9#) 490 494 (wrap-prefix #1# line-prefix #9#) 495 496 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 496 499 (wrap-prefix #1# line-prefix #10#) 499 505 (wrap-prefix #1# line-prefix #10#) 505 506 (display #("~\n" 0 2 (font-lock-face shadow))) 506 507 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #8#) 507 510 (wrap-prefix #1# line-prefix #11# display #8#) 510 512 (wrap-prefix #1# line-prefix #11# display #8#) 512 515 (wrap-prefix #1# line-prefix #11#) 516 517 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #12=(space :width (- 27 (2)))) 517 518 (wrap-prefix #1# line-prefix #12#) 518 521 (wrap-prefix #1# line-prefix #12#) 521 522 (wrap-prefix #1# line-prefix #12#) 522 527 (wrap-prefix #1# line-prefix #12#) 528 529 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 529 532 (wrap-prefix #1# line-prefix #13#) 532 539 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld
index a3530a6c44d..e280e654f11 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero.[07:00]\n<bob> 0.5\n* bob one.\n<bob> two.\n<bob> 2.5\n* bob three\n<bob> four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 455 456 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #6#) 459 466 (wrap-prefix #1# line-prefix #6#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 #10=(2))) display #8=#("> " 0 1 (font-lock-face shadow))) 475 478 (wrap-prefix #1# line-prefix #7# display #8#) 478 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 485 486 (wrap-prefix #1# line-prefix #9#) 486 489 (wrap-prefix #1# line-prefix #9#) 489 494 (wrap-prefix #1# line-prefix #9#) 495 496 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 (6)))) 496 499 (wrap-prefix #1# line-prefix #11#) 499 505 (wrap-prefix #1# line-prefix #11#) 506 507 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 #10#)) display #8#) 507 510 (wrap-prefix #1# line-prefix #12# display #8#) 510 512 (wrap-prefix #1# line-prefix #12# display #8#) 512 515 (wrap-prefix #1# line-prefix #12#) 516 517 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #13=(space :width (- 27 (2)))) 517 518 (wrap-prefix #1# line-prefix #13#) 518 521 (wrap-prefix #1# line-prefix #13#) 521 527 (wrap-prefix #1# line-prefix #13#) 528 529 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #14=(space :width (- 27 (6)))) 529 532 (wrap-prefix #1# line-prefix #14#) 532 539 (wrap-prefix #1# line-prefix #14#))
\ No newline at end of file
+#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero.[07:00]\n<bob> 0.5\n* bob one.\n<bob> two.\n<bob> 2.5\n* bob three\n<bob> four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 455 456 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #6#) 459 466 (wrap-prefix #1# line-prefix #6#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 #10=(2))) display #8=#("> " 0 1 (font-lock-face shadow))) 475 478 (wrap-prefix #1# line-prefix #7# display #8#) 478 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 485 486 (wrap-prefix #1# line-prefix #9#) 486 489 (wrap-prefix #1# line-prefix #9#) 489 490 (wrap-prefix #1# line-prefix #9#) 490 494 (wrap-prefix #1# line-prefix #9#) 495 496 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 (6)))) 496 499 (wrap-prefix #1# line-prefix #11#) 499 505 (wrap-prefix #1# line-prefix #11#) 506 507 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 #10#)) display #8#) 507 510 (wrap-prefix #1# line-prefix #12# display #8#) 510 512 (wrap-prefix #1# line-prefix #12# display #8#) 512 515 (wrap-prefix #1# line-prefix #12#) 516 517 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #13=(space :width (- 27 (2)))) 517 518 (wrap-prefix #1# line-prefix #13#) 518 521 (wrap-prefix #1# line-prefix #13#) 521 522 (wrap-prefix #1# line-prefix #13#) 522 527 (wrap-prefix #1# line-prefix #13#) 528 529 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #14=(space :width (- 27 (6)))) 529 532 (wrap-prefix #1# line-prefix #14#) 532 539 (wrap-prefix #1# line-prefix #14#))
\ No newline at end of file
--
2.42.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-5.6-Add-replacement-text-field-to-erc-input-struct.patch --]
[-- Type: text/x-patch, Size: 11521 bytes --]
From 673a6d7f99d5e2cae263cc919b03ea29f7163f2e Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 1 Jan 2024 06:37:25 -0800
Subject: [PATCH 1/2] [5.6] Add replacement-text field to erc-input struct
* etc/ERC-NEWS: Promote `refoldp' slot from simulated to real.
* lisp/erc/erc-common.el (erc-input): Add `substxt' and `refoldp'
slots.
(erc--input-split): Move `refoldp' to "superclass".
* lisp/erc/erc-goodies.el (erc--command-indicator-permit-insertion):
Use `substxt' field instead of `insertp'.
(erc--command-indicator-display): Accept extra lines.
* lisp/erc/erc.el (erc-pre-send-functions): Revise doc.
(erc--input-ensure-hook-context, erc-input-refoldp): Remove unused
functions.
(erc--run-send-hooks): Copy data from additional fields of `erc-input'
object to `erc--input-split' object.
(erc--send-input-lines): Handle `substxt' field of `erc-input' object
when it's non-nil. (Bug#68265)
---
etc/ERC-NEWS | 14 +++++--
lisp/erc/erc-common.el | 19 ++++++++-
lisp/erc/erc-goodies.el | 7 +++-
lisp/erc/erc.el | 89 +++++++++++++++++++----------------------
4 files changed, 74 insertions(+), 55 deletions(-)
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 6cfa704d995..2adcc9ab9f4 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -570,9 +570,17 @@ ERC now adjusts input lines to fall within allowed length limits
before showing hook members the result. For compatibility,
third-party code can request that the final input be adjusted again
prior to being sent. To facilitate this, the 'erc-input' object
-shared among hook members has gained a "phony" 'refoldp' slot that's
-only accessible from 'erc-pre-send-functions'. See doc string for
-details.
+shared among hook members has gained a 'refoldp' slot. See doc string
+for details.
+
+*** More flexibility in sending and displaying prompt input.
+The abnormal hook 'erc-pre-send-functions' previously married outgoing
+message text to its inserted representation in an ERC target buffer.
+Going forward, users can populate the new slot 'substxt' with
+alternate text to insert in place of the 'string' slot's contents,
+which ERC still sends to the server. This dichotomy lets users
+completely avoid the often fiddly 'erc-send-modify-hook' and friends
+for use cases like language translation and subprotocol encoding.
*** ERC's prompt survives the insertion of user input and messages.
Previously, ERC's prompt and its input marker disappeared while
diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index e7e70fffd3a..30ce0a0bb1a 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -49,7 +49,23 @@ erc-session-server
(declare-function widget-type "wid-edit" (widget))
(cl-defstruct erc-input
- string insertp sendp)
+ "Object shared among members of `erc-pre-send-functions'.
+Any use outside of the hook is not supported."
+ ( string "" :type string
+ :documentation "String to send and, without `substxt', insert.
+ERC treats separate lines as separate messages.")
+ ( insertp nil :type boolean
+ :documentation "Whether to insert outgoing message.
+When nil, ERC still sends `string'.")
+ ( sendp nil :type boolean
+ :documentation "Whether to send and (for compat reasons) insert.
+To insert without sending, define a (slash) command.")
+ ( substxt nil :type (or function string null)
+ :documentation "Alternate string to insert without splitting.
+The function form is for internal use.")
+ ( refoldp nil :type boolean
+ :documentation "Whether to resplit a possibly overlong `string'.
+ERC only refolds `string', never `substxt'."))
(cl-defstruct (erc--input-split (:include erc-input
(string "" :read-only t)
@@ -57,7 +73,6 @@ erc-input
(sendp (with-suppressed-warnings
((obsolete erc-send-this))
erc-send-this))))
- (refoldp nil :type boolean)
(lines nil :type (list-of string))
(abortp nil :type (list-of symbol))
(cmdp nil :type boolean))
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index 23589657b2d..3434280bbb4 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -583,15 +583,18 @@ erc--command-indicator-permit-insertion
"Insert `erc-input' STATE's message if it's an echoed command."
(cl-assert erc-command-indicator-mode)
(when (erc--input-split-cmdp state)
- (setf (erc--input-split-insertp state) #'erc--command-indicator-display)
+ (setf (erc--input-split-insertp state) t
+ (erc--input-split-substxt state) #'erc--command-indicator-display)
(erc-send-distinguish-noncommands state)))
;; This function used to be called `erc-display-command'. It was
;; neutered in ERC 5.3.x (Emacs 24.5), commented out in 5.4, removed
;; in 5.5, and restored in 5.6.
-(defun erc--command-indicator-display (line)
+(defun erc--command-indicator-display (line &rest rest)
"Insert command LINE as echoed input resembling that of REPLs and shells."
(when erc-insert-this
+ (when rest
+ (setq line (string-join (cons line rest) "\n")))
(save-excursion
(erc--assert-input-bounds)
(let ((insert-position (marker-position (goto-char erc-insert-marker)))
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 478683a77f5..00963d24a32 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1211,30 +1211,30 @@ erc-send-pre-hook
(make-obsolete-variable 'erc-send-pre-hook 'erc-pre-send-functions "27.1")
(defcustom erc-pre-send-functions nil
- "Special hook run to possibly alter the string that is sent.
-The functions are called with one argument, an `erc-input' struct,
-and should alter that struct.
+ "Special hook to possibly alter the string to send and insert.
+ERC calls the member functions with one argument, an `erc-input'
+struct instance to modify as needed.
-The struct has three slots:
-
- `string': The current input string.
- `insertp': Whether the string should be inserted into the erc buffer.
- `sendp': Whether the string should be sent to the irc server.
-
-And one \"phony\" slot only accessible by hook members at runtime:
+The struct has five slots:
- `refoldp': Whether the string should be re-split per protocol limits.
+ `string': String to send, originally from prompt input.
+ `insertp': Whether a string should be inserted in the buffer.
+ `sendp': Whether `string' should be sent to the IRC server.
+ `substxt': String to display (but not send) instead of `string'.
+ `refoldp': Whether to re-split `string' per protocol limits.
This hook runs after protocol line splitting has taken place, so
-the value of `string' is originally \"pre-filled\". If you need
-ERC to refill the entire payload before sending it, set the phony
-`refoldp' slot to a non-nil value. Note that this refilling is
-only a convenience, and modules with special needs, such as
-preserving \"preformatted\" text or encoding for subprotocol
-\"tunneling\", should handle splitting manually."
- :group 'erc
- :type 'hook
- :version "27.1")
+the value of `string' comes \"pre-split\" according to the option
+`erc-split-line-length'. If you need ERC to refill the entire
+payload before sending it, set the `refoldp' slot to a non-nil
+value. Note that this refilling is only a convenience, and
+modules with special needs, such as preserving \"preformatted\"
+text or encoding for subprotocol \"tunneling\", should handle
+splitting manually and possibly also specify replacement text to
+display via the `substxt' slot."
+ :package-version '(ERC . "5.3")
+ :group 'erc-hooks
+ :type 'hook)
(define-obsolete-variable-alias 'erc--pre-send-split-functions
'erc--input-review-functions "30.1")
@@ -7825,22 +7825,6 @@ erc--split-lines
(setf (erc--input-split-lines state)
(mapcan #'erc--split-line (erc--input-split-lines state)))))
-(defun erc--input-ensure-hook-context ()
- (unless (erc--input-split-p erc--current-line-input-split)
- (error "Invoked outside of `erc-pre-send-functions'")))
-
-(defun erc-input-refoldp (_)
- "Impersonate accessor for phony `erc-input' `refoldp' slot.
-This function only works inside `erc-pre-send-functions' members."
- (declare (gv-setter (lambda (v)
- `(progn
- (erc--input-ensure-hook-context)
- (setf (erc--input-split-refoldp
- erc--current-line-input-split)
- ,v)))))
- (erc--input-ensure-hook-context)
- (erc--input-split-refoldp erc--current-line-input-split))
-
(defun erc--run-send-hooks (lines-obj)
"Run send-related hooks that operate on the entire prompt input.
Sequester some of the back and forth involved in honoring old
@@ -7858,12 +7842,17 @@ erc--run-send-hooks
(state (progn
;; This may change `str' and `erc-*-this'.
(run-hook-with-args 'erc-send-pre-hook str)
- (make-erc-input :string str
- :insertp erc-insert-this
- :sendp erc-send-this))))
+ (make-erc-input
+ :string str
+ :insertp erc-insert-this
+ :sendp erc-send-this
+ :substxt (erc--input-split-substxt lines-obj)
+ :refoldp (erc--input-split-refoldp lines-obj)))))
(run-hook-with-args 'erc-pre-send-functions state)
(setf (erc--input-split-sendp lines-obj) (erc-input-sendp state)
(erc--input-split-insertp lines-obj) (erc-input-insertp state)
+ (erc--input-split-substxt lines-obj) (erc-input-substxt state)
+ (erc--input-split-refoldp lines-obj) (erc-input-refoldp state)
;; See note in test of same name re trailing newlines.
(erc--input-split-lines lines-obj)
(let ((lines (split-string (erc-input-string state)
@@ -7881,15 +7870,19 @@ erc--run-send-hooks
(defun erc--send-input-lines (lines-obj)
"Send lines in `erc--input-split-lines' object LINES-OBJ."
(when (erc--input-split-sendp lines-obj)
- (dolist (line (erc--input-split-lines lines-obj))
- (when (erc--input-split-insertp lines-obj)
- (if (eq (erc--input-split-insertp lines-obj)
- 'erc--command-indicator-display)
- (funcall (erc--input-split-insertp lines-obj) line)
- (erc-display-msg line)))
- (erc-process-input-line (concat line "\n")
- (null erc-flood-protect)
- (not (erc--input-split-cmdp lines-obj))))))
+ (let ((insertp (erc--input-split-insertp lines-obj))
+ (substxt (erc--input-split-substxt lines-obj)))
+ (when (and insertp substxt)
+ (setq insertp nil)
+ (if (functionp substxt)
+ (apply substxt (erc--input-split-lines lines-obj))
+ (erc-display-msg substxt)))
+ (dolist (line (erc--input-split-lines lines-obj))
+ (when insertp
+ (erc-display-msg line))
+ (erc-process-input-line (concat line "\n")
+ (null erc-flood-protect)
+ (not (erc--input-split-cmdp lines-obj)))))))
(defun erc-send-input (input &optional skip-ws-chk)
"Treat INPUT as typed in by the user.
--
2.42.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-5.6-Expose-catalog-specific-message-formatter-in-ERC.patch --]
[-- Type: text/x-patch, Size: 55568 bytes --]
From 9bb8693156326cf3ef33f9ccf1e6b4bbbcf9ed61 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Tue, 9 Jan 2024 06:54:18 -0800
Subject: [PATCH 2/2] [5.6] Expose catalog-specific message formatter in ERC
* lisp/erc/erc-common.el (erc--msgfspec): New struct to support
"msgfspec" interface.
(erc--define-msgfspec): New macro for defining items needed to support
the "msgfspec" interface. These can of course be defined manually.
(erc--msgfspec-speaker): New struct for `speaker' catalog
implementation of "msgfspec" interface.
(erc--msgfspec-speaker-hook): New variable.
(erc--msgfspec-speaker-from-args): New function, an alternate
constructor for `make-erc--msgfspec-speaker.
(erc--msgfspec-speaker-apply-spec): New function, a "formatter"
for the "msgfspec" interface.
* lisp/erc/erc.el
(erc--message-speaker-statusmsg, erc--message-speaker-statusmsg-input,
erc--message-speaker-input-chan-privmsg,
erc--message-speaker-input-query-privmsg,
erc--message-speaker-input-query-notice,
erc--message-speaker-input-chan-notice,
erc--message-speaker-chan-privmsg, erc--message-speaker-query-privmsg,
erc--message-speaker-chan-notice, erc--message-speaker-query-notice,
erc--message-speaker-ctcp-action,
erc--message-speaker-ctcp-action-input,
erc--message-speaker-ctcp-action-statusmsg,
erc--message-speaker-ctcp-action-statusmsg-input): Update variable
values to include tracer sentinels in the form of `erc--%' text props
that correspond to each template's format specifiers. They are
removed during formatting and serve to help hook members splice,
excise, and interrogate a shared copy of the template.
(erc--mfs-get-bounds, erc--mfs-get-nth-bounds, erc--mfs-insert-before,
erc--msgfspec-insert-plain-before, erc--msgfspec-insert-spec-before,
erc--msgfspec-insert-plain-after, erc--msgfspec-insert-spec-after):
New utility functions and internal helpers to assist hook members in
manipulating the working template prior to formatting.
(erc--matched-message-catalog): New variable.
(erc--make-message-variable-name): Assign matched catalog to
`erc--matched-message-catalog' when it's nil, which indicates it's
been let-bound somewhere back in the call stack.
(erc-format-message): Run catalog-specific message-formatting handler
when defined.
* test/lisp/erc/erc-tests.el (erc--define-msgfspec,
erc--mfs-get-bounds,
erc--mfs-insert-before,
erc--msgfspec-speaker-from-args): New tests. (Bug#67677) (Bug#68265)
; * test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld: Update.
; * test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld:
; Update.
; * test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld:
; Update.
---
lisp/erc/erc-common.el | 107 ++++++++++
lisp/erc/erc.el | 200 ++++++++++++++----
test/lisp/erc/erc-tests.el | 174 +++++++++++++++
.../fill/snapshots/merge-wrap-01.eld | 2 +-
.../merge-wrap-indicator-post-01.eld | 2 +-
.../snapshots/merge-wrap-indicator-pre-01.eld | 2 +-
6 files changed, 439 insertions(+), 48 deletions(-)
diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index 30ce0a0bb1a..eee06a3fde9 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -165,6 +165,113 @@ erc--isupport-data
(table (make-char-table 'erc--channel-mode-types) :type char-table)
(shortargs (make-hash-table :test #'equal)))
+(cl-defstruct erc--msgfspec
+ "Abstract struct for object shared among message-format hook members."
+ ( key nil :type symbol
+ :documentation "Catalog entry key, a symbol.")
+ ( buffer nil :type (or buffer null)
+ :documentation "Buffer with catalog entry value, a template string.")
+ ( alist nil :type list
+ :documentation "Extra items for `format-spec' SPECIFICATION."))
+
+(defmacro erc--define-msgfspec (catalog &rest slots)
+ "Define items that satisfy the \"erc-msgfspec\" interface.
+Expect symbol CATALOG to be the name of a message-format catalog
+and SLOTS to be an alist of (CHAR . DOC), where CHAR is a
+`format-spec' character and DOC is a string explaining its role.
+Using these, define a \"msgfspec\" data struct named
+\"erc-msgfspec-CATALOG\", with massaged SLOTS becoming its
+string-typed fields. Arrange for each field to be DOC'umented
+and accessed by a function named \"erc-msgfspec-CATALOG-?CHAR\"
+\(note the question mark). Additionally, create a constructor
+for the struct, named \"erc-msgfspec-CATALOG-from-args\", along
+with a hook variable named \"erc-msgfspec-CATALOG-hook\". Also
+define a wrapper named \"erc-msgfspec-CATALOG-apply-spec\" to
+allow the `erc-display-message' machinery to call `format-spec'
+with a specification alist derived from the struct instance
+passed around and potentially influenced by each hook member."
+ (declare (indent 1)
+ (debug (symbolp (&rest &or symbolp (symbolp &rest sexp)))))
+ (let* ((chars)
+ (specs (let (out)
+ (while-let (((characterp (car-safe (car-safe slots))))
+ (spec (pop slots))
+ (char (car spec)))
+ (cl-assert (stringp (cdr spec)))
+ (push `(,(intern (format "?%c" char)) ""
+ :type 'string :documentation ,(cdr spec))
+ out)
+ (push char chars))
+ (setq chars (nreverse chars))
+ (nreverse out)))
+ (internalp (eq ?- (aref (symbol-name catalog) 0)))
+ (name (if internalp
+ (substring (symbol-name catalog) 1)
+ (symbol-name catalog)))
+ (full-name (concat "erc-" (if internalp "-" "") "msgfspec-" name))
+ (hook (intern (concat full-name "-hook")))
+ (makr (intern (concat full-name "-from-args")))
+ (fmtr (intern (concat full-name "-apply-spec")))
+ (setters (mapcar (lambda (letr)
+ (list letr '\,
+ `(,(intern (format "%s-?%c" full-name letr))
+ msgfspec-obj)))
+ chars))
+ (choices (mapcar (lambda (letr)
+ (list letr (intern (format ":?%c" letr))))
+ chars)))
+ `(progn
+
+ (cl-defstruct (,(intern full-name) (:include erc--msgfspec))
+ ,(concat "Shared object for `" name
+ "' catalog message-format hook.")
+ ,@specs
+ ,@slots)
+
+ (defvar ,hook nil
+ ,(concat "Hook run before formatting a `" name "' catalog entry."
+ "\nCalled by `erc-format-message' with an `"
+ full-name "'\nobject."))
+
+ (defun ,makr (key format &rest spec-plist)
+ ,(concat "Create a `" full-name "' object from catalog entry."
+ "\nExpect KEY to be the entry's key, FORMAT its value, and"
+ "\nSPEC-PLIST the plist of `format-spec' args originally"
+ " given" ; continued
+ "\nto `erc-display-message'.")
+ (let ((buffer (get-buffer-create
+ (format ,(concat " *" full-name "-%s*") key)
+ ,@(and (>= emacs-major-version 28) '(t))))
+ args)
+ (with-current-buffer buffer (insert format))
+ (while-let ((spec-plist)
+ (key (pop spec-plist))
+ (val (pop spec-plist)))
+ (setq args (nconc (list (pcase key ,@choices) val) args)))
+ (apply #',(intern (concat "make-" full-name))
+ :key key :buffer buffer args)))
+ (defun ,fmtr (msgfspec-obj)
+ ,(concat "Massage MSGFSPEC-OBJ into args for `format-spec'."
+ "\nApply the latter after incorporating the `alist' slot"
+ "\nfor the current `" full-name "' object.")
+ (format-spec (with-current-buffer (erc--msgfspec-buffer msgfspec-obj)
+ (remove-text-properties (point-min) (point-max)
+ '(erc--% nil))
+ (prog1 (buffer-string) (kill-buffer)))
+ (,'\`(,@setters
+ (,'\,@ (,(intern (concat full-name "-alist"))
+ msgfspec-obj))))
+ 'ignore))
+ (put ',catalog 'erc-msgfspec-makr #',makr)
+ (put ',catalog 'erc-msgfspec-fmtr ',fmtr)
+ (put ',catalog 'erc-msgfspec-hook ',hook))))
+
+(erc--define-msgfspec -speaker
+ (?n . "Nickname.")
+ (?m . "Message body.")
+ (?p . "Channel-membership prefix.")
+ (?s . "STATUSMSG prefix."))
+
;; After dropping 28, we can use prefixed "erc-autoload" cookies.
(defun erc--normalize-module-symbol (symbol)
"Return preferred SYMBOL for `erc--modules'."
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 00963d24a32..f80bafa42b9 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -5924,121 +5924,134 @@ erc-format-privmessage
;; The format strings in the following `-speaker' catalog shouldn't
;; contain any non-protocol words, so they make sense in any language.
+;; Intervals with a format-spec specifier % ... c must have the text
+;; property (erc--% . ?c) so that msgfspec-related code can find it.
(defvar erc--message-speaker-statusmsg
#("(%p%n%s) %m"
0 1 (font-lock-face erc-default-face)
- 1 3 (font-lock-face erc-nick-prefix-face)
- 3 5 (font-lock-face erc-nick-default-face)
- 5 7 (font-lock-face erc-notice-face)
- 7 11 (font-lock-face erc-default-face))
+ 1 3 (erc--% ?p font-lock-face erc-nick-prefix-face)
+ 3 5 (erc--% ?n font-lock-face erc-nick-default-face)
+ 5 7 (erc--% ?s font-lock-face erc-notice-face)
+ 7 9 (font-lock-face erc-default-face)
+ 9 11 (erc--% ?m font-lock-face erc-default-face))
"Message template for in-channel status messages.")
(defvar erc--message-speaker-statusmsg-input
#("(%p%n%s) %m"
0 1 (font-lock-face erc-default-face)
- 1 3 (font-lock-face erc-my-nick-prefix-face)
- 3 5 (font-lock-face erc-my-nick-face)
- 5 7 (font-lock-face erc-notice-face)
+ 1 3 (erc--% ?p font-lock-face erc-my-nick-prefix-face)
+ 3 5 (erc--% ?n font-lock-face erc-my-nick-face)
+ 5 7 (erc--% ?s font-lock-face erc-notice-face)
7 8 (font-lock-face erc-default-face)
- 8 11 (font-lock-face erc-input-face))
+ 8 9 (font-lock-face erc-input-face)
+ 9 11 (erc--% ?m font-lock-face erc-input-face))
"Message template for echoed status messages.")
(defvar erc--message-speaker-input-chan-privmsg
#("<%p%n> %m"
0 1 (font-lock-face erc-default-face)
- 1 3 (font-lock-face erc-my-nick-prefix-face)
- 3 5 (font-lock-face erc-my-nick-face)
+ 1 3 (erc--% ?p font-lock-face erc-my-nick-prefix-face)
+ 3 5 (erc--% ?n font-lock-face erc-my-nick-face)
5 7 (font-lock-face erc-default-face)
- 7 9 (font-lock-face erc-input-face))
+ 7 9 (erc--% ?m font-lock-face erc-input-face))
"Message template for prompt input or echoed PRIVMSG from own nick.")
(defvar erc--message-speaker-input-query-privmsg
#("*%n* %m"
0 1 (font-lock-face erc-direct-msg-face)
- 1 3 (font-lock-face erc-my-nick-face)
+ 1 3 (erc--% ?n font-lock-face erc-my-nick-face)
3 5 (font-lock-face erc-direct-msg-face)
- 5 7 (font-lock-face erc-input-face))
+ 5 7 (erc--% ?m font-lock-face erc-input-face))
"Message template for prompt input or echoed PRIVMSG query from own nick.")
(defvar erc--message-speaker-input-query-notice
#("-%n- %m"
0 1 (font-lock-face erc-direct-msg-face)
- 1 3 (font-lock-face erc-my-nick-face)
+ 1 3 (erc--% ?n font-lock-face erc-my-nick-face)
3 5 (font-lock-face erc-direct-msg-face)
- 5 7 (font-lock-face erc-input-face))
+ 5 7 (erc--% ?m font-lock-face erc-input-face))
"Message template for echoed or spoofed query NOTICE from own nick.")
(defvar erc--message-speaker-input-chan-notice
#("-%p%n- %m"
0 1 (font-lock-face erc-default-face)
- 1 3 (font-lock-face erc-my-nick-prefix-face)
- 3 5 (font-lock-face erc-my-nick-face)
+ 1 3 (erc--% ?p font-lock-face erc-my-nick-prefix-face)
+ 3 5 (erc--% ?n font-lock-face erc-my-nick-face)
5 7 (font-lock-face erc-default-face)
- 7 9 (font-lock-face erc-input-face))
+ 7 9 (erc--% ?m font-lock-face erc-input-face))
"Message template for prompt input or echoed NOTICE from own nick.")
(defvar erc--message-speaker-chan-privmsg
#("<%p%n> %m"
0 1 (font-lock-face erc-default-face)
- 1 3 (font-lock-face erc-nick-prefix-face)
- 3 5 (font-lock-face erc-nick-default-face)
- 5 9 (font-lock-face erc-default-face))
+ 1 3 (erc--% ?p font-lock-face erc-nick-prefix-face)
+ 3 5 (erc--% ?n font-lock-face erc-nick-default-face)
+ 5 7 (font-lock-face erc-default-face)
+ 7 9 (erc--% ?m font-lock-face erc-default-face))
"Message template for a PRIVMSG in a channel.")
(defvar erc--message-speaker-query-privmsg
#("*%n* %m"
0 1 (font-lock-face erc-direct-msg-face)
- 1 3 (font-lock-face erc-nick-msg-face)
- 3 7 (font-lock-face erc-direct-msg-face))
+ 1 3 (erc--% ?n font-lock-face erc-nick-msg-face)
+ 3 5 (font-lock-face erc-direct-msg-face)
+ 5 7 (erc--% ?m font-lock-face erc-direct-msg-face))
"Message template for a PRIVMSG in query buffer.")
(defvar erc--message-speaker-chan-notice
#("-%p%n- %m"
0 1 (font-lock-face erc-default-face)
- 1 3 (font-lock-face erc-nick-prefix-face)
- 3 5 (font-lock-face erc-nick-default-face)
- 5 9 (font-lock-face erc-default-face))
+ 1 3 (erc--% ?p font-lock-face erc-nick-prefix-face)
+ 3 5 (erc--% ?n font-lock-face erc-nick-default-face)
+ 5 7 (font-lock-face erc-default-face)
+ 7 9 (erc--% ?m font-lock-face erc-default-face))
"Message template for a NOTICE in a channel.")
(defvar erc--message-speaker-query-notice
#("-%n- %m"
0 1 (font-lock-face erc-direct-msg-face)
- 1 3 (font-lock-face erc-nick-msg-face)
- 3 7 (font-lock-face erc-direct-msg-face))
+ 1 3 (erc--% 110 font-lock-face erc-nick-msg-face)
+ 3 5 (font-lock-face erc-direct-msg-face)
+ 5 7 (erc--% 109 font-lock-face erc-direct-msg-face))
"Message template for a NOTICE in a query buffer.")
(defvar erc--message-speaker-ctcp-action
#("* %p%n %m"
0 2 (font-lock-face erc-action-face)
- 2 4 (font-lock-face (erc-nick-prefix-face erc-action-face))
- 4 9 (font-lock-face erc-action-face))
+ 2 4 (erc--% ?p font-lock-face (erc-nick-prefix-face erc-action-face))
+ 4 6 (erc--% ?n font-lock-face erc-action-face)
+ 6 7 (font-lock-face erc-action-face)
+ 7 9 (erc--% ?m font-lock-face erc-action-face))
"Message template for a CTCP ACTION from another user.")
(defvar erc--message-speaker-ctcp-action-input
#("* %p%n %m"
0 2 (font-lock-face #1=(erc-input-face erc-action-face))
- 2 4 (font-lock-face (erc-my-nick-prefix-face . #1#))
- 4 6 (font-lock-face (erc-my-nick-face . #1#))
- 6 9 (font-lock-face #1#))
+ 2 4 (erc--% ?p font-lock-face (erc-my-nick-prefix-face . #1#))
+ 4 6 (erc--% ?n font-lock-face (erc-my-nick-face . #1#))
+ 6 7 (font-lock-face #1#)
+ 7 9 (erc--% ?m font-lock-face #1#))
"Message template for a CTCP ACTION from current client.")
(defvar erc--message-speaker-ctcp-action-statusmsg
#("* (%p%n%s) %m"
0 3 (font-lock-face erc-action-face)
- 3 5 (font-lock-face (erc-nick-prefix-face erc-action-face))
- 5 7 (font-lock-face erc-action-face)
- 7 9 (font-lock-face (erc-notice-face erc-action-face))
- 9 13 (font-lock-face erc-action-face))
+ 3 5 (erc--% ?p font-lock-face (erc-nick-prefix-face erc-action-face))
+ 5 7 (erc--% ?n font-lock-face erc-action-face)
+ 7 9 (erc--% ?s font-lock-face (erc-notice-face erc-action-face))
+ 9 11 (font-lock-face erc-action-face)
+ 11 13 (erc--% ?m font-lock-face erc-action-face))
"Template for a CTCP ACTION status message from another chan op.")
(defvar erc--message-speaker-ctcp-action-statusmsg-input
#("* (%p%n%s) %m"
0 3 (font-lock-face #1=(erc-input-face erc-action-face))
- 3 5 (font-lock-face (erc-my-nick-prefix-face . #1#))
- 5 7 (font-lock-face (erc-my-nick-face . #1#))
- 7 9 (font-lock-face (erc-notice-face . #1#))
- 9 13 (font-lock-face #1#))
+ 3 5 (erc--% ?p font-lock-face (erc-my-nick-prefix-face . #1#))
+ 5 7 (erc--% ?n font-lock-face (erc-my-nick-face . #1#))
+ 7 9 (erc--% ?s font-lock-face (erc-notice-face . #1#))
+ 9 11 (font-lock-face #1#)
+ 11 13 (erc--% ?m font-lock-face #1#))
"Template for a CTCP ACTION status message from current client.")
(defun erc--speakerize-nick (nick &optional disp)
@@ -6099,6 +6112,87 @@ erc--determine-speaker-message-format-args
?p (or prefix "") ?n (erc--speakerize-nick nick disp-nick)
?s (or statusmsg "") ?m message))
+(defun erc--mfs-get-bounds (char &optional from-pos)
+ "Return a cons cell with the bounds of CHAR's format specifier if found.
+Begin searching at FROM-POS if given. On success, ensure the
+returned pair can be used to obtain CHAR's associated specifier
+via `buffer-substring', meaning the pair's CDR is one position
+beyond the end of the substring itself."
+ (and-let* ((beg (text-property-any (or from-pos (point-min)) (point-max)
+ 'erc--% char))
+ (end (next-single-property-change beg 'erc--% nil (point-max))))
+ (cons beg end)))
+
+(defun erc--mfs-get-nth-bounds (char &optional n)
+ "Return bounds of CHAR's Nth occurrence, N=1 being the first/default."
+ (unless n (setq n 1))
+ (let (bounds)
+ (while (and (natnump (cl-decf n))
+ (setq bounds (erc--mfs-get-bounds char (cdr bounds)))))
+ bounds))
+
+(defun erc--mfs-insert-before (target string &optional afterp)
+ "Insert STRING before TARGET's format specifier.
+Expect TARGET to be the character associated with the format
+specifier to insert in front of. Or, if multiple specifiers for
+the same character exist, and the first among them isn't desired,
+expect a cons of (CHAR . N) instead. Assume STRING is either a
+plain string lacking any format specifiers or a cons of (CHAR
+. STRING-SPEC) designating exactly one character-specifier
+association for ERC to remember while formatting the current
+message, an example being (?a . \"%a\"). Move point as needed
+before inserting STRING, and return its updated value on success."
+ (let ((nth (cdr-safe target))
+ (char (car-safe string)))
+ (when nth
+ (setq target (car target)))
+ (when char
+ (setq string (cdr string)))
+ (when-let ((bounds (erc--mfs-get-nth-bounds target nth)))
+ (goto-char (if afterp (cdr bounds) (car bounds)))
+ (insert (if char (propertize string 'erc--% char) string))
+ (point))))
+
+(defun erc--msgfspec-insert-plain-before
+ (msgfspec target-char string &optional nth)
+ "Insert STRING before the first (or NTH) of TARGET-CHAR's format specifiers.
+Assume STRING does not contain a format specifier, and expect
+MSGFSPEC to be an `erc--msgfspec' object. Return point on
+success."
+ (with-current-buffer (erc--msgfspec-buffer msgfspec)
+ (erc--mfs-insert-before (if nth (cons target-char nth) target-char)
+ string)))
+
+(defun erc--msgfspec-insert-spec-before
+ (msgfspec target-char spec-char spec-string &optional nth)
+ "Insert SPEC-STRING before TARGET-CHAR's first (or NTH) format specifier.
+Assume SPEC-STRING contains a format specifier for SPEC-CHAR, and
+expect MSGFSPEC to be an `erc--msgfspec' object. Return point on
+success."
+ (with-current-buffer (erc--msgfspec-buffer msgfspec)
+ (erc--mfs-insert-before (if nth (cons target-char nth) target-char)
+ (cons spec-char spec-string))))
+
+(defun erc--msgfspec-insert-plain-after
+ (msgfspec target-char string &optional nth)
+ "Insert STRING after the first (or NTH) of TARGET-CHAR's format specifiers.
+Assume STRING does not contain a format specifier, and expect
+MSGFSPEC to be an `erc--msgfspec' object. Return point on
+success."
+ (with-current-buffer (erc--msgfspec-buffer msgfspec)
+ (erc--mfs-insert-before (if nth (cons target-char nth) target-char)
+ string 'afterp)))
+
+(defun erc--msgfspec-insert-spec-after
+ (msgfspec target-char spec-char spec-string &optional nth)
+ "Insert SPEC-STRING after TARGET-CHAR's first (or NTH) format specifier.
+Assume SPEC-STRING contains a format specifier for SPEC-CHAR, and
+expect MSGFSPEC to be an `erc--msgfspec' object. Return point on
+success."
+ (with-current-buffer (erc--msgfspec-buffer msgfspec)
+ (erc--mfs-insert-before (if nth (cons target-char nth) target-char)
+ (cons spec-char spec-string) 'afterp)))
+
(defcustom erc-show-speaker-membership-status nil
"Whether to prefix speakers with their channel status.
For example, when this option is non-nil and some nick \"Alice\"
@@ -9121,17 +9215,25 @@ erc-popup-input-buffer
;;; Message catalog
+(defvar erc--matched-message-catalog (gensym "erc-"))
+
(define-inline erc--make-message-variable-name (catalog key softp)
"Return variable name conforming to ERC's message-catalog interface.
Given a CATALOG symbol `mycat' and format-string KEY `mykey',
also a symbol, return the symbol `erc-message-mycat-mykey'. With
-SOFTP, only do so when defined as a variable."
+SOFTP, only do so when defined as a variable. As a side effect
+of SOFTP, when `erc--matched-message-catalog' is nil, set it to
+CATALOG if KEY is found."
(inline-quote
(let* ((catname (symbol-name ,catalog))
(prefix (if (eq ?- (aref catname 0)) "erc--message" "erc-message-"))
(name (concat prefix catname "-" (symbol-name ,key))))
(if ,softp
- (and-let* ((s (intern-soft name)) ((boundp s))) s)
+ (and-let* ((s (intern-soft name))
+ ((boundp s)))
+ (unless erc--matched-message-catalog
+ (setq erc--matched-message-catalog ,catalog))
+ s)
(intern name)))))
(defun erc-make-message-variable-name (catalog entry)
@@ -9331,12 +9433,20 @@ erc-format-message
See also `format-spec'."
(when (eq (logand (length args) 1) 1) ; oddp
(error "Obscure usage of this function appeared"))
- (let ((entry (erc-retrieve-catalog-entry msg)))
+ (let* ((erc--matched-message-catalog nil)
+ (entry (erc-retrieve-catalog-entry msg)))
(when (not entry)
(error "No format spec for message %s" msg))
(when (functionp entry)
(setq entry (apply entry args)))
- (format-spec entry (apply #'format-spec-make args) 'ignore)))
+ (if-let ((catalog erc--matched-message-catalog)
+ (spec-makr (get catalog 'erc-msgfspec-makr))
+ (spec-hook (get catalog 'erc-msgfspec-hook))
+ (spec-fmtr (get catalog 'erc-msgfspec-fmtr))
+ (obj (apply spec-makr msg entry args)))
+ (progn (run-hook-with-args spec-hook obj)
+ (funcall spec-fmtr obj))
+ (format-spec entry (apply #'format-spec-make args) 'ignore))))
;;; Various hook functions
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index b3912cab33d..b6bc4962a2e 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -2560,6 +2560,180 @@ erc--format-speaker-input-message
(should (equal (erc-tests--format-my-nick "oh my") expect))
(should (equal (erc--format-speaker-input-message "oh my") expect))))
+(ert-deftest erc--define-msgfspec ()
+ (when (< emacs-major-version 28)
+ (ert-skip "`get-buffer-create' lacks `inhibit-buffer-hooks'"))
+ (should
+ (equal
+ (macroexpand-1 '(erc--define-msgfspec foo
+ (?a . "Ay.")
+ (?b . "Bee.")
+ (?c . "See.")
+ (my-slot nil :type list :documentation "OK.")))
+
+ '(progn
+
+ (cl-defstruct (erc-msgfspec-foo (:include erc--msgfspec))
+ "Shared object for `foo' catalog message-format hook."
+ (\?a "" :type 'string :documentation "Ay.")
+ (\?b "" :type 'string :documentation "Bee.")
+ (\?c "" :type 'string :documentation "See.")
+ (my-slot nil :type list :documentation "OK."))
+
+ (defvar erc-msgfspec-foo-hook nil
+ "Hook run before formatting a `foo' catalog entry.
+Called by `erc-format-message' with an `erc-msgfspec-foo'
+object.")
+
+ (defun erc-msgfspec-foo-from-args (key format &rest spec-plist)
+ "Create a `erc-msgfspec-foo' object from catalog entry.
+Expect KEY to be the entry's key, FORMAT its value, and
+SPEC-PLIST the plist of `format-spec' args originally given
+to `erc-display-message'."
+ (let ((buffer (get-buffer-create
+ (format " *erc-msgfspec-foo-%s*" key) t))
+ args)
+ (with-current-buffer buffer (insert format))
+ (while-let ((spec-plist)
+ (key (pop spec-plist))
+ (val (pop spec-plist)))
+ (setq args (nconc (list (pcase key (?a :?a) (?b :?b) (?c :?c))
+ val)
+ args)))
+ (apply #'make-erc-msgfspec-foo :key key :buffer buffer args)))
+
+ (defun erc-msgfspec-foo-apply-spec (msgfspec-obj)
+ "Massage MSGFSPEC-OBJ into args for `format-spec'.
+Apply the latter after incorporating the `alist' slot
+for the current `erc-msgfspec-foo' object."
+ (format-spec (with-current-buffer (erc--msgfspec-buffer msgfspec-obj)
+ (remove-text-properties (point-min) (point-max)
+ '(erc--% nil))
+ (prog1 (buffer-string) (kill-buffer)))
+ `((?a . ,(erc-msgfspec-foo-?a msgfspec-obj))
+ (?b . ,(erc-msgfspec-foo-?b msgfspec-obj))
+ (?c . ,(erc-msgfspec-foo-?c msgfspec-obj))
+ ,@(erc-msgfspec-foo-alist msgfspec-obj))
+ 'ignore))
+
+ (put 'foo 'erc-msgfspec-makr #'erc-msgfspec-foo-from-args)
+ (put 'foo 'erc-msgfspec-fmtr 'erc-msgfspec-foo-apply-spec)
+ (put 'foo 'erc-msgfspec-hook 'erc-msgfspec-foo-hook)))))
+
+(ert-deftest erc--mfs-get-bounds ()
+ (erc-mode)
+ (should-not (erc--mfs-get-bounds ?a))
+
+ (insert (propertize "%a" 'erc--% ?a))
+ (should (equal (erc--mfs-get-bounds ?a) '(1 . 3)))
+ (should (equal (buffer-substring 1 3) "%a"))
+ (should (= (point-max) 3))
+
+ (insert (propertize "%<010b" 'erc--% ?b))
+ (should (equal (erc--mfs-get-bounds ?b) '(3 . 9)))
+ (should (equal (buffer-substring 3 9) "%<010b"))
+ (should (= (point-max) 9))
+
+ (insert (propertize "%c" 'erc--% ?c))
+ (should (equal (erc--mfs-get-bounds ?c) '(9 . 11)))
+ (should (equal (buffer-substring 9 11) "%c"))
+ (should (= (point-max) 11))
+
+ ;; With start pos.
+ (insert (propertize "%^a" 'erc--% ?a))
+ (should (equal (erc--mfs-get-bounds ?a 3) '(11 . 14)))
+ (should (equal (buffer-substring 11 14) "%^a"))
+ (should (= (point-max) 14)))
+
+(ert-deftest erc--mfs-get-nth-bounds ()
+ (erc-mode)
+
+ (should-not (erc--mfs-get-nth-bounds ?a 0))
+ (should-not (erc--mfs-get-nth-bounds ?a 1))
+
+ (insert #("%a %a" 0 2 (erc--% 97) 3 5 (erc--% 97)))
+ (should (equal (erc--mfs-get-nth-bounds ?a 1) '(1 . 3)))
+ (should (equal (erc--mfs-get-nth-bounds ?a 2) '(4 . 6))))
+
+(ert-deftest erc--mfs-insert-before () ; and *-after
+ (erc-mode)
+ (should-not (erc--mfs-insert-before ?a ""))
+
+ (insert (propertize "%a" 'erc--% ?a))
+ (should (= 2 (erc--mfs-insert-before ?a "[")))
+ (should (= 5 (erc--mfs-insert-before ?a "]" 'afterp)))
+ (should (equal (buffer-string) "[%a]"))
+
+ (should (= 10 (erc--mfs-insert-before ?a '(?b . "%<010b") 'afterp)))
+ (should (equal (buffer-string) "[%a%<010b]"))
+
+ (should (= 13 (erc--mfs-insert-before ?b '(?a . "%^a") 'afterp)))
+ (should (equal (buffer-string) "[%a%<010b%^a]"))
+
+ ;; With start pos.
+ (should (= 11 (erc--mfs-insert-before '(?a . 2) "@")))
+ (should (equal (buffer-string) "[%a%<010b@%^a]")))
+
+(ert-deftest erc--msgfspec-speaker-from-args ()
+ (erc-mode)
+ (let ((obj (erc--msgfspec-speaker-from-args
+ 'input-chan-privmsg erc--message-speaker-input-chan-privmsg
+ ?p "@" ?n "bob" ?s "" ?m "Hi.")))
+
+ (ert-info ("Plain")
+ (with-current-buffer (erc--msgfspec-buffer obj)
+ (should (equal "<%p%n> %m" (buffer-string)))
+ (should (eql 3 (erc--msgfspec-insert-plain-before obj ?p "_")))
+ (should (equal "<_%p%n> %m" (buffer-string)))
+
+ ;; Does not inherit.
+ (should (= ?_ (char-after 2)))
+ (should-not (text-properties-at 2))
+ (should (eql 6 (erc--msgfspec-insert-plain-after obj ?p "_")))
+ (should (= ?_ (char-after 5)))
+ (should-not (text-properties-at 5))
+ (should (equal "<_%p_%n> %m" (buffer-string)))))
+
+ (ert-info ("Spec")
+ (with-current-buffer (erc--msgfspec-buffer obj)
+ ;; Before.
+ (should (equal "<_%p_%n> %m" (buffer-string)))
+ (should (eql 8 (erc--msgfspec-insert-spec-before
+ obj ?n ?i (propertize "%i" 'font-lock-face 'my-face))))
+ (should (equal "<_%p_%i%n> %m" (buffer-string)))
+ (should (looking-at (rx "%n> %m")))
+ (should (erc-tests-common-equal-with-props
+ (buffer-substring 6 8)
+ #("%i" 0 2 (erc--% ?i font-lock-face my-face))))
+
+ ;; After.
+ (should (eql 12 (erc--msgfspec-insert-spec-after obj ?n ?i "%i")))
+ (should (looking-at (rx "> %m")))
+ (should (equal "<_%p_%i%n%i> %m" (buffer-string)))
+ (should (erc-tests-common-equal-with-props
+ (buffer-substring 10 12) #("%i" 0 2 (erc--% ?i))))
+
+ ;; Seek.
+ (should (eql 13 (erc--msgfspec-insert-plain-after obj ?i "_" 2)))
+ (should (looking-at (rx "> %m")))
+ (should (equal "<_%p_%i%n%i_> %m" (buffer-string)))))
+
+ (ert-info ("Render")
+ (push '(?i . "~") (erc--msgfspec-alist obj))
+ (should (erc-tests-common-equal-with-props
+ (erc--msgfspec-speaker-apply-spec obj)
+ #("<_@_~bob~_> Hi."
+ 0 1 (font-lock-face erc-default-face)
+ ;; 1 2 _
+ 2 3 (font-lock-face erc-my-nick-prefix-face)
+ ;; 3 4 _
+ 4 5 (font-lock-face my-face)
+ 5 8 (font-lock-face erc-my-nick-face)
+ ;; 8 10 ~_
+ 10 12 (font-lock-face erc-default-face)
+ 12 15 (font-lock-face erc-input-face))))
+ (should-not (buffer-live-p (erc--msgfspec-buffer obj))))))
+
(ert-deftest erc--route-insertion ()
(erc-tests-common-prep-for-insertion)
(erc-tests-common-init-server-proc "sleep" "1")
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
index feaba85ec90..2da225223ca 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero.[07:00]\n<bob> 0.5\n* bob one.\n<bob> two.\n<bob> 2.5\n* bob three\n<bob> four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 455 456 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #6#) 459 466 (wrap-prefix #1# line-prefix #6#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) display #8="") 475 478 (wrap-prefix #1# line-prefix #7# display #8#) 478 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 485 486 (wrap-prefix #1# line-prefix #9#) 486 489 (wrap-prefix #1# line-prefix #9#) 489 494 (wrap-prefix #1# line-prefix #9#) 495 496 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 496 499 (wrap-prefix #1# line-prefix #10#) 499 505 (wrap-prefix #1# line-prefix #10#) 506 507 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #8#) 507 510 (wrap-prefix #1# line-prefix #11# display #8#) 510 512 (wrap-prefix #1# line-prefix #11# display #8#) 512 515 (wrap-prefix #1# line-prefix #11#) 516 517 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #12=(space :width (- 27 (2)))) 517 518 (wrap-prefix #1# line-prefix #12#) 518 521 (wrap-prefix #1# line-prefix #12#) 521 527 (wrap-prefix #1# line-prefix #12#) 528 529 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 529 532 (wrap-prefix #1# line-prefix #13#) 532 539 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file
+#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero.[07:00]\n<bob> 0.5\n* bob one.\n<bob> two.\n<bob> 2.5\n* bob three\n<bob> four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 455 456 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #6#) 459 466 (wrap-prefix #1# line-prefix #6#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) display #8="") 475 478 (wrap-prefix #1# line-prefix #7# display #8#) 478 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 485 486 (wrap-prefix #1# line-prefix #9#) 486 489 (wrap-prefix #1# line-prefix #9#) 489 490 (wrap-prefix #1# line-prefix #9#) 490 494 (wrap-prefix #1# line-prefix #9#) 495 496 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 496 499 (wrap-prefix #1# line-prefix #10#) 499 505 (wrap-prefix #1# line-prefix #10#) 506 507 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #8#) 507 510 (wrap-prefix #1# line-prefix #11# display #8#) 510 512 (wrap-prefix #1# line-prefix #11# display #8#) 512 515 (wrap-prefix #1# line-prefix #11#) 516 517 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #12=(space :width (- 27 (2)))) 517 518 (wrap-prefix #1# line-prefix #12#) 518 521 (wrap-prefix #1# line-prefix #12#) 521 522 (wrap-prefix #1# line-prefix #12#) 522 527 (wrap-prefix #1# line-prefix #12#) 528 529 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 529 532 (wrap-prefix #1# line-prefix #13#) 532 539 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld
index ed1488c8595..d3704aa7ed9 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero.[07:00]\n<bob> 0.5\n* bob one.\n<bob> two.\n<bob> 2.5\n* bob three\n<bob> four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 455 456 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #6#) 459 466 (wrap-prefix #1# line-prefix #6#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) display #8="") 475 478 (wrap-prefix #1# line-prefix #7# display #8#) 478 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 485 486 (wrap-prefix #1# line-prefix #9#) 486 489 (wrap-prefix #1# line-prefix #9#) 489 494 (wrap-prefix #1# line-prefix #9#) 495 496 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 496 499 (wrap-prefix #1# line-prefix #10#) 499 505 (wrap-prefix #1# line-prefix #10#) 505 506 (display #("~\n" 0 2 (font-lock-face shadow))) 506 507 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #8#) 507 510 (wrap-prefix #1# line-prefix #11# display #8#) 510 512 (wrap-prefix #1# line-prefix #11# display #8#) 512 515 (wrap-prefix #1# line-prefix #11#) 516 517 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #12=(space :width (- 27 (2)))) 517 518 (wrap-prefix #1# line-prefix #12#) 518 521 (wrap-prefix #1# line-prefix #12#) 521 527 (wrap-prefix #1# line-prefix #12#) 528 529 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 529 532 (wrap-prefix #1# line-prefix #13#) 532 539 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file
+#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero.[07:00]\n<bob> 0.5\n* bob one.\n<bob> two.\n<bob> 2.5\n* bob three\n<bob> four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 455 456 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #6#) 459 466 (wrap-prefix #1# line-prefix #6#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) display #8="") 475 478 (wrap-prefix #1# line-prefix #7# display #8#) 478 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 485 486 (wrap-prefix #1# line-prefix #9#) 486 489 (wrap-prefix #1# line-prefix #9#) 489 490 (wrap-prefix #1# line-prefix #9#) 490 494 (wrap-prefix #1# line-prefix #9#) 495 496 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 496 499 (wrap-prefix #1# line-prefix #10#) 499 505 (wrap-prefix #1# line-prefix #10#) 505 506 (display #("~\n" 0 2 (font-lock-face shadow))) 506 507 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) display #8#) 507 510 (wrap-prefix #1# line-prefix #11# display #8#) 510 512 (wrap-prefix #1# line-prefix #11# display #8#) 512 515 (wrap-prefix #1# line-prefix #11#) 516 517 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #12=(space :width (- 27 (2)))) 517 518 (wrap-prefix #1# line-prefix #12#) 518 521 (wrap-prefix #1# line-prefix #12#) 521 522 (wrap-prefix #1# line-prefix #12#) 522 527 (wrap-prefix #1# line-prefix #12#) 528 529 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 529 532 (wrap-prefix #1# line-prefix #13#) 532 539 (wrap-prefix #1# line-prefix #13#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld
index a3530a6c44d..e280e654f11 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero.[07:00]\n<bob> 0.5\n* bob one.\n<bob> two.\n<bob> 2.5\n* bob three\n<bob> four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 455 456 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #6#) 459 466 (wrap-prefix #1# line-prefix #6#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 #10=(2))) display #8=#("> " 0 1 (font-lock-face shadow))) 475 478 (wrap-prefix #1# line-prefix #7# display #8#) 478 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 485 486 (wrap-prefix #1# line-prefix #9#) 486 489 (wrap-prefix #1# line-prefix #9#) 489 494 (wrap-prefix #1# line-prefix #9#) 495 496 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 (6)))) 496 499 (wrap-prefix #1# line-prefix #11#) 499 505 (wrap-prefix #1# line-prefix #11#) 506 507 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 #10#)) display #8#) 507 510 (wrap-prefix #1# line-prefix #12# display #8#) 510 512 (wrap-prefix #1# line-prefix #12# display #8#) 512 515 (wrap-prefix #1# line-prefix #12#) 516 517 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #13=(space :width (- 27 (2)))) 517 518 (wrap-prefix #1# line-prefix #13#) 518 521 (wrap-prefix #1# line-prefix #13#) 521 527 (wrap-prefix #1# line-prefix #13#) 528 529 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #14=(space :width (- 27 (6)))) 529 532 (wrap-prefix #1# line-prefix #14#) 532 539 (wrap-prefix #1# line-prefix #14#))
\ No newline at end of file
+#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n<bob> zero.[07:00]\n<bob> 0.5\n* bob one.\n<bob> two.\n<bob> 2.5\n* bob three\n<bob> four.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix (space :width (- 27 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 190 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (invisible timestamp)))) 191 192 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 192 197 (wrap-prefix #1# line-prefix #3#) 197 199 (wrap-prefix #1# line-prefix #3#) 199 202 (wrap-prefix #1# line-prefix #3#) 202 315 (wrap-prefix #1# line-prefix #3#) 316 348 (wrap-prefix #1# line-prefix #3#) 349 350 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 350 353 (wrap-prefix #1# line-prefix #4#) 353 355 (wrap-prefix #1# line-prefix #4#) 355 360 (wrap-prefix #1# line-prefix #4#) 360 435 (wrap-prefix #1# line-prefix #4#) 436 437 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 437 454 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 455 456 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 456 459 (wrap-prefix #1# line-prefix #6#) 459 466 (wrap-prefix #1# line-prefix #6#) 466 473 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (invisible timestamp)))) 474 475 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 #10=(2))) display #8=#("> " 0 1 (font-lock-face shadow))) 475 478 (wrap-prefix #1# line-prefix #7# display #8#) 478 480 (wrap-prefix #1# line-prefix #7# display #8#) 480 483 (wrap-prefix #1# line-prefix #7#) 484 485 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 485 486 (wrap-prefix #1# line-prefix #9#) 486 489 (wrap-prefix #1# line-prefix #9#) 489 490 (wrap-prefix #1# line-prefix #9#) 490 494 (wrap-prefix #1# line-prefix #9#) 495 496 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 (6)))) 496 499 (wrap-prefix #1# line-prefix #11#) 499 505 (wrap-prefix #1# line-prefix #11#) 506 507 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 #10#)) display #8#) 507 510 (wrap-prefix #1# line-prefix #12# display #8#) 510 512 (wrap-prefix #1# line-prefix #12# display #8#) 512 515 (wrap-prefix #1# line-prefix #12#) 516 517 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION wrap-prefix #1# line-prefix #13=(space :width (- 27 (2)))) 517 518 (wrap-prefix #1# line-prefix #13#) 518 521 (wrap-prefix #1# line-prefix #13#) 521 522 (wrap-prefix #1# line-prefix #13#) 522 527 (wrap-prefix #1# line-prefix #13#) 528 529 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #14=(space :width (- 27 (6)))) 529 532 (wrap-prefix #1# line-prefix #14#) 532 539 (wrap-prefix #1# line-prefix #14#))
\ No newline at end of file
--
2.42.0
next prev parent reply other threads:[~2024-01-12 16:19 UTC|newest]
Thread overview: 6+ messages / expand[flat|nested] mbox.gz Atom feed top
[not found] <87jzpq7apw.fsf@neverwas.me>
2023-12-18 14:50 ` bug#67677: 30.0.50; ERC 5.6: Use templates for formatting chat messages J.P.
[not found] ` <87v88vftu6.fsf@neverwas.me>
2024-01-08 5:46 ` J.P.
2024-01-12 16:19 ` J.P. [this message]
[not found] ` <87a5paa5j0.fsf@neverwas.me>
2024-01-19 2:16 ` J.P.
[not found] ` <87fryurrst.fsf@neverwas.me>
2024-02-01 3:14 ` J.P.
2023-12-07 7:06 J.P.
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to='87a5paa5j0.fsf__25588.5717504256$1705076448$gmane$org@neverwas.me' \
--to=jp@neverwas.me \
--cc=67677@debbugs.gnu.org \
--cc=emacs-erc@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).