From: Lennart Borgman <lennart.borgman@gmail.com>
To: martin rudalics <rudalics@gmx.at>
Cc: Stefan Monnier <monnier@iro.umontreal.ca>, emacs-devel@gnu.org
Subject: Re: moving window handling into lisp
Date: Thu, 13 Aug 2009 14:49:19 +0200 [thread overview]
Message-ID: <e01d8a50908130549h40ce7e21je2312a080e71ebaf@mail.gmail.com> (raw)
In-Reply-To: <e01d8a50908130432t6ba62f37je534b350dad138cc@mail.gmail.com>
[-- Attachment #1: Type: text/plain, Size: 1082 bytes --]
This one is easier to play with.
On Thu, Aug 13, 2009 at 1:32 PM, Lennart
Borgman<lennart.borgman@gmail.com> wrote:
> New, version. This one does walk down too... ;-)
>
>
> On Thu, Aug 13, 2009 at 12:25 PM, Lennart
> Borgman<lennart.borgman@gmail.com> wrote:
>> 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: 9153 bytes --]
;;; win-alg.el --- Window size computation
;;
;; Author: Lennart Borgman (lennart O borgman A gmail O com)
;; Created: 2009-08-12 Wed
;; Version: 0.2
;; Last-Updated: 2009-08-13 Thu
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Window creation etc
;;(defun wa-make-window (width wumin wumax height hmin hmax)
(defun wa-make-window (name width wumin wumax)
(list (list 'name name) ;; Easier communication ...
(list 'child nil) ;; Child windows
(list 'usr-size wumin wumax) ;; Restrictions
(list 'req-size nil nil) ;; Slot for computated requirements, wumin wumax
(list 'set-size nil width) ;; Slot for setting new size
))
;; Fix-me: Make defmacro to make those getters setters... - including
;; checks...
(defun wa-name (window) (nth 1 (nth 0 window))) ;; 'name
(defun wa-child (window) (nth 1 (nth 1 window))) ;; 'child
(defun wa-wumin (window) (nth 1 (nth 2 window))) ;; 'usr-size
(defun wa-wumax (window) (nth 2 (nth 2 window))) ;; 'usr-size
(defun wa-wrmin (window) (nth 1 (nth 3 window))) ;; 'req-size
(defun wa-wrmax (window) (nth 2 (nth 3 window))) ;; 'req-size
(defun wa-wset (window) (nth 2 (nth 4 window))) ;; 'set-size
(defun wa-set-name (window name) (setcar (nthcdr 1 (nth 0 window)) name)) ;; 'name
(defun wa-set-child (window child) (setcar (nthcdr 1 (nth 1 window)) child)) ;; 'child
(defun wa-set-wumin (window wumin) (setcar (nthcdr 1 (nth 2 window)) wumin)) ;; 'usr-size
(defun wa-set-wumax (window wumax) (setcar (nthcdr 2 (nth 2 window)) wumax)) ;; 'usr-size
(defun wa-set-wrmin (window wumin) (setcar (nthcdr 1 (nth 3 window)) wumin)) ;; 'req-size
(defun wa-set-wrmax (window wumax) (setcar (nthcdr 2 (nth 3 window)) wumax)) ;; 'req-size
(defun wa-set-wset (window size) (setcar (nthcdr 2 (nth 4 window)) size)) ;; 'set-size
(defun wa-set-flag (window flag) (setcar (nthcdr 1 (nth 4 window)) flag)) ;; 'set-size
(defvar wa-failed nil)
(defun wa-error (format-string &rest args)
(setq wa-failed t)
(apply 'message (propertize format-string 'face 'secondary-selection)
args)
(throw 'wa-error nil))
(defun wa-set-child-windows (parent vertical &rest sizes)
(unless wa-failed (assert (< 1 (length sizes)) t))
(let (children
(num 0))
(setq children (mapcar (lambda (size)
(setq num (1+ num))
(if vertical
(wa-make-window (format "%s-%d" (wa-name parent) num)
nil
(nth 0 size)
(nth 1 size))))
sizes))
(wa-set-child parent children)
parent))
(defun wa-check-fit (win)
(let ((wumin (wa-wumin win))
(wumax (wa-wumax win))
(wrmin (wa-wrmin win))
(wrmax (wa-wrmax win))
(wset (wa-wset win)))
(wa-set-flag win 'FAILED)
;; Top window
(when (and wset wrmin)
(unless (<= wrmin wset)
(wa-error "Window %s set size too small=%d, min=%d" (wa-name win) wset wrmin)))
(when (and wset wrmax)
(unless (>= wrmax wset)
(wa-error "Window %s set size too large=%d, max=%s" (wa-name win) wset wrmax)))
;; All
(when (and wumax wrmin)
(unless (<= wrmin wumax)
(wa-error "Window %s is too small, min=%d, but can be max=%d" (wa-name win) wrmin wumax)))
(when (and wrmax wumin)
(unless (>= wrmax wumin)
(wa-error "Window %s's childs are too small, max=%d, but can be min=%d" (wa-name win) wrmax wumin)))
(wa-set-flag win 'OK)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Computation of sizes
(defun wa-clear-computed (win)
(wa-set-wrmin win nil)
(wa-set-wrmax win nil)
(wa-set-wset win nil)
(dolist (c (wa-child win))
(wa-clear-computed c)))
(defun wa-init-fail-flag (win)
(wa-set-flag win 'INIT)
(dolist (c (wa-child win))
(wa-init-fail-flag c)))
(defun wa-compute-required (win)
"Walk up collecting needed sizes."
(let ((childs (wa-child win))
(wumin (wa-wumin win))
(wumax (wa-wumax win))
(cmin 0)
(cmax nil))
(when childs
;; Clear childs set sizes, we do not know them here
(dolist (c childs) (wa-set-wset c nil))
(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 wumin (setq cmin (max wumin (or cmin wumin))))
(when wumax (setq cmax (min wumax (or cmax wumax))))
;; Sanity
(when (= cmin 0) (setq cmin 1))
(unless wa-failed (assert (or (not cmin) (<= 1 cmin)) t))
(unless wa-failed (assert (or (not cmax) (<= 1 cmax)) t))
(wa-set-wrmin win cmin)
(wa-set-wrmax win cmax)
(wa-check-fit win)
(list (wa-wrmin win)
(wa-wrmax win))))
(defun wa-compute-wanted (win strategy)
"Walk down compute sizes."
(when (wa-child win)
(let ((cmin (wa-wrmin win))
(cmax (wa-wrmax win))
(width (wa-wset 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 ((wrmin (wa-wrmin c)))
(when (and wrmin (<= goal wrmin))
(wa-set-wset c (wa-wrmin c))
(setq rest-childs (delete c rest-childs))
(setq rest-width (- rest-width (wa-wrmin c))))))
(setq goal (/ rest-width (length childs)))
;; Check child max requirements
(dolist (c (copy-sequence rest-childs))
(let ((wrmax (wa-wrmax c)))
(when (and wrmax (>= goal wrmax))
(wa-set-wset c (wa-wrmax c))
(setq rest-childs (delete c rest-childs))
(setq rest-width (- rest-width (wa-wrmax 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 (wa-error "Unknown strategy: %s" strategy)))
;; Check
(let ((w 0))
(dolist (c childs)
(let ((wset (wa-wset c)))
(unless wa-failed (assert (<= 0 wset) t))
(setq w (+ w wset))))
(unless (= w (wa-wset win))
(wa-error "Bad set sizes child sum w=%d, win width=%d" w (wa-wset win))))
;; Walk down
(dolist (c childs)
(wa-compute-wanted c strategy)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Testing part
(defvar wa-root-window nil)
(defun wa-add-test-childs ()
(wa-set-child-windows wa-root-window t
'(nil 7)
'(14 nil)
'(nil nil)
'(3 nil)
)
(wa-set-child-windows (car (wa-child wa-root-window)) t
'(nil nil)
'(8 15))
)
(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" 15 15 nil))
(setq wa-root-window (wa-make-window "Root" 43 15 nil))
(setq wa-root-window (wa-make-window "Root" 18 15 nil))
;; (wa-child wa-root-window)
;; (wa-wset wa-root-window)
;; (wa-wumin wa-root-window)
;; (wa-wumax wa-root-window)
;; (wa-clear-computed wa-root-window)
;; Setup
(wa-add-test-childs)
(wa-init-fail-flag wa-root-window)
(setq wa-failed nil)
;; Show state now in case we want to stop on errors
(describe-variable 'wa-root-window)
;; Compute required, may fail. In this case the initial state will
;; remain in the help buffer.
(catch 'wa-error
(wa-compute-required wa-root-window))
;; Now it should not fail
(wa-compute-wanted wa-root-window 'eq-sizes)
(describe-variable 'wa-root-window)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; win-alg.el ends here
next prev parent reply other threads:[~2009-08-13 12:49 UTC|newest]
Thread overview: 130+ messages / expand[flat|nested] mbox.gz Atom feed top
2009-07-27 8:32 moving window handling into lisp Miles Bader
2009-07-27 13:37 ` martin rudalics
2009-07-27 13:41 ` Lennart Borgman
2009-07-27 13:45 ` martin rudalics
2009-07-27 13:58 ` Lennart Borgman
2009-07-27 14:35 ` martin rudalics
2009-07-27 14:41 ` Lennart Borgman
2009-07-27 15:02 ` martin rudalics
2009-07-27 15:28 ` Lennart Borgman
2009-07-27 16:52 ` martin rudalics
2009-07-27 16:58 ` Lennart Borgman
2009-07-27 18:18 ` Stefan Monnier
2009-07-28 7:38 ` martin rudalics
2009-07-28 9:39 ` Lennart Borgman
2009-07-28 12:25 ` martin rudalics
[not found] ` <e01d8a50907280532kcff2d1w15567a430668a502@mail.gmail.com>
2009-07-28 13:23 ` martin rudalics
2009-07-28 13:44 ` Lennart Borgman
2009-07-29 9:04 ` martin rudalics
2009-07-28 13:47 ` Stefan Monnier
2009-07-28 14:11 ` Lennart Borgman
2009-07-29 9:05 ` martin rudalics
2009-07-29 14:05 ` Stefan Monnier
2009-08-01 2:20 ` Miles Bader
2009-08-03 21:29 ` Stefan Monnier
2009-08-11 9:18 ` martin rudalics
2009-08-11 19:16 ` Stefan Monnier
2009-08-11 19:29 ` Lennart Borgman
2009-08-12 8:57 ` martin rudalics
2009-08-12 9:02 ` Lennart Borgman
2009-08-12 13:33 ` martin rudalics
2009-08-12 15:57 ` Lennart Borgman
2009-08-12 17:05 ` martin rudalics
2009-08-12 19:39 ` Lennart Borgman
2009-08-12 21:10 ` Lennart Borgman
2009-08-13 9:55 ` martin rudalics
2009-08-13 9:57 ` Lennart Borgman
2009-08-13 10:25 ` Lennart Borgman
2009-08-13 11:32 ` Lennart Borgman
2009-08-13 12:49 ` Lennart Borgman [this message]
2009-08-13 13:56 ` martin rudalics
2009-08-13 16:43 ` Lennart Borgman
2009-08-13 18:07 ` martin rudalics
2009-08-14 1:13 ` Lennart Borgman
2009-08-14 7:18 ` martin rudalics
2009-08-14 11:21 ` Lennart Borgman
2009-08-14 13:21 ` martin rudalics
2009-08-12 8:56 ` martin rudalics
2009-08-13 2:32 ` Stefan Monnier
2009-08-13 9:54 ` martin rudalics
2009-08-13 17:00 ` Stefan Monnier
2009-08-13 18:09 ` martin rudalics
2009-08-14 1:47 ` Stephen J. Turnbull
2009-08-14 7:17 ` martin rudalics
2009-08-14 6:42 ` Richard Stallman
2009-08-14 7:18 ` martin rudalics
2009-08-14 20:56 ` Richard Stallman
2009-08-15 10:12 ` martin rudalics
2009-08-15 19:47 ` Stefan Monnier
2009-08-14 15:39 ` Stefan Monnier
2009-08-14 15:42 ` Lennart Borgman
2009-08-14 18:26 ` Stefan Monnier
2009-08-15 10:12 ` martin rudalics
2009-08-15 11:02 ` Lennart Borgman
2009-08-15 12:44 ` martin rudalics
2009-08-15 13:35 ` David Kastrup
2009-08-15 13:39 ` Lennart Borgman
2009-08-15 16:11 ` martin rudalics
2009-08-15 16:19 ` Lennart Borgman
2009-08-15 17:37 ` martin rudalics
2009-08-15 18:18 ` Lennart Borgman
2009-08-16 10:25 ` martin rudalics
2009-08-16 11:14 ` Lennart Borgman
2009-08-16 12:12 ` David Kastrup
2009-08-16 12:19 ` Lennart Borgman
2009-08-16 15:17 ` martin rudalics
2009-08-16 16:15 ` David Kastrup
2009-08-16 19:24 ` martin rudalics
2009-08-16 12:17 ` martin rudalics
2009-08-16 12:26 ` Lennart Borgman
2009-08-16 15:18 ` martin rudalics
2009-08-15 19:05 ` Stephen J. Turnbull
2009-08-16 10:26 ` martin rudalics
2009-08-16 11:16 ` Lennart Borgman
2009-08-16 12:17 ` martin rudalics
2009-08-16 12:29 ` Lennart Borgman
2009-08-16 15:18 ` martin rudalics
2009-08-16 14:49 ` Stephen J. Turnbull
2009-08-16 15:31 ` martin rudalics
2009-08-16 16:28 ` Stephen J. Turnbull
2009-08-16 19:25 ` martin rudalics
2009-08-15 15:07 ` Jan Djärv
2009-08-15 15:38 ` David Kastrup
2009-08-15 16:07 ` martin rudalics
2009-08-15 18:21 ` Stephen J. Turnbull
2009-08-16 10:25 ` martin rudalics
2009-08-15 19:51 ` Stefan Monnier
2009-08-16 10:26 ` martin rudalics
2009-08-16 11:18 ` Lennart Borgman
2009-08-16 12:17 ` martin rudalics
2009-08-16 12:30 ` Lennart Borgman
2009-07-27 14:00 ` Miles Bader
2009-07-27 14:36 ` martin rudalics
[not found] ` <4A87F8B8.6050102@gmx.at>
[not found] ` <e01d8a50908160523r12216cffm34060d2793943785@mail.gmail.com>
[not found] ` <4A882312.6020106@gmx.at>
[not found] ` <e01d8a50908191816p2d9e978dw6aa0623c79dd8699@mail.gmail.com>
[not found] ` <4A8D12B3.6070502@gmx.at>
[not found] ` <e01d8a50908200219o69f67900lb9fa9368e9aadf62@mail.gmail.com>
[not found] ` <4A8D46C9.1010108@gmx.at>
[not found] ` <e01d8a50908200622y101e5b2bq9fb5874cbb8c81fe@mail.gmail.com>
[not found] ` <4A8D66D5.3000600@gmx.at>
2009-08-20 15:41 ` Lennart Borgman
2009-08-20 18:15 ` martin rudalics
2009-08-20 23:08 ` Lennart Borgman
2009-08-21 12:40 ` martin rudalics
2009-08-21 13:58 ` Lennart Borgman
2009-08-22 11:00 ` martin rudalics
2009-08-22 13:45 ` Lennart Borgman
2009-08-22 14:17 ` martin rudalics
2009-08-21 19:34 ` Stefan Monnier
2009-08-22 11:01 ` martin rudalics
2009-08-21 0:19 ` Richard Stallman
2009-08-21 12:40 ` martin rudalics
-- strict thread matches above, loose matches on Subject: below --
2009-08-17 19:06 grischka
2009-08-18 7:13 ` martin rudalics
2009-08-18 11:38 ` Lennart Borgman
2009-08-19 9:15 ` grischka
2009-08-19 12:45 ` martin rudalics
2009-08-20 11:45 ` grischka
2009-08-20 12:51 ` martin rudalics
2009-08-20 13:05 ` David Kastrup
2009-08-20 15:08 ` martin rudalics
2009-08-20 19:35 ` grischka
2009-08-21 12:22 ` martin rudalics
2009-08-21 19:32 ` Stefan Monnier
2009-08-22 4:55 ` Stephen J. Turnbull
2009-08-23 1:01 ` Stefan Monnier
2009-08-24 13:10 ` grischka
2009-08-19 13:01 ` Lennart Borgman
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=e01d8a50908130549h40ce7e21je2312a080e71ebaf@mail.gmail.com \
--to=lennart.borgman@gmail.com \
--cc=emacs-devel@gnu.org \
--cc=monnier@iro.umontreal.ca \
--cc=rudalics@gmx.at \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.