Commit c5e28e39 authored by Martin Rudalics's avatar Martin Rudalics

New macro with-temp-buffer-window and related fixes.

* buffer.c (Fdelete_all_overlays): New function.

* window.el (temp-buffer-window-setup-hook)
(temp-buffer-window-show-hook): New hooks.
(temp-buffer-window-setup, temp-buffer-window-show)
(with-temp-buffer-window): New functions.
(fit-window-to-buffer): Remove unused optional argument
OVERRIDE.
(special-display-popup-frame): Make sure the window used shows
BUFFER.

* help.el (temp-buffer-resize-mode): Fix doc-string.
(resize-temp-buffer-window): New optional argument WINDOW.

* files.el (recover-file, save-buffers-kill-emacs):
* dired.el (dired-mark-pop-up): Use with-temp-buffer-window.
parent 3eab3ca9
......@@ -631,6 +631,10 @@ The interpretation of the DECLS is determined by `defun-declarations-alist'.
*** The functions get-lru-window, get-mru-window and get-largest-window
now accept a third argument to avoid choosing the selected window.
*** New macro with-temp-buffer-window.
*** New display action function display-buffer-below-selected.
*** New display action alist `inhibit-switch-frame', if non-nil, tells
display action functions to avoid changing which frame is selected.
......
2012-09-03 Martin Rudalics <rudalics@gmx.at>
* window.el (temp-buffer-window-setup-hook)
(temp-buffer-window-show-hook): New hooks.
(temp-buffer-window-setup, temp-buffer-window-show)
(with-temp-buffer-window): New functions.
(fit-window-to-buffer): Remove unused optional argument
OVERRIDE.
(special-display-popup-frame): Make sure the window used shows
BUFFER.
* help.el (temp-buffer-resize-mode): Fix doc-string.
(resize-temp-buffer-window): New optional argument WINDOW.
* files.el (recover-file, save-buffers-kill-emacs):
* dired.el (dired-mark-pop-up): Use with-temp-buffer-window.
2012-09-02 Michael Albinus <michael.albinus@gmx.de>
* eshell/em-unix.el (eshell/sudo): When we have an ad-hoc
......
......@@ -2973,36 +2973,43 @@ If t, confirmation is never needed."
(const shell) (const symlink) (const touch)
(const uncompress))))
(defun dired-mark-pop-up (bufname op-symbol files function &rest args)
(defun dired-mark-pop-up (buffer-or-name op-symbol files function &rest args)
"Return FUNCTION's result on ARGS after showing which files are marked.
Displays the file names in a buffer named BUFNAME;
nil gives \" *Marked Files*\".
This uses function `dired-pop-to-buffer' to do that.
FUNCTION should not manipulate files, just read input
(an argument or confirmation).
The window is not shown if there is just one file or
OP-SYMBOL is a member of the list in `dired-no-confirm'.
Displays the file names in a window showing a buffer named
BUFFER-OR-NAME; the default name being \" *Marked Files*\". The
window is not shown if there is just one file, `dired-no-confirm'
is t, or OP-SYMBOL is a member of the list in `dired-no-confirm'.
FILES is the list of marked files. It can also be (t FILENAME)
in the case of one marked file, to distinguish that from using
just the current file."
(or bufname (setq bufname " *Marked Files*"))
just the current file.
FUNCTION should not manipulate files, just read input \(an
argument or confirmation)."
(if (or (eq dired-no-confirm t)
(memq op-symbol dired-no-confirm)
;; If FILES defaulted to the current line's file.
(= (length files) 1))
(apply function args)
(with-current-buffer (get-buffer-create bufname)
(erase-buffer)
;; 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)))
(save-window-excursion
(dired-pop-to-buffer bufname)
(apply function args))))
(let ((buffer (get-buffer-create (or buffer-or-name " *Marked Files*"))))
(with-current-buffer buffer
(let ((split-height-threshold 0))
(with-temp-buffer-window
buffer
(cons 'display-buffer-below-selected 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.
(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))))))))
(defun dired-format-columns-of-files (files)
(let ((beg (point)))
......
......@@ -5350,23 +5350,26 @@ non-nil, it is called instead of rereading visited file contents."
(not (file-exists-p file-name)))
(error "Auto-save file %s not current"
(abbreviate-file-name file-name)))
((save-window-excursion
(with-output-to-temp-buffer "*Directory*"
(buffer-disable-undo standard-output)
(save-excursion
(let ((switches dired-listing-switches))
(if (file-symlink-p file)
(setq switches (concat switches " -L")))
(set-buffer standard-output)
;; Use insert-directory-safely, not insert-directory,
;; because these files might not exist. In particular,
;; FILE might not exist if the auto-save file was for
;; a buffer that didn't visit a file, such as "*mail*".
;; The code in v20.x called `ls' directly, so we need
;; to emulate what `ls' did in that case.
(insert-directory-safely file switches)
(insert-directory-safely file-name switches))))
(yes-or-no-p (format "Recover auto save file %s? " file-name)))
((with-temp-buffer-window
"*Directory*" nil
#'(lambda (window _value)
(with-selected-window window
(unwind-protect
(yes-or-no-p (format "Recover auto save file %s? " file-name))
(when (window-live-p window)
(quit-restore-window window 'kill)))))
(with-current-buffer standard-output
(let ((switches dired-listing-switches))
(if (file-symlink-p file)
(setq switches (concat switches " -L")))
;; Use insert-directory-safely, not insert-directory,
;; because these files might not exist. In particular,
;; FILE might not exist if the auto-save file was for
;; a buffer that didn't visit a file, such as "*mail*".
;; The code in v20.x called `ls' directly, so we need
;; to emulate what `ls' did in that case.
(insert-directory-safely file switches)
(insert-directory-safely file-name switches))))
(switch-to-buffer (find-file-noselect file t))
(let ((inhibit-read-only t)
;; Keep the current buffer-file-coding-system.
......@@ -6327,8 +6330,15 @@ if any returns nil. If `confirm-kill-emacs' is non-nil, calls it."
(setq active t))
(setq processes (cdr processes)))
(or (not active)
(progn (list-processes t)
(yes-or-no-p "Active processes exist; kill them and exit anyway? ")))))
(with-temp-buffer-window
(get-buffer-create "*Process List*") nil
#'(lambda (window _value)
(with-selected-window window
(unwind-protect
(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)))))
;; Query the user for other things, perhaps.
(run-hook-with-args-until-failure 'kill-emacs-query-functions)
(or (null confirm-kill-emacs)
......
......@@ -39,9 +39,10 @@
;; `help-window-point-marker' is a marker you can move to a valid
;; position of the buffer shown in the help window in order to override
;; the standard positioning mechanism (`point-min') chosen by
;; `with-output-to-temp-buffer'. `with-help-window' has this point
;; nowhere before exiting. Currently used by `view-lossage' to assert
;; that the last keystrokes are always visible.
;; `with-output-to-temp-buffer' and `with-temp-buffer-window'.
;; `with-help-window' has this point nowhere before exiting. Currently
;; used by `view-lossage' to assert that the last keystrokes are always
;; visible.
(defvar help-window-point-marker (make-marker)
"Marker to override default `window-point' in help windows.")
......@@ -975,13 +976,13 @@ function is called, the window to be resized is selected."
:version "20.4")
(define-minor-mode temp-buffer-resize-mode
"Toggle auto-shrinking temp buffer windows (Temp Buffer Resize mode).
"Toggle auto-resizing temporary buffer windows (Temp Buffer Resize Mode).
With a prefix argument ARG, enable Temp Buffer Resize mode if ARG
is positive, and disable it otherwise. If called from Lisp,
enable the mode if ARG is omitted or nil.
When Temp Buffer Resize mode is enabled, the windows in which we
show a temporary buffer are automatically reduced in height to
show a temporary buffer are automatically resized in height to
fit the buffer's contents, but never more than
`temp-buffer-max-height' nor less than `window-min-height'.
......@@ -994,19 +995,22 @@ and some others."
(add-hook 'temp-buffer-show-hook 'resize-temp-buffer-window 'append)
(remove-hook 'temp-buffer-show-hook 'resize-temp-buffer-window)))
(defun resize-temp-buffer-window ()
"Resize the selected window to fit its contents.
Will not make it higher than `temp-buffer-max-height' nor smaller
than `window-min-height'. Do nothing if the selected window is
not vertically combined or some of its contents are scrolled out
of view."
(when (and (pos-visible-in-window-p (point-min))
(window-combined-p))
(fit-window-to-buffer
nil
(if (functionp temp-buffer-max-height)
(funcall temp-buffer-max-height (window-buffer))
temp-buffer-max-height))))
(defun resize-temp-buffer-window (&optional window)
"Resize WINDOW to fit its contents.
WINDOW can be any live window and defaults to the selected one.
Do not make WINDOW higher than `temp-buffer-max-height' nor
smaller than `window-min-height'. Do nothing if WINDOW is not
vertically combined or some of its contents are scrolled out of
view."
(setq window (window-normalize-window window t))
(let ((height (if (functionp temp-buffer-max-height)
(with-selected-window window
(funcall temp-buffer-max-height (window-buffer)))
temp-buffer-max-height)))
(when (and (pos-visible-in-window-p (point-min) window)
(window-combined-p window))
(fit-window-to-buffer window height))))
;;; Help windows.
(defcustom help-window-select 'other
......
......@@ -73,6 +73,108 @@ are not altered by this macro (unless they are altered in BODY)."
(when (window-live-p save-selected-window-window)
(select-window save-selected-window-window 'norecord))))))
(defvar temp-buffer-window-setup-hook nil
"Normal hook run by `with-temp-buffer-window' before buffer display.
This hook is run by `with-temp-buffer-window' with the buffer to be
displayed current.")
(defvar temp-buffer-window-show-hook nil
"Normal hook run by `with-temp-buffer-window' after buffer display.
This hook is run by `with-temp-buffer-window' with the buffer
displayed and current and its window selected.")
(defun temp-buffer-window-setup (buffer-or-name)
"Set up temporary buffer specified by BUFFER-OR-NAME
Return the buffer."
(let ((old-dir default-directory)
(buffer (get-buffer-create buffer-or-name)))
(with-current-buffer buffer
(kill-all-local-variables)
(setq default-directory old-dir)
(delete-all-overlays)
(setq buffer-read-only nil)
(setq buffer-file-name nil)
(setq buffer-undo-list t)
(let ((inhibit-read-only t)
(inhibit-modification-hooks t))
(erase-buffer)
(run-hooks 'temp-buffer-window-setup-hook))
;; Return the buffer.
buffer)))
(defun temp-buffer-window-show (&optional buffer action)
"Show temporary buffer BUFFER in a window.
Return the window showing BUFFER. Pass ACTION as action argument
to `display-buffer'."
(let (window frame)
(with-current-buffer buffer
(set-buffer-modified-p nil)
(setq buffer-read-only t)
(goto-char (point-min))
(when (setq window (display-buffer buffer action))
(setq frame (window-frame window))
(unless (eq frame (selected-frame))
(raise-frame frame))
(setq minibuffer-scroll-window window)
(set-window-hscroll window 0)
(with-selected-window window
(run-hooks 'temp-buffer-window-show-hook)
(when temp-buffer-resize-mode
(resize-temp-buffer-window window)))
;; Return the window.
window))))
(defmacro with-temp-buffer-window (buffer-or-name action quit-function &rest body)
"Evaluate BODY and display buffer specified by BUFFER-OR-NAME.
BUFFER-OR-NAME must specify either a live buffer or the name of a
buffer. If no buffer with such a name exists, create one.
Make sure the specified buffer is empty before evaluating BODY.
Do not make that buffer current for BODY. Instead, bind
`standard-output' to that buffer, so that output generated with
`prin1' and similar functions in BODY goes into that buffer.
After evaluating BODY, mark the specified buffer unmodified and
read-only, and display it in a window via `display-buffer'. Pass
ACTION as action argument to `display-buffer'. Automatically
shrink the window used if `temp-buffer-resize-mode' is enabled.
Return the value returned by BODY unless QUIT-FUNCTION specifies
a function. In that case, run the function with two arguments -
the window showing the specified buffer and the value returned by
BODY - and return the value returned by that function.
If the buffer is displayed on a new frame, the window manager may
decide to select that frame. In that case, it's usually a good
strategy if the function specified by QUIT-FUNCTION selects the
window showing the buffer before reading a value from the
minibuffer, for example, when asking a `yes-or-no-p' question.
This construct is similar to `with-output-to-temp-buffer' but
does neither put the buffer in help mode nor does it call
`temp-buffer-show-function'. It also runs different hooks,
namely `temp-buffer-window-setup-hook' (with the specified buffer
current) and `temp-buffer-window-show-hook' (with the specified
buffer current and the window showing it selected).
Since this macro calls `display-buffer', the window displaying
the buffer is usually not selected and the specified buffer
usually not made current. QUIT-FUNCTION can override that."
(declare (debug t))
(let ((buffer (make-symbol "buffer"))
(window (make-symbol "window"))
(value (make-symbol "value")))
`(let* ((,buffer (temp-buffer-window-setup ,buffer-or-name))
(standard-output ,buffer)
,window ,value)
(with-current-buffer ,buffer
(setq ,value (progn ,@body))
(setq ,window (temp-buffer-window-show ,buffer ,action)))
(if (functionp ,quit-function)
(funcall ,quit-function ,window ,value)
,value))))
;; The following two functions are like `window-next-sibling' and
;; `window-prev-sibling' but the WINDOW argument is _not_ optional (so
;; they don't substitute the selected window for nil), and they return
......@@ -4696,6 +4798,9 @@ and (cdr ARGS) as second."
(make-frame (append args special-display-frame-alist))))
(window (frame-selected-window frame)))
(display-buffer-record-window 'frame window buffer)
(unless (eq buffer (window-buffer window))
(set-window-buffer window buffer)
(set-window-prev-buffers window nil))
(set-window-dedicated-p window t)
window)))))
......@@ -5710,7 +5815,7 @@ WINDOW must be a live window and defaults to the selected one."
window))))
;;; Resizing buffers to fit their contents exactly.
(defun fit-window-to-buffer (&optional window max-height min-height override)
(defun fit-window-to-buffer (&optional window max-height min-height)
"Adjust height of WINDOW to display its buffer's contents exactly.
WINDOW must be a live window and defaults to the selected one.
......@@ -5721,10 +5826,6 @@ defaults to `window-min-height'. Both MAX-HEIGHT and MIN-HEIGHT
are specified in lines and include the mode line and header line,
if any.
Optional argument OVERRIDE non-nil means override restrictions
imposed by `window-min-height' and `window-min-width' on the size
of WINDOW.
Return the number of lines by which WINDOW was enlarged or
shrunk. If an error occurs during resizing, return nil but don't
signal an error.
......@@ -5733,28 +5834,27 @@ Note that even if this function makes WINDOW large enough to show
_all_ lines of its buffer you might not see the first lines when
WINDOW was scrolled."
(interactive)
;; Do all the work in WINDOW and its buffer and restore the selected
;; window and the current buffer when we're done.
(setq window (window-normalize-window window t))
;; Can't resize a full height or fixed-size window.
(unless (or (window-size-fixed-p window)
(window-full-height-p window))
;; `with-selected-window' should orderly restore the current buffer.
(with-selected-window window
;; We are in WINDOW's buffer now.
(let* (;; Adjust MIN-HEIGHT.
(let* ((height (window-total-size))
(min-height
(if override
(window-min-size window nil window)
(max (or min-height window-min-height)
window-safe-min-height)))
(max-window-height
(window-total-size (frame-root-window window)))
;; Adjust MAX-HEIGHT.
;; Adjust MIN-HEIGHT.
(if (numberp min-height)
;; Can't get smaller than `window-safe-min-height'.
(max min-height window-safe-min-height)
;; Preserve header and mode line if present.
(window-min-size nil nil t)))
(max-height
(if (or override (not max-height))
max-window-height
(min max-height max-window-height)))
;; Adjust MAX-HEIGHT.
(if (numberp max-height)
;; Can't get larger than height of frame.
(min max-height
(window-total-size (frame-root-window window)))
;, Don't delete other windows.
(+ height (window-max-delta nil nil window))))
;; Make `desired-height' the height necessary to show
;; all of WINDOW's buffer, constrained by MIN-HEIGHT
;; and MAX-HEIGHT.
......@@ -5779,7 +5879,6 @@ WINDOW was scrolled."
(window-max-delta window nil window))
(max desired-delta
(- (window-min-delta window nil window))))))
;; This `condition-case' shouldn't be necessary, but who knows?
(condition-case nil
(if (zerop delta)
;; Return zero if DELTA became zero in the process.
......
2012-09-03 Martin Rudalics <rudalics@gmx.at>
* buffer.c (Fdelete_all_overlays): New function.
2012-09-03 Chong Yidong <cyd@gnu.org>
* gtkutil.c: Add extern decl for Qxft.
......
......@@ -4073,6 +4073,25 @@ DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
return unbind_to (count, Qnil);
}
DEFUN ("delete-all-overlays", Fdelete_all_overlays, Sdelete_all_overlays, 0, 1, 0,
doc: /* Delete all overlays of BUFFER.
BUFFER omitted or nil means delete all overlays of the current
buffer. */)
(Lisp_Object buffer)
{
register struct buffer *buf;
if (NILP (buffer))
buf = current_buffer;
else
{
CHECK_BUFFER (buffer);
buf = XBUFFER (buffer);
}
delete_all_overlays (buf);
}
/* Overlay dissection functions. */
......@@ -6286,6 +6305,7 @@ and `bury-buffer-internal'. */);
defsubr (&Soverlayp);
defsubr (&Smake_overlay);
defsubr (&Sdelete_overlay);
defsubr (&Sdelete_all_overlays);
defsubr (&Smove_overlay);
defsubr (&Soverlay_start);
defsubr (&Soverlay_end);
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment