fix hang with incremental layout

TODO.FACTOR.txt

@@ -1,7 +1,5 @@
 + bugs to fix soon
 
-<erg> if write returns -1  and errno == EINTR then it's not a real error, you can try again
-
 <magnus--> http://developer.apple.com/technotes/tn2004/tn2123.html#SECLIMITATIONS
 <magnus--> http://www.caddr.com/macho/archives/sbcl-devel/2005-3/4742.html
 <magnus--> not *too* long

library/ui/fonts.factor

@@ -5,7 +5,7 @@ USING: alien hashtables io kernel lists namespaces sdl sequences
 styles ;
 
 : ttf-name ( font style -- name )
-    cons [
+    cons {{
         [[ [[ "Monospaced" plain       ]] "VeraMono" ]]
         [[ [[ "Monospaced" bold        ]] "VeraMoBd" ]]
         [[ [[ "Monospaced" bold-italic ]] "VeraMoBI" ]]
@@ -18,7 +18,7 @@ styles ;
         [[ [[ "Serif" bold             ]] "VeraSeBd" ]]
         [[ [[ "Serif" bold-italic      ]] "VeraBI"   ]]
         [[ [[ "Serif" italic           ]] "VeraIt"   ]]
-    ] assoc ;
+    }} hash ;
 
 : ttf-path ( name -- string )
     [ resource-path % "/fonts/" % % ".ttf" % ] make-string ;
@@ -35,7 +35,9 @@ global [ open-fonts nest drop ] bind
 
 : ttf-init ( -- )
     TTF_Init
-    open-fonts [ [ cdr expired? not ] hash-subset ] change ;
+    global [
+        open-fonts [ [ cdr expired? not ] hash-subset ] change
+    ] bind ;
 
 : gadget-font ( gadget -- font )
     [ font paint-prop ] keep

library/ui/hierarchy.factor

@@ -4,36 +4,34 @@ IN: gadgets
 USING: generic hashtables kernel lists math matrices namespaces
 sequences ;
 
-: remove-gadget ( gadget box -- )
+: remove-gadget ( gadget parent -- )
     [ 2dup gadget-children remq swap set-gadget-children ] keep
     relayout
     f swap set-gadget-parent ;
 
-: (add-gadget) ( gadget box -- )
-    #! This is inefficient.
-    [ gadget-children swap add ] keep
-    set-gadget-children ;
-
 : unparent ( gadget -- )
     [
         dup gadget-parent dup
         [ remove-gadget ] [ 2drop ] ifte
     ] when* ;
 
-: add-gadget ( gadget box -- )
+: (add-gadget) ( gadget box -- )
-    #! Add a gadget to a box.
+    #! This is inefficient.
     over unparent
     dup pick set-gadget-parent
-    tuck (add-gadget)
+    [ gadget-children swap add ] keep set-gadget-children ;
-    relayout ;
 
-: (parent-list) ( gadget -- )
+: add-gadget ( gadget parent -- )
-    [ dup gadget-parent (parent-list) , ] when* ;
+    #! Add a gadget to a parent gadget.
+    [ (add-gadget) ] keep relayout ;
 
-: parent-list ( gadget -- list )
+: (parents) ( gadget -- )
+    [ dup gadget-parent (parents) , ] when* ;
+
+: parents ( gadget -- list )
     #! A list of all parents of the gadget, including the
     #! gadget itself.
-    [ (parent-list) ] make-list ;
+    [ (parents) ] make-list ;
 
 : (each-parent) ( list quot -- ? )
     over [
@@ -51,7 +49,7 @@ sequences ;
 : each-parent ( gadget quot -- ? )
     #! Keep executing the quotation on higher and higher
     #! parents until it returns f.
-    >r parent-list r> (each-parent) ; inline
+    >r parents r> (each-parent) ; inline
 
 : screen-pos ( gadget -- point )
     #! The position of the gadget on the screen.

library/ui/incremental.factor

@@ -14,12 +14,14 @@ USING: generic kernel matrices ;
 
 TUPLE: incremental cursor ;
 
-M: incremental pref-dim incremental-cursor ;
-
 C: incremental ( pack -- incremental )
     [ set-delegate ] keep
     { 0 0 0 } over set-incremental-cursor ;
 
+M: incremental pref-dim incremental-cursor ;
+
+M: incremental layout* drop ;
+
 : next-cursor ( gadget incremental -- cursor )
     [
         swap shape-dim swap incremental-cursor
@@ -33,8 +35,12 @@ C: incremental ( pack -- incremental )
     dup incremental-cursor dup rot pack-vector v* v-
     swap set-shape-loc ;
 
+: prefer-incremental ( gadget -- )
+    dup pref-dim swap set-shape-dim ;
+
 : add-incremental ( gadget incremental -- )
-    2dup add-gadget
+    2dup (add-gadget)
-    >r dup dup pref-dim swap set-shape-dim r>
+    over prefer-incremental
-    f over set-gadget-relayout?
+    2dup incremental-loc
-    2dup incremental-loc update-cursor ;
+    tuck update-cursor
+    prefer-incremental ;

library/ui/init-world.factor

@@ -1,16 +1,15 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: generic kernel math namespaces styles ;
+USING: generic io kernel listener math namespaces styles threads ;
 
 
 global [
     <world> world set
     
     {{
-
         [[ background [ 255 255 255 ] ]]
-        [[ rollover-bg [ 216 216 216 ] ]]
+        [[ rollover-bg [ 255 255 204 ] ]]
         [[ foreground [ 0 0 0 ] ]]
         [[ reverse-video f ]]
         [[ font "Sans Serif" ]]
@@ -22,9 +21,13 @@ global [
     
     <plain-gadget> add-layer
 
-    <console> dup
+    <pane> dup
-    "Stack display goes here" <label> <y-splitter>
+    
+    <scroller> "Stack display goes here" <label> <y-splitter>
     3/4 over set-splitter-split add-layer
     
+    dup
+    [ [ clear  print-banner listener ] in-thread ] with-stream
+    
     request-focus
 ] bind

library/ui/panes.factor

@@ -51,7 +51,7 @@ TUPLE: pane output active current input continuation ;
 
 C: pane ( -- pane )
     <line-pile> over set-delegate
-    <line-pile> ( <incremental> ) over add-output
+    <line-pile> <incremental> over add-output
     <line-shelf> over set-pane-current
     "" <editor> over set-pane-input
     dup init-active-line
@@ -65,7 +65,7 @@ M: pane focusable-child* ( pane -- editor )
     [ <presentation> ] keep pane-current add-gadget ;
 
 : pane-terpri ( pane -- )
-    dup pane-current over pane-output ( add-incremental ) add-gadget
+    dup pane-current over pane-output add-incremental
     <line-shelf> over set-pane-current init-active-line ;
 
 : pane-write ( style pane list -- )
@@ -86,6 +86,4 @@ M: pane stream-write-attr ( string style stream -- )
 M: pane stream-close ( stream -- ) drop ;
 
 : <console> ( -- pane )
-    <pane> dup
+    <pane> <scroller> ;
-    [ [ clear  print-banner listener ] in-thread ] with-stream
-    <scroller> ;