diff options
| author | F. Jason Park | 2023-05-30 23:27:12 -0700 |
|---|---|---|
| committer | F. Jason Park | 2023-07-13 18:45:31 -0700 |
| commit | b354b3a53bfbb30dc4f98fe9947f3ba939e1436d (patch) | |
| tree | 05dd44b080dd5977d0384ab12b896ffc51b47849 | |
| parent | d45770e8d03ae82d44d05086e22d552ab60e34e9 (diff) | |
| download | emacs-b354b3a53bfbb30dc4f98fe9947f3ba939e1436d.tar.gz emacs-b354b3a53bfbb30dc4f98fe9947f3ba939e1436d.zip | |
Allow custom display-buffer actions in ERC
* doc/misc/erc.texi: Add new section under "Integrations" chapter
describing `display-buffer' Custom function choice for ERC's many
buffer-display options.
* etc/ERC-NEWS: Mention new function variant for all buffer-display
options.
* lisp/erc/erc-backend.el: Add forward declaration for
`erc--called-as-input-p' and `erc--display-context'.
(erc--server-reconnect-display-timer,
erc--server-last-reconnect-display-reset): 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', for the benefit of
custom `display-buffer'-like functions running in `erc-setup-buffer'.
(erc-server-471, erc-server-471-functions, erc-server-473,
erc-server-473-functions): New handlers for JOIN rejections. Also
remove 471 and 473 from comment at bottom of file.
(erc-server-475): Bind `erc--called-as-input-p' so that `erc-cmd-JOIN'
sets `erc-interactive-display' context.
* lisp/erc/erc-join.el (erc-autojoin-mode, erc-autojoin-enable,
erc-autojoin-disable): Kill local variable
`erc-join--requested-channels'. Add and remove
`erc-join--remove-requested-channels' to/from various server-handler
hooks for JOIN rejection numerics.
(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-join--remove-requested-channel): New JOIN rejection handler to
stop tracking channel in `erc-join--requested-channels'.
(erc--server-determine-join-display-context): module-specific
implementation of generic function for `erc-autojoin-mode'.
(erc-autojoin--join): Remember channels slated for JOIN'ing.
* lisp/erc/erc.el (erc--buffer-display-choices): New helper constant
for defining common `:type' for all buffer-display options.
(erc-buffer-display, erc-interactive-display,
erc-auto-reconnect-display, erc-receive-query-display): Use helper
`erc--buffer-display-choices' for defining `:type', which
includes a new choice for a `display-buffer'-like function.
(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-server-buffers): New option.
(erc-buffer-do): Revise doc string.
(erc--display-context): New variable, an alist of "context tokens" to
be forwarded 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, like `display-buffer'
and `pop-to-buffer'.
(erc-open): Run `erc-setup-buffer' when option
`erc-reconnect-display-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'.
(erc-connection-established): Update name of
`erc-reconnect-display-timeout' to
`erc-auto-reconnect-display-timeout'.
(erc-message-english-s471, erc-message-english-s473): New variables,
format templates for JOIN rejection messages.
* 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-scenarios-join-display-context.el: New file.
* 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, erc-server-select):
Expect new environment binding for `erc--display-context'.
* test/lisp/erc/resources/join/buffer-display/mode-context.eld: New
file. (Bug#62833)
| -rw-r--r-- | doc/misc/erc.texi | 181 | ||||
| -rw-r--r-- | etc/ERC-NEWS | 16 | ||||
| -rw-r--r-- | lisp/erc/erc-backend.el | 36 | ||||
| -rw-r--r-- | lisp/erc/erc-join.el | 39 | ||||
| -rw-r--r-- | lisp/erc/erc.el | 212 | ||||
| -rw-r--r-- | test/lisp/erc/erc-scenarios-base-buffer-display.el | 28 | ||||
| -rw-r--r-- | test/lisp/erc/erc-scenarios-join-display-context.el | 66 | ||||
| -rw-r--r-- | test/lisp/erc/erc-tests.el | 90 | ||||
| -rw-r--r-- | test/lisp/erc/resources/join/buffer-display/mode-context.eld | 38 |
9 files changed, 620 insertions, 86 deletions
diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index ddfdb2e2b64..00aa34e51fa 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi | |||
| @@ -613,6 +613,7 @@ Integrations | |||
| 613 | * URL:: Opening IRC URLs in ERC. | 613 | * URL:: Opening IRC URLs in ERC. |
| 614 | * SOCKS:: Connecting to IRC with a SOCKS proxy. | 614 | * SOCKS:: Connecting to IRC with a SOCKS proxy. |
| 615 | * auth-source:: Retrieving auth-source entries with ERC. | 615 | * auth-source:: Retrieving auth-source entries with ERC. |
| 616 | * display-buffer:: Controlling how ERC displays buffers. | ||
| 616 | 617 | ||
| 617 | @end detailmenu | 618 | @end detailmenu |
| 618 | @end menu | 619 | @end menu |
| @@ -1226,6 +1227,7 @@ stuff, to the current ERC buffer." | |||
| 1226 | 1227 | ||
| 1227 | @menu | 1228 | @menu |
| 1228 | * auth-source:: Retrieving auth-source entries with ERC. | 1229 | * auth-source:: Retrieving auth-source entries with ERC. |
| 1230 | * display-buffer:: Controlling how ERC displays buffers. | ||
| 1229 | @end menu | 1231 | @end menu |
| 1230 | 1232 | ||
| 1231 | @anchor{URL} | 1233 | @anchor{URL} |
| @@ -1468,6 +1470,185 @@ required by certain channels you join. When modifying a traditional | |||
| 1468 | @samp{user} field (for example, @samp{login "#fsf"}, in netrc's case). | 1470 | @samp{user} field (for example, @samp{login "#fsf"}, in netrc's case). |
| 1469 | The actual key goes in the @samp{password} (or @samp{secret}) field. | 1471 | The actual key goes in the @samp{password} (or @samp{secret}) field. |
| 1470 | 1472 | ||
| 1473 | @node display-buffer | ||
| 1474 | @subsection display-buffer | ||
| 1475 | @cindex display-buffer | ||
| 1476 | |||
| 1477 | ERC supports the ``action'' interface used by @code{display-buffer} | ||
| 1478 | and friends from @file{window.el}. @xref{Displaying Buffers,,, elisp, | ||
| 1479 | Emacs Lisp}, for specifics. When ERC displays a new or | ||
| 1480 | ``reassociated'' buffer, it consults its various buffer-display | ||
| 1481 | options, such as @code{erc-buffer-display}, to decide whether and how | ||
| 1482 | the buffer ought to appear in a window. Exactly which one it consults | ||
| 1483 | depends on the context in which the buffer is being manifested. | ||
| 1484 | |||
| 1485 | For some buffer-display options, the context is pretty cut and dry. | ||
| 1486 | For instance, in the case of @code{erc-receive-query-display}, you're | ||
| 1487 | receiving a query from someone you haven't yet chatted with in the | ||
| 1488 | current session. For other options, like | ||
| 1489 | @code{erc-interactive-display}, the precise context varies. For | ||
| 1490 | example, you might be opening a query buffer with the command | ||
| 1491 | @kbd{/QUERY bob @key{RET}} or joining a new channel with @kbd{/JOIN | ||
| 1492 | #chan @key{RET}}. Power users wishing to distinguish between such | ||
| 1493 | nuanced contexts or just exercise more control over buffer-display | ||
| 1494 | behavior generally can elect to override these options by setting one | ||
| 1495 | or more to a ``@code{display-buffer}-like'' function that accepts a | ||
| 1496 | @var{buffer} and an @var{action} argument. | ||
| 1497 | |||
| 1498 | @subsubheading Examples | ||
| 1499 | |||
| 1500 | In this first example, a user-provided buffer-display function | ||
| 1501 | displays new server buffers in the current window when issuing an | ||
| 1502 | @kbd{M-x erc-tls @key{RET}} and in a split window for all other | ||
| 1503 | interactve contexts covered by the option | ||
| 1504 | @code{erc-interactive-display}, like clicking an @samp{irc://}-style | ||
| 1505 | @acronym{URL} (@pxref{URL}). | ||
| 1506 | |||
| 1507 | @lisp | ||
| 1508 | (defun my-erc-interactive-display-buffer (buffer action) | ||
| 1509 | "Pop to BUFFER when running \\[erc-tls], clicking a link, etc." | ||
| 1510 | (when-let ((alist (cdr action)) | ||
| 1511 | (found (alist-get 'erc-interactive-display alist))) | ||
| 1512 | (if (eq found 'erc-tls) | ||
| 1513 | (pop-to-buffer-same-window buffer action) | ||
| 1514 | (pop-to-buffer buffer action)))) | ||
| 1515 | |||
| 1516 | (setopt erc-interactive-display #'my-erc-interactive-display-buffer) | ||
| 1517 | @end lisp | ||
| 1518 | |||
| 1519 | @noindent | ||
| 1520 | Observe that ERC supplies the names of buffer-display options as | ||
| 1521 | @var{action} alist keys and pairs them with contextual constants, like | ||
| 1522 | the symbols @samp{erc-tls} or @samp{url}, the full lineup of which are | ||
| 1523 | listed below. | ||
| 1524 | |||
| 1525 | In this second example, the user writes three predicates that somewhat | ||
| 1526 | resemble the ``@code{display-buffer}-like'' function above. These too | ||
| 1527 | look for @var{action} alist keys sharing the names of buffer-display | ||
| 1528 | options (and, in one case, a module's minor mode). | ||
| 1529 | |||
| 1530 | @lisp | ||
| 1531 | (defun my-erc-disp-entry-p (_ action) | ||
| 1532 | (memq (cdr (or (assq 'erc-buffer-display action) | ||
| 1533 | (assq 'erc-interactive-display action))) | ||
| 1534 | '(erc-tls url))) | ||
| 1535 | |||
| 1536 | (defun my-erc-disp-query-p (_ action) | ||
| 1537 | (or (eq (cdr (assq 'erc-interactive-display action)) '/QUERY) | ||
| 1538 | (and (eq (cdr (assq 'erc-receive-query-display action)) 'PRIVMSG) | ||
| 1539 | (member (erc-default-target) '("bob" "alice"))))) | ||
| 1540 | |||
| 1541 | (defun my-erc-disp-chan-p (_ action) | ||
| 1542 | (or (assq 'erc-autojoin-mode action) | ||
| 1543 | (and (memq (cdr (assq 'erc-buffer-display alist)) 'JOIN) | ||
| 1544 | (member (erc-default-target) '("#emacs" "#fsf"))))) | ||
| 1545 | @end lisp | ||
| 1546 | |||
| 1547 | @noindent | ||
| 1548 | You'll notice we ignore the @var{buffer} parameter of these predicates | ||
| 1549 | because ERC ensures that @var{buffer} is already current (which is why | ||
| 1550 | we can freely call @code{erc-default-target}). Note also that we | ||
| 1551 | cheat a little by treating the @var{action} parameter like an alist | ||
| 1552 | when it's really a cons of one or more functions and an alist. | ||
| 1553 | |||
| 1554 | @noindent | ||
| 1555 | To complement our predicates, we set all three buffer-display options | ||
| 1556 | referenced in their @var{action}-alist lookups to | ||
| 1557 | @code{display-buffer}. This tells ERC to defer to that function in | ||
| 1558 | the display contexts covered by these options. | ||
| 1559 | |||
| 1560 | @lisp | ||
| 1561 | (setopt erc-buffer-display #'display-buffer | ||
| 1562 | erc-interactive-display #'display-buffer | ||
| 1563 | erc-receive-query-display #'display-buffer | ||
| 1564 | ;; | ||
| 1565 | erc-auto-reconnect-display 'bury) | ||
| 1566 | @end lisp | ||
| 1567 | |||
| 1568 | @noindent | ||
| 1569 | The last option above just tells ERC to avoid any buffer-display | ||
| 1570 | machinery when auto-reconnecting. (For historical reasons, ERC's | ||
| 1571 | buffer-display options use the term ``bury'' to mean ``ignore'' rather | ||
| 1572 | than @code{bury-buffer}.) | ||
| 1573 | |||
| 1574 | Finally, we compose our predicates into @code{buffer-match-p} | ||
| 1575 | conditions and pair them with various well known @code{display-buffer} | ||
| 1576 | action functions and action-alist members. | ||
| 1577 | |||
| 1578 | @lisp | ||
| 1579 | (setopt display-buffer-alist | ||
| 1580 | |||
| 1581 | ;; Create new frame with M-x erc-tls RET or (erc-tls ...) | ||
| 1582 | '(((and (major-mode . erc-mode) my-erc-disp-entry-p) | ||
| 1583 | display-buffer-pop-up-frame | ||
| 1584 | (reusable-frames . visible)) | ||
| 1585 | |||
| 1586 | ;; Show important chans and queries in a split. | ||
| 1587 | ((and (major-mode . erc-mode) | ||
| 1588 | (or my-erc-disp-chan-p my-erc-disp-query-p)) | ||
| 1589 | display-buffer-pop-up-window) | ||
| 1590 | |||
| 1591 | ;; Ignore everything else. | ||
| 1592 | ((major-mode . erc-mode) | ||
| 1593 | display-buffer-no-window | ||
| 1594 | (allow-no-window . t)))) | ||
| 1595 | @end lisp | ||
| 1596 | |||
| 1597 | @noindent | ||
| 1598 | Of course, we could just as well set our buffer-display options to one | ||
| 1599 | or more homespun functions instead of bothering with | ||
| 1600 | @code{display-buffer-alist} at all (in what would make for a more | ||
| 1601 | complicated version of our first example). But perhaps we already | ||
| 1602 | have a growing menagerie of similar predicates and like to keep | ||
| 1603 | everything in one place in our @file{init.el}. | ||
| 1604 | |||
| 1605 | @subsubheading Action alist items | ||
| 1606 | |||
| 1607 | @table @asis | ||
| 1608 | @item Option-based keys: | ||
| 1609 | All keys are symbols, as are values, unless otherwise noted. | ||
| 1610 | |||
| 1611 | @itemize @bullet | ||
| 1612 | @item @code{erc-buffer-display} | ||
| 1613 | @itemize @minus | ||
| 1614 | @item @samp{JOIN} | ||
| 1615 | @item @samp{NOTICE} | ||
| 1616 | @item @samp{PRIVMSG} | ||
| 1617 | @item @samp{erc} (entry point called non-interactively) | ||
| 1618 | @item @samp{erc-tls} | ||
| 1619 | @end itemize | ||
| 1620 | |||
| 1621 | @item @code{erc-interactive-display} | ||
| 1622 | @itemize @minus | ||
| 1623 | @item @samp{/QUERY} | ||
| 1624 | @item @samp{/JOIN} | ||
| 1625 | @item @samp{/RECONNECT} | ||
| 1626 | @item @samp{url} (hyperlink clicked) | ||
| 1627 | @item @samp{erc} (entry point called interactively) | ||
| 1628 | @item @samp{erc-tls} | ||
| 1629 | @end itemize | ||
| 1630 | |||
| 1631 | @item @code{erc-receive-query-display} | ||
| 1632 | @itemize @minus | ||
| 1633 | @item @samp{NOTICE} | ||
| 1634 | @item @samp{PRIVMSG} | ||
| 1635 | @end itemize | ||
| 1636 | |||
| 1637 | @item @code{erc-auto-reconnect-display} | ||
| 1638 | @itemize @minus | ||
| 1639 | @item something non-@code{nil} | ||
| 1640 | @end itemize | ||
| 1641 | @end itemize | ||
| 1642 | |||
| 1643 | @item Module-based (minor-mode) keys: | ||
| 1644 | |||
| 1645 | @itemize @bullet | ||
| 1646 | @item @code{erc-autojoin-mode} | ||
| 1647 | @itemize @minus | ||
| 1648 | @item channel name as a string, e.g., @code{"#chan"} | ||
| 1649 | @end itemize | ||
| 1650 | @end itemize | ||
| 1651 | @end table | ||
| 1471 | 1652 | ||
| 1472 | @node Options | 1653 | @node Options |
| 1473 | @section Options | 1654 | @section Options |
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 9c94f68ce27..64d73ef7481 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 | |||
| 37 | this area aim to make the process of connecting interactively slightly | 37 | this area aim to make the process of connecting interactively slightly |
| 38 | more streamlined and less repetitive, even for veteran users. | 38 | more streamlined and less repetitive, even for veteran users. |
| 39 | 39 | ||
| 40 | ** Revised buffer-display handling for interactive commands. | 40 | ** Revised buffer-display handling. |
| 41 | A point of friction for new users and one only just introduced with | 41 | A point of friction for new users and one only just introduced with |
| 42 | ERC 5.5 has been the lack of visual feedback when first connecting via | 42 | ERC 5.5 has been the lack of visual feedback when first connecting via |
| 43 | M-x erc or when issuing a "/JOIN" command at the prompt. As explained | 43 | 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 | |||
| 56 | option (now known as 'erc-receive-query-display') is nil, ERC uses | 56 | option (now known as 'erc-receive-query-display') is nil, ERC uses |
| 57 | 'erc-join-buffer' in its place, much like it does for | 57 | 'erc-join-buffer' in its place, much like it does for |
| 58 | 'erc-interactive-display'. The old nil behavior can still be gotten | 58 | 'erc-interactive-display'. The old nil behavior can still be gotten |
| 59 | via the new compatibility flag 'erc-receive-query-display-defer'. | 59 | via the new compatibility flag 'erc-receive-query-display-defer'. The |
| 60 | relatively new option 'erc-reconnect-display' has likewise been | ||
| 61 | renamed, this time for clarity, to 'erc-auto-reconnect-display'. | ||
| 62 | |||
| 63 | This release also introduces a few subtleties affecting the display of | ||
| 64 | new or reassociated buffers. One involves buffers that already occupy | ||
| 65 | the selected window. ERC now treats these as deserving of an implicit | ||
| 66 | 'bury'. An escape hatch for this and most other baked-in behaviors is | ||
| 67 | now available in the form of a new type variant recognized by all such | ||
| 68 | options. That is, users can now specify their own function to | ||
| 69 | exercise full control over nearly all buffer-display related | ||
| 70 | decisions. See the newly expanded doc strings of 'erc-buffer-display' | ||
| 71 | and friends, as well as Info node '(erc) display-buffer', for details. | ||
| 60 | 72 | ||
| 61 | ** Setting a module's mode variable via Customize earns a warning. | 73 | ** Setting a module's mode variable via Customize earns a warning. |
| 62 | Trying and failing to activate a module via its minor mode's Custom | 74 | 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..363509d17fa 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el | |||
| @@ -101,6 +101,8 @@ | |||
| 101 | (eval-when-compile (require 'cl-lib)) | 101 | (eval-when-compile (require 'cl-lib)) |
| 102 | (require 'erc-common) | 102 | (require 'erc-common) |
| 103 | 103 | ||
| 104 | (defvar erc--called-as-input-p) | ||
| 105 | (defvar erc--display-context) | ||
| 104 | (defvar erc--target) | 106 | (defvar erc--target) |
| 105 | (defvar erc--user-from-nick-function) | 107 | (defvar erc--user-from-nick-function) |
| 106 | (defvar erc-channel-list) | 108 | (defvar erc-channel-list) |
| @@ -304,7 +306,7 @@ function `erc-server-process-alive' instead.") | |||
| 304 | "Timer that resets `erc--server-last-reconnect-count' to zero. | 306 | "Timer that resets `erc--server-last-reconnect-count' to zero. |
| 305 | Becomes non-nil in all server buffers when an IRC connection is | 307 | Becomes non-nil in all server buffers when an IRC connection is |
| 306 | first \"established\" and carries out its duties | 308 | first \"established\" and carries out its duties |
| 307 | `erc-reconnect-display-timeout' seconds later.") | 309 | `erc-auto-reconnect-display-timeout' seconds later.") |
| 308 | 310 | ||
| 309 | (defvar-local erc--server-last-reconnect-count 0 | 311 | (defvar-local erc--server-last-reconnect-count 0 |
| 310 | "Snapshot of reconnect count when the connection was established.") | 312 | "Snapshot of reconnect count when the connection was established.") |
| @@ -957,7 +959,7 @@ EVENT is the message received from the closed connection process." | |||
| 957 | (erc--server-last-reconnect-display-reset (current-buffer))) | 959 | (erc--server-last-reconnect-display-reset (current-buffer))) |
| 958 | 960 | ||
| 959 | (defun erc--server-last-reconnect-display-reset (buffer) | 961 | (defun erc--server-last-reconnect-display-reset (buffer) |
| 960 | "Deactivate `erc-reconnect-display'." | 962 | "Deactivate `erc-auto-reconnect-display'." |
| 961 | (when (buffer-live-p buffer) | 963 | (when (buffer-live-p buffer) |
| 962 | (with-current-buffer buffer | 964 | (with-current-buffer buffer |
| 963 | (when erc--server-reconnect-display-timer | 965 | (when erc--server-reconnect-display-timer |
| @@ -1684,6 +1686,12 @@ add things to `%s' instead." | |||
| 1684 | parsed 'notice 'active | 1686 | parsed 'notice 'active |
| 1685 | 'INVITE ?n nick ?u login ?h host ?c chnl))))) | 1687 | 'INVITE ?n nick ?u login ?h host ?c chnl))))) |
| 1686 | 1688 | ||
| 1689 | (cl-defmethod erc--server-determine-join-display-context (_channel alist) | ||
| 1690 | "Determine `erc--display-context' for JOINs." | ||
| 1691 | (if (assq 'erc-buffer-display alist) | ||
| 1692 | alist | ||
| 1693 | `((erc-buffer-display . JOIN) ,@alist))) | ||
| 1694 | |||
| 1687 | (define-erc-response-handler (JOIN) | 1695 | (define-erc-response-handler (JOIN) |
| 1688 | "Handle join messages." | 1696 | "Handle join messages." |
| 1689 | nil | 1697 | nil |
| @@ -1698,7 +1706,11 @@ add things to `%s' instead." | |||
| 1698 | (let* ((str (cond | 1706 | (let* ((str (cond |
| 1699 | ;; If I have joined a channel | 1707 | ;; If I have joined a channel |
| 1700 | ((erc-current-nick-p nick) | 1708 | ((erc-current-nick-p nick) |
| 1701 | (when (setq buffer (erc--open-target chnl)) | 1709 | (let ((erc--display-context |
| 1710 | (erc--server-determine-join-display-context | ||
| 1711 | chnl erc--display-context))) | ||
| 1712 | (setq buffer (erc--open-target chnl))) | ||
| 1713 | (when buffer | ||
| 1702 | (set-buffer buffer) | 1714 | (set-buffer buffer) |
| 1703 | (with-suppressed-warnings | 1715 | (with-suppressed-warnings |
| 1704 | ((obsolete erc-add-default-channel)) | 1716 | ((obsolete erc-add-default-channel)) |
| @@ -1887,6 +1899,8 @@ add things to `%s' instead." | |||
| 1887 | (noticep (string= cmd "NOTICE")) | 1899 | (noticep (string= cmd "NOTICE")) |
| 1888 | ;; S.B. downcase *both* tgt and current nick | 1900 | ;; S.B. downcase *both* tgt and current nick |
| 1889 | (privp (erc-current-nick-p tgt)) | 1901 | (privp (erc-current-nick-p tgt)) |
| 1902 | (erc--display-context `((erc-buffer-display . ,(intern cmd)) | ||
| 1903 | ,@erc--display-context)) | ||
| 1890 | s buffer | 1904 | s buffer |
| 1891 | fnick) | 1905 | fnick) |
| 1892 | (setf (erc-response.contents parsed) msg) | 1906 | (setf (erc-response.contents parsed) msg) |
| @@ -1901,6 +1915,8 @@ add things to `%s' instead." | |||
| 1901 | (and erc-ensure-target-buffer-on-privmsg | 1915 | (and erc-ensure-target-buffer-on-privmsg |
| 1902 | (or erc-receive-query-display | 1916 | (or erc-receive-query-display |
| 1903 | erc-join-buffer))))) | 1917 | erc-join-buffer))))) |
| 1918 | (push `(erc-receive-query-display . ,(intern cmd)) | ||
| 1919 | erc--display-context) | ||
| 1904 | (setq buffer (erc--open-target nick))) | 1920 | (setq buffer (erc--open-target nick))) |
| 1905 | ;; A channel buffer has been killed but is still joined. | 1921 | ;; A channel buffer has been killed but is still joined. |
| 1906 | (when erc-ensure-target-buffer-on-privmsg | 1922 | (when erc-ensure-target-buffer-on-privmsg |
| @@ -2486,6 +2502,17 @@ See `erc-display-server-message'." nil | |||
| 2486 | parsed | 2502 | parsed |
| 2487 | (erc-response.contents parsed))) | 2503 | (erc-response.contents parsed))) |
| 2488 | 2504 | ||
| 2505 | (define-erc-response-handler (471) | ||
| 2506 | "ERR_CHANNELISFULL: channel full." nil | ||
| 2507 | (erc-display-message parsed '(notice error) nil 's471 | ||
| 2508 | ?c (cadr (erc-response.command-args parsed)) | ||
| 2509 | ?s (erc-response.contents parsed))) | ||
| 2510 | |||
| 2511 | (define-erc-response-handler (473) | ||
| 2512 | "ERR_INVITEONLYCHAN: channel invitation only." nil | ||
| 2513 | (erc-display-message parsed '(notice error) nil 's473 | ||
| 2514 | ?c (cadr (erc-response.command-args parsed)))) | ||
| 2515 | |||
| 2489 | (define-erc-response-handler (474) | 2516 | (define-erc-response-handler (474) |
| 2490 | "Banned from channel errors." nil | 2517 | "Banned from channel errors." nil |
| 2491 | (erc-display-message parsed '(notice error) nil | 2518 | (erc-display-message parsed '(notice error) nil |
| @@ -2499,6 +2526,7 @@ See `erc-display-server-message'." nil | |||
| 2499 | ?c (cadr (erc-response.command-args parsed))) | 2526 | ?c (cadr (erc-response.command-args parsed))) |
| 2500 | (when erc-prompt-for-channel-key | 2527 | (when erc-prompt-for-channel-key |
| 2501 | (let ((channel (cadr (erc-response.command-args parsed))) | 2528 | (let ((channel (cadr (erc-response.command-args parsed))) |
| 2529 | (erc--called-as-input-p t) | ||
| 2502 | (key (read-from-minibuffer | 2530 | (key (read-from-minibuffer |
| 2503 | (format "Channel %s is mode +k. Enter key (RET to cancel): " | 2531 | (format "Channel %s is mode +k. Enter key (RET to cancel): " |
| 2504 | (cadr (erc-response.command-args parsed)))))) | 2532 | (cadr (erc-response.command-args parsed)))))) |
| @@ -2567,7 +2595,7 @@ See `erc-display-error-notice'." nil | |||
| 2567 | ;; 200 201 202 203 204 205 206 208 209 211 212 213 | 2595 | ;; 200 201 202 203 204 205 206 208 209 211 212 213 |
| 2568 | ;; 214 215 216 217 218 219 241 242 243 244 249 261 | 2596 | ;; 214 215 216 217 218 219 241 242 243 244 249 261 |
| 2569 | ;; 262 302 342 351 407 409 411 413 414 415 | 2597 | ;; 262 302 342 351 407 409 411 413 414 415 |
| 2570 | ;; 423 424 436 441 443 444 467 471 472 473 KILL) | 2598 | ;; 423 424 436 441 443 444 467 472 KILL) |
| 2571 | ;; nil nil | 2599 | ;; nil nil |
| 2572 | ;; (ignore proc parsed)) | 2600 | ;; (ignore proc parsed)) |
| 2573 | 2601 | ||
diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el index 45cfd565f89..2a57e77a622 100644 --- a/lisp/erc/erc-join.el +++ b/lisp/erc/erc-join.el | |||
| @@ -44,11 +44,23 @@ | |||
| 44 | ((add-hook 'erc-after-connect #'erc-autojoin-channels) | 44 | ((add-hook 'erc-after-connect #'erc-autojoin-channels) |
| 45 | (add-hook 'erc-nickserv-identified-hook #'erc-autojoin-after-ident) | 45 | (add-hook 'erc-nickserv-identified-hook #'erc-autojoin-after-ident) |
| 46 | (add-hook 'erc-server-JOIN-functions #'erc-autojoin-add) | 46 | (add-hook 'erc-server-JOIN-functions #'erc-autojoin-add) |
| 47 | (add-hook 'erc-server-PART-functions #'erc-autojoin-remove)) | 47 | (add-hook 'erc-server-PART-functions #'erc-autojoin-remove) |
| 48 | (add-hook 'erc-server-405-functions #'erc-join--remove-requested-channel) | ||
| 49 | (add-hook 'erc-server-471-functions #'erc-join--remove-requested-channel) | ||
| 50 | (add-hook 'erc-server-473-functions #'erc-join--remove-requested-channel) | ||
| 51 | (add-hook 'erc-server-474-functions #'erc-join--remove-requested-channel) | ||
| 52 | (add-hook 'erc-server-475-functions #'erc-join--remove-requested-channel)) | ||
| 48 | ((remove-hook 'erc-after-connect #'erc-autojoin-channels) | 53 | ((remove-hook 'erc-after-connect #'erc-autojoin-channels) |
| 49 | (remove-hook 'erc-nickserv-identified-hook #'erc-autojoin-after-ident) | 54 | (remove-hook 'erc-nickserv-identified-hook #'erc-autojoin-after-ident) |
| 50 | (remove-hook 'erc-server-JOIN-functions #'erc-autojoin-add) | 55 | (remove-hook 'erc-server-JOIN-functions #'erc-autojoin-add) |
| 51 | (remove-hook 'erc-server-PART-functions #'erc-autojoin-remove))) | 56 | (remove-hook 'erc-server-PART-functions #'erc-autojoin-remove) |
| 57 | (remove-hook 'erc-server-405-functions #'erc-join--remove-requested-channel) | ||
| 58 | (remove-hook 'erc-server-471-functions #'erc-join--remove-requested-channel) | ||
| 59 | (remove-hook 'erc-server-473-functions #'erc-join--remove-requested-channel) | ||
| 60 | (remove-hook 'erc-server-474-functions #'erc-join--remove-requested-channel) | ||
| 61 | (remove-hook 'erc-server-475-functions #'erc-join--remove-requested-channel) | ||
| 62 | (erc-buffer-do (lambda () | ||
| 63 | (kill-local-variable 'erc-join--requested-channels))))) | ||
| 52 | 64 | ||
| 53 | (defcustom erc-autojoin-channels-alist nil | 65 | (defcustom erc-autojoin-channels-alist nil |
| 54 | "Alist of channels to autojoin on IRC networks. | 66 | "Alist of channels to autojoin on IRC networks. |
| @@ -138,6 +150,28 @@ network or a network ID). Return nil on failure." | |||
| 138 | (string-match-p candidate (or erc-server-announced-name | 150 | (string-match-p candidate (or erc-server-announced-name |
| 139 | erc-session-server))))) | 151 | erc-session-server))))) |
| 140 | 152 | ||
| 153 | (defvar-local erc-join--requested-channels nil | ||
| 154 | "List of channels for which an outgoing JOIN was sent.") | ||
| 155 | |||
| 156 | ;; Assume users will update their `erc-autojoin-channels-alist' when | ||
| 157 | ;; encountering errors, like a 475 ERR_BADCHANNELKEY. | ||
| 158 | (defun erc-join--remove-requested-channel (_ parsed) | ||
| 159 | "Remove channel from `erc-join--requested-channels'." | ||
| 160 | (when-let ((channel (cadr (erc-response.command-args parsed))) | ||
| 161 | ((member channel erc-join--requested-channels))) | ||
| 162 | (setq erc-join--requested-channels | ||
| 163 | (delete channel erc-join--requested-channels))) | ||
| 164 | nil) | ||
| 165 | |||
| 166 | (cl-defmethod erc--server-determine-join-display-context | ||
| 167 | (channel alist &context (erc-autojoin-mode (eql t))) | ||
| 168 | "Add item to `erc-display-context' ALIST if CHANNEL was autojoined." | ||
| 169 | (when (member channel erc-join--requested-channels) | ||
| 170 | (setq erc-join--requested-channels | ||
| 171 | (delete channel erc-join--requested-channels)) | ||
| 172 | (push (cons 'erc-autojoin-mode channel) alist)) | ||
| 173 | (cl-call-next-method channel alist)) | ||
| 174 | |||
| 141 | (defun erc-autojoin--join () | 175 | (defun erc-autojoin--join () |
| 142 | ;; This is called in the server buffer | 176 | ;; This is called in the server buffer |
| 143 | (pcase-dolist (`(,name . ,channels) erc-autojoin-channels-alist) | 177 | (pcase-dolist (`(,name . ,channels) erc-autojoin-channels-alist) |
| @@ -146,6 +180,7 @@ network or a network ID). Return nil on failure." | |||
| 146 | (let ((buf (erc-get-buffer chan erc-server-process))) | 180 | (let ((buf (erc-get-buffer chan erc-server-process))) |
| 147 | (unless (and buf (with-current-buffer buf | 181 | (unless (and buf (with-current-buffer buf |
| 148 | (erc--current-buffer-joined-p))) | 182 | (erc--current-buffer-joined-p))) |
| 183 | (push chan erc-join--requested-channels) | ||
| 149 | (erc-server-join-channel nil chan))))))) | 184 | (erc-server-join-channel nil chan))))))) |
| 150 | 185 | ||
| 151 | (defun erc-autojoin-after-ident (_network _nick) | 186 | (defun erc-autojoin-after-ident (_network _nick) |
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index f2ea69f6bba..d3bec98e14c 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el | |||
| @@ -1553,9 +1553,26 @@ Defaults to the server buffer." | |||
| 1553 | "IRC port to use for encrypted connections if it cannot be \ | 1553 | "IRC port to use for encrypted connections if it cannot be \ |
| 1554 | detected otherwise.") | 1554 | detected otherwise.") |
| 1555 | 1555 | ||
| 1556 | (defconst erc--buffer-display-choices | ||
| 1557 | `(choice (const :tag "Use value of `erc-buffer-display'" nil) | ||
| 1558 | (const :tag "Split window and select" window) | ||
| 1559 | (const :tag "Split window but don't select" window-noselect) | ||
| 1560 | (const :tag "New frame" frame) | ||
| 1561 | (const :tag "Don't display" bury) | ||
| 1562 | (const :tag "Use current window" buffer) | ||
| 1563 | (choice :tag "Defer to a display function" | ||
| 1564 | (function-item display-buffer) | ||
| 1565 | (function-item pop-to-buffer) | ||
| 1566 | (function :tag "User-defined"))) | ||
| 1567 | "Common choices for buffer-display options.") | ||
| 1568 | |||
| 1556 | (defvaralias 'erc-join-buffer 'erc-buffer-display) | 1569 | (defvaralias 'erc-join-buffer 'erc-buffer-display) |
| 1557 | (defcustom erc-buffer-display 'bury | 1570 | (defcustom erc-buffer-display 'bury |
| 1558 | "How to display a newly created ERC buffer. | 1571 | "How to display a newly created ERC buffer. |
| 1572 | This determines ERC's baseline, \"catch-all\" buffer-display | ||
| 1573 | behavior. It takes a backseat to more specific options, like | ||
| 1574 | `erc-interactive-display', `erc-auto-reconnect-display', and | ||
| 1575 | `erc-receive-query-display'. | ||
| 1559 | 1576 | ||
| 1560 | The available choices are: | 1577 | The available choices are: |
| 1561 | 1578 | ||
| @@ -1564,17 +1581,34 @@ The available choices are: | |||
| 1564 | `frame' - in another frame, | 1581 | `frame' - in another frame, |
| 1565 | `bury' - bury it in a new buffer, | 1582 | `bury' - bury it in a new buffer, |
| 1566 | `buffer' - in place of the current buffer, | 1583 | `buffer' - in place of the current buffer, |
| 1567 | 1584 | DISPLAY-FUNCTION - a `display-buffer'-like function | |
| 1568 | See related options `erc-interactive-display', | 1585 | |
| 1569 | `erc-reconnect-display', and `erc-receive-query-display'." | 1586 | Here, DISPLAY-FUNCTION should accept a buffer and an ACTION of |
| 1587 | the kind described by the Info node `(elisp) Choosing Window'. | ||
| 1588 | At times, ERC may add hints about the calling context to the | ||
| 1589 | ACTION's alist. Keys are symbols such as user options, like | ||
| 1590 | `erc-buffer-display', or module minor modes, like | ||
| 1591 | `erc-autojoin-mode'. Values are non-nil constants specific to | ||
| 1592 | each. For this particular option, possible values include the | ||
| 1593 | symbols | ||
| 1594 | |||
| 1595 | `JOIN', `PRIVMSG', `NOTICE', `erc', and `erc-tls'. | ||
| 1596 | |||
| 1597 | The first three signify IRC commands received from the server and | ||
| 1598 | the rest entry-point commands responsible for the connection. | ||
| 1599 | When dealing with the latter two, users may prefer to set this | ||
| 1600 | option to `bury' and instead call DISPLAY-FUNCTION directly | ||
| 1601 | on (server) buffers returned by these entry points because the | ||
| 1602 | context leading to their creation is plainly obvious. For | ||
| 1603 | additional details, see the Info node `(erc) display-buffer'. | ||
| 1604 | |||
| 1605 | Note that when the selected window already shows the current | ||
| 1606 | buffer, ERC pretends this option's value is `bury' unless the | ||
| 1607 | variable `erc-skip-displaying-selected-window-buffer' is nil or | ||
| 1608 | the value of this option is DISPLAY-FUNCTION." | ||
| 1570 | :package-version '(ERC . "5.5") | 1609 | :package-version '(ERC . "5.5") |
| 1571 | :group 'erc-buffers | 1610 | :group 'erc-buffers |
| 1572 | :type '(choice (const :tag "Split window and select" window) | 1611 | :type (cons 'choice (nthcdr 2 erc--buffer-display-choices))) |
| 1573 | (const :tag "Split window, don't select" window-noselect) | ||
| 1574 | (const :tag "New frame" frame) | ||
| 1575 | (const :tag "Bury in new buffer" bury) | ||
| 1576 | (const :tag "Use current buffer" buffer) | ||
| 1577 | (const :tag "Use current buffer" t))) | ||
| 1578 | 1612 | ||
| 1579 | (defvaralias 'erc-query-display 'erc-interactive-display) | 1613 | (defvaralias 'erc-query-display 'erc-interactive-display) |
| 1580 | (defcustom erc-interactive-display 'window | 1614 | (defcustom erc-interactive-display 'window |
| @@ -1583,38 +1617,58 @@ This affects commands like /QUERY and /JOIN when issued | |||
| 1583 | interactively at the prompt. It does not apply when calling a | 1617 | interactively at the prompt. It does not apply when calling a |
| 1584 | handler for such a command, like `erc-cmd-JOIN', from lisp code. | 1618 | handler for such a command, like `erc-cmd-JOIN', from lisp code. |
| 1585 | See `erc-buffer-display' for a full description of available | 1619 | See `erc-buffer-display' for a full description of available |
| 1586 | values." | 1620 | values. |
| 1621 | |||
| 1622 | When the value is a user-provided function, ERC may inject a hint | ||
| 1623 | about the invocation context as an extra item in the \"action | ||
| 1624 | alist\" included as part of the second argument. The item's key | ||
| 1625 | is the symbol `erc-interactive-display' and its value one of | ||
| 1626 | |||
| 1627 | `/QUERY', `/JOIN', `/RECONNECT', `url', `erc', or `erc-tls'. | ||
| 1628 | |||
| 1629 | All are symbols indicating an inciting user action, such as the | ||
| 1630 | issuance of a slash command, the clicking of a URL hyperlink, or | ||
| 1631 | the invocation of an entry-point command. See Info node `(erc) | ||
| 1632 | display-buffer' for more." | ||
| 1587 | :package-version '(ERC . "5.6") ; FIXME sync on release | 1633 | :package-version '(ERC . "5.6") ; FIXME sync on release |
| 1588 | :group 'erc-buffers | 1634 | :group 'erc-buffers |
| 1589 | :type '(choice (const :tag "Use value of `erc-buffer-display'" nil) | 1635 | :type erc--buffer-display-choices) |
| 1590 | (const :tag "Split window and select" window) | 1636 | |
| 1591 | (const :tag "Split window, don't select" window-noselect) | 1637 | (defvaralias 'erc-reconnect-display 'erc-auto-reconnect-display) |
| 1592 | (const :tag "New frame" frame) | 1638 | (defcustom erc-auto-reconnect-display nil |
| 1593 | (const :tag "Bury new and don't display existing" bury) | 1639 | "How to display a channel buffer when automatically reconnecting. |
| 1594 | (const :tag "Use current buffer" buffer))) | 1640 | ERC ignores this option when a user issues a /RECONNECT or |
| 1595 | 1641 | successfully reinvokes `erc-tls' with similar arguments to those | |
| 1596 | (defcustom erc-reconnect-display nil | 1642 | from the prior connection. See `erc-buffer-display' for a |
| 1597 | "How and whether to display a channel buffer when auto-reconnecting. | 1643 | description of possible values. |
| 1598 | This only affects automatic reconnections and is ignored, like | 1644 | |
| 1599 | all other buffer-display options, when issuing a /RECONNECT or | 1645 | When the value is function, ERC may inject a hint about the |
| 1600 | successfully reinvoking `erc-tls' with similar arguments. See | 1646 | calling context as an extra item in the alist making up the tail |
| 1601 | `erc-buffer-display' for a description of possible values." | 1647 | of the second, \"action\" argument. The item's key is the symbol |
| 1648 | `erc-auto-reconnect-display' and its value something non-nil." | ||
| 1602 | :package-version '(ERC . "5.5") | 1649 | :package-version '(ERC . "5.5") |
| 1603 | :group 'erc-buffers | 1650 | :group 'erc-buffers |
| 1604 | :type '(choice (const :tag "Use value of `erc-buffer-display'" nil) | 1651 | :type erc--buffer-display-choices) |
| 1605 | (const :tag "Split window and select" window) | 1652 | |
| 1606 | (const :tag "Split window, don't select" window-noselect) | 1653 | (defcustom erc-auto-reconnect-display-timeout 10 |
| 1607 | (const :tag "New frame" frame) | 1654 | "Duration `erc-auto-reconnect-display' remains active. |
| 1608 | (const :tag "Bury in new buffer" bury) | ||
| 1609 | (const :tag "Use current buffer" buffer))) | ||
| 1610 | |||
| 1611 | (defcustom erc-reconnect-display-timeout 10 | ||
| 1612 | "Duration `erc-reconnect-display' remains active. | ||
| 1613 | The countdown starts on MOTD and is canceled early by any | 1655 | The countdown starts on MOTD and is canceled early by any |
| 1614 | \"slash\" command." | 1656 | \"slash\" command." |
| 1657 | :package-version '(ERC . "5.6") ; FIXME sync on release | ||
| 1615 | :type 'integer | 1658 | :type 'integer |
| 1616 | :group 'erc-buffers) | 1659 | :group 'erc-buffers) |
| 1617 | 1660 | ||
| 1661 | (defcustom erc-reconnect-display-server-buffers nil | ||
| 1662 | "Apply buffer-display options to server buffers when reconnecting. | ||
| 1663 | By default, ERC does not consider `erc-auto-reconnect-display' | ||
| 1664 | for server buffers when automatically reconnecting, nor does it | ||
| 1665 | consider `erc-interactive-display' when users issue a /RECONNECT. | ||
| 1666 | Enabling this tells ERC to always display server buffers | ||
| 1667 | according to those options." | ||
| 1668 | :package-version '(ERC . "5.6") ; FIXME sync on release | ||
| 1669 | :type 'boolean | ||
| 1670 | :group 'erc-buffers) | ||
| 1671 | |||
| 1618 | (defcustom erc-frame-alist nil | 1672 | (defcustom erc-frame-alist nil |
| 1619 | "Alist of frame parameters for creating erc frames. | 1673 | "Alist of frame parameters for creating erc frames. |
| 1620 | A value of nil means to use `default-frame-alist'." | 1674 | A value of nil means to use `default-frame-alist'." |
| @@ -1824,9 +1878,8 @@ server connection, or nil which means all open connections." | |||
| 1824 | 1878 | ||
| 1825 | (defalias 'erc-buffer-do 'erc-buffer-filter | 1879 | (defalias 'erc-buffer-do 'erc-buffer-filter |
| 1826 | "Call FUNCTION in all ERC buffers or only those for PROC. | 1880 | "Call FUNCTION in all ERC buffers or only those for PROC. |
| 1827 | Expect users to prefer this alias to `erc-buffer-filter' in cases | 1881 | Expect to be preferred over `erc-buffer-filter' in cases where |
| 1828 | where the latter would only be called for effect and its return | 1882 | the return value goes unused. |
| 1829 | value thrown away. | ||
| 1830 | 1883 | ||
| 1831 | \(fn FUNCTION &optional PROC)") | 1884 | \(fn FUNCTION &optional PROC)") |
| 1832 | 1885 | ||
| @@ -2094,12 +2147,43 @@ anything about the dependency's implementation.") | |||
| 2094 | (defvar erc--setup-buffer-hook nil | 2147 | (defvar erc--setup-buffer-hook nil |
| 2095 | "Internal hook for module setup involving windows and frames.") | 2148 | "Internal hook for module setup involving windows and frames.") |
| 2096 | 2149 | ||
| 2150 | (defvar erc--display-context nil | ||
| 2151 | "Extra action alist items passed to `display-buffer'. | ||
| 2152 | Non-nil when a user specifies a custom display action for certain | ||
| 2153 | buffer-display options, like `erc-auto-reconnect-display'. ERC | ||
| 2154 | pairs the option's symbol with a context-dependent value and adds | ||
| 2155 | the entry to the user-provided alist when calling `pop-to-buffer' | ||
| 2156 | or `display-buffer'.") | ||
| 2157 | |||
| 2158 | (defvar erc-skip-displaying-selected-window-buffer t | ||
| 2159 | "Whether to forgo showing a buffer that's already being displayed. | ||
| 2160 | But only in the selected window. This is intended as a crutch | ||
| 2161 | for non-user third-party code that might be slow to adopt the | ||
| 2162 | `display-buffer' function variant available to all buffer-display | ||
| 2163 | options starting in ERC 5.6. Users with rare requirements, like | ||
| 2164 | wanting to change the window buffer to something other than the | ||
| 2165 | one being processed, should see the Info node `(erc) | ||
| 2166 | display-buffer'.") | ||
| 2167 | (make-obsolete 'erc-show-already-displayed-buffer | ||
| 2168 | "non-nil behavior to be made permanent" "30.1") | ||
| 2169 | |||
| 2170 | (defvar-local erc--display-buffer-overriding-action nil | ||
| 2171 | "The value of `display-buffer-overriding-action' when non-nil. | ||
| 2172 | Influences the displaying of new or reassociated ERC buffers. | ||
| 2173 | Reserved for use by built-in modules.") | ||
| 2174 | |||
| 2097 | (defun erc-setup-buffer (buffer) | 2175 | (defun erc-setup-buffer (buffer) |
| 2098 | "Consults `erc-join-buffer' to find out how to display `BUFFER'." | 2176 | "Consults `erc-join-buffer' to find out how to display `BUFFER'." |
| 2099 | (pcase (if (zerop (erc-with-server-buffer | 2177 | (pcase (if (zerop (erc-with-server-buffer |
| 2100 | erc--server-last-reconnect-count)) | 2178 | erc--server-last-reconnect-count)) |
| 2101 | erc-join-buffer | 2179 | erc-join-buffer |
| 2102 | (or erc-reconnect-display erc-join-buffer)) | 2180 | (or erc-auto-reconnect-display erc-join-buffer)) |
| 2181 | ((and (pred functionp) disp-fn (let context erc--display-context)) | ||
| 2182 | (unless (zerop erc--server-last-reconnect-count) | ||
| 2183 | (push '(erc-auto-reconnect-display . t) context)) | ||
| 2184 | (funcall disp-fn buffer (cons nil context))) | ||
| 2185 | ((guard (and erc-skip-displaying-selected-window-buffer | ||
| 2186 | (eq (window-buffer) buffer)))) | ||
| 2103 | ('window | 2187 | ('window |
| 2104 | (if (active-minibuffer-window) | 2188 | (if (active-minibuffer-window) |
| 2105 | (display-buffer buffer) | 2189 | (display-buffer buffer) |
| @@ -2292,13 +2376,18 @@ Returns the buffer for the given server or channel." | |||
| 2292 | (erc-update-mode-line)) | 2376 | (erc-update-mode-line)) |
| 2293 | 2377 | ||
| 2294 | ;; Now display the buffer in a window as per user wishes. | 2378 | ;; Now display the buffer in a window as per user wishes. |
| 2295 | (unless (eq buffer old-buffer) | 2379 | (when (eq buffer old-buffer) (cl-assert (and connect (not target)))) |
| 2380 | (unless (and (not erc-reconnect-display-server-buffers) | ||
| 2381 | (eq buffer old-buffer)) | ||
| 2296 | (when erc-log-p | 2382 | (when erc-log-p |
| 2297 | ;; we can't log to debug buffer, it may not exist yet | 2383 | ;; we can't log to debug buffer, it may not exist yet |
| 2298 | (message "erc: old buffer %s, switching to %s" | 2384 | (message "erc: old buffer %s, switching to %s" |
| 2299 | old-buffer buffer)) | 2385 | old-buffer buffer)) |
| 2300 | (erc-setup-buffer buffer) | 2386 | (let ((display-buffer-overriding-action |
| 2301 | (run-hooks 'erc--setup-buffer-hook)) | 2387 | (or erc--display-buffer-overriding-action |
| 2388 | display-buffer-overriding-action))) | ||
| 2389 | (erc-setup-buffer buffer) | ||
| 2390 | (run-hooks 'erc--setup-buffer-hook))) | ||
| 2302 | 2391 | ||
| 2303 | buffer)) | 2392 | buffer)) |
| 2304 | 2393 | ||
| @@ -2410,6 +2499,8 @@ With prefix arg, also prompt for user and full name." | |||
| 2410 | env) | 2499 | env) |
| 2411 | (when erc-interactive-display | 2500 | (when erc-interactive-display |
| 2412 | (push `(erc-join-buffer . ,erc-interactive-display) env)) | 2501 | (push `(erc-join-buffer . ,erc-interactive-display) env)) |
| 2502 | (when erc--display-context | ||
| 2503 | (push `(erc--display-context . ,erc--display-context) env)) | ||
| 2413 | (when opener | 2504 | (when opener |
| 2414 | (push `(erc-server-connect-function . ,opener) env)) | 2505 | (push `(erc-server-connect-function . ,opener) env)) |
| 2415 | (when (and passwd (string= "" passwd)) | 2506 | (when (and passwd (string= "" passwd)) |
| @@ -2471,7 +2562,12 @@ for the values of the other parameters. | |||
| 2471 | See `erc-tls' for the meaning of ID. | 2562 | See `erc-tls' for the meaning of ID. |
| 2472 | 2563 | ||
| 2473 | \(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME ID)" | 2564 | \(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME ID)" |
| 2474 | (interactive (erc-select-read-args)) | 2565 | (interactive (let ((erc--display-context `((erc-interactive-display . erc) |
| 2566 | ,@erc--display-context))) | ||
| 2567 | (erc-select-read-args))) | ||
| 2568 | (unless (assq 'erc--display-context --interactive-env--) | ||
| 2569 | (push '(erc--display-context . ((erc-buffer-display . erc))) | ||
| 2570 | --interactive-env--)) | ||
| 2475 | (erc--with-entrypoint-environment --interactive-env-- | 2571 | (erc--with-entrypoint-environment --interactive-env-- |
| 2476 | (erc-open server port nick full-name t password nil nil nil nil user id))) | 2572 | (erc-open server port nick full-name t password nil nil nil nil user id))) |
| 2477 | 2573 | ||
| @@ -2536,8 +2632,11 @@ CLIENT-CERTIFICATE, this parameter cannot be specified | |||
| 2536 | interactively. | 2632 | interactively. |
| 2537 | 2633 | ||
| 2538 | \(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME CLIENT-CERTIFICATE ID)" | 2634 | \(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME CLIENT-CERTIFICATE ID)" |
| 2539 | (interactive (let ((erc-default-port erc-default-port-tls)) | 2635 | (interactive |
| 2540 | (erc-select-read-args))) | 2636 | (let ((erc-default-port erc-default-port-tls) |
| 2637 | (erc--display-context `((erc-interactive-display . erc-tls) | ||
| 2638 | ,@erc--display-context))) | ||
| 2639 | (erc-select-read-args))) | ||
| 2541 | ;; Bind `erc-server-connect-function' to `erc-open-tls-stream' | 2640 | ;; Bind `erc-server-connect-function' to `erc-open-tls-stream' |
| 2542 | ;; around `erc-open' when a non-default value hasn't been specified | 2641 | ;; around `erc-open' when a non-default value hasn't been specified |
| 2543 | ;; by the user or the interactive form. And don't bother checking | 2642 | ;; by the user or the interactive form. And don't bother checking |
| @@ -2546,6 +2645,9 @@ interactively. | |||
| 2546 | (not (eq erc-server-connect-function #'erc-open-network-stream))) | 2645 | (not (eq erc-server-connect-function #'erc-open-network-stream))) |
| 2547 | (push '(erc-server-connect-function . erc-open-tls-stream) | 2646 | (push '(erc-server-connect-function . erc-open-tls-stream) |
| 2548 | --interactive-env--)) | 2647 | --interactive-env--)) |
| 2648 | (unless (assq 'erc--display-context --interactive-env--) | ||
| 2649 | (push '(erc--display-context . ((erc-buffer-display . erc-tls))) | ||
| 2650 | --interactive-env--)) | ||
| 2549 | (erc--with-entrypoint-environment --interactive-env-- | 2651 | (erc--with-entrypoint-environment --interactive-env-- |
| 2550 | (erc-open server port nick full-name t password | 2652 | (erc-open server port nick full-name t password |
| 2551 | nil nil nil client-certificate user id))) | 2653 | nil nil nil client-certificate user id))) |
| @@ -3769,7 +3871,10 @@ were most recently invited. See also `invitation'." | |||
| 3769 | (sn (erc-extract-nick (erc-response.sender parsed))) | 3871 | (sn (erc-extract-nick (erc-response.sender parsed))) |
| 3770 | ((erc-nick-equal-p sn (erc-current-nick))) | 3872 | ((erc-nick-equal-p sn (erc-current-nick))) |
| 3771 | (erc-join-buffer (or erc-interactive-display | 3873 | (erc-join-buffer (or erc-interactive-display |
| 3772 | erc-join-buffer))) | 3874 | erc-join-buffer)) |
| 3875 | (erc--display-context `((erc-interactive-display | ||
| 3876 | . /JOIN) | ||
| 3877 | ,@erc--display-context))) | ||
| 3773 | (run-hook-with-args-until-success | 3878 | (run-hook-with-args-until-success |
| 3774 | 'erc-server-JOIN-functions proc parsed) | 3879 | 'erc-server-JOIN-functions proc parsed) |
| 3775 | t)))) | 3880 | t)))) |
| @@ -4153,7 +4258,9 @@ on the value of `erc-interactive-display'." | |||
| 4153 | ;; currently broken, evil hack to display help anyway | 4258 | ;; currently broken, evil hack to display help anyway |
| 4154 | ;(erc-delete-query)))) | 4259 | ;(erc-delete-query)))) |
| 4155 | (signal 'wrong-number-of-arguments '(erc-cmd-QUERY 0))) | 4260 | (signal 'wrong-number-of-arguments '(erc-cmd-QUERY 0))) |
| 4156 | (let ((erc-join-buffer erc-interactive-display)) | 4261 | (let ((erc-join-buffer erc-interactive-display) |
| 4262 | (erc--display-context `((erc-interactive-display . /QUERY) | ||
| 4263 | ,@erc--display-context))) | ||
| 4157 | (erc-with-server-buffer | 4264 | (erc-with-server-buffer |
| 4158 | (erc--open-target user)))) | 4265 | (erc--open-target user)))) |
| 4159 | 4266 | ||
| @@ -4273,6 +4380,9 @@ the message given by REASON." | |||
| 4273 | 4380 | ||
| 4274 | (defun erc--cmd-reconnect () | 4381 | (defun erc--cmd-reconnect () |
| 4275 | (let ((buffer (erc-server-buffer)) | 4382 | (let ((buffer (erc-server-buffer)) |
| 4383 | (erc-join-buffer erc-interactive-display) | ||
| 4384 | (erc--display-context `((erc-interactive-display . /RECONNECT) | ||
| 4385 | ,@erc--display-context)) | ||
| 4276 | (process nil)) | 4386 | (process nil)) |
| 4277 | (unless (buffer-live-p buffer) | 4387 | (unless (buffer-live-p buffer) |
| 4278 | (setq buffer (current-buffer))) | 4388 | (setq buffer (current-buffer))) |
| @@ -4937,13 +5047,7 @@ compatibility flag `erc-receive-query-display-defer' to nil. Use | |||
| 4937 | :package-version '(ERC . "5.6") | 5047 | :package-version '(ERC . "5.6") |
| 4938 | :group 'erc-buffers | 5048 | :group 'erc-buffers |
| 4939 | :group 'erc-query | 5049 | :group 'erc-query |
| 4940 | :type '(choice (const :tag "Defer to value of `erc-buffer-display'" nil) | 5050 | :type erc--buffer-display-choices) |
| 4941 | (const :tag "Split window and select" window) | ||
| 4942 | (const :tag "Split window, don't select" window-noselect) | ||
| 4943 | (const :tag "New frame" frame) | ||
| 4944 | (const :tag "Bury in new buffer" bury) | ||
| 4945 | (const :tag "Use current buffer" buffer) | ||
| 4946 | (const :tag "Use current buffer" t))) | ||
| 4947 | 5051 | ||
| 4948 | (defvar erc-receive-query-display-defer t | 5052 | (defvar erc-receive-query-display-defer t |
| 4949 | "How to interpret a null `erc-receive-query-display'. | 5053 | "How to interpret a null `erc-receive-query-display'. |
| @@ -5389,7 +5493,7 @@ Set user modes and run `erc-after-connect' hook." | |||
| 5389 | (setq erc--server-last-reconnect-count erc-server-reconnect-count | 5493 | (setq erc--server-last-reconnect-count erc-server-reconnect-count |
| 5390 | erc-server-reconnect-count 0) | 5494 | erc-server-reconnect-count 0) |
| 5391 | (setq erc--server-reconnect-display-timer | 5495 | (setq erc--server-reconnect-display-timer |
| 5392 | (run-at-time erc-reconnect-display-timeout nil | 5496 | (run-at-time erc-auto-reconnect-display-timeout nil |
| 5393 | #'erc--server-last-reconnect-display-reset | 5497 | #'erc--server-last-reconnect-display-reset |
| 5394 | (current-buffer))) | 5498 | (current-buffer))) |
| 5395 | (add-hook 'erc-disconnected-hook | 5499 | (add-hook 'erc-disconnected-hook |
| @@ -7769,6 +7873,8 @@ All windows are opened in the current frame." | |||
| 7769 | (s463 . "Your host isn't among the privileged") | 7873 | (s463 . "Your host isn't among the privileged") |
| 7770 | (s464 . "Password incorrect") | 7874 | (s464 . "Password incorrect") |
| 7771 | (s465 . "You are banned from this server") | 7875 | (s465 . "You are banned from this server") |
| 7876 | (s471 . "Max occupancy for channel %c exceeded: %s") | ||
| 7877 | (s473 . "Channel %c is invitation only") | ||
| 7772 | (s474 . "You can't join %c because you're banned (+b)") | 7878 | (s474 . "You can't join %c because you're banned (+b)") |
| 7773 | (s475 . "You must specify the correct channel key (+k) to join %c") | 7879 | (s475 . "You must specify the correct channel key (+k) to join %c") |
| 7774 | (s481 . "Permission Denied - You're not an IRC operator") | 7880 | (s481 . "Permission Denied - You're not an IRC operator") |
| @@ -7970,6 +8076,8 @@ Beginning with ERC 5.5, new connections require human intervention. | |||
| 7970 | Customize `erc-url-connect-function' to override this." | 8076 | Customize `erc-url-connect-function' to override this." |
| 7971 | (when (eql port 0) (setq port nil)) | 8077 | (when (eql port 0) (setq port nil)) |
| 7972 | (let* ((net (erc-networks--determine host)) | 8078 | (let* ((net (erc-networks--determine host)) |
| 8079 | (erc--display-context `((erc-interactive-display . url) | ||
| 8080 | ,@erc--display-context)) | ||
| 7973 | (server-buffer | 8081 | (server-buffer |
| 7974 | ;; Viable matches may slip through the cracks for unknown | 8082 | ;; Viable matches may slip through the cracks for unknown |
| 7975 | ;; networks. Additional passes could likely improve things. | 8083 | ;; 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 @@ | |||
| 26 | 26 | ||
| 27 | (eval-when-compile (require 'erc-join)) | 27 | (eval-when-compile (require 'erc-join)) |
| 28 | 28 | ||
| 29 | ;; These first couple `erc-reconnect-display' tests used to live in | 29 | ;; These first couple `erc-auto-reconnect-display' tests used to live |
| 30 | ;; erc-scenarios-base-reconnect but have since been renamed. | 30 | ;; in erc-scenarios-base-reconnect but have since been renamed. |
| 31 | 31 | ||
| 32 | (defun erc-scenarios-base-buffer-display--reconnect-common | 32 | (defun erc-scenarios-base-buffer-display--reconnect-common |
| 33 | (assert-server assert-chan assert-rest) | 33 | (assert-server assert-chan assert-rest) |
| @@ -80,11 +80,11 @@ | |||
| 80 | :tags '(:expensive-test) | 80 | :tags '(:expensive-test) |
| 81 | (should (eq erc-buffer-display 'bury)) | 81 | (should (eq erc-buffer-display 'bury)) |
| 82 | (should (eq erc-interactive-display 'window)) | 82 | (should (eq erc-interactive-display 'window)) |
| 83 | (should-not erc-reconnect-display) | 83 | (should-not erc-auto-reconnect-display) |
| 84 | 84 | ||
| 85 | (let ((erc-buffer-display 'window) | 85 | (let ((erc-buffer-display 'window) |
| 86 | (erc-interactive-display 'buffer) | 86 | (erc-interactive-display 'buffer) |
| 87 | (erc-reconnect-display 'bury)) | 87 | (erc-auto-reconnect-display 'bury)) |
| 88 | 88 | ||
| 89 | (erc-scenarios-base-buffer-display--reconnect-common | 89 | (erc-scenarios-base-buffer-display--reconnect-common |
| 90 | 90 | ||
| @@ -104,7 +104,7 @@ | |||
| 104 | ;; A manual /JOIN command tells ERC we're done auto-reconnecting | 104 | ;; A manual /JOIN command tells ERC we're done auto-reconnecting |
| 105 | (with-current-buffer "FooNet" (erc-scenarios-common-say "/JOIN #spam")) | 105 | (with-current-buffer "FooNet" (erc-scenarios-common-say "/JOIN #spam")) |
| 106 | 106 | ||
| 107 | (ert-info ("#spam ignores `erc-reconnect-display'") | 107 | (ert-info ("#spam ignores `erc-auto-reconnect-display'") |
| 108 | ;; Uses `erc-interactive-display' instead. | 108 | ;; Uses `erc-interactive-display' instead. |
| 109 | (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) | 109 | (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) |
| 110 | (should (eq (window-buffer) (get-buffer "#spam"))) | 110 | (should (eq (window-buffer) (get-buffer "#spam"))) |
| @@ -115,10 +115,10 @@ | |||
| 115 | :tags '(:expensive-test) | 115 | :tags '(:expensive-test) |
| 116 | (should (eq erc-buffer-display 'bury)) | 116 | (should (eq erc-buffer-display 'bury)) |
| 117 | (should (eq erc-interactive-display 'window)) | 117 | (should (eq erc-interactive-display 'window)) |
| 118 | (should-not erc-reconnect-display) | 118 | (should-not erc-auto-reconnect-display) |
| 119 | 119 | ||
| 120 | (let ((erc-buffer-display 'window-noselect) | 120 | (let ((erc-buffer-display 'window-noselect) |
| 121 | (erc-reconnect-display 'bury) | 121 | (erc-auto-reconnect-display 'bury) |
| 122 | (erc-interactive-display 'buffer)) | 122 | (erc-interactive-display 'buffer)) |
| 123 | (erc-scenarios-base-buffer-display--reconnect-common | 123 | (erc-scenarios-base-buffer-display--reconnect-common |
| 124 | 124 | ||
| @@ -155,7 +155,7 @@ | |||
| 155 | (should (eq (window-buffer) (get-buffer "bob"))) | 155 | (should (eq (window-buffer) (get-buffer "bob"))) |
| 156 | (should (frame-root-window-p (selected-window))))) | 156 | (should (frame-root-window-p (selected-window))))) |
| 157 | 157 | ||
| 158 | (ert-info ("Newly joined chan ignores `erc-reconnect-display'") | 158 | (ert-info ("Newly joined chan ignores `erc-auto-reconnect-display'") |
| 159 | (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) | 159 | (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) |
| 160 | (should (eq (window-buffer) (get-buffer "bob"))) | 160 | (should (eq (window-buffer) (get-buffer "bob"))) |
| 161 | (should-not (frame-root-window-p (selected-window))) | 161 | (should-not (frame-root-window-p (selected-window))) |
| @@ -165,13 +165,13 @@ | |||
| 165 | :tags '(:expensive-test) | 165 | :tags '(:expensive-test) |
| 166 | (should (eq erc-buffer-display 'bury)) | 166 | (should (eq erc-buffer-display 'bury)) |
| 167 | (should (eq erc-interactive-display 'window)) | 167 | (should (eq erc-interactive-display 'window)) |
| 168 | (should (eq erc-reconnect-display-timeout 10)) | 168 | (should (eq erc-auto-reconnect-display-timeout 10)) |
| 169 | (should-not erc-reconnect-display) | 169 | (should-not erc-auto-reconnect-display) |
| 170 | 170 | ||
| 171 | (let ((erc-buffer-display 'window-noselect) | 171 | (let ((erc-buffer-display 'window-noselect) |
| 172 | (erc-reconnect-display 'bury) | 172 | (erc-auto-reconnect-display 'bury) |
| 173 | (erc-interactive-display 'buffer) | 173 | (erc-interactive-display 'buffer) |
| 174 | (erc-reconnect-display-timeout 0.5)) | 174 | (erc-auto-reconnect-display-timeout 0.5)) |
| 175 | (erc-scenarios-base-buffer-display--reconnect-common | 175 | (erc-scenarios-base-buffer-display--reconnect-common |
| 176 | #'ignore #'ignore ; These two are identical to the previous test. | 176 | #'ignore #'ignore ; These two are identical to the previous test. |
| 177 | 177 | ||
| @@ -188,10 +188,10 @@ | |||
| 188 | (erc-d-t-wait-for 1 (null erc--server-reconnect-display-timer)) | 188 | (erc-d-t-wait-for 1 (null erc--server-reconnect-display-timer)) |
| 189 | (erc-cmd-JOIN "#spam"))) | 189 | (erc-cmd-JOIN "#spam"))) |
| 190 | 190 | ||
| 191 | (ert-info ("Newly joined chan ignores `erc-reconnect-display'") | 191 | (ert-info ("Newly joined chan ignores `erc-auto-reconnect-display'") |
| 192 | (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) | 192 | (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) |
| 193 | (should (eq (window-buffer) (messages-buffer))) | 193 | (should (eq (window-buffer) (messages-buffer))) |
| 194 | ;; If `erc-reconnect-display-timeout' were left alone, this | 194 | ;; If `erc-auto-reconnect-display-timeout' were left alone, this |
| 195 | ;; would be (frame-root-window-p #<window 1 on *scratch*>). | 195 | ;; would be (frame-root-window-p #<window 1 on *scratch*>). |
| 196 | (should-not (frame-root-window-p (selected-window))) | 196 | (should-not (frame-root-window-p (selected-window))) |
| 197 | (should (eq (current-buffer) (window-buffer (next-window)))))))))) | 197 | (should (eq (current-buffer) (window-buffer (next-window)))))))))) |
diff --git a/test/lisp/erc/erc-scenarios-join-display-context.el b/test/lisp/erc/erc-scenarios-join-display-context.el new file mode 100644 index 00000000000..32b782d2af1 --- /dev/null +++ b/test/lisp/erc/erc-scenarios-join-display-context.el | |||
| @@ -0,0 +1,66 @@ | |||
| 1 | ;;; erc-scenarios-join-display-context.el --- buffer-display autojoin ctx -*- lexical-binding: t -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2023 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; This file is part of GNU Emacs. | ||
| 6 | |||
| 7 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 8 | ;; it under the terms of the GNU General Public License as published by | ||
| 9 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 10 | ;; (at your option) any later version. | ||
| 11 | |||
| 12 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 15 | ;; GNU General Public License for more details. | ||
| 16 | |||
| 17 | ;; You should have received a copy of the GNU General Public License | ||
| 18 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | ||
| 19 | |||
| 20 | ;;; Commentary: | ||
| 21 | |||
| 22 | ;;; Code: | ||
| 23 | |||
| 24 | (require 'ert-x) | ||
| 25 | (eval-and-compile | ||
| 26 | (let ((load-path (cons (ert-resource-directory) load-path))) | ||
| 27 | (require 'erc-scenarios-common))) | ||
| 28 | |||
| 29 | (ert-deftest erc-scenarios-join-display-context--errors () | ||
| 30 | :tags '(:expensive-test) | ||
| 31 | (erc-scenarios-common-with-cleanup | ||
| 32 | ((erc-scenarios-common-dialog "join/buffer-display") | ||
| 33 | (erc-server-flood-penalty 0.1) | ||
| 34 | (dumb-server (erc-d-run "localhost" t 'mode-context)) | ||
| 35 | (port (process-contact dumb-server :service)) | ||
| 36 | (erc-buffer-display (lambda (buf action) | ||
| 37 | (when (equal | ||
| 38 | (alist-get 'erc-autojoin-mode action) | ||
| 39 | "#chan") | ||
| 40 | (pop-to-buffer buf)))) | ||
| 41 | (erc-autojoin-channels-alist '((foonet "#chan" "#spam" "#foo"))) | ||
| 42 | (expect (erc-d-t-make-expecter))) | ||
| 43 | |||
| 44 | (ert-info ("Connect without password") | ||
| 45 | (with-current-buffer (erc :server "127.0.0.1" | ||
| 46 | :port port | ||
| 47 | :nick "tester" | ||
| 48 | :full-name "tester") | ||
| 49 | (should (string= (buffer-name) (format "127.0.0.1:%d" port))) | ||
| 50 | ;; FIXME test for effect rather than inspecting interval variables. | ||
| 51 | (erc-d-t-wait-for 10 (equal erc-join--requested-channels | ||
| 52 | '("#foo" "#spam" "#chan"))) | ||
| 53 | (funcall expect 10 "Max occupancy for channel #spam exceeded") | ||
| 54 | (funcall expect 10 "Channel #foo is invitation only"))) | ||
| 55 | |||
| 56 | (ert-info ("New #chan buffer displayed in new window") | ||
| 57 | (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) | ||
| 58 | (should (eq (window-buffer) (current-buffer))) | ||
| 59 | (funcall expect 10 "#chan was created on"))) | ||
| 60 | |||
| 61 | ;; FIXME find a less dishonest way to do this than inspecting | ||
| 62 | ;; interval variables. | ||
| 63 | (ert-info ("Ensure channels no longer tracked") | ||
| 64 | (should-not erc-join--requested-channels)))) | ||
| 65 | |||
| 66 | ;;; erc-scenarios-join-display-context.el ends here | ||
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index fed25056b42..0e4ea1b1db6 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el | |||
| @@ -427,8 +427,9 @@ | |||
| 427 | (should (looking-at-p (regexp-quote "*** Welcome")))) | 427 | (should (looking-at-p (regexp-quote "*** Welcome")))) |
| 428 | 428 | ||
| 429 | (ert-info ("Reconnect") | 429 | (ert-info ("Reconnect") |
| 430 | (erc-open "localhost" 6667 "tester" "Tester" nil | 430 | (with-current-buffer (erc-server-buffer) |
| 431 | "fake" nil "#chan" proc nil "user" nil) | 431 | (erc-open "localhost" 6667 "tester" "Tester" nil |
| 432 | "fake" nil "#chan" proc nil "user" nil)) | ||
| 432 | (should-not (get-buffer "#chan<2>"))) | 433 | (should-not (get-buffer "#chan<2>"))) |
| 433 | 434 | ||
| 434 | (ert-info ("Existing prompt respected") | 435 | (ert-info ("Existing prompt respected") |
| @@ -512,6 +513,50 @@ | |||
| 512 | (dolist (b '("server" "other" "#chan" "#foo" "#fake")) | 513 | (dolist (b '("server" "other" "#chan" "#foo" "#fake")) |
| 513 | (kill-buffer b)))) | 514 | (kill-buffer b)))) |
| 514 | 515 | ||
| 516 | (ert-deftest erc-setup-buffer--custom-action () | ||
| 517 | (erc-mode) | ||
| 518 | (erc-tests--set-fake-server-process "sleep" "1") | ||
| 519 | (setq erc--server-last-reconnect-count 0) | ||
| 520 | (let ((owin (selected-window)) | ||
| 521 | (obuf (window-buffer)) | ||
| 522 | (mbuf (messages-buffer)) | ||
| 523 | calls) | ||
| 524 | (cl-letf (((symbol-function 'switch-to-buffer) ; regression | ||
| 525 | (lambda (&rest r) (push (cons 'switch-to-buffer r) calls))) | ||
| 526 | ((symbol-function 'erc--test-fun) | ||
| 527 | (lambda (&rest r) (push (cons 'erc--test-fun r) calls))) | ||
| 528 | ((symbol-function 'display-buffer) | ||
| 529 | (lambda (&rest r) (push (cons 'display-buffer r) calls)))) | ||
| 530 | |||
| 531 | ;; Baseline | ||
| 532 | (let ((erc-join-buffer 'bury)) | ||
| 533 | (erc-setup-buffer mbuf) | ||
| 534 | (should-not calls)) | ||
| 535 | |||
| 536 | (should-not erc--display-context) | ||
| 537 | |||
| 538 | ;; `display-buffer' | ||
| 539 | (let ((erc--display-context '((erc-buffer-display . 1))) | ||
| 540 | (erc-join-buffer 'erc--test-fun)) | ||
| 541 | (erc-setup-buffer mbuf) | ||
| 542 | (should (equal `(erc--test-fun ,mbuf (nil (erc-buffer-display . 1))) | ||
| 543 | (pop calls))) | ||
| 544 | (should-not calls)) | ||
| 545 | |||
| 546 | ;; `pop-to-buffer' with `erc-auto-reconnect-display' | ||
| 547 | (let* ((erc--server-last-reconnect-count 1) | ||
| 548 | (erc--display-context '((erc-buffer-display . 1))) | ||
| 549 | (erc-auto-reconnect-display 'erc--test-fun)) | ||
| 550 | (erc-setup-buffer mbuf) | ||
| 551 | (should (equal `(erc--test-fun ,mbuf | ||
| 552 | (nil (erc-auto-reconnect-display . t) | ||
| 553 | (erc-buffer-display . 1))) | ||
| 554 | (pop calls))) | ||
| 555 | (should-not calls))) | ||
| 556 | |||
| 557 | (should (eq owin (selected-window))) | ||
| 558 | (should (eq obuf (window-buffer))))) | ||
| 559 | |||
| 515 | (ert-deftest erc-lurker-maybe-trim () | 560 | (ert-deftest erc-lurker-maybe-trim () |
| 516 | (let (erc-lurker-trim-nicks | 561 | (let (erc-lurker-trim-nicks |
| 517 | (erc-lurker-ignore-chars "_`")) | 562 | (erc-lurker-ignore-chars "_`")) |
| @@ -1537,14 +1582,18 @@ | |||
| 1537 | (erc-join-buffer . window)))))) | 1582 | (erc-join-buffer . window)))))) |
| 1538 | 1583 | ||
| 1539 | (ert-info ("Switches to TLS when URL is ircs://") | 1584 | (ert-info ("Switches to TLS when URL is ircs://") |
| 1540 | (should (equal (ert-simulate-keys "ircs://irc.gnu.org\r\r\r\r" | 1585 | (let ((erc--display-context '((erc-interactive-display . erc)))) |
| 1541 | (erc-select-read-args)) | 1586 | (should (equal (ert-simulate-keys "ircs://irc.gnu.org\r\r\r\r" |
| 1542 | (list :server "irc.gnu.org" | 1587 | (erc-select-read-args)) |
| 1543 | :port 6697 | 1588 | (list :server "irc.gnu.org" |
| 1544 | :nick (user-login-name) | 1589 | :port 6697 |
| 1545 | '&interactive-env | 1590 | :nick (user-login-name) |
| 1546 | '((erc-server-connect-function . erc-open-tls-stream) | 1591 | '&interactive-env |
| 1547 | (erc-join-buffer . window)))))) | 1592 | '((erc-server-connect-function |
| 1593 | . erc-open-tls-stream) | ||
| 1594 | (erc--display-context | ||
| 1595 | . ((erc-interactive-display . erc))) | ||
| 1596 | (erc-join-buffer . window))))))) | ||
| 1548 | 1597 | ||
| 1549 | (setq-local erc-interactive-display nil) ; cheat to save space | 1598 | (setq-local erc-interactive-display nil) ; cheat to save space |
| 1550 | 1599 | ||
| @@ -1624,6 +1673,7 @@ | |||
| 1624 | ((symbol-function 'erc-open) | 1673 | ((symbol-function 'erc-open) |
| 1625 | (lambda (&rest r) | 1674 | (lambda (&rest r) |
| 1626 | (push `((erc-join-buffer ,erc-join-buffer) | 1675 | (push `((erc-join-buffer ,erc-join-buffer) |
| 1676 | (erc--display-context ,@erc--display-context) | ||
| 1627 | (erc-server-connect-function | 1677 | (erc-server-connect-function |
| 1628 | ,erc-server-connect-function)) | 1678 | ,erc-server-connect-function)) |
| 1629 | env) | 1679 | env) |
| @@ -1636,6 +1686,7 @@ | |||
| 1636 | nil nil nil nil nil "user" nil))) | 1686 | nil nil nil nil nil "user" nil))) |
| 1637 | (should (equal (pop env) | 1687 | (should (equal (pop env) |
| 1638 | '((erc-join-buffer bury) | 1688 | '((erc-join-buffer bury) |
| 1689 | (erc--display-context (erc-buffer-display . erc-tls)) | ||
| 1639 | (erc-server-connect-function erc-open-tls-stream))))) | 1690 | (erc-server-connect-function erc-open-tls-stream))))) |
| 1640 | 1691 | ||
| 1641 | (ert-info ("Full") | 1692 | (ert-info ("Full") |
| @@ -1652,6 +1703,7 @@ | |||
| 1652 | "bob:changeme" nil nil nil t "bobo" GNU.org))) | 1703 | "bob:changeme" nil nil nil t "bobo" GNU.org))) |
| 1653 | (should (equal (pop env) | 1704 | (should (equal (pop env) |
| 1654 | '((erc-join-buffer bury) | 1705 | '((erc-join-buffer bury) |
| 1706 | (erc--display-context (erc-buffer-display . erc-tls)) | ||
| 1655 | (erc-server-connect-function erc-open-tls-stream))))) | 1707 | (erc-server-connect-function erc-open-tls-stream))))) |
| 1656 | 1708 | ||
| 1657 | ;; Values are often nil when called by lisp code, which leads to | 1709 | ;; Values are often nil when called by lisp code, which leads to |
| @@ -1671,6 +1723,7 @@ | |||
| 1671 | "bob:changeme" nil nil nil nil "bobo" nil))) | 1723 | "bob:changeme" nil nil nil nil "bobo" nil))) |
| 1672 | (should (equal (pop env) | 1724 | (should (equal (pop env) |
| 1673 | '((erc-join-buffer bury) | 1725 | '((erc-join-buffer bury) |
| 1726 | (erc--display-context (erc-buffer-display . erc-tls)) | ||
| 1674 | (erc-server-connect-function erc-open-tls-stream))))) | 1727 | (erc-server-connect-function erc-open-tls-stream))))) |
| 1675 | 1728 | ||
| 1676 | (ert-info ("Interactive") | 1729 | (ert-info ("Interactive") |
| @@ -1681,6 +1734,8 @@ | |||
| 1681 | nil nil nil nil "user" nil))) | 1734 | nil nil nil nil "user" nil))) |
| 1682 | (should (equal (pop env) | 1735 | (should (equal (pop env) |
| 1683 | '((erc-join-buffer window) | 1736 | '((erc-join-buffer window) |
| 1737 | (erc--display-context | ||
| 1738 | (erc-interactive-display . erc-tls)) | ||
| 1684 | (erc-server-connect-function erc-open-tls-stream))))) | 1739 | (erc-server-connect-function erc-open-tls-stream))))) |
| 1685 | 1740 | ||
| 1686 | (ert-info ("Custom connect function") | 1741 | (ert-info ("Custom connect function") |
| @@ -1691,6 +1746,8 @@ | |||
| 1691 | nil nil nil nil nil "user" nil))) | 1746 | nil nil nil nil nil "user" nil))) |
| 1692 | (should (equal (pop env) | 1747 | (should (equal (pop env) |
| 1693 | '((erc-join-buffer bury) | 1748 | '((erc-join-buffer bury) |
| 1749 | (erc--display-context | ||
| 1750 | (erc-buffer-display . erc-tls)) | ||
| 1694 | (erc-server-connect-function my-connect-func)))))) | 1751 | (erc-server-connect-function my-connect-func)))))) |
| 1695 | 1752 | ||
| 1696 | (ert-info ("Advised default function overlooked") ; intentional | 1753 | (ert-info ("Advised default function overlooked") ; intentional |
| @@ -1702,6 +1759,7 @@ | |||
| 1702 | nil nil nil nil nil "user" nil))) | 1759 | nil nil nil nil nil "user" nil))) |
| 1703 | (should (equal (pop env) | 1760 | (should (equal (pop env) |
| 1704 | '((erc-join-buffer bury) | 1761 | '((erc-join-buffer bury) |
| 1762 | (erc--display-context (erc-buffer-display . erc-tls)) | ||
| 1705 | (erc-server-connect-function erc-open-tls-stream)))) | 1763 | (erc-server-connect-function erc-open-tls-stream)))) |
| 1706 | (advice-remove 'erc-server-connect-function 'erc-tests--erc-tls)) | 1764 | (advice-remove 'erc-server-connect-function 'erc-tests--erc-tls)) |
| 1707 | 1765 | ||
| @@ -1715,6 +1773,8 @@ | |||
| 1715 | '("irc.libera.chat" 6697 "tester" "unknown" t | 1773 | '("irc.libera.chat" 6697 "tester" "unknown" t |
| 1716 | nil nil nil nil nil "user" nil))) | 1774 | nil nil nil nil nil "user" nil))) |
| 1717 | (should (equal (pop env) `((erc-join-buffer bury) | 1775 | (should (equal (pop env) `((erc-join-buffer bury) |
| 1776 | (erc--display-context | ||
| 1777 | (erc-buffer-display . erc-tls)) | ||
| 1718 | (erc-server-connect-function ,f)))) | 1778 | (erc-server-connect-function ,f)))) |
| 1719 | (advice-remove 'erc-server-connect-function | 1779 | (advice-remove 'erc-server-connect-function |
| 1720 | 'erc-tests--erc-tls))))))) | 1780 | 'erc-tests--erc-tls))))))) |
| @@ -1729,6 +1789,7 @@ | |||
| 1729 | ((symbol-function 'erc-open) | 1789 | ((symbol-function 'erc-open) |
| 1730 | (lambda (&rest r) | 1790 | (lambda (&rest r) |
| 1731 | (push `((erc-join-buffer ,erc-join-buffer) | 1791 | (push `((erc-join-buffer ,erc-join-buffer) |
| 1792 | (erc--display-context ,@erc--display-context) | ||
| 1732 | (erc-server-connect-function | 1793 | (erc-server-connect-function |
| 1733 | ,erc-server-connect-function)) | 1794 | ,erc-server-connect-function)) |
| 1734 | env) | 1795 | env) |
| @@ -1741,8 +1802,9 @@ | |||
| 1741 | '("irc.libera.chat" 6697 "tester" "unknown" t nil | 1802 | '("irc.libera.chat" 6697 "tester" "unknown" t nil |
| 1742 | nil nil nil nil "user" nil))) | 1803 | nil nil nil nil "user" nil))) |
| 1743 | (should (equal (pop env) | 1804 | (should (equal (pop env) |
| 1744 | '((erc-join-buffer window) (erc-server-connect-function | 1805 | '((erc-join-buffer window) |
| 1745 | erc-open-tls-stream))))) | 1806 | (erc--display-context (erc-interactive-display . erc)) |
| 1807 | (erc-server-connect-function erc-open-tls-stream))))) | ||
| 1746 | 1808 | ||
| 1747 | (ert-info ("Nick supplied, decline TLS upgrade") | 1809 | (ert-info ("Nick supplied, decline TLS upgrade") |
| 1748 | (ert-simulate-keys "\r\rdummy\r\rn\r" | 1810 | (ert-simulate-keys "\r\rdummy\r\rn\r" |
| @@ -1752,6 +1814,7 @@ | |||
| 1752 | nil nil nil nil "user" nil))) | 1814 | nil nil nil nil "user" nil))) |
| 1753 | (should (equal (pop env) | 1815 | (should (equal (pop env) |
| 1754 | '((erc-join-buffer window) | 1816 | '((erc-join-buffer window) |
| 1817 | (erc--display-context (erc-interactive-display . erc)) | ||
| 1755 | (erc-server-connect-function | 1818 | (erc-server-connect-function |
| 1756 | erc-open-network-stream)))))))) | 1819 | erc-open-network-stream)))))))) |
| 1757 | 1820 | ||
| @@ -1762,6 +1825,7 @@ | |||
| 1762 | ((symbol-function 'erc-open) | 1825 | ((symbol-function 'erc-open) |
| 1763 | (lambda (&rest r) | 1826 | (lambda (&rest r) |
| 1764 | (push `((erc-join-buffer ,erc-join-buffer) | 1827 | (push `((erc-join-buffer ,erc-join-buffer) |
| 1828 | (erc--display-context ,@erc--display-context) | ||
| 1765 | (erc-server-connect-function | 1829 | (erc-server-connect-function |
| 1766 | ,erc-server-connect-function)) | 1830 | ,erc-server-connect-function)) |
| 1767 | env) | 1831 | env) |
| @@ -1776,6 +1840,7 @@ | |||
| 1776 | nil nil nil nil "user" nil))) | 1840 | nil nil nil nil "user" nil))) |
| 1777 | (should (equal (pop env) | 1841 | (should (equal (pop env) |
| 1778 | '((erc-join-buffer window) | 1842 | '((erc-join-buffer window) |
| 1843 | (erc--display-context (erc-interactive-display . erc)) | ||
| 1779 | (erc-server-connect-function erc-open-tls-stream))))) | 1844 | (erc-server-connect-function erc-open-tls-stream))))) |
| 1780 | 1845 | ||
| 1781 | (ert-info ("Selects entry that doesn't support TLS") | 1846 | (ert-info ("Selects entry that doesn't support TLS") |
| @@ -1787,6 +1852,7 @@ | |||
| 1787 | nil nil nil nil "user" nil))) | 1852 | nil nil nil nil "user" nil))) |
| 1788 | (should (equal (pop env) | 1853 | (should (equal (pop env) |
| 1789 | '((erc-join-buffer window) | 1854 | '((erc-join-buffer window) |
| 1855 | (erc--display-context (erc-interactive-display . erc)) | ||
| 1790 | (erc-server-connect-function | 1856 | (erc-server-connect-function |
| 1791 | erc-open-network-stream)))))))) | 1857 | erc-open-network-stream)))))))) |
| 1792 | 1858 | ||
diff --git a/test/lisp/erc/resources/join/buffer-display/mode-context.eld b/test/lisp/erc/resources/join/buffer-display/mode-context.eld new file mode 100644 index 00000000000..6ebbdc7e824 --- /dev/null +++ b/test/lisp/erc/resources/join/buffer-display/mode-context.eld | |||
| @@ -0,0 +1,38 @@ | |||
| 1 | ;; -*- mode: lisp-data; -*- | ||
| 2 | ((nick 1 "NICK tester")) | ||
| 3 | ((user 1 "USER user 0 * :tester") | ||
| 4 | (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") | ||
| 5 | (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.8.0") | ||
| 6 | (0.00 ":irc.foonet.org 003 tester :This server was created Tue, 24 May 2022 05:28:42 UTC") | ||
| 7 | (0.00 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.8.0 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") | ||
| 8 | (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server") | ||
| 9 | (0.01 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server") | ||
| 10 | (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server") | ||
| 11 | (0.00 ":irc.foonet.org 251 tester :There are 0 users and 4 invisible on 1 server(s)") | ||
| 12 | (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online") | ||
| 13 | (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections") | ||
| 14 | (0.00 ":irc.foonet.org 254 tester 2 :channels formed") | ||
| 15 | (0.00 ":irc.foonet.org 255 tester :I have 4 clients and 0 servers") | ||
| 16 | (0.00 ":irc.foonet.org 265 tester 4 4 :Current local users 4, max 4") | ||
| 17 | (0.00 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4") | ||
| 18 | (0.00 ":irc.foonet.org 422 tester :MOTD File is missing")) | ||
| 19 | |||
| 20 | ((mode 6 "MODE tester +i") | ||
| 21 | (0.00 ":irc.foonet.org 221 tester +i") | ||
| 22 | (0.00 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.") | ||
| 23 | (0.02 ":irc.foonet.org 221 tester +i")) | ||
| 24 | |||
| 25 | ((join-chan 10 "JOIN #chan") | ||
| 26 | (0.03 ":tester!~u@w9rfqveugz722.irc JOIN #chan")) | ||
| 27 | |||
| 28 | ((~mode-chan 10 "MODE #chan") | ||
| 29 | (0.01 ":irc.foonet.org 353 tester = #chan :@tester") | ||
| 30 | (0.00 ":irc.foonet.org 366 tester #chan :End of NAMES list") | ||
| 31 | (0.01 ":irc.foonet.org 324 tester #chan +nt") | ||
| 32 | (0.03 ":irc.foonet.org 329 tester #chan 1653370308")) | ||
| 33 | |||
| 34 | ((~join-spam 10 "JOIN #spam") | ||
| 35 | (0.03 ":irc.foonet.org 471 tester #spam :Cannot join channel (+l)")) | ||
| 36 | |||
| 37 | ((~join-foo 10 "JOIN #foo") | ||
| 38 | (0.03 ":irc.foonet.org 473 tester #foo :Cannot join channel (+i)")) | ||