Re: moving window handling into lisp

[Lennart Borgman <lennart.borgman@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 769 bytes --]

On Thu, Aug 13, 2009 at 11:57 AM, Lennart
Borgman<lennart.borgman@gmail.com> wrote:
> On Thu, Aug 13, 2009 at 11:55 AM, martin rudalics<rudalics@gmx.at> wrote:
>>> Ehum, as always..., here is a better, somewhat more working version... ;-)
>>
>> IIUC you're going down in some window tree and try to distribute the
>> available space among the children of each internal window.  But the
>> interesting part is when you have to backtrack because some window
>> didn't fit into its parent and you have to shrink (or enlarge) some
>> (grand-)parent's sibling.  I couldn't find that part :-(
>
>
> And that is the whole point of going up the tree and collecting sizes first...


Here is the walking down part too. You have to tell me what you are missing.

[-- Attachment #2: win-alg.el --]
[-- Type: text/plain, Size: 7559 bytes --]

;;; win-alg.el --- Window size computation
;;
;; Author: Lennart Borgman (lennart O borgman A gmail O com)
;; Created: 2009-08-12 Wed
;; Version: 0.1
;; Last-Updated: 2009-08-12 Wed
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Window creation etc

;;(defun wa-make-window (width wmin wmax height hmin hmax)
(defun wa-make-window (name width wmin wmax)
  (list (list 'name name)            ;; Easier communication ...
        (list 'child nil)            ;; Child windows
        (list 'size width wmin wmax) ;; Old size and restrictions
        (list 'compsize nil nil)     ;; Slot for computation, wmin wmax
        (list 'set-size nil)         ;; Slot for setting, wmin wmax
        ))

;; Fix-me: Make defmacro to make those getters setters... - including
;; checks...
(defun wa-name  (window) (nth 1 (nth 0 window)))
(defun wa-child (window) (nth 1 (nth 1 window)))
(defun wa-width (window) (nth 1 (nth 2 window)))
(defun wa-wmin  (window) (nth 2 (nth 2 window)))
(defun wa-wmax  (window) (nth 3 (nth 2 window)))
(defun wa-wcmin (window) (nth 1 (nth 3 window)))
(defun wa-wcmax (window) (nth 2 (nth 3 window)))
(defun wa-wset  (window) (nth 1 (nth 4 window)))

(defun wa-set-name   (window name)  (setcar (nthcdr 1 (nth 0 window)) name))
(defun wa-set-child  (window child) (setcar (nthcdr 1 (nth 1 window)) child))
(defun wa-set-width  (window width) (setcar (nthcdr 1 (nth 2 window)) width))
(defun wa-set-wmin   (window wmin)  (setcar (nthcdr 2 (nth 2 window)) wmin))
(defun wa-set-wmax   (window wmax)  (setcar (nthcdr 3 (nth 2 window)) wmax))
(defun wa-set-wcmin  (window wmin)  (setcar (nthcdr 1 (nth 3 window)) wmin))
(defun wa-set-wcmax  (window wmax)  (setcar (nthcdr 2 (nth 3 window)) wmax))
(defun wa-set-wset   (window size)  (setcar (nthcdr 1 (nth 4 window)) size))

(defun wa-set-child-windows (parent vertical &rest sizes)
  (dolist (s sizes) (assert (= 3 (length s)) t))
  (let* ((tot-given (apply '+ (mapcar (lambda (s) (car s)) (cdr sizes))))
         (par-size       (if vertical (wa-width parent) (wa-height parent)))
         ;;(par-other-size (if vertical (wa-height parent) (wa-width parent)))
         (real-sizes (copy-sequence sizes))
         children
         (num 0))
    (setcar (nth 1 real-sizes) (- par-size tot-given))
    (setq children (mapcar (lambda (size)
                             (setq num (1+ num))
                             (if vertical
                                 (wa-make-window (format "%s-%d" (wa-name parent) num)
                                                 (nth 0 size)
                                                 (nth 1 size)
                                                 (nth 2 size))
                               ;;(wa-make-window size par-other-size)
                               ))
                           real-sizes))
    (wa-set-child parent children)))

(defun wa-check-fit (win)
  (let ((wmin (wa-wmin win))
        (wmax (wa-wmax win))
        (wcmin (wa-wcmin win))
        (wcmax (wa-wcmax win)))
    (when (and wmax wcmin)
      (unless (<= wcmin wmax)
        (error "Window %s is too small, min=%d, but can be max=%d" (wa-name win) wcmin wmax)))
    (when (and wcmax wmin)
      (unless (<= wcmax wmin)
        (error "Window %s's childs are too small, max=%d, but can be min=%d" (wa-name win) wcmax wmin)))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Computation of sizes

(defun wa-clear-computed (win)
  (wa-set-wcmin win nil)
  (wa-set-wcmax win nil)
  (dolist (c (wa-child win))
    (wa-clear-computed c)))

(defun wa-compute-required (win)
  "Walk up collecting needed sizes."
  (let ((childs (wa-child win))
        (wmin (wa-wmin win))
        (wmax (wa-wmax win))
        (cmin 0)
        (cmax nil))
    (when childs
      (dolist (c childs)
        (let* ((res (wa-compute-required c))
               (res-min (nth 0 res))
               (res-max (nth 1 res)))
          ;; Just sum the MIN
          (setq cmin (+ cmin res-min))
          (if res-max
              ;; ... ok, let us sum MAX to see how big we can be ...
              (if (numberp cmax)
                  (setq cmax (+ cmax res-max))
                (setq cmax res-max))
            ;; Hurray, at least one child can grow!
            (setq cmax nil)))))
    (when wmin (setq cmin (max wmin (or cmin wmin))))
    (when wmax (setq cmax (min wmax (or cmax wmax))))
    (wa-set-wcmin win cmin)
    (wa-set-wcmax win cmax)
    (wa-check-fit win)
    (list (wa-wcmin win)
          (wa-wcmax win))))

(defun wa-compute-wanted (win strategy)
  "Walk down compute sizes."
  ;; Set root window size
  (unless (wa-wset win) (wa-set-wset win (wa-width win)))
  (let ((cmin   (wa-wcmin  win))
        (cmax   (wa-wcmax  win))
        (width  (wa-width win))
        (childs (wa-child win))
        )
  (case strategy
    ('eq-sizes
     (let (
           (rest-width width)
           (goal (/ width (length childs)))
           (rest-childs (copy-sequence childs)))
       ;; Clear childs
       (dolist (c childs) (wa-set-wset c nil))
       ;; Check child min requirements
       (dolist (c (copy-sequence rest-childs))
         (let ((wcmin (wa-wcmin c)))
           (when (and wcmin (<= goal wcmin))
             (wa-set-wset c (wa-wcmin c))
             (setq rest-childs (delete c rest-childs))
             (setq rest-width (- rest-width (wa-wcmin c))))))
       (setq goal (/ rest-width (length childs)))
       ;; Check child max requirements
       (dolist (c (copy-sequence rest-childs))
         (let ((wcmax (wa-wcmax c)))
           (when (and wcmax (>= goal wcmax))
             (wa-set-wset c (wa-wcmax c))
             (setq rest-childs (delete c rest-childs))
             (setq rest-width (- rest-width (wa-wcmax c))))))
       (setq goal (/ rest-width (length childs)))
       ;; Distribute the rest, taking care of roundings
       (wa-set-wset (car rest-childs)
                   (- rest-width (* goal (1- (length rest-childs)))))
       (dolist (c (cdr rest-childs))
         (wa-set-wset c goal))))
    (t (error "Unknown rule: %s" rule)))
  ;; Check
  (let ((w 0))
    (dolist (c childs)
      (setq w (+ w (wa-wset c))))
    (unless (= w (wa-wset win))
      (error "Bad set sizes child sum w=%d, win width=%d" w (wa-wset win))))
  ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Testing part

(defvar wa-root-window nil)

(defun wa-add-test-childs ()
  (wa-set-child-windows wa-root-window t
                         '(nil nil nil)
                         '(5 4 nil)
                         '(8 nil nil)
                         '(4 3 nil)
                         ))

(setq wa-root-window (wa-make-window "Root" 80 nil nil))
(setq wa-root-window (wa-make-window "Root" 80 nil 8))
(setq wa-root-window (wa-make-window "Root" 80 nil 6))
(setq wa-root-window (wa-make-window "Root" 80 5 nil))
(setq wa-root-window (wa-make-window "Root" 80 15 nil))

;; (wa-child wa-root-window)
;; (wa-width wa-root-window)
;; (wa-wmin wa-root-window)
;; (wa-wmax wa-root-window)
;; (wa-clear-computed wa-root-window)

(wa-add-test-childs)
(wa-compute-required wa-root-window)
(wa-compute-wanted   wa-root-window 'eq-sizes)
(describe-variable 'wa-root-window)



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; win-alg.el ends here