From 78bba39e65b168a117c077518f2aee2a8465e470 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Tue, 30 May 2023 23:27:12 -0700 Subject: [PATCH 2/2] [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-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-action): Local variable allowing modules to influence the displaying of new ERC buffers independently of user options. (erc-open): Bind `display-buffer-overriding-action' to the value of `erc--display-buffer-action' around calls to `erc-setup-buffer'. (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 | 9 ++- lisp/erc/erc.el | 153 ++++++++++++++++++++++++++++--------- test/lisp/erc/erc-tests.el | 81 +++++++++++++++++--- 4 files changed, 206 insertions(+), 49 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 68cf0e2d6ca..9177f61f8cc 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'. +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 '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 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 b5bd96c189d..3bcda27444d 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) @@ -1686,7 +1687,9 @@ define-erc-response-handler "Handle join messages." nil (let ((chnl (erc-response.contents parsed)) - (buffer nil)) + (buffer nil) + (erc--display-context `((erc-buffer-display . 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) @@ -1885,6 +1888,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) @@ -1899,6 +1904,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 70adbb15b5f..f1dafd0dbf8 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 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: @@ -1559,17 +1576,32 @@ 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 of user options, like +`erc-buffer-display', and values are predefined 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,30 +1610,36 @@ 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', `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))) + :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 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-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))) + :type erc--buffer-display-choices) (defcustom erc-reconnect-display-timeout 10 "Duration `erc-reconnect-display' remains active. @@ -2089,12 +2127,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-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-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)) + ((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 (cons nil context))) + ((guard (and erc-skip-displaying-selected-window-buffer + (eq (window-buffer) buffer)))) ('window (if (active-minibuffer-window) (display-buffer buffer) @@ -2292,8 +2355,10 @@ erc-open ;; 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-action display-buffer-overriding-action))) + (erc-setup-buffer buffer) + (run-hooks 'erc--setup-buffer-hook))) buffer)) @@ -2401,6 +2466,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 +2521,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 +2591,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 +2604,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 +3761,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 +4148,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)))) @@ -4851,13 +4934,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'. @@ -7853,6 +7930,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 b751ef50520..6dbd0d4704f 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -503,6 +503,49 @@ 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-reconnect-display' + (let* ((erc--server-last-reconnect-count 1) + (erc--display-context '((erc-buffer-display . 1))) + (erc-reconnect-display 'erc--test-fun)) + (erc-setup-buffer mbuf) + (should (equal `(erc--test-fun ,mbuf (nil (erc-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 +1482,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 +1573,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 +1586,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 +1603,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 +1623,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 +1634,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 +1646,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 +1659,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 +1673,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 +1689,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 +1702,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 +1714,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