From caceae2529106eef4b5cc2b56c0cc6319ea7fcdf Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Wed, 22 Aug 2012 11:22:08 +0200 Subject: [PATCH] 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. --- lisp/ChangeLog | 9 ++ lisp/window.el | 485 +++++++++++++++++++++++++++++++++++++++++++++++---------- 2 files changed, 409 insertions(+), 85 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 4296280b22e..f8ed5ce15fd 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -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 diff --git a/lisp/window.el b/lisp/window.el index ab90d8a4bde..8f402f0c2b9 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -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)) -- 2.11.4.GIT