From 97ed8faebbcccfd958673158f884701e549dfab3 Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Fri, 16 Sep 2011 11:45:36 -0700 Subject: [PATCH] Get the subwindows in order; window-inferiors is random. --- src/gtk-screen/gtk-screen.pkg | 4 +- src/gtk-screen/gtk-screen.scm | 110 +++++++++++++++++++--------------- 2 files changed, 63 insertions(+), 51 deletions(-) diff --git a/src/gtk-screen/gtk-screen.pkg b/src/gtk-screen/gtk-screen.pkg index a8520bf9d..dfadd16a9 100644 --- a/src/gtk-screen/gtk-screen.pkg +++ b/src/gtk-screen/gtk-screen.pkg @@ -56,8 +56,8 @@ USA. hook/inferior-process-output) (import (edwin window) editor-frame-root-window - window-inferiors inferior-window - combination? combination-vertical? + window-inferiors find-inferior window-next + combination? combination-vertical? combination-child (%window-x-size window-x-size) (%window-y-size window-y-size) %set-window-x-size! diff --git a/src/gtk-screen/gtk-screen.scm b/src/gtk-screen/gtk-screen.scm index 564314641..1289ec1cb 100644 --- a/src/gtk-screen/gtk-screen.scm +++ b/src/gtk-screen/gtk-screen.scm @@ -732,15 +732,14 @@ USA. (%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) @@ -750,71 +749,69 @@ USA. (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)) @@ -845,8 +842,8 @@ USA. (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) @@ -897,6 +894,21 @@ USA. (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))) @@ -1121,10 +1133,10 @@ USA. (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) @@ -1132,16 +1144,16 @@ USA. (%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))))) @@ -1156,7 +1168,7 @@ USA. (%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)) -- 2.25.1