selective closures
Sam Anklesaria
parent
d0c5b43dc5
commit
bf3d2d3d97
|
|
@ -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 ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Subproject commit 54edac761ab48bee66f8db0210c27d52b72a94ef
|
||||
|
|
@ -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 ;
|
||||
|
|
@ -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.
|
|
@ -0,0 +1 @@
|
|||
Sam Anklesaria
|
||||
|
|
@ -0,0 +1 @@
|
|||
Sam Anklesaria
|
||||
|
|
@ -0,0 +1 @@
|
|||
Sam Anklesaria
|
||||
|
|
@ -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" }
|
||||
|
|
@ -0,0 +1 @@
|
|||
Sam Anklesaria
|
||||
|
|
@ -0,0 +1 @@
|
|||
Sam Anklesaria
|
||||
Loading…
Reference in New Issue