Merge branch 'master' of git://github.com/bogiebro/factor
commit
e5217b928e
basis
cocoa/dialogs
io/launcher
extra
|
@ -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@ ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
|
@ -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 ;
|
|
@ -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." ;
|
||||
|
||||
|
|
|
@ -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>> ;
|
||||
|
|
Loading…
Reference in New Issue