(defcustom erc-reuse-frames t
"Determines whether new frames are always created.
-
-A value of t means only create a frame for undisplayed buffers.
-`displayed' means use any existing, potentially hidden frame
-already displaying a buffer from the same network context or,
-failing that, a frame showing any ERC buffer. As a last resort,
-`displayed' defaults to the selected frame, except for brand new
-connections, for which the invoking frame is always used. When
-this option is nil, a new frame is always created.
-
-Regardless of its value, this option is ignored unless
-`erc-join-buffer' is set to `frame'. And like most options in
-the `erc-buffer' customize group, this has no effect on server
-buffers while reconnecting because those are always buried."
- :package-version '(ERC . "5.6") ; FIXME sync on release
+Non-nil means only create a frame for undisplayed buffers. Nil
+means always create a new frame. Regardless of its value, ERC
+ignores this option unless `erc-join-buffer' is `frame'. And
+like most options in the `erc-buffer' customize group, this has
+no effect on server buffers while reconnecting because ERC always
+buries those."
:group 'erc-buffers
- :type '(choice boolean
- (const displayed)))
+ :type 'boolean)
(defun erc-channel-p (channel)
"Return non-nil if CHANNEL seems to be an IRC channel name."
confidently call (erc-foo-mode 1) without having to learn
anything about the dependency's implementation.")
-(defun erc--setup-buffer-first-window (frame a b)
- (catch 'found
- (walk-window-tree
- (lambda (w)
- (when (cond ((functionp a) (with-current-buffer (window-buffer w)
- (funcall a b)))
- (t (eq (buffer-local-value a (window-buffer w)) b)))
- (throw 'found t)))
- frame nil 0)))
-
-(defun erc--display-buffer-use-some-frame (buffer alist)
- "Maybe display BUFFER in an existing frame for the same connection.
-If performed, return window used; otherwise, return nil. Forward ALIST
-to display-buffer machinery."
- (when-let*
- ((idp (lambda (value)
- (and erc-networks--id
- (erc-networks--id-equal-p erc-networks--id value))))
- (procp (lambda (frame)
- (erc--setup-buffer-first-window frame idp erc-networks--id)))
- (ercp (lambda (frame)
- (erc--setup-buffer-first-window frame 'major-mode 'erc-mode)))
- ((or (cdr (frame-list)) (funcall ercp (selected-frame)))))
- ;; Workaround to avoid calling `window--display-buffer' directly
- (or (display-buffer-use-some-frame buffer
- `((frame-predicate . ,procp) ,@alist))
- (display-buffer-use-some-frame buffer
- `((frame-predicate . ,ercp) ,@alist)))))
-
(defvar erc--setup-buffer-hook nil
"Internal hook for module setup involving windows and frames.")
('bury
nil)
('frame
- (cond
- ((and (eq erc-reuse-frames 'displayed)
- (not (get-buffer-window buffer t)))
- (display-buffer buffer '((erc--display-buffer-use-some-frame)
- (inhibit-switch-frame . t)
- (inhibit-same-window . t))))
- ((or (not erc-reuse-frames)
- (not (get-buffer-window buffer t)))
+ (when (or (not erc-reuse-frames)
+ (not (get-buffer-window buffer t)))
(let ((frame (make-frame (or erc-frame-alist
default-frame-alist))))
(raise-frame frame)
(select-frame frame))
(switch-to-buffer buffer)
(when erc-frame-dedicated-flag
- (set-window-dedicated-p (selected-window) t)))))
+ (set-window-dedicated-p (selected-window) t))))
(_
(if (active-minibuffer-window)
(display-buffer buffer)
(dolist (b '("server" "other" "#chan" "#foo" "#fake"))
(kill-buffer b))))
-(defun erc-tests--run-in-term (&optional debug)
- (let* ((default-directory (getenv "EMACS_TEST_DIRECTORY"))
- (emacs (expand-file-name invocation-name invocation-directory))
- (process-environment (cons "ERC_TESTS_SUBPROCESS=1"
- process-environment))
- (name (ert-test-name (ert-running-test)))
- (temp-file (make-temp-file "erc-term-test-"))
- (cmd `(let ((stats 1))
- (setq enable-dir-local-variables nil)
- (unwind-protect
- (setq stats (ert-run-tests-batch ',name))
- (unless ',debug
- (let ((buf (with-current-buffer (messages-buffer)
- (buffer-string))))
- (with-temp-file ,temp-file
- (insert buf)))
- (kill-emacs (ert-stats-completed-unexpected stats))))))
- ;; `ert-test' object in Emacs 29 has a `file-name' field
- (file-name (symbol-file name 'ert--test))
- (default-directory (expand-file-name (file-name-directory file-name)))
- (package (if-let* ((found (getenv "ERC_PACKAGE_NAME"))
- ((string-prefix-p "erc-" found)))
- (intern found)
- 'erc))
- (setup (and (featurep 'compat)
- `(progn
- (require 'package)
- (let ((package-load-list '((compat t) (,package t))))
- (package-initialize)))))
- ;; Make subprocess terminal bigger than controlling.
- (buf (cl-letf (((symbol-function 'window-screen-lines)
- (lambda () 20))
- ((symbol-function 'window-max-chars-per-line)
- (lambda () 40)))
- (make-term (symbol-name name) emacs nil "-Q" "-nw"
- "-eval" (prin1-to-string setup)
- "-l" file-name "-eval" (format "%S" cmd))))
- (proc (get-buffer-process buf))
- (err (lambda ()
- (with-temp-buffer
- (insert-file-contents temp-file)
- (message "Subprocess: %s" (buffer-string))
- (delete-file temp-file)))))
- (with-current-buffer buf
- (set-process-query-on-exit-flag proc nil)
- (with-timeout (10 (funcall err) (error "Timed out awaiting result"))
- (while (process-live-p proc)
- (accept-process-output proc 0.1)))
- (while (accept-process-output proc))
- (goto-char (point-min))
- ;; Otherwise gives process exited abnormally with exit-code >0
- (unless (search-forward (format "Process %s finished" name) nil t)
- (funcall err)
- (ert-fail (when (search-forward "exited" nil t)
- (buffer-substring-no-properties (line-beginning-position)
- (line-end-position)))))
- (delete-file temp-file)
- (when noninteractive
- (kill-buffer)))))
-
-(defun erc-tests--servars (source &rest vars)
- (unless (bufferp source)
- (setq source (get-buffer source)))
- (dolist (var vars)
- (should (local-variable-if-set-p var))
- (set var (buffer-local-value var source))))
-
-(defun erc-tests--erc-reuse-frames (test &optional debug)
- (if (and (or debug noninteractive) (not (getenv "ERC_TESTS_SUBPROCESS")))
- (progn
- (when (memq system-type '(windows-nt ms-dos))
- (ert-skip "System must be UNIX"))
- (erc-tests--run-in-term debug))
- (should-not erc-frame-dedicated-flag)
- (should (eq erc-reuse-frames t))
- (let ((erc-join-buffer 'frame)
- (erc-reuse-frames t)
- (erc-frame-alist nil)
- (orig-frame (selected-frame))
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
- (delete-other-frames)
- (delete-other-windows)
- (set-window-buffer (selected-window) "*scratch*")
- (funcall test orig-frame)
- (delete-other-frames orig-frame)
- (delete-other-windows))))
-
-;; TODO add cases for frame-display behavior while reconnecting
-
-(defun erc-tests--erc-reuse-frames--t (_)
- (ert-info ("New server buffer creates and raises second frame")
- (with-current-buffer (generate-new-buffer "server")
- (erc-mode)
- (setq erc-server-process (start-process "server"
- (current-buffer) "sleep" "10")
- erc-frame-alist (cons '(name . "server") default-frame-alist)
- erc-network 'foonet
- erc-networks--id (erc-networks--id-create nil)
- erc--server-last-reconnect-count 0)
- (set-process-buffer erc-server-process (current-buffer))
- (set-process-query-on-exit-flag erc-server-process nil)
- (should-not (get-buffer-window (current-buffer) t))
- (erc-setup-buffer (current-buffer))
- (should (equal "server" (frame-parameter (window-frame) 'name)))
- (should (get-buffer-window (current-buffer) t))))
-
- (ert-info ("New channel creates and raises third frame")
- (with-current-buffer (generate-new-buffer "#chan")
- (erc-mode)
- (erc-tests--servars "server" 'erc-server-process 'erc-networks--id
- 'erc-network)
- (setq erc-frame-alist (cons '(name . "#chan") default-frame-alist)
- erc-default-recipients '("#chan"))
- (should-not (get-buffer-window (current-buffer) t))
- (erc-setup-buffer (current-buffer))
- (should (equal "#chan" (frame-parameter (window-frame) 'name)))
- (should (get-buffer-window (current-buffer) t))
- (should (cddr (frame-list))))))
-
-(ert-deftest erc-reuse-frames--t ()
- :tags '(:unstable :expensive-test)
- (erc-tests--erc-reuse-frames
- (lambda (orig-frame)
- (erc-tests--erc-reuse-frames--t orig-frame)
- (dolist (b '("server" "#chan"))
- (kill-buffer b)))))
-
-(defun erc-tests--erc-reuse-frames--displayed-single (_ server-name chan-name)
-
- (should (eq erc-reuse-frames 'displayed))
-
- (ert-info ("New server buffer shown in existing frame")
- (with-current-buffer (generate-new-buffer server-name)
- (erc-mode)
- (setq erc-server-process (start-process server-name (current-buffer)
- "sleep" "10")
- erc-frame-alist (cons `(name . ,server-name) default-frame-alist)
- erc-network (make-symbol server-name)
- erc-server-current-nick "tester"
- erc-networks--id (erc-networks--id-create nil)
- erc--server-last-reconnect-count 0)
- (set-process-buffer erc-server-process (current-buffer))
- (set-process-query-on-exit-flag erc-server-process nil)
- (should-not (get-buffer-window (current-buffer) t))
- (erc-setup-buffer (current-buffer))
- (should-not (equal server-name (frame-parameter (window-frame) 'name)))
- ;; New server buffer window appears in split below ERT/scratch
- (should (get-buffer-window (current-buffer) t))))
-
- (ert-info ("New channel shown in existing frame")
- (with-current-buffer (generate-new-buffer chan-name)
- (erc-mode)
- (erc-tests--servars server-name 'erc-server-process 'erc-networks--id
- 'erc-network)
- (setq erc-frame-alist (cons `(name . ,chan-name) default-frame-alist)
- erc-default-recipients (list chan-name))
- (should-not (get-buffer-window (current-buffer) t))
- (erc-setup-buffer (current-buffer))
- (should-not (equal chan-name (frame-parameter (window-frame) 'name)))
- ;; New channel buffer replaces server in lower window
- (should (get-buffer-window (current-buffer) t))
- (should-not (get-buffer-window server-name t)))))
-
-(ert-deftest erc-reuse-frames--displayed-single ()
- :tags '(:unstable :expensive-test)
- (erc-tests--erc-reuse-frames
- (lambda (orig-frame)
- (let ((erc-reuse-frames 'displayed))
- (erc-tests--erc-reuse-frames--displayed-single orig-frame
- "server" "#chan")
- (should-not (cdr (frame-list))))
- (dolist (b '("server" "#chan"))
- (kill-buffer b)))))
-
-(defun erc-tests--assert-server-split (buffer-or-name frame-name)
- ;; Assert current buffer resides on one side of a horizontal split
- ;; in the "server" frame but is not selected.
- (let* ((buffer-window (get-buffer-window buffer-or-name t))
- (buffer-frame (window-frame buffer-window)))
- (should (equal frame-name (frame-parameter buffer-frame 'name)))
- (should (memq buffer-window (car-safe (window-tree buffer-frame))))
- (should-not (eq buffer-window (frame-selected-window)))
- buffer-frame))
-
-(defun erc-tests--erc-reuse-frames--displayed-double (_)
- (should (eq erc-reuse-frames 'displayed))
-
- (make-frame '((name . "other")))
- (select-frame (make-frame '((name . "server"))) 'no-record)
- (set-window-buffer (selected-window) "*scratch*") ; invokes `erc'
-
- ;; A user invokes an entry point and switches immediately to a new
- ;; frame before autojoin kicks in (bug#55540).
-
- (ert-info ("New server buffer shown in selected frame")
- (with-current-buffer (generate-new-buffer "server")
- (erc-mode)
- (setq erc-server-process (start-process "server" (current-buffer)
- "sleep" "10")
- erc-network 'foonet
- erc-server-current-nick "tester"
- erc-networks--id (erc-networks--id-create nil)
- erc--server-last-reconnect-count 0)
- (set-process-buffer erc-server-process (current-buffer))
- (set-process-query-on-exit-flag erc-server-process nil)
- (should-not (get-buffer-window (current-buffer) t))
- (erc-setup-buffer (current-buffer))
- (should (equal "server" (frame-parameter (window-frame) 'name)))
- (should (get-buffer-window (current-buffer) t))))
-
- (select-frame-by-name "other")
-
- (ert-info ("New channel shown in dedicated frame")
- (with-current-buffer (generate-new-buffer "#chan")
- (erc-mode)
- (erc-tests--servars "server" 'erc-server-process 'erc-networks--id
- 'erc-network)
- (setq erc-frame-alist (cons '(name . "#chan") default-frame-alist)
- erc-default-recipients '("#chan"))
- (should-not (get-buffer-window (current-buffer) t))
- (erc-setup-buffer (current-buffer))
- (erc-tests--assert-server-split (current-buffer) "server")
- ;; New channel buffer replaces server in lower window of other frame
- (should-not (get-buffer-window "server" t)))))
-
-(ert-deftest erc-reuse-frames--displayed-double ()
- :tags '(:unstable :expensive-test)
- (erc-tests--erc-reuse-frames
- (lambda (orig-frame)
- (let ((erc-reuse-frames 'displayed))
- (erc-tests--erc-reuse-frames--displayed-double orig-frame))
- (dolist (b '("server" "#chan"))
- (kill-buffer b)))))
-
-;; If a frame showing ERC buffers exists among other frames, new,
-;; additional connections will use the existing IRC frame. However,
-;; if two or more frames exist with ERC buffers unique to a particular
-;; connection, the correct frame will be found.
-
-(defun erc-tests--erc-reuse-frames--displayed-full (orig-frame)
- (erc-tests--erc-reuse-frames--displayed-double orig-frame)
- ;; Server buffer is not displayed because #chan has replaced it in
- ;; the "server" frame, which is not selected.
- (should (equal "other" (frame-parameter (window-frame) 'name)))
- (erc-tests--erc-reuse-frames--displayed-single orig-frame "ircd" "#spam")
- (should (equal "other" (frame-parameter (window-frame) 'name)))
-
- ;; Buffer "#spam" has replaced "ircd", which earlier replaced
- ;; "#chan" in frame "server". But this is confusing, so...
- (ert-info ("Arrange windows for second connection in other frame")
- (set-window-buffer (selected-window) "ircd")
- (split-window-below)
- (set-window-buffer (next-window) "#spam")
- (should (equal (cddar (window-tree))
- (list (get-buffer-window "ircd" t)
- (get-buffer-window "#spam" t)))))
-
- (ert-info ("Arrange windows for first connection in server frame")
- (select-frame-by-name "server")
- (set-window-buffer (selected-window) "server")
- (set-window-buffer (next-window) "#chan")
- (should (equal (cddar (window-tree))
- (list (get-buffer-window "server" t)
- (get-buffer-window "#chan" t)))))
-
- ;; Select original ERT frame
- (ert-info ("New target for connection server finds appropriate frame")
- (select-frame orig-frame 'no-record)
- (with-current-buffer (window-buffer (selected-window))
- (should (member (buffer-name) '("*ert*" "*scratch*")))
- (with-current-buffer (generate-new-buffer "alice")
- (erc-mode)
- (erc-tests--servars "server" 'erc-server-process 'erc-networks--id)
- (setq erc-default-recipients '("alice"))
- (should-not (get-buffer-window (current-buffer) t))
- (erc-setup-buffer (current-buffer))
- ;; Window created in frame "server"
- (should (eq (selected-frame) orig-frame))
- (erc-tests--assert-server-split (current-buffer) "server"))))
-
- (ert-info ("New target for connection ircd finds appropriate frame")
- (select-frame orig-frame 'no-record)
- (with-current-buffer (window-buffer (selected-window))
- (should (member (buffer-name) '("*ert*" "*scratch*")))
- (with-current-buffer (generate-new-buffer "bob")
- (erc-mode)
- (erc-tests--servars "ircd" 'erc-server-process 'erc-networks--id)
- (setq erc-default-recipients '("bob"))
- (should-not (get-buffer-window (current-buffer) t))
- (erc-setup-buffer (current-buffer))
- ;; Window created in frame "other"
- (should (eq (selected-frame) orig-frame))
- (erc-tests--assert-server-split (current-buffer) "other")))))
-
-(ert-deftest erc-reuse-frames--displayed-full ()
- :tags '(:unstable :expensive-test)
- (erc-tests--erc-reuse-frames
- (lambda (orig-frame)
- (let ((erc-reuse-frames 'displayed))
- (erc-tests--erc-reuse-frames--displayed-full orig-frame))
- (dolist (b '("server" "ircd" "bob" "alice" "#spam" "#chan"))
- (kill-buffer b)))))
-
(ert-deftest erc-lurker-maybe-trim ()
(let (erc-lurker-trim-nicks
(erc-lurker-ignore-chars "_`"))