From c7ed508ef36fcb2f0c6731b588b953c77b2eb0db Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 20 Apr 2023 19:20:59 -0700 Subject: [PATCH 4/4] [5.6] Ignore erc-reconnect-display after a timeout * lisp/erc/erc-backend.el (erc--server-reconnect-display-timer): New variable to store active timer that, upon firing, zeroes out `erc--server-last-reconnect-count'. (erc--server-last-reconnect-on-disconnect): New function to run on `erc-disconnected-hook'. (erc--server-last-reconnect-display-reset): New function that ensures the reconnect-display window is closed. * lisp/erc/erc.el (erc-reconnect-display-timeout): New option to control how long `erc-reconnect-display' affects the displaying of new or reassociated buffers following an automatic reconnection. (erc-process-input-line): Ensure user input marks the end of the reconnect-display window. (erc-cmd-JOIN): Don't bother resetting `erc--server-last-reconnect-count' because it's now handled by the caller, `erc-process-input-line'. (erc-connection-established): Schedule timer and register hook to reset last-reconnect count and close the reconnect-display window. * test/lisp/erc/erc-scenarios-base-buffer-display.el: (erc-scenarios-base-buffer-display--reconnect-common): Add new args to test fixture. (erc-scenarios-base-reconnect-options--buffer, erc-scenarios-base-buffer-display--defwin-recbury-intbuf): Rename former to latter and rework to better reflect realistic settings for the relevant display options. (erc-scenarios-base-reconnect-options--default, erc-scenarios-base-buffer-display--defwino-recbury-intbuf): Rename former to latter and rework to be more realistic. (erc-scenarios-base-buffer-display--count-reset-timeout): New test for new option `erc-reconnect-display-timeout'. (Bug#62833) --- lisp/erc/erc-backend.el | 22 +++ lisp/erc/erc.el | 15 +- .../erc/erc-scenarios-base-buffer-display.el | 168 +++++++++++++----- 3 files changed, 159 insertions(+), 46 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 5d44f478719..c72c769f2e1 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -298,6 +298,12 @@ erc-server-connected (defvar-local erc-server-reconnect-count 0 "Number of times we have failed to reconnect to the current server.") +(defvar-local erc--server-reconnect-display-timer nil + "Timer that resets `erc--server-last-reconnect-count' to zero. +Becomes non-nil in all server buffers when an IRC connection is +first \"established\" and carries out its duties +`erc-reconnect-display-timeout' seconds later.") + (defvar-local erc--server-last-reconnect-count 0 "Snapshot of reconnect count when the connection was established.") @@ -902,6 +908,22 @@ erc-server-reconnect-p erc-server-reconnecting) (erc--server-reconnect-p event))) +(defun erc--server-last-reconnect-on-disconnect (&rest _) + (remove-hook 'erc-disconnected-hook + #'erc--server-last-reconnect-on-disconnect t) + (erc--server-last-reconnect-display-reset (current-buffer))) + +(defun erc--server-last-reconnect-display-reset (buffer) + "Deactivate `erc-reconnect-display'." + (when (buffer-live-p buffer) + (with-current-buffer buffer + (when erc--server-reconnect-display-timer + (cancel-timer erc--server-reconnect-display-timer) + (remove-hook 'erc-disconnected-hook + #'erc--server-last-reconnect-display-reset t) + (setq erc--server-reconnect-display-timer nil + erc--server-last-reconnect-count 0))))) + (defconst erc--mode-line-process-reconnecting '(:eval (erc-with-server-buffer (and erc--server-reconnect-timer diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 5f1aaaafe49..85b3d8bb650 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1564,6 +1564,13 @@ erc-reconnect-display (const :tag "Bury in new buffer" bury) (const :tag "Use current buffer" buffer))) +(defcustom erc-reconnect-display-timeout 10 + "Duration `erc-reconnect-display' remains active. +The countdown starts on MOTD and is canceled early by any +\"slash\" command." + :type 'integer + :group 'erc-buffer) + (defcustom erc-frame-alist nil "Alist of frame parameters for creating erc frames. A value of nil means to use `default-frame-alist'." @@ -3123,6 +3130,7 @@ erc-process-input-line (let* ((cmd (nth 0 command-list)) (args (nth 1 command-list)) (erc--called-as-input-p t)) + (erc--server-last-reconnect-display-reset (erc-server-buffer)) (condition-case nil (if (listp args) (apply cmd args) @@ -3595,7 +3603,6 @@ erc-cmd-JOIN ((with-current-buffer existing (erc-get-channel-user (erc-current-nick))))) (switch-to-buffer existing) - (setq erc--server-last-reconnect-count 0) (when-let* ; bind `erc-join-buffer' when /JOIN issued ((erc--called-as-input-p) (fn (lambda (proc parsed) @@ -5184,6 +5191,12 @@ erc-connection-established (setq erc-server-connected t) (setq erc--server-last-reconnect-count erc-server-reconnect-count erc-server-reconnect-count 0) + (setq erc--server-reconnect-display-timer + (run-at-time erc-reconnect-display-timeout nil + #'erc--server-last-reconnect-display-reset + (current-buffer))) + (add-hook 'erc-disconnected-hook + #'erc--server-last-reconnect-on-disconnect nil t) (erc-update-mode-line) (erc-set-initial-user-mode nick buffer) (erc-server-setup-periodical-ping buffer) diff --git a/test/lisp/erc/erc-scenarios-base-buffer-display.el b/test/lisp/erc/erc-scenarios-base-buffer-display.el index 3ed7a83653e..53a3d7e8ef7 100644 --- a/test/lisp/erc/erc-scenarios-base-buffer-display.el +++ b/test/lisp/erc/erc-scenarios-base-buffer-display.el @@ -29,7 +29,8 @@ ;; These first couple `erc-reconnect-display' tests used to live in ;; erc-scenarios-base-reconnect but have since been renamed. -(defun erc-scenarios-base-buffer-display--reconnect-common (test) +(defun erc-scenarios-base-buffer-display--reconnect-common + (assert-server assert-chan assert-rest) (erc-scenarios-common-with-cleanup ((erc-scenarios-common-dialog "base/reconnect") (dumb-server (erc-d-run "localhost" t 'options 'options-again)) @@ -37,87 +38,164 @@ erc-scenarios-base-buffer-display--reconnect-common (expect (erc-d-t-make-expecter)) (erc-server-flood-penalty 0.1) (erc-server-auto-reconnect t) - erc-autojoin-channels-alist - erc-server-buffer) + erc-autojoin-channels-alist) (should (memq 'autojoin erc-modules)) (ert-info ("Connect to foonet") - (setq erc-server-buffer (erc :server "127.0.0.1" - :port port - :nick "tester" - :password "changeme" - :full-name "tester")) - (with-current-buffer erc-server-buffer + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :password "changeme" + :full-name "tester") + (funcall assert-server expect) (should (string= (buffer-name) (format "127.0.0.1:%d" port))) (funcall expect 10 "debug mode"))) (ert-info ("Wait for some output in channels") (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall assert-chan expect) (funcall expect 10 "welcome"))) (ert-info ("Server buffer shows connection failed") - (with-current-buffer erc-server-buffer + (with-current-buffer "FooNet" (funcall expect 10 "Connection failed! Re-establishing"))) (should (equal erc-autojoin-channels-alist '((FooNet "#chan")))) - - (funcall test) - - ;; A manual /JOIN command tells ERC we're done auto-reconnecting - (with-current-buffer "FooNet" (erc-cmd-JOIN "#spam")) - - (erc-d-t-ensure-for 1 "Newly joined chan ignores `erc-reconnect-display'" - (not (eq (window-buffer) (get-buffer "#spam")))) + (delete-other-windows) + (pop-to-buffer-same-window "*Messages*") (ert-info ("Wait for auto reconnect") - (with-current-buffer erc-server-buffer - (funcall expect 10 "still in debug mode"))) + (with-current-buffer "FooNet" (funcall expect 10 "still in debug mode"))) - (ert-info ("Wait for activity to recommence in channels") + (funcall assert-rest expect) + + (ert-info ("Wait for activity to recommence in both channels") (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) (funcall expect 10 "forest of Arden")) (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) (funcall expect 10 "her elves come here anon"))))) -(ert-deftest erc-scenarios-base-reconnect-options--buffer () +(ert-deftest erc-scenarios-base-buffer-display--defwin-recbury-intbuf () :tags '(:expensive-test) - (should (eq erc-join-buffer 'bury)) + (should (eq erc-buffer-display 'bury)) + (should (eq erc-interactive-display 'window)) (should-not erc-reconnect-display) - ;; FooNet (the server buffer) is not switched to because it's - ;; already current (but not shown) when `erc-open' is called. See - ;; related conditional guard towards the end of that function. + (let ((erc-buffer-display 'window) + (erc-interactive-display 'buffer) + (erc-reconnect-display 'bury)) - (let ((erc-reconnect-display 'buffer)) (erc-scenarios-base-buffer-display--reconnect-common - (lambda () - (pop-to-buffer-same-window "*Messages*") - (erc-d-t-ensure-for 1 "Server buffer not shown" - (not (eq (window-buffer) (get-buffer "FooNet")))) + (lambda (_) + (should (eq (window-buffer) (current-buffer))) + (should-not (frame-root-window-p (selected-window)))) - (erc-d-t-wait-for 5 "Channel #chan shown when autojoined" - (eq (window-buffer) (get-buffer "#chan"))))))) + (lambda (_) + (should (eq (window-buffer) (current-buffer))) + (should (equal (get-buffer "FooNet") (window-buffer (next-window))))) -(ert-deftest erc-scenarios-base-reconnect-options--default () - :tags '(:expensive-test) - (should (eq erc-join-buffer 'bury)) - (should-not erc-reconnect-display) + (lambda (_) + (with-current-buffer "FooNet" + (should (eq (window-buffer) (messages-buffer))) + (should (frame-root-window-p (selected-window)))) - (erc-scenarios-base-buffer-display--reconnect-common + ;; A manual /JOIN command tells ERC we're done auto-reconnecting + (with-current-buffer "FooNet" (erc-scenarios-common-say "/JOIN #spam")) - (lambda () - (pop-to-buffer-same-window "*Messages*") + (ert-info ("#spam ignores `erc-reconnect-display'") + ;; Uses `erc-interactive-display' instead. + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) + (should (eq (window-buffer) (get-buffer "#spam"))) + ;; Option `buffer' replaces entire window (no split) + (should (frame-root-window-p (selected-window))))))))) - (erc-d-t-ensure-for 1 "Server buffer not shown" - (not (eq (window-buffer) (get-buffer "FooNet")))) +(ert-deftest erc-scenarios-base-buffer-display--defwino-recbury-intbuf () + :tags '(:expensive-test) + (should (eq erc-buffer-display 'bury)) + (should (eq erc-interactive-display 'window)) + (should-not erc-reconnect-display) - (erc-d-t-ensure-for 3 "Channel #chan not shown" - (not (eq (window-buffer) (get-buffer "#chan")))) + (let ((erc-buffer-display 'window-noselect) + (erc-reconnect-display 'bury) + (erc-interactive-display 'buffer)) + (erc-scenarios-base-buffer-display--reconnect-common - (should (eq (window-buffer) (messages-buffer)))))) + (lambda (_) + ;; Selected window shows some non-ERC buffer. New server + ;; buffer appears in another window (other side of split). + (should-not (frame-root-window-p (selected-window))) + (should-not (eq (window-buffer) (current-buffer))) + (with-current-buffer (window-buffer) + (should-not (derived-mode-p 'erc-mode))) + (should (eq (current-buffer) (window-buffer (next-window))))) + + (lambda (_) + (should-not (frame-root-window-p (selected-window))) + ;; Current split likely shows scratch. + (with-current-buffer (window-buffer) + (should-not (derived-mode-p 'erc-mode))) + (should (eq (current-buffer) (window-buffer (next-window))))) + + (lambda (_) + (with-current-buffer "FooNet" + (should (eq (window-buffer) (messages-buffer))) + (should (frame-root-window-p (selected-window)))) + + ;; A non-interactive JOIN command doesn't signal that we're + ;; done auto-reconnecting, and `erc-interactive-display' is + ;; ignored, so `erc-buffer-display' is again in charge (here, + ;; that means `window-noselect'). + (ert-info ("Join chan noninteractively and open a /QUERY") + (with-current-buffer "FooNet" + (erc-cmd-JOIN "#spam") + ;; However this will reset the option. + (erc-scenarios-common-say "/QUERY bob") + (should (eq (window-buffer) (get-buffer "bob"))) + (should (frame-root-window-p (selected-window))))) + + (ert-info ("Newly joined chan ignores `erc-reconnect-display'") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) + (should (eq (window-buffer) (get-buffer "bob"))) + (should-not (frame-root-window-p (selected-window))) + (should (eq (current-buffer) (window-buffer (next-window)))))))))) + +(ert-deftest erc-scenarios-base-buffer-display--count-reset-timeout () + :tags '(:expensive-test) + (should (eq erc-buffer-display 'bury)) + (should (eq erc-interactive-display 'window)) + (should (eq erc-reconnect-display-timeout 10)) + (should-not erc-reconnect-display) + (let ((erc-buffer-display 'window-noselect) + (erc-reconnect-display 'bury) + (erc-interactive-display 'buffer) + ;; Try changing this value to 1. The last `ert-info' block + ;; should fail. + (erc-reconnect-display-timeout 0.1)) + (erc-scenarios-base-buffer-display--reconnect-common + #'ignore #'ignore ; These two are identical to the previous test. + + (lambda (_) + (with-current-buffer "FooNet" + (should (eq (window-buffer) (messages-buffer))) + (should (frame-root-window-p (selected-window)))) + + ;; A non-interactive JOIN command doesn't signal that we're + ;; done auto-reconnecting + (ert-info ("Join chan noninteractively") + (with-current-buffer "FooNet" + (sit-for 0.1) + (erc-cmd-JOIN "#spam"))) + + (ert-info ("Newly joined chan ignores `erc-reconnect-display'") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) + (should (eq (window-buffer) (messages-buffer))) + ;; If `erc-reconnect-display-timeout' were left alone, this + ;; would be (frame-root-window-p #). + (should-not (frame-root-window-p (selected-window))) + (should (eq (current-buffer) (window-buffer (next-window)))))))))) ;; This shows that the option `erc-interactive-display' overrides ;; `erc-join-buffer' during cold opens and interactive /JOINs. -- 2.39.2