(%trace "; update-widgets "screen"\n")
(let* ((root (screen-root-window screen)) ;editor-frame
(toplevel (gtk-screen-toplevel screen))
- (top-children (gtk-container-children toplevel)))
+ (top-children (gtk-container-reverse-children toplevel)))
(define-integrable (main)
(if (null? top-children)
(let ((top-box (gtk-vbox-new #f 0)))
(gtk-container-add toplevel top-box)
(%trace "; -init "root" in "top-box"\n")
- (re-pack-inferiors! (reverse (window-inferiors root))
- top-box '() "--")
+ (re-pack-windows! (%reversed-children root) top-box '() "--")
(%trace "; -show-init "toplevel"\n")
(gtk-widget-grab-focus (typein-widget screen))
(gtk-widget-show-all toplevel)
(error "Not a GtkBin:" toplevel))
(let ((top-box (car top-children)))
(%trace "; -pack "root" into "top-box"\n")
- (re-pack-inferiors! (reverse (window-inferiors root))
- top-box (gtk-container-children top-box)
- "--")
+ (re-pack-windows! (%reversed-children root)
+ top-box (gtk-container-children top-box)
+ "--")
(%trace "; -show-all "toplevel"\n")
(gtk-widget-show-all toplevel)
(%trace "; update-widgets done\n")))))
- (define (re-pack-inferiors! inferiors box children prefix)
- (cond ((and (not (pair? inferiors))
- (not (pair? children)))
+ (define (re-pack-windows! windows box widgets prefix)
+ (cond ((and (not (pair? windows))
+ (not (pair? widgets)))
(%trace "; "prefix"done\n"))
- ((not (pair? inferiors)) ;extra children
+ ((not (pair? windows)) ;extra children
(for-each (lambda (child)
(%trace "; "prefix"destroying extra "child"\n")
(gtk-object-destroy child))
- children)
+ widgets)
(%trace "; "prefix"done, tossed extra children\n"))
- ((not (pair? children))
- ;; and (pair? inferiors) -- insufficient children
- (let ((w (inferior-window (car inferiors))))
- (pack-new! box w prefix))
- (re-pack-inferiors! (cdr inferiors) box '() prefix))
- (else ;; (and (pair? children) (pair? inferiors))
- (let* ((child (car children))
- (window (inferior-window (car inferiors))))
+ ((not (pair? widgets))
+ ;; and (pair? windows) -- insufficient children
+ (pack-new! box (car windows) prefix)
+ (re-pack-windows! (cdr windows) box '() prefix))
+ (else ;; (and (pair? widgets) (pair? windows))
+ (let ((widget (car widgets))
+ (window (car windows)))
(cond
;; Exact combo. match.
((and (combination? window)
- (not (buffer-frame-widget? child))
+ (not (buffer-frame-widget? widget))
(if (combination-vertical? window)
- (gtk-vbox? child)
- (gtk-hbox? child)))
- (%trace "; "prefix"matched "window" "child"\n")
- (re-pack-inferiors! (window-inferiors window)
- child
- (gtk-container-children child)
- (string-append prefix "--"))
- (re-pack-inferiors! (cdr inferiors)
- box (cdr children) prefix))
+ (gtk-vbox? widget)
+ (gtk-hbox? widget)))
+ (%trace "; "prefix"matched "window" to "widget"\n")
+ (%trace "; "prefix"children right-to-left: "
+ (%reversed-children window)"\n")
+ (re-pack-windows! (%reversed-children window)
+ widget
+ (gtk-container-children widget)
+ (string-append prefix "--"))
+ (re-pack-windows! (cdr windows) box (cdr widgets) prefix))
;; Exact leaf match.
((and (buffer-frame? window)
- (buffer-frame-widget? child)
- (let ((text (buffer-frame-widget-text* child)))
+ (buffer-frame-widget? widget)
+ (let ((text (buffer-frame-widget-text* widget)))
(and (eq? window (text-widget-buffer-frame text))
text)))
=> (lambda (text)
(%trace "; "prefix"matched "window" to "
- child" ("text")\n")
- (if (not text) (error "Found no text-widget:" child))
+ widget" (containing "text")\n")
(re-size! text window)
- (re-pack-inferiors! (cdr inferiors)
- box (cdr children) prefix)))
+ (re-pack-windows! (cdr windows)
+ box (cdr widgets) prefix)))
(else
;; Children were added/removed. Must remove the rest
;; before adding any, to get the ordering right. For
;; now, just remove one, in case one child was removed
;; and we will match the next...
- (%trace "; "prefix"destroying "child
+ (%trace "; "prefix"destroying "widget
", which mismatched "window"\n")
- (gtk-object-destroy child)
- (re-pack-inferiors! inferiors
- box (cdr children) prefix)))))))
+ (gtk-object-destroy widget)
+ (re-pack-windows! windows box (cdr widgets) prefix)))))))
(define (re-size! widget window)
(let ((area (fix-layout-geometry widget))
(let ((new (if (combination-vertical? window)
(gtk-vbox-new #f 0) (gtk-hbox-new #f 0)))
(new-prefix (string-append prefix "--")))
- (for-each (lambda (i) (pack-new! new (inferior-window i) new-prefix))
- (window-inferiors window))
+ (for-each (lambda (window) (pack-new! new window new-prefix))
+ (%reversed-children window))
(%trace "; "prefix"pack-new! packing "new" in "box"\n")
(gtk-box-pack-end box new #t #t 0)))
((buffer-frame? window)
(typein-frame (last (gtk-container-reverse-children top-box))))
(any-child text-widget? typein-frame)))
+(define (%reversed-children window)
+ ;; Produce a list of a combination window's children from right to
+ ;; left (or bottom to top).
+ (cond ((editor-frame? window)
+ (list (editor-frame-typein-window window)
+ (editor-frame-root-window window)))
+ ((combination? window)
+ (let loop ((child (combination-child window))
+ (so-far '()))
+ (if child
+ (loop (window-next child)
+ (cons child so-far))
+ so-far)))
+ (else (error "Unexpected Edwin window:" window))))
+
(define-integrable (%text-x-size window)
(%window-x-size (frame-text-inferior window)))
(else
(%trace "; "prefix""window": unexpected type\n"))))
- (define (%set-starts! inferiors parent prefix x y)
- (if (pair? inferiors)
- (let* ((inferior (car inferiors))
- (window (inferior-window inferior)))
+ (define (%set-starts! windows parent prefix x y)
+ (if (pair? windows)
+ (let* ((window (car windows))
+ (inferior (find-inferior (window-inferiors parent) window)))
(%trace "; "prefix""window" start: "x"x"y
" (was "
(inferior-x-start inferior)"x"(inferior-y-start inferior)
(%set-inferior-start! inferior x y)
(if (or (editor-frame? window)
(combination? window))
- (%set-starts! (window-inferiors window) window
+ (%set-starts! (reverse! (%reversed-children window)) window
(string-append prefix "--")
x y))
(if (or (editor-frame? parent)
(and (combination? parent)
(combination-vertical? parent)))
- (%set-starts! (cdr inferiors) parent prefix
+ (%set-starts! (cdr windows) parent prefix
x
(fix:+ y (%window-y-size window)))
- (%set-starts! (cdr inferiors) parent prefix
+ (%set-starts! (cdr windows) parent prefix
(fix:+ x (%window-x-size window))
y)))))
(%trace "; screen: "x-size"x"y-size"\n")
(set-screen-x-size! screen x-size)
(set-screen-y-size! screen y-size))
- (%set-starts! (window-inferiors root) root "--" 0 0)))
+ (%set-starts! (reverse! (%reversed-children root)) root "--" 0 0)))
(define-integrable (editor-frame? object)
(object-of-class? editor-frame object))