Get the subwindows in order; window-inferiors is random.
authorMatt Birkholz <matt@birkholz.chandler.az.us>
Fri, 16 Sep 2011 18:45:36 +0000 (11:45 -0700)
committerMatt Birkholz <matt@birkholz.chandler.az.us>
Fri, 16 Sep 2011 18:45:36 +0000 (11:45 -0700)
src/gtk-screen/gtk-screen.pkg
src/gtk-screen/gtk-screen.scm

index a8520bf9d2e0c75e473a37fbd6d61a26920ebb7b..dfadd16a95ee8c8536a0d395b34266d36a49eb7e 100644 (file)
@@ -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!
index 5643146418ec9502d73a33b2eab9fd29082aabe5..1289ec1cb6e9f5d1b0a55965415488fc903d13f9 100644 (file)
@@ -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))