* 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.
*** 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
(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)))
(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.
(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)
;; `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.")
: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'.
(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
(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
(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)))))
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.
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.
_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.
(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.
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);
+}
\f
/* Overlay dissection functions. */
defsubr (&Soverlayp);
defsubr (&Smake_overlay);
defsubr (&Sdelete_overlay);
+ defsubr (&Sdelete_all_overlays);
defsubr (&Smove_overlay);
defsubr (&Soverlay_start);
defsubr (&Soverlay_end);
projects / emacs.git / commitdiff