master e7f2f6cd92 04/10: Improve auto-reconnect visibility in ERC

[F. Jason Park]

branch: master
commit e7f2f6cd92b924ecdfcf1356560d4a168546677d
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>

    Improve auto-reconnect visibility in ERC
    
    * lisp/erc/erc-backend.el (erc--server-reconnect-timer): New variable.
    (erc-server-reconnect-function): New user option.
    (erc-process-sentinel-2): Display time remaining until next
    reconnection attempt.  Also remove condition case and move bulk of
    else condition logic to `erc-schedule-reconnect'.  More importantly,
    no longer set `erc--server-reconnecting here').
    (erc-server-connect): Initialize `erc--server-reconnect-timer' to nil.
    (erc-server-reconnect): Set `erc-server--reconnecting' here.
    (erc--mode-line-process-reconnecting): New constant to store value for
    "reconnect" state of `mode-line-process'.
    (erc--cancel-auto-reconnect-timer): New function to cancel
    auto-reconnect timer and print message.
    (erc-schedule-reconnect): New function for scheduling another
    reconnect attempt.
    
    * lisp/erc/erc.el (erc-open): Only update mode line for target
    buffers. For server buffers, let `erc-login' and/or process sentinels
    take care of it.
    (erc--cmd-reconnect, erc-cmd-RECONNECT): Rename latter to former, a
    new function, but repurpose existing to recognize newly allowed
    additional arguments and act accordingly.  In new internal function,
    cancel an existing auto-reconnect timer, if any, before proceeding.
    Defer to `erc-server-reconnect' to set `erc--server-reconnecting'.
    Fix `with-suppressed-warnings' form.
    (erc-update-mode-line-buffer): Show "reconnecting in Ns" for
    `mode-line-process' when awaiting an automatic reconnect attempt.
    (erc-message-english-reconnecting,
    erc-message-english-reconnect-canceled): Add new message functions to
    English catalog.
    
    * lisp/erc/erc-pcomplete.el (pcomplete/erc-mode/RECONNECT): Perform
    completion for newly subcommand-aware `erc-cmd-RECONNECT'.
    
    * lisp/erc/erc-scenarios-base-reconnect
    (erc-scenarios-base-cancel-reconnect): Add new test case for canceling
    reconnect timers.  (Bug#58840.)
---
 lisp/erc/erc-backend.el                       | 77 ++++++++++++++++++++-------
 lisp/erc/erc-pcomplete.el                     |  4 ++
 lisp/erc/erc.el                               | 45 ++++++++++------
 test/lisp/erc/erc-scenarios-base-reconnect.el | 46 ++++++++++++++++
 4 files changed, 137 insertions(+), 35 deletions(-)

diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 026b34849a..51c92e0f12 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -299,6 +299,9 @@ function `erc-server-process-alive' instead.")
 (defvar-local erc--server-last-reconnect-count 0
   "Snapshot of reconnect count when the connection was established.")
 
+(defvar-local erc--server-reconnect-timer nil
+  "Auto-reconnect timer for a network context.")
+
 (defvar-local erc-server-quitting nil
   "Non-nil if the user requests a quit.")
 
@@ -401,6 +404,16 @@ This only has an effect if `erc-server-auto-reconnect' is 
non-nil."
 If a key is pressed while ERC is waiting, it will stop waiting."
   :type 'number)
 
+(defcustom erc-server-reconnect-function 'erc-server-delayed-reconnect
+  "Function called by the reconnect timer to create a new connection.
+Called with a server buffer as its only argument.  Potential uses
+include exponential backoff and probing for connectivity prior to
+dialing.  Use `erc-schedule-reconnect' to instead try again later
+and optionally alter the attempts tally."
+  :package-version '(ERC . "5.4.1") ; FIXME on next release
+  :type '(choice (function-item erc-server-delayed-reconnect)
+                 function))
+
 (defcustom erc-split-line-length 440
   "The maximum length of a single message.
 If a message exceeds this size, it is broken into multiple ones.
@@ -645,7 +658,8 @@ TLS (see `erc-session-client-certificate' for more 
details)."
       (setq erc-server-process process)
       (setq erc-server-quitting nil)
       (setq erc-server-reconnecting nil
-            erc--server-reconnecting nil)
+            erc--server-reconnecting nil
+            erc--server-reconnect-timer nil)
       (setq erc-server-timed-out nil)
       (setq erc-server-banned nil)
       (setq erc-server-error-occurred nil)
@@ -686,6 +700,7 @@ Make sure you are in an ERC buffer when running this."
     (with-current-buffer buffer
       (erc-update-mode-line)
       (erc-set-active-buffer (current-buffer))
+      (setq erc--server-reconnecting t)
       (setq erc-server-last-sent-time 0)
       (setq erc-server-lines-sent 0)
       (let ((erc-server-connect-function (or erc-session-connector
@@ -758,37 +773,59 @@ EVENT is the message received from the closed connection 
process."
         erc-server-reconnecting)
       (erc--server-reconnect-p event)))
 
+(defconst erc--mode-line-process-reconnecting
+  '(:eval (erc-with-server-buffer
+            (and erc--server-reconnect-timer
+                 (format ": reconnecting in %.1fs"
+                         (- (timer-until erc--server-reconnect-timer
+                                         (current-time)))))))
+  "Mode-line construct showing seconds until next reconnect attempt.
+Move point around to refresh.")
+
+(defun erc--cancel-auto-reconnect-timer ()
+  (when erc--server-reconnect-timer
+    (cancel-timer erc--server-reconnect-timer)
+    (erc-display-message nil 'notice nil 'reconnect-canceled
+                         ?u (buffer-name)
+                         ?c (- (timer-until erc--server-reconnect-timer
+                                            (current-time))))
+    (setq erc--server-reconnect-timer nil)
+    (erc-update-mode-line)))
+
+(defun erc-schedule-reconnect (buffer &optional incr)
+  "Create and return a reconnect timer for BUFFER.
+When `erc-server-reconnect-attempts' is a number, increment
+`erc-server-reconnect-count' by INCR unconditionally."
+  (let ((count (and (integerp erc-server-reconnect-attempts)
+                    (- erc-server-reconnect-attempts
+                       (cl-incf erc-server-reconnect-count (or incr 1))))))
+    (erc-display-message nil 'error (current-buffer) 'reconnecting
+                         ?m erc-server-reconnect-timeout
+                         ?i (if count erc-server-reconnect-count "N")
+                         ?n (if count erc-server-reconnect-attempts "A"))
+    (setq erc-server-reconnecting nil
+          erc--server-reconnect-timer
+          (run-at-time erc-server-reconnect-timeout nil
+                       erc-server-reconnect-function buffer))))
+
 (defun erc-process-sentinel-2 (event buffer)
   "Called when `erc-process-sentinel-1' has detected an unexpected disconnect."
-  (if (not (buffer-live-p buffer))
-      (erc-update-mode-line)
+  (when (buffer-live-p buffer)
     (with-current-buffer buffer
-      (let ((reconnect-p (erc--server-reconnect-p event)) message delay)
+      (let ((reconnect-p (erc--server-reconnect-p event)) message)
         (setq message (if reconnect-p 'disconnected 'disconnected-noreconnect))
         (erc-display-message nil 'error (current-buffer) message)
         (if (not reconnect-p)
             ;; terminate, do not reconnect
             (progn
-              (setq erc--server-reconnecting nil)
+              (setq erc--server-reconnecting nil
+                    erc--server-reconnect-timer nil)
               (erc-display-message nil 'error (current-buffer)
                                    'terminated ?e event)
-              ;; Update mode line indicators
-              (erc-update-mode-line)
               (set-buffer-modified-p nil))
           ;; reconnect
-          (condition-case nil
-              (progn
-                (setq erc-server-reconnecting nil
-                      erc--server-reconnecting t
-                      erc-server-reconnect-count (1+ 
erc-server-reconnect-count))
-                (setq delay erc-server-reconnect-timeout)
-                (run-at-time delay nil
-                             #'erc-server-delayed-reconnect buffer))
-            (error (unless (integerp erc-server-reconnect-attempts)
-                     (message "%s ... %s"
-                              "Reconnecting until we succeed"
-                              "kill the ERC server buffer to stop"))
-                   (erc-server-delayed-reconnect buffer))))))))
+          (erc-schedule-reconnect buffer))))
+    (erc-update-mode-line)))
 
 (defun erc-process-sentinel-1 (event buffer)
   "Called when `erc-process-sentinel' has decided that we're disconnecting.
diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el
index af8528dbc3..3ba18e835b 100644
--- a/lisp/erc/erc-pcomplete.el
+++ b/lisp/erc/erc-pcomplete.el
@@ -179,6 +179,10 @@ for use on `completion-at-point-function'."
 (defun pcomplete/erc-mode/UNIGNORE ()
   (pcomplete-here (erc-with-server-buffer erc-ignore-list)))
 
+(defun pcomplete/erc-mode/RECONNECT ()
+  (pcomplete-here '("cancel"))
+  (pcomplete-opt "a"))
+
 ;;; Functions that provide possible completions.
 
 (defun pcomplete-erc-commands ()
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 2d55e698a7..303f45d177 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2032,12 +2032,12 @@ Returns the buffer for the given server or channel."
     ;; Saving log file on exit
     (run-hook-with-args 'erc-connect-pre-hook buffer)
 
-    (when connect
-      (erc-server-connect erc-session-server
-                          erc-session-port
-                          buffer
-                          erc-session-client-certificate))
-    (erc-update-mode-line)
+    (if connect
+        (erc-server-connect erc-session-server
+                            erc-session-port
+                            buffer
+                            erc-session-client-certificate)
+      (erc-update-mode-line))
 
     ;; Now display the buffer in a window as per user wishes.
     (unless (eq buffer old-buffer)
@@ -3804,17 +3804,17 @@ the message given by REASON."
 (put 'erc-cmd-GQUIT 'do-not-parse-args t)
 (put 'erc-cmd-GQUIT 'process-not-needed t)
 
-(defun erc-cmd-RECONNECT ()
-  "Try to reconnect to the current IRC server."
+(defun erc--cmd-reconnect ()
   (let ((buffer (erc-server-buffer))
         (process nil))
     (unless (buffer-live-p buffer)
       (setq buffer (current-buffer)))
     (with-current-buffer buffer
+      (when erc--server-reconnect-timer
+        (erc--cancel-auto-reconnect-timer))
       (setq erc-server-quitting nil)
       (with-suppressed-warnings ((obsolete erc-server-reconnecting))
         (setq erc-server-reconnecting t))
-      (setq erc--server-reconnecting t)
       (setq erc-server-reconnect-count 0)
       (setq process (get-buffer-process (erc-server-buffer)))
       (when process
@@ -3828,6 +3828,18 @@ the message given by REASON."
           (setq erc--server-reconnecting nil
                 erc-server-reconnecting nil)))))
   t)
+
+(defun erc-cmd-RECONNECT (&rest args)
+  "Try reconnecting to the current IRC server.
+Alternatively, CANCEL a scheduled attempt for either the current
+connection or, with -A, all applicable connections.
+
+\(fn [CANCEL [-A]])"
+  (pcase args
+    (`("cancel" "-a") (erc-buffer-filter #'erc--cancel-auto-reconnect-timer))
+    (`("cancel") (erc-with-server-buffer (erc--cancel-auto-reconnect-timer)))
+    (_ (erc--cmd-reconnect))))
+
 (put 'erc-cmd-RECONNECT 'process-not-needed t)
 
 (defun erc-cmd-SERVER (server)
@@ -6713,11 +6725,12 @@ shortened server name instead."
                   (?s . ,(erc-format-target-and/or-server))
                   (?S . ,(erc-format-target-and/or-network))
                   (?t . ,(erc-format-target))))
-          (process-status (cond ((and (erc-server-process-alive)
-                                      (not erc-server-connected))
-                                 ":connecting")
-                                ((erc-server-process-alive)
-                                 "")
+          (process-status (cond ((erc-server-process-alive buffer)
+                                 (unless erc-server-connected
+                                   ": connecting"))
+                                ((erc-with-server-buffer
+                                   erc--server-reconnect-timer)
+                                 erc--mode-line-process-reconnecting)
                                 (t
                                  ": CLOSED")))
           (face (cond ((eq erc-header-line-face-method nil)
@@ -6728,7 +6741,7 @@ shortened server name instead."
                        'erc-header-line))))
       (setq mode-line-buffer-identification
             (list (format-spec erc-mode-line-format spec)))
-      (setq mode-line-process (list process-status))
+      (setq mode-line-process process-status)
       (let ((header (if erc-header-line-format
                         (format-spec erc-header-line-format spec)
                       nil)))
@@ -6913,6 +6926,8 @@ All windows are opened in the current frame."
    (disconnected . "\n\nConnection failed!  Re-establishing connection...\n")
    (disconnected-noreconnect
     . "\n\nConnection failed!  Not re-establishing connection.\n")
+   (reconnecting . "Reconnecting in %ms: attempt %i/%n ...")
+   (reconnect-canceled . "Canceled %u reconnect timer with %cs to go...")
    (finished . "\n\n*** ERC finished ***\n")
    (terminated . "\n\n*** ERC terminated: %e\n")
    (login . "Logging in as `%n'...")
diff --git a/test/lisp/erc/erc-scenarios-base-reconnect.el 
b/test/lisp/erc/erc-scenarios-base-reconnect.el
index 49298dc594..8762f33b30 100644
--- a/test/lisp/erc/erc-scenarios-base-reconnect.el
+++ b/test/lisp/erc/erc-scenarios-base-reconnect.el
@@ -224,4 +224,50 @@
       (with-current-buffer "#chan"
         (funcall expect 10 "here comes the lady")))))
 
+
+(ert-deftest erc-scenarios-base-cancel-reconnect ()
+  :tags '(:expensive-test)
+  (erc-scenarios-common-with-cleanup
+      ((erc-scenarios-common-dialog "base/reconnect")
+       (dumb-server (erc-d-run "localhost" t 'timer 'timer 'timer-last))
+       (port (process-contact dumb-server :service))
+       (expect (erc-d-t-make-expecter))
+       (erc-server-auto-reconnect t)
+       erc-autojoin-channels-alist
+       erc-server-buffer)
+
+    (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
+        (should (string= (buffer-name) (format "127.0.0.1:%d" port)))))
+
+    (ert-info ("Two connection attempts, all stymied")
+      (with-current-buffer erc-server-buffer
+        (ert-info ("First two attempts behave normally")
+          (dotimes (n 2)
+            (ert-info ((format "Initial attempt %d" (1+ n)))
+              (funcall expect 3 "Opening connection")
+              (funcall expect 2 "Password incorrect")
+              (funcall expect 2 "Connection failed!")
+              (funcall expect 2 "Re-establishing connection"))))
+        (ert-info ("/RECONNECT cancels timer but still attempts to connect")
+          (erc-cmd-RECONNECT)
+          (funcall expect 2 "Canceled")
+          (funcall expect 3 "Opening connection")
+          (funcall expect 2 "Password incorrect")
+          (funcall expect 2 "Connection failed!")
+          (funcall expect 2 "Re-establishing connection"))
+        (ert-info ("Explicitly cancel timer")
+          (erc-cmd-RECONNECT "cancel")
+          (funcall expect 2 "Canceled")
+          (erc-d-t-absent-for 1 "Opening connection" (point)))))
+
+    (ert-info ("Server buffer is unique and temp name is absent")
+      (should (equal (list (get-buffer (format "127.0.0.1:%d" port)))
+                     (erc-scenarios-common-buflist "127.0.0.1"))))))
+
 ;;; erc-scenarios-base-reconnect.el ends here