mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-29 07:58:28 +00:00
Code Issues Releases Activity

Remove duplicate ERC prompt on reconnect

Browse Source 
* 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.
This commit is contained in:
F. Jason Park 2022-04-05 17:45:00 -07:00
parent 4ae0707704
commit a63ed6f78a
3 changed files with 229 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
lisp/erc/erc-backend.el
View File

@ -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.

83
lisp/erc/erc.el
View File

@ -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 `/').
See also the variables `erc-prompt' and `erc-command-indicator'."
(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)
(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

152
test/lisp/erc/erc-tests.el
View File

@ -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)