mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00
Code Issues Projects Releases Wiki Activity
emacs/test/lisp/erc/erc-scenarios-base-buffer-display.el
F. Jason Park b354b3a53b Allow custom display-buffer actions in ERC 
* doc/misc/erc.texi: Add new section under "Integrations" chapter
describing `display-buffer' Custom function choice for ERC's many
buffer-display options.
* etc/ERC-NEWS: Mention new function variant for all buffer-display
options.
* lisp/erc/erc-backend.el: Add forward declaration for
`erc--called-as-input-p' and `erc--display-context'.
(erc--server-reconnect-display-timer,
erc--server-last-reconnect-display-reset): Use new name for option
`erc-reconnect-display', now `erc-auto-reconnect-display'.
(erc--server-determine-join-display-context): New generic function to
determine value of `erc--display-context' during JOINs.
(erc-server-JOIN, erc-server-PRIVMSG): Set `erc--display-context' to a
symbol for the handler's IRC command, like `JOIN', for the benefit of
custom `display-buffer'-like functions running in `erc-setup-buffer'.
(erc-server-471, erc-server-471-functions, erc-server-473,
erc-server-473-functions): New handlers for JOIN rejections.  Also
remove 471 and 473 from comment at bottom of file.
(erc-server-475): Bind `erc--called-as-input-p' so that `erc-cmd-JOIN'
sets `erc-interactive-display' context.
* lisp/erc/erc-join.el (erc-autojoin-mode, erc-autojoin-enable,
erc-autojoin-disable): Kill local variable
`erc-join--requested-channels'.  Add and remove
`erc-join--remove-requested-channels' to/from various server-handler
hooks for JOIN rejection numerics.
(erc-join--requested-channels): New local variable to remember
channels we've attempted to JOIN this session that haven't yet been
confirmed by the server.
(erc-join--remove-requested-channel): New JOIN rejection handler to
stop tracking channel in `erc-join--requested-channels'.
(erc--server-determine-join-display-context): module-specific
implementation of generic function for `erc-autojoin-mode'.
(erc-autojoin--join): Remember channels slated for JOIN'ing.
* lisp/erc/erc.el (erc--buffer-display-choices): New helper constant
for defining common `:type' for all buffer-display options.
(erc-buffer-display, erc-interactive-display,
erc-auto-reconnect-display, erc-receive-query-display): Use helper
`erc--buffer-display-choices' for defining `:type', which
includes a new choice for a `display-buffer'-like function.
(erc-reconnect-display, erc-auto-reconnect-display): Alias former to
latter, now the preferred name.
(erc-reconnect-timeout, erc-auto-reconnect-timeout): Change name from
former to latter.  This option is new in ERC 5.6.
(erc-reconnect-display-server-buffers): New option.
(erc-buffer-do): Revise doc string.
(erc--display-context): New variable, an alist of "context tokens" to
be forwarded as the "action alist" to `erc-buffer-display' functions.
(erc-skip-displaying-selected-window-buffer): New variable, deprecated
at birth, to act as an escape hatch for folks who don't want to skip
the displaying of buffers already showing in the selected window.
(erc--display-buffer-overriding-action): Local variable allowing
modules to influence the displaying of new ERC buffers independently
of user options.
(erc-setup-buffer): Do nothing when the selected window already shows
current buffer unless user has provided a custom display function.
Accommodate new Custom choice function values, like `display-buffer'
and `pop-to-buffer'.
(erc-open): Run `erc-setup-buffer' when option
`erc-reconnect-display-server-buffers' is non-nil, even for existing
server buffers.  Bind `display-buffer-overriding-action' to the value
of `erc--display-buffer-overriding-action' around calls to
`erc-setup-buffer'.
(erc-select-read-args): Add `erc--display-context' to environment.
(erc, erc-tls): Bind `erc--display-context' around calls to
`erc-select-read-args' and main body.
(erc-cmd-JOIN, erc-cmd-QUERY, erc--cmd-reconnect, erc-handle-irc-url):
Add item for `erc-interactive-display' to `erc--display-context'.
(erc-connection-established): Update name of
`erc-reconnect-display-timeout' to
`erc-auto-reconnect-display-timeout'.
(erc-message-english-s471, erc-message-english-s473): New variables,
format templates for JOIN rejection messages.
* test/lisp/erc/erc-scenarios-base-buffer-display.el
(erc-scenarios-base-buffer-display--defwin-recbury-intbuf,
erc-scenarios-base-buffer-display--defwino-recbury-intbuf,
erc-scenarios-base-buffer-display--count-reset-timeout): Use preferred
name `erc-auto-reconnect-display' for `erc-reconnect-display'.
* test/lisp/erc/erc-scenarios-join-display-context.el: New file.
* test/lisp/erc/erc-tests.el (erc--initialize-markers): Fix
unrealistic call to `erc-open'.
(erc-setup-buffer--custom-action): New test.
(erc-select-read-args, erc-tls, erc--interactive, erc-server-select):
Expect new environment binding for `erc--display-context'.
* test/lisp/erc/resources/join/buffer-display/mode-context.eld: New
file.  (Bug#62833)
2023-07-13 18:45:31 -07:00

235 lines
9.7 KiB
EmacsLisp
Raw Blame History

;;; erc-scenarios-base-buffer-display.el --- Buffer display scenarios -*- lexical-binding: t -*-
;; Copyright (C) 2023 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
(require 'ert-x)
(eval-and-compile
(let ((load-path (cons (ert-resource-directory) load-path)))
(require 'erc-scenarios-common)))
(eval-when-compile (require 'erc-join))
;; These first couple `erc-auto-reconnect-display' tests used to live
;; in erc-scenarios-base-reconnect but have since been renamed.
(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))
(port (process-contact dumb-server :service))
(expect (erc-d-t-make-expecter))
(erc-server-flood-penalty 0.1)
(erc-server-auto-reconnect t)
erc-autojoin-channels-alist)
(should (memq 'autojoin erc-modules))
(ert-info ("Connect to foonet")
(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 "FooNet"
(funcall expect 10 "Connection failed! Re-establishing")))
(should (equal erc-autojoin-channels-alist '((FooNet "#chan"))))
(delete-other-windows)
(pop-to-buffer-same-window "*Messages*")
(ert-info ("Wait for auto reconnect")
(with-current-buffer "FooNet" (funcall expect 10 "still in debug mode")))
(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-buffer-display--defwin-recbury-intbuf ()
:tags '(:expensive-test)
(should (eq erc-buffer-display 'bury))
(should (eq erc-interactive-display 'window))
(should-not erc-auto-reconnect-display)
(let ((erc-buffer-display 'window)
(erc-interactive-display 'buffer)
(erc-auto-reconnect-display 'bury))
(erc-scenarios-base-buffer-display--reconnect-common
(lambda (_)
(should (eq (window-buffer) (current-buffer)))
(should-not (frame-root-window-p (selected-window))))
(lambda (_)
(should (eq (window-buffer) (current-buffer)))
(should (equal (get-buffer "FooNet") (window-buffer (next-window)))))
(lambda (_)
(with-current-buffer "FooNet"
(should (eq (window-buffer) (messages-buffer)))
(should (frame-root-window-p (selected-window))))
;; A manual /JOIN command tells ERC we're done auto-reconnecting
(with-current-buffer "FooNet" (erc-scenarios-common-say "/JOIN #spam"))
(ert-info ("#spam ignores `erc-auto-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)
(erc-d-t-wait-for 5 (frame-root-window-p (selected-window)))))))))
(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-auto-reconnect-display)
(let ((erc-buffer-display 'window-noselect)
(erc-auto-reconnect-display 'bury)
(erc-interactive-display 'buffer))
(erc-scenarios-base-buffer-display--reconnect-common
(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-auto-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-auto-reconnect-display-timeout 10))
(should-not erc-auto-reconnect-display)
(let ((erc-buffer-display 'window-noselect)
(erc-auto-reconnect-display 'bury)
(erc-interactive-display 'buffer)
(erc-auto-reconnect-display-timeout 0.5))
(erc-scenarios-base-buffer-display--reconnect-common
#'ignore #'ignore ; These two are identical to the previous test.
(lambda (_)
(with-current-buffer "FooNet"
(should erc--server-reconnect-display-timer)
(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"
(erc-d-t-wait-for 1 (null erc--server-reconnect-display-timer))
(erc-cmd-JOIN "#spam")))
(ert-info ("Newly joined chan ignores `erc-auto-reconnect-display'")
(with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam"))
(should (eq (window-buffer) (messages-buffer)))
;; If `erc-auto-reconnect-display-timeout' were left alone, this
;; would be (frame-root-window-p #<window 1 on *scratch*>).
(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.
(ert-deftest erc-scenarios-base-buffer-display--interactive-default ()
:tags '(:expensive-test)
(should (eq erc-join-buffer 'bury))
(should (eq erc-interactive-display 'window))
(erc-scenarios-common-with-cleanup
((erc-scenarios-common-dialog "join/legacy")
(dumb-server (erc-d-run "localhost" t 'foonet))
(port (process-contact dumb-server :service))
(url (format "tester:changeme@127.0.0.1:%d\r\r" port))
(expect (erc-d-t-make-expecter))
(erc-server-flood-penalty 0.1)
(erc-server-auto-reconnect t)
(erc-user-full-name "tester"))
(ert-info ("Connect to foonet")
(with-current-buffer (let (inhibit-interaction)
(ert-simulate-keys url
(call-interactively #'erc)))
(should (string= (buffer-name) (format "127.0.0.1:%d" port)))
(erc-d-t-wait-for 10 "Server buffer shown"
(eq (window-buffer) (current-buffer)))
(funcall expect 10 "debug mode")
(erc-scenarios-common-say "/JOIN #chan")))
(ert-info ("Wait for output in #chan")
(with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
(funcall expect 10 "welcome")
(erc-d-t-ensure-for 3 "Channel #chan shown"
(eq (window-buffer) (current-buffer)))
(funcall expect 10 "be prosperous")))))
;;; erc-scenarios-base-buffer-display.el ends here
Reference in a new issue View git blame Copy permalink