help-gnu-emacs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: New balance-windows


From: Pascal Bourguignon
Subject: Re: New balance-windows
Date: Sun, 07 Aug 2005 20:23:46 +0200
User-agent: Gnus/5.11 (Gnus v5.11) Emacs/22.0.50 (gnu/linux)

Lennart Borgman <lennart.borgman.073@student.lu.se> writes:

> Pascal Bourguignon wrote:
>
>>>Is the problem really that welldefined in Emacs? Do you know how the
>>>windows have been splitted? The difference above may perhaps be seen
>>>as emerging from that difficulty?
>>>    
>>>
>>
>>Indeed, but the data is available at least internally, so it should be
>>easy to patch emacs to publish window parameters like it's done for
>>frame parameters for example.
>>
>>File: elisp,  Node: Window Internals
>>  
>>
> Thanks, I did not know this was available. Then the windows in each
> frame can be seen as a tree using those fields you mentioned. But what
> should then be done with this? What should the mapping between this
> tree and the visual view be? It looks to me that the level in the tree
> alone will not give any useful hint. The topology (ie whether the
> splitting was horizontal or vertical) must be taken into account, but
> maybe the level in the tree can be used too? It actually looks a bit
> difficult...

Well, it's only available to the C programmer...

Since window parents are not normal emacs lisp windows, I assume we'd
export the window internals as a new data type. Let's call it "split".

(frame-split-root [frame])           --> split or nil
(window-configuration-split winconf) --> split or nil
(splitp object)                      --> boolean
(split-direction split)              --> :vertical | :horizontal
;; (window-split-vertically) produces a :vertical split-direction.
(split-edges sow)                    --> (left top right bottom)
;; Perhaps (defalias split-edges window-edges)
(split-cuts split)                   --> (BReak  BReak  ...)
;; The bottom or right of the correponding child.
(split-children split)               --> (child  child  ...)
;; A split child may be a window or a split.
(split-parent sow) --> split
(enlarge-split sow increment preserve-before)


;; The parent is null for root splits or windows,
;; othewise it's always a split.
(or (null   (split-parent sow))
    (splitp (split-parent sow)))

;; the edges of the split are the same as the edge of an alone window:
(equal (split-edges split) (progn (delete-other-windows) (window-edges)))

;; the length is the number of collapsed windows or splits:
(= (length (split-cuts split)) (length (split-children split)))

;; child splits are perpendicular:
(every (lambda (child-split)
         (not (eq (split-direction split) (split-direction child-split))))
       (delete-if-not (function splitp) (split-children split)))

;; split cuts are sorted (hence the order of the corresponding split-children
;; list):
(dotimes (i (1- (length (split-cuts split))))
  (< (nth i (split-cuts split)) (nth (1+ i) (split-cuts split))))


(dotimes (i (length (split-cuts split)))
  (and
   ;; all children are either a split or a window:
   (or (windowp  (nth i (split-children split)))
       (splitp   (nth i (split-children split))))
   ;; the parent of each children of split is the split itself:
   (eq split (split-parent (nth i (split-children split))))
   ;; the cuts are the bottom or right of the corresponding child:
   (= (nth i (split-cuts split))
      (funcall (if (eq (split-direction split) :vertical)
                   (function bottom)
                   (function right))
               (split-edges (nth i (split-children split)))))
   ;; the sides are the same for all children:
   (every (lambda (side)
            (= (funcall side (split-edges split))
               (funcall side (split-edges (nth i (split-children split))))))
          (if (eq (split-direction split) :vertical)
              (list (function left) (function right))
              (list (function top)  (function bottom))))
   ))

Several parallel cuts are collapsed into one split.

(progn (delete-other-windows)
       (split-window-vertically)
       (split-window-vertically))

and:

(progn (delete-other-windows)
       (split-window-vertically)
       (other-window 1)
       (split-window-vertically))

would both give (= 3 (length (split-cuts (frame-split-root)))).
And:

(equal (progn (delete-other-windows)
              (split-window-vertically)
              (split-window-vertically)
              (frame-split-root))
       (progn (delete-other-windows)
              (split-window-vertically)
              (other-window 1)
              (split-window-vertically)
              (frame-split-root)))




Then the balancing algorithm could be as simple as:


(require 'cl)
(defun plusp  (x) (< 0 x))
(defun left   (x) (first  x))
(defun top    (x) (second x))
(defun right  (x) (third  x))
(defun bottom (x) (fourth x))

(defun split-height (split)
  (- (bottom (split-edges split)) (top  (split-edges split))))

(defun split-width  (split)
  (- (right  (split-edges split)) (left (split-edges split))))
   
(defun balance-split (split)
  (labels ((count-children (sow direction)
             ;; This could be cached into the split-or-window structure
             (if (splitp sow)
                 (reduce (if (eq (split-direction sow) direction)
                             (function +)
                             (function max))
                         (mapcar (lambda (child) 
                                    (count-children child direction))
                                 (split-children sow)))
                 1)))
    (let* ((relative-sizes
            (mapcar (lambda (child) 
                       (count-children child (split-direction split)))
                    (split-children split)))
           (total (reduce (function +) relative-sizes))
           (split-size (if (eq (split-direction split) :vertical)
                           (split-height split)
                           (split-width  split))))
      (loop
         for child-size in relative-sizes
         for child in (butlast (split-children split))
         for new-size = (truncate (* split-size child-size) total)
         do (enlarge-split child
                           (- new-size
                              (if (eq (split-direction split) :vertical)
                                  (split-height child)
                                  (split-width  child)))
                           (split-direction split)
                           t))
      (dolist (child (split-children split))
        (when (splitp child)
          (balance-split child))))))

(defun balance-windows ()
  (interactive)
  (when (splitp (frame-split-root))
    (balance-split (frame-split-root))))


And give excelent results, see at the end for an example.


;; The following is a simulator for the above specified split data structure.

(defstruct sow direction parent children right bottom)

(defun split-or-window-previous (sow)
  (let ((parent  (split-or-window-parent sow)))
    (when parent
      (let* ((children (split-or-window-children parent))
             (i (position sow children)))
        (and i (plusp i) (nth (1- i) children))))))
    
(defun split-or-window-left (sow)
  (let ((parent (split-or-window-parent sow)))
    (if parent
        (if (eq (split-or-window-direction parent) :horizontal)
            (let ((previous (split-or-window-previous sow)))
              (if previous
                  (split-or-window-right previous)
                  (split-or-window-left  parent)))
            (split-or-window-left  parent))
        0)))

(defun split-or-window-top (sow)
  (let ((parent (split-or-window-parent sow)))
    (if parent
        (if (eq (split-or-window-direction parent) :vertical)
            (let ((previous (split-or-window-previous sow)))
              (if previous
                  (split-or-window-bottom previous)
                  (split-or-window-top   parent)))
            (split-or-window-top   parent))
        0)))

(defun splitp (sow)
  (and (split-or-window-p sow)
       (split-or-window-children sow)))

(defun split-edges (sow)
  (list (split-or-window-left sow)
        (split-or-window-top sow)
        (split-or-window-right sow)
        (split-or-window-bottom sow)))

(defvar *current-window*   (make-split-or-window  :right 42 :bottom 42))
(defvar *frame-split-root* *current-window*)
(defun frame-split-root    (&optional frame)  *frame-split-root*)
(defvar *window-list*      (list *current-window*))
(defun window-list*        () *window-list*)
(defun current-window      () *current-window*)

(defun initialize (width height)
  (setf *current-window*    (make-split-or-window  :right width :bottom height)
        *frame-split-root*  *current-window*
        *window-list* (list *current-window*)))

(defun split-direction (split)
  (assert (splitp split))
  (split-or-window-direction split))

(defun split-cuts (split)
  (assert (splitp split))
  (mapcar (if (eq (split-direction split) :vertical)
              (function bottom)
              (function right)) (split-children split)))

(defun split-children (split)
  (assert (splitp split))
  (split-or-window-children split))

(defun split-parent (sow)
  (split-or-window-parent sow))

(defun enlarge-split (sow increment direction preserve-before)
  (unless (zerop increment)
    (if (eq direction :vertical)
        (incf (split-or-window-bottom sow) increment)
        (incf (split-or-window-right  sow) increment))
    (when (splitp sow)
      (if (eq (split-direction sow) direction)
          ;; change the size in same direction
          ;; TODO: check increment vs. last size and preserve-before
          (let ((last-child  (first (last (split-or-window-children
                                           sow)))))
            (enlarge-split last-child increment direction preserve-before))
          ;; change the size orthogonally
          (dolist (child (split-or-window-children sow))
            (enlarge-split child increment direction preserve-before))))
    (let ((parent (split-or-window-parent sow)))
      (when (and parent (eq (split-direction parent) direction))
        (let ((next (second (memq sow (split-or-window-children parent)))))
          (when next
            (if (eq direction :vertical)
                (incf (split-or-window-top  next) increment)
                (incf (split-or-window-left next) increment))))))))

(defun insert-after (new old list) (push new (cdr (memq old list))))

(defun split (direction &optional size)
  (flet ((split-size (split) (if (eq direction :vertical)
                                 (split-height split)
                                 (split-width  split)))
         (make-split (direction window parent)
           (let* ((edges (split-edges window))
                  (result (make-split-or-window
                           :parent parent
                           :children (list window)
                           :direction direction
                           :right  (right  edges)
                           :bottom (bottom edges))))
             (setf (split-or-window-parent window) result))))
    (setf size (or size (/ (split-size (current-window)) 2)))
    (unless (< 1 size)
      (error  "split: Window too small."))
    (when (<= (split-size (current-window)) size)
      (error "split: Too big size asked."))
    (let ((split (split-parent (current-window))))
      (cond
        ((null split)
         ;; make a new root split:
         (setf split (make-split direction (current-window) nil))
         (setf *frame-split-root* split))
        ((not (eq direction (split-direction split)))
         ;; make a new perpendicular split
         (let ((perpendicular (make-split direction (current-window) split)))
           (setf (split-or-window-children split)
                 (nsubstitute perpendicular (current-window)
                              (split-or-window-children split)))
           (assert (memq perpendicular (split-or-window-children split)))
           (setf split perpendicular))))
      (assert (eq split (split-parent (current-window))))
      (assert (memq (current-window) (split-children split)))
      (assert (eq direction (split-direction split)))
      (let* ((dx (if (eq direction :vertical) 0 size))
             (dy (if (eq direction :vertical) size 0))
             (edges (split-edges (current-window)))
             ;; make a new window:
             (other (make-split-or-window
                     :parent split
                     :right  (right  edges)
                     :bottom (bottom edges))))
        (if (eq direction :vertical)
            (setf (split-or-window-bottom (current-window)) (+ (top  edges) dy))
            (setf (split-or-window-right (current-window))  (+ (left edges) 
dx)))
        (insert-after other (current-window) (split-or-window-children split))
        (insert-after other (current-window) *window-list*)
        (assert (memq (current-window) *window-list*))
        (assert (memq other            *window-list*))
        (assert (memq (current-window) (split-or-window-children split)))
        (assert (memq other            (split-or-window-children split)))))))

(defun other-window* (n &optional all-frames)
  (let ((i (mod (+ (position (current-window) (window-list*)) n)
                (length (window-list*)))))
    (setf *current-window* (nth i (window-list*)))))

(defun windowp* (window) (memq window (window-list*)))

(defun delete-other-windows* (&optional window)
  (when (windowp* window)
    (setf *current-window* window))
  (setf window (current-window))
  (when (split-parent window)
    (let ((root  (frame-split-root)))
      (setf (split-or-window-left   window) (split-or-window-left   root)
            (split-or-window-top    window) (split-or-window-top    root)
            (split-or-window-right  window) (split-or-window-right  root)
            (split-or-window-bottom window) (split-or-window-bottom root)))
    (setf (split-or-window-parent window) nil)
    (setf *frame-split-root* window
          *window-list* (list window))))
     
(defun split-describe (split &optional level)
  (setf level (or level ""))
  (if (splitp split)
      (progn
        (insert (format "%s#<split %s %s %s %s>\n"
                  level
                  (format ":direction %S" (split-direction split))
                  (format ":parent %S" (not (null (split-parent split))))
                  (format ":edges %S" (split-edges split))
                  (format ":children %S" (length (split-children split)))))
        (dolist (child (split-children split))
          (split-describe child (concat "  " level))))
      (insert (format "%s#<window %s %s>\n"
                level
                (format ":parent %S" (not (null (split-parent split))))
                (format ":edges %S" (split-edges split))))))

(defun split-draw (split)
  (with-current-buffer (get-buffer-create "*splits*")
    (erase-buffer)
    (unless (eq major-mode 'picture-mode)
      (picture-mode))
    (picture-open-line (1+ (bottom (split-edges split))))
    (labels ((goto (x y)
               (message "goto %s %s" x y)
               (goto-line y)
               (beginning-of-line)
               (picture-forward-column x))
             (draw-rectangle (edges)
               (picture-draw-rectangle
                (progn (goto (left  edges) (top    edges)) (point))
                (progn (goto (right edges) (bottom edges)) (point))))
             (draw-split (split)
               (draw-rectangle (split-edges split))
               (if (splitp split)
                   (dolist (child (split-children split))
                     (draw-split child)))))
      (draw-split split)))
  (sit-for 1)
  (force-mode-line-update t))



Let's make some windows:

(progn
  (initialize 60 56)
  (delete-other-windows*)
  (split :vertical)
  (split :horizontal)
  (split :vertical)
  (split :vertical)
  (balance-windows) (split-draw (frame-split-root))
  (other-window* 4)
  (split :vertical)
  (split :horizontal)
  (split :horizontal)
  (other-window* 1)
  (split :vertical)
  (balance-windows) (split-draw (frame-split-root))
  (other-window* 7)
  (split :vertical)
  (split :vertical)
  (split :vertical)
  (balance-windows) (split-draw (frame-split-root))
  (split-describe (frame-split-root)))

#<split :direction :vertical :parent nil :edges (0 0 60 56) :children 3>
  #<split :direction :horizontal :parent t :edges (0 0 60 32) :children 2>
    #<split :direction :vertical :parent t :edges (0 0 30 32) :children 3>
      #<window :parent t :edges (0 0 30 10)>
      #<window :parent t :edges (0 10 30 20)>
      #<window :parent t :edges (0 20 30 32)>
    #<split :direction :vertical :parent t :edges (30 0 60 32) :children 4>
      #<window :parent t :edges (30 0 60 8)>
      #<window :parent t :edges (30 8 60 16)>
      #<window :parent t :edges (30 16 60 24)>
      #<window :parent t :edges (30 24 60 32)>
  #<split :direction :horizontal :parent t :edges (0 32 60 48) :children 3>
    #<window :parent t :edges (0 32 20 48)>
    #<split :direction :vertical :parent t :edges (20 32 40 48) :children 2>
      #<window :parent t :edges (20 32 40 40)>
      #<window :parent t :edges (20 40 40 48)>
    #<window :parent t :edges (40 32 60 48)>
  #<window :parent t :edges (0 48 60 56)>


+-----------------------------+-----------------------------+
|                             |                             |
|                             |                             |
|                             |                             |
|                             |                             |
|                             |                             |
|                             |                             |
|                             +-----------------------------+
|                             |                             |
+-----------------------------|                             |
|                             |                             |
|                             |                             |
|                             |                             |
|                             |                             |
|                             |                             |
|                             +-----------------------------+
|                             |                             |
|                             |                             |
|                             |                             |
+-----------------------------|                             |
|                             |                             |
|                             |                             |
|                             |                             |
|                             +-----------------------------+
|                             |                             |
|                             |                             |
|                             |                             |
|                             |                             |
|                             |                             |
|                             |                             |
|                             |                             |
+-------------------+-------------------+-------------------+
|                   |                   |                   |
|                   |                   |                   |
|                   |                   |                   |
|                   |                   |                   |
|                   |                   |                   |
|                   |                   |                   |
|                   |                   |                   |
|                   +-------------------|                   |
|                   |                   |                   |
|                   |                   |                   |
|                   |                   |                   |
|                   |                   |                   |
|                   |                   |                   |
|                   |                   |                   |
|                   |                   |                   |
+-----------------------------------------------------------+
|                                                           |
|                                                           |
|                                                           |
|                                                           |
|                                                           |
|                                                           |
|                                                           |
+-----------------------------------------------------------+


The current algorithm something like the following, that doesn't look
like "balanced" to me:

+-----------------------------+-----------------------------+
|                             |                             |
|                             |         too small           |
|                             |                             |
|                             +-----------------------------+
|                             |                             |
|                             |                             |
|                             |                             |
+-----------------------------+-----------------------------+
|                             |                             |
|                             |                             |
|                             |                             |
|                             |                             |
|                             |                             |
|                             |                             |
|                             |                             |
+-----------------------------+-----------------------------+
|                             |                             |
|                             |                             |
|                             |                             |
|                             |                             |
|                             |                             |
|                             |                             |
|                             |                             |
|                             |                             |
|                             |                             |
|                             |                             |
|                             |                             |
+-------------+---------------+-----------------------------+
|             |               |                             |
|             |               |                             |
|             |               |                             |
|             |               |                             |
|             |               |                             |
|             +---------------|        too big              |
|             |               |                             |
|             |               |                             |
|             |               |                             |
|             |               |                             |
|             |               |                             |
+-------------+---------------+-----------------------------+
|                                                           |
|                                                           |
|                                                           |
|                                                           |
|                                                           |
|                                                           |
|                                                           |
|                       too big                             |
|                                                           |
|                                                           |
|                                                           |
+-----------------------------------------------------------+


Finally: I'm posting my balance-windows / balance-split here rather
than on gnu.emacs.develp because I feel it's more a user-level
feature, if only the right internals were exported.

(Perhaps some users will prefer the current version of balance-windows.)


-- 
__Pascal Bourguignon__                     http://www.informatimago.com/
-----BEGIN GEEK CODE BLOCK-----
Version: 3.12
GCS d? s++:++ a+ C+++ UL++++ P--- L+++ E+++ W++ N+++ o-- K- w--- 
O- M++ V PS PE++ Y++ PGP t+ 5+ X++ R !tv b+++ DI++++ D++ 
G e+++ h+ r-- z? 
------END GEEK CODE BLOCK------


reply via email to

[Prev in Thread] Current Thread [Next in Thread]