mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-27 07:37:33 +00:00
e1a2cb1ce5
* dispnew.c (change_frame_size_1): Add new_lines instead of new_height, the latter may be still zero if passed as such. * window.c (Fwindow_pixel_height): Mention bottom divider in doc-string. * window.el (window-min-height, window-min-width): Rewrite doc-strings. (window-body-size): Add PIXELWISE argument to make it consistent with its callees. * display.texi (Window Dividers): New section. * frames.texi (Layout Parameters): Add right-divider-width and bottom-divider-width. * windows.texi (Window Sizes): Redraw schematic and rewrite its description. Rewrite descriptions of `window-total-height', `window-total-width', `window-total-size', `window-body-height', `window-body-width' and `window-size-fixed'. Add descriptions for `window-pixel-height', `window-pixel-width', `window-min-height' and `window-min-width'. Remove description of `window-size-fixed-p' moving part of it to that of `window-size-fixed'. (Resizing Windows): Mention dividers when talking about minimum sizes.
7758 lines
306 KiB
EmacsLisp
7758 lines
306 KiB
EmacsLisp
;;; window.el --- GNU Emacs window commands aside from those written in C
|
||
|
||
;; Copyright (C) 1985, 1989, 1992-1994, 2000-2014 Free Software
|
||
;; Foundation, Inc.
|
||
|
||
;; Maintainer: emacs-devel@gnu.org
|
||
;; Keywords: internal
|
||
;; Package: emacs
|
||
|
||
;; This file is part of GNU Emacs.
|
||
|
||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation, either version 3 of the License, or
|
||
;; (at your option) any later version.
|
||
|
||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||
|
||
;;; Commentary:
|
||
|
||
;; Window tree functions.
|
||
|
||
;;; Code:
|
||
|
||
(defun internal--before-save-selected-window ()
|
||
(cons (selected-window)
|
||
;; We save and restore all frames' selected windows, because
|
||
;; `select-window' can change the frame-selected-window of
|
||
;; whatever frame that window is in. Each text terminal's
|
||
;; top-frame is preserved by putting it last in the list.
|
||
(apply #'append
|
||
(mapcar (lambda (terminal)
|
||
(let ((frames (frames-on-display-list terminal))
|
||
(top-frame (tty-top-frame terminal))
|
||
alist)
|
||
(if top-frame
|
||
(setq frames
|
||
(cons top-frame
|
||
(delq top-frame frames))))
|
||
(dolist (f frames)
|
||
(push (cons f (frame-selected-window f))
|
||
alist))
|
||
alist))
|
||
(terminal-list)))))
|
||
|
||
(defun internal--after-save-selected-window (state)
|
||
(dolist (elt (cdr state))
|
||
(and (frame-live-p (car elt))
|
||
(window-live-p (cdr elt))
|
||
(set-frame-selected-window (car elt) (cdr elt) 'norecord)))
|
||
(when (window-live-p (car state))
|
||
(select-window (car state) 'norecord)))
|
||
|
||
(defmacro save-selected-window (&rest body)
|
||
"Execute BODY, then select the previously selected window.
|
||
The value returned is the value of the last form in BODY.
|
||
|
||
This macro saves and restores the selected window, as well as the
|
||
selected window in each frame. If the previously selected window
|
||
is no longer live, then whatever window is selected at the end of
|
||
BODY remains selected. If the previously selected window of some
|
||
frame is no longer live at the end of BODY, that frame's selected
|
||
window is left alone.
|
||
|
||
This macro saves and restores the current buffer, since otherwise
|
||
its normal operation could make a different buffer current. The
|
||
order of recently selected windows and the buffer list ordering
|
||
are not altered by this macro (unless they are altered in BODY)."
|
||
(declare (indent 0) (debug t))
|
||
`(let ((save-selected-window--state (internal--before-save-selected-window)))
|
||
(save-current-buffer
|
||
(unwind-protect
|
||
(progn ,@body)
|
||
(internal--after-save-selected-window save-selected-window--state)))))
|
||
|
||
(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 (let ((window-combination-limit
|
||
;; When `window-combination-limit' equals
|
||
;; `temp-buffer' or `temp-buffer-resize' and
|
||
;; `temp-buffer-resize-mode' is enabled in this
|
||
;; buffer bind it to t so resizing steals space
|
||
;; preferably from the window that was split.
|
||
(if (or (eq window-combination-limit 'temp-buffer)
|
||
(and (eq window-combination-limit
|
||
'temp-buffer-resize)
|
||
temp-buffer-resize-mode))
|
||
t
|
||
window-combination-limit)))
|
||
(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 in a buffer BUFFER-OR-NAME and show that buffer.
|
||
BUFFER-OR-NAME must specify either a live buffer, or the name of
|
||
a buffer (if it does not exist, this macro creates it).
|
||
|
||
Make the buffer specified by BUFFER-OR-NAME empty before running
|
||
BODY and make that buffer current for running the forms in BODY.
|
||
In addition, bind `standard-output' to that buffer, so that
|
||
output generated with `prin1' and similar functions in BODY goes
|
||
into that buffer.
|
||
|
||
At the end of BODY, mark the specified buffer unmodified and
|
||
read-only, and display it in a window (but do not select it).
|
||
The display happens by calling `display-buffer' passing it the
|
||
ACTION argument. If `temp-buffer-resize-mode' is enabled, the
|
||
corresponding window may shrink automatically.
|
||
|
||
Return the value returned by BODY, unless QUIT-FUNCTION specifies
|
||
a function. In that case, run that 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 QUIT-FUNCTION selects the window showing the buffer
|
||
before reading any value from the minibuffer; for example, when
|
||
asking a `yes-or-no-p' question.
|
||
|
||
This runs the hook `temp-buffer-window-setup-hook' before BODY,
|
||
with the specified buffer temporarily current. It runs the hook
|
||
`temp-buffer-window-show-hook' after displaying the buffer, with
|
||
that buffer temporarily current, and the window that was used to
|
||
display it temporarily selected.
|
||
|
||
This construct is similar to `with-output-to-temp-buffer' but,
|
||
unlike that, makes BUFFER-OR-NAME current when running BODY.
|
||
Also, it neither runs `temp-buffer-setup-hook' which usually puts
|
||
the buffer in Help mode, nor `temp-buffer-show-function' (the
|
||
ACTION argument replaces this)."
|
||
(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
|
||
;; nil when WINDOW doesn't have a parent (like a frame's root window or
|
||
;; a minibuffer window).
|
||
(defun window-right (window)
|
||
"Return WINDOW's right sibling.
|
||
Return nil if WINDOW is the root window of its frame. WINDOW can
|
||
be any window."
|
||
(and window (window-parent window) (window-next-sibling window)))
|
||
|
||
(defun window-left (window)
|
||
"Return WINDOW's left sibling.
|
||
Return nil if WINDOW is the root window of its frame. WINDOW can
|
||
be any window."
|
||
(and window (window-parent window) (window-prev-sibling window)))
|
||
|
||
(defun window-child (window)
|
||
"Return WINDOW's first child window.
|
||
WINDOW can be any window."
|
||
(or (window-top-child window) (window-left-child window)))
|
||
|
||
(defun window-child-count (window)
|
||
"Return number of WINDOW's child windows.
|
||
WINDOW can be any window."
|
||
(let ((count 0))
|
||
(when (and (windowp window) (setq window (window-child window)))
|
||
(while window
|
||
(setq count (1+ count))
|
||
(setq window (window-next-sibling window))))
|
||
count))
|
||
|
||
(defun window-last-child (window)
|
||
"Return last child window of WINDOW.
|
||
WINDOW can be any window."
|
||
(when (and (windowp window) (setq window (window-child window)))
|
||
(while (window-next-sibling window)
|
||
(setq window (window-next-sibling window))))
|
||
window)
|
||
|
||
(defun window-normalize-buffer (buffer-or-name)
|
||
"Return buffer specified by BUFFER-OR-NAME.
|
||
BUFFER-OR-NAME must be either a buffer or a string naming a live
|
||
buffer and defaults to the current buffer."
|
||
(cond
|
||
((not buffer-or-name)
|
||
(current-buffer))
|
||
((bufferp buffer-or-name)
|
||
(if (buffer-live-p buffer-or-name)
|
||
buffer-or-name
|
||
(error "Buffer %s is not a live buffer" buffer-or-name)))
|
||
((get-buffer buffer-or-name))
|
||
(t
|
||
(error "No such buffer %s" buffer-or-name))))
|
||
|
||
(defun window-normalize-frame (frame)
|
||
"Return frame specified by FRAME.
|
||
FRAME must be a live frame and defaults to the selected frame."
|
||
(if frame
|
||
(if (frame-live-p frame)
|
||
frame
|
||
(error "%s is not a live frame" frame))
|
||
(selected-frame)))
|
||
|
||
(defun window-normalize-window (window &optional live-only)
|
||
"Return the window specified by WINDOW.
|
||
If WINDOW is nil, return the selected window. Otherwise, if
|
||
WINDOW is a live or an internal window, return WINDOW; if
|
||
LIVE-ONLY is non-nil, return WINDOW for a live window only.
|
||
Otherwise, signal an error."
|
||
(cond
|
||
((null window)
|
||
(selected-window))
|
||
(live-only
|
||
(if (window-live-p window)
|
||
window
|
||
(error "%s is not a live window" window)))
|
||
((window-valid-p window)
|
||
window)
|
||
(t
|
||
(error "%s is not a valid window" window))))
|
||
|
||
;; Maybe this should go to frame.el.
|
||
(defun frame-char-size (&optional window-or-frame horizontal)
|
||
"Return the value of `frame-char-height' for WINDOW-OR-FRAME.
|
||
If WINDOW-OR-FRAME is a live frame, return the value of
|
||
`frame-char-height' for that frame. If WINDOW-OR-FRAME is a
|
||
valid window, return the value of `frame-char-height' for that
|
||
window's frame. In any other case, return the value of
|
||
`frame-char-height' for the selected frame.
|
||
|
||
Optional argument HORIZONTAL non-nil means to return the value of
|
||
`frame-char-width' for WINDOW-OR-FRAME."
|
||
(let ((frame
|
||
(cond
|
||
((window-valid-p window-or-frame)
|
||
(window-frame window-or-frame))
|
||
((frame-live-p window-or-frame)
|
||
window-or-frame)
|
||
(t (selected-frame)))))
|
||
(if horizontal
|
||
(frame-char-width frame)
|
||
(frame-char-height frame))))
|
||
|
||
(defvar ignore-window-parameters nil
|
||
"If non-nil, standard functions ignore window parameters.
|
||
The functions currently affected by this are `split-window',
|
||
`delete-window', `delete-other-windows' and `other-window'.
|
||
|
||
An application may bind this to a non-nil value around calls to
|
||
these functions to inhibit processing of window parameters.")
|
||
|
||
;; This must go to C, finally (or get removed).
|
||
(defconst window-safe-min-height 1
|
||
"The absolute minimum number of lines of any window.
|
||
Anything less might crash Emacs.")
|
||
|
||
(defun window-safe-min-pixel-height (&optional window)
|
||
"Return the absolute minimum pixel height of WINDOW."
|
||
(* window-safe-min-height
|
||
(frame-char-size (window-normalize-window window))))
|
||
|
||
(defcustom window-min-height 4
|
||
"The minimum total height, in lines, of any window.
|
||
The value has to accommodate one text line, a mode and header
|
||
line, and a bottom divider, if present. A value less than
|
||
`window-safe-min-height' is ignored. The value of this variable
|
||
is honored when windows are resized or split.
|
||
|
||
Applications should never rebind this variable. To resize a
|
||
window to a height less than the one specified here, an
|
||
application should instead call `window-resize' with a non-nil
|
||
IGNORE argument. In order to have `split-window' make a window
|
||
shorter, explicitly specify the SIZE argument of that function."
|
||
:type 'integer
|
||
:version "24.1"
|
||
:group 'windows)
|
||
|
||
(defun window-min-pixel-height (&optional window)
|
||
"Return the minimum pixel height of window WINDOW."
|
||
(* (max window-min-height window-safe-min-height)
|
||
(frame-char-size window)))
|
||
|
||
;; This must go to C, finally (or get removed).
|
||
(defconst window-safe-min-width 2
|
||
"The absolute minimum number of columns of a window.
|
||
Anything less might crash Emacs.")
|
||
|
||
(defun window-safe-min-pixel-width (&optional window)
|
||
"Return the absolute minimum pixel width of WINDOW."
|
||
(* window-safe-min-width
|
||
(frame-char-size (window-normalize-window window) t)))
|
||
|
||
(defcustom window-min-width 10
|
||
"The minimum total width, in columns, of any window.
|
||
The value has to accommodate two text columns as well as margins,
|
||
fringes, a scroll bar and a right divider, if present. A value
|
||
less than `window-safe-min-width' is ignored. The value of this
|
||
variable is honored when windows are resized or split.
|
||
|
||
Applications should never rebind this variable. To resize a
|
||
window to a width less than the one specified here, an
|
||
application should instead call `window-resize' with a non-nil
|
||
IGNORE argument. In order to have `split-window' make a window
|
||
narrower, explicitly specify the SIZE argument of that function."
|
||
:type 'integer
|
||
:version "24.1"
|
||
:group 'windows)
|
||
|
||
(defun window-min-pixel-width (&optional window)
|
||
"Return the minimum pixel width of window WINDOW."
|
||
(* (max window-min-width window-safe-min-width)
|
||
(frame-char-size window t)))
|
||
|
||
(defun window-safe-min-pixel-size (&optional window horizontal)
|
||
"Return the absolute minimum pixel height of WINDOW.
|
||
Optional argument HORIZONTAL non-nil means return the absolute
|
||
minimum pixel width of WINDOW."
|
||
(if horizontal
|
||
(window-safe-min-pixel-width window)
|
||
(window-safe-min-pixel-height window)))
|
||
|
||
(defun window-combined-p (&optional window horizontal)
|
||
"Return non-nil if WINDOW has siblings in a given direction.
|
||
WINDOW must be a valid window and defaults to the selected one.
|
||
|
||
HORIZONTAL determines a direction for the window combination. If
|
||
HORIZONTAL is omitted or nil, return non-nil if WINDOW is part of
|
||
a vertical window combination. If HORIZONTAL is non-nil, return
|
||
non-nil if WINDOW is part of a horizontal window combination."
|
||
(setq window (window-normalize-window window))
|
||
(let ((parent (window-parent window)))
|
||
(and parent
|
||
(if horizontal
|
||
(window-left-child parent)
|
||
(window-top-child parent)))))
|
||
|
||
(defun window-combination-p (&optional window horizontal)
|
||
"Return WINDOW's first child if WINDOW is a vertical combination.
|
||
WINDOW can be any window and defaults to the selected one.
|
||
Optional argument HORIZONTAL non-nil means return WINDOW's first
|
||
child if WINDOW is a horizontal combination."
|
||
(setq window (window-normalize-window window))
|
||
(if horizontal
|
||
(window-left-child window)
|
||
(window-top-child window)))
|
||
|
||
(defun window-combinations (window &optional horizontal)
|
||
"Return largest number of windows vertically arranged within WINDOW.
|
||
WINDOW must be a valid window and defaults to the selected one.
|
||
If HORIZONTAL is non-nil, return the largest number of
|
||
windows horizontally arranged within WINDOW."
|
||
(setq window (window-normalize-window window))
|
||
(cond
|
||
((window-live-p window)
|
||
;; If WINDOW is live, return 1.
|
||
1)
|
||
((if horizontal
|
||
(window-left-child window)
|
||
(window-top-child window))
|
||
;; If WINDOW is iso-combined, return the sum of the values for all
|
||
;; child windows of WINDOW.
|
||
(let ((child (window-child window))
|
||
(count 0))
|
||
(while child
|
||
(setq count
|
||
(+ (window-combinations child horizontal)
|
||
count))
|
||
(setq child (window-right child)))
|
||
count))
|
||
(t
|
||
;; If WINDOW is not iso-combined, return the maximum value of any
|
||
;; child window of WINDOW.
|
||
(let ((child (window-child window))
|
||
(count 1))
|
||
(while child
|
||
(setq count
|
||
(max (window-combinations child horizontal)
|
||
count))
|
||
(setq child (window-right child)))
|
||
count))))
|
||
|
||
(defun walk-window-tree-1 (fun walk-window-tree-window any &optional sub-only)
|
||
"Helper function for `walk-window-tree' and `walk-window-subtree'."
|
||
(let (walk-window-tree-buffer)
|
||
(while walk-window-tree-window
|
||
(setq walk-window-tree-buffer
|
||
(window-buffer walk-window-tree-window))
|
||
(when (or walk-window-tree-buffer any)
|
||
(funcall fun walk-window-tree-window))
|
||
(unless walk-window-tree-buffer
|
||
(walk-window-tree-1
|
||
fun (window-left-child walk-window-tree-window) any)
|
||
(walk-window-tree-1
|
||
fun (window-top-child walk-window-tree-window) any))
|
||
(if sub-only
|
||
(setq walk-window-tree-window nil)
|
||
(setq walk-window-tree-window
|
||
(window-right walk-window-tree-window))))))
|
||
|
||
(defun walk-window-tree (fun &optional frame any minibuf)
|
||
"Run function FUN on each live window of FRAME.
|
||
FUN must be a function with one argument - a window. FRAME must
|
||
be a live frame and defaults to the selected one. ANY, if
|
||
non-nil, means to run FUN on all live and internal windows of
|
||
FRAME.
|
||
|
||
Optional argument MINIBUF t means run FUN on FRAME's minibuffer
|
||
window even if it isn't active. MINIBUF nil or omitted means run
|
||
FUN on FRAME's minibuffer window only if it's active. In both
|
||
cases the minibuffer window must be part of FRAME. MINIBUF
|
||
neither nil nor t means never run FUN on the minibuffer window.
|
||
|
||
This function performs a pre-order, depth-first traversal of the
|
||
window tree. If FUN changes the window tree, the result is
|
||
unpredictable."
|
||
(setq frame (window-normalize-frame frame))
|
||
(walk-window-tree-1 fun (frame-root-window frame) any)
|
||
(when (memq minibuf '(nil t))
|
||
;; Run FUN on FRAME's minibuffer window if requested.
|
||
(let ((minibuffer-window (minibuffer-window frame)))
|
||
(when (and (window-live-p minibuffer-window)
|
||
(eq (window-frame minibuffer-window) frame)
|
||
(or (eq minibuf t)
|
||
(minibuffer-window-active-p minibuffer-window)))
|
||
(funcall fun minibuffer-window)))))
|
||
|
||
(defun walk-window-subtree (fun &optional window any)
|
||
"Run function FUN on the subtree of windows rooted at WINDOW.
|
||
WINDOW defaults to the selected window. FUN must be a function
|
||
with one argument - a window. By default, run FUN only on live
|
||
windows of the subtree. If the optional argument ANY is non-nil,
|
||
run FUN on all live and internal windows of the subtree. If
|
||
WINDOW is live, run FUN on WINDOW only.
|
||
|
||
This function performs a pre-order, depth-first traversal of the
|
||
subtree rooted at WINDOW. If FUN changes that tree, the result
|
||
is unpredictable."
|
||
(setq window (window-normalize-window window))
|
||
(walk-window-tree-1 fun window any t))
|
||
|
||
(defun window-with-parameter (parameter &optional value frame any minibuf)
|
||
"Return first window on FRAME with PARAMETER non-nil.
|
||
FRAME defaults to the selected frame. Optional argument VALUE
|
||
non-nil means only return a window whose window-parameter value
|
||
for PARAMETER equals VALUE (comparison is done with `equal').
|
||
Optional argument ANY non-nil means consider internal windows
|
||
too.
|
||
|
||
Optional argument MINIBUF t means consider FRAME's minibuffer
|
||
window even if it isn't active. MINIBUF nil or omitted means
|
||
consider FRAME's minibuffer window only if it's active. In both
|
||
cases the minibuffer window must be part of FRAME. MINIBUF
|
||
neither nil nor t means never consider the minibuffer window."
|
||
(let (this-value)
|
||
(catch 'found
|
||
(walk-window-tree
|
||
(lambda (window)
|
||
(when (and (setq this-value (window-parameter window parameter))
|
||
(or (not value) (equal value this-value)))
|
||
(throw 'found window)))
|
||
frame any minibuf))))
|
||
|
||
;;; Atomic windows.
|
||
(defun window-atom-root (&optional window)
|
||
"Return root of atomic window WINDOW is a part of.
|
||
WINDOW must be a valid window and defaults to the selected one.
|
||
Return nil if WINDOW is not part of an atomic window."
|
||
(setq window (window-normalize-window window))
|
||
(let (root)
|
||
(while (and window (window-parameter window 'window-atom))
|
||
(setq root window)
|
||
(setq window (window-parent window)))
|
||
root))
|
||
|
||
(defun window-make-atom (window)
|
||
"Make WINDOW an atomic window.
|
||
WINDOW must be an internal window. Return WINDOW."
|
||
(if (not (window-child window))
|
||
(error "Window %s is not an internal window" window)
|
||
(walk-window-subtree
|
||
(lambda (window)
|
||
(unless (window-parameter window 'window-atom)
|
||
(set-window-parameter window 'window-atom t)))
|
||
window t)
|
||
window))
|
||
|
||
(defun display-buffer-in-atom-window (buffer alist)
|
||
"Display BUFFER in an atomic window.
|
||
This function displays BUFFER in a new window that will be
|
||
combined with an existing window to form an atomic window. If
|
||
the existing window is already part of an atomic window, add the
|
||
new window to that atomic window. Operations like `split-window'
|
||
or `delete-window', when applied to a constituent of an atomic
|
||
window, are applied atomically to the root of that atomic window.
|
||
|
||
ALIST is an association list of symbols and values. The
|
||
following symbols can be used.
|
||
|
||
`window' specifies the existing window the new window shall be
|
||
combined with. Use `window-atom-root' to make the new window a
|
||
sibling of an atomic window's root. If an internal window is
|
||
specified here, all children of that window become part of the
|
||
atomic window too. If no window is specified, the new window
|
||
becomes a sibling of the selected window. By default, the
|
||
`window-atom' parameter of the existing window is set to `main'
|
||
provided it is live and was not set before.
|
||
|
||
`side' denotes the side of the existing window where the new
|
||
window shall be located. Valid values are `below', `right',
|
||
`above' and `left'. The default is `below'. By default, the
|
||
`window-atom' parameter of the new window is set to this value.
|
||
|
||
The return value is the new window, nil when creating that window
|
||
failed."
|
||
(let* ((ignore-window-parameters t)
|
||
(window-combination-limit t)
|
||
(window-combination-resize 'atom)
|
||
(window (cdr (assq 'window alist)))
|
||
(side (cdr (assq 'side alist)))
|
||
(atom (when window (window-parameter window 'window-atom)))
|
||
root new)
|
||
(setq window (window-normalize-window window))
|
||
(setq root (window-atom-root window))
|
||
;; Split off new window.
|
||
(when (setq new (split-window window nil side))
|
||
(window-make-atom
|
||
(if (and root (not (eq root window)))
|
||
;; When WINDOW was part of an atomic window and we did not
|
||
;; split its root, root atomic window at old root.
|
||
root
|
||
;; Otherwise, root atomic window at WINDOW's new parent.
|
||
(window-parent window)))
|
||
;; Assign `window-atom' parameters, if needed.
|
||
(when (and (not atom) (window-live-p window))
|
||
(set-window-parameter window 'window-atom 'main))
|
||
(set-window-parameter new 'window-atom side)
|
||
;; Display BUFFER in NEW and return NEW.
|
||
(window--display-buffer
|
||
buffer new 'window alist display-buffer-mark-dedicated))))
|
||
|
||
(defun window--atom-check-1 (window)
|
||
"Subroutine of `window--atom-check'."
|
||
(when window
|
||
(if (window-parameter window 'window-atom)
|
||
(let ((count 0))
|
||
(when (or (catch 'reset
|
||
(walk-window-subtree
|
||
(lambda (window)
|
||
(if (window-parameter window 'window-atom)
|
||
(setq count (1+ count))
|
||
(throw 'reset t)))
|
||
window t))
|
||
;; count >= 1 must hold here. If there's no other
|
||
;; window around dissolve this atomic window.
|
||
(= count 1))
|
||
;; Dissolve atomic window.
|
||
(walk-window-subtree
|
||
(lambda (window)
|
||
(set-window-parameter window 'window-atom nil))
|
||
window t)))
|
||
;; Check children.
|
||
(unless (window-buffer window)
|
||
(window--atom-check-1 (window-left-child window))
|
||
(window--atom-check-1 (window-top-child window))))
|
||
;; Check right sibling
|
||
(window--atom-check-1 (window-right window))))
|
||
|
||
(defun window--atom-check (&optional frame)
|
||
"Check atomicity of all windows on FRAME.
|
||
FRAME defaults to the selected frame. If an atomic window is
|
||
wrongly configured, reset the atomicity of all its windows on
|
||
FRAME to nil. An atomic window is wrongly configured if it has
|
||
no child windows or one of its child windows is not atomic."
|
||
(window--atom-check-1 (frame-root-window frame)))
|
||
|
||
;; Side windows.
|
||
(defvar window-sides '(left top right bottom)
|
||
"Window sides.")
|
||
|
||
(defcustom window-sides-vertical nil
|
||
"If non-nil, left and right side windows are full height.
|
||
Otherwise, top and bottom side windows are full width."
|
||
:type 'boolean
|
||
:group 'windows
|
||
:version "24.1")
|
||
|
||
(defcustom window-sides-slots '(nil nil nil nil)
|
||
"Maximum number of side window slots.
|
||
The value is a list of four elements specifying the number of
|
||
side window slots on (in this order) the left, top, right and
|
||
bottom side of each frame. If an element is a number, this means
|
||
to display at most that many side windows on the corresponding
|
||
side. If an element is nil, this means there's no bound on the
|
||
number of slots on that side."
|
||
:version "24.1"
|
||
:risky t
|
||
:type
|
||
'(list
|
||
:value (nil nil nil nil)
|
||
(choice
|
||
:tag "Left"
|
||
:help-echo "Maximum slots of left side window."
|
||
:value nil
|
||
:format "%[Left%] %v\n"
|
||
(const :tag "Unlimited" :format "%t" nil)
|
||
(integer :tag "Number" :value 2 :size 5))
|
||
(choice
|
||
:tag "Top"
|
||
:help-echo "Maximum slots of top side window."
|
||
:value nil
|
||
:format "%[Top%] %v\n"
|
||
(const :tag "Unlimited" :format "%t" nil)
|
||
(integer :tag "Number" :value 3 :size 5))
|
||
(choice
|
||
:tag "Right"
|
||
:help-echo "Maximum slots of right side window."
|
||
:value nil
|
||
:format "%[Right%] %v\n"
|
||
(const :tag "Unlimited" :format "%t" nil)
|
||
(integer :tag "Number" :value 2 :size 5))
|
||
(choice
|
||
:tag "Bottom"
|
||
:help-echo "Maximum slots of bottom side window."
|
||
:value nil
|
||
:format "%[Bottom%] %v\n"
|
||
(const :tag "Unlimited" :format "%t" nil)
|
||
(integer :tag "Number" :value 3 :size 5)))
|
||
:group 'windows)
|
||
|
||
(defun window--major-non-side-window (&optional frame)
|
||
"Return the major non-side window of frame FRAME.
|
||
The optional argument FRAME must be a live frame and defaults to
|
||
the selected one.
|
||
|
||
If FRAME has at least one side window, the major non-side window
|
||
is either an internal non-side window such that all other
|
||
non-side windows on FRAME descend from it, or the single live
|
||
non-side window of FRAME. If FRAME has no side windows, return
|
||
its root window."
|
||
(let ((frame (window-normalize-frame frame))
|
||
major sibling)
|
||
;; Set major to the _last_ window found by `walk-window-tree' that
|
||
;; is not a side window but has a side window as its sibling.
|
||
(walk-window-tree
|
||
(lambda (window)
|
||
(and (not (window-parameter window 'window-side))
|
||
(or (and (setq sibling (window-prev-sibling window))
|
||
(window-parameter sibling 'window-side))
|
||
(and (setq sibling (window-next-sibling window))
|
||
(window-parameter sibling 'window-side)))
|
||
(setq major window)))
|
||
frame t 'nomini)
|
||
(or major (frame-root-window frame))))
|
||
|
||
(defun window--major-side-window (side)
|
||
"Return major side window on SIDE.
|
||
SIDE must be one of the symbols `left', `top', `right' or
|
||
`bottom'. Return nil if no such window exists."
|
||
(let ((root (frame-root-window))
|
||
window)
|
||
;; (1) If a window on the opposite side exists, return that window's
|
||
;; sibling.
|
||
;; (2) If the new window shall span the entire side, return the
|
||
;; frame's root window.
|
||
;; (3) If a window on an orthogonal side exists, return that
|
||
;; window's sibling.
|
||
;; (4) Otherwise return the frame's root window.
|
||
(cond
|
||
((or (and (eq side 'left)
|
||
(setq window (window-with-parameter 'window-side 'right nil t)))
|
||
(and (eq side 'top)
|
||
(setq window (window-with-parameter 'window-side 'bottom nil t))))
|
||
(window-prev-sibling window))
|
||
((or (and (eq side 'right)
|
||
(setq window (window-with-parameter 'window-side 'left nil t)))
|
||
(and (eq side 'bottom)
|
||
(setq window (window-with-parameter 'window-side 'top nil t))))
|
||
(window-next-sibling window))
|
||
((memq side '(left right))
|
||
(cond
|
||
(window-sides-vertical
|
||
root)
|
||
((setq window (window-with-parameter 'window-side 'top nil t))
|
||
(window-next-sibling window))
|
||
((setq window (window-with-parameter 'window-side 'bottom nil t))
|
||
(window-prev-sibling window))
|
||
(t root)))
|
||
((memq side '(top bottom))
|
||
(cond
|
||
((not window-sides-vertical)
|
||
root)
|
||
((setq window (window-with-parameter 'window-side 'left nil t))
|
||
(window-next-sibling window))
|
||
((setq window (window-with-parameter 'window-side 'right nil t))
|
||
(window-prev-sibling window))
|
||
(t root))))))
|
||
|
||
(defun display-buffer-in-major-side-window (buffer side slot &optional alist)
|
||
"Display BUFFER in a new window on SIDE of the selected frame.
|
||
SIDE must be one of `left', `top', `right' or `bottom'. SLOT
|
||
specifies the slot to use. ALIST is an association list of
|
||
symbols and values as passed to `display-buffer-in-side-window'.
|
||
This function may be called only if no window on SIDE exists yet.
|
||
The new window automatically becomes the \"major\" side window on
|
||
SIDE. Return the new window, nil if its creation window failed."
|
||
(let* ((left-or-right (memq side '(left right)))
|
||
(major (window--major-side-window side))
|
||
(on-side (cond
|
||
((eq side 'top) 'above)
|
||
((eq side 'bottom) 'below)
|
||
(t side)))
|
||
;; The following two bindings will tell `split-window' to take
|
||
;; the space for the new window from `major' and not make a new
|
||
;; parent window unless needed.
|
||
(window-combination-resize 'side)
|
||
(window-combination-limit nil)
|
||
(new (split-window major nil on-side)))
|
||
(when new
|
||
;; Initialize `window-side' parameter of new window to SIDE.
|
||
(set-window-parameter new 'window-side side)
|
||
;; Install `window-slot' parameter of new window.
|
||
(set-window-parameter new 'window-slot slot)
|
||
;; Install `delete-window' parameter thus making sure that when
|
||
;; the new window is deleted, a side window on the opposite side
|
||
;; does not get resized.
|
||
(set-window-parameter new 'delete-window 'delete-side-window)
|
||
;; Auto-adjust height/width of new window unless a size has been
|
||
;; explicitly requested.
|
||
(unless (if left-or-right
|
||
(cdr (assq 'window-width alist))
|
||
(cdr (assq 'window-height alist)))
|
||
(setq alist
|
||
(cons
|
||
(cons
|
||
(if left-or-right 'window-width 'window-height)
|
||
(/ (window-total-size (frame-root-window) left-or-right)
|
||
;; By default use a fourth of the size of the frame's
|
||
;; root window.
|
||
4))
|
||
alist)))
|
||
;; Install BUFFER in new window and return NEW.
|
||
(window--display-buffer buffer new 'window alist 'side))))
|
||
|
||
(defun delete-side-window (window)
|
||
"Delete side window WINDOW."
|
||
(let ((window-combination-resize
|
||
(window-parameter (window-parent window) 'window-side))
|
||
(ignore-window-parameters t))
|
||
(delete-window window)))
|
||
|
||
(defun display-buffer-in-side-window (buffer alist)
|
||
"Display BUFFER in a side window of the selected frame.
|
||
ALIST is an association list of symbols and values. The
|
||
following special symbols can be used in ALIST.
|
||
|
||
`side' denotes the side of the frame where the new window shall
|
||
be located. Valid values are `bottom', `right', `top' and
|
||
`left'. The default is `bottom'.
|
||
|
||
`slot' if non-nil, specifies the window slot where to display
|
||
BUFFER. A value of zero or nil means use the middle slot on
|
||
the specified side. A negative value means use a slot
|
||
preceding (that is, above or on the left of) the middle slot.
|
||
A positive value means use a slot following (that is, below or
|
||
on the right of) the middle slot. The default is zero."
|
||
(let ((side (or (cdr (assq 'side alist)) 'bottom))
|
||
(slot (or (cdr (assq 'slot alist)) 0)))
|
||
(cond
|
||
((not (memq side '(top bottom left right)))
|
||
(error "Invalid side %s specified" side))
|
||
((not (numberp slot))
|
||
(error "Invalid slot %s specified" slot)))
|
||
|
||
(let* ((major (window-with-parameter 'window-side side nil t))
|
||
;; `major' is the major window on SIDE, `windows' the list of
|
||
;; life windows on SIDE.
|
||
(windows
|
||
(when major
|
||
(let (windows)
|
||
(walk-window-tree
|
||
(lambda (window)
|
||
(when (eq (window-parameter window 'window-side) side)
|
||
(setq windows (cons window windows))))
|
||
nil nil 'nomini)
|
||
(nreverse windows))))
|
||
(slots (when major (max 1 (window-child-count major))))
|
||
(max-slots
|
||
(nth (cond
|
||
((eq side 'left) 0)
|
||
((eq side 'top) 1)
|
||
((eq side 'right) 2)
|
||
((eq side 'bottom) 3))
|
||
window-sides-slots))
|
||
window this-window this-slot prev-window next-window
|
||
best-window best-slot abs-slot)
|
||
|
||
(cond
|
||
((and (numberp max-slots) (<= max-slots 0))
|
||
;; No side-slots available on this side. Don't create an error,
|
||
;; just return nil.
|
||
nil)
|
||
((not windows)
|
||
;; No major window exists on this side, make one.
|
||
(display-buffer-in-major-side-window buffer side slot alist))
|
||
(t
|
||
;; Scan windows on SIDE.
|
||
(catch 'found
|
||
(dolist (window windows)
|
||
(setq this-slot (window-parameter window 'window-slot))
|
||
(cond
|
||
;; The following should not happen and probably be checked
|
||
;; by window--side-check.
|
||
((not (numberp this-slot)))
|
||
((= this-slot slot)
|
||
;; A window with a matching slot has been found.
|
||
(setq this-window window)
|
||
(throw 'found t))
|
||
(t
|
||
;; Check if this window has a better slot value wrt the
|
||
;; slot of the window we want.
|
||
(setq abs-slot
|
||
(if (or (and (> this-slot 0) (> slot 0))
|
||
(and (< this-slot 0) (< slot 0)))
|
||
(abs (- slot this-slot))
|
||
(+ (abs slot) (abs this-slot))))
|
||
(unless (and best-slot (<= best-slot abs-slot))
|
||
(setq best-window window)
|
||
(setq best-slot abs-slot))
|
||
(cond
|
||
((<= this-slot slot)
|
||
(setq prev-window window))
|
||
((not next-window)
|
||
(setq next-window window)))))))
|
||
|
||
;; `this-window' is the first window with the same SLOT.
|
||
;; `prev-window' is the window with the largest slot < SLOT. A new
|
||
;; window will be created after it.
|
||
;; `next-window' is the window with the smallest slot > SLOT. A new
|
||
;; window will be created before it.
|
||
;; `best-window' is the window with the smallest absolute difference
|
||
;; of its slot and SLOT.
|
||
|
||
;; Note: We dedicate the window used softly to its buffer to
|
||
;; avoid that "other" (non-side) buffer display functions steal
|
||
;; it from us. This must eventually become customizable via
|
||
;; ALIST (or, better, avoided in the "other" functions).
|
||
(or (and this-window
|
||
;; Reuse `this-window'.
|
||
(window--display-buffer buffer this-window 'reuse alist 'side))
|
||
(and (or (not max-slots) (< slots max-slots))
|
||
(or (and next-window
|
||
;; Make new window before `next-window'.
|
||
(let ((next-side
|
||
(if (memq side '(left right)) 'above 'left))
|
||
(window-combination-resize 'side))
|
||
(setq window (split-window next-window nil next-side))
|
||
;; When the new window is deleted, its space
|
||
;; is returned to other side windows.
|
||
(set-window-parameter
|
||
window 'delete-window 'delete-side-window)
|
||
window))
|
||
(and prev-window
|
||
;; Make new window after `prev-window'.
|
||
(let ((prev-side
|
||
(if (memq side '(left right)) 'below 'right))
|
||
(window-combination-resize 'side))
|
||
(setq window (split-window prev-window nil prev-side))
|
||
;; When the new window is deleted, its space
|
||
;; is returned to other side windows.
|
||
(set-window-parameter
|
||
window 'delete-window 'delete-side-window)
|
||
window)))
|
||
(set-window-parameter window 'window-slot slot)
|
||
(window--display-buffer buffer window 'window alist 'side))
|
||
(and best-window
|
||
;; Reuse `best-window'.
|
||
(progn
|
||
;; Give best-window the new slot value.
|
||
(set-window-parameter best-window 'window-slot slot)
|
||
(window--display-buffer
|
||
buffer best-window 'reuse alist 'side)))))))))
|
||
|
||
(defun window--side-check (&optional frame)
|
||
"Check the side window configuration of FRAME.
|
||
FRAME defaults to the selected frame.
|
||
|
||
A valid side window configuration preserves the following two
|
||
invariants:
|
||
|
||
- If there exists a window whose window-side parameter is
|
||
non-nil, there must exist at least one live window whose
|
||
window-side parameter is nil.
|
||
|
||
- If a window W has a non-nil window-side parameter (i) it must
|
||
have a parent window and that parent's window-side parameter
|
||
must be either nil or the same as for W, and (ii) any child
|
||
window of W must have the same window-side parameter as W.
|
||
|
||
If the configuration is invalid, reset the window-side parameters
|
||
of all windows on FRAME to nil."
|
||
(let (left top right bottom none side parent parent-side)
|
||
(when (or (catch 'reset
|
||
(walk-window-tree
|
||
(lambda (window)
|
||
(setq side (window-parameter window 'window-side))
|
||
(setq parent (window-parent window))
|
||
(setq parent-side
|
||
(and parent (window-parameter parent 'window-side)))
|
||
;; The following `cond' seems a bit tedious, but I'd
|
||
;; rather stick to using just the stack.
|
||
(cond
|
||
(parent-side
|
||
(when (not (eq parent-side side))
|
||
;; A parent whose window-side is non-nil must
|
||
;; have a child with the same window-side.
|
||
(throw 'reset t)))
|
||
((not side)
|
||
(when (window-buffer window)
|
||
;; Record that we have at least one non-side,
|
||
;; live window.
|
||
(setq none t)))
|
||
((if (memq side '(left top))
|
||
(window-prev-sibling window)
|
||
(window-next-sibling window))
|
||
;; Left and top major side windows must not have a
|
||
;; previous sibling, right and bottom major side
|
||
;; windows must not have a next sibling.
|
||
(throw 'reset t))
|
||
;; Now check that there's no more than one major
|
||
;; window for any of left, top, right and bottom.
|
||
((eq side 'left)
|
||
(if left (throw 'reset t) (setq left t)))
|
||
((eq side 'top)
|
||
(if top (throw 'reset t) (setq top t)))
|
||
((eq side 'right)
|
||
(if right (throw 'reset t) (setq right t)))
|
||
((eq side 'bottom)
|
||
(if bottom (throw 'reset t) (setq bottom t)))
|
||
(t
|
||
(throw 'reset t))))
|
||
frame t 'nomini))
|
||
;; If there's a side window, there must be at least one
|
||
;; non-side window.
|
||
(and (or left top right bottom) (not none)))
|
||
(walk-window-tree
|
||
(lambda (window)
|
||
(set-window-parameter window 'window-side nil))
|
||
frame t 'nomini))))
|
||
|
||
(defun window--check (&optional frame)
|
||
"Check atomic and side windows on FRAME.
|
||
FRAME defaults to the selected frame."
|
||
(window--side-check frame)
|
||
(window--atom-check frame))
|
||
|
||
;; Dumping frame/window contents.
|
||
(defun window--dump-window (&optional window erase)
|
||
"Dump WINDOW to buffer *window-frame-dump*.
|
||
WINDOW must be a valid window and defaults to the selected one.
|
||
Optional argument ERASE non-nil means erase *window-frame-dump*
|
||
before writing to it."
|
||
(setq window (window-normalize-window window))
|
||
(with-current-buffer (get-buffer-create "*window-frame-dump*")
|
||
(when erase (erase-buffer))
|
||
(insert
|
||
(format "%s parent: %s\n" window (window-parent window))
|
||
(format "pixel left: %s top: %s size: %s x %s new: %s\n"
|
||
(window-pixel-left window) (window-pixel-top window)
|
||
(window-size window t t) (window-size window nil t)
|
||
(window-new-pixel window))
|
||
(format "char left: %s top: %s size: %s x %s new: %s\n"
|
||
(window-left-column window) (window-top-line window)
|
||
(window-total-size window t) (window-total-size window)
|
||
(window-new-total window))
|
||
(format "normal: %s x %s new: %s\n"
|
||
(window-normal-size window t) (window-normal-size window)
|
||
(window-new-normal window)))
|
||
(when (window-live-p window)
|
||
(let ((fringes (window-fringes window))
|
||
(margins (window-margins window)))
|
||
(insert
|
||
(format "body pixel: %s x %s char: %s x %s\n"
|
||
(window-body-width window t) (window-body-height window t)
|
||
(window-body-width window) (window-body-height window))
|
||
(format "width left fringe: %s left margin: %s right margin: %s\n"
|
||
(car fringes) (or (car margins) 0) (or (cdr margins) 0))
|
||
(format "width right fringe: %s scroll-bar: %s divider: %s\n"
|
||
(cadr fringes)
|
||
(window-scroll-bar-width window)
|
||
(window-right-divider-width window))
|
||
(format "height header-line: %s mode-line: %s divider: %s\n"
|
||
(window-header-line-height window)
|
||
(window-mode-line-height window)
|
||
(window-bottom-divider-width window)))))
|
||
(insert "\n")))
|
||
|
||
(defun window--dump-frame (&optional window-or-frame)
|
||
"Dump WINDOW-OR-FRAME to buffer *window-frame-dump*.
|
||
WINDOW-OR-FRAME can be a frame or a window and defaults to the
|
||
selected frame. When WINDOW-OR-FRAME is a window, dump that
|
||
window's frame. The buffer *window-frame-dump* is erased before
|
||
dumping to it."
|
||
(interactive)
|
||
(let* ((window
|
||
(cond
|
||
((or (not window-or-frame)
|
||
(frame-live-p window-or-frame))
|
||
(frame-root-window window-or-frame))
|
||
((or (window-live-p window-or-frame)
|
||
(window-child window-or-frame))
|
||
window-or-frame)
|
||
(t
|
||
(frame-root-window))))
|
||
(frame (window-frame window)))
|
||
(with-current-buffer (get-buffer-create "*window-frame-dump*")
|
||
(erase-buffer)
|
||
(insert
|
||
(format "frame pixel: %s x %s cols/lines: %s x %s units: %s x %s\n"
|
||
(frame-pixel-width frame) (frame-pixel-height frame)
|
||
(frame-total-cols frame) (frame-text-lines frame) ; (frame-total-lines frame)
|
||
(frame-char-width frame) (frame-char-height frame))
|
||
(format "frame text pixel: %s x %s cols/lines: %s x %s\n"
|
||
(frame-text-width frame) (frame-text-height frame)
|
||
(frame-text-cols frame) (frame-text-lines frame))
|
||
(format "tool: %s scroll: %s fringe: %s border: %s right: %s bottom: %s\n\n"
|
||
(tool-bar-height frame t)
|
||
(frame-scroll-bar-width frame)
|
||
(frame-fringe-width frame)
|
||
(frame-border-width frame)
|
||
(frame-right-divider-width frame)
|
||
(frame-bottom-divider-width frame)))
|
||
(walk-window-tree 'window--dump-window frame t t))))
|
||
|
||
;;; Window sizes.
|
||
(defun window-total-size (&optional window horizontal round)
|
||
"Return the total height or width of WINDOW.
|
||
WINDOW must be a valid window and defaults to the selected one.
|
||
|
||
If HORIZONTAL is omitted or nil, return the total height of
|
||
WINDOW, in lines, like `window-total-height'. Otherwise return
|
||
the total width, in columns, like `window-total-width'.
|
||
|
||
Optional argument ROUND is handled as for `window-total-height'
|
||
and `window-total-width'."
|
||
(if horizontal
|
||
(window-total-width window round)
|
||
(window-total-height window round)))
|
||
|
||
(defun window-size (&optional window horizontal pixelwise round)
|
||
"Return the height or width of WINDOW.
|
||
WINDOW must be a valid window and defaults to the selected one.
|
||
|
||
If HORIZONTAL is omitted or nil, return the total height of
|
||
WINDOW, in lines, like `window-total-height'. Otherwise return
|
||
the total width, in columns, like `window-total-width'.
|
||
|
||
Optional argument PIXELWISE means return the pixel size of WINDOW
|
||
like `window-pixel-height' and `window-pixel-width'.
|
||
|
||
Optional argument ROUND is ignored if PIXELWISE is non-nil and
|
||
handled as for `window-total-height' and `window-total-width'
|
||
otherwise."
|
||
(if horizontal
|
||
(if pixelwise
|
||
(window-pixel-width window)
|
||
(window-total-width window round))
|
||
(if pixelwise
|
||
(window-pixel-height window)
|
||
(window-total-height window round))))
|
||
|
||
(defvar window-size-fixed nil
|
||
"Non-nil in a buffer means windows displaying the buffer are fixed-size.
|
||
If the value is `height', then only the window's height is fixed.
|
||
If the value is `width', then only the window's width is fixed.
|
||
Any other non-nil value fixes both the width and the height.
|
||
|
||
Emacs won't change the size of any window displaying that buffer,
|
||
unless it has no other choice (like when deleting a neighboring
|
||
window).")
|
||
(make-variable-buffer-local 'window-size-fixed)
|
||
|
||
(defun window--size-ignore-p (window ignore)
|
||
"Return non-nil if IGNORE says to ignore size restrictions for WINDOW."
|
||
(if (window-valid-p ignore) (eq window ignore) ignore))
|
||
|
||
(defun window-safe-min-size (&optional window horizontal pixelwise)
|
||
"Return safe minimum size of WINDOW.
|
||
WINDOW must be a valid window and defaults to the selected one.
|
||
Optional argument HORIZONTAL non-nil means return the minimum
|
||
number of columns of WINDOW; otherwise return the minimum number
|
||
of WINDOW's lines.
|
||
|
||
Optional argument PIXELWISE non-nil means return the minimum pixel-size
|
||
of WINDOW."
|
||
(setq window (window-normalize-window window))
|
||
(if pixelwise
|
||
(if horizontal
|
||
(* window-safe-min-width
|
||
(frame-char-width (window-frame window)))
|
||
(* window-safe-min-height
|
||
(frame-char-height (window-frame window))))
|
||
(if horizontal window-safe-min-width window-safe-min-height)))
|
||
|
||
(defun window-min-size (&optional window horizontal ignore pixelwise)
|
||
"Return the minimum size of WINDOW.
|
||
WINDOW must be a valid window and defaults to the selected one.
|
||
Optional argument HORIZONTAL non-nil means return the minimum
|
||
number of columns of WINDOW; otherwise return the minimum number
|
||
of WINDOW's lines.
|
||
|
||
Optional argument IGNORE, if non-nil, means ignore restrictions
|
||
imposed by fixed size windows, `window-min-height' or
|
||
`window-min-width' settings. If IGNORE equals `safe', live
|
||
windows may get as small as `window-safe-min-height' lines and
|
||
`window-safe-min-width' columns. If IGNORE is a window, ignore
|
||
restrictions for that window only. Any other non-nil value
|
||
means ignore all of the above restrictions for all windows.
|
||
|
||
Optional argument PIXELWISE non-nil means return the minimum pixel-size
|
||
of WINDOW."
|
||
(window--min-size-1
|
||
(window-normalize-window window) horizontal ignore pixelwise))
|
||
|
||
(defun window--min-size-1 (window horizontal ignore pixelwise)
|
||
"Internal function of `window-min-size'."
|
||
(let ((sub (window-child window)))
|
||
(if sub
|
||
(let ((value 0))
|
||
;; WINDOW is an internal window.
|
||
(if (window-combined-p sub horizontal)
|
||
;; The minimum size of an iso-combination is the sum of
|
||
;; the minimum sizes of its child windows.
|
||
(while sub
|
||
(setq value (+ value
|
||
(window--min-size-1
|
||
sub horizontal ignore pixelwise)))
|
||
(setq sub (window-right sub)))
|
||
;; The minimum size of an ortho-combination is the maximum
|
||
;; of the minimum sizes of its child windows.
|
||
(while sub
|
||
(setq value (max value
|
||
(window--min-size-1
|
||
sub horizontal ignore pixelwise)))
|
||
(setq sub (window-right sub))))
|
||
value)
|
||
(with-current-buffer (window-buffer window)
|
||
(cond
|
||
((and (not (window--size-ignore-p window ignore))
|
||
(window-size-fixed-p window horizontal))
|
||
;; The minimum size of a fixed size window is its size.
|
||
(window-size window horizontal pixelwise))
|
||
((or (eq ignore 'safe) (eq ignore window))
|
||
;; If IGNORE equals `safe' or WINDOW return the safe values.
|
||
(window-safe-min-size window horizontal pixelwise))
|
||
(horizontal
|
||
;; For the minimum width of a window take fringes and
|
||
;; scroll-bars into account. This is questionable and should
|
||
;; be removed as soon as we are able to split (and resize)
|
||
;; windows such that the new (or resized) windows can get a
|
||
;; size less than the user-specified `window-min-height' and
|
||
;; `window-min-width'.
|
||
(let* ((char-size (frame-char-size window t))
|
||
(fringes (window-fringes window))
|
||
(pixel-width
|
||
(+ (window-safe-min-size window t t)
|
||
(car fringes) (cadr fringes)
|
||
(window-scroll-bar-width window)
|
||
(window-right-divider-width window))))
|
||
(if pixelwise
|
||
(max
|
||
(if window-resize-pixelwise
|
||
pixel-width
|
||
;; Round up to next integral of columns.
|
||
(* (ceiling pixel-width char-size) char-size))
|
||
(if (window--size-ignore-p window ignore)
|
||
0
|
||
(window-min-pixel-width)))
|
||
(max
|
||
(ceiling pixel-width char-size)
|
||
(if (window--size-ignore-p window ignore)
|
||
0
|
||
window-min-width)))))
|
||
((let ((char-size (frame-char-size window))
|
||
(pixel-height
|
||
(+ (window-safe-min-size window nil t)
|
||
(window-header-line-height window)
|
||
(window-mode-line-height window)
|
||
(window-bottom-divider-width window))))
|
||
(if pixelwise
|
||
(max
|
||
(if window-resize-pixelwise
|
||
pixel-height
|
||
;; Round up to next integral of lines.
|
||
(* (ceiling pixel-height char-size) char-size))
|
||
(if (window--size-ignore-p window ignore)
|
||
0
|
||
(window-min-pixel-height)))
|
||
(max (ceiling pixel-height char-size)
|
||
(if (window--size-ignore-p window ignore)
|
||
0
|
||
window-min-height))))))))))
|
||
|
||
(defun window-sizable (window delta &optional horizontal ignore pixelwise)
|
||
"Return DELTA if DELTA lines can be added to WINDOW.
|
||
WINDOW must be a valid window and defaults to the selected one.
|
||
Optional argument HORIZONTAL non-nil means return DELTA if DELTA
|
||
columns can be added to WINDOW. A return value of zero means
|
||
that no lines (or columns) can be added to WINDOW.
|
||
|
||
This function looks only at WINDOW and, recursively, its child
|
||
windows. The function `window-resizable' looks at other windows
|
||
as well.
|
||
|
||
DELTA positive means WINDOW shall be enlarged by DELTA lines or
|
||
columns. If WINDOW cannot be enlarged by DELTA lines or columns
|
||
return the maximum value in the range 0..DELTA by which WINDOW
|
||
can be enlarged.
|
||
|
||
DELTA negative means WINDOW shall be shrunk by -DELTA lines or
|
||
columns. If WINDOW cannot be shrunk by -DELTA lines or columns,
|
||
return the minimum value in the range DELTA..0 by which WINDOW
|
||
can be shrunk.
|
||
|
||
Optional argument IGNORE non-nil means ignore restrictions
|
||
imposed by fixed size windows, `window-min-height' or
|
||
`window-min-width' settings. If IGNORE equals `safe', live
|
||
windows may get as small as `window-safe-min-height' lines and
|
||
`window-safe-min-width' columns. If IGNORE is a window, ignore
|
||
restrictions for that window only. Any other non-nil value means
|
||
ignore all of the above restrictions for all windows.
|
||
|
||
Optional argument PIXELWISE non-nil means interpret DELTA as
|
||
pixels."
|
||
(setq window (window-normalize-window window))
|
||
(cond
|
||
((< delta 0)
|
||
(max (- (window-min-size window horizontal ignore pixelwise)
|
||
(window-size window horizontal pixelwise))
|
||
delta))
|
||
((window--size-ignore-p window ignore)
|
||
delta)
|
||
((> delta 0)
|
||
(if (window-size-fixed-p window horizontal)
|
||
0
|
||
delta))
|
||
(t 0)))
|
||
|
||
(defun window-sizable-p (window delta &optional horizontal ignore pixelwise)
|
||
"Return t if WINDOW can be resized by DELTA lines.
|
||
WINDOW must be a valid window and defaults to the selected one.
|
||
For the meaning of the arguments of this function see the
|
||
doc-string of `window-sizable'."
|
||
(setq window (window-normalize-window window))
|
||
(if (> delta 0)
|
||
(>= (window-sizable window delta horizontal ignore pixelwise)
|
||
delta)
|
||
(<= (window-sizable window delta horizontal ignore pixelwise)
|
||
delta)))
|
||
|
||
(defun window--size-fixed-1 (window horizontal)
|
||
"Internal function for `window-size-fixed-p'."
|
||
(let ((sub (window-child window)))
|
||
(catch 'fixed
|
||
(if sub
|
||
;; WINDOW is an internal window.
|
||
(if (window-combined-p sub horizontal)
|
||
;; An iso-combination is fixed size if all its child
|
||
;; windows are fixed-size.
|
||
(progn
|
||
(while sub
|
||
(unless (window--size-fixed-1 sub horizontal)
|
||
;; We found a non-fixed-size child window, so
|
||
;; WINDOW's size is not fixed.
|
||
(throw 'fixed nil))
|
||
(setq sub (window-right sub)))
|
||
;; All child windows are fixed-size, so WINDOW's size is
|
||
;; fixed.
|
||
(throw 'fixed t))
|
||
;; An ortho-combination is fixed-size if at least one of its
|
||
;; child windows is fixed-size.
|
||
(while sub
|
||
(when (window--size-fixed-1 sub horizontal)
|
||
;; We found a fixed-size child window, so WINDOW's size
|
||
;; is fixed.
|
||
(throw 'fixed t))
|
||
(setq sub (window-right sub))))
|
||
;; WINDOW is a live window.
|
||
(with-current-buffer (window-buffer window)
|
||
(if horizontal
|
||
(memq window-size-fixed '(width t))
|
||
(memq window-size-fixed '(height t))))))))
|
||
|
||
(defun window-size-fixed-p (&optional window horizontal)
|
||
"Return non-nil if WINDOW's height is fixed.
|
||
WINDOW must be a valid window and defaults to the selected one.
|
||
Optional argument HORIZONTAL non-nil means return non-nil if
|
||
WINDOW's width is fixed.
|
||
|
||
If this function returns nil, this does not necessarily mean that
|
||
WINDOW can be resized in the desired direction. The function
|
||
`window-resizable' can tell that."
|
||
(window--size-fixed-1
|
||
(window-normalize-window window) horizontal))
|
||
|
||
(defun window--min-delta-1 (window delta &optional horizontal ignore trail noup pixelwise)
|
||
"Internal function for `window-min-delta'."
|
||
(if (not (window-parent window))
|
||
;; If we can't go up, return zero.
|
||
0
|
||
;; Else try to find a non-fixed-size sibling of WINDOW.
|
||
(let* ((parent (window-parent window))
|
||
(sub (window-child parent)))
|
||
(catch 'done
|
||
(if (window-combined-p sub horizontal)
|
||
;; In an iso-combination throw DELTA if we find at least one
|
||
;; child window and that window is either not fixed-size or
|
||
;; we can ignore fixed-sizeness.
|
||
(let ((skip (eq trail 'after)))
|
||
(while sub
|
||
(cond
|
||
((eq sub window)
|
||
(setq skip (eq trail 'before)))
|
||
(skip)
|
||
((and (not (window--size-ignore-p window ignore))
|
||
(window-size-fixed-p sub horizontal)))
|
||
(t
|
||
;; We found a non-fixed-size child window.
|
||
(throw 'done delta)))
|
||
(setq sub (window-right sub))))
|
||
;; In an ortho-combination set DELTA to the minimum value by
|
||
;; which other child windows can shrink.
|
||
(while sub
|
||
(unless (eq sub window)
|
||
(setq delta
|
||
(min delta
|
||
(max (- (window-size sub horizontal pixelwise 'ceiling)
|
||
(window-min-size
|
||
sub horizontal ignore pixelwise))
|
||
0))))
|
||
(setq sub (window-right sub))))
|
||
(if noup
|
||
delta
|
||
(window--min-delta-1
|
||
parent delta horizontal ignore trail nil pixelwise))))))
|
||
|
||
(defun window-min-delta (&optional window horizontal ignore trail noup nodown pixelwise)
|
||
"Return number of lines by which WINDOW can be shrunk.
|
||
WINDOW must be a valid window and defaults to the selected one.
|
||
Return zero if WINDOW cannot be shrunk.
|
||
|
||
Optional argument HORIZONTAL non-nil means return number of
|
||
columns by which WINDOW can be shrunk.
|
||
|
||
Optional argument IGNORE non-nil means ignore restrictions
|
||
imposed by fixed size windows, `window-min-height' or
|
||
`window-min-width' settings. If IGNORE is a window, ignore
|
||
restrictions for that window only. If IGNORE equals `safe',
|
||
live windows may get as small as `window-safe-min-height' lines
|
||
and `window-safe-min-width' columns. Any other non-nil value
|
||
means ignore all of the above restrictions for all windows.
|
||
|
||
Optional argument TRAIL restricts the windows that can be enlarged.
|
||
If its value is `before', only windows to the left of or above WINDOW
|
||
can be enlarged. If it is `after', only windows to the right of or
|
||
below WINDOW can be enlarged.
|
||
|
||
Optional argument NOUP non-nil means don't go up in the window
|
||
tree, but try to enlarge windows within WINDOW's combination only.
|
||
|
||
Optional argument NODOWN non-nil means don't check whether WINDOW
|
||
itself (and its child windows) can be shrunk; check only whether
|
||
at least one other window can be enlarged appropriately.
|
||
|
||
Optional argument PIXELWISE non-nil means return number of pixels
|
||
by which WINDOW can be shrunk."
|
||
(setq window (window-normalize-window window))
|
||
(let ((size (window-size window horizontal pixelwise 'floor))
|
||
(minimum (window-min-size window horizontal ignore pixelwise)))
|
||
(cond
|
||
(nodown
|
||
;; If NODOWN is t, try to recover the entire size of WINDOW.
|
||
(window--min-delta-1
|
||
window size horizontal ignore trail noup pixelwise))
|
||
((<= size minimum)
|
||
;; If NODOWN is nil and WINDOW's size is already at its minimum,
|
||
;; there's nothing to recover.
|
||
0)
|
||
(t
|
||
;; Otherwise, try to recover whatever WINDOW is larger than its
|
||
;; minimum size.
|
||
(window--min-delta-1
|
||
window (- size minimum) horizontal ignore trail noup pixelwise)))))
|
||
|
||
(defun window--max-delta-1 (window delta &optional horizontal ignore trail noup pixelwise)
|
||
"Internal function of `window-max-delta'."
|
||
(if (not (window-parent window))
|
||
;; Can't go up. Return DELTA.
|
||
delta
|
||
(let* ((parent (window-parent window))
|
||
(sub (window-child parent)))
|
||
(catch 'fixed
|
||
(if (window-combined-p sub horizontal)
|
||
;; For an iso-combination calculate how much we can get from
|
||
;; other child windows.
|
||
(let ((skip (eq trail 'after)))
|
||
(while sub
|
||
(cond
|
||
((eq sub window)
|
||
(setq skip (eq trail 'before)))
|
||
(skip)
|
||
(t
|
||
(setq delta
|
||
(+ delta
|
||
(max
|
||
(- (window-size sub horizontal pixelwise 'floor)
|
||
(window-min-size
|
||
sub horizontal ignore pixelwise))
|
||
0)))))
|
||
(setq sub (window-right sub))))
|
||
;; For an ortho-combination throw DELTA when at least one
|
||
;; child window is fixed-size.
|
||
(while sub
|
||
(when (and (not (eq sub window))
|
||
(not (window--size-ignore-p sub ignore))
|
||
(window-size-fixed-p sub horizontal))
|
||
(throw 'fixed delta))
|
||
(setq sub (window-right sub))))
|
||
(if noup
|
||
;; When NOUP is nil, DELTA is all we can get.
|
||
delta
|
||
;; Else try with parent of WINDOW, passing the DELTA we
|
||
;; recovered so far.
|
||
(window--max-delta-1
|
||
parent delta horizontal ignore trail nil pixelwise))))))
|
||
|
||
(defun window-max-delta (&optional window horizontal ignore trail noup nodown pixelwise)
|
||
"Return maximum number of lines by which WINDOW can be enlarged.
|
||
WINDOW must be a valid window and defaults to the selected one.
|
||
The return value is zero if WINDOW cannot be enlarged.
|
||
|
||
Optional argument HORIZONTAL non-nil means return maximum number
|
||
of columns by which WINDOW can be enlarged.
|
||
|
||
Optional argument IGNORE non-nil means ignore restrictions
|
||
imposed by fixed size windows, `window-min-height' or
|
||
`window-min-width' settings. If IGNORE is a window, ignore
|
||
restrictions for that window only. If IGNORE equals `safe',
|
||
live windows may get as small as `window-safe-min-height' lines
|
||
and `window-safe-min-width' columns. Any other non-nil value means
|
||
ignore all of the above restrictions for all windows.
|
||
|
||
Optional argument TRAIL restricts the windows that can be enlarged.
|
||
If its value is `before', only windows to the left of or above WINDOW
|
||
can be enlarged. If it is `after', only windows to the right of or
|
||
below WINDOW can be enlarged.
|
||
|
||
Optional argument NOUP non-nil means don't go up in the window
|
||
tree but try to obtain the entire space from windows within
|
||
WINDOW's combination.
|
||
|
||
Optional argument NODOWN non-nil means do not check whether
|
||
WINDOW itself (and its child windows) can be enlarged; check
|
||
only whether other windows can be shrunk appropriately.
|
||
|
||
Optional argument PIXELWISE non-nil means return number of
|
||
pixels by which WINDOW can be enlarged."
|
||
(setq window (window-normalize-window window))
|
||
(if (and (not (window--size-ignore-p window ignore))
|
||
(not nodown) (window-size-fixed-p window horizontal))
|
||
;; With IGNORE and NOWDON nil return zero if WINDOW has fixed
|
||
;; size.
|
||
0
|
||
;; WINDOW has no fixed size.
|
||
(window--max-delta-1 window 0 horizontal ignore trail noup pixelwise)))
|
||
|
||
;; Make NOUP also inhibit the min-size check.
|
||
(defun window--resizable (window delta &optional horizontal ignore trail noup nodown pixelwise)
|
||
"Return DELTA if WINDOW can be resized vertically by DELTA lines.
|
||
WINDOW must be a valid window and defaults to the selected one.
|
||
Optional argument HORIZONTAL non-nil means return DELTA if WINDOW
|
||
can be resized horizontally by DELTA columns. A return value of
|
||
zero means that WINDOW is not resizable.
|
||
|
||
DELTA positive means WINDOW shall be enlarged by DELTA lines or
|
||
columns. If WINDOW cannot be enlarged by DELTA lines or columns,
|
||
return the maximum value in the range 0..DELTA by which WINDOW
|
||
can be enlarged.
|
||
|
||
DELTA negative means WINDOW shall be shrunk by -DELTA lines or
|
||
columns. If WINDOW cannot be shrunk by -DELTA lines or columns,
|
||
return the minimum value in the range DELTA..0 that can be used
|
||
for shrinking WINDOW.
|
||
|
||
Optional argument IGNORE non-nil means ignore restrictions
|
||
imposed by fixed size windows, `window-min-height' or
|
||
`window-min-width' settings. If IGNORE is a window, ignore
|
||
restrictions for that window only. If IGNORE equals `safe',
|
||
live windows may get as small as `window-safe-min-height' lines
|
||
and `window-safe-min-width' columns. Any other non-nil value
|
||
means ignore all of the above restrictions for all windows.
|
||
|
||
Optional argument TRAIL `before' means only windows to the left
|
||
of or below WINDOW can be shrunk. Optional argument TRAIL
|
||
`after' means only windows to the right of or above WINDOW can be
|
||
shrunk.
|
||
|
||
Optional argument NOUP non-nil means don't go up in the window
|
||
tree but check only whether space can be obtained from (or given
|
||
to) WINDOW's siblings.
|
||
|
||
Optional argument NODOWN non-nil means don't go down in the
|
||
window tree. This means do not check whether resizing would
|
||
violate size restrictions of WINDOW or its child windows.
|
||
|
||
Optional argument PIXELWISE non-nil means interpret DELTA as
|
||
number of pixels."
|
||
(setq window (window-normalize-window window))
|
||
(cond
|
||
((< delta 0)
|
||
(max (- (window-min-delta
|
||
window horizontal ignore trail noup nodown pixelwise))
|
||
delta))
|
||
((> delta 0)
|
||
(min (window-max-delta
|
||
window horizontal ignore trail noup nodown pixelwise)
|
||
delta))
|
||
(t 0)))
|
||
|
||
(defun window--resizable-p (window delta &optional horizontal ignore trail noup nodown pixelwise)
|
||
"Return t if WINDOW can be resized vertically by DELTA lines.
|
||
WINDOW must be a valid window and defaults to the selected one.
|
||
For the meaning of the arguments of this function see the
|
||
doc-string of `window--resizable'.
|
||
|
||
Optional argument PIXELWISE non-nil means interpret DELTA as
|
||
pixels."
|
||
(setq window (window-normalize-window window))
|
||
(if (> delta 0)
|
||
(>= (window--resizable
|
||
window delta horizontal ignore trail noup nodown pixelwise)
|
||
delta)
|
||
(<= (window--resizable
|
||
window delta horizontal ignore trail noup nodown pixelwise)
|
||
delta)))
|
||
|
||
(defun window-resizable (window delta &optional horizontal ignore pixelwise)
|
||
"Return DELTA if WINDOW can be resized vertically by DELTA lines.
|
||
WINDOW must be a valid window and defaults to the selected one.
|
||
Optional argument HORIZONTAL non-nil means return DELTA if WINDOW
|
||
can be resized horizontally by DELTA columns. A return value of
|
||
zero means that WINDOW is not resizable.
|
||
|
||
DELTA positive means WINDOW shall be enlarged by DELTA lines or
|
||
columns. If WINDOW cannot be enlarged by DELTA lines or columns
|
||
return the maximum value in the range 0..DELTA by which WINDOW
|
||
can be enlarged.
|
||
|
||
DELTA negative means WINDOW shall be shrunk by -DELTA lines or
|
||
columns. If WINDOW cannot be shrunk by -DELTA lines or columns,
|
||
return the minimum value in the range DELTA..0 that can be used
|
||
for shrinking WINDOW.
|
||
|
||
Optional argument IGNORE non-nil means ignore restrictions
|
||
imposed by fixed size windows, `window-min-height' or
|
||
`window-min-width' settings. If IGNORE is a window, ignore
|
||
restrictions for that window only. If IGNORE equals `safe',
|
||
live windows may get as small as `window-safe-min-height' lines
|
||
and `window-safe-min-width' columns. Any other non-nil value
|
||
means ignore all of the above restrictions for all windows.
|
||
|
||
Optional argument PIXELWISE non-nil means interpret DELTA as
|
||
pixels."
|
||
(setq window (window-normalize-window window))
|
||
(window--resizable window delta horizontal ignore nil nil nil pixelwise))
|
||
|
||
(defun window-resizable-p (window delta &optional horizontal ignore pixelwise)
|
||
"Return t if WINDOW can be resized vertically by DELTA lines.
|
||
WINDOW must be a valid window and defaults to the selected one.
|
||
For the meaning of the arguments of this function see the
|
||
doc-string of `window-resizable'."
|
||
(setq window (window-normalize-window window))
|
||
(if (> delta 0)
|
||
(>= (window--resizable
|
||
window delta horizontal ignore nil nil nil pixelwise)
|
||
delta)
|
||
(<= (window--resizable
|
||
window delta horizontal ignore nil nil nil pixelwise)
|
||
delta)))
|
||
|
||
;; Aliases of functions defined in window.c.
|
||
(defalias 'window-height 'window-total-height)
|
||
(defalias 'window-width 'window-body-width)
|
||
|
||
;; Eventually the following two should work pixelwise.
|
||
|
||
;; See discussion in bug#4543.
|
||
(defun window-full-height-p (&optional window)
|
||
"Return t if WINDOW is as high as its containing frame.
|
||
More precisely, return t if and only if the total height of
|
||
WINDOW equals the total height of the root window of WINDOW's
|
||
frame. WINDOW must be a valid window and defaults to the
|
||
selected one."
|
||
(setq window (window-normalize-window window))
|
||
(= (window-pixel-height window)
|
||
(window-pixel-height (frame-root-window window))))
|
||
|
||
(defun window-full-width-p (&optional window)
|
||
"Return t if WINDOW is as wide as its containing frame.
|
||
More precisely, return t if and only if the total width of WINDOW
|
||
equals the total width of the root window of WINDOW's frame.
|
||
WINDOW must be a valid window and defaults to the selected one."
|
||
(setq window (window-normalize-window window))
|
||
(= (window-pixel-width window)
|
||
(window-pixel-width (frame-root-window window))))
|
||
|
||
(defun window-body-size (&optional window horizontal pixelwise)
|
||
"Return the height or width of WINDOW's text area.
|
||
WINDOW must be a live window and defaults to the selected one.
|
||
|
||
If HORIZONTAL is omitted or nil, return the height of the text
|
||
area, like `window-body-height'. Otherwise, return the width of
|
||
the text area, like `window-body-width'. In either case, the
|
||
optional argument PIXELWISE is passed to the functions."
|
||
(if horizontal
|
||
(window-body-width window pixelwise)
|
||
(window-body-height window pixelwise)))
|
||
|
||
(defun window-current-scroll-bars (&optional window)
|
||
"Return the current scroll bar settings for WINDOW.
|
||
WINDOW must be a live window and defaults to the selected one.
|
||
|
||
The return value is a cons cell (VERTICAL . HORIZONTAL) where
|
||
VERTICAL specifies the current location of the vertical scroll
|
||
bars (`left', `right', or nil), and HORIZONTAL specifies the
|
||
current location of the horizontal scroll bars (`top', `bottom',
|
||
or nil).
|
||
|
||
Unlike `window-scroll-bars', this function reports the scroll bar
|
||
type actually used, once frame defaults and `scroll-bar-mode' are
|
||
taken into account."
|
||
(setq window (window-normalize-window window t))
|
||
(let ((vert (nth 2 (window-scroll-bars window)))
|
||
(hor nil))
|
||
(when (or (eq vert t) (eq hor t))
|
||
(let ((fcsb (frame-current-scroll-bars (window-frame window))))
|
||
(if (eq vert t)
|
||
(setq vert (car fcsb)))
|
||
(if (eq hor t)
|
||
(setq hor (cdr fcsb)))))
|
||
(cons vert hor)))
|
||
|
||
(defun walk-windows (fun &optional minibuf all-frames)
|
||
"Cycle through all live windows, calling FUN for each one.
|
||
FUN must specify a function with a window as its sole argument.
|
||
The optional arguments MINIBUF and ALL-FRAMES specify the set of
|
||
windows to include in the walk.
|
||
|
||
MINIBUF t means include the minibuffer window even if the
|
||
minibuffer is not active. MINIBUF nil or omitted means include
|
||
the minibuffer window only if the minibuffer is active. Any
|
||
other value means do not include the minibuffer window even if
|
||
the minibuffer is active.
|
||
|
||
ALL-FRAMES nil or omitted means consider all windows on the
|
||
selected frame, plus the minibuffer window if specified by the
|
||
MINIBUF argument. If the minibuffer counts, consider all windows
|
||
on all frames that share that minibuffer too. The following
|
||
non-nil values of ALL-FRAMES have special meanings:
|
||
|
||
- t means consider all windows on all existing frames.
|
||
|
||
- `visible' means consider all windows on all visible frames on
|
||
the current terminal.
|
||
|
||
- 0 (the number zero) means consider all windows on all visible
|
||
and iconified frames on the current terminal.
|
||
|
||
- A frame means consider all windows on that frame only.
|
||
|
||
Anything else means consider all windows on the selected frame
|
||
and no others.
|
||
|
||
This function changes neither the order of recently selected
|
||
windows nor the buffer list."
|
||
;; If we start from the minibuffer window, don't fail to come
|
||
;; back to it.
|
||
(when (window-minibuffer-p)
|
||
(setq minibuf t))
|
||
;; Make sure to not mess up the order of recently selected
|
||
;; windows. Use `save-selected-window' and `select-window'
|
||
;; with second argument non-nil for this purpose.
|
||
(save-selected-window
|
||
(when (framep all-frames)
|
||
(select-window (frame-first-window all-frames) 'norecord))
|
||
(dolist (walk-windows-window (window-list-1 nil minibuf all-frames))
|
||
(funcall fun walk-windows-window))))
|
||
|
||
(defun window-at-side-p (&optional window side)
|
||
"Return t if WINDOW is at SIDE of its containing frame.
|
||
WINDOW must be a valid window and defaults to the selected one.
|
||
SIDE can be any of the symbols `left', `top', `right' or
|
||
`bottom'. The default value nil is handled like `bottom'."
|
||
(setq window (window-normalize-window window))
|
||
(let ((edge
|
||
(cond
|
||
((eq side 'left) 0)
|
||
((eq side 'top) 1)
|
||
((eq side 'right) 2)
|
||
((memq side '(bottom nil)) 3))))
|
||
(= (nth edge (window-pixel-edges window))
|
||
(nth edge (window-pixel-edges (frame-root-window window))))))
|
||
|
||
(defun window-at-side-list (&optional frame side)
|
||
"Return list of all windows on SIDE of FRAME.
|
||
FRAME must be a live frame and defaults to the selected frame.
|
||
SIDE can be any of the symbols `left', `top', `right' or
|
||
`bottom'. The default value nil is handled like `bottom'."
|
||
(setq frame (window-normalize-frame frame))
|
||
(let (windows)
|
||
(walk-window-tree
|
||
(lambda (window)
|
||
(when (window-at-side-p window side)
|
||
(setq windows (cons window windows))))
|
||
frame nil 'nomini)
|
||
(nreverse windows)))
|
||
|
||
(defun window--in-direction-2 (window posn &optional horizontal)
|
||
"Support function for `window-in-direction'."
|
||
(if horizontal
|
||
(let ((top (window-pixel-top window)))
|
||
(if (> top posn)
|
||
(- top posn)
|
||
(- posn top (window-pixel-height window))))
|
||
(let ((left (window-pixel-left window)))
|
||
(if (> left posn)
|
||
(- left posn)
|
||
(- posn left (window-pixel-width window))))))
|
||
|
||
;; Predecessors to the below have been devised by Julian Assange in
|
||
;; change-windows-intuitively.el and Hovav Shacham in windmove.el.
|
||
;; Neither of these allow to selectively ignore specific windows
|
||
;; (windows whose `no-other-window' parameter is non-nil) as targets of
|
||
;; the movement.
|
||
(defun window-in-direction (direction &optional window ignore sign wrap mini)
|
||
"Return window in DIRECTION as seen from WINDOW.
|
||
More precisely, return the nearest window in direction DIRECTION
|
||
as seen from the position of `window-point' in window WINDOW.
|
||
DIRECTION must be one of `above', `below', `left' or `right'.
|
||
WINDOW must be a live window and defaults to the selected one.
|
||
|
||
Do not return a window whose `no-other-window' parameter is
|
||
non-nil. If the nearest window's `no-other-window' parameter is
|
||
non-nil, try to find another window in the indicated direction.
|
||
If, however, the optional argument IGNORE is non-nil, return that
|
||
window even if its `no-other-window' parameter is non-nil.
|
||
|
||
Optional argument SIGN a negative number means to use the right
|
||
or bottom edge of WINDOW as reference position instead of
|
||
`window-point'. SIGN a positive number means to use the left or
|
||
top edge of WINDOW as reference position.
|
||
|
||
Optional argument WRAP non-nil means to wrap DIRECTION around
|
||
frame borders. This means to return for WINDOW at the top of the
|
||
frame and DIRECTION `above' the minibuffer window if the frame
|
||
has one, and a window at the bottom of the frame otherwise.
|
||
|
||
Optional argument MINI nil means to return the minibuffer window
|
||
if and only if it is currently active. MINI non-nil means to
|
||
return the minibuffer window even when it's not active. However,
|
||
if WRAP non-nil, always act as if MINI were nil.
|
||
|
||
Return nil if no suitable window can be found."
|
||
(setq window (window-normalize-window window t))
|
||
(unless (memq direction '(above below left right))
|
||
(error "Wrong direction %s" direction))
|
||
(let* ((frame (window-frame window))
|
||
(hor (memq direction '(left right)))
|
||
(first (if hor
|
||
(window-pixel-left window)
|
||
(window-pixel-top window)))
|
||
(last (+ first (window-size window hor t)))
|
||
;; The column / row value of `posn-at-point' can be nil for the
|
||
;; mini-window, guard against that.
|
||
(posn
|
||
(cond
|
||
((and (numberp sign) (< sign 0))
|
||
(if hor
|
||
(1- (+ (window-pixel-top window) (window-pixel-height window)))
|
||
(1- (+ (window-pixel-left window) (window-pixel-width window)))))
|
||
((and (numberp sign) (> sign 0))
|
||
(if hor
|
||
(window-pixel-top window)
|
||
(window-pixel-left window)))
|
||
((let ((posn-cons (nth 2 (posn-at-point (window-point window) window))))
|
||
(if hor
|
||
(+ (or (cdr posn-cons) 1) (window-pixel-top window))
|
||
(+ (or (car posn-cons) 1) (window-pixel-left window)))))))
|
||
(best-edge
|
||
(cond
|
||
((eq direction 'below) (frame-pixel-height frame))
|
||
((eq direction 'right) (frame-pixel-width frame))
|
||
(t -1)))
|
||
(best-edge-2 best-edge)
|
||
(best-diff-2 (if hor (frame-pixel-height frame) (frame-pixel-width frame)))
|
||
best best-2 best-diff-2-new)
|
||
(walk-window-tree
|
||
(lambda (w)
|
||
(let* ((w-top (window-pixel-top w))
|
||
(w-left (window-pixel-left w)))
|
||
(cond
|
||
((or (eq window w)
|
||
;; Ignore ourselves.
|
||
(and (window-parameter w 'no-other-window)
|
||
;; Ignore W unless IGNORE is non-nil.
|
||
(not ignore))))
|
||
(hor
|
||
(cond
|
||
((and (<= w-top posn)
|
||
(< posn (+ w-top (window-pixel-height w))))
|
||
;; W is to the left or right of WINDOW and covers POSN.
|
||
(when (or (and (eq direction 'left)
|
||
(or (and (<= w-left first) (> w-left best-edge))
|
||
(and wrap
|
||
(window-at-side-p window 'left)
|
||
(window-at-side-p w 'right))))
|
||
(and (eq direction 'right)
|
||
(or (and (>= w-left last) (< w-left best-edge))
|
||
(and wrap
|
||
(window-at-side-p window 'right)
|
||
(window-at-side-p w 'left)))))
|
||
(setq best-edge w-left)
|
||
(setq best w)))
|
||
((and (or (and (eq direction 'left)
|
||
(<= (+ w-left (window-pixel-width w)) first))
|
||
(and (eq direction 'right) (<= last w-left)))
|
||
;; W is to the left or right of WINDOW but does not
|
||
;; cover POSN.
|
||
(setq best-diff-2-new
|
||
(window--in-direction-2 w posn hor))
|
||
(or (< best-diff-2-new best-diff-2)
|
||
(and (= best-diff-2-new best-diff-2)
|
||
(if (eq direction 'left)
|
||
(> w-left best-edge-2)
|
||
(< w-left best-edge-2)))))
|
||
(setq best-edge-2 w-left)
|
||
(setq best-diff-2 best-diff-2-new)
|
||
(setq best-2 w))))
|
||
((and (<= w-left posn)
|
||
(< posn (+ w-left (window-pixel-width w))))
|
||
;; W is above or below WINDOW and covers POSN.
|
||
(when (or (and (eq direction 'above)
|
||
(or (and (<= w-top first) (> w-top best-edge))
|
||
(and wrap
|
||
(window-at-side-p window 'top)
|
||
(if (active-minibuffer-window)
|
||
(minibuffer-window-active-p w)
|
||
(window-at-side-p w 'bottom)))))
|
||
(and (eq direction 'below)
|
||
(or (and (>= w-top first) (< w-top best-edge))
|
||
(and wrap
|
||
(if (active-minibuffer-window)
|
||
(minibuffer-window-active-p window)
|
||
(window-at-side-p window 'bottom))
|
||
(window-at-side-p w 'top)))))
|
||
(setq best-edge w-top)
|
||
(setq best w)))
|
||
((and (or (and (eq direction 'above)
|
||
(<= (+ w-top (window-pixel-height w)) first))
|
||
(and (eq direction 'below) (<= last w-top)))
|
||
;; W is above or below WINDOW but does not cover POSN.
|
||
(setq best-diff-2-new
|
||
(window--in-direction-2 w posn hor))
|
||
(or (< best-diff-2-new best-diff-2)
|
||
(and (= best-diff-2-new best-diff-2)
|
||
(if (eq direction 'above)
|
||
(> w-top best-edge-2)
|
||
(< w-top best-edge-2)))))
|
||
(setq best-edge-2 w-top)
|
||
(setq best-diff-2 best-diff-2-new)
|
||
(setq best-2 w)))))
|
||
frame nil (and mini t))
|
||
(or best best-2)))
|
||
|
||
(defun get-window-with-predicate (predicate &optional minibuf all-frames default)
|
||
"Return a live window satisfying PREDICATE.
|
||
More precisely, cycle through all windows calling the function
|
||
PREDICATE on each one of them with the window as its sole
|
||
argument. Return the first window for which PREDICATE returns
|
||
non-nil. Windows are scanned starting with the window following
|
||
the selected window. If no window satisfies PREDICATE, return
|
||
DEFAULT.
|
||
|
||
MINIBUF t means include the minibuffer window even if the
|
||
minibuffer is not active. MINIBUF nil or omitted means include
|
||
the minibuffer window only if the minibuffer is active. Any
|
||
other value means do not include the minibuffer window even if
|
||
the minibuffer is active.
|
||
|
||
ALL-FRAMES nil or omitted means consider all windows on the selected
|
||
frame, plus the minibuffer window if specified by the MINIBUF
|
||
argument. If the minibuffer counts, consider all windows on all
|
||
frames that share that minibuffer too. The following non-nil
|
||
values of ALL-FRAMES have special meanings:
|
||
|
||
- t means consider all windows on all existing frames.
|
||
|
||
- `visible' means consider all windows on all visible frames on
|
||
the current terminal.
|
||
|
||
- 0 (the number zero) means consider all windows on all visible
|
||
and iconified frames on the current terminal.
|
||
|
||
- A frame means consider all windows on that frame only.
|
||
|
||
Anything else means consider all windows on the selected frame
|
||
and no others."
|
||
(catch 'found
|
||
(dolist (window (window-list-1
|
||
(next-window nil minibuf all-frames)
|
||
minibuf all-frames))
|
||
(when (funcall predicate window)
|
||
(throw 'found window)))
|
||
default))
|
||
|
||
(defalias 'some-window 'get-window-with-predicate)
|
||
|
||
(defun get-lru-window (&optional all-frames dedicated not-selected)
|
||
"Return the least recently used window on frames specified by ALL-FRAMES.
|
||
Return a full-width window if possible. A minibuffer window is
|
||
never a candidate. A dedicated window is never a candidate
|
||
unless DEDICATED is non-nil, so if all windows are dedicated, the
|
||
value is nil. Avoid returning the selected window if possible.
|
||
Optional argument NOT-SELECTED non-nil means never return the
|
||
selected window.
|
||
|
||
The following non-nil values of the optional argument ALL-FRAMES
|
||
have special meanings:
|
||
|
||
- t means consider all windows on all existing frames.
|
||
|
||
- `visible' means consider all windows on all visible frames on
|
||
the current terminal.
|
||
|
||
- 0 (the number zero) means consider all windows on all visible
|
||
and iconified frames on the current terminal.
|
||
|
||
- A frame means consider all windows on that frame only.
|
||
|
||
Any other value of ALL-FRAMES means consider all windows on the
|
||
selected frame and no others."
|
||
(let (best-window best-time second-best-window second-best-time time)
|
||
(dolist (window (window-list-1 nil 'nomini all-frames))
|
||
(when (and (or dedicated (not (window-dedicated-p window)))
|
||
(or (not not-selected) (not (eq window (selected-window)))))
|
||
(setq time (window-use-time window))
|
||
(if (or (eq window (selected-window))
|
||
(not (window-full-width-p window)))
|
||
(when (or (not second-best-time) (< time second-best-time))
|
||
(setq second-best-time time)
|
||
(setq second-best-window window))
|
||
(when (or (not best-time) (< time best-time))
|
||
(setq best-time time)
|
||
(setq best-window window)))))
|
||
(or best-window second-best-window)))
|
||
|
||
(defun get-mru-window (&optional all-frames dedicated not-selected)
|
||
"Return the most recently used window on frames specified by ALL-FRAMES.
|
||
A minibuffer window is never a candidate. A dedicated window is
|
||
never a candidate unless DEDICATED is non-nil, so if all windows
|
||
are dedicated, the value is nil. Optional argument NOT-SELECTED
|
||
non-nil means never return the selected window.
|
||
|
||
The following non-nil values of the optional argument ALL-FRAMES
|
||
have special meanings:
|
||
|
||
- t means consider all windows on all existing frames.
|
||
|
||
- `visible' means consider all windows on all visible frames on
|
||
the current terminal.
|
||
|
||
- 0 (the number zero) means consider all windows on all visible
|
||
and iconified frames on the current terminal.
|
||
|
||
- A frame means consider all windows on that frame only.
|
||
|
||
Any other value of ALL-FRAMES means consider all windows on the
|
||
selected frame and no others."
|
||
(let (best-window best-time time)
|
||
(dolist (window (window-list-1 nil 'nomini all-frames))
|
||
(setq time (window-use-time window))
|
||
(when (and (or dedicated (not (window-dedicated-p window)))
|
||
(or (not not-selected) (not (eq window (selected-window))))
|
||
(or (not best-time) (> time best-time)))
|
||
(setq best-time time)
|
||
(setq best-window window)))
|
||
best-window))
|
||
|
||
(defun get-largest-window (&optional all-frames dedicated not-selected)
|
||
"Return the largest window on frames specified by ALL-FRAMES.
|
||
A minibuffer window is never a candidate. A dedicated window is
|
||
never a candidate unless DEDICATED is non-nil, so if all windows
|
||
are dedicated, the value is nil. Optional argument NOT-SELECTED
|
||
non-nil means never return the selected window.
|
||
|
||
The following non-nil values of the optional argument ALL-FRAMES
|
||
have special meanings:
|
||
|
||
- t means consider all windows on all existing frames.
|
||
|
||
- `visible' means consider all windows on all visible frames on
|
||
the current terminal.
|
||
|
||
- 0 (the number zero) means consider all windows on all visible
|
||
and iconified frames on the current terminal.
|
||
|
||
- A frame means consider all windows on that frame only.
|
||
|
||
Any other value of ALL-FRAMES means consider all windows on the
|
||
selected frame and no others."
|
||
(let ((best-size 0)
|
||
best-window size)
|
||
(dolist (window (window-list-1 nil 'nomini all-frames))
|
||
(when (and (or dedicated (not (window-dedicated-p window)))
|
||
(or (not not-selected) (not (eq window (selected-window)))))
|
||
(setq size (* (window-pixel-height window)
|
||
(window-pixel-width window)))
|
||
(when (> size best-size)
|
||
(setq best-size size)
|
||
(setq best-window window))))
|
||
best-window))
|
||
|
||
(defun get-buffer-window-list (&optional buffer-or-name minibuf all-frames)
|
||
"Return list of all windows displaying BUFFER-OR-NAME, or nil if none.
|
||
BUFFER-OR-NAME may be a buffer or the name of an existing buffer
|
||
and defaults to the current buffer. Windows are scanned starting
|
||
with the selected window.
|
||
|
||
MINIBUF t means include the minibuffer window even if the
|
||
minibuffer is not active. MINIBUF nil or omitted means include
|
||
the minibuffer window only if the minibuffer is active. Any
|
||
other value means do not include the minibuffer window even if
|
||
the minibuffer is active.
|
||
|
||
ALL-FRAMES nil or omitted means consider all windows on the
|
||
selected frame, plus the minibuffer window if specified by the
|
||
MINIBUF argument. If the minibuffer counts, consider all windows
|
||
on all frames that share that minibuffer too. The following
|
||
non-nil values of ALL-FRAMES have special meanings:
|
||
|
||
- t means consider all windows on all existing frames.
|
||
|
||
- `visible' means consider all windows on all visible frames on
|
||
the current terminal.
|
||
|
||
- 0 (the number zero) means consider all windows on all visible
|
||
and iconified frames on the current terminal.
|
||
|
||
- A frame means consider all windows on that frame only.
|
||
|
||
Anything else means consider all windows on the selected frame
|
||
and no others."
|
||
(let ((buffer (window-normalize-buffer buffer-or-name))
|
||
windows)
|
||
(dolist (window (window-list-1 (selected-window) minibuf all-frames))
|
||
(when (eq (window-buffer window) buffer)
|
||
(setq windows (cons window windows))))
|
||
(nreverse windows)))
|
||
|
||
(defun minibuffer-window-active-p (window)
|
||
"Return t if WINDOW is the currently active minibuffer window."
|
||
(eq window (active-minibuffer-window)))
|
||
|
||
(defun count-windows (&optional minibuf)
|
||
"Return the number of live windows on the selected frame.
|
||
The optional argument MINIBUF specifies whether the minibuffer
|
||
window shall be counted. See `walk-windows' for the precise
|
||
meaning of this argument."
|
||
(length (window-list-1 nil minibuf)))
|
||
|
||
;;; Resizing windows.
|
||
(defun window--size-to-pixel (window size &optional horizontal pixelwise round-maybe)
|
||
"For WINDOW convert SIZE lines to pixels.
|
||
SIZE is supposed to specify a height of WINDOW in terms of text
|
||
lines. The return value is the number of pixels specifying that
|
||
height.
|
||
|
||
WINDOW must be a valid window. Optional argument HORIZONTAL
|
||
non-nil means convert SIZE columns to pixels.
|
||
|
||
Optional argument PIXELWISE non-nil means SIZE already specifies
|
||
pixels but may have to be adjusted to a multiple of the character
|
||
size of WINDOW's frame. Optional argument ROUND-MAYBE non-nil
|
||
means round to the nearest multiple of the character size of
|
||
WINDOW's frame if the option `window-resize-pixelwise' is nil."
|
||
(setq window (window-normalize-window window))
|
||
(let ((char-size (frame-char-size window horizontal)))
|
||
(if pixelwise
|
||
(if (and round-maybe (not window-resize-pixelwise))
|
||
(* (round size char-size) char-size)
|
||
size)
|
||
(* size char-size))))
|
||
|
||
(defun window--pixel-to-total-1 (window horizontal char-size)
|
||
"Subroutine of `window--pixel-to-total'."
|
||
(let ((child (window-child window)))
|
||
(if (window-combination-p window horizontal)
|
||
;; In an iso-combination distribute sizes proportionally.
|
||
(let ((remainder (window-new-total window))
|
||
size best-child rem best-rem)
|
||
;; Initialize total sizes to each child's floor.
|
||
(while child
|
||
(setq size (max (/ (window-size child horizontal t) char-size) 1))
|
||
(set-window-new-total child size)
|
||
(setq remainder (- remainder size))
|
||
(setq child (window-next-sibling child)))
|
||
;; Distribute remainder.
|
||
(while (> remainder 0)
|
||
(setq child (window-last-child window))
|
||
(setq best-child nil)
|
||
(setq best-rem 0)
|
||
(while child
|
||
(when (and (<= (window-new-total child)
|
||
(/ (window-size child horizontal t) char-size))
|
||
(> (setq rem (% (window-size child horizontal t)
|
||
char-size))
|
||
best-rem))
|
||
(setq best-child child)
|
||
(setq best-rem rem))
|
||
(setq child (window-prev-sibling child)))
|
||
;; We MUST have a best-child here.
|
||
(set-window-new-total best-child 1 t)
|
||
(setq remainder (1- remainder)))
|
||
;; Recurse.
|
||
(setq child (window-child window))
|
||
(while child
|
||
(window--pixel-to-total-1 child horizontal char-size)
|
||
(setq child (window-next-sibling child))))
|
||
;; In an ortho-combination assign new sizes directly.
|
||
(let ((size (window-new-total window)))
|
||
(while child
|
||
(set-window-new-total child size)
|
||
(window--pixel-to-total-1 child horizontal char-size)
|
||
(setq child (window-next-sibling child)))))))
|
||
|
||
(defun window--pixel-to-total (&optional frame horizontal)
|
||
"On FRAME assign new total window heights from pixel heights.
|
||
FRAME must be a live frame and defaults to the selected frame.
|
||
|
||
Optional argument HORIZONTAL non-nil means assign new total
|
||
window widths from pixel widths."
|
||
(setq frame (window-normalize-frame frame))
|
||
(let* ((char-size (frame-char-size frame horizontal))
|
||
(root (frame-root-window))
|
||
(root-size (window-size root horizontal t))
|
||
;; We have to care about the minibuffer window only if it
|
||
;; appears together with the root window on this frame.
|
||
(mini (let ((mini (minibuffer-window frame)))
|
||
(and (eq (window-frame mini) frame)
|
||
(not (eq mini root)) mini)))
|
||
(mini-size (and mini (window-size mini horizontal t))))
|
||
;; We round the line/column sizes of windows here to the nearest
|
||
;; integer. In some cases this can make windows appear _larger_
|
||
;; than the containing frame (line/column-wise) because the latter's
|
||
;; sizes are not (yet) rounded. We might eventually fix that.
|
||
(if (and mini (not horizontal))
|
||
(let (lines)
|
||
(set-window-new-total root (max (/ root-size char-size) 1))
|
||
(set-window-new-total mini (max (/ mini-size char-size) 1))
|
||
(setq lines (- (round (+ root-size mini-size) char-size)
|
||
(+ (window-new-total root) (window-new-total mini))))
|
||
(while (> lines 0)
|
||
(if (>= (% root-size (window-new-total root))
|
||
(% mini-size (window-new-total mini)))
|
||
(set-window-new-total root 1 t)
|
||
(set-window-new-total mini 1 t))
|
||
(setq lines (1- lines))))
|
||
(set-window-new-total root (round root-size char-size))
|
||
(when mini
|
||
;; This is taken in the horizontal case only.
|
||
(set-window-new-total mini (round mini-size char-size))))
|
||
(unless (window-buffer root)
|
||
(window--pixel-to-total-1 root horizontal char-size))
|
||
;; Apply the new sizes.
|
||
(window-resize-apply-total frame horizontal)))
|
||
|
||
(defun window--resize-reset (&optional frame horizontal)
|
||
"Reset resize values for all windows on FRAME.
|
||
FRAME defaults to the selected frame.
|
||
|
||
This function stores the current value of `window-size' applied
|
||
with argument HORIZONTAL in the new total size of all windows on
|
||
FRAME. It also resets the new normal size of each of these
|
||
windows."
|
||
(window--resize-reset-1
|
||
(frame-root-window (window-normalize-frame frame)) horizontal))
|
||
|
||
(defun window--resize-reset-1 (window horizontal)
|
||
"Internal function of `window--resize-reset'."
|
||
;; Register old size in the new total size.
|
||
(set-window-new-pixel window (window-size window horizontal t))
|
||
(set-window-new-total window (window-size window horizontal))
|
||
;; Reset new normal size.
|
||
(set-window-new-normal window)
|
||
(when (window-child window)
|
||
(window--resize-reset-1 (window-child window) horizontal))
|
||
(when (window-right window)
|
||
(window--resize-reset-1 (window-right window) horizontal)))
|
||
|
||
;; The following routine is used to manually resize the minibuffer
|
||
;; window and is currently used, for example, by ispell.el.
|
||
(defun window--resize-mini-window (window delta)
|
||
"Resize minibuffer window WINDOW by DELTA pixels.
|
||
If WINDOW cannot be resized by DELTA pixels make it as large (or
|
||
as small) as possible, but don't signal an error."
|
||
(when (window-minibuffer-p window)
|
||
(let* ((frame (window-frame window))
|
||
(root (frame-root-window frame))
|
||
(height (window-pixel-height window))
|
||
(min-delta
|
||
(- (window-pixel-height root)
|
||
(window-min-size root nil nil t))))
|
||
;; Sanitize DELTA.
|
||
(cond
|
||
((<= (+ height delta) 0)
|
||
(setq delta (- (frame-char-height (window-frame window)) height)))
|
||
((> delta min-delta)
|
||
(setq delta min-delta)))
|
||
|
||
(unless (zerop delta)
|
||
;; Resize now.
|
||
(window--resize-reset frame)
|
||
;; Ideally we should be able to resize just the last child of root
|
||
;; here. See the comment in `resize-root-window-vertically' for
|
||
;; why we do not do that.
|
||
(window--resize-this-window root (- delta) nil nil t)
|
||
(set-window-new-pixel window (+ height delta))
|
||
;; The following routine catches the case where we want to resize
|
||
;; a minibuffer-only frame.
|
||
(when (resize-mini-window-internal window)
|
||
(window--pixel-to-total frame)
|
||
(run-window-configuration-change-hook frame))))))
|
||
|
||
(defun window--resize-apply-p (frame &optional horizontal)
|
||
"Return t when a window on FRAME shall be resized vertically.
|
||
Optional argument HORIZONTAL non-nil means return t when a window
|
||
shall be resized horizontally."
|
||
(catch 'apply
|
||
(walk-window-tree
|
||
(lambda (window)
|
||
(unless (= (window-new-pixel window)
|
||
(window-size window horizontal t))
|
||
(throw 'apply t)))
|
||
frame t)
|
||
nil))
|
||
|
||
(defun window-resize (window delta &optional horizontal ignore pixelwise)
|
||
"Resize WINDOW vertically by DELTA lines.
|
||
WINDOW can be an arbitrary window and defaults to the selected
|
||
one. An attempt to resize the root window of a frame will raise
|
||
an error though.
|
||
|
||
DELTA a positive number means WINDOW shall be enlarged by DELTA
|
||
lines. DELTA negative means WINDOW shall be shrunk by -DELTA
|
||
lines.
|
||
|
||
Optional argument HORIZONTAL non-nil means resize WINDOW
|
||
horizontally by DELTA columns. In this case a positive DELTA
|
||
means enlarge WINDOW by DELTA columns. DELTA negative means
|
||
WINDOW shall be shrunk by -DELTA columns.
|
||
|
||
Optional argument IGNORE non-nil means ignore restrictions
|
||
imposed by fixed size windows, `window-min-height' or
|
||
`window-min-width' settings. If IGNORE is a window, ignore
|
||
restrictions for that window only. If IGNORE equals `safe',
|
||
live windows may get as small as `window-safe-min-height' lines
|
||
and `window-safe-min-width' columns. Any other non-nil value
|
||
means ignore all of the above restrictions for all windows.
|
||
|
||
Optional argument PIXELWISE non-nil means resize WINDOW by DELTA
|
||
pixels.
|
||
|
||
This function resizes other windows proportionally and never
|
||
deletes any windows. If you want to move only the low (right)
|
||
edge of WINDOW consider using `adjust-window-trailing-edge'
|
||
instead."
|
||
(setq window (window-normalize-window window))
|
||
(let* ((frame (window-frame window))
|
||
(minibuffer-window (minibuffer-window frame))
|
||
sibling)
|
||
(setq delta (window--size-to-pixel
|
||
window delta horizontal pixelwise t))
|
||
(cond
|
||
((eq window (frame-root-window frame))
|
||
(error "Cannot resize the root window of a frame"))
|
||
((window-minibuffer-p window)
|
||
(if horizontal
|
||
(error "Cannot resize minibuffer window horizontally")
|
||
(window--resize-mini-window window delta)))
|
||
((and (not horizontal)
|
||
(window-full-height-p window)
|
||
(eq (window-frame minibuffer-window) frame)
|
||
(or (not resize-mini-windows)
|
||
(eq minibuffer-window (active-minibuffer-window))))
|
||
;; If WINDOW is full height and either `resize-mini-windows' is
|
||
;; nil or the minibuffer window is active, resize the minibuffer
|
||
;; window.
|
||
(window--resize-mini-window minibuffer-window (- delta)))
|
||
((window--resizable-p
|
||
window delta horizontal ignore nil nil nil t)
|
||
(window--resize-reset frame horizontal)
|
||
(window--resize-this-window window delta horizontal ignore t)
|
||
(if (and (not window-combination-resize)
|
||
(window-combined-p window horizontal)
|
||
(setq sibling (or (window-right window) (window-left window)))
|
||
(window-sizable-p
|
||
sibling (- delta) horizontal ignore t))
|
||
;; If window-combination-resize is nil, WINDOW is part of an
|
||
;; iso-combination, and WINDOW's neighboring right or left
|
||
;; sibling can be resized as requested, resize that sibling.
|
||
(let ((normal-delta
|
||
(/ (float delta)
|
||
(window-size (window-parent window) horizontal t))))
|
||
(window--resize-this-window sibling (- delta) horizontal nil t)
|
||
(set-window-new-normal
|
||
window (+ (window-normal-size window horizontal)
|
||
normal-delta))
|
||
(set-window-new-normal
|
||
sibling (- (window-normal-size sibling horizontal)
|
||
normal-delta)))
|
||
;; Otherwise, resize all other windows in the same combination.
|
||
(window--resize-siblings window delta horizontal ignore))
|
||
(when (window--resize-apply-p frame horizontal)
|
||
(if (window-resize-apply frame horizontal)
|
||
(progn
|
||
(window--pixel-to-total frame horizontal)
|
||
(run-window-configuration-change-hook frame))
|
||
(error "Failed to apply resizing %s" window))))
|
||
(t
|
||
(error "Cannot resize window %s" window)))))
|
||
|
||
(defun window-resize-no-error (window delta &optional horizontal ignore pixelwise)
|
||
"Resize WINDOW vertically if it is resizable by DELTA lines.
|
||
This function is like `window-resize' but does not signal an
|
||
error when WINDOW cannot be resized. For the meaning of the
|
||
optional arguments see the documentation of `window-resize'.
|
||
|
||
Optional argument PIXELWISE non-nil means interpret DELTA as
|
||
pixels."
|
||
(when (window--resizable-p
|
||
window delta horizontal ignore nil nil nil pixelwise)
|
||
(window-resize window delta horizontal ignore pixelwise)))
|
||
|
||
(defun window--resize-child-windows-skip-p (window)
|
||
"Return non-nil if WINDOW shall be skipped by resizing routines."
|
||
(memq (window-new-normal window) '(ignore stuck skip)))
|
||
|
||
(defun window--resize-child-windows-normal (parent horizontal window this-delta &optional trail other-delta)
|
||
"Recursively set new normal height of child windows of window PARENT.
|
||
HORIZONTAL non-nil means set the new normal width of these
|
||
windows. WINDOW specifies a child window of PARENT that has been
|
||
resized by THIS-DELTA lines (columns).
|
||
|
||
Optional argument TRAIL either `before' or `after' means set values
|
||
only for windows before or after WINDOW. Optional argument
|
||
OTHER-DELTA, a number, specifies that this many lines (columns)
|
||
have been obtained from (or returned to) an ancestor window of
|
||
PARENT in order to resize WINDOW."
|
||
(let* ((delta-normal
|
||
(if (and (= (- this-delta)
|
||
(window-size window horizontal t))
|
||
(zerop other-delta))
|
||
;; When WINDOW gets deleted and we can return its entire
|
||
;; space to its siblings, use WINDOW's normal size as the
|
||
;; normal delta.
|
||
(- (window-normal-size window horizontal))
|
||
;; In any other case calculate the normal delta from the
|
||
;; relation of THIS-DELTA to the total size of PARENT.
|
||
(/ (float this-delta)
|
||
(window-size parent horizontal t))))
|
||
(sub (window-child parent))
|
||
(parent-normal 0.0)
|
||
(skip (eq trail 'after)))
|
||
|
||
;; Set parent-normal to the sum of the normal sizes of all child
|
||
;; windows of PARENT that shall be resized, excluding only WINDOW
|
||
;; and any windows specified by the optional TRAIL argument.
|
||
(while sub
|
||
(cond
|
||
((eq sub window)
|
||
(setq skip (eq trail 'before)))
|
||
(skip)
|
||
(t
|
||
(setq parent-normal
|
||
(+ parent-normal (window-normal-size sub horizontal)))))
|
||
(setq sub (window-right sub)))
|
||
|
||
;; Set the new normal size of all child windows of PARENT from what
|
||
;; they should have contributed for recovering THIS-DELTA lines
|
||
;; (columns).
|
||
(setq sub (window-child parent))
|
||
(setq skip (eq trail 'after))
|
||
(while sub
|
||
(cond
|
||
((eq sub window)
|
||
(setq skip (eq trail 'before)))
|
||
(skip)
|
||
(t
|
||
(let ((old-normal (window-normal-size sub horizontal)))
|
||
(set-window-new-normal
|
||
sub (min 1.0 ; Don't get larger than 1.
|
||
(max (- old-normal
|
||
(* (/ old-normal parent-normal)
|
||
delta-normal))
|
||
;; Don't drop below 0.
|
||
0.0))))))
|
||
(setq sub (window-right sub)))
|
||
|
||
(when (numberp other-delta)
|
||
;; Set the new normal size of windows from what they should have
|
||
;; contributed for recovering OTHER-DELTA lines (columns).
|
||
(setq delta-normal (/ (float (window-size parent horizontal t))
|
||
(+ (window-size parent horizontal t)
|
||
other-delta)))
|
||
(setq sub (window-child parent))
|
||
(setq skip (eq trail 'after))
|
||
(while sub
|
||
(cond
|
||
((eq sub window)
|
||
(setq skip (eq trail 'before)))
|
||
(skip)
|
||
(t
|
||
(set-window-new-normal
|
||
sub (min 1.0 ; Don't get larger than 1.
|
||
(max (* (window-new-normal sub) delta-normal)
|
||
;; Don't drop below 0.
|
||
0.0)))))
|
||
(setq sub (window-right sub))))
|
||
|
||
;; Set the new normal size of WINDOW to what is left by the sum of
|
||
;; the normal sizes of its siblings.
|
||
(set-window-new-normal
|
||
window
|
||
(let ((sum 0))
|
||
(setq sub (window-child parent))
|
||
(while sub
|
||
(cond
|
||
((eq sub window))
|
||
((not (numberp (window-new-normal sub)))
|
||
(setq sum (+ sum (window-normal-size sub horizontal))))
|
||
(t
|
||
(setq sum (+ sum (window-new-normal sub)))))
|
||
(setq sub (window-right sub)))
|
||
;; Don't get larger than 1 or smaller than 0.
|
||
(min 1.0 (max (- 1.0 sum) 0.0))))))
|
||
|
||
(defun window--resize-child-windows (parent delta &optional horizontal window ignore trail edge char-size)
|
||
"Resize child windows of window PARENT vertically by DELTA pixels.
|
||
PARENT must be a vertically combined internal window.
|
||
|
||
Optional argument HORIZONTAL non-nil means resize child windows
|
||
of PARENT horizontally by DELTA pixels. In this case PARENT must
|
||
be a horizontally combined internal window.
|
||
|
||
WINDOW, if specified, must denote a child window of PARENT that
|
||
is resized by DELTA pixels.
|
||
|
||
Optional argument IGNORE non-nil means ignore restrictions
|
||
imposed by fixed size windows, `window-min-height' or
|
||
`window-min-width' settings. If IGNORE equals `safe', live
|
||
windows may get as small as `window-safe-min-height' lines and
|
||
`window-safe-min-width' columns. If IGNORE is a window, ignore
|
||
restrictions for that window only. Any other non-nil value means
|
||
ignore all of the above restrictions for all windows.
|
||
|
||
Optional arguments TRAIL and EDGE, when non-nil, restrict the set
|
||
of windows that shall be resized. If TRAIL equals `before',
|
||
resize only windows on the left or above EDGE. If TRAIL equals
|
||
`after', resize only windows on the right or below EDGE. Also,
|
||
preferably only resize windows adjacent to EDGE.
|
||
|
||
If the optional argument CHAR-SIZE is a positive integer, it specifies
|
||
the number of pixels by which windows are incrementally resized.
|
||
If CHAR-SIZE is nil, this means to use the value of
|
||
`frame-char-height' or `frame-char-width' of WINDOW's frame.
|
||
|
||
Return the symbol `normalized' if new normal sizes have been
|
||
already set by this routine."
|
||
(let* ((first (window-child parent))
|
||
(last (window-last-child parent))
|
||
(parent-total (+ (window-size parent horizontal t)
|
||
delta))
|
||
(char-size (or char-size
|
||
(and window-resize-pixelwise 1)
|
||
(frame-char-size window horizontal)))
|
||
sub best-window best-value best-delta)
|
||
|
||
(if (and edge (memq trail '(before after))
|
||
(progn
|
||
(setq sub first)
|
||
(while (and (window-right sub)
|
||
(or (and (eq trail 'before)
|
||
(not (window--resize-child-windows-skip-p
|
||
(window-right sub))))
|
||
(and (eq trail 'after)
|
||
(window--resize-child-windows-skip-p sub))))
|
||
(setq sub (window-right sub)))
|
||
sub)
|
||
(if horizontal
|
||
(if (eq trail 'before)
|
||
(= (+ (window-pixel-left sub) (window-pixel-width sub))
|
||
edge)
|
||
(= (window-pixel-left sub) edge))
|
||
(if (eq trail 'before)
|
||
(= (+ (window-pixel-top sub) (window-pixel-height sub))
|
||
edge)
|
||
(= (window-pixel-top sub) edge)))
|
||
(window-sizable-p sub delta horizontal ignore t))
|
||
;; Resize only windows adjacent to EDGE.
|
||
(progn
|
||
(window--resize-this-window
|
||
sub delta horizontal ignore t trail edge)
|
||
(if (and window (eq (window-parent sub) parent))
|
||
(progn
|
||
;; Assign new normal sizes.
|
||
(set-window-new-normal
|
||
sub (/ (float (window-new-pixel sub)) parent-total))
|
||
(set-window-new-normal
|
||
window (- (window-normal-size window horizontal)
|
||
(- (window-new-normal sub)
|
||
(window-normal-size sub horizontal)))))
|
||
(window--resize-child-windows-normal
|
||
parent horizontal sub 0 trail delta))
|
||
;; Return 'normalized to notify `window--resize-siblings' that
|
||
;; normal sizes have been already set.
|
||
'normalized)
|
||
;; Resize all windows proportionally.
|
||
(setq sub last)
|
||
(while sub
|
||
(cond
|
||
((or (window--resize-child-windows-skip-p sub)
|
||
;; Ignore windows to skip and fixed-size child windows -
|
||
;; in the latter case make it a window to skip.
|
||
(and (not ignore)
|
||
(window-size-fixed-p sub horizontal)
|
||
(set-window-new-normal sub 'ignore))))
|
||
((< delta 0)
|
||
;; When shrinking store the number of lines/cols we can get
|
||
;; from this window here together with the total/normal size
|
||
;; factor.
|
||
(set-window-new-normal
|
||
sub
|
||
(cons
|
||
;; We used to call this with NODOWN t, "fixed" 2011-05-11.
|
||
(window-min-delta sub horizontal ignore trail t nil t)
|
||
(- (/ (float (window-size sub horizontal t))
|
||
parent-total)
|
||
(window-normal-size sub horizontal)))))
|
||
((> delta 0)
|
||
;; When enlarging store the total/normal size factor only
|
||
(set-window-new-normal
|
||
sub
|
||
(- (/ (float (window-size sub horizontal t))
|
||
parent-total)
|
||
(window-normal-size sub horizontal)))))
|
||
|
||
(setq sub (window-left sub)))
|
||
|
||
(cond
|
||
((< delta 0)
|
||
;; Shrink windows by delta.
|
||
(setq best-window t)
|
||
(while (and best-window (not (zerop delta)))
|
||
(setq sub last)
|
||
(setq best-window nil)
|
||
(setq best-value most-negative-fixnum)
|
||
(while sub
|
||
(when (and (consp (window-new-normal sub))
|
||
(not (<= (car (window-new-normal sub)) 0))
|
||
(> (cdr (window-new-normal sub)) best-value))
|
||
(setq best-window sub)
|
||
(setq best-value (cdr (window-new-normal sub))))
|
||
|
||
(setq sub (window-left sub)))
|
||
|
||
(when best-window
|
||
(setq best-delta (min (car (window-new-normal best-window))
|
||
char-size (- delta)))
|
||
(setq delta (+ delta best-delta))
|
||
(set-window-new-pixel best-window (- best-delta) t)
|
||
(set-window-new-normal
|
||
best-window
|
||
(if (= (car (window-new-normal best-window)) best-delta)
|
||
'skip ; We can't shrink best-window any further.
|
||
(cons (- (car (window-new-normal best-window)) best-delta)
|
||
(- (/ (float (window-new-pixel best-window))
|
||
parent-total)
|
||
(window-normal-size best-window horizontal))))))))
|
||
((> delta 0)
|
||
;; Enlarge windows by delta.
|
||
(setq best-window t)
|
||
(while (and best-window (not (zerop delta)))
|
||
(setq sub last)
|
||
(setq best-window nil)
|
||
(setq best-value most-positive-fixnum)
|
||
(while sub
|
||
(when (and (numberp (window-new-normal sub))
|
||
(< (window-new-normal sub) best-value))
|
||
(setq best-window sub)
|
||
(setq best-value (window-new-normal sub)))
|
||
|
||
(setq sub (window-left sub)))
|
||
|
||
(when best-window
|
||
(setq best-delta (min delta char-size))
|
||
(setq delta (- delta best-delta))
|
||
(set-window-new-pixel best-window best-delta t)
|
||
(set-window-new-normal
|
||
best-window
|
||
(- (/ (float (window-new-pixel best-window))
|
||
parent-total)
|
||
(window-normal-size best-window horizontal)))))))
|
||
|
||
(when best-window
|
||
(setq sub last)
|
||
(while sub
|
||
(when (or (consp (window-new-normal sub))
|
||
(numberp (window-new-normal sub)))
|
||
;; Reset new normal size fields so `window-resize-apply'
|
||
;; won't use them to apply new sizes.
|
||
(set-window-new-normal sub))
|
||
|
||
(unless (eq (window-new-normal sub) 'ignore)
|
||
;; Resize this window's child windows (back-engineering
|
||
;; delta from sub's old and new total sizes).
|
||
(let ((delta (- (window-new-pixel sub)
|
||
(window-size sub horizontal t))))
|
||
(unless (and (zerop delta) (not trail))
|
||
;; For the TRAIL non-nil case we have to resize SUB
|
||
;; recursively even if it's size does not change.
|
||
(window--resize-this-window
|
||
sub delta horizontal ignore nil trail edge))))
|
||
(setq sub (window-left sub)))))))
|
||
|
||
(defun window--resize-siblings (window delta &optional horizontal ignore trail edge char-size)
|
||
"Resize other windows when WINDOW is resized vertically by DELTA pixels.
|
||
Optional argument HORIZONTAL non-nil means resize other windows
|
||
when WINDOW is resized horizontally by DELTA pixels. WINDOW
|
||
itself is not resized by this function.
|
||
|
||
Optional argument IGNORE non-nil means ignore restrictions
|
||
imposed by fixed size windows, `window-min-height' or
|
||
`window-min-width' settings. If IGNORE equals `safe', live
|
||
windows may get as small as `window-safe-min-height' lines and
|
||
`window-safe-min-width' columns. If IGNORE is a window, ignore
|
||
restrictions for that window only. Any other non-nil value means
|
||
ignore all of the above restrictions for all windows.
|
||
|
||
Optional arguments TRAIL and EDGE, when non-nil, refine the set
|
||
of windows that shall be resized. If TRAIL equals `before',
|
||
resize only windows on the left or above EDGE. If TRAIL equals
|
||
`after', resize only windows on the right or below EDGE. Also,
|
||
preferably only resize windows adjacent to EDGE."
|
||
(when (window-parent window)
|
||
(let* ((parent (window-parent window))
|
||
(sub (window-child parent)))
|
||
(if (window-combined-p sub horizontal)
|
||
;; In an iso-combination try to extract DELTA from WINDOW's
|
||
;; siblings.
|
||
(let ((skip (eq trail 'after))
|
||
this-delta other-delta)
|
||
;; Decide which windows shall be left alone.
|
||
(while sub
|
||
(cond
|
||
((eq sub window)
|
||
;; Make sure WINDOW is left alone when
|
||
;; resizing its siblings.
|
||
(set-window-new-normal sub 'ignore)
|
||
(setq skip (eq trail 'before)))
|
||
(skip
|
||
;; Make sure this sibling is left alone when
|
||
;; resizing its siblings.
|
||
(set-window-new-normal sub 'ignore))
|
||
((or (window--size-ignore-p sub ignore)
|
||
(not (window-size-fixed-p sub horizontal)))
|
||
;; Set this-delta to t to signal that we found a sibling
|
||
;; of WINDOW whose size is not fixed.
|
||
(setq this-delta t)))
|
||
|
||
(setq sub (window-right sub)))
|
||
|
||
;; Set this-delta to what we can get from WINDOW's siblings.
|
||
(if (= (- delta) (window-size window horizontal t))
|
||
;; A deletion, presumably. We must handle this case
|
||
;; specially since `window--resizable' can't be used.
|
||
(if this-delta
|
||
;; There's at least one resizable sibling we can
|
||
;; give WINDOW's size to.
|
||
(setq this-delta delta)
|
||
;; No resizable sibling exists.
|
||
(setq this-delta 0))
|
||
;; Any other form of resizing.
|
||
(setq this-delta
|
||
(window--resizable
|
||
window delta horizontal ignore trail t nil t)))
|
||
|
||
;; Set other-delta to what we still have to get from
|
||
;; ancestor windows of parent.
|
||
(setq other-delta (- delta this-delta))
|
||
(unless (zerop other-delta)
|
||
;; Unless we got everything from WINDOW's siblings, PARENT
|
||
;; must be resized by other-delta lines or columns.
|
||
(set-window-new-pixel parent other-delta 'add))
|
||
|
||
(if (zerop this-delta)
|
||
;; We haven't got anything from WINDOW's siblings but we
|
||
;; must update the normal sizes to respect other-delta.
|
||
(window--resize-child-windows-normal
|
||
parent horizontal window this-delta trail other-delta)
|
||
;; We did get something from WINDOW's siblings which means
|
||
;; we have to resize their child windows.
|
||
(unless (eq (window--resize-child-windows
|
||
parent (- this-delta) horizontal
|
||
window ignore trail edge char-size)
|
||
;; If `window--resize-child-windows' returns
|
||
;; 'normalized, this means it has set the
|
||
;; normal sizes already.
|
||
'normalized)
|
||
;; Set the normal sizes.
|
||
(window--resize-child-windows-normal
|
||
parent horizontal window this-delta trail other-delta))
|
||
;; Set DELTA to what we still have to get from ancestor
|
||
;; windows.
|
||
(setq delta other-delta)))
|
||
|
||
;; In an ortho-combination all siblings of WINDOW must be
|
||
;; resized by DELTA.
|
||
(set-window-new-pixel parent delta 'add)
|
||
(while sub
|
||
(unless (eq sub window)
|
||
(window--resize-this-window
|
||
sub delta horizontal ignore t))
|
||
(setq sub (window-right sub))))
|
||
|
||
(unless (zerop delta)
|
||
;; "Go up."
|
||
(window--resize-siblings
|
||
parent delta horizontal ignore trail edge char-size)))))
|
||
|
||
(defun window--resize-this-window (window delta &optional horizontal ignore add trail edge char-size)
|
||
"Resize WINDOW vertically by DELTA pixels.
|
||
Optional argument HORIZONTAL non-nil means resize WINDOW
|
||
horizontally by DELTA pixels.
|
||
|
||
Optional argument IGNORE non-nil means ignore restrictions
|
||
imposed by fixed size windows, `window-min-height' or
|
||
`window-min-width' settings. If IGNORE equals `safe', live
|
||
windows may get as small as `window-safe-min-height' lines and
|
||
`window-safe-min-width' columns. If IGNORE is a window, ignore
|
||
restrictions for that window only. Any other non-nil value
|
||
means ignore all of the above restrictions for all windows.
|
||
|
||
Optional argument ADD non-nil means add DELTA to the new total
|
||
size of WINDOW.
|
||
|
||
Optional arguments TRAIL and EDGE, when non-nil, refine the set
|
||
of windows that shall be resized. If TRAIL equals `before',
|
||
resize only windows on the left or above EDGE. If TRAIL equals
|
||
`after', resize only windows on the right or below EDGE. Also,
|
||
preferably only resize windows adjacent to EDGE.
|
||
|
||
If the optional argument CHAR-SIZE is a positive integer, it specifies
|
||
the number of pixels by which windows are incrementally resized.
|
||
If CHAR-SIZE is nil, this means to use the value of
|
||
`frame-char-height' or `frame-char-width' of WINDOW's frame.
|
||
|
||
This function recursively resizes WINDOW's child windows to fit the
|
||
new size. Make sure that WINDOW is `window--resizable' before
|
||
calling this function. Note that this function does not resize
|
||
siblings of WINDOW or WINDOW's parent window. You have to
|
||
eventually call `window-resize-apply' in order to make resizing
|
||
actually take effect."
|
||
(when add
|
||
;; Add DELTA to the new total size of WINDOW.
|
||
(set-window-new-pixel window delta t))
|
||
|
||
(let ((sub (window-child window)))
|
||
(cond
|
||
((not sub))
|
||
((window-combined-p sub horizontal)
|
||
;; In an iso-combination resize child windows according to their
|
||
;; normal sizes.
|
||
(window--resize-child-windows
|
||
window delta horizontal nil ignore trail edge char-size))
|
||
;; In an ortho-combination resize each child window by DELTA.
|
||
(t
|
||
(while sub
|
||
(window--resize-this-window
|
||
sub delta horizontal ignore t trail edge char-size)
|
||
(setq sub (window-right sub)))))))
|
||
|
||
(defun window--resize-root-window (window delta horizontal ignore pixelwise)
|
||
"Resize root window WINDOW vertically by DELTA lines.
|
||
HORIZONTAL non-nil means resize root window WINDOW horizontally
|
||
by DELTA columns.
|
||
|
||
IGNORE non-nil means ignore any restrictions imposed by fixed
|
||
size windows, `window-min-height' or `window-min-width' settings.
|
||
|
||
This function is only called by the frame resizing routines. It
|
||
resizes windows proportionally and never deletes any windows."
|
||
(when (and (windowp window) (numberp delta))
|
||
(let ((pixel-delta
|
||
(if pixelwise
|
||
delta
|
||
(window--size-to-pixel window delta horizontal))))
|
||
(when (window-sizable-p window pixel-delta horizontal ignore t)
|
||
(window--resize-reset (window-frame window) horizontal)
|
||
(window--resize-this-window
|
||
window pixel-delta horizontal ignore t)))))
|
||
|
||
(defun window--resize-root-window-vertically (window delta pixelwise)
|
||
"Resize root window WINDOW vertically by DELTA lines.
|
||
If DELTA is less than zero and we can't shrink WINDOW by DELTA
|
||
lines, shrink it as much as possible. If DELTA is greater than
|
||
zero, this function can resize fixed-size windows in order to
|
||
recover the necessary lines. Return the number of lines that
|
||
were recovered.
|
||
|
||
Third argument PIXELWISE non-nil means to interpret DELTA as
|
||
pixels and return the number of pixels that were recovered.
|
||
|
||
This function is called by the minibuffer window resizing
|
||
routines."
|
||
(let* ((frame (window-frame window))
|
||
(pixel-delta
|
||
(cond
|
||
(pixelwise
|
||
delta)
|
||
((numberp delta)
|
||
(* (frame-char-height frame) delta))
|
||
(t 0)))
|
||
ignore)
|
||
(cond
|
||
((zerop pixel-delta))
|
||
((< pixel-delta 0)
|
||
(setq pixel-delta (window-sizable window pixel-delta nil nil pixelwise))
|
||
(window--resize-reset frame)
|
||
;; When shrinking the root window, emulate an edge drag in order
|
||
;; to not resize other windows if we can avoid it (Bug#12419).
|
||
(window--resize-this-window
|
||
window pixel-delta nil ignore t 'before
|
||
(+ (window-pixel-top window) (window-pixel-height window)))
|
||
;; Don't record new normal sizes to make sure that shrinking back
|
||
;; proportionally works as intended.
|
||
(walk-window-tree
|
||
(lambda (window) (set-window-new-normal window 'ignore)) frame t))
|
||
((> pixel-delta 0)
|
||
(window--resize-reset frame)
|
||
(unless (window-sizable window pixel-delta nil nil pixelwise)
|
||
(setq ignore t))
|
||
;; When growing the root window, resize proportionally. This
|
||
;; should give windows back their original sizes (hopefully).
|
||
(window--resize-this-window
|
||
window pixel-delta nil ignore t)))
|
||
;; Return the possibly adjusted DELTA.
|
||
(if pixelwise
|
||
pixel-delta
|
||
(/ pixel-delta (frame-char-height frame)))))
|
||
|
||
(defun adjust-window-trailing-edge (window delta &optional horizontal pixelwise)
|
||
"Move WINDOW's bottom edge by DELTA lines.
|
||
Optional argument HORIZONTAL non-nil means move WINDOW's right
|
||
edge by DELTA columns. WINDOW must be a valid window and
|
||
defaults to the selected one.
|
||
|
||
Optional argument PIXELWISE non-nil means interpret DELTA as
|
||
number of pixels.
|
||
|
||
If DELTA is greater than zero, move the edge downwards or to the
|
||
right. If DELTA is less than zero, move the edge upwards or to
|
||
the left. If the edge can't be moved by DELTA lines or columns,
|
||
move it as far as possible in the desired direction."
|
||
(setq window (window-normalize-window window))
|
||
(let* ((frame (window-frame window))
|
||
(minibuffer-window (minibuffer-window frame))
|
||
(right window)
|
||
left this-delta min-delta max-delta)
|
||
|
||
(unless pixelwise
|
||
(setq pixelwise t)
|
||
(setq delta (* delta (frame-char-size window horizontal))))
|
||
|
||
;; Find the edge we want to move.
|
||
(while (and (or (not (window-combined-p right horizontal))
|
||
(not (window-right right)))
|
||
(setq right (window-parent right))))
|
||
(cond
|
||
((and (not right) (not horizontal)
|
||
;; Resize the minibuffer window if it's on the same frame as
|
||
;; and immediately below WINDOW and it's either active or
|
||
;; `resize-mini-windows' is nil.
|
||
(eq (window-frame minibuffer-window) frame)
|
||
(= (nth 1 (window-pixel-edges minibuffer-window))
|
||
(nth 3 (window-pixel-edges window)))
|
||
(or (not resize-mini-windows)
|
||
(eq minibuffer-window (active-minibuffer-window))))
|
||
(window--resize-mini-window minibuffer-window (- delta)))
|
||
((or (not (setq left right)) (not (setq right (window-right right))))
|
||
(if horizontal
|
||
(error "No window on the right of this one")
|
||
(error "No window below this one")))
|
||
(t
|
||
;; Set LEFT to the first resizable window on the left. This step is
|
||
;; needed to handle fixed-size windows.
|
||
(while (and left (window-size-fixed-p left horizontal))
|
||
(setq left
|
||
(or (window-left left)
|
||
(progn
|
||
(while (and (setq left (window-parent left))
|
||
(not (window-combined-p left horizontal))))
|
||
(window-left left)))))
|
||
(unless left
|
||
(if horizontal
|
||
(error "No resizable window on the left of this one")
|
||
(error "No resizable window above this one")))
|
||
|
||
;; Set RIGHT to the first resizable window on the right. This step
|
||
;; is needed to handle fixed-size windows.
|
||
(while (and right (window-size-fixed-p right horizontal))
|
||
(setq right
|
||
(or (window-right right)
|
||
(progn
|
||
(while (and (setq right (window-parent right))
|
||
(not (window-combined-p right horizontal))))
|
||
(window-right right)))))
|
||
(unless right
|
||
(if horizontal
|
||
(error "No resizable window on the right of this one")
|
||
(error "No resizable window below this one")))
|
||
|
||
;; LEFT and RIGHT (which might be both internal windows) are now the
|
||
;; two windows we want to resize.
|
||
(cond
|
||
((> delta 0)
|
||
(setq max-delta
|
||
(window--max-delta-1
|
||
left 0 horizontal nil 'after nil pixelwise))
|
||
(setq min-delta
|
||
(window--min-delta-1
|
||
right (- delta) horizontal nil 'before nil pixelwise))
|
||
(when (or (< max-delta delta) (> min-delta (- delta)))
|
||
;; We can't get the whole DELTA - move as far as possible.
|
||
(setq delta (min max-delta (- min-delta))))
|
||
(unless (zerop delta)
|
||
;; Start resizing.
|
||
(window--resize-reset frame horizontal)
|
||
;; Try to enlarge LEFT first.
|
||
(setq this-delta (window--resizable
|
||
left delta horizontal nil 'after nil nil pixelwise))
|
||
(unless (zerop this-delta)
|
||
(window--resize-this-window
|
||
left this-delta horizontal nil t 'before
|
||
(if horizontal
|
||
(+ (window-pixel-left left) (window-pixel-width left))
|
||
(+ (window-pixel-top left) (window-pixel-height left)))))
|
||
;; Shrink windows on right of LEFT.
|
||
(window--resize-siblings
|
||
left delta horizontal nil 'after
|
||
(if horizontal
|
||
(window-pixel-left right)
|
||
(window-pixel-top right)))))
|
||
((< delta 0)
|
||
(setq max-delta
|
||
(window--max-delta-1
|
||
right 0 horizontal nil 'before nil pixelwise))
|
||
(setq min-delta
|
||
(window--min-delta-1
|
||
left delta horizontal nil 'after nil pixelwise))
|
||
(when (or (< max-delta (- delta)) (> min-delta delta))
|
||
;; We can't get the whole DELTA - move as far as possible.
|
||
(setq delta (max (- max-delta) min-delta)))
|
||
(unless (zerop delta)
|
||
;; Start resizing.
|
||
(window--resize-reset frame horizontal)
|
||
;; Try to enlarge RIGHT.
|
||
(setq this-delta
|
||
(window--resizable
|
||
right (- delta) horizontal nil 'before nil nil pixelwise))
|
||
(unless (zerop this-delta)
|
||
(window--resize-this-window
|
||
right this-delta horizontal nil t 'after
|
||
(if horizontal
|
||
(window-pixel-left right)
|
||
(window-pixel-top right))))
|
||
;; Shrink windows on left of RIGHT.
|
||
(window--resize-siblings
|
||
right (- delta) horizontal nil 'before
|
||
(if horizontal
|
||
(+ (window-pixel-left left) (window-pixel-width left))
|
||
(+ (window-pixel-top left) (window-pixel-height left)))))))
|
||
(unless (zerop delta)
|
||
;; Don't report an error in the standard case.
|
||
(when (window--resize-apply-p frame horizontal)
|
||
(if (window-resize-apply frame horizontal)
|
||
(progn
|
||
(window--pixel-to-total frame horizontal)
|
||
(run-window-configuration-change-hook frame))
|
||
;; But do report an error if applying the changes fails.
|
||
(error "Failed adjusting window %s" window))))))))
|
||
|
||
(defun enlarge-window (delta &optional horizontal)
|
||
"Make the selected window DELTA lines taller.
|
||
Interactively, if no argument is given, make the selected window
|
||
one line taller. If optional argument HORIZONTAL is non-nil,
|
||
make selected window wider by DELTA columns. If DELTA is
|
||
negative, shrink selected window by -DELTA lines or columns."
|
||
(interactive "p")
|
||
(let ((minibuffer-window (minibuffer-window)))
|
||
(cond
|
||
((zerop delta))
|
||
((window-size-fixed-p nil horizontal)
|
||
(error "Selected window has fixed size"))
|
||
((window-minibuffer-p)
|
||
(if horizontal
|
||
(error "Cannot resize minibuffer window horizontally")
|
||
(window--resize-mini-window (selected-window) delta)))
|
||
((and (not horizontal)
|
||
(window-full-height-p)
|
||
(eq (window-frame minibuffer-window) (selected-frame))
|
||
(not resize-mini-windows))
|
||
;; If the selected window is full height and `resize-mini-windows'
|
||
;; is nil, resize the minibuffer window.
|
||
(window--resize-mini-window minibuffer-window (- delta)))
|
||
((window--resizable-p nil delta horizontal)
|
||
(window-resize nil delta horizontal))
|
||
(t
|
||
(window-resize
|
||
nil (if (> delta 0)
|
||
(window-max-delta nil horizontal)
|
||
(- (window-min-delta nil horizontal)))
|
||
horizontal)))))
|
||
|
||
(defun shrink-window (delta &optional horizontal)
|
||
"Make the selected window DELTA lines smaller.
|
||
Interactively, if no argument is given, make the selected window
|
||
one line smaller. If optional argument HORIZONTAL is non-nil,
|
||
make selected window narrower by DELTA columns. If DELTA is
|
||
negative, enlarge selected window by -DELTA lines or columns.
|
||
Also see the `window-min-height' variable."
|
||
(interactive "p")
|
||
(let ((minibuffer-window (minibuffer-window)))
|
||
(cond
|
||
((zerop delta))
|
||
((window-size-fixed-p nil horizontal)
|
||
(error "Selected window has fixed size"))
|
||
((window-minibuffer-p)
|
||
(if horizontal
|
||
(error "Cannot resize minibuffer window horizontally")
|
||
(window--resize-mini-window (selected-window) (- delta))))
|
||
((and (not horizontal)
|
||
(window-full-height-p)
|
||
(eq (window-frame minibuffer-window) (selected-frame))
|
||
(not resize-mini-windows))
|
||
;; If the selected window is full height and `resize-mini-windows'
|
||
;; is nil, resize the minibuffer window.
|
||
(window--resize-mini-window minibuffer-window delta))
|
||
((window--resizable-p nil (- delta) horizontal)
|
||
(window-resize nil (- delta) horizontal))
|
||
(t
|
||
(window-resize
|
||
nil (if (> delta 0)
|
||
(- (window-min-delta nil horizontal))
|
||
(window-max-delta nil horizontal))
|
||
horizontal)))))
|
||
|
||
(defun maximize-window (&optional window)
|
||
"Maximize WINDOW.
|
||
Make WINDOW as large as possible without deleting any windows.
|
||
WINDOW must be a valid window and defaults to the selected one.
|
||
|
||
If the option `window-resize-pixelwise' is non-nil maximize
|
||
WINDOW pixelwise."
|
||
(interactive)
|
||
(setq window (window-normalize-window window))
|
||
(window-resize
|
||
window (window-max-delta window nil nil nil nil nil window-resize-pixelwise)
|
||
nil nil window-resize-pixelwise)
|
||
(window-resize
|
||
window (window-max-delta window t nil nil nil nil window-resize-pixelwise)
|
||
t nil window-resize-pixelwise))
|
||
|
||
(defun minimize-window (&optional window)
|
||
"Minimize WINDOW.
|
||
Make WINDOW as small as possible without deleting any windows.
|
||
WINDOW must be a valid window and defaults to the selected one.
|
||
|
||
If the option `window-resize-pixelwise' is non-nil minimize
|
||
WINDOW pixelwise."
|
||
(interactive)
|
||
(setq window (window-normalize-window window))
|
||
(window-resize
|
||
window
|
||
(- (window-min-delta window nil nil nil nil nil window-resize-pixelwise))
|
||
nil nil window-resize-pixelwise)
|
||
(window-resize
|
||
window
|
||
(- (window-min-delta window t nil nil nil nil window-resize-pixelwise))
|
||
t nil window-resize-pixelwise))
|
||
|
||
(defun frame-root-window-p (window)
|
||
"Return non-nil if WINDOW is the root window of its frame."
|
||
(eq window (frame-root-window window)))
|
||
|
||
(defun window--subtree (window &optional next)
|
||
"Return window subtree rooted at WINDOW.
|
||
Optional argument NEXT non-nil means include WINDOW's right
|
||
siblings in the return value.
|
||
|
||
See the documentation of `window-tree' for a description of the
|
||
return value."
|
||
(let (list)
|
||
(while window
|
||
(setq list
|
||
(cons
|
||
(cond
|
||
((window-top-child window)
|
||
(cons t (cons (window-edges window)
|
||
(window--subtree (window-top-child window) t))))
|
||
((window-left-child window)
|
||
(cons nil (cons (window-edges window)
|
||
(window--subtree (window-left-child window) t))))
|
||
(t window))
|
||
list))
|
||
(setq window (when next (window-next-sibling window))))
|
||
(nreverse list)))
|
||
|
||
(defun window-tree (&optional frame)
|
||
"Return the window tree of frame FRAME.
|
||
FRAME must be a live frame and defaults to the selected frame.
|
||
The return value is a list of the form (ROOT MINI), where ROOT
|
||
represents the window tree of the frame's root window, and MINI
|
||
is the frame's minibuffer window.
|
||
|
||
If the root window is not split, ROOT is the root window itself.
|
||
Otherwise, ROOT is a list (DIR EDGES W1 W2 ...) where DIR is nil
|
||
for a horizontal split, and t for a vertical split. EDGES gives
|
||
the combined size and position of the child windows in the split,
|
||
and the rest of the elements are the child windows in the split.
|
||
Each of the child windows may again be a window or a list
|
||
representing a window split, and so on. EDGES is a list (LEFT
|
||
TOP RIGHT BOTTOM) as returned by `window-edges'."
|
||
(setq frame (window-normalize-frame frame))
|
||
(window--subtree (frame-root-window frame) t))
|
||
|
||
(defun other-window (count &optional all-frames)
|
||
"Select another window in cyclic ordering of windows.
|
||
COUNT specifies the number of windows to skip, starting with the
|
||
selected window, before making the selection. If COUNT is
|
||
positive, skip COUNT windows forwards. If COUNT is negative,
|
||
skip -COUNT windows backwards. COUNT zero means do not skip any
|
||
window, so select the selected window. In an interactive call,
|
||
COUNT is the numeric prefix argument. Return nil.
|
||
|
||
If the `other-window' parameter of the selected window is a
|
||
function and `ignore-window-parameters' is nil, call that
|
||
function with the arguments COUNT and ALL-FRAMES.
|
||
|
||
This function does not select a window whose `no-other-window'
|
||
window parameter is non-nil.
|
||
|
||
This function uses `next-window' for finding the window to
|
||
select. The argument ALL-FRAMES has the same meaning as in
|
||
`next-window', but the MINIBUF argument of `next-window' is
|
||
always effectively nil."
|
||
(interactive "p")
|
||
(let* ((window (selected-window))
|
||
(function (and (not ignore-window-parameters)
|
||
(window-parameter window 'other-window)))
|
||
old-window old-count)
|
||
(if (functionp function)
|
||
(funcall function count all-frames)
|
||
;; `next-window' and `previous-window' may return a window we are
|
||
;; not allowed to select. Hence we need an exit strategy in case
|
||
;; all windows are non-selectable.
|
||
(catch 'exit
|
||
(while (> count 0)
|
||
(setq window (next-window window nil all-frames))
|
||
(cond
|
||
((eq window old-window)
|
||
(when (= count old-count)
|
||
;; Keep out of infinite loops. When COUNT has not changed
|
||
;; since we last looked at `window' we're probably in one.
|
||
(throw 'exit nil)))
|
||
((window-parameter window 'no-other-window)
|
||
(unless old-window
|
||
;; The first non-selectable window `next-window' got us:
|
||
;; Remember it and the current value of COUNT.
|
||
(setq old-window window)
|
||
(setq old-count count)))
|
||
(t
|
||
(setq count (1- count)))))
|
||
(while (< count 0)
|
||
(setq window (previous-window window nil all-frames))
|
||
(cond
|
||
((eq window old-window)
|
||
(when (= count old-count)
|
||
;; Keep out of infinite loops. When COUNT has not changed
|
||
;; since we last looked at `window' we're probably in one.
|
||
(throw 'exit nil)))
|
||
((window-parameter window 'no-other-window)
|
||
(unless old-window
|
||
;; The first non-selectable window `previous-window' got
|
||
;; us: Remember it and the current value of COUNT.
|
||
(setq old-window window)
|
||
(setq old-count count)))
|
||
(t
|
||
(setq count (1+ count)))))
|
||
|
||
(select-window window)
|
||
;; Always return nil.
|
||
nil))))
|
||
|
||
;; This should probably return non-nil when the selected window is part
|
||
;; of an atomic window whose root is the frame's root window.
|
||
(defun one-window-p (&optional nomini all-frames)
|
||
"Return non-nil if the selected window is the only window.
|
||
Optional arg NOMINI non-nil means don't count the minibuffer
|
||
even if it is active. Otherwise, the minibuffer is counted
|
||
when it is active.
|
||
|
||
Optional argument ALL-FRAMES specifies the set of frames to
|
||
consider, see also `next-window'. ALL-FRAMES nil or omitted
|
||
means consider windows on the selected frame only, plus the
|
||
minibuffer window if specified by the NOMINI argument. If the
|
||
minibuffer counts, consider all windows on all frames that share
|
||
that minibuffer too. The remaining non-nil values of ALL-FRAMES
|
||
with a special meaning are:
|
||
|
||
- t means consider all windows on all existing frames.
|
||
|
||
- `visible' means consider all windows on all visible frames on
|
||
the current terminal.
|
||
|
||
- 0 (the number zero) means consider all windows on all visible
|
||
and iconified frames on the current terminal.
|
||
|
||
- A frame means consider all windows on that frame only.
|
||
|
||
Anything else means consider all windows on the selected frame
|
||
and no others."
|
||
(let ((base-window (selected-window)))
|
||
(if (and nomini (eq base-window (minibuffer-window)))
|
||
(setq base-window (next-window base-window)))
|
||
(eq base-window
|
||
(next-window base-window (if nomini 'arg) all-frames))))
|
||
|
||
;;; Deleting windows.
|
||
(defun window-deletable-p (&optional window)
|
||
"Return t if WINDOW can be safely deleted from its frame.
|
||
WINDOW must be a valid window and defaults to the selected one.
|
||
Return 'frame if deleting WINDOW should also delete its frame."
|
||
(setq window (window-normalize-window window))
|
||
|
||
(unless (or ignore-window-parameters
|
||
(eq (window-parameter window 'delete-window) t))
|
||
;; Handle atomicity.
|
||
(when (window-parameter window 'window-atom)
|
||
(setq window (window-atom-root window))))
|
||
|
||
(let ((frame (window-frame window)))
|
||
(cond
|
||
((frame-root-window-p window)
|
||
;; WINDOW's frame can be deleted only if there are other frames
|
||
;; on the same terminal, and it does not contain the active
|
||
;; minibuffer.
|
||
(unless (or (eq frame (next-frame frame 0))
|
||
;; We can delete our frame only if no other frame
|
||
;; currently uses our minibuffer window.
|
||
(catch 'other
|
||
(dolist (other (frame-list))
|
||
(when (and (not (eq other frame))
|
||
(eq (window-frame (minibuffer-window other))
|
||
frame))
|
||
(throw 'other t))))
|
||
(let ((minibuf (active-minibuffer-window)))
|
||
(and minibuf (eq frame (window-frame minibuf)))))
|
||
'frame))
|
||
((or ignore-window-parameters
|
||
(not (eq window (window--major-non-side-window frame))))
|
||
;; WINDOW can be deleted unless it is the major non-side window of
|
||
;; its frame.
|
||
t))))
|
||
|
||
(defun window--in-subtree-p (window root)
|
||
"Return t if WINDOW is either ROOT or a member of ROOT's subtree."
|
||
(or (eq window root)
|
||
(let ((parent (window-parent window)))
|
||
(catch 'done
|
||
(while parent
|
||
(if (eq parent root)
|
||
(throw 'done t)
|
||
(setq parent (window-parent parent))))))))
|
||
|
||
(defun delete-window (&optional window)
|
||
"Delete WINDOW.
|
||
WINDOW must be a valid window and defaults to the selected one.
|
||
Return nil.
|
||
|
||
If the variable `ignore-window-parameters' is non-nil or the
|
||
`delete-window' parameter of WINDOW equals t, do not process any
|
||
parameters of WINDOW. Otherwise, if the `delete-window'
|
||
parameter of WINDOW specifies a function, call that function with
|
||
WINDOW as its sole argument and return the value returned by that
|
||
function.
|
||
|
||
Otherwise, if WINDOW is part of an atomic window, call
|
||
`delete-window' with the root of the atomic window as its
|
||
argument. Signal an error if WINDOW is either the only window on
|
||
its frame, the last non-side window, or part of an atomic window
|
||
that is its frame's root window."
|
||
(interactive)
|
||
(setq window (window-normalize-window window))
|
||
(let* ((frame (window-frame window))
|
||
(function (window-parameter window 'delete-window))
|
||
(parent (window-parent window))
|
||
atom-root)
|
||
(window--check frame)
|
||
(catch 'done
|
||
;; Handle window parameters.
|
||
(cond
|
||
;; Ignore window parameters if `ignore-window-parameters' tells
|
||
;; us so or `delete-window' equals t.
|
||
((or ignore-window-parameters (eq function t)))
|
||
((functionp function)
|
||
;; The `delete-window' parameter specifies the function to call.
|
||
;; If that function is `ignore' nothing is done. It's up to the
|
||
;; function called here to avoid infinite recursion.
|
||
(throw 'done (funcall function window)))
|
||
((and (window-parameter window 'window-atom)
|
||
(setq atom-root (window-atom-root window))
|
||
(not (eq atom-root window)))
|
||
(if (eq atom-root (frame-root-window frame))
|
||
(error "Root of atomic window is root window of its frame")
|
||
(throw 'done (delete-window atom-root))))
|
||
((not parent)
|
||
(error "Attempt to delete minibuffer or sole ordinary window"))
|
||
((eq window (window--major-non-side-window frame))
|
||
(error "Attempt to delete last non-side window")))
|
||
|
||
(let* ((horizontal (window-left-child parent))
|
||
(size (window-size window horizontal t))
|
||
(frame-selected
|
||
(window--in-subtree-p (frame-selected-window frame) window))
|
||
;; Emacs 23 preferably gives WINDOW's space to its left
|
||
;; sibling.
|
||
(sibling (or (window-left window) (window-right window))))
|
||
(window--resize-reset frame horizontal)
|
||
(cond
|
||
((and (not window-combination-resize)
|
||
sibling (window-sizable-p sibling size horizontal nil t))
|
||
;; Resize WINDOW's sibling.
|
||
(window--resize-this-window sibling size horizontal nil t)
|
||
(set-window-new-normal
|
||
sibling (+ (window-normal-size sibling horizontal)
|
||
(window-normal-size window horizontal))))
|
||
((window--resizable-p window (- size) horizontal nil nil nil t t)
|
||
;; Can do without resizing fixed-size windows.
|
||
(window--resize-siblings window (- size) horizontal))
|
||
(t
|
||
;; Can't do without resizing fixed-size windows.
|
||
(window--resize-siblings window (- size) horizontal t)))
|
||
;; Actually delete WINDOW.
|
||
(delete-window-internal window)
|
||
(window--pixel-to-total frame horizontal)
|
||
(when (and frame-selected
|
||
(window-parameter
|
||
(frame-selected-window frame) 'no-other-window))
|
||
;; `delete-window-internal' has selected a window that should
|
||
;; not be selected, fix this here.
|
||
(other-window -1 frame))
|
||
(run-window-configuration-change-hook frame)
|
||
(window--check frame)
|
||
;; Always return nil.
|
||
nil))))
|
||
|
||
(defun delete-other-windows (&optional window)
|
||
"Make WINDOW fill its frame.
|
||
WINDOW must be a valid window and defaults to the selected one.
|
||
Return nil.
|
||
|
||
If the variable `ignore-window-parameters' is non-nil or the
|
||
`delete-other-windows' parameter of WINDOW equals t, do not
|
||
process any parameters of WINDOW. Otherwise, if the
|
||
`delete-other-windows' parameter of WINDOW specifies a function,
|
||
call that function with WINDOW as its sole argument and return
|
||
the value returned by that function.
|
||
|
||
Otherwise, if WINDOW is part of an atomic window, call this
|
||
function with the root of the atomic window as its argument. If
|
||
WINDOW is a non-side window, make WINDOW the only non-side window
|
||
on the frame. Side windows are not deleted. If WINDOW is a side
|
||
window signal an error."
|
||
(interactive)
|
||
(setq window (window-normalize-window window))
|
||
(let* ((frame (window-frame window))
|
||
(function (window-parameter window 'delete-other-windows))
|
||
(window-side (window-parameter window 'window-side))
|
||
atom-root side-main)
|
||
(window--check frame)
|
||
(catch 'done
|
||
(cond
|
||
;; Ignore window parameters if `ignore-window-parameters' is t or
|
||
;; `delete-other-windows' is t.
|
||
((or ignore-window-parameters (eq function t)))
|
||
((functionp function)
|
||
;; The `delete-other-windows' parameter specifies the function
|
||
;; to call. If the function is `ignore' no windows are deleted.
|
||
;; It's up to the function called to avoid infinite recursion.
|
||
(throw 'done (funcall function window)))
|
||
((and (window-parameter window 'window-atom)
|
||
(setq atom-root (window-atom-root window))
|
||
(not (eq atom-root window)))
|
||
(if (eq atom-root (frame-root-window frame))
|
||
(error "Root of atomic window is root window of its frame")
|
||
(throw 'done (delete-other-windows atom-root))))
|
||
((memq window-side window-sides)
|
||
(error "Cannot make side window the only window"))
|
||
((and (window-minibuffer-p window)
|
||
(not (eq window (frame-root-window window))))
|
||
(error "Can't expand minibuffer to full frame")))
|
||
|
||
;; If WINDOW is the major non-side window, do nothing.
|
||
(if (window-with-parameter 'window-side)
|
||
(setq side-main (window--major-non-side-window frame))
|
||
(setq side-main (frame-root-window frame)))
|
||
(unless (eq window side-main)
|
||
(delete-other-windows-internal window side-main)
|
||
(run-window-configuration-change-hook frame)
|
||
(window--check frame))
|
||
;; Always return nil.
|
||
nil)))
|
||
|
||
(defun delete-other-windows-vertically (&optional window)
|
||
"Delete the windows in the same column with WINDOW, but not WINDOW itself.
|
||
This may be a useful alternative binding for \\[delete-other-windows]
|
||
if you often split windows horizontally."
|
||
(interactive)
|
||
(let* ((window (or window (selected-window)))
|
||
(edges (window-edges window))
|
||
(w window) delenda)
|
||
(while (not (eq (setq w (next-window w 1)) window))
|
||
(let ((e (window-edges w)))
|
||
(when (and (= (car e) (car edges))
|
||
(= (nth 2 e) (nth 2 edges)))
|
||
(push w delenda))))
|
||
(mapc 'delete-window delenda)))
|
||
|
||
;;; Windows and buffers.
|
||
|
||
;; `prev-buffers' and `next-buffers' are two reserved window slots used
|
||
;; for (1) determining which buffer to show in the window when its
|
||
;; buffer shall be buried or killed and (2) which buffer to show for
|
||
;; `switch-to-prev-buffer' and `switch-to-next-buffer'.
|
||
|
||
;; `prev-buffers' consists of <buffer, window-start, window-point>
|
||
;; triples. The entries on this list are ordered by the time their
|
||
;; buffer has been removed from the window, the most recently removed
|
||
;; buffer's entry being first. The window-start and window-point
|
||
;; components are `window-start' and `window-point' at the time the
|
||
;; buffer was removed from the window which implies that the entry must
|
||
;; be added when `set-window-buffer' removes the buffer from the window.
|
||
|
||
;; `next-buffers' is the list of buffers that have been replaced
|
||
;; recently by `switch-to-prev-buffer'. These buffers are the least
|
||
;; preferred candidates of `switch-to-prev-buffer' and the preferred
|
||
;; candidates of `switch-to-next-buffer' to switch to. This list is
|
||
;; reset to nil by any action changing the window's buffer with the
|
||
;; exception of `switch-to-prev-buffer' and `switch-to-next-buffer'.
|
||
;; `switch-to-prev-buffer' pushes the buffer it just replaced on it,
|
||
;; `switch-to-next-buffer' pops the last pushed buffer from it.
|
||
|
||
;; Both `prev-buffers' and `next-buffers' may reference killed buffers
|
||
;; if such a buffer was killed while the window was hidden within a
|
||
;; window configuration. Such killed buffers get removed whenever
|
||
;; `switch-to-prev-buffer' or `switch-to-next-buffer' encounter them.
|
||
|
||
;; The following function is called by `set-window-buffer' _before_ it
|
||
;; replaces the buffer of the argument window with the new buffer.
|
||
(defun record-window-buffer (&optional window)
|
||
"Record WINDOW's buffer.
|
||
WINDOW must be a live window and defaults to the selected one."
|
||
(let* ((window (window-normalize-window window t))
|
||
(buffer (window-buffer window))
|
||
(entry (assq buffer (window-prev-buffers window))))
|
||
;; Reset WINDOW's next buffers. If needed, they are resurrected by
|
||
;; `switch-to-prev-buffer' and `switch-to-next-buffer'.
|
||
(set-window-next-buffers window nil)
|
||
|
||
(when entry
|
||
;; Remove all entries for BUFFER from WINDOW's previous buffers.
|
||
(set-window-prev-buffers
|
||
window (assq-delete-all buffer (window-prev-buffers window))))
|
||
|
||
;; Don't record insignificant buffers.
|
||
(unless (eq (aref (buffer-name buffer) 0) ?\s)
|
||
;; Add an entry for buffer to WINDOW's previous buffers.
|
||
(with-current-buffer buffer
|
||
(let ((start (window-start window))
|
||
(point (window-point window)))
|
||
(setq entry
|
||
(cons buffer
|
||
(if entry
|
||
;; We have an entry, update marker positions.
|
||
(list (set-marker (nth 1 entry) start)
|
||
(set-marker (nth 2 entry) point))
|
||
;; Make new markers.
|
||
(list (copy-marker start)
|
||
(copy-marker
|
||
;; Preserve window-point-insertion-type
|
||
;; (Bug#12588).
|
||
point window-point-insertion-type)))))
|
||
(set-window-prev-buffers
|
||
window (cons entry (window-prev-buffers window)))))
|
||
|
||
(run-hooks 'buffer-list-update-hook))))
|
||
|
||
(defun unrecord-window-buffer (&optional window buffer)
|
||
"Unrecord BUFFER in WINDOW.
|
||
WINDOW must be a live window and defaults to the selected one.
|
||
BUFFER must be a live buffer and defaults to the buffer of
|
||
WINDOW."
|
||
(let* ((window (window-normalize-window window t))
|
||
(buffer (or buffer (window-buffer window))))
|
||
(set-window-prev-buffers
|
||
window (assq-delete-all buffer (window-prev-buffers window)))
|
||
(set-window-next-buffers
|
||
window (delq buffer (window-next-buffers window)))))
|
||
|
||
(defun set-window-buffer-start-and-point (window buffer &optional start point)
|
||
"Set WINDOW's buffer to BUFFER.
|
||
WINDOW must be a live window and defaults to the selected one.
|
||
Optional argument START non-nil means set WINDOW's start position
|
||
to START. Optional argument POINT non-nil means set WINDOW's
|
||
point to POINT. If WINDOW is selected this also sets BUFFER's
|
||
`point' to POINT. If WINDOW is selected and the buffer it showed
|
||
before was current this also makes BUFFER the current buffer."
|
||
(setq window (window-normalize-window window t))
|
||
(let ((selected (eq window (selected-window)))
|
||
(current (eq (window-buffer window) (current-buffer))))
|
||
(set-window-buffer window buffer)
|
||
(when (and selected current)
|
||
(set-buffer buffer))
|
||
(when start
|
||
;; Don't force window-start here (even if POINT is nil).
|
||
(set-window-start window start t))
|
||
(when point
|
||
(set-window-point window point))))
|
||
|
||
(defcustom switch-to-visible-buffer t
|
||
"If non-nil, allow switching to an already visible buffer.
|
||
If this variable is non-nil, `switch-to-prev-buffer' and
|
||
`switch-to-next-buffer' may switch to an already visible buffer
|
||
provided the buffer was shown before in the window specified as
|
||
argument to those functions. If this variable is nil,
|
||
`switch-to-prev-buffer' and `switch-to-next-buffer' always try to
|
||
avoid switching to a buffer that is already visible in another
|
||
window on the same frame."
|
||
:type 'boolean
|
||
:version "24.1"
|
||
:group 'windows)
|
||
|
||
(defun switch-to-prev-buffer (&optional window bury-or-kill)
|
||
"In WINDOW switch to previous buffer.
|
||
WINDOW must be a live window and defaults to the selected one.
|
||
Return the buffer switched to, nil if no suitable buffer could be
|
||
found.
|
||
|
||
Optional argument BURY-OR-KILL non-nil means the buffer currently
|
||
shown in WINDOW is about to be buried or killed and consequently
|
||
shall not be switched to in future invocations of this command.
|
||
|
||
As a special case, if BURY-OR-KILL equals `append', this means to
|
||
move the buffer to the end of WINDOW's previous buffers list so a
|
||
future invocation of `switch-to-prev-buffer' less likely switches
|
||
to it."
|
||
(interactive)
|
||
(let* ((window (window-normalize-window window t))
|
||
(frame (window-frame window))
|
||
(old-buffer (window-buffer window))
|
||
;; Save this since it's destroyed by `set-window-buffer'.
|
||
(next-buffers (window-next-buffers window))
|
||
(pred (frame-parameter frame 'buffer-predicate))
|
||
entry new-buffer killed-buffers visible)
|
||
(when (window-minibuffer-p window)
|
||
;; Don't switch in minibuffer window.
|
||
(unless (setq window (minibuffer-selected-window))
|
||
(error "Window %s is a minibuffer window" window)))
|
||
|
||
(when (window-dedicated-p window)
|
||
;; Don't switch in dedicated window.
|
||
(error "Window %s is dedicated to buffer %s" window old-buffer))
|
||
|
||
(catch 'found
|
||
;; Scan WINDOW's previous buffers first, skipping entries of next
|
||
;; buffers.
|
||
(dolist (entry (window-prev-buffers window))
|
||
(when (and (setq new-buffer (car entry))
|
||
(or (buffer-live-p new-buffer)
|
||
(not (setq killed-buffers
|
||
(cons new-buffer killed-buffers))))
|
||
(not (eq new-buffer old-buffer))
|
||
(or (null pred) (funcall pred new-buffer))
|
||
;; When BURY-OR-KILL is nil, avoid switching to a
|
||
;; buffer in WINDOW's next buffers list.
|
||
(or bury-or-kill (not (memq new-buffer next-buffers))))
|
||
(if (and (not switch-to-visible-buffer)
|
||
(get-buffer-window new-buffer frame))
|
||
;; Try to avoid showing a buffer visible in some other
|
||
;; window.
|
||
(setq visible new-buffer)
|
||
(set-window-buffer-start-and-point
|
||
window new-buffer (nth 1 entry) (nth 2 entry))
|
||
(throw 'found t))))
|
||
;; Scan reverted buffer list of WINDOW's frame next, skipping
|
||
;; entries of next buffers. Note that when we bury or kill a
|
||
;; buffer we don't reverse the global buffer list to avoid showing
|
||
;; a buried buffer instead. Otherwise, we must reverse the global
|
||
;; buffer list in order to make sure that switching to the
|
||
;; previous/next buffer traverse it in opposite directions.
|
||
(dolist (buffer (if bury-or-kill
|
||
(buffer-list frame)
|
||
(nreverse (buffer-list frame))))
|
||
(when (and (buffer-live-p buffer)
|
||
(not (eq buffer old-buffer))
|
||
(or (null pred) (funcall pred buffer))
|
||
(not (eq (aref (buffer-name buffer) 0) ?\s))
|
||
(or bury-or-kill (not (memq buffer next-buffers))))
|
||
(if (get-buffer-window buffer frame)
|
||
;; Try to avoid showing a buffer visible in some other window.
|
||
(unless visible
|
||
(setq visible buffer))
|
||
(setq new-buffer buffer)
|
||
(set-window-buffer-start-and-point window new-buffer)
|
||
(throw 'found t))))
|
||
(unless bury-or-kill
|
||
;; Scan reverted next buffers last (must not use nreverse
|
||
;; here!).
|
||
(dolist (buffer (reverse next-buffers))
|
||
;; Actually, buffer _must_ be live here since otherwise it
|
||
;; would have been caught in the scan of previous buffers.
|
||
(when (and (or (buffer-live-p buffer)
|
||
(not (setq killed-buffers
|
||
(cons buffer killed-buffers))))
|
||
(not (eq buffer old-buffer))
|
||
(or (null pred) (funcall pred buffer))
|
||
(setq entry (assq buffer (window-prev-buffers window))))
|
||
(setq new-buffer buffer)
|
||
(set-window-buffer-start-and-point
|
||
window new-buffer (nth 1 entry) (nth 2 entry))
|
||
(throw 'found t))))
|
||
|
||
;; Show a buffer visible in another window.
|
||
(when visible
|
||
(setq new-buffer visible)
|
||
(set-window-buffer-start-and-point window new-buffer)))
|
||
|
||
(if bury-or-kill
|
||
(let ((entry (and (eq bury-or-kill 'append)
|
||
(assq old-buffer (window-prev-buffers window)))))
|
||
;; Remove `old-buffer' from WINDOW's previous and (restored list
|
||
;; of) next buffers.
|
||
(set-window-prev-buffers
|
||
window (assq-delete-all old-buffer (window-prev-buffers window)))
|
||
(set-window-next-buffers window (delq old-buffer next-buffers))
|
||
(when entry
|
||
;; Append old-buffer's entry to list of WINDOW's previous
|
||
;; buffers so it's less likely to get switched to soon but
|
||
;; `display-buffer-in-previous-window' can nevertheless find
|
||
;; it.
|
||
(set-window-prev-buffers
|
||
window (append (window-prev-buffers window) (list entry)))))
|
||
;; Move `old-buffer' to head of WINDOW's restored list of next
|
||
;; buffers.
|
||
(set-window-next-buffers
|
||
window (cons old-buffer (delq old-buffer next-buffers))))
|
||
|
||
;; Remove killed buffers from WINDOW's previous and next buffers.
|
||
(when killed-buffers
|
||
(dolist (buffer killed-buffers)
|
||
(set-window-prev-buffers
|
||
window (assq-delete-all buffer (window-prev-buffers window)))
|
||
(set-window-next-buffers
|
||
window (delq buffer (window-next-buffers window)))))
|
||
|
||
;; Return new-buffer.
|
||
new-buffer))
|
||
|
||
(defun switch-to-next-buffer (&optional window)
|
||
"In WINDOW switch to next buffer.
|
||
WINDOW must be a live window and defaults to the selected one.
|
||
Return the buffer switched to, nil if no suitable buffer could be
|
||
found."
|
||
(interactive)
|
||
(let* ((window (window-normalize-window window t))
|
||
(frame (window-frame window))
|
||
(old-buffer (window-buffer window))
|
||
(next-buffers (window-next-buffers window))
|
||
(pred (frame-parameter frame 'buffer-predicate))
|
||
new-buffer entry killed-buffers visible)
|
||
(when (window-minibuffer-p window)
|
||
;; Don't switch in minibuffer window.
|
||
(unless (setq window (minibuffer-selected-window))
|
||
(error "Window %s is a minibuffer window" window)))
|
||
|
||
(when (window-dedicated-p window)
|
||
;; Don't switch in dedicated window.
|
||
(error "Window %s is dedicated to buffer %s" window old-buffer))
|
||
|
||
(catch 'found
|
||
;; Scan WINDOW's next buffers first.
|
||
(dolist (buffer next-buffers)
|
||
(when (and (or (buffer-live-p buffer)
|
||
(not (setq killed-buffers
|
||
(cons buffer killed-buffers))))
|
||
(not (eq buffer old-buffer))
|
||
(or (null pred) (funcall pred buffer))
|
||
(setq entry (assq buffer (window-prev-buffers window))))
|
||
(setq new-buffer buffer)
|
||
(set-window-buffer-start-and-point
|
||
window new-buffer (nth 1 entry) (nth 2 entry))
|
||
(throw 'found t)))
|
||
;; Scan the buffer list of WINDOW's frame next, skipping previous
|
||
;; buffers entries.
|
||
(dolist (buffer (buffer-list frame))
|
||
(when (and (buffer-live-p buffer)
|
||
(not (eq buffer old-buffer))
|
||
(or (null pred) (funcall pred buffer))
|
||
(not (eq (aref (buffer-name buffer) 0) ?\s))
|
||
(not (assq buffer (window-prev-buffers window))))
|
||
(if (get-buffer-window buffer frame)
|
||
;; Try to avoid showing a buffer visible in some other window.
|
||
(setq visible buffer)
|
||
(setq new-buffer buffer)
|
||
(set-window-buffer-start-and-point window new-buffer)
|
||
(throw 'found t))))
|
||
;; Scan WINDOW's reverted previous buffers last (must not use
|
||
;; nreverse here!)
|
||
(dolist (entry (reverse (window-prev-buffers window)))
|
||
(when (and (setq new-buffer (car entry))
|
||
(or (buffer-live-p new-buffer)
|
||
(not (setq killed-buffers
|
||
(cons new-buffer killed-buffers))))
|
||
(not (eq new-buffer old-buffer))
|
||
(or (null pred) (funcall pred new-buffer)))
|
||
(if (and (not switch-to-visible-buffer)
|
||
(get-buffer-window new-buffer frame))
|
||
;; Try to avoid showing a buffer visible in some other window.
|
||
(unless visible
|
||
(setq visible new-buffer))
|
||
(set-window-buffer-start-and-point
|
||
window new-buffer (nth 1 entry) (nth 2 entry))
|
||
(throw 'found t))))
|
||
|
||
;; Show a buffer visible in another window.
|
||
(when visible
|
||
(setq new-buffer visible)
|
||
(set-window-buffer-start-and-point window new-buffer)))
|
||
|
||
;; Remove `new-buffer' from and restore WINDOW's next buffers.
|
||
(set-window-next-buffers window (delq new-buffer next-buffers))
|
||
|
||
;; Remove killed buffers from WINDOW's previous and next buffers.
|
||
(when killed-buffers
|
||
(dolist (buffer killed-buffers)
|
||
(set-window-prev-buffers
|
||
window (assq-delete-all buffer (window-prev-buffers window)))
|
||
(set-window-next-buffers
|
||
window (delq buffer (window-next-buffers window)))))
|
||
|
||
;; Return new-buffer.
|
||
new-buffer))
|
||
|
||
(defun get-next-valid-buffer (list &optional buffer visible-ok frame)
|
||
"Search LIST for a valid buffer to display in FRAME.
|
||
Return nil when all buffers in LIST are undesirable for display,
|
||
otherwise return the first suitable buffer in LIST.
|
||
|
||
Buffers not visible in windows are preferred to visible buffers,
|
||
unless VISIBLE-OK is non-nil.
|
||
If the optional argument FRAME is nil, it defaults to the selected frame.
|
||
If BUFFER is non-nil, ignore occurrences of that buffer in LIST."
|
||
;; This logic is more or less copied from other-buffer.
|
||
(setq frame (or frame (selected-frame)))
|
||
(let ((pred (frame-parameter frame 'buffer-predicate))
|
||
found buf)
|
||
(while (and (not found) list)
|
||
(setq buf (car list))
|
||
(if (and (not (eq buffer buf))
|
||
(buffer-live-p buf)
|
||
(or (null pred) (funcall pred buf))
|
||
(not (eq (aref (buffer-name buf) 0) ?\s))
|
||
(or visible-ok (null (get-buffer-window buf 'visible))))
|
||
(setq found buf)
|
||
(setq list (cdr list))))
|
||
(car list)))
|
||
|
||
(defun last-buffer (&optional buffer visible-ok frame)
|
||
"Return the last buffer in FRAME's buffer list.
|
||
If BUFFER is the last buffer, return the preceding buffer
|
||
instead. Buffers not visible in windows are preferred to visible
|
||
buffers, unless optional argument VISIBLE-OK is non-nil.
|
||
Optional third argument FRAME nil or omitted means use the
|
||
selected frame's buffer list. If no such buffer exists, return
|
||
the buffer `*scratch*', creating it if necessary."
|
||
(setq frame (or frame (selected-frame)))
|
||
(or (get-next-valid-buffer (nreverse (buffer-list frame))
|
||
buffer visible-ok frame)
|
||
(get-buffer "*scratch*")
|
||
(let ((scratch (get-buffer-create "*scratch*")))
|
||
(set-buffer-major-mode scratch)
|
||
scratch)))
|
||
|
||
(defcustom frame-auto-hide-function #'iconify-frame
|
||
"Function called to automatically hide frames.
|
||
The function is called with one argument - a frame.
|
||
|
||
Functions affected by this option are those that bury a buffer
|
||
shown in a separate frame like `quit-window' and `bury-buffer'."
|
||
:type '(choice (const :tag "Iconify" iconify-frame)
|
||
(const :tag "Delete" delete-frame)
|
||
(const :tag "Do nothing" ignore)
|
||
function)
|
||
:group 'windows
|
||
:group 'frames
|
||
:version "24.1")
|
||
|
||
(defun window--delete (&optional window dedicated-only kill)
|
||
"Delete WINDOW if possible.
|
||
WINDOW must be a live window and defaults to the selected one.
|
||
Optional argument DEDICATED-ONLY non-nil means to delete WINDOW
|
||
only if it's dedicated to its buffer. Optional argument KILL
|
||
means the buffer shown in window will be killed. Return non-nil
|
||
if WINDOW gets deleted or its frame is auto-hidden."
|
||
(setq window (window-normalize-window window t))
|
||
(unless (and dedicated-only (not (window-dedicated-p window)))
|
||
(let ((deletable (window-deletable-p window)))
|
||
(cond
|
||
((eq deletable 'frame)
|
||
(let ((frame (window-frame window)))
|
||
(cond
|
||
(kill
|
||
(delete-frame frame))
|
||
((functionp frame-auto-hide-function)
|
||
(funcall frame-auto-hide-function frame))))
|
||
'frame)
|
||
(deletable
|
||
(delete-window window)
|
||
t)))))
|
||
|
||
(defun bury-buffer (&optional buffer-or-name)
|
||
"Put BUFFER-OR-NAME at the end of the list of all buffers.
|
||
There it is the least likely candidate for `other-buffer' to
|
||
return; thus, the least likely buffer for \\[switch-to-buffer] to
|
||
select by default.
|
||
|
||
You can specify a buffer name as BUFFER-OR-NAME, or an actual
|
||
buffer object. If BUFFER-OR-NAME is nil or omitted, bury the
|
||
current buffer. Also, if BUFFER-OR-NAME is nil or omitted,
|
||
remove the current buffer from the selected window if it is
|
||
displayed there."
|
||
(interactive)
|
||
(let* ((buffer (window-normalize-buffer buffer-or-name)))
|
||
;; If `buffer-or-name' is not on the selected frame we unrecord it
|
||
;; although it's not "here" (call it a feature).
|
||
(bury-buffer-internal buffer)
|
||
;; Handle case where `buffer-or-name' is nil and the current buffer
|
||
;; is shown in the selected window.
|
||
(cond
|
||
((or buffer-or-name (not (eq buffer (window-buffer)))))
|
||
((window--delete nil t))
|
||
(t
|
||
;; Switch to another buffer in window.
|
||
(set-window-dedicated-p nil nil)
|
||
(switch-to-prev-buffer nil 'bury)))
|
||
|
||
;; Always return nil.
|
||
nil))
|
||
|
||
(defun unbury-buffer ()
|
||
"Switch to the last buffer in the buffer list."
|
||
(interactive)
|
||
(switch-to-buffer (last-buffer)))
|
||
|
||
(defun next-buffer ()
|
||
"In selected window switch to next buffer."
|
||
(interactive)
|
||
(cond
|
||
((window-minibuffer-p)
|
||
(error "Cannot switch buffers in minibuffer window"))
|
||
((eq (window-dedicated-p) t)
|
||
(error "Window is strongly dedicated to its buffer"))
|
||
(t
|
||
(switch-to-next-buffer))))
|
||
|
||
(defun previous-buffer ()
|
||
"In selected window switch to previous buffer."
|
||
(interactive)
|
||
(cond
|
||
((window-minibuffer-p)
|
||
(error "Cannot switch buffers in minibuffer window"))
|
||
((eq (window-dedicated-p) t)
|
||
(error "Window is strongly dedicated to its buffer"))
|
||
(t
|
||
(switch-to-prev-buffer))))
|
||
|
||
(defun delete-windows-on (&optional buffer-or-name frame)
|
||
"Delete all windows showing BUFFER-OR-NAME.
|
||
BUFFER-OR-NAME may be a buffer or the name of an existing buffer
|
||
and defaults to the current buffer.
|
||
|
||
The following non-nil values of the optional argument FRAME
|
||
have special meanings:
|
||
|
||
- t means consider all windows on the selected frame only.
|
||
|
||
- `visible' means consider all windows on all visible frames on
|
||
the current terminal.
|
||
|
||
- 0 (the number zero) means consider all windows on all visible
|
||
and iconified frames on the current terminal.
|
||
|
||
- A frame means consider all windows on that frame only.
|
||
|
||
Any other value of FRAME means consider all windows on all
|
||
frames.
|
||
|
||
When a window showing BUFFER-OR-NAME is dedicated and the only
|
||
window of its frame, that frame is deleted when there are other
|
||
frames left."
|
||
(interactive "BDelete windows on (buffer):\nP")
|
||
(let ((buffer (window-normalize-buffer buffer-or-name))
|
||
;; Handle the "inverted" meaning of the FRAME argument wrt other
|
||
;; `window-list-1' based function.
|
||
(all-frames (cond ((not frame) t) ((eq frame t) nil) (t frame))))
|
||
(dolist (window (window-list-1 nil nil all-frames))
|
||
(if (eq (window-buffer window) buffer)
|
||
(let ((deletable (window-deletable-p window)))
|
||
(cond
|
||
((and (eq deletable 'frame) (window-dedicated-p window))
|
||
;; Delete frame if and only if window is dedicated.
|
||
(delete-frame (window-frame window)))
|
||
((eq deletable t)
|
||
;; Delete window.
|
||
(delete-window window))
|
||
(t
|
||
;; In window switch to previous buffer.
|
||
(set-window-dedicated-p window nil)
|
||
(switch-to-prev-buffer window 'bury))))
|
||
;; If a window doesn't show BUFFER, unrecord BUFFER in it.
|
||
(unrecord-window-buffer window buffer)))))
|
||
|
||
(defun replace-buffer-in-windows (&optional buffer-or-name)
|
||
"Replace BUFFER-OR-NAME with some other buffer in all windows showing it.
|
||
BUFFER-OR-NAME may be a buffer or the name of an existing buffer
|
||
and defaults to the current buffer.
|
||
|
||
When a window showing BUFFER-OR-NAME is dedicated, that window is
|
||
deleted. If that window is the only window on its frame, the
|
||
frame is deleted too when there are other frames left. If there
|
||
are no other frames left, some other buffer is displayed in that
|
||
window.
|
||
|
||
This function removes the buffer denoted by BUFFER-OR-NAME from
|
||
all window-local buffer lists."
|
||
(interactive "bBuffer to replace: ")
|
||
(let ((buffer (window-normalize-buffer buffer-or-name)))
|
||
(dolist (window (window-list-1 nil nil t))
|
||
(if (eq (window-buffer window) buffer)
|
||
(unless (window--delete window t t)
|
||
;; Switch to another buffer in window.
|
||
(set-window-dedicated-p window nil)
|
||
(switch-to-prev-buffer window 'kill))
|
||
;; Unrecord BUFFER in WINDOW.
|
||
(unrecord-window-buffer window buffer)))))
|
||
|
||
(defun quit-restore-window (&optional window bury-or-kill)
|
||
"Quit WINDOW and deal with its buffer.
|
||
WINDOW must be a live window and defaults to the selected one.
|
||
|
||
According to information stored in WINDOW's `quit-restore' window
|
||
parameter either (1) delete WINDOW and its frame, (2) delete
|
||
WINDOW, (3) restore the buffer previously displayed in WINDOW,
|
||
or (4) make WINDOW display some other buffer than the present
|
||
one. If non-nil, reset `quit-restore' parameter to nil.
|
||
|
||
Optional second argument BURY-OR-KILL tells how to proceed with
|
||
the buffer of WINDOW. The following values are handled:
|
||
|
||
`nil' means to not handle the buffer in a particular way. This
|
||
means that if WINDOW is not deleted by this function, invoking
|
||
`switch-to-prev-buffer' will usually show the buffer again.
|
||
|
||
`append' means that if WINDOW is not deleted, move its buffer to
|
||
the end of WINDOW's previous buffers so it's less likely that a
|
||
future invocation of `switch-to-prev-buffer' will switch to it.
|
||
Also, move the buffer to the end of the frame's buffer list.
|
||
|
||
`bury' means that if WINDOW is not deleted, remove its buffer
|
||
from WINDOW'S list of previous buffers. Also, move the buffer
|
||
to the end of the frame's buffer list. This value provides the
|
||
most reliable remedy to not have `switch-to-prev-buffer' switch
|
||
to this buffer again without killing the buffer.
|
||
|
||
`kill' means to kill WINDOW's buffer."
|
||
(setq window (window-normalize-window window t))
|
||
(let* ((buffer (window-buffer window))
|
||
(quit-restore (window-parameter window 'quit-restore))
|
||
(prev-buffer
|
||
(let* ((prev-buffers (window-prev-buffers window))
|
||
(prev-buffer (caar prev-buffers)))
|
||
(and (or (not (eq prev-buffer buffer))
|
||
(and (cdr prev-buffers)
|
||
(not (eq (setq prev-buffer (cadr prev-buffers))
|
||
buffer))))
|
||
prev-buffer)))
|
||
quad entry)
|
||
(cond
|
||
((and (not prev-buffer)
|
||
(or (eq (nth 1 quit-restore) 'frame)
|
||
(and (eq (nth 1 quit-restore) 'window)
|
||
;; If the window has been created on an existing
|
||
;; frame and ended up as the sole window on that
|
||
;; frame, do not delete it (Bug#12764).
|
||
(not (eq window (frame-root-window window)))))
|
||
(eq (nth 3 quit-restore) buffer)
|
||
;; Delete WINDOW if possible.
|
||
(window--delete window nil (eq bury-or-kill 'kill)))
|
||
;; If the previously selected window is still alive, select it.
|
||
(when (window-live-p (nth 2 quit-restore))
|
||
(select-window (nth 2 quit-restore))))
|
||
((and (listp (setq quad (nth 1 quit-restore)))
|
||
(buffer-live-p (car quad))
|
||
(eq (nth 3 quit-restore) buffer))
|
||
;; Show another buffer stored in quit-restore parameter.
|
||
(when (and (integerp (nth 3 quad))
|
||
(/= (nth 3 quad) (window-total-height window)))
|
||
;; Try to resize WINDOW to its old height but don't signal an
|
||
;; error.
|
||
(condition-case nil
|
||
(window-resize window (- (nth 3 quad) (window-total-height window)))
|
||
(error nil)))
|
||
(set-window-dedicated-p window nil)
|
||
;; Restore WINDOW's previous buffer, start and point position.
|
||
(set-window-buffer-start-and-point
|
||
window (nth 0 quad) (nth 1 quad) (nth 2 quad))
|
||
;; Deal with the buffer we just removed from WINDOW.
|
||
(setq entry (and (eq bury-or-kill 'append)
|
||
(assq buffer (window-prev-buffers window))))
|
||
(when bury-or-kill
|
||
;; Remove buffer from WINDOW's previous and next buffers.
|
||
(set-window-prev-buffers
|
||
window (assq-delete-all buffer (window-prev-buffers window)))
|
||
(set-window-next-buffers
|
||
window (delq buffer (window-next-buffers window))))
|
||
(when entry
|
||
;; Append old buffer's entry to list of WINDOW's previous
|
||
;; buffers so it's less likely to get switched to soon but
|
||
;; `display-buffer-in-previous-window' can nevertheless find it.
|
||
(set-window-prev-buffers
|
||
window (append (window-prev-buffers window) (list entry))))
|
||
;; Reset the quit-restore parameter.
|
||
(set-window-parameter window 'quit-restore nil)
|
||
;; Select old window.
|
||
(when (window-live-p (nth 2 quit-restore))
|
||
(select-window (nth 2 quit-restore))))
|
||
(t
|
||
;; Show some other buffer in WINDOW and reset the quit-restore
|
||
;; parameter.
|
||
(set-window-parameter window 'quit-restore nil)
|
||
;; Make sure that WINDOW is no more dedicated.
|
||
(set-window-dedicated-p window nil)
|
||
(switch-to-prev-buffer window bury-or-kill)))
|
||
|
||
;; Deal with the buffer.
|
||
(cond
|
||
((not (buffer-live-p buffer)))
|
||
((eq bury-or-kill 'kill)
|
||
(kill-buffer buffer))
|
||
(bury-or-kill
|
||
(bury-buffer-internal buffer)))))
|
||
|
||
(defun quit-window (&optional kill window)
|
||
"Quit WINDOW and bury its buffer.
|
||
WINDOW must be a live window and defaults to the selected one.
|
||
With prefix argument KILL non-nil, kill the buffer instead of
|
||
burying it.
|
||
|
||
According to information stored in WINDOW's `quit-restore' window
|
||
parameter either (1) delete WINDOW and its frame, (2) delete
|
||
WINDOW, (3) restore the buffer previously displayed in WINDOW,
|
||
or (4) make WINDOW display some other buffer than the present
|
||
one. If non-nil, reset `quit-restore' parameter to nil."
|
||
(interactive "P")
|
||
(quit-restore-window window (if kill 'kill 'bury)))
|
||
|
||
(defun quit-windows-on (&optional buffer-or-name kill frame)
|
||
"Quit all windows showing BUFFER-OR-NAME.
|
||
BUFFER-OR-NAME may be a buffer or the name of an existing buffer
|
||
and defaults to the current buffer. Optional argument KILL
|
||
non-nil means to kill BUFFER-OR-NAME. KILL nil means to bury
|
||
BUFFER-OR-NAME. Optional argument FRAME is handled as by
|
||
`delete-windows-on'.
|
||
|
||
This function calls `quit-window' on all candidate windows
|
||
showing BUFFER-OR-NAME."
|
||
(interactive "BQuit windows on (buffer):\nP")
|
||
(let ((buffer (window-normalize-buffer buffer-or-name))
|
||
;; Handle the "inverted" meaning of the FRAME argument wrt other
|
||
;; `window-list-1' based function.
|
||
(all-frames (cond ((not frame) t) ((eq frame t) nil) (t frame))))
|
||
(dolist (window (window-list-1 nil nil all-frames))
|
||
(if (eq (window-buffer window) buffer)
|
||
(quit-window kill window)
|
||
;; If a window doesn't show BUFFER, unrecord BUFFER in it.
|
||
(unrecord-window-buffer window buffer)))))
|
||
|
||
;;; Splitting windows.
|
||
(defun window-split-min-size (&optional horizontal pixelwise)
|
||
"Return minimum height of any window when splitting windows.
|
||
Optional argument HORIZONTAL non-nil means return minimum width."
|
||
(cond
|
||
(pixelwise
|
||
(if horizontal
|
||
(window-min-pixel-width)
|
||
(window-min-pixel-height)))
|
||
(horizontal
|
||
(max window-min-width window-safe-min-width))
|
||
(t
|
||
(max window-min-height window-safe-min-height))))
|
||
|
||
(defun split-window (&optional window size side pixelwise)
|
||
"Make a new window adjacent to WINDOW.
|
||
WINDOW must be a valid window and defaults to the selected one.
|
||
Return the new window which is always a live window.
|
||
|
||
Optional argument SIZE a positive number means make WINDOW SIZE
|
||
lines or columns tall. If SIZE is negative, make the new window
|
||
-SIZE lines or columns tall. If and only if SIZE is non-nil, its
|
||
absolute value can be less than `window-min-height' or
|
||
`window-min-width'; so this command can make a new window as
|
||
small as one line or two columns. SIZE defaults to half of
|
||
WINDOW's size.
|
||
|
||
Optional third argument SIDE nil (or `below') specifies that the
|
||
new window shall be located below WINDOW. SIDE `above' means the
|
||
new window shall be located above WINDOW. In both cases SIZE
|
||
specifies the new number of lines for WINDOW (or the new window
|
||
if SIZE is negative) including space reserved for the mode and/or
|
||
header line.
|
||
|
||
SIDE t (or `right') specifies that the new window shall be
|
||
located on the right side of WINDOW. SIDE `left' means the new
|
||
window shall be located on the left of WINDOW. In both cases
|
||
SIZE specifies the new number of columns for WINDOW (or the new
|
||
window provided SIZE is negative) including space reserved for
|
||
fringes and the scrollbar or a divider column. Any other non-nil
|
||
value for SIDE is currently handled like t (or `right').
|
||
|
||
PIXELWISE, if non-nil, means to interpret SIZE pixelwise.
|
||
|
||
If the variable `ignore-window-parameters' is non-nil or the
|
||
`split-window' parameter of WINDOW equals t, do not process any
|
||
parameters of WINDOW. Otherwise, if the `split-window' parameter
|
||
of WINDOW specifies a function, call that function with all three
|
||
arguments and return the value returned by that function.
|
||
|
||
Otherwise, if WINDOW is part of an atomic window, \"split\" the
|
||
root of that atomic window. The new window does not become a
|
||
member of that atomic window.
|
||
|
||
If WINDOW is live, properties of the new window like margins and
|
||
scrollbars are inherited from WINDOW. If WINDOW is an internal
|
||
window, these properties as well as the buffer displayed in the
|
||
new window are inherited from the window selected on WINDOW's
|
||
frame. The selected window is not changed by this function."
|
||
(setq window (window-normalize-window window))
|
||
(let* ((side (cond
|
||
((not side) 'below)
|
||
((memq side '(below above right left)) side)
|
||
(t 'right)))
|
||
(horizontal (not (memq side '(below above))))
|
||
(frame (window-frame window))
|
||
(parent (window-parent window))
|
||
(function (window-parameter window 'split-window))
|
||
(window-side (window-parameter window 'window-side))
|
||
;; Rebind the following two variables since in some cases we
|
||
;; have to override their value.
|
||
(window-combination-limit window-combination-limit)
|
||
(window-combination-resize window-combination-resize)
|
||
(char-size (frame-char-size window horizontal))
|
||
(pixel-size
|
||
(when (numberp size)
|
||
(window--size-to-pixel window size horizontal pixelwise t)))
|
||
atom-root)
|
||
(window--check frame)
|
||
(catch 'done
|
||
(cond
|
||
;; Ignore window parameters if either `ignore-window-parameters'
|
||
;; is t or the `split-window' parameter equals t.
|
||
((or ignore-window-parameters (eq function t)))
|
||
((functionp function)
|
||
;; The `split-window' parameter specifies the function to call.
|
||
;; If that function is `ignore', do nothing.
|
||
(throw 'done (funcall function window size side)))
|
||
;; If WINDOW is part of an atomic window, split the root window
|
||
;; of that atomic window instead.
|
||
((and (window-parameter window 'window-atom)
|
||
(setq atom-root (window-atom-root window))
|
||
(not (eq atom-root window)))
|
||
(throw 'done (split-window atom-root size side pixelwise)))
|
||
;; If WINDOW is a side window or its first or last child is a
|
||
;; side window, throw an error unless `window-combination-resize'
|
||
;; equals 'side.
|
||
((and (not (eq window-combination-resize 'side))
|
||
(or (window-parameter window 'window-side)
|
||
(and (window-child window)
|
||
(or (window-parameter
|
||
(window-child window) 'window-side)
|
||
(window-parameter
|
||
(window-last-child window) 'window-side)))))
|
||
(error "Cannot split side window or parent of side window"))
|
||
;; If `window-combination-resize' is 'side and window has a side
|
||
;; window sibling, bind `window-combination-limit' to t.
|
||
((and (not (eq window-combination-resize 'side))
|
||
(or (and (window-prev-sibling window)
|
||
(window-parameter
|
||
(window-prev-sibling window) 'window-side))
|
||
(and (window-next-sibling window)
|
||
(window-parameter
|
||
(window-next-sibling window) 'window-side))))
|
||
(setq window-combination-limit t)))
|
||
|
||
;; If `window-combination-resize' is t and SIZE is non-negative,
|
||
;; bind `window-combination-limit' to t.
|
||
(when (and (eq window-combination-resize t)
|
||
pixel-size (> pixel-size 0))
|
||
(setq window-combination-limit t))
|
||
|
||
(let* ((parent-pixel-size
|
||
;; `parent-pixel-size' is the pixel size of WINDOW's
|
||
;; parent, provided it has one.
|
||
(when parent (window-size parent horizontal t)))
|
||
;; `resize' non-nil means we are supposed to resize other
|
||
;; windows in WINDOW's combination.
|
||
(resize
|
||
(and window-combination-resize
|
||
(or (window-parameter window 'window-side)
|
||
(not (eq window-combination-resize 'side)))
|
||
(not (eq window-combination-limit t))
|
||
;; Resize makes sense in iso-combinations only.
|
||
(window-combined-p window horizontal)))
|
||
;; `old-pixel-size' is the current pixel size of WINDOW.
|
||
(old-pixel-size (window-size window horizontal t))
|
||
;; `new-size' is the specified or calculated size of the
|
||
;; new window.
|
||
new-pixel-size new-parent new-normal)
|
||
(cond
|
||
((not pixel-size)
|
||
(setq new-pixel-size
|
||
(if resize
|
||
;; When resizing try to give the new window the
|
||
;; average size of a window in its combination.
|
||
(min (- parent-pixel-size
|
||
(window-min-size parent horizontal nil t))
|
||
(/ parent-pixel-size
|
||
(1+ (window-combinations parent horizontal))))
|
||
;; Else try to give the new window half the size
|
||
;; of WINDOW (plus an eventual odd pixel).
|
||
(/ old-pixel-size 2)))
|
||
(unless window-resize-pixelwise
|
||
;; Round to nearest char-size multiple.
|
||
(setq new-pixel-size
|
||
(* char-size (round new-pixel-size char-size)))))
|
||
((>= pixel-size 0)
|
||
;; SIZE non-negative specifies the new size of WINDOW.
|
||
|
||
;; Note: Specifying a non-negative SIZE is practically
|
||
;; always done as workaround for making the new window
|
||
;; appear above or on the left of the new window (the
|
||
;; ispell window is a typical example of that). In all
|
||
;; these cases the SIDE argument should be set to 'above
|
||
;; or 'left in order to support the 'resize option.
|
||
;; Here we have to nest the windows instead, see above.
|
||
(setq new-pixel-size (- old-pixel-size pixel-size)))
|
||
(t
|
||
;; SIZE negative specifies the size of the new window.
|
||
(setq new-pixel-size (- pixel-size))))
|
||
|
||
;; Check SIZE.
|
||
(cond
|
||
((not pixel-size)
|
||
(cond
|
||
(resize
|
||
;; SIZE unspecified, resizing.
|
||
(when (and (not (window-sizable-p
|
||
parent (- new-pixel-size) horizontal nil t))
|
||
;; Try again with minimum split size.
|
||
(setq new-pixel-size
|
||
(max new-pixel-size
|
||
(window-split-min-size horizontal t)))
|
||
(not (window-sizable-p
|
||
parent (- new-pixel-size) horizontal nil t)))
|
||
(error "Window %s too small for splitting 1" parent)))
|
||
((> (+ new-pixel-size (window-min-size window horizontal nil t))
|
||
old-pixel-size)
|
||
;; SIZE unspecified, no resizing.
|
||
(error "Window %s too small for splitting 2" window))))
|
||
((and (>= pixel-size 0)
|
||
(or (>= pixel-size old-pixel-size)
|
||
(< new-pixel-size
|
||
(window-safe-min-pixel-size window horizontal))))
|
||
;; SIZE specified as new size of old window. If the new size
|
||
;; is larger than the old size or the size of the new window
|
||
;; would be less than the safe minimum, signal an error.
|
||
(error "Window %s too small for splitting 3" window))
|
||
(resize
|
||
;; SIZE specified, resizing.
|
||
(unless (window-sizable-p
|
||
parent (- new-pixel-size) horizontal nil t)
|
||
;; If we cannot resize the parent give up.
|
||
(error "Window %s too small for splitting 4" parent)))
|
||
((or (< new-pixel-size
|
||
(window-safe-min-pixel-size window horizontal))
|
||
(< (- old-pixel-size new-pixel-size)
|
||
(window-safe-min-pixel-size window horizontal)))
|
||
;; SIZE specification violates minimum size restrictions.
|
||
(error "Window %s too small for splitting 5" window)))
|
||
|
||
(window--resize-reset frame horizontal)
|
||
|
||
(setq new-parent
|
||
;; Make new-parent non-nil if we need a new parent window;
|
||
;; either because we want to nest or because WINDOW is not
|
||
;; iso-combined.
|
||
(or (eq window-combination-limit t)
|
||
(not (window-combined-p window horizontal))))
|
||
(setq new-normal
|
||
;; Make new-normal the normal size of the new window.
|
||
(cond
|
||
(pixel-size (/ (float new-pixel-size)
|
||
(if new-parent old-pixel-size parent-pixel-size)))
|
||
(new-parent 0.5)
|
||
(resize (/ 1.0 (1+ (window-combinations parent horizontal))))
|
||
(t (/ (window-normal-size window horizontal) 2.0))))
|
||
|
||
(if resize
|
||
;; Try to get space from OLD's siblings. We could go "up" and
|
||
;; try getting additional space from surrounding windows but
|
||
;; we won't be able to return space to those windows when we
|
||
;; delete the one we create here. Hence we do not go up.
|
||
(progn
|
||
(window--resize-child-windows
|
||
parent (- new-pixel-size) horizontal)
|
||
(let* ((normal (- 1.0 new-normal))
|
||
(sub (window-child parent)))
|
||
(while sub
|
||
(set-window-new-normal
|
||
sub (* (window-normal-size sub horizontal) normal))
|
||
(setq sub (window-right sub)))))
|
||
;; Get entire space from WINDOW.
|
||
(set-window-new-pixel
|
||
window (- old-pixel-size new-pixel-size))
|
||
;; (set-window-new-pixel window (- old-pixel-size new-pixel-size))
|
||
;; (set-window-new-total
|
||
;; window (- old-size new-size))
|
||
(window--resize-this-window window (- new-pixel-size) horizontal)
|
||
(set-window-new-normal
|
||
window (- (if new-parent 1.0 (window-normal-size window horizontal))
|
||
new-normal)))
|
||
|
||
(let* ((new (split-window-internal window new-pixel-size side new-normal)))
|
||
(window--pixel-to-total frame horizontal)
|
||
;; Assign window-side parameters, if any.
|
||
(cond
|
||
((eq window-combination-resize 'side)
|
||
(let ((window-side
|
||
(cond
|
||
(window-side window-side)
|
||
((eq side 'above) 'top)
|
||
((eq side 'below) 'bottom)
|
||
(t side))))
|
||
;; We made a new side window.
|
||
(set-window-parameter new 'window-side window-side)
|
||
(when (and new-parent (window-parameter window 'window-side))
|
||
;; We've been splitting a side root window. Give the
|
||
;; new parent the same window-side parameter.
|
||
(set-window-parameter
|
||
(window-parent new) 'window-side window-side))))
|
||
((eq window-combination-resize 'atom)
|
||
;; Make sure `window--check-frame' won't destroy an existing
|
||
;; atomic window in case the new window gets nested inside.
|
||
(unless (window-parameter window 'window-atom)
|
||
(set-window-parameter window 'window-atom t))
|
||
(when new-parent
|
||
(set-window-parameter (window-parent new) 'window-atom t))
|
||
(set-window-parameter new 'window-atom t)))
|
||
|
||
(run-window-configuration-change-hook frame)
|
||
(run-window-scroll-functions new)
|
||
(window--check frame)
|
||
;; Always return the new window.
|
||
new)))))
|
||
|
||
;; I think this should be the default; I think people will prefer it--rms.
|
||
(defcustom split-window-keep-point t
|
||
"If non-nil, \\[split-window-below] preserves point in the new window.
|
||
If nil, adjust point in the two windows to minimize redisplay.
|
||
This option applies only to `split-window-below' and functions
|
||
that call it. The low-level `split-window' function always keeps
|
||
the original point in both windows."
|
||
:type 'boolean
|
||
:group 'windows)
|
||
|
||
(defun split-window-below (&optional size)
|
||
"Split the selected window into two windows, one above the other.
|
||
The selected window is above. The newly split-off window is
|
||
below, and displays the same buffer. Return the new window.
|
||
|
||
If optional argument SIZE is omitted or nil, both windows get the
|
||
same height, or close to it. If SIZE is positive, the upper
|
||
\(selected) window gets SIZE lines. If SIZE is negative, the
|
||
lower (new) window gets -SIZE lines.
|
||
|
||
If the variable `split-window-keep-point' is non-nil, both
|
||
windows get the same value of point as the selected window.
|
||
Otherwise, the window starts are chosen so as to minimize the
|
||
amount of redisplay; this is convenient on slow terminals."
|
||
(interactive "P")
|
||
(let ((old-window (selected-window))
|
||
(old-point (window-point))
|
||
(size (and size (prefix-numeric-value size)))
|
||
moved-by-window-height moved new-window bottom)
|
||
(when (and size (< size 0) (< (- size) window-min-height))
|
||
;; `split-window' would not signal an error here.
|
||
(error "Size of new window too small"))
|
||
(setq new-window (split-window nil size))
|
||
(unless split-window-keep-point
|
||
(with-current-buffer (window-buffer)
|
||
;; Use `save-excursion' around vertical movements below
|
||
;; (Bug#10971). Note: When the selected window's buffer has a
|
||
;; header line, up to two lines of the buffer may not show up
|
||
;; in the resulting configuration.
|
||
(save-excursion
|
||
(goto-char (window-start))
|
||
(setq moved (vertical-motion (window-height)))
|
||
(set-window-start new-window (point))
|
||
(when (> (point) (window-point new-window))
|
||
(set-window-point new-window (point)))
|
||
(when (= moved (window-height))
|
||
(setq moved-by-window-height t)
|
||
(vertical-motion -1))
|
||
(setq bottom (point)))
|
||
(and moved-by-window-height
|
||
(<= bottom (point))
|
||
(set-window-point old-window (1- bottom)))
|
||
(and moved-by-window-height
|
||
(<= (window-start new-window) old-point)
|
||
(set-window-point new-window old-point)
|
||
(select-window new-window))))
|
||
;; Always copy quit-restore parameter in interactive use.
|
||
(let ((quit-restore (window-parameter old-window 'quit-restore)))
|
||
(when quit-restore
|
||
(set-window-parameter new-window 'quit-restore quit-restore)))
|
||
new-window))
|
||
|
||
(defalias 'split-window-vertically 'split-window-below)
|
||
|
||
(defun split-window-right (&optional size)
|
||
"Split the selected window into two side-by-side windows.
|
||
The selected window is on the left. The newly split-off window
|
||
is on the right, and displays the same buffer. Return the new
|
||
window.
|
||
|
||
If optional argument SIZE is omitted or nil, both windows get the
|
||
same width, or close to it. If SIZE is positive, the left-hand
|
||
\(selected) window gets SIZE columns. If SIZE is negative, the
|
||
right-hand (new) window gets -SIZE columns. Here, SIZE includes
|
||
the width of the window's scroll bar; if there are no scroll
|
||
bars, it includes the width of the divider column to the window's
|
||
right, if any."
|
||
(interactive "P")
|
||
(let ((old-window (selected-window))
|
||
(size (and size (prefix-numeric-value size)))
|
||
new-window)
|
||
(when (and size (< size 0) (< (- size) window-min-width))
|
||
;; `split-window' would not signal an error here.
|
||
(error "Size of new window too small"))
|
||
(setq new-window (split-window nil size t))
|
||
;; Always copy quit-restore parameter in interactive use.
|
||
(let ((quit-restore (window-parameter old-window 'quit-restore)))
|
||
(when quit-restore
|
||
(set-window-parameter new-window 'quit-restore quit-restore)))
|
||
new-window))
|
||
|
||
(defalias 'split-window-horizontally 'split-window-right)
|
||
|
||
;;; Balancing windows.
|
||
|
||
;; The following routine uses the recycled code from an old version of
|
||
;; `window--resize-child-windows'. It's not very pretty, but coding it the way the
|
||
;; new `window--resize-child-windows' code does would hardly make it any shorter or
|
||
;; more readable (FWIW we'd need three loops - one to calculate the
|
||
;; minimum sizes per window, one to enlarge or shrink windows until the
|
||
;; new parent-size matches, and one where we shrink the largest/enlarge
|
||
;; the smallest window).
|
||
(defun balance-windows-2 (window horizontal)
|
||
"Subroutine of `balance-windows-1'.
|
||
WINDOW must be a vertical combination (horizontal if HORIZONTAL
|
||
is non-nil)."
|
||
(let* ((char-size (if window-resize-pixelwise
|
||
1
|
||
(frame-char-size window horizontal)))
|
||
(first (window-child window))
|
||
(sub first)
|
||
(number-of-children 0)
|
||
(parent-size (window-new-pixel window))
|
||
(total-sum parent-size)
|
||
failed size sub-total sub-delta sub-amount rest)
|
||
(while sub
|
||
(setq number-of-children (1+ number-of-children))
|
||
(when (window-size-fixed-p sub horizontal)
|
||
(setq total-sum
|
||
(- total-sum (window-size sub horizontal t)))
|
||
(set-window-new-normal sub 'ignore))
|
||
(setq sub (window-right sub)))
|
||
|
||
(setq failed t)
|
||
(while (and failed (> number-of-children 0))
|
||
(setq size (/ total-sum number-of-children))
|
||
(setq failed nil)
|
||
(setq sub first)
|
||
(while (and sub (not failed))
|
||
;; Ignore child windows that should be ignored or are stuck.
|
||
(unless (window--resize-child-windows-skip-p sub)
|
||
(setq sub-total (window-size sub horizontal t))
|
||
(setq sub-delta (- size sub-total))
|
||
(setq sub-amount
|
||
(window-sizable sub sub-delta horizontal nil t))
|
||
;; Register the new total size for this child window.
|
||
(set-window-new-pixel sub (+ sub-total sub-amount))
|
||
(unless (= sub-amount sub-delta)
|
||
(setq total-sum (- total-sum sub-total sub-amount))
|
||
(setq number-of-children (1- number-of-children))
|
||
;; We failed and need a new round.
|
||
(setq failed t)
|
||
(set-window-new-normal sub 'skip)))
|
||
(setq sub (window-right sub))))
|
||
|
||
;; How can we be sure that `number-of-children' is NOT zero here ?
|
||
(setq rest (% total-sum number-of-children))
|
||
;; Fix rounding by trying to enlarge non-stuck windows by one line
|
||
;; (column) until `rest' is zero.
|
||
(setq sub first)
|
||
(while (and sub (> rest 0))
|
||
(unless (window--resize-child-windows-skip-p window)
|
||
(set-window-new-pixel sub (min rest char-size) t)
|
||
(setq rest (- rest char-size)))
|
||
(setq sub (window-right sub)))
|
||
|
||
;; Fix rounding by trying to enlarge stuck windows by one line
|
||
;; (column) until `rest' equals zero.
|
||
(setq sub first)
|
||
(while (and sub (> rest 0))
|
||
(unless (eq (window-new-normal sub) 'ignore)
|
||
(set-window-new-pixel sub (min rest char-size) t)
|
||
(setq rest (- rest char-size)))
|
||
(setq sub (window-right sub)))
|
||
|
||
(setq sub first)
|
||
(while sub
|
||
;; Record new normal sizes.
|
||
(set-window-new-normal
|
||
sub (/ (if (eq (window-new-normal sub) 'ignore)
|
||
(window-size sub horizontal t)
|
||
(window-new-pixel sub))
|
||
(float parent-size)))
|
||
;; Recursively balance each window's child windows.
|
||
(balance-windows-1 sub horizontal)
|
||
(setq sub (window-right sub)))))
|
||
|
||
(defun balance-windows-1 (window &optional horizontal)
|
||
"Subroutine of `balance-windows'."
|
||
(if (window-child window)
|
||
(let ((sub (window-child window)))
|
||
(if (window-combined-p sub horizontal)
|
||
(balance-windows-2 window horizontal)
|
||
(let ((size (window-new-pixel window)))
|
||
(while sub
|
||
(set-window-new-pixel sub size)
|
||
(balance-windows-1 sub horizontal)
|
||
(setq sub (window-right sub))))))))
|
||
|
||
(defun balance-windows (&optional window-or-frame)
|
||
"Balance the sizes of windows of WINDOW-OR-FRAME.
|
||
WINDOW-OR-FRAME is optional and defaults to the selected frame.
|
||
If WINDOW-OR-FRAME denotes a frame, balance the sizes of all
|
||
windows of that frame. If WINDOW-OR-FRAME denotes a window,
|
||
recursively balance the sizes of all child windows of that
|
||
window."
|
||
(interactive)
|
||
(let* ((window
|
||
(cond
|
||
((or (not window-or-frame)
|
||
(frame-live-p window-or-frame))
|
||
(frame-root-window window-or-frame))
|
||
((or (window-live-p window-or-frame)
|
||
(window-child window-or-frame))
|
||
window-or-frame)
|
||
(t
|
||
(error "Not a window or frame %s" window-or-frame))))
|
||
(frame (window-frame window)))
|
||
;; Balance vertically.
|
||
(window--resize-reset (window-frame window))
|
||
(balance-windows-1 window)
|
||
(when (window--resize-apply-p frame)
|
||
(window-resize-apply frame)
|
||
(window--pixel-to-total frame)
|
||
(run-window-configuration-change-hook frame))
|
||
;; Balance horizontally.
|
||
(window--resize-reset (window-frame window) t)
|
||
(balance-windows-1 window t)
|
||
(when (window--resize-apply-p frame t)
|
||
(window-resize-apply frame t)
|
||
(window--pixel-to-total frame t)
|
||
(run-window-configuration-change-hook frame))))
|
||
|
||
(defun window-fixed-size-p (&optional window direction)
|
||
"Return t if WINDOW cannot be resized in DIRECTION.
|
||
WINDOW defaults to the selected window. DIRECTION can be
|
||
nil (i.e. any), `height' or `width'."
|
||
(with-current-buffer (window-buffer window)
|
||
(when (and (boundp 'window-size-fixed) window-size-fixed)
|
||
(not (and direction
|
||
(member (cons direction window-size-fixed)
|
||
'((height . width) (width . height))))))))
|
||
|
||
;;; A different solution to balance-windows.
|
||
(defvar window-area-factor 1
|
||
"Factor by which the window area should be over-estimated.
|
||
This is used by `balance-windows-area'.
|
||
Changing this globally has no effect.")
|
||
(make-variable-buffer-local 'window-area-factor)
|
||
|
||
(defun balance-windows-area-adjust (window delta horizontal pixelwise)
|
||
"Wrapper around `window-resize' with error checking.
|
||
Arguments WINDOW, DELTA and HORIZONTAL are passed on to that function."
|
||
;; `window-resize' may fail if delta is too large.
|
||
(while (>= (abs delta) 1)
|
||
(condition-case nil
|
||
(progn
|
||
;; It was wrong to use `window-resize' here. Somehow
|
||
;; `balance-windows-area' depends on resizing windows
|
||
;; asymmetrically.
|
||
(adjust-window-trailing-edge window delta horizontal pixelwise)
|
||
(setq delta 0))
|
||
(error
|
||
;;(message "adjust: %s" (error-message-string err))
|
||
(setq delta (/ delta 2))))))
|
||
|
||
(defun balance-windows-area ()
|
||
"Make all visible windows the same area (approximately).
|
||
See also `window-area-factor' to change the relative size of
|
||
specific buffers."
|
||
(interactive)
|
||
(let* ((unchanged 0) (carry 0) (round 0)
|
||
;; Remove fixed-size windows.
|
||
(wins (delq nil (mapcar (lambda (win)
|
||
(if (not (window-fixed-size-p win)) win))
|
||
(window-list nil 'nomini))))
|
||
(changelog nil)
|
||
(pixelwise window-resize-pixelwise)
|
||
next)
|
||
;; Resizing a window changes the size of surrounding windows in complex
|
||
;; ways, so it's difficult to balance them all. The introduction of
|
||
;; `adjust-window-trailing-edge' made it a bit easier, but it is still
|
||
;; very difficult to do. `balance-window' above takes an off-line
|
||
;; approach: get the whole window tree, then balance it, then try to
|
||
;; adjust the windows so they fit the result.
|
||
;; Here, instead, we take a "local optimization" approach, where we just
|
||
;; go through all the windows several times until nothing needs to be
|
||
;; changed. The main problem with this approach is that it's difficult
|
||
;; to make sure it terminates, so we use some heuristic to try and break
|
||
;; off infinite loops.
|
||
;; After a round without any change, we allow a second, to give a chance
|
||
;; to the carry to propagate a minor imbalance from the end back to
|
||
;; the beginning.
|
||
(while (< unchanged 2)
|
||
;; (message "New round")
|
||
(setq unchanged (1+ unchanged) round (1+ round))
|
||
(dolist (win wins)
|
||
(setq next win)
|
||
(while (progn (setq next (next-window next))
|
||
(window-fixed-size-p next)))
|
||
;; (assert (eq next (or (cadr (member win wins)) (car wins))))
|
||
(let* ((horiz
|
||
(< (car (window-pixel-edges win)) (car (window-pixel-edges next))))
|
||
(areadiff (/ (- (* (window-size next nil pixelwise)
|
||
(window-size next t pixelwise)
|
||
(buffer-local-value 'window-area-factor
|
||
(window-buffer next)))
|
||
(* (window-size win nil pixelwise)
|
||
(window-size win t pixelwise)
|
||
(buffer-local-value 'window-area-factor
|
||
(window-buffer win))))
|
||
(max (buffer-local-value 'window-area-factor
|
||
(window-buffer win))
|
||
(buffer-local-value 'window-area-factor
|
||
(window-buffer next)))))
|
||
(edgesize (if horiz
|
||
(+ (window-size win nil pixelwise)
|
||
(window-size next nil pixelwise))
|
||
(+ (window-size win t pixelwise)
|
||
(window-size next t pixelwise))))
|
||
(diff (/ areadiff edgesize)))
|
||
(when (zerop diff)
|
||
;; Maybe diff is actually closer to 1 than to 0.
|
||
(setq diff (/ (* 3 areadiff) (* 2 edgesize))))
|
||
(when (and (zerop diff) (not (zerop areadiff)))
|
||
(setq diff (/ (+ areadiff carry) edgesize))
|
||
;; Change things smoothly.
|
||
(if (or (> diff 1) (< diff -1)) (setq diff (/ diff 2))))
|
||
(if (zerop diff)
|
||
;; Make sure negligible differences don't accumulate to
|
||
;; become significant.
|
||
(setq carry (+ carry areadiff))
|
||
;; This used `adjust-window-trailing-edge' before and uses
|
||
;; `window-resize' now. Error wrapping is still needed.
|
||
(balance-windows-area-adjust win diff horiz pixelwise)
|
||
;; (sit-for 0.5)
|
||
(let ((change (cons win (window-pixel-edges win))))
|
||
;; If the same change has been seen already for this window,
|
||
;; we're most likely in an endless loop, so don't count it as
|
||
;; a change.
|
||
(unless (member change changelog)
|
||
(push change changelog)
|
||
(setq unchanged 0 carry 0)))))))
|
||
;; We've now basically balanced all the windows.
|
||
;; But there may be some minor off-by-one imbalance left over,
|
||
;; so let's do some fine tuning.
|
||
;; (bw-finetune wins)
|
||
;; (message "Done in %d rounds" round)
|
||
))
|
||
|
||
;;; Window states, how to get them and how to put them in a window.
|
||
(defun window--state-get-1 (window &optional writable)
|
||
"Helper function for `window-state-get'."
|
||
(let* ((type
|
||
(cond
|
||
((window-top-child window) 'vc)
|
||
((window-left-child window) 'hc)
|
||
(t 'leaf)))
|
||
(buffer (window-buffer window))
|
||
(selected (eq window (selected-window)))
|
||
(head
|
||
`(,type
|
||
,@(unless (window-next-sibling window) `((last . t)))
|
||
(pixel-width . ,(window-pixel-width window))
|
||
(pixel-height . ,(window-pixel-height window))
|
||
(total-width . ,(window-total-width window))
|
||
(total-height . ,(window-total-height window))
|
||
(normal-height . ,(window-normal-size window))
|
||
(normal-width . ,(window-normal-size window t))
|
||
,@(unless (window-live-p window)
|
||
`((combination-limit . ,(window-combination-limit window))))
|
||
,@(let ((parameters (window-parameters window))
|
||
list)
|
||
;; Make copies of those window parameters whose
|
||
;; persistence property is `writable' if WRITABLE is
|
||
;; non-nil and non-nil if WRITABLE is nil.
|
||
(dolist (par parameters)
|
||
(let ((pers (cdr (assq (car par)
|
||
window-persistent-parameters))))
|
||
(when (and pers (or (not writable) (eq pers 'writable)))
|
||
(setq list (cons (cons (car par) (cdr par)) list)))))
|
||
;; Add `clone-of' parameter if necessary.
|
||
(let ((pers (cdr (assq 'clone-of
|
||
window-persistent-parameters))))
|
||
(when (and pers (or (not writable) (eq pers 'writable))
|
||
(not (assq 'clone-of list)))
|
||
(setq list (cons (cons 'clone-of window) list))))
|
||
(when list
|
||
`((parameters . ,list))))
|
||
,@(when buffer
|
||
;; All buffer related things go in here.
|
||
(let ((point (window-point window))
|
||
(start (window-start window)))
|
||
`((buffer
|
||
,(buffer-name buffer)
|
||
(selected . ,selected)
|
||
(hscroll . ,(window-hscroll window))
|
||
(fringes . ,(window-fringes window))
|
||
(margins . ,(window-margins window))
|
||
(scroll-bars . ,(window-scroll-bars window))
|
||
(vscroll . ,(window-vscroll window))
|
||
(dedicated . ,(window-dedicated-p window))
|
||
(point . ,(if writable point
|
||
(copy-marker point
|
||
(buffer-local-value
|
||
'window-point-insertion-type
|
||
buffer))))
|
||
(start . ,(if writable start (copy-marker start)))))))))
|
||
(tail
|
||
(when (memq type '(vc hc))
|
||
(let (list)
|
||
(setq window (window-child window))
|
||
(while window
|
||
(setq list (cons (window--state-get-1 window writable) list))
|
||
(setq window (window-right window)))
|
||
(nreverse list)))))
|
||
(append head tail)))
|
||
|
||
(defun window-state-get (&optional window writable)
|
||
"Return state of WINDOW as a Lisp object.
|
||
WINDOW can be any window and defaults to the root window of the
|
||
selected frame.
|
||
|
||
Optional argument WRITABLE non-nil means do not use markers for
|
||
sampling `window-point' and `window-start'. Together, WRITABLE
|
||
and the variable `window-persistent-parameters' specify which
|
||
window parameters are saved by this function. WRITABLE should be
|
||
non-nil when the return value shall be written to a file and read
|
||
back in another session. Otherwise, an application may run into
|
||
an `invalid-read-syntax' error while attempting to read back the
|
||
value from file.
|
||
|
||
The return value can be used as argument for `window-state-put'
|
||
to put the state recorded here into an arbitrary window. The
|
||
value can be also stored on disk and read back in a new session."
|
||
(setq window
|
||
(if window
|
||
(if (window-valid-p window)
|
||
window
|
||
(error "%s is not a live or internal window" window))
|
||
(frame-root-window)))
|
||
;; The return value is a cons whose car specifies some constraints on
|
||
;; the size of WINDOW. The cdr lists the states of the child windows
|
||
;; of WINDOW.
|
||
(cons
|
||
;; Frame related things would go into a function, say `frame-state',
|
||
;; calling `window-state-get' to insert the frame's root window.
|
||
`((min-height . ,(window-min-size window))
|
||
(min-width . ,(window-min-size window t))
|
||
(min-height-ignore . ,(window-min-size window nil t))
|
||
(min-width-ignore . ,(window-min-size window t t))
|
||
(min-height-safe . ,(window-min-size window nil 'safe))
|
||
(min-width-safe . ,(window-min-size window t 'safe))
|
||
(min-pixel-height . ,(window-min-size window nil nil t))
|
||
(min-pixel-width . ,(window-min-size window t nil t))
|
||
(min-pixel-height-ignore . ,(window-min-size window nil t t))
|
||
(min-pixel-width-ignore . ,(window-min-size window t t t))
|
||
(min-pixel-height-safe . ,(window-min-size window nil 'safe t))
|
||
(min-pixel-width-safe . ,(window-min-size window t 'safe t)))
|
||
(window--state-get-1 window writable)))
|
||
|
||
(defvar window-state-put-list nil
|
||
"Helper variable for `window-state-put'.")
|
||
|
||
(defvar window-state-put-stale-windows nil
|
||
"Helper variable for `window-state-put'.")
|
||
|
||
(defun window--state-put-1 (state &optional window ignore totals pixelwise)
|
||
"Helper function for `window-state-put'."
|
||
(let ((type (car state)))
|
||
(setq state (cdr state))
|
||
(cond
|
||
((eq type 'leaf)
|
||
;; For a leaf window just add unprocessed entries to
|
||
;; `window-state-put-list'.
|
||
(push (cons window state) window-state-put-list))
|
||
((memq type '(vc hc))
|
||
(let* ((horizontal (eq type 'hc))
|
||
(total (window-size window horizontal pixelwise))
|
||
(first t)
|
||
size new)
|
||
(dolist (item state)
|
||
;; Find the next child window. WINDOW always points to the
|
||
;; real window that we want to fill with what we find here.
|
||
(when (memq (car item) '(leaf vc hc))
|
||
(if (assq 'last item)
|
||
;; The last child window. Below `window--state-put-1'
|
||
;; will put into it whatever ITEM has in store.
|
||
(setq new nil)
|
||
;; Not the last child window, prepare for splitting
|
||
;; WINDOW. SIZE is the new (and final) size of the old
|
||
;; window.
|
||
(setq size
|
||
(if totals
|
||
;; Use total size.
|
||
(if pixelwise
|
||
(cdr (assq (if horizontal
|
||
'pixel-width
|
||
'pixel-height)
|
||
item))
|
||
(cdr (assq (if horizontal
|
||
'total-width
|
||
'total-height)
|
||
item)))
|
||
;; Use normalized size and round.
|
||
(round
|
||
(* total
|
||
(cdr (assq (if horizontal 'normal-width 'normal-height)
|
||
item))))))
|
||
|
||
;; Use safe sizes, we try to resize later.
|
||
(setq size (max size
|
||
(if horizontal
|
||
(* window-safe-min-width
|
||
(if pixelwise
|
||
(frame-char-width (window-frame window))
|
||
1))
|
||
(* window-safe-min-height
|
||
(if pixelwise
|
||
(frame-char-height (window-frame window))
|
||
1)))))
|
||
(if (window-sizable-p window (- size) horizontal 'safe pixelwise)
|
||
(let* ((window-combination-limit
|
||
(assq 'combination-limit item)))
|
||
;; We must inherit the combination limit, otherwise
|
||
;; we might mess up handling of atomic and side
|
||
;; window.
|
||
(setq new (split-window window size horizontal pixelwise)))
|
||
;; Give up if we can't resize window down to safe sizes.
|
||
(error "Cannot resize window %s" window))
|
||
|
||
(when first
|
||
(setq first nil)
|
||
;; When creating the first child window add for parent
|
||
;; unprocessed entries to `window-state-put-list'.
|
||
(setq window-state-put-list
|
||
(cons (cons (window-parent window) state)
|
||
window-state-put-list))))
|
||
|
||
;; Now process the current window (either the one we've just
|
||
;; split or the last child of its parent).
|
||
(window--state-put-1 item window ignore totals)
|
||
;; Continue with the last window split off.
|
||
(setq window new))))))))
|
||
|
||
(defun window--state-put-2 (ignore pixelwise)
|
||
"Helper function for `window-state-put'."
|
||
(dolist (item window-state-put-list)
|
||
(let ((window (car item))
|
||
(combination-limit (cdr (assq 'combination-limit item)))
|
||
(parameters (cdr (assq 'parameters item)))
|
||
(state (cdr (assq 'buffer item))))
|
||
(when combination-limit
|
||
(set-window-combination-limit window combination-limit))
|
||
;; Reset window's parameters and assign saved ones (we might want
|
||
;; a `remove-window-parameters' function here).
|
||
(dolist (parameter (window-parameters window))
|
||
(set-window-parameter window (car parameter) nil))
|
||
(when parameters
|
||
(dolist (parameter parameters)
|
||
(set-window-parameter window (car parameter) (cdr parameter))))
|
||
;; Process buffer related state.
|
||
(when state
|
||
(let ((buffer (get-buffer (car state))))
|
||
(if buffer
|
||
(with-current-buffer buffer
|
||
(set-window-buffer window buffer)
|
||
(set-window-hscroll window (cdr (assq 'hscroll state)))
|
||
(apply 'set-window-fringes
|
||
(cons window (cdr (assq 'fringes state))))
|
||
(let ((margins (cdr (assq 'margins state))))
|
||
(set-window-margins window (car margins) (cdr margins)))
|
||
(let ((scroll-bars (cdr (assq 'scroll-bars state))))
|
||
(set-window-scroll-bars
|
||
window (car scroll-bars) (nth 2 scroll-bars)
|
||
(nth 3 scroll-bars)))
|
||
(set-window-vscroll window (cdr (assq 'vscroll state)))
|
||
;; Adjust vertically.
|
||
(if (memq window-size-fixed '(t height))
|
||
;; A fixed height window, try to restore the
|
||
;; original size.
|
||
(let ((delta
|
||
(- (cdr (assq
|
||
(if pixelwise 'pixel-height 'total-height)
|
||
item))
|
||
(window-size window nil pixelwise)))
|
||
window-size-fixed)
|
||
(when (window--resizable-p
|
||
window delta nil nil nil nil nil pixelwise)
|
||
(window-resize window delta nil nil pixelwise)))
|
||
;; Else check whether the window is not high enough.
|
||
(let* ((min-size
|
||
(window-min-size window nil ignore pixelwise))
|
||
(delta
|
||
(- min-size (window-size window nil pixelwise))))
|
||
(when (and (> delta 0)
|
||
(window--resizable-p
|
||
window delta nil ignore nil nil nil pixelwise))
|
||
(window-resize window delta nil ignore pixelwise))))
|
||
;; Adjust horizontally.
|
||
(if (memq window-size-fixed '(t width))
|
||
;; A fixed width window, try to restore the original
|
||
;; size.
|
||
(let ((delta
|
||
(- (cdr (assq
|
||
(if pixelwise 'pixel-width 'total-width)
|
||
item))
|
||
(window-size window t pixelwise)))
|
||
window-size-fixed)
|
||
(when (window--resizable-p
|
||
window delta nil nil nil nil nil pixelwise)
|
||
(window-resize window delta nil nil pixelwise)))
|
||
;; Else check whether the window is not wide enough.
|
||
(let* ((min-size (window-min-size window t ignore pixelwise))
|
||
(delta (- min-size (window-size window t pixelwise))))
|
||
(when (and (> delta 0)
|
||
(window--resizable-p
|
||
window delta t ignore nil nil nil pixelwise))
|
||
(window-resize window delta t ignore pixelwise))))
|
||
;; Set dedicated status.
|
||
(set-window-dedicated-p window (cdr (assq 'dedicated state)))
|
||
;; Install positions (maybe we should do this after all
|
||
;; windows have been created and sized).
|
||
(ignore-errors
|
||
(set-window-start window (cdr (assq 'start state)))
|
||
(set-window-point window (cdr (assq 'point state))))
|
||
;; Select window if it's the selected one.
|
||
(when (cdr (assq 'selected state))
|
||
(select-window window)))
|
||
;; We don't want to raise an error in case the buffer does
|
||
;; not exist anymore, so we switch to a previous one and
|
||
;; save the window with the intention of deleting it later
|
||
;; if possible.
|
||
(switch-to-prev-buffer window)
|
||
(push window window-state-put-stale-windows)))))))
|
||
|
||
(defun window-state-put (state &optional window ignore)
|
||
"Put window state STATE into WINDOW.
|
||
STATE should be the state of a window returned by an earlier
|
||
invocation of `window-state-get'. Optional argument WINDOW must
|
||
specify a valid window and defaults to the selected one. If
|
||
WINDOW is not live, replace WINDOW by a live one before putting
|
||
STATE into it.
|
||
|
||
Optional argument IGNORE non-nil means ignore minimum window
|
||
sizes and fixed size restrictions. IGNORE equal `safe' means
|
||
windows can get as small as `window-safe-min-height' and
|
||
`window-safe-min-width'."
|
||
(setq window-state-put-stale-windows nil)
|
||
(setq window (window-normalize-window window))
|
||
|
||
;; When WINDOW is internal, reduce it to a live one to put STATE into,
|
||
;; see Bug#16793.
|
||
(unless (window-live-p window)
|
||
(let ((root (frame-root-window window)))
|
||
(if (eq window root)
|
||
(setq window (frame-first-window root))
|
||
(setq root window)
|
||
(setq window (catch 'live
|
||
(walk-window-subtree
|
||
(lambda (window)
|
||
(when (window-live-p window)
|
||
(throw 'live window)))
|
||
root))))
|
||
(delete-other-windows-internal window root)))
|
||
|
||
(let* ((frame (window-frame window))
|
||
(head (car state))
|
||
;; We check here (1) whether the total sizes of root window of
|
||
;; STATE and that of WINDOW are equal so we can avoid
|
||
;; calculating new sizes, and (2) if we do have to resize
|
||
;; whether we can do so without violating size restrictions.
|
||
(pixelwise (and (cdr (assq 'pixel-width state))
|
||
(cdr (assq 'pixel-height state))))
|
||
(totals (or (and pixelwise
|
||
(= (window-pixel-width window)
|
||
(cdr (assq 'pixel-width state)))
|
||
(= (window-pixel-height window)
|
||
(cdr (assq 'pixel-height state))))
|
||
(and (= (window-total-width window)
|
||
(cdr (assq 'total-width state)))
|
||
(= (window-total-height window)
|
||
(cdr (assq 'total-height state))))))
|
||
(min-height (cdr (assq
|
||
(if pixelwise 'min-pixel-height 'min-height)
|
||
head)))
|
||
(min-width (cdr (assq
|
||
(if pixelwise 'min-pixel-width 'min-weight)
|
||
head))))
|
||
(if (and (not totals)
|
||
(or (> min-height (window-size window nil pixelwise))
|
||
(> min-width (window-size window t pixelwise)))
|
||
(or (not ignore)
|
||
(and (setq min-height
|
||
(cdr (assq
|
||
(if pixelwise
|
||
'min-pixel-height-ignore
|
||
'min-height-ignore)
|
||
head)))
|
||
(setq min-width
|
||
(cdr (assq
|
||
(if pixelwise
|
||
'min-pixel-width-ignore
|
||
'min-width-ignore)
|
||
head)))
|
||
(or (> min-height
|
||
(window-size window nil pixelwise))
|
||
(> min-width
|
||
(window-size window t pixelwise)))
|
||
(or (not (eq ignore 'safe))
|
||
(and (setq min-height
|
||
(cdr (assq
|
||
(if pixelwise
|
||
'min-pixel-height-safe
|
||
'min-height-safe)
|
||
head)))
|
||
(setq min-width
|
||
(cdr (assq
|
||
(if pixelwise
|
||
'min-pixel-width-safe
|
||
'min-width-safe)
|
||
head)))
|
||
(or (> min-height
|
||
(window-size window nil pixelwise))
|
||
(> min-width
|
||
(window-size window t pixelwise))))))))
|
||
;; The check above might not catch all errors due to rounding
|
||
;; issues - so IGNORE equal 'safe might not always produce the
|
||
;; minimum possible state. But such configurations hardly make
|
||
;; sense anyway.
|
||
(error "Window %s too small to accommodate state" window)
|
||
(setq state (cdr state))
|
||
(setq window-state-put-list nil)
|
||
;; Work on the windows of a temporary buffer to make sure that
|
||
;; splitting proceeds regardless of any buffer local values of
|
||
;; `window-size-fixed'. Release that buffer after the buffers of
|
||
;; all live windows have been set by `window--state-put-2'.
|
||
(with-temp-buffer
|
||
(set-window-buffer window (current-buffer))
|
||
(window--state-put-1 state window nil totals pixelwise)
|
||
(window--state-put-2 ignore pixelwise))
|
||
(while window-state-put-stale-windows
|
||
(let ((window (pop window-state-put-stale-windows)))
|
||
(when (eq (window-deletable-p window) t)
|
||
(delete-window window))))
|
||
(window--check frame))))
|
||
|
||
(defun display-buffer-record-window (type window buffer)
|
||
"Record information for window used by `display-buffer'.
|
||
TYPE specifies the type of the calling operation and must be one
|
||
of the symbols 'reuse (when WINDOW existed already and was
|
||
reused for displaying BUFFER), 'window (when WINDOW was created
|
||
on an already existing frame), or 'frame (when WINDOW was
|
||
created on a new frame). WINDOW is the window used for or created
|
||
by the `display-buffer' routines. BUFFER is the buffer that
|
||
shall be displayed.
|
||
|
||
This function installs or updates the quit-restore parameter of
|
||
WINDOW. The quit-restore parameter is a list of four elements:
|
||
The first element is one of the symbols 'window, 'frame, 'same or
|
||
'other. The second element is either one of the symbols 'window
|
||
or 'frame or a list whose elements are the buffer previously
|
||
shown in the window, that buffer's window start and window point,
|
||
and the window's height. The third element is the window
|
||
selected at the time the parameter was created. The fourth
|
||
element is BUFFER."
|
||
(cond
|
||
((eq type 'reuse)
|
||
(if (eq (window-buffer window) buffer)
|
||
;; WINDOW shows BUFFER already.
|
||
(when (consp (window-parameter window 'quit-restore))
|
||
;; If WINDOW has a quit-restore parameter, reset its car.
|
||
(setcar (window-parameter window 'quit-restore) 'same))
|
||
;; WINDOW shows another buffer.
|
||
(with-current-buffer (window-buffer window)
|
||
(set-window-parameter
|
||
window 'quit-restore
|
||
(list 'other
|
||
;; A quadruple of WINDOW's buffer, start, point and height.
|
||
(list (current-buffer) (window-start window)
|
||
;; Preserve window-point-insertion-type (Bug#12588).
|
||
(copy-marker
|
||
(window-point window) window-point-insertion-type)
|
||
(window-total-height window))
|
||
(selected-window) buffer)))))
|
||
((eq type 'window)
|
||
;; WINDOW has been created on an existing frame.
|
||
(set-window-parameter
|
||
window 'quit-restore
|
||
(list 'window 'window (selected-window) buffer)))
|
||
((eq type 'frame)
|
||
;; WINDOW has been created on a new frame.
|
||
(set-window-parameter
|
||
window 'quit-restore
|
||
(list 'frame 'frame (selected-window) buffer)))))
|
||
|
||
(defcustom display-buffer-function nil
|
||
"If non-nil, function to call to handle `display-buffer'.
|
||
It will receive two args, the buffer and a flag which if non-nil
|
||
means that the currently selected window is not acceptable. It
|
||
should choose or create a window, display the specified buffer in
|
||
it, and return the window.
|
||
|
||
The specified function should call `display-buffer-record-window'
|
||
with corresponding arguments to set up the quit-restore parameter
|
||
of the window used."
|
||
:type '(choice
|
||
(const nil)
|
||
(function :tag "function"))
|
||
:group 'windows)
|
||
|
||
(make-obsolete-variable 'display-buffer-function
|
||
'display-buffer-alist "24.3")
|
||
|
||
;; Eventually, we want to turn this into a defvar; instead of
|
||
;; customizing this, the user should use a `pop-up-frame-parameters'
|
||
;; alist entry in `display-buffer-base-action'.
|
||
(defcustom pop-up-frame-alist nil
|
||
"Alist of parameters for automatically generated new frames.
|
||
If non-nil, the value you specify here is used by the default
|
||
`pop-up-frame-function' for the creation of new frames.
|
||
|
||
Since `pop-up-frame-function' is used by `display-buffer' for
|
||
making new frames, any value specified here by default affects
|
||
the automatic generation of new frames via `display-buffer' and
|
||
all functions based on it. The behavior of `make-frame' is not
|
||
affected by this variable."
|
||
:type '(repeat (cons :format "%v"
|
||
(symbol :tag "Parameter")
|
||
(sexp :tag "Value")))
|
||
:group 'frames)
|
||
|
||
(defcustom pop-up-frame-function
|
||
(lambda () (make-frame pop-up-frame-alist))
|
||
"Function used by `display-buffer' for creating a new frame.
|
||
This function is called with no arguments and should return a new
|
||
frame. The default value calls `make-frame' with the argument
|
||
`pop-up-frame-alist'."
|
||
:type 'function
|
||
:group 'frames)
|
||
|
||
(defcustom special-display-buffer-names nil
|
||
"List of names of buffers that should be displayed specially.
|
||
Displaying a buffer with `display-buffer' or `pop-to-buffer', if
|
||
its name is in this list, displays the buffer in a way specified
|
||
by `special-display-function'. `special-display-popup-frame'
|
||
\(the default for `special-display-function') usually displays
|
||
the buffer in a separate frame made with the parameters specified
|
||
by `special-display-frame-alist'. If `special-display-function'
|
||
has been set to some other function, that function is called with
|
||
the buffer as first, and nil as second argument.
|
||
|
||
Alternatively, an element of this list can be specified as
|
||
\(BUFFER-NAME FRAME-PARAMETERS), where BUFFER-NAME is a buffer
|
||
name and FRAME-PARAMETERS an alist of (PARAMETER . VALUE) pairs.
|
||
`special-display-popup-frame' will interpret such pairs as frame
|
||
parameters when it creates a special frame, overriding the
|
||
corresponding values from `special-display-frame-alist'.
|
||
|
||
As a special case, if FRAME-PARAMETERS contains (same-window . t)
|
||
`special-display-popup-frame' displays that buffer in the
|
||
selected window. If FRAME-PARAMETERS contains (same-frame . t),
|
||
it displays that buffer in a window on the selected frame.
|
||
|
||
If `special-display-function' specifies some other function than
|
||
`special-display-popup-frame', that function is called with the
|
||
buffer named BUFFER-NAME as first, and FRAME-PARAMETERS as second
|
||
argument.
|
||
|
||
Finally, an element of this list can be also specified as
|
||
\(BUFFER-NAME FUNCTION OTHER-ARGS). In that case,
|
||
`special-display-popup-frame' will call FUNCTION with the buffer
|
||
named BUFFER-NAME as first argument, and OTHER-ARGS as the
|
||
second.
|
||
|
||
Any alternative function specified here is responsible for
|
||
setting up the quit-restore parameter of the window used.
|
||
|
||
If this variable appears \"not to work\", because you added a
|
||
name to it but the corresponding buffer is displayed in the
|
||
selected window, look at the values of `same-window-buffer-names'
|
||
and `same-window-regexps'. Those variables take precedence over
|
||
this one.
|
||
|
||
See also `special-display-regexps'."
|
||
:type '(repeat
|
||
(choice :tag "Buffer"
|
||
:value ""
|
||
(string :format "%v")
|
||
(cons :tag "With parameters"
|
||
:format "%v"
|
||
:value ("" . nil)
|
||
(string :format "%v")
|
||
(repeat :tag "Parameters"
|
||
(cons :format "%v"
|
||
(symbol :tag "Parameter")
|
||
(sexp :tag "Value"))))
|
||
(list :tag "With function"
|
||
:format "%v"
|
||
:value ("" . nil)
|
||
(string :format "%v")
|
||
(function :tag "Function")
|
||
(repeat :tag "Arguments" (sexp)))))
|
||
:group 'windows
|
||
:group 'frames)
|
||
(make-obsolete-variable 'special-display-buffer-names 'display-buffer-alist "24.3")
|
||
(put 'special-display-buffer-names 'risky-local-variable t)
|
||
|
||
(defcustom special-display-regexps nil
|
||
"List of regexps saying which buffers should be displayed specially.
|
||
Displaying a buffer with `display-buffer' or `pop-to-buffer', if
|
||
any regexp in this list matches its name, displays it specially
|
||
using `special-display-function'. `special-display-popup-frame'
|
||
\(the default for `special-display-function') usually displays
|
||
the buffer in a separate frame made with the parameters specified
|
||
by `special-display-frame-alist'. If `special-display-function'
|
||
has been set to some other function, that function is called with
|
||
the buffer as first, and nil as second argument.
|
||
|
||
Alternatively, an element of this list can be specified as
|
||
\(REGEXP FRAME-PARAMETERS), where REGEXP is a regexp as above and
|
||
FRAME-PARAMETERS an alist of (PARAMETER . VALUE) pairs.
|
||
`special-display-popup-frame' will then interpret these pairs as
|
||
frame parameters when creating a special frame for a buffer whose
|
||
name matches REGEXP, overriding the corresponding values from
|
||
`special-display-frame-alist'.
|
||
|
||
As a special case, if FRAME-PARAMETERS contains (same-window . t)
|
||
`special-display-popup-frame' displays buffers matching REGEXP in
|
||
the selected window. (same-frame . t) in FRAME-PARAMETERS means
|
||
to display such buffers in a window on the selected frame.
|
||
|
||
If `special-display-function' specifies some other function than
|
||
`special-display-popup-frame', that function is called with the
|
||
buffer whose name matched REGEXP as first, and FRAME-PARAMETERS
|
||
as second argument.
|
||
|
||
Finally, an element of this list can be also specified as
|
||
\(REGEXP FUNCTION OTHER-ARGS). `special-display-popup-frame'
|
||
will then call FUNCTION with the buffer whose name matched
|
||
REGEXP as first, and OTHER-ARGS as second argument.
|
||
|
||
Any alternative function specified here is responsible for
|
||
setting up the quit-restore parameter of the window used.
|
||
|
||
If this variable appears \"not to work\", because you added a
|
||
name to it but the corresponding buffer is displayed in the
|
||
selected window, look at the values of `same-window-buffer-names'
|
||
and `same-window-regexps'. Those variables take precedence over
|
||
this one.
|
||
|
||
See also `special-display-buffer-names'."
|
||
:type '(repeat
|
||
(choice :tag "Buffer"
|
||
:value ""
|
||
(regexp :format "%v")
|
||
(cons :tag "With parameters"
|
||
:format "%v"
|
||
:value ("" . nil)
|
||
(regexp :format "%v")
|
||
(repeat :tag "Parameters"
|
||
(cons :format "%v"
|
||
(symbol :tag "Parameter")
|
||
(sexp :tag "Value"))))
|
||
(list :tag "With function"
|
||
:format "%v"
|
||
:value ("" . nil)
|
||
(regexp :format "%v")
|
||
(function :tag "Function")
|
||
(repeat :tag "Arguments" (sexp)))))
|
||
:group 'windows
|
||
:group 'frames)
|
||
(make-obsolete-variable 'special-display-regexps 'display-buffer-alist "24.3")
|
||
(put 'special-display-regexps 'risky-local-variable t)
|
||
|
||
(defun special-display-p (buffer-name)
|
||
"Return non-nil if a buffer named BUFFER-NAME gets a special frame.
|
||
More precisely, return t if `special-display-buffer-names' or
|
||
`special-display-regexps' contain a string entry equaling or
|
||
matching BUFFER-NAME. If `special-display-buffer-names' or
|
||
`special-display-regexps' contain a list entry whose car equals
|
||
or matches BUFFER-NAME, the return value is the cdr of that
|
||
entry."
|
||
(let (tmp)
|
||
(cond
|
||
((member buffer-name special-display-buffer-names)
|
||
t)
|
||
((setq tmp (assoc buffer-name special-display-buffer-names))
|
||
(cdr tmp))
|
||
((catch 'found
|
||
(dolist (regexp special-display-regexps)
|
||
(cond
|
||
((stringp regexp)
|
||
(when (string-match-p regexp buffer-name)
|
||
(throw 'found t)))
|
||
((and (consp regexp) (stringp (car regexp))
|
||
(string-match-p (car regexp) buffer-name))
|
||
(throw 'found (cdr regexp))))))))))
|
||
|
||
(defcustom special-display-frame-alist
|
||
'((height . 14) (width . 80) (unsplittable . t))
|
||
"Alist of parameters for special frames.
|
||
Special frames are used for buffers whose names are listed in
|
||
`special-display-buffer-names' and for buffers whose names match
|
||
one of the regular expressions in `special-display-regexps'.
|
||
|
||
This variable can be set in your init file, like this:
|
||
|
||
(setq special-display-frame-alist '((width . 80) (height . 20)))
|
||
|
||
These supersede the values given in `default-frame-alist'."
|
||
:type '(repeat (cons :format "%v"
|
||
(symbol :tag "Parameter")
|
||
(sexp :tag "Value")))
|
||
:group 'frames)
|
||
(make-obsolete-variable 'special-display-frame-alist 'display-buffer-alist "24.3")
|
||
|
||
(defun special-display-popup-frame (buffer &optional args)
|
||
"Pop up a frame displaying BUFFER and return its window.
|
||
If BUFFER is already displayed in a visible or iconified frame,
|
||
raise that frame. Otherwise, display BUFFER in a new frame.
|
||
|
||
Optional argument ARGS is a list specifying additional
|
||
information.
|
||
|
||
If ARGS is an alist, use it as a list of frame parameters. If
|
||
these parameters contain (same-window . t), display BUFFER in
|
||
the selected window. If they contain (same-frame . t), display
|
||
BUFFER in a window of the selected frame.
|
||
|
||
If ARGS is a list whose car is a symbol, use (car ARGS) as a
|
||
function to do the work. Pass it BUFFER as first argument, and
|
||
pass the elements of (cdr ARGS) as the remaining arguments."
|
||
(if (and args (symbolp (car args)))
|
||
(apply (car args) buffer (cdr args))
|
||
(let ((window (get-buffer-window buffer 0)))
|
||
(or
|
||
;; If we have a window already, make it visible.
|
||
(when window
|
||
(let ((frame (window-frame window)))
|
||
(make-frame-visible frame)
|
||
(raise-frame frame)
|
||
(display-buffer-record-window 'reuse window buffer)
|
||
window))
|
||
;; Reuse the current window if the user requested it.
|
||
(when (cdr (assq 'same-window args))
|
||
(condition-case nil
|
||
(progn (switch-to-buffer buffer nil t) (selected-window))
|
||
(error nil)))
|
||
;; Stay on the same frame if requested.
|
||
(when (or (cdr (assq 'same-frame args)) (cdr (assq 'same-window args)))
|
||
(let* ((pop-up-windows t)
|
||
pop-up-frames
|
||
special-display-buffer-names special-display-regexps)
|
||
(display-buffer buffer)))
|
||
;; If no window yet, make one in a new frame.
|
||
(let* ((frame
|
||
(with-current-buffer buffer
|
||
(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)))))
|
||
|
||
(defcustom special-display-function 'special-display-popup-frame
|
||
"Function to call for displaying special buffers.
|
||
This function is called with two arguments - the buffer and,
|
||
optionally, a list - and should return a window displaying that
|
||
buffer. The default value usually makes a separate frame for the
|
||
buffer using `special-display-frame-alist' to specify the frame
|
||
parameters. See the definition of `special-display-popup-frame'
|
||
for how to specify such a function.
|
||
|
||
A buffer is special when its name is either listed in
|
||
`special-display-buffer-names' or matches a regexp in
|
||
`special-display-regexps'.
|
||
|
||
The specified function should call `display-buffer-record-window'
|
||
with corresponding arguments to set up the quit-restore parameter
|
||
of the window used."
|
||
:type 'function
|
||
:group 'frames)
|
||
(make-obsolete-variable 'special-display-function 'display-buffer-alist "24.3")
|
||
|
||
(defcustom same-window-buffer-names nil
|
||
"List of names of buffers that should appear in the \"same\" window.
|
||
`display-buffer' and `pop-to-buffer' show a buffer whose name is
|
||
on this list in the selected rather than some other window.
|
||
|
||
An element of this list can be a cons cell instead of just a
|
||
string. In that case, the cell's car must be a string specifying
|
||
the buffer name. This is for compatibility with
|
||
`special-display-buffer-names'; the cdr of the cons cell is
|
||
ignored.
|
||
|
||
See also `same-window-regexps'."
|
||
:type '(repeat (string :format "%v"))
|
||
:group 'windows)
|
||
|
||
(defcustom same-window-regexps nil
|
||
"List of regexps saying which buffers should appear in the \"same\" window.
|
||
`display-buffer' and `pop-to-buffer' show a buffer whose name
|
||
matches a regexp on this list in the selected rather than some
|
||
other window.
|
||
|
||
An element of this list can be a cons cell instead of just a
|
||
string. In that case, the cell's car must be a regexp matching
|
||
the buffer name. This is for compatibility with
|
||
`special-display-regexps'; the cdr of the cons cell is ignored.
|
||
|
||
See also `same-window-buffer-names'."
|
||
:type '(repeat (regexp :format "%v"))
|
||
:group 'windows)
|
||
|
||
(defun same-window-p (buffer-name)
|
||
"Return non-nil if a buffer named BUFFER-NAME would be shown in the \"same\" window.
|
||
This function returns non-nil if `display-buffer' or
|
||
`pop-to-buffer' would show a buffer named BUFFER-NAME in the
|
||
selected rather than (as usual) some other window. See
|
||
`same-window-buffer-names' and `same-window-regexps'."
|
||
(cond
|
||
((not (stringp buffer-name)))
|
||
;; The elements of `same-window-buffer-names' can be buffer
|
||
;; names or cons cells whose cars are buffer names.
|
||
((member buffer-name same-window-buffer-names))
|
||
((assoc buffer-name same-window-buffer-names))
|
||
((catch 'found
|
||
(dolist (regexp same-window-regexps)
|
||
;; The elements of `same-window-regexps' can be regexps
|
||
;; or cons cells whose cars are regexps.
|
||
(when (or (and (stringp regexp)
|
||
(string-match-p regexp buffer-name))
|
||
(and (consp regexp) (stringp (car regexp))
|
||
(string-match-p (car regexp) buffer-name)))
|
||
(throw 'found t)))))))
|
||
|
||
(defcustom pop-up-frames nil
|
||
"Whether `display-buffer' should make a separate frame.
|
||
If nil, never make a separate frame.
|
||
If the value is `graphic-only', make a separate frame
|
||
on graphic displays only.
|
||
Any other non-nil value means always make a separate frame."
|
||
:type '(choice
|
||
(const :tag "Never" nil)
|
||
(const :tag "On graphic displays only" graphic-only)
|
||
(const :tag "Always" t))
|
||
:group 'windows)
|
||
|
||
(defcustom display-buffer-reuse-frames nil
|
||
"Non-nil means `display-buffer' should reuse frames.
|
||
If the buffer in question is already displayed in a frame, raise
|
||
that frame."
|
||
:type 'boolean
|
||
:version "21.1"
|
||
:group 'windows)
|
||
|
||
(make-obsolete-variable
|
||
'display-buffer-reuse-frames
|
||
"use a `reusable-frames' alist entry in `display-buffer-alist'."
|
||
"24.3")
|
||
|
||
(defcustom pop-up-windows t
|
||
"Non-nil means `display-buffer' should make a new window."
|
||
:type 'boolean
|
||
:group 'windows)
|
||
|
||
(defcustom split-window-preferred-function 'split-window-sensibly
|
||
"Function called by `display-buffer' routines to split a window.
|
||
This function is called with a window as single argument and is
|
||
supposed to split that window and return the new window. If the
|
||
window can (or shall) not be split, it is supposed to return nil.
|
||
The default is to call the function `split-window-sensibly' which
|
||
tries to split the window in a way which seems most suitable.
|
||
You can customize the options `split-height-threshold' and/or
|
||
`split-width-threshold' in order to have `split-window-sensibly'
|
||
prefer either vertical or horizontal splitting.
|
||
|
||
If you set this to any other function, bear in mind that the
|
||
`display-buffer' routines may call this function two times. The
|
||
argument of the first call is the largest window on its frame.
|
||
If that call fails to return a live window, the function is
|
||
called again with the least recently used window as argument. If
|
||
that call fails too, `display-buffer' will use an existing window
|
||
to display its buffer.
|
||
|
||
The window selected at the time `display-buffer' was invoked is
|
||
still selected when this function is called. Hence you can
|
||
compare the window argument with the value of `selected-window'
|
||
if you intend to split the selected window instead or if you do
|
||
not want to split the selected window."
|
||
:type 'function
|
||
:version "23.1"
|
||
:group 'windows)
|
||
|
||
(defcustom split-height-threshold 80
|
||
"Minimum height for splitting windows sensibly.
|
||
If this is an integer, `split-window-sensibly' may split a window
|
||
vertically only if it has at least this many lines. If this is
|
||
nil, `split-window-sensibly' is not allowed to split a window
|
||
vertically. If, however, a window is the only window on its
|
||
frame, `split-window-sensibly' may split it vertically
|
||
disregarding the value of this variable."
|
||
:type '(choice (const nil) (integer :tag "lines"))
|
||
:version "23.1"
|
||
:group 'windows)
|
||
|
||
(defcustom split-width-threshold 160
|
||
"Minimum width for splitting windows sensibly.
|
||
If this is an integer, `split-window-sensibly' may split a window
|
||
horizontally only if it has at least this many columns. If this
|
||
is nil, `split-window-sensibly' is not allowed to split a window
|
||
horizontally."
|
||
:type '(choice (const nil) (integer :tag "columns"))
|
||
:version "23.1"
|
||
:group 'windows)
|
||
|
||
(defun window-splittable-p (window &optional horizontal)
|
||
"Return non-nil if `split-window-sensibly' may split WINDOW.
|
||
Optional argument HORIZONTAL nil or omitted means check whether
|
||
`split-window-sensibly' may split WINDOW vertically. HORIZONTAL
|
||
non-nil means check whether WINDOW may be split horizontally.
|
||
|
||
WINDOW may be split vertically when the following conditions
|
||
hold:
|
||
- `window-size-fixed' is either nil or equals `width' for the
|
||
buffer of WINDOW.
|
||
- `split-height-threshold' is an integer and WINDOW is at least as
|
||
high as `split-height-threshold'.
|
||
- When WINDOW is split evenly, the emanating windows are at least
|
||
`window-min-height' lines tall and can accommodate at least one
|
||
line plus - if WINDOW has one - a mode line.
|
||
|
||
WINDOW may be split horizontally when the following conditions
|
||
hold:
|
||
- `window-size-fixed' is either nil or equals `height' for the
|
||
buffer of WINDOW.
|
||
- `split-width-threshold' is an integer and WINDOW is at least as
|
||
wide as `split-width-threshold'.
|
||
- When WINDOW is split evenly, the emanating windows are at least
|
||
`window-min-width' or two (whichever is larger) columns wide."
|
||
(when (window-live-p window)
|
||
(with-current-buffer (window-buffer window)
|
||
(if horizontal
|
||
;; A window can be split horizontally when its width is not
|
||
;; fixed, it is at least `split-width-threshold' columns wide
|
||
;; and at least twice as wide as `window-min-width' and 2 (the
|
||
;; latter value is hardcoded).
|
||
(and (memq window-size-fixed '(nil height))
|
||
;; Testing `window-full-width-p' here hardly makes any
|
||
;; sense nowadays. This can be done more intuitively by
|
||
;; setting up `split-width-threshold' appropriately.
|
||
(numberp split-width-threshold)
|
||
(>= (window-width window)
|
||
(max split-width-threshold
|
||
(* 2 (max window-min-width 2)))))
|
||
;; A window can be split vertically when its height is not
|
||
;; fixed, it is at least `split-height-threshold' lines high,
|
||
;; and it is at least twice as high as `window-min-height' and 2
|
||
;; if it has a mode line or 1.
|
||
(and (memq window-size-fixed '(nil width))
|
||
(numberp split-height-threshold)
|
||
(>= (window-height window)
|
||
(max split-height-threshold
|
||
(* 2 (max window-min-height
|
||
(if mode-line-format 2 1))))))))))
|
||
|
||
(defun split-window-sensibly (&optional window)
|
||
"Split WINDOW in a way suitable for `display-buffer'.
|
||
WINDOW defaults to the currently selected window.
|
||
If `split-height-threshold' specifies an integer, WINDOW is at
|
||
least `split-height-threshold' lines tall and can be split
|
||
vertically, split WINDOW into two windows one above the other and
|
||
return the lower window. Otherwise, if `split-width-threshold'
|
||
specifies an integer, WINDOW is at least `split-width-threshold'
|
||
columns wide and can be split horizontally, split WINDOW into two
|
||
windows side by side and return the window on the right. If this
|
||
can't be done either and WINDOW is the only window on its frame,
|
||
try to split WINDOW vertically disregarding any value specified
|
||
by `split-height-threshold'. If that succeeds, return the lower
|
||
window. Return nil otherwise.
|
||
|
||
By default `display-buffer' routines call this function to split
|
||
the largest or least recently used window. To change the default
|
||
customize the option `split-window-preferred-function'.
|
||
|
||
You can enforce this function to not split WINDOW horizontally,
|
||
by setting (or binding) the variable `split-width-threshold' to
|
||
nil. If, in addition, you set `split-height-threshold' to zero,
|
||
chances increase that this function does split WINDOW vertically.
|
||
|
||
In order to not split WINDOW vertically, set (or bind) the
|
||
variable `split-height-threshold' to nil. Additionally, you can
|
||
set `split-width-threshold' to zero to make a horizontal split
|
||
more likely to occur.
|
||
|
||
Have a look at the function `window-splittable-p' if you want to
|
||
know how `split-window-sensibly' determines whether WINDOW can be
|
||
split."
|
||
(let ((window (or window (selected-window))))
|
||
(or (and (window-splittable-p window)
|
||
;; Split window vertically.
|
||
(with-selected-window window
|
||
(split-window-below)))
|
||
(and (window-splittable-p window t)
|
||
;; Split window horizontally.
|
||
(with-selected-window window
|
||
(split-window-right)))
|
||
(and (eq window (frame-root-window (window-frame window)))
|
||
(not (window-minibuffer-p window))
|
||
;; If WINDOW is the only window on its frame and is not the
|
||
;; minibuffer window, try to split it vertically disregarding
|
||
;; the value of `split-height-threshold'.
|
||
(let ((split-height-threshold 0))
|
||
(when (window-splittable-p window)
|
||
(with-selected-window window
|
||
(split-window-below))))))))
|
||
|
||
(defun window--try-to-split-window (window &optional alist)
|
||
"Try to split WINDOW.
|
||
Return value returned by `split-window-preferred-function' if it
|
||
represents a live window, nil otherwise."
|
||
(and (window-live-p window)
|
||
(not (frame-parameter (window-frame window) 'unsplittable))
|
||
(let* ((window-combination-limit
|
||
;; When `window-combination-limit' equals
|
||
;; `display-buffer' or equals `resize-window' and a
|
||
;; `window-height' or `window-width' alist entry are
|
||
;; present, bind it to t so resizing steals space
|
||
;; preferably from the window that was split.
|
||
(if (or (eq window-combination-limit 'display-buffer)
|
||
(and (eq window-combination-limit 'window-size)
|
||
(or (cdr (assq 'window-height alist))
|
||
(cdr (assq 'window-width alist)))))
|
||
t
|
||
window-combination-limit))
|
||
(new-window
|
||
;; Since `split-window-preferred-function' might
|
||
;; throw an error use `condition-case'.
|
||
(condition-case nil
|
||
(funcall split-window-preferred-function window)
|
||
(error nil))))
|
||
(and (window-live-p new-window) new-window))))
|
||
|
||
(defun window--frame-usable-p (frame)
|
||
"Return FRAME if it can be used to display a buffer."
|
||
(when (frame-live-p frame)
|
||
(let ((window (frame-root-window frame)))
|
||
;; `frame-root-window' may be an internal window which is considered
|
||
;; "dead" by `window-live-p'. Hence if `window' is not live we
|
||
;; implicitly know that `frame' has a visible window we can use.
|
||
(unless (and (window-live-p window)
|
||
(or (window-minibuffer-p window)
|
||
;; If the window is soft-dedicated, the frame is usable.
|
||
;; Actually, even if the window is really dedicated,
|
||
;; the frame is still usable by splitting it.
|
||
;; At least Emacs-22 allowed it, and it is desirable
|
||
;; when displaying same-frame windows.
|
||
nil ; (eq t (window-dedicated-p window))
|
||
))
|
||
frame))))
|
||
|
||
(defcustom even-window-heights t
|
||
"If non-nil `display-buffer' will try to even window heights.
|
||
Otherwise `display-buffer' will leave the window configuration
|
||
alone. Heights are evened only when `display-buffer' chooses a
|
||
window that appears above or below the selected window."
|
||
:type 'boolean
|
||
:group 'windows)
|
||
|
||
(defun window--even-window-heights (window)
|
||
"Even heights of WINDOW and selected window.
|
||
Do this only if these windows are vertically adjacent to each
|
||
other, `even-window-heights' is non-nil, and the selected window
|
||
is higher than WINDOW."
|
||
(when (and even-window-heights
|
||
;; Even iff WINDOW forms a vertical combination with the
|
||
;; selected window, and WINDOW's height exceeds that of the
|
||
;; selected window, see also bug#11880.
|
||
(window-combined-p window)
|
||
(= (window-child-count (window-parent window)) 2)
|
||
(eq (window-parent) (window-parent window))
|
||
(> (window-total-height) (window-total-height window)))
|
||
;; Don't throw an error if we can't even window heights for
|
||
;; whatever reason.
|
||
(condition-case nil
|
||
(enlarge-window
|
||
(/ (- (window-total-height window) (window-total-height)) 2))
|
||
(error nil))))
|
||
|
||
(defun window--display-buffer (buffer window type &optional alist dedicated)
|
||
"Display BUFFER in WINDOW.
|
||
TYPE must be one of the symbols `reuse', `window' or `frame' and
|
||
is passed unaltered to `display-buffer-record-window'. ALIST is
|
||
the alist argument of `display-buffer'. Set `window-dedicated-p'
|
||
to DEDICATED if non-nil. Return WINDOW if BUFFER and WINDOW are
|
||
live."
|
||
(when (and (buffer-live-p buffer) (window-live-p window))
|
||
(display-buffer-record-window type window buffer)
|
||
(unless (eq buffer (window-buffer window))
|
||
(set-window-dedicated-p window nil)
|
||
(set-window-buffer window buffer)
|
||
(when dedicated
|
||
(set-window-dedicated-p window dedicated))
|
||
(when (memq type '(window frame))
|
||
(set-window-prev-buffers window nil)))
|
||
(let ((parameter (window-parameter window 'quit-restore))
|
||
(height (cdr (assq 'window-height alist)))
|
||
(width (cdr (assq 'window-width alist)))
|
||
(size (cdr (assq 'window-size alist))))
|
||
(cond
|
||
((or (eq type 'frame)
|
||
(and (eq (car parameter) 'same)
|
||
(eq (nth 1 parameter) 'frame)))
|
||
;; Adjust size of frame if asked for.
|
||
(cond
|
||
((not size))
|
||
((consp size)
|
||
(let ((width (car size))
|
||
(height (cdr size))
|
||
(frame (window-frame window)))
|
||
(when (and (numberp width) (numberp height))
|
||
(set-frame-height
|
||
frame (+ (frame-height frame)
|
||
(- height (window-total-height window))))
|
||
(set-frame-width
|
||
frame (+ (frame-width frame)
|
||
(- width (window-total-width window)))))))
|
||
((functionp size)
|
||
(ignore-errors (funcall size window)))))
|
||
((or (eq type 'window)
|
||
(and (eq (car parameter) 'same)
|
||
(eq (nth 1 parameter) 'window)))
|
||
;; Adjust height of window if asked for.
|
||
(cond
|
||
((not height))
|
||
((numberp height)
|
||
(let* ((new-height
|
||
(if (integerp height)
|
||
height
|
||
(round
|
||
(* (window-total-height (frame-root-window window))
|
||
height))))
|
||
(delta (- new-height (window-total-height window))))
|
||
(when (and (window--resizable-p window delta nil 'safe)
|
||
(window-combined-p window))
|
||
(window-resize window delta nil 'safe))))
|
||
((functionp height)
|
||
(ignore-errors (funcall height window))))
|
||
;; Adjust width of window if asked for.
|
||
(cond
|
||
((not width))
|
||
((numberp width)
|
||
(let* ((new-width
|
||
(if (integerp width)
|
||
width
|
||
(round
|
||
(* (window-total-width (frame-root-window window))
|
||
width))))
|
||
(delta (- new-width (window-total-width window))))
|
||
(when (and (window--resizable-p window delta t 'safe)
|
||
(window-combined-p window t))
|
||
(window-resize window delta t 'safe))))
|
||
((functionp width)
|
||
(ignore-errors (funcall width window)))))))
|
||
|
||
window))
|
||
|
||
(defun window--maybe-raise-frame (frame)
|
||
(let ((visible (frame-visible-p frame)))
|
||
(unless (or (not visible)
|
||
;; Assume the selected frame is already visible enough.
|
||
(eq frame (selected-frame))
|
||
;; Assume the frame from which we invoked the
|
||
;; minibuffer is visible.
|
||
(and (minibuffer-window-active-p (selected-window))
|
||
(eq frame (window-frame (minibuffer-selected-window)))))
|
||
(raise-frame frame))))
|
||
|
||
;; FIXME: Not implemented.
|
||
;; FIXME: By the way, there could be more levels of dedication:
|
||
;; - `barely' dedicated doesn't prevent reuse of the window, only records that
|
||
;; the window hasn't been used for something else yet.
|
||
;; - `softly' dedicated only allows reuse when asked explicitly.
|
||
;; - `strongly' never allows reuse.
|
||
(defvar display-buffer-mark-dedicated nil
|
||
"If non-nil, `display-buffer' marks the windows it creates as dedicated.
|
||
The actual non-nil value of this variable will be copied to the
|
||
`window-dedicated-p' flag.")
|
||
|
||
(defconst display-buffer--action-function-custom-type
|
||
'(choice :tag "Function"
|
||
(const :tag "--" ignore) ; default for insertion
|
||
(const display-buffer-reuse-window)
|
||
(const display-buffer-pop-up-window)
|
||
(const display-buffer-same-window)
|
||
(const display-buffer-pop-up-frame)
|
||
(const display-buffer-in-previous-window)
|
||
(const display-buffer-use-some-window)
|
||
(function :tag "Other function"))
|
||
"Custom type for `display-buffer' action functions.")
|
||
|
||
(defconst display-buffer--action-custom-type
|
||
`(cons :tag "Action"
|
||
(choice :tag "Action functions"
|
||
,display-buffer--action-function-custom-type
|
||
(repeat
|
||
:tag "List of functions"
|
||
,display-buffer--action-function-custom-type))
|
||
(alist :tag "Action arguments"
|
||
:key-type symbol
|
||
:value-type (sexp :tag "Value")))
|
||
"Custom type for `display-buffer' actions.")
|
||
|
||
(defvar display-buffer-overriding-action '(nil . nil)
|
||
"Overriding action to perform to display a buffer.
|
||
It should be a cons cell (FUNCTION . ALIST), where FUNCTION is a
|
||
function or a list of functions. Each function should accept two
|
||
arguments: a buffer to display and an alist similar to ALIST.
|
||
See `display-buffer' for details.")
|
||
(put 'display-buffer-overriding-action 'risky-local-variable t)
|
||
|
||
(defcustom display-buffer-alist nil
|
||
"Alist of conditional actions for `display-buffer'.
|
||
This is a list of elements (CONDITION . ACTION), where:
|
||
|
||
CONDITION is either a regexp matching buffer names, or a
|
||
function that takes two arguments - a buffer name and the
|
||
ACTION argument of `display-buffer' - and returns a boolean.
|
||
|
||
ACTION is a cons cell (FUNCTION . ALIST), where FUNCTION is a
|
||
function or a list of functions. Each such function should
|
||
accept two arguments: a buffer to display and an alist of the
|
||
same form as ALIST. See `display-buffer' for details.
|
||
|
||
`display-buffer' scans this alist until it either finds a
|
||
matching regular expression or the function specified by a
|
||
condition returns non-nil. In any of these cases, it adds the
|
||
associated action to the list of actions it will try."
|
||
:type `(alist :key-type
|
||
(choice :tag "Condition"
|
||
regexp
|
||
(function :tag "Matcher function"))
|
||
:value-type ,display-buffer--action-custom-type)
|
||
:risky t
|
||
:version "24.1"
|
||
:group 'windows)
|
||
|
||
(defcustom display-buffer-base-action '(nil . nil)
|
||
"User-specified default action for `display-buffer'.
|
||
It should be a cons cell (FUNCTION . ALIST), where FUNCTION is a
|
||
function or a list of functions. Each function should accept two
|
||
arguments: a buffer to display and an alist similar to ALIST.
|
||
See `display-buffer' for details."
|
||
:type display-buffer--action-custom-type
|
||
:risky t
|
||
:version "24.1"
|
||
:group 'windows)
|
||
|
||
(defconst display-buffer-fallback-action
|
||
'((display-buffer--maybe-same-window ;FIXME: why isn't this redundant?
|
||
display-buffer-reuse-window
|
||
display-buffer--maybe-pop-up-frame-or-window
|
||
display-buffer-in-previous-window
|
||
display-buffer-use-some-window
|
||
;; If all else fails, pop up a new frame.
|
||
display-buffer-pop-up-frame))
|
||
"Default fallback action for `display-buffer'.
|
||
This is the action used by `display-buffer' if no other actions
|
||
specified, e.g. by the user options `display-buffer-alist' or
|
||
`display-buffer-base-action'. See `display-buffer'.")
|
||
(put 'display-buffer-fallback-action 'risky-local-variable t)
|
||
|
||
(defun display-buffer-assq-regexp (buffer-name alist action)
|
||
"Retrieve ALIST entry corresponding to BUFFER-NAME.
|
||
ACTION is the action argument passed to `display-buffer'."
|
||
(catch 'match
|
||
(dolist (entry alist)
|
||
(let ((key (car entry)))
|
||
(when (or (and (stringp key)
|
||
(string-match-p key buffer-name))
|
||
(and (functionp key)
|
||
(funcall key buffer-name action)))
|
||
(throw 'match (cdr entry)))))))
|
||
|
||
(defvar display-buffer--same-window-action
|
||
'(display-buffer-same-window
|
||
(inhibit-same-window . nil))
|
||
"A `display-buffer' action for displaying in the same window.")
|
||
(put 'display-buffer--same-window-action 'risky-local-variable t)
|
||
|
||
(defvar display-buffer--other-frame-action
|
||
'((display-buffer-reuse-window
|
||
display-buffer-pop-up-frame)
|
||
(reusable-frames . 0)
|
||
(inhibit-same-window . t))
|
||
"A `display-buffer' action for displaying in another frame.")
|
||
(put 'display-buffer--other-frame-action 'risky-local-variable t)
|
||
|
||
(defun display-buffer (buffer-or-name &optional action frame)
|
||
"Display BUFFER-OR-NAME in some window, without selecting it.
|
||
BUFFER-OR-NAME must be a buffer or the name of an existing
|
||
buffer. Return the window chosen for displaying BUFFER-OR-NAME,
|
||
or nil if no such window is found.
|
||
|
||
Optional argument ACTION, if non-nil, should specify a display
|
||
action. Its form is described below.
|
||
|
||
Optional argument FRAME, if non-nil, acts like an additional
|
||
ALIST entry (reusable-frames . FRAME) to the action list of ACTION,
|
||
specifying the frame(s) to search for a window that is already
|
||
displaying the buffer. See `display-buffer-reuse-window'
|
||
|
||
If ACTION is non-nil, it should have the form (FUNCTION . ALIST),
|
||
where FUNCTION is either a function or a list of functions, and
|
||
ALIST is an arbitrary association list (alist).
|
||
|
||
Each such FUNCTION should accept two arguments: the buffer to
|
||
display and an alist. Based on those arguments, it should
|
||
display the buffer and return the window. If the caller is
|
||
prepared to handle the case of not displaying the buffer
|
||
and returning nil from `display-buffer' it should pass
|
||
\(allow-no-window . t) as an element of the ALIST.
|
||
|
||
The `display-buffer' function builds a function list and an alist
|
||
by combining the functions and alists specified in
|
||
`display-buffer-overriding-action', `display-buffer-alist', the
|
||
ACTION argument, `display-buffer-base-action', and
|
||
`display-buffer-fallback-action' (in order). Then it calls each
|
||
function in the combined function list in turn, passing the
|
||
buffer as the first argument and the combined alist as the second
|
||
argument, until one of the functions returns non-nil.
|
||
|
||
If ACTION is nil, the function list and the alist are built using
|
||
only the other variables mentioned above.
|
||
|
||
Available action functions include:
|
||
`display-buffer-same-window'
|
||
`display-buffer-reuse-window'
|
||
`display-buffer-pop-up-frame'
|
||
`display-buffer-pop-up-window'
|
||
`display-buffer-in-previous-window'
|
||
`display-buffer-use-some-window'
|
||
|
||
Recognized alist entries include:
|
||
|
||
`inhibit-same-window' -- A non-nil value prevents the same
|
||
window from being used for display.
|
||
|
||
`inhibit-switch-frame' -- A non-nil value prevents any other
|
||
frame from being raised or selected,
|
||
even if the window is displayed there.
|
||
|
||
`reusable-frames' -- Value specifies frame(s) to search for a
|
||
window that already displays the buffer.
|
||
See `display-buffer-reuse-window'.
|
||
|
||
`pop-up-frame-parameters' -- Value specifies an alist of frame
|
||
parameters to give a new frame, if
|
||
one is created.
|
||
|
||
`window-height' -- Value specifies either an integer (the number
|
||
of lines of a new window), a floating point number (the
|
||
fraction of a new window with respect to the height of the
|
||
frame's root window) or a function to be called with one
|
||
argument - a new window. The function is supposed to adjust
|
||
the height of the window; its return value is ignored.
|
||
Suitable functions are `shrink-window-if-larger-than-buffer'
|
||
and `fit-window-to-buffer'.
|
||
|
||
`window-width' -- Value specifies either an integer (the number
|
||
of columns of a new window), a floating point number (the
|
||
fraction of a new window with respect to the width of the
|
||
frame's root window) or a function to be called with one
|
||
argument - a new window. The function is supposed to adjust
|
||
the width of the window; its return value is ignored.
|
||
|
||
`allow-no-window' -- A non-nil value indicates readiness for the case
|
||
of not displaying the buffer and FUNCTION can safely return
|
||
a non-window value to suppress displaying.
|
||
|
||
The ACTION argument to `display-buffer' can also have a non-nil
|
||
and non-list value. This means to display the buffer in a window
|
||
other than the selected one, even if it is already displayed in
|
||
the selected window. If called interactively with a prefix
|
||
argument, ACTION is t."
|
||
(interactive (list (read-buffer "Display buffer: " (other-buffer))
|
||
(if current-prefix-arg t)))
|
||
(let ((buffer (if (bufferp buffer-or-name)
|
||
buffer-or-name
|
||
(get-buffer buffer-or-name)))
|
||
;; Make sure that when we split windows the old window keeps
|
||
;; point, bug#14829.
|
||
(split-window-keep-point t)
|
||
;; Handle the old form of the first argument.
|
||
(inhibit-same-window (and action (not (listp action)))))
|
||
(unless (listp action) (setq action nil))
|
||
(if display-buffer-function
|
||
;; If `display-buffer-function' is defined, let it do the job.
|
||
(funcall display-buffer-function buffer inhibit-same-window)
|
||
;; Otherwise, use the defined actions.
|
||
(let* ((user-action
|
||
(display-buffer-assq-regexp
|
||
(buffer-name buffer) display-buffer-alist action))
|
||
(special-action (display-buffer--special-action buffer))
|
||
;; Extra actions from the arguments to this function:
|
||
(extra-action
|
||
(cons nil (append (if inhibit-same-window
|
||
'((inhibit-same-window . t)))
|
||
(if frame
|
||
`((reusable-frames . ,frame))))))
|
||
;; Construct action function list and action alist.
|
||
(actions (list display-buffer-overriding-action
|
||
user-action special-action action extra-action
|
||
display-buffer-base-action
|
||
display-buffer-fallback-action))
|
||
(functions (apply 'append
|
||
(mapcar (lambda (x)
|
||
(setq x (car x))
|
||
(if (functionp x) (list x) x))
|
||
actions)))
|
||
(alist (apply 'append (mapcar 'cdr actions)))
|
||
window)
|
||
(unless (buffer-live-p buffer)
|
||
(error "Invalid buffer"))
|
||
(while (and functions (not window))
|
||
(setq window (funcall (car functions) buffer alist)
|
||
functions (cdr functions)))
|
||
(and (windowp window) window)))))
|
||
|
||
(defun display-buffer-other-frame (buffer)
|
||
"Display buffer BUFFER preferably in another frame.
|
||
This uses the function `display-buffer' as a subroutine; see
|
||
its documentation for additional customization information."
|
||
(interactive "BDisplay buffer in other frame: ")
|
||
(display-buffer buffer display-buffer--other-frame-action t))
|
||
|
||
;;; `display-buffer' action functions:
|
||
|
||
(defun display-buffer-same-window (buffer alist)
|
||
"Display BUFFER in the selected window.
|
||
This fails if ALIST has a non-nil `inhibit-same-window' entry, or
|
||
if the selected window is a minibuffer window or is dedicated to
|
||
another buffer; in that case, return nil. Otherwise, return the
|
||
selected window."
|
||
(unless (or (cdr (assq 'inhibit-same-window alist))
|
||
(window-minibuffer-p)
|
||
(window-dedicated-p))
|
||
(window--display-buffer buffer (selected-window) 'reuse alist)))
|
||
|
||
(defun display-buffer--maybe-same-window (buffer alist)
|
||
"Conditionally display BUFFER in the selected window.
|
||
If `same-window-p' returns non-nil for BUFFER's name, call
|
||
`display-buffer-same-window' and return its value. Otherwise,
|
||
return nil."
|
||
(and (same-window-p (buffer-name buffer))
|
||
(display-buffer-same-window buffer alist)))
|
||
|
||
(defun display-buffer-reuse-window (buffer alist)
|
||
"Return a window that is already displaying BUFFER.
|
||
Return nil if no usable window is found.
|
||
|
||
If ALIST has a non-nil `inhibit-same-window' entry, the selected
|
||
window is not eligible for reuse.
|
||
|
||
If ALIST contains a `reusable-frames' entry, its value determines
|
||
which frames to search for a reusable window:
|
||
nil -- the selected frame (actually the last non-minibuffer frame)
|
||
A frame -- just that frame
|
||
`visible' -- all visible frames
|
||
0 -- all frames on the current terminal
|
||
t -- all frames.
|
||
|
||
If ALIST contains no `reusable-frames' entry, search just the
|
||
selected frame if `display-buffer-reuse-frames' and
|
||
`pop-up-frames' are both nil; search all frames on the current
|
||
terminal if either of those variables is non-nil.
|
||
|
||
If ALIST has a non-nil `inhibit-switch-frame' entry, then in the
|
||
event that a window on another frame is chosen, avoid raising
|
||
that frame."
|
||
(let* ((alist-entry (assq 'reusable-frames alist))
|
||
(frames (cond (alist-entry (cdr alist-entry))
|
||
((if (eq pop-up-frames 'graphic-only)
|
||
(display-graphic-p)
|
||
pop-up-frames)
|
||
0)
|
||
(display-buffer-reuse-frames 0)
|
||
(t (last-nonminibuffer-frame))))
|
||
(window (if (and (eq buffer (window-buffer))
|
||
(not (cdr (assq 'inhibit-same-window alist))))
|
||
(selected-window)
|
||
(car (delq (selected-window)
|
||
(get-buffer-window-list buffer 'nomini
|
||
frames))))))
|
||
(when (window-live-p window)
|
||
(prog1 (window--display-buffer buffer window 'reuse alist)
|
||
(unless (cdr (assq 'inhibit-switch-frame alist))
|
||
(window--maybe-raise-frame (window-frame window)))))))
|
||
|
||
(defun display-buffer--special-action (buffer)
|
||
"Return special display action for BUFFER, if any.
|
||
If `special-display-p' returns non-nil for BUFFER, return an
|
||
appropriate display action involving `special-display-function'.
|
||
See `display-buffer' for the format of display actions."
|
||
(and special-display-function
|
||
;; `special-display-p' returns either t or a list of frame
|
||
;; parameters to pass to `special-display-function'.
|
||
(let ((pars (special-display-p (buffer-name buffer))))
|
||
(when pars
|
||
(list (list #'display-buffer-reuse-window
|
||
`(lambda (buffer _alist)
|
||
(funcall special-display-function
|
||
buffer ',(if (listp pars) pars)))))))))
|
||
|
||
(defun display-buffer-pop-up-frame (buffer alist)
|
||
"Display BUFFER in a new frame.
|
||
This works by calling `pop-up-frame-function'. If successful,
|
||
return the window used; otherwise return nil.
|
||
|
||
If ALIST has a non-nil `inhibit-switch-frame' entry, avoid
|
||
raising the new frame.
|
||
|
||
If ALIST has a non-nil `pop-up-frame-parameters' entry, the
|
||
corresponding value is an alist of frame parameters to give the
|
||
new frame."
|
||
(let* ((params (cdr (assq 'pop-up-frame-parameters alist)))
|
||
(pop-up-frame-alist (append params pop-up-frame-alist))
|
||
(fun pop-up-frame-function)
|
||
frame window)
|
||
(when (and fun
|
||
;; Make BUFFER current so `make-frame' will use it as the
|
||
;; new frame's buffer (Bug#15133).
|
||
(with-current-buffer buffer
|
||
(setq frame (funcall fun)))
|
||
(setq window (frame-selected-window frame)))
|
||
(prog1 (window--display-buffer
|
||
buffer window 'frame alist display-buffer-mark-dedicated)
|
||
(unless (cdr (assq 'inhibit-switch-frame alist))
|
||
(window--maybe-raise-frame frame))))))
|
||
|
||
(defun display-buffer-pop-up-window (buffer alist)
|
||
"Display BUFFER by popping up a new window.
|
||
The new window is created on the selected frame, or in
|
||
`last-nonminibuffer-frame' if no windows can be created there.
|
||
If successful, return the new window; otherwise return nil.
|
||
|
||
If ALIST has a non-nil `inhibit-switch-frame' entry, then in the
|
||
event that the new window is created on another frame, avoid
|
||
raising the frame."
|
||
(let ((frame (or (window--frame-usable-p (selected-frame))
|
||
(window--frame-usable-p (last-nonminibuffer-frame))))
|
||
window)
|
||
(when (and (or (not (frame-parameter frame 'unsplittable))
|
||
;; If the selected frame cannot be split, look at
|
||
;; `last-nonminibuffer-frame'.
|
||
(and (eq frame (selected-frame))
|
||
(setq frame (last-nonminibuffer-frame))
|
||
(window--frame-usable-p frame)
|
||
(not (frame-parameter frame 'unsplittable))))
|
||
;; Attempt to split largest or least recently used window.
|
||
(setq window (or (window--try-to-split-window
|
||
(get-largest-window frame t) alist)
|
||
(window--try-to-split-window
|
||
(get-lru-window frame t) alist))))
|
||
(prog1 (window--display-buffer
|
||
buffer window 'window alist display-buffer-mark-dedicated)
|
||
(unless (cdr (assq 'inhibit-switch-frame alist))
|
||
(window--maybe-raise-frame (window-frame window)))))))
|
||
|
||
(defun display-buffer--maybe-pop-up-frame-or-window (buffer alist)
|
||
"Try displaying BUFFER based on `pop-up-frames' or `pop-up-windows'.
|
||
|
||
If `pop-up-frames' is non-nil (and not `graphic-only' on a
|
||
text-only terminal), try with `display-buffer-pop-up-frame'.
|
||
|
||
If that cannot be done, and `pop-up-windows' is non-nil, try
|
||
again with `display-buffer-pop-up-window'."
|
||
(or (and (if (eq pop-up-frames 'graphic-only)
|
||
(display-graphic-p)
|
||
pop-up-frames)
|
||
(display-buffer-pop-up-frame buffer alist))
|
||
(and pop-up-windows
|
||
(display-buffer-pop-up-window buffer alist))))
|
||
|
||
(defun display-buffer-below-selected (buffer alist)
|
||
"Try displaying BUFFER in a window below the selected window.
|
||
This either splits the selected window or reuses the window below
|
||
the selected one."
|
||
(let (window)
|
||
(or (and (not (frame-parameter nil 'unsplittable))
|
||
(let ((split-height-threshold 0)
|
||
split-width-threshold)
|
||
(setq window (window--try-to-split-window (selected-window) alist)))
|
||
(window--display-buffer
|
||
buffer window 'window alist display-buffer-mark-dedicated))
|
||
(and (setq window (window-in-direction 'below))
|
||
(not (window-dedicated-p window))
|
||
(window--display-buffer
|
||
buffer window 'reuse alist display-buffer-mark-dedicated)))))
|
||
|
||
(defun display-buffer-at-bottom (buffer alist)
|
||
"Try displaying BUFFER in a window at the bottom of the selected frame.
|
||
This either splits the window at the bottom of the frame or the
|
||
frame's root window, or reuses an existing window at the bottom
|
||
of the selected frame."
|
||
(let (bottom-window window)
|
||
(walk-window-tree
|
||
(lambda (window) (setq bottom-window window)) nil nil 'nomini)
|
||
(or (and (not (frame-parameter nil 'unsplittable))
|
||
(let (split-width-threshold)
|
||
(setq window (window--try-to-split-window bottom-window alist)))
|
||
(window--display-buffer
|
||
buffer window 'window alist display-buffer-mark-dedicated))
|
||
(and (not (frame-parameter nil 'unsplittable))
|
||
(setq window
|
||
(condition-case nil
|
||
(split-window (window--major-non-side-window))
|
||
(error nil)))
|
||
(window--display-buffer
|
||
buffer window 'window alist display-buffer-mark-dedicated))
|
||
(and (setq window bottom-window)
|
||
(not (window-dedicated-p window))
|
||
(window--display-buffer
|
||
buffer window 'reuse alist display-buffer-mark-dedicated)))))
|
||
|
||
(defun display-buffer-in-previous-window (buffer alist)
|
||
"Display BUFFER in a window previously showing it.
|
||
If ALIST has a non-nil `inhibit-same-window' entry, the selected
|
||
window is not eligible for reuse.
|
||
|
||
If ALIST contains a `reusable-frames' entry, its value determines
|
||
which frames to search for a reusable window:
|
||
nil -- the selected frame (actually the last non-minibuffer frame)
|
||
A frame -- just that frame
|
||
`visible' -- all visible frames
|
||
0 -- all frames on the current terminal
|
||
t -- all frames.
|
||
|
||
If ALIST contains no `reusable-frames' entry, search just the
|
||
selected frame if `display-buffer-reuse-frames' and
|
||
`pop-up-frames' are both nil; search all frames on the current
|
||
terminal if either of those variables is non-nil.
|
||
|
||
If ALIST has a `previous-window' entry, the window specified by
|
||
that entry will override any other window found by the methods
|
||
above, even if that window never showed BUFFER before."
|
||
(let* ((alist-entry (assq 'reusable-frames alist))
|
||
(inhibit-same-window
|
||
(cdr (assq 'inhibit-same-window alist)))
|
||
(frames (cond
|
||
(alist-entry (cdr alist-entry))
|
||
((if (eq pop-up-frames 'graphic-only)
|
||
(display-graphic-p)
|
||
pop-up-frames)
|
||
0)
|
||
(display-buffer-reuse-frames 0)
|
||
(t (last-nonminibuffer-frame))))
|
||
best-window second-best-window window)
|
||
;; Scan windows whether they have shown the buffer recently.
|
||
(catch 'best
|
||
(dolist (window (window-list-1 (frame-first-window) 'nomini frames))
|
||
(when (and (assq buffer (window-prev-buffers window))
|
||
(not (window-dedicated-p window)))
|
||
(if (eq window (selected-window))
|
||
(unless inhibit-same-window
|
||
(setq second-best-window window))
|
||
(setq best-window window)
|
||
(throw 'best t)))))
|
||
;; When ALIST has a `previous-window' entry, that entry may override
|
||
;; anything we found so far.
|
||
(when (and (setq window (cdr (assq 'previous-window alist)))
|
||
(window-live-p window)
|
||
(not (window-dedicated-p window)))
|
||
(if (eq window (selected-window))
|
||
(unless inhibit-same-window
|
||
(setq second-best-window window))
|
||
(setq best-window window)))
|
||
;; Return best or second best window found.
|
||
(when (setq window (or best-window second-best-window))
|
||
(window--display-buffer buffer window 'reuse alist))))
|
||
|
||
(defun display-buffer-use-some-window (buffer alist)
|
||
"Display BUFFER in an existing window.
|
||
Search for a usable window, set that window to the buffer, and
|
||
return the window. If no suitable window is found, return nil.
|
||
|
||
If ALIST has a non-nil `inhibit-switch-frame' entry, then in the
|
||
event that a window in another frame is chosen, avoid raising
|
||
that frame."
|
||
(let* ((not-this-window (cdr (assq 'inhibit-same-window alist)))
|
||
(frame (or (window--frame-usable-p (selected-frame))
|
||
(window--frame-usable-p (last-nonminibuffer-frame))))
|
||
(window
|
||
;; Reuse an existing window.
|
||
(or (get-lru-window frame nil not-this-window)
|
||
(let ((window (get-buffer-window buffer 'visible)))
|
||
(unless (and not-this-window
|
||
(eq window (selected-window)))
|
||
window))
|
||
(get-largest-window 'visible nil not-this-window)
|
||
(let ((window (get-buffer-window buffer 0)))
|
||
(unless (and not-this-window
|
||
(eq window (selected-window)))
|
||
window))
|
||
(get-largest-window 0 nil not-this-window)))
|
||
(quit-restore (and (window-live-p window)
|
||
(window-parameter window 'quit-restore)))
|
||
(quad (nth 1 quit-restore)))
|
||
(when (window-live-p window)
|
||
;; If the window was used by `display-buffer' before, try to
|
||
;; resize it to its old height but don't signal an error.
|
||
(when (and (listp quad)
|
||
(integerp (nth 3 quad))
|
||
(/= (nth 3 quad) (window-total-height window)))
|
||
(condition-case nil
|
||
(window-resize window (- (nth 3 quad) (window-total-height window)))
|
||
(error nil)))
|
||
|
||
(prog1
|
||
(window--display-buffer buffer window 'reuse alist)
|
||
(window--even-window-heights window)
|
||
(unless (cdr (assq 'inhibit-switch-frame alist))
|
||
(window--maybe-raise-frame (window-frame window)))))))
|
||
|
||
(defun display-buffer-no-window (_buffer alist)
|
||
"Display BUFFER in no window.
|
||
If ALIST has a non-nil `allow-no-window' entry, then don't display
|
||
a window at all. This makes possible to override the default action
|
||
and avoid displaying the buffer. It is assumed that when the caller
|
||
specifies a non-nil `allow-no-window' then it can handle a nil value
|
||
returned from `display-buffer' in this case."
|
||
(when (cdr (assq 'allow-no-window alist))
|
||
'fail))
|
||
|
||
;;; Display + selection commands:
|
||
(defun pop-to-buffer (buffer &optional action norecord)
|
||
"Select buffer BUFFER in some window, preferably a different one.
|
||
BUFFER may be a buffer, a string (a buffer name), or nil. If it
|
||
is a string not naming an existent buffer, create a buffer with
|
||
that name. If BUFFER is nil, choose some other buffer. Return
|
||
the buffer.
|
||
|
||
This uses `display-buffer' as a subroutine. The optional ACTION
|
||
argument is passed to `display-buffer' as its ACTION argument.
|
||
See `display-buffer' for more information. ACTION is t if called
|
||
interactively with a prefix argument, which means to pop to a
|
||
window other than the selected one even if the buffer is already
|
||
displayed in the selected window.
|
||
|
||
If the window to show BUFFER is not on the selected
|
||
frame, raise that window's frame and give it input focus.
|
||
|
||
Optional third arg NORECORD non-nil means do not put this buffer
|
||
at the front of the list of recently selected ones."
|
||
(interactive (list (read-buffer "Pop to buffer: " (other-buffer))
|
||
(if current-prefix-arg t)))
|
||
(setq buffer (window-normalize-buffer-to-switch-to buffer))
|
||
;; This should be done by `select-window' below.
|
||
;; (set-buffer buffer)
|
||
(let* ((old-frame (selected-frame))
|
||
(window (display-buffer buffer action))
|
||
(frame (window-frame window)))
|
||
;; If we chose another frame, make sure it gets input focus.
|
||
(unless (eq frame old-frame)
|
||
(select-frame-set-input-focus frame norecord))
|
||
;; Make sure new window is selected (Bug#8615), (Bug#6954).
|
||
(select-window window norecord)
|
||
buffer))
|
||
|
||
(defun pop-to-buffer-same-window (buffer &optional norecord)
|
||
"Select buffer BUFFER in some window, preferably the same one.
|
||
BUFFER may be a buffer, a string (a buffer name), or nil. If it
|
||
is a string not naming an existent buffer, create a buffer with
|
||
that name. If BUFFER is nil, choose some other buffer. Return
|
||
the buffer.
|
||
|
||
Optional argument NORECORD, if non-nil means do not put this
|
||
buffer at the front of the list of recently selected ones.
|
||
|
||
Unlike `pop-to-buffer', this function prefers using the selected
|
||
window over popping up a new window or frame."
|
||
(pop-to-buffer buffer display-buffer--same-window-action norecord))
|
||
|
||
(defun read-buffer-to-switch (prompt)
|
||
"Read the name of a buffer to switch to, prompting with PROMPT.
|
||
Return the name of the buffer as a string.
|
||
|
||
This function is intended for the `switch-to-buffer' family of
|
||
commands since these need to omit the name of the current buffer
|
||
from the list of completions and default values."
|
||
(let ((rbts-completion-table (internal-complete-buffer-except)))
|
||
(minibuffer-with-setup-hook
|
||
(lambda ()
|
||
(setq minibuffer-completion-table rbts-completion-table)
|
||
;; Since rbts-completion-table is built dynamically, we
|
||
;; can't just add it to the default value of
|
||
;; icomplete-with-completion-tables, so we add it
|
||
;; here manually.
|
||
(if (and (boundp 'icomplete-with-completion-tables)
|
||
(listp icomplete-with-completion-tables))
|
||
(set (make-local-variable 'icomplete-with-completion-tables)
|
||
(cons rbts-completion-table
|
||
icomplete-with-completion-tables))))
|
||
(read-buffer prompt (other-buffer (current-buffer))
|
||
(confirm-nonexistent-file-or-buffer)))))
|
||
|
||
(defun window-normalize-buffer-to-switch-to (buffer-or-name)
|
||
"Normalize BUFFER-OR-NAME argument of buffer switching functions.
|
||
If BUFFER-OR-NAME is nil, return the buffer returned by
|
||
`other-buffer'. Else, if a buffer specified by BUFFER-OR-NAME
|
||
exists, return that buffer. If no such buffer exists, create a
|
||
buffer with the name BUFFER-OR-NAME and return that buffer."
|
||
(if buffer-or-name
|
||
(or (get-buffer buffer-or-name)
|
||
(let ((buffer (get-buffer-create buffer-or-name)))
|
||
(set-buffer-major-mode buffer)
|
||
buffer))
|
||
(other-buffer)))
|
||
|
||
(defcustom switch-to-buffer-preserve-window-point nil
|
||
"If non-nil, `switch-to-buffer' tries to preserve `window-point'.
|
||
If this is nil, `switch-to-buffer' displays the buffer at that
|
||
buffer's `point'. If this is `already-displayed', it tries to
|
||
display the buffer at its previous position in the selected
|
||
window, provided the buffer is currently displayed in some other
|
||
window on any visible or iconified frame. If this is t, it
|
||
unconditionally tries to display the buffer at its previous
|
||
position in the selected window.
|
||
|
||
This variable is ignored if the buffer is already displayed in
|
||
the selected window or never appeared in it before, or if
|
||
`switch-to-buffer' calls `pop-to-buffer' to display the buffer."
|
||
:type '(choice
|
||
(const :tag "Never" nil)
|
||
(const :tag "If already displayed elsewhere" already-displayed)
|
||
(const :tag "Always" t))
|
||
:group 'windows
|
||
:version "24.3")
|
||
|
||
(defun switch-to-buffer (buffer-or-name &optional norecord force-same-window)
|
||
"Display buffer BUFFER-OR-NAME in the selected window.
|
||
|
||
WARNING: This is NOT the way to work on another buffer temporarily
|
||
within a Lisp program! Use `set-buffer' instead. That avoids
|
||
messing with the window-buffer correspondences.
|
||
|
||
If the selected window cannot display the specified
|
||
buffer (e.g. if it is a minibuffer window or strongly dedicated
|
||
to another buffer), call `pop-to-buffer' to select the buffer in
|
||
another window.
|
||
|
||
If called interactively, read the buffer name using the
|
||
minibuffer. The variable `confirm-nonexistent-file-or-buffer'
|
||
determines whether to request confirmation before creating a new
|
||
buffer.
|
||
|
||
BUFFER-OR-NAME may be a buffer, a string (a buffer name), or nil.
|
||
If BUFFER-OR-NAME is a string that does not identify an existing
|
||
buffer, create a buffer with that name. If BUFFER-OR-NAME is
|
||
nil, switch to the buffer returned by `other-buffer'.
|
||
|
||
If optional argument NORECORD is non-nil, do not put the buffer
|
||
at the front of the buffer list, and do not make the window
|
||
displaying it the most recently selected one.
|
||
|
||
If optional argument FORCE-SAME-WINDOW is non-nil, the buffer
|
||
must be displayed in the selected window; if that is impossible,
|
||
signal an error rather than calling `pop-to-buffer'.
|
||
|
||
The option `switch-to-buffer-preserve-window-point' can be used
|
||
to make the buffer appear at its last position in the selected
|
||
window.
|
||
|
||
Return the buffer switched to."
|
||
(interactive
|
||
(list (read-buffer-to-switch "Switch to buffer: ") nil 'force-same-window))
|
||
(let ((buffer (window-normalize-buffer-to-switch-to buffer-or-name)))
|
||
(cond
|
||
;; Don't call set-window-buffer if it's not needed since it
|
||
;; might signal an error (e.g. if the window is dedicated).
|
||
((eq buffer (window-buffer)))
|
||
((window-minibuffer-p)
|
||
(if force-same-window
|
||
(user-error "Cannot switch buffers in minibuffer window")
|
||
(pop-to-buffer buffer norecord)))
|
||
((eq (window-dedicated-p) t)
|
||
(if force-same-window
|
||
(user-error "Cannot switch buffers in a dedicated window")
|
||
(pop-to-buffer buffer norecord)))
|
||
(t
|
||
(let* ((entry (assq buffer (window-prev-buffers)))
|
||
(displayed (and (eq switch-to-buffer-preserve-window-point
|
||
'already-displayed)
|
||
(get-buffer-window buffer 0))))
|
||
(set-window-buffer nil buffer)
|
||
(when (and entry
|
||
(or (eq switch-to-buffer-preserve-window-point t)
|
||
displayed))
|
||
;; Try to restore start and point of buffer in the selected
|
||
;; window (Bug#4041).
|
||
(set-window-start (selected-window) (nth 1 entry) t)
|
||
(set-window-point nil (nth 2 entry))))))
|
||
|
||
(unless norecord
|
||
(select-window (selected-window)))
|
||
(set-buffer buffer)))
|
||
|
||
(defun switch-to-buffer-other-window (buffer-or-name &optional norecord)
|
||
"Select the buffer specified by BUFFER-OR-NAME in another window.
|
||
BUFFER-OR-NAME may be a buffer, a string (a buffer name), or
|
||
nil. Return the buffer switched to.
|
||
|
||
If called interactively, prompt for the buffer name using the
|
||
minibuffer. The variable `confirm-nonexistent-file-or-buffer'
|
||
determines whether to request confirmation before creating a new
|
||
buffer.
|
||
|
||
If BUFFER-OR-NAME is a string and does not identify an existing
|
||
buffer, create a new buffer with that name. If BUFFER-OR-NAME is
|
||
nil, switch to the buffer returned by `other-buffer'.
|
||
|
||
Optional second argument NORECORD non-nil means do not put this
|
||
buffer at the front of the list of recently selected ones.
|
||
|
||
This uses the function `display-buffer' as a subroutine; see its
|
||
documentation for additional customization information."
|
||
(interactive
|
||
(list (read-buffer-to-switch "Switch to buffer in other window: ")))
|
||
(let ((pop-up-windows t))
|
||
(pop-to-buffer buffer-or-name t norecord)))
|
||
|
||
(defun switch-to-buffer-other-frame (buffer-or-name &optional norecord)
|
||
"Switch to buffer BUFFER-OR-NAME in another frame.
|
||
BUFFER-OR-NAME may be a buffer, a string (a buffer name), or
|
||
nil. Return the buffer switched to.
|
||
|
||
If called interactively, prompt for the buffer name using the
|
||
minibuffer. The variable `confirm-nonexistent-file-or-buffer'
|
||
determines whether to request confirmation before creating a new
|
||
buffer.
|
||
|
||
If BUFFER-OR-NAME is a string and does not identify an existing
|
||
buffer, create a new buffer with that name. If BUFFER-OR-NAME is
|
||
nil, switch to the buffer returned by `other-buffer'.
|
||
|
||
Optional second arg NORECORD non-nil means do not put this
|
||
buffer at the front of the list of recently selected ones.
|
||
|
||
This uses the function `display-buffer' as a subroutine; see its
|
||
documentation for additional customization information."
|
||
(interactive
|
||
(list (read-buffer-to-switch "Switch to buffer in other frame: ")))
|
||
(pop-to-buffer buffer-or-name display-buffer--other-frame-action norecord))
|
||
|
||
(defun set-window-text-height (window height)
|
||
"Set the height in lines of the text display area of WINDOW to HEIGHT.
|
||
WINDOW must be a live window and defaults to the selected one.
|
||
HEIGHT doesn't include the mode line or header line, if any, or
|
||
any partial-height lines in the text display area.
|
||
|
||
Note that the current implementation of this function cannot
|
||
always set the height exactly, but attempts to be conservative,
|
||
by allocating more lines than are actually needed in the case
|
||
where some error may be present."
|
||
(setq window (window-normalize-window window t))
|
||
(let ((delta (- height (window-text-height window))))
|
||
(unless (zerop delta)
|
||
;; Setting window-min-height to a value like 1 can lead to very
|
||
;; bizarre displays because it also allows Emacs to make *other*
|
||
;; windows one line tall, which means that there's no more space
|
||
;; for the mode line.
|
||
(let ((window-min-height (min 2 height)))
|
||
(window-resize window delta)))))
|
||
|
||
(defun enlarge-window-horizontally (delta)
|
||
"Make selected window DELTA columns wider.
|
||
Interactively, if no argument is given, make selected window one
|
||
column wider."
|
||
(interactive "p")
|
||
(enlarge-window delta t))
|
||
|
||
(defun shrink-window-horizontally (delta)
|
||
"Make selected window DELTA columns narrower.
|
||
Interactively, if no argument is given, make selected window one
|
||
column narrower."
|
||
(interactive "p")
|
||
(shrink-window delta t))
|
||
|
||
(defun count-screen-lines (&optional beg end count-final-newline window)
|
||
"Return the number of screen lines in the region.
|
||
The number of screen lines may be different from the number of actual lines,
|
||
due to line breaking, display table, etc.
|
||
|
||
Optional arguments BEG and END default to `point-min' and `point-max'
|
||
respectively.
|
||
|
||
If region ends with a newline, ignore it unless optional third argument
|
||
COUNT-FINAL-NEWLINE is non-nil.
|
||
|
||
The optional fourth argument WINDOW specifies the window used for obtaining
|
||
parameters such as width, horizontal scrolling, and so on. The default is
|
||
to use the selected window's parameters.
|
||
|
||
Like `vertical-motion', `count-screen-lines' always uses the current buffer,
|
||
regardless of which buffer is displayed in WINDOW. This makes possible to use
|
||
`count-screen-lines' in any buffer, whether or not it is currently displayed
|
||
in some window."
|
||
(unless beg
|
||
(setq beg (point-min)))
|
||
(unless end
|
||
(setq end (point-max)))
|
||
(if (= beg end)
|
||
0
|
||
(save-excursion
|
||
(save-restriction
|
||
(widen)
|
||
(narrow-to-region (min beg end)
|
||
(if (and (not count-final-newline)
|
||
(= ?\n (char-before (max beg end))))
|
||
(1- (max beg end))
|
||
(max beg end)))
|
||
(goto-char (point-min))
|
||
(1+ (vertical-motion (buffer-size) window))))))
|
||
|
||
(defun window-buffer-height (window)
|
||
"Return the height (in screen lines) of the buffer that WINDOW is displaying.
|
||
WINDOW must be a live window and defaults to the selected one."
|
||
(setq window (window-normalize-window window t))
|
||
(with-current-buffer (window-buffer window)
|
||
(max 1
|
||
(count-screen-lines (point-min) (point-max)
|
||
;; If buffer ends with a newline, ignore it when
|
||
;; counting height unless point is after it.
|
||
(eobp)
|
||
window))))
|
||
|
||
;;; Resizing windows and frames to fit their contents exactly.
|
||
(defcustom fit-window-to-buffer-horizontally nil
|
||
"Non-nil means `fit-window-to-buffer' can resize windows horizontally.
|
||
If this is nil, `fit-window-to-buffer' never resizes windows
|
||
horizontally. If this is `only', it can resize windows
|
||
horizontally only. Any other value means `fit-window-to-buffer'
|
||
can resize windows in both dimensions."
|
||
:type 'boolean
|
||
:version "24.4"
|
||
:group 'help)
|
||
|
||
;; `fit-frame-to-buffer' eventually wants to know the real frame sizes
|
||
;; counting title bar and outer borders.
|
||
(defcustom fit-frame-to-buffer nil
|
||
"Non-nil means `fit-frame-to-buffer' can fit a frame to its buffer.
|
||
A frame is fit if and only if its root window is a live window
|
||
and this option is non-nil. If this is `horizontally', frames
|
||
are resized horizontally only. If this is `vertically', frames
|
||
are resized vertically only. Any other non-nil value means
|
||
frames can be resized in both dimensions. See also
|
||
`fit-frame-to-buffer-margins' and `fit-frame-to-buffer-sizes'.
|
||
|
||
If this is non-nil and a window is the only window of its frame,
|
||
`fit-window-to-buffer' will invoke `fit-frame-to-buffer' to fit
|
||
the frame to its buffer."
|
||
:type 'boolean
|
||
:version "24.4"
|
||
:group 'help)
|
||
|
||
(defcustom fit-frame-to-buffer-margins '(nil nil nil nil)
|
||
"Margins around frame for `fit-frame-to-buffer'.
|
||
This list specifies the numbers of pixels to be left free on the
|
||
left, above, the right, and below a frame that shall be fit to
|
||
its buffer. The value specified here can be overridden for a
|
||
specific frame by that frame's `fit-frame-to-buffer-margins'
|
||
parameter, if present.
|
||
|
||
This variable controls how fitting a frame to the size of its
|
||
buffer coordinates with the size of your display. If you don't
|
||
specify a value here, the size of the display's workarea is used.
|
||
|
||
See also `fit-frame-to-buffer-sizes'."
|
||
:version "24.4"
|
||
:type '(list
|
||
(choice
|
||
:tag "Left"
|
||
:value nil
|
||
:format "%[LeftMargin%] %v "
|
||
(const :tag "None" :format "%t" nil)
|
||
(integer :tag "Pixels" :size 5))
|
||
(choice
|
||
:tag "Top"
|
||
:value nil
|
||
:format "%[TopMargin%] %v "
|
||
(const :tag "None" :format "%t" nil)
|
||
(integer :tag "Pixels" :size 5))
|
||
(choice
|
||
:tag "Right"
|
||
:value nil
|
||
:format "%[RightMargin%] %v "
|
||
(const :tag "None" :format "%t" nil)
|
||
(integer :tag "Pixels" :size 5))
|
||
(choice
|
||
:tag "Bottom"
|
||
:value nil
|
||
:format "%[BottomMargin%] %v "
|
||
(const :tag "None" :format "%t" nil)
|
||
(integer :tag "Pixels" :size 5)))
|
||
:group 'help)
|
||
|
||
(defcustom fit-frame-to-buffer-sizes '(nil nil nil nil)
|
||
"Size boundaries of frame for `fit-frame-to-buffer'.
|
||
This list specifies the total maximum and minimum lines and
|
||
maximum and minimum columns of the root window of any frame that
|
||
shall be fit to its buffer. If any of these values is non-nil,
|
||
it overrides the corresponding argument of `fit-frame-to-buffer'.
|
||
|
||
On window systems where the menubar can wrap, fitting a frame to
|
||
its buffer may swallow the last line(s). Specifying an
|
||
appropriate minimum width value here can avoid such wrapping.
|
||
|
||
See also `fit-frame-to-buffer-margins'."
|
||
:version "24.4"
|
||
:type '(list
|
||
(choice
|
||
:tag "Maximum Height"
|
||
:value nil
|
||
:format "%[MaxHeight%] %v "
|
||
(const :tag "None" :format "%t" nil)
|
||
(integer :tag "Lines" :size 5))
|
||
(choice
|
||
:tag "Minimum Height"
|
||
:value nil
|
||
:format "%[MinHeight%] %v "
|
||
(const :tag "None" :format "%t" nil)
|
||
(integer :tag "Lines" :size 5))
|
||
(choice
|
||
:tag "Maximum Width"
|
||
:value nil
|
||
:format "%[MaxWidth%] %v "
|
||
(const :tag "None" :format "%t" nil)
|
||
(integer :tag "Columns" :size 5))
|
||
(choice
|
||
:tag "Minimum Width"
|
||
:value nil
|
||
:format "%[MinWidth%] %v\n"
|
||
(const :tag "None" :format "%t" nil)
|
||
(integer :tag "Columns" :size 5)))
|
||
:group 'help)
|
||
|
||
(declare-function x-display-pixel-height "xfns.c" (&optional terminal))
|
||
|
||
(defun window--sanitize-margin (margin left right)
|
||
"Return MARGIN if it's a number between LEFT and RIGHT."
|
||
(when (and (numberp margin)
|
||
(<= left (- right margin)) (<= margin right))
|
||
margin))
|
||
|
||
(defun fit-frame-to-buffer (&optional frame max-height min-height max-width min-width)
|
||
"Adjust size of FRAME to display the contents of its buffer exactly.
|
||
FRAME can be any live frame and defaults to the selected one.
|
||
Fit only if FRAME's root window is live. MAX-HEIGHT, MIN-HEIGHT,
|
||
MAX-WIDTH and MIN-WIDTH specify bounds on the new total size of
|
||
FRAME's root window. MIN-HEIGHT and MIN-WIDTH default to the values of
|
||
`window-min-height' and `window-min-width' respectively.
|
||
|
||
The option `fit-frame-to-buffer' controls whether this function
|
||
has any effect. New position and size of FRAME are additionally
|
||
determined by the options `fit-frame-to-buffer-sizes' and
|
||
`fit-frame-to-buffer-margins' or the corresponding parameters of
|
||
FRAME."
|
||
(interactive)
|
||
(unless (and (fboundp 'x-display-pixel-height)
|
||
;; We need the respective sizes now.
|
||
(fboundp 'display-monitor-attributes-list))
|
||
(user-error "Cannot resize frame in non-graphic Emacs"))
|
||
(setq frame (window-normalize-frame frame))
|
||
(when (and (window-live-p (frame-root-window frame))
|
||
fit-frame-to-buffer
|
||
(or (not window-size-fixed)
|
||
(and (eq window-size-fixed 'height)
|
||
(not (eq fit-frame-to-buffer 'vertically)))
|
||
(and (eq window-size-fixed 'width)
|
||
(not (eq fit-frame-to-buffer 'horizontally)))))
|
||
(with-selected-window (frame-root-window frame)
|
||
(let* ((window (frame-root-window frame))
|
||
(char-width (frame-char-width))
|
||
(char-height (frame-char-height))
|
||
(monitor-attributes (car (display-monitor-attributes-list
|
||
(frame-parameter frame 'display))))
|
||
(geometry (cdr (assq 'geometry monitor-attributes)))
|
||
(display-width (- (nth 2 geometry) (nth 0 geometry)))
|
||
(display-height (- (nth 3 geometry) (nth 1 geometry)))
|
||
(workarea (cdr (assq 'workarea monitor-attributes)))
|
||
;; Handle margins.
|
||
(margins (or (frame-parameter frame 'fit-frame-to-buffer-margins)
|
||
fit-frame-to-buffer-margins))
|
||
(left-margin (if (nth 0 margins)
|
||
(or (window--sanitize-margin
|
||
(nth 0 margins) 0 display-width)
|
||
0)
|
||
(nth 0 workarea)))
|
||
(top-margin (if (nth 1 margins)
|
||
(or (window--sanitize-margin
|
||
(nth 1 margins) 0 display-height)
|
||
0)
|
||
(nth 1 workarea)))
|
||
(workarea-width (nth 2 workarea))
|
||
(right-margin (if (nth 2 margins)
|
||
(- display-width
|
||
(or (window--sanitize-margin
|
||
(nth 2 margins) left-margin display-width)
|
||
0))
|
||
(nth 2 workarea)))
|
||
(workarea-height (nth 3 workarea))
|
||
(bottom-margin (if (nth 3 margins)
|
||
(- display-height
|
||
(or (window--sanitize-margin
|
||
(nth 3 margins) top-margin display-height)
|
||
0))
|
||
(nth 3 workarea)))
|
||
;; The pixel width of FRAME (which does not include the
|
||
;; window manager's decorations).
|
||
(frame-width (frame-pixel-width))
|
||
;; The pixel width of the body of FRAME's root window.
|
||
(window-body-width (window-body-width nil t))
|
||
;; The difference in pixels between total and body width of
|
||
;; FRAME's window.
|
||
(window-extra-width (- (window-pixel-width) window-body-width))
|
||
;; The difference in pixels between the frame's pixel width
|
||
;; and the window's body width. This is the space we can't
|
||
;; use for fitting.
|
||
(extra-width (- frame-width window-body-width))
|
||
;; The maximum width we can use for fitting.
|
||
(fit-width (- workarea-width extra-width))
|
||
;; The pixel position of FRAME's left border. We usually
|
||
;; try to leave this alone.
|
||
(left
|
||
(let ((left (frame-parameter nil 'left)))
|
||
(if (consp left)
|
||
(funcall (car left) (cadr left))
|
||
left)))
|
||
;; The pixel height of FRAME (which does not include title
|
||
;; line, decorations, and sometimes neither the menu nor
|
||
;; the toolbar).
|
||
(frame-height (frame-pixel-height))
|
||
;; The pixel height of FRAME's root window (we don't care
|
||
;; about the window's body height since the return value of
|
||
;; `window-text-pixel-size' includes header and mode line).
|
||
(window-height (window-pixel-height))
|
||
;; The difference in pixels between the frame's pixel
|
||
;; height and the window's height.
|
||
(extra-height (- frame-height window-height))
|
||
;; When tool-bar-mode is enabled and we just created a new
|
||
;; frame, reserve lines for toolbar resizing. Needed
|
||
;; because for reasons unknown to me Emacs (1) reserves one
|
||
;; line for the toolbar when making the initial frame and
|
||
;; toolbars are enabled, and (2) later adds the remaining
|
||
;; lines needed. Our code runs IN BETWEEN (1) and (2).
|
||
;; YMMV when you're on a system that behaves differently.
|
||
(toolbar-extra-height
|
||
(let ((quit-restore (window-parameter window 'quit-restore))
|
||
;; This may have to change when we allow arbitrary
|
||
;; pixel height toolbars.
|
||
(lines (tool-bar-height)))
|
||
(* char-height
|
||
(if (and quit-restore (eq (car quit-restore) 'frame)
|
||
(not (zerop lines)))
|
||
(1- lines)
|
||
0))))
|
||
;; The pixel position of FRAME's top border.
|
||
(top
|
||
(let ((top (frame-parameter nil 'top)))
|
||
(if (consp top)
|
||
(funcall (car top) (cadr top))
|
||
top)))
|
||
;; Sanitize minimum and maximum sizes.
|
||
(sizes (or (frame-parameter frame 'fit-frame-to-buffer-sizes)
|
||
fit-frame-to-buffer-sizes))
|
||
(max-height
|
||
(cond
|
||
((numberp (nth 0 sizes)) (* (nth 0 sizes) char-height))
|
||
((numberp max-height) (* max-height char-height))
|
||
(t display-height)))
|
||
(min-height
|
||
(cond
|
||
((numberp (nth 1 sizes)) (* (nth 1 sizes) char-height))
|
||
((numberp min-height) (* min-height char-height))
|
||
(t (* window-min-height char-height))))
|
||
(max-width
|
||
(cond
|
||
((numberp (nth 2 sizes))
|
||
(- (* (nth 2 sizes) char-width) window-extra-width))
|
||
((numberp max-width)
|
||
(- (* max-width char-width) window-extra-width))
|
||
(t display-height)))
|
||
(min-width
|
||
(cond
|
||
((numberp (nth 3 sizes))
|
||
(- (* (nth 3 sizes) char-width) window-extra-width))
|
||
((numberp min-width)
|
||
(- (* min-width char-width) window-extra-width))
|
||
(t (* window-min-width char-width))))
|
||
;; Note: Currently, for a new frame the sizes of the header
|
||
;; and mode line may be estimated incorrectly
|
||
(value (window-text-pixel-size
|
||
nil t t workarea-width workarea-height t))
|
||
(width (+ (car value) (window-right-divider-width)))
|
||
(height (+ (cdr value) (window-bottom-divider-width))))
|
||
;; Don't change height or width when the window's size is fixed
|
||
;; in either direction.
|
||
(cond
|
||
((eq window-size-fixed 'width)
|
||
(setq width nil))
|
||
((eq window-size-fixed 'height)
|
||
(setq height nil)))
|
||
;; Fit width to constraints.
|
||
(when width
|
||
(unless frame-resize-pixelwise
|
||
;; Round to character sizes.
|
||
(setq width (* (/ (+ width char-width -1) char-width)
|
||
char-width)))
|
||
;; Fit to maximum and minimum widths.
|
||
(setq width (max (min width max-width) min-width))
|
||
;; Add extra width.
|
||
(setq width (+ width extra-width))
|
||
;; Preserve margins.
|
||
(let ((right (+ left width)))
|
||
(cond
|
||
((> right right-margin)
|
||
;; Move frame to left (we don't know its real width).
|
||
(setq left (max left-margin (- left (- right right-margin)))))
|
||
((< left left-margin)
|
||
;; Move frame to right.
|
||
(setq left left-margin)))))
|
||
;; Fit height to constraints.
|
||
(when height
|
||
(unless frame-resize-pixelwise
|
||
(setq height (* (/ (+ height char-height -1) char-height)
|
||
char-height)))
|
||
;; Fit to maximum and minimum heights.
|
||
(setq height (max (min height max-height) min-height))
|
||
;; Add extra height.
|
||
(setq height (+ height extra-height))
|
||
;; Preserve margins.
|
||
(let ((bottom (+ top height)))
|
||
(cond
|
||
((> bottom bottom-margin)
|
||
;; Move frame up (we don't know its real height).
|
||
(setq top (max top-margin (- top (- bottom bottom-margin)))))
|
||
((< top top-margin)
|
||
;; Move frame down.
|
||
(setq top top-margin)))))
|
||
;; Apply changes.
|
||
(set-frame-position frame left top)
|
||
;; Clumsily try to translate our calculations to what
|
||
;; `set-frame-size' wants.
|
||
(when width
|
||
(setq width (- (+ (frame-text-width) width)
|
||
extra-width window-body-width)))
|
||
(when height
|
||
(setq height (- (+ (frame-text-height) height)
|
||
extra-height window-height)))
|
||
(set-frame-size
|
||
frame
|
||
(if width
|
||
(if frame-resize-pixelwise
|
||
width
|
||
(/ width char-width))
|
||
(frame-text-width))
|
||
(if height
|
||
(if frame-resize-pixelwise
|
||
height
|
||
(/ height char-height))
|
||
(frame-text-height))
|
||
frame-resize-pixelwise)))))
|
||
|
||
(defun fit-window-to-buffer (&optional window max-height min-height max-width min-width)
|
||
"Adjust size of WINDOW to display its buffer's contents exactly.
|
||
WINDOW must be a live window and defaults to the selected one.
|
||
|
||
If WINDOW is part of a vertical combination, adjust WINDOW's
|
||
height. The new height is calculated from the number of lines of
|
||
the accessible portion of its buffer. The optional argument
|
||
MAX-HEIGHT specifies a maximum height and defaults to the height
|
||
of WINDOW's frame. The optional argument MIN-HEIGHT specifies a
|
||
minimum height and 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.
|
||
|
||
If WINDOW is part of a horizontal combination and the value of
|
||
the option `fit-window-to-buffer-horizontally' is non-nil, adjust
|
||
WINDOW's height. The new width of WINDOW is calculated from the
|
||
maximum length of its buffer's lines that follow the current
|
||
start position of WINDOW. The optional argument MAX-WIDTH
|
||
specifies a maximum width and defaults to the width of WINDOW's
|
||
frame. The optional argument MIN-WIDTH specifies a minimum width
|
||
and defaults to `window-min-width'. Both MAX-WIDTH and MIN-WIDTH
|
||
are specified in columns and include fringes, margins and
|
||
scrollbars, if any.
|
||
|
||
Fit pixelwise if the option `window-resize-pixelwise' is non-nil.
|
||
If WINDOW is its frame's root window, then if the option
|
||
`fit-frame-to-buffer' is non-nil, call `fit-frame-to-buffer' to
|
||
adjust the frame's size.
|
||
|
||
Note that even if this function makes WINDOW large enough to show
|
||
_all_ parts of its buffer you might not see the first part when
|
||
WINDOW was scrolled. If WINDOW is resized horizontally, you will
|
||
not see the top of its buffer unless WINDOW starts at its minimum
|
||
accessible position."
|
||
(interactive)
|
||
(setq window (window-normalize-window window t))
|
||
(if (eq window (frame-root-window window))
|
||
(when fit-frame-to-buffer
|
||
;; Fit WINDOW's frame to buffer.
|
||
(fit-frame-to-buffer
|
||
(window-frame window)
|
||
max-height min-height max-width min-width))
|
||
(with-selected-window window
|
||
(let* ((pixelwise window-resize-pixelwise)
|
||
(char-height (frame-char-height))
|
||
(char-width (frame-char-width))
|
||
(total-height (window-size window nil pixelwise))
|
||
(body-height (window-body-height window pixelwise))
|
||
(body-width (window-body-width window pixelwise))
|
||
(min-height
|
||
;; Sanitize MIN-HEIGHT.
|
||
(if (numberp min-height)
|
||
;; Can't get smaller than `window-safe-min-height'.
|
||
(max (if pixelwise
|
||
(* char-height min-height)
|
||
min-height)
|
||
(if pixelwise
|
||
(window-safe-min-pixel-height window)
|
||
window-safe-min-height))
|
||
;; Preserve header and mode line if present.
|
||
(max (if pixelwise
|
||
(* char-height window-min-height)
|
||
window-min-height)
|
||
(window-min-size nil nil t pixelwise))))
|
||
(max-height
|
||
;; Sanitize MAX-HEIGHT.
|
||
(if (numberp max-height)
|
||
(min
|
||
(+ total-height
|
||
(window-max-delta
|
||
window nil nil nil nil nil pixelwise))
|
||
(if pixelwise
|
||
(* char-height max-height)
|
||
max-height))
|
||
(+ total-height (window-max-delta
|
||
window nil nil nil nil nil pixelwise))))
|
||
height)
|
||
(cond
|
||
;; If WINDOW is vertically combined, try to resize it
|
||
;; vertically.
|
||
((and (not (eq fit-window-to-buffer-horizontally 'only))
|
||
(not (window-size-fixed-p window))
|
||
(window-combined-p))
|
||
;; Vertically we always want to fit the entire buffer.
|
||
;; WINDOW'S height can't get larger than its frame's pixel
|
||
;; height. Its width remains fixed.
|
||
(setq height (+ (cdr (window-text-pixel-size
|
||
nil nil t nil (frame-pixel-height) t))
|
||
(window-bottom-divider-width)))
|
||
;; Round height.
|
||
(unless pixelwise
|
||
(setq height (/ (+ height char-height -1) char-height)))
|
||
(unless (= height total-height)
|
||
(window-resize-no-error
|
||
window
|
||
(- (max min-height (min max-height height)) total-height)
|
||
nil window pixelwise)))
|
||
;; If WINDOW is horizontally combined, try to resize it
|
||
;; horizontally.
|
||
((and fit-window-to-buffer-horizontally
|
||
(not (window-size-fixed-p window t))
|
||
(window-combined-p nil t))
|
||
(let* ((total-width (window-size window t pixelwise))
|
||
(min-width
|
||
;; Sanitize MIN-WIDTH.
|
||
(if (numberp min-width)
|
||
;; Can't get smaller than `window-safe-min-width'.
|
||
(max (if pixelwise
|
||
(* char-width min-width)
|
||
min-width)
|
||
(if pixelwise
|
||
(window-safe-min-pixel-width)
|
||
window-safe-min-width))
|
||
;; Preserve fringes, margins, scrollbars if present.
|
||
(max (if pixelwise
|
||
(* char-width window-min-width)
|
||
window-min-width)
|
||
(window-min-size nil nil t pixelwise))))
|
||
(max-width
|
||
;; Sanitize MAX-WIDTH.
|
||
(if (numberp max-width)
|
||
(min (+ total-width
|
||
(window-max-delta
|
||
nil t nil nil nil nil pixelwise))
|
||
(if pixelwise
|
||
(* char-width max-width)
|
||
max-width))
|
||
(+ total-width (window-max-delta
|
||
nil t nil nil nil nil pixelwise))))
|
||
;; When fitting vertically, assume that WINDOW's start
|
||
;; position remains unaltered. WINDOW can't get wider
|
||
;; than its frame's pixel width, its height remains
|
||
;; unaltered.
|
||
(width (+ (car (window-text-pixel-size
|
||
nil (window-start) (point-max)
|
||
(frame-pixel-width)
|
||
;; Add one char-height to assure that
|
||
;; we're on the safe side. This
|
||
;; overshoots when the first line below
|
||
;; the bottom is wider than the window.
|
||
(* body-height
|
||
(if pixelwise char-height 1))))
|
||
(window-right-divider-width))))
|
||
(unless pixelwise
|
||
(setq width (/ (+ width char-width -1) char-width)))
|
||
(unless (= width body-width)
|
||
(window-resize-no-error
|
||
window
|
||
(- (max min-width
|
||
(min max-width
|
||
(+ total-width (- width body-width))))
|
||
total-width)
|
||
t window pixelwise)))))))))
|
||
|
||
(defun window-safely-shrinkable-p (&optional window)
|
||
"Return t if WINDOW can be shrunk without shrinking other windows.
|
||
WINDOW defaults to the selected window."
|
||
(with-selected-window (or window (selected-window))
|
||
(let ((edges (window-edges)))
|
||
(or (= (nth 2 edges) (nth 2 (window-edges (previous-window))))
|
||
(= (nth 0 edges) (nth 0 (window-edges (next-window))))))))
|
||
|
||
(defun shrink-window-if-larger-than-buffer (&optional window)
|
||
"Shrink height of WINDOW if its buffer doesn't need so many lines.
|
||
More precisely, shrink WINDOW vertically to be as small as
|
||
possible, while still showing the full contents of its buffer.
|
||
WINDOW must be a live window and defaults to the selected one.
|
||
|
||
Do not shrink WINDOW to less than `window-min-height' lines. Do
|
||
nothing if the buffer contains more lines than the present window
|
||
height, or if some of the window's contents are scrolled out of
|
||
view, or if shrinking this window would also shrink another
|
||
window, or if the window is the only window of its frame.
|
||
|
||
Return non-nil if the window was shrunk, nil otherwise."
|
||
(interactive)
|
||
(setq window (window-normalize-window window t))
|
||
;; Make sure that WINDOW is vertically combined and `point-min' is
|
||
;; visible (for whatever reason that's needed). The remaining issues
|
||
;; should be taken care of by `fit-window-to-buffer'.
|
||
(when (and (window-combined-p window)
|
||
(pos-visible-in-window-p (point-min) window))
|
||
(fit-window-to-buffer window (window-total-height window))))
|
||
|
||
(defun kill-buffer-and-window ()
|
||
"Kill the current buffer and delete the selected window."
|
||
(interactive)
|
||
(let ((window-to-delete (selected-window))
|
||
(buffer-to-kill (current-buffer))
|
||
(delete-window-hook (lambda () (ignore-errors (delete-window)))))
|
||
(unwind-protect
|
||
(progn
|
||
(add-hook 'kill-buffer-hook delete-window-hook t t)
|
||
(if (kill-buffer (current-buffer))
|
||
;; If `delete-window' failed before, we rerun it to regenerate
|
||
;; the error so it can be seen in the echo area.
|
||
(when (eq (selected-window) window-to-delete)
|
||
(delete-window))))
|
||
;; If the buffer is not dead for some reason (probably because
|
||
;; of a `quit' signal), remove the hook again.
|
||
(ignore-errors
|
||
(with-current-buffer buffer-to-kill
|
||
(remove-hook 'kill-buffer-hook delete-window-hook t))))))
|
||
|
||
|
||
(defvar recenter-last-op nil
|
||
"Indicates the last recenter operation performed.
|
||
Possible values: `top', `middle', `bottom', integer or float numbers.")
|
||
|
||
(defcustom recenter-positions '(middle top bottom)
|
||
"Cycling order for `recenter-top-bottom'.
|
||
A list of elements with possible values `top', `middle', `bottom',
|
||
integer or float numbers that define the cycling order for
|
||
the command `recenter-top-bottom'.
|
||
|
||
Top and bottom destinations are `scroll-margin' lines from the true
|
||
window top and bottom. Middle redraws the frame and centers point
|
||
vertically within the window. Integer number moves current line to
|
||
the specified absolute window-line. Float number between 0.0 and 1.0
|
||
means the percentage of the screen space from the top. The default
|
||
cycling order is middle -> top -> bottom."
|
||
:type '(repeat (choice
|
||
(const :tag "Top" top)
|
||
(const :tag "Middle" middle)
|
||
(const :tag "Bottom" bottom)
|
||
(integer :tag "Line number")
|
||
(float :tag "Percentage")))
|
||
:version "23.2"
|
||
:group 'windows)
|
||
|
||
(defun recenter-top-bottom (&optional arg)
|
||
"Move current buffer line to the specified window line.
|
||
With no prefix argument, successive calls place point according
|
||
to the cycling order defined by `recenter-positions'.
|
||
|
||
A prefix argument is handled like `recenter':
|
||
With numeric prefix ARG, move current line to window-line ARG.
|
||
With plain `C-u', move current line to window center."
|
||
(interactive "P")
|
||
(cond
|
||
(arg (recenter arg)) ; Always respect ARG.
|
||
(t
|
||
(setq recenter-last-op
|
||
(if (eq this-command last-command)
|
||
(car (or (cdr (member recenter-last-op recenter-positions))
|
||
recenter-positions))
|
||
(car recenter-positions)))
|
||
(let ((this-scroll-margin
|
||
(min (max 0 scroll-margin)
|
||
(truncate (/ (window-body-height) 4.0)))))
|
||
(cond ((eq recenter-last-op 'middle)
|
||
(recenter))
|
||
((eq recenter-last-op 'top)
|
||
(recenter this-scroll-margin))
|
||
((eq recenter-last-op 'bottom)
|
||
(recenter (- -1 this-scroll-margin)))
|
||
((integerp recenter-last-op)
|
||
(recenter recenter-last-op))
|
||
((floatp recenter-last-op)
|
||
(recenter (round (* recenter-last-op (window-height))))))))))
|
||
|
||
(define-key global-map [?\C-l] 'recenter-top-bottom)
|
||
|
||
(defun move-to-window-line-top-bottom (&optional arg)
|
||
"Position point relative to window.
|
||
|
||
With a prefix argument ARG, acts like `move-to-window-line'.
|
||
|
||
With no argument, positions point at center of window.
|
||
Successive calls position point at positions defined
|
||
by `recenter-positions'."
|
||
(interactive "P")
|
||
(cond
|
||
(arg (move-to-window-line arg)) ; Always respect ARG.
|
||
(t
|
||
(setq recenter-last-op
|
||
(if (eq this-command last-command)
|
||
(car (or (cdr (member recenter-last-op recenter-positions))
|
||
recenter-positions))
|
||
(car recenter-positions)))
|
||
(let ((this-scroll-margin
|
||
(min (max 0 scroll-margin)
|
||
(truncate (/ (window-body-height) 4.0)))))
|
||
(cond ((eq recenter-last-op 'middle)
|
||
(call-interactively 'move-to-window-line))
|
||
((eq recenter-last-op 'top)
|
||
(move-to-window-line this-scroll-margin))
|
||
((eq recenter-last-op 'bottom)
|
||
(move-to-window-line (- -1 this-scroll-margin)))
|
||
((integerp recenter-last-op)
|
||
(move-to-window-line recenter-last-op))
|
||
((floatp recenter-last-op)
|
||
(move-to-window-line (round (* recenter-last-op (window-height))))))))))
|
||
|
||
(define-key global-map [?\M-r] 'move-to-window-line-top-bottom)
|
||
|
||
;;; Scrolling commands.
|
||
|
||
;;; Scrolling commands which do not signal errors at top/bottom
|
||
;;; of buffer at first key-press (instead move to top/bottom
|
||
;;; of buffer).
|
||
|
||
(defcustom scroll-error-top-bottom nil
|
||
"Move point to top/bottom of buffer before signaling a scrolling error.
|
||
A value of nil means just signal an error if no more scrolling possible.
|
||
A value of t means point moves to the beginning or the end of the buffer
|
||
\(depending on scrolling direction) when no more scrolling possible.
|
||
When point is already on that position, then signal an error."
|
||
:type 'boolean
|
||
:group 'windows
|
||
:version "24.1")
|
||
|
||
(defun scroll-up-command (&optional arg)
|
||
"Scroll text of selected window upward ARG lines; or near full screen if no ARG.
|
||
If `scroll-error-top-bottom' is non-nil and `scroll-up' cannot
|
||
scroll window further, move cursor to the bottom line.
|
||
When point is already on that position, then signal an error.
|
||
A near full screen is `next-screen-context-lines' less than a full screen.
|
||
Negative ARG means scroll downward.
|
||
If ARG is the atom `-', scroll downward by nearly full screen."
|
||
(interactive "^P")
|
||
(cond
|
||
((null scroll-error-top-bottom)
|
||
(scroll-up arg))
|
||
((eq arg '-)
|
||
(scroll-down-command nil))
|
||
((< (prefix-numeric-value arg) 0)
|
||
(scroll-down-command (- (prefix-numeric-value arg))))
|
||
((eobp)
|
||
(scroll-up arg)) ; signal error
|
||
(t
|
||
(condition-case nil
|
||
(scroll-up arg)
|
||
(end-of-buffer
|
||
(if arg
|
||
;; When scrolling by ARG lines can't be done,
|
||
;; move by ARG lines instead.
|
||
(forward-line arg)
|
||
;; When ARG is nil for full-screen scrolling,
|
||
;; move to the bottom of the buffer.
|
||
(goto-char (point-max))))))))
|
||
|
||
(put 'scroll-up-command 'scroll-command t)
|
||
|
||
(defun scroll-down-command (&optional arg)
|
||
"Scroll text of selected window down ARG lines; or near full screen if no ARG.
|
||
If `scroll-error-top-bottom' is non-nil and `scroll-down' cannot
|
||
scroll window further, move cursor to the top line.
|
||
When point is already on that position, then signal an error.
|
||
A near full screen is `next-screen-context-lines' less than a full screen.
|
||
Negative ARG means scroll upward.
|
||
If ARG is the atom `-', scroll upward by nearly full screen."
|
||
(interactive "^P")
|
||
(cond
|
||
((null scroll-error-top-bottom)
|
||
(scroll-down arg))
|
||
((eq arg '-)
|
||
(scroll-up-command nil))
|
||
((< (prefix-numeric-value arg) 0)
|
||
(scroll-up-command (- (prefix-numeric-value arg))))
|
||
((bobp)
|
||
(scroll-down arg)) ; signal error
|
||
(t
|
||
(condition-case nil
|
||
(scroll-down arg)
|
||
(beginning-of-buffer
|
||
(if arg
|
||
;; When scrolling by ARG lines can't be done,
|
||
;; move by ARG lines instead.
|
||
(forward-line (- arg))
|
||
;; When ARG is nil for full-screen scrolling,
|
||
;; move to the top of the buffer.
|
||
(goto-char (point-min))))))))
|
||
|
||
(put 'scroll-down-command 'scroll-command t)
|
||
|
||
;;; Scrolling commands which scroll a line instead of full screen.
|
||
|
||
(defun scroll-up-line (&optional arg)
|
||
"Scroll text of selected window upward ARG lines; or one line if no ARG.
|
||
If ARG is omitted or nil, scroll upward by one line.
|
||
This is different from `scroll-up-command' that scrolls a full screen."
|
||
(interactive "p")
|
||
(scroll-up (or arg 1)))
|
||
|
||
(put 'scroll-up-line 'scroll-command t)
|
||
|
||
(defun scroll-down-line (&optional arg)
|
||
"Scroll text of selected window down ARG lines; or one line if no ARG.
|
||
If ARG is omitted or nil, scroll down by one line.
|
||
This is different from `scroll-down-command' that scrolls a full screen."
|
||
(interactive "p")
|
||
(scroll-down (or arg 1)))
|
||
|
||
(put 'scroll-down-line 'scroll-command t)
|
||
|
||
|
||
(defun scroll-other-window-down (&optional lines)
|
||
"Scroll the \"other window\" down.
|
||
For more details, see the documentation for `scroll-other-window'."
|
||
(interactive "P")
|
||
(scroll-other-window
|
||
;; Just invert the argument's meaning.
|
||
;; We can do that without knowing which window it will be.
|
||
(if (eq lines '-) nil
|
||
(if (null lines) '-
|
||
(- (prefix-numeric-value lines))))))
|
||
|
||
(defun beginning-of-buffer-other-window (arg)
|
||
"Move point to the beginning of the buffer in the other window.
|
||
Leave mark at previous position.
|
||
With arg N, put point N/10 of the way from the true beginning."
|
||
(interactive "P")
|
||
(let ((orig-window (selected-window))
|
||
(window (other-window-for-scrolling)))
|
||
;; We use unwind-protect rather than save-window-excursion
|
||
;; because the latter would preserve the things we want to change.
|
||
(unwind-protect
|
||
(progn
|
||
(select-window window)
|
||
;; Set point and mark in that window's buffer.
|
||
(with-no-warnings
|
||
(beginning-of-buffer arg))
|
||
;; Set point accordingly.
|
||
(recenter '(t)))
|
||
(select-window orig-window))))
|
||
|
||
(defun end-of-buffer-other-window (arg)
|
||
"Move point to the end of the buffer in the other window.
|
||
Leave mark at previous position.
|
||
With arg N, put point N/10 of the way from the true end."
|
||
(interactive "P")
|
||
;; See beginning-of-buffer-other-window for comments.
|
||
(let ((orig-window (selected-window))
|
||
(window (other-window-for-scrolling)))
|
||
(unwind-protect
|
||
(progn
|
||
(select-window window)
|
||
(with-no-warnings
|
||
(end-of-buffer arg))
|
||
(recenter '(t)))
|
||
(select-window orig-window))))
|
||
|
||
(defvar mouse-autoselect-window-timer nil
|
||
"Timer used by delayed window autoselection.")
|
||
|
||
(defvar mouse-autoselect-window-position nil
|
||
"Last mouse position recorded by delayed window autoselection.")
|
||
|
||
(defvar mouse-autoselect-window-window nil
|
||
"Last window recorded by delayed window autoselection.")
|
||
|
||
(defvar mouse-autoselect-window-state nil
|
||
"When non-nil, special state of delayed window autoselection.
|
||
Possible values are `suspend' (suspend autoselection after a menu or
|
||
scrollbar interaction) and `select' (the next invocation of
|
||
`handle-select-window' shall select the window immediately).")
|
||
|
||
(defun mouse-autoselect-window-cancel (&optional force)
|
||
"Cancel delayed window autoselection.
|
||
Optional argument FORCE means cancel unconditionally."
|
||
(unless (and (not force)
|
||
;; Don't cancel for select-window or select-frame events
|
||
;; or when the user drags a scroll bar.
|
||
(or (memq this-command
|
||
'(handle-select-window handle-switch-frame))
|
||
(and (eq this-command 'scroll-bar-toolkit-scroll)
|
||
(memq (nth 4 (event-end last-input-event))
|
||
'(handle end-scroll)))))
|
||
(setq mouse-autoselect-window-state nil)
|
||
(when (timerp mouse-autoselect-window-timer)
|
||
(cancel-timer mouse-autoselect-window-timer))
|
||
(remove-hook 'pre-command-hook 'mouse-autoselect-window-cancel)))
|
||
|
||
(defun mouse-autoselect-window-start (mouse-position &optional window suspend)
|
||
"Start delayed window autoselection.
|
||
MOUSE-POSITION is the last position where the mouse was seen as returned
|
||
by `mouse-position'. Optional argument WINDOW non-nil denotes the
|
||
window where the mouse was seen. Optional argument SUSPEND non-nil
|
||
means suspend autoselection."
|
||
;; Record values for MOUSE-POSITION, WINDOW, and SUSPEND.
|
||
(setq mouse-autoselect-window-position mouse-position)
|
||
(when window (setq mouse-autoselect-window-window window))
|
||
(setq mouse-autoselect-window-state (when suspend 'suspend))
|
||
;; Install timer which runs `mouse-autoselect-window-select' after
|
||
;; `mouse-autoselect-window' seconds.
|
||
(setq mouse-autoselect-window-timer
|
||
(run-at-time
|
||
(abs mouse-autoselect-window) nil 'mouse-autoselect-window-select)))
|
||
|
||
(defun mouse-autoselect-window-select ()
|
||
"Select window with delayed window autoselection.
|
||
If the mouse position has stabilized in a non-selected window, select
|
||
that window. The minibuffer window is selected only if the minibuffer
|
||
is active. This function is run by `mouse-autoselect-window-timer'."
|
||
(ignore-errors
|
||
(let* ((mouse-position (mouse-position))
|
||
(window
|
||
(ignore-errors
|
||
(window-at (cadr mouse-position) (cddr mouse-position)
|
||
(car mouse-position)))))
|
||
(cond
|
||
((or (and (fboundp 'menu-or-popup-active-p) (menu-or-popup-active-p))
|
||
(and window
|
||
(let ((coords (coordinates-in-window-p
|
||
(cdr mouse-position) window)))
|
||
(and (not (consp coords))
|
||
(not (memq coords '(left-margin right-margin)))))))
|
||
;; A menu / popup dialog is active or the mouse is not on the
|
||
;; text region of WINDOW: Suspend autoselection temporarily.
|
||
(mouse-autoselect-window-start mouse-position nil t))
|
||
((eq mouse-autoselect-window-state 'suspend)
|
||
;; Delayed autoselection was temporarily suspended, reenable it.
|
||
(mouse-autoselect-window-start mouse-position))
|
||
((and window (not (eq window (selected-window)))
|
||
(or (not (numberp mouse-autoselect-window))
|
||
(and (> mouse-autoselect-window 0)
|
||
;; If `mouse-autoselect-window' is positive, select
|
||
;; window if the window is the same as before.
|
||
(eq window mouse-autoselect-window-window))
|
||
;; Otherwise select window if the mouse is at the same
|
||
;; position as before. Observe that the first test after
|
||
;; starting autoselection usually fails since the value of
|
||
;; `mouse-autoselect-window-position' recorded there is the
|
||
;; position where the mouse has entered the new window and
|
||
;; not necessarily where the mouse has stopped moving.
|
||
(equal mouse-position mouse-autoselect-window-position))
|
||
;; The minibuffer is a candidate window if it's active.
|
||
(or (not (window-minibuffer-p window))
|
||
(eq window (active-minibuffer-window))))
|
||
;; Mouse position has stabilized in non-selected window: Cancel
|
||
;; delayed autoselection and try to select that window.
|
||
(mouse-autoselect-window-cancel t)
|
||
;; Select window where mouse appears unless the selected window is the
|
||
;; minibuffer. Use `unread-command-events' in order to execute pre-
|
||
;; and post-command hooks and trigger idle timers. To avoid delaying
|
||
;; autoselection again, set `mouse-autoselect-window-state'."
|
||
(unless (window-minibuffer-p)
|
||
(setq mouse-autoselect-window-state 'select)
|
||
(setq unread-command-events
|
||
(cons (list 'select-window (list window))
|
||
unread-command-events))))
|
||
((or (and window (eq window (selected-window)))
|
||
(not (numberp mouse-autoselect-window))
|
||
(equal mouse-position mouse-autoselect-window-position))
|
||
;; Mouse position has either stabilized in the selected window or at
|
||
;; `mouse-autoselect-window-position': Cancel delayed autoselection.
|
||
(mouse-autoselect-window-cancel t))
|
||
(t
|
||
;; Mouse position has not stabilized yet, resume delayed
|
||
;; autoselection.
|
||
(mouse-autoselect-window-start mouse-position window))))))
|
||
|
||
(defun handle-select-window (event)
|
||
"Handle select-window events."
|
||
(interactive "e")
|
||
(let ((window (posn-window (event-start event))))
|
||
(unless (or (not (window-live-p window))
|
||
;; Don't switch if we're currently in the minibuffer.
|
||
;; This tries to work around problems where the
|
||
;; minibuffer gets unselected unexpectedly, and where
|
||
;; you then have to move your mouse all the way down to
|
||
;; the minibuffer to select it.
|
||
(window-minibuffer-p)
|
||
;; Don't switch to minibuffer window unless it's active.
|
||
(and (window-minibuffer-p window)
|
||
(not (minibuffer-window-active-p window)))
|
||
;; Don't switch when autoselection shall be delayed.
|
||
(and (numberp mouse-autoselect-window)
|
||
(not (zerop mouse-autoselect-window))
|
||
(not (eq mouse-autoselect-window-state 'select))
|
||
(progn
|
||
;; Cancel any delayed autoselection.
|
||
(mouse-autoselect-window-cancel t)
|
||
;; Start delayed autoselection from current mouse
|
||
;; position and window.
|
||
(mouse-autoselect-window-start (mouse-position) window)
|
||
;; Executing a command cancels delayed autoselection.
|
||
(add-hook
|
||
'pre-command-hook 'mouse-autoselect-window-cancel))))
|
||
(when mouse-autoselect-window
|
||
;; Reset state of delayed autoselection.
|
||
(setq mouse-autoselect-window-state nil)
|
||
;; Run `mouse-leave-buffer-hook' when autoselecting window.
|
||
(run-hooks 'mouse-leave-buffer-hook))
|
||
;; Clear echo area.
|
||
(message nil)
|
||
(select-window window))))
|
||
|
||
(defun truncated-partial-width-window-p (&optional window)
|
||
"Return non-nil if lines in WINDOW are specifically truncated due to its width.
|
||
WINDOW must be a live window and defaults to the selected one.
|
||
Return nil if WINDOW is not a partial-width window
|
||
(regardless of the value of `truncate-lines').
|
||
Otherwise, consult the value of `truncate-partial-width-windows'
|
||
for the buffer shown in WINDOW."
|
||
(setq window (window-normalize-window window t))
|
||
(unless (window-full-width-p window)
|
||
(let ((t-p-w-w (buffer-local-value 'truncate-partial-width-windows
|
||
(window-buffer window))))
|
||
(if (integerp t-p-w-w)
|
||
(< (window-width window) t-p-w-w)
|
||
t-p-w-w))))
|
||
|
||
;; Some of these are in tutorial--default-keys, so update that if you
|
||
;; change these.
|
||
(define-key ctl-x-map "0" 'delete-window)
|
||
(define-key ctl-x-map "1" 'delete-other-windows)
|
||
(define-key ctl-x-map "2" 'split-window-below)
|
||
(define-key ctl-x-map "3" 'split-window-right)
|
||
(define-key ctl-x-map "o" 'other-window)
|
||
(define-key ctl-x-map "^" 'enlarge-window)
|
||
(define-key ctl-x-map "}" 'enlarge-window-horizontally)
|
||
(define-key ctl-x-map "{" 'shrink-window-horizontally)
|
||
(define-key ctl-x-map "-" 'shrink-window-if-larger-than-buffer)
|
||
(define-key ctl-x-map "+" 'balance-windows)
|
||
(define-key ctl-x-4-map "0" 'kill-buffer-and-window)
|
||
|
||
;;; window.el ends here
|