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#62833: 30.0.50; ERC 5.6: Rethink buffer-display options and behavior Date: Fri, 02 Jun 2023 07:06:03 -0700 Message-ID: <87pm6em01g.fsf__28659.9447879539$1685714851$gmane$org@neverwas.me> References: <87leiuy3cv.fsf@neverwas.me> <87jzxie9yf.fsf@neverwas.me> <87sfc08h19.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="7387"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: Corwin Brust , emacs-erc@gnu.org To: 62833@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Fri Jun 02 16:07:21 2023 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 1q55R2-0001fG-FY for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 02 Jun 2023 16:07:21 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1q55Ql-0001oJ-LC; Fri, 02 Jun 2023 10:07:03 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1q55Qk-0001nr-6i for bug-gnu-emacs@gnu.org; Fri, 02 Jun 2023 10:07:02 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1q55Qj-0005lt-UJ for bug-gnu-emacs@gnu.org; Fri, 02 Jun 2023 10:07:01 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1q55Qj-0002Wv-Oe for bug-gnu-emacs@gnu.org; Fri, 02 Jun 2023 10:07:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: "J.P." Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 02 Jun 2023 14:07:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 62833 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 62833-submit@debbugs.gnu.org id=B62833.16857147789663 (code B ref 62833); Fri, 02 Jun 2023 14:07:01 +0000 Original-Received: (at 62833) by debbugs.gnu.org; 2 Jun 2023 14:06:18 +0000 Original-Received: from localhost ([127.0.0.1]:40542 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1q55Q0-0002Vm-HL for submit@debbugs.gnu.org; Fri, 02 Jun 2023 10:06:17 -0400 Original-Received: from mail-108-mta98.mxroute.com ([136.175.108.98]:45811) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1q55Py-0002VV-3L for 62833@debbugs.gnu.org; Fri, 02 Jun 2023 10:06:15 -0400 Original-Received: from mail-111-mta2.mxroute.com ([136.175.111.2] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta98.mxroute.com (ZoneMTA) with ESMTPSA id 1887c6e0bc100074ee.002 for <62833@debbugs.gnu.org> (version=TLSv1/SSLv3 cipher=ECDHE-RSA-AES128-GCM-SHA256); Fri, 02 Jun 2023 14:06:06 +0000 X-Zone-Loop: 00d53d3b5ccf23fa442cb757d6bb6f7a6cbf3cb4aa8c X-Originating-IP: [136.175.111.2] 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:Date:References:In-Reply-To: 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=AURyYhjUjeFjR9epfNE5p2rWstqfyu/uGgNF+XKoRac=; b=Vxtl7uZB19s9YjNSP/a7+VdJcK D5D6dgjElX7/B1wyXHIuV/tOgM240hS/c+BI7OAP0AI/mNFd6iEU+0FN0f2BjhvQxKLkblNb87e/4 S/53nNVG875ZvEYIYNyXvISeDJSNGqt3Dv8/QdtgFOFVeRcEnxz2mMMx4w+8uiMVP4WeIkMSaDG3X Ak8HgxipK+dAlf05LmqiNK5sHuSLogtDcVTrfrR9kaGwT2WLBj87oD0IQDUz83R6QoxDQ6XxgmfA+ /AOP7mJTOeEASPxNqfvE0WXk9+51fIFhWPPT1seCs8OEJzZTCU0n7DM6aQau3tOKcJywWKsiTjnj/ e2zNnPZg==; In-Reply-To: <87sfc08h19.fsf@neverwas.me> (J. P.'s message of "Sat, 13 May 2023 07:03:46 -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-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:262770 Archived-At: --=-=-= Content-Type: text/plain "J.P." writes: > So because detecting a user's intent isn't foolproof (not only with 1, > but in general), we may want to extend the existing display options by > offering some sort of universal escape hatch that affords more > granular control. I've attempted something along these lines with the attached patch. It adds a new Custom type variant to all of ERC's buffer-display options. > However, doing this alone won't cover the problem of communicating to > each user-implemented instance of such an escape hatch the necessary > specifics about the context in which Emacs' display machinery is being > summoned. And I don't think switching away from the one-to-many > arrangement we have now to a single option per context is doable because > of the first problem of accurately detecting intent. > > So, as a compromise, I'm thinking we could extend all existing options > to accommodate arbitrary "action" forms, which we'd then pass along to a > new `display-buffer' call (in `erc-setup-buffer') before trusting and > selecting whatever window it spits out. Actually, instead of a `display-buffer' action alone, I went for a cons of a `display-buffer'-compatible function, like `pop-to-buffer', and an action argument, together. > The point would be to supplement user-supplied "action alists" with > extra contextual data to indicate things like the last slash command > invoked. (Alternatively, we could relay the same info via global erc-* > variables; doesn't matter to me.) For this new variant I'm proposing, ERC calls the user's function with the newly created buffer and a possibly augmented version of the action that includes some well defined contextual clues in its alist. The latter are enumerated in the doc strings of the various user options. > However, even this wouldn't be a panacea. A user would still need to > apply some extra elbow grease for things like your `my-connect-fun' or > my DBus example, possibly by doing something like > > (let ((erc-join-buffer > '(my-use-dedicated-frame (inhibit-same-window . t)))) > (erc-tls :server ...)) > > which doesn't seem all that painful. Although, at that point, why not > just do > > (display-buffer (let ((erc-join-buffer 'bury)) (erc-tls :server ...)) > '(my-use-dedicated-frame (inhibit-same-window . t))) > > which has always been possible and is no more complicated? This would be preferable if we had more granular options that only affected a single context, such as something exclusively for non-interactive `erc-tls' invocations. However, as described above, our existing options cover multiple contexts, so this approach falls short in the end, which is a shame because the blanket changes I'm proposing are somewhat invasive and add a nonzero amount of complexity. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-5.6-Allow-custom-display-buffer-actions-in-ERC.patch >From ba83fa278a6d8eec5cf0add2958c9021552e6fb0 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Tue, 30 May 2023 23:27:12 -0700 Subject: [PATCH] [5.6] Allow custom display-buffer actions in ERC * etc/ERC-NEWS: Mention new `display-buffer' "action" variant for all buffer-display options. * lisp/erc/erc-backend.el (erc-server-JOIN, erc-server-PRIVMSG, erc-server-NOTICE): Set `erc--display-context' to a symbol for the IRC command, like `JOIN' in order to influence `erc-setup-buffer' by way of `erc--open-target'. * 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-reconnect-display, erc-receive-query-display): Use helper `erc--buffer-display-choices' for defining `:type'. (erc-setup-buffer): Do nothing when the selected window already shows current buffer unless user has provided a custom action. Accommodate new choice values `display-buffer' and `pop-to-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-handle-irc-url): Add item for `erc-interactive-display' to `erc--display-context'. * test/lisp/erc/erc-tests.el (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) --- etc/ERC-NEWS | 12 +++- lisp/erc/erc-backend.el | 7 +- lisp/erc/erc.el | 142 ++++++++++++++++++++++++++++--------- test/lisp/erc/erc-tests.el | 104 ++++++++++++++++++++++++--- 4 files changed, 218 insertions(+), 47 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index e9ec9e2caab..edf9990d0de 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 @@ -58,6 +58,16 @@ option (now known as 'erc-receive-query-display') is nil, ERC uses 'erc-interactive-display'. The old nil behavior can still be gotten 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 +'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. + ** Setting a module's mode variable via Customize earns a warning. Trying and failing to activate a module via its minor mode's Custom widget has been an age-old annoyance for new users. Previously diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 2de24e7cb25..6a1c0745263 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) @@ -1688,7 +1689,9 @@ define-erc-response-handler "Handle join messages." nil (let ((chnl (erc-response.contents parsed)) - (buffer nil)) + (buffer nil) + (erc--display-context `((erc-display-buffer . JOIN) + ,@erc--display-context))) (pcase-let ((`(,nick ,login ,host) (erc-parse-user (erc-response.sender parsed)))) ;; strip the stupid combined JOIN facility (IRC 2.9) @@ -1887,6 +1890,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-display-buffer . ,(intern cmd)) + ,@erc--display-context)) s buffer fnick) (setf (erc-response.contents parsed) msg) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 2c2df81fa6d..2c5afc876d1 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1566,9 +1566,33 @@ 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) + (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"))))) + "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 the baseline, \"catch-all\" display behavior. It +takes a backseat to more context-specific display options, like +`erc-interactive-display', `erc-reconnect-display', and +`erc-receive-query-display'. The available choices are: @@ -1577,17 +1601,28 @@ 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 + +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 + + `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. -See related options `erc-interactive-display', -`erc-reconnect-display', and `erc-receive-query-display'." +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." :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 @@ -1596,30 +1631,38 @@ 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 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 + + `/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." :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))) + :type erc--buffer-display-choices) (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." +`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." :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))) + :type erc--buffer-display-choices) (defcustom erc-reconnect-display-timeout 10 "Duration `erc-reconnect-display' remains active. @@ -2119,7 +2162,7 @@ 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." +to `display-buffer' machinery." (when-let* ((idp (lambda (value) (and erc-networks--id @@ -2138,12 +2181,27 @@ erc--display-buffer-use-some-frame (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-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'.") + (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))) ('window (if (active-minibuffer-window) (display-buffer buffer) @@ -2455,6 +2513,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)) @@ -2508,7 +2568,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))) @@ -2573,8 +2638,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 @@ -2583,6 +2651,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))) @@ -3729,7 +3800,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)))) @@ -4113,7 +4187,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)))) @@ -4897,13 +4973,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'. @@ -7925,6 +7995,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-tests.el b/test/lisp/erc/erc-tests.el index 1c75f35e1b5..38186467de1 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -801,6 +801,72 @@ erc-reuse-frames--displayed-full (dolist (b '("server" "ircd" "bob" "alice" "#spam" "#chan")) (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 '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) + (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 + '(display-buffer display-buffer-no-window (allow-no-window . t)))) + (erc-setup-buffer mbuf) + (should (equal `(display-buffer + ,mbuf + (display-buffer-no-window (erc-buffer-display . 1) + (allow-no-window . t))) + (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-setup-buffer mbuf) + (should (equal `(pop-to-buffer ,mbuf + ((display-buffer-same-window) + (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 (eq owin (selected-window))) + (should (eq obuf (window-buffer))))) + (ert-deftest erc-lurker-maybe-trim () (let (erc-lurker-trim-nicks (erc-lurker-ignore-chars "_`")) @@ -1737,14 +1803,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 @@ -1824,6 +1894,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) @@ -1836,6 +1907,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") @@ -1852,6 +1924,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 @@ -1871,6 +1944,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") @@ -1881,6 +1955,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") @@ -1891,6 +1967,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 @@ -1902,6 +1980,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)) @@ -1915,6 +1994,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))))))) @@ -1929,6 +2010,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) @@ -1941,8 +2023,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" @@ -1952,6 +2035,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.40.1 --=-=-=--