unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
* bug#72736: 31.0.50; ERC 5.6.1: Keep ban lists in sync
@ 2024-08-20 20:10 J.P.
  2024-08-24 18:03 ` J.P.
       [not found] ` <87msl123y6.fsf@neverwas.me>
  0 siblings, 2 replies; 4+ messages in thread
From: J.P. @ 2024-08-20 20:10 UTC (permalink / raw)
  To: 72736; +Cc: emacs-erc

[-- Attachment #1: Type: text/plain, Size: 5812 bytes --]

Tags: patch

The function `erc-banlist-update' conditionally modifies the local
variable `erc-channel-banlist'." As originally envisioned, this list
remains synced with the server's because `erc-banlist-update' runs
whenever the client receives a MODE command. But due to a bug in the
logic surrounding an internal flag (meant to regulate meaningful action
by the function), synchronization is inconsistent and difficult to
predict, which makes `erc-channel-banlist' ultimately unreliable.

Much of this can be solved by simply wiring in ban-list syncing to the
MODE-handling "framework" introduced by bug#67220. So instead of the
current situation, in which `erc-banlist-update' only understands "+b"
or "-b" but not "+mb", etc., we'll have a reliable solution for handling
all such permutations. This *should* have been addressed by bug#67220
along with everything else in that arena, but unscrambling all the
aforementioned state-flag business seemed a chore too many at the time,
ISTR.

The last two of the attached patches aim to improve the situation by
updating `erc-channel-banlist' on a rolling basis, unconditionally. On
the UX side, they provide third-party modules with a new function,
`erc-sync-banlist', that effectively guarantees `erc-channel-banlist'
will remain in sync for the remainder of the session, once invoked.

I've also run into some related issues on the interactive side with the
slash commands /BANLIST and /MASSUNBAN. Currently, issuing a /MASSUNBAN
corrupts synchronization, potentially across all sessions. For example,
issuing a subsequent /BANLIST won't send a "MODE #chan b" to refresh
`erc-channel-banlist' as it usually does. Instead, it will proceed in
listing the variable's stale contents, which could potentially confuse a
channel operator and lead to unfortunate social situations.

The first few patches in the set are mostly unrelated fixes. The second
tackles a memory leak introduced by Bug#67677, which added the "msg
props" internal framework for organizing per-message text props. The
third patch is of a supporting nature and internally binds the current
`erc-response' object for hooks and handlers, to allow easier access
toward the business end of the call stack. I was hoping to avoid such a
change until 5.7, but circumstances dictate otherwise.

Thanks.

In GNU Emacs 31.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version
 3.24.43, cairo version 1.18.0) of 2024-08-19 built on localhost
Repository revision: a876c4d7a17df152e3e78800c76ddf158f632ee5
Repository branch: master
Windowing system distributor 'The X.Org Foundation', version 11.0.12401002
System Description: Fedora Linux 40 (Workstation Edition)

Configured using:
 'configure --enable-check-lisp-object-type --enable-checking=yes,glyphs
 'CFLAGS=-O0 -g3'
 PKG_CONFIG_PATH=:/usr/lib64/pkgconfig:/usr/share/pkgconfig'

Configured features:
ACL CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GPM GSETTINGS HARFBUZZ JPEG
LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 M17N_FLT MODULES NATIVE_COMP
NOTIFY INOTIFY PDUMPER PNG RSVG SECCOMP SOUND SQLITE3 THREADS TIFF
TOOLKIT_SCROLL_BARS WEBP X11 XDBE XIM XINPUT2 XPM GTK3 ZLIB

Important settings:
  value of $LANG: en_US.UTF-8
  value of $XMODIFIERS: @im=ibus
  locale-coding-system: utf-8-unix

Major mode: Lisp Interaction

Minor modes in effect:
  tooltip-mode: t
  global-eldoc-mode: t
  eldoc-mode: t
  show-paren-mode: t
  electric-indent-mode: t
  mouse-wheel-mode: t
  tool-bar-mode: t
  menu-bar-mode: t
  file-name-shadow-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  blink-cursor-mode: t
  minibuffer-regexp-mode: t
  line-number-mode: t
  indent-tabs-mode: t
  transient-mark-mode: t
  auto-composition-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t

Load-path shadows:
None found.

Features:
(shadow sort compile comint ansi-osc ansi-color ring comp-run
comp-common mail-extr emacsbug message mailcap yank-media puny dired
dired-loaddefs rfc822 mml mml-sec epa epg rfc6068 epg-config gnus-util
text-property-search time-date mm-decode mm-bodies mm-encode mail-parse
rfc2231 mailabbrev gmm-utils mailheader sendmail rfc2047 rfc2045
ietf-drums mm-util mail-prsvr mail-utils erc derived auth-source eieio
eieio-core icons password-cache json map format-spec erc-backend
erc-networks easy-mmode byte-opt bytecomp byte-compile erc-common inline
cl-extra help-mode erc-compat cl-seq cl-macs gv pcase rx compat subr-x
cl-loaddefs cl-lib erc-loaddefs rmc iso-transl tooltip cconv eldoc paren
electric uniquify ediff-hook vc-hooks lisp-float-type elisp-mode mwheel
term/x-win x-win term/common-win x-dnd touch-screen tool-bar dnd fontset
image regexp-opt fringe tabulated-list replace newcomment text-mode
lisp-mode prog-mode register page tab-bar menu-bar rfn-eshadow isearch
easymenu timer select scroll-bar mouse jit-lock font-lock syntax
font-core term/tty-colors frame minibuffer nadvice seq simple cl-generic
indonesian philippine cham georgian utf-8-lang misc-lang vietnamese
tibetan thai tai-viet lao korean japanese eucjp-ms cp51932 hebrew greek
romanian slovak czech european ethiopic indian cyrillic chinese
composite emoji-zwj charscript charprop case-table epa-hook
jka-cmpr-hook help abbrev obarray oclosure cl-preloaded button loaddefs
theme-loaddefs faces cus-face macroexp files window text-properties
overlay sha1 md5 base64 format env code-pages mule custom widget keymap
hashtable-print-readable backquote threads dbusbind inotify lcms2
dynamic-setting system-font-setting font-render-setting cairo gtk
x-toolkit xinput2 x multi-tty move-toolbar make-network-process
native-compile emacs)

Memory information:
((conses 16 159110 10474) (symbols 48 11702 0) (strings 32 28787 4600)
 (string-bytes 1 1011760) (vectors 16 17066)
 (vector-slots 8 185078 5037) (floats 8 30 1) (intervals 56 357 0)
 (buffers 984 12))

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-5.6.1-Rename-internal-variable-in-erc-fill.patch --]
[-- Type: text/x-patch, Size: 3053 bytes --]

From e499857ccb895832070f5af35e42bece4c9c474e Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 19 Aug 2024 22:40:25 -0700
Subject: [PATCH 1/5] [5.6.1] ; Rename internal variable in erc-fill

* lisp/erc/erc-fill.el (erc--fill-wrap-scrolltobottom-exempt-p):
Rename to `erc-fill--wrap-scrolltobottom-exempt-p' so prefix matches
library and feature.
(erc-fill--wrap-ensure-dependencies): Update variable name.
* test/lisp/erc/erc-fill-tests.el (erc-fill-tests--wrap-populate):
Update variable name.
* test/lisp/erc/resources/erc-scenarios-common.el
(erc-scenarios-common--make-bindings): Use updated variable name.
---
 lisp/erc/erc-fill.el                            | 4 ++--
 test/lisp/erc/erc-fill-tests.el                 | 2 +-
 test/lisp/erc/resources/erc-scenarios-common.el | 2 +-
 3 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index c863d99a339..986314822ba 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -421,7 +421,7 @@ erc-button-mode
 (defvar erc-scrolltobottom-mode)
 (defvar erc-legacy-invisible-bounds-p)
 
-(defvar erc--fill-wrap-scrolltobottom-exempt-p nil)
+(defvar erc-fill--wrap-scrolltobottom-exempt-p nil)
 
 (defun erc-fill--wrap-ensure-dependencies ()
   (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
@@ -435,7 +435,7 @@ erc-fill--wrap-ensure-dependencies
     (unless erc-fill-mode
       (push 'fill missing-deps)
       (erc-fill-mode +1))
-    (unless (or erc-scrolltobottom-mode erc--fill-wrap-scrolltobottom-exempt-p
+    (unless (or erc-scrolltobottom-mode erc-fill--wrap-scrolltobottom-exempt-p
                 (memq 'scrolltobottom erc-modules))
       (push 'scrolltobottom missing-deps)
       (erc-scrolltobottom-mode +1))
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index f8bfc362085..b52a996f184 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -52,7 +52,7 @@ erc-fill-tests--insert-privmsg
 
 (defun erc-fill-tests--wrap-populate (test)
   (let ((original-window-buffer (window-buffer (selected-window)))
-        (erc--fill-wrap-scrolltobottom-exempt-p t)
+        (erc-fill--wrap-scrolltobottom-exempt-p t)
         (erc-stamp--tz t)
         (erc-fill-function 'erc-fill-wrap)
         (pre-command-hook pre-command-hook)
diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el
index 0dc82c98d5f..130b0aae109 100644
--- a/test/lisp/erc/resources/erc-scenarios-common.el
+++ b/test/lisp/erc/resources/erc-scenarios-common.el
@@ -150,7 +150,7 @@ erc-scenarios-common--print-trace
       (timer-list (copy-sequence timer-list))
       (timer-idle-list (copy-sequence timer-idle-list))
       (erc-auth-source-parameters-join-function nil)
-      (erc--fill-wrap-scrolltobottom-exempt-p t)
+      (erc-fill--wrap-scrolltobottom-exempt-p t)
       (erc-autojoin-channels-alist nil)
       (erc-server-auto-reconnect nil)
       (erc-after-connect nil)
-- 
2.46.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-5.6.1-Store-one-string-per-user-in-erc-spkr-msg-prop.patch --]
[-- Type: text/x-patch, Size: 10994 bytes --]

From 6283c01e6da88ba2c031f118684922aa2f64c16e Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Tue, 6 Aug 2024 19:13:51 -0700
Subject: [PATCH 2/5] [5.6.1] Store one string per user in erc--spkr msg prop

* lisp/erc/erc.el (erc--msg-props): Mention that the `erc--spkr'
msg-prop value is taken from the `nickname' slot of the user's
`erc-server-users' entry.
(erc--speakerize-nick): Avoid using the provided NICK parameter for
the `erc--spkr' property.  Instead, use the version from the
`nickname' slot of its `erc-server-users' item, which is itself an
`erc-server-user' object.  These text props were originally introduced
in ERC 5.6 as part of Bug#67677.
* test/lisp/erc/erc-tests.el (erc--refresh-prompt)
(erc--check-prompt-input-functions, erc-send-current-line)
(erc--check-prompt-input-for-multiline-blanks)
(erc-send-whitespace-lines): Use more convenient helper utility to
create fake server buffer where possible.
(erc--speakerize-nick): New test.
* test/lisp/erc/resources/erc-tests-common.el
(erc-tests-common-make-server-buf): Don't use ERT temp buffer's name
for dialed server, etc., because it contains unwanted chars.
(erc-tests-common-with-process-input-spy): Defer to each test to set
up its own prompt, etc.
---
 lisp/erc/erc.el                             | 29 ++++-----
 test/lisp/erc/erc-tests.el                  | 71 ++++++++++++++++++---
 test/lisp/erc/resources/erc-tests-common.el |  9 +--
 3 files changed, 81 insertions(+), 28 deletions(-)

diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 5e8fa3051c7..8b3eef94ee4 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -173,7 +173,8 @@ erc--msg-props
     and help text, and on outgoing messages unless echoed back by
     the server (assuming future support)
 
- - `erc--spkr': a string, the nick of the person speaking
+ - `erc--spkr': a string, the non-case-mapped nick of the speaker as
+    stored in the `nickname' slot of its `erc-server-users' item
 
  - `erc--ctcp': a CTCP command, like `ACTION'
 
@@ -6339,20 +6340,18 @@ erc--message-speaker-ctcp-action-statusmsg-input
   "Template for a CTCP ACTION status message from current client.")
 
 (defun erc--speakerize-nick (nick &optional disp)
-  "Propertize NICK with `erc--speaker' if not already present.
-Do so to DISP instead if it's non-nil.  In either case, assign
-NICK, sans properties, as the `erc--speaker' value.  As a side
-effect, pair the latter string (the same `eq'-able object) with
-the symbol `erc--spkr' in the \"msg prop\" environment for any
-imminent `erc-display-message' invocations.  While doing so,
-include any overrides defined in `erc--message-speaker-catalog'."
-  (let ((plain-nick (substring-no-properties nick)))
-    (erc--ensure-spkr-prop plain-nick (get erc--message-speaker-catalog
-                                           'erc--msg-prop-overrides))
-    (if (text-property-not-all 0 (length (or disp nick))
-                               'erc--speaker nil (or disp nick))
-        (or disp nick)
-      (propertize (or disp nick) 'erc--speaker plain-nick))))
+  "Return propertized NICK with canonical NICK in `erc--speaker'.
+Return propertized DISP instead if given.  As a side effect, pair NICK
+with `erc--spkr' in the \"msg prop\" environment for any imminent
+`erc-display-message' invocations, and include any overrides defined in
+`erc--message-speaker-catalog'.  Expect NICK (but not necessarily DISP)
+to be absent of any existing text properties."
+  (when-let ((erc-server-process)
+             (cusr (erc-get-server-user nick)))
+    (setq nick (erc-server-user-nickname cusr)))
+  (erc--ensure-spkr-prop nick (get erc--message-speaker-catalog
+                                   'erc--msg-prop-overrides))
+  (propertize (or disp nick) 'erc--speaker nick))
 
 (defun erc--determine-speaker-message-format-args
     (nick message queryp privmsgp inputp &optional statusmsg prefix disp-nick)
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index f65c1496087..b11f994bce8 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -330,16 +330,12 @@ erc--refresh-prompt
 
     (ert-info ("Server buffer")
       (with-current-buffer (get-buffer-create "ServNet")
-        (erc-tests-common-prep-for-insertion)
+        (erc-tests-common-make-server-buf "ServNet")
         (goto-char erc-insert-marker)
         (should (looking-at-p "ServNet 3>"))
         (erc-tests-common-init-server-proc "sleep" "1")
         (set-process-sentinel erc-server-process #'ignore)
-        (setq erc-network 'ServNet
-              erc-server-current-nick "tester"
-              erc-networks--id (erc-networks--id-create nil)
-              erc-server-users (make-hash-table :test 'equal))
-        (set-process-query-on-exit-flag erc-server-process nil)
+        (setq erc-server-current-nick "tester")
         ;; Incoming message redraws prompt
         (erc-display-message nil 'notice nil "Welcome")
         (should (looking-at-p (rx "*** Welcome")))
@@ -364,6 +360,8 @@ erc--refresh-prompt
           (should-not (search-forward (rx (any "3-5") ">") nil t)))))
 
     (ert-info ("Channel buffer")
+      ;; Create buffer manually instead of using `erc--open-target' in
+      ;; order to show prompt before/after network is known.
       (with-current-buffer (get-buffer-create "#chan")
         (erc-tests-common-prep-for-insertion)
         (goto-char erc-insert-marker)
@@ -1521,6 +1519,7 @@ erc--input-line-delim-regexp
 (ert-deftest erc--check-prompt-input-functions ()
   (erc-tests-common-with-process-input-spy
    (lambda (next)
+     (erc-tests-common-prep-for-insertion)
 
      (ert-info ("Errors when point not in prompt area") ; actually just dings
        (insert "/msg #chan hi")
@@ -1556,7 +1555,7 @@ erc--check-prompt-input-functions
 (ert-deftest erc-send-current-line ()
   (erc-tests-common-with-process-input-spy
    (lambda (next)
-     (erc-tests-common-init-server-proc "sleep" "1")
+     (erc-tests-common-make-server-buf (buffer-name))
      (should (= 0 erc-last-input-time))
 
      (ert-info ("Simple command")
@@ -1639,7 +1638,8 @@ erc--check-prompt-input-for-multiline-blanks
   (ert-with-message-capture messages
     (erc-tests-common-with-process-input-spy
      (lambda (next)
-       (erc-tests-common-init-server-proc "sleep" "300")
+       (erc-tests-common-make-server-buf (buffer-name))
+
        (should-not erc-send-whitespace-lines)
        (should erc-warn-about-blank-lines)
 
@@ -1717,7 +1717,8 @@ erc--check-prompt-input-for-multiline-blanks/explanations
 (ert-deftest erc-send-whitespace-lines ()
   (erc-tests-common-with-process-input-spy
    (lambda (next)
-     (erc-tests-common-init-server-proc "sleep" "1")
+     (erc-tests-common-make-server-buf (buffer-name))
+
      (setq-local erc-send-whitespace-lines t)
 
      (ert-info ("Multiline hunk with blank line correctly split")
@@ -2653,6 +2654,58 @@ erc-tests--format-privmessage
            (erc--determine-speaker-message-format-args nick msg privp msgp
                                                        inputp nil pfx))))
 
+;; This test demonstrates that ERC uses the same string for the
+;; `erc--spkr' and `erc--speaker' text properties, which it gets from
+;; the `nickname' shot of the speaker's server user.
+(ert-deftest erc--speakerize-nick ()
+  (erc-tests-common-make-server-buf)
+  (setq erc-server-current-nick "tester")
+
+  (let ((sentinel "alice"))
+    (with-current-buffer (erc--open-target "#chan")
+      (erc-update-current-channel-member "bob" "bob" t nil nil nil nil nil
+                                         "example.org" "~u" "bob")
+      (erc-update-current-channel-member "alice" sentinel t nil nil nil nil nil
+                                         "fsf.org" "~u" "alice"))
+
+    (erc-call-hooks nil (make-erc-response
+                         :sender "alice!~u@fsf.org"
+                         :command "PRIVMSG"
+                         :command-args '("#chan" "one")
+                         :contents "one"
+                         :unparsed ":alice!~u@fsf.org PRIVMSG #chan :one"))
+    (erc-call-hooks nil (make-erc-response
+                         :sender "bob!~u@example.org"
+                         :command "PRIVMSG"
+                         :command-args '("#chan" "hi")
+                         :contents "hi"
+                         :unparsed ":bob!~u@example.org PRIVMSG #chan :hi"))
+    (erc-call-hooks nil (make-erc-response
+                         :sender "alice!~u@fsf.org"
+                         :command "PRIVMSG"
+                         :command-args '("#chan" "two")
+                         :contents "two"
+                         :unparsed ":alice!~u@fsf.org PRIVMSG #chan :two"))
+
+    (with-current-buffer (get-buffer "#chan")
+      (should (eq sentinel
+                  (erc-server-user-nickname (erc-get-server-user "alice"))))
+      (goto-char (point-min))
+
+      (should (search-forward "<a" nil t))
+      (should (looking-at "lice> one"))
+      (should (eq (get-text-property (point) 'erc--speaker) sentinel))
+      (should (eq (erc--get-inserted-msg-prop 'erc--spkr) sentinel))
+
+      (should (search-forward "<bob> hi" nil t))
+
+      (should (search-forward "<a" nil t))
+      (should (looking-at "lice> two"))
+      (should (eq (get-text-property (point) 'erc--speaker) sentinel))
+      (should (eq (erc--get-inserted-msg-prop 'erc--spkr) sentinel))
+
+      (when noninteractive (kill-buffer)))))
+
 ;; This asserts that `erc--determine-speaker-message-format-args'
 ;; behaves identically to `erc-format-privmessage', the function whose
 ;; role it basically replaced.
diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el
index 2ec32db77cd..b5bb1fb09c3 100644
--- a/test/lisp/erc/resources/erc-tests-common.el
+++ b/test/lisp/erc/resources/erc-tests-common.el
@@ -103,16 +103,17 @@ erc-tests-common-with-process-input-spy
                  (lambda (&rest r) (push r calls)))
                 ((symbol-function 'erc-server-buffer)
                  (lambda () (current-buffer))))
-        (erc-tests-common-prep-for-insertion)
         (funcall test-fn (lambda () (pop calls)))))
     (when noninteractive (kill-buffer))))
 
 (defun erc-tests-common-make-server-buf (&optional name)
   "Return a server buffer named NAME, creating it if necessary.
 Use NAME for the network and the session server as well."
-  (unless name
-    (cl-assert (string-prefix-p " *temp*" (setq name (buffer-name)))))
-  (with-current-buffer (get-buffer-create name)
+  (with-current-buffer (if name
+                           (get-buffer-create name)
+                         (and (string-search "temp" (buffer-name))
+                              (setq name "foonet")
+                              (buffer-name)))
     (erc-tests-common-prep-for-insertion)
     (erc-tests-common-init-server-proc "sleep" "1")
     (setq erc-session-server (concat "irc." name ".org")
-- 
2.46.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-5.6.1-Bind-current-erc-response-around-all-handlers.patch --]
[-- Type: text/x-patch, Size: 1718 bytes --]

From 0665e75229ae6b92c21fd3a12a0e46136026da32 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 18 Aug 2024 23:50:58 -0700
Subject: [PATCH 3/5] [5.6.1] Bind current erc-response around all handlers

* lisp/erc/erc-backend.el (erc--parsed-response): New variable to be
the internal version of the ancient `erc-message-parsed', which is
only available during `erc-display-message', and therefore of somewhat
limited utility.
(erc-call-hooks): Bind `erc--parsed-response' to the parsed
`erc-response' object for the duration of its handling.  Bind
`erc--msg-prop-overrides' around all hooks to allow response handlers
to influence inserted msg props for any `erc-display-message' calls.
---
 lisp/erc/erc-backend.el | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 9aedc110067..d999cf57db8 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -1534,11 +1534,15 @@ erc-get-hook
   (gethash (format (if (numberp command) "%03i" "%s") command)
            erc-server-responses))
 
+(defvar erc--parsed-response nil)
+
 (defun erc-call-hooks (process message)
   "Call hooks associated with MESSAGE in PROCESS.
 
 Finds hooks by looking in the `erc-server-responses' hash table."
-  (let ((hook (or (erc-get-hook (erc-response.command message))
+  (let ((erc--parsed-response message)
+        (erc--msg-prop-overrides erc--msg-prop-overrides)
+        (hook (or (erc-get-hook (erc-response.command message))
                   'erc-default-server-functions)))
     (run-hook-with-args-until-success hook process message)
     ;; Some handlers, like `erc-cmd-JOIN', open new targets without
-- 
2.46.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0004-5.6.1-Use-5.6-MODE-framework-to-update-erc-channel-b.patch --]
[-- Type: text/x-patch, Size: 6253 bytes --]

From 241e91980886e48579e74a7f739079547f7d73fd Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 18 Aug 2024 22:58:11 -0700
Subject: [PATCH 4/5] [5.6.1] Use 5.6 MODE framework to update
 erc-channel-banlist

* lisp/erc/erc-backend.el (erc-server-MODE): Don't call
`erc-banlist-update'.
* lisp/erc/erc.el (erc-banlist-finished): Deprecate function unused
since 2003.
(erc--banlist-update): New function.
(erc-banlist-update): Deprecate function because its logic is faulty
and it doesn't handle mixed mode letters, like "MODE #foobar
+mb *@127.0.0.1".  See https://modern.ircdocs.horse/#mode-message.  It
also depends on an obsolete convention regarding the symbol property
`received-from-server' of `erc-channel-banlist'.  Basically, this
function used to run upon receipt of any "MODE" command from the
server.  However, actual updates to the variable `erc-channel-banlist'
only happened if `received-from-server' was t, which could only be the
case after the user issued a /MASSUNBAN.  And that behavior was
determined to be a bug.  This mode framework stuff was introduced as
part of bug#67220 for ERC 5.6.
(erc--handle-channel-mode): New method.
* test/lisp/erc/erc-tests.el (erc--channel-modes)
(erc--channel-modes/graphic-p): Assert contents of
`erc-channel-banlist' updated on "MODE".
---
 lisp/erc/erc-backend.el    |  4 ++--
 lisp/erc/erc.el            | 19 +++++++++++++++++++
 test/lisp/erc/erc-tests.el | 17 +++++++++++++----
 3 files changed, 34 insertions(+), 6 deletions(-)

diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index d999cf57db8..16e8cae4733 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -1851,8 +1851,8 @@ erc--server-determine-join-display-context
                                    ?t tgt ?m mode)
             (erc-display-message parsed 'notice buf
                                  'MODE ?n nick ?u login
-                                 ?h host ?t tgt ?m mode)))
-      (erc-banlist-update proc parsed))))
+                                 ?h host ?t tgt ?m mode)))))
+  nil)
 
 (defun erc--wrangle-query-buffers-on-nick-change (old new)
   "Create or reuse a query buffer for NEW nick after considering OLD nick.
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 8b3eef94ee4..e1fd279f405 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -6639,17 +6639,31 @@ erc-banlist-store
                                           erc-channel-banlist))))))
   nil)
 
+;; This was a default member of `erc-server-368-functions' (nee -hook)
+;; between January and June of 2003 (but not as part of any release).
 (defun erc-banlist-finished (proc parsed)
   "Record that we have received the banlist."
+  (declare (obsolete "uses obsolete and likely faulty logic" "31.1"))
   (let* ((channel (nth 1 (erc-response.command-args parsed)))
          (buffer (erc-get-buffer channel proc)))
     (with-current-buffer buffer
       (put 'erc-channel-banlist 'received-from-server t)))
   t)                                    ; suppress the 'end of banlist' message
 
+(defun erc--banlist-update (statep mask)
+  "Add or remove a mask from `erc-channel-banlist'."
+  (if statep
+      (let ((whoset (erc-response.sender erc--parsed-response)))
+        (cl-pushnew (cons whoset mask) erc-channel-banlist :test #'equal))
+    (let ((upcased (upcase mask)))
+      (setq erc-channel-banlist
+            (cl-delete-if (lambda (y) (equal (upcase (cdr y)) upcased))
+                          erc-channel-banlist)))))
+
 (defun erc-banlist-update (proc parsed)
   "Check MODE commands for bans and update the banlist appropriately."
   ;; FIXME: Possibly incorrect. -- Lawrence 2004-05-11
+  (declare (obsolete "`erc-channel-banlist' always updated on MODE" "31.1"))
   (let* ((tgt (car (erc-response.command-args parsed)))
          (mode (erc-response.contents parsed))
          (whoset (erc-response.sender parsed))
@@ -7732,6 +7746,11 @@ erc--handle-channel-mode
             (cl-pushnew (char-to-string c) erc-channel-modes :test #'equal)
           (delete (char-to-string c) erc-channel-modes))))
 
+;; We could specialize on type A, but that may be too brittle.
+(cl-defmethod erc--handle-channel-mode (_ (_ (eql ?b)) state arg)
+  ;; Add or remove a ban from `erc-channel-banlist'.
+  (erc--banlist-update state arg))
+
 ;; We could specialize on type C, but that may be too brittle.
 (cl-defmethod erc--handle-channel-mode (_ (_ (eql ?l)) state arg)
   "Update channel user limit, remembering ARG when STATE is non-nil."
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index b11f994bce8..560d3bbb3d0 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -934,8 +934,13 @@ erc--channel-modes
 
   (erc-tests-common-init-server-proc "sleep" "1")
 
-  (cl-letf (((symbol-function 'erc-update-mode-line) #'ignore))
-    (erc--update-channel-modes "+bltk" "fool!*@*" "3" "h2"))
+  (cl-letf ((erc--parsed-response (make-erc-response
+                                   :sender "chop!~u@gnu.org"))
+            ((symbol-function 'erc-update-mode-line) #'ignore))
+    (should-not erc-channel-banlist)
+    (erc--update-channel-modes "+bbltk" "fool!*@*" "spam!*@*" "3" "h2")
+    (should (equal erc-channel-banlist '(("chop!~u@gnu.org" . "spam!*@*")
+                                         ("chop!~u@gnu.org" . "fool!*@*")))))
 
   (should (equal (erc--channel-modes 'string) "klt"))
   (should (equal (erc--channel-modes 'strings) '("k" "l" "t")))
@@ -983,8 +988,12 @@ erc--channel-modes/graphic-p
         erc-server-parameters
         '(("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz")))
 
-  (cl-letf (((symbol-function 'erc-update-mode-line) #'ignore))
-    (erc--update-channel-modes "+bltk" "fool!*@*" "3" "hun2"))
+  (cl-letf ((erc--parsed-response (make-erc-response
+                                   :sender "chop!~u@gnu.org"))
+            ((symbol-function 'erc-update-mode-line) #'ignore))
+    (should-not erc-channel-banlist)
+    (erc--update-channel-modes "+bltk" "fool!*@*" "3" "hun2")
+    (should (equal erc-channel-banlist '(("chop!~u@gnu.org" . "fool!*@*")))))
 
   ;; Truncation cache populated and used.
   (let ((cache (erc--channel-mode-types-shortargs erc--channel-mode-types))
-- 
2.46.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0005-5.6.1-Fix-inconsistent-handling-of-ban-lists-in-ERC.patch --]
[-- Type: text/x-patch, Size: 12779 bytes --]

From 75d2be6b3f74ef0822a2e69ba2f94f5806aa4182 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 18 Aug 2024 22:58:33 -0700
Subject: [PATCH 5/5] [5.6.1] Fix inconsistent handling of ban lists in ERC

* etc/ERC-NEWS: Mention new function `erc-sync-banlist' in new section
for ERC 5.6.1.
* lisp/erc/erc-fill.el (erc--determine-fill-column-function): New
method for `fill' and `fill-wrap' modules.
* lisp/erc/erc-pcomplete.el (pcomplete/erc-mode/BANLIST)
(pcomplete/erc-mode/BL)
(pcomplete/erc-mode/MASSUNBAN, pcomplete/erc-mode/MUB):
New functions.
* lisp/erc/erc.el (erc-channel-banlist): Deprecate practice of using
the symbol-property `received-from-server' of as a state flag because
it's error-prone and bleeds into other connections.
(erc--channel-banlist-synchronized-p): New variable.
(erc-sync-banlist): New function, announced in ERC-NEWS.
(erc--wrap-banlist): New function.
(erc-banlist-fill-padding): New variable.
(erc--determine-fill-column-function): New generic function.
(erc-cmd-BANLIST): Move forward declaration of `erc-fill-column' from
top level into function body.  Always reset `received-from-server' to
nil.  Improve column calculations.
(erc-cmd-MASSUNBAN): Always reset `received-from-server' to nil.
---
 etc/ERC-NEWS              |   9 ++
 lisp/erc/erc-fill.el      |   6 ++
 lisp/erc/erc-pcomplete.el |   8 ++
 lisp/erc/erc.el           | 192 ++++++++++++++++++++------------------
 4 files changed, 124 insertions(+), 91 deletions(-)

diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 9803c3ff379..5dd72e6f1b3 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -11,6 +11,15 @@ This file is about changes in ERC, the powerful, modular, and
 extensible IRC (Internet Relay Chat) client distributed with
 GNU Emacs since Emacs version 22.1.
 
+\f
+* Changes in ERC 5.6.1
+
+** Reliable library access for ban lists.
+Say goodbye to continually running "/BANLIST" for programmatic
+purposes.  Modules can instead use the function 'erc-sync-banlist' to
+guarantee that the variable 'erc-channel-banlist' remain synced for
+the remainder of an IRC session.
+
 \f
 * Changes in ERC 5.6
 
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 986314822ba..fa9d2071ccd 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -896,6 +896,12 @@ erc-timestamp-offset
       (length (format-time-string erc-timestamp-format))
     0))
 
+(cl-defmethod erc--determine-fill-column-function
+  (&context (erc-fill-mode (eql t)))
+  (if erc-fill-wrap-mode
+      (- (window-width) erc-fill--wrap-value 1)
+    erc-fill-column))
+
 (provide 'erc-fill)
 
 ;;; erc-fill.el ends here
diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el
index 05cbaf3872f..afbe3895667 100644
--- a/lisp/erc/erc-pcomplete.el
+++ b/lisp/erc/erc-pcomplete.el
@@ -187,6 +187,14 @@ pcomplete/erc-mode/RECONNECT
   (pcomplete-here '("cancel"))
   (pcomplete-opt "a"))
 
+(defun pcomplete/erc-mode/BANLIST ()
+  (pcomplete-opt "f"))
+(defalias 'pcomplete/erc-mode/BL #'pcomplete/erc-mode/BANLIST)
+
+(defun pcomplete/erc-mode/MASSUNBAN ()
+  (pcomplete-opt "f"))
+(defalias 'pcomplete/erc-mode/MUB #'pcomplete/erc-mode/MASSUNBAN)
+
 ;;; Functions that provide possible completions.
 
 (defun pcomplete-erc-commands ()
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index e1fd279f405..ef8515790cd 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -5556,108 +5556,117 @@ erc-cmd-CLEARTOPIC
 (defvar-local erc-channel-banlist nil
   "A list of bans seen for the current channel.
 
-Each ban is an alist of the form:
-  (WHOSET . MASK)
-
-The property `received-from-server' indicates whether
-or not the ban list has been requested from the server.")
+Entries are cons cells of the form (WHOSET . MASK), where WHOSET is the
+channel operator who issued the ban.  Modules needing such a list should
+call `erc-sync-banlist' once per session in the channel before accessing
+the variable.  Interactive users need only issue a /BANLIST.  Note that
+older versions of ERC relied on a deprecated convention involving a
+property of the symbol `erc-channel-banlist' to indicate whether a ban
+list had been received in full, but this was found to be unreliable.")
 (put 'erc-channel-banlist 'received-from-server nil)
 
-(defvar erc-fill-column)
-
-(defun erc-cmd-BANLIST ()
-  "Pretty-print the contents of `erc-channel-banlist'.
-
-The ban list is fetched from the server if necessary."
-  (let ((chnl (erc-default-target))
-        (chnl-name (buffer-name)))
-
-    (cond
-     ((not (erc-channel-p chnl))
-      (erc-display-message nil 'notice 'active "You're not on a channel\n"))
-
-     ((not (get 'erc-channel-banlist 'received-from-server))
-      (let ((old-367-hook erc-server-367-functions))
-        (setq erc-server-367-functions 'erc-banlist-store
-              erc-channel-banlist nil)
-        ;; fetch the ban list then callback
-        (erc-with-server-buffer
-          (erc-once-with-server-event
-           368
-           (lambda (_proc _parsed)
-             (with-current-buffer chnl-name
-               (put 'erc-channel-banlist 'received-from-server t)
-               (setq erc-server-367-functions old-367-hook)
-               (erc-cmd-BANLIST)
-               t)))
-          (erc-server-send (format "MODE %s b" chnl)))))
-
-     ((null erc-channel-banlist)
-      (erc-display-message nil 'notice 'active
-                           (format "No bans for channel: %s\n" chnl))
+(defvar-local erc--channel-banlist-synchronized-p nil
+  "Whether the channel banlist has been fetched since joining.")
+
+(defun erc-sync-banlist (&optional done-fn)
+  "Initialize syncing of current channel's `erc-channel-banlist'.
+Arrange for it to remain synced for the rest of the IRC session.  When
+DONE-FN is non-nil, call it with no args once fully updated, and expect
+it to return non-nil, if necessary, to inhibit further processing."
+  (unless (erc-channel-p (current-buffer))
+    (error "Not a channel buffer"))
+  (let ((channel (erc-target))
+        (buffer (current-buffer))
+        (hook (lambda (&rest r) (always (apply #'erc-banlist-store r)))))
+    (setq erc-channel-banlist nil)
+    (erc-with-server-buffer
+      (add-hook 'erc-server-367-functions hook -98 t)
+      (erc-once-with-server-event
+       368 (lambda (&rest _)
+             (remove-hook 'erc-server-367-functions hook t)
+             (with-current-buffer buffer
+               (prog1 (if done-fn (funcall done-fn) t)
+                 (setq erc--channel-banlist-synchronized-p t)))))
+      (erc-server-send (format "MODE %s b" channel)))))
+
+(defun erc--wrap-banlist-cmd (slashcmd)
+  (lambda ()
+    (put 'erc-channel-banlist 'received-from-server t)
+    (unwind-protect (funcall slashcmd)
       (put 'erc-channel-banlist 'received-from-server nil))
+    t))
 
-     (t
-      (let* ((erc-fill-column (or (and (boundp 'erc-fill-column)
-                                       erc-fill-column)
-                                  (and (boundp 'fill-column)
-                                       fill-column)
-                                  (1- (window-width))))
-             (separator (make-string erc-fill-column ?=))
-             (fmt (concat
-                   "%-" (number-to-string (/ erc-fill-column 2)) "s"
-                   "%" (number-to-string (/ erc-fill-column 2)) "s")))
+(defvar erc-banlist-fill-padding 1.0
+  "Scaling factor from 0 to 1 of free space between entries, if any.")
 
-        (erc-display-message
-         nil 'notice 'active
-         (format "Ban list for channel: %s\n" (erc-default-target)))
-
-        (erc-display-line separator 'active)
-        (erc-display-line (format fmt "Ban Mask" "Banned By") 'active)
-        (erc-display-line separator 'active)
-
-        (mapc
-         (lambda (x)
-           (erc-display-line
-            (format fmt
-                    (truncate-string-to-width (cdr x) (/ erc-fill-column 2))
-                    (if (car x)
-                        (truncate-string-to-width (car x) (/ erc-fill-column 2))
-                      ""))
-            'active))
-         erc-channel-banlist)
-
-        (erc-display-message nil 'notice 'active "End of Ban list")
-        (put 'erc-channel-banlist 'received-from-server nil)))))
+(cl-defgeneric erc--determine-fill-column-function ()
+  fill-column)
+
+(defun erc-cmd-BANLIST (&rest args)
+  "Print the list of ban masks for the current channel.
+When uninitialized or with option -f, resync `erc-channel-banlist'."
+  (cond
+   ((not (erc-channel-p (current-buffer)))
+    (erc-display-message nil 'notice 'active "You're not on a channel\n"))
+   ((or (equal args '("-f"))
+        (and (not erc--channel-banlist-synchronized-p)
+             (not (get 'erc-channel-banlist 'received-from-server))))
+    (erc-sync-banlist (erc--wrap-banlist-cmd #'erc-cmd-BANLIST)))
+   ((null erc-channel-banlist)
+    (erc-display-message nil 'notice 'active
+                         (format "No bans for channel: %s\n" (erc-target))))
+   ((let ((max-width (erc--determine-fill-column-function))
+          (lw 0) (rw 0) separator fmt)
+      (dolist (entry erc-channel-banlist)
+        (setq rw (max (length (car entry)) rw)
+              lw (max (length (cdr entry)) lw)))
+      (let ((maxw (* 1.0 (min max-width (+ rw lw)))))
+        (when (< maxw (+ rw lw)) ; scale down when capped
+          (cl-psetq rw (/ (* rw maxw) (* 1.0 (+ rw lw)))
+                    lw (/ (* lw maxw) (* 1.0 (+ rw lw)))))
+        (when-let ((larger (max rw lw)) ; cap ratio at 3:1
+                   (wavg (* maxw 0.75))
+                   ((> larger wavg)))
+          (setq rw (if (eql larger rw) wavg (- maxw wavg))
+                lw (- maxw rw)))
+        (cl-psetq rw (+ rw (* erc-banlist-fill-padding
+                              (- (/ (* rw max-width) maxw) rw)))
+                  lw (+ lw (* erc-banlist-fill-padding
+                              (- (/ (* lw max-width) maxw) lw)))))
+      (setq rw (truncate rw)
+            lw (truncate lw))
+      (cl-assert (<= (+ rw lw) max-width))
+      (setq separator (make-string (+ rw lw 1) ?=)
+            fmt (concat "%-" (number-to-string lw) "s "
+                        "%" (number-to-string rw) "s"))
+      (erc-display-message
+       nil 'notice 'active
+       (format "Ban list for channel: %s%s\n" (erc-target)
+               (if erc--channel-banlist-synchronized-p " (cached)" "")))
+      (erc-display-line separator 'active)
+      (erc-display-line (format fmt "Ban Mask" "Banned By") 'active)
+      (erc-display-line separator 'active)
+      (dolist (entry erc-channel-banlist)
+        (erc-display-line
+         (format fmt (truncate-string-to-width (cdr entry) lw)
+                 (truncate-string-to-width (car entry) rw))
+         'active))
+      (erc-display-message nil 'notice 'active "End of Ban list"))))
+  (put 'erc-channel-banlist 'received-from-server nil)
   t)
 
 (defalias 'erc-cmd-BL #'erc-cmd-BANLIST)
 
-(defun erc-cmd-MASSUNBAN ()
-  "Mass Unban.
-
-Unban all currently banned users in the current channel."
+(defun erc-cmd-MASSUNBAN (&rest args)
+  "Remove all bans in the current channel."
   (let ((chnl (erc-default-target)))
     (cond
-
      ((not (erc-channel-p chnl))
       (erc-display-message nil 'notice 'active "You're not on a channel\n"))
-
-     ((not (get 'erc-channel-banlist 'received-from-server))
-      (let ((old-367-hook erc-server-367-functions))
-        (setq erc-server-367-functions 'erc-banlist-store)
-        ;; fetch the ban list then callback
-        (erc-with-server-buffer
-          (erc-once-with-server-event
-           368
-           (lambda (_proc _parsed)
-             (with-current-buffer chnl
-               (put 'erc-channel-banlist 'received-from-server t)
-               (setq erc-server-367-functions old-367-hook)
-               (erc-cmd-MASSUNBAN)
-               t)))
-          (erc-server-send (format "MODE %s b" chnl)))))
-
+     ((or (equal args '("-f"))
+          (and (not erc--channel-banlist-synchronized-p)
+               (not (get 'erc-channel-banlist 'received-from-server))))
+      (erc-sync-banlist (erc--wrap-banlist-cmd #'erc-cmd-MASSUNBAN)))
      (t (let ((bans (mapcar #'cdr erc-channel-banlist)))
           (when bans
             ;; Glob the bans into groups of three, and carry out the unban.
@@ -5668,8 +5677,9 @@ erc-cmd-MASSUNBAN
                 (format "MODE %s -%s %s" (erc-default-target)
                         (make-string (length x) ?b)
                         (mapconcat #'identity x " "))))
-             (erc-group-list bans 3))))
-        t))))
+             (erc-group-list bans 3))))))
+    (put 'erc-channel-banlist 'received-from-server nil)
+    t))
 
 (defalias 'erc-cmd-MUB #'erc-cmd-MASSUNBAN)
 
-- 
2.46.0


^ permalink raw reply related	[flat|nested] 4+ messages in thread
end of thread, other threads:[~2024-10-01  0:15 UTC | newest]

Thread overview: 4+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2024-08-20 20:10 bug#72736: 31.0.50; ERC 5.6.1: Keep ban lists in sync J.P.
2024-08-24 18:03 ` J.P.
     [not found] ` <87msl123y6.fsf@neverwas.me>
2024-09-05 21:58   ` J.P.
     [not found]   ` <87mskl3gpv.fsf@neverwas.me>
2024-10-01  0:15     ` J.P.

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).