From: "J.P." <jp@neverwas.me>
To: Pankaj Jangid <pankaj@codeisgreat.org>
Cc: 51753@debbugs.gnu.org, emacs-erc@gnu.org
Subject: bug#51753: bug#55540: 29.0.50; ERC launches autojoin-channels in current frame
Date: Wed, 10 Aug 2022 06:15:52 -0700 [thread overview]
Message-ID: <87a68cnss7.fsf_-___13671.3780275144$1660138999$gmane$org@neverwas.me> (raw)
In-Reply-To: <87fsl0zo2e.fsf@neverwas.me> (J. P.'s message of "Mon, 23 May 2022 00:48:57 -0700")
[-- Attachment #1: Type: text/plain, Size: 640 bytes --]
Hi Pankaj,
"J.P." <jp@neverwas.me> writes:
> One thing to be aware of is that even if we pivot to #1, the
> connection-detection and buffer-association stuff will still be
> unreliable in many cases. However, that should change after bug#48598
> lands.
The changes I was referring to have been on HEAD for over a month now,
but I've been slow in getting back around to this bug (sorry). In case
you or anyone else is interested, I've reworked things a bit to leverage
the new buffer-association stuff, which should make finding a suitable
frame more reliable. You still have to set the options as initially
described up thread. Thanks.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v2-v3.diff --]
[-- Type: text/x-patch, Size: 24920 bytes --]
From 5098c91eb6176e217f590bfa3da965cbe84653dc Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 10 Aug 2022 00:40:22 -0700
Subject: [PATCH 0/1] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (1):
Allow erc-reuse-frames to favor connections
lisp/erc/erc.el | 61 +++++++-
test/lisp/erc/erc-tests.el | 294 +++++++++++++++++++++++++++++++++++++
2 files changed, 348 insertions(+), 7 deletions(-)
Interdiff:
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 79091e18d5..c3bb30368a 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1701,14 +1701,20 @@ erc-frame-dedicated-flag
:type 'boolean)
(defcustom erc-reuse-frames t
- "Non-nil means only create a frame for undisplayed buffers.
-For new target buffers, a value of 'displayed' extends this to mean use
-the frame of any buffer from the same server connection, visible or not,
-or, as a last resort, a frame showing any ERC buffer. 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'. Note that
-like most options in the `erc-buffer' customize group, this has no
-effect on server buffers while reconnecting."
+ "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.4.1") ; FIXME update when publishing to ELPA
:group 'erc-buffers
:type '(choice boolean
@@ -2143,11 +2149,13 @@ erc-update-modules
(funcall sym 1)
(error "`%s' is not a known ERC module" mod))))))
-(defun erc--setup-buffer-first-win (frame a b)
+(defun erc--setup-buffer-first-window (frame a b)
(catch 'found
(walk-window-tree
(lambda (w)
- (when (eq (buffer-local-value a (window-buffer w)) b)
+ (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)))
@@ -2156,17 +2164,19 @@ erc--display-buffer-use-some-frame
If performed, return window used; otherwise, return nil. Forward ALIST
to display-buffer machinery."
(when-let*
- ((same-proc-p (lambda (fr)
- (erc--setup-buffer-first-win fr 'erc-server-process
- erc-server-process)))
- (same-mode-p (lambda (fr)
- (erc--setup-buffer-first-win fr 'major-mode 'erc-mode)))
- ((or (cdr (frame-list)) (funcall same-mode-p (selected-frame))))
- (frame (car (or (filtered-frame-list same-proc-p)
- (filtered-frame-list same-mode-p))))
- (window (get-lru-window frame nil t)))
- ;; FIXME don't rely on internal window.el function (tab-bar also does it)
- (window--display-buffer buffer window 'reuse alist)))
+ ((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)))))
(defun erc-setup-buffer (buffer)
"Consults `erc-join-buffer' to find out how to display `BUFFER'."
@@ -2187,6 +2197,7 @@ erc-setup-buffer
((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)))
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 11c501ea84..0986fa6b8f 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -336,124 +336,299 @@ erc--switch-to-buffer
(dolist (b '("server" "other" "#chan" "#foo" "#fake"))
(kill-buffer b))))
-(ert-deftest erc-reuse-frames ()
- ;; TODO run this in a pseudo terminal subprocess for EMBA
- ;;
- ;; TODO case that simulates automatic reconnecting, with an
- ;; existing, unselected frame containing two windows, one with a
- ;; dead ERC buffer and the other a non-ERC buffer
- (skip-unless (not noninteractive))
- (should-not erc-frame-dedicated-flag)
- (let ((erc-join-buffer 'frame)
- (erc-reuse-frames t)
- (orig-frame (selected-frame))
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+(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)))
+ ;; 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"
+ "-L" (file-name-directory (locate-library "erc"))
+ "-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 (point-at-bol)
+ (point-at-eol)))))
+ (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 ("Value: t")
- (with-current-buffer (generate-new-buffer "server")
+ (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)
+ (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)
+ (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)
+ (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)
- (setq erc-server-process (start-process "server" (current-buffer)
- "sleep" "1")
- erc-frame-alist (cons '(name . "server") default-frame-alist))
- (set-process-query-on-exit-flag erc-server-process nil)
+ (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))
- ;; New frame created and raised
- (should (equal "server" (frame-parameter (window-frame) 'name)))
- (should (get-buffer-window (current-buffer) t))
-
- (with-current-buffer (generate-new-buffer "#chan")
- (erc-mode)
- (setq erc-server-process erc-server-process
- 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))
- ;; Another frame was created just for #chan
- (should (equal "#chan" (frame-parameter (window-frame) 'name)))
- (should (get-buffer-window (current-buffer) t))
- (delete-frame))
-
- (select-frame-by-name "server")
- (pop-to-buffer "#chan")
- ;; The server frame contains two vertical windows
- (let ((tree (window-tree)))
- (should (memq (get-buffer-window "server" t) (car tree)))
- (should (memq (get-buffer-window "#chan" t) (car tree))))
- (should (eq (get-buffer "#chan") (window-buffer (selected-window))))
- (should (eq (get-buffer "server") (window-buffer (next-window))))))
-
- (ert-info ("Value: displayed, scratch frame selected")
- (select-frame orig-frame)
- (with-current-buffer "*scratch*"
- (with-current-buffer (generate-new-buffer "#spam")
- (erc-mode)
- (setq erc-server-process (buffer-local-value 'erc-server-process
- (get-buffer "server"))
- erc-reuse-frames 'displayed
- erc-frame-alist (cons '(name . "#spam") default-frame-alist)
- erc-default-recipients '("#spam"))
- (should-not (get-buffer-window (current-buffer) t))
- (erc-setup-buffer (current-buffer))
- ;; Window shows up in other frame
- (should (eq (selected-frame) orig-frame))
- (let ((fr (window-frame (get-buffer-window (current-buffer) t))))
- (should (equal "server" (frame-parameter fr 'name)))
- (with-selected-frame fr
- (should (memq (get-buffer-window "#spam" t)
- (car (window-tree))))))))
-
- (with-current-buffer "server"
- (ert-info ("Value: displayed, server frame selected")
- (select-frame-by-name "server")
- (select-window (get-buffer-window "#spam"))
- (with-current-buffer (generate-new-buffer "bob")
- (erc-mode)
- (setq erc-server-process (buffer-local-value 'erc-server-process
- (get-buffer "server"))
- erc-frame-alist (cons '(name . "bob") default-frame-alist)
- erc-default-recipients '("bob"))
- (should-not (get-buffer-window (current-buffer) t))
- (erc-setup-buffer (current-buffer))
- ;; Window shows up in this frame
- (let ((fr (window-frame (get-buffer-window (current-buffer) t))))
- (should (eq fr (selected-frame)))
- (should (equal "server" (frame-parameter fr 'name)))
- (with-selected-frame fr
- (should (memq (get-buffer-window "bob" t)
- (car (window-tree)))))
- ;; `inhibit-same-window' respected
- (should-not (eq (get-buffer-window "bob") (selected-window))))))
-
- (ert-info ("Value: displayed, other frames deleted")
- (with-selected-frame orig-frame
- (delete-frame))
- (should-not (cdr (frame-list)))
- (select-window (get-buffer-window "bob"))
- (with-current-buffer (generate-new-buffer "alice")
- (erc-mode)
- (setq erc-server-process (buffer-local-value 'erc-server-process
- (get-buffer "server"))
- erc-frame-alist (cons '(name . "alice") default-frame-alist)
- erc-default-recipients '("alice"))
- (should-not (get-buffer-window (current-buffer) t))
- (erc-setup-buffer (current-buffer))
- (let ((fr (window-frame (get-buffer-window (current-buffer) t))))
- (should (eq fr (selected-frame)))
- (should (equal "server" (frame-parameter fr 'name)))
- (with-selected-frame fr
- (should (memq (get-buffer-window "alice" t)
- (car (window-tree)))))
- (should-not (eq (get-buffer-window "alice")
- (selected-window)))))))))
-
- (should-not (cdr (frame-list)))
- (delete-other-windows)
- (kill-buffer "server")
- (kill-buffer "bob")
- (kill-buffer "alice")
- (kill-buffer "#spam")
- (kill-buffer "#chan"))
+ ;; 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)
+ (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
--
2.36.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-Allow-erc-reuse-frames-to-favor-connections.patch --]
[-- Type: text/x-patch, Size: 19248 bytes --]
From 5098c91eb6176e217f590bfa3da965cbe84653dc Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sat, 21 May 2022 03:04:04 -0700
Subject: [PATCH 1/1] Allow erc-reuse-frames to favor connections
* lisp/erc/erc.el (erc-reuse-frames): Add alternate value to favor
existing frames already displaying buffers from the same connection.
(erc--setup-buffer-first-window, erc--display-buffer-use-some-frame):
Add helpers to support 'display' variant of `erc-resuse-frames'
(erc-reuse-frames, erc-tests--servars, erc-tests--assert-server-split,
erc-tests--erc-reuse-frames, erc-tests--run-in-term): Add test case
and supporting helpers. (Bug#55540)
---
lisp/erc/erc.el | 61 +++++++-
test/lisp/erc/erc-tests.el | 294 +++++++++++++++++++++++++++++++++++++
2 files changed, 348 insertions(+), 7 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 151d75e7ce..c3bb30368a 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1702,11 +1702,23 @@ erc-frame-dedicated-flag
(defcustom erc-reuse-frames t
"Determines whether new frames are always created.
-Non-nil means that a new frame is not created to display an ERC
-buffer if there is already a window displaying it. This only has
-effect when `erc-join-buffer' is set to `frame'."
+
+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.4.1") ; FIXME update when publishing to ELPA
:group 'erc-buffers
- :type 'boolean)
+ :type '(choice boolean
+ (const displayed)))
(defun erc-channel-p (channel)
"Return non-nil if CHANNEL seems to be an IRC channel name."
@@ -2137,6 +2149,35 @@ erc-update-modules
(funcall sym 1)
(error "`%s' is not a known ERC module" mod))))))
+(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)))))
+
(defun erc-setup-buffer (buffer)
"Consults `erc-join-buffer' to find out how to display `BUFFER'."
(pcase (if (zerop (erc-with-server-buffer
@@ -2152,15 +2193,21 @@ erc-setup-buffer
('bury
nil)
('frame
- (when (or (not erc-reuse-frames)
- (not (get-buffer-window buffer t)))
+ (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)))
(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)
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 0f222edacf..0986fa6b8f 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -336,6 +336,300 @@ erc--switch-to-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)))
+ ;; 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"
+ "-L" (file-name-directory (locate-library "erc"))
+ "-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 (point-at-bol)
+ (point-at-eol)))))
+ (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)
+ (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)
+ (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)
+ (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)
+ (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 "_`"))
--
2.36.1
next prev parent reply other threads:[~2022-08-10 13:15 UTC|newest]
Thread overview: 26+ messages / expand[flat|nested] mbox.gz Atom feed top
2022-05-20 13:06 bug#55540: 29.0.50; ERC launches autojoin-channels in current frame instead of original frame Pankaj Jangid
2022-05-20 13:10 ` Lars Ingebrigtsen
2022-05-20 13:31 ` Pankaj Jangid
2022-05-20 13:37 ` Lars Ingebrigtsen
2022-05-23 1:56 ` bug#51753: ERC switches to channel buffer on reconnect J.P.
[not found] ` <87a6b92ers.fsf@neverwas.me>
2022-05-23 2:50 ` Pankaj Jangid
2022-05-23 7:48 ` J.P.
[not found] ` <87fsl0zo2e.fsf@neverwas.me>
2022-08-10 13:15 ` J.P. [this message]
[not found] ` <87a68cnss7.fsf_-_@neverwas.me>
2022-08-11 2:55 ` bug#51753: bug#55540: 29.0.50; ERC launches autojoin-channels in current frame Pankaj Jangid
[not found] ` <87sfm3tro1.fsf@codeisgreat.org>
2022-09-06 11:01 ` bug#55540: 29.0.50; ERC launches autojoin-channels in current frame instead of original frame Lars Ingebrigtsen
2022-09-06 11:01 ` bug#51753: " Lars Ingebrigtsen
[not found] ` <87o7vsu5pc.fsf_-_@gnus.org>
2022-09-06 13:53 ` J.P.
2022-09-06 13:53 ` J.P.
[not found] ` <87o7vs38yp.fsf@neverwas.me>
2022-09-06 14:02 ` bug#51753: " Lars Ingebrigtsen
2022-09-07 3:10 ` J.P.
2022-09-07 3:10 ` bug#51753: " J.P.
[not found] ` <874jxj282o.fsf@neverwas.me>
2022-09-07 12:55 ` Lars Ingebrigtsen
2022-09-07 12:55 ` bug#51753: " Lars Ingebrigtsen
[not found] ` <87mtbbmjho.fsf@gnus.org>
2022-09-20 13:11 ` J.P.
2022-09-20 13:11 ` J.P.
[not found] ` <87pmfq198w.fsf@neverwas.me>
2022-09-22 3:07 ` Pankaj Jangid
2022-09-22 3:07 ` bug#51753: " Pankaj Jangid
[not found] ` <87y1uc150p.fsf@codeisgreat.org>
2022-09-22 6:22 ` J.P.
2023-04-08 23:25 ` J.P.
2023-04-08 23:25 ` bug#51753: " J.P.
[not found] ` <87pmg77tpc.fsf@dataswamp.org>
2022-12-30 14:28 ` J.P.
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to='87a68cnss7.fsf_-___13671.3780275144$1660138999$gmane$org@neverwas.me' \
--to=jp@neverwas.me \
--cc=51753@debbugs.gnu.org \
--cc=emacs-erc@gnu.org \
--cc=pankaj@codeisgreat.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).