emacs-29 fda1ad4a9e 3/3: Remove obsolete server buffers on MOTD in erc-track

[F. Jason Park]

branch: emacs-29
commit fda1ad4a9ec030d013fc16c92d8494bc755b3763
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>

    Remove obsolete server buffers on MOTD in erc-track
    
    * lisp/erc/erc-networks.el
    (erc-networks--copy-server-buffer-functions): New internal hook
    through which modules can perform housekeeping when server buffers
    belonging to the same network context are merged.
    (erc-networks--copy-over-server-buffer-contents): Run new internal
    hook `erc-networks--copy-server-buffer-functions'.
    * lisp/erc/erc-track.el (erc-track-enable, erc-track-disable): Manage
    membership in `erc-networks--copy-server-buffer-functions' hook.
    (erc-track--replace-killed-buffer): New function to replace server
    buffer being killed in `erc-modified-channels-alist'.
    * test/lisp/erc/erc-scenarios-base-association.el
    (erc-scenarios-networks-merge-server-track): New test.
    * test/lisp/erc/resources/networks/merge-server/track.eld: New test
    data.  (Bug#60560.)
---
 lisp/erc/erc-networks.el                           |  6 +++
 lisp/erc/erc-track.el                              | 12 +++++-
 test/lisp/erc/erc-scenarios-base-association.el    | 49 ++++++++++++++++++++++
 .../erc/resources/networks/merge-server/track.eld  | 44 +++++++++++++++++++
 4 files changed, 109 insertions(+), 2 deletions(-)

diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index 4044be08f9..95fd8990c9 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -1366,6 +1366,11 @@ ANNOUNCED is the server's reported host name."
                erc-server-connected t
                erc-networks--id nid))))))
 
+(defvar erc-networks--copy-server-buffer-functions nil
+  "Abnormal hook run in new server buffers when deduping.
+Passed the existing buffer to be killed, whose contents have
+already been copied over to the current, replacement buffer.")
+
 (defun erc-networks--copy-over-server-buffer-contents (existing name)
   "Kill off existing server buffer after copying its contents.
 Must be called from the replacement buffer."
@@ -1386,6 +1391,7 @@ Must be called from the replacement buffer."
         erc-kill-server-hook
         erc-kill-buffer-hook)
     (erc-networks--insert-transplanted-content text)
+    (run-hook-with-args 'erc-networks--copy-server-buffer-functions existing)
     (kill-buffer name)))
 
 ;; This stands alone for testing purposes
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index 61c0c66abf..7fd7b53602 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -521,7 +521,9 @@ keybindings will not do anything useful."
        (add-hook 'erc-disconnected-hook #'erc-modified-channels-update))
      ;; enable the tracking keybindings
      (add-hook 'erc-connect-pre-hook #'erc-track-minor-mode-maybe)
-     (erc-track-minor-mode-maybe)))
+     (erc-track-minor-mode-maybe))
+   (add-hook 'erc-networks--copy-server-buffer-functions
+             #'erc-track--replace-killed-buffer))
   ;; Disable:
   ((when (boundp 'erc-track-when-inactive)
      (erc-track-remove-from-mode-line)
@@ -539,7 +541,9 @@ keybindings will not do anything useful."
      ;; disable the tracking keybindings
      (remove-hook 'erc-connect-pre-hook #'erc-track-minor-mode-maybe)
      (when erc-track-minor-mode
-       (erc-track-minor-mode -1)))))
+       (erc-track-minor-mode -1)))
+   (remove-hook 'erc-networks--copy-server-buffer-functions
+                #'erc-track--replace-killed-buffer)))
 
 (defcustom erc-track-when-inactive nil
   "Enable channel tracking even for visible buffers, if you are inactive."
@@ -942,6 +946,10 @@ reverse it."
   (interactive "p")
   (erc-track--switch-buffer 'switch-to-buffer-other-window arg))
 
+(defun erc-track--replace-killed-buffer (existing)
+  (when-let ((found (assq existing erc-modified-channels-alist)))
+    (setcar found (current-buffer))))
+
 (provide 'erc-track)
 
 ;;; erc-track.el ends here
diff --git a/test/lisp/erc/erc-scenarios-base-association.el 
b/test/lisp/erc/erc-scenarios-base-association.el
index 1e280d0fdd..a40a4cb755 100644
--- a/test/lisp/erc/erc-scenarios-base-association.el
+++ b/test/lisp/erc/erc-scenarios-base-association.el
@@ -26,7 +26,9 @@
 
 (declare-function erc-network-name "erc-networks")
 (declare-function erc-network "erc-networks")
+(declare-function erc-track-get-active-buffer "erc-track" (arg))
 (defvar erc-autojoin-channels-alist)
+(defvar erc-track-mode)
 (defvar erc-network)
 
 ;; Two networks, same channel name, no confusion (no bouncer).  Some
@@ -190,4 +192,51 @@
       (with-current-buffer "#chan@barnet"
         (erc-d-t-search-for 10 "I'll bid adieu")))))
 
+;; Some modules may need to perform housekeeping when a newly
+;; connected server buffer is deemed a duplicate after its persistent
+;; network context is discovered on MOTD end.  One such module is
+;; `track', which needs to rid its list of modified channels of the
+;; buffer being killed.  Without this, a user may encounter an
+;; "Attempt to display deleted buffer" error when they try switching
+;; to it.
+
+(ert-deftest erc-scenarios-networks-merge-server-track ()
+  :tags '(:expensive-test)
+  (erc-scenarios-common-with-cleanup
+      ((erc-scenarios-common-dialog "networks/merge-server")
+       (dumb-server (erc-d-run "localhost" t 'track 'track))
+       (port (process-contact dumb-server :service))
+       (erc-server-flood-penalty 0.1)
+       (expect (erc-d-t-make-expecter)))
+
+    (ert-info ("Connect")
+      (with-current-buffer (erc :server "127.0.0.1"
+                                :port port
+                                :nick "tester")
+        (should (string= (buffer-name) (format "127.0.0.1:%d" port)))
+        (should erc-track-mode)
+        (funcall expect 5 "changed mode for tester")
+        (erc-cmd-JOIN "#chan")))
+
+    (ert-info ("Join channel and quit")
+      (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+        (funcall expect 5 "The hour that fools should ask")
+        (erc-cmd-QUIT ""))
+      (with-current-buffer "FooNet"
+        (funcall expect 5 "finished")))
+
+    (ert-info ("Reconnect")
+      (with-current-buffer (erc :server "127.0.0.1"
+                                :port port
+                                :nick "tester")
+        (should (string= (buffer-name) (format "127.0.0.1:%d" port)))
+        (funcall expect 5 "changed mode for tester")))
+
+    (with-current-buffer "#chan"
+      (funcall expect 5 "The hour that fools should ask")
+      ;; Simulate the old `erc-track-switch-buffer'
+      (switch-to-buffer (erc-track-get-active-buffer 1))
+      (erc-d-t-wait-for 10 (eq (get-buffer "FooNet") (current-buffer)))
+      (erc-cmd-QUIT ""))))
+
 ;;; erc-scenarios-base-association.el ends here
diff --git a/test/lisp/erc/resources/networks/merge-server/track.eld 
b/test/lisp/erc/resources/networks/merge-server/track.eld
new file mode 100644
index 0000000000..4a97f92f72
--- /dev/null
+++ b/test/lisp/erc/resources/networks/merge-server/track.eld
@@ -0,0 +1,44 @@
+;; -*- mode: lisp-data; -*-
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :unknown")
+ (0.00 ":irc.example.net NOTICE * :*** Looking up your hostname...")
+ (0.01 ":irc.example.net NOTICE tester :*** Could not resolve your hostname: 
Domain not found; using your IP address (10.0.2.100) instead.")
+ (0.10 ":irc.example.net 001 tester :Welcome to the FooNet IRC Network 
tester!user@10.0.2.100")
+ (0.02 ":irc.example.net 002 tester :Your host is irc.example.net, running 
version InspIRCd-3")
+ (0.02 ":irc.example.net 003 tester :This server was created 05:58:57 Jan 04 
2023")
+ (0.01 ":irc.example.net 004 tester irc.example.net InspIRCd-3 BIRcgikorsw 
ACHIKMORTXabcefghijklmnopqrstvz :HIXabefghjkloqv")
+ (0.00 ":irc.example.net 005 tester ACCEPT=30 AWAYLEN=200 BOT=B CALLERID=g 
CASEMAPPING=ascii CHANLIMIT=#:20 CHANMODES=IXbeg,k,Hfjl,ACKMORTcimnprstz 
CHANNELLEN=64 CHANTYPES=# ELIST=CMNTU ESILENCE=CcdiNnPpTtx EXCEPTS=e :are 
supported by this server")
+ (0.02 ":irc.example.net 005 tester EXTBAN=,ACORTUacjrwz HOSTLEN=64 INVEX=I 
KEYLEN=32 KICKLEN=255 LINELEN=512 MAXLIST=I:100,X:100,b:100,e:100,g:100 
MAXTARGETS=20 MODES=20 MONITOR=30 NAMELEN=128 NAMESX NETWORK=FooNet :are 
supported by this server")
+ (0.01 ":irc.example.net 005 tester NICKLEN=30 PREFIX=(qaohv)~&@%+ SAFELIST 
SILENCE=32 STATUSMSG=~&@%+ TOPICLEN=307 UHNAMES USERIP USERLEN=10 
USERMODES=,,s,BIRcgikorw WHOX :are supported by this server")
+ (0.01 ":irc.example.net 251 tester :There are 2 users and 0 invisible on 2 
servers")
+ (0.01 ":irc.example.net 253 tester 1 :unknown connections")
+ (0.01 ":irc.example.net 254 tester 1 :channels formed")
+ (0.00 ":irc.example.net 255 tester :I have 2 clients and 1 servers")
+ (0.00 ":irc.example.net 265 tester :Current local users: 2  Max: 3")
+ (0.00 ":irc.example.net 266 tester :Current global users: 2  Max: 3")
+ (0.00 ":irc.example.net 375 tester :irc.example.net message of the day")
+ (0.00 ":irc.example.net 372 tester :  Have fun with the image!")
+ (0.00 ":irc.example.net 376 tester :End of message of the day."))
+
+((mode 10 "MODE tester +i")
+ (0.00 ":irc.example.net 501 tester x :is not a recognised user mode.")
+ (0.00 ":NickServ!NickServ@services.int NOTICE tester :Welcome to FooNet, 
tester! Here on FooNet, we provide services to enable the registration of 
nicknames and channels! For details, type \2/msg NickServ help\2 and \2/msg 
ChanServ help\2.")
+ (0.02 ":tester!user@10.0.2.100 MODE tester :+i"))
+
+((join 10 "JOIN #chan")
+ (0.01 ":tester!user@10.0.2.100 JOIN :#chan"))
+
+((mode 10 "MODE #chan")
+ (0.01 ":irc.example.net 353 tester = #chan :@alice bob tester")
+ (0.01 ":irc.example.net 366 tester #chan :End of /NAMES list.")
+ (0.00 ":alice!alice@0::1 PRIVMSG #chan :tester, welcome!")
+ (0.02 ":bob!bob@0::1 PRIVMSG #chan :tester, welcome!")
+ (0.02 ":irc.example.net 324 tester #chan :+nt")
+ (0.01 ":irc.example.net 329 tester #chan :1672811954")
+ (0.07 ":alice!alice@0::1 PRIVMSG #chan :bob: This afternoon, sir ? well, she 
shall be there.")
+ (0.05 ":bob!bob@0::1 PRIVMSG #chan :alice: The hour that fools should ask."))
+
+((quit 10 "QUIT :\2ERC\2")
+ (0.04 "ERROR :Closing link: (user@10.0.2.100) [Quit: \2ERC\2]"))
+
+((drop 1 DROP))