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
(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)
;; 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))
(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
(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)
((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))
((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)
((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)
((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
;; `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.
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)
`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))
projects / emacs.git / commitdiff