From 17c1c7b9c3e2c1708e300638ec351bbdfc1776f5 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 19 Jun 2023 23:14:40 -0700 Subject: [PATCH 1/2] Revert "Allow erc-reuse-frames to favor connections" This (mostly) reverts commit 0e4c07dc7448aafd2aa5f6e101d7b7aac23d8a6b. * etc/ERC-NEWS: Also revert hunk from 52c8d537 "* etc/ERC-NEWS: Add section for ERC 5.6." because it announced this feature, which no longer exists. * lisp/erc/erc.el (erc-reuse-frames): Revise doc string instead of reverting completely. (Bug#62833) --- etc/ERC-NEWS | 8 - lisp/erc/erc.el | 64 ++------ test/lisp/erc/erc-tests.el | 303 ------------------------------------- 3 files changed, 10 insertions(+), 365 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 68f1083621c..68cf0e2d6ca 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -82,14 +82,6 @@ connectivity before attempting to reconnect in earnest. See options 'erc-server-reconnect-function' and 'erc-nickname-in-use-functions' to get started. -** Easily constrain all ERC-related business to a dedicated frame. -The option 'erc-reuse-frames' can now be set to 'displayed', which -tells ERC to show new buffers in frames already occupied by buffers -from the same connection. This customization depends on the option -'erc-buffer-display' (formerly 'erc-join-buffer') being set to -'frame'. If you find the name 'displayed' unhelpful, please suggest -an alternative by writing to the mailing list. - ** Module 'fill' can add a bit of space between messages. On graphical displays, it's now possible to add some breathing room around certain messages via the new option 'erc-fill-line-spacing'. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index a1538962602..70adbb15b5f 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1626,23 +1626,14 @@ erc-frame-dedicated-flag (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." @@ -2095,35 +2086,6 @@ erc--updating-modules-p 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.") @@ -2142,21 +2104,15 @@ erc-setup-buffer ('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) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index f3489a16386..b751ef50520 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -503,309 +503,6 @@ 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))) - (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 "_`")) -- 2.40.1