Use call( in a bunch of places in the UI; update-ui infers now

basis/core-text/core-text.factor

@@ -121,7 +121,7 @@ CONSTANT: max-line-age 10
 
 : age-assoc ( assoc quot -- assoc' )
     '[ nip @ ] assoc-partition
-    [ values dispose-each ] dip ;
+    [ values dispose-each ] dip ; inline
 
 : age-lines ( -- )
     cached-lines global [ [ age-line ] age-assoc ] change-at ;

basis/listener/listener.factor

@@ -1,10 +1,10 @@
-! Copyright (C) 2003, 2008 Slava Pestov.
+! Copyright (C) 2003, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays hashtables io kernel math math.parser memory
 namespaces parser lexer sequences strings io.styles
 vectors words generic system combinators continuations debugger
 definitions compiler.units accessors colors prettyprint fry
-sets vocabs.parser ;
+sets vocabs.parser call ;
 IN: listener
 
 GENERIC: stream-read-quot ( stream -- quot/f )
@@ -55,7 +55,8 @@ SYMBOL: visible-vars
 SYMBOL: error-hook
 
 : call-error-hook ( error -- )
-    error-continuation get error-hook get call ;
+    error-continuation get error-hook get
+    call( error continuation -- ) ;
 
 [ drop print-error-and-restarts ] error-hook set-global
 

basis/models/filter/filter.factor

@@ -1,6 +1,6 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors models kernel ;
+USING: accessors models kernel call ;
 IN: models.filter
 
 TUPLE: filter < model model quot ;
@@ -12,6 +12,7 @@ TUPLE: filter < model model quot ;
         [ add-dependency ] keep ;
 
 M: filter model-changed
-    [ [ value>> ] [ quot>> ] bi* call ] [ nip ] 2bi set-model ;
+    [ [ value>> ] [ quot>> ] bi* call( old -- new ) ] [ nip ] 2bi
+    set-model ;
 
 M: filter model-activated [ model>> ] keep model-changed ;

basis/models/models-tests.factor

@@ -31,3 +31,6 @@ T{ model-tester f f } "tester" set
     "tester" get
     "model-c" get value>>
 ] unit-test
+
+\ model-changed must-infer
+\ set-model must-infer

basis/ui/commands/commands.factor

@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays definitions kernel sequences strings
 math assocs words generic namespaces make assocs quotations
-splitting ui.gestures unicode.case unicode.categories tr fry ;
+splitting ui.gestures unicode.case unicode.categories tr fry
+call ;
 IN: ui.commands
 
 SYMBOL: +nullary+
@@ -74,7 +75,7 @@ M: word command-description ( word -- str )
     [ nip ] [ curry ] if ;
 
 M: word invoke-command ( target command -- )
-    command-quot call ;
+    command-quot call( -- ) ;
 
 M: word command-word ;
 

basis/ui/gadgets/gadgets-tests.factor

@@ -161,3 +161,6 @@ M: mock-gadget ungraft*
 \ relayout must-infer
 \ relayout-1 must-infer
 \ pref-dim must-infer
+
+\ graft* must-infer
+\ ungraft* must-infer

basis/ui/gadgets/panes/panes.factor

@@ -9,7 +9,7 @@ ui.gadgets.labels ui.gadgets.scrollers ui.gadgets.paragraphs
 ui.gadgets.incremental ui.gadgets.packs ui.gadgets.theme
 ui.gadgets.menus ui.clipboards ui.gestures ui.traverse ui.render
 ui.text ui.gadgets.presentations ui.gadgets.grids
-ui.gadgets.grid-lines colors ;
+ui.gadgets.grid-lines colors call ;
 IN: ui.gadgets.panes
 
 TUPLE: pane < pack
@@ -146,7 +146,8 @@ M: style-stream write-gadget
 TUPLE: pane-control < pane quot ;
 
 M: pane-control model-changed ( model pane-control -- )
-    [ value>> ] [ dup quot>> ] bi* with-pane ;
+    [ value>> ] [ dup quot>> ] bi*
+    '[ _ call( value -- ) ] with-pane ;
 
 : <pane-control> ( model quot -- pane )
     pane-control new-pane

basis/ui/gadgets/worlds/worlds.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs continuations kernel math models
+USING: accessors arrays assocs continuations kernel math models call
 namespaces opengl sequences io combinators combinators.short-circuit
 fry math.vectors ui.gadgets ui.gestures ui.render ui.text ui.text.private
 ui.backend ui.gadgets.tracks math.rectangles ;
@@ -77,7 +77,7 @@ C: <world-error> world-error
 SYMBOL: ui-error-hook
 
 : ui-error ( error -- )
-    ui-error-hook get [ call ] [ die ] if* ;
+    ui-error-hook get [ call( error -- ) ] [ die drop ] if* ;
 
 ui-error-hook global [ [ rethrow ] or ] change-at
 

basis/ui/gestures/gestures-tests.factor

@@ -0,0 +1,5 @@
+IN: ui.gestures.tests
+USING: tools.test ui.gestures ;
+
+\ handle-gesture must-infer
+\ send-queued-gesture must-infer

basis/ui/gestures/gestures.factor

@@ -1,10 +1,10 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs kernel math math.order models
 namespaces make sequences words strings system hashtables
 math.parser math.vectors classes.tuple classes boxes calendar
 alarms combinators sets columns fry deques ui.gadgets
-ui.gadgets.private unicode.case combinators.short-circuit ;
+ui.gadgets.private unicode.case combinators.short-circuit call ;
 IN: ui.gestures
 
 GENERIC: handle-gesture ( gesture gadget -- ? )
@@ -12,7 +12,7 @@ GENERIC: handle-gesture ( gesture gadget -- ? )
 M: object handle-gesture
     [ nip ]
     [ class superclasses [ "gestures" word-prop ] map assoc-stack ] 2bi
-    dup [ call f ] [ 2drop t ] if ;
+    dup [ call( gadget -- ) f ] [ 2drop t ] if ;
 
 : set-gestures ( class hash -- ) "gestures" set-word-prop ;
 

basis/ui/operations/operations-tests.factor

@@ -26,3 +26,5 @@ io.streams.string math help help.markup accessors ;
 [ ] [
     [ { $operations \ + } print-element ] with-string-writer drop
 ] unit-test
+
+\ object-operations must-infer

basis/ui/operations/operations.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays definitions kernel ui.commands
 ui.gestures sequences strings math words generic namespaces
-hashtables help.markup quotations assocs fry ;
+hashtables help.markup quotations assocs fry call ;
 IN: ui.operations
 
 SYMBOL: +keyboard+
@@ -34,7 +34,7 @@ M: operation command-word command>> command-word ;
 SYMBOL: operations
 
 : object-operations ( obj -- operations )
-    operations get [ predicate>> call ] with filter ;
+    operations get [ predicate>> call( obj -- ? ) ] with filter ;
 
 : gesture>operation ( gesture object -- operation/f )
     object-operations [ operation-gesture = ] with find nip ;
@@ -77,4 +77,4 @@ SYMBOL: operations
     [ translator>> ] [ command>> ] bi '[ _ @ _ execute ] ;
 
 M: operation invoke-command ( target command -- )
-    operation-quot call ;
+    operation-quot call( -- ) ;

basis/ui/render/render-tests.factor

@@ -0,0 +1,4 @@
+IN: ui.render.tests
+USING: ui.render tools.test ;
+
+\ draw-gadget must-infer

basis/ui/ui-docs.factor

@@ -97,7 +97,6 @@ ARTICLE: "gadgets" "Pre-made UI gadgets"
 { $subsection "ui.gadgets.menus" }
 { $subsection "ui.gadgets.panes" }
 { $subsection "ui.gadgets.presentations" }
-{ $subsection "ui.gadgets.lists" }
 { $subsection "ui.gadgets.tables" } ;
 
 ARTICLE: "ui-geometry" "Gadget geometry"

basis/ui/ui-tests.factor

@@ -2,3 +2,4 @@ IN: ui.tests
 USING: ui tools.test ;
 
 \ open-window must-infer
+\ update-ui must-infer

basis/ui/ui.factor

@@ -117,12 +117,10 @@ M: world ungraft*
 
 : update-ui ( -- )
     [
-        [
+        notify-queued
-            notify-queued
+        layout-queued
-            layout-queued
+        redraw-worlds
-            redraw-worlds
+        send-queued-gestures
-            send-queued-gestures
-        ] call( -- )
     ] [ ui-error ] recover ;
 
 SYMBOL: ui-thread