diff --git a/basis/cocoa/dialogs/dialogs.factor b/basis/cocoa/dialogs/dialogs.factor index 84a1ad46a3..7761286127 100644 --- a/basis/cocoa/dialogs/dialogs.factor +++ b/basis/cocoa/dialogs/dialogs.factor @@ -12,6 +12,9 @@ IN: cocoa.dialogs dup 1 -> setResolvesAliases: dup 1 -> setAllowsMultipleSelection: ; +: ( -- panel ) + dup 1 -> setCanChooseDirectories: ; + : ( -- 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 ) dup -> runModal NSOKButton = [ -> filenames CF>string-array ] [ drop f ] if ; + +: open-panel ( -- paths ) (open-panel) ; +: open-dir-panel ( -- paths ) (open-panel) ; : split-path ( path -- dir file ) "/" split1-last [ ] bi@ ; diff --git a/basis/io/launcher/launcher.factor b/basis/io/launcher/launcher.factor index f5809223fc..838c09c657 100755 --- a/basis/io/launcher/launcher.factor +++ b/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 f swap stream-read-until drop ; diff --git a/extra/file-trees/file-trees-tests.factor b/extra/file-trees/file-trees-tests.factor new file mode 100644 index 0000000000..dbb8f9f5d8 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/extra/file-trees/file-trees.factor b/extra/file-trees/file-trees.factor new file mode 100644 index 0000000000..788291c0a2 --- /dev/null +++ b/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 ; + +: ( start -- tree ) V{ } clone + [ tree boa dup children>> ] [ ".." swap tree boa ] bi swap push ; + +DEFER: (tree-insert) + +: tree-insert ( path tree -- ) [ unclip ] [ 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-insert ] curry each ] keep ; \ No newline at end of file diff --git a/extra/ui/frp/frp-docs.factor b/extra/ui/frp/frp-docs.factor index a6f625cc59..af44567e46 100644 --- a/extra/ui/frp/frp-docs.factor +++ b/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: +{ $values { "gadgets" "a list of gadgets" } { "track" track } } { $syntax "[ gadget , gadget , ... ] " } { $description "Creates an horizontal track containing the gadgets listed in the quotation" } ; HELP: +{ $values { "gadgets" "a list of gadgets" } { "track" track } } { $syntax "[ gadget , gadget , ... ] " } { $description "Creates an vertical track containing the gadgets listed in the quotation" } ; ! Gadgets HELP: +{ $values { "text" "the button's label" } { "button" button } } { $description "Creates an button whose model updates on clicks" } ; HELP: -{ $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: +{ $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: +{ $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. " -"Also, a gadget is a monad. Binding recieves a model and creates a new gadget." ; +"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." ; diff --git a/extra/ui/frp/frp.factor b/extra/ui/frp/frp.factor index f5c0f1bd10..aa7c44ee03 100644 --- a/extra/ui/frp/frp.factor +++ b/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* ; -: ( model quot -- table ) - frp-table new-line-gadget dup >>renderer swap >>quot swap >>model +: ( model -- table ) + frp-table new-line-gadget dup >>renderer [ ] >>quot swap >>model f >>selected-value sans-serif-font >>font focus-border-color >>focus-border-color transparent >>column-line-color ; +: ( model -- table ) [ 1array ] >>quot ; : ( -- field ) f ; ! 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>> ;