--- /dev/null
+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 ;
\ No newline at end of file
--- /dev/null
+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 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-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
\ No newline at end of file
--- /dev/null
+USING: help.syntax help.markup ;
+IN: ui.frp
+ARTICLE: { "ui.frp" "index" } "Functional Reactive Programming"
+"The " { $vocab-link "ui.frp" } " vocabulary is a take on functional reactive programming for user interfaces. The library is implimented as a set of models collectively called signals, and is made up of multiple submodles, all of which can be imported collectively from ui.frp" $nl
+{ $vocab-subsection "Using signals:" "ui.frp.signals" }
+{ $vocab-subsection "Creating user interfaces:" "ui.frp.layout" }
+{ $vocab-subsection "Using gadgets:" "ui.frp.gadgets" }
+{ $vocab-subsection "Combining signals:" "ui.frp.functors" }
+{ $vocab-subsection "Typeclass instances:" "ui.frp.instances" }
+"To get the hang of using the library, check out " { $vocab-link "darcs-ui-demo" } $nl
+"For more information about frp, go to http://haskell.org/haskellwiki/Functional_Reactive_Programming"
+;
+ABOUT: { "ui.frp" "index" }
\ No newline at end of file
--- /dev/null
+USING: help.markup help.syntax ui.frp.signals ;
+IN: ui.frp.functors
+
+ARTICLE: { "ui.frp.functors" "signal-collection" } "Signal Collection"
+"While " { $vocab-link "models.arrow.smart" } " use arrows and products to apply a quotation to the values of more than one signal, frp has more than one kind of arrow, as well as more than one kind of product" $nl
+"A simple pattern is used to generate the requisite 'smart mapping' functions: "
+"if 'word' maps a function on a model, then '2word; would map on two models. "
+"The product is specified on the end: '2word-product'. " { $link | } " updates when any of the model it collects updates, while " { $link & } " updates when all dependencies have new values. "
+"Examples of collection functions are 2fmap-| and 2$>-&" ;
+ABOUT: { "ui.frp.functors" "signal-collection" }
\ No newline at end of file
--- /dev/null
+USING: help.markup help.syntax ui.gadgets.buttons
+ui.gadgets.editors ui.frp.gadgets ;
+IN: ui.frp.gadgets
+
+HELP: <frp-button>
+{ $values { "gadget" "the button's label" } { "button" button } }
+{ $description "Creates an button whose signal updates on clicks. " } ;
+
+HELP: <frp-table>
+{ $values { "model" "values the table is to display" } { "table" frp-table } }
+{ $description "Creates an " { $link frp-table } } ;
+
+HELP: <frp-table*>
+{ $values { "table" frp-table } }
+{ $description "Creates an " { $link frp-table } " with no initial values to display" } ;
+
+HELP: <frp-list>
+{ $values { "column-model" "values the table is to display" } { "table" frp-table } }
+{ $description "Creates an " { $link frp-table } " with a val-quot that renders each element as its own row" } ;
+
+HELP: <frp-list*>
+{ $values { "table" frp-table } }
+{ $description "Creates an frp-list with no initial values to display" } ;
+
+HELP: indexed
+{ $values { "table" frp-table } }
+{ $description "Sets the output model of an frp-table to the selected-index, rather than the selected-value" } ;
+
+HELP: <frp-field>
+{ $values { "field" model-field } }
+{ $description "Creates a field with an empty initial value" } ;
\ No newline at end of file
--- /dev/null
+USING: help.markup help.syntax monads ui.frp.signals ;
+IN: ui.frp.instances
+IN: ui.frp.instances
+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." ;
+ABOUT: { "ui.frp.instances" "explanation" }
\ No newline at end of file
--- /dev/null
+USING: help.markup help.syntax models ui.gadgets.tracks ui.frp.layout ;
+IN: ui.frp.layout
+
+HELP: ,
+{ $values { "uiitem" "a gadget or model" } }
+{ $description "Used in a series of gadgets created by a box, accumulating the gadget" } ;
+
+HELP: ,%
+{ $syntax "gadget ,% width" }
+{ $description "Like ',' but stretches the gadget to always fill a percent of the parent" } ;
+
+HELP: ->
+{ $values { "uiitem" "a gadget or model" } { "model" model } }
+{ $description "Like ',' but passes its model on for further use." } ;
+
+HELP: ->%
+{ $syntax "gadget ,% width" }
+{ $description "Like '->' but stretches the gadget to always fill a percent of the parent" } ;
+
+HELP: <spacer>
+{ $description "Grows to fill any empty space in a box" } ;
+
+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" } ;
\ No newline at end of file
--- /dev/null
+USING: help.markup help.syntax models models.arrow sequences ui.frp.signals ;
+IN: ui.frp.signals
+
+HELP: <merge>
+{ $values { "models" "a list of models" } { "signal" basic-model } }
+{ $description "Creates a signal that merges the updates of others" } ;
+
+HELP: <filter>
+{ $values { "model" model } { "quot" "quotation with stack effect ( a b -- c )" } { "filter-signal" filter-model } }
+{ $description "Creates a signal that uses the updates of another model only when they satisfy a given predicate" } ;
+
+HELP: <fold>
+{ $values { "oldval" "starting value" } { "quot" "applied to update and previous values" } { "model" model } { "signal" 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 signal that starts with the behavior of signal1 and switches to the behavior of signal2 on its update" } ;
+
+HELP: <mapped>
+{ $values { "model" model } { "quot" "applied to model's value on updates" } { "signal" model } }
+{ $description "The signal version of an " { $link <arrow> } } ;
+
+HELP: $>
+{ $values { "model" model } { "quot" "applied to model's value on updates" } { "signal" model } }
+{ $description "Like " { $link <mapped> } ", but doesn't produce a new value" } ;
+
+HELP: <$
+{ $values { "model" model } { "quot" "applied to model's value on updates" } { "signal" model } }
+{ $description "Opposite of " { $link <$ } "- gives output, but takes no input" } ;
\ No newline at end of file
projects / factor.git / commitdiff