Commit 6198ccd0 authored by Martin Rudalics's avatar Martin Rudalics
Browse files

Window configuration, balancing and fit-to-buffer rewrites.

* window.c (delete_deletable_window): Re-add.
(Fset_window_configuration): Rewrite to handle dead buffers and
consequently deletable windows.
(window_tree, Fwindow_tree): Remove.  Supply functionality in
window.el.
(compare_window_configurations): Simplify code.

* window.el (window-tree-1, window-tree): New functions, moving
the latter to window.el.
(bw-get-tree, bw-get-tree-1, bw-find-tree-sub)
(bw-find-tree-sub-1, bw-l, bw-t, bw-r, bw-b, bw-dir, bw-eqdir)
(bw-refresh-edges): Remove.
(balance-windows-1, balance-windows-2): New functions.
(balance-windows): Rewrite in terms of window tree functions,
balance-windows-1 and balance-windows-2.
(bw-adjust-window): Remove.
(balance-windows-area-adjust): New function with functionality of
bw-adjust-window but using resize-window.
(set-window-text-height): Rewrite doc-string.  Use
normalize-live-window and resize-window.
(enlarge-window-horizontally, shrink-window-horizontally): Rename
argument to DELTA.
(window-buffer-height): New function.
(fit-window-to-buffer, shrink-window-if-larger-than-buffer):
Rewrite using new window resize routines.
(kill-buffer-and-window, mouse-autoselect-window-select): Use
ignore-errors instead of condition-case.
(quit-window): Call delete-frame instead of delete-windows-on
for the only buffer on frame.
parent 1ab0dee5
2011-06-11 Martin Rudalics <rudalics@gmx.at>
* window.el (window-tree-1, window-tree): New functions, moving
the latter to window.el.
(bw-get-tree, bw-get-tree-1, bw-find-tree-sub)
(bw-find-tree-sub-1, bw-l, bw-t, bw-r, bw-b, bw-dir, bw-eqdir)
(bw-refresh-edges): Remove.
(balance-windows-1, balance-windows-2): New functions.
(balance-windows): Rewrite in terms of window tree functions,
balance-windows-1 and balance-windows-2.
(bw-adjust-window): Remove.
(balance-windows-area-adjust): New function with functionality of
bw-adjust-window but using resize-window.
(set-window-text-height): Rewrite doc-string. Use
normalize-live-window and resize-window.
(enlarge-window-horizontally, shrink-window-horizontally): Rename
argument to DELTA.
(window-buffer-height): New function.
(fit-window-to-buffer, shrink-window-if-larger-than-buffer):
Rewrite using new window resize routines.
(kill-buffer-and-window, mouse-autoselect-window-select): Use
ignore-errors instead of condition-case.
(quit-window): Call delete-frame instead of delete-windows-on
for the only buffer on frame.
2011-06-10 Martin Rudalics <rudalics@gmx.at>
* loadup.el (top-level): Load window before files for the sake
......
......@@ -2077,6 +2077,47 @@ WINDOW can be any window and defaults to the selected window."
(defsubst 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-tree-1 (window &optional next)
"Return window tree rooted at WINDOW.
Optional argument NEXT non-nil means include windows 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-vchild window)
(cons t (cons (window-edges window)
(window-tree-1 (window-vchild window) t))))
((window-hchild window)
(cons nil (cons (window-edges window)
(window-tree-1 (window-hchild window) t))))
(t window))
list))
(setq window (when next (window-next 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 subwindows in the split,
and the rest of the elements are the subwindows in the split.
Each of the subwindows 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 (normalize-live-frame frame))
(window-tree-1 (frame-root-window frame) t))
(defun other-window (count &optional all-frames)
"Select another window in cyclic ordering of windows.
......@@ -3184,201 +3225,125 @@ The selected window remains selected. Return the new window."
(defalias 'split-window-horizontally 'split-window-side-by-side)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; `balance-windows' subroutines using `window-tree'
;;; Translate from internal window tree format
(defun bw-get-tree (&optional window-or-frame)
"Get a window split tree in our format.
WINDOW-OR-FRAME must be nil, a frame, or a window. If it is nil,
then the whole window split tree for `selected-frame' is returned.
If it is a frame, then this is used instead. If it is a window,
then the smallest tree containing that window is returned."
(when window-or-frame
(unless (or (framep window-or-frame)
(windowp window-or-frame))
(error "Not a frame or window: %s" window-or-frame)))
(let ((subtree (bw-find-tree-sub window-or-frame)))
(when subtree
(if (integerp subtree)
nil
(bw-get-tree-1 subtree)))))
(defun bw-get-tree-1 (split)
(if (windowp split)
split
(let ((dir (car split))
(edges (car (cdr split)))
(childs (cdr (cdr split))))
(list
(cons 'dir (if dir 'ver 'hor))
(cons 'b (nth 3 edges))
(cons 'r (nth 2 edges))
(cons 't (nth 1 edges))
(cons 'l (nth 0 edges))
(cons 'childs (mapcar #'bw-get-tree-1 childs))))))
(defun bw-find-tree-sub (window-or-frame &optional get-parent)
(let* ((window (when (windowp window-or-frame) window-or-frame))
(frame (when (windowp window) (window-frame window)))
(wt (car (window-tree frame))))
(when (< 1 (length (window-list frame 0)))
(if window
(bw-find-tree-sub-1 wt window get-parent)
wt))))
(defun bw-find-tree-sub-1 (tree win &optional get-parent)
(unless (windowp win) (error "Not a window: %s" win))
(if (memq win tree)
(if get-parent
get-parent
tree)
(let ((childs (cdr (cdr tree)))
child
subtree)
(while (and childs (not subtree))
(setq child (car childs))
(setq childs (cdr childs))
(when (and child (listp child))
(setq subtree (bw-find-tree-sub-1 child win get-parent))))
(if (integerp subtree)
(progn
(if (= 1 subtree)
tree
(1- subtree)))
subtree
))))
;;; Window or object edges
(defun bw-l (obj)
"Left edge of OBJ."
(if (windowp obj) (nth 0 (window-edges obj)) (cdr (assq 'l obj))))
(defun bw-t (obj)
"Top edge of OBJ."
(if (windowp obj) (nth 1 (window-edges obj)) (cdr (assq 't obj))))
(defun bw-r (obj)
"Right edge of OBJ."
(if (windowp obj) (nth 2 (window-edges obj)) (cdr (assq 'r obj))))
(defun bw-b (obj)
"Bottom edge of OBJ."
(if (windowp obj) (nth 3 (window-edges obj)) (cdr (assq 'b obj))))
;;; Split directions
(defun bw-dir (obj)
"Return window split tree direction if OBJ.
If OBJ is a window return 'both. If it is a window split tree
then return its direction."
(if (symbolp obj)
obj
(if (windowp obj)
'both
(let ((dir (cdr (assq 'dir obj))))
(unless (memq dir '(hor ver both))
(error "Can't find dir in %s" obj))
dir))))
(defun bw-eqdir (obj1 obj2)
"Return t if window split tree directions are equal.
OBJ1 and OBJ2 should be either windows or window split trees in
our format. The directions returned by `bw-dir' are compared and
t is returned if they are `eq' or one of them is 'both."
(let ((dir1 (bw-dir obj1))
(dir2 (bw-dir obj2)))
(or (eq dir1 dir2)
(eq dir1 'both)
(eq dir2 'both))))
;;; Building split tree
(defun bw-refresh-edges (obj)
"Refresh the edge information of OBJ and return OBJ."
(unless (windowp obj)
(let ((childs (cdr (assq 'childs obj)))
(ol 1000)
(ot 1000)
(or -1)
(ob -1))
(dolist (o childs)
(when (> ol (bw-l o)) (setq ol (bw-l o)))
(when (> ot (bw-t o)) (setq ot (bw-t o)))
(when (< or (bw-r o)) (setq or (bw-r o)))
(when (< ob (bw-b o)) (setq ob (bw-b o))))
(setq obj (delq 'l obj))
(setq obj (delq 't obj))
(setq obj (delq 'r obj))
(setq obj (delq 'b obj))
(add-to-list 'obj (cons 'l ol))
(add-to-list 'obj (cons 't ot))
(add-to-list 'obj (cons 'r or))
(add-to-list 'obj (cons 'b ob))
))
obj)
;;; Balancing windows.
;; The following routine uses the recycled code from an old version of
;; `resize-subwindows'. It's not very pretty, but coding it the way the
;; new `resize-subwindows' 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 an iso-combination."
(let* ((first (window-child window))
(sub first)
(number-of-children 0)
(parent-size (window-new-total window))
(total-sum parent-size)
found 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-total-size sub horizontal)))
(set-window-new-normal sub 'ignore))
(setq sub (window-right sub)))
;;; Balance windows
(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 subwindows that should be ignored or are stuck.
(unless (resize-subwindows-skip-p sub)
(setq found t)
(setq sub-total (window-total-size sub horizontal))
(setq sub-delta (- size sub-total))
(setq sub-amount
(window-sizable sub sub-delta horizontal))
;; Register the new total size for this subwindow.
(set-window-new-total 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))))
(defun balance-windows (&optional window-or-frame)
"Make windows the same heights or widths in window split subtrees.
(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 (resize-subwindows-skip-p window)
(set-window-new-total sub 1 t)
(setq rest (1- rest)))
(setq sub (window-right sub)))
When called non-interactively WINDOW-OR-FRAME may be either a
window or a frame. It then balances the windows on the implied
frame. If the parameter is a window only the corresponding window
subtree is balanced."
(interactive)
(let (
(wt (bw-get-tree window-or-frame))
(w)
(h)
(tried-sizes)
(last-sizes)
(windows (window-list nil 0)))
(when wt
(while (not (member last-sizes tried-sizes))
(when last-sizes (setq tried-sizes (cons last-sizes tried-sizes)))
(setq last-sizes (mapcar (lambda (w)
(window-edges w))
windows))
(when (eq 'hor (bw-dir wt))
(setq w (- (bw-r wt) (bw-l wt))))
(when (eq 'ver (bw-dir wt))
(setq h (- (bw-b wt) (bw-t wt))))
(bw-balance-sub wt w h)))))
(defun bw-adjust-window (window delta horizontal)
"Wrapper around `adjust-window-trailing-edge' with error checking.
Arguments WINDOW, DELTA and HORIZONTAL are passed on to that function."
;; `adjust-window-trailing-edge' may fail if delta is too large.
(while (>= (abs delta) 1)
(condition-case nil
(progn
(adjust-window-trailing-edge window delta horizontal)
(setq delta 0))
(error
;;(message "adjust: %s" (error-message-string err))
(setq delta (/ delta 2))))))
;; 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-total sub 1 t)
(setq rest (1- rest)))
(setq sub (window-right sub)))
(defun bw-balance-sub (wt w h)
(setq wt (bw-refresh-edges wt))
(unless w (setq w (- (bw-r wt) (bw-l wt))))
(unless h (setq h (- (bw-b wt) (bw-t wt))))
(if (windowp wt)
(progn
(when w
(let ((dw (- w (- (bw-r wt) (bw-l wt)))))
(when (/= 0 dw)
(bw-adjust-window wt dw t))))
(when h
(let ((dh (- h (- (bw-b wt) (bw-t wt)))))
(when (/= 0 dh)
(bw-adjust-window wt dh nil)))))
(let* ((childs (cdr (assq 'childs wt)))
(cw (when w (/ w (if (bw-eqdir 'hor wt) (length childs) 1))))
(ch (when h (/ h (if (bw-eqdir 'ver wt) (length childs) 1)))))
(dolist (c childs)
(bw-balance-sub c cw ch)))))
(setq sub first)
(while sub
;; Record new normal sizes.
(set-window-new-normal
sub (/ (if (eq (window-new-normal sub) 'ignore)
(window-total-size sub horizontal)
(window-new-total sub))
(float parent-size)))
;; Recursively balance each subwindow's subwindows.
(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-iso-combined-p sub horizontal)
(balance-windows-2 window horizontal)
(let ((size (window-new-total window)))
(while sub
(set-window-new-total sub size)
(balance-windows-1 sub horizontal)
(setq sub (window-right sub))))))))
(defun balance-windows (&optional window-or-frame)
"Balance the sizes of subwindows 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
subwindows of that frame's root window. If WINDOW-OR-FRAME
denots a window, balance the sizes of all subwindows 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.
(resize-window-reset (window-frame window))
(balance-windows-1 window)
(resize-window-apply frame)
;; Balance horizontally.
(resize-window-reset (window-frame window) t)
(balance-windows-1 window t)
(resize-window-apply frame t)))
(defun window-fixed-size-p (&optional window direction)
"Return t if WINDOW cannot be resized in DIRECTION.
......@@ -3391,13 +3356,25 @@ nil (i.e. any), `height' or `width'."
'((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)
"Wrapper around `resize-window' with error checking.
Arguments WINDOW, DELTA and HORIZONTAL are passed on to that function."
;; `resize-window' may fail if delta is too large.
(while (>= (abs delta) 1)
(condition-case nil
(progn
(resize-window window delta horizontal)
(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
......@@ -3459,7 +3436,9 @@ specific buffers."
;; Make sure negligible differences don't accumulate to
;; become significant.
(setq carry (+ carry areadiff))
(bw-adjust-window win diff horiz)
;; This used `adjust-window-trailing-edge' before and uses
;; `resize-window' now. Error wrapping is still needed.
(balance-windows-area-adjust win diff horiz)
;; (sit-for 0.5)
(let ((change (cons win (window-edges win))))
;; If the same change has been seen already for this window,
......@@ -4314,13 +4293,15 @@ documentation for additional customization information."
(defun set-window-text-height (window height)
"Set the height in lines of the text display area of WINDOW to HEIGHT.
HEIGHT doesn't include the mode line or header line, if any, or
any partial-height lines in the text display area.
WINDOW must be a live window. 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 (normalize-live-window window))
(let ((delta (- height (window-text-height window))))
(unless (zerop delta)
;; Setting window-min-height to a value like 1 can lead to very
......@@ -4328,36 +4309,21 @@ where some error may be present."
;; windows 1-line tall, which means that there's no more space for
;; the modeline.
(let ((window-min-height (min 2 height))) ; One text line plus a modeline.
(if (and window (not (eq window (selected-window))))
(save-selected-window
(select-window window 'norecord)
(enlarge-window delta))
(enlarge-window delta))))))
(resize-window window delta)))))
(defun enlarge-window-horizontally (columns)
"Make selected window COLUMNS wider.
(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 columns t))
(enlarge-window delta t))
(defun shrink-window-horizontally (columns)
"Make selected window COLUMNS narrower.
(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 columns t))
(defun window-buffer-height (window)
"Return the height (in screen lines) of the buffer that WINDOW is displaying."
(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))))
(shrink-window delta t))
(defun count-screen-lines (&optional beg end count-final-newline window)
"Return the number of screen lines in the region.
......@@ -4395,80 +4361,99 @@ in some window."
(goto-char (point-min))
(1+ (vertical-motion (buffer-size) window))))))
(defun fit-window-to-buffer (&optional window max-height min-height)
(defun window-buffer-height (window)
"Return the height (in screen lines) of the buffer that WINDOW is displaying."
(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 buffers to fit their contents exactly.
(defun fit-window-to-buffer (&optional window max-height min-height override)
"Adjust height of WINDOW to display its buffer's contents exactly.
WINDOW defaults to the selected window.
Optional argument MAX-HEIGHT specifies the maximum height of the
window and defaults to the maximum permissible height of a window
on WINDOW's frame.
Optional argument MIN-HEIGHT specifies the minimum height of the
window 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.
Return non-nil if height was orderly adjusted, nil otherwise.
Caution: This function can delete WINDOW and/or other windows
when their height shrinks to less than MIN-HEIGHT."
WINDOW can be any live window and defaults to the selected one.
Optional argument MAX-HEIGHT specifies the maximum height of
WINDOW and defaults to the height of WINDOW's frame. Optional
argument MIN-HEIGHT specifies the minimum height of WINDOW 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.
Optional argument OVERRIDE non-nil means override restrictions
imposed by `window-min-height' and `window-min-width' on the size
of WINDOW.
Return the number of lines by which WINDOW was enlarged or
shrunk. If an error occurs during resizing, return nil but don't
signal an error.
Note that even if this function makes WINDOW large enough to show
_all_ lines of its buffer you might not see the first lines when
WINDOW was scrolled."
(interactive)
;; Do all the work in WINDOW and its buffer and restore the selected
;; window and the current buffer when we're done.
(let ((old-buffer (current-buffer))
value)
(with-selected-window (or window (setq window (selected-window)))
(set-buffer (window-buffer))
;; Use `condition-case' to handle any fixed-size windows and other
;; pitfalls nearby.
(condition-case nil
(let* (;; MIN-HEIGHT must not be less than 1 and defaults to
;; `window-min-height'.
(min-height (max (or min-height window-min-height) 1))
(setq window (normalize-live-window window))
;; Can't resize a full height or fixed-size window.
(unless (or (window-size-fixed-p window)
(window-full-height-p window))
;; `with-selected-window' should orderly restore the current buffer.
(with-selected-window window
;; We are in WINDOW's buffer now.
(let* ( ;; Adjust MIN-HEIGHT.
(min-height
(if override
(window-min-size window nil window)
(max (or min-height window-min-height)
window-safe-min-height)))
(max-window-height
;; Maximum height of any window on this frame.
(min (window-height (frame-root-window)) (frame-height)))
;; MAX-HEIGHT must not be larger than max-window-height and
;; defaults to max-window-height.
(window-total-size (frame-root-window window)))
;; Adjust MAX-HEIGHT.
(max-height
(min (or max-height max-window-height) max-window-height))
(if (or override (not max-height))
max-window-height
(min max-height max-window-height)))
;; Make `desired-height' the height necessary to show
;; all of WINDOW's buffer, constrained by MIN-HEIGHT
;; and MAX-HEIGHT.
(desired-height
;; The height necessary to show all of WINDOW's buffer,
;; constrained by MIN-HEIGHT and MAX-HEIGHT.
(max
(min
;; For an empty buffer `count-screen-lines' returns zero.
;; Even in that case we need one line for the cursor.
(+ (max (count-screen-lines) 1)
(+ (count-screen-lines)
;; For non-minibuffers count the mode line, if any.
(if (and (not (window-minibuffer-p)) mode-line-format)
1 0)
(if (and (not (window-minibuffer-p window))
mode-line-format)
1
0)
;; Count the header line, if any.
(if header-line-format 1 0))
max-height)
min-height))
(desired-delta
(- desired-height (window-total-size window)))
(delta
;; How much the window height has to change.
(if (= (window-height) (window-height (frame-root-window)))
;; Don't try to resize a full-height window.
(if (> desired-delta 0)
(min desired-delta
(window-max-delta window nil window))
(max desired-delta
(- (window-min-delta window nil window))))))
;; This `condition-case' shouldn't be necessary, but who knows?
(condition-case nil
(if (zerop delta)
;; Return zero if DELTA became zero in the proces.
0
(- desired-height (window-height))))
;; Do something reasonable so `enlarge-window' can make
;; windows as small as MIN-HEIGHT.
(window-min-height (min min-height window-min-height)))
;; Don't try to redisplay with the cursor at the end on its
;; own line--that would force a scroll and spoil things.
(when (and (eobp) (bolp) (not (bobp)))
(set-window-point window (1- (window-point))))
;; Adjust WINDOW's height to the nominally correct one
;; (which may actually be slightly off because of variable
;; height text, etc).
(unless (zerop delta)
(enlarge-window delta))
;; `enlarge-window' might have deleted WINDOW, so make sure
;; WINDOW's still alive for the remainder of this.