Commit caceae25 authored by Martin Rudalics's avatar Martin Rudalics
Browse files

Rewrite handling of side and atomic windows.

* window.el (display-buffer-in-atom-window, window--major-non-side-window)
(window--major-side-window, display-buffer-in-major-side-window)
(delete-side-window, display-buffer-in-side-window): New
functions.
(window--side-check, window-deletable-p, delete-window)
(delete-other-windows, split-window): Handle side windows and
atomic windows appropriately.
(window--display-buffer): Call display-buffer-record-window also
when the window buffer did not change.
parent 842e3a93
......@@ -7,6 +7,15 @@
(window-in-direction): Simplify and rewrite doc-string.
(window--size-ignore): Rename to window--size-ignore-p. Update
callers.
(display-buffer-in-atom-window, window--major-non-side-window)
(window--major-side-window, display-buffer-in-major-side-window)
(delete-side-window, display-buffer-in-side-window): New
functions.
(window--side-check, window-deletable-p, delete-window)
(delete-other-windows, split-window): Handle side windows and
atomic windows appropriately.
(window--display-buffer): Call display-buffer-record-window also
when the window buffer did not change.
 
2012-08-22 Christopher Schmidt <christopher@ch.ristopher.com>
 
......
......@@ -357,6 +357,45 @@ WINDOW must be an internal window. Return WINDOW."
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.
`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'.
The return value is the new window, nil when creating that window
failed."
(let ((ignore-window-parameters t)
(window-combination-limit t)
(window (cdr (assq 'window alist)))
(side (cdr (assq 'side alist)))
new)
(setq window (window-normalize-window window))
;; Split off new window
(when (setq new (split-window window nil side))
;; Make sure we have a valid atomic window.
(window-make-atom (window-parent window))
;; Display BUFFER in NEW and return NEW.
(window--display-buffer
buffer new 'window display-buffer-mark-dedicated))))
(defun window--atom-check-1 (window)
"Subroutine of `window--atom-check'."
(when window
......@@ -446,23 +485,273 @@ number of slots on that side."
(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)
(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* ((root (frame-root-window))
(left-or-right (memq side '(left right)))
(size (or (assq 'size alist)
(/ (window-total-size (frame-root-window) left-or-right)
;; By default use a fourth of the size of the
;; frame's root window. This has to be made
;; customizable via ALIST.
4)))
(major (window--major-side-window side))
(selected-window (selected-window))
(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 (- size) on-side))
fun)
(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)
;; Install BUFFER in new window and return NEW.
(window--display-buffer buffer new 'window '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 window on side SIDE of the selected frame.
ALIST is an association list of symbols and values. The
following symbols can be used:
`side' denotes the side of the existing window 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))
new)
(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)))))
(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))
(selected-window (selected-window))
window this-window this-slot prev-window next-window
best-window best-slot abs-slot new-window)
(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 '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 '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 'side)))))))))
(defun window--side-check (&optional frame)
"Check the window-side parameter of all windows on FRAME.
FRAME defaults to the selected frame. If the configuration is
invalid, reset all window-side parameters to nil.
A valid configuration has to preserve the following invariant:
- If a window has a non-nil window-side parameter, it must have a
parent window and the parent window's window-side parameter
must be either nil or the same as for window.
- If windows with non-nil window-side parameters exist, there
must be at most one window of each side and non-side with a
parent whose window-side parameter is nil and there must be no
leaf window whose window-side parameter is nil."
(let (normal none left top right bottom
side parent parent-side)
"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)
......@@ -478,40 +767,34 @@ A valid configuration has to preserve the following invariant:
;; A parent whose window-side is non-nil must
;; have a child with the same window-side.
(throw 'reset t)))
;; Now check that there's more than one main window
;; for any of none, left, top, right and bottom.
((eq side 'none)
(if none
(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)))
(if left (throw 'reset t) (setq left t)))
((eq side 'top)
(if top
(throw 'reset t)
(setq top t)))
(if top (throw 'reset t) (setq top t)))
((eq side 'right)
(if right
(throw 'reset t)
(setq right t)))
(if right (throw 'reset t) (setq right t)))
((eq side 'bottom)
(if bottom
(throw 'reset t)
(setq bottom t)))
((window-buffer window)
;; A leaf window without window-side parameter,
;; record its existence.
(setq normal t))))
(if bottom (throw 'reset t) (setq bottom t)))
(t
(throw 'reset t))))
frame t))
(if none
;; At least one non-side window exists, so there must
;; be at least one side-window and no normal window.
(or (not (or left top right bottom)) normal)
;; No non-side window exists, so there must be no side
;; window either.
(or left top right bottom)))
;; 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))
......@@ -2393,8 +2676,7 @@ Return `frame' if deleting WINDOW should also delete its frame."
(when (window-parameter window 'window-atom)
(setq window (window-atom-root window))))
(let ((parent (window-parent window))
(frame (window-frame window)))
(let ((frame (window-frame window)))
(cond
((frame-root-window-p window)
;; WINDOW's frame can be deleted only if there are other frames
......@@ -2405,10 +2687,9 @@ Return `frame' if deleting WINDOW should also delete its frame."
(and minibuf (eq frame (window-frame minibuf)))))
'frame))
((or ignore-window-parameters
(not (eq (window-parameter window 'window-side) 'none))
(and parent (eq (window-parameter parent 'window-side) 'none)))
;; WINDOW can be deleted unless it is the main window of its
;; frame.
(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)
......@@ -2459,13 +2740,13 @@ that is its frame's root window."
((and (window-parameter window 'window-atom)
(setq atom-root (window-atom-root window))
(not (eq atom-root window)))
(throw 'done (delete-window atom-root)))
((and (eq (window-parameter window 'window-side) 'none)
(or (not parent)
(not (eq (window-parameter parent 'window-side) 'none))))
(error "Attempt to delete last non-side 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")))
(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-total-size window horizontal))
......@@ -2539,13 +2820,19 @@ window signal an error."
((and (window-parameter window 'window-atom)
(setq atom-root (window-atom-root window))
(not (eq atom-root window)))
(throw 'done (delete-other-windows atom-root)))
((eq window-side 'none)
;; Set side-main to the major non-side window.
(setq side-main (window-with-parameter 'window-side 'none frame t)))
(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")))
;; If WINDOW is the main non-side window, do nothing.
(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)
......@@ -3204,14 +3491,16 @@ frame. The selected window is not changed by this function."
((not side) 'below)
((memq side '(below above right left)) side)
(t 'right)))
(horizontal (not (memq side '(nil below above))))
(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 `window-combination-limit' since in some cases we may
;; have to override its value.
;; Rebind `window-combination-limit' and
;; `window-combination-resize' since in some cases we may have
;; to override their value.
(window-combination-limit window-combination-limit)
(window-combination-resize window-combination-resize)
atom-root)
(window--check frame)
......@@ -3229,20 +3518,32 @@ frame. The selected window is not changed by this function."
((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))))
(when (and window-side
(or (not parent)
(not (window-parameter parent 'window-side))))
;; WINDOW is a side root window. To make sure that a new parent
;; window gets created set `window-combination-limit' to t.
(setq window-combination-limit t))
(when (and window-combination-resize size (> size 0))
;; If `window-combination-resize' is non-nil and SIZE is a
;; non-negative integer, we cannot reasonably resize other
;; windows. Rather bind `window-combination-limit' to t to make
;; sure that subsequent window deletions are handled correctly.
(throw 'done (split-window atom-root size side)))
;; 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) size (> size 0))
(setq window-combination-limit t))
(let* ((parent-size
......@@ -3252,7 +3553,10 @@ frame. The selected window is not changed by this function."
;; `resize' non-nil means we are supposed to resize other
;; windows in WINDOW's combination.
(resize
(and window-combination-resize (not window-combination-limit)
(and window-combination-resize
(or (window-parameter window 'window-side)
(not (eq window-combination-resize 'side)))
(not window-combination-limit)
;; Resize makes sense in iso-combinations only.
(window-combined-p window horizontal)))
;; `old-size' is the current size of WINDOW.
......@@ -3363,10 +3667,21 @@ frame. The selected window is not changed by this function."
new-normal)))
(let* ((new (split-window-internal window new-size side new-normal)))
;; Inherit window-side parameters, if any.
(when (and window-side new-parent)
(set-window-parameter (window-parent new) 'window-side window-side)
(set-window-parameter new 'window-side window-side))
;; Assign window-side parameters, if any.
(when (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))))
(run-window-configuration-change-hook frame)
(window--check frame)
......@@ -4621,9 +4936,9 @@ is passed unaltered to `display-buffer-record-window'. 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)
(display-buffer-record-window type window buffer)
(set-window-buffer window buffer)
(when dedicated
(set-window-dedicated-p window dedicated))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment