From unknown Sun Jun 15 08:53:31 2025 Content-Disposition: inline Content-Transfer-Encoding: quoted-printable MIME-Version: 1.0 X-Mailer: MIME-tools 5.509 (Entity 5.509) Content-Type: text/plain; charset=utf-8 From: bug#72736 <72736@debbugs.gnu.org> To: bug#72736 <72736@debbugs.gnu.org> Subject: Status: 31.0.50; ERC 5.6.1: Keep ban lists in sync Reply-To: bug#72736 <72736@debbugs.gnu.org> Date: Sun, 15 Jun 2025 15:53:31 +0000 retitle 72736 31.0.50; ERC 5.6.1: Keep ban lists in sync reassign 72736 emacs submitter 72736 "J.P." severity 72736 normal tag 72736 patch thanks From debbugs-submit-bounces@debbugs.gnu.org Tue Aug 20 16:11:25 2024 Received: (at submit) by debbugs.gnu.org; 20 Aug 2024 20:11:25 +0000 Received: from localhost ([127.0.0.1]:33706 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sgVCN-0004yh-BI for submit@debbugs.gnu.org; Tue, 20 Aug 2024 16:11:25 -0400 Received: from lists.gnu.org ([209.51.188.17]:52730) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sgVCJ-0004yX-KA for submit@debbugs.gnu.org; Tue, 20 Aug 2024 16:11:22 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1sgVBb-0003zl-5L for bug-gnu-emacs@gnu.org; Tue, 20 Aug 2024 16:10:35 -0400 Received: from mail-108-mta67.mxroute.com ([136.175.108.67]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1sgVBW-0006jS-QO for bug-gnu-emacs@gnu.org; Tue, 20 Aug 2024 16:10:34 -0400 Received: from filter006.mxroute.com ([136.175.111.3] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta67.mxroute.com (ZoneMTA) with ESMTPSA id 191716987c50006bab.001 for (version=TLSv1.3 cipher=TLS_AES_256_GCM_SHA384); Tue, 20 Aug 2024 20:10:27 +0000 X-Zone-Loop: 4bb3af6156547289754e3294854aaa50804dfb8dc6d2 X-Originating-IP: [136.175.111.3] DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=neverwas.me ; s=x; h=Content-Type:MIME-Version:Message-ID:Date:Subject:To:From:Sender: Reply-To:Cc:Content-Transfer-Encoding:Content-ID:Content-Description: Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc:Resent-Message-ID: In-Reply-To:References:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=kZFPJcmzYEuC0NDiLICeZhzygI+O6vfHxcQWviorMGY=; b=m2S5k/3Zbw5v4P1iX9l9YMatYN jKGDCNaSy6SSPB1wN4J7p/3m1RoYgOwd3RV67xe9G/IVeth9G+Sv+JhNXRliGaEv1xlneDxirjDoD dPiHhrwz2IQLU87cHDs3GqXceWlT0azcedZ9YtpGf17kwEatbby8ohi294Pl0uQbtCYzfDi/GU2k6 zqlAbW2I6O+nqfJTdy2p0OMUBHZQjSqrsAUDE8heyfUAJZ68oYrbd3V5wEbNOiiptnRlEuS24tTQC v9f39LtW2jBo/OTJzscJjohikkSC31zALpqX+yZKR3avFLFmkpO+fMtPtZC2XFPb9XvT7lKns4bqe zycNzwyg==; From: "J.P." To: bug-gnu-emacs@gnu.org Subject: 31.0.50; ERC 5.6.1: Keep ban lists in sync X-Debbugs-CC: emacs-erc@gnu.org Date: Tue, 20 Aug 2024 13:10:23 -0700 Message-ID: <87plq3551s.fsf@neverwas.me> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Authenticated-Id: masked@neverwas.me Received-SPF: pass client-ip=136.175.108.67; envelope-from=jp@neverwas.me; helo=mail-108-mta67.mxroute.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, RCVD_IN_VALIDITY_RPBL_BLOCKED=0.001, RCVD_IN_VALIDITY_SAFE_BLOCKED=0.001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no X-Spam_action: no action X-Spam-Score: -1.4 (-) X-Debbugs-Envelope-To: submit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -2.4 (--) --=-=-= Content-Type: text/plain 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)) --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-5.6.1-Rename-internal-variable-in-erc-fill.patch >From e499857ccb895832070f5af35e42bece4c9c474e Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-5.6.1-Store-one-string-per-user-in-erc-spkr-msg-prop.patch >From 6283c01e6da88ba2c031f118684922aa2f64c16e Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 " one")) + (should (eq (get-text-property (point) 'erc--speaker) sentinel)) + (should (eq (erc--get-inserted-msg-prop 'erc--spkr) sentinel)) + + (should (search-forward " hi" nil t)) + + (should (search-forward " 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-5.6.1-Bind-current-erc-response-around-all-handlers.patch >From 0665e75229ae6b92c21fd3a12a0e46136026da32 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0004-5.6.1-Use-5.6-MODE-framework-to-update-erc-channel-b.patch >From 241e91980886e48579e74a7f739079547f7d73fd Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0005-5.6.1-Fix-inconsistent-handling-of-ban-lists-in-ERC.patch >From 75d2be6b3f74ef0822a2e69ba2f94f5806aa4182 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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. + +* 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. + * 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 --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Sat Aug 24 14:04:43 2024 Received: (at 72736) by debbugs.gnu.org; 24 Aug 2024 18:04:43 +0000 Received: from localhost ([127.0.0.1]:41880 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1shv7y-0006jm-LS for submit@debbugs.gnu.org; Sat, 24 Aug 2024 14:04:43 -0400 Received: from mail-108-mta110.mxroute.com ([136.175.108.110]:35665) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1shv7u-0006jb-Q3 for 72736@debbugs.gnu.org; Sat, 24 Aug 2024 14:04:40 -0400 Received: from filter006.mxroute.com ([136.175.111.3] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta110.mxroute.com (ZoneMTA) with ESMTPSA id 191858f05ef0003e01.001 for <72736@debbugs.gnu.org> (version=TLSv1.3 cipher=TLS_AES_256_GCM_SHA384); Sat, 24 Aug 2024 18:03:48 +0000 X-Zone-Loop: 23658bae0fcdabbf4d3b15425674535bb674c9b19885 X-Originating-IP: [136.175.111.3] DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=neverwas.me ; s=x; h=Content-Type:MIME-Version:Message-ID:Date:References:In-Reply-To: Subject:Cc:To:From:Sender:Reply-To:Content-Transfer-Encoding:Content-ID: Content-Description:Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc :Resent-Message-ID:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=wEL5i/gKB2KgwzqtK5j54Hi4ETgo+WdAxd+mWijDQFk=; b=HsyNNz8bEZguMbenmq/hBnhJby HZDfd+tWqEbMBmF0C80bN7XRPWKLsiXCyt/IYrH4Bfy/hNzQM4Qn1g9AA9WWm94rEKL9bgJDxdGqP xb0tgHGZ43j92tZA39Pj18BJ23pTCYn4tbwGsXm0XKuCLAni5anIFR7ZL2Q9Iy0yfJ6snnnLGNaKp RZ/qMt1ONLiigDjzohmHu/jm6bc0y1JnEbdGwUotp7b1GNWOg/CimUZPDifKokoujMItOf4LiHt/g mELYYPMrE5mgFFP7gppxqzARph1qx/DVkSrFNOMpZrFYAttj/6SC8aU0hd8MIitOFx8dtQBfLbAUx DGSToKxg==; From: "J.P." To: 72736@debbugs.gnu.org Subject: Re: bug#72736: 31.0.50; ERC 5.6.1: Keep ban lists in sync In-Reply-To: <87plq3551s.fsf@neverwas.me> (J. P.'s message of "Tue, 20 Aug 2024 13:10:23 -0700") References: <87plq3551s.fsf@neverwas.me> Date: Sat, 24 Aug 2024 11:03:45 -0700 Message-ID: <87msl123y6.fsf@neverwas.me> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain X-Authenticated-Id: masked@neverwas.me X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 72736 Cc: emacs-erc@gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) "J.P." 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. From debbugs-submit-bounces@debbugs.gnu.org Thu Sep 05 18:00:04 2024 Received: (at 72736) by debbugs.gnu.org; 5 Sep 2024 22:00:04 +0000 Received: from localhost ([127.0.0.1]:38474 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1smKWK-0005w5-PB for submit@debbugs.gnu.org; Thu, 05 Sep 2024 18:00:04 -0400 Received: from mail-108-mta14.mxroute.com ([136.175.108.14]:39487) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1smKWJ-0005vj-I4 for 72736@debbugs.gnu.org; Thu, 05 Sep 2024 18:00:03 -0400 Received: from filter006.mxroute.com ([136.175.111.3] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta14.mxroute.com (ZoneMTA) with ESMTPSA id 191c4329a410003e01.001 for <72736@debbugs.gnu.org> (version=TLSv1.3 cipher=TLS_AES_256_GCM_SHA384); Thu, 05 Sep 2024 21:58:56 +0000 X-Zone-Loop: b17ece55c4ee197c3f75d7164ba5cfd8f7a027065eb3 X-Originating-IP: [136.175.111.3] DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=neverwas.me ; s=x; h=Content-Type:MIME-Version:Message-ID:Date:References:In-Reply-To: Subject:Cc:To:From:Sender:Reply-To:Content-Transfer-Encoding:Content-ID: Content-Description:Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc :Resent-Message-ID:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=29l8sIXpfSACMVX+8mXsroRngmtjOm4oU5GqOFt36fE=; b=jSm6sw3P2kWXMWBHYugfAmT/W2 3ai5RsYS/1HztFqw1wVBMI4LmXYJngjSyUPEuqdwDJ2QxHaJz0AfJDgt+x76Yx2C8gj5opIQOa2TE x99ltJEpG+niwRvX56hkkT6j8Tlpbp2sLa4CDmWHmgkKCEfCAlznT3/SQ+ZigzlXAYEiCYGH+w4Z1 NVj7KLQlTjuOObKVly1gl86xZfRel87U1SYi660GZZJAMYC6Me4sNCyfODX16EvIBZN7wNGwUxw6k j73QrWnjiBl0xRREIxNDdA9bnL59+0SrRGguDgROOrIpG74Oy5fCSSE+Xrb1kyY0xGXmuA9naQlxS /iMZloKA==; From: "J.P." To: 72736@debbugs.gnu.org Subject: Re: bug#72736: 31.0.50; ERC 5.6.1: Keep ban lists in sync In-Reply-To: <87msl123y6.fsf@neverwas.me> (J. P.'s message of "Sat, 24 Aug 2024 11:03:45 -0700") References: <87plq3551s.fsf@neverwas.me> <87msl123y6.fsf@neverwas.me> Date: Thu, 05 Sep 2024 14:58:52 -0700 Message-ID: <87mskl3gpv.fsf@neverwas.me> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Authenticated-Id: masked@neverwas.me X-Debbugs-Envelope-To: 72736 Cc: emacs-erc@gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" --=-=-= Content-Type: text/plain v2. Only update `erc-channel-banlist' if initialized. Redo shared hook mechanism for buffer truncation. "J.P." 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. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-v1-v2.diff >From 5297613ac24bfbee5ed43f01875c08c147b7f618 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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. 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 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 " [07:04:37] alice: Here,") + (funcall expect -0.001 " [07:04:37] alice: Here,") + (funcall expect 1 " [07:04:42] bob: By my troth") + (funcall expect -0.001 " [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 " 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 " 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-5.6.1-Rename-internal-variable-in-erc-fill.patch >From d2224a549b3ad24e4798a827f965d2f624efb6fc Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-5.6.1-Store-one-string-per-user-in-erc-spkr-msg-prop.patch >From 6d27ebb9f7a9d2786cc9ac0808c71941d2627f6e Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 " one")) + (should (eq (get-text-property (point) 'erc--speaker) sentinel)) + (should (eq (erc--get-inserted-msg-prop 'erc--spkr) sentinel)) + + (should (search-forward " hi" nil t)) + + (should (search-forward " 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-5.6.1-Bind-current-erc-response-around-all-handlers.patch >From 29fbad881e33d56e76c9fb0fb8b9a07037dfcc2e Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0004-5.6.1-Fix-inconsistent-handling-of-ban-lists-in-ERC.patch >From 9bb1ca1f792863642e2a043822303c1f03b474e1 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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. + +* 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. + * 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0005-5.6.1-Fix-overlooked-case-in-erc-get-inserted-msg-be.patch >From eec711c9df63415aaeaaa3382eb2a89b1e59e53d Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 " 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 " 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0006-5.6.1-Redo-ERC-truncation-and-CLEAR-hook-mechanism.patch >From 5297613ac24bfbee5ed43f01875c08c147b7f618 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 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 " [07:04:37] alice: Here,") + (funcall expect -0.001 " [07:04:37] alice: Here,") + (funcall expect 1 " [07:04:42] bob: By my troth") + (funcall expect -0.001 " [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 --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Mon Sep 30 20:16:24 2024 Received: (at 72736-done) by debbugs.gnu.org; 1 Oct 2024 00:16:24 +0000 Received: from localhost ([127.0.0.1]:47933 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1svQYy-00020J-7Q for submit@debbugs.gnu.org; Mon, 30 Sep 2024 20:16:24 -0400 Received: from mail-108-mta92.mxroute.com ([136.175.108.92]:35437) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1svQYv-00020D-Ot for 72736-done@debbugs.gnu.org; Mon, 30 Sep 2024 20:16:23 -0400 Received: from filter006.mxroute.com ([136.175.111.3] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta92.mxroute.com (ZoneMTA) with ESMTPSA id 192456ed3a00003e01.001 for <72736-done@debbugs.gnu.org> (version=TLSv1.3 cipher=TLS_AES_256_GCM_SHA384); Tue, 01 Oct 2024 00:15:44 +0000 X-Zone-Loop: ed7aaebdc37212b0c757a28b1538d463e52a12e7b196 X-Originating-IP: [136.175.111.3] DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=neverwas.me ; s=x; h=Content-Type:MIME-Version:Message-ID:Date:References:In-Reply-To: Subject:Cc:To:From:Sender:Reply-To:Content-Transfer-Encoding:Content-ID: Content-Description:Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc :Resent-Message-ID:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=uY5Qfep439keyj/QAaw4RYwzmx74p5wczTJGBRYjKCw=; b=B6OC9JvGQuH3rpaC9Osu2KfrQM 9QE+s7feC9PYbKbmBRhZXJG52vL6BzwOHpN9E/+BwUSgCw+uMK+SEKE+2g/vcDMPK0kAsUQlAI8en o4dkJCXB5tAxNmXMOpW1qNjDrMV+HHmpJMZpaoD//ZUzeRqklDvaYD2MbkTeNYh6bxGYvfHNnMNg1 yIaeLFOIjOYgI1m4WcAYvhaxoEGH+ri3EPHvsw+ZJh2NexRt/EpTgOuZ4W/ypo2QV7cGaPg2VeNFK hkA+Rk4wPdGPEcnnmsnXmvfeLoIoQTC3A6ER6RHGQPpIad2xxNwkWX8/raVb7lraGhCGF1d9wAhsE h0Kk8T0A==; From: "J.P." To: 72736-done@debbugs.gnu.org Subject: Re: bug#72736: 31.0.50; ERC 5.6.1: Keep ban lists in sync In-Reply-To: <87mskl3gpv.fsf@neverwas.me> (J. P.'s message of "Thu, 05 Sep 2024 14:58:52 -0700") References: <87plq3551s.fsf@neverwas.me> <87msl123y6.fsf@neverwas.me> <87mskl3gpv.fsf@neverwas.me> Date: Mon, 30 Sep 2024 17:15:41 -0700 Message-ID: <87y138oez6.fsf@neverwas.me> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain X-Authenticated-Id: masked@neverwas.me X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 72736-done Cc: emacs-erc@gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) "J.P." writes: > v2. Only update `erc-channel-banlist' if initialized. Redo shared hook > mechanism for buffer truncation. I've installed these as https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=054602533ca https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=51d5419fdc3 Thanks and closing. From unknown Sun Jun 15 08:53:31 2025 Received: (at fakecontrol) by fakecontrolmessage; To: internal_control@debbugs.gnu.org From: Debbugs Internal Request Subject: Internal Control Message-Id: bug archived. Date: Tue, 29 Oct 2024 11:24:05 +0000 User-Agent: Fakemail v42.6.9 # This is a fake control message. # # The action: # bug archived. thanks # This fakemail brought to you by your local debbugs # administrator