commit badce2d952db81c91521ddc988a925154370d56a Author: F. Jason Park Date: Mon Jun 29 17:49:38 2026 -0700 Allow slashes and periods in ERC ISUPPORT params * lisp/erc/erc-backend.el (erc-server-005): Add "." and "/" to regexp for parameter keys as per the updated recommendation of the living specification. See https://github.com/ircdocs/modern-irc/pull/251 and the corresponding issue it closed. * test/lisp/erc/erc-tests.el (erc-server-005): Expect slashes and periods in parameter keys. diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 819b8ae5033..85475a4c52f 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -2381,8 +2381,8 @@ A server may send more than one 005 message." value negated) (when (string-match - (rx bot (| (: (group (+ (any "A-Z"))) "=" (group (* nonl))) - (: (? (group "-")) (group (+ (any "A-Z"))))) + (rx bot (| (: (group (+ (any "A-Z./"))) "=" (group (* nonl))) + (: (? (group "-")) (group (+ (any "A-Z./"))))) eot) section) (setq key (or (match-string 1 section) (match-string 4 section)) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 74c1a4bfa19..953be0c91fb 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1305,7 +1305,8 @@ (lambda (_ _ _ line) (push line calls)))) (ert-info ("Baseline") - (setq args '("tester" "BOT=B" "CHANTYPES=" "EXCEPTS" "PREFIX=(ov)@+" + (setq args '("tester" "BOT=B" "A.B/c=d" + "CHANTYPES=" "EXCEPTS" "PREFIX=(ov)@+" "are supp...") parsed (make-erc-response :command-args args :command "005")) @@ -1316,14 +1317,17 @@ ;; Should be ("CHANTYPES") but ;; retained for compatibility. ("CHANTYPES" . "") + ("A.B/c" . "d") ("BOT" . "B")))) (should (zerop (hash-table-count erc--isupport-params))) (should (equal "(ov)@+" (erc--get-isupport-entry 'PREFIX t))) (should (equal '(EXCEPTS) (erc--get-isupport-entry 'EXCEPTS))) (should (equal "B" (erc--get-isupport-entry 'BOT t))) - (should (string= - (pop calls) - "BOT=B CHANTYPES= EXCEPTS PREFIX=(ov)@+ are supp...")) + (should (equal "d" (erc--get-isupport-entry 'A.B/c t))) + (should + (string= + "BOT=B A.B/c=d CHANTYPES= EXCEPTS PREFIX=(ov)@+ are supp..." + (pop calls))) (should (equal args (erc-response.command-args parsed))))) (erc-call-hooks nil parsed)) @@ -1336,7 +1340,8 @@ (setq verify (lambda () (should (equal erc-server-parameters - '(("PREFIX" . "(ohv)@%+") ("BOT" . "B")))) + '(("PREFIX" . "(ohv)@%+") ("A.B/c" . "d") + ("BOT" . "B")))) (should (string-prefix-p "-EXCEPTS -CHANTYPES -FAKE PREFIX=(ohv)@%+ " (pop calls))) commit cab6a0d0e332001d75ae252a7148d984a29d724e Author: F. Jason Park Date: Sun Nov 17 16:32:25 2024 -0800 Make erc-settings a module * doc/misc/erc.texi: Add Settings node under Modules. * etc/ERC-NEWS: Mention new module along with function `erc-channel-buffer-p. * lisp/erc/erc-networks.el (erc-settings): Move to new module library `erc-settings'. (erc-get): Neuter completely by effectively aliasing to `ignore'. * lisp/erc/erc-settings.el: New file. * lisp/erc/erc.el (erc-channel-buffer-p): New function. (erc-modules): Add `settings' to custom set. * test/lisp/erc/erc-scenarios-settings.el: New file. * test/lisp/erc/erc-settings-tests.el: New file. * test/lisp/erc/erc-tests.el (erc-tests--modules): Add `settings'. * test/lisp/erc/resources/settings/basic-sasl.eld: New file. * test/lisp/erc/resources/settings/basic.eld: New file. (Bug#76019) diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index e8b1724ef5f..3e39f819a52 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -83,6 +83,10 @@ Advanced Module Topics * Example: Module Example. An example module. * Usage: Module Usage. How to use specific modules. +Individual Modules + +* Settings: Settings Module. Per-buffer configuration. + Advanced Usage * Connecting:: Ways of connecting to an IRC server. @@ -144,7 +148,6 @@ ERC comes with the following capabilities enabled by default. @node Getting Started @chapter Getting Started -@cindex settings The command @kbd{M-x erc} will start ERC and prompt for the server to connect to. If you're unsure of which server or network to connect @@ -552,6 +555,10 @@ Scroll to the bottom of the buffer @item services Identify to Nickserv (IRC Services) automatically +@cindex modules, settings +@item settings +Apply options locally per-buffer (@pxref{Settings Module}) + @cindex modules, smiley @item smiley Convert smileys to pretty icons @@ -1011,6 +1018,383 @@ list or the bug tracker. @c PRE5_4: Document every option of every module in its own subnode +@node Module Usage +@section Usage +@cindex individual modules +@cindex module usage + +Detailed documentation on individual built-in modules. + +@menu +* Settings: Settings Module. Scoped user options. +@end menu + +@node Settings Module +@subsection Settings +@cindex settings + +This global module lets you apply ERC options on a per-buffer basis as +local variable bindings (@pxref{Buffer-Local Variables,,, elisp,}). It +consists of a single @dfn{meta option}: + +@defopt erc-settings +An alist where each key is a @dfn{match condition} and each value a list +of bindings that loosely resembles a @code{let}-style @var{varlist}. +The first element of each binding is the variable of a user option and +the second an arbitrary sexp assigned to it locally in all matching +buffers. You can tell ERC to evaluate a given sexp as a Lisp form +before assigning it by including a trailing third element: the +@dfn{modifier flag} @code{:eval}. + +A match condition specifies when and whether ERC should apply each group +of bindings. These resemble @code{buffer-match-p} conditions, with two +major differences (@pxref{Buffer List,,, elisp,}). The first is that +predicate conditions don't take any arguments. Instead, ERC runs them +with the candidate buffer current. The second difference is that the +assortment of associative cons-cell conditions is completely new. Gone +are @code{major-mode}, @code{category}, etc. In their place, ERC offers +the following: + +@itemize +@item @code{(network . @samp{})} +@item @code{(id . @samp{})} +@item @code{(name . @samp{})} +@item @code{(target . @samp{})} +@end itemize + +The associated @code{cdr} values for the @code{network} and @code{id} +conditions are symbols identifying the current IRC network and the +@dfn{network context}, respectively. When first connecting, a +@code{network} condition is always @code{nil}, but an @code{id} +condition can be non-@code{nil} if you supply a matching @var{ID} +argument to an entry-point command, like @code{erc-tls} (@pxref{Network +Identifier}). + +Additionally, ERC also recognizes @code{buffer-match-p}'s boolean +operations and constants: + +@itemize +@item @code{(and @samp{})} +@item @code{(or @samp{})} +@item @code{(not @samp{})} +@item @code{t} +@item @code{nil} +@end itemize + +Also valid are regular expressions and nullary predicates: + +@itemize +@item @code{""} +@item @code{} +@end itemize + +@end defopt + +@noindent +Here's a contrived @code{erc-settings} value containing seven entries, +the first of which has two assignments: + +@lisp +(((and (network . Libera.Chat) ; buffers #emacs, + "\\`#emacs") ; #emacs-foo, etc., + (my-own-variable 42) ; on Libera.Chat only + (erc-foo "")) + + ((or (target . "#chan") ; buffers #chan, bob, + (target . "bob")) ; chan@@Libera.Chat, + (erc-foo (erc-current-nick) :eval)) ; bob@@OFTC, etc. + + (erc-open-server-buffer-p (erc-bar 1)) ; connected server buffers + (erc-query-buffer-p (erc-bar 2)) ; query buffers only + (erc-channel-buffer-p (erc-bar 3)) ; channel buffers only + (erc-target (erc-bar 4)) ; query or channel buffers + (t (erc-bar 5))) ; any `erc-mode' buffer +@end lisp + +@noindent +Unfortunately, predicate functions too dissimilar from those in the last +hunk above may not work in all match contexts due to the interaction +between this module and ERC's rather convoluted major-mode setup. While +the only way to know for sure is to try them, selecting them becomes +much easier if you can gain a sense for when exactly @samp{settings} +attempts to create bindings: + +@itemize +@item +In server buffers +@enumerate +@item +before ERC enables any modules or sets any local variables +@item +after establishing a logical IRC connection and learning what network +it's connected to +@end enumerate + +@item +In target buffers +@enumerate +@item +before enabling any modules, but only if you're overriding +@code{erc-modules} and, only then, for that option alone +@item +after ERC has set most of its default local variables and run +global-module setup but before running major-mode hooks or local-module +setup +@end enumerate +@end itemize + +The main downside of this staggered approach is that @samp{settings} +skips any bindings for variables that already have a local binding +rather than do the intuitive thing and simply clobber them. The reason +for this is to retain a consistent state between a global module's minor +mode setup and any local-module setup or major-mode hooks. They must +all witness the same value for the same variable. + +Revisiting the phony example above with this precedence quirk in mind, +notice that the made-up variable @code{erc-bar} will be @code{2} in +query buffers, @code{3} in channel buffers, and @code{5} in server +buffers. It's never @code{1} because the first binding opportunity +occurs before connecting, when @code{erc-open-server-buffer-p} returns +@code{nil}. It's likewise never @code{4} because that binding appears +lower in the list than those for @code{2} and @code{3}. For more on +this behavior, see the very last example below. + +When it comes to binding the option @code{erc-modules}, @samp{settings} +must make special accommodations. Getting it right may take some trial +and error, and it's only guaranteed to work for local modules because +most global ones share state among all sessions. However, it's fine to +include global modules in an @code{erc-modules} binding as long as they +also appear in the @code{default-value}. To set @code{erc-modules} for +a specific server buffer, specify an entry like + +@lisp +("[.]libera[.]chat:" + (erc-modules (seq-union '(sasl keep-place-indicator) erc-modules) + :eval) + (erc-sasl-user :nick)) +@end lisp + +@noindent +Here, the match condition is a regexp matching a dialed @acronym{TCP} +address because server buffers typically have these as temporary names +while connecting. As mentioned, ERC later renames them to reflect a +discovered network, after which @samp{settings} binds any matching +unbound options. + +A session's target buffers normally share the @code{erc-modules} value +bound locally in their server buffer. To specify a separate, overriding +set of modules for certain target buffers, use a condition that only +applies to them: + +@lisp +((and (network . Libera.Chat) erc-channel-buffer-p) + (erc-modules (seq-union '(fill-wrap) erc-modules) :eval)) +@end lisp + +@noindent +This is often unnecessary because local modules that only operate in one +kind of buffer tend to disable themselves elsewhere. And some, like +@samp{keep-place-indicator}, offer an option to restrict activation +based on buffer type. + +@anchor{Settings Examples} +@subsection Settings Examples +@cindex settings, examples + +A typical setup might include configuration for two networks, one that +uses @acronym{SASL} to authenticate and another that uses a server +password. + +@lisp +(setopt erc-modules + `(settings ,@@erc-modules) ; assuming `erc' is loaded + + erc-settings + ;; Pre-connect and server buffer config for @samp{Libera.Chat}. + '(("libera\\.chat:" + (erc-prompt "Libera>") + (erc-autojoin-channels-alist ((Libera.Chat "##jrh"))) + (erc-header-line-format "%n on %S (%m, %l)") + (erc-sasl-user :nick) + (erc-modules `(sasl ,@@erc-modules) :eval)) + + ;; Channel buffer config for @samp{Libera.Chat}. + ((and (network . Libera.Chat) erc-channel-buffer-p) + (erc-modules `(keep-place-indicator ,@@erc-modules) :eval) + (erc-prompt erc-prompt-format) + (erc-prompt-format "%c%b>") + (erc-header-line-format "%t: %o")) + + ;; Query buffer configuration for any network. + (erc-query-buffer-p + (erc-prompt erc-prompt-format) + (erc-prompt-format "%S>") + (erc-header-line-format nil)) + + ;; Pre-connect and server-buffer config for @samp{OFTC}. + ("oftc\\.net:" + (erc-prompt "OFTC!") + (erc-modules `(nicks ,@@erc-modules) :eval)))) +@end lisp + +@noindent +Note that the pre-connection config described in the last entry can't +use the @dfn{global module} @samp{services} because it's incompatible +with the @dfn{local module} @samp{sasl}, needed for Libera by the first +entry. In this scenario, instead of a server password, the @samp{OFTC} +connection could alternatively use @dfn{CertFP} via auth-source (see +next example). + +@anchor{ID-based Settings Example} +@subsubsection ID-based +@cindex settings, examples, id-based + +New users coming from traditional IRC clients often express a desire to +store connection details alongside other per-network or per-connection +configuration. Although ERC was designed to keep these concerns +separate, the @samp{settings} module can emulate that experience to some +degree. + +@lisp +(setopt erc-modules + `(settings ,@@erc-modules) + + erc-settings + ;; Connection details common to both @samp{Libera.Chat} IDs. + '(((and (or (id . lib-jrh) (id . lib-jrbot)) + (not erc-server-process-alive)) + (erc-server "irc.libera.chat") + (erc-port 6697) + (erc-modules `(sasl ,@@erc-modules) :eval)) + + ;; Connection details for account @samp{jrh}. + ((and (id . lib-jrh) (not erc-server-process-alive)) + (erc-nick "jrh") + (erc-user-full-name "J. Random Hacker") + (erc-email-userid "jrh") + (erc-autojoin-channels-alist ((lib-jrh "##jrh")))) + + ;; Connection details for account @samp{jrbot}. + ((and (id . lib-jrbot) (not erc-server-process-alive)) + (erc-nick "jrbot") + (erc-email-userid "jrbot") + (erc-user-full-name "J.R. Bot (jrh's bot)") + (erc-sasl-auth-source-function erc-auth-source-function) + (erc-autojoin-channels-alist ((lib-jrbot "##jrh" "##jrbot")))) + + ;; Non-connection opts for both @samp{Libera.Chat} sessions. + ((and (network . Libera.Chat) erc-open-server-buffer-p) + (erc-prompt "libera>") + (erc-header-line-format "%n on %S (%m, %l)")) + ((and (network . Libera.Chat) erc-channel-buffer-p) + (erc-modules `(keep-place-indicator ,@@erc-modules) :eval) + (erc-prompt erc-prompt-format) + (erc-prompt-format "%c%b>") + (erc-header-line-format "%t: %o")) + + ;; Server details for @samp{OFTC}. + ((and (id . oftc) (target . nil)) + (erc-server "irc.oftc.net") + (erc-port 6697) + (erc-nick "jrh") + (erc-email-userid "jrh") + (erc-user-full-name "J. Random Hacker") + (network-stream-use-client-certificates t) + (erc-modules `(services-regain ,@@erc-modules) :eval) + (erc-prompt "jrh@@OFTC!")))) + +(defun my-erc-up (id) + "Connect to preconfigured session identified by ID." + (interactive "SNet id: ") + (erc-tls :server nil + :port nil + :nick nil + :user nil + :password nil + :full-name nil + :id network-id)) +@end lisp + +@noindent +With a setup like the above, you can connect to a predefined session by +supplying an identifying symbol, like @code{lib-jrh}, along with the +@var{ID} keyword parameter to the entry-point command @code{erc-tls}. +The main gotcha when using these identifiers is that a regexp targeting +a dialed @acronym{TCP} address, like +@code{"\\`irc[.]libera[.]chat:6697\\'"}, won't work for conditions like +the first one above because server buffers receive permanent names +immediately upon creation, long before connecting. Instead, you'll want +to specify a chosen identifier via the @samp{(id . )} pattern +and likely qualify it with another subcondition, like @code{(not +erc-server-process-alive)}, to ensure that the @code{erc-modules} +binding only matches the server buffer and not any target buffers. +Equivalent qualifying subconditions would be @code{(not erc-target)} and +@code{(target . nil)}. + +Regarding authentication, notice that the @samp{lib-jrbot} connection +retrieves its @acronym{SASL} credentials, which might be a client +certificate, via auth-source, while session @samp{lib-jrh} prompts you +interactively for a password. (@xref{SASL, SASL in ERC}.) The +@samp{oftc} connection also uses auth-source to supply its credentials, +this time for non-@acronym{SASL} client-cert (@dfn{CertFP}) +authentication. Lastly, in the scenario above, a user would need to run +@kbd{M-x my-erc-up @key{RET}} instead of @kbd{M-x erc @key{RET}} when +connecting to IRC. For convenience, ERC provides a similar command: + +@defun erc-settings-connect-by-id network-id +Prompt the user and provide completion for some @samp{(id . )} +appearing in their @code{erc-settings}, and specify it as the argument +to the @var{ID} keyword parameter when invoking @code{erc-tls}. +@end defun + +With both traditional and ID-based setups, it's often more convenient to +define less exclusive, more ``overlapping'' match conditions: + +@lisp +(use-package erc-settings + :custom + (erc-settings + '(((not erc-server-process-alive) ; common to all servers + (erc-nick "jrh") + (erc-port 6697) + (erc-email-userid "jrh") + (erc-user-full-name "J. Random Hacker")) + + (erc-channel-buffer-p ; all channels + (erc-modules `(keep-place-indicator ,@@erc-modules) :eval)) + + ((id . id-libera) ; Libera.Chat only, including targets + (erc-server "irc.libera.chat") + (erc-sasl-password "changeme") + (erc-modules `(sasl ,@@erc-modules) :eval) + (erc-prompt erc-prompt-format) + (erc-autojoin-channels-alist ((id-foonet "#erc")))) + + ((id . id-oftc) ; OFTC only, including targets + (erc-server "irc.oftc.net") + (erc-modules `(fill-wrap ,@@erc-modules) :eval) + (erc-autojoin-channels-alist ((id-barnet "##jrh"))))))) +@end lisp + +If you go this route, know that @samp{settings} will often create local +bindings in buffers where they're not applicable. In the above example, +buffer @file{#erc} on @samp{Libera.Chat} will have @code{erc-server} and +@code{erc-sasl-password} bound locally for no reason. In most cases, +this is perfectly harmless. + +A final thing to notice about the example above is that the +@code{erc-modules} binding in the second group, the one with match +condition @code{erc-channel-buffer-p}, effectively @dfn{shadow}s that +same variable in all remaining settings affecting channel buffers. If +it instead appeared at the end of the list, ERC would skip its +@code{erc-modules} binding because the variable would already be locally +bound. But, as is, both @file{##jrh} on @samp{OFTC} and @file{#erc} on +@samp{Libera.Chat} activate @samp{keep-place-indicator} but not +@samp{fll-wrap}. Server buffer @file{id-oftc} has only @samp{fll-wrap}, +and server buffer @file{id-libera} has neither. And, if you were to +receive a query from @samp{alice} on @samp{OFTC}, buffer @file{alice} +would only have @samp{fill-wrap} but not @samp{keep-place-indicator} +because it's a non-channel on @samp{OFTC}. @node Advanced Usage @@ -1519,6 +1903,11 @@ authenticate successfully. @item Multiple networks +If you use the @samp{settings} module, introduced in ERC 5.7, please +refer to that section's guide for a more modern, config-based approach +to specifying buffer-local @acronym{SASL} options (@pxref{Settings +Examples}). + @example # ~/.authinfo.gpg diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 68655ecd4bd..bc9669e7b59 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -34,6 +34,13 @@ skip messages from "fools" and those in untracked buffers. Option 'erc-desktop-notifications-ignored-when-focused' can spare users from being notified when interacting with the initiating buffer. +** Apply options granularly to specific connections or buffers. +Based on an idea drafted nearly a quarter century ago by ERC's earliest +contributors, the 'settings' module offers a ready-made method for +binding arbitrary user options to various "scopes" of interest. It +leverages buffer-local variables and match conditions reminiscent of +'buffer-match-p'. + ** Changes in the library API. *** Module setup runs in query buffers on reconnect. @@ -61,6 +68,10 @@ being killed. For modules still needing to run delayed, session-aware code, a new convenience macro called 'erc-with-initialized-session' is now available to automate any 'erc-mode-hook' wrangling for you. +*** A predicate to detect if the current buffer is a channel. +New function 'erc-channel-buffer-p' is a channel-detecting complement to +'erc-query-buffer-p' and a light wrapper around 'erc-channel-p'. + * Changes in ERC 5.6.2 diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index 3e924d0b0f1..20188b323df 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -1609,28 +1609,12 @@ return the host alone sans URL formatting (for compatibility)." (scheme (if (cdr pspec) "ircs" "irc"))) (if ports (format "%s://%s:%d" scheme host (seq-random-elt ports)) host))) -;;; The following experimental -;; It does not work yet, help me with it if you -;; think it is worth the effort. - -(defvar erc-settings - '((pals Libera.Chat ("kensanata" "shapr" "anti\\(fuchs\\|gone\\)")) - (format-nick-function (Libera.Chat "#emacs") erc-format-@nick)) - "Experimental: Alist of configuration options. - -WARNING: this variable is a vestige from a long-abandoned -experiment. ERC may redefine it using the same name for any -purpose at any time. - -The format is (VARNAME SCOPE VALUE) where -VARNAME is a symbol identifying the configuration option, -SCOPE is either a symbol which identifies an entry from - `erc-networks-alist' or a list (NET TARGET) where NET is a network symbol and - TARGET is a string identifying the channel/query target. -VALUE is the options value.") -(make-obsolete-variable 'erc-settings - "temporarily deprecated for later repurposing" "30.1") +;; Longtime occupant of this file `erc-settings' was repurposed in ERC +;; 5.7 and moved to erc-settings.el. +;; Attempting to provide a "working" version of this function would be +;; nonsensical because `erc-settings' now has a completely different +;; layout than the unfinished version from `erc-networks' (circa 2002). (defun erc-get (var &optional net target) "Retrieve configuration values from `erc-settings'. @@ -1639,27 +1623,9 @@ long-abandoned experiment. ERC may redefine it using the same name for any purpose at any time. \(fn &rest UNKNOWN)" - (declare (obsolete "temporarily deprecated for later repurposing" "30.1")) - (let ((items erc-settings) - elt val) - (while items - (setq elt (car items) - items (cdr items)) - (when (eq (car elt) var) - (cond ((and net target (listp (nth 1 elt)) - (eq net (car (nth 1 elt))) - (string-equal target (nth 1 (nth 1 elt)))) - (setq val (nth 2 elt) - items nil)) - ((and net (eq net (nth 1 elt))) - (setq val (nth 2 elt) - items nil)) - ((and (not net) (not target) (not (nth 1 elt))) - (setq val (nth 2 elt) - items nil))))) - val)) - -;; (erc-get 'pals 'Libera.Chat) + (declare (obsolete "`erc-settings' schema incompatible with PoC from 2002" + "31.1")) + (ignore var net target)) (provide 'erc-networks) diff --git a/lisp/erc/erc-settings.el b/lisp/erc/erc-settings.el new file mode 100644 index 00000000000..570a86a9039 --- /dev/null +++ b/lisp/erc/erc-settings.el @@ -0,0 +1,296 @@ +;;; erc-settings.el -- Buffer-local options -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This module is based on an ancient proof-of-concept by Mario Lang, +;; with contributions from Diane Murray and possibly others. It lived +;; in erc-networks.el for over two decades before becoming its own +;; module in 2026. + +;; Usage: add `settings' to `erc-modules', and customize the option +;; `erc-settings'. + +;;; Code: +(require 'erc) + +(defgroup erc-settings nil + "Buffer-local values for arbitrary user options." + :group 'erc) + +(define-widget 'erc--buffer-match 'lazy + "Condition for `erc-settings--buffer-match-p'." + :tag "Valid `erc-settings' match condition" + :type `(choice (boolean :tag "Always/never") + (regexp :tag "Buffer-name regexp") + (function :tag "Predicate") + (cons :tag "Network" (const network) symbol) + (cons :tag "ID" (const id) symbol) + (cons :tag "Target" (const target) (choice string + (const nil))) + (cons :tag "Buffer name" (const name) string) + (list :tag "Negation" + (const not) + (erc--buffer-match :tag "Match condition")) + (cons :tag "All/any" + (choice :tag "Operator" (const or) (const and)) + (repeat :tag "Match condition" erc--buffer-match)))) + +(defcustom erc-settings () + "A match-condition alist for setting ERC's user options locally. + +This \"meta option\" provides a means of specifying buffer-local values +for other user options. It does this by setting an option's variable +locally in server and target buffers. If a local binding already exists +for a variable, ERC leaves it alone. Alist members should be of the +form (MATCHCOND . BINDINGS), where BINDINGS is a list of assignments +like (VAR VAL . FLAGS). + +MATCHCOND works like a `buffer-match-p' condition, only tailored +slightly to meet ERC's unique requirements. The boolean operators +`and', `or', and `not' remain unchanged, as do strings, which ERC treats +as regexps to be matched against a buffer's name. For servers, this +name is usually a dialed TCP address while connecting and a network (ID) +once connected. Query and channel buffers normally share their target's +name, possibly suffixed by a disambiguating \"@\" + identifier. If +MATCHCOND is a function, ERC assumes it's a predicate that takes no +arguments and runs in the candidate ERC buffer. As for key-value +cons-cell conditions, ERC ignores all traditional ones defined by +`buffer-match-p', like `derived-mode' and `major-mode', instead +preferring to define its own: (network . NETWORK), where NETWORK is a +symbol returned by the function `erc-network'; (id . ID), where ID is a +user-provided symbol as described by the Info node `(erc) Network +Identifier'; (target . TARGET), where TARGET, if non-nil, is the channel +name or query nick; and (name . NAME), which matches a buffer's NAME, as +a string. + +In BINDINGS, each member's VAR is the symbol of a user option or +variable to which ERC assigns the sexp VAL locally in the current +buffer. When FLAGS contains the keyword :eval, ERC evaluates VAL as a +Lisp form and assigns the result to VAR. Each entry in BINDINGS should +appear in order of decreasing match specificity and increasing +generality because even though ERC applies all matching entries, it +skips subsequent ones for which a local binding already exists. + +See Info node `(erc) Settings' for a friendlier description of the DSL +and Info node `(erc) Settings Examples' for example usage." + :package-version '(ERC . "5.7") + :type (let* ((flags '(set :tag "Flags" + (const :tag "Prefer custom-set (advanced)" :custom) + (const :tag "Evaluate form" :eval))) + (setting `(cons :tag "Binding assignment" + (variable :tag "Option/variable") + (cons :tag "Value" sexp ,flags)))) + `(alist :key-type erc--buffer-match :value-type (repeat ,setting)))) + +;;;###autoload(autoload 'erc-settings-mode "erc-settings" nil t) +(define-erc-module settings nil + "Global module to set ERC options locally per-buffer. +Like many modules, this cannot reasonably be toggled via mode command +mid-session. To see the result of updates to the option `erc-settings' +immediately, destroy and reopen all affected sessions." + ((when (and erc--updating-modules-p + (not (memq #'erc-settings--set-modules + (default-value 'erc--set-modules-functions)))) + (erc--warn-once-before-connect 'erc-settings-mode + "Module `settings' did not load properly. Add it to `erc-modules'" + " and run `erc-update-modules' before connecting, or use a" + " Custom-aware configuration method, like `setopt'.")) + ;; Set non-`erc-module' entries in target buffers after all default + ;; non-connection related local session variables have been set. + (if erc--updating-modules-p + (add-hook 'change-major-mode-after-body-hook + #'erc-settings--setup -90 t) + (erc-buffer-do #'erc-settings--setup)) + ;; Set any remaining entries in server buffers once the network is + ;; known and all local session variables have been populated. + (add-hook 'erc-after-connect #'erc-settings-bind -30) + (add-hook 'erc--set-modules-functions #'erc-settings--set-modules 30)) + ((erc-buffer-do #'erc-settings--setup) + (remove-hook 'erc-after-connect #'erc-settings-bind) + (remove-hook 'erc--set-modules-functions #'erc-settings--set-modules))) + +(defun erc-settings--setup () + (if erc-settings-mode + (when erc-server-connected + (erc-settings--set (erc-settings--gather-bindings (current-buffer)))) + (remove-hook 'change-major-mode-after-body-hook #'erc-settings--setup t) + (dolist (entry erc-settings) + (pcase-dolist (`(,var . ,_) (cdr entry)) + (when (local-variable-p var) + (kill-local-variable var)))))) + +(defun erc-settings--buffer-match-p (condition) + "Return non-nil if CONDITION matches current buffer. +Act almost like `buffer-match-p', except recognize an alternate set of +property-based cons-cell conditions. Additionally, don't pass any +arguments to predicate-type conditions, and interpret CONDITION in the +current buffer, where CONDITION should be among the following: + +- the symbol t, which always matches, +- the symbol nil, which never matches, +- a regular expression matched against current buffer's name, +- a predicate taking no arguments and run in the candidate buffer +- a symbol-keyed cons cell described by one the following: + + `id' `eq' to current buffer's network context ID + `network' `eq' to current buffer's `erc-network' + `target' `equal' to current buffer's `erc-target' + `name' `equal' to current buffer's name + `and' a list of matching conditions + `or' a list containing at least one matching condition + `not' a list of a single condition that matches when negated" + (pcase condition + ('t t) + ((pred stringp) (string-match-p condition (buffer-name))) + ((pred functionp) (funcall condition)) + (`(id . ,id) (and erc-networks--id + (eq (erc-networks--id-symbol erc-networks--id) id))) + (`(network . ,network) (and erc-network (eq erc-network network))) + (`(target . ,target) (equal target (erc-target))) + (`(name . ,name) (equal name (buffer-name))) + (`(not . ,cond) (not (erc-settings--buffer-match-p cond))) + (`(or . ,args) (seq-some #'erc-settings--buffer-match-p args)) + (`(and . ,args) (seq-every-p #'erc-settings--buffer-match-p args)))) + +(defun erc-settings-bind (&rest _) + "Set all settings in option `erc-settings' from current network's ID." + (erc-settings--set (erc-settings--gather-bindings (current-buffer)))) + +;;;###autoload +(defun erc-settings--set-modules (id target target-server-buffer) + "Set `erc-modules' locally if an entry exists for the current buffer. +In server buffers, bind all matching entries, not just `erc-modules'. +Expect TARGET to be a string or nil and ID to be a symbol. When TARGET +is non-nil, borrow local values from TARGET-SERVER-BUFFER to temporarily +bind identifying variables sought by match conditions." + (when (and erc-settings (or erc-settings-mode (memq 'settings erc-modules))) + ;; Shadow `erc-networks--id' for (id . ), `erc--target' for + ;; (target . ), etc. Although predicates of interest, like + ;; `erc-query-buffer-p', may call on `buffer-local-value', its + ;; `buffer' argument will be the current buffer, which doesn't yet + ;; have any buffer-local bindings. + (cl-assert (not (local-variable-p 'erc-networks--id))) + (cl-assert (not (local-variable-p 'erc-network))) + (cl-assert (not (local-variable-p 'erc--target))) + (let ((erc-networks--id + (or (and id (erc-networks--id-create id)) + (and target (buffer-local-value 'erc-networks--id + target-server-buffer))))) + (if target + (if-let* + ((erc-network (buffer-local-value 'erc-network + target-server-buffer)) + (erc--target (erc--target-from-string target)) + (bindings (erc-settings--gather-bindings (current-buffer))) + (entry (assq 'erc-modules bindings))) + (erc-settings--set-value 'erc-modules (nth 1 entry) (cddr entry)) + (when-let* ((old-value (with-current-buffer target-server-buffer + (and (local-variable-p 'erc-modules) + erc-modules)))) + (setq-local erc-modules old-value))) + (erc-settings-bind))))) + +(defun erc-settings--gather-bindings (buffer) + "Return a list of matching bindings for server BUFFER's session." + (with-current-buffer buffer + (mapcan (lambda (entry) + (and (erc-settings--buffer-match-p (car entry)) + (copy-sequence (cdr entry)))) + erc-settings))) + +;; Currently, when a binding contains the experimental flag :custom, ERC +;; tries to use VAR's `custom-set' function, if defined, for setting its +;; value. ERC doesn't do so by default because many such functions use +;; `set-default', which defeats the purpose. +(defun erc-settings--set-value (var value flags) + "Set VAR to VALUE locally and interpret FLAGS. +Do nothing if VAR already has a local binding. If VAR has the symbol +property `erc-settings--wrap', assume it's a function that takes the +arguments (SETTER VAR VALUE), and defer to it to perform the actual +setting." + (unless (local-variable-p var) + (let ((setter #'set) + (evalp nil) + (customp nil)) + (dolist (flag flags) + (pcase-exhaustive flag + (:eval (setq evalp t)) + (:custom (setq customp t)))) + (make-local-variable var) + (when evalp + (setq value (eval value t))) + (when customp + (custom-load-symbol var) + (setq setter (or (get var 'custom-set) #'set))) + (if-let* ((xsetter (get var 'erc-settings--wrap))) + (funcall xsetter setter var value) + (funcall setter var value))))) + +(defun erc-settings--set (bindings) + "Set all matching bindings locally in current buffer. +Expect BINDINGS to be a list of (KEY VALUE . FLAGS)." + (pcase-dolist (`(,var ,value . ,flags) bindings) + (erc-settings--set-value var value flags))) + +(defun erc-settings--ensure-prompt-reset (setter var value) + (cl-assert (eq var 'erc-prompt)) + (when (and erc-input-marker (stringp value)) + (let ((erc-prompt (lambda () value))) + (with-silent-modifications + (erc--refresh-prompt)))) + (funcall setter var value)) + +(put 'erc-prompt 'erc-settings--wrap #'erc-settings--ensure-prompt-reset) + +(defun erc-settings--find-condition (predicate settings) + "Return all conditions in SETTINGS for which PREDICATE returns non-nil." + (letrec ((found ()) + (find (lambda (condition) + (pcase condition + (`(and . ,rest) (mapc find rest)) + (`(or . ,rest) (mapc find rest)) + (`(not ,cond) (funcall find cond)) + ((pred (funcall predicate)) (push condition found)))))) + (dolist (setting settings) + (funcall find (car setting))) + (nreverse found))) + +(defun erc-settings--extract-ids () + "Return all arguments to an `id' property condition in `erc-settings'." + (mapcar #'cdr (erc-settings--find-condition + (lambda (condition) (eq (car-safe condition) 'id)) + erc-settings))) + +;;;###autoload +(defun erc-settings-connect-by-id (network-id) + "Connect via some preconfigured network ID specified in `erc-settings'. +See Info node `(erc) ID-based Settings Example'." + (interactive (list (completing-read "Network ID: " + (erc-settings--extract-ids)))) + (erc-tls :server nil :port nil :nick nil :user nil + :password nil :full-name nil :id network-id)) + +(provide 'erc-settings) + +;;; erc-settings.el ends here +;; +;; Local Variables: +;; generated-autoload-file: "erc-loaddefs.el" +;; End: diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index b661453fdce..f87d13eb559 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2016,6 +2016,10 @@ buries those." (target (buffer-local-value 'erc--target target)) ((erc--target-channel-p target))))))) +(defun erc-channel-buffer-p (&optional buffer) + "Call `erc-channel-p' with BUFFER or the current buffer." + (erc-channel-p (or buffer (current-buffer)))) + ;; For the sake of compatibility, a historical quirk concerning this ;; option, when nil, has been preserved: all buffers are suffixed with ;; the original dialed host name, which is usually something like @@ -2410,6 +2414,7 @@ removed modules. It also gives packages access to the hook scrolltobottom) (const :tag "services: Identify to Nickserv (IRC Services) automatically" services) + (const :tag "settings: Set ERC user options buffer locally" settings) (const :tag "smiley: Convert smileys to pretty icons" smiley) (const :tag "sound: Play sounds when you receive CTCP SOUND requests" sound) diff --git a/test/lisp/erc/erc-scenarios-settings.el b/test/lisp/erc/erc-scenarios-settings.el new file mode 100644 index 00000000000..97ff547e12b --- /dev/null +++ b/test/lisp/erc/erc-scenarios-settings.el @@ -0,0 +1,190 @@ +;;; erc-scenarios-settings.el --- erc-settings tests -*- lexical-binding: t -*- + +;; Copyright (C) 2026 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(require 'erc-settings) + +(ert-deftest erc-scenarios-settings/sasl () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-server-flood-penalty 0.1) + (erc-scenarios-common-dialog "settings") + (server-foonet (erc-d-run "localhost" t "server-foonet" 'basic-sasl)) + (server-barnet (erc-d-run "localhost" t "server-barnet" 'basic)) + (port-foonet (process-contact server-foonet :service)) + (port-barnet (process-contact server-barnet :service)) + (erc-modules `(settings ,@erc-modules)) + (erc-settings + `(((and ,(rx-to-string `(: ":" ,(number-to-string port-foonet) eot) t) + (not erc-server-process-alive)) + (erc-modules `(sasl ,@erc-modules) :eval)) + ((and ,(rx-to-string `(: ":" ,(number-to-string port-barnet) eot) t) + (not erc-server-process-alive)) + (erc-modules `(fill-wrap ,@erc-modules) :eval) + (erc-autojoin-channels-alist (("." "#spam")))) + ((and (network . foonet) erc-open-server-buffer-p) + (erc-prompt "server!!!") + (erc-autojoin-channels-alist ((foonet "#chan")))) + ((and (network . foonet) erc-channel-buffer-p) + (erc-modules `(keep-place-indicator ,@erc-modules) :eval)))) + (expect (erc-d-t-make-expecter))) + + ;; Simulate `setopt', `custom-set-variables', etc. + (erc-update-modules) + (with-current-buffer (erc :server "127.0.0.1" + :port port-foonet + :nick "tester" + :user "tester" + :password "changeme" + :full-name "tester") + (funcall expect 10 "This server is in debug mode")) + (with-current-buffer (erc :server "127.0.0.1" + :port port-barnet + :nick "tester" + :user "tester" + :full-name "tester") + (funcall expect 10 "This server is in debug mode")) + + ;; Sentinel variables for modules we're enabling locally. + (defvar erc-fill--wrap-last-msg) + (defvar erc--keep-place-indicator-overlay) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 10 " bob: Grows, lives, and dies") + (should erc--keep-place-indicator-overlay) + (should-not erc-fill--wrap-last-msg) + (funcall expect 10 "ERC>")) + + ;; Targets that don't specify their own local modules inherit any + ;; from their server buffer (if `erc-modules' is locally bound). + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) + (funcall expect 10 " alice: Ay, like a") + (should-not erc--keep-place-indicator-overlay) + (should erc-fill--wrap-last-msg) + (funcall expect 10 "ERC>")) + + ;; Point in fact: `fill-wrap' is enabled in this query buffer. + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "alice")) + (funcall expect 10 " My hand to thee") + (should-not erc--keep-place-indicator-overlay) + (should erc-fill--wrap-last-msg) + (funcall expect 10 "ERC>")) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet")) + (should-not erc--keep-place-indicator-overlay) + (should-not erc-fill--wrap-last-msg) + (funcall expect 10 "server!!!")) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "barnet")) + (should-not erc--keep-place-indicator-overlay) + (should erc-fill--wrap-last-msg) + (funcall expect 10 "ERC>")) + + (erc-settings-mode -1))) + +(ert-deftest erc-scenarios-settings/sasl/id () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-server-flood-penalty 0.1) + (erc-scenarios-common-dialog "settings") + (server-foonet (erc-d-run "localhost" t "server-foonet" 'basic-sasl)) + (server-barnet (erc-d-run "localhost" t "server-barnet" 'basic)) + (port-foonet (process-contact server-foonet :service)) + (port-barnet (process-contact server-barnet :service)) + (erc-modules `(settings ,@erc-modules)) + (erc-settings + `(((not erc-server-process-alive) ; common to both servers + (erc-server "127.0.0.1") + (erc-nick "tester") + (erc-email-userid "tester") + (erc-user-full-name "tester")) + ;; If this were moved to the end of the list (try it), ERC + ;; would skip it because (id . x) matches in channels too. + (erc-channel-buffer-p ; all channels + (erc-modules `(keep-place-indicator ,@erc-modules) :eval)) + ((id . id-foonet) ; foonet only (channels too) + (erc-port ,port-foonet) + (erc-sasl-password "changeme") + (erc-modules `(sasl ,@erc-modules) :eval) + (erc-prompt "wee!!!") + (erc-autojoin-channels-alist ((id-foonet "#chan")))) + ((id . id-barnet) ; barnet only (channels too) + (erc-port ,port-barnet) + (erc-modules `(fill-wrap ,@erc-modules) :eval) + (erc-autojoin-channels-alist ((id-barnet "#spam")))))) + (expect (erc-d-t-make-expecter))) + + ;; Simulate `setopt', `custom-set-variables', etc. + (erc-update-modules) + + ;; Mimic `erc-settings-connect-by-id', except don't use TLS. + (with-current-buffer (erc :server nil :port nil :nick nil :user nil + :password nil :full-name nil :id 'id-foonet) + (should (equal (buffer-name) "id-foonet")) + (funcall expect 10 "This server is in debug mode")) + (with-current-buffer (erc :server nil :port nil :nick nil :user nil + :password nil :full-name nil :id 'id-barnet) + (should (equal (buffer-name) "id-barnet")) + (funcall expect 10 "This server is in debug mode")) + + ;; Sentinel variables for modules we're enabling locally. + (defvar erc-fill--wrap-last-msg) + (defvar erc--keep-place-indicator-overlay) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 10 " bob: Grows, lives, and dies") + (should erc--keep-place-indicator-overlay) + (should-not erc-fill--wrap-last-msg) + (funcall expect 10 "wee!!!")) + + ;; Channel-only module overrides were applied correctly. + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) + (funcall expect 10 " alice: Ay, like a") + (should erc--keep-place-indicator-overlay) + (should-not erc-fill--wrap-last-msg) + (funcall expect 10 "ERC>")) + + ;; Module `fill-wrap' is active in this query buffer because it has + ;; no query-specific overrides for `erc-modules'. It instead + ;; inherits the local value from the server buffer. + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "alice")) + (funcall expect 10 " My hand to thee") + (should-not erc--keep-place-indicator-overlay) + (should erc-fill--wrap-last-msg) + (funcall expect 10 "ERC>")) + + (with-current-buffer "id-foonet" + (should-not erc--keep-place-indicator-overlay) + (should-not erc-fill--wrap-last-msg) + (funcall expect 10 "wee!!!")) + + (with-current-buffer "id-barnet" + (should-not erc--keep-place-indicator-overlay) + (should erc-fill--wrap-last-msg) + (funcall expect 10 "ERC>")) + + (erc-settings-mode -1))) + +;;; erc-scenarios-settings.el ends here diff --git a/test/lisp/erc/erc-settings-tests.el b/test/lisp/erc/erc-settings-tests.el new file mode 100644 index 00000000000..a9e338992db --- /dev/null +++ b/test/lisp/erc/erc-settings-tests.el @@ -0,0 +1,119 @@ +;;; erc-settings-tests.el --- Tests for erc-settings -*- lexical-binding:t -*- + +;; Copyright (C) 2026 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'erc-settings) +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-tests-common))) + +;; This test does some Custom type checking via `setopt'. +(ert-deftest erc-settings () + (when (< emacs-major-version 29) (ert-skip "Needs `setopt'")) + + (cl-letf* ((erc-settings ()) + ((symbol-function 'set-default) #'set) + ((symbol-function 'warn) #'error)) + + (setopt erc-settings `(((or (network . foonet) + ,(rx bot "127.0.0.1:")) + (erc-foo 1)) + ((and ,(rx bot "#emacs") + (not ,(rx bot "#emacs-devel"))) + (erc-foo 2) + (erc-bar 3)))) + + ;; Realistic predicates and bindings. + (setopt erc-settings '(((and (id . foonet) + (not erc-server-process-alive)) + (erc-prompt "ERC! ") + (erc-sasl-user :nick)) + (erc-open-server-buffer-p + (erc-autojoin-channels-alist (("." "#chan")))) + ((or "#chan" "#spam" erc-query-buffer-p) + (erc-modules `(keep-place-indicator ,@erc-modules) + :eval)))) + + ;; Network can also be a regexp. + (setopt erc-settings `(((or ,(rx bot (| "localhost" "127.0.0.1") ":") + (network . foonet)) + (erc-foo 1)) + ((or ,(rx bot "#emacs") "#erc") + (erc-foo 2))))) + + (should (equal erc-settings ()))) + +(ert-deftest erc-settings--gather-bindings () + + ;; Match by network only. + (with-current-buffer (get-buffer-create "foonet") + (setq erc-network 'foonet) + (let ((erc-settings '(((or (network . barnet) ignore nil)) + ((and (network . foonet) always t) + (erc-foo 1) (erc-bar 2)) + ((network . baznet))))) + (should (equal '((erc-foo 1) (erc-bar 2)) + (erc-settings--gather-bindings (current-buffer))))) + (kill-buffer)) + + ;; Multiple regexps. + (with-current-buffer (get-buffer-create "localhost:6697") + (let ((erc-settings '(((network . barnet)) + ("\\`localhost" + (erc-foo 1)) + ("." + (erc-bar 2))))) + (should (equal '((erc-foo 1) (erc-bar 2)) + (erc-settings--gather-bindings (current-buffer)))) + (kill-buffer))) + + ;; One regexp, one network. + (with-current-buffer (get-buffer-create "foonet") + (setq erc-network 'foonet) + (let ((erc-settings `((,(rx (| "foonet" "barnet")) + (erc-foo 1)) + ((and (network . foonet) (name . "foonet")) + (erc-bar 2))))) + (should (equal '((erc-foo 1) (erc-bar 2)) + (erc-settings--gather-bindings (current-buffer))))) + (kill-buffer))) + +(ert-deftest erc-settings--extract-ids () + (should-not (erc-settings--extract-ids)) + + ;; Does not deduplicate. + (let ((erc-settings '(((id . a) + (erc-foo 0)) + ("." + (erc-foo 1)) + ((and t nil) + (erc-foo 2)) + ((and ignore (id . b)) + (erc-foo 3)) + ((or (not (id . c)) (and (id . d) ignore)) + (erc-foo 4)) + ((not (id . a)) + (erc-foo 5))))) + (should (equal (erc-settings--extract-ids) '(a b c d a))))) + +;;; erc-settings-tests.el ends here diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index b3a39c66f5a..74c1a4bfa19 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -3807,6 +3807,7 @@ sasl scrolltobottom services + settings smiley sound spelling diff --git a/test/lisp/erc/resources/settings/basic-sasl.eld b/test/lisp/erc/resources/settings/basic-sasl.eld new file mode 100644 index 00000000000..33d57018bb7 --- /dev/null +++ b/test/lisp/erc/resources/settings/basic-sasl.eld @@ -0,0 +1,47 @@ +;; -*- mode: lisp-data; -*- +((cap 10 "CAP REQ :sasl")) +((nick 10 "NICK tester")) +((user 10 "USER tester 0 * :tester")) +((authenticate 10 "AUTHENTICATE PLAIN") + (0.00 ":irc.foonet.org CAP * ACK sasl") + (0.04 "AUTHENTICATE +")) +((authenticate 10 "AUTHENTICATE AHRlc3RlcgBjaGFuZ2VtZQ==") + (0.01 ":irc.foonet.org 900 * * tester :You are now logged in as tester") + (0.01 ":irc.foonet.org 903 * :Authentication successful")) +((cap 10 "CAP END") + (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1") + (0.01 ":irc.foonet.org 003 tester :This server was created Sat, 01 Feb 2025 03:19:43 UTC") + (0.00 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=25 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server") + (0.03 ":irc.foonet.org 005 tester draft/CHATHISTORY=25 :are supported by this server") + (0.00 ":irc.foonet.org 251 tester :There are 0 users and 4 invisible on 1 server(s)") + (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0.00 ":irc.foonet.org 254 tester 2 :channels formed") + (0.00 ":irc.foonet.org 255 tester :I have 4 clients and 0 servers") + (0.00 ":irc.foonet.org 265 tester 4 4 :Current local users 4, max 4") + (0.03 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4") + (0.00 ":irc.foonet.org 422 tester :MOTD File is missing") + (0.00 ":irc.foonet.org 221 tester +i") + (0.00 ":irc.foonet.org NOTICE tester :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.")) + +((mode-user 10 "MODE tester +i") + (0.00 ":irc.foonet.org 221 tester +i")) + +((join 10 "JOIN #chan") + (0.00 ":tester!~u@pzawpqpfiqshn.irc JOIN #chan") + (0.03 ":irc.foonet.org 353 tester = #chan :@fsbot bob alice tester") + (0.03 ":irc.foonet.org 366 tester #chan :End of NAMES list") + (0.00 ":alice!~u@pgq8itg3w7n3a.irc PRIVMSG #chan :tester, welcome!") + (0.01 ":bob!~u@pgq8itg3w7n3a.irc PRIVMSG #chan :tester, welcome!") + (0.01 ":bob!~u@pgq8itg3w7n3a.irc PRIVMSG #chan :alice: Then the liars and swearers are fools, for there are liars and swearers enow to beat the honest men, and hang up them.")) + +((mode-chan 10 "MODE #chan") + (0.00 ":irc.foonet.org 324 tester #chan +Cnt") + (0.01 ":irc.foonet.org 329 tester #chan 1738379988") + (0.07 ":alice!~u@pgq8itg3w7n3a.irc PRIVMSG #chan :bob: Grows, lives, and dies, in single blessedness.") + (0.05 ":bob!~u@pgq8itg3w7n3a.irc PRIVMSG #chan :alice: Is't come to this, i' faith ? Hath not the world one man but he will wear his cap with suspicion ? Shall I never see a bachelor of three-score again ? Go to, i' faith; an thou wilt needs thrust thy neck into a yoke, wear the print of it, and sigh away Sundays. Look! Don Pedro is returned to seek you.") + (0.05 ":alice!~u@pgq8itg3w7n3a.irc PRIVMSG #chan :There's the fool hangs on your back already.") + (0.07 ":alice!~u@pgq8itg3w7n3a.irc PRIVMSG #chan :bob: Here is a purr of Fortune's, sir, or of Fortune's cat but not a musk-cat that has fallen into the unclean fishpond of her displeasure, and, as he says, is muddied withal. Pray you, sir, use the carp as you may, for he looks like a poor, decayed, ingenious, foolish, rascally knave. I do pity his distress in my similes of comfort, and leave him to your lordship.")) diff --git a/test/lisp/erc/resources/settings/basic.eld b/test/lisp/erc/resources/settings/basic.eld new file mode 100644 index 00000000000..e6a54f1fd38 --- /dev/null +++ b/test/lisp/erc/resources/settings/basic.eld @@ -0,0 +1,38 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER tester 0 * :tester") + (0.00 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester") + (0.01 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version ergo-v2.11.1") + (0.01 ":irc.barnet.org 003 tester :This server was created Sat, 01 Feb 2025 03:19:43 UTC") + (0.00 ":irc.barnet.org 004 tester irc.barnet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 ":irc.barnet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=25 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") + (0.01 ":irc.barnet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=barnet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server") + (0.03 ":irc.barnet.org 005 tester draft/CHATHISTORY=25 :are supported by this server") + (0.00 ":irc.barnet.org 251 tester :There are 0 users and 4 invisible on 1 server(s)") + (0.00 ":irc.barnet.org 252 tester 0 :IRC Operators online") + (0.00 ":irc.barnet.org 253 tester 0 :unregistered connections") + (0.00 ":irc.barnet.org 254 tester 2 :channels formed") + (0.00 ":irc.barnet.org 255 tester :I have 4 clients and 0 servers") + (0.00 ":irc.barnet.org 265 tester 4 4 :Current local users 4, max 4") + (0.03 ":irc.barnet.org 266 tester 4 4 :Current global users 4, max 4") + (0.00 ":irc.barnet.org 422 tester :MOTD File is missing") + (0.00 ":irc.barnet.org 221 tester +i") + (0.00 ":irc.barnet.org NOTICE tester :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.")) + +((mode-user 10 "MODE tester +i") + (0.00 ":irc.barnet.org 221 tester +i")) + +((join 10 "JOIN #spam") + (0.00 ":tester!~u@pzawpqpfiqshn.irc JOIN #spam") + (0.03 ":irc.barnet.org 353 tester = #spam :@fsbot bob alice tester") + (0.03 ":irc.barnet.org 366 tester #spam :End of NAMES list") + (0.00 ":alice!~u@pgq8itg3w7n3a.irc PRIVMSG #spam :tester, welcome!") + (0.01 ":bob!~u@pgq8itg3w7n3a.irc PRIVMSG #spam :tester, welcome!") + (0.07 ":bob!~u@pgq8itg3w7n3a.irc PRIVMSG #spam :Prithee, unpin me,have grace and favour in them.")) + +((mode-chan 10 "MODE #spam") + (0.00 ":irc.barnet.org 324 tester #spam +Cnt") + (0.01 ":irc.barnet.org 329 tester #spam 1738379988") + (0.04 ":bob!~u@pgq8itg3w7n3a.irc PRIVMSG #spam :alice: Ay, like a black dog, as the saying is.") + (0.07 ":alice!~u@pgq8itg3w7n3a.irc PRIVMSG tester :My hand to thee; mine honour on my promise.") + (0.02 ":alice!~u@pgq8itg3w7n3a.irc PRIVMSG #spam :bob: She is Lavinia, therefore must be lov'd.")) commit 7c8c769a4d487b6b0cdb909444a10c7cc484a528 Author: F. Jason Park Date: Sat Feb 1 16:59:51 2025 -0800 Set major-mode before updating modules in erc-open * etc/ERC-NEWS: Mention change. * lisp/erc/erc-button.el (erc-button-mode, erc-button-enable) (erc-button-disable): Use `erc-with-initialized-session' instead of `erc-mode-hook'. * lisp/erc/erc-common.el (erc-with-initialized-session): New macro. * lisp/erc/erc-goodies.el (erc-scrolltobottom-mode) (erc-scrolltobottom-enable, erc-scrolltobottom-disable) (erc-move-to-prompt-mode, erc-move-to-prompt-enable) (erc-move-to-prompt-disable): Use `erc-with-initialized-session' instead of `erc-mode-hook'. * lisp/erc/erc-imenu.el (erc-imenu-mode, erc-imenu-enable) (erc-imenu-disable): Use macro instead of `erc-mode-hook'. * lisp/erc/erc-stamp.el (erc-stamp-mode, erc-stamp-enable) (erc-stamp-disable): Use macro instead of `erc-mode-hook'. * lisp/erc/erc-track.el (erc-track-mode, erc-track-enable) (erc-track-disable): Use macro instead of `erc-mode-hook'. * lisp/erc/erc-truncate.el (erc-truncate-mode, erc-truncate-enable) (erc-truncate-disable): Use macro instead of `erc-mode-hook'. * lisp/erc/erc.el (erc--set-modules-functions): New variable, an internal hook to modify erc-modules membership. (erc-open): Set major mode before updating modules and run `erc--set-modules-functions'. (Bug#76019) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 2088345f97e..68655ecd4bd 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -51,6 +51,16 @@ were simply reversed as given. Now, just like with global modules, ERC preserves the preferred order when activating local modules for new sessions. +*** Major-mode setup runs before global-module setup in 'erc-open'. +The "enable" body of a global module's minor-mode command will now see +'erc-mode' as the 'major-mode'. Although ERC still delays its +major-mode hook until after it has initialized its main session +variables, a module can also now set any of its own variables that don't +depend on such initialization immediately and without fear of their +being killed. For modules still needing to run delayed, session-aware +code, a new convenience macro called 'erc-with-initialized-session' is +now available to automate any 'erc-mode-hook' wrangling for you. + * Changes in ERC 5.6.2 diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index a7b5855e9eb..0fbd43ad22f 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -54,13 +54,11 @@ "This mode buttonizes all messages according to `erc-button-alist'." ((add-hook 'erc-insert-modify-hook #'erc-button-add-buttons 30) (add-hook 'erc-send-modify-hook #'erc-button-add-buttons 30) - (add-hook 'erc-mode-hook #'erc-button-setup 91) - (unless erc--updating-modules-p (erc-buffer-do #'erc-button-setup)) + (erc-with-initialized-session (erc-button-setup)) (add-hook 'erc--tab-functions #'erc-button-next) (erc--modify-local-map t "" #'erc-button-previous)) ((remove-hook 'erc-insert-modify-hook #'erc-button-add-buttons) (remove-hook 'erc-send-modify-hook #'erc-button-add-buttons) - (remove-hook 'erc-mode-hook #'erc-button-setup) (remove-hook 'erc--tab-functions #'erc-button-next) (erc--modify-local-map nil "" #'erc-button-previous))) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index aa176a14b46..481b6084a6a 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -434,6 +434,22 @@ if ARG is omitted or nil. (put ',enable 'definition-name ',name) (put ',disable 'definition-name ',name)))) +(defmacro erc-with-initialized-session (&rest body) + "Run BODY in all ERC buffers if outside `erc-open' and soon otherwise. +When inside `erc-open', run BODY after session variables have been +initialzied and after all `erc-mode-hook' members but before any +`after-change-major-mode-hook' members. Expect caller to know this is +only useful in global-module setup and that they're still responsible +for teardown, which is often done with `erc-buffer-do' or similar." + (let ((fn (make-symbol "fn")) + (hook-var (make-symbol "hook-var"))) + `(let ((,fn (lambda () ,@body))) + (if erc--updating-modules-p + (let ((,hook-var (gensym "erc--oneoff-major-mode-hook-"))) + (set ,hook-var ,fn) + (push ,hook-var delayed-mode-hooks)) + (erc-buffer-do ,fn))))) + (defmacro erc-with-buffer (spec &rest body) "Execute BODY in the buffer associated with SPEC. diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index ec110b65b8c..ddb5a24bd0d 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -79,12 +79,11 @@ be experimental. It currently only works with Emacs 28+." ;;;###autoload(autoload 'erc-scrolltobottom-mode "erc-goodies" nil t) (define-erc-module scrolltobottom nil "This mode causes the prompt to stay at the end of the window." - ((add-hook 'erc-mode-hook #'erc--scrolltobottom-setup) - (when (and erc-scrolltobottom-all (< emacs-major-version 28)) + ((when (and erc-scrolltobottom-all (< emacs-major-version 28)) (erc-button--display-error-notice-with-keys "Option `erc-scrolltobottom-all' requires Emacs 28+. Disabling.") (setq erc-scrolltobottom-all nil)) - (unless erc--updating-modules-p (erc-buffer-do #'erc--scrolltobottom-setup)) + (erc-with-initialized-session (erc--scrolltobottom-setup)) (if erc-scrolltobottom-all (progn (remove-hook 'erc-insert-done-hook #'erc-possibly-scroll-to-bottom) @@ -97,8 +96,7 @@ be experimental. It currently only works with Emacs 28+." (remove-hook 'erc-insert-done-hook #'erc--scrolltobottom-all) (remove-hook 'erc-send-completed-hook #'erc--scrolltobottom-all) (add-hook 'erc-insert-done-hook #'erc-possibly-scroll-to-bottom))) - ((remove-hook 'erc-mode-hook #'erc--scrolltobottom-setup) - (erc-buffer-do #'erc--scrolltobottom-setup) + ((erc-buffer-do #'erc--scrolltobottom-setup) (remove-hook 'erc-insert-pre-hook #'erc--scrolltobottom-on-pre-insert) (remove-hook 'erc-send-completed-hook #'erc--scrolltobottom-all) (remove-hook 'erc-insert-done-hook #'erc--scrolltobottom-all) @@ -258,10 +256,8 @@ Put this function on `erc-insert-post-hook' and/or `erc-send-post-hook'." ;;;###autoload(autoload 'erc-move-to-prompt-mode "erc-goodies" nil t) (define-erc-module move-to-prompt nil "This mode causes the point to be moved to the prompt when typing text." - ((add-hook 'erc-mode-hook #'erc-move-to-prompt-setup) - (unless erc--updating-modules-p (erc-buffer-do #'erc-move-to-prompt-setup))) - ((remove-hook 'erc-mode-hook #'erc-move-to-prompt-setup) - (dolist (buffer (erc-buffer-list)) + ((erc-with-initialized-session (erc-move-to-prompt-setup))) + ((dolist (buffer (erc-buffer-list)) (with-current-buffer buffer (remove-hook 'pre-command-hook #'erc-move-to-prompt t))))) diff --git a/lisp/erc/erc-imenu.el b/lisp/erc/erc-imenu.el index 965e8ead14c..669d8bf42b1 100644 --- a/lisp/erc/erc-imenu.el +++ b/lisp/erc/erc-imenu.el @@ -135,11 +135,9 @@ Don't rely on this function, read it first!" ;;;###autoload(autoload 'erc-imenu-mode "erc-imenu" nil t) (define-erc-module imenu nil "Simple Imenu integration for ERC." - ((add-hook 'erc-mode-hook #'erc-imenu-setup) - (add-hook 'which-function-mode-hook #'erc-imenu--disable-which-func) - (unless erc--updating-modules-p (erc-buffer-do #'erc-imenu-setup))) - ((remove-hook 'erc-mode-hook #'erc-imenu-setup) - (remove-hook 'which-function-mode-hook #'erc-imenu--disable-which-func) + ((add-hook 'which-function-mode-hook #'erc-imenu--disable-which-func) + (erc-with-initialized-session (erc-imenu-setup))) + ((remove-hook 'which-function-mode-hook #'erc-imenu--disable-which-func) (erc-buffer-do #'erc-imenu-setup))) (defun erc-imenu-setup () diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index fa4b829b4cf..f80d49ca343 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -178,13 +178,11 @@ from entering them and instead jump over them." ;;;###autoload(autoload 'erc-timestamp-mode "erc-stamp" nil t) (define-erc-module stamp timestamp "This mode timestamps messages in the channel buffers." - ((add-hook 'erc-mode-hook #'erc-stamp--setup) - (add-hook 'erc-insert-modify-hook #'erc-add-timestamp 70) + ((add-hook 'erc-insert-modify-hook #'erc-add-timestamp 70) (add-hook 'erc-send-modify-hook #'erc-add-timestamp 70) (add-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect) - (unless erc--updating-modules-p (erc-buffer-do #'erc-stamp--setup))) - ((remove-hook 'erc-mode-hook #'erc-stamp--setup) - (remove-hook 'erc-insert-modify-hook #'erc-add-timestamp) + (erc-with-initialized-session (erc-stamp--setup))) + ((remove-hook 'erc-insert-modify-hook #'erc-add-timestamp) (remove-hook 'erc-send-modify-hook #'erc-add-timestamp) (remove-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect) (erc-buffer-do #'erc-stamp--setup))) diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index 91466b9d5e3..53213217f7c 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -607,8 +607,7 @@ keybindings will not do anything useful." ;; enable the tracking keybindings (add-hook 'erc-connect-pre-hook #'erc-track-minor-mode-maybe) (erc-track-minor-mode-maybe)) - (add-hook 'erc-mode-hook #'erc-track--setup) - (unless erc--updating-modules-p (erc-buffer-do #'erc-track--setup)) + (erc-with-initialized-session (erc-track--setup)) (add-hook 'erc-networks--copy-server-buffer-functions #'erc-track--replace-killed-buffer)) ;; Disable: @@ -630,7 +629,6 @@ keybindings will not do anything useful." (remove-hook 'erc-connect-pre-hook #'erc-track-minor-mode-maybe) (when erc-track-minor-mode (erc-track-minor-mode -1))) - (remove-hook 'erc-mode-hook #'erc-track--setup) (erc-buffer-do #'erc-track--setup) (remove-hook 'erc-networks--copy-server-buffer-functions #'erc-track--replace-killed-buffer))) diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el index 340584e26db..d651d87d412 100644 --- a/lisp/erc/erc-truncate.el +++ b/lisp/erc/erc-truncate.el @@ -67,12 +67,10 @@ for other purposes should customize either `erc-enable-logging' or ;;enable ((add-hook 'erc-insert-done-hook #'erc-truncate-buffer) (add-hook 'erc-connect-pre-hook #'erc-truncate--warn-about-logging) - (add-hook 'erc-mode-hook #'erc-truncate--setup) - (unless erc--updating-modules-p (erc-buffer-do #'erc-truncate--setup))) + (erc-with-initialized-session (erc-truncate--setup))) ;; disable ((remove-hook 'erc-insert-done-hook #'erc-truncate-buffer) (remove-hook 'erc-connect-pre-hook #'erc-truncate--warn-about-logging) - (remove-hook 'erc-mode-hook #'erc-truncate--setup) (erc-buffer-do #'erc-truncate--setup))) (defvar-local erc-truncate--buffer-size nil diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 22f2a90de63..b661453fdce 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2497,6 +2497,11 @@ realizes it's missing some required module \"foo\", it can confidently call (erc-foo-mode 1) without having to learn anything about the dependency's implementation.") +(defvar erc--set-modules-functions nil + "Abnormal hook run before updating modules on major-mode init. +Calls members with ID and TARGET parameters of `erc-open', both possibly +nil, along with a non-nil TARGET's server buffer when applicable.") + (defvar erc--setup-buffer-hook '(erc--warn-about-aberrant-modules) "Internal hook for module setup involving windows and frames.") @@ -2652,6 +2657,9 @@ side effect of setting the current buffer to the one it returns. Use (when connect (run-hook-with-args 'erc-before-connect server port nick)) (set-buffer buffer) (setq old-point (point)) + (delay-mode-hooks (erc-mode)) + (run-hook-with-args 'erc--set-modules-functions id channel + (and channel old-buffer)) (setq delayed-modules (erc--merge-local-modes (let ((erc--updating-modules-p t)) (erc--update-modules @@ -2659,8 +2667,6 @@ side effect of setting the current buffer to the one it returns. Use (or erc--server-reconnecting erc--target-priors))) - (delay-mode-hooks (erc-mode)) - (setq erc-server-reconnect-count old-recon-count) (when (setq erc-server-connected (not connect)) commit 5d3fadb2478af116972f65e777796d0ea96a3773 Author: F. Jason Park Date: Sat Oct 12 17:44:30 2024 -0700 Use erc-match API for erc-desktop-notifications * etc/ERC-NEWS: New entries for the `erc-match' API and notification options. * lisp/erc/erc-desktop-notifications.el (erc-desktop-notifications-ignored-when-focused): New option. (erc-desktop-notifications-skip-predicates): New option. (erc-notifications-notify): Address ancient comment regarding PRIVP parameter possibly being unneeded when the current target matches the nick. (erc-notifications-PRIVMSG): Deprecate. (erc-desktop-notifications-untracked-p, erc-desktop-notifications-fool-p) (erc-desktop-notifications-focused-p): New functions for `erc-desktop-notifications-skip-predicates'. (erc-notifications-notify-on-match): Account for new options, and use new `erc-match' API. (erc-notifications-mode, erc-notifications-enable) (erc-notifications-disable): Instead of the "PRIVMSG" response-handler hook, use the `erc-match' API. (erc-desktop-notifications--setup): New function. (erc-desktop-notifications--query-NOTICE-p): New variable. (erc-desktop-notifications-match-query): New struct type. (erc-desktop-notifications--query-p): New function. (erc-desktop-notifications--query-notify): New function. * test/lisp/erc/erc-desktop-notifications-tests.el: New file. (Bug#73798) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index d28c0670a73..2088345f97e 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -14,6 +14,26 @@ GNU Emacs since Emacs version 22.1. * Changes in ERC 5.7 +** A flexible 'match' API. +To the frustration many, ERC has long lacked of a flexible API for +reacting to a message's contents and envelope info, like its sender and +associated IRC command. While the long-term plan is to transition to an +object-based formatting model that should offer more useful access to +the various parts of a message before they're assembled, it's become +obvious that users need something practical in the interim. This +'match' API is based on a simple hook-like handler system that offers +more opportunities for things like filtering and styling. See Info node +'Match API' to find out more. + +** Exercise more control in skipping certain desktop notifications. +Skip select notifications that ERC would otherwise emit with new hook +option 'erc-desktop-notifications-skip-predicates'. Its default members +skip messages from "fools" and those in untracked buffers. + +** Opt out of desktop notifications from the active buffer. +Option 'erc-desktop-notifications-ignored-when-focused' can spare users +from being notified when interacting with the initiating buffer. + ** Changes in the library API. *** Module setup runs in query buffers on reconnect. diff --git a/lisp/erc/erc-desktop-notifications.el b/lisp/erc/erc-desktop-notifications.el index e4a62c614a4..a3b728a5e53 100644 --- a/lisp/erc/erc-desktop-notifications.el +++ b/lisp/erc/erc-desktop-notifications.el @@ -47,6 +47,28 @@ "Icon to use for notification." :type '(choice (const :tag "No icon" nil) file)) +(defcustom erc-desktop-notifications-ignored-when-focused () + "Contexts in which to suppress notification in the selected window. +Assumes `erc-desktop-notifications-focused-p' is a member of +`erc-desktop-notifications-skip-predicates'. If the option's value +contains the symbol `query', ERC skips all notifications in focused +query buffers. And if it contains `mention', ERC skips notifications +upon mention of the user's nick in a focused channel buffer." + :package-version '(ERC . "5.7") + :type '(set (const query) (const mention))) + +(defcustom erc-desktop-notifications-skip-predicates + '(erc-desktop-notifications-focused-p + erc-desktop-notifications-untracked-p + erc-desktop-notifications-fool-p) + "Abnormal hook whose members return non-nil to suppress notification. +Called in match buffer with a matching `erc-match-user' object." + :options '(erc-desktop-notifications-focused-p + erc-desktop-notifications-untracked-p + erc-desktop-notifications-fool-p) + :package-version '(ERC . "5.7") + :type 'hook) + (defcustom erc-notifications-bus :session "D-Bus bus to use for notification." :version "25.1" @@ -60,16 +82,18 @@ (defun erc-notifications-notify (nick msg &optional privp) "Notify that NICK send some MSG, where PRIVP should be non-nil for PRIVMSGs. This will replace the last notification sent with this function." - ;; TODO: can we do this without PRIVP? (by "fixing" ERC's not - ;; setting the current buffer to the existing query buffer) (dbus-ignore-errors (setq erc-notifications-last-notification - (let* ((channel (if privp (erc-get-buffer nick) (current-buffer))) - (title (format "%s in %s" - (erc-compat--xml-escape-string nick t) - channel)) - (body (erc-compat--xml-escape-string (erc-controls-strip msg) - t))) + (let* ((channel (or (and privp (not (equal nick (erc-target))) + (erc-get-buffer nick)) + (current-buffer))) + (title (if (or privp (equal nick (erc-target))) + (erc-compat--xml-escape-string nick t) + (format "%s in %s" + (erc-compat--xml-escape-string nick t) + channel))) + (body (erc-compat--xml-escape-string + (erc-controls-strip msg) t))) (funcall (cond ((featurep 'android) #'android-notifications-notify) ((featurep 'haiku) @@ -85,6 +109,7 @@ This will replace the last notification sent with this function." (pop-to-buffer channel))))))) (defun erc-notifications-PRIVMSG (_proc parsed) + (declare (obsolete "switched to `erc-match-type' API" "31.1")) (let ((nick (car (erc-parse-user (erc-response.sender parsed)))) (target (car (erc-response.command-args parsed))) (msg (erc-response.contents parsed))) @@ -96,23 +121,96 @@ This will replace the last notification sent with this function." ;; Return nil to continue processing by ERC nil) -(defun erc-notifications-notify-on-match (match-type nickuserhost msg) +(defun erc-desktop-notifications-untracked-p (&rest _) + "Return non-nil if current buffer's target appears in `erc-track-exclude'." + (and (boundp 'erc-track-exclude) (member (erc-target) erc-track-exclude))) + +(defun erc-desktop-notifications-fool-p (&rest _) + "Return non-nil if the current message has a \"match type\" of `fool'." + (erc-match-get-match 'erc-match-opt-fool)) + +(defun erc-desktop-notifications-focused-p (match) + "Return non-nil if the frame is focused and suppressed by context. +See `erc-desktop-notifications-ignored-when-focused' for contexts." + (and (eq (current-buffer) (window-buffer)) + (cond + ((erc-query-buffer-p) + (memq 'query erc-desktop-notifications-ignored-when-focused)) + ((erc-match-opt-current-nick-p match) + (memq 'mention erc-desktop-notifications-ignored-when-focused))) + (frame-focus-state))) + +(defun erc-notifications-notify-on-match (match-type _ msg) + "Emit MSG if MATCH-TYPE is `current-nick' and other conditions allow." (when (eq match-type 'current-nick) - (let ((nick (nth 0 (erc-parse-user nickuserhost)))) - (unless (or (string-match-p "^Server:" nick) - (when (boundp 'erc-track-exclude) - (member nick erc-track-exclude))) - (erc-notifications-notify nick msg))))) + (let ((match erc-match-highlight-matched)) + (cl-assert (erc-match-opt-current-nick-p match)) + (when-let* ((nick (erc-match-nick match))) + (unless (run-hook-with-args-until-success + 'erc-desktop-notifications-skip-predicates + match) + (erc-notifications-notify nick msg)))))) ;;;###autoload(autoload 'erc-notifications-mode "erc-desktop-notifications" "" t) (define-erc-module notifications nil "Send notifications on private message reception and mentions." ;; Enable - ((add-hook 'erc-server-PRIVMSG-functions #'erc-notifications-PRIVMSG) - (add-hook 'erc-text-matched-hook #'erc-notifications-notify-on-match)) + ((unless erc--updating-modules-p + (erc-buffer-do #'erc-desktop-notifications--setup)) + (add-hook 'erc-mode-hook #'erc-desktop-notifications--setup)) ;; Disable - ((remove-hook 'erc-server-PRIVMSG-functions #'erc-notifications-PRIVMSG) - (remove-hook 'erc-text-matched-hook #'erc-notifications-notify-on-match))) + ((erc-buffer-do #'erc-desktop-notifications--setup) + (remove-hook 'erc-mode-hook #'erc-desktop-notifications--setup))) + +(defun erc-desktop-notifications--setup () + (if erc-notifications-mode + (progn + (add-hook 'erc-match-functions + ;; Run after default value to detect fools. + #'erc-desktop-notifications-match-query 20 t) + (add-hook 'erc-text-matched-hook #'erc-notifications-notify-on-match + 20 t)) + (remove-hook 'erc-match-functions + #'erc-desktop-notifications-match-query t) + (remove-hook 'erc-text-matched-hook + #'erc-notifications-notify-on-match t))) + +;; This flag is most likely only temporary and exists as a hedge against +;; a likely thinko involving NOTICEs sent to query buffers. At the time +;; of writing, it's unclear whether the current behavior of suppressing +;; query NOTICEs outright is TRT. For example, a user might want +;; NOTICEs from a particular bot to trigger notifications because it's +;; monitoring critical updates to some library they use. When the +;; picture becomes clearer, the introduction of a new option/predicate +;; pair resembling `erc-desktop-notifications-ignored-when-focused' and +;; `erc-desktop-notifications-focused-p' may be warranted. +(defvar erc-desktop-notifications--query-NOTICE-p nil + "Whether to notify on receiving a \"NOTICE\" in a query. +Bots and services typically send these.") + +(cl-defstruct (erc-desktop-notifications-match-query + (:constructor erc-desktop-notifications-match-query) + (:include erc-match-user + (category nil) + (predicate #'erc-desktop-notifications--query-p) + (handler #'erc-desktop-notifications--query-notify))) + "Desktop notification match type for queries.") + +(defun erc-desktop-notifications--query-p (match) + "Return non-nil if MATCH object describes a \"PRIVMSG\" query." + (and (erc-query-buffer-p) + (or erc-desktop-notifications--query-NOTICE-p + (eq (erc-match-command match) 'PRIVMSG)) + (progn + (cl-assert (erc-match-nick match)) + (not (run-hook-with-args-until-success + 'erc-desktop-notifications-skip-predicates match))))) + +(defun erc-desktop-notifications--query-notify (match) + ;; No need for PRIVP arg because current buffer is correct. + (erc-notifications-notify (erc-target) + (erc-match-get-message-body match))) + (provide 'erc-desktop-notifications) diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 7c77960994d..c6675053e55 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -298,7 +298,7 @@ available via universal argument." "Type constructors for \\+`match' processing. See the struct `erc-match' as well as Info node `(erc) Match API' for details." - :package-version '(ERC . "5.7") ; FIXME sync on release + :package-version '(ERC . "5.7") :type '(hook :options (erc-match-opt-pal erc-match-opt-fool erc-match-opt-dangerous-host diff --git a/test/lisp/erc/erc-desktop-notifications-tests.el b/test/lisp/erc/erc-desktop-notifications-tests.el new file mode 100644 index 00000000000..690c0e37ac3 --- /dev/null +++ b/test/lisp/erc/erc-desktop-notifications-tests.el @@ -0,0 +1,139 @@ +;;; erc-desktop-notifications-tests.el --- Notifications tests -*- lexical-binding:t -*- + +;; Copyright (C) 2026 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. +;; +;; GNU Emacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: +;;; Code: +(require 'erc-desktop-notifications) + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-tests-common))) + +(defun erc-desktop-notifications-tests--perform (test) + (erc-tests-common-make-server-buf) + (erc-notifications-mode +1) + (setq erc-server-current-nick "tester") + + (unwind-protect + (cl-letf* ((calls nil) + ((frame-parameter nil 'last-focus-update) + t) + ((symbol-function 'erc-notifications-notify) + (lambda (&rest r) (push r calls)))) + (with-current-buffer (erc--open-target "#chan") + (funcall test (lambda () (prog1 calls (setq calls nil)))))) + + (when noninteractive + (erc-notifications-mode -1) + (erc-tests-common-kill-buffers)))) + +(defun erc-desktop-notifications-tests--populate-chan (test) + (erc-desktop-notifications-tests--perform + (lambda (check) + (erc-tests-common-add-cmem "bob") + (erc-tests-common-add-cmem "alice") + + (erc-tests-common-simulate-line + ":irc.foonet.org 353 tester = #chan :alice bob tester") + (erc-tests-common-simulate-line + ":irc.foonet.org 366 tester #chan :End of NAMES list") + (erc-tests-common-simulate-privmsg "bob" "hi tester") + + (should (equal (current-buffer) (get-buffer "#chan"))) + (should (not (eq (current-buffer) (window-buffer)))) ; *ert* or *scratch* + (funcall test check)))) + +(ert-deftest erc-desktop-notifications-focused-contexts/default () + (should-not erc-desktop-notifications-ignored-when-focused) + + (erc-desktop-notifications-tests--populate-chan + (lambda (check) + + ;; A private query triggers a notification. + (erc-tests-common-simulate-line ":bob!~bob@fsf.org PRIVMSG tester yo") + (should (eq (current-buffer) (get-buffer "bob"))) + + ;; A NOTICE command doesn't trigger a notification (unless + ;; `erc-desktop-notifications--query-NOTICE-p' is non-nil). + (erc-tests-common-simulate-line ":irc.foonet.org NOTICE tester nope") + + (should (equal (funcall check) + '(("bob" "yo") + ("bob" "hi tester\n")))) + + ;; Setting the window to the buffer where insertions are happening + ;; makes no difference: notifications are still sent. + (erc-tests-common-simulate-line ":bob!~bob@fsf.org PRIVMSG tester ho") + + (ert-with-buffer-selected "#chan" + (erc-tests-common-simulate-privmsg "alice" "hi tester") + + (should (equal (funcall check) + '(("alice" "hi tester\n") ("bob" "ho")))))))) + +(ert-deftest erc-desktop-notifications-focused-contexts/unselected () + (should-not erc-desktop-notifications-ignored-when-focused) + + (let ((erc-desktop-notifications-ignored-when-focused '(query mention))) + + (erc-desktop-notifications-tests--populate-chan + (lambda (check) + (should (equal (funcall check) '(("bob" "hi tester\n")))) + + ;; Buffer #chan is current and displayed in the selected window, + ;; so no notification is sent. + (ert-with-buffer-selected "#chan" + (erc-tests-common-simulate-privmsg "alice" "hi tester") + + ;; A new query arrives for a buffer that doesn't exist. The + ;; option `erc-receive-query-display' tells ERC to switch to + ;; that buffer and show it before insertion. Therefore, no + ;; notification is sent. + (let ((erc-receive-query-display 'buffer)) + (erc-tests-common-simulate-line + ":bob!~bob@fsf.org PRIVMSG tester yo"))) + + (should-not (funcall check)))))) + +(ert-deftest erc-desktop-notifications-skip-predicates/fools () + (erc-desktop-notifications-tests--populate-chan + (lambda (check) + + ;; A private query triggers a notification. + (erc-tests-common-simulate-line ":bob!~bob@fsf.org PRIVMSG tester yo") + (should (eq (current-buffer) (get-buffer "bob"))) + + (should (equal (funcall check) + '(("bob" "yo") + ("bob" "hi tester\n")))) + + (let ((erc-fools '("bob"))) + + ;; A query from is suppressed if bob is a fool. + (erc-tests-common-simulate-line ":bob!~bob@fsf.org PRIVMSG tester ho") + (should-not (funcall check)) + + ;; A mention from bob is suppressed if bob is a fool. + (with-current-buffer "#chan" + (erc-tests-common-simulate-privmsg "bob" "hi tester") + (erc-tests-common-simulate-privmsg "alice" "hi tester") + (should (equal (funcall check) '(("alice" "hi tester\n"))))))))) + +;;; erc-desktop-notifications-tests.el ends here commit 3c0fa74ca9a1d1338cb0cd0208cbb58ce3308465 Author: F. Jason Park Date: Sat Jun 3 02:01:29 2023 -0700 Introduce lower level erc-match API * doc/misc/erc.texi (Match API): New node under the Advanced chapter. Update menus. * lisp/erc/erc-match.el (erc-match--opt-pat-cache): New variable. (erc-match--opt-pat-custom-set): New function. (erc-pals, erc-fools, erc-keywords, erc-dangerous-hosts): Specify `erc-match--opt-pat-custom-set' as `custom-set' function. (erc-pal-highlight-type, erc-fool-highlight-type) (erc-dangerous-host-highlight-type): Add `nick-or-mention' variant. (erc-match-functions): New option. (erc-add-entry-to-list, erc-remove-entry-from-list): Clear options cache. (erc-match, erc-match-traditional, erc-match-opt-current-nick) (erc-match-opt-keyword, erc-match-user, erc-match-opt-fool) (erc-match-opt-pal, erc-match-opt-dangerous-host): New struct types. (erc-match--opt-pat-get, erc-match--opt-pat-make) (erc-match--opt-pat-make-kw, erc-match--opt-pat-make-addr-beg) (erc-match--opt-pat-make-addr-end, erc-match--current-nick-p) (erc-match--keyword-p, erc-match--user-nuh-or-mention-p): New functions. (erc-match-highlight-by-part): New generic function and methods. (erc-match-highlight-matched): New variable. (erc-match--instances): New variable. (erc-match-highlight): New function. (erc-match-get-message-body): New function. (erc-match-get-match): New function (erc-match--run-match): New function. (erc-match--message): New function. (erc-match-use-legacy-logic-p): New variable. (erc-match-message): Move body to `erc-match--message-legacy. Rework as thin wrapper. (erc-match--message-legacy): New function with former body of `erc-match-message'. (erc-log-matches): Rework to be slightly less wasteful. * test/lisp/erc/erc-match-tests.el (erc-match-tests--perform): Shadow `erc-match--opt-pat-cache'. (erc-match-message/pal/nick/legacy, erc-match-message/fool/nick/legacy) (erc-match-message/dangerous-host/nick/legacy): New tests. (erc-match-tests--hl-type-nick-or-mention): New function. (erc-match-message/pal/nick-or-mention) (erc-match-message/fool/nick-or-mention) (erc-match-message/dangerous-host/nick-or-mention) (erc-match-message/pal/message/legacy) (erc-match-message/fool/message/legacy) (erc-match-message/dangerous-host/message/legacy) (erc-match-message/pal/all/legacy, erc-match-message/fool/all/legacy) (erc-match-message/dangerous-host/all/legacy) (erc-match-message/current-nick/nick-or-keyword/legacy) (erc-match-message/keyword/keyword/legacy, erc-log-matches/legacy) (ert-deftest erc-match--opt-pat-cache) (erc-match-functions/api/non-parts-based) (erc-match-functions/api/parts-based): New tests. * test/lisp/erc/erc-scenarios-match-api.el: New file. * test/lisp/erc/resources/match/functions/custom-match-log: New file. * test/lisp/erc/resources/match/functions/custom.eld: New file. (Bug#73798) diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 9b75ac6a83c..e8b1724ef5f 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -89,6 +89,7 @@ Advanced Usage * SASL:: Authenticating via SASL. * Sample Configuration:: An example configuration file. * Integrations:: Integrations available for ERC. +* Match API:: Custom matching and highlighting. * Options:: Options that are available for ERC. @end detailmenu @@ -1021,6 +1022,7 @@ list or the bug tracker. * SASL:: Authenticating via SASL. * Sample Configuration:: An example configuration file. * Integrations:: Integrations available for ERC. +* Match API:: Custom matching and highlighting. * Options:: Options that are available for ERC. @detailmenu @@ -2355,6 +2357,322 @@ All keys are symbols, as are values, unless otherwise noted. @end itemize @end table +@node Match API +@section Match API +@cindex low-level match + +This section describes the low-level @samp{match} @acronym{API} +introduced in ERC 5.7. For basic configuration help, please see the doc +strings for option @code{erc-pal-highlight-type} and friends in the +@code{erc-match} group. Unfortunately, those options often prove +insufficient for more granular filtering and highlighting needs, and +advanced users may come to outgrow them. However, under the hood, those +options all use the same foundational @code{erc-match} API, which +centers around a @code{cl-defstruct} @dfn{type} of the same name: + +@deftp {Struct} erc-match @ + predicate spkr-beg spkr-end body-beg sender nick command handler newlinep + + This is a @code{cl-struct} type that contains some handy facts about + the message being processed. That formatted message occupies the + narrowed buffer when ERC creates and provides access to each + @code{erc-match} instance. To use this interface, you add a + @dfn{constructor}-like function to the hook + @code{erc-match-functions}: + + @defopt erc-match-functions + + An abnormal hook for which each member function accepts the parameters + named above as an @samp{&rest}-style plist and returns a new + @code{erc-match} instance. Conforming to this interface are, of + course, traditional constructors automatically provided by a + @code{cl-defstruct} definition derived from @code{erc-match}, such as + @samp{make-my-match} for some @dfn{subtype} @samp{my-match}. + + @end defopt + + The only slot you definitely need to specify is @samp{predicate}. + Both it and @samp{handler} are functions that take a single argument: + the instance itself. As its name implies, @samp{predicate} must + return non-@code{nil} if @samp{handler}, whose return value ERC + ignores, should run. + + A few slots, like @samp{spkr-beg}, @samp{spkr-end}, and @samp{nick}, + may surprise you. The first two are null for non-chat messages, like + those displayed for @samp{JOIN} events. The @samp{nick} slot can + likewise be @code{nil} if the sender of the message is a domain-style + host name, such as @samp{irc.example.org}, which it often is for + informational messages, like @samp{*** #chan was created on 2023-12-26 + 00:36:42}. This includes, for example, server-sent @samp{NOTICE}s and + @samp{221} user-mode changes. + + To locate the start of the just-inserted message, use slot + @samp{body-beg}, a marker indicating the beginning of the message + proper. Locating the end depends on whether the narrowed buffer + includes a trailing newline, which it does if the slot @samp{newlinep} + is non-nil. If you want to extract just the message body's text, use + the function @code{erc-match-get-message-body}: + + @defun erc-match-get-message-body match + + Takes an @code{erc-match} instance and returns a string containing the + message body, sans trailing newline and any leading speaker or + decorative component, such as @code{erc-notice-prefix}. The match + buffer must be current. + + @end defun + +@end deftp + +@noindent +Unless you're writing a module, there's often no need to subclass +@code{erc-match}. For everyday tasks or simple customizations in your +@file{init.el}, you can often just instantiate it directly (it's +@dfn{concrete}). To do this, define a function that invokes its +constructor: + +@lisp +(require 'erc-match) + +(defvar my-mentions 0) + +(defun my-match (&rest plist) + (apply #'erc-match + :predicate (lambda (_) (search-forward "my-project" nil t)) + :handler (lambda (_) (cl-incf my-mentions)) + plist)) + +(add-hook 'erc-match-functions #'my-match) +(setopt erc-prompt (lambda () (format "%d!" my-mentions))) +@end lisp + +@noindent +Here, the user could just as well shove the incrementer into the +@samp{predicate} body, since @samp{handler} is set to @code{ignore} by +default (however, some frown at the notion of a predicate exhibiting +side effects). The user could also choose to concentrate only on chat +content by filtering out non-@samp{PRIVMSG} messages via the slot +@samp{command}. + +In cases where you need a handler to only run when some other match type +appearing earlier in @code{erc-match-functions} has _not_ yielded a +match, use: + +@defun erc-match-get-match constructor + +When called from a @samp{handler} or a @samp{predicate} body, this +utility returns the @code{erc-match} instance from the last successful +match by @code{erc-match-functions} member @var{constructor} for the +current message. Use this for deduplication and to share data between +match instances. + +@end defun + +@noindent +For a detailed example of matching for non-highlighting purposes, see +the @samp{jabbycat} demo module, available on ERC's dev-oriented package +archive: @uref{https://emacs-erc.gitlab.io/bugs/archive/jabbycat.html}. +If you're in a hurry, check out @file{erc-desktop-notifications.el}, +which ships with ERC. Just be aware that it's full of potentially +confusing compatibility-related fuss you'll want to ignore, such as +adapting the global setup and teardown business to a buffer-local +context. (New modules most likely adhere to the modern convention of +being defined as @code{local} in order to allow things like adding local +members to @code{erc-match-functions} in their @dfn{enable body}.) + +@anchor{highlighting} +@subsection Highlighting +@cindex highlighting + +Module authors and normal users alike will often want to manage and +apply faces themselves. If that's you, feel free to skip to the more +extensive examples in the subsection below. However, for the sake of +completeness, it's worth mentioning that (especially in a pinch) you can +likely piggyback atop the highlighting functionality already provided by +@samp{match} to support its traditional high-level options. + +@lisp +(require 'erc-match) + +(defvar my-keywords + `((foonet ("#chan" ,(rx bow (or "foo" "bar" "baz") eow))))) + +(defface my-face + '((t (:inherit font-lock-constant-face :weight bold))) + "My face.") + +(defun my-match (&rest plist) + (apply #'erc-match-opt-keyword + :data (and-let* ((chans (alist-get (erc-network) my-keywords))) + (cdr (assoc (erc-target) chans))) + :face 'my-face + plist)) + +(add-hook 'erc-match-functions #'my-match) +@end lisp + +@noindent +Here, the user leverages a handy subtype of @code{erc-match}, called +@code{erc-match-opt-keyword}, which actually descends directly from +another, intermediate @code{erc-match} type: + +@deftp {Struct} erc-match-traditional category face data part + +Use this type or one of its descendants (see below) if you want +@code{erc-text-matched-hook} to run right after the @samp{handler} +slot's default highlighter, @code{erc-match-highlight}, on every match +for which the @samp{category} slot's value is non-@code{nil} (it becomes +the argument provided for the hook's @var{match-type} parameter). + +The @samp{part} slot determines what portion of the message is being +highlighted or otherwise operated on. It can be any symbol, but the +ones with predefined methods are @code{nick}, @code{message}, +@code{all}, @code{keyword}, @code{nick-or-keyword}, and +@code{nick-or-mention}. + +Accompanying the @samp{part} slot is @samp{data}, which holds the value +of the module's option corresponding to the specific type. For example, +ERC initializes the @samp{data} slot for the @code{erc-match-opt-pal} +type with the value of @code{erc-pals}. + +The default handler, @code{erc-match-highlight}, does its work by +deferring to a purpose-built @dfn{method} meant to handle +@samp{part}-based highlighting: + +@defop {Method} erc-match-traditional erc-match-highlight-by-part @ + instance part + + You can override this method by @dfn{specializing} on any subclassed + @code{erc-match-traditional} type and/or non-reserved @var{part}, such + as one known only to your @file{init.el} or (informally) associated + with your package by its library @dfn{namespace}. + +@end defop + +Note that when the handler runs, the narrowed buffer contains a trailing +newline after the inserted message because, unlike with a normal +@code{erc-match} object, the @samp{newlinep} slot is non-nil. + +@end deftp + +@noindent +You likely won't be needing these, but just for the record, other +options-based types similar to @code{erc-match-opt-keyword} include +@code{erc-match-opt-current-nick}, @code{erc-match-opt-fool}, +@code{erc-match-opt-pal}, and @code{erc-match-opt-dangerous-host}. (If +you're familiar with this module's user options, you'll notice some +parallels here.) + +@anchor{highlighting examples} +@subsubsection Complete Highlighting Examples +@cindex highlighting examples + +As mentioned, most users needn't bother with the piggybacking approach +detailed above, which can oftentimes be more complicated than starting +afresh. Here's a more elaborate, module-like example demoing some +highlighting with a custom @code{erc-match}-derived type. It's a +superficial rewrite of @file{erc-colorize.el} by Sylvain Rousseau +@uref{https://github.com/thisirs/erc-colorize.git}. + +@lisp +;;; erc-colorize.el --- Per-user message faces -*- lexical-binding: t; -*- + +(require 'ring) +(require 'erc-match) +(require 'erc-button) ; for `erc-button-add-face' + +(defgroup erc-colorize nil + "Highlight messages with per-user faces from a limited pool." + :group 'erc) + +(defface erc-colorize-1 '((t :inherit font-lock-keyword-face)) + "Auto-assigned face for distinguishing between messages.") + +(defface erc-colorize-2 '((t :inherit font-lock-type-face)) + "Auto-assigned face for distinguishing between messages.") + +(defface erc-colorize-3 '((t :inherit font-lock-string-face)) + "Auto-assigned face for distinguishing between messages.") + +(defface erc-colorize-4 '((t :inherit font-lock-constant-face)) + "Auto-assigned face for distinguishing between messages.") + +(defface erc-colorize-5 '((t :inherit font-lock-preprocessor-face)) + "Auto-assigned face for distinguishing between messages.") + +(defface erc-colorize-6 '((t :inherit font-lock-variable-name-face)) + "Auto-assigned face for distinguishing between messages.") + +(defface erc-colorize-7 '((t :inherit font-lock-warning-face)) + "Auto-assigned face for distinguishing between messages.") + +(defvar erc-colorize-faces '(erc-colorize-1 + erc-colorize-2 + erc-colorize-3 + erc-colorize-4 + erc-colorize-5 + erc-colorize-6 + erc-colorize-7) + "List of faces to apply to chat messages.") + +(defvar-local erc-colorize-ring nil + "Ring of cons cells of the form (NICK . FACE).") + +(define-erc-module colorize nil + "Highlight messages from a speaker with the same face in target buffers." + ((when (erc-target) + (add-hook 'erc-match-functions 'erc-colorize 0 t) + (setq erc-colorize-ring (make-ring (length erc-colorize-faces))))) + ((remove-hook 'erc-match-functions 'erc-colorize t)) + localp) + +(defun erc-colorize-color (ring nick) + "Return a face to use for string NICK. +Prefer an existing entry in RING. If there isn't one, pick the first +unused face in `erc-colorize-faces'. Otherwise, pick the least used +face." + (or + (and-let* ((i (catch 'found + (dotimes (i (ring-length ring)) + (when (equal (car (ring-ref ring i)) nick) + (throw 'found i)))))) + (ring-insert ring (ring-remove ring i)) + (cdr (ring-ref ring 0))) + (let ((used (mapcar #'cdr (ring-elements ring)))) + (and-let* ((face (catch 'found + (dolist (face erc-colorize-faces) + (unless (member face used) + (throw 'found face)))))) + (prog1 face + (ring-insert ring (cons nick face))))) + (let ((older (ring-remove ring))) + (ring-insert ring (cons nick (cdr older))) + (cdr older)))) + +(cl-defstruct (erc-colorize ( :include erc-match + (predicate #'erc-colorize-nick) + (handler #'erc-colorize-message)) + (:constructor erc-colorize)) + "An `erc-match' type for the `erc-colorize' module.") + +(defun erc-colorize-message (match) + "Highlight MATCH's full message with a face from `erc-colorize-faces'." + (erc-button-add-face (point-min) (point-max) + (erc-colorize-color erc-colorize-ring + (erc-colorize-nick match)))) + +(provide 'erc-colorize) + +;;; erc-colorize.el ends here +@end lisp + +@noindent +Finally, for an even more thorough example in the form of a package, +check out @uref{https://emacs-erc.gitlab.io/bugs/archive/erc-link.html}, +which demos some good practices for integrating with other modules and +passing data from predicate to handler. + + @node Options @section Options @cindex options diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index b003cb1f49e..7c77960994d 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -63,14 +63,28 @@ highlighted." (erc-buffer-do #'erc-match--setup) (erc--modify-local-map nil "C-c C-k" #'erc-go-to-log-matches-buffer))) +;; This caches the result of applying `regexp-opt' analogs to the +;; regexp-based user options, mainly for history playback bursts. +(defvar erc-match--opt-pat-cache nil + "Alist of (COMPUTE-FN . PAIRS) where PAIRS is an alist of (IN . OUT).") + +(defun erc-match--opt-pat-custom-set (sym val &optional _) + "Assign VAL to SYM via `set'." + (when erc-match--opt-pat-cache + (setq erc-match--opt-pat-cache nil)) + (set sym val)) + + ;; Remaining customizations (defcustom erc-pals nil "List of pals on IRC." + :set #'erc-match--opt-pat-custom-set :type '(repeat regexp)) (defcustom erc-fools nil "List of fools on IRC." + :set #'erc-match--opt-pat-custom-set :type '(repeat regexp)) (defcustom erc-keywords nil @@ -78,12 +92,14 @@ highlighted." Each entry in the list is either a regexp, or a cons cell with the regexp in the car and the face to use in the cdr. If no face is specified, `erc-keyword-face' is used." + :set #'erc-match--opt-pat-custom-set :type '(repeat (choice regexp (list regexp face)))) (defcustom erc-dangerous-hosts nil "List of regexps for hosts to highlight. Useful to mark nicks from dangerous hosts." + :set #'erc-match--opt-pat-custom-set :type '(repeat regexp)) (defcustom erc-current-nick-highlight-type 'keyword @@ -122,10 +138,15 @@ The following values are allowed: `all' - highlight the entire message (including the nick) from pal + `nick-or-mention' - highlight a matching speaker or all matching + mentions as quasi keywords + A value of `nick' only highlights a matching sender's nick in the bracketed speaker portion of the message. A value of \\+`message' basically highlights its complement: the message-body alone, after the -speaker tag. All values for this option require a matching sender to be +speaker tag. A value of `nick-or-mention' works like `nick' but also +matches \"mentions,\" which `erc-fool-highlight-type' explains in its +doc string. All values for this option require a matching sender to be an actual user on the network \(or a bot/service) as opposed to a host name, such as that of the server itself \(e.g. \"irc.gnu.org\"). When patterns from other user-based categories \(namely, \\+`fool' and @@ -135,6 +156,7 @@ which in turn clobbers `erc-pal-face'. \(Other effects, such as \\+`fool'-related invisibility may not survive such collisions.)" :type '(choice (const nil) (const nick) + (const nick-or-mention) (const message) (const all))) @@ -148,12 +170,12 @@ IRC-style \"mentions\" in which a speaker addresses a USER directly: USER: hi. USER, hi. -However, at present, this option doesn't offer a means of highlighting -matched mentions alone. See `erc-pal-highlight-type' for a summary of -possible values and additional details common to categories like -\\+`fool' that normally match against a message's sender." +See `erc-pal-highlight-type' for a summary of possible values and +additional details common to categories like \\+`fool' that normally +match against a message's sender." :type '(choice (const nil) (const nick) + (const nick-or-mention) (const message) (const all))) @@ -182,6 +204,7 @@ additional details common to categories like \\+`dangerous-host' that normally match against a message's sender." :type '(choice (const nil) (const nick) + (const nick-or-mention) (const message) (const all))) @@ -241,12 +264,12 @@ for beeping to work." (defcustom erc-text-matched-hook '(erc-log-matches) "Abnormal hook for visiting text matching a predefined \"type\". ERC calls members with the arguments (MATCH-TYPE NUH MESSAGE), where -MATCH-TYPE is a symbol among `current-nick', `keyword', `pal', -`dangerous-host', and `fool'; and NUH is an `erc-response' sender, like -\"bob!~bob@example.org\" or an IRC command prefixed with the string -\"Server:\", as in \"Server:353\". MESSAGE is the current incarnation -of the just-inserted message minus a leading speaker, like \" \". -For traditional reasons, MESSAGE always includes a leading +MATCH-TYPE is a \"category\" symbol, one of `current-nick', `keyword', +`pal', `dangerous-host', and `fool'; and NUH is an `erc-response' +sender, like \"bob!~bob@example.org\" or an IRC command prefixed with +the string \"Server:\", as in \"Server:353\". MESSAGE is the current +incarnation of the just-inserted message minus a leading speaker, like +\" \". For traditional reasons, MESSAGE always includes a leading `erc-notice-prefix' and a trailing newline." :options '(erc-log-matches erc-hide-fools erc-beep-on-match) :type 'hook) @@ -267,6 +290,22 @@ available via universal argument." (const t) (const nil))) +(defcustom erc-match-functions '(erc-match-opt-pal + erc-match-opt-fool + erc-match-opt-dangerous-host + erc-match-opt-keyword + erc-match-opt-current-nick) + "Type constructors for \\+`match' processing. +See the struct `erc-match' as well as Info node `(erc) Match API' for +details." + :package-version '(ERC . "5.7") ; FIXME sync on release + :type '(hook :options (erc-match-opt-pal + erc-match-opt-fool + erc-match-opt-dangerous-host + erc-match-opt-keyword + erc-match-opt-current-nick))) + + ;; Internal variables: ;; This is exactly the same as erc-button-syntax-table. Should we @@ -322,6 +361,8 @@ Note that this is the default face to use if LIST must be passed as a symbol The query happens using PROMPT. Completion is performed on the optional alist COMPLETIONS." + (when erc-match--opt-pat-cache + (setq erc-match--opt-pat-cache nil)) (let ((entry (completing-read prompt completions @@ -345,6 +386,8 @@ Completion is performed on the optional alist COMPLETIONS." LIST must be passed as a symbol. The elements of LIST can be strings, or cons cells where the car is the string." + (when erc-match--opt-pat-cache + (setq erc-match--opt-pat-cache nil)) (let* ((alist (mapcar (lambda (x) (if (listp x) x @@ -468,7 +511,310 @@ In any of the following situations, MSG is directed at an entry FOOL: (or (erc-list-match fools-beg msg) (erc-list-match fools-end msg)))) +(cl-defstruct (erc-match (:constructor erc-match)) + "Base type for text and user matching performed by the \\+`match' module. +Users wishing to perform custom matching should add a constructor that +returns an instance of this type to the hook `erc-match-functions'. If +the `:predicate' slot's predicate returns non-nil after being called +with its own instance in the narrowed single-message buffer, ERC calls +the `:handler' slot's function with the same instance and with the match +data still intact. More details in Info node `(erc) Match API'." + ( predicate (error "Keyword `:predicate' missing") :type function + :documentation "Called in narrowed buffer with own instance.") + ( spkr-beg nil :type (or null natnum) + :documentation "Position of the beginning of speaker's nick, if known.") + ( spkr-end nil :type (or null natnum) + :documentation "Position of the end of speaker's nick, if known.") + ( body-beg (error "Keyword `:body-beg' missing") :type marker + :documentation "Marker residing at the beginning of the message body.") + ( sender (error "Keyword `:sender' missing") :type string + :documentation "The sender's n!u@h.") + ( nick nil :type (or null string) + :documentation "The sender's nick if they're a user and not the server.") + ( command (error "Keyword `:command' missing") :type (or symbol natnum) + :documentation "Protocol command or numeric, like `PRIVMSG' or 353.") + ( handler #'ignore :type function + :documentation "Called on `:predicate' match with own instance.") + ( newlinep nil :type boolean + :documentation "Whether narrowed buffer includes trailing newline.")) + +(cl-defstruct (erc-match-traditional + (:constructor erc-match-traditional) + (:include erc-match + (handler #'erc-match-highlight) + (newlinep t))) + "Match type for user-option based on \"categories\" and \"parts\". +The `:category' slot exists for the benefit of `erc-text-matched-hook', +which receives its value as a second parameter (the hook only runs when +the slot is non-nil). For compatibility, the narrowed buffer includes a +trailing newline." + ( category (error "Keyword `:category' missing") :type symbol + :documentation "Traditional \\+`match' \"category\", like `pal'.") + ( face 'erc-default-face :type face + :documentation "Face to highlight the matched portion with.") + ( part nil :type symbol + :documentation "Symbol for the portion of the message to highlight.") + ( data nil :type list + :documentation "User-specified patterns or other type-specific data.")) + +(cl-defstruct (erc-match-opt-current-nick + (:include erc-match-traditional + (category 'current-nick) + (predicate #'erc-match--current-nick-p) + (part erc-current-nick-highlight-type) + (face 'erc-current-nick-face) + (data (list (concat "\\b" + (regexp-quote (erc-current-nick)) + "\\b")))) + (:constructor erc-match-opt-current-nick)) + "An options-based type for the `current-nick' category.") + +(cl-defstruct (erc-match-opt-keyword + (:include erc-match-traditional + (category 'keyword) + (predicate #'erc-match--keyword-p) + (part erc-keyword-highlight-type) + (face 'erc-keyword-face) + (data erc-keywords)) + (:constructor erc-match-opt-keyword)) + "An options-based type for the `keyword' category.") + +(cl-defstruct (erc-match-user (:include erc-match-traditional) + (:constructor erc-match-user)) + "An `erc-match' that's only processed when `:nick' is non-nil.") + +(cl-defstruct (erc-match-opt-fool + (:include erc-match-user + (category 'fool) + (predicate #'erc-match--user-nuh-or-mention-p) + (part erc-fool-highlight-type) + (face 'erc-fool-face) + (data erc-fools)) + (:constructor erc-match-opt-fool)) + "An options-based type for the `fool' category.") + +(cl-defstruct (erc-match-opt-pal + (:include erc-match-user + (category 'pal) + (predicate #'erc-match--user-nuh-or-mention-p) + (part erc-pal-highlight-type) + (face 'erc-pal-face) + (data erc-pals)) + (:constructor erc-match-opt-pal)) + "An options-based type for the `pal' category.") + +(cl-defstruct (erc-match-opt-dangerous-host + (:include erc-match-user + (category 'dangerous-host) + (predicate #'erc-match--user-nuh-or-mention-p) + (part erc-dangerous-host-highlight-type) + (face 'erc-dangerous-host-face) + (data erc-dangerous-hosts)) + (:constructor erc-match-opt-dangerous-host)) + "An options-based type for the `dangerous-host' category.") + +(defun erc-match--opt-pat-get (compute-fn input) + "Retrieve cached results for computing INPUT with COMPUTE-FN." + (with-memoization (alist-get input (alist-get compute-fn + erc-match--opt-pat-cache nil t) + nil t) + (funcall compute-fn input))) + +(defun erc-match--opt-pat-make (patterns) + "Act like `regexp-opt' but for regexp PATTERNS, not fixed strings." + (string-join patterns "\\|")) + +(defun erc-match--opt-pat-make-kw (patterns) + (mapconcat (lambda (w) (or (car-safe w) w)) patterns "\\|")) + +(defun erc-match--opt-pat-make-addr-beg (patterns) + (concat "\\<\\(" (erc-match--opt-pat-make patterns) "\\)[:,] ")) + +(defun erc-match--opt-pat-make-addr-end (patterns) + (concat "\\s. \\(" (erc-match--opt-pat-make patterns) "\\)\\s.")) + +(defun erc-match--current-nick-p (match) + (re-search-forward (car (erc-match-traditional-data match)) nil t)) + +(defun erc-match--keyword-p (match) + "Return non-nil if the pattern given for MATCH's user option matches." + (and-let* ((patterns (erc-match-traditional-data match))) + (goto-char (erc-match-body-beg match)) + (re-search-forward (erc-match--opt-pat-get #'erc-match--opt-pat-make-kw + patterns) + nil t))) + +(defun erc-match--user-nuh-or-mention-p (match) + "Return non-nil on matching \"NUH\" for MATCH object. +Also do so on mentions if the category is `fool' or the corresponding +\"part\" option is `nick-or-mention'." + (and-let* ((patterns (erc-match-traditional-data match))) + (or (string-match (erc-match--opt-pat-get #'erc-match--opt-pat-make + patterns) + (erc-match-sender match)) + (and (or (eq (erc-match-traditional-category match) 'fool) + (eq (erc-match-traditional-part match) 'nick-or-mention)) + ;; Mimic `erc-match-directed-at-fool-p', but search + ;; the narrowed buffer instead of a string argument. + (goto-char (erc-match-body-beg match)) + (or (looking-at (erc-match--opt-pat-get + #'erc-match--opt-pat-make-addr-beg + patterns)) + (search-forward-regexp + (erc-match--opt-pat-get #'erc-match--opt-pat-make-addr-end + patterns) + nil t)))))) + +(cl-defgeneric erc-match-highlight-by-part (match part) + "Highlight PART of narrowed buffer for `erc-match' object MATCH.") + +(cl-defmethod erc-match-highlight-by-part ((match erc-match-traditional) + (_ (eql nick))) + "Highlight MATCH's nick in the bracketed speaker portion of the message." + (when (erc-match-spkr-beg match) + (erc-put-text-property (erc-match-spkr-beg match) + (erc-match-spkr-end match) + 'font-lock-face + (erc-match-traditional-face match)))) + +(cl-defmethod erc-match-highlight-by-part ((match erc-match-traditional) + (_ (eql message))) + "Highlight MATCH's message body, not including the leading speaker tag." + (erc-put-text-property (erc-match-body-beg match) (point-max) + 'font-lock-face (erc-match-traditional-face match))) + +(cl-defmethod erc-match-highlight-by-part ((match erc-match-traditional) + (_ (eql all))) + "Highlight MATCH's whole message, including the speaker tag." + (erc-put-text-property (point-min) (point-max) + 'font-lock-face (erc-match-traditional-face match))) + +(cl-defmethod erc-match-highlight-by-part ((match erc-match-traditional) + (_ (eql keyword))) + "Highlight all occurrences of all keyword patterns for MATCH." + (dolist (pat (erc-match-traditional-data match)) + (let ((regex (if (consp pat) (car pat) pat)) + (face (if (consp pat) (cdr pat) (erc-match-traditional-face match)))) + (goto-char (erc-match-body-beg match)) + (while (re-search-forward regex nil t) + (erc-put-text-property (match-beginning 0) (match-end 0) + 'font-lock-face face))))) + +(cl-defmethod erc-match-highlight-by-part ((match erc-match-traditional) + (_ (eql nick-or-keyword))) + "Highlight MATCH's speaker-tag nick if applicable, otherwise all mentions." + (if (erc-match-spkr-end match) + (erc-put-text-property (erc-match-spkr-beg match) + (erc-match-spkr-end match) + 'font-lock-face + (erc-match-traditional-face match)) + (erc-match-highlight-by-part match 'keyword))) + +(cl-defmethod erc-match-highlight-by-part ((match erc-match-traditional) + (_ (eql nick-or-mention))) + "Highlight MATCH's speaker tag nick of matching users or all mentions." + (cl-letf (((erc-match-body-beg match) + (or (erc-match-spkr-beg match) (point-min)))) + (erc-match-highlight-by-part match 'keyword))) + +(defvar erc-match-highlight-matched nil + "Matched `erc-match' instance in `erc-text-matched-hook'.") + +(defvar erc-match--instances nil + "Alist mapping constructors to successful `erc-match' instances.") + +(defun erc-match-highlight (match) + "Dispatch `erc-match-highlight-by-part' on MATCH's `:part' slot. +Run `erc-text-matched-hook' when MATCH's `category' slot is non-nil." + (unless (erc-match-traditional-p match) + (signal 'wrong-type-argument (list 'erc-match-traditional match))) + (cl-assert (erc-match-newlinep match)) + (erc-match-highlight-by-part match (erc-match-traditional-part match)) + (when (erc-match-traditional-category match) + (let ((user-nuh (and (erc-match-nick match) (erc-match-sender match))) + (erc-match-highlight-matched match)) + (run-hook-with-args 'erc-text-matched-hook + (erc-match-traditional-category match) + (or user-nuh (format "Server:%s" + (erc-match-command match))) + ;; For compatibility, include a leading "*** ". + (buffer-substring (if user-nuh + (erc-match-body-beg match) + (point-min)) + (point-max)))))) + +(defun erc-match-get-message-body (match) + "Return the message body for MATCH in the current narrowed buffer." + (with-restriction (point-min) + (if (erc-match-newlinep match) (point-max) (1+ (point-max))) + (buffer-substring (erc-match-body-beg match) (1- (point-max))))) + +(defun erc-match-get-match (constructor) + "Return successful `erc-match' instance for CONSTRUCTOR, if any. +Expect to be called only from `erc-match' :predicate and :handler +functions as well as `erc-text-matched-hook' members." + (alist-get constructor erc-match--instances)) + +(defun erc-match--run-match (constructor spkr-beg spkr-end body-beg + nick sender command) + "Run `erc-match' handler if its predicate returns non-nil. +Call CONSTRUCTOR with SPKR-BEG, SPKR-END, BODY-BEG, NICK SENDER, and +COMMAND to create the `erc-match' instance." + (when-let* ((instance (funcall constructor + :spkr-beg spkr-beg + :spkr-end spkr-end + :body-beg body-beg + :nick nick + :sender sender + :command command)) + (_ (or nick (not (erc-match-user-p instance)))) + (_ (goto-char (point-min))) + (_ (funcall (erc-match-predicate instance) instance))) + (if (erc-match-newlinep instance) + (funcall (erc-match-handler instance) instance) + (with-restriction (point-min) (1- (point-max)) + (funcall (erc-match-handler instance) instance))) + (push (cons constructor instance) erc-match--instances) + nil)) + +(defun erc-match--message () + "Run `erc-match-functions' against contents of narrowed buffer." + (goto-char (point-min)) + (let* ((response erc--parsed-response) + (user-nuh (and response (erc-get-parsed-vector-nick response))) + ;; Nick of sender's NUH if they are not the server itself. + (nick (and user-nuh (or (erc--check-msg-prop 'erc--spkr) + (erc-extract-nick user-nuh)))) + (unknownp (erc--check-msg-prop 'erc--msg 'unknown)) + (spkr-end (and (not unknownp) (erc--get-speaker-bounds))) + (spkr-beg (and spkr-end (pop spkr-end))) + (body-beg (save-excursion + (unless unknownp + (when-let* ((fn (erc--check-msg-prop 'erc--pfx))) + (funcall fn))) + (point-marker))) + (command (erc--check-msg-prop 'erc--cmd)) + (erc-match--instances ())) + (with-syntax-table erc-match-syntax-table + (run-hook-wrapped 'erc-match-functions #'erc-match--run-match + spkr-beg spkr-end body-beg nick + (erc-response.sender response) command)))) + +(defvar erc-match-use-legacy-logic-p nil + "When non-nil, use the non-`erc-match' variant of `erc-match-message'.") +(make-obsolete 'erc-match-use-legacy-logic-p + "non-nil behavior mostly replicated bug for bug" "32.1") + (defun erc-match-message () + "Run handlers for matched patterns in the narrowed buffer." + (if (or erc-match-use-legacy-logic-p (null erc--parsed-response)) + (erc-match--message-legacy) + (unless (or (and erc-match-exclude-server-buffer (erc--server-buffer-p)) + (null (erc--check-msg-prop 'erc--cmd)) + (erc--memq-msg-prop 'erc--skip 'match)) + (erc-match--message)))) + +(defun erc-match--message-legacy () "Mark certain keywords in a region. Use this defun with `erc-insert-modify-hook'." ;; This needs some refactoring. @@ -591,27 +937,25 @@ The behavior of this function is controlled by the variables Specify the match types which should be logged in the former, and deactivate/activate match logging in the latter. See `erc-log-match-format'." - (let ((match-buffer-name (cdr (assq match-type - erc-log-matches-types-alist))) - (nick (nth 0 (erc-parse-user nickuserhost)))) - (when (and - (or (eq erc-log-matches-flag t) - (and (eq erc-log-matches-flag 'away) - (erc-away-time))) - match-buffer-name) - (let ((line (format-spec - erc-log-match-format - `((?n . ,nick) - (?t . ,(format-time-string - (or (bound-and-true-p erc-timestamp-format) - "[%Y-%m-%d %H:%M] "))) - (?c . ,(or (erc-default-target) "")) - (?m . ,message) - (?u . ,nickuserhost))))) - (with-current-buffer (erc-log-matches-make-buffer match-buffer-name) - (let ((inhibit-read-only t)) - (goto-char (point-max)) - (insert line))))))) + (when-let* + ((erc-log-matches-flag) + (_ (or (eq erc-log-matches-flag t) (erc-away-time))) + (match-buffer-name (cdr (assq match-type erc-log-matches-types-alist))) + (line (format-spec + erc-log-match-format + (erc-compat--defer-format-spec-in-buffer + (?n . (or (erc--check-msg-prop 'erc--spkr) + (erc-extract-nick nickuserhost))) + (?t . (format-time-string + (or (bound-and-true-p erc-timestamp-format) + "[%Y-%m-%d %H:%M] "))) + (?c erc-default-target) + (?m . message) + (?u . nickuserhost))))) + (with-current-buffer (erc-log-matches-make-buffer match-buffer-name) + (with-silent-modifications + (goto-char (point-max)) + (insert line))))) (defun erc-log-matches-make-buffer (name) "Create or get a log-matches buffer named NAME and return it." diff --git a/test/lisp/erc/erc-match-tests.el b/test/lisp/erc/erc-match-tests.el index 178addeb604..0bb347785c6 100644 --- a/test/lisp/erc/erc-match-tests.el +++ b/test/lisp/erc/erc-match-tests.el @@ -251,8 +251,9 @@ (defun erc-match-tests--perform (test) (erc-tests-common-make-server-buf) (setq erc-server-current-nick "tester") - (with-current-buffer (erc--open-target "#chan") - (funcall test)) + (let (erc-match--opt-pat-cache) + (with-current-buffer (erc--open-target "#chan") + (funcall test))) (when noninteractive (erc-tests-common-kill-buffers))) @@ -346,6 +347,77 @@ (let ((erc-dangerous-hosts (list "bob"))) (erc-match-tests--hl-type-nick 'erc-dangerous-host-face))) +(ert-deftest erc-match-message/pal/nick/legacy () + (should (eq erc-pal-highlight-type 'nick)) + (with-suppressed-warnings ((erc-match-use-legacy-logic-p obsolete)) + (let ((erc-match-use-legacy-logic-p t) + (erc-pals (list "bob"))) + (erc-match-tests--hl-type-nick 'erc-pal-face)))) + +(ert-deftest erc-match-message/fool/nick/legacy () + (should (eq erc-fool-highlight-type 'nick)) + (with-suppressed-warnings ((erc-match-use-legacy-logic-p obsolete)) + (let ((erc-match-use-legacy-logic-p t) + (erc-fools (list "bob"))) + (erc-match-tests--hl-type-nick/mention 'erc-fool-face)))) + +(ert-deftest erc-match-message/dangerous-host/nick/legacy () + (should (eq erc-dangerous-host-highlight-type 'nick)) + (with-suppressed-warnings ((erc-match-use-legacy-logic-p obsolete)) + (let ((erc-match-use-legacy-logic-p t) + (erc-dangerous-hosts (list "bob"))) + (erc-match-tests--hl-type-nick 'erc-dangerous-host-face)))) + +;; Mentions are treated as keywords, even in the speaker portion. +;; Contrast this with `erc-match-tests--hl-type-nick/mention', where the +;; speakers are highlighted despite "mention" matches occurring in the +;; message body. +(defun erc-match-tests--hl-type-nick-or-mention (face) + (erc-match-tests--hl-type-nick + face + (lambda () + (erc-tests-common-simulate-privmsg "alice" "bob: one bob ONE") + (erc-tests-common-simulate-privmsg "alice" "bob, two") + (erc-tests-common-simulate-privmsg "alice" "three, bob.") + + (search-forward " bob: one") + (goto-char (pos-bol)) + (erc-match-tests--assert-face-absent face "bob: one") + (erc-match-tests--assert-face-present face ": one ") + (erc-match-tests--assert-face-absent face "bob ONE") + (erc-match-tests--assert-face-present face " ONE") + (erc-match-tests--assert-face-absent face (pos-eol)) + + (search-forward " bob, two") + (goto-char (pos-bol)) + (erc-match-tests--assert-face-absent face "bob, two") + (erc-match-tests--assert-face-present face ", two") + (erc-match-tests--assert-face-absent face (pos-eol)) + + (search-forward " three, bob.") + (goto-char (pos-bol)) + (erc-match-tests--assert-face-absent face "bob.") + (erc-match-tests--assert-face-present face ".") + (erc-match-tests--assert-face-absent face (pos-eol))))) + +(ert-deftest erc-match-message/pal/nick-or-mention () + (should (eq erc-pal-highlight-type 'nick)) + (let ((erc-pal-highlight-type 'nick-or-mention) + (erc-pals (list "bob"))) + (erc-match-tests--hl-type-nick-or-mention 'erc-pal-face))) + +(ert-deftest erc-match-message/fool/nick-or-mention () + (should (eq erc-fool-highlight-type 'nick)) + (let ((erc-fool-highlight-type 'nick-or-mention) + (erc-fools (list "bob"))) + (erc-match-tests--hl-type-nick-or-mention 'erc-fool-face))) + +(ert-deftest erc-match-message/dangerous-host/nick-or-mention () + (should (eq erc-dangerous-host-highlight-type 'nick)) + (let ((erc-dangerous-host-highlight-type 'nick-or-mention) + (erc-dangerous-hosts (list "bob"))) + (erc-match-tests--hl-type-nick-or-mention 'erc-dangerous-host-face))) + (defun erc-match-tests--hl-type-message (face) (should (eq erc-current-nick-highlight-type 'keyword)) (should (eq erc-keyword-highlight-type 'keyword)) @@ -411,6 +483,30 @@ (erc-dangerous-host-highlight-type 'message)) (erc-match-tests--hl-type-message 'erc-dangerous-host-face))) +(ert-deftest erc-match-message/pal/message/legacy () + (should (eq erc-pal-highlight-type 'nick)) + (with-suppressed-warnings ((erc-match-use-legacy-logic-p obsolete)) + (let ((erc-match-use-legacy-logic-p t) + (erc-pals (list "bob")) + (erc-pal-highlight-type 'message)) + (erc-match-tests--hl-type-message 'erc-pal-face)))) + +(ert-deftest erc-match-message/fool/message/legacy () + (should (eq erc-fool-highlight-type 'nick)) + (with-suppressed-warnings ((erc-match-use-legacy-logic-p obsolete)) + (let ((erc-match-use-legacy-logic-p t) + (erc-fools (list "bob")) + (erc-fool-highlight-type 'message)) + (erc-match-tests--hl-type-message 'erc-fool-face)))) + +(ert-deftest erc-match-message/dangerous-host/message/legacy () + (should (eq erc-dangerous-host-highlight-type 'nick)) + (with-suppressed-warnings ((erc-match-use-legacy-logic-p obsolete)) + (let ((erc-match-use-legacy-logic-p t) + (erc-dangerous-hosts (list "bob")) + (erc-dangerous-host-highlight-type 'message)) + (erc-match-tests--hl-type-message 'erc-dangerous-host-face)))) + (defun erc-match-tests--hl-type-all (face) (should (eq erc-current-nick-highlight-type 'keyword)) (should (eq erc-keyword-highlight-type 'keyword)) @@ -476,6 +572,30 @@ (erc-dangerous-host-highlight-type 'all)) (erc-match-tests--hl-type-all 'erc-dangerous-host-face))) +(ert-deftest erc-match-message/pal/all/legacy () + (should (eq erc-pal-highlight-type 'nick)) + (with-suppressed-warnings ((erc-match-use-legacy-logic-p obsolete)) + (let ((erc-match-use-legacy-logic-p t) + (erc-pals (list "bob")) + (erc-pal-highlight-type 'all)) + (erc-match-tests--hl-type-all 'erc-pal-face)))) + +(ert-deftest erc-match-message/fool/all/legacy () + (should (eq erc-fool-highlight-type 'nick)) + (with-suppressed-warnings ((erc-match-use-legacy-logic-p obsolete)) + (let ((erc-match-use-legacy-logic-p t) + (erc-fools (list "bob")) + (erc-fool-highlight-type 'all)) + (erc-match-tests--hl-type-all 'erc-fool-face)))) + +(ert-deftest erc-match-message/dangerous-host/all/legacy () + (should (eq erc-dangerous-host-highlight-type 'nick)) + (with-suppressed-warnings ((erc-match-use-legacy-logic-p obsolete)) + (let ((erc-match-use-legacy-logic-p t) + (erc-dangerous-hosts (list "bob")) + (erc-dangerous-host-highlight-type 'all)) + (erc-match-tests--hl-type-all 'erc-dangerous-host-face)))) + (defun erc-match-tests--hl-type-nick-or-keyword () (should (eq erc-current-nick-highlight-type 'keyword)) @@ -520,6 +640,11 @@ (ert-deftest erc-match-message/current-nick/nick-or-keyword () (erc-match-tests--hl-type-nick-or-keyword)) +(ert-deftest erc-match-message/current-nick/nick-or-keyword/legacy () + (with-suppressed-warnings ((erc-match-use-legacy-logic-p obsolete)) + (let ((erc-match-use-legacy-logic-p t)) + (erc-match-tests--hl-type-nick-or-keyword)))) + (defun erc-match-tests--hl-type-keyword () (should (eq erc-keyword-highlight-type 'keyword)) @@ -576,6 +701,11 @@ (ert-deftest erc-match-message/keyword/keyword () (erc-match-tests--hl-type-keyword)) +(ert-deftest erc-match-message/keyword/keyword/legacy () + (with-suppressed-warnings ((erc-match-use-legacy-logic-p obsolete)) + (let ((erc-match-use-legacy-logic-p t)) + (erc-match-tests--hl-type-keyword)))) + (defun erc-match-tests--log-matches () (let ((erc-log-matches-flag t) (erc-timestamp-format "[@@TS@@]") @@ -598,5 +728,130 @@ (ert-deftest erc-log-matches () (erc-match-tests--log-matches)) +(ert-deftest erc-log-matches/legacy () + (with-suppressed-warnings ((erc-match-use-legacy-logic-p obsolete)) + (let ((erc-match-use-legacy-logic-p t)) + (erc-match-tests--log-matches)))) + +(ert-deftest erc-match--opt-pat-cache () + (let ((erc-match--opt-pat-cache ())) + (let ((erc-keywords '("foo"))) + (erc-match--keyword-p (erc-match-opt-keyword :body-beg 1 + :sender "" + :command 'fake))) + (let ((erc-keywords '("bar"))) + (erc-match--keyword-p (erc-match-opt-keyword :body-beg 1 + :sender "" + :command 'fake))) + (let ((erc-fools '("baz"))) + (erc-match--user-nuh-or-mention-p (erc-match-opt-fool :body-beg 1 + :sender "" + :command 'fake))) + (should (equal erc-match--opt-pat-cache + '((erc-match--opt-pat-make-addr-end + (("baz") . "\\s. \\(baz\\)\\s.")) + (erc-match--opt-pat-make-addr-beg + (("baz") . "\\<\\(baz\\)[:,] ")) + (erc-match--opt-pat-make + (("baz") . "baz")) + (erc-match--opt-pat-make-kw + (("bar") . "bar") (("foo") . "foo"))))))) + +;; This demos bare-bones usage of the `erc-match' API that implicitly +;; opts out of the traditional options and "parts"-based mechanism. The +;; user does not have to provide a `:part' keyword because they've +;; overridden the `:handler', meaning `erc-match-highlight-by-part' +;; never runs. This is somewhat analogous but ultimately orthogonal to +;; `erc-text-matched-hook' not running because that happens on account +;; of the user not specifying a `:category' field. +(ert-deftest erc-match-functions/api/non-parts-based () + (let* ((results ()) + (erc-text-matched-hook (lambda (&rest r) (push r results))) + (erc-match-functions + (list + (lambda (&rest plist) + ;; Doing everything in `:pred' would also work if + ;; specifying `ignore' for `:handler'. And you wouldn't + ;; even need to return non-nil on matches. + (apply #'erc-match + :predicate (lambda (_) (search-forward "alice" nil t)) + :handler (lambda (m) + (should (eq (erc-match-newlinep m) + (= ?\n (char-before (point-max))))) + (push (match-string 0) results) + (push (erc-match-get-message-body m) results)) + :newlinep (zerop (random 2)) + plist))))) + + (erc-match-tests--perform + (lambda () + (erc-tests-common-add-cmem "bob") + (erc-tests-common-add-cmem "Alice") + (erc-tests-common-simulate-line + ":irc.foonet.org 353 tester = #chan :bob tester Alice") + (erc-tests-common-simulate-line + ":irc.foonet.org 366 tester #chan :End of NAMES list") + (erc-tests-common-simulate-privmsg "bob" "hi ALICE") + (goto-char (point-min)) + + ;; Trailing newline doesn't affect `erc-match-get-message-body'. + (should (equal results '("hi ALICE" + "ALICE" + "Users on #chan: bob tester Alice" + "Alice"))))))) + +;; This one piggybacks on infrastructure supporting the traditional +;; `match' interface. +(ert-deftest erc-match-functions/api/parts-based () + (let* ((results ()) + (bodies ()) + (erc-text-matched-hook (lambda (&rest r) + (push r results))) + (erc-match-functions ())) + + (erc-match-tests--perform + (lambda () + + ;; Use local setter for no particular reason. + (add-hook 'erc-match-functions + (lambda (&rest plist) + (apply #'erc-match-traditional + :category 'keyword + :part 'keyword + :data '("alice") + :face 'error + :predicate (lambda (_) + (search-forward "alice" nil t)) + ;; Override `erc-match-highlight'. + :handler (lambda (m) + (push (erc-match-get-message-body m) + bodies) + (erc-match-highlight m)) + plist)) + 0 t) + + (erc-tests-common-add-cmem "bob") + (erc-tests-common-add-cmem "Alice") + (erc-tests-common-simulate-line + ":irc.foonet.org 353 tester = #chan :Alice bob tester") + (erc-tests-common-simulate-line + ":irc.foonet.org 366 tester #chan :End of NAMES list") + (erc-tests-common-simulate-privmsg "bob" "hi ALICE") + (goto-char (point-min)) + + (search-forward "*** Users on #chan:") + (erc-match-tests--assert-face-absent 'error "Alice") + (erc-match-tests--assert-face-present 'error " bob") + (erc-match-tests--assert-face-absent 'error (pos-eol)) + + ;; Prefixes detected for notices and spoken messages. + (should (equal bodies + '("hi ALICE" + "Users on #chan: Alice bob tester"))) + + (should (equal results + '(( keyword "bob!~bob@fsf.org" "hi ALICE\n") + ( keyword "Server:353" + "*** Users on #chan: Alice bob tester\n")))))))) ;;; erc-match-tests.el ends here diff --git a/test/lisp/erc/erc-scenarios-match-api.el b/test/lisp/erc/erc-scenarios-match-api.el new file mode 100644 index 00000000000..0a8afbf33f2 --- /dev/null +++ b/test/lisp/erc/erc-scenarios-match-api.el @@ -0,0 +1,127 @@ +;;; erc-scenarios-match-api.el --- `erc-match-functions' scenarios -*- lexical-binding: t -*- + +;; Copyright (C) 2026 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(require 'erc-match) +(require 'erc-stamp) + +(defun erc-scenarios-match-api--test-fn (&rest plist) + (apply #'erc-match + :predicate #'always + :handler (lambda (m) + (let ((body (erc-match-get-message-body m)) + (cmd (format (if (numberp (erc-match-command m)) + "%03i" + "%s") + (erc-match-command m))) + (nick (or (erc-match-nick m) "?"))) + (with-current-buffer "*erc-match test matches*" + (save-excursion + (goto-char (point-max)) + (insert cmd " " nick ": " body "\n"))))) + plist)) + +(defun erc-scenarios-match-api--custom-match-functions () + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "match/functions") + (dumb-server (erc-d-run "localhost" t 'custom)) + (port (process-contact dumb-server :service)) + (expect (erc-d-t-make-expecter)) + (erc-server-flood-penalty 0.1) + (erc-autojoin-channels-alist '((foonet "#chan"))) + (match-buffer (get-buffer-create "*erc-match test matches*")) + (erc-match-functions + (cons #'erc-scenarios-match-api--test-fn erc-match-functions)) + ;; Shadow this date stamp instead of mocking the time function. + ;; The version numbers in the QUIT message don't need this + ;; because they're printed verbatim from the server response. + (erc-message-english-s329 "%c was created on @@DATESTAMP@@")) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :full-name "tester" + :user "tester" + :nick "tester") + (funcall expect 5 "debug"))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 10 " There were none principal") + (erc-scenarios-common-say "/query bob")) + + (with-current-buffer "bob" + (erc-scenarios-common-say "hi") + (funcall expect 10 " As much as ever Coriolanus did")) + + (with-current-buffer "foonet" + (erc-scenarios-common-say "/msg NickServ help identify") + (funcall expect 10 "End of NickServ HELP")) + + (with-current-buffer "#chan" + (funcall expect 10 " bob: Thus men may grow wiser") + (erc-scenarios-common-say "/quit") + (funcall expect 10 "quit: Quit:")) + + (with-current-buffer "foonet" + (funcall expect 10 "==> ERROR")) + + (with-temp-buffer + (insert-file-contents + (expand-file-name "match/functions/custom-match-log" + (ert-resource-directory))) + (let ((expected (buffer-string))) + (with-current-buffer "*erc-match test matches*" + (should (equal expected (buffer-string)))))))) + +;; These tests primarily ensure that the various fields of the +;; `erc-match' object, like `spkr-beg', as well as associated utilities, +;; like `erc-match-get-message-body', work as expected. It defines a +;; custom `erc-match-functions' member that prints a summary of every +;; displayed message to its own buffer. That buffer's contents appear +;; in the file resources/match/functions/custom-match-log. + +(ert-deftest erc-scenarios-match-api--custom-functions/basic () + :tags '(:expensive-test) + (erc-scenarios-match-api--custom-match-functions)) + +(ert-deftest erc-scenarios-match-api--custom-functions/fill-wrap () + :tags '(:expensive-test) + (let ((erc-modules (cons 'fill-wrap erc-modules))) + (erc-scenarios-match-api--custom-match-functions))) + +(ert-deftest erc-scenarios-match-api--custom-functions/left-stamps () + :tags '(:expensive-test) + (let ((erc-insert-timestamp-function #'erc-insert-timestamp-left) + (erc-timestamp-only-if-changed-flag nil)) + (erc-scenarios-match-api--custom-match-functions))) + +(ert-deftest erc-scenarios-match-api--custom-functions/left-stamps/fill-wrap () + :tags '(:expensive-test) + (let ((erc-insert-timestamp-function #'erc-insert-timestamp-left) + (erc-timestamp-only-if-changed-flag nil) + (erc-modules (cons 'fill-wrap erc-modules))) + (erc-scenarios-match-api--custom-match-functions))) + +;;; erc-scenarios-match-api.el ends here diff --git a/test/lisp/erc/resources/match/functions/custom-match-log b/test/lisp/erc/resources/match/functions/custom-match-log new file mode 100644 index 00000000000..4b07e4c4fe6 --- /dev/null +++ b/test/lisp/erc/resources/match/functions/custom-match-log @@ -0,0 +1,39 @@ +001 ?: Welcome to the foonet IRC Network tester +002 ?: Your host is irc.foonet.org, running version ergo-v2.17.0 +003 ?: This server was created Sat, 25 Apr 2026 06:08:20 UTC +004 ?: irc.foonet.org ergo-v2.17.0 BERTZios CEIMRUabefhiklmnoqstuv +005 ?: AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=25 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX are supported by this server +005 ?: KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 MSGREFTYPES=msgid,timestamp NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ SAFELIST SAFERATE STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 are supported by this server +005 ?: TOPICLEN=390 UTF8ONLY WHOX draft/CHATHISTORY=25 are supported by this server +251 ?: There are 0 users and 4 invisible on 1 server(s) +252 ?: 0 operator(s) online +253 ?: 0 unknown connection(s) +254 ?: 2 channels formed +255 ?: I have 4 clients and 0 servers +265 ?: Current local users 4, max 4 +266 ?: Current global users 4, max 4 +422 ?: MOTD File is missing +221 ?: User modes for tester: +i +NOTICE ?: 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. +221 ?: User modes for tester: +i +JOIN tester: You have joined channel #chan +353 ?: Users on #chan: @fsbot alice bob tester +PRIVMSG alice: tester, welcome! +PRIVMSG bob: tester, welcome! +PRIVMSG bob: alice: No tearing, lady; I perceive you know it. +324 ?: #chan modes: +Cnt +329 ?: #chan was created on @@DATESTAMP@@ +PRIVMSG alice: There were none principal; they were all like one another as half-pence are; every one fault seeming monstrous till his fellow fault came to match it. +PRIVMSG bob: As much as ever Coriolanus did. +NOTICE NickServ: *** NickServ HELP *** +NOTICE NickServ: Syntax: IDENTIFY [password] +NOTICE NickServ: IDENTIFY lets you login to the given username using either password auth, or +NOTICE NickServ: certfp (your client certificate) if a password is not given. +NOTICE NickServ: *** End of NickServ HELP *** +PRIVMSG bob: alice: Deceive me not now, Navarre is infected. +PRIVMSG bob: Bear me to prison, where I am committed. +PRIVMSG alice: Wisely and slow; they stumble that run fast. +PRIVMSG alice: bob: Thus men may grow wiser every day: it is the first time that ever I heard breaking of ribs was sport for ladies. +QUIT tester: tester (~u@ux6rwus5uzr3u.irc) has quit: Quit: ERC 5.6.2-git (IRC client for GNU Emacs 31.0.50) +QUIT tester: tester (~u@ux6rwus5uzr3u.irc) has quit: Quit: ERC 5.6.2-git (IRC client for GNU Emacs 31.0.50) +ERROR ?: ERROR from 127.0.0.1: Quit: ERC 5.6.2-git (IRC client for GNU Emacs 31.0.50) diff --git a/test/lisp/erc/resources/match/functions/custom.eld b/test/lisp/erc/resources/match/functions/custom.eld new file mode 100644 index 00000000000..073c1e403bb --- /dev/null +++ b/test/lisp/erc/resources/match/functions/custom.eld @@ -0,0 +1,49 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER tester 0 * :tester") + (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.00 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.17.0") + (0.00 ":irc.foonet.org 003 tester :This server was created Sat, 25 Apr 2026 06:08:20 UTC") + (0.00 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.17.0 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=25 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") + (0.00 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 MSGREFTYPES=msgid,timestamp NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ SAFELIST SAFERATE STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 :are supported by this server") + (0.00 ":irc.foonet.org 005 tester TOPICLEN=390 UTF8ONLY WHOX draft/CHATHISTORY=25 :are supported by this server") + (0.00 ":irc.foonet.org 251 tester :There are 0 users and 4 invisible on 1 server(s)") + (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0.10 ":irc.foonet.org 254 tester 2 :channels formed") + (0.00 ":irc.foonet.org 255 tester :I have 4 clients and 0 servers") + (0.00 ":irc.foonet.org 265 tester 4 4 :Current local users 4, max 4") + (0.00 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4") + (0.00 ":irc.foonet.org 422 tester :MOTD File is missing") + (0.00 ":irc.foonet.org 221 tester +i") + (0.00 ":irc.foonet.org NOTICE tester :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.")) +((mode 10 "MODE tester +i")) +((join 10 "JOIN #chan") + (0.00 ":irc.foonet.org 221 tester +i") + (0.00 ":tester!~u@ux6rwus5uzr3u.irc JOIN #chan") + (0.01 ":irc.foonet.org 353 tester = #chan :@fsbot alice bob tester") + (0.00 ":irc.foonet.org 366 tester #chan :End of NAMES list") + (0.01 ":alice!~u@r6eftc2mf679y.irc PRIVMSG #chan :tester, welcome!") + (0.00 ":bob!~u@r6eftc2mf679y.irc PRIVMSG #chan :tester, welcome!") + (0.03 ":bob!~u@r6eftc2mf679y.irc PRIVMSG #chan :alice: No tearing, lady; I perceive you know it.")) +((mode-chan 10 "MODE #chan") + (0.00 ":irc.foonet.org 324 tester #chan +Cnt") + (0.00 ":irc.foonet.org 329 tester #chan 1777097304") + (0.01 ":alice!~u@r6eftc2mf679y.irc PRIVMSG #chan :There were none principal; they were all like one another as half-pence are; every one fault seeming monstrous till his fellow fault came to match it.")) +((privmsg-bob 10 "PRIVMSG bob :hi") + (0.03 ":bob!~u@r6eftc2mf679y.irc PRIVMSG tester :As much as ever Coriolanus did.")) +((privmsg-nickserv 10 "PRIVMSG NickServ :help identify") + (0.02 ":NickServ!NickServ@localhost NOTICE tester :*** \2NickServ HELP\2 ***") + (0.00 ":NickServ!NickServ@localhost NOTICE tester :Syntax: \2IDENTIFY [password]\2") + (0.00 ":NickServ!NickServ@localhost NOTICE tester :IDENTIFY lets you login to the given username using either password auth, or") + (0.00 ":NickServ!NickServ@localhost NOTICE tester :certfp (your client certificate) if a password is not given.") + (0.00 ":NickServ!NickServ@localhost NOTICE tester :*** \2End of NickServ HELP\2 ***") + ;; + (0.07 ":bob!~u@r6eftc2mf679y.irc PRIVMSG #chan :alice: Deceive me not now, Navarre is infected.") + (0.04 ":bob!~u@r6eftc2mf679y.irc PRIVMSG #chan :Bear me to prison, where I am committed.") + (0.07 ":alice!~u@r6eftc2mf679y.irc PRIVMSG #chan :Wisely and slow; they stumble that run fast.") + (0.03 ":alice!~u@r6eftc2mf679y.irc PRIVMSG #chan :bob: Thus men may grow wiser every day: it is the first time that ever I heard breaking of ribs was sport for ladies.")) +((quit 10 "QUIT :") + (0.01 ":tester!~u@ux6rwus5uzr3u.irc QUIT :Quit: \2ERC\2 5.6.2-git (IRC client for GNU Emacs 31.0.50)") + (0.00 "ERROR :Quit: \2ERC\2 5.6.2-git (IRC client for GNU Emacs 31.0.50)")) commit f0e01e0d14150c490fc3c09993192eb3279c7c6c Author: F. Jason Park Date: Thu Apr 23 01:09:45 2026 -0700 Make prefix-body boundary more detectable in ERC * lisp/erc/erc-button.el (erc-button--display-error-notice-with-keys-and-warn): Use utility for skipping past first word. * lisp/erc/erc-fill.el (erc-fill-wrap): Use new `erc--pfx' msg-prop interface. * lisp/erc/erc-goodies.el (erc--command-indicator-body-find): New function. (erc--command-indicator-display): Add `erc--pfx' function-valued msg prop for moving past command-indicator prompt to start of body. Stash inserted prompt string in oneoff `erc--command-indicator' prop. * lisp/erc/erc.el (erc--ensure-spkr-prop): Add `erc--pfx' msg prop for finding the start of the message body after a speaker tag with the `erc--speaker' text property. (erc-display-message-highlight): Add `erc--pfx' functions for known variants of the `erc-display-message' TYPE parameter, such as `notice' and `error'. (erc--ctcp-action-speaker-in-prefix-p): New variable. (erc--pfx-skip-word-fwd, erc--pfx-skip-spkr-fwd) (erc--pfx-skip-notice-fwd, erc--pfx-skip-template-fwd): New functions. * test/lisp/erc/erc-tests.el (erc--pfx-skip-notice-fwd) (erc--pfx-skip-template-fwd): New tests. (Bug#73798) ;; test/lisp/erc/resources/fill/snapshots/merge-01-start.eld: ;; test/lisp/erc/resources/fill/snapshots/merge-02-right.eld: ;; test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld: ;; test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld: ;; test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld: ;; test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld: ;; test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld: ;; test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld: ;; test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld: ;; test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld: Update. diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 3cb2d527cd4..a7b5855e9eb 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -873,9 +873,7 @@ non-strings, concatenate leading string members before applying (with-temp-buffer (insert string) (goto-char (point-min)) - (with-syntax-table lisp-mode-syntax-table - (skip-syntax-forward "^-")) - (forward-char) + (erc--pfx-skip-word-fwd) (erc--lwarn 'erc :warning (buffer-substring-no-properties (point) (point-max)))))) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 7ca29f16e03..0d72bde5309 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -706,15 +706,17 @@ See `erc-fill-wrap-mode' for details." (let ((len (or (and erc-fill--wrap-length-function (funcall erc-fill--wrap-length-function)) (and-let* ((msg-prop (erc--check-msg-prop 'erc--msg)) - ((not (eq msg-prop 'unknown)))) - (when-let* ((e (erc--get-speaker-bounds)) - (b (pop e)) - ((or erc-fill--wrap-action-dedent-p - (not (erc--check-msg-prop 'erc--ctcp - 'ACTION))))) - (goto-char e)) - (skip-syntax-forward "^-") - (forward-char) + (_ (not (eq msg-prop 'unknown)))) + (if-let* ((fn (erc--check-msg-prop 'erc--pfx))) + (let ((erc--ctcp-action-speaker-in-prefix-p + erc-fill--wrap-action-dedent-p)) + (funcall fn)) + ;; FIXME remove this before releasing ERC 5.7. + (unless (eq msg-prop 'datestamp) + (erc--lwarn 'erc-fill :error + "Missing `erc--pfx' skip-fwd function: %S" + (list :msg-prop msg-prop + :buffer-string (buffer-string))))) (cond ((eq msg-prop 'datestamp) (when erc-fill--wrap-rejigger-last-message (set-marker erc-fill--wrap-last-msg (point-min))) diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index e99d5f68175..ec110b65b8c 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -633,6 +633,9 @@ Do nothing if the variable `erc-command-indicator' is nil." (erc--input-split-substxt state) #'erc--command-indicator-display) (erc-send-distinguish-noncommands state))) +(defun erc--command-indicator-body-find () + (search-forward (erc--check-msg-prop 'erc--command-indicator) (pos-eol) t)) + ;; 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. @@ -651,6 +654,9 @@ Do nothing if the variable `erc-command-indicator' is nil." 'hash-table))))) (when-let* ((string (erc-command-indicator)) (erc-input-marker (copy-marker erc-input-marker))) + (puthash 'erc--command-indicator string erc--msg-props) + (puthash 'erc--pfx #'erc--command-indicator-body-find + erc--msg-props) (erc-display-prompt nil nil string 'erc-command-indicator-face) (remove-text-properties insert-position (point) '(field nil erc-prompt nil)) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 591ca1f5fbe..22f2a90de63 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -188,6 +188,9 @@ as of ERC 5.6: - `erc--skip': list of symbols known to modules that indicate an intent to skip or simplify module-specific processing + - `erc--pfx': function taking no args that advances point to the + start of the semantic body + - `erc--ephemeral': a symbol prefixed by or matching a module name; indicates to other modules and members of modification hooks that the current message should not affect stateful @@ -3269,11 +3272,13 @@ when present. Assume NICK itself to be free of any text props, and return it." (cond (erc--msg-props (puthash 'erc--spkr nick erc--msg-props) + (puthash 'erc--pfx #'erc--pfx-skip-spkr-fwd erc--msg-props) (dolist (entry overrides) (puthash (car entry) (cdr entry) erc--msg-props))) (erc--msg-prop-overrides (setq erc--msg-prop-overrides - `((erc--spkr . ,nick) ,@overrides ,@erc--msg-prop-overrides)))) + `((erc--spkr . ,nick) (erc--pfx . ,#'erc--pfx-skip-spkr-fwd) + ,@overrides ,@erc--msg-prop-overrides)))) nick) (defun erc-string-invisible-p (string) @@ -3868,8 +3873,14 @@ retrieval by `text-properties-at' and friends." See also `erc-make-notice'." (cond ((eq type 'notice) + (when erc--msg-props + (puthash 'erc--pfx #'erc--pfx-skip-notice-fwd erc--msg-props)) (erc-make-notice string)) (t + (when (and erc--msg-props ; prefer notice if combined + (not (erc--check-msg-prop 'erc--pfx + #'erc--pfx-skip-notice-fwd))) + (puthash 'erc--pfx #'erc--pfx-skip-template-fwd erc--msg-props)) (erc-put-text-property 0 (length string) 'font-lock-face @@ -6283,6 +6294,35 @@ Assume buffer is narrowed to the confines of an inserted message." 'erc--speaker nil))) (cons beg (next-single-property-change beg 'erc--speaker)))) +(defvar erc--ctcp-action-speaker-in-prefix-p nil + ;; This variable replaces `erc-fill--wrap-action-dedent-p' in ERC 5.6. + "Whether the speaker of a /ME is part of the prefix rather than the body.") + +;; Insertion hook members defer to the function value of the `erc--pfx' +;; msg prop to find the "body" portion of a message after a prefix, such +;; as a " " tag, assuming the `erc--msg' prop isn't `unknown'. +(defun erc--pfx-skip-word-fwd () + "Go to a space following an initial run of non-space chars." + (unless (and (bobp) (eq ?\s (char-after (point)))) + (search-forward " " (pos-eol) t))) + +(defun erc--pfx-skip-spkr-fwd () + "Move point after the first space following the speaker tag. +That's one char beyond the last with a `erc--speaker' text property." + (let ((bounds (erc--get-speaker-bounds))) + (when (or erc--ctcp-action-speaker-in-prefix-p + (not (erc--check-msg-prop 'erc--ctcp 'ACTION))) + (goto-char (cdr bounds))) + (search-forward " " (pos-eol) t))) + +(defun erc--pfx-skip-notice-fwd () + "Move point past `erc-notice-prefix'." + (search-forward erc-notice-prefix (+ (point) (length erc-notice-prefix)) t)) + +(defun erc--pfx-skip-template-fwd () + "Skip common prefixes from the English format-template catalog." + (search-forward-regexp (rx bol (| "\n\n*** " "==> ")) (+ (point) 6) t)) + (defvar erc--cmem-from-nick-function #'erc--cmem-get-existing "Function maybe returning a \"channel member\" cons from a nick. Must return either nil or a cons of an `erc-server-user' and an diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index f2f874717e9..b3a39c66f5a 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -3065,6 +3065,63 @@ (when noninteractive (kill-buffer)))) +(ert-deftest erc--pfx-skip-notice-fwd () + (erc-tests-common-make-server-buf) + ;; Inhibit login I/O. + (setq erc-logged-in t) + + ;; Moves past leading `erc-notice-prefix'. + (let* ((calledp nil) + (erc-insert-modify-hook + (lambda () + (goto-char (point-min)) + (erc--pfx-skip-notice-fwd) + (should (looking-at (rx "One!" eol))) + (setq calledp t)))) + (erc-tests-common-simulate-line ":irc.foonet.net 375 tester :One!") + (should calledp)) + + ;; Respects customized option. + (let* ((erc-notice-prefix "~~> ") + (calledp nil) + (erc-insert-modify-hook + (lambda () + (goto-char (point-min)) + (erc--pfx-skip-notice-fwd) + (should (looking-at (rx "Two!" eol))) + (should (looking-back (rx bol "~~> "))) + (setq calledp t)))) + (erc-tests-common-simulate-line ":irc.foonet.net 372 tester :Two!") + (should calledp))) + +(ert-deftest erc--pfx-skip-template-fwd () + (erc-tests-common-make-server-buf) + + ;; Skips over two leading newlines. + (let* ((calledp nil) + (erc-insert-modify-hook + (lambda () + (goto-char (point-min)) + (should (looking-at (rx eol bol))) + (erc--pfx-skip-template-fwd) + (should (equal (buffer-substring (point) (pos-eol)) + "ERC finished ***")) + (setq calledp t)))) + (erc-display-message nil 'error (current-buffer) 'finished) + (should calledp)) + + ;; Does the same for arbitrary non-whitespace prefix. + (let* ((calledp nil) + (erc-insert-modify-hook + (lambda () + (goto-char (point-min)) + (erc--pfx-skip-template-fwd) + (should (looking-at (rx "ERROR from : Quit 123" eol))) + (should (looking-back (rx bol "==> "))) + (setq calledp t)))) + (erc-tests-common-simulate-line "ERROR :Quit 123") + (should calledp))) + (defun erc-tests--format-my-nick (message) (concat (erc-format-my-nick) (propertize message 'font-lock-face 'erc-input-face))) diff --git a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld index d1dde661020..d01d4c25f87 100644 --- a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld +++ b/test/lisp/erc/resources/fill/snapshots/merge-01-start.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 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 alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero. [07:00]\n one.\n two.\n three.\n four.\n five.\n six.\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 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#6=(margin right-margin) #("[00:00]" 0 7 (font-lock-face erc-timestamp-face invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #5#) 460 467 (wrap-prefix #1# line-prefix #5#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #5#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[07:00]" 0 7 (font-lock-face erc-timestamp-face invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #8=(space :width (- 27 (8)))) 477 482 (wrap-prefix #1# line-prefix #8#) 482 488 (wrap-prefix #1# line-prefix #8#) 489 490 (erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #9=(space :width (- 27 0)) erc-fill--wrap-merge #7="" display #7#) 490 495 (wrap-prefix #1# line-prefix #9# erc-fill--wrap-merge #7# display #7#) 495 497 (wrap-prefix #1# line-prefix #9# erc-fill--wrap-merge #7# display #7#) 497 501 (wrap-prefix #1# line-prefix #9#) 502 503 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 503 506 (wrap-prefix #1# line-prefix #10#) 506 514 (wrap-prefix #1# line-prefix #10#) 515 516 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) erc-fill--wrap-merge #7# display #7#) 516 519 (wrap-prefix #1# line-prefix #11# erc-fill--wrap-merge #7# display #7#) 519 521 (wrap-prefix #1# line-prefix #11# erc-fill--wrap-merge #7# display #7#) 521 526 (wrap-prefix #1# line-prefix #11#) 527 528 (erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 (8)))) 528 533 (wrap-prefix #1# line-prefix #12#) 533 540 (wrap-prefix #1# line-prefix #12#) 541 542 (erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 0)) erc-fill--wrap-merge #7# display #7#) 542 547 (wrap-prefix #1# line-prefix #13# erc-fill--wrap-merge #7# display #7#) 547 549 (wrap-prefix #1# line-prefix #13# erc-fill--wrap-merge #7# display #7#) 549 553 (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 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 alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero. [07:00]\n one.\n two.\n three.\n four.\n five.\n six.\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 erc--pfx erc--pfx-skip-notice-fwd wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#6=(margin right-margin) #("[00:00]" 0 7 (font-lock-face erc-timestamp-face invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #5=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #5#) 460 467 (wrap-prefix #1# line-prefix #5#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #5#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #5# display (#6# #("[07:00]" 0 7 (font-lock-face erc-timestamp-face invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #8=(space :width (- 27 (8)))) 477 482 (wrap-prefix #1# line-prefix #8#) 482 488 (wrap-prefix #1# line-prefix #8#) 489 490 (erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #9=(space :width (- 27 0)) erc-fill--wrap-merge #7="" display #7#) 490 495 (wrap-prefix #1# line-prefix #9# erc-fill--wrap-merge #7# display #7#) 495 497 (wrap-prefix #1# line-prefix #9# erc-fill--wrap-merge #7# display #7#) 497 501 (wrap-prefix #1# line-prefix #9#) 502 503 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 503 506 (wrap-prefix #1# line-prefix #10#) 506 514 (wrap-prefix #1# line-prefix #10#) 515 516 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) erc-fill--wrap-merge #7# display #7#) 516 519 (wrap-prefix #1# line-prefix #11# erc-fill--wrap-merge #7# display #7#) 519 521 (wrap-prefix #1# line-prefix #11# erc-fill--wrap-merge #7# display #7#) 521 526 (wrap-prefix #1# line-prefix #11#) 527 528 (erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #12=(space :width (- 27 (8)))) 528 533 (wrap-prefix #1# line-prefix #12#) 533 540 (wrap-prefix #1# line-prefix #12#) 541 542 (erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #13=(space :width (- 27 0)) erc-fill--wrap-merge #7# display #7#) 542 547 (wrap-prefix #1# line-prefix #13# erc-fill--wrap-merge #7# display #7#) 547 549 (wrap-prefix #1# line-prefix #13# erc-fill--wrap-merge #7# display #7#) 549 553 (wrap-prefix #1# line-prefix #13#)) diff --git a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld index f2770ce1c62..677e131aa25 100644 --- a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld +++ b/test/lisp/erc/resources/fill/snapshots/merge-02-right.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 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 alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero. [07:00]\n one.\n two.\n three.\n four.\n five.\n six.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18))) field erc-timestamp) 21 22 (wrap-prefix #1# line-prefix #2=(space :width (- 29 (4))) erc--msg notice erc--ts 0) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (wrap-prefix #1# line-prefix #2# field erc-timestamp) 184 191 (wrap-prefix #1# line-prefix #2# field erc-timestamp display (#6=(margin right-margin) #("[00:00]" 0 7 (font-lock-face erc-timestamp-face invisible timestamp)))) 192 193 (wrap-prefix #1# line-prefix #3=(space :width (- 29 (8))) erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix (space :width (- 29 (8)))) 350 351 (wrap-prefix #1# line-prefix #4=(space :width (- 29 (6))) erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (wrap-prefix #1# line-prefix (space :width (- 29 (18))) field erc-timestamp) 456 457 (wrap-prefix #1# line-prefix #5=(space :width (- 29 (6))) erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG) 457 460 (wrap-prefix #1# line-prefix #5#) 460 467 (wrap-prefix #1# line-prefix #5#) 467 468 (wrap-prefix #1# line-prefix #5# field erc-timestamp) 468 475 (wrap-prefix #1# line-prefix #5# field erc-timestamp display (#6# #("[07:00]" 0 7 (font-lock-face erc-timestamp-face invisible timestamp)))) 476 477 (wrap-prefix #1# line-prefix #8=(space :width (- 29 (8))) erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG) 477 482 (wrap-prefix #1# line-prefix #8#) 482 488 (wrap-prefix #1# line-prefix #8#) 489 490 (wrap-prefix #1# line-prefix #9=(space :width (- 29 0)) erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG erc-fill--wrap-merge #7="" display #7#) 490 495 (wrap-prefix #1# line-prefix #9# erc-fill--wrap-merge #7# display #7#) 495 497 (wrap-prefix #1# line-prefix #9# erc-fill--wrap-merge #7# display #7#) 497 501 (wrap-prefix #1# line-prefix #9#) 502 503 (wrap-prefix #1# line-prefix #10=(space :width (- 29 (6))) erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG) 503 506 (wrap-prefix #1# line-prefix #10#) 506 514 (wrap-prefix #1# line-prefix #10#) 515 516 (wrap-prefix #1# line-prefix #11=(space :width (- 29 0)) erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc-fill--wrap-merge #7# display #7#) 516 519 (wrap-prefix #1# line-prefix #11# erc-fill--wrap-merge #7# display #7#) 519 521 (wrap-prefix #1# line-prefix #11# erc-fill--wrap-merge #7# display #7#) 521 526 (wrap-prefix #1# line-prefix #11#) 527 528 (wrap-prefix #1# line-prefix #12=(space :width (- 29 (8))) erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG) 528 533 (wrap-prefix #1# line-prefix #12#) 533 540 (wrap-prefix #1# line-prefix #12#) 541 542 (wrap-prefix #1# line-prefix #13=(space :width (- 29 0)) erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG erc-fill--wrap-merge #7# display #7#) 542 547 (wrap-prefix #1# line-prefix #13# erc-fill--wrap-merge #7# display #7#) 547 549 (wrap-prefix #1# line-prefix #13# erc-fill--wrap-merge #7# display #7#) 549 553 (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 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 alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero. [07:00]\n one.\n two.\n three.\n four.\n five.\n six.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18))) field erc-timestamp) 21 22 (wrap-prefix #1# line-prefix #2=(space :width (- 29 (4))) erc--msg notice erc--ts 0 erc--pfx erc--pfx-skip-notice-fwd) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (wrap-prefix #1# line-prefix #2# field erc-timestamp) 184 191 (wrap-prefix #1# line-prefix #2# field erc-timestamp display (#6=(margin right-margin) #("[00:00]" 0 7 (font-lock-face erc-timestamp-face invisible timestamp)))) 192 193 (wrap-prefix #1# line-prefix #3=(space :width (- 29 (8))) erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix (space :width (- 29 (8)))) 350 351 (wrap-prefix #1# line-prefix #4=(space :width (- 29 (6))) erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (wrap-prefix #1# line-prefix (space :width (- 29 (18))) field erc-timestamp) 456 457 (wrap-prefix #1# line-prefix #5=(space :width (- 29 (6))) erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd) 457 460 (wrap-prefix #1# line-prefix #5#) 460 467 (wrap-prefix #1# line-prefix #5#) 467 468 (wrap-prefix #1# line-prefix #5# field erc-timestamp) 468 475 (wrap-prefix #1# line-prefix #5# field erc-timestamp display (#6# #("[07:00]" 0 7 (font-lock-face erc-timestamp-face invisible timestamp)))) 476 477 (wrap-prefix #1# line-prefix #8=(space :width (- 29 (8))) erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd) 477 482 (wrap-prefix #1# line-prefix #8#) 482 488 (wrap-prefix #1# line-prefix #8#) 489 490 (wrap-prefix #1# line-prefix #9=(space :width (- 29 0)) erc--msg msg erc--spkr "alice" erc--ts 1680332400 erc--cmd PRIVMSG erc-fill--wrap-merge #7="" erc--pfx erc--pfx-skip-spkr-fwd display #7#) 490 495 (wrap-prefix #1# line-prefix #9# erc-fill--wrap-merge #7# display #7#) 495 497 (wrap-prefix #1# line-prefix #9# erc-fill--wrap-merge #7# display #7#) 497 501 (wrap-prefix #1# line-prefix #9#) 502 503 (wrap-prefix #1# line-prefix #10=(space :width (- 29 (6))) erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd) 503 506 (wrap-prefix #1# line-prefix #10#) 506 514 (wrap-prefix #1# line-prefix #10#) 515 516 (wrap-prefix #1# line-prefix #11=(space :width (- 29 0)) erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc-fill--wrap-merge #7# erc--pfx erc--pfx-skip-spkr-fwd display #7#) 516 519 (wrap-prefix #1# line-prefix #11# erc-fill--wrap-merge #7# display #7#) 519 521 (wrap-prefix #1# line-prefix #11# erc-fill--wrap-merge #7# display #7#) 521 526 (wrap-prefix #1# line-prefix #11#) 527 528 (wrap-prefix #1# line-prefix #12=(space :width (- 29 (8))) erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd) 528 533 (wrap-prefix #1# line-prefix #12#) 533 540 (wrap-prefix #1# line-prefix #12#) 541 542 (wrap-prefix #1# line-prefix #13=(space :width (- 29 0)) erc--msg msg erc--spkr "Dummy" erc--ts 1680332400 erc--cmd PRIVMSG erc-fill--wrap-merge #7# erc--pfx erc--pfx-skip-spkr-fwd display #7#) 542 547 (wrap-prefix #1# line-prefix #13# erc-fill--wrap-merge #7# display #7#) 547 549 (wrap-prefix #1# line-prefix #13# erc-fill--wrap-merge #7# display #7#) 549 553 (wrap-prefix #1# line-prefix #13#)) 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 fc011e14530..82f136d8266 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 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 alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero. [07:00]\n 0.5\n* bob one.\n two.\n 2.5\n* bob three\n 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 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (font-lock-face erc-timestamp-face invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #6#) 460 467 (wrap-prefix #1# line-prefix #6#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #6#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (font-lock-face erc-timestamp-face invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) erc-fill--wrap-merge #8="" display #8#) 477 480 (wrap-prefix #1# line-prefix #7# erc-fill--wrap-merge #8# display #8#) 480 482 (wrap-prefix #1# line-prefix #7# erc-fill--wrap-merge #8# display #8#) 482 485 (wrap-prefix #1# line-prefix #7#) 486 487 (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)))) 487 488 (wrap-prefix #1# line-prefix #9#) 488 491 (wrap-prefix #1# line-prefix #9#) 491 496 (wrap-prefix #1# line-prefix #9#) 497 498 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 498 501 (wrap-prefix #1# line-prefix #10#) 501 507 (wrap-prefix #1# line-prefix #10#) 508 509 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) erc-fill--wrap-merge #8# display #8#) 509 512 (wrap-prefix #1# line-prefix #11# erc-fill--wrap-merge #8# display #8#) 512 514 (wrap-prefix #1# line-prefix #11# erc-fill--wrap-merge #8# display #8#) 514 517 (wrap-prefix #1# line-prefix #11#) 518 519 (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)))) 519 520 (wrap-prefix #1# line-prefix #12#) 520 523 (wrap-prefix #1# line-prefix #12#) 523 529 (wrap-prefix #1# line-prefix #12#) 530 531 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 531 534 (wrap-prefix #1# line-prefix #13#) 534 541 (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 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 alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero. [07:00]\n 0.5\n* bob one.\n two.\n 2.5\n* bob three\n 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 erc--pfx erc--pfx-skip-notice-fwd wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (font-lock-face erc-timestamp-face invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #6#) 460 467 (wrap-prefix #1# line-prefix #6#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #6#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (font-lock-face erc-timestamp-face invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #7=(space :width (- 27 0)) erc-fill--wrap-merge #8="" display #8#) 477 480 (wrap-prefix #1# line-prefix #7# erc-fill--wrap-merge #8# display #8#) 480 482 (wrap-prefix #1# line-prefix #7# erc-fill--wrap-merge #8# display #8#) 482 485 (wrap-prefix #1# line-prefix #7#) 486 487 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 487 488 (wrap-prefix #1# line-prefix #9#) 488 491 (wrap-prefix #1# line-prefix #9#) 491 496 (wrap-prefix #1# line-prefix #9#) 497 498 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #10=(space :width (- 27 (6)))) 498 501 (wrap-prefix #1# line-prefix #10#) 501 507 (wrap-prefix #1# line-prefix #10#) 508 509 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #11=(space :width (- 27 0)) erc-fill--wrap-merge #8# display #8#) 509 512 (wrap-prefix #1# line-prefix #11# erc-fill--wrap-merge #8# display #8#) 512 514 (wrap-prefix #1# line-prefix #11# erc-fill--wrap-merge #8# display #8#) 514 517 (wrap-prefix #1# line-prefix #11#) 518 519 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #12=(space :width (- 27 (2)))) 519 520 (wrap-prefix #1# line-prefix #12#) 520 523 (wrap-prefix #1# line-prefix #12#) 523 529 (wrap-prefix #1# line-prefix #12#) 530 531 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #13=(space :width (- 27 (6)))) 531 534 (wrap-prefix #1# line-prefix #13#) 534 541 (wrap-prefix #1# line-prefix #13#)) 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 ad9bec913a7..3c7c5e58910 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 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 alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero. [07:00]\n 0.5\n* bob one.\n two.\n 2.5\n* bob three\n 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 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (font-lock-face erc-timestamp-face invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #6#) 460 467 (wrap-prefix #1# line-prefix #6#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #6#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (font-lock-face erc-timestamp-face invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #7=(space :width (- 27 #10=(2))) erc-fill--wrap-merge t display #8=#("> " 0 1 (font-lock-face shadow))) 477 480 (wrap-prefix #1# line-prefix #7# erc-fill--wrap-merge t display #8#) 480 482 (wrap-prefix #1# line-prefix #7# erc-fill--wrap-merge t display #8#) 482 485 (wrap-prefix #1# line-prefix #7#) 486 487 (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)))) 487 488 (wrap-prefix #1# line-prefix #9#) 488 491 (wrap-prefix #1# line-prefix #9#) 491 496 (wrap-prefix #1# line-prefix #9#) 497 498 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #11=(space :width (- 27 (6)))) 498 501 (wrap-prefix #1# line-prefix #11#) 501 507 (wrap-prefix #1# line-prefix #11#) 508 509 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #12=(space :width (- 27 #10#)) erc-fill--wrap-merge t display #8#) 509 512 (wrap-prefix #1# line-prefix #12# erc-fill--wrap-merge t display #8#) 512 514 (wrap-prefix #1# line-prefix #12# erc-fill--wrap-merge t display #8#) 514 517 (wrap-prefix #1# line-prefix #12#) 518 519 (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)))) 519 520 (wrap-prefix #1# line-prefix #13#) 520 523 (wrap-prefix #1# line-prefix #13#) 523 529 (wrap-prefix #1# line-prefix #13#) 530 531 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #14=(space :width (- 27 (6)))) 531 534 (wrap-prefix #1# line-prefix #14#) 534 541 (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 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 alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1 2023]\n zero. [07:00]\n 0.5\n* bob one.\n two.\n 2.5\n* bob three\n 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 erc--pfx erc--pfx-skip-notice-fwd wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display (#5=(margin right-margin) #("[00:00]" 0 7 (font-lock-face erc-timestamp-face invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 437 438 (erc--msg datestamp erc--ts 1680307200 field erc-timestamp) 438 455 (field erc-timestamp wrap-prefix #1# line-prefix (space :width (- 27 (18)))) 456 457 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #6=(space :width (- 27 (6)))) 457 460 (wrap-prefix #1# line-prefix #6#) 460 467 (wrap-prefix #1# line-prefix #6#) 467 468 (field erc-timestamp wrap-prefix #1# line-prefix #6#) 468 475 (field erc-timestamp wrap-prefix #1# line-prefix #6# display (#5# #("[07:00]" 0 7 (font-lock-face erc-timestamp-face invisible timestamp)))) 476 477 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #7=(space :width (- 27 #10=(2))) erc-fill--wrap-merge t display #8=#("> " 0 1 (font-lock-face shadow))) 477 480 (wrap-prefix #1# line-prefix #7# erc-fill--wrap-merge t display #8#) 480 482 (wrap-prefix #1# line-prefix #7# erc-fill--wrap-merge t display #8#) 482 485 (wrap-prefix #1# line-prefix #7#) 486 487 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 487 488 (wrap-prefix #1# line-prefix #9#) 488 491 (wrap-prefix #1# line-prefix #9#) 491 496 (wrap-prefix #1# line-prefix #9#) 497 498 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #11=(space :width (- 27 (6)))) 498 501 (wrap-prefix #1# line-prefix #11#) 501 507 (wrap-prefix #1# line-prefix #11#) 508 509 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #12=(space :width (- 27 #10#)) erc-fill--wrap-merge t display #8#) 509 512 (wrap-prefix #1# line-prefix #12# erc-fill--wrap-merge t display #8#) 512 514 (wrap-prefix #1# line-prefix #12# erc-fill--wrap-merge t display #8#) 514 517 (wrap-prefix #1# line-prefix #12#) 518 519 (erc--msg ctcp-action erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--ctcp ACTION erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #13=(space :width (- 27 (2)))) 519 520 (wrap-prefix #1# line-prefix #13#) 520 523 (wrap-prefix #1# line-prefix #13#) 523 529 (wrap-prefix #1# line-prefix #13#) 530 531 (erc--msg msg erc--spkr "bob" erc--ts 1680332400 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #14=(space :width (- 27 (6)))) 531 534 (wrap-prefix #1# line-prefix #14#) 534 541 (wrap-prefix #1# line-prefix #14#)) diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld index 8fee2a8d0d8..71f97b3fafc 100644 --- a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld +++ b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.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 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 alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\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 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (font-lock-face erc-timestamp-face invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#)) \ 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 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 alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\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 erc--pfx erc--pfx-skip-notice-fwd wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (font-lock-face erc-timestamp-face invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#)) diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld index e0d529dd8a4..d992ec108c7 100644 --- a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld +++ b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.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 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 alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (font-lock-face erc-timestamp-face invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 29 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 29 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#)) \ 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 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 alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 29) line-prefix (space :width (- 29 (18)))) 21 22 (erc--msg notice erc--ts 0 erc--pfx erc--pfx-skip-notice-fwd wrap-prefix #1# line-prefix #2=(space :width (- 29 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (font-lock-face erc-timestamp-face invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #3=(space :width (- 29 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #4=(space :width (- 29 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#)) diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld index cd8c0298ad1..f5d1f19972d 100644 --- a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld +++ b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.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 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 alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 25) line-prefix (space :width (- 25 (18)))) 21 22 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #2=(space :width (- 25 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (font-lock-face erc-timestamp-face invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 25 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 25 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#)) \ 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 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 alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg datestamp erc--ts 0 field erc-timestamp) 3 20 (field erc-timestamp wrap-prefix #1=(space :width 25) line-prefix (space :width (- 25 (18)))) 21 22 (erc--msg notice erc--ts 0 erc--pfx erc--pfx-skip-notice-fwd wrap-prefix #1# line-prefix #2=(space :width (- 25 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (font-lock-face erc-timestamp-face invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #3=(space :width (- 25 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #4=(space :width (- 25 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#)) diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld index 8fee2a8d0d8..71f97b3fafc 100644 --- a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld +++ b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.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 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 alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\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 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (font-lock-face erc-timestamp-face invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#)) \ 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 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 alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\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 erc--pfx erc--pfx-skip-notice-fwd wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (font-lock-face erc-timestamp-face invisible timestamp)))) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#)) diff --git a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld index 211e9afac22..1d14672dbc3 100644 --- a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld +++ b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.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 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 alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n This buffer is for text.\n*** one two three\n*** four five six\n Somebody stop me\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 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (font-lock-face erc-timestamp-face invisible timestamp)))) 191 192 (line-spacing 0.5) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 349 350 (line-spacing 0.5) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 436 437 (line-spacing 0.5) 437 438 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #5=(space :width (- 27 0)) erc-fill--wrap-merge #6="" display #6#) 438 441 (wrap-prefix #1# line-prefix #5# erc-fill--wrap-merge #6# display #6#) 441 443 (wrap-prefix #1# line-prefix #5# erc-fill--wrap-merge #6# display #6#) 443 467 (wrap-prefix #1# line-prefix #5#) 467 468 (line-spacing 0.5) 468 469 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #7=(space :width (- 27 (4)))) 469 485 (wrap-prefix #1# line-prefix #7#) 486 487 (erc--msg notice erc--ts 0 wrap-prefix #1# line-prefix #8=(space :width (- 27 (4)))) 487 503 (wrap-prefix #1# line-prefix #8#) 503 504 (line-spacing 0.5) 504 505 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 505 508 (wrap-prefix #1# line-prefix #9#) 508 526 (wrap-prefix #1# line-prefix #9#)) \ 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 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 alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n This buffer is for text.\n*** one two three\n*** four five six\n Somebody stop me\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 erc--pfx erc--pfx-skip-notice-fwd wrap-prefix #1# line-prefix #2=(space :width (- 27 (4)))) 22 183 (wrap-prefix #1# line-prefix #2#) 183 184 (field erc-timestamp wrap-prefix #1# line-prefix #2#) 184 191 (field erc-timestamp wrap-prefix #1# line-prefix #2# display ((margin right-margin) #("[00:00]" 0 7 (font-lock-face erc-timestamp-face invisible timestamp)))) 191 192 (line-spacing 0.5) 192 193 (erc--msg msg erc--spkr "alice" erc--ts 0 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 193 198 (wrap-prefix #1# line-prefix #3#) 198 200 (wrap-prefix #1# line-prefix #3#) 200 203 (wrap-prefix #1# line-prefix #3#) 203 316 (wrap-prefix #1# line-prefix #3#) 317 349 (wrap-prefix #1# line-prefix #3#) 349 350 (line-spacing 0.5) 350 351 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #4=(space :width (- 27 (6)))) 351 354 (wrap-prefix #1# line-prefix #4#) 354 356 (wrap-prefix #1# line-prefix #4#) 356 361 (wrap-prefix #1# line-prefix #4#) 361 436 (wrap-prefix #1# line-prefix #4#) 436 437 (line-spacing 0.5) 437 438 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #5=(space :width (- 27 0)) erc-fill--wrap-merge #6="" display #6#) 438 441 (wrap-prefix #1# line-prefix #5# erc-fill--wrap-merge #6# display #6#) 441 443 (wrap-prefix #1# line-prefix #5# erc-fill--wrap-merge #6# display #6#) 443 467 (wrap-prefix #1# line-prefix #5#) 467 468 (line-spacing 0.5) 468 469 (erc--msg notice erc--ts 0 erc--pfx erc--pfx-skip-notice-fwd wrap-prefix #1# line-prefix #7=(space :width (- 27 (4)))) 469 485 (wrap-prefix #1# line-prefix #7#) 486 487 (erc--msg notice erc--ts 0 erc--pfx erc--pfx-skip-notice-fwd wrap-prefix #1# line-prefix #8=(space :width (- 27 (4)))) 487 503 (wrap-prefix #1# line-prefix #8#) 503 504 (line-spacing 0.5) 504 505 (erc--msg msg erc--spkr "bob" erc--ts 0 erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd wrap-prefix #1# line-prefix #9=(space :width (- 27 (6)))) 505 508 (wrap-prefix #1# line-prefix #9#) 508 526 (wrap-prefix #1# line-prefix #9#)) diff --git a/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld index 1b22b6c5cfd..2310b1d7af2 100644 --- a/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld +++ b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld @@ -1 +1 @@ -#("\n\n[00:00]*** 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.\n[00:00] 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[00:00] alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg notice erc--ts 0 display #3=(#5=(margin left-margin) #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix #2=(space :width (- 27 (4)))) 3 9 (display #3# field erc-timestamp wrap-prefix #1# line-prefix #2#) 9 171 (wrap-prefix #1# line-prefix #2#) 172 173 (erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG display #6=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #4=(space :width (- 27 (8)))) 173 179 (display #6# field erc-timestamp wrap-prefix #1# line-prefix #4#) 179 180 (wrap-prefix #1# line-prefix #4#) 180 185 (wrap-prefix #1# line-prefix #4#) 185 187 (wrap-prefix #1# line-prefix #4#) 187 190 (wrap-prefix #1# line-prefix #4#) 190 303 (wrap-prefix #1# line-prefix #4#) 304 336 (wrap-prefix #1# line-prefix #4#) 337 338 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG display #8=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #7=(space :width (- 27 (6)))) 338 344 (display #8# field erc-timestamp wrap-prefix #1# line-prefix #7#) 344 345 (wrap-prefix #1# line-prefix #7#) 345 348 (wrap-prefix #1# line-prefix #7#) 348 350 (wrap-prefix #1# line-prefix #7#) 350 355 (wrap-prefix #1# line-prefix #7#) 355 430 (wrap-prefix #1# line-prefix #7#)) \ No newline at end of file +#("\n\n[00:00]*** 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.\n[00:00] 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[00:00] alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg notice erc--ts 0 erc--pfx erc--pfx-skip-notice-fwd display #3=(#5=(margin left-margin) #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix #2=(space :width (- 27 (4)))) 3 9 (display #3# field erc-timestamp wrap-prefix #1# line-prefix #2#) 9 171 (wrap-prefix #1# line-prefix #2#) 172 173 (erc--msg msg erc--ts 0 erc--spkr "alice" erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd display #6=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #4=(space :width (- 27 (8)))) 173 179 (display #6# field erc-timestamp wrap-prefix #1# line-prefix #4#) 179 180 (wrap-prefix #1# line-prefix #4#) 180 185 (wrap-prefix #1# line-prefix #4#) 185 187 (wrap-prefix #1# line-prefix #4#) 187 190 (wrap-prefix #1# line-prefix #4#) 190 303 (wrap-prefix #1# line-prefix #4#) 304 336 (wrap-prefix #1# line-prefix #4#) 337 338 (erc--msg msg erc--ts 0 erc--spkr "bob" erc--cmd PRIVMSG erc--pfx erc--pfx-skip-spkr-fwd display #8=(#5# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #7=(space :width (- 27 (6)))) 338 344 (display #8# field erc-timestamp wrap-prefix #1# line-prefix #7#) 344 345 (wrap-prefix #1# line-prefix #7#) 345 348 (wrap-prefix #1# line-prefix #7#) 348 350 (wrap-prefix #1# line-prefix #7#) 350 355 (wrap-prefix #1# line-prefix #7#) 355 430 (wrap-prefix #1# line-prefix #7#)) commit 500afb626cbc9d3ef589295bb72e2d3759530cc9 Author: F. Jason Park Date: Wed Feb 12 21:11:51 2025 -0800 Add module example to ERC's documentation * doc/misc/erc.texi: Add "Modules" section to the main detailed menu. (Modules): Promote "Local Modules" and "Module Loading" subheadings to sections and proper nodes. Rename "Local Modules" to "Module Scope" but retain anchor for compatibility. (Module Example): New section under the Modules chapter. diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 03767a2e68c..9b75ac6a83c 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -76,6 +76,13 @@ Getting Started * Sample Session:: Example of connecting to the @samp{#emacs} channel * Special Features:: Differences from standalone IRC clients +Advanced Module Topics + +* Scope: Module Scope. Differences between module types. +* Loading: Module Loading. How ERC loads modules. +* Example: Module Example. An example module. +* Usage: Module Usage. How to use specific modules. + Advanced Usage * Connecting:: Ways of connecting to an IRC server. @@ -615,9 +622,19 @@ so demands special precautions to avoid degrading the user experience. At present, the only such module is @code{networks}, whose library ERC always loads anyway. +@c Advanced module topics and individual module usage. +@menu +* Scope: Module Scope. Differences between module types. +* Loading: Module Loading. How ERC loads modules. +* Example: Module Example. An example module. +* Usage: Module Usage. How to use specific modules. +@end menu + @anchor{Local Modules} -@subheading Local Modules +@node Module Scope +@section Scope @cindex local modules +@cindex module scope @c Earlier language in code comments, commit messages, and tracker @c discussions used to describe a local module as being "active" in a @@ -698,10 +715,8 @@ buffers belonging to their connection (when called interactively). And unlike global toggles, none of these ever mutates @code{erc-modules}. -@c FIXME add section to Advanced chapter for creating modules, and -@c move this there. -@anchor{Module Loading} -@subheading Loading +@node Module Loading +@section Loading @cindex module loading ERC loads internal modules in alphabetical order and third-party @@ -755,6 +770,245 @@ Customize into displaying the widget for @code{erc-modules} incorrectly, with built-in modules moved from the predefined checklist to the user-provided free-form area. +@node Module Example +@section Example +@cindex module example + +This is a walkthrough of a working module, presented in sections. +If you'd prefer to view it as a whole, you can install it as a +third-party package through ERC's devel archive: +@uref{https://emacs-erc.gitlab.io/bugs/archive/erc-view.html}. + +@lisp +;;; erc-view.el -- Automatic view-mode for ERC -*- lexical-binding: t; -*- + +;; Maintainer: The ERC Maintainers +;; Keywords: convenience +;; Version: 0.1 +;; Package-Requires: ((emacs "30.1")) +;; URL: https://gitlab.com/emacs-erc/erc-view + +;;; Commentary: + +;; This is a demo local module for ERC. It automatically enables +;; `view-mode' when leaving the prompt area and disables it when +;; reentering. It also ensures `view-mode' stays enabled or disabled +;; when reconnecting. + +;;; Code: +@end lisp + +@noindent +You need to import ERC's main library somehow. The easiest way is +directly, via a simple @code{(require 'erc)}, although this module does +so indirectly because it also uses definitions from @file{erc-goodies}: + +@lisp +(require 'erc-goodies) +(require 'view) +@end lisp + +@noindent +Avoid headaches by aligning the name of your module with its containing +library and Custom group: one group and module per library. + +@lisp +(defgroup erc-view nil + "Automatically enter and exit `view-mode' in ERC." + :version "0.1" + :group 'erc) + +(defcustom erc-view-enable-when-exiting-prompt t + "Whether to enable `view-mode' when exiting the prompt area." + :type 'boolean) + +(defcustom erc-view-disable-when-entering-prompt t + "Whether to disable `view-mode' when entering the prompt area." + :type 'boolean) + +(defcustom erc-view-backspace-at-prompt-scrolls-down t + "Whether a \\`' at the prompt scrolls down to enter `view-mode'." + :type 'boolean) + +(defvar-local erc-view--enabled-p nil + "Current reconnect-aware activation state of `view-mode'.") +@end lisp + +@noindent +In some cases, you may need a variable's value to survive the +reinitialization of ERC's @code{major-mode} performed in each buffer +upon reconnecting. Do this by leveraging the @code{permanent-local} +symbol property. (@pxref{Creating Buffer-Local,,,elisp,}.) Also see +the mini-section after this example for a few caveats regarding the +durability of permanent values like this. + +@lisp +(put 'erc-view--enabled-p 'permanent-local t) +@end lisp + +Moving on, if your module needs to bind keys, define its keymap +@emph{before} the module itself, and use the standard minor-mode naming +convention of @code{erc-my-module-mode-map}. + +@lisp +(defvar-keymap erc-view-mode-map + :doc "Keymap for `view-mode' in ERC." + " " #'erc-view--enable-on-backspace) + +(defvar-keymap erc-view-mode-overriding-map + :parent view-mode-map + :doc "Overriding keymap for `view-mode' when `erc-view-mode' is active. +Hitting \\`' atop a button prompts for an action by default. Use +\\`C-j' or \\`j' for scrolling up by a line." + "C" nil ; View-kill-and-leave + "E" #'erc-view--exit-to-bottom ; View-exit-and-edit + "Q" nil ; View-quit-all + "k" #'View-scroll-line-backward ; Vi backwards line + "j" #'View-scroll-line-forward ; Vi forwards line + "S-" #'View-scroll-line-backward) +@end lisp + +You'll almost always want to define your module as buffer-local. Do +this by including a @code{localp} flag as the final parameter to +@code{define-erc-module}, after the @dfn{disable body}. If your module +only operates in one kind of buffer, disable it elsewhere in the +@dfn{enable body}. For example, if it should only run in server +buffers, disable it in target buffers by doing something like @code{(if +(erc-target) (erc-my-module-mode -1) (erc-my-module--setup))}. And in +all cases, do mention the module's intended @dfn{scope} in the doc +string. Some informal adjectives that may help with that are: + +@itemize +@item query-local +@item channel-local +@item target-local (query or channel) +@item server-local +@item session-local (server and target) +@item buffer-local (server or target) +@end itemize + +@noindent +You may also wish to mention this in the Custom group's doc string. + +@lisp +(define-erc-module view nil + "Use `view-mode' for reading and navigating \"scrollback\". +If enabling, restore `view-mode' activation state. + +Note that if paired with the `scrolltobottom' module, the option +`erc-scrolltobottom-all' should probably be enabled. This module is +buffer-local." + ((add-hook 'view-mode-hook #'erc-view--remember 0 t) + (add-hook 'post-command-hook #'erc-view--enforce-prompt-boundary 0 t) + (setf (alist-get 'view-mode minor-mode-overriding-map-alist) + erc-view-mode-overriding-map) + (unless (local-variable-p 'erc-view--enabled-p) + (setq-local erc-view--enabled-p nil)) + (view-mode (if erc-view--enabled-p +1 -1))) + ((kill-local-variable 'erc-view--enabled-p) + (remove-hook 'post-command-hook #'erc-view--enforce-prompt-boundary t) + (remove-hook 'view-mode-hook #'erc-view--remember t) + (setf (alist-get 'view-mode minor-mode-overriding-map-alist nil 'remove) + nil)) + localp) +@end lisp + +Always define your module early, before any code that refers to its mode +command or minor-mode variable. + +@lisp +(defun erc-view--enable-on-backspace (lines) + "Enable `view-mode' at the prompt by hitting \\`'." + (interactive "P") + (if (and erc-view-backspace-at-prompt-scrolls-down (not view-mode) + (= (point) erc-input-marker)) + (progn + (view-mode +1) + (View-scroll-page-backward lines)) + (call-interactively #'delete-backward-char))) + +(defun erc-view--enforce-prompt-boundary () + "Enable or disable `view-mode' when crossing prompt boundary." + (when-let* + ((new (if (>= (point) erc-input-marker) + (and view-mode erc-view-disable-when-entering-prompt -1) + (and (not view-mode) erc-view-enable-when-exiting-prompt +1)))) + (run-at-time 0 nil (lambda (buffer new) + (with-current-buffer buffer (view-mode new))) + (current-buffer) new))) + +(defun erc-view--exit-to-bottom () + "Scroll to prompt, exit `view-mode', and move to EOB." + (interactive) + (let (view-no-disable-on-exit) + (View-scroll-to-buffer-end) + (View-exit) + (goto-char (point-max)))) + +(defun erc-view--remember () + "Remember the value of `view-mode'. +Disable `erc-move-to-prompt-setup' locally when `view-mode' is enabled." + (setq erc-view--enabled-p view-mode) + (when erc-move-to-prompt-mode + (if view-mode + (remove-hook 'pre-command-hook #'erc-move-to-prompt t) + (erc-move-to-prompt-setup)))) +@end lisp + +Don't forget to @code{provide} your module so that +@code{erc-update-modules} can find it. + +@lisp +(provide 'erc-view) + +;;; erc-view.el ends here + +@end lisp +Mimicking the above should just about cover most use cases. If your +module isn't loading correctly, it's likely a naming, layout, or +packaging issue. If you @emph{must} defy the convention recommended +earlier regarding a library-group-module correspondence or if you've +designed your module mainly to be toggled interactively rather than +added to @code{erc-modules}, try placing a line like the following above +the module's definition. + +@lisp +;;;###autoload(autoload 'erc-my-module-mode "erc-my-module" nil t) +@end lisp + +@noindent +Just remember, doing so means you'll need to (re)generate the autoload +file when hacking locally (@pxref{Fetching Package Sources,,, emacs,}). + +@subsection Nuances Regarding Local Module State +By convention, disabling a module's minor mode kills local bindings. +Mode commands, like @code{erc-view-mode}, do so in the current buffer +only, while unidirectional ones, like @code{erc-view-mode-disable}, do +so connection-wide if given a prefix argument. + +There are also occasions in which the persistence of a buffer-local +variable is undefined, most notably during a @dfn{transplant}, when +copying an old buffer's contents into its replacement buffer. This +crude merge operation can occur, for example, in server buffers upon +@dfn{logical connection} (at @samp{MOTD}'s end) if a user reconnects +with a new invocation of an entry-point command, like @code{erc-tls}, +instead of via the auto-reconnect facility or by issuing a +@samp{/reconnect} at the prompt. (Unaffected are entry-point +invocations that include an @code{:id} keyword because reassociation +happens immediately in such cases, before ERC even initializes any +modules.) + +Transplants can also happen in target buffers, most often after a user +reconnects under a new nick and conducts business in the same channel +and query buffers, only to renick @emph{back} to the previous nick via a +@samp{/nick oldme} or similar. As of version 5.7, ERC retains the +current buffer's permanent value in all such situations, meaning ERC +ignores permanent values from previous buffers and retains default ones +assigned during module initialization. Package authors needing access +to these internal transplant junctures should make a case on the mailing +list or the bug tracker. + + @c PRE5_4: Document every option of every module in its own subnode commit c86cec9202d3e6fb57951a944441b6fe28afe35d Author: F. Jason Park Date: Sat May 16 18:42:14 2026 -0700 Rename erc--with-dependent-type-match for clarity * lisp/erc/erc-common.el (erc--with-dependent-type-match) (erc--custom-with-type-match-features): Rename former to latter to avoid confusion between actual Lisp types and Custom types. * lisp/erc/erc-track.el (erc-track-faces-priority-list) (erc-track-faces-normal-list): Use new name. ;; The problem this macro rather bluntly attempts to work around is ;; one of option values referencing symbols from libraries that ;; haven't been loaded. A general solution might be possible were ;; it not for ERC's inconsistent face and option names. Some don't ;; even reflect module aliases let alone their group or library, ;; e.g., `erc-pal-face'. If they were someday properly namespaced, ;; this macro could be replaced with a custom :match function that ;; adds temporary advice :after-until ;; ;; (compat-call plist-get (cdr (get 'face 'widget-type)) :match) ;; ;; It could then find the longest group name loaded by `cus-load' ;; that's a prefix of the face in question and then load the group's ;; `custom-loads' libraries (see `customize-read-group') with ;; `custom-load-symbol', all before trying `facep' again. diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 1a0b9c323d1..aa176a14b46 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -572,7 +572,12 @@ Use the CASEMAPPING ISUPPORT parameter to determine the style." (when erc-channel-members-changed-hook (run-hooks 'erc-channel-members-changed-hook)))))))) -(defmacro erc--with-dependent-type-match (type &rest features) +;; The default values of some ERC's options contain items defined in +;; other libraries that may not be loaded when `setopt' is invoked on +;; the option, which results in an unfriendly warning. User configs can +;; simply `require' such dependencies beforehand, but that's often +;; undesirable in ERC's own library code. +(defmacro erc--custom-with-type-match-features (type &rest features) "Massage Custom :type TYPE with :match function that pre-loads FEATURES." `(backquote-list* ',(car type) :match (lambda (w v) diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index 6306df3fa2a..91466b9d5e3 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -215,7 +215,7 @@ Note that ERC prioritizes certain faces reserved for critical messages regardless of this option's value." :package-version '(ERC . "5.6.1") :set #'erc-track--massage-nick-button-faces - :type (erc--with-dependent-type-match + :type (erc--custom-with-type-match-features (repeat (choice face (repeat :tag "Combination" face))) erc-button)) @@ -259,7 +259,7 @@ module. To see your changes reflected mid-session, cycle The effect may be disabled by setting this variable to nil." :package-version '(ERC . "5.6.1") :set #'erc-track--massage-nick-button-faces - :type (erc--with-dependent-type-match + :type (erc--custom-with-type-match-features (repeat (choice face (repeat :tag "Combination" face))) erc-button)) commit 3b52f8f98168c5c26d6db78263a5055689545d58 Author: F. Jason Park Date: Sat May 23 14:23:18 2026 -0700 ; Add erc-stamp test for right-margin face * test/lisp/erc/erc-scenarios-fill-wrap.el (erc-scenarios-fill-wrap/right-margin-stamp-face--assert-superior): New function. (erc-scenarios-fill-wrap/right-margin-stamp-face): New test that fails if the right-margin's timestamp doesn't display its face property correctly. * test/lisp/erc/resources/erc-scenarios-common.el (erc-scenarios-common--run-in-term): Add control channel to run code from the subprocess in the controlling process. (erc-scenarios-common-term-with-line-mode): New macro. (erc-scenarios-common--inferior-term-c2-proc): New variable. (erc-scenarios-common-term-call-in-superior): New function. (Bug#80693) diff --git a/test/lisp/erc/erc-scenarios-fill-wrap.el b/test/lisp/erc/erc-scenarios-fill-wrap.el index 89f6eaf7988..d0e5ba035a9 100644 --- a/test/lisp/erc/erc-scenarios-fill-wrap.el +++ b/test/lisp/erc/erc-scenarios-fill-wrap.el @@ -91,4 +91,72 @@ (erc-scrolltobottom-mode -1))) +(defun erc-scenarios-fill-wrap/right-margin-stamp-face--assert-superior () + (erc-d-t-wait-for 10 (erc-scenarios-common-term-with-line-mode + (search-forward "[23:20]" nil t))) + (should (member + (get-text-property (match-beginning 0) 'font-lock-face) + (list '((:foreground "#00FF00") term-bold) ; 31 graphical + '((:foreground "green3") term-bold) ; 31 non-graphical + '(( :foreground "green3" ; 29,30 non-graphical + :background "unspecified-bg" + :inverse-video nil) + term-bold) + '(( :foreground "green3" ; 28 non-graphical + :background "unspecified-bg" + :inverse-video nil) + :inherit term-bold))))) + +;; Before Emacs 31, a display property's margin string would inherit +;; face properties residing at the same buffer position. Beginning in +;; 31, only those on the spec's string itself were to be considered. To +;; adapt, ERC added an explicit face to its margin stamps. This test +;; checks the final "realized" appearance without regard for the +;; properties themselves. It does so through very roundabout means, +;; using a term.el subprocess. Obviously, reverting 9ba65aa9 "Fix +;; missing margin face on display prop in erc-stamp" or commenting out +;; its addition to `erc-insert-timestamp-right' makes this test fail +;; unless the inciting changes added by bug#80693 were to also be +;; reverted to restore pre-31 behavior. +(ert-deftest erc-scenarios-fill-wrap/right-margin-stamp-face () + :tags '(:expensive-test :unstable) + + (when (and noninteractive (= emacs-major-version 27)) + (ert-skip "May stall on Emacs 27")) + + ;; Force fixture to use inferior process so that face-merging behavior + ;; can be verified in the controlling Emacs instance. + (let ((erc-scenarios-common-interactive-debug-term-p (not noninteractive))) + (erc-scenarios-common-with-noninteractive-in-term + ((erc-scenarios-common-dialog "join/legacy") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'foonet)) + (erc-stamp--tz t) + ;; Start at 2023-10-22T06:16:43.445Z + (erc-stamp--current-time (if (< emacs-major-version 29) + '(25908 23515 445000 0) + '(1697930203445 . 1000))) + (erc-timer-hook (cons (lambda (&rest _) + (setq erc-stamp--current-time + (time-add erc-stamp--current-time 15))) + erc-timer-hook)) + (expect (erc-d-t-make-expecter)) + (erc-autojoin-channels-alist '((FooNet "#chan"))) + (erc-modules `(fill-wrap ,@erc-modules)) + (port (process-contact dumb-server :service))) + + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :password "changeme" + :full-name "tester") + (funcall expect 10 "This server is in debug mode")) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 10 "[23:20]") + + (erc-scenarios-common-term-call-in-superior + #'erc-scenarios-fill-wrap/right-margin-stamp-face--assert-superior) + (funcall expect 10 " tester, welcome"))))) + ;;; erc-scenarios-fill-wrap.el ends here diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index aa18bbf7b21..4177379d935 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -284,6 +284,30 @@ completion." ;; a <31 definition of `ert-with-buffer-selected'. (tcompat (and (featurep 'erc-tests-compat) (locate-library "erc-tests-compat"))) + (control-process nil) + ;; Create a control channel to communicate between the term + ;; subprocess and the controlling Emacs. Must run before + ;; creating the subprocess so it sees the env var. + (control-server-process nil) + (_ (progn + (setq control-server-process + (make-network-process + :server 1 + :sentinel (lambda (p s) + (when (string-prefix-p "open" s) + (setq control-process p) + (set-process-buffer + p (get-buffer-create + "*erc-test-term-c2/superior*")) + (delete-process control-server-process))) + :noquery t ; client inherits + :host "localhost" + :service t + :coding 'utf-8-emacs + :name "*erc-test-term-c2/superior*")) + (push (format "ERC_TEST_TERM_C2_PORT=%d" + (process-contact control-server-process :service)) + process-environment))) ;; Make subprocess terminal bigger than controlling. (buf (cl-letf (((symbol-function 'window-screen-lines) (lambda () (car erc-scenarios-common--term-size))) @@ -311,7 +335,23 @@ completion." (set-process-query-on-exit-flag proc nil) (unless noninteractive (term-char-mode)) (erc-d-t-wait-for 30 (process-live-p proc)) - (while (accept-process-output proc)) + (with-timeout (30 nil) + (while (accept-process-output proc) + ;; If the subprocess emitted something readable, assume it's a + ;; named function and call it, letting errors propagate. + (when control-process + (unless (zerop (buffer-size (process-buffer control-process))) + (with-current-buffer (process-buffer control-process) + (goto-char (point-min)) + (let* ((test (read (current-buffer))) + (result (and (symbolp test) + (string-prefix-p "erc-" (symbol-name test)) + (with-current-buffer buf + (funcall test))))) + (cl-assert (eq (get-buffer-process buf) proc)) + (run-at-time 0 nil #'process-send-string + control-process (format "%S\n" result))) + (erase-buffer)))))) (term-line-mode) (goto-char (point-min)) ;; Otherwise gives process exited abnormally with exit-code >0 @@ -321,9 +361,46 @@ completion." (buffer-substring-no-properties (line-beginning-position) (line-end-position))))) (delete-file temp-file) + ;; Kill client if connected, else server that's still listening. + (delete-process (or control-process control-server-process)) (when noninteractive (kill-buffer))))) +(defmacro erc-scenarios-common-term-with-line-mode (&rest body) + "Run BODY to validate contents of term window's contents." + `(save-restriction + (cl-assert (eq major-mode 'term-mode)) + (when (fboundp 'term-handle-deferred-scroll) + (term-handle-deferred-scroll)) + (defvar term-home-marker) + (narrow-to-region term-home-marker (point-max)) + (goto-char (point-min)) + ,@body)) + +(defvar erc-scenarios-common--inferior-term-c2-proc nil) + +(defun erc-scenarios-common-term-call-in-superior (sym) + "Run function SYM in superior process instead of term subprocess." + (run-at-time + 0 nil #'process-send-string + (or (and erc-scenarios-common--inferior-term-c2-proc + (process-live-p erc-scenarios-common--inferior-term-c2-proc)) + (setq erc-scenarios-common--inferior-term-c2-proc + (let ((b (get-buffer-create "*erc-test-term-c2/inferior*"))) + (make-network-process + :buffer b + :noquery t + :host "localhost" + :service (string-to-number (getenv "ERC_TEST_TERM_C2_PORT")) + :coding 'utf-8-emacs + :name (buffer-name b))))) + (concat (symbol-name sym) "\n")) + (ert-with-buffer-selected (current-buffer) + (with-current-buffer "*erc-test-term-c2/inferior*" + (ert-info ("Superior process assertion confirmed") + (erc-d-t-wait-for 10 (> (point-max) 1)) + (erase-buffer))))) + (defvar erc-scenarios-common-interactive-debug-term-p nil "Non-nil means run test in an inferior Emacs, even if interactive.") commit b2177acb8c8293386615f1181180c32f9d574f08 Author: Juri Linkov Date: Tue Jun 30 18:52:41 2026 +0300 Fix prog-fill-reindent-defun to better handle an active region * lisp/progmodes/prog-mode.el (prog--text-at-point-or-region-p): New function (bug#63790, bug#81281). (prog-fill-reindent-defun-default): Use it instead of 'prog--text-at-point-p'. * lisp/treesit.el (treesit-fill-reindent-defun): Use it instead of 'prog--text-at-point-p'. diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el index afa18d9958b..a1cc32d3601 100644 --- a/lisp/progmodes/prog-mode.el +++ b/lisp/progmodes/prog-mode.el @@ -166,6 +166,14 @@ instead." (and (re-search-forward "\\s-*\\s<" (line-end-position) t) (nth 8 (syntax-ppss)))))) +(defun prog--text-at-point-or-region-p () + "Return non-nil if point or region's other end are in text." + (or (prog--text-at-point-p) + (and (use-region-p) + (save-excursion + (goto-char (mark)) + (prog--text-at-point-p))))) + (defvar prog-fill-reindent-defun-function #'prog-fill-reindent-defun-default "Function called by `prog-fill-reindent-defun' to do the actual work. @@ -176,7 +184,7 @@ It should take the same argument as `prog-fill-reindent-defun'.") JUSTIFY is the same as in `fill-paragraph'." (interactive "P") (save-excursion - (if (prog--text-at-point-p) + (if (prog--text-at-point-or-region-p) (fill-paragraph justify (region-active-p)) (beginning-of-defun) (let ((start (point))) diff --git a/lisp/treesit.el b/lisp/treesit.el index dbb39b19226..b5c7f2852d8 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -58,7 +58,7 @@ (require 'cl-lib) (require 'font-lock) (require 'seq) -(require 'prog-mode) ; For `prog--text-at-point-p'. +(require 'prog-mode) ; For `prog--text-at-point-or-region-p'. ;;; Function declarations @@ -4165,7 +4165,7 @@ This is a tree-sitter implementation of `prog-fill-reindent-defun'. JUSTIFY is the same as in `fill-paragraph'." (interactive "P") (save-excursion - (if (prog--text-at-point-p) + (if (prog--text-at-point-or-region-p) (fill-paragraph justify (region-active-p)) (let* ((treesit-defun-tactic 'parent-first) (node (treesit-defun-at-point))) commit d56e98592ef949f31687ff8adf16a12411efb1e5 Author: Juri Linkov Date: Tue Jun 30 18:47:15 2026 +0300 Clicking mode line menus in inactive windows now switches the window * lisp/bindings.el (mode-line-window-select): New function (bug#81178). (x-pre-popup-menu-hook): Add it to 'x-pre-popup-menu-hook'. diff --git a/etc/NEWS b/etc/NEWS index 1537464d653..5db066a7466 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -80,6 +80,15 @@ left margin is present, Emacs will now display the overlay arrow into this margin. Edebug is now using this feature by explicitly setting up a left margin for it. +** Mode Line + +*** Popup menus invoked from mode line select another window. +Clicking mode line elements in inactive windows now first +selects another window before displaying the menu, so the +commands invoked from the menu will operate on the right buffer. +You can restore the previous behavior by removing +'mode-line-window-select' from 'x-pre-popup-menu-hook'. + * Editing Changes in Emacs 32.1 diff --git a/lisp/bindings.el b/lisp/bindings.el index b13dc0a705c..198ad12c5c6 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -889,6 +889,18 @@ or not." (with-selected-window (minibuffer-window) (eq window (minibuffer-selected-window))))))) +(defun mode-line-window-select (&optional _ignored-arg) + "Select the window on whose mode-line the mouse was clicked." + (when-let* ((_ (mouse-event-p last-input-event)) + (event (event-start last-input-event)) + (_ (eq (posn-area event) 'mode-line)) + (window (posn-window event)) + (_ (not (eq (selected-window) window)))) + (mouse-select-window last-input-event))) + +(add-hook 'x-pre-popup-menu-hook #'mode-line-window-select) + + (defmacro bound-and-true-p (var) "Return the value of symbol VAR if it is bound, else nil. Note that if `lexical-binding' is in effect, this function isn't