bug#62833: 30.0.50; ERC 5.6: Rethink buffer-display options and behavior

["J.P." <jp@neverwas.me>]

[-- Attachment #1: Type: text/plain, Size: 1766 bytes --]

v2 (Custom function choice). Fix multiple misspellings of the variable
`erc-buffer-display'. Simplify defcustom type from cons to plain
function. Convert `displayed' frames variant to function item. Add
escape hatch for no-op when buffer matches `window-buffer'.

"J.P." <jp@neverwas.me> writes:

> Actually, instead of a `display-buffer' action alone, I went for a cons
> of a `display-buffer'-compatible function, like `pop-to-buffer', and an
> action argument, together.
>
> [...]
>
> For this new variant I'm proposing, ERC calls the user's function with
> the newly created buffer and a possibly augmented version of the action
> that includes some well defined contextual clues in its alist. The
> latter are enumerated in the doc strings of the various user options.

I've simplified this further. Instead of a cons of a `display-buffer'-
compatible function and action, I think it's simpler to expect a
function that takes as arguments the new buffer and a "context alist"
(that can double as an "action alist"). This way, the user's code can
inspect the context, assemble the action parameter appropriately, and
dispatch `display-buffer' or similar as needed. I've also added some
ready-made function items, though possibly only as placeholders.

>> Although, at that point, why not just do
>>
>>   (display-buffer (let ((erc-join-buffer 'bury)) (erc-tls :server ...))
>>                   '(my-use-dedicated-frame (inhibit-same-window . t)))
>>
>> which has always been possible and is no more complicated?
>
> This would be preferable if we had more granular options that only
> affected a single context, such as something exclusively for
> non-interactive `erc-tls' invocations.

I've described this briefly in the doc string for `erc-buffer-display'.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v1-v2.diff --]
[-- Type: text/x-patch, Size: 22791 bytes --]

From 24dafe2771b6756c10a259ca5f5782f7d11f8fe7 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 9 Jun 2023 00:14:52 -0700
Subject: [PATCH 0/2] *** NOT A PATCH ***

*** BLURB HERE ***

F. Jason Park (2):
  [5.6] Allow custom display-buffer actions in ERC
  [5.6] Move erc-reuse-frames choice to action function

 etc/ERC-NEWS               |  20 +--
 lisp/erc/erc-backend.el    |   9 +-
 lisp/erc/erc.el            | 249 ++++++++++++++++++++++++++-----------
 test/lisp/erc/erc-tests.el |  91 +++++++++++---
 4 files changed, 268 insertions(+), 101 deletions(-)

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