;;; split-root.el --- root window splitter
;; Copyright (C) 2006 Nikolaj Schumacher
;;; License
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2
;; of the License, or (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
;;; Usage
;; Use `split-root-window' to split the root window. This creates a pair of
;; windows, a new one, and one containing your previous window configuration
;; (as long as it fits).
;;; Known Issues
;; Splitting the root window actually destroys all windows and recreates them.
;; Therefore all windows will be considered dead after splitting.
(require 'cl)
(defun window-settings (window)
"Stores WINDOW's buffer, point and window-start in a list"
(list (window-buffer window) (window-point window) ;;(window-start window)
(eq (selected-window) window)))
(defun set-window-settings (conf &optional window)
"Sets buffer, point and window-start to conf, given by ``window-settings''."
(set-window-buffer window (car conf))
;; (set-window-start window ( conf))
;; set point last, so its guaranteed to stay the same
(set-window-point window (cadr conf))
(when (caddr conf) (select-window window t)))
(defun calculate-window-tree (tree)
"Calculate a version of `window-tree' for use by `split-root-window'."
(if (windowp tree)
(let ((edges (window-edges tree)))
`(,(window-settings tree)
,(- (nth 2 edges) (nth 0 edges))
,(- (nth 3 edges) (nth 1 edges))))
(let* (;;(width 0) (height 0)
(pos (cadr tree))
(width (- (nth 2 pos) (nth 0 pos)))
(height (- (nth 3 pos) (nth 1 pos)))
(horflag (not (car tree)))
(children (mapcar '(lambda (child)
(let ((size (calculate-window-tree child)))
size)) (cddr tree))))
`(,horflag ,width ,height ,@children))))
(defun build-window-tree (tree window)
"Restore window settings from a tree created by `calculate-window-tree'."
(if (atom (car tree))
;; tree
(let ((horflag (car tree))
(children (cdddr tree)))
;; create windows for children
(while (cdr children)
;; recursive descent
(let* ((child (car children))
(child-width (cadr child))
(child-height (caddr child))
(next-window
(split-window window
(if horflag child-width child-height)
horflag)))
(build-window-tree child window)
(setq window next-window)
(pop children)))
(build-window-tree (car children) window))
;; single window
(set-window-settings (car tree) window)))
(defun split-root-scale-window-tree (tree width height)
"Scale a result of `calculate-window-tree' to fit into smaller space."
(if (atom (car tree))
;; tree
(let* ((horflag (car tree))
(w (cadr tree))
(h (caddr tree))
(children (cdddr tree)))
(if (car tree)
(split-root-scale-window-tree-h tree width height)
(split-root-scale-window-tree-v tree width height)))
;; single window
`(,(car tree) ,width ,height)))
(defun split-root-scale-window-tree-h (tree width height)
"`split-root-scale-window-tree' for horizontally split tree nodes."
(let* ((w (cadr tree))
(children (cdddr tree))
result)
(assert (not (eq w 0)))
(assert (not (eq width 0)))
(assert (not (eq h 0)))
(assert (not (eq height 0)))
(while children
(let ((child (car children)))
(pop children)
(let* ((child-width (cadr child))
(new-child-width
(if (null children)
;; last child
width
(round (/ (float (* child-width width))
w)))))
(message "width %s" new-child-width)
;; and resize the child, if big enough
(unless (< new-child-width window-min-width)
;; subtract what we used up
(setq w (- w child-width))
(setq width (- width new-child-width))
(push (split-root-scale-window-tree child new-child-width height)
result)))))
`(t ,width ,height ,@(nreverse result))))
(defun split-root-scale-window-tree-v (tree width height)
"`split-root-scale-window-tree' for vertically split tree nodes."
(let* ((h (caddr tree))
(children (cdddr tree))
result)
(assert (not (eq w 0)))
(assert (not (eq width 0)))
(assert (not (eq h 0)))
(assert (not (eq height 0)))
(while children
(let ((child (car children)))
(pop children)
(let* ((child-height (caddr child))
(new-child-height
(if (null children)
;; last child
height
(round (/ (float (* child-height height))
h)))))
;; and resize the child, if big enough
(message "height %s" new-child-height)
(unless (< new-child-height window-min-height)
;; subtract what we used up
(setq h (- h child-height))
(setq height (- height new-child-height))
(push (split-root-scale-window-tree child width new-child-height)
result)))))
`(nil ,width ,height ,@(nreverse result))))
;;;###autoload
(defun split-root-window (&optional size horflag top-left)
"Split a window of SIZE lines/columns from the root window.
If optional argument horflag is non-nil, split side by side and put size
columns in the new window.
If optional argument TOP-LEFT is non-nil the window will appear at the
top/left, otherwise of the bottom/right."
(interactive)
(let ((tree (calculate-window-tree (car (window-tree)))))
(delete-other-windows)
(let* ((edges (window-edges))
(width (- (nth 2 edges) (nth 0 edges)))
(height (- (nth 3 edges) (nth 1 edges)))
(sz (or size (/ (if horflag width height) 2)))
(remaining (- (if horflag width height) sz))
(old-window (selected-window))
(new-window old-window))
(if top-left
(setq new-window (split-window new-window sz horflag))
(setq old-window (split-window new-window remaining horflag)))
(build-window-tree
(if horflag
(split-root-scale-window-tree tree remaining height)
(split-root-scale-window-tree tree width remaining)) new-window)
old-window
)))
(provide 'split-root)