diff --git a/extra/darcs-ui-demo/commands/commands.factor b/extra/darcs-ui-demo/commands/commands.factor new file mode 100644 index 0000000000..a8148d3b6c --- /dev/null +++ b/extra/darcs-ui-demo/commands/commands.factor @@ -0,0 +1,34 @@ +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 diff --git a/extra/darcs-ui-demo/darcs-ui-demo.factor b/extra/darcs-ui-demo/darcs-ui-demo.factor new file mode 100644 index 0000000000..ccbda7b4b2 --- /dev/null +++ b/extra/darcs-ui-demo/darcs-ui-demo.factor @@ -0,0 +1,72 @@ +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 +: ( columns -- scroller ) + [ first ] >>val-quot + { "Patch" "Author" "Date" } >>column-titles + ; + +: ( {str} -- gadget ) t >>multiple-selection? indexed ; + +: answer ( length indices -- ) [ index [ "y" ] [ "n" ] if write ] curry each flush ; + +: patches-quot ( -- model-of-quot ) + [ whatsnew [ length ] keep + [ ->% 1 "okay" [ close-window ] >>hook + -> [ [ answer ] 2curry ] 2fmap-& + ] { 229 200 } >>pref-dim "select changes" open-window + ] [ drop [ ] "No changes!" alert f ] recover ; + +: ( str -- button ) i" vocab:darcs-ui-demo/icons/_.tiff" ; +: ( str -- model ) -> [ drop patches-quot ] bind ; + +: load-pref ( name file -- model ) "_darcs/prefs/" prepend dup exists? + [ utf8 [ readln ] with-file-reader nip ] + [ '[ dup _ utf8 set-file-contents ] swap ask-user swap fmap ] if ; + +: toolbar ( -- file-updates patch-updates ) + "add" -> [ drop open-dir-panel [ add-repo-file ] when* ] $> + "rem" -> [ drop open-panel [ remove-repo-file ] when* ] $> + 2array >behavior + "rec" dup [ drop "Patch Name:" ask-user ] bind dup + C[ drop "Your Name:" "author" load-pref ] bind C[ record ] 3$>-& + "push" -> [ "Push To:" "defaultrepo" load-pref ] bind* C[ repo-push ] $> , + "pull" -> [ "Pull From:" "defaultrepo" load-pref ] bind* C[ pull ] $> + "send" -> [ "Send To:" "defaultrepo" load-pref ] bind* C[ send ] $> , + "app" -> C[ open-dir-panel [ first app ] when* ] $> 3array >behavior ; + +: darcs-window ( -- ) [ + [ + toolbar + + { "PATCHES:" "MATCHES:" + "FROM-TAG:" "FROM-PATCH:" "FROM-MATCH:" + "TO-TAG:" "TO-MATCH:" "TO-PATCH:" + } -> [ but-last >lower ] fmap + { 100 10 } >>pref-dim ->% 1 + ] +baseline+ >>align , + [ + C[ rot drop patches ] 3fmap-| ->% .5 + [ C[ drop files "\n" split create-tree ] fmap ->% .5 + [ file? ] [ comment>> ] fmap + ] dip + ] ,% .5 + C[ cnts ] 2fmap-| "Select a patch and file to see its historical contents" + swap ,% .5 + ] "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 diff --git a/extra/darcs-ui-demo/icons/add.tiff b/extra/darcs-ui-demo/icons/add.tiff new file mode 100644 index 0000000000..c17d99617b Binary files /dev/null and b/extra/darcs-ui-demo/icons/add.tiff differ diff --git a/extra/darcs-ui-demo/icons/app.tiff b/extra/darcs-ui-demo/icons/app.tiff new file mode 100644 index 0000000000..e823240eac Binary files /dev/null and b/extra/darcs-ui-demo/icons/app.tiff differ diff --git a/extra/darcs-ui-demo/icons/pull.tiff b/extra/darcs-ui-demo/icons/pull.tiff new file mode 100644 index 0000000000..b89d6339f1 Binary files /dev/null and b/extra/darcs-ui-demo/icons/pull.tiff differ diff --git a/extra/darcs-ui-demo/icons/push.tiff b/extra/darcs-ui-demo/icons/push.tiff new file mode 100644 index 0000000000..56513ebb32 Binary files /dev/null and b/extra/darcs-ui-demo/icons/push.tiff differ diff --git a/extra/darcs-ui-demo/icons/rec.tiff b/extra/darcs-ui-demo/icons/rec.tiff new file mode 100644 index 0000000000..06dc4c9e21 Binary files /dev/null and b/extra/darcs-ui-demo/icons/rec.tiff differ diff --git a/extra/darcs-ui-demo/icons/rem.tiff b/extra/darcs-ui-demo/icons/rem.tiff new file mode 100644 index 0000000000..14d6a66efe Binary files /dev/null and b/extra/darcs-ui-demo/icons/rem.tiff differ diff --git a/extra/darcs-ui-demo/icons/send.tiff b/extra/darcs-ui-demo/icons/send.tiff new file mode 100644 index 0000000000..3d9b1f5e71 Binary files /dev/null and b/extra/darcs-ui-demo/icons/send.tiff differ diff --git a/extra/ui/frp/frp-docs.factor b/extra/ui/frp/frp-docs.factor new file mode 100644 index 0000000000..1e9c0b771f --- /dev/null +++ b/extra/ui/frp/frp-docs.factor @@ -0,0 +1,13 @@ +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 diff --git a/extra/ui/frp/functors/functors-docs.factor b/extra/ui/frp/functors/functors-docs.factor new file mode 100644 index 0000000000..256be95702 --- /dev/null +++ b/extra/ui/frp/functors/functors-docs.factor @@ -0,0 +1,10 @@ +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 diff --git a/extra/ui/frp/gadgets/gadgets-docs.factor b/extra/ui/frp/gadgets/gadgets-docs.factor new file mode 100644 index 0000000000..208e87f4a3 --- /dev/null +++ b/extra/ui/frp/gadgets/gadgets-docs.factor @@ -0,0 +1,31 @@ +USING: help.markup help.syntax ui.gadgets.buttons +ui.gadgets.editors ui.frp.gadgets ; +IN: ui.frp.gadgets + +HELP: +{ $values { "gadget" "the button's label" } { "button" button } } +{ $description "Creates an button whose signal updates on clicks. " } ; + +HELP: +{ $values { "model" "values the table is to display" } { "table" frp-table } } +{ $description "Creates an " { $link frp-table } } ; + +HELP: +{ $values { "table" frp-table } } +{ $description "Creates an " { $link frp-table } " with no initial values to display" } ; + +HELP: +{ $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: +{ $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: +{ $values { "field" model-field } } +{ $description "Creates a field with an empty initial value" } ; \ No newline at end of file diff --git a/extra/ui/frp/instances/instances-docs.factor b/extra/ui/frp/instances/instances-docs.factor new file mode 100644 index 0000000000..12d5fdbe21 --- /dev/null +++ b/extra/ui/frp/instances/instances-docs.factor @@ -0,0 +1,9 @@ +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 } $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 diff --git a/extra/ui/frp/layout/layout-docs.factor b/extra/ui/frp/layout/layout-docs.factor new file mode 100644 index 0000000000..3679572669 --- /dev/null +++ b/extra/ui/frp/layout/layout-docs.factor @@ -0,0 +1,30 @@ +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: +{ $description "Grows to fill any empty space in a box" } ; + +HELP: +{ $values { "gadgets" "a list of gadgets" } { "track" track } } +{ $syntax "[ gadget , gadget , ... ] " } +{ $description "Creates an horizontal track containing the gadgets listed in the quotation" } ; +HELP: +{ $values { "gadgets" "a list of gadgets" } { "track" track } } +{ $syntax "[ gadget , gadget , ... ] " } +{ $description "Creates an vertical track containing the gadgets listed in the quotation" } ; \ No newline at end of file diff --git a/extra/ui/frp/signals/signals-docs.factor b/extra/ui/frp/signals/signals-docs.factor new file mode 100644 index 0000000000..2cc455c7ff --- /dev/null +++ b/extra/ui/frp/signals/signals-docs.factor @@ -0,0 +1,30 @@ +USING: help.markup help.syntax models models.arrow sequences ui.frp.signals ; +IN: ui.frp.signals + +HELP: +{ $values { "models" "a list of models" } { "signal" basic-model } } +{ $description "Creates a signal that merges the updates of others" } ; + +HELP: +{ $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: +{ $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: +{ $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: +{ $values { "model" model } { "quot" "applied to model's value on updates" } { "signal" model } } +{ $description "The signal version of an " { $link } } ; + +HELP: $> +{ $values { "model" model } { "quot" "applied to model's value on updates" } { "signal" model } } +{ $description "Like " { $link } ", 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