From ef44191e86417b47d4e9b5773fcac6afe59c365a Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Fri, 25 Jul 2008 12:24:43 -0500 Subject: [PATCH 01/12] ui.gadgets.grids: Add 'grid-add' --- extra/ui/gadgets/grids/grids.factor | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/extra/ui/gadgets/grids/grids.factor b/extra/ui/gadgets/grids/grids.factor index fcc1f691e9..cd2433f3eb 100644 --- a/extra/ui/gadgets/grids/grids.factor +++ b/extra/ui/gadgets/grids/grids.factor @@ -25,6 +25,11 @@ grid >r >r 2dup swap add-gadget drop r> r> 3dup grid-child unparent rot grid>> nth set-nth ; +: grid-add ( grid child i j -- grid ) + >r >r dupd swap r> r> + >r >r 2dup swap add-gadget drop r> r> + 3dup grid-child unparent rot grid>> nth set-nth ; + : grid-remove ( grid i j -- grid ) -rot grid-add* ; : pref-dim-grid ( grid -- dims ) From de3b36fb6b11140773ee16e0e0a93246cc4e5597 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Fri, 25 Jul 2008 12:29:29 -0500 Subject: [PATCH 02/12] Convert calls to 'grid-add*' to 'grid-add' --- extra/ui/gadgets/frames/frames-docs.factor | 6 +++--- extra/ui/gadgets/labelled/labelled.factor | 8 ++++---- extra/ui/gadgets/scrollers/scrollers.factor | 6 +++--- extra/ui/gadgets/sliders/sliders.factor | 10 +++++----- 4 files changed, 15 insertions(+), 15 deletions(-) diff --git a/extra/ui/gadgets/frames/frames-docs.factor b/extra/ui/gadgets/frames/frames-docs.factor index 890836dcaa..36c7feed97 100755 --- a/extra/ui/gadgets/frames/frames-docs.factor +++ b/extra/ui/gadgets/frames/frames-docs.factor @@ -7,7 +7,7 @@ ARTICLE: "ui-frame-layout" "Frame layouts" { $subsection frame } "Creating empty frames:" { $subsection } -"A set of mnemonic words for the positions on a frame's 3x3 grid; these words push values which may be passed to " { $link grid-add* } ":" +"A set of mnemonic words for the positions on a frame's 3x3 grid; these words push values which may be passed to " { $link grid-add } ":" { $subsection @center } { $subsection @left } { $subsection @right } @@ -20,7 +20,7 @@ ARTICLE: "ui-frame-layout" "Frame layouts" : $ui-frame-constant ( element -- ) drop - { $description "Symbolic constant for a common input to " { $link grid-add* } "." } print-element ; + { $description "Symbolic constant for a common input to " { $link grid-add } "." } print-element ; HELP: @center $ui-frame-constant ; HELP: @left $ui-frame-constant ; @@ -35,7 +35,7 @@ HELP: @bottom-right $ui-frame-constant ; HELP: frame { $class-description "A frame is a gadget which lays out its children in a 3x3 grid. If the frame is enlarged past its preferred size, the center gadget fills up available room." $nl -"Frames are constructed by calling " { $link } " and since they inherit from " { $link grid } ", children can be managed with " { $link grid-add* } " and " { $link grid-remove } "." } ; +"Frames are constructed by calling " { $link } " and since they inherit from " { $link grid } ", children can be managed with " { $link grid-add } " and " { $link grid-remove } "." } ; HELP: { $values { "frame" frame } } diff --git a/extra/ui/gadgets/labelled/labelled.factor b/extra/ui/gadgets/labelled/labelled.factor index 831ac1b1d8..bd775a2d39 100755 --- a/extra/ui/gadgets/labelled/labelled.factor +++ b/extra/ui/gadgets/labelled/labelled.factor @@ -39,8 +39,8 @@ M: labelled-gadget focusable-child* labelled-gadget-content ; : ( title quot -- gadget ) - swap dup [ @left grid-add* ] [ drop ] if - swap @center grid-add* ; + swap dup [ @left grid-add ] [ drop ] if + swap @center grid-add ; TUPLE: closable-gadget < frame content ; @@ -49,8 +49,8 @@ TUPLE: closable-gadget < frame content ; : ( gadget title quot -- gadget ) closable-gadget new-frame - -rot @top grid-add* + -rot @top grid-add swap >>content - dup content>> @center grid-add* ; + dup content>> @center grid-add ; M: closable-gadget focusable-child* closable-gadget-content ; diff --git a/extra/ui/gadgets/scrollers/scrollers.factor b/extra/ui/gadgets/scrollers/scrollers.factor index f45f40c805..ed825824ef 100755 --- a/extra/ui/gadgets/scrollers/scrollers.factor +++ b/extra/ui/gadgets/scrollers/scrollers.factor @@ -38,11 +38,11 @@ scroller H{ >>model faint-boundary - dup model>> dependencies>> first >>x dup x>> @bottom grid-add* - dup model>> dependencies>> second >>y dup y>> @right grid-add* + dup model>> dependencies>> first >>x dup x>> @bottom grid-add + dup model>> dependencies>> second >>y dup y>> @right grid-add swap over model>> >>viewport - dup viewport>> @center grid-add* ; + dup viewport>> @center grid-add ; : ( gadget -- scroller ) scroller new-scroller ; diff --git a/extra/ui/gadgets/sliders/sliders.factor b/extra/ui/gadgets/sliders/sliders.factor index fba5f5df48..b67edeaea3 100755 --- a/extra/ui/gadgets/sliders/sliders.factor +++ b/extra/ui/gadgets/sliders/sliders.factor @@ -130,7 +130,7 @@ M: elevator layout* tuck >>elevator swap >>thumb dup elevator>> over thumb>> add-gadget - @center grid-add* ; + @center grid-add ; : ( -- button ) { 0 1 } arrow-left -1 ; : ( -- button ) { 0 1 } arrow-right 1 ; @@ -145,15 +145,15 @@ M: elevator layout* : ( range -- slider ) { 1 0 } - @left grid-add* + @left grid-add { 0 1 } elevator, - @right grid-add* ; + @right grid-add ; : ( range -- slider ) { 0 1 } - @top grid-add* + @top grid-add { 1 0 } elevator, - @bottom grid-add* ; + @bottom grid-add ; M: slider pref-dim* dup call-next-method From ddbab9cdd2354ce586b92738e45f3c84985528d9 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Fri, 25 Jul 2008 12:34:41 -0500 Subject: [PATCH 03/12] Update code in extra to use 'grid-add' --- extra/automata/ui/ui.factor | 4 ++-- extra/boids/ui/ui.factor | 4 ++-- extra/color-picker/color-picker.factor | 6 +++--- extra/irc/ui/ui.factor | 6 +++--- extra/ui/gadgets/tabs/tabs.factor | 8 ++++---- 5 files changed, 14 insertions(+), 14 deletions(-) diff --git a/extra/automata/ui/ui.factor b/extra/automata/ui/ui.factor index 8dd3c7ece5..cfb0462877 100644 --- a/extra/automata/ui/ui.factor +++ b/extra/automata/ui/ui.factor @@ -72,13 +72,13 @@ DEFER: automata-window "5 - Random Rule" [ random-rule ] view-button add-gadget "n - New" [ automata-window ] view-button add-gadget - @top grid-add* + @top grid-add C[ display ] { 400 400 } >>pdim dup >slate - @center grid-add* + @center grid-add diff --git a/extra/boids/ui/ui.factor b/extra/boids/ui/ui.factor index 6d57bb32ac..4639a0b58d 100755 --- a/extra/boids/ui/ui.factor +++ b/extra/boids/ui/ui.factor @@ -143,9 +143,9 @@ VARS: population-label cohesion-label alignment-label separation-label ; } [ call ] map [ add-gadget ] each 1 over set-pack-fill - @top grid-add* + @top grid-add - slate> @center grid-add* + slate> @center grid-add diff --git a/extra/color-picker/color-picker.factor b/extra/color-picker/color-picker.factor index 15c4e7c733..c3214f5bf2 100755 --- a/extra/color-picker/color-picker.factor +++ b/extra/color-picker/color-picker.factor @@ -37,11 +37,11 @@ M: color-preview model-changed swap dup - [ @top grid-add* ] - [ @center grid-add* ] + [ @top grid-add ] + [ @center grid-add ] [ [ [ truncate number>string ] map " " join ] - @bottom grid-add* + @bottom grid-add ] tri* ; diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor index a79920efe5..9b8d1a4d11 100755 --- a/extra/irc/ui/ui.factor +++ b/extra/irc/ui/ui.factor @@ -155,12 +155,12 @@ irc-editor "general" f { : ( listener client -- irc-tab ) irc-tab new-frame swap client>> >>client swap >>listener - [ @center grid-add* ] keep - @bottom grid-add* ; + [ @center grid-add ] keep + @bottom grid-add ; : ( listener client -- irc-tab ) - [ @right grid-add* ] dip >>listmodel + [ @right grid-add ] dip >>listmodel [ update-participants ] keep ; : ( listener client -- irc-tab ) diff --git a/extra/ui/gadgets/tabs/tabs.factor b/extra/ui/gadgets/tabs/tabs.factor index 5688bb5a2e..12031e5911 100755 --- a/extra/ui/gadgets/tabs/tabs.factor +++ b/extra/ui/gadgets/tabs/tabs.factor @@ -15,8 +15,8 @@ DEFER: (del-page) :: add-toggle ( model n name toggler -- ) n name toggler parent>> '[ , , , (del-page) ] "X" swap - @right grid-add* - n model name @center grid-add* + @right grid-add + n model name @center grid-add toggler swap add-gadget drop ; : redo-toggler ( tabbed -- ) @@ -52,10 +52,10 @@ DEFER: (del-page) tabbed new-frame 0 >>model 1 >>fill >>toggler - dup toggler>> @left grid-add* + dup toggler>> @left grid-add swap [ keys >vector >>names ] - [ values over model>> >>content dup content>> @center grid-add* ] + [ values over model>> >>content dup content>> @center grid-add ] bi dup redo-toggler ; From f4809d92d925e2bf146ce0284d12b3ea60f04b0e Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Fri, 25 Jul 2008 12:36:02 -0500 Subject: [PATCH 04/12] ui.gadgets.grids-docs: update help for 'grid-add' --- extra/ui/gadgets/grids/grids-docs.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/ui/gadgets/grids/grids-docs.factor b/extra/ui/gadgets/grids/grids-docs.factor index 31f85e4784..eb7affdb80 100755 --- a/extra/ui/gadgets/grids/grids-docs.factor +++ b/extra/ui/gadgets/grids/grids-docs.factor @@ -7,7 +7,7 @@ ARTICLE: "ui-grid-layout" "Grid layouts" "Creating grids from a fixed set of gadgets:" { $subsection } "Managing chidren:" -{ $subsection grid-add* } +{ $subsection grid-add } { $subsection grid-remove } { $subsection grid-child } ; @@ -18,7 +18,7 @@ $nl $nl "The " { $link grid-fill? } " slot stores a boolean, indicating if grid cells should assume their preferred size, or if they should fill the dimensions of the cell. The default is " { $link t } "." $nl -"Grids are created by calling " { $link } " and children are managed with " { $link grid-add* } " and " { $link grid-remove } "." +"Grids are created by calling " { $link } " and children are managed with " { $link grid-add } " and " { $link grid-remove } "." $nl "The " { $link add-gadget } ", " { $link unparent } " and " { $link clear-gadget } " words should not be used to manage child gadgets of grids." } ; @@ -31,7 +31,7 @@ HELP: grid-child { $description "Outputs the child gadget at the " { $snippet "i" } "," { $snippet "j" } "th position of the grid." } { $errors "Throws an error if the indices are out of bounds." } ; -HELP: grid-add* +HELP: grid-add { $values { "gadget" gadget } { "grid" grid } { "i" "non-negative integer" } { "j" "non-negative integer" } } { $description "Adds a child gadget at the specified location." } { $side-effects "grid" } ; From 8a90325f67da100de73e37b77d16615a69efbcca Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Fri, 25 Jul 2008 12:37:09 -0500 Subject: [PATCH 05/12] ui.gadgets.grids: Update 'grid-remove' --- extra/ui/gadgets/grids/grids.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/ui/gadgets/grids/grids.factor b/extra/ui/gadgets/grids/grids.factor index cd2433f3eb..5e4af7fcb3 100644 --- a/extra/ui/gadgets/grids/grids.factor +++ b/extra/ui/gadgets/grids/grids.factor @@ -30,7 +30,7 @@ grid >r >r 2dup swap add-gadget drop r> r> 3dup grid-child unparent rot grid>> nth set-nth ; -: grid-remove ( grid i j -- grid ) -rot grid-add* ; +: grid-remove ( grid i j -- grid ) -rot grid-add ; : pref-dim-grid ( grid -- dims ) grid>> [ [ pref-dim ] map ] map ; From 2291c2d18a479303e0ccd56c08c8db27ee09080a Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Fri, 25 Jul 2008 12:48:08 -0500 Subject: [PATCH 06/12] Remove 'grid-add*' --- extra/ui/gadgets/grids/grids.factor | 5 ----- 1 file changed, 5 deletions(-) diff --git a/extra/ui/gadgets/grids/grids.factor b/extra/ui/gadgets/grids/grids.factor index 5e4af7fcb3..eb2cdad801 100644 --- a/extra/ui/gadgets/grids/grids.factor +++ b/extra/ui/gadgets/grids/grids.factor @@ -20,11 +20,6 @@ grid : grid-child ( grid i j -- gadget ) rot grid>> nth nth ; -: grid-add* ( grid child i j -- grid ) - >r >r dupd swap r> r> - >r >r 2dup swap add-gadget drop r> r> - 3dup grid-child unparent rot grid>> nth set-nth ; - : grid-add ( grid child i j -- grid ) >r >r dupd swap r> r> >r >r 2dup swap add-gadget drop r> r> From cbf5fccb69f5a1eb60c3e1b04fad58ee5d6c99b1 Mon Sep 17 00:00:00 2001 From: Phil Dawes Date: Fri, 25 Jul 2008 22:02:07 +0100 Subject: [PATCH 07/12] Added write-csv word --- extra/csv/csv-docs.factor | 11 +++++++++-- extra/csv/csv-tests.factor | 10 +++++++++- extra/csv/csv.factor | 25 +++++++++++++++++++++++-- 3 files changed, 41 insertions(+), 5 deletions(-) diff --git a/extra/csv/csv-docs.factor b/extra/csv/csv-docs.factor index c9f39900ab..e4741f4810 100644 --- a/extra/csv/csv-docs.factor +++ b/extra/csv/csv-docs.factor @@ -2,20 +2,27 @@ USING: help.syntax help.markup kernel prettyprint sequences ; IN: csv HELP: csv -{ $values { "stream" "a stream" } +{ $values { "stream" "an input stream" } { "rows" "an array of arrays of fields" } } { $description "parses a csv stream into an array of row arrays" } ; HELP: csv-row -{ $values { "stream" "a stream" } +{ $values { "stream" "an input stream" } { "row" "an array of fields" } } { $description "parses a row from a csv stream" } ; +HELP: write-csv +{ $values { "rows" "an sequence of sequences of strings" } + { "stream" "an output stream" } } +{ $description "writes csv to the output stream, escaping where necessary" +} ; + HELP: with-delimiter { $values { "char" "field delimiter (e.g. CHAR: \t)" } { "quot" "a quotation" } } { $description "Sets the field delimiter for csv or csv-row words " } ; + diff --git a/extra/csv/csv-tests.factor b/extra/csv/csv-tests.factor index 7e96dbc0a6..8261ae104a 100644 --- a/extra/csv/csv-tests.factor +++ b/extra/csv/csv-tests.factor @@ -1,5 +1,5 @@ -USING: io.streams.string csv tools.test shuffle ; IN: csv.tests +USING: io.streams.string csv tools.test shuffle kernel strings ; ! I like to name my unit tests : named-unit-test ( name output input -- ) @@ -68,3 +68,11 @@ IN: csv.tests [ { { "foo" "bar" } { "1" "2" } } ] [ "foo,\"bar\"\n1,2" csv ] named-unit-test + +"can write csv too!" +[ "foo1,bar1\nfoo2,bar2\n" ] +[ { { "foo1" "bar1" } { "foo2" "bar2" } } tuck write-csv >string ] named-unit-test + +"escapes quotes commas and newlines when writing" +[ "\"fo\"\"o1\",bar1\n\"fo\no2\",\"b,ar2\"\n" ] +[ { { "fo\"o1" "bar1" } { "fo\no2" "b,ar2" } } tuck write-csv >string ] named-unit-test ! " diff --git a/extra/csv/csv.factor b/extra/csv/csv.factor index 8ba0832b29..3d1fb64492 100644 --- a/extra/csv/csv.factor +++ b/extra/csv/csv.factor @@ -10,7 +10,7 @@ IN: csv DEFER: quoted-field VAR: delimiter - + ! trims whitespace from either end of string : trim-whitespace ( str -- str ) [ blank? ] trim ; inline @@ -57,7 +57,7 @@ VAR: delimiter [ (csv) ] when ; : init-vars ( -- ) - delimiter> [ CHAR: , >delimiter ] unless ; inline + delimiter> [ CHAR: , >delimiter ] unless ; inline : csv-row ( stream -- row ) init-vars @@ -69,3 +69,24 @@ VAR: delimiter : with-delimiter ( char quot -- ) delimiter swap with-variable ; inline + + + +: needs-escaping? ( cell -- ? ) + [ "\n\"" delimiter> suffix member? ] contains? ; inline ! " + +: escape-quotes ( cell -- cell' ) + [ [ dup , CHAR: " = [ CHAR: " , ] when ] each ] "" make ; inline + +: enclose-in-quotes ( cell -- cell' ) + CHAR: " [ prefix ] [ suffix ] bi ; inline ! " + +: escape-if-required ( cell -- cell' ) + dup needs-escaping? [ escape-quotes enclose-in-quotes ] when ; inline + +: write-row ( row -- ) + [ delimiter> write1 ] [ escape-if-required write ] interleave nl ; inline + +: write-csv ( rows outstream -- ) + init-vars + [ [ write-row ] each ] with-output-stream ; From d2894204ea9e767dc6534a88fc7dba4ca6e9bd1f Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Fri, 25 Jul 2008 16:41:03 -0500 Subject: [PATCH 08/12] boids.ui: Clean up shelf code --- extra/boids/ui/ui.factor | 36 +++++++++++++++++++----------------- 1 file changed, 19 insertions(+), 17 deletions(-) diff --git a/extra/boids/ui/ui.factor b/extra/boids/ui/ui.factor index 4639a0b58d..3d0916d835 100755 --- a/extra/boids/ui/ui.factor +++ b/extra/boids/ui/ui.factor @@ -116,34 +116,36 @@ VARS: population-label cohesion-label alignment-label separation-label ; - { - [ "ESC - Pause" [ drop toggle-loop ] button* ] - - [ "1 - Randomize" [ drop randomize ] button* ] - - [ 1 over set-pack-fill + "ESC - Pause" [ drop toggle-loop ] button* add-gadget + + "1 - Randomize" [ drop randomize ] button* add-gadget + + 1 over set-pack-fill population-label> add-gadget "3 - Add 10" [ drop add-10-boids ] button* add-gadget - "2 - Sub 10" [ drop sub-10-boids ] button* add-gadget ] - - [ 1 over set-pack-fill + "2 - Sub 10" [ drop sub-10-boids ] button* add-gadget + add-gadget + + 1 over set-pack-fill cohesion-label> add-gadget "q - +0.1" [ drop inc-cohesion-weight ] button* add-gadget - "a - -0.1" [ drop dec-cohesion-weight ] button* add-gadget ] + "a - -0.1" [ drop dec-cohesion-weight ] button* add-gadget + add-gadget - [ 1 over set-pack-fill + 1 over set-pack-fill alignment-label> add-gadget "w - +0.1" [ drop inc-alignment-weight ] button* add-gadget - "s - -0.1" [ drop dec-alignment-weight ] button* add-gadget ] + "s - -0.1" [ drop dec-alignment-weight ] button* add-gadget + add-gadget - [ 1 over set-pack-fill + 1 over set-pack-fill separation-label> add-gadget "e - +0.1" [ drop inc-separation-weight ] button* add-gadget - "d - -0.1" [ drop dec-separation-weight ] button* add-gadget ] + "d - -0.1" [ drop dec-separation-weight ] button* add-gadget + add-gadget - } [ call ] map [ add-gadget ] each - 1 over set-pack-fill - @top grid-add + 1 over set-pack-fill + @top grid-add slate> @center grid-add From 8ad22154e5db31939f28fa6c6f80222fc72011c2 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Fri, 25 Jul 2008 16:55:10 -0500 Subject: [PATCH 09/12] boids.ui: Rearrange 'boids-window*' --- extra/boids/ui/ui.factor | 96 +++++++++++++++++++--------------------- 1 file changed, 45 insertions(+), 51 deletions(-) diff --git a/extra/boids/ui/ui.factor b/extra/boids/ui/ui.factor index 3d0916d835..064eda841b 100755 --- a/extra/boids/ui/ui.factor +++ b/extra/boids/ui/ui.factor @@ -100,74 +100,68 @@ VARS: population-label cohesion-label alignment-label separation-label ; : boids-window* ( -- ) init-variables init-world-size init-boids loop on - C[ display ] >slate - t slate> set-gadget-clipped? - { 600 400 } slate> set-slate-pdim - C[ [ run ] in-thread ] slate> set-slate-graft - C[ loop off ] slate> set-slate-ungraft - ""