* bug#72736: 31.0.50; ERC 5.6.1: Keep ban lists in sync
@ 2024-08-20 20:10 J.P.
2024-08-24 18:03 ` J.P.
[not found] ` <87msl123y6.fsf@neverwas.me>
0 siblings, 2 replies; 3+ messages in thread
From: J.P. @ 2024-08-20 20:10 UTC (permalink / raw)
To: 72736; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 5812 bytes --]
Tags: patch
The function `erc-banlist-update' conditionally modifies the local
variable `erc-channel-banlist'." As originally envisioned, this list
remains synced with the server's because `erc-banlist-update' runs
whenever the client receives a MODE command. But due to a bug in the
logic surrounding an internal flag (meant to regulate meaningful action
by the function), synchronization is inconsistent and difficult to
predict, which makes `erc-channel-banlist' ultimately unreliable.
Much of this can be solved by simply wiring in ban-list syncing to the
MODE-handling "framework" introduced by bug#67220. So instead of the
current situation, in which `erc-banlist-update' only understands "+b"
or "-b" but not "+mb", etc., we'll have a reliable solution for handling
all such permutations. This *should* have been addressed by bug#67220
along with everything else in that arena, but unscrambling all the
aforementioned state-flag business seemed a chore too many at the time,
ISTR.
The last two of the attached patches aim to improve the situation by
updating `erc-channel-banlist' on a rolling basis, unconditionally. On
the UX side, they provide third-party modules with a new function,
`erc-sync-banlist', that effectively guarantees `erc-channel-banlist'
will remain in sync for the remainder of the session, once invoked.
I've also run into some related issues on the interactive side with the
slash commands /BANLIST and /MASSUNBAN. Currently, issuing a /MASSUNBAN
corrupts synchronization, potentially across all sessions. For example,
issuing a subsequent /BANLIST won't send a "MODE #chan b" to refresh
`erc-channel-banlist' as it usually does. Instead, it will proceed in
listing the variable's stale contents, which could potentially confuse a
channel operator and lead to unfortunate social situations.
The first few patches in the set are mostly unrelated fixes. The second
tackles a memory leak introduced by Bug#67677, which added the "msg
props" internal framework for organizing per-message text props. The
third patch is of a supporting nature and internally binds the current
`erc-response' object for hooks and handlers, to allow easier access
toward the business end of the call stack. I was hoping to avoid such a
change until 5.7, but circumstances dictate otherwise.
Thanks.
In GNU Emacs 31.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version
3.24.43, cairo version 1.18.0) of 2024-08-19 built on localhost
Repository revision: a876c4d7a17df152e3e78800c76ddf158f632ee5
Repository branch: master
Windowing system distributor 'The X.Org Foundation', version 11.0.12401002
System Description: Fedora Linux 40 (Workstation Edition)
Configured using:
'configure --enable-check-lisp-object-type --enable-checking=yes,glyphs
'CFLAGS=-O0 -g3'
PKG_CONFIG_PATH=:/usr/lib64/pkgconfig:/usr/share/pkgconfig'
Configured features:
ACL CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GPM GSETTINGS HARFBUZZ JPEG
LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 M17N_FLT MODULES NATIVE_COMP
NOTIFY INOTIFY PDUMPER PNG RSVG SECCOMP SOUND SQLITE3 THREADS TIFF
TOOLKIT_SCROLL_BARS WEBP X11 XDBE XIM XINPUT2 XPM GTK3 ZLIB
Important settings:
value of $LANG: en_US.UTF-8
value of $XMODIFIERS: @im=ibus
locale-coding-system: utf-8-unix
Major mode: Lisp Interaction
Minor modes in effect:
tooltip-mode: t
global-eldoc-mode: t
eldoc-mode: t
show-paren-mode: t
electric-indent-mode: t
mouse-wheel-mode: t
tool-bar-mode: t
menu-bar-mode: t
file-name-shadow-mode: t
global-font-lock-mode: t
font-lock-mode: t
blink-cursor-mode: t
minibuffer-regexp-mode: t
line-number-mode: t
indent-tabs-mode: t
transient-mark-mode: t
auto-composition-mode: t
auto-encryption-mode: t
auto-compression-mode: t
Load-path shadows:
None found.
Features:
(shadow sort compile comint ansi-osc ansi-color ring comp-run
comp-common mail-extr emacsbug message mailcap yank-media puny dired
dired-loaddefs rfc822 mml mml-sec epa epg rfc6068 epg-config gnus-util
text-property-search time-date mm-decode mm-bodies mm-encode mail-parse
rfc2231 mailabbrev gmm-utils mailheader sendmail rfc2047 rfc2045
ietf-drums mm-util mail-prsvr mail-utils erc derived auth-source eieio
eieio-core icons password-cache json map format-spec erc-backend
erc-networks easy-mmode byte-opt bytecomp byte-compile erc-common inline
cl-extra help-mode erc-compat cl-seq cl-macs gv pcase rx compat subr-x
cl-loaddefs cl-lib erc-loaddefs rmc iso-transl tooltip cconv eldoc paren
electric uniquify ediff-hook vc-hooks lisp-float-type elisp-mode mwheel
term/x-win x-win term/common-win x-dnd touch-screen tool-bar dnd fontset
image regexp-opt fringe tabulated-list replace newcomment text-mode
lisp-mode prog-mode register page tab-bar menu-bar rfn-eshadow isearch
easymenu timer select scroll-bar mouse jit-lock font-lock syntax
font-core term/tty-colors frame minibuffer nadvice seq simple cl-generic
indonesian philippine cham georgian utf-8-lang misc-lang vietnamese
tibetan thai tai-viet lao korean japanese eucjp-ms cp51932 hebrew greek
romanian slovak czech european ethiopic indian cyrillic chinese
composite emoji-zwj charscript charprop case-table epa-hook
jka-cmpr-hook help abbrev obarray oclosure cl-preloaded button loaddefs
theme-loaddefs faces cus-face macroexp files window text-properties
overlay sha1 md5 base64 format env code-pages mule custom widget keymap
hashtable-print-readable backquote threads dbusbind inotify lcms2
dynamic-setting system-font-setting font-render-setting cairo gtk
x-toolkit xinput2 x multi-tty move-toolbar make-network-process
native-compile emacs)
Memory information:
((conses 16 159110 10474) (symbols 48 11702 0) (strings 32 28787 4600)
(string-bytes 1 1011760) (vectors 16 17066)
(vector-slots 8 185078 5037) (floats 8 30 1) (intervals 56 357 0)
(buffers 984 12))
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-5.6.1-Rename-internal-variable-in-erc-fill.patch --]
[-- Type: text/x-patch, Size: 3053 bytes --]
From e499857ccb895832070f5af35e42bece4c9c474e Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 19 Aug 2024 22:40:25 -0700
Subject: [PATCH 1/5] [5.6.1] ; Rename internal variable in erc-fill
* lisp/erc/erc-fill.el (erc--fill-wrap-scrolltobottom-exempt-p):
Rename to `erc-fill--wrap-scrolltobottom-exempt-p' so prefix matches
library and feature.
(erc-fill--wrap-ensure-dependencies): Update variable name.
* test/lisp/erc/erc-fill-tests.el (erc-fill-tests--wrap-populate):
Update variable name.
* test/lisp/erc/resources/erc-scenarios-common.el
(erc-scenarios-common--make-bindings): Use updated variable name.
---
lisp/erc/erc-fill.el | 4 ++--
test/lisp/erc/erc-fill-tests.el | 2 +-
test/lisp/erc/resources/erc-scenarios-common.el | 2 +-
3 files changed, 4 insertions(+), 4 deletions(-)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index c863d99a339..986314822ba 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -421,7 +421,7 @@ erc-button-mode
(defvar erc-scrolltobottom-mode)
(defvar erc-legacy-invisible-bounds-p)
-(defvar erc--fill-wrap-scrolltobottom-exempt-p nil)
+(defvar erc-fill--wrap-scrolltobottom-exempt-p nil)
(defun erc-fill--wrap-ensure-dependencies ()
(with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
@@ -435,7 +435,7 @@ erc-fill--wrap-ensure-dependencies
(unless erc-fill-mode
(push 'fill missing-deps)
(erc-fill-mode +1))
- (unless (or erc-scrolltobottom-mode erc--fill-wrap-scrolltobottom-exempt-p
+ (unless (or erc-scrolltobottom-mode erc-fill--wrap-scrolltobottom-exempt-p
(memq 'scrolltobottom erc-modules))
(push 'scrolltobottom missing-deps)
(erc-scrolltobottom-mode +1))
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index f8bfc362085..b52a996f184 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -52,7 +52,7 @@ erc-fill-tests--insert-privmsg
(defun erc-fill-tests--wrap-populate (test)
(let ((original-window-buffer (window-buffer (selected-window)))
- (erc--fill-wrap-scrolltobottom-exempt-p t)
+ (erc-fill--wrap-scrolltobottom-exempt-p t)
(erc-stamp--tz t)
(erc-fill-function 'erc-fill-wrap)
(pre-command-hook pre-command-hook)
diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el
index 0dc82c98d5f..130b0aae109 100644
--- a/test/lisp/erc/resources/erc-scenarios-common.el
+++ b/test/lisp/erc/resources/erc-scenarios-common.el
@@ -150,7 +150,7 @@ erc-scenarios-common--print-trace
(timer-list (copy-sequence timer-list))
(timer-idle-list (copy-sequence timer-idle-list))
(erc-auth-source-parameters-join-function nil)
- (erc--fill-wrap-scrolltobottom-exempt-p t)
+ (erc-fill--wrap-scrolltobottom-exempt-p t)
(erc-autojoin-channels-alist nil)
(erc-server-auto-reconnect nil)
(erc-after-connect nil)
--
2.46.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-5.6.1-Store-one-string-per-user-in-erc-spkr-msg-prop.patch --]
[-- Type: text/x-patch, Size: 10994 bytes --]
From 6283c01e6da88ba2c031f118684922aa2f64c16e Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Tue, 6 Aug 2024 19:13:51 -0700
Subject: [PATCH 2/5] [5.6.1] Store one string per user in erc--spkr msg prop
* lisp/erc/erc.el (erc--msg-props): Mention that the `erc--spkr'
msg-prop value is taken from the `nickname' slot of the user's
`erc-server-users' entry.
(erc--speakerize-nick): Avoid using the provided NICK parameter for
the `erc--spkr' property. Instead, use the version from the
`nickname' slot of its `erc-server-users' item, which is itself an
`erc-server-user' object. These text props were originally introduced
in ERC 5.6 as part of Bug#67677.
* test/lisp/erc/erc-tests.el (erc--refresh-prompt)
(erc--check-prompt-input-functions, erc-send-current-line)
(erc--check-prompt-input-for-multiline-blanks)
(erc-send-whitespace-lines): Use more convenient helper utility to
create fake server buffer where possible.
(erc--speakerize-nick): New test.
* test/lisp/erc/resources/erc-tests-common.el
(erc-tests-common-make-server-buf): Don't use ERT temp buffer's name
for dialed server, etc., because it contains unwanted chars.
(erc-tests-common-with-process-input-spy): Defer to each test to set
up its own prompt, etc.
---
lisp/erc/erc.el | 29 ++++-----
test/lisp/erc/erc-tests.el | 71 ++++++++++++++++++---
test/lisp/erc/resources/erc-tests-common.el | 9 +--
3 files changed, 81 insertions(+), 28 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 5e8fa3051c7..8b3eef94ee4 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -173,7 +173,8 @@ erc--msg-props
and help text, and on outgoing messages unless echoed back by
the server (assuming future support)
- - `erc--spkr': a string, the nick of the person speaking
+ - `erc--spkr': a string, the non-case-mapped nick of the speaker as
+ stored in the `nickname' slot of its `erc-server-users' item
- `erc--ctcp': a CTCP command, like `ACTION'
@@ -6339,20 +6340,18 @@ erc--message-speaker-ctcp-action-statusmsg-input
"Template for a CTCP ACTION status message from current client.")
(defun erc--speakerize-nick (nick &optional disp)
- "Propertize NICK with `erc--speaker' if not already present.
-Do so to DISP instead if it's non-nil. In either case, assign
-NICK, sans properties, as the `erc--speaker' value. As a side
-effect, pair the latter string (the same `eq'-able object) with
-the symbol `erc--spkr' in the \"msg prop\" environment for any
-imminent `erc-display-message' invocations. While doing so,
-include any overrides defined in `erc--message-speaker-catalog'."
- (let ((plain-nick (substring-no-properties nick)))
- (erc--ensure-spkr-prop plain-nick (get erc--message-speaker-catalog
- 'erc--msg-prop-overrides))
- (if (text-property-not-all 0 (length (or disp nick))
- 'erc--speaker nil (or disp nick))
- (or disp nick)
- (propertize (or disp nick) 'erc--speaker plain-nick))))
+ "Return propertized NICK with canonical NICK in `erc--speaker'.
+Return propertized DISP instead if given. As a side effect, pair NICK
+with `erc--spkr' in the \"msg prop\" environment for any imminent
+`erc-display-message' invocations, and include any overrides defined in
+`erc--message-speaker-catalog'. Expect NICK (but not necessarily DISP)
+to be absent of any existing text properties."
+ (when-let ((erc-server-process)
+ (cusr (erc-get-server-user nick)))
+ (setq nick (erc-server-user-nickname cusr)))
+ (erc--ensure-spkr-prop nick (get erc--message-speaker-catalog
+ 'erc--msg-prop-overrides))
+ (propertize (or disp nick) 'erc--speaker nick))
(defun erc--determine-speaker-message-format-args
(nick message queryp privmsgp inputp &optional statusmsg prefix disp-nick)
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index f65c1496087..b11f994bce8 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -330,16 +330,12 @@ erc--refresh-prompt
(ert-info ("Server buffer")
(with-current-buffer (get-buffer-create "ServNet")
- (erc-tests-common-prep-for-insertion)
+ (erc-tests-common-make-server-buf "ServNet")
(goto-char erc-insert-marker)
(should (looking-at-p "ServNet 3>"))
(erc-tests-common-init-server-proc "sleep" "1")
(set-process-sentinel erc-server-process #'ignore)
- (setq erc-network 'ServNet
- erc-server-current-nick "tester"
- erc-networks--id (erc-networks--id-create nil)
- erc-server-users (make-hash-table :test 'equal))
- (set-process-query-on-exit-flag erc-server-process nil)
+ (setq erc-server-current-nick "tester")
;; Incoming message redraws prompt
(erc-display-message nil 'notice nil "Welcome")
(should (looking-at-p (rx "*** Welcome")))
@@ -364,6 +360,8 @@ erc--refresh-prompt
(should-not (search-forward (rx (any "3-5") ">") nil t)))))
(ert-info ("Channel buffer")
+ ;; Create buffer manually instead of using `erc--open-target' in
+ ;; order to show prompt before/after network is known.
(with-current-buffer (get-buffer-create "#chan")
(erc-tests-common-prep-for-insertion)
(goto-char erc-insert-marker)
@@ -1521,6 +1519,7 @@ erc--input-line-delim-regexp
(ert-deftest erc--check-prompt-input-functions ()
(erc-tests-common-with-process-input-spy
(lambda (next)
+ (erc-tests-common-prep-for-insertion)
(ert-info ("Errors when point not in prompt area") ; actually just dings
(insert "/msg #chan hi")
@@ -1556,7 +1555,7 @@ erc--check-prompt-input-functions
(ert-deftest erc-send-current-line ()
(erc-tests-common-with-process-input-spy
(lambda (next)
- (erc-tests-common-init-server-proc "sleep" "1")
+ (erc-tests-common-make-server-buf (buffer-name))
(should (= 0 erc-last-input-time))
(ert-info ("Simple command")
@@ -1639,7 +1638,8 @@ erc--check-prompt-input-for-multiline-blanks
(ert-with-message-capture messages
(erc-tests-common-with-process-input-spy
(lambda (next)
- (erc-tests-common-init-server-proc "sleep" "300")
+ (erc-tests-common-make-server-buf (buffer-name))
+
(should-not erc-send-whitespace-lines)
(should erc-warn-about-blank-lines)
@@ -1717,7 +1717,8 @@ erc--check-prompt-input-for-multiline-blanks/explanations
(ert-deftest erc-send-whitespace-lines ()
(erc-tests-common-with-process-input-spy
(lambda (next)
- (erc-tests-common-init-server-proc "sleep" "1")
+ (erc-tests-common-make-server-buf (buffer-name))
+
(setq-local erc-send-whitespace-lines t)
(ert-info ("Multiline hunk with blank line correctly split")
@@ -2653,6 +2654,58 @@ erc-tests--format-privmessage
(erc--determine-speaker-message-format-args nick msg privp msgp
inputp nil pfx))))
+;; This test demonstrates that ERC uses the same string for the
+;; `erc--spkr' and `erc--speaker' text properties, which it gets from
+;; the `nickname' shot of the speaker's server user.
+(ert-deftest erc--speakerize-nick ()
+ (erc-tests-common-make-server-buf)
+ (setq erc-server-current-nick "tester")
+
+ (let ((sentinel "alice"))
+ (with-current-buffer (erc--open-target "#chan")
+ (erc-update-current-channel-member "bob" "bob" t nil nil nil nil nil
+ "example.org" "~u" "bob")
+ (erc-update-current-channel-member "alice" sentinel t nil nil nil nil nil
+ "fsf.org" "~u" "alice"))
+
+ (erc-call-hooks nil (make-erc-response
+ :sender "alice!~u@fsf.org"
+ :command "PRIVMSG"
+ :command-args '("#chan" "one")
+ :contents "one"
+ :unparsed ":alice!~u@fsf.org PRIVMSG #chan :one"))
+ (erc-call-hooks nil (make-erc-response
+ :sender "bob!~u@example.org"
+ :command "PRIVMSG"
+ :command-args '("#chan" "hi")
+ :contents "hi"
+ :unparsed ":bob!~u@example.org PRIVMSG #chan :hi"))
+ (erc-call-hooks nil (make-erc-response
+ :sender "alice!~u@fsf.org"
+ :command "PRIVMSG"
+ :command-args '("#chan" "two")
+ :contents "two"
+ :unparsed ":alice!~u@fsf.org PRIVMSG #chan :two"))
+
+ (with-current-buffer (get-buffer "#chan")
+ (should (eq sentinel
+ (erc-server-user-nickname (erc-get-server-user "alice"))))
+ (goto-char (point-min))
+
+ (should (search-forward "<a" nil t))
+ (should (looking-at "lice> one"))
+ (should (eq (get-text-property (point) 'erc--speaker) sentinel))
+ (should (eq (erc--get-inserted-msg-prop 'erc--spkr) sentinel))
+
+ (should (search-forward "<bob> hi" nil t))
+
+ (should (search-forward "<a" nil t))
+ (should (looking-at "lice> two"))
+ (should (eq (get-text-property (point) 'erc--speaker) sentinel))
+ (should (eq (erc--get-inserted-msg-prop 'erc--spkr) sentinel))
+
+ (when noninteractive (kill-buffer)))))
+
;; This asserts that `erc--determine-speaker-message-format-args'
;; behaves identically to `erc-format-privmessage', the function whose
;; role it basically replaced.
diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el
index 2ec32db77cd..b5bb1fb09c3 100644
--- a/test/lisp/erc/resources/erc-tests-common.el
+++ b/test/lisp/erc/resources/erc-tests-common.el
@@ -103,16 +103,17 @@ erc-tests-common-with-process-input-spy
(lambda (&rest r) (push r calls)))
((symbol-function 'erc-server-buffer)
(lambda () (current-buffer))))
- (erc-tests-common-prep-for-insertion)
(funcall test-fn (lambda () (pop calls)))))
(when noninteractive (kill-buffer))))
(defun erc-tests-common-make-server-buf (&optional name)
"Return a server buffer named NAME, creating it if necessary.
Use NAME for the network and the session server as well."
- (unless name
- (cl-assert (string-prefix-p " *temp*" (setq name (buffer-name)))))
- (with-current-buffer (get-buffer-create name)
+ (with-current-buffer (if name
+ (get-buffer-create name)
+ (and (string-search "temp" (buffer-name))
+ (setq name "foonet")
+ (buffer-name)))
(erc-tests-common-prep-for-insertion)
(erc-tests-common-init-server-proc "sleep" "1")
(setq erc-session-server (concat "irc." name ".org")
--
2.46.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-5.6.1-Bind-current-erc-response-around-all-handlers.patch --]
[-- Type: text/x-patch, Size: 1718 bytes --]
From 0665e75229ae6b92c21fd3a12a0e46136026da32 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 18 Aug 2024 23:50:58 -0700
Subject: [PATCH 3/5] [5.6.1] Bind current erc-response around all handlers
* lisp/erc/erc-backend.el (erc--parsed-response): New variable to be
the internal version of the ancient `erc-message-parsed', which is
only available during `erc-display-message', and therefore of somewhat
limited utility.
(erc-call-hooks): Bind `erc--parsed-response' to the parsed
`erc-response' object for the duration of its handling. Bind
`erc--msg-prop-overrides' around all hooks to allow response handlers
to influence inserted msg props for any `erc-display-message' calls.
---
lisp/erc/erc-backend.el | 6 +++++-
1 file changed, 5 insertions(+), 1 deletion(-)
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 9aedc110067..d999cf57db8 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -1534,11 +1534,15 @@ erc-get-hook
(gethash (format (if (numberp command) "%03i" "%s") command)
erc-server-responses))
+(defvar erc--parsed-response nil)
+
(defun erc-call-hooks (process message)
"Call hooks associated with MESSAGE in PROCESS.
Finds hooks by looking in the `erc-server-responses' hash table."
- (let ((hook (or (erc-get-hook (erc-response.command message))
+ (let ((erc--parsed-response message)
+ (erc--msg-prop-overrides erc--msg-prop-overrides)
+ (hook (or (erc-get-hook (erc-response.command message))
'erc-default-server-functions)))
(run-hook-with-args-until-success hook process message)
;; Some handlers, like `erc-cmd-JOIN', open new targets without
--
2.46.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0004-5.6.1-Use-5.6-MODE-framework-to-update-erc-channel-b.patch --]
[-- Type: text/x-patch, Size: 6253 bytes --]
From 241e91980886e48579e74a7f739079547f7d73fd Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 18 Aug 2024 22:58:11 -0700
Subject: [PATCH 4/5] [5.6.1] Use 5.6 MODE framework to update
erc-channel-banlist
* lisp/erc/erc-backend.el (erc-server-MODE): Don't call
`erc-banlist-update'.
* lisp/erc/erc.el (erc-banlist-finished): Deprecate function unused
since 2003.
(erc--banlist-update): New function.
(erc-banlist-update): Deprecate function because its logic is faulty
and it doesn't handle mixed mode letters, like "MODE #foobar
+mb *@127.0.0.1". See https://modern.ircdocs.horse/#mode-message. It
also depends on an obsolete convention regarding the symbol property
`received-from-server' of `erc-channel-banlist'. Basically, this
function used to run upon receipt of any "MODE" command from the
server. However, actual updates to the variable `erc-channel-banlist'
only happened if `received-from-server' was t, which could only be the
case after the user issued a /MASSUNBAN. And that behavior was
determined to be a bug. This mode framework stuff was introduced as
part of bug#67220 for ERC 5.6.
(erc--handle-channel-mode): New method.
* test/lisp/erc/erc-tests.el (erc--channel-modes)
(erc--channel-modes/graphic-p): Assert contents of
`erc-channel-banlist' updated on "MODE".
---
lisp/erc/erc-backend.el | 4 ++--
lisp/erc/erc.el | 19 +++++++++++++++++++
test/lisp/erc/erc-tests.el | 17 +++++++++++++----
3 files changed, 34 insertions(+), 6 deletions(-)
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index d999cf57db8..16e8cae4733 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -1851,8 +1851,8 @@ erc--server-determine-join-display-context
?t tgt ?m mode)
(erc-display-message parsed 'notice buf
'MODE ?n nick ?u login
- ?h host ?t tgt ?m mode)))
- (erc-banlist-update proc parsed))))
+ ?h host ?t tgt ?m mode)))))
+ nil)
(defun erc--wrangle-query-buffers-on-nick-change (old new)
"Create or reuse a query buffer for NEW nick after considering OLD nick.
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 8b3eef94ee4..e1fd279f405 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -6639,17 +6639,31 @@ erc-banlist-store
erc-channel-banlist))))))
nil)
+;; This was a default member of `erc-server-368-functions' (nee -hook)
+;; between January and June of 2003 (but not as part of any release).
(defun erc-banlist-finished (proc parsed)
"Record that we have received the banlist."
+ (declare (obsolete "uses obsolete and likely faulty logic" "31.1"))
(let* ((channel (nth 1 (erc-response.command-args parsed)))
(buffer (erc-get-buffer channel proc)))
(with-current-buffer buffer
(put 'erc-channel-banlist 'received-from-server t)))
t) ; suppress the 'end of banlist' message
+(defun erc--banlist-update (statep mask)
+ "Add or remove a mask from `erc-channel-banlist'."
+ (if statep
+ (let ((whoset (erc-response.sender erc--parsed-response)))
+ (cl-pushnew (cons whoset mask) erc-channel-banlist :test #'equal))
+ (let ((upcased (upcase mask)))
+ (setq erc-channel-banlist
+ (cl-delete-if (lambda (y) (equal (upcase (cdr y)) upcased))
+ erc-channel-banlist)))))
+
(defun erc-banlist-update (proc parsed)
"Check MODE commands for bans and update the banlist appropriately."
;; FIXME: Possibly incorrect. -- Lawrence 2004-05-11
+ (declare (obsolete "`erc-channel-banlist' always updated on MODE" "31.1"))
(let* ((tgt (car (erc-response.command-args parsed)))
(mode (erc-response.contents parsed))
(whoset (erc-response.sender parsed))
@@ -7732,6 +7746,11 @@ erc--handle-channel-mode
(cl-pushnew (char-to-string c) erc-channel-modes :test #'equal)
(delete (char-to-string c) erc-channel-modes))))
+;; We could specialize on type A, but that may be too brittle.
+(cl-defmethod erc--handle-channel-mode (_ (_ (eql ?b)) state arg)
+ ;; Add or remove a ban from `erc-channel-banlist'.
+ (erc--banlist-update state arg))
+
;; We could specialize on type C, but that may be too brittle.
(cl-defmethod erc--handle-channel-mode (_ (_ (eql ?l)) state arg)
"Update channel user limit, remembering ARG when STATE is non-nil."
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index b11f994bce8..560d3bbb3d0 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -934,8 +934,13 @@ erc--channel-modes
(erc-tests-common-init-server-proc "sleep" "1")
- (cl-letf (((symbol-function 'erc-update-mode-line) #'ignore))
- (erc--update-channel-modes "+bltk" "fool!*@*" "3" "h2"))
+ (cl-letf ((erc--parsed-response (make-erc-response
+ :sender "chop!~u@gnu.org"))
+ ((symbol-function 'erc-update-mode-line) #'ignore))
+ (should-not erc-channel-banlist)
+ (erc--update-channel-modes "+bbltk" "fool!*@*" "spam!*@*" "3" "h2")
+ (should (equal erc-channel-banlist '(("chop!~u@gnu.org" . "spam!*@*")
+ ("chop!~u@gnu.org" . "fool!*@*")))))
(should (equal (erc--channel-modes 'string) "klt"))
(should (equal (erc--channel-modes 'strings) '("k" "l" "t")))
@@ -983,8 +988,12 @@ erc--channel-modes/graphic-p
erc-server-parameters
'(("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz")))
- (cl-letf (((symbol-function 'erc-update-mode-line) #'ignore))
- (erc--update-channel-modes "+bltk" "fool!*@*" "3" "hun2"))
+ (cl-letf ((erc--parsed-response (make-erc-response
+ :sender "chop!~u@gnu.org"))
+ ((symbol-function 'erc-update-mode-line) #'ignore))
+ (should-not erc-channel-banlist)
+ (erc--update-channel-modes "+bltk" "fool!*@*" "3" "hun2")
+ (should (equal erc-channel-banlist '(("chop!~u@gnu.org" . "fool!*@*")))))
;; Truncation cache populated and used.
(let ((cache (erc--channel-mode-types-shortargs erc--channel-mode-types))
--
2.46.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0005-5.6.1-Fix-inconsistent-handling-of-ban-lists-in-ERC.patch --]
[-- Type: text/x-patch, Size: 12779 bytes --]
From 75d2be6b3f74ef0822a2e69ba2f94f5806aa4182 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 18 Aug 2024 22:58:33 -0700
Subject: [PATCH 5/5] [5.6.1] Fix inconsistent handling of ban lists in ERC
* etc/ERC-NEWS: Mention new function `erc-sync-banlist' in new section
for ERC 5.6.1.
* lisp/erc/erc-fill.el (erc--determine-fill-column-function): New
method for `fill' and `fill-wrap' modules.
* lisp/erc/erc-pcomplete.el (pcomplete/erc-mode/BANLIST)
(pcomplete/erc-mode/BL)
(pcomplete/erc-mode/MASSUNBAN, pcomplete/erc-mode/MUB):
New functions.
* lisp/erc/erc.el (erc-channel-banlist): Deprecate practice of using
the symbol-property `received-from-server' of as a state flag because
it's error-prone and bleeds into other connections.
(erc--channel-banlist-synchronized-p): New variable.
(erc-sync-banlist): New function, announced in ERC-NEWS.
(erc--wrap-banlist): New function.
(erc-banlist-fill-padding): New variable.
(erc--determine-fill-column-function): New generic function.
(erc-cmd-BANLIST): Move forward declaration of `erc-fill-column' from
top level into function body. Always reset `received-from-server' to
nil. Improve column calculations.
(erc-cmd-MASSUNBAN): Always reset `received-from-server' to nil.
---
etc/ERC-NEWS | 9 ++
lisp/erc/erc-fill.el | 6 ++
lisp/erc/erc-pcomplete.el | 8 ++
lisp/erc/erc.el | 192 ++++++++++++++++++++------------------
4 files changed, 124 insertions(+), 91 deletions(-)
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 9803c3ff379..5dd72e6f1b3 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -11,6 +11,15 @@ This file is about changes in ERC, the powerful, modular, and
extensible IRC (Internet Relay Chat) client distributed with
GNU Emacs since Emacs version 22.1.
+\f
+* Changes in ERC 5.6.1
+
+** Reliable library access for ban lists.
+Say goodbye to continually running "/BANLIST" for programmatic
+purposes. Modules can instead use the function 'erc-sync-banlist' to
+guarantee that the variable 'erc-channel-banlist' remain synced for
+the remainder of an IRC session.
+
\f
* Changes in ERC 5.6
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 986314822ba..fa9d2071ccd 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -896,6 +896,12 @@ erc-timestamp-offset
(length (format-time-string erc-timestamp-format))
0))
+(cl-defmethod erc--determine-fill-column-function
+ (&context (erc-fill-mode (eql t)))
+ (if erc-fill-wrap-mode
+ (- (window-width) erc-fill--wrap-value 1)
+ erc-fill-column))
+
(provide 'erc-fill)
;;; erc-fill.el ends here
diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el
index 05cbaf3872f..afbe3895667 100644
--- a/lisp/erc/erc-pcomplete.el
+++ b/lisp/erc/erc-pcomplete.el
@@ -187,6 +187,14 @@ pcomplete/erc-mode/RECONNECT
(pcomplete-here '("cancel"))
(pcomplete-opt "a"))
+(defun pcomplete/erc-mode/BANLIST ()
+ (pcomplete-opt "f"))
+(defalias 'pcomplete/erc-mode/BL #'pcomplete/erc-mode/BANLIST)
+
+(defun pcomplete/erc-mode/MASSUNBAN ()
+ (pcomplete-opt "f"))
+(defalias 'pcomplete/erc-mode/MUB #'pcomplete/erc-mode/MASSUNBAN)
+
;;; Functions that provide possible completions.
(defun pcomplete-erc-commands ()
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index e1fd279f405..ef8515790cd 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -5556,108 +5556,117 @@ erc-cmd-CLEARTOPIC
(defvar-local erc-channel-banlist nil
"A list of bans seen for the current channel.
-Each ban is an alist of the form:
- (WHOSET . MASK)
-
-The property `received-from-server' indicates whether
-or not the ban list has been requested from the server.")
+Entries are cons cells of the form (WHOSET . MASK), where WHOSET is the
+channel operator who issued the ban. Modules needing such a list should
+call `erc-sync-banlist' once per session in the channel before accessing
+the variable. Interactive users need only issue a /BANLIST. Note that
+older versions of ERC relied on a deprecated convention involving a
+property of the symbol `erc-channel-banlist' to indicate whether a ban
+list had been received in full, but this was found to be unreliable.")
(put 'erc-channel-banlist 'received-from-server nil)
-(defvar erc-fill-column)
-
-(defun erc-cmd-BANLIST ()
- "Pretty-print the contents of `erc-channel-banlist'.
-
-The ban list is fetched from the server if necessary."
- (let ((chnl (erc-default-target))
- (chnl-name (buffer-name)))
-
- (cond
- ((not (erc-channel-p chnl))
- (erc-display-message nil 'notice 'active "You're not on a channel\n"))
-
- ((not (get 'erc-channel-banlist 'received-from-server))
- (let ((old-367-hook erc-server-367-functions))
- (setq erc-server-367-functions 'erc-banlist-store
- erc-channel-banlist nil)
- ;; fetch the ban list then callback
- (erc-with-server-buffer
- (erc-once-with-server-event
- 368
- (lambda (_proc _parsed)
- (with-current-buffer chnl-name
- (put 'erc-channel-banlist 'received-from-server t)
- (setq erc-server-367-functions old-367-hook)
- (erc-cmd-BANLIST)
- t)))
- (erc-server-send (format "MODE %s b" chnl)))))
-
- ((null erc-channel-banlist)
- (erc-display-message nil 'notice 'active
- (format "No bans for channel: %s\n" chnl))
+(defvar-local erc--channel-banlist-synchronized-p nil
+ "Whether the channel banlist has been fetched since joining.")
+
+(defun erc-sync-banlist (&optional done-fn)
+ "Initialize syncing of current channel's `erc-channel-banlist'.
+Arrange for it to remain synced for the rest of the IRC session. When
+DONE-FN is non-nil, call it with no args once fully updated, and expect
+it to return non-nil, if necessary, to inhibit further processing."
+ (unless (erc-channel-p (current-buffer))
+ (error "Not a channel buffer"))
+ (let ((channel (erc-target))
+ (buffer (current-buffer))
+ (hook (lambda (&rest r) (always (apply #'erc-banlist-store r)))))
+ (setq erc-channel-banlist nil)
+ (erc-with-server-buffer
+ (add-hook 'erc-server-367-functions hook -98 t)
+ (erc-once-with-server-event
+ 368 (lambda (&rest _)
+ (remove-hook 'erc-server-367-functions hook t)
+ (with-current-buffer buffer
+ (prog1 (if done-fn (funcall done-fn) t)
+ (setq erc--channel-banlist-synchronized-p t)))))
+ (erc-server-send (format "MODE %s b" channel)))))
+
+(defun erc--wrap-banlist-cmd (slashcmd)
+ (lambda ()
+ (put 'erc-channel-banlist 'received-from-server t)
+ (unwind-protect (funcall slashcmd)
(put 'erc-channel-banlist 'received-from-server nil))
+ t))
- (t
- (let* ((erc-fill-column (or (and (boundp 'erc-fill-column)
- erc-fill-column)
- (and (boundp 'fill-column)
- fill-column)
- (1- (window-width))))
- (separator (make-string erc-fill-column ?=))
- (fmt (concat
- "%-" (number-to-string (/ erc-fill-column 2)) "s"
- "%" (number-to-string (/ erc-fill-column 2)) "s")))
+(defvar erc-banlist-fill-padding 1.0
+ "Scaling factor from 0 to 1 of free space between entries, if any.")
- (erc-display-message
- nil 'notice 'active
- (format "Ban list for channel: %s\n" (erc-default-target)))
-
- (erc-display-line separator 'active)
- (erc-display-line (format fmt "Ban Mask" "Banned By") 'active)
- (erc-display-line separator 'active)
-
- (mapc
- (lambda (x)
- (erc-display-line
- (format fmt
- (truncate-string-to-width (cdr x) (/ erc-fill-column 2))
- (if (car x)
- (truncate-string-to-width (car x) (/ erc-fill-column 2))
- ""))
- 'active))
- erc-channel-banlist)
-
- (erc-display-message nil 'notice 'active "End of Ban list")
- (put 'erc-channel-banlist 'received-from-server nil)))))
+(cl-defgeneric erc--determine-fill-column-function ()
+ fill-column)
+
+(defun erc-cmd-BANLIST (&rest args)
+ "Print the list of ban masks for the current channel.
+When uninitialized or with option -f, resync `erc-channel-banlist'."
+ (cond
+ ((not (erc-channel-p (current-buffer)))
+ (erc-display-message nil 'notice 'active "You're not on a channel\n"))
+ ((or (equal args '("-f"))
+ (and (not erc--channel-banlist-synchronized-p)
+ (not (get 'erc-channel-banlist 'received-from-server))))
+ (erc-sync-banlist (erc--wrap-banlist-cmd #'erc-cmd-BANLIST)))
+ ((null erc-channel-banlist)
+ (erc-display-message nil 'notice 'active
+ (format "No bans for channel: %s\n" (erc-target))))
+ ((let ((max-width (erc--determine-fill-column-function))
+ (lw 0) (rw 0) separator fmt)
+ (dolist (entry erc-channel-banlist)
+ (setq rw (max (length (car entry)) rw)
+ lw (max (length (cdr entry)) lw)))
+ (let ((maxw (* 1.0 (min max-width (+ rw lw)))))
+ (when (< maxw (+ rw lw)) ; scale down when capped
+ (cl-psetq rw (/ (* rw maxw) (* 1.0 (+ rw lw)))
+ lw (/ (* lw maxw) (* 1.0 (+ rw lw)))))
+ (when-let ((larger (max rw lw)) ; cap ratio at 3:1
+ (wavg (* maxw 0.75))
+ ((> larger wavg)))
+ (setq rw (if (eql larger rw) wavg (- maxw wavg))
+ lw (- maxw rw)))
+ (cl-psetq rw (+ rw (* erc-banlist-fill-padding
+ (- (/ (* rw max-width) maxw) rw)))
+ lw (+ lw (* erc-banlist-fill-padding
+ (- (/ (* lw max-width) maxw) lw)))))
+ (setq rw (truncate rw)
+ lw (truncate lw))
+ (cl-assert (<= (+ rw lw) max-width))
+ (setq separator (make-string (+ rw lw 1) ?=)
+ fmt (concat "%-" (number-to-string lw) "s "
+ "%" (number-to-string rw) "s"))
+ (erc-display-message
+ nil 'notice 'active
+ (format "Ban list for channel: %s%s\n" (erc-target)
+ (if erc--channel-banlist-synchronized-p " (cached)" "")))
+ (erc-display-line separator 'active)
+ (erc-display-line (format fmt "Ban Mask" "Banned By") 'active)
+ (erc-display-line separator 'active)
+ (dolist (entry erc-channel-banlist)
+ (erc-display-line
+ (format fmt (truncate-string-to-width (cdr entry) lw)
+ (truncate-string-to-width (car entry) rw))
+ 'active))
+ (erc-display-message nil 'notice 'active "End of Ban list"))))
+ (put 'erc-channel-banlist 'received-from-server nil)
t)
(defalias 'erc-cmd-BL #'erc-cmd-BANLIST)
-(defun erc-cmd-MASSUNBAN ()
- "Mass Unban.
-
-Unban all currently banned users in the current channel."
+(defun erc-cmd-MASSUNBAN (&rest args)
+ "Remove all bans in the current channel."
(let ((chnl (erc-default-target)))
(cond
-
((not (erc-channel-p chnl))
(erc-display-message nil 'notice 'active "You're not on a channel\n"))
-
- ((not (get 'erc-channel-banlist 'received-from-server))
- (let ((old-367-hook erc-server-367-functions))
- (setq erc-server-367-functions 'erc-banlist-store)
- ;; fetch the ban list then callback
- (erc-with-server-buffer
- (erc-once-with-server-event
- 368
- (lambda (_proc _parsed)
- (with-current-buffer chnl
- (put 'erc-channel-banlist 'received-from-server t)
- (setq erc-server-367-functions old-367-hook)
- (erc-cmd-MASSUNBAN)
- t)))
- (erc-server-send (format "MODE %s b" chnl)))))
-
+ ((or (equal args '("-f"))
+ (and (not erc--channel-banlist-synchronized-p)
+ (not (get 'erc-channel-banlist 'received-from-server))))
+ (erc-sync-banlist (erc--wrap-banlist-cmd #'erc-cmd-MASSUNBAN)))
(t (let ((bans (mapcar #'cdr erc-channel-banlist)))
(when bans
;; Glob the bans into groups of three, and carry out the unban.
@@ -5668,8 +5677,9 @@ erc-cmd-MASSUNBAN
(format "MODE %s -%s %s" (erc-default-target)
(make-string (length x) ?b)
(mapconcat #'identity x " "))))
- (erc-group-list bans 3))))
- t))))
+ (erc-group-list bans 3))))))
+ (put 'erc-channel-banlist 'received-from-server nil)
+ t))
(defalias 'erc-cmd-MUB #'erc-cmd-MASSUNBAN)
--
2.46.0
^ permalink raw reply related [flat|nested] 3+ messages in thread
* bug#72736: 31.0.50; ERC 5.6.1: Keep ban lists in sync
2024-08-20 20:10 bug#72736: 31.0.50; ERC 5.6.1: Keep ban lists in sync J.P.
@ 2024-08-24 18:03 ` J.P.
[not found] ` <87msl123y6.fsf@neverwas.me>
1 sibling, 0 replies; 3+ messages in thread
From: J.P. @ 2024-08-24 18:03 UTC (permalink / raw)
To: 72736; +Cc: emacs-erc
"J.P." <jp@neverwas.me> writes:
> +(cl-defmethod erc--handle-channel-mode (_ (_ (eql ?b)) state arg)
> + ;; Add or remove a ban from `erc-channel-banlist'.
> + (erc--banlist-update state arg))
Both for clarity and compatibility with the current behavior, I think we
should instead keep `erc-channel-banlist' empty (and locally unbound)
until formally initialized for a given channel within an ERC session. An
easy way to do that would be to guard the above like so:
(when erc--channel-banlist-synchronized-p
(erc--banlist-update state arg))
> +
> ;; We could specialize on type C, but that may be too brittle.
> (cl-defmethod erc--handle-channel-mode (_ (_ (eql ?l)) state arg)
> "Update channel user limit, remembering ARG when STATE is non-nil."
As far as re-syncing on reconnect, that's probably better handled by an
actual module (if anyone feels like writing one). We could move all the
ban-list stuff to a new file and maybe offer an alternate display style
for interactive use, perhaps one based on `tabular-list-mode' or
similar.
^ permalink raw reply [flat|nested] 3+ messages in thread
* bug#72736: 31.0.50; ERC 5.6.1: Keep ban lists in sync
[not found] ` <87msl123y6.fsf@neverwas.me>
@ 2024-09-05 21:58 ` J.P.
0 siblings, 0 replies; 3+ messages in thread
From: J.P. @ 2024-09-05 21:58 UTC (permalink / raw)
To: 72736; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 1559 bytes --]
v2. Only update `erc-channel-banlist' if initialized. Redo shared hook
mechanism for buffer truncation.
"J.P." <jp@neverwas.me> writes:
> Both for clarity and compatibility with the current behavior, I think we
> should instead keep `erc-channel-banlist' empty (and locally unbound)
> until formally initialized for a given channel within an ERC session. An
> easy way to do that would be to guard the above like so:
>
> (when erc--channel-banlist-synchronized-p
> (erc--banlist-update state arg))
I've done this in the latest set of patches (attached).
I've also tacked on a reworking of the rather awkward hook mechanism by
which modules can run code prior to a buffer's truncation. This was
previously handled by the abnormal hook `erc--pre-clear-functions',
which was run by both the `truncate' module and the `erc-cmd-CLEAR'
slash command. Part of this overhaul involved deferring most of the code
that formerly ran on `erc-insert-done-hook' to a per-response, ephemeral
`erc-timing-hook' member.
The main reason for this move is to escape the insertion related context
imposed on such hooks by response-handling code further back in the call
stack. We're not inserting anything, so it makes little sense to abuse
such hooks for their side effects, which is a design flaw and a common
antipattern (though an excusable one, seeing as there's no real sensible
alternative). Regardless, deferring to a known call site over a limited
extent via `erc-timer-hook' seems far more predictable and manageable
than relying on `run-at-time' or similar.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v1-v2.diff --]
[-- Type: text/x-patch, Size: 33568 bytes --]
From 5297613ac24bfbee5ed43f01875c08c147b7f618 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 5 Sep 2024 14:22:11 -0700
Subject: [PATCH 0/6] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (6):
[5.6.1] ; Rename internal variable in erc-fill
[5.6.1] Store one string per user in erc--spkr msg prop
[5.6.1] Bind current erc-response around all handlers
[5.6.1] Fix inconsistent handling of ban lists in ERC
[5.6.1] Fix overlooked case in erc--get-inserted-msg-beg-at
[5.6.1] Redo ERC truncation and /CLEAR hook mechanism
etc/ERC-NEWS | 9 +
lisp/erc/erc-backend.el | 10 +-
lisp/erc/erc-fill.el | 14 +-
lisp/erc/erc-log.el | 10 +-
lisp/erc/erc-pcomplete.el | 8 +
lisp/erc/erc-stamp.el | 101 ++++--
lisp/erc/erc-truncate.el | 103 +++---
lisp/erc/erc.el | 299 ++++++++++--------
test/lisp/erc/erc-fill-tests.el | 2 +-
test/lisp/erc/erc-goodies-tests.el | 5 +
test/lisp/erc/erc-scenarios-log.el | 22 +-
test/lisp/erc/erc-tests.el | 94 +++++-
.../erc/resources/erc-scenarios-common.el | 2 +-
test/lisp/erc/resources/erc-tests-common.el | 16 +-
14 files changed, 474 insertions(+), 221 deletions(-)
Interdiff:
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 5dd72e6f1b3..0b5385f0589 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -17,7 +17,7 @@ GNU Emacs since Emacs version 22.1.
** Reliable library access for ban lists.
Say goodbye to continually running "/BANLIST" for programmatic
purposes. Modules can instead use the function 'erc-sync-banlist' to
-guarantee that the variable 'erc-channel-banlist' remain synced for
+guarantee that the variable 'erc-channel-banlist' remains synced for
the remainder of an IRC session.
\f
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index fa9d2071ccd..6f3d51f6937 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -547,6 +547,8 @@ fill-wrap
(when erc-fill-wrap-merge
(add-hook 'erc-button--prev-next-predicate-functions
#'erc-fill--wrap-merged-button-p nil t))
+ (add-function :after (local 'erc--clear-function)
+ #'erc-stamp--redo-right-stamp-post-clear '((depth . 50)))
(erc-stamp--display-margin-mode +1)
(visual-line-mode +1))
((visual-line-mode -1)
@@ -557,6 +559,8 @@ fill-wrap
(kill-local-variable 'erc-fill--wrap-last-msg)
(kill-local-variable 'erc--inhibit-prompt-display-property-p)
(kill-local-variable 'erc-fill--wrap-merge-indicator-pre)
+ (remove-function (local 'erc--clear-function)
+ #'erc-stamp--redo-right-stamp-post-clear)
(remove-hook 'erc--refresh-prompt-hook
#'erc-fill--wrap-indent-prompt t)
(remove-hook 'erc-button--prev-next-predicate-functions
diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el
index 66420662c23..6bb240f56d7 100644
--- a/lisp/erc/erc-log.el
+++ b/lisp/erc/erc-log.el
@@ -231,7 +231,7 @@ log
(add-hook 'erc-part-hook #'erc-conditional-save-buffer)
;; append, so that 'erc-initialize-log-marker runs first
(add-hook 'erc-connect-pre-hook #'erc-log-setup-logging 'append)
- (add-hook 'erc--pre-clear-functions #'erc-save-buffer-in-logs 50)
+ ;; FIXME use proper local "setup" function and major-mode hook.
(dolist (buffer (erc-buffer-list))
(erc-log-setup-logging buffer))
(erc--modify-local-map t "C-c C-l" #'erc-save-buffer-in-logs))
@@ -244,7 +244,6 @@ log
(remove-hook 'erc-quit-hook #'erc-conditional-save-queries)
(remove-hook 'erc-part-hook #'erc-conditional-save-buffer)
(remove-hook 'erc-connect-pre-hook #'erc-log-setup-logging)
- (remove-hook 'erc--pre-clear-functions #'erc-save-buffer-in-logs)
(dolist (buffer (erc-buffer-list))
(erc-log-disable-logging buffer))
(erc--modify-local-map nil "C-c C-l" #'erc-save-buffer-in-logs)))
@@ -259,6 +258,8 @@ erc-log-setup-logging
(auto-save-mode -1)
(setq buffer-file-name nil)
(add-hook 'write-file-functions #'erc-save-buffer-in-logs nil t)
+ (add-function :before (local 'erc--clear-function)
+ #'erc-log--save-on-clear '((depth . 50)))
(when erc-log-insert-log-on-open
(ignore-errors
(save-excursion
@@ -271,6 +272,7 @@ erc-log-disable-logging
"Disable logging in BUFFER."
(when (erc-logging-enabled buffer)
(with-current-buffer buffer
+ (remove-function (local 'erc--clear-function) #'erc-log--save-on-clear)
(setq buffer-offer-save nil
erc-enable-logging nil))))
@@ -415,6 +417,7 @@ erc-save-buffer-in-logs
(widen)
;; early on in the initialization, don't try and write the log out
(when (and (markerp erc-last-saved-position)
+ (null erc--insert-marker) ; suppress when splicing
(> erc-insert-marker (1+ erc-last-saved-position)))
(let ((start (1+ (marker-position erc-last-saved-position)))
(end (marker-position erc-insert-marker)))
@@ -446,6 +449,9 @@ erc-save-buffer-in-logs
(set-buffer-modified-p nil))))))
t)
+(defun erc-log--save-on-clear (_ end)
+ (erc-save-buffer-in-logs end))
+
;; This is a kludge to avoid littering erc-truncate.el with forward
;; declarations needed only for a corner-case compatibility check.
(defun erc-log--call-when-logging-enabled-sans-module (fn)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index bebc1d0be38..7d773c8f4b2 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -182,13 +182,11 @@ stamp
(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)
- (add-hook 'erc--pre-clear-functions #'erc-stamp--reset-on-clear 40)
(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)
(remove-hook 'erc-send-modify-hook #'erc-add-timestamp)
(remove-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect)
- (remove-hook 'erc--pre-clear-functions #'erc-stamp--reset-on-clear)
(erc-buffer-do #'erc-stamp--setup)))
(defvar erc-stamp--invisible-property nil
@@ -707,7 +705,8 @@ erc-stamp--find-insertion-point
;; Continue searching after encountering a message without a
;; timestamp because date stamps must be unique, and
;; "Re-establishing connection" messages should have stamps.
- (while-let ((q (previous-single-property-change (1- p) 'erc--ts))
+ (while-let ((pp (max (1- p) (point-min)))
+ (q (previous-single-property-change pp 'erc--ts))
(qq (erc--get-inserted-msg-beg q))
(ts (get-text-property qq 'erc--ts))
((not (time-less-p ts target-time))))
@@ -753,7 +752,7 @@ erc-stamp--defer-date-insertion-on-post-modify
(set-marker marker (point-min))
(set-marker-insertion-type marker t)
(erc--hide-message 'timestamp))
- ,@erc-insert-post-hook))
+ ,@(ensure-list erc-insert-post-hook)))
(erc-insert-timestamp-function
#'erc-stamp--propertize-left-date-stamp)
(pos (erc-stamp--find-insertion-point marker aligned))
@@ -980,11 +979,16 @@ erc-stamp--add-csf-on-post-modify
(defun erc-stamp--setup ()
"Enable or disable buffer-local `erc-stamp-mode' modifications."
(if erc-stamp-mode
- (erc-stamp--manage-local-options-state)
+ (progn
+ (erc-stamp--manage-local-options-state)
+ (add-function :around (local 'erc--clear-function)
+ #'erc-stamp--reset-on-clear '((depth . 40))))
(let (erc-echo-timestamps erc-hide-timestamps erc-timestamp-intangible)
(erc-stamp--manage-local-options-state))
;; Undo local mods from `erc-insert-timestamp-left-and-right'.
(erc-stamp--date-mode -1) ; kills `erc-timestamp-last-inserted-left'
+ (remove-function (local 'erc--clear-function)
+ #'erc-stamp--reset-on-clear)
(kill-local-variable 'erc-stamp--last-stamp)
(kill-local-variable 'erc-timestamp-last-inserted)
(kill-local-variable 'erc-timestamp-last-inserted-right)
@@ -1023,6 +1027,8 @@ erc-toggle-timestamps
(defvar-local erc-stamp--last-stamp nil)
+;; FIXME rename this to avoid confusion with IRC messages.
+;; Something like `erc-stamp--on-clear-echo-area-message'.
(defun erc-stamp--on-clear-message (&rest _)
"Return `dont-clear-message' when operating inside the same stamp."
(and erc-stamp--last-stamp erc-echo-timestamps
@@ -1052,25 +1058,74 @@ erc-echo-timestamp
(defun erc--echo-ts-csf (_window _before dir)
(erc-echo-timestamp dir (erc--get-inserted-msg-prop 'erc--ts)))
-(defun erc-stamp--update-saved-position (&rest _)
- (remove-hook 'erc-stamp--insert-date-hook
- #'erc-stamp--update-saved-position t)
- (move-marker erc-last-saved-position (1- (point-max))))
-
-(defun erc-stamp--reset-on-clear (pos)
- "Forget last-inserted stamps when POS is at insert marker.
+(defun erc-stamp--redo-right-stamp-post-clear (_ end)
+ "Append new right stamp to first inserted message after END."
+ ;; During truncation, the last existing right stamp is often deleted
+ ;; regardless of `erc-timestamp-only-if-changed-flag'. As of ERC 5.6,
+ ;; recreating inserted messages from scratch isn't doable. (Although,
+ ;; attempting surgery like this is likely unwise.)
+ (when-let ((erc-stamp--date-mode)
+ ((< end erc-insert-marker))
+ (bounds (erc--get-inserted-msg-bounds (1+ end)))
+ (ts (get-text-property (car bounds) 'erc--ts))
+ (format (with-suppressed-warnings
+ ((obsolete erc-timestamp-format-right))
+ (or erc-timestamp-format-right erc-timestamp-format)))
+ (rendered (erc-format-timestamp ts format))
+ ((not (equal rendered erc-timestamp-last-inserted-right)))
+ (erc--msg-props (map-into `((erc--ts . ,ts)) 'hash-table)))
+ (save-excursion
+ (save-restriction
+ (let ((erc-timestamp-last-inserted erc-timestamp-last-inserted)
+ (erc-timestamp-last-inserted-right
+ erc-timestamp-last-inserted-right))
+ (narrow-to-region (car bounds) (cdr bounds))
+ (erc-add-timestamp))))))
+
+(defun erc-stamp--reset-on-clear (orig beg end)
+ "Forget stamps older than POS.
And discard stale references in `erc-stamp--date-stamps'."
- (when erc-stamp--date-stamps
- (setq erc-stamp--date-stamps
- (seq-filter (lambda (o) (> (erc-stamp--date-marker o) pos))
- erc-stamp--date-stamps)))
- (when (= pos (1- erc-insert-marker))
- (when erc-stamp--date-mode
- (add-hook 'erc-stamp--insert-date-hook
- #'erc-stamp--update-saved-position 0 t))
- (setq erc-timestamp-last-inserted nil
- erc-timestamp-last-inserted-left nil
- erc-timestamp-last-inserted-right nil)))
+ (let (culled)
+ (when erc-stamp--date-stamps
+ (setq erc-stamp--date-stamps
+ ;; This assumes `seq-filter' visits items in order.
+ (seq-filter (lambda (o)
+ (or (> (erc-stamp--date-marker o) end)
+ (ignore
+ (set-marker (erc-stamp--date-marker o) nil)
+ (push o culled))))
+ erc-stamp--date-stamps)))
+ (funcall orig beg end)
+ (when-let ((culled)
+ ((not (or (erc--memq-msg-prop 'erc--skip 'stamp)
+ (and erc--msg-prop-overrides
+ (memq 'stamp
+ (alist-get 'erc--skip
+ erc--msg-prop-overrides))))))
+ (ct (erc-stamp--date-ts (car culled))))
+ (cl-assert erc-stamp--date-mode)
+ (let ((hook (make-symbol "temporary-hook"))
+ (rendered (erc-stamp--format-date-stamp ct))
+ (want-rhs-p (= end erc-insert-marker)))
+ ;; Object successfully removed from model but snapshot remains.
+ (cl-assert (null (cl-find rendered erc-stamp--date-stamps
+ :test #'string=
+ :key #'erc-stamp--date-str)))
+ ;; When it's midnight, `rendered' may still be yesterday while
+ ;; `erc-timestamp-last-inserted-left' is already today.
+ (let* ((data (make-erc-stamp--date :ts ct :str rendered))
+ (erc-stamp--deferred-date-stamp data)
+ (erc-timestamp-last-inserted-left nil))
+ (erc-stamp--defer-date-insertion-on-post-modify hook)
+ (set-marker (erc-stamp--date-marker data) end)
+ (run-hooks hook)
+ (unless (= ?\n (char-after erc-last-saved-position))
+ (cl-assert (or erc--called-as-input-p (null erc--msg-props)))
+ (cl-assert (= erc-last-saved-position erc-insert-marker))
+ (set-marker erc-last-saved-position (1- erc-insert-marker))))
+ (when want-rhs-p
+ (setq erc-timestamp-last-inserted-right nil
+ erc-timestamp-last-inserted nil))))))
(defun erc-stamp--dedupe-date-stamps (old-stamps)
"Update `erc-stamp--date-stamps' from its counterpart OLD-STAMPS.
diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el
index 4b602074ebb..c471d7a72ad 100644
--- a/lisp/erc/erc-truncate.el
+++ b/lisp/erc/erc-truncate.el
@@ -38,7 +38,7 @@ erc-truncate
(defcustom erc-max-buffer-size 30000
"Maximum size in chars of each ERC buffer.
Used only when auto-truncation is enabled.
-\(see `erc-truncate-buffer' and `erc-insert-post-hook')."
+\(Also see `erc-truncate-buffer'.)"
:type 'integer)
;;;###autoload(autoload 'erc-truncate-mode "erc-truncate" nil t)
@@ -49,10 +49,31 @@ truncate
tracking heavy-traffic channels."
;;enable
((add-hook 'erc-insert-done-hook #'erc-truncate-buffer)
- (add-hook 'erc-connect-pre-hook #'erc-truncate--warn-about-logging))
+ (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)))
;; disable
((remove-hook 'erc-insert-done-hook #'erc-truncate-buffer)
- (remove-hook 'erc-connect-pre-hook #'erc-truncate--warn-about-logging)))
+ (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
+ "Temporary buffer-local override for `erc-max-buffer-size'.")
+
+(defun erc-truncate--setup ()
+ "Enable or disable buffer-local `erc-truncate-mode' modifications."
+ (if erc-truncate-mode
+ (progn
+ (when-let ((priors (or erc--server-reconnecting erc--target-priors))
+ (val (alist-get 'erc-truncate--buffer-size priors)))
+ (setq erc-truncate--buffer-size val))
+ (add-function :before (local 'erc--clear-function)
+ #'erc-truncate--inhibit-when-local-and-interactive
+ '((depth . 20))))
+ (remove-function (local 'erc--clear-function)
+ #'erc-truncate--inhibit-when-local-and-interactive)
+ (kill-local-variable 'erc-truncate--buffer-size)))
(defun erc-truncate--warn-about-logging (&rest _)
(when (and (not erc--target)
@@ -90,49 +111,51 @@ erc-truncate-buffer-to-size
(setq buffer (current-buffer))
(unless (get-buffer buffer)
(error "erc-truncate-buffer-to-size: %S is not a buffer" buffer)))
- (when (> (buffer-size buffer) (+ size 512))
- (with-current-buffer buffer
- ;; Note that when erc-insert-post-hook runs, the buffer is
- ;; narrowed to the new message. So do this delicate widening.
- ;; I am not sure, I think this was not recommended behavior in
- ;; Emacs 20.
- (save-restriction
- (widen)
- (let ((end (- erc-insert-marker size)))
- ;; Truncate at message boundary (formerly line boundary
- ;; before 5.6).
- (goto-char end)
- (goto-char (or (erc--get-inserted-msg-beg end)
- (pos-bol)))
- (setq end (point))
- ;; try to save the current buffer using
- ;; `erc-save-buffer-in-logs'. We use this, in case the
- ;; user has both `erc-save-buffer-in-logs' and
- ;; `erc-truncate-buffer' in `erc-insert-post-hook'. If
- ;; this is the case, only the non-saved part of the current
- ;; buffer should be saved. Rather than appending the
- ;; deleted part of the buffer to the log file.
- ;;
- ;; Alternatively this could be made conditional on:
- ;; (not (memq 'erc-save-buffer-in-logs
- ;; erc-insert-post-hook))
- ;; Comments?
- ;; The comments above concern pre-5.6 behavior and reflect
- ;; an obsolete understanding of how `erc-logging-enabled'
- ;; behaves in practice.
- (run-hook-with-args 'erc--pre-clear-functions end)
- ;; disable undoing for the truncating
- (buffer-disable-undo)
- (let ((inhibit-read-only t))
- (delete-region (point-min) end)))
- (buffer-enable-undo)))))
+ (with-current-buffer buffer
+ (when (and (not erc--inhibit-clear-p)
+ (> (buffer-size)
+ (+ (if (and erc-truncate--buffer-size
+ (> erc-truncate--buffer-size size))
+ (setq size erc-truncate--buffer-size)
+ size)
+ 512)))
+ ;; Though unneeded, widen anyway to preserve pre-5.5 behavior.
+ (save-excursion
+ (save-restriction
+ (widen)
+ (let ((beg (point-min-marker))
+ (end (goto-char (- erc-insert-marker size))))
+ ;; Truncate at message boundary (formerly line boundary
+ ;; before 5.6).
+ (goto-char (or (erc--get-inserted-msg-beg end) (pos-bol)))
+ (setq end (point-marker))
+ (with-silent-modifications
+ (funcall erc--clear-function beg end))
+ (set-marker beg nil)
+ (set-marker end nil)))))))
;;;###autoload
(defun erc-truncate-buffer ()
"Truncate current buffer to `erc-max-buffer-size'."
(interactive)
+ ;; This `save-excursion' only exists for historical reasons because
+ ;; `erc-truncate-buffer-to-size' normally runs in a different buffer.
(save-excursion
- (erc-truncate-buffer-to-size erc-max-buffer-size)))
+ (if (and erc--parsed-response erc--msg-props)
+ (let ((symbol (make-symbol "erc-truncate--buffer-deferred"))
+ (buffer (current-buffer)))
+ (fset symbol
+ (lambda (&rest _)
+ (remove-hook 'erc-timer-hook symbol t)
+ (erc-truncate-buffer-to-size erc-max-buffer-size buffer)))
+ (erc-with-server-buffer (add-hook 'erc-timer-hook symbol -80 t)))
+ (erc-truncate-buffer-to-size erc-max-buffer-size))))
+
+(defun erc-truncate--inhibit-when-local-and-interactive (&rest _)
+ "Ensure `erc-truncate--buffer-size' is nil on /CLEAR."
+ (when (and erc--called-as-input-p erc-truncate--buffer-size)
+ (message "Resetting max buffer size to %d" erc-max-buffer-size)
+ (setq erc-truncate--buffer-size nil)))
(provide 'erc-truncate)
;;; erc-truncate.el ends here
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index ef8515790cd..8938db81c20 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1793,7 +1793,9 @@ erc-mode
(setq-local completion-ignore-case t)
(add-hook 'post-command-hook #'erc-check-text-conversion nil t)
(add-hook 'kill-buffer-hook #'erc-kill-buffer-function nil t)
- (add-hook 'completion-at-point-functions #'erc-complete-word-at-point nil t))
+ (add-hook 'completion-at-point-functions #'erc-complete-word-at-point nil t)
+ (add-function :before (local 'erc--clear-function)
+ #'erc--skip-past-headroom-on-clear '((depth . 30))))
;; activation
@@ -3323,10 +3325,14 @@ erc--get-inserted-msg-beg-at
(macroexp-let2* nil ((point point)
(at-start-p at-start-p))
`(or (and ,at-start-p ,point)
- (and-let* ((p (previous-single-property-change ,point 'erc--msg)))
- (if (and (= p (1- ,point)) (get-text-property p 'erc--msg))
- p
- (1- p))))))
+ (let ((p (previous-single-property-change ,point 'erc--msg)))
+ (cond
+ ((and p (= p (1- ,point)) (get-text-property p 'erc--msg)) p)
+ (p (1- p))
+ ((and (null p)
+ (> ,point (point-min))
+ (get-text-property (1- point) 'erc--msg))
+ (1- point)))))))
(defmacro erc--get-inserted-msg-end-at (point at-start-p)
(macroexp-let2 nil point point
@@ -3355,9 +3361,9 @@ erc--get-inserted-msg-bounds
(and-let* ((b (erc--get-inserted-msg-beg-at point at-start-p)))
(cons b (erc--get-inserted-msg-end-at point at-start-p)))))
-(defun erc--get-inserted-msg-prop (prop)
+(defun erc--get-inserted-msg-prop (prop &optional point)
"Return the value of text property PROP for some message at point."
- (and-let* ((stack-pos (erc--get-inserted-msg-beg (point))))
+ (and-let* ((stack-pos (erc--get-inserted-msg-beg (or point (point)))))
(get-text-property stack-pos prop)))
;; FIXME improve this nascent "message splicing" facility to include a
@@ -3382,7 +3388,8 @@ erc--with-spliced-insertion
(declare (indent 1))
(let ((marker (make-symbol "marker")))
`(progn
- (cl-assert (= ?\n (char-before ,marker-or-pos)))
+ (cl-assert (or (= ,marker-or-pos (point-min))
+ (= ?\n (char-before ,marker-or-pos))))
(cl-assert (null erc--insert-line-function))
(let* ((,marker (and (not (markerp ,marker-or-pos))
(copy-marker ,marker-or-pos)))
@@ -3698,7 +3705,8 @@ erc--insert-before-markers-transplanting-hidden
the inserted version of STRING."
(let* ((after (and (not erc-legacy-invisible-bounds-p)
(get-text-property (point) 'erc--hide)))
- (before (and after (get-text-property (1- (point)) 'invisible)))
+ (before (and after (> (point) (point-min))
+ (get-text-property (1- (point)) 'invisible)))
(a (and after (ensure-list after)))
(b (and before (ensure-list before)))
(new (and before (erc--solo (cl-intersection b a)))))
@@ -4470,21 +4478,37 @@ erc--unignore-user
(when-let ((existing (erc--find-ignore-timer user buffer)))
(cancel-timer existing)))))
-(defvar erc--pre-clear-functions nil
- "Abnormal hook run when truncating buffers.
-Called with position indicating boundary of interval to be excised.")
+(defvar erc--clear-function #'delete-region
+ "Function to truncate buffer.
+Called with two markers, LOWER and UPPER, indicating the bounds of the
+interval to be excised. LOWER <= UPPER <= `erc-insert-marker'.")
+
+(defun erc--skip-past-headroom-on-clear (lower _)
+ "Move marker LOWER past the 2 newlines added by `erc--initialize-markers'."
+ (when (and (not (buffer-narrowed-p)) (= lower (point-min)))
+ (save-excursion
+ (goto-char (point-min))
+ (set-marker lower (1+ (skip-chars-forward "\n" 3))))))
+
+(defvar erc--inhibit-clear-p nil
+ "When non-nil, inhbiit buffer truncation.")
(defun erc-cmd-CLEAR ()
"Clear messages in current buffer after informing active modules.
Expect modules to perform housekeeping tasks to withstand the
disruption. When called from Lisp code, only clear messages up
to but not including the one occupying the current line."
+ (when erc--inhibit-clear-p
+ (user-error "Truncation currently inhibited"))
(with-silent-modifications
- (let ((max (if (>= (point) erc-insert-marker)
- (1- erc-insert-marker)
- (or (erc--get-inserted-msg-beg (point)) (pos-bol)))))
- (run-hook-with-args 'erc--pre-clear-functions max)
- (delete-region (point-min) max)))
+ (let ((end (copy-marker
+ (cond ((>= (point) erc-insert-marker) erc-insert-marker)
+ ((erc--get-inserted-msg-beg (point)))
+ ((pos-bol)))))
+ (beg (point-min-marker)))
+ (funcall erc--clear-function beg end)
+ (set-marker beg nil)
+ (set-marker end nil)))
t)
(put 'erc-cmd-CLEAR 'process-not-needed t)
@@ -5555,29 +5579,28 @@ erc-cmd-CLEARTOPIC
(defvar-local erc-channel-banlist nil
"A list of bans seen for the current channel.
-
-Entries are cons cells of the form (WHOSET . MASK), where WHOSET is the
-channel operator who issued the ban. Modules needing such a list should
-call `erc-sync-banlist' once per session in the channel before accessing
-the variable. Interactive users need only issue a /BANLIST. Note that
+Entries are cons cells of the form (OP . MASK), where OP is the channel
+operator who issued the ban. Modules needing such a list should call
+`erc-sync-banlist' once per session in the channel before accessing the
+variable. Interactive users need only issue a /BANLIST. Note that
older versions of ERC relied on a deprecated convention involving a
property of the symbol `erc-channel-banlist' to indicate whether a ban
-list had been received in full, but this was found to be unreliable.")
+list had been received in full; this was found to be unreliable.")
(put 'erc-channel-banlist 'received-from-server nil)
(defvar-local erc--channel-banlist-synchronized-p nil
- "Whether the channel banlist has been fetched since joining.")
+ "Whether the full channel ban list has been fetched since joining.")
(defun erc-sync-banlist (&optional done-fn)
"Initialize syncing of current channel's `erc-channel-banlist'.
Arrange for it to remain synced for the rest of the IRC session. When
-DONE-FN is non-nil, call it with no args once fully updated, and expect
-it to return non-nil, if necessary, to inhibit further processing."
+DONE-FN is non-nil, call it with no args once fully updated. Expect it
+to return non-nil, if necessary, to inhibit further processing."
(unless (erc-channel-p (current-buffer))
(error "Not a channel buffer"))
(let ((channel (erc-target))
(buffer (current-buffer))
- (hook (lambda (&rest r) (always (apply #'erc-banlist-store r)))))
+ (hook (lambda (&rest r) (apply #'erc-banlist-store r) t)))
(setq erc-channel-banlist nil)
(erc-with-server-buffer
(add-hook 'erc-server-367-functions hook -98 t)
@@ -6673,7 +6696,7 @@ erc--banlist-update
(defun erc-banlist-update (proc parsed)
"Check MODE commands for bans and update the banlist appropriately."
;; FIXME: Possibly incorrect. -- Lawrence 2004-05-11
- (declare (obsolete "`erc-channel-banlist' always updated on MODE" "31.1"))
+ (declare (obsolete "continual syncing via `erc--banlist-update'" "31.1"))
(let* ((tgt (car (erc-response.command-args parsed)))
(mode (erc-response.contents parsed))
(whoset (erc-response.sender parsed))
@@ -7758,8 +7781,8 @@ erc--handle-channel-mode
;; We could specialize on type A, but that may be too brittle.
(cl-defmethod erc--handle-channel-mode (_ (_ (eql ?b)) state arg)
- ;; Add or remove a ban from `erc-channel-banlist'.
- (erc--banlist-update state arg))
+ "Update `erc-channel-banlist' when synchronized."
+ (when erc--channel-banlist-synchronized-p (erc--banlist-update state arg)))
;; We could specialize on type C, but that may be too brittle.
(cl-defmethod erc--handle-channel-mode (_ (_ (eql ?l)) state arg)
diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el
index 038434b3880..1d74025c5ce 100644
--- a/test/lisp/erc/erc-goodies-tests.el
+++ b/test/lisp/erc/erc-goodies-tests.el
@@ -597,6 +597,11 @@ erc--get-inserted-msg-beg/readonly
#'erc-tests-common-assert-get-inserted-msg/basic
(lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg))))))
+(ert-deftest erc--get-inserted-msg-beg/truncated/readonly ()
+ (erc-tests-common-assert-get-inserted-msg-readonly-with
+ #'erc-tests-common-assert-get-inserted-msg/truncated
+ (lambda (arg) (should (= 1 (erc--get-inserted-msg-beg arg))))))
+
(ert-deftest erc--get-inserted-msg-end/readonly ()
(erc-tests-common-assert-get-inserted-msg-readonly-with
#'erc-tests-common-assert-get-inserted-msg/basic
diff --git a/test/lisp/erc/erc-scenarios-log.el b/test/lisp/erc/erc-scenarios-log.el
index 3c738822f96..76d3b74222d 100644
--- a/test/lisp/erc/erc-scenarios-log.el
+++ b/test/lisp/erc/erc-scenarios-log.el
@@ -117,10 +117,12 @@ erc-scenarios-log--clear-stamp
(should (file-exists-p logfile))
(funcall expect 10 "please your lordship")
(ert-info ("Buffer truncated")
- (goto-char (point-min))
- (funcall expect 10 "@@STAMP@@" (point)) ; reset
+ (funcall expect 10 "@@STAMP@@" (goto-char (point-min))) ; reset
(funcall expect -0.1 "Grows, lives")
- (funcall expect 1 "For these two")))
+ (funcall expect 1 "For these two")
+ ;; Stamp resides just before `erc-last-saved-position'.
+ (should (looking-back (rx "]\n<bob> alice: For these two")))
+ (should (= erc-last-saved-position (1- (pos-bol))))))
(ert-info ("Current contents saved")
(with-temp-buffer
@@ -129,7 +131,7 @@ erc-scenarios-log--clear-stamp
(funcall expect 1 "You have joined")
(funcall expect 1 "Playback Complete.")
(funcall expect 1 "Grows, lives")
- (funcall expect -0.01 "please your lordship")))
+ (funcall expect -0.001 "alice: For these two hours")))
(ert-info ("Remainder saved, timestamp printed when option non-nil")
(with-current-buffer "foonet"
@@ -180,7 +182,7 @@ erc-scenarios-log--truncate
(should-not (file-exists-p logserv))
(should-not (file-exists-p logchan))
(funcall expect 10 "*** MAXLIST=beI:60")
- (should (= (pos-bol) (point-min)))
+ (should (= (pos-bol) 22))
(should (file-exists-p logserv))))
(ert-info ("Log file ahead of truncation point")
@@ -198,9 +200,13 @@ erc-scenarios-log--truncate
(with-temp-buffer
(insert-file-contents logchan)
(funcall expect 1 "You have joined")
- (funcall expect 1 "[07:04:37] alice: Here,")
- (funcall expect 1 "loathed enemy")
- (funcall expect -0.1 "please your lordship")))
+ ;; No unwanted duplicates.
+ (funcall expect 1 "<bob> [07:04:37] alice: Here,")
+ (funcall expect -0.001 "<bob> [07:04:37] alice: Here,")
+ (funcall expect 1 "<alice> [07:04:42] bob: By my troth")
+ (funcall expect -0.001 "<alice> [07:04:42] bob: By my troth")
+ (funcall expect 1 "I will grant it")
+ (funcall expect -0.001 "loathed enemy")))
(erc-log-mode -1)
(erc-truncate-mode -1)
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 560d3bbb3d0..eddb3a5b2c8 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -929,6 +929,7 @@ erc--channel-modes
(setq erc--isupport-params (make-hash-table)
erc--target (erc--target-from-string "#test")
+ erc--channel-banlist-synchronized-p t
erc-server-parameters
'(("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz")))
@@ -985,6 +986,7 @@ erc--channel-modes/graphic-p
(erc-tests-common-init-server-proc "sleep" "1")
(setq erc--isupport-params (make-hash-table)
erc--target (erc--target-from-string "#test")
+ erc--channel-banlist-synchronized-p t
erc-server-parameters
'(("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz")))
@@ -1932,6 +1934,10 @@ erc--get-inserted-msg-beg/basic
(erc-tests-common-assert-get-inserted-msg/basic
(lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg))))))
+(ert-deftest erc--get-inserted-msg-beg/truncated ()
+ (erc-tests-common-assert-get-inserted-msg/truncated
+ (lambda (arg) (should (= 1 (erc--get-inserted-msg-beg arg))))))
+
(ert-deftest erc--get-inserted-msg-end/basic ()
(erc-tests-common-assert-get-inserted-msg/basic
(lambda (arg) (should (= 11 (erc--get-inserted-msg-end arg))))))
diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el
index b5bb1fb09c3..1cd54a1f715 100644
--- a/test/lisp/erc/resources/erc-tests-common.el
+++ b/test/lisp/erc/resources/erc-tests-common.el
@@ -184,6 +184,13 @@ erc-tests-common-assert-get-inserted-msg/basic
(should (looking-back "<bob> hi"))
(erc-tests-common-assert-get-inserted-msg 3 11 test-fn))
+(defun erc-tests-common-assert-get-inserted-msg/truncated (test-fn)
+ (erc-tests-common-get-inserted-msg-setup)
+ (with-silent-modifications (delete-region 1 3))
+ (goto-char 9)
+ (should (looking-back "<bob> hi"))
+ (erc-tests-common-assert-get-inserted-msg 1 9 test-fn))
+
;; This is a "mixin" and requires a base assertion function, like
;; `erc-tests-common-assert-get-inserted-msg/basic', to work.
(defun erc-tests-common-assert-get-inserted-msg-readonly-with
--
2.46.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-5.6.1-Rename-internal-variable-in-erc-fill.patch --]
[-- Type: text/x-patch, Size: 4447 bytes --]
From d2224a549b3ad24e4798a827f965d2f624efb6fc Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 19 Aug 2024 22:40:25 -0700
Subject: [PATCH 1/6] [5.6.1] ; Rename internal variable in erc-fill
* lisp/erc/erc-fill.el (erc--fill-wrap-scrolltobottom-exempt-p):
Rename to `erc-fill--wrap-scrolltobottom-exempt-p' so prefix matches
library and feature.
(erc-fill--wrap-ensure-dependencies): Update variable name.
* lisp/erc/erc-truncate.el (erc-max-buffer-size): Don't mention
`erc-insert-post-hook' in doc string because truncation now happens
elsewhere.
(erc-truncate-buffer-to-size): Update obsolete comment that describes
pre-5.5/Emacs 29 behavior.
* test/lisp/erc/erc-fill-tests.el (erc-fill-tests--wrap-populate):
Update variable name.
* test/lisp/erc/resources/erc-scenarios-common.el
(erc-scenarios-common--make-bindings): Use updated variable name.
(Bug#72736)
---
lisp/erc/erc-fill.el | 4 ++--
lisp/erc/erc-truncate.el | 7 ++-----
test/lisp/erc/erc-fill-tests.el | 2 +-
test/lisp/erc/resources/erc-scenarios-common.el | 2 +-
4 files changed, 6 insertions(+), 9 deletions(-)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index c863d99a339..986314822ba 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -421,7 +421,7 @@ erc-button-mode
(defvar erc-scrolltobottom-mode)
(defvar erc-legacy-invisible-bounds-p)
-(defvar erc--fill-wrap-scrolltobottom-exempt-p nil)
+(defvar erc-fill--wrap-scrolltobottom-exempt-p nil)
(defun erc-fill--wrap-ensure-dependencies ()
(with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
@@ -435,7 +435,7 @@ erc-fill--wrap-ensure-dependencies
(unless erc-fill-mode
(push 'fill missing-deps)
(erc-fill-mode +1))
- (unless (or erc-scrolltobottom-mode erc--fill-wrap-scrolltobottom-exempt-p
+ (unless (or erc-scrolltobottom-mode erc-fill--wrap-scrolltobottom-exempt-p
(memq 'scrolltobottom erc-modules))
(push 'scrolltobottom missing-deps)
(erc-scrolltobottom-mode +1))
diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el
index 4b602074ebb..711a2988302 100644
--- a/lisp/erc/erc-truncate.el
+++ b/lisp/erc/erc-truncate.el
@@ -38,7 +38,7 @@ erc-truncate
(defcustom erc-max-buffer-size 30000
"Maximum size in chars of each ERC buffer.
Used only when auto-truncation is enabled.
-\(see `erc-truncate-buffer' and `erc-insert-post-hook')."
+\(Also see `erc-truncate-buffer'.)"
:type 'integer)
;;;###autoload(autoload 'erc-truncate-mode "erc-truncate" nil t)
@@ -92,10 +92,7 @@ erc-truncate-buffer-to-size
(error "erc-truncate-buffer-to-size: %S is not a buffer" buffer)))
(when (> (buffer-size buffer) (+ size 512))
(with-current-buffer buffer
- ;; Note that when erc-insert-post-hook runs, the buffer is
- ;; narrowed to the new message. So do this delicate widening.
- ;; I am not sure, I think this was not recommended behavior in
- ;; Emacs 20.
+ ;; Though unneeded, widen anyway to preserve pre-5.5 behavior.
(save-restriction
(widen)
(let ((end (- erc-insert-marker size)))
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index f8bfc362085..b52a996f184 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -52,7 +52,7 @@ erc-fill-tests--insert-privmsg
(defun erc-fill-tests--wrap-populate (test)
(let ((original-window-buffer (window-buffer (selected-window)))
- (erc--fill-wrap-scrolltobottom-exempt-p t)
+ (erc-fill--wrap-scrolltobottom-exempt-p t)
(erc-stamp--tz t)
(erc-fill-function 'erc-fill-wrap)
(pre-command-hook pre-command-hook)
diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el
index 0dc82c98d5f..130b0aae109 100644
--- a/test/lisp/erc/resources/erc-scenarios-common.el
+++ b/test/lisp/erc/resources/erc-scenarios-common.el
@@ -150,7 +150,7 @@ erc-scenarios-common--print-trace
(timer-list (copy-sequence timer-list))
(timer-idle-list (copy-sequence timer-idle-list))
(erc-auth-source-parameters-join-function nil)
- (erc--fill-wrap-scrolltobottom-exempt-p t)
+ (erc-fill--wrap-scrolltobottom-exempt-p t)
(erc-autojoin-channels-alist nil)
(erc-server-auto-reconnect nil)
(erc-after-connect nil)
--
2.46.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-5.6.1-Store-one-string-per-user-in-erc-spkr-msg-prop.patch --]
[-- Type: text/x-patch, Size: 11007 bytes --]
From 6d27ebb9f7a9d2786cc9ac0808c71941d2627f6e Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Tue, 6 Aug 2024 19:13:51 -0700
Subject: [PATCH 2/6] [5.6.1] Store one string per user in erc--spkr msg prop
* lisp/erc/erc.el (erc--msg-props): Mention that the `erc--spkr'
msg-prop value is taken from the `nickname' slot of the user's
`erc-server-users' entry.
(erc--speakerize-nick): Avoid using the provided NICK parameter for
the `erc--spkr' property. Instead, use the version from the
`nickname' slot of its `erc-server-users' item, which is itself an
`erc-server-user' object. These text props were originally introduced
in ERC 5.6 as part of bug#67677.
* test/lisp/erc/erc-tests.el (erc--refresh-prompt)
(erc--check-prompt-input-functions, erc-send-current-line)
(erc--check-prompt-input-for-multiline-blanks)
(erc-send-whitespace-lines): Use more convenient helper utility to
create fake server buffer where possible.
(erc--speakerize-nick): New test.
* test/lisp/erc/resources/erc-tests-common.el
(erc-tests-common-make-server-buf): Don't use ERT temp buffer's name
for dialed server, etc., because it contains unwanted chars.
(erc-tests-common-with-process-input-spy): Defer to each test to set
up its own prompt, etc. (Bug#72736)
---
lisp/erc/erc.el | 29 ++++-----
test/lisp/erc/erc-tests.el | 71 ++++++++++++++++++---
test/lisp/erc/resources/erc-tests-common.el | 9 +--
3 files changed, 81 insertions(+), 28 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 5e8fa3051c7..8b3eef94ee4 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -173,7 +173,8 @@ erc--msg-props
and help text, and on outgoing messages unless echoed back by
the server (assuming future support)
- - `erc--spkr': a string, the nick of the person speaking
+ - `erc--spkr': a string, the non-case-mapped nick of the speaker as
+ stored in the `nickname' slot of its `erc-server-users' item
- `erc--ctcp': a CTCP command, like `ACTION'
@@ -6339,20 +6340,18 @@ erc--message-speaker-ctcp-action-statusmsg-input
"Template for a CTCP ACTION status message from current client.")
(defun erc--speakerize-nick (nick &optional disp)
- "Propertize NICK with `erc--speaker' if not already present.
-Do so to DISP instead if it's non-nil. In either case, assign
-NICK, sans properties, as the `erc--speaker' value. As a side
-effect, pair the latter string (the same `eq'-able object) with
-the symbol `erc--spkr' in the \"msg prop\" environment for any
-imminent `erc-display-message' invocations. While doing so,
-include any overrides defined in `erc--message-speaker-catalog'."
- (let ((plain-nick (substring-no-properties nick)))
- (erc--ensure-spkr-prop plain-nick (get erc--message-speaker-catalog
- 'erc--msg-prop-overrides))
- (if (text-property-not-all 0 (length (or disp nick))
- 'erc--speaker nil (or disp nick))
- (or disp nick)
- (propertize (or disp nick) 'erc--speaker plain-nick))))
+ "Return propertized NICK with canonical NICK in `erc--speaker'.
+Return propertized DISP instead if given. As a side effect, pair NICK
+with `erc--spkr' in the \"msg prop\" environment for any imminent
+`erc-display-message' invocations, and include any overrides defined in
+`erc--message-speaker-catalog'. Expect NICK (but not necessarily DISP)
+to be absent of any existing text properties."
+ (when-let ((erc-server-process)
+ (cusr (erc-get-server-user nick)))
+ (setq nick (erc-server-user-nickname cusr)))
+ (erc--ensure-spkr-prop nick (get erc--message-speaker-catalog
+ 'erc--msg-prop-overrides))
+ (propertize (or disp nick) 'erc--speaker nick))
(defun erc--determine-speaker-message-format-args
(nick message queryp privmsgp inputp &optional statusmsg prefix disp-nick)
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index f65c1496087..b11f994bce8 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -330,16 +330,12 @@ erc--refresh-prompt
(ert-info ("Server buffer")
(with-current-buffer (get-buffer-create "ServNet")
- (erc-tests-common-prep-for-insertion)
+ (erc-tests-common-make-server-buf "ServNet")
(goto-char erc-insert-marker)
(should (looking-at-p "ServNet 3>"))
(erc-tests-common-init-server-proc "sleep" "1")
(set-process-sentinel erc-server-process #'ignore)
- (setq erc-network 'ServNet
- erc-server-current-nick "tester"
- erc-networks--id (erc-networks--id-create nil)
- erc-server-users (make-hash-table :test 'equal))
- (set-process-query-on-exit-flag erc-server-process nil)
+ (setq erc-server-current-nick "tester")
;; Incoming message redraws prompt
(erc-display-message nil 'notice nil "Welcome")
(should (looking-at-p (rx "*** Welcome")))
@@ -364,6 +360,8 @@ erc--refresh-prompt
(should-not (search-forward (rx (any "3-5") ">") nil t)))))
(ert-info ("Channel buffer")
+ ;; Create buffer manually instead of using `erc--open-target' in
+ ;; order to show prompt before/after network is known.
(with-current-buffer (get-buffer-create "#chan")
(erc-tests-common-prep-for-insertion)
(goto-char erc-insert-marker)
@@ -1521,6 +1519,7 @@ erc--input-line-delim-regexp
(ert-deftest erc--check-prompt-input-functions ()
(erc-tests-common-with-process-input-spy
(lambda (next)
+ (erc-tests-common-prep-for-insertion)
(ert-info ("Errors when point not in prompt area") ; actually just dings
(insert "/msg #chan hi")
@@ -1556,7 +1555,7 @@ erc--check-prompt-input-functions
(ert-deftest erc-send-current-line ()
(erc-tests-common-with-process-input-spy
(lambda (next)
- (erc-tests-common-init-server-proc "sleep" "1")
+ (erc-tests-common-make-server-buf (buffer-name))
(should (= 0 erc-last-input-time))
(ert-info ("Simple command")
@@ -1639,7 +1638,8 @@ erc--check-prompt-input-for-multiline-blanks
(ert-with-message-capture messages
(erc-tests-common-with-process-input-spy
(lambda (next)
- (erc-tests-common-init-server-proc "sleep" "300")
+ (erc-tests-common-make-server-buf (buffer-name))
+
(should-not erc-send-whitespace-lines)
(should erc-warn-about-blank-lines)
@@ -1717,7 +1717,8 @@ erc--check-prompt-input-for-multiline-blanks/explanations
(ert-deftest erc-send-whitespace-lines ()
(erc-tests-common-with-process-input-spy
(lambda (next)
- (erc-tests-common-init-server-proc "sleep" "1")
+ (erc-tests-common-make-server-buf (buffer-name))
+
(setq-local erc-send-whitespace-lines t)
(ert-info ("Multiline hunk with blank line correctly split")
@@ -2653,6 +2654,58 @@ erc-tests--format-privmessage
(erc--determine-speaker-message-format-args nick msg privp msgp
inputp nil pfx))))
+;; This test demonstrates that ERC uses the same string for the
+;; `erc--spkr' and `erc--speaker' text properties, which it gets from
+;; the `nickname' shot of the speaker's server user.
+(ert-deftest erc--speakerize-nick ()
+ (erc-tests-common-make-server-buf)
+ (setq erc-server-current-nick "tester")
+
+ (let ((sentinel "alice"))
+ (with-current-buffer (erc--open-target "#chan")
+ (erc-update-current-channel-member "bob" "bob" t nil nil nil nil nil
+ "example.org" "~u" "bob")
+ (erc-update-current-channel-member "alice" sentinel t nil nil nil nil nil
+ "fsf.org" "~u" "alice"))
+
+ (erc-call-hooks nil (make-erc-response
+ :sender "alice!~u@fsf.org"
+ :command "PRIVMSG"
+ :command-args '("#chan" "one")
+ :contents "one"
+ :unparsed ":alice!~u@fsf.org PRIVMSG #chan :one"))
+ (erc-call-hooks nil (make-erc-response
+ :sender "bob!~u@example.org"
+ :command "PRIVMSG"
+ :command-args '("#chan" "hi")
+ :contents "hi"
+ :unparsed ":bob!~u@example.org PRIVMSG #chan :hi"))
+ (erc-call-hooks nil (make-erc-response
+ :sender "alice!~u@fsf.org"
+ :command "PRIVMSG"
+ :command-args '("#chan" "two")
+ :contents "two"
+ :unparsed ":alice!~u@fsf.org PRIVMSG #chan :two"))
+
+ (with-current-buffer (get-buffer "#chan")
+ (should (eq sentinel
+ (erc-server-user-nickname (erc-get-server-user "alice"))))
+ (goto-char (point-min))
+
+ (should (search-forward "<a" nil t))
+ (should (looking-at "lice> one"))
+ (should (eq (get-text-property (point) 'erc--speaker) sentinel))
+ (should (eq (erc--get-inserted-msg-prop 'erc--spkr) sentinel))
+
+ (should (search-forward "<bob> hi" nil t))
+
+ (should (search-forward "<a" nil t))
+ (should (looking-at "lice> two"))
+ (should (eq (get-text-property (point) 'erc--speaker) sentinel))
+ (should (eq (erc--get-inserted-msg-prop 'erc--spkr) sentinel))
+
+ (when noninteractive (kill-buffer)))))
+
;; This asserts that `erc--determine-speaker-message-format-args'
;; behaves identically to `erc-format-privmessage', the function whose
;; role it basically replaced.
diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el
index 2ec32db77cd..b5bb1fb09c3 100644
--- a/test/lisp/erc/resources/erc-tests-common.el
+++ b/test/lisp/erc/resources/erc-tests-common.el
@@ -103,16 +103,17 @@ erc-tests-common-with-process-input-spy
(lambda (&rest r) (push r calls)))
((symbol-function 'erc-server-buffer)
(lambda () (current-buffer))))
- (erc-tests-common-prep-for-insertion)
(funcall test-fn (lambda () (pop calls)))))
(when noninteractive (kill-buffer))))
(defun erc-tests-common-make-server-buf (&optional name)
"Return a server buffer named NAME, creating it if necessary.
Use NAME for the network and the session server as well."
- (unless name
- (cl-assert (string-prefix-p " *temp*" (setq name (buffer-name)))))
- (with-current-buffer (get-buffer-create name)
+ (with-current-buffer (if name
+ (get-buffer-create name)
+ (and (string-search "temp" (buffer-name))
+ (setq name "foonet")
+ (buffer-name)))
(erc-tests-common-prep-for-insertion)
(erc-tests-common-init-server-proc "sleep" "1")
(setq erc-session-server (concat "irc." name ".org")
--
2.46.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-5.6.1-Bind-current-erc-response-around-all-handlers.patch --]
[-- Type: text/x-patch, Size: 1730 bytes --]
From 29fbad881e33d56e76c9fb0fb8b9a07037dfcc2e Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 18 Aug 2024 23:50:58 -0700
Subject: [PATCH 3/6] [5.6.1] Bind current erc-response around all handlers
* lisp/erc/erc-backend.el (erc--parsed-response): New variable to be
the internal version of the ancient `erc-message-parsed', which is
only available during `erc-display-message', and therefore of somewhat
limited utility.
(erc-call-hooks): Bind `erc--parsed-response' to the parsed
`erc-response' object for the duration of its handling. Bind
`erc--msg-prop-overrides' around all hooks to allow response handlers
to influence inserted msg props for any `erc-display-message' calls.
(Bug#72736)
---
lisp/erc/erc-backend.el | 6 +++++-
1 file changed, 5 insertions(+), 1 deletion(-)
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 9aedc110067..d999cf57db8 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -1534,11 +1534,15 @@ erc-get-hook
(gethash (format (if (numberp command) "%03i" "%s") command)
erc-server-responses))
+(defvar erc--parsed-response nil)
+
(defun erc-call-hooks (process message)
"Call hooks associated with MESSAGE in PROCESS.
Finds hooks by looking in the `erc-server-responses' hash table."
- (let ((hook (or (erc-get-hook (erc-response.command message))
+ (let ((erc--parsed-response message)
+ (erc--msg-prop-overrides erc--msg-prop-overrides)
+ (hook (or (erc-get-hook (erc-response.command message))
'erc-default-server-functions)))
(run-hook-with-args-until-success hook process message)
;; Some handlers, like `erc-cmd-JOIN', open new targets without
--
2.46.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0004-5.6.1-Fix-inconsistent-handling-of-ban-lists-in-ERC.patch --]
[-- Type: text/x-patch, Size: 19246 bytes --]
From 9bb1ca1f792863642e2a043822303c1f03b474e1 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 18 Aug 2024 22:58:11 -0700
Subject: [PATCH 4/6] [5.6.1] Fix inconsistent handling of ban lists in ERC
* etc/ERC-NEWS: Mention new function `erc-sync-banlist' in new section
for ERC 5.6.1.
* lisp/erc/erc-backend.el (erc-server-MODE): Don't call
`erc-banlist-update'.
* lisp/erc/erc-fill.el (erc--determine-fill-column-function): New
method for `fill' and `fill-wrap' modules.
* lisp/erc/erc-pcomplete.el (pcomplete/erc-mode/BANLIST)
(pcomplete/erc-mode/BL)
(pcomplete/erc-mode/MASSUNBAN, pcomplete/erc-mode/MUB):
New functions.
* lisp/erc/erc.el (erc-channel-banlist): Deprecate practice of using
the symbol-property `received-from-server' of as a state flag because
it's error-prone and bleeds into other connections.
(erc--channel-banlist-synchronized-p): New variable to indicate
whether the ban list has been initialized. The presence of a local
binding for `erc-channel-banlist' could probably be used for the same
purpose but would surely require rewriting `erc-cmd-BANLIST' and
`erc-cmd-MASSUNBAN'.
(erc-sync-banlist): New function, announced in ERC-NEWS.
(erc--wrap-banlist): New function.
(erc-banlist-fill-padding): New variable.
(erc--determine-fill-column-function): New generic function.
(erc-cmd-BANLIST): Move forward declaration of `erc-fill-column' from
top level into function body. Always reset `received-from-server' to
nil. Improve column calculations.
(erc-cmd-MASSUNBAN): Always reset `received-from-server' to nil.
(erc-banlist-finished): Deprecate function unused since 2003.
(erc--banlist-update): New function.
(erc-banlist-update): Deprecate function because its logic is faulty
and it doesn't handle mixed mode letters, like "MODE #foobar
+mb *@127.0.0.1". See https://modern.ircdocs.horse/#mode-message. It
also depends on an obsolete convention regarding the symbol property
`received-from-server' of `erc-channel-banlist'. Basically, this
function used to run upon receipt of any "MODE" command from the
server. However, actual updates to the variable `erc-channel-banlist'
only happened if `received-from-server' was t, which could only be the
case after the user issued a /MASSUNBAN. And that behavior was
determined to be a bug. This mode framework stuff was introduced as
part of bug#67220 for ERC 5.6.
(erc--handle-channel-mode): New method.
* test/lisp/erc/erc-tests.el (erc--channel-modes)
(erc--channel-modes/graphic-p): Assert contents of
`erc-channel-banlist' updated on "MODE". (Bug#72736)
---
etc/ERC-NEWS | 9 ++
lisp/erc/erc-backend.el | 4 +-
lisp/erc/erc-fill.el | 6 ++
lisp/erc/erc-pcomplete.el | 8 ++
lisp/erc/erc.el | 212 +++++++++++++++++++++----------------
test/lisp/erc/erc-tests.el | 19 +++-
6 files changed, 160 insertions(+), 98 deletions(-)
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 9803c3ff379..0b5385f0589 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -11,6 +11,15 @@ This file is about changes in ERC, the powerful, modular, and
extensible IRC (Internet Relay Chat) client distributed with
GNU Emacs since Emacs version 22.1.
+\f
+* Changes in ERC 5.6.1
+
+** Reliable library access for ban lists.
+Say goodbye to continually running "/BANLIST" for programmatic
+purposes. Modules can instead use the function 'erc-sync-banlist' to
+guarantee that the variable 'erc-channel-banlist' remains synced for
+the remainder of an IRC session.
+
\f
* Changes in ERC 5.6
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index d999cf57db8..16e8cae4733 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -1851,8 +1851,8 @@ erc--server-determine-join-display-context
?t tgt ?m mode)
(erc-display-message parsed 'notice buf
'MODE ?n nick ?u login
- ?h host ?t tgt ?m mode)))
- (erc-banlist-update proc parsed))))
+ ?h host ?t tgt ?m mode)))))
+ nil)
(defun erc--wrangle-query-buffers-on-nick-change (old new)
"Create or reuse a query buffer for NEW nick after considering OLD nick.
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 986314822ba..fa9d2071ccd 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -896,6 +896,12 @@ erc-timestamp-offset
(length (format-time-string erc-timestamp-format))
0))
+(cl-defmethod erc--determine-fill-column-function
+ (&context (erc-fill-mode (eql t)))
+ (if erc-fill-wrap-mode
+ (- (window-width) erc-fill--wrap-value 1)
+ erc-fill-column))
+
(provide 'erc-fill)
;;; erc-fill.el ends here
diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el
index 05cbaf3872f..afbe3895667 100644
--- a/lisp/erc/erc-pcomplete.el
+++ b/lisp/erc/erc-pcomplete.el
@@ -187,6 +187,14 @@ pcomplete/erc-mode/RECONNECT
(pcomplete-here '("cancel"))
(pcomplete-opt "a"))
+(defun pcomplete/erc-mode/BANLIST ()
+ (pcomplete-opt "f"))
+(defalias 'pcomplete/erc-mode/BL #'pcomplete/erc-mode/BANLIST)
+
+(defun pcomplete/erc-mode/MASSUNBAN ()
+ (pcomplete-opt "f"))
+(defalias 'pcomplete/erc-mode/MUB #'pcomplete/erc-mode/MASSUNBAN)
+
;;; Functions that provide possible completions.
(defun pcomplete-erc-commands ()
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 8b3eef94ee4..52ec4d23dd7 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -5555,109 +5555,117 @@ erc-cmd-CLEARTOPIC
(defvar-local erc-channel-banlist nil
"A list of bans seen for the current channel.
-
-Each ban is an alist of the form:
- (WHOSET . MASK)
-
-The property `received-from-server' indicates whether
-or not the ban list has been requested from the server.")
+Entries are cons cells of the form (OP . MASK), where OP is the channel
+operator who issued the ban. Modules needing such a list should call
+`erc-sync-banlist' once per session in the channel before accessing the
+variable. Interactive users need only issue a /BANLIST. Note that
+older versions of ERC relied on a deprecated convention involving a
+property of the symbol `erc-channel-banlist' to indicate whether a ban
+list had been received in full; this was found to be unreliable.")
(put 'erc-channel-banlist 'received-from-server nil)
-(defvar erc-fill-column)
-
-(defun erc-cmd-BANLIST ()
- "Pretty-print the contents of `erc-channel-banlist'.
-
-The ban list is fetched from the server if necessary."
- (let ((chnl (erc-default-target))
- (chnl-name (buffer-name)))
-
- (cond
- ((not (erc-channel-p chnl))
- (erc-display-message nil 'notice 'active "You're not on a channel\n"))
-
- ((not (get 'erc-channel-banlist 'received-from-server))
- (let ((old-367-hook erc-server-367-functions))
- (setq erc-server-367-functions 'erc-banlist-store
- erc-channel-banlist nil)
- ;; fetch the ban list then callback
- (erc-with-server-buffer
- (erc-once-with-server-event
- 368
- (lambda (_proc _parsed)
- (with-current-buffer chnl-name
- (put 'erc-channel-banlist 'received-from-server t)
- (setq erc-server-367-functions old-367-hook)
- (erc-cmd-BANLIST)
- t)))
- (erc-server-send (format "MODE %s b" chnl)))))
-
- ((null erc-channel-banlist)
- (erc-display-message nil 'notice 'active
- (format "No bans for channel: %s\n" chnl))
+(defvar-local erc--channel-banlist-synchronized-p nil
+ "Whether the full channel ban list has been fetched since joining.")
+
+(defun erc-sync-banlist (&optional done-fn)
+ "Initialize syncing of current channel's `erc-channel-banlist'.
+Arrange for it to remain synced for the rest of the IRC session. When
+DONE-FN is non-nil, call it with no args once fully updated. Expect it
+to return non-nil, if necessary, to inhibit further processing."
+ (unless (erc-channel-p (current-buffer))
+ (error "Not a channel buffer"))
+ (let ((channel (erc-target))
+ (buffer (current-buffer))
+ (hook (lambda (&rest r) (apply #'erc-banlist-store r) t)))
+ (setq erc-channel-banlist nil)
+ (erc-with-server-buffer
+ (add-hook 'erc-server-367-functions hook -98 t)
+ (erc-once-with-server-event
+ 368 (lambda (&rest _)
+ (remove-hook 'erc-server-367-functions hook t)
+ (with-current-buffer buffer
+ (prog1 (if done-fn (funcall done-fn) t)
+ (setq erc--channel-banlist-synchronized-p t)))))
+ (erc-server-send (format "MODE %s b" channel)))))
+
+(defun erc--wrap-banlist-cmd (slashcmd)
+ (lambda ()
+ (put 'erc-channel-banlist 'received-from-server t)
+ (unwind-protect (funcall slashcmd)
(put 'erc-channel-banlist 'received-from-server nil))
+ t))
- (t
- (let* ((erc-fill-column (or (and (boundp 'erc-fill-column)
- erc-fill-column)
- (and (boundp 'fill-column)
- fill-column)
- (1- (window-width))))
- (separator (make-string erc-fill-column ?=))
- (fmt (concat
- "%-" (number-to-string (/ erc-fill-column 2)) "s"
- "%" (number-to-string (/ erc-fill-column 2)) "s")))
+(defvar erc-banlist-fill-padding 1.0
+ "Scaling factor from 0 to 1 of free space between entries, if any.")
- (erc-display-message
- nil 'notice 'active
- (format "Ban list for channel: %s\n" (erc-default-target)))
-
- (erc-display-line separator 'active)
- (erc-display-line (format fmt "Ban Mask" "Banned By") 'active)
- (erc-display-line separator 'active)
-
- (mapc
- (lambda (x)
- (erc-display-line
- (format fmt
- (truncate-string-to-width (cdr x) (/ erc-fill-column 2))
- (if (car x)
- (truncate-string-to-width (car x) (/ erc-fill-column 2))
- ""))
- 'active))
- erc-channel-banlist)
-
- (erc-display-message nil 'notice 'active "End of Ban list")
- (put 'erc-channel-banlist 'received-from-server nil)))))
+(cl-defgeneric erc--determine-fill-column-function ()
+ fill-column)
+
+(defun erc-cmd-BANLIST (&rest args)
+ "Print the list of ban masks for the current channel.
+When uninitialized or with option -f, resync `erc-channel-banlist'."
+ (cond
+ ((not (erc-channel-p (current-buffer)))
+ (erc-display-message nil 'notice 'active "You're not on a channel\n"))
+ ((or (equal args '("-f"))
+ (and (not erc--channel-banlist-synchronized-p)
+ (not (get 'erc-channel-banlist 'received-from-server))))
+ (erc-sync-banlist (erc--wrap-banlist-cmd #'erc-cmd-BANLIST)))
+ ((null erc-channel-banlist)
+ (erc-display-message nil 'notice 'active
+ (format "No bans for channel: %s\n" (erc-target))))
+ ((let ((max-width (erc--determine-fill-column-function))
+ (lw 0) (rw 0) separator fmt)
+ (dolist (entry erc-channel-banlist)
+ (setq rw (max (length (car entry)) rw)
+ lw (max (length (cdr entry)) lw)))
+ (let ((maxw (* 1.0 (min max-width (+ rw lw)))))
+ (when (< maxw (+ rw lw)) ; scale down when capped
+ (cl-psetq rw (/ (* rw maxw) (* 1.0 (+ rw lw)))
+ lw (/ (* lw maxw) (* 1.0 (+ rw lw)))))
+ (when-let ((larger (max rw lw)) ; cap ratio at 3:1
+ (wavg (* maxw 0.75))
+ ((> larger wavg)))
+ (setq rw (if (eql larger rw) wavg (- maxw wavg))
+ lw (- maxw rw)))
+ (cl-psetq rw (+ rw (* erc-banlist-fill-padding
+ (- (/ (* rw max-width) maxw) rw)))
+ lw (+ lw (* erc-banlist-fill-padding
+ (- (/ (* lw max-width) maxw) lw)))))
+ (setq rw (truncate rw)
+ lw (truncate lw))
+ (cl-assert (<= (+ rw lw) max-width))
+ (setq separator (make-string (+ rw lw 1) ?=)
+ fmt (concat "%-" (number-to-string lw) "s "
+ "%" (number-to-string rw) "s"))
+ (erc-display-message
+ nil 'notice 'active
+ (format "Ban list for channel: %s%s\n" (erc-target)
+ (if erc--channel-banlist-synchronized-p " (cached)" "")))
+ (erc-display-line separator 'active)
+ (erc-display-line (format fmt "Ban Mask" "Banned By") 'active)
+ (erc-display-line separator 'active)
+ (dolist (entry erc-channel-banlist)
+ (erc-display-line
+ (format fmt (truncate-string-to-width (cdr entry) lw)
+ (truncate-string-to-width (car entry) rw))
+ 'active))
+ (erc-display-message nil 'notice 'active "End of Ban list"))))
+ (put 'erc-channel-banlist 'received-from-server nil)
t)
(defalias 'erc-cmd-BL #'erc-cmd-BANLIST)
-(defun erc-cmd-MASSUNBAN ()
- "Mass Unban.
-
-Unban all currently banned users in the current channel."
+(defun erc-cmd-MASSUNBAN (&rest args)
+ "Remove all bans in the current channel."
(let ((chnl (erc-default-target)))
(cond
-
((not (erc-channel-p chnl))
(erc-display-message nil 'notice 'active "You're not on a channel\n"))
-
- ((not (get 'erc-channel-banlist 'received-from-server))
- (let ((old-367-hook erc-server-367-functions))
- (setq erc-server-367-functions 'erc-banlist-store)
- ;; fetch the ban list then callback
- (erc-with-server-buffer
- (erc-once-with-server-event
- 368
- (lambda (_proc _parsed)
- (with-current-buffer chnl
- (put 'erc-channel-banlist 'received-from-server t)
- (setq erc-server-367-functions old-367-hook)
- (erc-cmd-MASSUNBAN)
- t)))
- (erc-server-send (format "MODE %s b" chnl)))))
-
+ ((or (equal args '("-f"))
+ (and (not erc--channel-banlist-synchronized-p)
+ (not (get 'erc-channel-banlist 'received-from-server))))
+ (erc-sync-banlist (erc--wrap-banlist-cmd #'erc-cmd-MASSUNBAN)))
(t (let ((bans (mapcar #'cdr erc-channel-banlist)))
(when bans
;; Glob the bans into groups of three, and carry out the unban.
@@ -5668,8 +5676,9 @@ erc-cmd-MASSUNBAN
(format "MODE %s -%s %s" (erc-default-target)
(make-string (length x) ?b)
(mapconcat #'identity x " "))))
- (erc-group-list bans 3))))
- t))))
+ (erc-group-list bans 3))))))
+ (put 'erc-channel-banlist 'received-from-server nil)
+ t))
(defalias 'erc-cmd-MUB #'erc-cmd-MASSUNBAN)
@@ -6639,17 +6648,31 @@ erc-banlist-store
erc-channel-banlist))))))
nil)
+;; This was a default member of `erc-server-368-functions' (nee -hook)
+;; between January and June of 2003 (but not as part of any release).
(defun erc-banlist-finished (proc parsed)
"Record that we have received the banlist."
+ (declare (obsolete "uses obsolete and likely faulty logic" "31.1"))
(let* ((channel (nth 1 (erc-response.command-args parsed)))
(buffer (erc-get-buffer channel proc)))
(with-current-buffer buffer
(put 'erc-channel-banlist 'received-from-server t)))
t) ; suppress the 'end of banlist' message
+(defun erc--banlist-update (statep mask)
+ "Add or remove a mask from `erc-channel-banlist'."
+ (if statep
+ (let ((whoset (erc-response.sender erc--parsed-response)))
+ (cl-pushnew (cons whoset mask) erc-channel-banlist :test #'equal))
+ (let ((upcased (upcase mask)))
+ (setq erc-channel-banlist
+ (cl-delete-if (lambda (y) (equal (upcase (cdr y)) upcased))
+ erc-channel-banlist)))))
+
(defun erc-banlist-update (proc parsed)
"Check MODE commands for bans and update the banlist appropriately."
;; FIXME: Possibly incorrect. -- Lawrence 2004-05-11
+ (declare (obsolete "continual syncing via `erc--banlist-update'" "31.1"))
(let* ((tgt (car (erc-response.command-args parsed)))
(mode (erc-response.contents parsed))
(whoset (erc-response.sender parsed))
@@ -7732,6 +7755,11 @@ erc--handle-channel-mode
(cl-pushnew (char-to-string c) erc-channel-modes :test #'equal)
(delete (char-to-string c) erc-channel-modes))))
+;; We could specialize on type A, but that may be too brittle.
+(cl-defmethod erc--handle-channel-mode (_ (_ (eql ?b)) state arg)
+ "Update `erc-channel-banlist' when synchronized."
+ (when erc--channel-banlist-synchronized-p (erc--banlist-update state arg)))
+
;; We could specialize on type C, but that may be too brittle.
(cl-defmethod erc--handle-channel-mode (_ (_ (eql ?l)) state arg)
"Update channel user limit, remembering ARG when STATE is non-nil."
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index b11f994bce8..72ea11aeba1 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -929,13 +929,19 @@ erc--channel-modes
(setq erc--isupport-params (make-hash-table)
erc--target (erc--target-from-string "#test")
+ erc--channel-banlist-synchronized-p t
erc-server-parameters
'(("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz")))
(erc-tests-common-init-server-proc "sleep" "1")
- (cl-letf (((symbol-function 'erc-update-mode-line) #'ignore))
- (erc--update-channel-modes "+bltk" "fool!*@*" "3" "h2"))
+ (cl-letf ((erc--parsed-response (make-erc-response
+ :sender "chop!~u@gnu.org"))
+ ((symbol-function 'erc-update-mode-line) #'ignore))
+ (should-not erc-channel-banlist)
+ (erc--update-channel-modes "+bbltk" "fool!*@*" "spam!*@*" "3" "h2")
+ (should (equal erc-channel-banlist '(("chop!~u@gnu.org" . "spam!*@*")
+ ("chop!~u@gnu.org" . "fool!*@*")))))
(should (equal (erc--channel-modes 'string) "klt"))
(should (equal (erc--channel-modes 'strings) '("k" "l" "t")))
@@ -980,11 +986,16 @@ erc--channel-modes/graphic-p
(erc-tests-common-init-server-proc "sleep" "1")
(setq erc--isupport-params (make-hash-table)
erc--target (erc--target-from-string "#test")
+ erc--channel-banlist-synchronized-p t
erc-server-parameters
'(("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz")))
- (cl-letf (((symbol-function 'erc-update-mode-line) #'ignore))
- (erc--update-channel-modes "+bltk" "fool!*@*" "3" "hun2"))
+ (cl-letf ((erc--parsed-response (make-erc-response
+ :sender "chop!~u@gnu.org"))
+ ((symbol-function 'erc-update-mode-line) #'ignore))
+ (should-not erc-channel-banlist)
+ (erc--update-channel-modes "+bltk" "fool!*@*" "3" "hun2")
+ (should (equal erc-channel-banlist '(("chop!~u@gnu.org" . "fool!*@*")))))
;; Truncation cache populated and used.
(let ((cache (erc--channel-mode-types-shortargs erc--channel-mode-types))
--
2.46.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #7: 0005-5.6.1-Fix-overlooked-case-in-erc-get-inserted-msg-be.patch --]
[-- Type: text/x-patch, Size: 4959 bytes --]
From eec711c9df63415aaeaaa3382eb2a89b1e59e53d Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Tue, 27 Aug 2024 23:05:35 -0700
Subject: [PATCH 5/6] [5.6.1] Fix overlooked case in
erc--get-inserted-msg-beg-at
* lisp/erc/erc.el (erc--get-inserted-msg-beg-at): Account for the start
of a props header being `bobp' when searching backwards.
(erc--get-inserted-msg-prop): Add optional `point' parameter.
* test/lisp/erc/erc-goodies-tests.el
(erc--get-inserted-msg-beg/truncated/readonly): New test.
* test/lisp/erc/erc-tests.el (erc--get-inserted-msg-beg/truncated): New
test.
* test/lisp/erc/resources/erc-tests-common.el
(erc-tests-common-assert-get-inserted-msg/truncated): New test helper.
(Bug#72736)
---
lisp/erc/erc.el | 16 ++++++++++------
test/lisp/erc/erc-goodies-tests.el | 5 +++++
test/lisp/erc/erc-tests.el | 4 ++++
test/lisp/erc/resources/erc-tests-common.el | 7 +++++++
4 files changed, 26 insertions(+), 6 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 52ec4d23dd7..7d006db69a6 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -3323,10 +3323,14 @@ erc--get-inserted-msg-beg-at
(macroexp-let2* nil ((point point)
(at-start-p at-start-p))
`(or (and ,at-start-p ,point)
- (and-let* ((p (previous-single-property-change ,point 'erc--msg)))
- (if (and (= p (1- ,point)) (get-text-property p 'erc--msg))
- p
- (1- p))))))
+ (let ((p (previous-single-property-change ,point 'erc--msg)))
+ (cond
+ ((and p (= p (1- ,point)) (get-text-property p 'erc--msg)) p)
+ (p (1- p))
+ ((and (null p)
+ (> ,point (point-min))
+ (get-text-property (1- point) 'erc--msg))
+ (1- point)))))))
(defmacro erc--get-inserted-msg-end-at (point at-start-p)
(macroexp-let2 nil point point
@@ -3355,9 +3359,9 @@ erc--get-inserted-msg-bounds
(and-let* ((b (erc--get-inserted-msg-beg-at point at-start-p)))
(cons b (erc--get-inserted-msg-end-at point at-start-p)))))
-(defun erc--get-inserted-msg-prop (prop)
+(defun erc--get-inserted-msg-prop (prop &optional point)
"Return the value of text property PROP for some message at point."
- (and-let* ((stack-pos (erc--get-inserted-msg-beg (point))))
+ (and-let* ((stack-pos (erc--get-inserted-msg-beg (or point (point)))))
(get-text-property stack-pos prop)))
;; FIXME improve this nascent "message splicing" facility to include a
diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el
index 038434b3880..1d74025c5ce 100644
--- a/test/lisp/erc/erc-goodies-tests.el
+++ b/test/lisp/erc/erc-goodies-tests.el
@@ -597,6 +597,11 @@ erc--get-inserted-msg-beg/readonly
#'erc-tests-common-assert-get-inserted-msg/basic
(lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg))))))
+(ert-deftest erc--get-inserted-msg-beg/truncated/readonly ()
+ (erc-tests-common-assert-get-inserted-msg-readonly-with
+ #'erc-tests-common-assert-get-inserted-msg/truncated
+ (lambda (arg) (should (= 1 (erc--get-inserted-msg-beg arg))))))
+
(ert-deftest erc--get-inserted-msg-end/readonly ()
(erc-tests-common-assert-get-inserted-msg-readonly-with
#'erc-tests-common-assert-get-inserted-msg/basic
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 72ea11aeba1..eddb3a5b2c8 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1934,6 +1934,10 @@ erc--get-inserted-msg-beg/basic
(erc-tests-common-assert-get-inserted-msg/basic
(lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg))))))
+(ert-deftest erc--get-inserted-msg-beg/truncated ()
+ (erc-tests-common-assert-get-inserted-msg/truncated
+ (lambda (arg) (should (= 1 (erc--get-inserted-msg-beg arg))))))
+
(ert-deftest erc--get-inserted-msg-end/basic ()
(erc-tests-common-assert-get-inserted-msg/basic
(lambda (arg) (should (= 11 (erc--get-inserted-msg-end arg))))))
diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el
index b5bb1fb09c3..1cd54a1f715 100644
--- a/test/lisp/erc/resources/erc-tests-common.el
+++ b/test/lisp/erc/resources/erc-tests-common.el
@@ -184,6 +184,13 @@ erc-tests-common-assert-get-inserted-msg/basic
(should (looking-back "<bob> hi"))
(erc-tests-common-assert-get-inserted-msg 3 11 test-fn))
+(defun erc-tests-common-assert-get-inserted-msg/truncated (test-fn)
+ (erc-tests-common-get-inserted-msg-setup)
+ (with-silent-modifications (delete-region 1 3))
+ (goto-char 9)
+ (should (looking-back "<bob> hi"))
+ (erc-tests-common-assert-get-inserted-msg 1 9 test-fn))
+
;; This is a "mixin" and requires a base assertion function, like
;; `erc-tests-common-assert-get-inserted-msg/basic', to work.
(defun erc-tests-common-assert-get-inserted-msg-readonly-with
--
2.46.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #8: 0006-5.6.1-Redo-ERC-truncation-and-CLEAR-hook-mechanism.patch --]
[-- Type: text/x-patch, Size: 27252 bytes --]
From 5297613ac24bfbee5ed43f01875c08c147b7f618 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Tue, 27 Aug 2024 01:00:04 -0700
Subject: [PATCH 6/6] [5.6.1] Redo ERC truncation and /CLEAR hook mechanism
* lisp/erc/erc-fill.el (erc-fill-wrap-mode, erc-fill-wrap-enable):
Add right-stamp rewriter to `erc--clear-function' advice stack.
(erc-fill-wrap-disable): Remove right-stamp rewriter.
* lisp/erc/erc-log.el (erc-log-mode, erc-log-enable): Don't add
`erc-save-buffer-in-logs' to `erc--pre-clear-functions'. Use local
advice instead, as noted below.
(erc-log-disable): Don't remove `erc-save-buffer-in-logs' from
`erc--pre-clear-functions'.
(erc-log-setup-logging): Add `erc-log--save-on-clear' to
`erc--clear-function'.
(erc-log-disable-logging): Remove `erc-log--save-on-clear' to
`erc-clear-function'.
(erc-log--save-on-clear): New function, a thin wrapper around
`erc-save-buffer-in-logs', adapting it to the `erc--clear-function'
advice interface.
* lisp/erc/erc-stamp.el (erc-stamp-mode, erc-stamp-enable): Don't
add `erc-stamp--reset-on-clear' to `erc--pre-clear-functions'.
(erc-stamp-disable): Don't remove `erc-stamp--reset-on-clear' from
`erc--pre-clear-functions'.
(erc-stamp--find-insertion-point): Account for initial position being
`bobp'.
(erc-stamp--defer-date-insertion-on-post-modify): Accommodate the rare
non-list `erc-insert-post-hook' when shadowing.
(erc-stamp--setup): Add and remove `erc-stamp--reset-on-clear' to and
from `erc--clear-function' advice stack.
(erc-stamp--redo-right-stamp-post-clear): New function.
(erc-stamp--update-saved-position): Remove unused function. This was
originally added along with `erc-stamp--reset-on-clear' as part of
bug#60936.
(erc-stamp--reset-on-clear): Expect end of truncation boundary to be at
`erc-insert-marker'. Rework to use new `erc--clear-function' interface
and run on `erc-timer-hook' instead of `erc-insert-done-hook'.
* lisp/erc/erc-truncate.el (erc-truncate-enable, erc-truncate-disable):
Add and remove `erc-truncate--setup' to and from `erc-mode-hook', and
run it when needed.
(erc-truncate--buffer-size): New variable.
(erc-truncate--setup): New function.
(erc-scenarios-log--truncate): Guard execution with
`erc-truncate--buffer-size' and `erc--inhibit-clear-p'. Reflow for
readability. Call hooks with marker instead of buffer position, as per
the new `erc--clear-function' interface.
(erc-truncate-buffer): Defer execution to `erc-timer-hook' when running
post-insertion via a response handler.
(erc-truncate--inhibit-when-local-and-interactive): New function.
* lisp/erc/erc.el (erc-mode): Add `erc--skip-past-headroom-on-clear'
to `erc--clear-function' advice stack in all ERC buffers.
(erc--with-spliced-insertion): Account for marker being `bobp'.
(erc--insert-before-markers-transplanting-hidden): Make more robust by
accommodating initial `point' being `bobp'.
(erc--clear-function): New variable, a function-valued local-advice
interface to replace `erc--pre-clear-functions'.
(erc--pre-clear-functions): Remove unused variable.
(erc--skip-past-headroom-on-clear): New function.
(erc--inhibit-clear-p): New variable.
(erc-cmd-CLEAR): Call hooks with markers instead of position. When
called interactively or `point' is at prompt, don't exempt the final
newline in what gets truncated.
* test/lisp/erc/erc-scenarios-log.el (erc-scenarios-log--clear-stamp)
(erc-scenarios-log--truncate): Update assertions. (Bug#72736)
---
lisp/erc/erc-fill.el | 4 ++
lisp/erc/erc-log.el | 10 ++-
lisp/erc/erc-stamp.el | 101 ++++++++++++++++++++++-------
lisp/erc/erc-truncate.el | 96 +++++++++++++++++----------
lisp/erc/erc.el | 42 ++++++++----
test/lisp/erc/erc-scenarios-log.el | 22 ++++---
6 files changed, 196 insertions(+), 79 deletions(-)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index fa9d2071ccd..6f3d51f6937 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -547,6 +547,8 @@ fill-wrap
(when erc-fill-wrap-merge
(add-hook 'erc-button--prev-next-predicate-functions
#'erc-fill--wrap-merged-button-p nil t))
+ (add-function :after (local 'erc--clear-function)
+ #'erc-stamp--redo-right-stamp-post-clear '((depth . 50)))
(erc-stamp--display-margin-mode +1)
(visual-line-mode +1))
((visual-line-mode -1)
@@ -557,6 +559,8 @@ fill-wrap
(kill-local-variable 'erc-fill--wrap-last-msg)
(kill-local-variable 'erc--inhibit-prompt-display-property-p)
(kill-local-variable 'erc-fill--wrap-merge-indicator-pre)
+ (remove-function (local 'erc--clear-function)
+ #'erc-stamp--redo-right-stamp-post-clear)
(remove-hook 'erc--refresh-prompt-hook
#'erc-fill--wrap-indent-prompt t)
(remove-hook 'erc-button--prev-next-predicate-functions
diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el
index 66420662c23..6bb240f56d7 100644
--- a/lisp/erc/erc-log.el
+++ b/lisp/erc/erc-log.el
@@ -231,7 +231,7 @@ log
(add-hook 'erc-part-hook #'erc-conditional-save-buffer)
;; append, so that 'erc-initialize-log-marker runs first
(add-hook 'erc-connect-pre-hook #'erc-log-setup-logging 'append)
- (add-hook 'erc--pre-clear-functions #'erc-save-buffer-in-logs 50)
+ ;; FIXME use proper local "setup" function and major-mode hook.
(dolist (buffer (erc-buffer-list))
(erc-log-setup-logging buffer))
(erc--modify-local-map t "C-c C-l" #'erc-save-buffer-in-logs))
@@ -244,7 +244,6 @@ log
(remove-hook 'erc-quit-hook #'erc-conditional-save-queries)
(remove-hook 'erc-part-hook #'erc-conditional-save-buffer)
(remove-hook 'erc-connect-pre-hook #'erc-log-setup-logging)
- (remove-hook 'erc--pre-clear-functions #'erc-save-buffer-in-logs)
(dolist (buffer (erc-buffer-list))
(erc-log-disable-logging buffer))
(erc--modify-local-map nil "C-c C-l" #'erc-save-buffer-in-logs)))
@@ -259,6 +258,8 @@ erc-log-setup-logging
(auto-save-mode -1)
(setq buffer-file-name nil)
(add-hook 'write-file-functions #'erc-save-buffer-in-logs nil t)
+ (add-function :before (local 'erc--clear-function)
+ #'erc-log--save-on-clear '((depth . 50)))
(when erc-log-insert-log-on-open
(ignore-errors
(save-excursion
@@ -271,6 +272,7 @@ erc-log-disable-logging
"Disable logging in BUFFER."
(when (erc-logging-enabled buffer)
(with-current-buffer buffer
+ (remove-function (local 'erc--clear-function) #'erc-log--save-on-clear)
(setq buffer-offer-save nil
erc-enable-logging nil))))
@@ -415,6 +417,7 @@ erc-save-buffer-in-logs
(widen)
;; early on in the initialization, don't try and write the log out
(when (and (markerp erc-last-saved-position)
+ (null erc--insert-marker) ; suppress when splicing
(> erc-insert-marker (1+ erc-last-saved-position)))
(let ((start (1+ (marker-position erc-last-saved-position)))
(end (marker-position erc-insert-marker)))
@@ -446,6 +449,9 @@ erc-save-buffer-in-logs
(set-buffer-modified-p nil))))))
t)
+(defun erc-log--save-on-clear (_ end)
+ (erc-save-buffer-in-logs end))
+
;; This is a kludge to avoid littering erc-truncate.el with forward
;; declarations needed only for a corner-case compatibility check.
(defun erc-log--call-when-logging-enabled-sans-module (fn)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index bebc1d0be38..7d773c8f4b2 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -182,13 +182,11 @@ stamp
(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)
- (add-hook 'erc--pre-clear-functions #'erc-stamp--reset-on-clear 40)
(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)
(remove-hook 'erc-send-modify-hook #'erc-add-timestamp)
(remove-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect)
- (remove-hook 'erc--pre-clear-functions #'erc-stamp--reset-on-clear)
(erc-buffer-do #'erc-stamp--setup)))
(defvar erc-stamp--invisible-property nil
@@ -707,7 +705,8 @@ erc-stamp--find-insertion-point
;; Continue searching after encountering a message without a
;; timestamp because date stamps must be unique, and
;; "Re-establishing connection" messages should have stamps.
- (while-let ((q (previous-single-property-change (1- p) 'erc--ts))
+ (while-let ((pp (max (1- p) (point-min)))
+ (q (previous-single-property-change pp 'erc--ts))
(qq (erc--get-inserted-msg-beg q))
(ts (get-text-property qq 'erc--ts))
((not (time-less-p ts target-time))))
@@ -753,7 +752,7 @@ erc-stamp--defer-date-insertion-on-post-modify
(set-marker marker (point-min))
(set-marker-insertion-type marker t)
(erc--hide-message 'timestamp))
- ,@erc-insert-post-hook))
+ ,@(ensure-list erc-insert-post-hook)))
(erc-insert-timestamp-function
#'erc-stamp--propertize-left-date-stamp)
(pos (erc-stamp--find-insertion-point marker aligned))
@@ -980,11 +979,16 @@ erc-stamp--add-csf-on-post-modify
(defun erc-stamp--setup ()
"Enable or disable buffer-local `erc-stamp-mode' modifications."
(if erc-stamp-mode
- (erc-stamp--manage-local-options-state)
+ (progn
+ (erc-stamp--manage-local-options-state)
+ (add-function :around (local 'erc--clear-function)
+ #'erc-stamp--reset-on-clear '((depth . 40))))
(let (erc-echo-timestamps erc-hide-timestamps erc-timestamp-intangible)
(erc-stamp--manage-local-options-state))
;; Undo local mods from `erc-insert-timestamp-left-and-right'.
(erc-stamp--date-mode -1) ; kills `erc-timestamp-last-inserted-left'
+ (remove-function (local 'erc--clear-function)
+ #'erc-stamp--reset-on-clear)
(kill-local-variable 'erc-stamp--last-stamp)
(kill-local-variable 'erc-timestamp-last-inserted)
(kill-local-variable 'erc-timestamp-last-inserted-right)
@@ -1023,6 +1027,8 @@ erc-toggle-timestamps
(defvar-local erc-stamp--last-stamp nil)
+;; FIXME rename this to avoid confusion with IRC messages.
+;; Something like `erc-stamp--on-clear-echo-area-message'.
(defun erc-stamp--on-clear-message (&rest _)
"Return `dont-clear-message' when operating inside the same stamp."
(and erc-stamp--last-stamp erc-echo-timestamps
@@ -1052,25 +1058,74 @@ erc-echo-timestamp
(defun erc--echo-ts-csf (_window _before dir)
(erc-echo-timestamp dir (erc--get-inserted-msg-prop 'erc--ts)))
-(defun erc-stamp--update-saved-position (&rest _)
- (remove-hook 'erc-stamp--insert-date-hook
- #'erc-stamp--update-saved-position t)
- (move-marker erc-last-saved-position (1- (point-max))))
-
-(defun erc-stamp--reset-on-clear (pos)
- "Forget last-inserted stamps when POS is at insert marker.
+(defun erc-stamp--redo-right-stamp-post-clear (_ end)
+ "Append new right stamp to first inserted message after END."
+ ;; During truncation, the last existing right stamp is often deleted
+ ;; regardless of `erc-timestamp-only-if-changed-flag'. As of ERC 5.6,
+ ;; recreating inserted messages from scratch isn't doable. (Although,
+ ;; attempting surgery like this is likely unwise.)
+ (when-let ((erc-stamp--date-mode)
+ ((< end erc-insert-marker))
+ (bounds (erc--get-inserted-msg-bounds (1+ end)))
+ (ts (get-text-property (car bounds) 'erc--ts))
+ (format (with-suppressed-warnings
+ ((obsolete erc-timestamp-format-right))
+ (or erc-timestamp-format-right erc-timestamp-format)))
+ (rendered (erc-format-timestamp ts format))
+ ((not (equal rendered erc-timestamp-last-inserted-right)))
+ (erc--msg-props (map-into `((erc--ts . ,ts)) 'hash-table)))
+ (save-excursion
+ (save-restriction
+ (let ((erc-timestamp-last-inserted erc-timestamp-last-inserted)
+ (erc-timestamp-last-inserted-right
+ erc-timestamp-last-inserted-right))
+ (narrow-to-region (car bounds) (cdr bounds))
+ (erc-add-timestamp))))))
+
+(defun erc-stamp--reset-on-clear (orig beg end)
+ "Forget stamps older than POS.
And discard stale references in `erc-stamp--date-stamps'."
- (when erc-stamp--date-stamps
- (setq erc-stamp--date-stamps
- (seq-filter (lambda (o) (> (erc-stamp--date-marker o) pos))
- erc-stamp--date-stamps)))
- (when (= pos (1- erc-insert-marker))
- (when erc-stamp--date-mode
- (add-hook 'erc-stamp--insert-date-hook
- #'erc-stamp--update-saved-position 0 t))
- (setq erc-timestamp-last-inserted nil
- erc-timestamp-last-inserted-left nil
- erc-timestamp-last-inserted-right nil)))
+ (let (culled)
+ (when erc-stamp--date-stamps
+ (setq erc-stamp--date-stamps
+ ;; This assumes `seq-filter' visits items in order.
+ (seq-filter (lambda (o)
+ (or (> (erc-stamp--date-marker o) end)
+ (ignore
+ (set-marker (erc-stamp--date-marker o) nil)
+ (push o culled))))
+ erc-stamp--date-stamps)))
+ (funcall orig beg end)
+ (when-let ((culled)
+ ((not (or (erc--memq-msg-prop 'erc--skip 'stamp)
+ (and erc--msg-prop-overrides
+ (memq 'stamp
+ (alist-get 'erc--skip
+ erc--msg-prop-overrides))))))
+ (ct (erc-stamp--date-ts (car culled))))
+ (cl-assert erc-stamp--date-mode)
+ (let ((hook (make-symbol "temporary-hook"))
+ (rendered (erc-stamp--format-date-stamp ct))
+ (want-rhs-p (= end erc-insert-marker)))
+ ;; Object successfully removed from model but snapshot remains.
+ (cl-assert (null (cl-find rendered erc-stamp--date-stamps
+ :test #'string=
+ :key #'erc-stamp--date-str)))
+ ;; When it's midnight, `rendered' may still be yesterday while
+ ;; `erc-timestamp-last-inserted-left' is already today.
+ (let* ((data (make-erc-stamp--date :ts ct :str rendered))
+ (erc-stamp--deferred-date-stamp data)
+ (erc-timestamp-last-inserted-left nil))
+ (erc-stamp--defer-date-insertion-on-post-modify hook)
+ (set-marker (erc-stamp--date-marker data) end)
+ (run-hooks hook)
+ (unless (= ?\n (char-after erc-last-saved-position))
+ (cl-assert (or erc--called-as-input-p (null erc--msg-props)))
+ (cl-assert (= erc-last-saved-position erc-insert-marker))
+ (set-marker erc-last-saved-position (1- erc-insert-marker))))
+ (when want-rhs-p
+ (setq erc-timestamp-last-inserted-right nil
+ erc-timestamp-last-inserted nil))))))
(defun erc-stamp--dedupe-date-stamps (old-stamps)
"Update `erc-stamp--date-stamps' from its counterpart OLD-STAMPS.
diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el
index 711a2988302..c471d7a72ad 100644
--- a/lisp/erc/erc-truncate.el
+++ b/lisp/erc/erc-truncate.el
@@ -49,10 +49,31 @@ truncate
tracking heavy-traffic channels."
;;enable
((add-hook 'erc-insert-done-hook #'erc-truncate-buffer)
- (add-hook 'erc-connect-pre-hook #'erc-truncate--warn-about-logging))
+ (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)))
;; disable
((remove-hook 'erc-insert-done-hook #'erc-truncate-buffer)
- (remove-hook 'erc-connect-pre-hook #'erc-truncate--warn-about-logging)))
+ (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
+ "Temporary buffer-local override for `erc-max-buffer-size'.")
+
+(defun erc-truncate--setup ()
+ "Enable or disable buffer-local `erc-truncate-mode' modifications."
+ (if erc-truncate-mode
+ (progn
+ (when-let ((priors (or erc--server-reconnecting erc--target-priors))
+ (val (alist-get 'erc-truncate--buffer-size priors)))
+ (setq erc-truncate--buffer-size val))
+ (add-function :before (local 'erc--clear-function)
+ #'erc-truncate--inhibit-when-local-and-interactive
+ '((depth . 20))))
+ (remove-function (local 'erc--clear-function)
+ #'erc-truncate--inhibit-when-local-and-interactive)
+ (kill-local-variable 'erc-truncate--buffer-size)))
(defun erc-truncate--warn-about-logging (&rest _)
(when (and (not erc--target)
@@ -90,46 +111,51 @@ erc-truncate-buffer-to-size
(setq buffer (current-buffer))
(unless (get-buffer buffer)
(error "erc-truncate-buffer-to-size: %S is not a buffer" buffer)))
- (when (> (buffer-size buffer) (+ size 512))
- (with-current-buffer buffer
+ (with-current-buffer buffer
+ (when (and (not erc--inhibit-clear-p)
+ (> (buffer-size)
+ (+ (if (and erc-truncate--buffer-size
+ (> erc-truncate--buffer-size size))
+ (setq size erc-truncate--buffer-size)
+ size)
+ 512)))
;; Though unneeded, widen anyway to preserve pre-5.5 behavior.
- (save-restriction
- (widen)
- (let ((end (- erc-insert-marker size)))
- ;; Truncate at message boundary (formerly line boundary
- ;; before 5.6).
- (goto-char end)
- (goto-char (or (erc--get-inserted-msg-beg end)
- (pos-bol)))
- (setq end (point))
- ;; try to save the current buffer using
- ;; `erc-save-buffer-in-logs'. We use this, in case the
- ;; user has both `erc-save-buffer-in-logs' and
- ;; `erc-truncate-buffer' in `erc-insert-post-hook'. If
- ;; this is the case, only the non-saved part of the current
- ;; buffer should be saved. Rather than appending the
- ;; deleted part of the buffer to the log file.
- ;;
- ;; Alternatively this could be made conditional on:
- ;; (not (memq 'erc-save-buffer-in-logs
- ;; erc-insert-post-hook))
- ;; Comments?
- ;; The comments above concern pre-5.6 behavior and reflect
- ;; an obsolete understanding of how `erc-logging-enabled'
- ;; behaves in practice.
- (run-hook-with-args 'erc--pre-clear-functions end)
- ;; disable undoing for the truncating
- (buffer-disable-undo)
- (let ((inhibit-read-only t))
- (delete-region (point-min) end)))
- (buffer-enable-undo)))))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (let ((beg (point-min-marker))
+ (end (goto-char (- erc-insert-marker size))))
+ ;; Truncate at message boundary (formerly line boundary
+ ;; before 5.6).
+ (goto-char (or (erc--get-inserted-msg-beg end) (pos-bol)))
+ (setq end (point-marker))
+ (with-silent-modifications
+ (funcall erc--clear-function beg end))
+ (set-marker beg nil)
+ (set-marker end nil)))))))
;;;###autoload
(defun erc-truncate-buffer ()
"Truncate current buffer to `erc-max-buffer-size'."
(interactive)
+ ;; This `save-excursion' only exists for historical reasons because
+ ;; `erc-truncate-buffer-to-size' normally runs in a different buffer.
(save-excursion
- (erc-truncate-buffer-to-size erc-max-buffer-size)))
+ (if (and erc--parsed-response erc--msg-props)
+ (let ((symbol (make-symbol "erc-truncate--buffer-deferred"))
+ (buffer (current-buffer)))
+ (fset symbol
+ (lambda (&rest _)
+ (remove-hook 'erc-timer-hook symbol t)
+ (erc-truncate-buffer-to-size erc-max-buffer-size buffer)))
+ (erc-with-server-buffer (add-hook 'erc-timer-hook symbol -80 t)))
+ (erc-truncate-buffer-to-size erc-max-buffer-size))))
+
+(defun erc-truncate--inhibit-when-local-and-interactive (&rest _)
+ "Ensure `erc-truncate--buffer-size' is nil on /CLEAR."
+ (when (and erc--called-as-input-p erc-truncate--buffer-size)
+ (message "Resetting max buffer size to %d" erc-max-buffer-size)
+ (setq erc-truncate--buffer-size nil)))
(provide 'erc-truncate)
;;; erc-truncate.el ends here
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 7d006db69a6..8938db81c20 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1793,7 +1793,9 @@ erc-mode
(setq-local completion-ignore-case t)
(add-hook 'post-command-hook #'erc-check-text-conversion nil t)
(add-hook 'kill-buffer-hook #'erc-kill-buffer-function nil t)
- (add-hook 'completion-at-point-functions #'erc-complete-word-at-point nil t))
+ (add-hook 'completion-at-point-functions #'erc-complete-word-at-point nil t)
+ (add-function :before (local 'erc--clear-function)
+ #'erc--skip-past-headroom-on-clear '((depth . 30))))
;; activation
@@ -3386,7 +3388,8 @@ erc--with-spliced-insertion
(declare (indent 1))
(let ((marker (make-symbol "marker")))
`(progn
- (cl-assert (= ?\n (char-before ,marker-or-pos)))
+ (cl-assert (or (= ,marker-or-pos (point-min))
+ (= ?\n (char-before ,marker-or-pos))))
(cl-assert (null erc--insert-line-function))
(let* ((,marker (and (not (markerp ,marker-or-pos))
(copy-marker ,marker-or-pos)))
@@ -3702,7 +3705,8 @@ erc--insert-before-markers-transplanting-hidden
the inserted version of STRING."
(let* ((after (and (not erc-legacy-invisible-bounds-p)
(get-text-property (point) 'erc--hide)))
- (before (and after (get-text-property (1- (point)) 'invisible)))
+ (before (and after (> (point) (point-min))
+ (get-text-property (1- (point)) 'invisible)))
(a (and after (ensure-list after)))
(b (and before (ensure-list before)))
(new (and before (erc--solo (cl-intersection b a)))))
@@ -4474,21 +4478,37 @@ erc--unignore-user
(when-let ((existing (erc--find-ignore-timer user buffer)))
(cancel-timer existing)))))
-(defvar erc--pre-clear-functions nil
- "Abnormal hook run when truncating buffers.
-Called with position indicating boundary of interval to be excised.")
+(defvar erc--clear-function #'delete-region
+ "Function to truncate buffer.
+Called with two markers, LOWER and UPPER, indicating the bounds of the
+interval to be excised. LOWER <= UPPER <= `erc-insert-marker'.")
+
+(defun erc--skip-past-headroom-on-clear (lower _)
+ "Move marker LOWER past the 2 newlines added by `erc--initialize-markers'."
+ (when (and (not (buffer-narrowed-p)) (= lower (point-min)))
+ (save-excursion
+ (goto-char (point-min))
+ (set-marker lower (1+ (skip-chars-forward "\n" 3))))))
+
+(defvar erc--inhibit-clear-p nil
+ "When non-nil, inhbiit buffer truncation.")
(defun erc-cmd-CLEAR ()
"Clear messages in current buffer after informing active modules.
Expect modules to perform housekeeping tasks to withstand the
disruption. When called from Lisp code, only clear messages up
to but not including the one occupying the current line."
+ (when erc--inhibit-clear-p
+ (user-error "Truncation currently inhibited"))
(with-silent-modifications
- (let ((max (if (>= (point) erc-insert-marker)
- (1- erc-insert-marker)
- (or (erc--get-inserted-msg-beg (point)) (pos-bol)))))
- (run-hook-with-args 'erc--pre-clear-functions max)
- (delete-region (point-min) max)))
+ (let ((end (copy-marker
+ (cond ((>= (point) erc-insert-marker) erc-insert-marker)
+ ((erc--get-inserted-msg-beg (point)))
+ ((pos-bol)))))
+ (beg (point-min-marker)))
+ (funcall erc--clear-function beg end)
+ (set-marker beg nil)
+ (set-marker end nil)))
t)
(put 'erc-cmd-CLEAR 'process-not-needed t)
diff --git a/test/lisp/erc/erc-scenarios-log.el b/test/lisp/erc/erc-scenarios-log.el
index 3c738822f96..76d3b74222d 100644
--- a/test/lisp/erc/erc-scenarios-log.el
+++ b/test/lisp/erc/erc-scenarios-log.el
@@ -117,10 +117,12 @@ erc-scenarios-log--clear-stamp
(should (file-exists-p logfile))
(funcall expect 10 "please your lordship")
(ert-info ("Buffer truncated")
- (goto-char (point-min))
- (funcall expect 10 "@@STAMP@@" (point)) ; reset
+ (funcall expect 10 "@@STAMP@@" (goto-char (point-min))) ; reset
(funcall expect -0.1 "Grows, lives")
- (funcall expect 1 "For these two")))
+ (funcall expect 1 "For these two")
+ ;; Stamp resides just before `erc-last-saved-position'.
+ (should (looking-back (rx "]\n<bob> alice: For these two")))
+ (should (= erc-last-saved-position (1- (pos-bol))))))
(ert-info ("Current contents saved")
(with-temp-buffer
@@ -129,7 +131,7 @@ erc-scenarios-log--clear-stamp
(funcall expect 1 "You have joined")
(funcall expect 1 "Playback Complete.")
(funcall expect 1 "Grows, lives")
- (funcall expect -0.01 "please your lordship")))
+ (funcall expect -0.001 "alice: For these two hours")))
(ert-info ("Remainder saved, timestamp printed when option non-nil")
(with-current-buffer "foonet"
@@ -180,7 +182,7 @@ erc-scenarios-log--truncate
(should-not (file-exists-p logserv))
(should-not (file-exists-p logchan))
(funcall expect 10 "*** MAXLIST=beI:60")
- (should (= (pos-bol) (point-min)))
+ (should (= (pos-bol) 22))
(should (file-exists-p logserv))))
(ert-info ("Log file ahead of truncation point")
@@ -198,9 +200,13 @@ erc-scenarios-log--truncate
(with-temp-buffer
(insert-file-contents logchan)
(funcall expect 1 "You have joined")
- (funcall expect 1 "[07:04:37] alice: Here,")
- (funcall expect 1 "loathed enemy")
- (funcall expect -0.1 "please your lordship")))
+ ;; No unwanted duplicates.
+ (funcall expect 1 "<bob> [07:04:37] alice: Here,")
+ (funcall expect -0.001 "<bob> [07:04:37] alice: Here,")
+ (funcall expect 1 "<alice> [07:04:42] bob: By my troth")
+ (funcall expect -0.001 "<alice> [07:04:42] bob: By my troth")
+ (funcall expect 1 "I will grant it")
+ (funcall expect -0.001 "loathed enemy")))
(erc-log-mode -1)
(erc-truncate-mode -1)
--
2.46.0
^ permalink raw reply related [flat|nested] 3+ messages in thread
end of thread, other threads:[~2024-09-05 21:58 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2024-08-20 20:10 bug#72736: 31.0.50; ERC 5.6.1: Keep ban lists in sync J.P.
2024-08-24 18:03 ` J.P.
[not found] ` <87msl123y6.fsf@neverwas.me>
2024-09-05 21:58 ` J.P.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).