selective closures

db4
Sam Anklesaria 2009-05-27 19:37:24 -05:00
parent d0c5b43dc5
commit bf3d2d3d97
17 changed files with 13 additions and 111 deletions

View File

@ -1,4 +1,7 @@
USING: fry namespaces kernel sequences parser ;
USING: assocs io.pathnames fry namespaces kernel sequences parser ;
IN: closures
: delayed-bind ( quot -- quot' ) '[ namestack [ set-namestack @ ] curry ] ;
SYNTAX: C[ parse-quotation delayed-bind over push-all ;
SYMBOL: |
: delayed-bind-with ( vars quot -- quot' ) '[ _ dup [ get ] map zip [ _ bind ] curry ] ;
SYNTAX: C[ | parse-until parse-quotation delayed-bind-with over push-all ;
! Common ones
SYNTAX: DIR[ parse-quotation { current-directory } swap delayed-bind-with over push-all ;

1
extra/darcs-ui Submodule

@ -0,0 +1 @@
Subproject commit 54edac761ab48bee66f8db0210c27d52b72a94ef

View File

@ -1,34 +0,0 @@
USING: arrays closures continuations darcs-ui io.encodings.utf8
io.launcher kernel regexp sequences fries xml xml.data xml.traversal
ui.gadgets.alerts ;
IN: darcs-ui-demo.commands
: extract ( tag name -- string ) tag-named children>string ;
: prepare-patches ( changelog -- table-columns )
string>xml "patch" tags-named
[ [ "name" extract ]
[ [ "author" attr ] [ "local_date" attr ] bi ]
bi 3array
] map ;
: patches ( method search -- table-columns )
[ drop "" ] [ i" --_ \"_\"" ] if-empty
i" darcs changes --xml-output _" run-desc prepare-patches ;
: whatsnew ( -- matches ) "darcs whatsnew" run-desc R/ ^[^+-].*/m all-matching-subseqs ;
: pull ( repo -- ) i" darcs pull -a _" [ try-process ] [ 2drop "Can't connect" alert* ] recover ; inline
: repo-push ( repo -- ) i{ "darcs" "push" "-a" _ } [ try-process ] [ 2drop "Push refused" alert* ] recover ; inline
: send ( repo -- ) i{ "darcs" "send" "-a" _ } [ try-process ] [ 2drop "Sending failed" alert* ] recover ; inline
: app ( file -- ) i{ "darcs" "apply" "-a" _ } [ try-process ] [ 2drop "Applying failed" alert* ] recover ; inline
: record ( quot name author -- ) i{ "darcs" "record" "--skip-long-comment" "-m" _ "--author" _ }
utf8 rot with-process-writer ; inline
: cnts ( file patch -- result ) i" exact \"_\"" swap i{ "darcs" "show" "contents" "--match" _ _ }
[ run-desc ] [ 2drop "File doesn't exist for selected patch" ] recover ;
: files ( -- str ) "darcs show files" [ run-desc ] [ drop "Error showing files" alert* ] recover ;
: init-repo ( -- ) "darcs init" try-process ;
: add-repo-file ( files -- ) { "darcs" "add" "-r" } prepend
[ try-process ] [ 2drop "File already exists in repository" alert* ] recover ;
: remove-repo-file ( files -- ) { "darcs" "remove" } prepend
[ try-process ] [ 2drop "File doesn't exist in repository" alert* ] recover ;

View File

@ -1,73 +0,0 @@
USING: accessors arrays cocoa.dialogs closures continuations
darcs-ui.commands fry file-trees io io.files io.directories
io.encodings.utf8 kernel math models monads sequences
splitting ui ui.gadgets.alerts ui.frp.gadgets ui.frp.layout
ui.frp.signals ui.frp.instances ui.gadgets.comboboxes
ui.gadgets.labels ui.gadgets.scrollers ui.baseline-alignment
ui.images unicode.case ;
EXCLUDE: fries => _ ;
IN: darcs-ui-demo
: <patch-viewer> ( columns -- scroller ) <frp-table>
[ first ] >>val-quot
{ "Patch" "Author" "Date" } >>column-titles
<scroller> ;
: <change-list> ( {str} -- gadget ) <frp-list> t >>multiple-selection? indexed <scroller> ;
: answer ( length indices -- ) [ index [ "y" ] [ "n" ] if write ] curry each flush ;
: patches-quot ( -- model-of-quot )
[ whatsnew [ length <model> ] keep <model>
[ <change-list> ->% 1 "okay" <frp-bevel-button> [ close-window ] >>hook
-> <updates> [ [ answer ] 2curry ] 2fmap-&
] <vbox> { 229 200 } >>pref-dim "select changes" open-window
] [ drop [ ] "No changes!" alert f <model> ] recover ;
: <darcs-button> ( str -- button ) i" vocab:darcs-ui-demo/icons/_.tiff" <image-name> <frp-button> ;
: <patch-button> ( str -- model ) <darcs-button> -> [ drop patches-quot ] bind ;
: load-pref ( name file -- model ) "_darcs/prefs/" prepend dup exists?
[ utf8 [ readln ] with-file-reader <model> nip ]
[ '[ dup _ utf8 set-file-contents ] swap ask-user swap fmap ] if ;
: toolbar ( -- file-updates patch-updates )
"add" <darcs-button> -> [ drop open-dir-panel [ add-repo-file ] when* ] $>
"rem" <darcs-button> -> [ drop open-panel [ remove-repo-file ] when* ] $>
2array <merge> >behavior
"rec" <patch-button> dup [ drop "Patch Name:" ask-user ] bind dup
C[ drop "Your Name:" "author" load-pref ] bind C[ record ] 3$>-&
"push" <darcs-button> -> [ "Push To:" "defaultrepo" load-pref ] bind* C[ repo-push ] $> ,
"pull" <darcs-button> -> [ "Pull From:" "defaultrepo" load-pref ] bind* C[ pull ] $>
"send" <darcs-button> -> [ "Send To:" "defaultrepo" load-pref ] bind* C[ send ] $> ,
"app" <darcs-button> -> C[ open-dir-panel [ first app ] when* ] $> 3array <merge> >behavior ;
: darcs-window ( -- ) [
[
toolbar
<spacer>
{ "PATCHES:" "MATCHES:"
"FROM-TAG:" "FROM-PATCH:" "FROM-MATCH:"
"TO-TAG:" "TO-MATCH:" "TO-PATCH:"
} <combobox> -> [ but-last >lower ] fmap
<frp-field> { 100 10 } >>pref-dim ->% 1
] <hbox> +baseline+ >>align ,
[
C[ rot drop patches ] 3fmap-| <patch-viewer> ->% .5
[ C[ drop files "\n" split create-tree ] fmap <dir-table> <scroller> ->% .5
[ file? ] <filter> [ comment>> ] fmap
] dip
] <hbox> ,% .5
C[ cnts ] 2fmap-| "Select a patch and file to see its historical contents" <model>
swap <switch> <label-control> <scroller> ,% .5
] <vbox> "darcs" open-window ;
DEFER: open-file
: create-repo ( -- ) "The selected folder is not a darcs repo. Would you like to create one?" { "yes" "no" } ask-buttons
[ C[ drop [ init-repo darcs-window ] [ drop "Can't write to folder" alert* ] recover ] $> activate-model ]
[ [ drop open-file ] $> activate-model ] bi* ;
: open-file ( -- ) [ open-dir-panel
[ first [ "_darcs" exists? [ darcs-window ] [ create-repo ] if ] with-directory ] unless-empty
] with-ui ;
MAIN: open-file

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

View File

@ -0,0 +1 @@
Sam Anklesaria

View File

@ -0,0 +1 @@
Sam Anklesaria

View File

@ -0,0 +1 @@
Sam Anklesaria

View File

@ -5,5 +5,5 @@ ARTICLE: { "ui.frp.instances" "explanation" } "FRP Instances"
"Signals are all functors, as " { $link fmap } " corresponds directly to " { $link <mapped> } $nl
"Moduls also impliment monad functionalities. " { $link bind } "ing switches between two models. " $nl
"Also, a gadget is a monad. Binding recieves a model and adds the resulting gadget onto the parent. " $nl
"Examples of these instances can be seen in the " { $vocab-link "darcs-ui-demo" } " vocabulary." ;
"Examples of these instances can be seen in the " { $vocab-link "darcs-ui" } " vocabulary." ;
ABOUT: { "ui.frp.instances" "explanation" }

View File

@ -0,0 +1 @@
Sam Anklesaria

View File

@ -0,0 +1 @@
Sam Anklesaria