emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

fix/bug-48598 bb117dfacb 05/27: [SQUASH-ME] Remove duplicate ERC prompt


From: F. Jason Park
Subject: fix/bug-48598 bb117dfacb 05/27: [SQUASH-ME] Remove duplicate ERC prompt on reconnect
Date: Fri, 8 Apr 2022 03:06:47 -0400 (EDT)

branch: fix/bug-48598
commit bb117dfacbaed2abe7a1b0d75287620cabff20a8
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>

    [SQUASH-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-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).
---
 lisp/erc/erc-backend.el    | 35 ++++++++++++++++---
 lisp/erc/erc.el            | 56 +++++++++++++-----------------
 test/lisp/erc/erc-tests.el | 85 ++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 138 insertions(+), 38 deletions(-)

diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 84b498064b..3b33b10998 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -706,6 +706,33 @@ 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
+                 (memq erc-hide-prompt
+                       (list t (if (erc-default-target) 'target 'server)))
+                 (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
+                               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)))
@@ -728,11 +755,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))))))
@@ -1480,6 +1504,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 bf7ac4aa50..c766215a99 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -244,14 +244,24 @@ 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.  Query prompts remain hidden until user input
+is detected or a new message arrives from the target."
+  :package-version '(ERC . "5.4.1") ; FIXME increment on next ELPA release
   :group 'erc-display
-  :type 'boolean)
+  :type '(choice (const :tag "Always hide prompt" t)
+                 (const :tag "Never hide prompt" nil)
+                 (const :tag "Only hide target prompt" 'target)
+                 (const :tag "Only hide server prompt" 'server)))
 
 ;; tunable GUI stuff
 
@@ -2013,7 +2023,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 erc--server-reconnecting))
     (when connect (run-hook-with-args 'erc-before-connect server port nick))
     (erc-update-modules)
     (set-buffer buffer)
@@ -2031,7 +2041,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 +2099,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)))
@@ -3763,9 +3774,9 @@ 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)))
@@ -5684,27 +5695,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 9d14f704e3..688942c779 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -149,6 +149,91 @@
         (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")))
+
+    (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 "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 "ServNet"
+        (erc--unhide-prompt)
+        (should-not (get-text-property erc-insert-marker 'display))))
+
+    (ert-info ("Value: target")
+      (setq erc-hide-prompt 'target)
+      (with-current-buffer "ServNet"
+        (erc--hide-prompt erc-server-process)
+        (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: 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 "#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 "ServNet"))))
+
 (ert-deftest erc--switch-to-buffer ()
   (defvar erc-modified-channels-alist) ; lisp/erc/erc-track.el
 



reply via email to

[Prev in Thread] Current Thread [Next in Thread]