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

db4
Doug Coleman 2009-05-01 15:57:33 -05:00
commit e5217b928e
6 changed files with 58 additions and 13 deletions

View File

@ -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 )
<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@ ;

View File

@ -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 ;

View File

@ -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

View File

@ -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 ;

View File

@ -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. "
"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." ;

View File

@ -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>> ;