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

"J.P." <[email protected]>
Newsgroups gmane.emacs.bugs,gmane.emacs.erc.general
Message-ID <[email protected]>
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." <[email protected]> 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'.
0000-v1-v2.diff (text/x-patch, 22.3 KB)
From 24dafe2771b6756c10a259ca5f5782f7d11f8fe7 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email protected]>
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
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.