From 3e3a63eb426fc92558a7ca8e58022a3b50301ed5 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Tue, 30 May 2023 23:27:12 -0700 Subject: [PATCH 1/1] [5.6] Allow custom display-buffer actions in ERC * doc/misc/erc.texi: Add new section for buffer-display options under the Integrations chapter. * etc/ERC-NEWS: Mention new function variant for all buffer-display options. * lisp/erc/erc-backend.el (erc--server-reconnect-display-timer, erc-server-last-reconnect-on-disconnect): Use new name for option `erc-reconnect-display', now `erc-auto-reconnect-display'. (erc--server-determine-join-display-context): New generic function to determine value of `erc--display-context' during JOINs. (erc-server-JOIN, erc-server-PRIVMSG): Set `erc--display-context' to a symbol for the handler's IRC command, like `JOIN', in order to influence `erc-setup-buffer' by way of `erc--open-target'. * lisp/erc/erc-join.el (erc-autojoin-disable): Unset variable `erc-join--requested-channels'. (erc-join--requested-channels): New local variable to remember channels we've attempted to JOIN this session that haven't yet been confirmed by the server. (erc--server-determine-join-display-context): New implementation of generic function for `erc-autojoin-mode'. (erc-autojoin--join): Remember JOIN'd channels. * lisp/erc/erc.el (erc--buffer-display-choices): New helper for defining common `:type' for all buffer-display options. (erc-buffer-display): Add new choice of either `display-buffer' or `pop-to-buffer' paired with an "action alist". (erc-buffer-display, erc-interactive-display, erc-auto-reconnect-display, erc-receive-query-display): Use helper `erc--buffer-display-choices' for defining `:type'. (erc-reconnect-display, erc-auto-reconnect-display): Alias former to latter, now the preferred name. (erc-reconnect-timeout, erc-auto-reconnect-timeout): Change name from former to latter. This option is new in ERC 5.6. (erc-reconnect-display-include-server-buffers): New option. (erc-buffer-do): Revise doc string. (erc--display-context): New variable to contain an alist of "context tokens" to be provided as the "action alist" to `erc-buffer-display' functions. (erc-skip-displaying-selected-window-buffer): New variable, deprecated at birth, to act as an escape hatch for folks who don't want to skip the displaying of buffers already showing in the selected window. (erc--display-buffer-overriding-action): Local variable allowing modules to influence the displaying of new ERC buffers independently of user options. (erc-setup-buffer): Do nothing when the selected window already shows current buffer unless user has provided a custom display function. Accommodate new Custom choice function values `display-buffer' and `pop-to-buffer'. (erc-open): Run `erc-setup-buffer' when option `erc-reconnect-display-include-server-buffers' is non-nil, even for existing server buffers. Bind `display-buffer-overriding-action' to the value of `erc--display-buffer-overriding-action' around calls to `erc-setup-buffer'. (erc-select-read-args): Add `erc--display-context' to environment. (erc, erc-tls): Bind `erc--display-context' around calls to `erc-select-read-args' and main body. (erc-cmd-JOIN, erc-cmd-QUERY, erc--cmd-reconnect, erc-handle-irc-url): Add item for `erc-interactive-display' to `erc--display-context'. * test/lisp/erc/erc-scenarios-base-buffer-display.el (erc-scenarios-base-buffer-display--defwin-recbury-intbuf, erc-scenarios-base-buffer-display--defwino-recbury-intbuf, erc-scenarios-base-buffer-display--count-reset-timeout): Use preferred name `erc-auto-reconnect-display' for `erc-reconnect-display'. * test/lisp/erc/erc-tests.el (erc--initialize-markers): Fix unrealistic call to `erc-open'. (erc-setup-buffer--custom-action): New test. (erc-select-read-args, erc-tls, erc--interactive): Expect new environment binding for `erc--display-context'. (Bug#62833) --- doc/misc/erc.texi | 177 +++++++++++++++ etc/ERC-NEWS | 16 +- lisp/erc/erc-backend.el | 21 +- lisp/erc/erc-join.el | 17 +- lisp/erc/erc.el | 202 +++++++++++++----- .../erc/erc-scenarios-base-buffer-display.el | 28 +-- test/lisp/erc/erc-tests.el | 87 ++++++-- 7 files changed, 464 insertions(+), 84 deletions(-) diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index ddfdb2e2b64..f8da23a9865 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -613,6 +613,7 @@ Advanced Usage * URL:: Opening IRC URLs in ERC. * SOCKS:: Connecting to IRC with a SOCKS proxy. * auth-source:: Retrieving auth-source entries with ERC. +* display-buffer:: Controlling how ERC displays buffers. @end detailmenu @end menu @@ -1226,6 +1227,7 @@ Integrations @menu * auth-source:: Retrieving auth-source entries with ERC. +* display-buffer:: Controlling how ERC displays buffers. @end menu @anchor{URL} @@ -1468,6 +1470,181 @@ auth-source @samp{user} field (for example, @samp{login "#fsf"}, in netrc's case). The actual key goes in the @samp{password} (or @samp{secret}) field. +@node display-buffer +@subsection display-buffer +@cindex display-buffer + +ERC supports the ``action'' interface used by @code{display-buffer} +and friends from @file{window.el}. @xref{Top,,Displaying Buffers, +elisp, Emacs buffer display machinery}, for specifics. When ERC +displays a new or ``reassociated'' buffer, it consults its various +buffer-display options, such as @code{erc-buffer-display}, to decide +whether and how the buffer ought to appear in a window. Exactly which +one it consults depends on the context in which the buffer is being +manifested. + +For some buffer-display options, the context is pretty cut and dry. +For instance, in the case of @code{erc-receive-query-display}, you're +receiving a query from someone you haven't yet chatted with in the +current session. For other options, like +@code{erc-interactive-display}, the precise context varies. For +example, you might be opening a query buffer with the command +@kbd{/QUERY bob @key{RET}} or joining a new channel with @kbd{/JOIN +#chan @key{RET}}. Power users wishing to distinguish between such +nuanced contexts or just exercise more control over buffer-display +behavior generally can elect to override these options by setting one +or more to a ``@code{display-buffer}-like'' function that accepts a +@var{buffer} and an @var{action} argument. + +@subsubheading Examples + +In this first example, a user-provided buffer-display function +displays new server buffers in a split window when the user issues an +@kbd{M-x erc-tls @key{RET}} or clicks an @samp{irc://}-style +@acronym{URL} (@pxref{URL}). Otherwise, ERC simply ``buries'' the +buffer. (For historical reasons, ERC's buffer-display options use the +term ``bury'' to mean ``ignore'' rather than some operation that +possibly modifies the buffer list.) + +@lisp +(defun my-erc-interactive-display-buffer (buffer action) + "Pop to BUFFER when running \\[erc-tls] or clicking a link." + (when-let ((alist (cdr action)) + (found (alist-get 'erc-interactive-display alist)) + ((memq found '(erc-tls url)))) + (pop-to-buffer buffer action))) + +(setopt erc-interactive-display #'my-erc-interactive-display-buffer) +@end lisp + +@noindent +Observe that ERC supplies the names of buffer-display options as +@var{action} alist keys and pairs them with contextual constants, like +the symbols @samp{erc-tls} or @samp{url}, the full lineup of which are +enumerated below. + +In this second example, the user writes three predicates that somewhat +resemble the ``@code{display-buffer}-like'' function above. These too +look for @var{action} alist keys sharing the names of buffer-display +options (and, in one case, a module's minor mode). + +@lisp +(defun my-erc-disp-entry-p (_ action) + (memq (cdr (or (assq 'erc-buffer-display action) + (assq 'erc-interactive-display action))) + '(erc-tls url))) + +(defun my-erc-disp-query-p (_ action) + (or (eq (cdr (assq 'erc-interactive-display action)) '/QUERY) + (and (eq (cdr (assq 'erc-receive-query-display action)) 'PRIVMSG) + (member (erc-default-target) '("bob" "alice"))))) + +(defun my-erc-disp-chan-p (_ action) + (or (assq 'erc-autojoin-mode action) + (and (memq (cdr (assq 'erc-buffer-display alist)) 'JOIN) + (member (erc-default-target) '("#emacs" "#fsf"))))) +@end lisp + +@noindent +You'll notice we ignore the @var{buffer} parameter of these predicates +because ERC ensures that @var{buffer} is already current (which is why +we can freely call @code{erc-default-target}). Note also that we +cheat a little by treating the @var{action} parameter like an alist +when it's really a cons of one or more functions and an alist. + +@noindent +To complement our predicates, we set all three buffer-display options +referenced in their @var{action}-alist lookups to +@code{display-buffer}. This tells ERC to defer to that function in +the display contexts covered by these options. + +@lisp +(setopt erc-buffer-display #'display-buffer + erc-interactive-display #'display-buffer + erc-receive-query-display #'display-buffer + ;; + erc-auto-reconnect-display 'bury) +@end lisp + +@noindent +Finally, we compose our predicates into @code{buffer-match-p} +conditions and pair them with various well known @code{display-buffer} +action functions and action-alist members. + +@lisp +(setopt display-buffer-alist + + ;; Create new frame with M-x erc-tls RET or (erc-tls ...) + '(((and (major-mode . erc-mode) my-erc-disp-entry-p) + display-buffer-pop-up-frame + (reusable-frames . visible)) + + ;; Show important chans and queries in a split. + ((and (major-mode . erc-mode) + (or my-erc-disp-chan-p my-erc-disp-query-p)) + display-buffer-pop-up-window) + + ;; Ignore everything else. + ((major-mode . erc-mode) + display-buffer-no-window + (allow-no-window . t)))) +@end lisp + +@noindent +Of course, we could just as well set our buffer-display options to one +or more homespun functions instead of bothering with +@code{display-buffer-alist} at all (in what would make for a more +complicated version of our first example). But perhaps we already +have a growing menagerie of similar predicates and like to keep +everything in one place in our @file{init.el}. + +@subsubheading Action alist items + +@table @asis +@item Option-based keys: +All keys are symbols, as are values, unless otherwise noted. + +@itemize @bullet +@item @code{erc-buffer-display} +@itemize @minus +@item @samp{JOIN} +@item @samp{NOTICE} +@item @samp{PRIVMSG} +@item @samp{erc} (entry point called non-interactively) +@item @samp{erc-tls} +@end itemize + +@item @code{erc-interactive-display} +@itemize @minus +@item @samp{/QUERY} +@item @samp{/JOIN} +@item @samp{/RECONNECT} +@item @samp{url} (hyperlink clicked) +@item @samp{erc} (entry point called interactively) +@item @samp{erc-tls} +@end itemize + +@item @code{erc-receive-query-display} +@itemize @minus +@item @samp{NOTICE} +@item @samp{PRIVMSG} +@end itemize + +@item @code{erc-auto-reconnect-display} +@itemize @minus +@item something non-@code{nil} +@end itemize +@end itemize + +@item Module-based (minor-mode) keys: + +@itemize @bullet +@item @code{erc-interactive-display} +@itemize @minus +@item channel name as a string +@end itemize +@end itemize +@end table @node Options @section Options diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 5665b760ea9..55f9aa4a8d5 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -37,7 +37,7 @@ decade overdue, this is no longer the case. Other UX improvements in this area aim to make the process of connecting interactively slightly more streamlined and less repetitive, even for veteran users. -** Revised buffer-display handling for interactive commands. +** Revised buffer-display handling. A point of friction for new users and one only just introduced with ERC 5.5 has been the lack of visual feedback when first connecting via M-x erc or when issuing a "/JOIN" command at the prompt. As explained @@ -56,7 +56,19 @@ reported as being difficult to discover and remember. When the latter option (now known as 'erc-receive-query-display') is nil, ERC uses 'erc-join-buffer' in its place, much like it does for 'erc-interactive-display'. The old nil behavior can still be gotten -via the new compatibility flag 'erc-receive-query-display-defer'. +via the new compatibility flag 'erc-receive-query-display-defer'. The +relatively new option 'erc-reconnect-display' has likewise been +renamed, this time for clarity, to 'erc-auto-reconnect-display'. + +This release also introduces a few subtleties affecting the display of +new or reassociated buffers. 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. That is, users can now specify their own 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 diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index f1b51f9234a..dcec817107f 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -101,6 +101,7 @@ (eval-when-compile (require 'cl-lib)) (require 'erc-common) +(defvar erc--display-context) (defvar erc--target) (defvar erc--user-from-nick-function) (defvar erc-channel-list) @@ -304,7 +305,7 @@ erc--server-reconnect-display-timer "Timer that resets `erc--server-last-reconnect-count' to zero. Becomes non-nil in all server buffers when an IRC connection is first \"established\" and carries out its duties -`erc-reconnect-display-timeout' seconds later.") +`erc-auto-reconnect-display-timeout' seconds later.") (defvar-local erc--server-last-reconnect-count 0 "Snapshot of reconnect count when the connection was established.") @@ -957,7 +958,7 @@ erc--server-last-reconnect-on-disconnect (erc--server-last-reconnect-display-reset (current-buffer))) (defun erc--server-last-reconnect-display-reset (buffer) - "Deactivate `erc-reconnect-display'." + "Deactivate `erc-auto-reconnect-display'." (when (buffer-live-p buffer) (with-current-buffer buffer (when erc--server-reconnect-display-timer @@ -1684,6 +1685,12 @@ define-erc-response-handler parsed 'notice 'active 'INVITE ?n nick ?u login ?h host ?c chnl))))) +(cl-defmethod erc--server-determine-join-display-context (_channel alist) + "Determine `erc--display-context' for JOINs." + (if (assq 'erc-buffer-display alist) + alist + `((erc-buffer-display . JOIN) ,@alist))) + (define-erc-response-handler (JOIN) "Handle join messages." nil @@ -1698,7 +1705,11 @@ define-erc-response-handler (let* ((str (cond ;; If I have joined a channel ((erc-current-nick-p nick) - (when (setq buffer (erc--open-target chnl)) + (let ((erc--display-context + (erc--server-determine-join-display-context + chnl erc--display-context))) + (setq buffer (erc--open-target chnl))) + (when buffer (set-buffer buffer) (with-suppressed-warnings ((obsolete erc-add-default-channel)) @@ -1887,6 +1898,8 @@ 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-buffer-display . ,(intern cmd)) + ,@erc--display-context)) s buffer fnick) (setf (erc-response.contents parsed) msg) @@ -1901,6 +1914,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-join.el b/lisp/erc/erc-join.el index 45cfd565f89..4419b620cf5 100644 --- a/lisp/erc/erc-join.el +++ b/lisp/erc/erc-join.el @@ -48,7 +48,9 @@ autojoin ((remove-hook 'erc-after-connect #'erc-autojoin-channels) (remove-hook 'erc-nickserv-identified-hook #'erc-autojoin-after-ident) (remove-hook 'erc-server-JOIN-functions #'erc-autojoin-add) - (remove-hook 'erc-server-PART-functions #'erc-autojoin-remove))) + (remove-hook 'erc-server-PART-functions #'erc-autojoin-remove) + (erc-buffer-do (lambda () + (kill-local-variable 'erc-join--requested-channels))))) (defcustom erc-autojoin-channels-alist nil "Alist of channels to autojoin on IRC networks. @@ -138,6 +140,18 @@ erc-autojoin-server-match (string-match-p candidate (or erc-server-announced-name erc-session-server))))) +(defvar-local erc-join--requested-channels nil + "List of channels for which an outgoing JOIN was sent.") + +(cl-defmethod erc--server-determine-join-display-context + (channel alist &context (erc-autojoin-mode (eql t))) + "Add item to `erc-display-context' ALIST if CHANNEL was autojoined." + (when (member channel erc-join--requested-channels) + (setq erc-join--requested-channels + (delete channel erc-join--requested-channels)) + (push (cons 'erc-autojoin-mode channel) alist)) + (cl-call-next-method channel alist)) + (defun erc-autojoin--join () ;; This is called in the server buffer (pcase-dolist (`(,name . ,channels) erc-autojoin-channels-alist) @@ -146,6 +160,7 @@ erc-autojoin--join (let ((buf (erc-get-buffer chan erc-server-process))) (unless (and buf (with-current-buffer buf (erc--current-buffer-joined-p))) + (push chan erc-join--requested-channels) (erc-server-join-channel nil chan))))))) (defun erc-autojoin-after-ident (_network _nick) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index e23185934f7..c4c698c8273 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1548,9 +1548,26 @@ erc-default-port-tls "IRC port to use for encrypted connections if it cannot be \ detected otherwise.") +(defconst erc--buffer-display-choices + `(choice (const :tag "Use value of `erc-buffer-display'" nil) + (const :tag "Split window and select" window) + (const :tag "Split window but don't select" window-noselect) + (const :tag "New frame" frame) + (const :tag "Don't display" bury) + (const :tag "Use current window" buffer) + (choice :tag "Defer to a display function" + (function-item display-buffer) + (function-item pop-to-buffer) + (function :tag "User-defined"))) + "Common choices for buffer-display options.") + (defvaralias 'erc-join-buffer 'erc-buffer-display) (defcustom erc-buffer-display 'bury "How to display a newly created ERC buffer. +This determines ERC's baseline, \"catch-all\" buffer-display +behavior. It takes a backseat to more specific options, like +`erc-interactive-display', `erc-auto-reconnect-display', and +`erc-receive-query-display'. The available choices are: @@ -1559,17 +1576,33 @@ erc-buffer-display `frame' - in another frame, `bury' - bury it in a new buffer, `buffer' - in place of the current buffer, - -See related options `erc-interactive-display', -`erc-reconnect-display', and `erc-receive-query-display'." + DISPLAY-FUNCTION - a `display-buffer'-like function + +Here, DISPLAY-FUNCTION should accept a buffer and an ACTION of +the kind described by the Info node `(elisp) Choosing Window'. +At times, ERC may add hints about the calling context to the +ACTION's alist. Keys are symbols such as user options, like +`erc-buffer-display', or module minor modes, like +`erc-autojoin-mode'. Values are non-nil constants specific to +each. For this particular option, possible values include the +symbols + + `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 two, users may prefer to call +DISPLAY-FUNCTION directly on (server) buffers returned by these +entry points because the context leading to their creation is +plainly obvious. + +Note that when the selected window already shows the current +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 '(choice (const :tag "Split window and select" window) - (const :tag "Split window, don't select" window-noselect) - (const :tag "New frame" frame) - (const :tag "Bury in new buffer" bury) - (const :tag "Use current buffer" buffer) - (const :tag "Use current buffer" t))) + :type (cons 'choice (nthcdr 2 erc--buffer-display-choices))) (defvaralias 'erc-query-display 'erc-interactive-display) (defcustom erc-interactive-display 'window @@ -1578,38 +1611,57 @@ erc-interactive-display interactively at the prompt. It does not apply when calling a handler for such a command, like `erc-cmd-JOIN', from lisp code. See `erc-buffer-display' for a full description of available -values." +values. + +When the value is a user-provided function, ERC may inject a hint +about the invocation context as an extra item in the \"action +alist\" included as part of the second argument. The item's key +is the symbol `erc-interactive-display' and its value one of + + `/QUERY', `/JOIN', `/RECONNECT', `url', `erc', or `erc-tls'. + +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 '(choice (const :tag "Use value of `erc-buffer-display'" nil) - (const :tag "Split window and select" window) - (const :tag "Split window, don't select" window-noselect) - (const :tag "New frame" frame) - (const :tag "Bury new and don't display existing" bury) - (const :tag "Use current buffer" buffer))) - -(defcustom erc-reconnect-display nil - "How and whether to display a channel buffer when auto-reconnecting. -This only affects automatic reconnections and is ignored, like -all other buffer-display options, when issuing a /RECONNECT or -successfully reinvoking `erc-tls' with similar arguments. See -`erc-buffer-display' for a description of possible values." + :type erc--buffer-display-choices) + +(defvaralias 'erc-reconnect-display 'erc-auto-reconnect-display) +(defcustom erc-auto-reconnect-display nil + "How to display a channel buffer when automatically reconnecting. +ERC ignores this option when a user issues a /RECONNECT or +successfully reinvokes `erc-tls' with similar arguments to those +from the prior connection. See `erc-buffer-display' for a +description of possible values. + +When the value is function, ERC may inject a hint about the +calling context as an extra item in the alist making up the tail +of the second, \"action\" argument. The item's key is the symbol +`erc-auto-reconnect-display' and its value something non-nil." :package-version '(ERC . "5.5") :group 'erc-buffers - :type '(choice (const :tag "Use value of `erc-buffer-display'" nil) - (const :tag "Split window and select" window) - (const :tag "Split window, don't select" window-noselect) - (const :tag "New frame" frame) - (const :tag "Bury in new buffer" bury) - (const :tag "Use current buffer" buffer))) - -(defcustom erc-reconnect-display-timeout 10 - "Duration `erc-reconnect-display' remains active. + :type erc--buffer-display-choices) + +(defcustom erc-auto-reconnect-display-timeout 10 + "Duration `erc-auto-reconnect-display' remains active. The countdown starts on MOTD and is canceled early by any \"slash\" command." + :package-version '(ERC . "5.6") ; FIXME sync on release :type 'integer :group 'erc-buffers) +(defcustom erc-reconnect-display-server-buffers nil + "Apply buffer-display options to server buffers when reconnecting. +By default, ERC does not consider `erc-auto-reconnect-display' +for server buffers when automatically reconnecting, nor does it +consider `erc-interactive-display' when users issue a /RECONNECT. +Enabling this tells ERC to always display server buffers +according to those options." + :package-version '(ERC . "5.6") ; FIXME sync on release + :type 'boolean + :group 'erc-buffers) + (defcustom erc-frame-alist nil "Alist of frame parameters for creating erc frames. A value of nil means to use `default-frame-alist'." @@ -1819,9 +1871,8 @@ erc-buffer-filter (defalias 'erc-buffer-do 'erc-buffer-filter "Call FUNCTION in all ERC buffers or only those for PROC. -Expect users to prefer this alias to `erc-buffer-filter' in cases -where the latter would only be called for effect and its return -value thrown away. +Expect to be preferred over `erc-buffer-filter' in cases where +the return value goes unused. \(fn FUNCTION &optional PROC)") @@ -2089,12 +2140,37 @@ erc--updating-modules-p (defvar erc--setup-buffer-hook nil "Internal hook for module setup involving windows and frames.") +(defvar erc--display-context nil + "Extra action alist items passed to `display-buffer'. +Non-nil when a user specifies a custom display action for certain +display-options, like `erc-auto-reconnect-display'. ERC pairs +the option's symbol with a context-dependent value and adds the +entry 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") + +(defvar-local erc--display-buffer-overriding-action nil + "The value of `display-buffer-overriding-action' when non-nil. +Influences the displaying of new or reassociated ERC buffers. +Reserved for use by built-in modules.") + (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)) + (or erc-auto-reconnect-display erc-join-buffer)) + ((and (pred functionp) disp-fn (let context erc--display-context)) + (unless (zerop erc--server-last-reconnect-count) + (push '(erc-auto-reconnect-display . t) context)) + (funcall disp-fn buffer (cons nil context))) + ((guard (and erc-skip-displaying-selected-window-buffer + (eq (window-buffer) buffer)))) ('window (if (active-minibuffer-window) (display-buffer buffer) @@ -2287,13 +2363,18 @@ erc-open (erc-update-mode-line)) ;; Now display the buffer in a window as per user wishes. - (unless (eq buffer old-buffer) + (when (eq buffer old-buffer) (cl-assert (and connect (not target)))) + (unless (and (not erc-reconnect-display-server-buffers) + (eq buffer old-buffer)) (when erc-log-p ;; we can't log to debug buffer, it may not exist yet (message "erc: old buffer %s, switching to %s" old-buffer buffer)) - (erc-setup-buffer buffer) - (run-hooks 'erc--setup-buffer-hook)) + (let ((display-buffer-overriding-action + (or erc--display-buffer-overriding-action + display-buffer-overriding-action))) + (erc-setup-buffer buffer) + (run-hooks 'erc--setup-buffer-hook))) buffer)) @@ -2401,6 +2482,8 @@ erc-select-read-args env) (when erc-interactive-display (push `(erc-join-buffer . ,erc-interactive-display) env)) + (when erc--display-context + (push `(erc--display-context . ,erc--display-context) env)) (when opener (push `(erc-server-connect-function . ,opener) env)) (when (and passwd (string= "" passwd)) @@ -2454,7 +2537,12 @@ erc See `erc-tls' for the meaning of ID. \(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME ID)" - (interactive (erc-select-read-args)) + (interactive (let ((erc--display-context `((erc-interactive-display . erc) + ,@erc--display-context))) + (erc-select-read-args))) + (unless (assq 'erc--display-context --interactive-env--) + (push '(erc--display-context . ((erc-buffer-display . erc))) + --interactive-env--)) (erc--with-entrypoint-environment --interactive-env-- (erc-open server port nick full-name t password nil nil nil nil user id))) @@ -2519,8 +2607,11 @@ erc-tls interactively. \(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME CLIENT-CERTIFICATE ID)" - (interactive (let ((erc-default-port erc-default-port-tls)) - (erc-select-read-args))) + (interactive + (let ((erc-default-port erc-default-port-tls) + (erc--display-context `((erc-interactive-display . erc-tls) + ,@erc--display-context))) + (erc-select-read-args))) ;; Bind `erc-server-connect-function' to `erc-open-tls-stream' ;; around `erc-open' when a non-default value hasn't been specified ;; by the user or the interactive form. And don't bother checking @@ -2529,6 +2620,9 @@ erc-tls (not (eq erc-server-connect-function #'erc-open-network-stream))) (push '(erc-server-connect-function . erc-open-tls-stream) --interactive-env--)) + (unless (assq 'erc--display-context --interactive-env--) + (push '(erc--display-context . ((erc-buffer-display . erc-tls))) + --interactive-env--)) (erc--with-entrypoint-environment --interactive-env-- (erc-open server port nick full-name t password nil nil nil client-certificate user id))) @@ -3683,7 +3777,10 @@ erc-cmd-JOIN (sn (erc-extract-nick (erc-response.sender parsed))) ((erc-nick-equal-p sn (erc-current-nick))) (erc-join-buffer (or erc-interactive-display - erc-join-buffer))) + erc-join-buffer)) + (erc--display-context `((erc-interactive-display + . /JOIN) + ,@erc--display-context))) (run-hook-with-args-until-success 'erc-server-JOIN-functions proc parsed) t)))) @@ -4067,7 +4164,9 @@ erc-cmd-QUERY ;; currently broken, evil hack to display help anyway ;(erc-delete-query)))) (signal 'wrong-number-of-arguments '(erc-cmd-QUERY 0))) - (let ((erc-join-buffer erc-interactive-display)) + (let ((erc-join-buffer erc-interactive-display) + (erc--display-context `((erc-interactive-display . /QUERY) + ,@erc--display-context))) (erc-with-server-buffer (erc--open-target user)))) @@ -4187,6 +4286,9 @@ 'erc-cmd-GQ (defun erc--cmd-reconnect () (let ((buffer (erc-server-buffer)) + (erc-join-buffer erc-interactive-display) + (erc--display-context `((erc-interactive-display . /RECONNECT) + ,@erc--display-context)) (process nil)) (unless (buffer-live-p buffer) (setq buffer (current-buffer))) @@ -4851,13 +4953,7 @@ erc-receive-query-display :package-version '(ERC . "5.6") :group 'erc-buffers :group 'erc-query - :type '(choice (const :tag "Defer to value of `erc-buffer-display'" nil) - (const :tag "Split window and select" window) - (const :tag "Split window, don't select" window-noselect) - (const :tag "New frame" frame) - (const :tag "Bury in new buffer" bury) - (const :tag "Use current buffer" buffer) - (const :tag "Use current buffer" t))) + :type erc--buffer-display-choices) (defvar erc-receive-query-display-defer t "How to interpret a null `erc-receive-query-display'. @@ -5285,7 +5381,7 @@ erc-connection-established (setq erc--server-last-reconnect-count erc-server-reconnect-count erc-server-reconnect-count 0) (setq erc--server-reconnect-display-timer - (run-at-time erc-reconnect-display-timeout nil + (run-at-time erc-auto-reconnect-display-timeout nil #'erc--server-last-reconnect-display-reset (current-buffer))) (add-hook 'erc-disconnected-hook @@ -7857,6 +7953,8 @@ erc-handle-irc-url Customize `erc-url-connect-function' to override this." (when (eql port 0) (setq port nil)) (let* ((net (erc-networks--determine host)) + (erc--display-context `((erc-interactive-display . url) + ,@erc--display-context)) (server-buffer ;; Viable matches may slip through the cracks for unknown ;; networks. Additional passes could likely improve things. diff --git a/test/lisp/erc/erc-scenarios-base-buffer-display.el b/test/lisp/erc/erc-scenarios-base-buffer-display.el index 548ad00e2d9..df292a8c113 100644 --- a/test/lisp/erc/erc-scenarios-base-buffer-display.el +++ b/test/lisp/erc/erc-scenarios-base-buffer-display.el @@ -26,8 +26,8 @@ (eval-when-compile (require 'erc-join)) -;; These first couple `erc-reconnect-display' tests used to live in -;; erc-scenarios-base-reconnect but have since been renamed. +;; These first couple `erc-auto-reconnect-display' tests used to live +;; in erc-scenarios-base-reconnect but have since been renamed. (defun erc-scenarios-base-buffer-display--reconnect-common (assert-server assert-chan assert-rest) @@ -80,11 +80,11 @@ erc-scenarios-base-buffer-display--defwin-recbury-intbuf :tags '(:expensive-test) (should (eq erc-buffer-display 'bury)) (should (eq erc-interactive-display 'window)) - (should-not erc-reconnect-display) + (should-not erc-auto-reconnect-display) (let ((erc-buffer-display 'window) (erc-interactive-display 'buffer) - (erc-reconnect-display 'bury)) + (erc-auto-reconnect-display 'bury)) (erc-scenarios-base-buffer-display--reconnect-common @@ -104,7 +104,7 @@ erc-scenarios-base-buffer-display--defwin-recbury-intbuf ;; A manual /JOIN command tells ERC we're done auto-reconnecting (with-current-buffer "FooNet" (erc-scenarios-common-say "/JOIN #spam")) - (ert-info ("#spam ignores `erc-reconnect-display'") + (ert-info ("#spam ignores `erc-auto-reconnect-display'") ;; Uses `erc-interactive-display' instead. (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) (should (eq (window-buffer) (get-buffer "#spam"))) @@ -115,10 +115,10 @@ erc-scenarios-base-buffer-display--defwino-recbury-intbuf :tags '(:expensive-test) (should (eq erc-buffer-display 'bury)) (should (eq erc-interactive-display 'window)) - (should-not erc-reconnect-display) + (should-not erc-auto-reconnect-display) (let ((erc-buffer-display 'window-noselect) - (erc-reconnect-display 'bury) + (erc-auto-reconnect-display 'bury) (erc-interactive-display 'buffer)) (erc-scenarios-base-buffer-display--reconnect-common @@ -155,7 +155,7 @@ erc-scenarios-base-buffer-display--defwino-recbury-intbuf (should (eq (window-buffer) (get-buffer "bob"))) (should (frame-root-window-p (selected-window))))) - (ert-info ("Newly joined chan ignores `erc-reconnect-display'") + (ert-info ("Newly joined chan ignores `erc-auto-reconnect-display'") (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) (should (eq (window-buffer) (get-buffer "bob"))) (should-not (frame-root-window-p (selected-window))) @@ -165,13 +165,13 @@ erc-scenarios-base-buffer-display--count-reset-timeout :tags '(:expensive-test) (should (eq erc-buffer-display 'bury)) (should (eq erc-interactive-display 'window)) - (should (eq erc-reconnect-display-timeout 10)) - (should-not erc-reconnect-display) + (should (eq erc-auto-reconnect-display-timeout 10)) + (should-not erc-auto-reconnect-display) (let ((erc-buffer-display 'window-noselect) - (erc-reconnect-display 'bury) + (erc-auto-reconnect-display 'bury) (erc-interactive-display 'buffer) - (erc-reconnect-display-timeout 0.5)) + (erc-auto-reconnect-display-timeout 0.5)) (erc-scenarios-base-buffer-display--reconnect-common #'ignore #'ignore ; These two are identical to the previous test. @@ -188,10 +188,10 @@ erc-scenarios-base-buffer-display--count-reset-timeout (erc-d-t-wait-for 1 (null erc--server-reconnect-display-timer)) (erc-cmd-JOIN "#spam"))) - (ert-info ("Newly joined chan ignores `erc-reconnect-display'") + (ert-info ("Newly joined chan ignores `erc-auto-reconnect-display'") (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) (should (eq (window-buffer) (messages-buffer))) - ;; If `erc-reconnect-display-timeout' were left alone, this + ;; If `erc-auto-reconnect-display-timeout' were left alone, this ;; would be (frame-root-window-p #). (should-not (frame-root-window-p (selected-window))) (should (eq (current-buffer) (window-buffer (next-window)))))))))) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 80c7c708fc5..4596dd9845e 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -418,8 +418,9 @@ erc--initialize-markers (should (looking-at-p (regexp-quote "*** Welcome")))) (ert-info ("Reconnect") - (erc-open "localhost" 6667 "tester" "Tester" nil - "fake" nil "#chan" proc nil "user" nil) + (with-current-buffer (erc-server-buffer) + (erc-open "localhost" 6667 "tester" "Tester" nil + "fake" nil "#chan" proc nil "user" nil)) (should-not (get-buffer "#chan<2>"))) (ert-info ("Existing prompt respected") @@ -503,6 +504,50 @@ erc--switch-to-buffer (dolist (b '("server" "other" "#chan" "#foo" "#fake")) (kill-buffer b)))) +(ert-deftest erc-setup-buffer--custom-action () + (erc-mode) + (erc-tests--set-fake-server-process "sleep" "1") + (setq erc--server-last-reconnect-count 0) + (let ((owin (selected-window)) + (obuf (window-buffer)) + (mbuf (messages-buffer)) + calls) + (cl-letf (((symbol-function 'switch-to-buffer) ; regression + (lambda (&rest r) (push (cons 'switch-to-buffer r) calls))) + ((symbol-function 'erc--test-fun) + (lambda (&rest r) (push (cons 'erc--test-fun r) calls))) + ((symbol-function 'display-buffer) + (lambda (&rest r) (push (cons 'display-buffer r) calls)))) + + ;; Baseline + (let ((erc-join-buffer 'bury)) + (erc-setup-buffer mbuf) + (should-not calls)) + + (should-not erc--display-context) + + ;; `display-buffer' + (let ((erc--display-context '((erc-buffer-display . 1))) + (erc-join-buffer 'erc--test-fun)) + (erc-setup-buffer mbuf) + (should (equal `(erc--test-fun ,mbuf (nil (erc-buffer-display . 1))) + (pop calls))) + (should-not calls)) + + ;; `pop-to-buffer' with `erc-auto-reconnect-display' + (let* ((erc--server-last-reconnect-count 1) + (erc--display-context '((erc-buffer-display . 1))) + (erc-auto-reconnect-display 'erc--test-fun)) + (erc-setup-buffer mbuf) + (should (equal `(erc--test-fun ,mbuf + (nil (erc-auto-reconnect-display . t) + (erc-buffer-display . 1))) + (pop calls))) + (should-not calls))) + + (should (eq owin (selected-window))) + (should (eq obuf (window-buffer))))) + (ert-deftest erc-lurker-maybe-trim () (let (erc-lurker-trim-nicks (erc-lurker-ignore-chars "_`")) @@ -1439,14 +1484,18 @@ erc-select-read-args (erc-join-buffer . window)))))) (ert-info ("Switches to TLS when URL is ircs://") - (should (equal (ert-simulate-keys "ircs://irc.gnu.org\r\r\r\r" - (erc-select-read-args)) - (list :server "irc.gnu.org" - :port 6697 - :nick (user-login-name) - '&interactive-env - '((erc-server-connect-function . erc-open-tls-stream) - (erc-join-buffer . window)))))) + (let ((erc--display-context '((erc-interactive-display . erc)))) + (should (equal (ert-simulate-keys "ircs://irc.gnu.org\r\r\r\r" + (erc-select-read-args)) + (list :server "irc.gnu.org" + :port 6697 + :nick (user-login-name) + '&interactive-env + '((erc-server-connect-function + . erc-open-tls-stream) + (erc--display-context + . ((erc-interactive-display . erc))) + (erc-join-buffer . window))))))) (setq-local erc-interactive-display nil) ; cheat to save space @@ -1526,6 +1575,7 @@ erc-tls ((symbol-function 'erc-open) (lambda (&rest r) (push `((erc-join-buffer ,erc-join-buffer) + (erc--display-context ,@erc--display-context) (erc-server-connect-function ,erc-server-connect-function)) env) @@ -1538,6 +1588,7 @@ erc-tls nil nil nil nil nil "user" nil))) (should (equal (pop env) '((erc-join-buffer bury) + (erc--display-context (erc-buffer-display . erc-tls)) (erc-server-connect-function erc-open-tls-stream))))) (ert-info ("Full") @@ -1554,6 +1605,7 @@ erc-tls "bob:changeme" nil nil nil t "bobo" GNU.org))) (should (equal (pop env) '((erc-join-buffer bury) + (erc--display-context (erc-buffer-display . erc-tls)) (erc-server-connect-function erc-open-tls-stream))))) ;; Values are often nil when called by lisp code, which leads to @@ -1573,6 +1625,7 @@ erc-tls "bob:changeme" nil nil nil nil "bobo" nil))) (should (equal (pop env) '((erc-join-buffer bury) + (erc--display-context (erc-buffer-display . erc-tls)) (erc-server-connect-function erc-open-tls-stream))))) (ert-info ("Interactive") @@ -1583,6 +1636,8 @@ erc-tls nil nil nil nil "user" nil))) (should (equal (pop env) '((erc-join-buffer window) + (erc--display-context + (erc-interactive-display . erc-tls)) (erc-server-connect-function erc-open-tls-stream))))) (ert-info ("Custom connect function") @@ -1593,6 +1648,8 @@ erc-tls nil nil nil nil nil "user" nil))) (should (equal (pop env) '((erc-join-buffer bury) + (erc--display-context + (erc-buffer-display . erc-tls)) (erc-server-connect-function my-connect-func)))))) (ert-info ("Advised default function overlooked") ; intentional @@ -1604,6 +1661,7 @@ erc-tls nil nil nil nil nil "user" nil))) (should (equal (pop env) '((erc-join-buffer bury) + (erc--display-context (erc-buffer-display . erc-tls)) (erc-server-connect-function erc-open-tls-stream)))) (advice-remove 'erc-server-connect-function 'erc-tests--erc-tls)) @@ -1617,6 +1675,8 @@ erc-tls '("irc.libera.chat" 6697 "tester" "unknown" t nil nil nil nil nil "user" nil))) (should (equal (pop env) `((erc-join-buffer bury) + (erc--display-context + (erc-buffer-display . erc-tls)) (erc-server-connect-function ,f)))) (advice-remove 'erc-server-connect-function 'erc-tests--erc-tls))))))) @@ -1631,6 +1691,7 @@ erc--interactive ((symbol-function 'erc-open) (lambda (&rest r) (push `((erc-join-buffer ,erc-join-buffer) + (erc--display-context ,@erc--display-context) (erc-server-connect-function ,erc-server-connect-function)) env) @@ -1643,8 +1704,9 @@ erc--interactive '("irc.libera.chat" 6697 "tester" "unknown" t nil nil nil nil nil "user" nil))) (should (equal (pop env) - '((erc-join-buffer window) (erc-server-connect-function - erc-open-tls-stream))))) + '((erc-join-buffer window) + (erc--display-context (erc-interactive-display . erc)) + (erc-server-connect-function erc-open-tls-stream))))) (ert-info ("Nick supplied, decline TLS upgrade") (ert-simulate-keys "\r\rdummy\r\rn\r" @@ -1654,6 +1716,7 @@ erc--interactive nil nil nil nil "user" nil))) (should (equal (pop env) '((erc-join-buffer window) + (erc--display-context (erc-interactive-display . erc)) (erc-server-connect-function erc-open-network-stream)))))))) -- 2.41.0