From e222378ecc70340a62d9327b5a74fa349c501d6b Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Mon, 4 May 2009 18:38:29 -0500 Subject: [PATCH 001/125] reduce-r (foldr for sequences) --- core/sequences/sequences.factor | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index d60602fc71..d03e46bcef 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2005, 2009 Slava Pestov, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel kernel.private slots.private math +USING: accessors kernel kernel.private locals slots.private math math.private math.order ; IN: sequences @@ -916,3 +916,10 @@ PRIVATE> [ array-flip ] [ generic-flip ] if ] [ generic-flip ] if ] unless ; + +:: reduce-r + ( list identity quot: ( obj1 obj2 -- obj ) -- result ) + list empty? + [ identity ] + [ list rest identity quot reduce-r list first quot call ] if ; + inline recursive \ No newline at end of file From f67d9a76e7f678864192c96909a02421356bcc98 Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Mon, 4 May 2009 18:39:52 -0500 Subject: [PATCH 002/125] order of str-fry arguments corrected --- extra/str-fry/str-fry.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/str-fry/str-fry.factor b/extra/str-fry/str-fry.factor index bfe74f37eb..55dba1285d 100644 --- a/extra/str-fry/str-fry.factor +++ b/extra/str-fry/str-fry.factor @@ -2,6 +2,6 @@ USING: combinators effects kernel math sequences splitting strings.parser ; IN: str-fry : str-fry ( str -- quot ) "_" split - [ unclip [ [ rot glue ] reduce ] 2curry ] + [ unclip-last [ [ spin glue ] reduce-r ] 2curry ] ! not rot [ length 1 - 1 [ call-effect ] 2curry ] bi ; SYNTAX: I" parse-string rest str-fry over push-all ; \ No newline at end of file From ac55e263389423dcdf0b2bd40fd23577e036a723 Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Mon, 4 May 2009 18:40:57 -0500 Subject: [PATCH 003/125] io.launcher: run-desc drops end newline --- basis/io/launcher/launcher.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/io/launcher/launcher.factor b/basis/io/launcher/launcher.factor index 838c09c657..a8a70cb778 100755 --- a/basis/io/launcher/launcher.factor +++ b/basis/io/launcher/launcher.factor @@ -266,4 +266,4 @@ M: object run-pipeline-element [ ] } cond -: run-desc ( desc -- result ) ascii f swap stream-read-until drop ; +: run-desc ( desc -- result ) ascii f swap stream-read-until drop but-last ; \ No newline at end of file From 63ea29972ad2ebe6c2b701c3ead56de3e42b73e9 Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Mon, 4 May 2009 18:41:31 -0500 Subject: [PATCH 004/125] frp initialization fixes --- extra/ui/frp/frp.factor | 11 +++++++---- extra/ui/gadgets/comboboxes/comboboxes.factor | 4 ++-- 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/extra/ui/frp/frp.factor b/extra/ui/frp/frp.factor index 699d034c72..76f746de71 100644 --- a/extra/ui/frp/frp.factor +++ b/extra/ui/frp/frp.factor @@ -1,7 +1,7 @@ -USING: accessors arrays colors fonts kernel models +USING: accessors arrays colors fonts kernel math models models.product monads sequences ui.gadgets ui.gadgets.buttons ui.gadgets.editors ui.gadgets.line-support ui.gadgets.tables -ui.gadgets.tracks ui.render ui.gadgets.scrollers ; +ui.gadgets.tracks ui.render ui.gadgets.scrollers ui.baseline-alignment ; QUALIFIED: make IN: ui.frp @@ -23,7 +23,7 @@ M: frp-table row-color color-quot>> [ call( a -- b ) ] [ drop f ] if* ; : ( model -- table ) [ 1array ] >>quot ; : ( -- table ) f ; -: ( -- field ) f ; +: ( -- field ) "" ; ! Layout utilities @@ -42,8 +42,11 @@ M: gadget -> dup make:, output-model ; M: model -> dup , ; M: table -> dup , selected-value>> ; + +! : ( -- ) ,( 100% 100% ) ; +! Add a % object as a possibility for pref-dim : ( gadgets type -- track ) - [ { } make:make ] dip swap [ f track-add ] each ; inline + [ { } make:make ] dip +baseline+ >>align swap [ f track-add ] each ; inline : ( gadgets type -- track ) [ ] [ [ model>> ] map ] bi >>model ; inline : ( gadgets -- track ) horizontal ; inline : ( gadgets -- track ) horizontal ; inline diff --git a/extra/ui/gadgets/comboboxes/comboboxes.factor b/extra/ui/gadgets/comboboxes/comboboxes.factor index b0dbe34d16..a937b73d35 100644 --- a/extra/ui/gadgets/comboboxes/comboboxes.factor +++ b/extra/ui/gadgets/comboboxes/comboboxes.factor @@ -1,6 +1,6 @@ USING: accessors arrays kernel math.rectangles models sequences ui.frp ui.gadgets ui.gadgets.glass ui.gadgets.labels -ui.gadgets.tables ui.gestures ; +ui.gadgets.tables ui.gestures colors.constants fonts ; IN: ui.gadgets.comboboxes TUPLE: combo-table < table spawner ; @@ -19,4 +19,4 @@ combobox H{ : ( options -- combobox ) [ first [ combobox new-label ] keep >>model ] keep [ 1array ] map trivial-renderer combo-table new-table - >>table ; \ No newline at end of file + >>table dup font>> COLOR: gray >>background 12 >>size >>font ; \ No newline at end of file From 9f0237ef271d3bdf5a69dbd608821694da47ee75 Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Tue, 5 May 2009 17:23:41 -0500 Subject: [PATCH 005/125] io.launcher uses destructors --- basis/io/launcher/launcher.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/io/launcher/launcher.factor b/basis/io/launcher/launcher.factor index a8a70cb778..5813502a2b 100755 --- a/basis/io/launcher/launcher.factor +++ b/basis/io/launcher/launcher.factor @@ -5,7 +5,7 @@ assocs combinators vocabs.loader init threads continuations math accessors concurrency.flags destructors environment io io.encodings.ascii io.backend io.timeouts io.pipes io.pipes.private io.encodings io.streams.duplex io.ports -debugger prettyprint summary calendar ; +debugger prettyprint summary calendar io.pathnames ; IN: io.launcher TUPLE: process < identity-tuple @@ -266,4 +266,4 @@ M: object run-pipeline-element [ ] } cond -: run-desc ( desc -- result ) ascii f swap stream-read-until drop but-last ; \ No newline at end of file +: run-desc ( desc -- result ) ascii stream-contents but-last ; \ No newline at end of file From f6345c72cec64d7642bc5a705312c7055166c223 Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Tue, 5 May 2009 17:24:59 -0500 Subject: [PATCH 006/125] closures: using dynamic namespaces lexically --- extra/closures/closures.factor | 4 ++++ 1 file changed, 4 insertions(+) create mode 100644 extra/closures/closures.factor diff --git a/extra/closures/closures.factor b/extra/closures/closures.factor new file mode 100644 index 0000000000..94bd2664eb --- /dev/null +++ b/extra/closures/closures.factor @@ -0,0 +1,4 @@ +USING: fry namespaces kernel sequences parser ; +IN: closures +: delayed-bind ( quot -- quot' ) '[ namespace [ _ bind ] curry ] ; +SYNTAX: C[ parse-quotation delayed-bind over push-all ; From fc01d07839d8f6a9799d54ce133229f78936d38a Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Tue, 5 May 2009 20:11:34 -0500 Subject: [PATCH 007/125] multi-arrows: arrows with multiple inputs --- extra/models/arrow/multi/multi.factor | 11 +++++++++++ 1 file changed, 11 insertions(+) create mode 100644 extra/models/arrow/multi/multi.factor diff --git a/extra/models/arrow/multi/multi.factor b/extra/models/arrow/multi/multi.factor new file mode 100644 index 0000000000..29e7fc547e --- /dev/null +++ b/extra/models/arrow/multi/multi.factor @@ -0,0 +1,11 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: models.arrow models.product stack-checker accessors fry +generalizations kernel ; +IN: models.arrow.multi + +: ( quot int -- arrow ) + [ narray ] [ '[ _ firstn @ ] ] bi ; inline + +: <2arrow> ( a b quot -- arrow ) 2 ; +: <3arrow> ( a b c quot -- arrow ) 3 ; \ No newline at end of file From bdff947b1fbb02eadae1be4bd5d8d30c2579a8ee Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Tue, 5 May 2009 20:44:05 -0500 Subject: [PATCH 008/125] models.arrow.multi corrections- uses macro --- extra/models/arrow/multi/multi.factor | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/extra/models/arrow/multi/multi.factor b/extra/models/arrow/multi/multi.factor index 29e7fc547e..b651731155 100644 --- a/extra/models/arrow/multi/multi.factor +++ b/extra/models/arrow/multi/multi.factor @@ -1,11 +1,11 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: models.arrow models.product stack-checker accessors fry -generalizations kernel ; +USING: macros models.arrow models.product fry +generalizations kernel sequences ; IN: models.arrow.multi -: ( quot int -- arrow ) - [ narray ] [ '[ _ firstn @ ] ] bi ; inline +MACRO: ( int -- quot ) dup + '[ [ _ narray ] dip [ _ firstn ] prepend ] ; -: <2arrow> ( a b quot -- arrow ) 2 ; -: <3arrow> ( a b c quot -- arrow ) 3 ; \ No newline at end of file +: <2arrow> ( a b quot -- arrow ) 2 ; inline +: <3arrow> ( a b c quot -- arrow ) 3 ; inline \ No newline at end of file From 68c895f391f239c0e4700c787b8f979a44af40a3 Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Wed, 6 May 2009 21:33:49 -0500 Subject: [PATCH 009/125] io.launcher run-desc fixes --- basis/io/launcher/launcher.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/io/launcher/launcher.factor b/basis/io/launcher/launcher.factor index 5813502a2b..56919b510a 100755 --- a/basis/io/launcher/launcher.factor +++ b/basis/io/launcher/launcher.factor @@ -3,7 +3,7 @@ USING: system kernel namespaces strings hashtables sequences assocs combinators vocabs.loader init threads continuations math accessors concurrency.flags destructors environment -io io.encodings.ascii io.backend io.timeouts io.pipes +io io.encodings.utf8 io.backend io.timeouts io.pipes io.pipes.private io.encodings io.streams.duplex io.ports debugger prettyprint summary calendar io.pathnames ; IN: io.launcher @@ -266,4 +266,4 @@ M: object run-pipeline-element [ ] } cond -: run-desc ( desc -- result ) ascii stream-contents but-last ; \ No newline at end of file +: run-desc ( desc -- result ) utf8 stream-contents but-last ; \ No newline at end of file From d48748c2043bbe390dec62c1e150687322595a6e Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Wed, 6 May 2009 21:34:27 -0500 Subject: [PATCH 010/125] kept dynamic generation --- extra/closures/closures.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/closures/closures.factor b/extra/closures/closures.factor index 94bd2664eb..1411fa96c0 100644 --- a/extra/closures/closures.factor +++ b/extra/closures/closures.factor @@ -1,4 +1,4 @@ USING: fry namespaces kernel sequences parser ; IN: closures -: delayed-bind ( quot -- quot' ) '[ namespace [ _ bind ] curry ] ; +: delayed-bind ( quot -- quot' ) '[ namestack [ set-namestack @ ] curry ] ; SYNTAX: C[ parse-quotation delayed-bind over push-all ; From 23a7ff35afc4991802e30c0148c3f87a73e70bd7 Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Wed, 6 May 2009 21:35:42 -0500 Subject: [PATCH 011/125] frp: percent width track adding --- extra/ui/frp/frp.factor | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/extra/ui/frp/frp.factor b/extra/ui/frp/frp.factor index 76f746de71..ae3b34b39f 100644 --- a/extra/ui/frp/frp.factor +++ b/extra/ui/frp/frp.factor @@ -1,7 +1,8 @@ -USING: accessors arrays colors fonts kernel math models +USING: accessors arrays colors fonts fry kernel math models models.product monads sequences ui.gadgets ui.gadgets.buttons ui.gadgets.editors ui.gadgets.line-support ui.gadgets.tables -ui.gadgets.tracks ui.render ui.gadgets.scrollers ui.baseline-alignment ; +ui.gadgets.tracks ui.render ui.gadgets.scrollers ui.baseline-alignment +math.parser lexer ; QUALIFIED: make IN: ui.frp @@ -26,27 +27,29 @@ M: frp-table row-color color-quot>> [ call( a -- b ) ] [ drop f ] if* ; : ( -- field ) "" ; ! Layout utilities +TUPLE: layout gadget width ; C: layout GENERIC: output-model ( gadget -- model ) M: gadget output-model model>> ; M: frp-table output-model selected-value>> ; M: model-field output-model field-model>> ; -M: scroller output-model children>> first model>> ; +M: scroller output-model viewport>> children>> first model>> ; +M: table output-model selected-value>> ; GENERIC: , ( uiitem -- ) -M: gadget , make:, ; +M: gadget , f make:, ; M: model , activate-model ; -GENERIC: -> ( uiitem -- model ) -M: gadget -> dup make:, output-model ; -M: model -> dup , ; -M: table -> dup , selected-value>> ; +SYNTAX: ,% scan string>number [ make:, ] curry over push-all ; +SYNTAX: ->% scan string>number '[ [ _ make:, ] [ output-model ] bi ] over push-all ; +GENERIC: -> ( uiitem -- model ) +M: gadget -> dup , output-model ; +M: model -> dup , ; ! : ( -- ) ,( 100% 100% ) ; -! Add a % object as a possibility for pref-dim : ( gadgets type -- track ) - [ { } make:make ] dip +baseline+ >>align swap [ f track-add ] each ; inline + [ { } make:make ] dip +baseline+ >>align swap [ [ gadget>> ] [ width>> ] bi track-add ] each ; inline : ( gadgets type -- track ) [ ] [ [ model>> ] map ] bi >>model ; inline : ( gadgets -- track ) horizontal ; inline : ( gadgets -- track ) horizontal ; inline From d590e87e2688fe8901906c06f9efcba398fbc0f4 Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Wed, 6 May 2009 21:36:06 -0500 Subject: [PATCH 012/125] file-trees: backwords browsing, path in selection --- extra/file-trees/file-trees.factor | 34 +++++++++++++++++++++--------- 1 file changed, 24 insertions(+), 10 deletions(-) diff --git a/extra/file-trees/file-trees.factor b/extra/file-trees/file-trees.factor index eadfccdc4c..ccd2338061 100644 --- a/extra/file-trees/file-trees.factor +++ b/extra/file-trees/file-trees.factor @@ -1,17 +1,25 @@ USING: accessors arrays delegate delegate.protocols -io.pathnames kernel locals namespaces prettyprint sequences -ui.frp vectors ; +io.pathnames kernel locals models.arrow namespaces prettyprint sequences +ui.frp vectors tools.continuations make ; IN: file-trees -TUPLE: tree node children ; +TUPLE: walkable-vector vector father ; +CONSULT: sequence-protocol walkable-vector vector>> ; + +M: walkable-vector set-nth [ vector>> set-nth ] 3keep nip + father>> swap children>> vector>> push ; + +TUPLE: tree node comment children ; CONSULT: sequence-protocol tree children>> ; -: ( start -- tree ) V{ } clone - [ tree boa dup children>> ] [ ".." swap tree boa ] bi swap push ; +: ( {start,comment} -- tree ) first2 walkable-vector new vector new >>vector + [ tree boa dup children>> ] [ ".." -rot tree boa ] 2bi swap (>>father) ; + +! If this was added to all grandchildren DEFER: (tree-insert) -: tree-insert ( path tree -- ) [ unclip ] [ children>> ] bi* (tree-insert) ; +: tree-insert ( path tree -- ) [ unclip ] [ children>> ] bi* (tree-insert) ; :: (tree-insert) ( path-rest path-head tree-children -- ) tree-children [ node>> path-head node>> = ] find nip [ path-rest swap tree-insert ] @@ -19,10 +27,16 @@ DEFER: (tree-insert) path-head tree-children push path-rest [ path-head tree-insert ] unless-empty ] if* ; -: create-tree ( file-list -- tree ) [ path-components ] map - t [ [ tree-insert ] curry each ] keep ; + +! Use an accumulator for this +: add-paths ( pathseq -- {{name,path}} ) + "" [ [ "/" glue dup ] keep swap 2array , ] [ reduce drop ] f make ; + +: create-tree ( file-list -- tree ) [ path-components add-paths ] map + { "/" "/" } [ [ tree-insert ] curry each ] keep ; : ( tree-model -- table ) [ node>> 1array ] >>quot - [ selected-value>> ] - [ swap >>model ] bi ; \ No newline at end of file + [ selected-value>> [ dup [ first ] when ] ] + [ swap >>model ] bi + [ dup comment>> 2array ] >>val-quot ; \ No newline at end of file From 7c921cd073e012775cf985da10e95a362a0ba972 Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Wed, 6 May 2009 21:39:13 -0500 Subject: [PATCH 013/125] file-trees: removed debugging leftovers --- extra/file-trees/file-trees.factor | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/extra/file-trees/file-trees.factor b/extra/file-trees/file-trees.factor index ccd2338061..52b1de7f96 100644 --- a/extra/file-trees/file-trees.factor +++ b/extra/file-trees/file-trees.factor @@ -1,6 +1,6 @@ USING: accessors arrays delegate delegate.protocols io.pathnames kernel locals models.arrow namespaces prettyprint sequences -ui.frp vectors tools.continuations make ; +ui.frp vectors make ; IN: file-trees TUPLE: walkable-vector vector father ; @@ -15,8 +15,6 @@ CONSULT: sequence-protocol tree children>> ; : ( {start,comment} -- tree ) first2 walkable-vector new vector new >>vector [ tree boa dup children>> ] [ ".." -rot tree boa ] 2bi swap (>>father) ; -! If this was added to all grandchildren - DEFER: (tree-insert) : tree-insert ( path tree -- ) [ unclip ] [ children>> ] bi* (tree-insert) ; From 06f0b0b98f1b294d903ac315fb345a32aaf7593e Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Sat, 9 May 2009 08:01:39 -0500 Subject: [PATCH 014/125] run-desc uses default stream --- basis/io/launcher/launcher.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/io/launcher/launcher.factor b/basis/io/launcher/launcher.factor index 56919b510a..cf03565770 100755 --- a/basis/io/launcher/launcher.factor +++ b/basis/io/launcher/launcher.factor @@ -266,4 +266,4 @@ M: object run-pipeline-element [ ] } cond -: run-desc ( desc -- result ) utf8 stream-contents but-last ; \ No newline at end of file +: run-desc ( desc -- result ) utf8 [ contents [ but-last ] [ f ] if* ] with-process-reader ; \ No newline at end of file From 7eefdfa79bec067f9af2c02a0cbdae16536133a3 Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Sat, 9 May 2009 08:02:35 -0500 Subject: [PATCH 015/125] file-trees: file? restriction blocking selected --- extra/file-trees/file-trees.factor | 10 ++++---- extra/file-trees/file-trees.factor copy | 34 +++++++++++++++++++++++++ 2 files changed, 39 insertions(+), 5 deletions(-) create mode 100644 extra/file-trees/file-trees.factor copy diff --git a/extra/file-trees/file-trees.factor b/extra/file-trees/file-trees.factor index 52b1de7f96..90916baa56 100644 --- a/extra/file-trees/file-trees.factor +++ b/extra/file-trees/file-trees.factor @@ -1,5 +1,5 @@ USING: accessors arrays delegate delegate.protocols -io.pathnames kernel locals models.arrow namespaces prettyprint sequences +io.pathnames kernel locals sequences ui.frp vectors make ; IN: file-trees @@ -12,6 +12,8 @@ M: walkable-vector set-nth [ vector>> set-nth ] 3keep nip TUPLE: tree node comment children ; CONSULT: sequence-protocol tree children>> ; +: file? ( tree -- ? ) children>> [ node>> ".." = not ] filter empty? ; + : ( {start,comment} -- tree ) first2 walkable-vector new vector new >>vector [ tree boa dup children>> ] [ ".." -rot tree boa ] 2bi swap (>>father) ; @@ -26,7 +28,6 @@ DEFER: (tree-insert) path-rest [ path-head tree-insert ] unless-empty ] if* ; -! Use an accumulator for this : add-paths ( pathseq -- {{name,path}} ) "" [ [ "/" glue dup ] keep swap 2array , ] [ reduce drop ] f make ; @@ -35,6 +36,5 @@ DEFER: (tree-insert) : ( tree-model -- table ) [ node>> 1array ] >>quot - [ selected-value>> [ dup [ first ] when ] ] - [ swap >>model ] bi - [ dup comment>> 2array ] >>val-quot ; \ No newline at end of file + [ selected-value>> ] + [ swap >>model ] bi ; \ No newline at end of file diff --git a/extra/file-trees/file-trees.factor copy b/extra/file-trees/file-trees.factor copy new file mode 100644 index 0000000000..e3324d9834 --- /dev/null +++ b/extra/file-trees/file-trees.factor copy @@ -0,0 +1,34 @@ +USING: accessors arrays delegate delegate.protocols +io.pathnames kernel locals namespaces prettyprint sequences +ui.frp vectors ; +IN: file-trees + +! There should be optional extra information you can provide +TUPLE: tree node children ; +CONSULT: sequence-protocol tree children>> ; + +: ( start -- tree ) V{ } clone + [ tree boa dup children>> ] [ ".." swap tree boa ] bi swap push ; + +DEFER: (tree-insert) + +: tree-insert ( path tree -- ) [ unclip ] [ children>> ] bi* (tree-insert) ; +:: (tree-insert) ( path-rest path-head tree-children -- ) + tree-children [ node>> path-head node>> = ] find nip + [ path-rest swap tree-insert ] + [ + path-head tree-children push + path-rest [ path-head tree-insert ] unless-empty + ] if* ; + +: create-tree ( file-list -- tree ) [ path-components ] map + t [ [ tree-insert ] curry each ] keep ; + +: find-path ( tree -- string ) dup node>> tuck t = + [ 2drop f ] [ children>> first find-path "/" glue ] if ; + +: ( tree-model -- table ) + [ node>> 1array ] >>quot + [ selected-value>> ] + [ swap >>model ] bi + [ find-path ] >>val-quot ; \ No newline at end of file From 1906ea1a3b560078ff6904baef190814f7fef312 Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Sat, 9 May 2009 08:04:46 -0500 Subject: [PATCH 016/125] mapped models- arrow multi-model subclasses --- extra/models/arrow/multi/multi.factor | 11 ----------- extra/models/mapped/mapped.factor | 11 +++++++++++ 2 files changed, 11 insertions(+), 11 deletions(-) delete mode 100644 extra/models/arrow/multi/multi.factor create mode 100644 extra/models/mapped/mapped.factor diff --git a/extra/models/arrow/multi/multi.factor b/extra/models/arrow/multi/multi.factor deleted file mode 100644 index b651731155..0000000000 --- a/extra/models/arrow/multi/multi.factor +++ /dev/null @@ -1,11 +0,0 @@ -! Copyright (C) 2009 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: macros models.arrow models.product fry -generalizations kernel sequences ; -IN: models.arrow.multi - -MACRO: ( int -- quot ) dup - '[ [ _ narray ] dip [ _ firstn ] prepend ] ; - -: <2arrow> ( a b quot -- arrow ) 2 ; inline -: <3arrow> ( a b c quot -- arrow ) 3 ; inline \ No newline at end of file diff --git a/extra/models/mapped/mapped.factor b/extra/models/mapped/mapped.factor new file mode 100644 index 0000000000..9b8dd9ccf9 --- /dev/null +++ b/extra/models/mapped/mapped.factor @@ -0,0 +1,11 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: macros ui.frp models.product fry +generalizations kernel sequences ; +IN: models.mapped + +MACRO: ( int -- quot ) dup + '[ [ _ narray ] dip [ _ firstn ] prepend ] ; + +: <2mapped> ( a b quot -- arrow ) 2 ; inline +: <3mapped> ( a b c quot -- arrow ) 3 ; inline \ No newline at end of file From 3532a5f6c6d11de70085f351ed6dbff9c34aeccf Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Sat, 9 May 2009 08:05:43 -0500 Subject: [PATCH 017/125] ui.frp: scroller output-model fix --- extra/ui/frp/frp.factor | 99 ++++++++++++++++++++--------------------- 1 file changed, 49 insertions(+), 50 deletions(-) diff --git a/extra/ui/frp/frp.factor b/extra/ui/frp/frp.factor index ae3b34b39f..e682691a0d 100644 --- a/extra/ui/frp/frp.factor +++ b/extra/ui/frp/frp.factor @@ -6,9 +6,52 @@ math.parser lexer ; QUALIFIED: make IN: ui.frp +! !!! Model utilities +TUPLE: multi-model < model ; +GENERIC: (model-changed) ( model observer -- ) +: ( models kind -- model ) f swap new-model [ [ add-dependency ] curry each ] keep ; +M: multi-model model-changed over value>> [ (model-changed) ] [ 2drop ] if ; + +TUPLE: basic-model < multi-model ; +M: basic-model (model-changed) [ value>> ] dip set-model ; +: ( models -- model ) basic-model ; + +TUPLE: filter-model < multi-model quot ; +M: filter-model (model-changed) [ value>> ] dip 2dup quot>> call( a -- ? ) + [ set-model ] [ 2drop ] if ; +: ( model quot -- filter-model ) [ 1array filter-model ] dip >>quot ; + +TUPLE: fold-model < multi-model oldval quot ; +M: fold-model (model-changed) [ [ value>> ] [ [ oldval>> ] [ quot>> ] bi ] bi* + call( val oldval -- newval ) ] keep set-model ; +: ( oldval quot model -- model' ) 1array fold-model swap >>quot + swap [ >>oldval ] [ >>value ] bi ; + +TUPLE: switch-model < multi-model original switcher on ; +M: switch-model (model-changed) 2dup switcher>> = + [ [ value>> ] [ t >>on ] bi* set-model ] + [ dup on>> [ 2drop ] [ [ value>> ] dip set-model ] if ] if ; +: ( signal1 signal2 -- signal' ) [ 2array switch-model ] 2keep + [ >>original ] [ >>switcher ] bi* ; +M: switch-model model-activated [ original>> ] keep model-changed ; + + +TUPLE: mapped-model < multi-model model quot ; + +: ( model quot -- mapped ) + f mapped-model new-model + swap >>quot + over >>model + [ add-dependency ] keep ; +M: mapped-model (model-changed) + [ [ value>> ] [ quot>> ] bi* call( old -- new ) ] [ nip ] 2bi + set-model ; +M: mapped-model model-activated [ model>> ] keep model-changed ; + + ! Gadgets : ( text -- button ) [ t swap set-control-value ] f >>model ; -TUPLE: frp-table < table quot val-quot color-quot column-titles column-alignment ; +TUPLE: frp-table < table { quot initial: [ ] } { val-quot initial: [ ] } color-quot column-titles column-alignment ; M: frp-table column-titles column-titles>> ; M: frp-table column-alignment column-alignment>> ; M: frp-table row-columns quot>> [ call( a -- b ) ] [ drop f ] if* ; @@ -16,10 +59,10 @@ M: frp-table row-value val-quot>> [ call( a -- b ) ] [ drop f ] if* ; M: frp-table row-color color-quot>> [ call( a -- b ) ] [ drop f ] if* ; : ( model -- table ) - frp-table new-line-gadget dup >>renderer [ ] >>quot swap >>model - f >>selected-value sans-serif-font >>font + frp-table new-line-gadget dup >>renderer swap >>model + f basic-model new-model >>selected-value sans-serif-font >>font focus-border-color >>focus-border-color - transparent >>column-line-color [ ] >>val-quot ; + transparent >>column-line-color ; : ( -- table ) f ; : ( model -- table ) [ 1array ] >>quot ; : ( -- table ) f ; @@ -33,8 +76,7 @@ GENERIC: output-model ( gadget -- model ) M: gadget output-model model>> ; M: frp-table output-model selected-value>> ; M: model-field output-model field-model>> ; -M: scroller output-model viewport>> children>> first model>> ; -M: table output-model selected-value>> ; +M: scroller output-model viewport>> children>> first output-model ; GENERIC: , ( uiitem -- ) M: gadget , f make:, ; @@ -47,7 +89,7 @@ GENERIC: -> ( uiitem -- model ) M: gadget -> dup , output-model ; M: model -> dup , ; -! : ( -- ) ,( 100% 100% ) ; +: ( -- ) 1 make:, ; : ( gadgets type -- track ) [ { } make:make ] dip +baseline+ >>align swap [ [ gadget>> ] [ width>> ] bi track-add ] each ; inline : ( gadgets type -- track ) [ ] [ [ model>> ] map ] bi >>model ; inline @@ -56,49 +98,6 @@ M: model -> dup , ; : ( gadgets -- track ) vertical ; inline : ( gadgets -- track ) vertical ; inline -! !!! Model utilities -TUPLE: multi-model < model ; -: ( models kind -- model ) f swap new-model [ [ add-dependency ] curry each ] keep ; - -! Events- discrete model utilities - -TUPLE: merge-model < multi-model ; -M: merge-model model-changed [ value>> ] dip set-model ; -: ( models -- model ) merge-model ; - -TUPLE: filter-model < multi-model quot ; -M: filter-model model-changed [ value>> ] dip [ quot>> call( val -- bool ) ] 2keep - [ set-model ] [ 2drop ] if ; -: ( model quot -- filter-model ) [ 1array filter-model ] dip >>quot ; - -! Behaviors - continuous model utilities - -TUPLE: fold-model < multi-model oldval quot ; -M: fold-model model-changed [ [ value>> ] [ [ oldval>> ] [ quot>> ] bi ] bi* - call( val oldval -- newval ) ] keep set-model ; -: ( oldval quot model -- model' ) 1array fold-model swap >>quot - swap [ >>oldval ] [ >>value ] bi ; - -TUPLE: switch-model < multi-model original switcher on ; -M: switch-model model-changed 2dup switcher>> = - [ over value>> [ [ value>> ] [ t >>on ] bi* set-model ] [ 2drop ] if ] - [ dup on>> [ 2drop ] [ [ value>> ] dip set-model ] if ] if ; -M: switch-model model-activated [ original>> ] keep model-changed ; -: ( signal1 signal2 -- signal' ) [ 2array switch-model ] 2keep - [ >>original ] [ >>switcher ] bi* ; - -TUPLE: mapped < model model quot ; - -: ( model quot -- arrow ) - f mapped new-model - swap >>quot - over >>model - [ add-dependency ] keep ; - -M: mapped model-changed - [ [ value>> ] [ quot>> ] bi* call( old -- new ) ] [ nip ] 2bi - set-model ; - ! Instances M: model fmap ; From 2678c75ac2b9e916b38afe0a380cfe8d7cc8b81d Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Sat, 9 May 2009 14:08:20 -0500 Subject: [PATCH 018/125] removed merge-model from frp-docs --- extra/ui/frp/frp-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/ui/frp/frp-docs.factor b/extra/ui/frp/frp-docs.factor index 479a56e513..fb63d7f1b9 100644 --- a/extra/ui/frp/frp-docs.factor +++ b/extra/ui/frp/frp-docs.factor @@ -25,7 +25,7 @@ HELP: { $description "Creates an button whose model updates on clicks" } ; HELP: -{ $values { "models" "a list of models" } { "model" merge-model } } +{ $values { "models" "a list of models" } { "model" basic-model } } { $description "Creates a model that merges the updates of others" } ; HELP: From b3c84be9731029ca167816b47f884a2f1ac13544 Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Sat, 9 May 2009 14:23:08 -0500 Subject: [PATCH 019/125] ui.frp: no automatic baseline alignment --- extra/ui/frp/frp.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/ui/frp/frp.factor b/extra/ui/frp/frp.factor index e682691a0d..68ae2132be 100644 --- a/extra/ui/frp/frp.factor +++ b/extra/ui/frp/frp.factor @@ -1,7 +1,7 @@ USING: accessors arrays colors fonts fry kernel math models models.product monads sequences ui.gadgets ui.gadgets.buttons ui.gadgets.editors ui.gadgets.line-support ui.gadgets.tables -ui.gadgets.tracks ui.render ui.gadgets.scrollers ui.baseline-alignment +ui.gadgets.tracks ui.render ui.gadgets.scrollers math.parser lexer ; QUALIFIED: make IN: ui.frp @@ -91,7 +91,7 @@ M: model -> dup , ; : ( -- ) 1 make:, ; : ( gadgets type -- track ) - [ { } make:make ] dip +baseline+ >>align swap [ [ gadget>> ] [ width>> ] bi track-add ] each ; inline + [ { } make:make ] dip swap [ [ gadget>> ] [ width>> ] bi track-add ] each ; inline : ( gadgets type -- track ) [ ] [ [ model>> ] map ] bi >>model ; inline : ( gadgets -- track ) horizontal ; inline : ( gadgets -- track ) horizontal ; inline From c7242b8516f4b8a2047559bdf6ffe50adda7bb2c Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Sat, 9 May 2009 16:38:45 -0500 Subject: [PATCH 020/125] file-trees can't browse files --- extra/file-trees/file-trees.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/file-trees/file-trees.factor b/extra/file-trees/file-trees.factor index 90916baa56..77952c8425 100644 --- a/extra/file-trees/file-trees.factor +++ b/extra/file-trees/file-trees.factor @@ -36,5 +36,5 @@ DEFER: (tree-insert) : ( tree-model -- table ) [ node>> 1array ] >>quot - [ selected-value>> ] + [ selected-value>> [ file? not ] ] [ swap >>model ] bi ; \ No newline at end of file From 89efe27ab575e38ceddd538df7c2b7811dfbc352 Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Wed, 13 May 2009 16:10:04 -0500 Subject: [PATCH 021/125] multiple selection in table views --- basis/ui/gadgets/tables/tables-docs.factor | 10 +- basis/ui/gadgets/tables/tables.factor | 119 +++++++++++++-------- extra/ui/frp/frp.factor | 4 +- 3 files changed, 85 insertions(+), 48 deletions(-) diff --git a/basis/ui/gadgets/tables/tables-docs.factor b/basis/ui/gadgets/tables/tables-docs.factor index c064a80ee4..4f016caa8a 100644 --- a/basis/ui/gadgets/tables/tables-docs.factor +++ b/basis/ui/gadgets/tables/tables-docs.factor @@ -20,13 +20,15 @@ ARTICLE: "ui.gadgets.tables.selection" "Table row selection" $nl "A few slots in the table gadget concern row selection:" { $table - { { $slot "selected-value" } { " - if set to a model, the currently selected row's value, as determined by a " { $link row-value } " call to the renderer, is stored in this model. See " { $link "models" } "." } } - { { $slot "selected-index" } " - the index of the currently selected row." } + { { $slot "selected-values" } { " - if set to a model, an array of the currently selected rows' values, as determined by a " { $link row-value } " call to the renderer, is stored in this model. See " { $link "models" } "." } } + { { $slot "selected-indices" } " - the indices of the currently selected rows." } { { $slot "selection-required?" } { " - if set to a true value, the table ensures that some row is always selected, if the model is non-empty. If set to " { $link f } ", a state where nothing is selected is permitted to occur. The default is " { $link f } "." } } + { { $slot "multiple-selection?" } { " - if set to a true value, users are allowed to select more than one value." } } + } "Some words for row selection:" -{ $subsection selected-row } -{ $subsection (selected-row) } ; +{ $subsection selected-rows } +{ $subsection (selected-rows) } ; ARTICLE: "ui.gadgets.tables.actions" "Table row actions" "When the user double-clicks on a row, or presses " { $command table "row" row-action } " while a row is selected, optional action and hook quotations are invoked. The action receives the row value and the hook receives the table gadget itself. These quotations are stored in the " { $slot "action" } " and " { $snippet "hook" } " slots of a table, respectively." diff --git a/basis/ui/gadgets/tables/tables.factor b/basis/ui/gadgets/tables/tables.factor index ba3b5a2f78..80f2ca400f 100644 --- a/basis/ui/gadgets/tables/tables.factor +++ b/basis/ui/gadgets/tables/tables.factor @@ -1,12 +1,12 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays colors colors.constants fry kernel math -math.functions math.rectangles math.order math.vectors namespaces -opengl sequences ui.gadgets ui.gadgets.scrollers ui.gadgets.status-bar -ui.gadgets.worlds ui.gestures ui.render ui.pens.solid ui.text -ui.commands ui.images ui.gadgets.menus ui.gadgets.line-support +math.functions math.ranges math.rectangles math.order math.vectors models.arrow +namespaces opengl sequences ui.gadgets ui.gadgets.scrollers +ui.gadgets.status-bar ui.gadgets.worlds ui.gestures ui.render ui.pens.solid +ui.text ui.commands ui.images ui.gadgets.menus ui.gadgets.line-support math.rectangles models math.ranges sequences combinators -combinators.short-circuit fonts locals strings ; +combinators.short-circuit fonts locals strings vectors ; IN: ui.gadgets.tables ! Row rendererer protocol @@ -41,16 +41,33 @@ focus-border-color { mouse-color initial: COLOR: black } column-line-color selection-required? -selected-index selected-value +selected-indices selected-values mouse-index { takes-focus? initial: t } -focused? ; +focused? +multiple-selection? ; + +IN: accessors +GENERIC: selected-value>> ( table -- n ) +GENERIC: selected-index>> ( table -- n ) +GENERIC: (>>selected-index) ( n table -- ) +GENERIC: (>>selected-value) ( val table -- ) +: >>selected-index ( table n -- table ) over (>>selected-index) ; +: >>selected-value ( table val -- table ) over (>>selected-value) ; + +M: table selected-value>> selected-values>> [ [ peek ] [ f ] if* ] ; +M: table (>>selected-value) [ [ 1vector ] ] dip (>>selected-values) ; +M: table selected-index>> selected-indices>> [ peek ] [ f ] if* ; +M: table (>>selected-index) [ 1vector ] dip (>>selected-indices) ; + +IN: ui.gadgets.tables +: push-selected-index ( table n -- table ) over selected-indices>> push ; : new-table ( rows renderer class -- table ) new-line-gadget swap >>renderer swap >>model - f >>selected-value + f >>selected-values sans-serif-font >>font focus-border-color >>focus-border-color transparent >>column-line-color ; inline @@ -131,12 +148,12 @@ M: table layout* : row-bounds ( table row -- loc dim ) row-rect rect-bounds ; inline -: draw-selected-row ( table -- ) +: draw-selected-rows ( table -- ) { - { [ dup selected-index>> not ] [ drop ] } + { [ dup selected-indices>> not ] [ drop ] } [ - [ ] [ selected-index>> ] [ selection-color>> gl-color ] tri - row-bounds gl-fill-rect + [ selected-indices>> ] [ selection-color>> gl-color ] [ ] tri + [ swap row-bounds gl-fill-rect ] curry each ] } cond ; @@ -189,10 +206,10 @@ M: table layout* dup renderer>> column-alignment [ ] [ column-widths>> length 0 ] ?if ; -:: row-font ( row index table -- font ) +:: row-font ( row ind table -- font ) table font>> clone row table renderer>> row-color [ >>foreground ] when* - index table selected-index>> = [ table selection-color>> >>background ] when ; + ind table selected-indices>> index [ table selection-color>> >>background ] when ; : draw-columns ( columns widths alignment font gap -- ) '[ [ _ ] 3dip _ draw-column ] 3each ; @@ -213,7 +230,7 @@ M: table draw-gadget* dup control-value empty? [ drop ] [ dup line-height \ line-height [ { - [ draw-selected-row ] + [ draw-selected-rows ] [ draw-lines ] [ draw-column-lines ] [ draw-focused-row ] @@ -236,17 +253,19 @@ M: table pref-dim* PRIVATE> -: (selected-row) ( table -- value/f ? ) - [ selected-index>> ] keep nth-row ; +: (selected-rows) ( table -- {row} ) + [ selected-indices>> ] keep + [ nth-row [ 1array ] [ drop { } ] if ] curry map concat ; -: selected-row ( table -- value/f ? ) - [ (selected-row) ] keep - swap [ renderer>> row-value t ] [ 2drop f f ] if ; +: selected-rows ( table -- {value} ) + [ (selected-rows) ] [ renderer>> ] bi [ row-value ] curry map ; + +: selected-row ( table -- value ? ) selected-rows [ f f ] [ peek t ] if-empty ; > ] bi set-model ; +: update-selected-values ( table -- ) + [ selected-rows ] [ selected-values>> ] bi set-model ; : show-row-summary ( table n -- ) over nth-row @@ -260,54 +279,68 @@ PRIVATE> : find-row-index ( value table -- n/f ) [ model>> value>> ] [ renderer>> '[ _ row-value ] map index ] bi ; -: initial-selected-index ( table -- n/f ) +: initial-selected-indices ( table -- n/f ) { [ model>> value>> empty? not ] [ selection-required?>> ] - [ drop 0 ] + [ drop V{ 0 } ] } 1&& ; -: (update-selected-index) ( table -- n/f ) - [ selected-value>> value>> ] keep over - [ find-row-index ] [ 2drop f ] if ; +: (update-selected-indices) ( table -- {n}/f ) + [ selected-values>> value>> ] keep + [ find-row-index ] curry map [ ] filter [ f ] when-empty ; -: update-selected-index ( table -- n/f ) +: update-selected-indices ( table -- {n}/f ) { - [ (update-selected-index) ] - [ initial-selected-index ] + [ (update-selected-indices) ] + [ initial-selected-indices ] } 1|| ; M: table model-changed - nip dup update-selected-index { - [ >>selected-index f >>mouse-index drop ] - [ show-row-summary ] - [ drop update-selected-value ] + nip dup update-selected-indices { + [ >>selected-indices f >>mouse-index drop ] + [ peek show-row-summary ] + [ drop update-selected-values ] [ drop relayout ] } 2cleave ; : thin-row-rect ( table row -- rect ) row-rect [ { 0 1 } v* ] change-dim ; +: scroll-to-row ( table n -- ) + dup [ [ thin-row-rect ] [ drop ] 2bi scroll>rect ] [ 2drop ] if ; + +: add-selected-row ( table n -- ) + [ scroll-to-row ] + [ push-selected-index relayout-1 ] 2bi ; + : (select-row) ( table n -- ) - [ dup [ [ thin-row-rect ] [ drop ] 2bi scroll>rect ] [ 2drop ] if ] + [ scroll-to-row ] [ >>selected-index relayout-1 ] 2bi ; : mouse-row ( table -- n ) [ hand-rel second ] keep y>line ; -: if-mouse-row ( table true: ( table mouse-index -- ) false: ( table -- ) -- ) +: if-mouse-row ( table true: ( mouse-index table -- ) false: ( table -- ) -- ) [ [ mouse-row ] keep 2dup valid-line? ] [ ] [ '[ nip @ ] ] tri* if ; inline -: table-button-down ( table -- ) - dup takes-focus?>> [ dup request-focus ] when - [ swap [ >>mouse-index ] [ (select-row) ] bi ] [ drop ] if-mouse-row ; +: (table-button-down) ( quot table -- ) + dup takes-focus?>> [ dup request-focus ] when swap + '[ swap [ >>mouse-index ] _ bi ] [ drop ] if-mouse-row ; inline + +: table-button-down ( table -- ) [ (select-row) ] swap (table-button-down) ; +: continued-button-down ( table -- ) dup multiple-selection?>> [ [ add-selected-row ] swap (table-button-down) ] [ table-button-down ] if ; +: thru-button-down ( table -- ) dup multiple-selection?>> [ + [ over selected-index>> (a,b] over + [ swap push-selected-index drop ] curry each continued-button-down ] + swap (table-button-down) ] [ table-button-down ] if ; PRIVATE> : row-action ( table -- ) - dup selected-row + dup [ selected-rows peek ] [ swap [ action>> call( value -- ) ] [ dup hook>> call( table -- ) ] bi ] [ 2drop ] if ; @@ -319,14 +352,14 @@ PRIVATE> : select-row ( table n -- ) over validate-line [ (select-row) ] - [ drop update-selected-value ] + [ drop update-selected-values ] [ show-row-summary ] 2tri ; @@ -385,6 +418,8 @@ table "sundry" f { { mouse-enter show-mouse-help } { mouse-leave hide-mouse-help } { motion show-mouse-help } + { T{ button-down f { A+ } 1 } continued-button-down } + { T{ button-down f { S+ } 1 } thru-button-down } { T{ button-down } table-button-down } { T{ button-up } table-button-up } { gain-focus focus-table } diff --git a/extra/ui/frp/frp.factor b/extra/ui/frp/frp.factor index 68ae2132be..82cf549ef7 100644 --- a/extra/ui/frp/frp.factor +++ b/extra/ui/frp/frp.factor @@ -60,7 +60,7 @@ M: frp-table row-color color-quot>> [ call( a -- b ) ] [ drop f ] if* ; : ( model -- table ) frp-table new-line-gadget dup >>renderer swap >>model - f basic-model new-model >>selected-value sans-serif-font >>font + f basic-model new-model >>selected-values sans-serif-font >>font focus-border-color >>focus-border-color transparent >>column-line-color ; : ( -- table ) f ; @@ -74,7 +74,7 @@ TUPLE: layout gadget width ; C: layout GENERIC: output-model ( gadget -- model ) M: gadget output-model model>> ; -M: frp-table output-model selected-value>> ; +M: table output-model dup multiple-selection?>> [ selected-values>> ] [ selected-value>> ] if ; M: model-field output-model field-model>> ; M: scroller output-model viewport>> children>> first output-model ; From 1a8fcee71213f18ad0cfe350c079dee0da0f32bb Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Wed, 13 May 2009 17:17:10 -0500 Subject: [PATCH 022/125] table views: selected value is always a vector --- basis/ui/gadgets/tables/tables.factor | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/basis/ui/gadgets/tables/tables.factor b/basis/ui/gadgets/tables/tables.factor index 80f2ca400f..50ddbb3184 100644 --- a/basis/ui/gadgets/tables/tables.factor +++ b/basis/ui/gadgets/tables/tables.factor @@ -55,9 +55,9 @@ GENERIC: (>>selected-value) ( val table -- ) : >>selected-index ( table n -- table ) over (>>selected-index) ; : >>selected-value ( table val -- table ) over (>>selected-value) ; -M: table selected-value>> selected-values>> [ [ peek ] [ f ] if* ] ; +M: table selected-value>> selected-values>> [ [ f ] [ peek ] if-empty ] ; M: table (>>selected-value) [ [ 1vector ] ] dip (>>selected-values) ; -M: table selected-index>> selected-indices>> [ peek ] [ f ] if* ; +M: table selected-index>> selected-indices>> [ f ] [ peek ] if-empty ; M: table (>>selected-index) [ 1vector ] dip (>>selected-indices) ; IN: ui.gadgets.tables @@ -67,7 +67,7 @@ IN: ui.gadgets.tables new-line-gadget swap >>renderer swap >>model - f >>selected-values + V{ } clone >>selected-values sans-serif-font >>font focus-border-color >>focus-border-color transparent >>column-line-color ; inline @@ -150,7 +150,7 @@ M: table layout* : draw-selected-rows ( table -- ) { - { [ dup selected-indices>> not ] [ drop ] } + { [ dup selected-indices>> empty? ] [ drop ] } [ [ selected-indices>> ] [ selection-color>> gl-color ] [ ] tri [ swap row-bounds gl-fill-rect ] curry each @@ -279,11 +279,11 @@ PRIVATE> : find-row-index ( value table -- n/f ) [ model>> value>> ] [ renderer>> '[ _ row-value ] map index ] bi ; -: initial-selected-indices ( table -- n/f ) +: initial-selected-indices ( table -- {n}/f ) { [ model>> value>> empty? not ] [ selection-required?>> ] - [ drop V{ 0 } ] + [ drop V{ 0 } clone ] } 1&& ; : (update-selected-indices) ( table -- {n}/f ) @@ -297,9 +297,9 @@ PRIVATE> } 1|| ; M: table model-changed - nip dup update-selected-indices { + nip dup update-selected-indices [ V{ } clone ] unless* { [ >>selected-indices f >>mouse-index drop ] - [ peek show-row-summary ] + [ [ f ] [ peek ] if-empty show-row-summary ] [ drop update-selected-values ] [ drop relayout ] } 2cleave ; From 20d9b1fde34b1f9caaad096da2935f10382b7a07 Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Wed, 13 May 2009 22:15:33 -0500 Subject: [PATCH 023/125] table gadget row-action bug fixed --- basis/ui/gadgets/tables/tables.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/ui/gadgets/tables/tables.factor b/basis/ui/gadgets/tables/tables.factor index 831a643377..bba970fb76 100644 --- a/basis/ui/gadgets/tables/tables.factor +++ b/basis/ui/gadgets/tables/tables.factor @@ -56,7 +56,7 @@ GENERIC: (>>selected-value) ( val table -- ) : >>selected-value ( table val -- table ) over (>>selected-value) ; M: table selected-value>> selected-values>> [ [ f ] [ peek ] if-empty ] ; -M: table (>>selected-value) [ [ 1vector ] change-model ] dip (>>selected-values) ; +M: table (>>selected-value) [ [ 1vector ] ] dip (>>selected-values) ; M: table selected-index>> selected-indices>> [ f ] [ peek ] if-empty ; M: table (>>selected-index) [ 1vector ] dip (>>selected-indices) ; @@ -342,7 +342,7 @@ M: table model-changed PRIVATE> : row-action ( table -- ) - dup [ selected-rows peek ] + dup selected-row [ swap [ action>> call( value -- ) ] [ dup hook>> call( table -- ) ] bi ] [ 2drop ] if ; From 44ddc7238bcc306935589efb8a3f048a6f3f936a Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Thu, 14 May 2009 10:01:37 -0500 Subject: [PATCH 024/125] multiple selection of same row fixed --- basis/ui/gadgets/tables/tables.factor | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/basis/ui/gadgets/tables/tables.factor b/basis/ui/gadgets/tables/tables.factor index bba970fb76..68fdf43de8 100644 --- a/basis/ui/gadgets/tables/tables.factor +++ b/basis/ui/gadgets/tables/tables.factor @@ -6,7 +6,7 @@ namespaces opengl sequences ui.gadgets ui.gadgets.scrollers ui.gadgets.status-bar ui.gadgets.worlds ui.gestures ui.render ui.pens.solid ui.text ui.commands ui.images ui.gadgets.menus ui.gadgets.line-support math.rectangles models math.ranges sequences combinators -combinators.short-circuit fonts locals strings vectors ; +combinators.short-circuit fonts locals strings vectors tools.annotations ; IN: ui.gadgets.tables ! Row rendererer protocol @@ -61,7 +61,7 @@ M: table selected-index>> selected-indices>> [ f ] [ peek ] if-empty ; M: table (>>selected-index) [ 1vector ] dip (>>selected-indices) ; IN: ui.gadgets.tables -: push-selected-index ( table n -- table ) over selected-indices>> push ; +: push-selected-index ( table n -- table ) 2dup swap selected-indices>> index [ drop ] [ over selected-indices>> push ] if ; : new-table ( rows renderer class -- table ) new-line-gadget @@ -335,8 +335,8 @@ M: table model-changed : table-button-down ( table -- ) [ (select-row) ] swap (table-button-down) ; : continued-button-down ( table -- ) dup multiple-selection?>> [ [ add-selected-row ] swap (table-button-down) ] [ table-button-down ] if ; : thru-button-down ( table -- ) dup multiple-selection?>> [ - [ over selected-index>> (a,b] over - [ swap push-selected-index drop ] curry each continued-button-down ] + [ 2dup over selected-index>> (a,b) swap + [ swap push-selected-index drop ] curry each add-selected-row ] swap (table-button-down) ] [ table-button-down ] if ; PRIVATE> @@ -420,10 +420,10 @@ table "sundry" f { { mouse-enter show-mouse-help } { mouse-leave hide-mouse-help } { motion show-mouse-help } + { T{ button-down f { C+ } 1 } thru-button-down } { T{ button-down f { A+ } 1 } continued-button-down } - { T{ button-down f { S+ } 1 } thru-button-down } - { T{ button-down } table-button-down } { T{ button-up } table-button-up } + { T{ button-down } table-button-down } { gain-focus focus-table } { lose-focus unfocus-table } { T{ drag } table-button-down } From 33148a8964ceed0c6ab5c56346d49245348bf5a4 Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Thu, 14 May 2009 12:38:43 -0500 Subject: [PATCH 025/125] tables shift-click hack for mac --- basis/ui/gadgets/tables/tables.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/basis/ui/gadgets/tables/tables.factor b/basis/ui/gadgets/tables/tables.factor index 68fdf43de8..a2e5f4b6a9 100644 --- a/basis/ui/gadgets/tables/tables.factor +++ b/basis/ui/gadgets/tables/tables.factor @@ -420,9 +420,10 @@ table "sundry" f { { mouse-enter show-mouse-help } { mouse-leave hide-mouse-help } { motion show-mouse-help } - { T{ button-down f { C+ } 1 } thru-button-down } + { T{ button-down f { S+ } 1 } thru-button-down } { T{ button-down f { A+ } 1 } continued-button-down } { T{ button-up } table-button-up } + { T{ button-up f { S+ } } table-button-up } { T{ button-down } table-button-down } { gain-focus focus-table } { lose-focus unfocus-table } From 38e8565555f864c199ba756a23bd64079048cde8 Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Fri, 15 May 2009 16:58:17 -0500 Subject: [PATCH 026/125] illusion models: two way arrows --- basis/inverse/vectors/authors.txt | 1 + basis/inverse/vectors/summary.txt | 1 + basis/inverse/vectors/vectors.factor | 17 +++++++++++++++++ basis/models/illusion/illusion.factor | 16 ++++++++++++++++ basis/models/illusion/summary.txt | 1 + basis/ui/gadgets/tables/tables.factor | 10 +++++----- 6 files changed, 41 insertions(+), 5 deletions(-) create mode 100644 basis/inverse/vectors/authors.txt create mode 100755 basis/inverse/vectors/summary.txt create mode 100644 basis/inverse/vectors/vectors.factor create mode 100644 basis/models/illusion/illusion.factor create mode 100644 basis/models/illusion/summary.txt diff --git a/basis/inverse/vectors/authors.txt b/basis/inverse/vectors/authors.txt new file mode 100644 index 0000000000..f990dd0ed2 --- /dev/null +++ b/basis/inverse/vectors/authors.txt @@ -0,0 +1 @@ +Daniel Ehrenberg diff --git a/basis/inverse/vectors/summary.txt b/basis/inverse/vectors/summary.txt new file mode 100755 index 0000000000..cb3c22991d --- /dev/null +++ b/basis/inverse/vectors/summary.txt @@ -0,0 +1 @@ +Inverses of Common Words on Vectors diff --git a/basis/inverse/vectors/vectors.factor b/basis/inverse/vectors/vectors.factor new file mode 100644 index 0000000000..1631052157 --- /dev/null +++ b/basis/inverse/vectors/vectors.factor @@ -0,0 +1,17 @@ +USING: generalizations inverse kernel locals sequences vectors ; +IN: inverse.vectors +: assure-vector ( vector -- vector ) + dup vector? assure ; inline + +: undo-nvector ( array n -- ... ) + [ assure-vector ] dip + [ assure-length ] [ firstn ] 2bi ; inline + +\ 1vector [ 1 undo-nvector ] define-inverse + +\ peek [ 1vector ] define-inverse + +:: undo-if-empty ( result a b -- seq ) + a call( -- b ) result = [ V{ } clone ] [ result b [undo] call( a -- b ) ] if ; + +\ if-empty 2 [ swap [ undo-if-empty ] 2curry ] define-pop-inverse diff --git a/basis/models/illusion/illusion.factor b/basis/models/illusion/illusion.factor new file mode 100644 index 0000000000..dde514a3d0 --- /dev/null +++ b/basis/models/illusion/illusion.factor @@ -0,0 +1,16 @@ +USING: accessors models models.arrow inverse inverse.vectors kernel ; +IN: models.illusion + +TUPLE: illusion < arrow ; + +: ( model quot -- illusion ) + illusion new V{ } clone >>connections V{ } clone >>dependencies 0 >>ref + swap >>quot over >>model [ add-dependency ] keep ; + +: backtalk ( value object -- ) [ quot>> [undo] call( a -- b ) ] [ model>> ] bi (>>value) ; + +IN: accessors +M: illusion (>>value) ( value object -- ) swap throw [ call-next-method ] 2keep + dup [ quot>> ] [ model>> ] bi and + [ backtalk ] + [ 2drop ] if ; \ No newline at end of file diff --git a/basis/models/illusion/summary.txt b/basis/models/illusion/summary.txt new file mode 100644 index 0000000000..8ea7cf1e7d --- /dev/null +++ b/basis/models/illusion/summary.txt @@ -0,0 +1 @@ +Two Way Arrows \ No newline at end of file diff --git a/basis/ui/gadgets/tables/tables.factor b/basis/ui/gadgets/tables/tables.factor index a2e5f4b6a9..84669be31b 100644 --- a/basis/ui/gadgets/tables/tables.factor +++ b/basis/ui/gadgets/tables/tables.factor @@ -1,12 +1,12 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays colors colors.constants fry kernel math -math.functions math.ranges math.rectangles math.order math.vectors models.arrow -namespaces opengl sequences ui.gadgets ui.gadgets.scrollers +math.functions math.ranges math.rectangles math.order math.vectors +models.illusion namespaces opengl sequences ui.gadgets ui.gadgets.scrollers ui.gadgets.status-bar ui.gadgets.worlds ui.gestures ui.render ui.pens.solid ui.text ui.commands ui.images ui.gadgets.menus ui.gadgets.line-support math.rectangles models math.ranges sequences combinators -combinators.short-circuit fonts locals strings vectors tools.annotations ; +combinators.short-circuit fonts locals strings vectors tools.continuations ; IN: ui.gadgets.tables ! Row rendererer protocol @@ -55,8 +55,8 @@ GENERIC: (>>selected-value) ( val table -- ) : >>selected-index ( table n -- table ) over (>>selected-index) ; : >>selected-value ( table val -- table ) over (>>selected-value) ; -M: table selected-value>> selected-values>> [ [ f ] [ peek ] if-empty ] ; -M: table (>>selected-value) [ [ 1vector ] ] dip (>>selected-values) ; +M: table selected-value>> selected-values>> [ [ f ] [ peek ] if-empty ] ; +M: table (>>selected-value) [ [ 1vector ] ] dip (>>selected-values) ; M: table selected-index>> selected-indices>> [ f ] [ peek ] if-empty ; M: table (>>selected-index) [ 1vector ] dip (>>selected-indices) ; From 611b3638f4a61a90dacecb88861f1a4fc3a0ba3f Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Fri, 15 May 2009 19:31:43 -0500 Subject: [PATCH 027/125] models.illusion allows multiple refs for original --- basis/models/illusion/illusion.factor | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/basis/models/illusion/illusion.factor b/basis/models/illusion/illusion.factor index dde514a3d0..78998e9ab0 100644 --- a/basis/models/illusion/illusion.factor +++ b/basis/models/illusion/illusion.factor @@ -7,10 +7,6 @@ TUPLE: illusion < arrow ; illusion new V{ } clone >>connections V{ } clone >>dependencies 0 >>ref swap >>quot over >>model [ add-dependency ] keep ; -: backtalk ( value object -- ) [ quot>> [undo] call( a -- b ) ] [ model>> ] bi (>>value) ; +: backtalk ( value object -- ) [ quot>> [undo] call( a -- b ) ] [ model>> ] bi set-model ; -IN: accessors -M: illusion (>>value) ( value object -- ) swap throw [ call-next-method ] 2keep - dup [ quot>> ] [ model>> ] bi and - [ backtalk ] - [ 2drop ] if ; \ No newline at end of file +M: illusion update-model ( model -- ) [ [ value>> ] keep backtalk ] with-locked-model ; \ No newline at end of file From b7c719c844a69fb07327c25a98e35380e20dc169 Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Fri, 15 May 2009 20:02:07 -0500 Subject: [PATCH 028/125] table single storage works for f --- basis/inverse/vectors/vectors.factor | 7 +++++++ basis/ui/gadgets/tables/tables.factor | 4 ++-- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/basis/inverse/vectors/vectors.factor b/basis/inverse/vectors/vectors.factor index 1631052157..5cb2258c4f 100644 --- a/basis/inverse/vectors/vectors.factor +++ b/basis/inverse/vectors/vectors.factor @@ -11,7 +11,14 @@ IN: inverse.vectors \ peek [ 1vector ] define-inverse +! if is too general to undo, but its derivatives aren't + :: undo-if-empty ( result a b -- seq ) a call( -- b ) result = [ V{ } clone ] [ result b [undo] call( a -- b ) ] if ; +:: undo-if* ( result a b -- boolean ) + b call( -- b ) result = [ f ] [ result a [undo] call( a -- b ) ] if ; + \ if-empty 2 [ swap [ undo-if-empty ] 2curry ] define-pop-inverse + +\ if* 2 [ swap [ undo-if* ] 2curry ] define-pop-inverse diff --git a/basis/ui/gadgets/tables/tables.factor b/basis/ui/gadgets/tables/tables.factor index 84669be31b..52cc26497f 100644 --- a/basis/ui/gadgets/tables/tables.factor +++ b/basis/ui/gadgets/tables/tables.factor @@ -56,9 +56,9 @@ GENERIC: (>>selected-value) ( val table -- ) : >>selected-value ( table val -- table ) over (>>selected-value) ; M: table selected-value>> selected-values>> [ [ f ] [ peek ] if-empty ] ; -M: table (>>selected-value) [ [ 1vector ] ] dip (>>selected-values) ; +M: table (>>selected-value) [ [ [ 1vector ] [ V{ } clone ] if* ] ] dip (>>selected-values) ; M: table selected-index>> selected-indices>> [ f ] [ peek ] if-empty ; -M: table (>>selected-index) [ 1vector ] dip (>>selected-indices) ; +M: table (>>selected-index) [ [ 1vector ] [ V{ } clone ] if* ] dip (>>selected-indices) ; IN: ui.gadgets.tables : push-selected-index ( table n -- table ) 2dup swap selected-indices>> index [ drop ] [ over selected-indices>> push ] if ; From 54ccd1039bebe4bd0ddf9869c5bb5a03d7a7e4a8 Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Sat, 16 May 2009 10:46:34 -0500 Subject: [PATCH 029/125] tables selected-values type error fixed --- basis/inverse/vectors/vectors.factor | 2 +- basis/models/illusion/illusion.factor | 3 ++- basis/ui/gadgets/tables/tables.factor | 5 +++-- 3 files changed, 6 insertions(+), 4 deletions(-) diff --git a/basis/inverse/vectors/vectors.factor b/basis/inverse/vectors/vectors.factor index 5cb2258c4f..d2cca00af0 100644 --- a/basis/inverse/vectors/vectors.factor +++ b/basis/inverse/vectors/vectors.factor @@ -5,7 +5,7 @@ IN: inverse.vectors : undo-nvector ( array n -- ... ) [ assure-vector ] dip - [ assure-length ] [ firstn ] 2bi ; inline + firstn ; inline \ 1vector [ 1 undo-nvector ] define-inverse diff --git a/basis/models/illusion/illusion.factor b/basis/models/illusion/illusion.factor index 78998e9ab0..6cab6e6371 100644 --- a/basis/models/illusion/illusion.factor +++ b/basis/models/illusion/illusion.factor @@ -7,6 +7,7 @@ TUPLE: illusion < arrow ; illusion new V{ } clone >>connections V{ } clone >>dependencies 0 >>ref swap >>quot over >>model [ add-dependency ] keep ; -: backtalk ( value object -- ) [ quot>> [undo] call( a -- b ) ] [ model>> ] bi set-model ; +: backtalk ( value object -- ) + [ quot>> [undo] call( a -- b ) ] [ model>> ] bi set-model ; M: illusion update-model ( model -- ) [ [ value>> ] keep backtalk ] with-locked-model ; \ No newline at end of file diff --git a/basis/ui/gadgets/tables/tables.factor b/basis/ui/gadgets/tables/tables.factor index 52cc26497f..ae8102f63e 100644 --- a/basis/ui/gadgets/tables/tables.factor +++ b/basis/ui/gadgets/tables/tables.factor @@ -6,7 +6,7 @@ models.illusion namespaces opengl sequences ui.gadgets ui.gadgets.scrollers ui.gadgets.status-bar ui.gadgets.worlds ui.gestures ui.render ui.pens.solid ui.text ui.commands ui.images ui.gadgets.menus ui.gadgets.line-support math.rectangles models math.ranges sequences combinators -combinators.short-circuit fonts locals strings vectors tools.continuations ; +combinators.short-circuit fonts locals strings vectors ; IN: ui.gadgets.tables ! Row rendererer protocol @@ -67,6 +67,7 @@ IN: ui.gadgets.tables new-line-gadget swap >>renderer swap >>model + V{ } clone >>selected-indices V{ } clone >>selected-values sans-serif-font >>font focus-border-color >>focus-border-color @@ -255,7 +256,7 @@ PRIVATE> : (selected-rows) ( table -- {row} ) [ selected-indices>> ] keep - [ nth-row [ 1array ] [ drop { } ] if ] curry map concat ; + [ nth-row [ 1vector ] [ drop V{ } clone ] if ] curry map concat ; : selected-rows ( table -- {value} ) [ (selected-rows) ] [ renderer>> ] bi [ row-value ] curry map ; From 8a50d2f8fd8ec9eea2d387c9fa7d5b3baf5b4db4 Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Sat, 16 May 2009 19:49:27 -0500 Subject: [PATCH 030/125] pseudo-slots vocabulary --- basis/pseudo-slots/pseudo-slots.factor | 14 ++++++++++ basis/ui/gadgets/tables/tables.factor | 36 ++++++++++++++------------ extra/ui/frp/frp.factor | 12 ++++++++- 3 files changed, 44 insertions(+), 18 deletions(-) create mode 100644 basis/pseudo-slots/pseudo-slots.factor diff --git a/basis/pseudo-slots/pseudo-slots.factor b/basis/pseudo-slots/pseudo-slots.factor new file mode 100644 index 0000000000..27308beab3 --- /dev/null +++ b/basis/pseudo-slots/pseudo-slots.factor @@ -0,0 +1,14 @@ +USING: functors kernel lexer sequences vocabs.parser ; +IN: pseudo-slots +FUNCTOR: make-definitions ( D -- ) +D>> DEFINES ${D}>> +>>D DEFINES >>${D} +(>>D) DEFINES (>>${D}) + +WHERE +GENERIC: (>>D) ( value object -- ) +GENERIC: D>> ( object -- value ) +: >>D ( object value -- object ) over (>>D) ; +;FUNCTOR + +SYNTAX: PSEUDO-SLOTS: ";" parse-tokens [ make-definitions ] each ; \ No newline at end of file diff --git a/basis/ui/gadgets/tables/tables.factor b/basis/ui/gadgets/tables/tables.factor index ae8102f63e..e0c8a497c3 100644 --- a/basis/ui/gadgets/tables/tables.factor +++ b/basis/ui/gadgets/tables/tables.factor @@ -2,11 +2,12 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays colors colors.constants fry kernel math math.functions math.ranges math.rectangles math.order math.vectors -models.illusion namespaces opengl sequences ui.gadgets ui.gadgets.scrollers -ui.gadgets.status-bar ui.gadgets.worlds ui.gestures ui.render ui.pens.solid -ui.text ui.commands ui.images ui.gadgets.menus ui.gadgets.line-support -math.rectangles models math.ranges sequences combinators -combinators.short-circuit fonts locals strings vectors ; +models.illusion namespaces opengl pseudo-slots sequences ui.gadgets +ui.gadgets.scrollers ui.gadgets.status-bar ui.gadgets.worlds +ui.gestures ui.render ui.pens.solid ui.text ui.commands ui.images +ui.gadgets.menus ui.gadgets.line-support math.rectangles models +math.ranges sequences combinators combinators.short-circuit +fonts locals strings vectors ; IN: ui.gadgets.tables ! Row rendererer protocol @@ -42,23 +43,22 @@ focus-border-color column-line-color selection-required? selected-indices selected-values +selected-indices* mouse-index { takes-focus? initial: t } focused? multiple-selection? ; +: in>out ( vector -- val/f ) [ f ] [ peek ] if-empty ; +: out>in ( val/f -- vector ) [ 1vector ] [ V{ } clone ] if* ; IN: accessors -GENERIC: selected-value>> ( table -- n ) -GENERIC: selected-index>> ( table -- n ) -GENERIC: (>>selected-index) ( n table -- ) -GENERIC: (>>selected-value) ( val table -- ) -: >>selected-index ( table n -- table ) over (>>selected-index) ; -: >>selected-value ( table val -- table ) over (>>selected-value) ; - -M: table selected-value>> selected-values>> [ [ f ] [ peek ] if-empty ] ; -M: table (>>selected-value) [ [ [ 1vector ] [ V{ } clone ] if* ] ] dip (>>selected-values) ; -M: table selected-index>> selected-indices>> [ f ] [ peek ] if-empty ; -M: table (>>selected-index) [ [ 1vector ] [ V{ } clone ] if* ] dip (>>selected-indices) ; +PSEUDO-SLOTS: selected-value selected-index selected-index* ; +M: table selected-value>> selected-values>> [ in>out ] ; +M: table (>>selected-value) [ [ out>in ] ] dip (>>selected-values) ; +M: table selected-index>> selected-indices>> in>out ; +M: table (>>selected-index) [ out>in ] dip (>>selected-indices) ; +M: table selected-index*>> selected-indices*>> in>out ; +M: table (>>selected-index*) [ out>in ] dip (>>selected-indices*) ; IN: ui.gadgets.tables : push-selected-index ( table n -- table ) 2dup swap selected-indices>> index [ drop ] [ over selected-indices>> push ] if ; @@ -69,6 +69,7 @@ IN: ui.gadgets.tables swap >>model V{ } clone >>selected-indices V{ } clone >>selected-values + V{ } clone >>selected-indices* sans-serif-font >>font focus-border-color >>focus-border-color transparent >>column-line-color ; inline @@ -268,7 +269,8 @@ PRIVATE> > ] bi set-model ; + [ [ selected-rows ] [ selected-values>> ] bi set-model ] + [ [ selected-indices>> ] [ selected-indices*>> ] bi set-model ] bi ; : show-row-summary ( table n -- ) over nth-row diff --git a/extra/ui/frp/frp.factor b/extra/ui/frp/frp.factor index 82cf549ef7..fa71d78e5d 100644 --- a/extra/ui/frp/frp.factor +++ b/extra/ui/frp/frp.factor @@ -27,6 +27,13 @@ M: fold-model (model-changed) [ [ value>> ] [ [ oldval>> ] [ quot>> ] bi ] bi* : ( oldval quot model -- model' ) 1array fold-model swap >>quot swap [ >>oldval ] [ >>value ] bi ; +TUPLE: updater-model < multi-model values updates ; +M: updater-model (model-changed) tuck updates>> = + [ [ values>> value>> ] keep set-model ] + [ drop ] if ; +: ( values updates -- updater ) [ 2array updater-model ] 2keep + [ >>values ] [ >>updates ] bi* ; + TUPLE: switch-model < multi-model original switcher on ; M: switch-model (model-changed) 2dup switcher>> = [ [ value>> ] [ t >>on ] bi* set-model ] @@ -66,6 +73,7 @@ M: frp-table row-color color-quot>> [ call( a -- b ) ] [ drop f ] if* ; : ( -- table ) f ; : ( model -- table ) [ 1array ] >>quot ; : ( -- table ) f ; +: indexed ( table -- table ) f >>val-quot ; : ( -- field ) "" ; @@ -74,7 +82,9 @@ TUPLE: layout gadget width ; C: layout GENERIC: output-model ( gadget -- model ) M: gadget output-model model>> ; -M: table output-model dup multiple-selection?>> [ selected-values>> ] [ selected-value>> ] if ; +M: table output-model dup multiple-selection?>> + [ dup val-quot>> [ selected-values>> ] [ selected-indices*>> ] if ] + [ dup val-quot>> [ selected-value>> ] [ selected-index*>> ] if ] if ; M: model-field output-model field-model>> ; M: scroller output-model viewport>> children>> first output-model ; From 4952fc6f9ff7a0f113057fc0034a927e89a805ac Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Sat, 16 May 2009 19:50:16 -0500 Subject: [PATCH 031/125] restarted modules vocab development --- core/vocabs/parser/parser.factor | 7 +++++-- {unmaintained => extra}/modules/remote-loading/authors.txt | 0 .../modules/remote-loading/remote-loading.factor | 0 {unmaintained => extra}/modules/remote-loading/summary.txt | 0 {unmaintained => extra}/modules/rpc-server/authors.txt | 0 .../modules/rpc-server/rpc-server.factor | 0 {unmaintained => extra}/modules/rpc-server/summary.txt | 0 {unmaintained => extra}/modules/rpc/authors.txt | 0 {unmaintained => extra}/modules/rpc/rpc-docs.factor | 0 {unmaintained => extra}/modules/rpc/rpc.factor | 3 --- {unmaintained => extra}/modules/rpc/summary.txt | 0 {unmaintained => extra}/modules/uploads/authors.txt | 0 {unmaintained => extra}/modules/uploads/summary.txt | 0 {unmaintained => extra}/modules/uploads/uploads.factor | 0 {unmaintained => extra}/modules/using/authors.txt | 0 {unmaintained => extra}/modules/using/summary.txt | 0 {unmaintained => extra}/modules/using/tests/tags.txt | 0 .../modules/using/tests/test-server.factor | 0 {unmaintained => extra}/modules/using/tests/tests.factor | 0 {unmaintained => extra}/modules/using/using-docs.factor | 0 {unmaintained => extra}/modules/using/using.factor | 0 21 files changed, 5 insertions(+), 5 deletions(-) rename {unmaintained => extra}/modules/remote-loading/authors.txt (100%) rename {unmaintained => extra}/modules/remote-loading/remote-loading.factor (100%) rename {unmaintained => extra}/modules/remote-loading/summary.txt (100%) rename {unmaintained => extra}/modules/rpc-server/authors.txt (100%) rename {unmaintained => extra}/modules/rpc-server/rpc-server.factor (100%) rename {unmaintained => extra}/modules/rpc-server/summary.txt (100%) rename {unmaintained => extra}/modules/rpc/authors.txt (100%) rename {unmaintained => extra}/modules/rpc/rpc-docs.factor (100%) rename {unmaintained => extra}/modules/rpc/rpc.factor (86%) rename {unmaintained => extra}/modules/rpc/summary.txt (100%) rename {unmaintained => extra}/modules/uploads/authors.txt (100%) rename {unmaintained => extra}/modules/uploads/summary.txt (100%) rename {unmaintained => extra}/modules/uploads/uploads.factor (100%) rename {unmaintained => extra}/modules/using/authors.txt (100%) rename {unmaintained => extra}/modules/using/summary.txt (100%) rename {unmaintained => extra}/modules/using/tests/tags.txt (100%) rename {unmaintained => extra}/modules/using/tests/test-server.factor (100%) rename {unmaintained => extra}/modules/using/tests/tests.factor (100%) rename {unmaintained => extra}/modules/using/using-docs.factor (100%) rename {unmaintained => extra}/modules/using/using.factor (100%) diff --git a/core/vocabs/parser/parser.factor b/core/vocabs/parser/parser.factor index e8783c0dbe..23b3feea9b 100644 --- a/core/vocabs/parser/parser.factor +++ b/core/vocabs/parser/parser.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007, 2009 Daniel Ehrenberg, Bruno Deferrari, ! Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: assocs hashtables kernel namespaces sequences +USING: assocs fry hashtables kernel namespaces sequences sets strings vocabs sorting accessors arrays ; IN: vocabs.parser @@ -56,4 +56,7 @@ SYMBOL: in dup string? [ "Vocabulary name must be a string" throw ] unless ; : set-in ( name -- ) - check-vocab-string dup in set create-vocab (use+) ; \ No newline at end of file + check-vocab-string dup in set create-vocab (use+) ; + +: with-in ( vocab quot -- vocab ) over + [ '[ _ set-in @ ] in get swap dip set-in ] dip vocab ; inline \ No newline at end of file diff --git a/unmaintained/modules/remote-loading/authors.txt b/extra/modules/remote-loading/authors.txt similarity index 100% rename from unmaintained/modules/remote-loading/authors.txt rename to extra/modules/remote-loading/authors.txt diff --git a/unmaintained/modules/remote-loading/remote-loading.factor b/extra/modules/remote-loading/remote-loading.factor similarity index 100% rename from unmaintained/modules/remote-loading/remote-loading.factor rename to extra/modules/remote-loading/remote-loading.factor diff --git a/unmaintained/modules/remote-loading/summary.txt b/extra/modules/remote-loading/summary.txt similarity index 100% rename from unmaintained/modules/remote-loading/summary.txt rename to extra/modules/remote-loading/summary.txt diff --git a/unmaintained/modules/rpc-server/authors.txt b/extra/modules/rpc-server/authors.txt similarity index 100% rename from unmaintained/modules/rpc-server/authors.txt rename to extra/modules/rpc-server/authors.txt diff --git a/unmaintained/modules/rpc-server/rpc-server.factor b/extra/modules/rpc-server/rpc-server.factor similarity index 100% rename from unmaintained/modules/rpc-server/rpc-server.factor rename to extra/modules/rpc-server/rpc-server.factor diff --git a/unmaintained/modules/rpc-server/summary.txt b/extra/modules/rpc-server/summary.txt similarity index 100% rename from unmaintained/modules/rpc-server/summary.txt rename to extra/modules/rpc-server/summary.txt diff --git a/unmaintained/modules/rpc/authors.txt b/extra/modules/rpc/authors.txt similarity index 100% rename from unmaintained/modules/rpc/authors.txt rename to extra/modules/rpc/authors.txt diff --git a/unmaintained/modules/rpc/rpc-docs.factor b/extra/modules/rpc/rpc-docs.factor similarity index 100% rename from unmaintained/modules/rpc/rpc-docs.factor rename to extra/modules/rpc/rpc-docs.factor diff --git a/unmaintained/modules/rpc/rpc.factor b/extra/modules/rpc/rpc.factor similarity index 86% rename from unmaintained/modules/rpc/rpc.factor rename to extra/modules/rpc/rpc.factor index 1c1217a71e..1c875339b2 100644 --- a/unmaintained/modules/rpc/rpc.factor +++ b/extra/modules/rpc/rpc.factor @@ -16,9 +16,6 @@ DEFER: get-words [ remote-quot ] 2keep create-in -rot define-declared word make-inline ] with-compilation-unit ; -: with-in ( vocab quot -- vocab ) over - [ '[ _ set-in @ ] in get swap dip set-in ] dip vocab ; inline - : remote-vocab ( addrspec vocabspec -- vocab ) dup "-remote" append [ [ (( -- words )) [ "get-words" remote-quot ] keep call-effect ] 2keep diff --git a/unmaintained/modules/rpc/summary.txt b/extra/modules/rpc/summary.txt similarity index 100% rename from unmaintained/modules/rpc/summary.txt rename to extra/modules/rpc/summary.txt diff --git a/unmaintained/modules/uploads/authors.txt b/extra/modules/uploads/authors.txt similarity index 100% rename from unmaintained/modules/uploads/authors.txt rename to extra/modules/uploads/authors.txt diff --git a/unmaintained/modules/uploads/summary.txt b/extra/modules/uploads/summary.txt similarity index 100% rename from unmaintained/modules/uploads/summary.txt rename to extra/modules/uploads/summary.txt diff --git a/unmaintained/modules/uploads/uploads.factor b/extra/modules/uploads/uploads.factor similarity index 100% rename from unmaintained/modules/uploads/uploads.factor rename to extra/modules/uploads/uploads.factor diff --git a/unmaintained/modules/using/authors.txt b/extra/modules/using/authors.txt similarity index 100% rename from unmaintained/modules/using/authors.txt rename to extra/modules/using/authors.txt diff --git a/unmaintained/modules/using/summary.txt b/extra/modules/using/summary.txt similarity index 100% rename from unmaintained/modules/using/summary.txt rename to extra/modules/using/summary.txt diff --git a/unmaintained/modules/using/tests/tags.txt b/extra/modules/using/tests/tags.txt similarity index 100% rename from unmaintained/modules/using/tests/tags.txt rename to extra/modules/using/tests/tags.txt diff --git a/unmaintained/modules/using/tests/test-server.factor b/extra/modules/using/tests/test-server.factor similarity index 100% rename from unmaintained/modules/using/tests/test-server.factor rename to extra/modules/using/tests/test-server.factor diff --git a/unmaintained/modules/using/tests/tests.factor b/extra/modules/using/tests/tests.factor similarity index 100% rename from unmaintained/modules/using/tests/tests.factor rename to extra/modules/using/tests/tests.factor diff --git a/unmaintained/modules/using/using-docs.factor b/extra/modules/using/using-docs.factor similarity index 100% rename from unmaintained/modules/using/using-docs.factor rename to extra/modules/using/using-docs.factor diff --git a/unmaintained/modules/using/using.factor b/extra/modules/using/using.factor similarity index 100% rename from unmaintained/modules/using/using.factor rename to extra/modules/using/using.factor From 9ffa0c32c8168339409667f604b1df8881e848d0 Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Sat, 16 May 2009 22:58:38 -0500 Subject: [PATCH 032/125] ui.frp uses table constructor --- basis/ui/gadgets/tables/tables.factor | 4 ++-- extra/ui/frp/frp.factor | 6 +----- 2 files changed, 3 insertions(+), 7 deletions(-) diff --git a/basis/ui/gadgets/tables/tables.factor b/basis/ui/gadgets/tables/tables.factor index e0c8a497c3..8848a0fe77 100644 --- a/basis/ui/gadgets/tables/tables.factor +++ b/basis/ui/gadgets/tables/tables.factor @@ -57,8 +57,8 @@ M: table selected-value>> selected-values>> [ in>out ] ; M: table (>>selected-value) [ [ out>in ] ] dip (>>selected-values) ; M: table selected-index>> selected-indices>> in>out ; M: table (>>selected-index) [ out>in ] dip (>>selected-indices) ; -M: table selected-index*>> selected-indices*>> in>out ; -M: table (>>selected-index*) [ out>in ] dip (>>selected-indices*) ; +M: table selected-index*>> selected-indices*>> [ in>out ] ; +M: table (>>selected-index*) [ [ out>in ] ] dip (>>selected-indices*) ; IN: ui.gadgets.tables : push-selected-index ( table n -- table ) 2dup swap selected-indices>> index [ drop ] [ over selected-indices>> push ] if ; diff --git a/extra/ui/frp/frp.factor b/extra/ui/frp/frp.factor index fa71d78e5d..4e38dc634e 100644 --- a/extra/ui/frp/frp.factor +++ b/extra/ui/frp/frp.factor @@ -65,11 +65,7 @@ M: frp-table row-columns quot>> [ call( a -- b ) ] [ drop f ] if* ; M: frp-table row-value val-quot>> [ call( a -- b ) ] [ drop f ] if* ; M: frp-table row-color color-quot>> [ call( a -- b ) ] [ drop f ] if* ; -: ( model -- table ) - frp-table new-line-gadget dup >>renderer swap >>model - f basic-model new-model >>selected-values sans-serif-font >>font - focus-border-color >>focus-border-color - transparent >>column-line-color ; +: ( model -- table ) f frp-table new-table dup >>renderer ; : ( -- table ) f ; : ( model -- table ) [ 1array ] >>quot ; : ( -- table ) f ; From 99a1119e3c9d0830e7b62ea55c402567db804e67 Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Sat, 16 May 2009 23:30:30 -0500 Subject: [PATCH 033/125] frp tables use basic-models --- extra/ui/frp/frp.factor | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/extra/ui/frp/frp.factor b/extra/ui/frp/frp.factor index 4e38dc634e..7689e07445 100644 --- a/extra/ui/frp/frp.factor +++ b/extra/ui/frp/frp.factor @@ -15,6 +15,7 @@ M: multi-model model-changed over value>> [ (model-changed) ] [ 2drop ] if ; TUPLE: basic-model < multi-model ; M: basic-model (model-changed) [ value>> ] dip set-model ; : ( models -- model ) basic-model ; +: ( value -- model ) basic-model new-model ; TUPLE: filter-model < multi-model quot ; M: filter-model (model-changed) [ value>> ] dip 2dup quot>> call( a -- ? ) @@ -57,7 +58,7 @@ M: mapped-model model-activated [ model>> ] keep model-changed ; ! Gadgets -: ( text -- button ) [ t swap set-control-value ] f >>model ; +: ( text -- button ) [ t swap set-control-value ] f >>model ; TUPLE: frp-table < table { quot initial: [ ] } { val-quot initial: [ ] } color-quot column-titles column-alignment ; M: frp-table column-titles column-titles>> ; M: frp-table column-alignment column-alignment>> ; @@ -65,10 +66,11 @@ M: frp-table row-columns quot>> [ call( a -- b ) ] [ drop f ] if* ; M: frp-table row-value val-quot>> [ call( a -- b ) ] [ drop f ] if* ; M: frp-table row-color color-quot>> [ call( a -- b ) ] [ drop f ] if* ; -: ( model -- table ) f frp-table new-table dup >>renderer ; -: ( -- table ) f ; +: ( model -- table ) f frp-table new-table dup >>renderer + V{ } clone >>selected-values V{ } clone >>selected-indices* ; +: ( -- table ) V{ } clone ; : ( model -- table ) [ 1array ] >>quot ; -: ( -- table ) f ; +: ( -- table ) V{ } clone ; : indexed ( table -- table ) f >>val-quot ; : ( -- field ) "" ; From a16f96447f3af9f47b6bf9b3185855bee6ab4fc0 Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Sun, 17 May 2009 17:35:07 -0500 Subject: [PATCH 034/125] alerts: "ask-user" added (uses functors) --- extra/models/mapped/mapped.factor | 4 ++-- extra/ui/frp/frp.factor | 10 ++++++++++ extra/ui/gadgets/alerts/alerts.factor | 17 ++++++++++++++--- 3 files changed, 26 insertions(+), 5 deletions(-) diff --git a/extra/models/mapped/mapped.factor b/extra/models/mapped/mapped.factor index 9b8dd9ccf9..698da935e5 100644 --- a/extra/models/mapped/mapped.factor +++ b/extra/models/mapped/mapped.factor @@ -1,11 +1,11 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: macros ui.frp models.product fry +USING: macros ui.frp fry generalizations kernel sequences ; IN: models.mapped MACRO: ( int -- quot ) dup - '[ [ _ narray ] dip [ _ firstn ] prepend ] ; + '[ [ _ narray ] dip [ _ firstn ] prepend ] ; : <2mapped> ( a b quot -- arrow ) 2 ; inline : <3mapped> ( a b c quot -- arrow ) 3 ; inline \ No newline at end of file diff --git a/extra/ui/frp/frp.factor b/extra/ui/frp/frp.factor index 7689e07445..4f9f2da139 100644 --- a/extra/ui/frp/frp.factor +++ b/extra/ui/frp/frp.factor @@ -56,6 +56,16 @@ M: mapped-model (model-changed) set-model ; M: mapped-model model-activated [ model>> ] keep model-changed ; +TUPLE: frp-product < multi-model ; +: ( models -- product ) frp-product ; +M: frp-product model-changed + nip + dup dependencies>> [ value>> ] all? + [ dup [ value>> ] product-value >>value notify-connections + ] [ drop ] if ; +M: frp-product update-model + dup value>> swap [ set-model ] set-product-value ; +M: frp-product model-activated dup model-changed ; ! Gadgets : ( text -- button ) [ t swap set-control-value ] f >>model ; diff --git a/extra/ui/gadgets/alerts/alerts.factor b/extra/ui/gadgets/alerts/alerts.factor index 03d60957fa..ec8335e0d3 100644 --- a/extra/ui/gadgets/alerts/alerts.factor +++ b/extra/ui/gadgets/alerts/alerts.factor @@ -1,4 +1,15 @@ -USING: accessors ui ui.gadgets ui.gadgets.labels ui.gadgets.buttons ui.gadgets.packs locals sequences fonts io.styles ; +USING: accessors kernel ui ui.frp ui.gadgets ui.gadgets.labels +ui.gadgets.buttons ui.gadgets.packs locals sequences fonts io.styles ; + IN: ui.gadgets.alerts -:: alert ( quot string -- ) { 10 10 } >>gap 1 >>align string