From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: "J.P." Newsgroups: gmane.emacs.bugs Subject: bug#51753: bug#55540: 29.0.50; ERC launches autojoin-channels in current frame Date: Wed, 10 Aug 2022 06:15:52 -0700 Message-ID: <87a68cnss7.fsf_-___13671.3780275144$1660138999$gmane$org@neverwas.me> References: <878rqwjqua.fsf@codeisgreat.org> <87a6b92ers.fsf@neverwas.me> <875ylxm07b.fsf@codeisgreat.org> <87fsl0zo2e.fsf@neverwas.me> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="38914"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/29.0.50 (gnu/linux) Cc: 51753@debbugs.gnu.org, emacs-erc@gnu.org To: Pankaj Jangid Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Wed Aug 10 15:43:12 2022 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1oLlzK-0009sj-N4 for geb-bug-gnu-emacs@m.gmane-mx.org; Wed, 10 Aug 2022 15:43:11 +0200 Original-Received: from localhost ([::1]:43966 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1oLlzJ-0001p4-Ln for geb-bug-gnu-emacs@m.gmane-mx.org; Wed, 10 Aug 2022 09:43:09 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:53774) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oLla3-0003qa-Go for bug-gnu-emacs@gnu.org; Wed, 10 Aug 2022 09:17:03 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:57143) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oLla2-0003qZ-42 for bug-gnu-emacs@gnu.org; Wed, 10 Aug 2022 09:17:03 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1oLla1-000327-WD for bug-gnu-emacs@gnu.org; Wed, 10 Aug 2022 09:17:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: "J.P." Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 10 Aug 2022 13:17:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 51753 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 51753-submit@debbugs.gnu.org id=B51753.166013737111597 (code B ref 51753); Wed, 10 Aug 2022 13:17:01 +0000 Original-Received: (at 51753) by debbugs.gnu.org; 10 Aug 2022 13:16:11 +0000 Original-Received: from localhost ([127.0.0.1]:46892 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oLlZB-00030x-M1 for submit@debbugs.gnu.org; Wed, 10 Aug 2022 09:16:11 -0400 Original-Received: from mail-108-mta247.mxroute.com ([136.175.108.247]:42897) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oLlZ7-00030A-7f for 51753@debbugs.gnu.org; Wed, 10 Aug 2022 09:16:07 -0400 Original-Received: from filter006.mxroute.com ([140.82.40.27] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta247.mxroute.com (ZoneMTA) with ESMTPSA id 18287e5bd800000261.002 for <51753@debbugs.gnu.org> (version=TLSv1/SSLv3 cipher=ECDHE-RSA-AES128-GCM-SHA256); Wed, 10 Aug 2022 13:15:56 +0000 X-Zone-Loop: bfbcf897e94ef6ed6fb59e36499ba7d7a0466be1e9ad X-Originating-IP: [140.82.40.27] DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=neverwas.me ; s=x; h=Content-Type:MIME-Version:Message-ID:In-Reply-To:Date:References: Subject:Cc:To:From:Sender:Reply-To:Content-Transfer-Encoding:Content-ID: Content-Description:Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc :Resent-Message-ID:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=OJCAm5kqDXac6/B7u9z3WzESkSZJh+Hsr96MndQTyn0=; b=DQOXp6bSFyvySze9oQyIU+v0jv 5/Km+XYxy9yBhf2CX57lKgn4RyUcpdaYSDM+b1RF6DwRi+JzGWTEf+5Hr4C6SIhJOQRPq9QYo89DY KB2YnTRSYIm9M5KNL8NI84GAV8WMVHX0W2yNzxK2fnM2ArIAXA4NibR12Qd8vNcIkcaU4B8XmpWI3 nRal78PcBeGwfTJZZjkM88CYHvFQy5QdshTykWgwPHM/9xRzvci8kByP7QZIm0RdrHu/6c7TFnbd9 GFtt9NajA/EiyyWH38J9EgoTvbDDnnSIW07YYahVWcq3CVAE2kn7f8Dyz/siLM3M7bzJ4MILPRyhI 4jsf36OQ==; In-Reply-To: <87fsl0zo2e.fsf@neverwas.me> (J. P.'s message of "Mon, 23 May 2022 00:48:57 -0700") X-Authenticated-Id: masked@neverwas.me X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:239295 Archived-At: --=-=-= Content-Type: text/plain Hi Pankaj, "J.P." 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. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-v2-v3.diff >From 5098c91eb6176e217f590bfa3da965cbe84653dc Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Allow-erc-reuse-frames-to-favor-connections.patch >From 5098c91eb6176e217f590bfa3da965cbe84653dc Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-=--