Merge branch 'master' of git://factorcode.org/git/factor into mongo-factor-driver

basis/cocoa/dialogs/dialogs.factor

@@ -12,6 +12,9 @@ IN: cocoa.dialogs
     dup 1 -> setResolvesAliases:
     dup 1 -> setAllowsMultipleSelection: ;
 
+: <NSDirPanel> ( -- panel ) <NSOpenPanel>
+   dup 1 -> setCanChooseDirectories: ;
+
 : <NSSavePanel> ( -- panel )
     NSSavePanel -> savePanel
     dup 1 -> setCanChooseFiles:
@@ -21,11 +24,13 @@ IN: cocoa.dialogs
 CONSTANT: NSOKButton 1
 CONSTANT: NSCancelButton 0
 
-: open-panel ( -- paths )
-    <NSOpenPanel>
+: (open-panel) ( panel -- paths )
     dup -> runModal NSOKButton =
     [ -> filenames CF>string-array ] [ drop f ] if ;
     
+: open-panel ( -- paths ) <NSOpenPanel> (open-panel) ;
+: open-dir-panel ( -- paths ) <NSDirPanel> (open-panel) ;
+
 : split-path ( path -- dir file )
     "/" split1-last [ <NSString> ] bi@ ;
 

basis/ftp/client/client.factor

@@ -66,7 +66,7 @@ ERROR: ftp-error got expected ;
 : list ( url -- ftp-response )
     utf8 open-passive-client
     ftp-list
-    lines
+    stream-lines
     <ftp-response> swap >>strings
     read-response 226 ftp-assert
     parse-list ;

basis/inverse/inverse-tests.factor

@@ -1,5 +1,7 @@
+! Copyright (C) 2007, 2009 Daniel Ehrenberg.
+! See http://factorcode.org/license.txt for BSD license.
 USING: inverse tools.test arrays math kernel sequences
-math.functions math.constants continuations ;
+math.functions math.constants continuations combinators.smart ;
 IN: inverse-tests
 
 [ 2 ] [ { 3 2 } [ 3 swap 2array ] undo ] unit-test
@@ -69,7 +71,7 @@ C: <nil> nil
 
 [ t ] [ pi [ pi ] matches? ] unit-test
 [ 0.0 ] [ 0.0 pi + [ pi + ] undo ] unit-test
-[ ] [ 3 [ _ ] undo ] unit-test
+[ ] [ 3 [ __ ] undo ] unit-test
 
 [ 2.0 ] [ 2 3 ^ [ 3 ^ ] undo ] unit-test
 [ 3.0 ] [ 2 3 ^ [ 2 swap ^ ] undo ] unit-test
@@ -89,3 +91,6 @@ TUPLE: funny-tuple ;
 : funny-tuple ( -- ) "OOPS" throw ;
 
 [ ] [ [ <funny-tuple> ] [undo] drop ] unit-test
+
+[ 0 ] [ { 1 2 } [ [ 1+ 2 ] { } output>sequence ] undo ] unit-test
+[ { 0 1 } ] [ 1 2 [ [ [ 1+ ] bi@ ] input<sequence ] undo ] unit-test

basis/inverse/inverse.factor

@@ -1,12 +1,12 @@
-! Copyright (C) 2007, 2008 Daniel Ehrenberg.
+! Copyright (C) 2007, 2009 Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel words summary slots quotations
 sequences assocs math arrays stack-checker effects generalizations
 continuations debugger classes.tuple namespaces make vectors
 bit-arrays byte-arrays strings sbufs math.functions macros
-sequences.private combinators mirrors splitting
-combinators.short-circuit fry words.symbol generalizations ;
-RENAME: _ fry => __
+sequences.private combinators mirrors splitting combinators.smart
+combinators.short-circuit fry words.symbol generalizations
+classes ;
 IN: inverse
 
 ERROR: fail ;
@@ -14,7 +14,7 @@ M: fail summary drop "Matching failed" ;
 
 : assure ( ? -- ) [ fail ] unless ; inline
 
-: =/fail ( obj1 obj2 -- ) = assure ;
+: =/fail ( obj1 obj2 -- ) = assure ; inline
 
 ! Inverse of a quotation
 
@@ -143,14 +143,19 @@ MACRO: undo ( quot -- ) [undo] ;
 \ pick [ [ pick ] dip =/fail ] define-inverse
 \ tuck [ swapd [ =/fail ] keep ] define-inverse
 
+\ bi@ 1 [ [undo] '[ _ bi@ ] ] define-pop-inverse
+\ tri@ 1 [ [undo] '[ _ tri@ ] ] define-pop-inverse
+\ bi* 2 [ [ [undo] ] bi@ '[ _ _ bi* ] ] define-pop-inverse
+\ tri* 3 [ [ [undo] ] tri@ '[ _ _ _ tri* ] ] define-pop-inverse
+
 \ not define-involution
-\ >boolean [ { t f } memq? assure ] define-inverse
+\ >boolean [ dup { t f } memq? assure ] define-inverse
 
 \ tuple>array \ >tuple define-dual
 \ reverse define-involution
 
-\ undo 1 [ [ call ] curry ] define-pop-inverse
-\ map 1 [ [undo] [ over sequence? assure map ] curry ] define-pop-inverse
+\ undo 1 [ ] define-pop-inverse
+\ map 1 [ [undo] '[ dup sequence? assure _ map ] ] define-pop-inverse
 
 \ exp \ log define-dual
 \ sq \ sqrt define-dual
@@ -173,16 +178,13 @@ ERROR: missing-literal ;
     2curry
 ] define-pop-inverse
 
-DEFER: _
-\ _ [ drop ] define-inverse
+DEFER: __
+\ __ [ drop ] define-inverse
 
 : both ( object object -- object )
     dupd assert= ;
 \ both [ dup ] define-inverse
 
-: assure-length ( seq length -- seq )
-    over length =/fail ;
-
 {
     { >array array? }
     { >vector vector? }
@@ -194,14 +196,23 @@ DEFER: _
     { >string string? }
     { >sbuf sbuf? }
     { >quotation quotation? }
-} [ \ dup swap \ assure 3array >quotation define-inverse ] assoc-each
+} [ '[ dup _ execute assure ] define-inverse ] assoc-each
 
-! These actually work on all seqs--should they?
-\ 1array [ 1 assure-length first ] define-inverse
-\ 2array [ 2 assure-length first2 ] define-inverse
-\ 3array [ 3 assure-length first3 ] define-inverse
-\ 4array [ 4 assure-length first4 ] define-inverse
-\ narray 1 [ [ firstn ] curry ] define-pop-inverse
+: assure-length ( seq length -- )
+    swap length =/fail ; inline
+
+: assure-array ( array -- array )
+    dup array? assure ; inline
+
+: undo-narray ( array n -- ... )
+    [ assure-array ] dip
+    [ assure-length ] [ firstn ] 2bi ; inline
+
+\ 1array [ 1 undo-narray ] define-inverse
+\ 2array [ 2 undo-narray ] define-inverse
+\ 3array [ 3 undo-narray ] define-inverse
+\ 4array [ 4 undo-narray ] define-inverse
+\ narray 1 [ '[ _ undo-narray ] ] define-pop-inverse
 
 \ first [ 1array ] define-inverse
 \ first2 [ 2array ] define-inverse
@@ -214,6 +225,12 @@ DEFER: _
 \ append 1 [ [ ?tail assure ] curry ] define-pop-inverse
 \ prepend 1 [ [ ?head assure ] curry ] define-pop-inverse
 
+: assure-same-class ( obj1 obj2 -- )
+    [ class ] bi@ = assure ; inline
+
+\ output>sequence 2 [ [undo] '[ dup _ assure-same-class _ input<sequence ] ] define-pop-inverse
+\ input<sequence 1 [ [undo] '[ _ { } output>sequence ] ] define-pop-inverse
+
 ! Constructor inverse
 : deconstruct-pred ( class -- quot )
     "predicate" word-prop [ dupd call assure ] curry ;
@@ -245,7 +262,7 @@ DEFER: _
     ] recover ; inline
 
 : true-out ( quot effect -- quot' )
-    out>> '[ @ __ ndrop t ] ;
+    out>> '[ @ _ ndrop t ] ;
 
 : false-recover ( effect -- quot )
     in>> [ ndrop f ] curry [ recover-fail ] curry ;

basis/io/encodings/string/string.factor

@@ -4,7 +4,7 @@ USING: io io.streams.byte-array ;
 IN: io.encodings.string
 
 : decode ( byte-array encoding -- string )
-    <byte-reader> contents ;
+    <byte-reader> stream-contents ;
 
 : encode ( string encoding -- byte-array )
     [ write ] with-byte-writer ;

basis/io/launcher/launcher.factor

@@ -3,9 +3,9 @@
 USING: system kernel namespaces strings hashtables sequences 
 assocs combinators vocabs.loader init threads continuations
 math accessors concurrency.flags destructors environment
-io io.backend io.timeouts io.pipes io.pipes.private io.encodings
-io.streams.duplex io.ports debugger prettyprint summary
-calendar ;
+io io.encodings.ascii io.backend io.timeouts io.pipes
+io.pipes.private io.encodings io.streams.duplex io.ports
+debugger prettyprint summary calendar ;
 IN: io.launcher
 
 TUPLE: process < identity-tuple
@@ -265,3 +265,5 @@ M: object run-pipeline-element
     { [ os winnt? ] [ "io.launcher.windows.nt" require ] }
     [ ]
 } cond
+
+: run-desc ( desc -- result ) ascii <process-reader> f swap stream-read-until drop ;

basis/io/launcher/unix/unix-tests.factor

@@ -33,7 +33,7 @@ concurrency.promises threads unix.process ;
     "cat"
     "launcher-test-1" temp-file
     2array
-    ascii <process-reader> contents
+    ascii <process-reader> stream-contents
 ] unit-test
 
 [ ] [
@@ -52,7 +52,7 @@ concurrency.promises threads unix.process ;
     "cat"
     "launcher-test-1" temp-file
     2array
-    ascii <process-reader> contents
+    ascii <process-reader> stream-contents
 ] unit-test
 
 [ ] [
@@ -70,14 +70,14 @@ concurrency.promises threads unix.process ;
     "cat"
     "launcher-test-1" temp-file
     2array
-    ascii <process-reader> contents
+    ascii <process-reader> stream-contents
 ] unit-test
 
 [ t ] [
     <process>
         "env" >>command
         { { "A" "B" } } >>environment
-    ascii <process-reader> lines
+    ascii <process-reader> stream-lines
     "A=B" swap member?
 ] unit-test
 
@@ -86,7 +86,7 @@ concurrency.promises threads unix.process ;
         "env" >>command
         { { "A" "B" } } >>environment
         +replace-environment+ >>environment-mode
-    ascii <process-reader> lines
+    ascii <process-reader> stream-lines
 ] unit-test
 
 [ "hi\n" ] [
@@ -113,13 +113,13 @@ concurrency.promises threads unix.process ;
     "append-test" temp-file utf8 file-contents
 ] unit-test
 
-[ t ] [ "ls" utf8 <process-stream> contents >boolean ] unit-test
+[ t ] [ "ls" utf8 <process-stream> stream-contents >boolean ] unit-test
 
 [ "Hello world.\n" ] [
     "cat" utf8 <process-stream> [
         "Hello world.\n" write
         output-stream get dispose
-        input-stream get contents
+        input-stream get stream-contents
     ] with-stream
 ] unit-test
 

basis/io/servers/connection/connection-tests.factor

@@ -35,4 +35,4 @@ concurrency.promises io.encodings.ascii io threads calendar ;
     dup start-server* sockets>> first addr>> port>> "port" set
 ] unit-test
 
-[ "Hello world." ] [ "localhost" "port" get <inet> ascii <client> drop contents ] unit-test
+[ "Hello world." ] [ "localhost" "port" get <inet> ascii <client> drop stream-contents ] unit-test

basis/io/sockets/secure/unix/unix-tests.factor

@@ -23,7 +23,7 @@ io.sockets.secure.unix.debug ;
 
 : client-test ( -- string )
     <secure-config> [
-        "127.0.0.1" "port" get ?promise <inet4> <secure> ascii <client> drop contents
+        "127.0.0.1" "port" get ?promise <inet4> <secure> ascii <client> drop stream-contents
     ] with-secure-context ;
 
 [ ] [ [ class name>> write ] server-test ] unit-test

basis/io/streams/byte-array/byte-array-tests.factor

@@ -6,7 +6,7 @@ io.encodings.utf8 io kernel arrays strings namespaces ;
 
 [ B{ BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 10111111 BIN: 11101111 BIN: 10000000 BIN: 10111111 BIN: 11011111 BIN: 10000000 CHAR: x } ]
 [ { BIN: 101111111000000111111 BIN: 1111000000111111 BIN: 11111000000 CHAR: x } >string utf8 [ write ] with-byte-writer ] unit-test
-[ { BIN: 101111111000000111111 } t ] [ { BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 10111111 } utf8 <byte-reader> contents dup >array swap string? ] unit-test
+[ { BIN: 101111111000000111111 } t ] [ { BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 10111111 } utf8 <byte-reader> stream-contents dup >array swap string? ] unit-test
 
 [ B{ 121 120 } 0 ] [
     B{ 0 121 120 0 0 0 0 0 0 } binary

basis/random/random.factor

@@ -54,7 +54,7 @@ PRIVATE>
 
 : randomize ( seq -- seq )
     dup length [ dup 1 > ]
-    [ [ random ] [ 1- ] bi [ pick exchange ] keep ]
+    [ [ iota random ] [ 1- ] bi [ pick exchange ] keep ]
     while drop ;
 
 : delete-random ( seq -- elt )

basis/ui/tools/listener/listener-tests.factor

@@ -75,7 +75,7 @@ CONSTANT: text "Hello world.\nThis is a test."
 [ ] [
     [
         "interactor" get register-self
-        "interactor" get contents "promise" get fulfill
+        "interactor" get stream-contents "promise" get fulfill
     ] in-thread
 ] unit-test
 

basis/xmode/code2html/code2html.factor

@@ -24,7 +24,7 @@ IN: xmode.code2html
     [XML <style><-></style> XML] ;
 
 :: htmlize-stream ( path stream -- xml )
-    stream lines
+    stream stream-lines
     [ "" ] [ path over first find-mode htmlize-lines ]
     if-empty :> input
     default-stylesheet :> stylesheet

core/checksums/checksums.factor

@@ -13,7 +13,7 @@ GENERIC: checksum-stream ( stream checksum -- value )
 GENERIC: checksum-lines ( lines checksum -- value )
 
 M: checksum checksum-stream
-    [ contents ] dip checksum-bytes ;
+    [ stream-contents ] dip checksum-bytes ;
 
 M: checksum checksum-lines
     [ B{ CHAR: \n } join ] dip checksum-bytes ;

core/checksums/crc32/crc32.factor

@@ -9,7 +9,7 @@ CONSTANT: crc32-polynomial HEX: edb88320
 
 CONSTANT: crc32-table V{ }
 
-256 [
+256 iota [
     8 [
         [ 2/ ] [ even? ] bi [ crc32-polynomial bitxor ] unless
     ] times >bignum

core/classes/tuple/tuple.factor

@@ -331,7 +331,7 @@ GENERIC: tuple-hashcode ( n tuple -- x )
 
 M: tuple tuple-hashcode
     [
-        [ class hashcode ] [ tuple-size ] [ ] tri
+        [ class hashcode ] [ tuple-size iota ] [ ] tri
         [ rot ] dip [
             swapd array-nth hashcode* sequence-hashcode-step
         ] 2curry each

core/hashtables/hashtables.factor

@@ -139,7 +139,7 @@ M: hashtable set-at ( value key hash -- )
 PRIVATE>
 
 M: hashtable >alist
-    [ array>> [ length 2/ ] keep ] [ assoc-size <vector> ] bi [
+    [ array>> [ length 2/ iota ] keep ] [ assoc-size <vector> ] bi [
         [
             [
                 [ 1 fixnum-shift-fast ] dip

core/io/files/files.factor

@@ -20,13 +20,13 @@ HOOK: (file-appender) io-backend ( path -- stream )
     swap normalize-path (file-appender) swap <encoder> ;
 
 : file-lines ( path encoding -- seq )
-    <file-reader> lines ;
+    <file-reader> stream-lines ;
 
 : with-file-reader ( path encoding quot -- )
     [ <file-reader> ] dip with-input-stream ; inline
 
 : file-contents ( path encoding -- seq )
-    <file-reader> contents ;
+    <file-reader> stream-contents ;
 
 : with-file-writer ( path encoding quot -- )
     [ <file-writer> ] dip with-output-stream ; inline

core/io/io-docs.factor

@@ -221,10 +221,14 @@ HELP: bl
 { $description "Outputs a space character (" { $snippet "\" \"" } ") to " { $link output-stream } "." }
 $io-error ;
 
-HELP: lines
+HELP: stream-lines
 { $values { "stream" "an input stream" } { "seq" "a sequence of strings" } }
 { $description "Reads lines of text until the stream is exhausted, collecting them in a sequence of strings." } ;
 
+HELP: lines
+{ $values { "seq" "a sequence of strings" } }
+{ $description "Reads lines of text until from the " { $link input-stream } " until it is exhausted, collecting them in a sequence of strings." } ;
+
 HELP: each-line
 { $values { "quot" { $quotation "( str -- )" } } }
 { $description "Calls the quotation with successive lines of text, until the current " { $link input-stream } " is exhausted." } ;
@@ -233,11 +237,16 @@ HELP: each-block
 { $values { "quot" { $quotation "( block -- )" } } }
 { $description "Calls the quotation with successive blocks of data, until the current " { $link input-stream } " is exhausted." } ;
 
-HELP: contents
+HELP: stream-contents
 { $values { "stream" "an input stream" } { "seq" "a string, byte array or " { $link f } } }
 { $description "Reads the entire contents of a stream. If the stream is empty, outputs "  { $link f } "." }
 $io-error ;
 
+HELP: contents
+{ $values { "seq" "a string, byte array or " { $link f } } }
+{ $description "Reads the entire contents of a the stream stored in " { $link input-stream } ". If the stream is empty, outputs " { $link f } "." }
+$io-error ;
+
 ARTICLE: "stream-protocol" "Stream protocol"
 "The stream protocol consists of a large number of generic words, many of which are optional."
 $nl
@@ -347,9 +356,11 @@ $nl
 "First, a simple composition of " { $link stream-write } " and " { $link stream-nl } ":"
 { $subsection stream-print }
 "Processing lines one by one:"
+{ $subsection stream-lines }
 { $subsection lines }
 { $subsection each-line }
 "Processing blocks of data:"
+{ $subsection stream-contents }
 { $subsection contents }
 { $subsection each-block }
 "Copying the contents of one stream to another:"

core/io/io.factor

@@ -68,9 +68,12 @@ SYMBOL: error-stream
 
 : bl ( -- ) " " write ;
 
-: lines ( stream -- seq )
+: stream-lines ( stream -- seq )
     [ [ readln dup ] [ ] produce nip ] with-input-stream ;
 
+: lines ( -- seq )
+    input-stream get stream-lines ;
+
 <PRIVATE
 
 : each-morsel ( handler: ( data -- ) reader: ( -- data ) -- )
@@ -81,11 +84,14 @@ PRIVATE>
 : each-line ( quot -- )
     [ readln ] each-morsel ; inline
 
-: contents ( stream -- seq )
+: stream-contents ( stream -- seq )
     [
         [ 65536 read-partial dup ] [ ] produce nip concat f like
     ] with-input-stream ;
 
+: contents ( -- seq )
+    input-stream get stream-contents ;
+
 : each-block ( quot: ( block -- ) -- )
     [ 8192 read-partial ] each-morsel ; inline
 

core/io/streams/c/c-tests.factor

@@ -5,6 +5,6 @@ IN: io.streams.c.tests
 [ "hello world" ] [
     "hello world" "test.txt" temp-file ascii set-file-contents
 
-    "test.txt" temp-file "rb" fopen <c-reader> contents
+    "test.txt" temp-file "rb" fopen <c-reader> stream-contents
     >string
 ] unit-test

core/parser/parser.factor

@@ -272,7 +272,7 @@ print-use-hook [ [ ] ] initialize
 : parse-stream ( stream name -- quot )
     [
         [
-            lines dup parse-fresh
+            stream-lines dup parse-fresh
             [ nip ] [ finish-parsing ] 2bi
             forget-smudged
         ] with-source-file

core/sequences/sequences.factor

@@ -556,7 +556,7 @@ PRIVATE>
     [ empty? not ] filter ;
 
 : mismatch ( seq1 seq2 -- i )
-    [ min-length ] 2keep
+    [ min-length iota ] 2keep
     [ 2nth-unsafe = not ] 2curry
     find drop ; inline
 

extra/contributors/contributors.factor

@@ -7,7 +7,7 @@ IN: contributors
 
 : changelog ( -- authors )
     image parent-directory [
-        "git log --pretty=format:%an" ascii <process-reader> lines
+        "git log --pretty=format:%an" ascii <process-reader> stream-lines
     ] with-directory ;
 
 : patch-counts ( authors -- assoc )

extra/file-trees/file-trees-tests.factor

@@ -0,0 +1,4 @@
+USING: kernel file-trees ;
+IN: file-trees.tests
+{ "/sample/1" "/sample/2" "/killer/1" "/killer/2/3"
+"/killer/2/4" "/killer/2/4/6" "/megakiller" } create-tree drop

extra/file-trees/file-trees.factor

@@ -0,0 +1,23 @@
+USING: accessors delegate delegate.protocols io.pathnames
+kernel locals namespaces sequences vectors
+tools.annotations prettyprint ;
+IN: file-trees
+
+TUPLE: tree node children ;
+CONSULT: sequence-protocol tree children>> [ node>> ] map ;
+
+: <tree> ( start -- tree ) V{ } clone
+   [ tree boa dup children>> ] [ ".." swap tree boa ] bi swap push ;
+
+DEFER: (tree-insert)
+
+: tree-insert ( path tree -- ) [ unclip <tree> ] [ children>> ] bi* (tree-insert) ;
+:: (tree-insert) ( path-rest path-head tree-children -- )
+   tree-children [ node>> path-head node>> = ] find nip
+   [ path-rest swap tree-insert ]
+   [ 
+      path-head tree-children push
+      path-rest [ path-head tree-insert ] unless-empty
+   ] if* ;
+: create-tree ( file-list -- tree ) [ path-components ] map
+   t <tree> [ [ tree-insert ] curry each ] keep ;

extra/irc/gitbot/gitbot.factor

@@ -33,7 +33,7 @@ M: object handle-message drop ;
         "--pretty=format:%h %an: %s" ,
         ".." glue ,
     ] { } make
-    latin1 [ input-stream get lines ] with-process-reader ;
+    latin1 [ lines ] with-process-reader ;
 
 : updates ( from to -- lines )
     git-log reverse

extra/mason/common/common.factor

@@ -16,7 +16,7 @@ M: output-process-error error.
 
 : try-output-process ( command -- )
     >process +stdout+ >>stderr utf8 <process-reader*>
-    [ contents ] [ dup wait-for-process ] bi*
+    [ stream-contents ] [ dup wait-for-process ] bi*
     0 = [ 2drop ] [ output-process-error ] if ;
 
 HOOK: really-delete-tree os ( path -- )

extra/ui/frp/frp-docs.factor

@@ -1,33 +1,43 @@
-USING: ui.frp help.syntax help.markup monads sequences ;
+USING: help.markup help.syntax models monads sequences
+ui.gadgets.buttons ui.gadgets.tracks ;
 IN: ui.frp
 
 ! Layout utilities
 
 HELP: ,
+{ $values { "uiitem" "a gadget or model" } }
 { $description "Used in a series of gadgets created by a box, accumulating the gadget" } ;
 HELP: ->
+{ $values { "uiitem" "a gadget or model" } { "model" model } }
 { $description "Like " { $link , } "but passes its model on for further use." } ;
 HELP: <hbox>
+{ $values { "gadgets" "a list of gadgets" } { "track" track } }
 { $syntax "[ gadget , gadget , ... ] <hbox>" }
 { $description "Creates an horizontal track containing the gadgets listed in the quotation" } ;
 HELP: <vbox>
+{ $values { "gadgets" "a list of gadgets" } { "track" track } }
 { $syntax "[ gadget , gadget , ... ] <hbox>" }
 { $description "Creates an vertical track containing the gadgets listed in the quotation" } ;
 
 ! Gadgets
 HELP: <frp-button>
+{ $values { "text" "the button's label" } { "button" button } }
 { $description "Creates an button whose model updates on clicks" } ;
 
 HELP: <merge>
-{ $description "Creates a model that merges the updates of two others" } ;
+{ $values { "models" "a list of models" } { "model" merge-model } }
+{ $description "Creates a model that merges the updates of others" } ;
 
 HELP: <filter>
+{ $values { "model" model } { "quot" "quotation with stack effect ( a b -- c )" } { "filter-model" filter-model } }
 { $description "Creates a model that uses the updates of another model when they satisfy a given predicate" } ;
 
 HELP: <fold>
+{ $values { "oldval" "starting value" } { "quot" "applied to update and previous values" } { "model" model } { "model'" model } }
 { $description "Similar to " { $link reduce } " but works on models, applying a quotation to the previous and new values at each update" } ;
 
 HELP: switch
+{ $values { "signal1" model } { "signal2" model } { "signal'" model } }
 { $description "Creates a model that starts with the behavior of model1 and switches to the behavior of model2 on its update" } ;
 
 ARTICLE: { "frp" "instances" } "FRP Instances"

extra/ui/frp/frp.factor

@@ -14,11 +14,12 @@ M: frp-table row-columns quot>> [ call( a -- b ) ] [ drop f ] if* ;
 M: frp-table row-value val-quot>> [ call( a -- b ) ]  [ drop f ] if* ;
 M: frp-table row-color color-quot>> [ call( a -- b ) ]  [ drop f ] if* ;
 
-: <frp-table> ( model quot -- table )
-    frp-table new-line-gadget dup >>renderer swap >>quot swap >>model
+: <frp-table> ( model -- table )
+    frp-table new-line-gadget dup >>renderer [ ] >>quot swap >>model
     f <model> >>selected-value sans-serif-font >>font
     focus-border-color >>focus-border-color
     transparent >>column-line-color ;
+: <frp-list> ( model -- table ) <frp-table> [ 1array ] >>quot ;
 : <frp-field> ( -- field ) f <model> <model-field> ;
 
 ! Layout utilities
@@ -27,11 +28,11 @@ GENERIC: output-model ( gadget -- model )
 M: gadget output-model model>> ;
 M: frp-table output-model selected-value>> ;
 
-GENERIC: , ( object -- )
+GENERIC: , ( uiitem -- )
 M: gadget , make:, ;
 M: model , activate-model ;
 
-GENERIC: -> ( object -- model )
+GENERIC: -> ( uiitem -- model )
 M: gadget -> dup make:, output-model ;
 M: model -> dup , ;
 M: table -> dup , selected-value>> ;