From 24dafe2771b6756c10a259ca5f5782f7d11f8fe7 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 9 Jun 2023 00:14:52 -0700 Subject: [PATCH 0/2] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (2): [5.6] Allow custom display-buffer actions in ERC [5.6] Move erc-reuse-frames choice to action function etc/ERC-NEWS | 20 +-- lisp/erc/erc-backend.el | 9 +- lisp/erc/erc.el | 249 ++++++++++++++++++++++++++----------- test/lisp/erc/erc-tests.el | 91 +++++++++++--- 4 files changed, 268 insertions(+), 101 deletions(-) Interdiff: diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index edf9990d0de..0aa8b4fc634 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -59,14 +59,14 @@ option (now known as 'erc-receive-query-display') is nil, ERC uses via the new compatibility flag 'erc-receive-query-display-defer'. A few subtleties affecting the display of new or reassociated buffers -have also emerged. One involves buffers that already occupy the -selected window. ERC now treats these as deserving of an implicit +have also been introduced. One involves buffers that already occupy +the selected window. ERC now treats these as deserving of an implicit 'bury'. An escape hatch for this and most other baked-in behaviors is now available in the form of a new type variant recognized by all such -options. Indeed, users can now specify their own 'display-buffer' -"actions" to exercise full control over nearly all buffer-display -related decisions. See the doc strings of 'erc-display-buffer' and -friends for details. +options. That is, users can now specify their own 'display-buffer' +function to exercise full control over nearly all buffer-display +related decisions. See the newly expanded doc strings of +'erc-buffer-display' and friends for details. ** Setting a module's mode variable via Customize earns a warning. Trying and failing to activate a module via its minor mode's Custom @@ -92,14 +92,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-backend.el b/lisp/erc/erc-backend.el index 6a1c0745263..ee0fd7a549d 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1690,7 +1690,7 @@ define-erc-response-handler nil (let ((chnl (erc-response.contents parsed)) (buffer nil) - (erc--display-context `((erc-display-buffer . JOIN) + (erc--display-context `((erc-buffer-display . JOIN) ,@erc--display-context))) (pcase-let ((`(,nick ,login ,host) (erc-parse-user (erc-response.sender parsed)))) @@ -1890,7 +1890,7 @@ define-erc-response-handler (noticep (string= cmd "NOTICE")) ;; S.B. downcase *both* tgt and current nick (privp (erc-current-nick-p tgt)) - (erc--display-context `((erc-display-buffer . ,(intern cmd)) + (erc--display-context `((erc-buffer-display . ,(intern cmd)) ,@erc--display-context)) s buffer fnick) @@ -1906,6 +1906,8 @@ define-erc-response-handler (and erc-ensure-target-buffer-on-privmsg (or erc-receive-query-display erc-join-buffer))))) + (push `(erc-receive-query-display . ,(intern cmd)) + erc--display-context) (setq buffer (erc--open-target nick))) ;; A channel buffer has been killed but is still joined. (when erc-ensure-target-buffer-on-privmsg diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 2c5afc876d1..a7646f5e4c1 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1573,17 +1573,10 @@ erc--buffer-display-choices (const :tag "New frame" frame) (const :tag "Don't display" bury) (const :tag "Use current window" buffer) - (cons :tag "Custom action" - (choice :tag "Display function" - (function-item pop-to-buffer) - (function-item display-buffer) - function) - (cons :tag "Action" - (choice :tag "Action function" - function (repeat function)) - (alist :tag "Action arguments" - :key-type symbol - :value-type (sexp :tag "Value"))))) + (choice :tag "Show in granular, context-aware manner" + (function-item erc-display-buffer-in-existing-frame) + (function-item erc-display-buffer-ensuring-frame) + (function :tag "User-provided function"))) "Common choices for buffer-display options.") (defvaralias 'erc-join-buffer 'erc-buffer-display) @@ -1601,25 +1594,30 @@ erc-buffer-display `frame' - in another frame, `bury' - bury it in a new buffer, `buffer' - in place of the current buffer, - (FUNC . ACTION) - call FUNC with buffer and ACTION + DISPLAY-FUNCTION - called with a buffer and an ACTION-ALIST -Here, FUNC signifies a function, like `display-buffer' or -`pop-to-buffer', that takes a buffer and an ACTION as arguments. -If non-nil, ACTION should be as described by the Info -node `(elisp) Displaying Buffers'. At times, ERC may add hints -about the calling context to a given action alist. Keys are -symbols of options that have influenced the outcome, like -`erc-buffer-display', and values are from a set of predefined -constants. In the case of this option, ERC uses the symbols +Here, DISPLAY-FUNCTION should accept a buffer and an ACTION-ALIST +of the kind described by the Info node `(elisp) Buffer Display +Action Alists'. Note that unlike a full display \"action\", this +lacks a function (or list of functions) at its head. At times, +ERC may add hints about the calling context to this alist. Keys +are symbols of options themselves, like `erc-buffer-display'. +Values are chosen from a set of predefined constants. In the +case of this option specifically, ERC uses the symbols - `JOIN',`PRIVMSG' `NOTICE', `erc', and `erc-tls'. + `JOIN', `PRIVMSG', `NOTICE', `erc', and `erc-tls'. The first three signify IRC commands received from the server and the rest entry-point commands responsible for the connection. +When dealing with the latter, users may prefer to call +DISPLAY-FUNCTION directly on a returned buffer (in this case, +server buffer) because the context leading to its creation is +plainly obvious. Note that when the selected window already shows the current -buffer, ERC pretends this option's value is `bury' unless it's -one of the two \"action\" conses described just above." +buffer, ERC pretends this option's value is `bury' unless the +variable `erc-skip-displaying-selected-window-buffer' is nil or +the value of this option is DISPLAY-FUNCTION." :package-version '(ERC . "5.5") :group 'erc-buffers :type (cons 'choice (nthcdr 2 erc--buffer-display-choices))) @@ -1633,17 +1631,16 @@ erc-interactive-display See `erc-buffer-display' for a full description of available values. -When the value is cons indicating a special display action, ERC -injects a hint about the invocation context as an extra item in -the action alist passed to `display-buffer' or `pop-to-buffer'. -The item's key is the symbol `erc-interactive-display' and its -value one of +When the value is a user-provided function, ERC may inject a hint +about the invocation context as an extra item in the alist passed +as the second argument. The hint item's key is the symbol +`erc-interactive-display' and its value one of `/QUERY', `/JOIN', `url', `erc', or `erc-tls'. -All are symbols indicating an inciting user action, such as -issuing a slash command, clicking a URL hyperlink, or invoking an -entry point." +All are symbols indicating an inciting user action, such as the +issuance of a slash command, the clicking of a URL hyperlink, or +the invocation of an entry-point command." :package-version '(ERC . "5.6") ; FIXME sync on release :group 'erc-buffers :type erc--buffer-display-choices) @@ -1655,11 +1652,10 @@ erc-reconnect-display successfully reinvoking `erc-tls' with similar arguments. See `erc-buffer-display' for a description of possible values. -When the value is cons indicating a special display action, ERC -injects a hint about the calling context as an extra item in the -action alist passed to `display-buffer' or `pop-to-buffer'. The -item's key is the symbol `erc-reconnect-display' and its value -non-nil." +When the value is function, ERC may inject a hint about the +calling context as an extra item in the second, \"action alist\" +argument. The item's key is the symbol `erc-reconnect-display' +and its value something non-nil." :package-version '(ERC . "5.5") :group 'erc-buffers :type erc--buffer-display-choices) @@ -1687,23 +1683,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, 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." :group 'erc-buffers - :type '(choice boolean - (const displayed))) + :type '(choice boolean)) (defun erc-channel-p (channel) "Return non-nil if CHANNEL seems to be an IRC channel name." @@ -2161,22 +2148,61 @@ erc--setup-buffer-first-window (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))))) +If performed, return winning window; otherwise, return nil. +Forward ALIST to `display-buffer' machinery." + (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))) + (anyp (assq 'erc--frame-any alist)) + (ercp (lambda (frame) + (let ((val (erc--setup-buffer-first-window frame 'major-mode + 'erc-mode))) + (if anyp val (not val))))) + new) + (when (or (cdr (frame-list)) + (funcall ercp (selected-frame)) + (and (not anyp) + (push `(pop-up-frame-parameters ,erc-frame-alist) alist) + (setq new t))) + (or (and new (display-buffer-pop-up-frame buffer alist)) + ;; Workaround to avoid calling `window--display-buffer' directly. + (display-buffer-use-some-frame buffer `((frame-predicate . ,procp) + ,@alist)) + (display-buffer-use-some-frame buffer `((frame-predicate . ,ercp) + ,@alist)))))) + +(defun erc-display-buffer-in-existing-frame (buffer alist) + "Display BUFFER in an existing frame with others from ERC. +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, use the selected +frame, except for brand new connections, which always get the +invoking frame. Pass ALIST along to `display-buffer'." + (unless (get-buffer-window buffer t) + (display-buffer buffer `((erc--display-buffer-use-some-frame) + (erc--frame-any . t) + (inhibit-switch-frame . t) + (inhibit-same-window . t) + ,@alist)))) + +(defun erc-display-buffer-ensuring-frame (buffer alist) + "Display BUFFER in a frame with others from its connection. +Use any frame already displaying a buffer from the same network +context. Failing that, create one unless some existing frame is +free of any ERC buffers, in which case, use that. Pass ALIST +along to `display-buffer'. + +WARNING: if a frame for the existing connection does not exist, +this function may raise a new one and steal focus." + (unless (get-buffer-window buffer t) + (let ((interactivep (alist-get 'erc-interactive-display alist))) + (display-buffer buffer `((erc--display-buffer-use-some-frame) + ,@(and (not interactivep) + '((inhibit-same-window . t))) + (inhibit-switch-frame . t) + ,@alist))))) (defvar erc--setup-buffer-hook nil "Internal hook for module setup involving windows and frames.") @@ -2189,19 +2215,24 @@ erc--display-context to the user-provided alist when calling `pop-to-buffer' or `display-buffer'.") +(defvar erc-skip-displaying-selected-window-buffer t + "Whether to forgo showing a buffer that's already being displayed. +But only in the selected window.") +(make-obsolete 'erc-show-already-displayed-buffer + "non-nil behavior to be made permanent" "30.1") + (defun erc-setup-buffer (buffer) "Consults `erc-join-buffer' to find out how to display `BUFFER'." (pcase (if (zerop (erc-with-server-buffer erc--server-last-reconnect-count)) erc-join-buffer (or erc-reconnect-display erc-join-buffer)) - ((and (or `(,disp-fn) `(,disp-fn . (,actfns . ,alist))) - (guard (functionp disp-fn))) - (let ((context erc--display-context)) - (unless (zerop erc--server-last-reconnect-count) - (push '(erc-reconnect-display . t) context)) - (funcall disp-fn buffer `(,actfns ,@context ,@alist)))) - ((guard (eq (window-buffer) buffer))) + ((and (pred functionp) disp-fn (let context erc--display-context)) + (unless (zerop erc--server-last-reconnect-count) + (push '(erc-reconnect-display . t) context)) + (funcall disp-fn buffer context)) + ((guard (and erc-skip-displaying-selected-window-buffer + (eq (window-buffer) buffer)))) ('window (if (active-minibuffer-window) (display-buffer buffer) @@ -2211,21 +2242,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 38186467de1..eb1c8f4ead2 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -627,7 +627,7 @@ erc-reuse-frames--t (defun erc-tests--erc-reuse-frames--displayed-single (_ server-name chan-name) - (should (eq erc-reuse-frames 'displayed)) + (should (eq erc-buffer-display #'erc-display-buffer-in-existing-frame)) (ert-info ("New server buffer shown in existing frame") (with-current-buffer (generate-new-buffer server-name) @@ -665,7 +665,7 @@ erc-reuse-frames--displayed-single :tags '(:unstable :expensive-test) (erc-tests--erc-reuse-frames (lambda (orig-frame) - (let ((erc-reuse-frames 'displayed)) + (let ((erc-buffer-display #'erc-display-buffer-in-existing-frame)) (erc-tests--erc-reuse-frames--displayed-single orig-frame "server" "#chan") (should-not (cdr (frame-list)))) @@ -683,7 +683,7 @@ erc-tests--assert-server-split buffer-frame)) (defun erc-tests--erc-reuse-frames--displayed-double (_) - (should (eq erc-reuse-frames 'displayed)) + (should (eq erc-buffer-display #'erc-display-buffer-in-existing-frame)) (make-frame '((name . "other"))) (select-frame (make-frame '((name . "server"))) 'no-record) @@ -727,7 +727,7 @@ erc-reuse-frames--displayed-double :tags '(:unstable :expensive-test) (erc-tests--erc-reuse-frames (lambda (orig-frame) - (let ((erc-reuse-frames 'displayed)) + (let ((erc-buffer-display #'erc-display-buffer-in-existing-frame)) (erc-tests--erc-reuse-frames--displayed-double orig-frame)) (dolist (b '("server" "#chan")) (kill-buffer b))))) @@ -796,7 +796,7 @@ erc-reuse-frames--displayed-full :tags '(:unstable :expensive-test) (erc-tests--erc-reuse-frames (lambda (orig-frame) - (let ((erc-reuse-frames 'displayed)) + (let ((erc-buffer-display #'erc-display-buffer-in-existing-frame)) (erc-tests--erc-reuse-frames--displayed-full orig-frame)) (dolist (b '("server" "ircd" "bob" "alice" "#spam" "#chan")) (kill-buffer b))))) @@ -811,8 +811,6 @@ erc-setup-buffer--custom-action calls) (cl-letf (((symbol-function 'switch-to-buffer) ; regression (lambda (&rest r) (push (cons 'switch-to-buffer r) calls))) - ((symbol-function 'pop-to-buffer) - (lambda (&rest r) (push (cons 'pop-to-buffer r) calls))) ((symbol-function 'erc--test-fun) (lambda (&rest r) (push (cons 'erc--test-fun r) calls))) ((symbol-function 'display-buffer) @@ -827,42 +825,21 @@ erc-setup-buffer--custom-action ;; `display-buffer' (let ((erc--display-context '((erc-buffer-display . 1))) - (erc-join-buffer - '(display-buffer display-buffer-no-window (allow-no-window . t)))) + (erc-join-buffer 'erc--test-fun)) (erc-setup-buffer mbuf) - (should (equal `(display-buffer - ,mbuf - (display-buffer-no-window (erc-buffer-display . 1) - (allow-no-window . t))) + (should (equal `(erc--test-fun ,mbuf ((erc-buffer-display . 1))) (pop calls))) (should-not calls)) ;; `pop-to-buffer' with `erc-reconnect-display' (let* ((erc--server-last-reconnect-count 1) (erc--display-context '((erc-buffer-display . 1))) - (erc-reconnect-display - '(pop-to-buffer . ((display-buffer-same-window))))) + (erc-reconnect-display 'erc--test-fun)) (erc-setup-buffer mbuf) - (should (equal `(pop-to-buffer ,mbuf - ((display-buffer-same-window) - (erc-reconnect-display . t) - (erc-buffer-display . 1))) + (should (equal `(erc--test-fun ,mbuf ((erc-reconnect-display . t) + (erc-buffer-display . 1))) (pop calls))) - (should-not calls)) - - ;; Undocumented variants - (pcase-dolist (`(,want ,got) - `(((pop-to-buffer) (nil)) - ((pop-to-buffer afun) (afun)) - ((pop-to-buffer (afun)) ((afun))) - ((erc--test-fun (afun)) ((afun))) - ((pop-to-buffer afun (a . 1)) (afun (a . 1))) - ((pop-to-buffer (afun) (a . 1)) ((afun) (a . 1))))) - (let* ((erc-buffer-display want)) - (ert-info ((format "want: %S, got: %S, calls: %S" want got calls)) - (erc-setup-buffer mbuf) - (should (equal (list (car want) mbuf got) (pop calls))) - (should-not calls))))) + (should-not calls))) (should (eq owin (selected-window))) (should (eq obuf (window-buffer))))) -- 2.40.1