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.
This commit is contained in:
Martin Rudalics
parent
3eab3ca987
commit
c5e28e3927
8 changed files with 244 additions and 79 deletions
4
etc/NEWS
4
etc/NEWS
|
|
@ -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.
|
||||
|
||||
|
|
|
|||
|
|
@ -1,3 +1,20 @@
|
|||
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.
|
||||
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'.
|
||||
|
||||
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'.
|
||||
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)
|
||||
|
|
|
|||
40
lisp/help.el
40
lisp/help.el
|
|
@ -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
|
||||
|
|
|
|||
141
lisp/window.el
141
lisp/window.el
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -1,3 +1,7 @@
|
|||
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.
|
||||
|
|
|
|||
20
src/buffer.c
20
src/buffer.c
|
|
@ -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);
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue