Merge branch 'master' of git://github.com/bogiebro/factor

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,10 +24,12 @@ IN: cocoa.dialogs
 CONSTANT: NSOKButton 1
 CONSTANT: NSCancelButton 0
 
-: open-panel ( -- paths )
+: (open-panel) ( panel -- paths )
-    <NSOpenPanel>
     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/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 io.encodings.ascii io.backend io.timeouts io.pipes
-io.streams.duplex io.ports debugger prettyprint summary
+io.pipes.private io.encodings io.streams.duplex io.ports
-calendar ;
+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 ;

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/ui/frp/frp-docs.factor

@@ -1,36 +1,46 @@
-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"
-"Models are all functors, as " { $link fmap } " corresponds directly to the " { $link "models.arrow" } " vocabulary.  "
+"Models are all functors, as " { $link fmap } " corresponds directly to the " { $link "models.arrow" } " vocabulary. "
-"Also, a gadget is a monad.  Binding recieves a model and creates a new gadget." ;
+"Also, a gadget is a monad. Binding recieves a model and creates a new gadget." ;
 

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> ( model -- table )
-    frp-table new-line-gadget dup >>renderer swap >>quot swap >>model
+    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>> ;