From 66c26e234a7aba152d0fe30aeca35051381fe3b4 Mon Sep 17 00:00:00 2001
From: slava <slava@factorcode.org>
Date: Fri, 28 Jul 2006 20:07:22 +0000
Subject: [PATCH] make-frame/track now compiles (except that add-gadget
 doesn't; this is pending)

---
 library/ui/gadgets/frames.factor |  4 ++--
 library/ui/gadgets/grids.factor  |  2 +-
 library/ui/gadgets/tracks.factor | 11 +++++------
 library/ui/hierarchy.factor      | 32 +++++++++++++++++++++-----------
 library/ui/models.factor         |  2 +-
 5 files changed, 30 insertions(+), 21 deletions(-)

diff --git a/library/ui/gadgets/frames.factor b/library/ui/gadgets/frames.factor
index 44be02a8f0..7763528035 100644
--- a/library/ui/gadgets/frames.factor
+++ b/library/ui/gadgets/frames.factor
@@ -38,7 +38,7 @@ M: frame layout* ( frame -- dim )
     ] with-grid ;
 
 : make-frame ( specs -- gadget )
-    <frame> [ swap build-grid ] keep ;
+    <frame> [ swap build-grid ] keep ; inline
 
 : make-frame* ( gadget specs -- gadget )
-    over [ delegate>frame build-grid ] keep ;
+    over [ delegate>frame build-grid ] keep ; inline
diff --git a/library/ui/gadgets/grids.factor b/library/ui/gadgets/grids.factor
index 3b2426e335..b6b6d5f793 100644
--- a/library/ui/gadgets/grids.factor
+++ b/library/ui/gadgets/grids.factor
@@ -72,4 +72,4 @@ M: grid layout* ( frame -- dim )
     #! Specs is an array of quadruples { quot post setter loc }.
     #! The setter has stack effect ( new gadget -- ),
     #! the loc is @center, @top, etc.
-    swap [ [ [ grid-add ] add-spec ] each ] with-gadget ;
+    swap [ [ grid-add ] build-spec ] with-gadget ; inline
diff --git a/library/ui/gadgets/tracks.factor b/library/ui/gadgets/tracks.factor
index 0de4a7be48..5a6abfc3ec 100644
--- a/library/ui/gadgets/tracks.factor
+++ b/library/ui/gadgets/tracks.factor
@@ -135,13 +135,12 @@ C: divider ( -- divider )
     #! Specs is an array of quadruples { quot post setter loc }.
     #! The setter has stack effect ( new gadget -- ),
     #! the loc is a ratio from 0 to 1.
-    swap [
-        [ [ [ drop track-add ] add-spec ] each ] keep
-        [ peek ] map gadget get set-track-sizes
-    ] with-gadget ;
+    2dup
+    swap [ [ drop track-add ] build-spec ] with-gadget
+    [ peek ] map swap set-track-sizes ; inline
 
 : make-track ( specs orientation -- gadget )
-    <track> [ swap build-track ] keep ;
+    <track> [ swap build-track ] keep ; inline
 
 : make-track* ( gadget specs orientation -- gadget )
-    <track> pick [ set-delegate build-track ] keep ;
+    <track> pick [ set-delegate build-track ] keep ; inline
diff --git a/library/ui/hierarchy.factor b/library/ui/hierarchy.factor
index aa03629a9f..2cf31ebcdd 100644
--- a/library/ui/hierarchy.factor
+++ b/library/ui/hierarchy.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2005, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: gadgets
-USING: generic hashtables kernel math namespaces sequences
-vectors words ;
+USING: generic hashtables inference kernel math namespaces
+sequences vectors words ;
 
 GENERIC: graft* ( gadget -- )
 
@@ -61,15 +61,25 @@ M: gadget ungraft* drop ;
     #! Add all gadgets in a sequence to a parent gadget.
     swap [ over (add-gadget) ] each relayout ;
 
-: add-spec ( { quot setter post loc } quot -- )
-    [
-        over first %
-        over second [ [ dup gadget get ] % , ] when*
-        over third %
-        [ gadget get ] %
-        swap fourth ,
-        %
-    ] [ ] make call ;
+: add-spec ( quot { quot setter post loc } -- )
+    dup first %
+    dup second [ [ dup gadget get ] % , ] when*
+    dup third %
+    [ gadget get ] %
+    fourth ,
+    % ;
+
+: (build-spec) ( quot spec -- quot )
+    [ [ add-spec ] each-with ] [ ] make ;
+
+: build-spec ( spec quot -- )
+    swap (build-spec) call ;
+
+\ build-spec { 2 0 } "infer-effect" set-word-prop
+
+\ build-spec [
+    pop-literal pop-literal nip (build-spec) infer-quot-value
+] "infer" set-word-prop
 
 : (parents) ( gadget -- )
     [ dup , gadget-parent (parents) ] when* ;
diff --git a/library/ui/models.factor b/library/ui/models.factor
index d69960f9ed..ae4ecab4d7 100644
--- a/library/ui/models.factor
+++ b/library/ui/models.factor
@@ -124,7 +124,7 @@ M: compose model-changed ( compose -- )
     swap delegate set-model ;
 
 M: compose set-model ( value compose -- )
-    model-dependencies [ set-model ] 2map ;
+    model-dependencies [ set-model ] 2each ;
 
 TUPLE: history back forward ;