master a63ed6f78a 04/25: Remove duplicate ERC prompt on reconnect

[F. Jason Park]

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

    Remove duplicate ERC prompt on reconnect
    
    * lisp/erc/erc-backend.el (erc--unhide-prompt, erc--hide-prompt,
    erc--unhide-prompt-on-self-insert): Add functions to ensure prompt is
    hidden on disconnect and shown when a user types /reconnect in a
    disconnected server buffer.
    (erc-process-sentinel): Register aforementioned function with
    `pre-command-hook' when prompt is deleted after disconnecting.
    (erc-server-PRIVMSG): Ensure prompt is showing when a new message
    arrives from target.
    
    * lisp/erc/erc.el (erc-hide-prompt): Repurpose unused option by
    changing meaning slightly to mean "selectively hide prompt when
    disconnected."  Also delete obsolete, commented-out code that at some
    point used this option in its prior incarnation.
    (erc-prompt-hidden): Add new option to specify look of prompt when
    hidden.
    (erc-unhide-query-prompt): Add option to force-reveal query prompts on
    reconnect.
    (erc-open): Augment earlier reconnect-detection semantics by
    incorporating `erc--server-reconnecting'.  In existing buffers, remove
    prompt-related hooks and reveal prompt, if necessary.
    (erc-cmd-RECONNECT): Allow a user to reconnect when already
    connected (by first disconnecting).
    (erc-connection-established): Possibly unhide query prompts.
    (Bug#54826)
    
    * test/lisp/erc/erc-tests.el (erc-tests--test-prep,
    erc-tests--set-fake-server-process): Factor out some common
    buffer-prep boilerplate involving user input and the server process.
    Shared with bug#54536.
---
 lisp/erc/erc-backend.el    |  41 ++++++++++--
 lisp/erc/erc.el            |  81 +++++++++++++-----------
 test/lisp/erc/erc-tests.el | 152 +++++++++++++++++++++++++++++++++++++++++++--
 3 files changed, 228 insertions(+), 46 deletions(-)

diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 5651d8271c..7aec02e897 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -705,6 +705,39 @@ Conditionally try to reconnect and take appropriate 
action."
       ;; unexpected disconnect
       (erc-process-sentinel-2 event buffer))))
 
+(defun erc--unhide-prompt ()
+  (remove-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert t)
+  (when (and (marker-position erc-insert-marker)
+             (marker-position erc-input-marker))
+    (with-silent-modifications
+      (remove-text-properties erc-insert-marker erc-input-marker
+                              '(display nil)))))
+
+(defun erc--unhide-prompt-on-self-insert ()
+  (when (and (eq this-command #'self-insert-command)
+             (or (eobp) (= (point) erc-input-marker)))
+    (erc--unhide-prompt)))
+
+(defun erc--hide-prompt (proc)
+  (erc-with-all-buffers-of-server
+      proc nil ; sorta wish this was indent 2
+      (when (and erc-hide-prompt
+                 (or (eq erc-hide-prompt t)
+                     ;; FIXME use `erc--target' after bug#48598
+                     (memq (if (erc-default-target)
+                               (if (erc-channel-p (car erc-default-recipients))
+                                   'channel
+                                 'query)
+                             'server)
+                           erc-hide-prompt))
+                 (marker-position erc-insert-marker)
+                 (marker-position erc-input-marker)
+                 (get-text-property erc-insert-marker 'erc-prompt))
+        (with-silent-modifications
+          (add-text-properties erc-insert-marker (1- erc-input-marker)
+                               `(display ,erc-prompt-hidden)))
+        (add-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert 0 t))))
+
 (defun erc-process-sentinel (cproc event)
   "Sentinel function for ERC process."
   (let ((buf (process-buffer cproc)))
@@ -727,11 +760,8 @@ Conditionally try to reconnect and take appropriate 
action."
           (dolist (buf (erc-buffer-filter (lambda () (boundp 
'erc-channel-users)) cproc))
             (with-current-buffer buf
               (setq erc-channel-users (make-hash-table :test 'equal))))
-          ;; Remove the prompt
-          (goto-char (or (marker-position erc-input-marker) (point-max)))
-          (forward-line 0)
-          (erc-remove-text-properties-region (point) (point-max))
-          (delete-region (point) (point-max))
+          ;; Hide the prompt
+          (erc--hide-prompt cproc)
           ;; Decide what to do with the buffer
           ;; Restart if disconnected
           (erc-process-sentinel-1 event buf))))))
@@ -1479,6 +1509,7 @@ add things to `%s' instead."
         (setq buffer (erc-get-buffer (if privp nick tgt) proc))
         (when buffer
           (with-current-buffer buffer
+            (when privp (erc--unhide-prompt))
             ;; update the chat partner info.  Add to the list if private
             ;; message.  We will accumulate private identities indefinitely
             ;; at this point.
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 1a6911a511..f9bff7e0c0 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -244,13 +244,34 @@ prompt you for it.")
   :group 'erc
   :type 'boolean)
 
-(defcustom erc-hide-prompt nil
-  "If non-nil, do not display the prompt for commands.
-
-\(A command is any input starting with a `/').
+(defcustom erc-prompt-hidden ">"
+  "Text to show in lieu of the prompt when hidden."
+  :package-version '(ERC . "5.4.1") ; FIXME increment on next ELPA release
+  :group 'erc-display
+  :type 'string)
 
-See also the variables `erc-prompt' and `erc-command-indicator'."
+(defcustom erc-hide-prompt t
+  "If non-nil, hide input prompt upon disconnecting.
+To unhide, type something in the input area.  Once revealed, a
+prompt remains unhidden until the next disconnection.  Channel
+prompts are unhidden upon rejoining.  See
+`erc-unhide-query-prompt' for behavior concerning query prompts."
+  :package-version '(ERC . "5.4.1") ; FIXME increment on next ELPA release
   :group 'erc-display
+  :type '(choice (const :tag "Always hide prompt" t)
+                 (set (const server)
+                      (const query)
+                      (const channel))))
+
+(defcustom erc-unhide-query-prompt nil
+  "When non-nil, always reveal query prompts upon reconnecting.
+Otherwise, prompts in a connection's query buffers remain hidden
+until the user types in the input area or a new message arrives
+from the target."
+  :package-version '(ERC . "5.4.1") ; FIXME increment on next ELPA release
+  :group 'erc-display
+  ;; Extensions may one day offer a way to discover whether a target
+  ;; is online.  When that happens, this can be expanded accordingly.
   :type 'boolean)
 
 ;; tunable GUI stuff
@@ -2013,7 +2034,7 @@ Returns the buffer for the given server or channel."
         (buffer (erc-get-buffer-create server port channel))
         (old-buffer (current-buffer))
         old-point
-        continued-session)
+        (continued-session (and erc-reuse-buffers erc--server-reconnecting)))
     (when connect (run-hook-with-args 'erc-before-connect server port nick))
     (erc-update-modules)
     (set-buffer buffer)
@@ -2031,7 +2052,7 @@ Returns the buffer for the given server or channel."
     ;; (the buffer may have existed)
     (goto-char (point-max))
     (forward-line 0)
-    (when (get-text-property (point) 'erc-prompt)
+    (when (or continued-session (get-text-property (point) 'erc-prompt))
       (setq continued-session t)
       (set-marker erc-input-marker
                   (or (next-single-property-change (point) 'erc-prompt)
@@ -2089,7 +2110,8 @@ Returns the buffer for the given server or channel."
       (goto-char (point-max))
       (insert "\n"))
     (if continued-session
-        (goto-char old-point)
+        (progn (goto-char old-point)
+               (erc--unhide-prompt))
       (set-marker erc-insert-marker (point))
       (erc-display-prompt)
       (goto-char (point-max)))
@@ -3753,12 +3775,15 @@ the message given by REASON."
       (setq erc--server-reconnecting t)
       (setq erc-server-reconnect-count 0)
       (setq process (get-buffer-process (erc-server-buffer)))
-      (if process
-          (delete-process process)
-        (erc-server-reconnect))
+      (when process
+        (delete-process process))
+      (erc-server-reconnect)
       (with-suppressed-warnings ((obsolete erc-server-reconnecting))
-        (setq erc-server-reconnecting nil))
-      (setq erc--server-reconnecting nil)))
+        (if erc-reuse-buffers
+            (progn (cl-assert (not erc--server-reconnecting))
+                   (cl-assert (not erc-server-reconnecting)))
+          (setq erc--server-reconnecting nil
+                erc-server-reconnecting nil)))))
   t)
 (put 'erc-cmd-RECONNECT 'process-not-needed t)
 
@@ -4720,7 +4745,14 @@ Set user modes and run `erc-after-connect' hook."
         (erc-update-mode-line)
         (erc-set-initial-user-mode nick buffer)
         (erc-server-setup-periodical-ping buffer)
-        (run-hook-with-args 'erc-after-connect server nick)))))
+        (run-hook-with-args 'erc-after-connect server nick))))
+
+  (when erc-unhide-query-prompt
+    (erc-with-all-buffers-of-server proc
+      nil ; FIXME use `erc--target' after bug#48598
+      (when (and (erc-default-target)
+                 (not (erc-channel-p (car erc-default-recipients))))
+        (erc--unhide-prompt)))))
 
 (defun erc-set-initial-user-mode (nick buffer)
   "If `erc-user-mode' is non-nil for NICK, set the user modes.
@@ -5674,27 +5706,6 @@ Return non-nil only if we actually send anything."
             (erc-process-input-line (concat string "\n") t nil))
           t))))))
 
-;; (defun erc-display-command (line)
-;;   (when erc-insert-this
-;;     (let ((insert-position (point)))
-;;       (unless erc-hide-prompt
-;;         (erc-display-prompt nil nil (erc-command-indicator)
-;;                             (and (erc-command-indicator)
-;;                                  'erc-command-indicator-face)))
-;;       (let ((beg (point)))
-;;         (insert line)
-;;         (erc-put-text-property beg (point)
-;;                                'font-lock-face 'erc-command-indicator-face)
-;;         (insert "\n"))
-;;       (when (processp erc-server-process)
-;;         (set-marker (process-mark erc-server-process) (point)))
-;;       (set-marker erc-insert-marker (point))
-;;       (save-excursion
-;;         (save-restriction
-;;           (narrow-to-region insert-position (point))
-;;           (run-hooks 'erc-send-modify-hook)
-;;           (run-hooks 'erc-send-post-hook))))))
-
 (defun erc-display-msg (line)
   "Display LINE as a message of the user to the current target at point."
   (when erc-insert-this
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 3c76cb97ca..061dfc2f5e 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -135,6 +135,150 @@
     (should (get-buffer "#spam"))
     (kill-buffer "#spam")))
 
+(defun erc-tests--send-prep ()
+  ;; Caller should probably shadow `erc-insert-modify-hook' or
+  ;; populate user tables for erc-button.
+  (erc-mode)
+  (insert "\n\n")
+  (setq erc-input-marker (make-marker)
+        erc-insert-marker (make-marker))
+  (set-marker erc-insert-marker (point-max))
+  (erc-display-prompt)
+  (should (= (point) erc-input-marker)))
+
+(defun erc-tests--set-fake-server-process (&rest args)
+  (setq erc-server-process
+        (apply #'start-process (car args) (current-buffer) args))
+  (set-process-query-on-exit-flag erc-server-process nil))
+
+(ert-deftest erc-hide-prompt ()
+  (let (erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+
+    (with-current-buffer (get-buffer-create "ServNet")
+      (erc-tests--send-prep)
+      (goto-char erc-insert-marker)
+      (should (looking-at-p (regexp-quote erc-prompt)))
+      (erc-tests--set-fake-server-process "sleep" "1")
+      (set-process-sentinel erc-server-process #'ignore)
+      (setq erc-network 'ServNet)
+      (set-process-query-on-exit-flag erc-server-process nil))
+
+    (with-current-buffer (get-buffer-create "#chan")
+      (erc-tests--send-prep)
+      (goto-char erc-insert-marker)
+      (should (looking-at-p (regexp-quote erc-prompt)))
+      (setq erc-server-process (buffer-local-value 'erc-server-process
+                                                   (get-buffer "ServNet"))
+            erc-default-recipients '("#chan")))
+
+    (with-current-buffer (get-buffer-create "bob")
+      (erc-tests--send-prep)
+      (goto-char erc-insert-marker)
+      (should (looking-at-p (regexp-quote erc-prompt)))
+      (setq erc-server-process (buffer-local-value 'erc-server-process
+                                                   (get-buffer "ServNet"))
+            erc-default-recipients '("bob")))
+
+    (ert-info ("Value: t (default)")
+      (should (eq erc-hide-prompt t))
+      (with-current-buffer "ServNet"
+        (should (= (point) erc-insert-marker))
+        (erc--hide-prompt erc-server-process)
+        (should (string= ">" (get-text-property (point) 'display))))
+
+      (with-current-buffer "#chan"
+        (goto-char erc-insert-marker)
+        (should (string= ">" (get-text-property (point) 'display)))
+        (should (memq #'erc--unhide-prompt-on-self-insert pre-command-hook))
+        (goto-char erc-input-marker)
+        (ert-simulate-command '(self-insert-command 1 ?/))
+        (goto-char erc-insert-marker)
+        (should-not (get-text-property (point) 'display))
+        (should-not (memq #'erc--unhide-prompt-on-self-insert
+                          pre-command-hook)))
+
+      (with-current-buffer "bob"
+        (goto-char erc-insert-marker)
+        (should (string= ">" (get-text-property (point) 'display)))
+        (should (memq #'erc--unhide-prompt-on-self-insert pre-command-hook))
+        (goto-char erc-input-marker)
+        (ert-simulate-command '(self-insert-command 1 ?/))
+        (goto-char erc-insert-marker)
+        (should-not (get-text-property (point) 'display))
+        (should-not (memq #'erc--unhide-prompt-on-self-insert
+                          pre-command-hook)))
+
+      (with-current-buffer "ServNet"
+        (should (get-text-property erc-insert-marker 'display))
+        (should (memq #'erc--unhide-prompt-on-self-insert pre-command-hook))
+        (erc--unhide-prompt)
+        (should-not (memq #'erc--unhide-prompt-on-self-insert
+                          pre-command-hook))
+        (should-not (get-text-property erc-insert-marker 'display))))
+
+    (ert-info ("Value: server")
+      (setq erc-hide-prompt '(server))
+      (with-current-buffer "ServNet"
+        (erc--hide-prompt erc-server-process)
+        (should (string= ">" (get-text-property erc-insert-marker 'display))))
+
+      (with-current-buffer "#chan"
+        (should-not (get-text-property erc-insert-marker 'display)))
+
+      (with-current-buffer "bob"
+        (should-not (get-text-property erc-insert-marker 'display)))
+
+      (with-current-buffer "ServNet"
+        (erc--unhide-prompt)
+        (should-not (get-text-property erc-insert-marker 'display))))
+
+    (ert-info ("Value: channel")
+      (setq erc-hide-prompt '(channel))
+      (with-current-buffer "ServNet"
+        (erc--hide-prompt erc-server-process)
+        (should-not (get-text-property erc-insert-marker 'display)))
+
+      (with-current-buffer "bob"
+        (should-not (get-text-property erc-insert-marker 'display)))
+
+      (with-current-buffer "#chan"
+        (should (string= ">" (get-text-property erc-insert-marker 'display)))
+        (erc--unhide-prompt)
+        (should-not (get-text-property erc-insert-marker 'display))))
+
+    (ert-info ("Value: query")
+      (setq erc-hide-prompt '(query))
+      (with-current-buffer "ServNet"
+        (erc--hide-prompt erc-server-process)
+        (should-not (get-text-property erc-insert-marker 'display)))
+
+      (with-current-buffer "bob"
+        (should (string= ">" (get-text-property erc-insert-marker 'display)))
+        (erc--unhide-prompt)
+        (should-not (get-text-property erc-insert-marker 'display)))
+
+      (with-current-buffer "#chan"
+        (should-not (get-text-property erc-insert-marker 'display))))
+
+    (ert-info ("Value: nil")
+      (setq erc-hide-prompt nil)
+      (with-current-buffer "ServNet"
+        (erc--hide-prompt erc-server-process)
+        (should-not (get-text-property erc-insert-marker 'display)))
+
+      (with-current-buffer "bob"
+        (should-not (get-text-property erc-insert-marker 'display)))
+
+      (with-current-buffer "#chan"
+        (should-not (get-text-property erc-insert-marker 'display))
+        (erc--unhide-prompt) ; won't blow up when prompt already showing
+        (should-not (get-text-property erc-insert-marker 'display))))
+
+    (when noninteractive
+      (kill-buffer "#chan")
+      (kill-buffer "bob")
+      (kill-buffer "ServNet"))))
+
 (ert-deftest erc--switch-to-buffer ()
   (defvar erc-modified-channels-alist) ; lisp/erc/erc-track.el
 
@@ -218,14 +362,10 @@
 (ert-deftest erc-ring-previous-command ()
   (with-current-buffer (get-buffer-create "*#fake*")
     (erc-mode)
-    (insert "\n\n")
+    (erc-tests--send-prep)
+    (setq-local erc-last-input-time 0)
     (should-not (local-variable-if-set-p 'erc-send-completed-hook))
     (set (make-local-variable 'erc-send-completed-hook) nil) ; skip t (globals)
-    (setq erc-input-marker (make-marker)
-          erc-insert-marker (make-marker))
-    (set-marker erc-insert-marker (point-max))
-    (erc-display-prompt)
-    (should (= (point) erc-input-marker))
     ;; Just in case erc-ring-mode is already on
     (setq-local erc-pre-send-functions nil)
     (add-hook 'erc-pre-send-functions #'erc-add-to-input-ring)