From 3273e2ace788a58bef77cef936021d151815ea94 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Mon, 30 Mar 2020 01:57:36 +0300 Subject: [PATCH] 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 2b25d6023cd..9fbf995d7e4 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 d0791d40196..00142d87dcc 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 bb5f549a2e2..765a923bf77 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 72d1cc250a3..b66bb034712 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 8ce0187f5b7..1f5fae95023 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 7f5b597542a..9e0e6339c6f 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 b54f1633f5e..0121a78191a 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))) -- 2.39.5