master 3273e2a: Deprecate with-displayed-buffer-window, use body-function instead (bug#39822)

[Juri Linkov]

branch: master
commit 3273e2ace788a58bef77cef936021d151815ea94
Author: Juri Linkov <address@hidden>
Commit: Juri Linkov <address@hidden>

    Deprecate with-displayed-buffer-window, use body-function instead 
(bug#39822)
    
    * doc/lispref/display.texi (Temporary Displays):
    Remove defmac with-displayed-buffer-window.
    
    * doc/lispref/windows.texi (Buffer Display Action Alists):
    Add body-function.
    
    * lisp/window.el (with-displayed-buffer-window): Declare macro obsolete.
    (window--display-buffer): Call 'body-function' after displaying the buffer.
    
    * lisp/dired.el (dired-mark-pop-up):
    * lisp/files.el (save-buffers-kill-emacs):
    * lisp/minibuffer.el (minibuffer-completion-help):
    Replace with-displayed-buffer-window with with-current-buffer-window
    and add action alist entry 'body-function' with former macro body.
---
 doc/lispref/display.texi |   6 ---
 doc/lispref/windows.texi |   9 ++++
 etc/NEWS                 |   4 ++
 lisp/dired.el            |  29 ++++++------
 lisp/files.el            |  14 ++++--
 lisp/minibuffer.el       | 116 ++++++++++++++++++++++++-----------------------
 lisp/window.el           |  10 +++-
 7 files changed, 105 insertions(+), 83 deletions(-)

diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 2b25d60..9fbf995 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -1318,12 +1318,6 @@ the buffer specified by @var{buffer-or-name} current for 
running
 @var{body}.
 @end defmac
 
-@defmac with-displayed-buffer-window buffer-or-name action quit-function &rest 
body
-This macro is like @code{with-current-buffer-window} but unlike that
-displays the buffer specified by @var{buffer-or-name} @emph{before}
-running @var{body}.
-@end defmac
-
 A window showing a temporary buffer can be fitted to the size of that
 buffer using the following mode:
 
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi
index d0791d4..00142d8 100644
--- a/doc/lispref/windows.texi
+++ b/doc/lispref/windows.texi
@@ -3048,6 +3048,15 @@ since there is no guarantee that an arbitrary caller of
 @code{display-buffer} will be able to handle the case that no window
 will display the buffer.  @code{display-buffer-no-window} is the only
 action function that cares about this entry.
+
+@vindex body-function@r{, a buffer display action alist entry}
+@item body-function
+The value must be a function taking one argument (a displayed window).
+This function can be used to fill the displayed window's body with
+some contents.  It is called @emph{after} the buffer is displayed, and
+@emph{before} the entries @code{window-height}, @code{window-width}
+and @code{preserve-size} are applied that could resize the window
+to fit it to the inserted contents.
 @end table
 
 By convention, the entries @code{window-height}, @code{window-width}
diff --git a/etc/NEWS b/etc/NEWS
index bb5f549..765a923 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -266,6 +266,10 @@ It was used to allow loading Lisp libraries compiled by 
XEmacs, a
 modified version of Emacs which is no longer actively maintained.
 This is no longer supported, and setting this variable has no effect.
 
++++
+** The macro 'with-displayed-buffer-window' is now obsolete.
+Use macro 'with-current-buffer-window' with action alist entry 'body-function'.
+
 
 * Lisp Changes in Emacs 28.1
 
diff --git a/lisp/dired.el b/lisp/dired.el
index 72d1cc2..b66bb03 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -3521,26 +3521,27 @@ argument or confirmation)."
          ;; Mark *Marked Files* window as softly-dedicated, to prevent
          ;; other buffers e.g. *Completions* from reusing it (bug#17554).
          (display-buffer-mark-dedicated 'soft))
-      (with-displayed-buffer-window
+      (with-current-buffer-window
        buffer
-       (cons 'display-buffer-below-selected
-            '((window-height . fit-window-to-buffer)
-              (preserve-size . (nil . t))))
+       `(display-buffer-below-selected
+         (window-height . fit-window-to-buffer)
+         (preserve-size . (nil . t))
+         (body-function
+          . ,#'(lambda (_window)
+                 ;; Handle (t FILE) just like (FILE), here.  That value is
+                 ;; used (only in some cases), to mean just one file that was
+                 ;; marked, rather than the current line file.
+                 (dired-format-columns-of-files
+                  (if (eq (car files) t) (cdr files) files))
+                 (remove-text-properties (point-min) (point-max)
+                                         '(mouse-face nil help-echo nil))
+                 (setq tab-line-exclude nil))))
        #'(lambda (window _value)
           (with-selected-window window
             (unwind-protect
                 (apply function args)
               (when (window-live-p window)
-                (quit-restore-window window 'kill)))))
-       ;; Handle (t FILE) just like (FILE), here.  That value is
-       ;; used (only in some cases), to mean just one file that was
-       ;; marked, rather than the current line file.
-       (with-current-buffer buffer
-        (dired-format-columns-of-files
-         (if (eq (car files) t) (cdr files) files))
-        (remove-text-properties (point-min) (point-max)
-                                '(mouse-face nil help-echo nil))
-        (setq tab-line-exclude nil))))))
+                (quit-restore-window window 'kill)))))))))
 
 (defun dired-format-columns-of-files (files)
   (let ((beg (point)))
diff --git a/lisp/files.el b/lisp/files.el
index 8ce0187..1f5fae9 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -7253,10 +7253,15 @@ if any returns nil.  If `confirm-kill-emacs' is 
non-nil, calls it."
                   (setq active t))
              (setq processes (cdr processes)))
            (or (not active)
-               (with-displayed-buffer-window
+               (with-current-buffer-window
                 (get-buffer-create "*Process List*")
-                '(display-buffer--maybe-at-bottom
-                  (dedicated . t))
+                `(display-buffer--maybe-at-bottom
+                  (dedicated . t)
+                  (window-height . fit-window-to-buffer)
+                  (preserve-size . (nil . t))
+                  (body-function
+                   . ,#'(lambda (_window)
+                          (list-processes t))))
                 #'(lambda (window _value)
                     (with-selected-window window
                       (unwind-protect
@@ -7264,8 +7269,7 @@ if any returns nil.  If `confirm-kill-emacs' is non-nil, 
calls it."
                             (setq confirm nil)
                             (yes-or-no-p "Active processes exist; kill them 
and exit anyway? "))
                         (when (window-live-p window)
-                          (quit-restore-window window 'kill)))))
-                (list-processes t)))))
+                          (quit-restore-window window 'kill)))))))))
      ;; Query the user for other things, perhaps.
      (run-hook-with-args-until-failure 'kill-emacs-query-functions)
      (or (null confirm)
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 7f5b597..9e0e633 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1973,7 +1973,7 @@ variables.")
              ;; minibuffer-hide-completions will know whether to
              ;; delete the window or not.
              (display-buffer-mark-dedicated 'soft))
-        (with-displayed-buffer-window
+        (with-current-buffer-window
           "*Completions*"
           ;; This is a copy of `display-buffer-fallback-action'
           ;; where `display-buffer-use-some-window' is replaced
@@ -1991,62 +1991,64 @@ variables.")
                 '(window-height . resize-temp-buffer-window)
               '(window-height . fit-window-to-buffer))
            ,(when temp-buffer-resize-mode
-              '(preserve-size . (nil . t))))
-          nil
-          ;; Remove the base-size tail because `sort' requires a properly
-          ;; nil-terminated list.
-          (when last (setcdr last nil))
-          (setq completions
-                ;; FIXME: This function is for the output of all-completions,
-                ;; not completion-all-completions.  Often it's the same, but
-                ;; not always.
-                (let ((sort-fun (completion-metadata-get
-                                 all-md 'display-sort-function)))
-                  (if sort-fun
-                      (funcall sort-fun completions)
-                    (sort completions 'string-lessp))))
-          (when afun
-            (setq completions
-                  (mapcar (lambda (s)
-                            (let ((ann (funcall afun s)))
-                              (if ann (list s ann) s)))
-                          completions)))
-
-          (with-current-buffer standard-output
-            (set (make-local-variable 'completion-base-position)
-                 (list (+ start base-size)
-                       ;; FIXME: We should pay attention to completion
-                       ;; boundaries here, but currently
-                       ;; completion-all-completions does not give us the
-                       ;; necessary information.
-                       end))
-            (set (make-local-variable 'completion-list-insert-choice-function)
-                 (let ((ctable minibuffer-completion-table)
-                       (cpred minibuffer-completion-predicate)
-                       (cprops completion-extra-properties))
-                   (lambda (start end choice)
-                     (unless (or (zerop (length prefix))
-                                 (equal prefix
-                                        (buffer-substring-no-properties
-                                         (max (point-min)
-                                              (- start (length prefix)))
-                                         start)))
-                       (message "*Completions* out of date"))
-                     ;; FIXME: Use `md' to do quoting&terminator here.
-                     (completion--replace start end choice)
-                     (let* ((minibuffer-completion-table ctable)
-                            (minibuffer-completion-predicate cpred)
-                            (completion-extra-properties cprops)
-                            (result (concat prefix choice))
-                            (bounds (completion-boundaries
-                                     result ctable cpred "")))
-                       ;; If the completion introduces a new field, then
-                       ;; completion is not finished.
-                       (completion--done result
-                                         (if (eq (car bounds) (length result))
-                                             'exact 'finished)))))))
-
-          (display-completion-list completions))))
+              '(preserve-size . (nil . t)))
+            (body-function
+             . ,#'(lambda (_window)
+                    ;; Remove the base-size tail because `sort' requires a 
properly
+                    ;; nil-terminated list.
+                    (when last (setcdr last nil))
+                    (setq completions
+                          ;; FIXME: This function is for the output of 
all-completions,
+                          ;; not completion-all-completions.  Often it's the 
same, but
+                          ;; not always.
+                          (let ((sort-fun (completion-metadata-get
+                                           all-md 'display-sort-function)))
+                            (if sort-fun
+                                (funcall sort-fun completions)
+                              (sort completions 'string-lessp))))
+                    (when afun
+                      (setq completions
+                            (mapcar (lambda (s)
+                                      (let ((ann (funcall afun s)))
+                                        (if ann (list s ann) s)))
+                                    completions)))
+
+                    (with-current-buffer standard-output
+                      (set (make-local-variable 'completion-base-position)
+                           (list (+ start base-size)
+                                 ;; FIXME: We should pay attention to 
completion
+                                 ;; boundaries here, but currently
+                                 ;; completion-all-completions does not give 
us the
+                                 ;; necessary information.
+                                 end))
+                      (set (make-local-variable 
'completion-list-insert-choice-function)
+                           (let ((ctable minibuffer-completion-table)
+                                 (cpred minibuffer-completion-predicate)
+                                 (cprops completion-extra-properties))
+                             (lambda (start end choice)
+                               (unless (or (zerop (length prefix))
+                                           (equal prefix
+                                                  
(buffer-substring-no-properties
+                                                   (max (point-min)
+                                                        (- start (length 
prefix)))
+                                                   start)))
+                                 (message "*Completions* out of date"))
+                               ;; FIXME: Use `md' to do quoting&terminator 
here.
+                               (completion--replace start end choice)
+                               (let* ((minibuffer-completion-table ctable)
+                                      (minibuffer-completion-predicate cpred)
+                                      (completion-extra-properties cprops)
+                                      (result (concat prefix choice))
+                                      (bounds (completion-boundaries
+                                               result ctable cpred "")))
+                                 ;; If the completion introduces a new field, 
then
+                                 ;; completion is not finished.
+                                 (completion--done result
+                                                   (if (eq (car bounds) 
(length result))
+                                                       'exact 'finished)))))))
+
+                    (display-completion-list completions))))
+          nil)))
     nil))
 
 (defun minibuffer-hide-completions ()
diff --git a/lisp/window.el b/lisp/window.el
index b54f163..0121a78 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -226,7 +226,9 @@ BODY."
   "Show a buffer BUFFER-OR-NAME and evaluate BODY in that buffer.
 This construct is like `with-current-buffer-window' but unlike that,
 displays the buffer specified by BUFFER-OR-NAME before running BODY."
-  (declare (debug t) (indent 3))
+  (declare (debug t) (indent 3)
+           (obsolete "use `with-current-buffer-window' with action alist entry 
`body-function'."
+                     "28.1"))
   (let ((buffer (make-symbol "buffer"))
        (window (make-symbol "window"))
        (value (make-symbol "value")))
@@ -7070,6 +7072,12 @@ Return WINDOW if BUFFER and WINDOW are live."
         (set-window-dedicated-p window display-buffer-mark-dedicated))))
     (when (memq type '(window frame tab))
       (set-window-prev-buffers window nil))
+
+    (when (functionp (cdr (assq 'body-function alist)))
+      (let ((inhibit-read-only t)
+            (inhibit-modification-hooks t))
+        (funcall (cdr (assq 'body-function alist)) window)))
+
     (let ((quit-restore (window-parameter window 'quit-restore))
          (height (cdr (assq 'window-height alist)))
          (width (cdr (assq 'window-width alist)))