From e222378ecc70340a62d9327b5a74fa349c501d6b Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Mon, 4 May 2009 18:38:29 -0500
Subject: [PATCH 001/128] 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 <sam@Tintin.local>
Date: Mon, 4 May 2009 18:39:52 -0500
Subject: [PATCH 002/128] 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 <effect> [ 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 <sam@Tintin.local>
Date: Mon, 4 May 2009 18:40:57 -0500
Subject: [PATCH 003/128] 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 <process-reader> f swap stream-read-until drop ;
+: run-desc ( desc -- result ) ascii <process-reader> 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 <sam@Tintin.local>
Date: Mon, 4 May 2009 18:41:31 -0500
Subject: [PATCH 004/128] 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* ;
: <frp-list> ( model -- table ) <frp-table> [ 1array ] >>quot ;
: <frp-list*> ( -- table ) f <model> <frp-list> ;
-: <frp-field> ( -- field ) f <model> <model-field> ;
+: <frp-field> ( -- field ) "" <model> <model-field> ;
! Layout utilities
@@ -42,8 +42,11 @@ M: gadget -> dup make:, output-model ;
M: model -> dup , ;
M: table -> dup , selected-value>> ;
+
+! : <spacer> ( -- ) <gadget> ,( 100% 100% ) ;
+! Add a % object as a possibility for pref-dim
: <box> ( gadgets type -- track )
- [ { } make:make ] dip <track> swap [ f track-add ] each ; inline
+ [ { } make:make ] dip <track> +baseline+ >>align swap [ f track-add ] each ; inline
: <box*> ( gadgets type -- track ) [ <box> ] [ [ model>> ] map <product> ] bi >>model ; inline
: <hbox> ( gadgets -- track ) horizontal <box> ; inline
: <hbox*> ( gadgets -- track ) horizontal <box*> ; 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{
: <combobox> ( options -- combobox ) [ first [ combobox new-label ] keep <model> >>model ] keep
[ 1array ] map <model> 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 <sam@Tintin.local>
Date: Tue, 5 May 2009 17:23:41 -0500
Subject: [PATCH 005/128] 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 <process-reader> f swap stream-read-until drop but-last ;
\ No newline at end of file
+: run-desc ( desc -- result ) ascii <process-reader> stream-contents but-last ;
\ No newline at end of file
From f6345c72cec64d7642bc5a705312c7055166c223 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Tue, 5 May 2009 17:24:59 -0500
Subject: [PATCH 006/128] 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 <sam@Tintin.local>
Date: Tue, 5 May 2009 20:11:34 -0500
Subject: [PATCH 007/128] 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
+
+: <n-arrow> ( quot int -- arrow )
+ [ narray <product> ] [ '[ _ firstn @ ] <arrow> ] bi ; inline
+
+: <2arrow> ( a b quot -- arrow ) 2 <n-arrow> ;
+: <3arrow> ( a b c quot -- arrow ) 3 <n-arrow> ;
\ No newline at end of file
From bdff947b1fbb02eadae1be4bd5d8d30c2579a8ee Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Tue, 5 May 2009 20:44:05 -0500
Subject: [PATCH 008/128] 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
-: <n-arrow> ( quot int -- arrow )
- [ narray <product> ] [ '[ _ firstn @ ] <arrow> ] bi ; inline
+MACRO: <n-arrow> ( int -- quot ) dup
+ '[ [ _ narray <product> ] dip [ _ firstn ] prepend <arrow> ] ;
-: <2arrow> ( a b quot -- arrow ) 2 <n-arrow> ;
-: <3arrow> ( a b c quot -- arrow ) 3 <n-arrow> ;
\ No newline at end of file
+: <2arrow> ( a b quot -- arrow ) 2 <n-arrow> ; inline
+: <3arrow> ( a b c quot -- arrow ) 3 <n-arrow> ; inline
\ No newline at end of file
From 68c895f391f239c0e4700c787b8f979a44af40a3 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Wed, 6 May 2009 21:33:49 -0500
Subject: [PATCH 009/128] 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 <process-reader> stream-contents but-last ;
\ No newline at end of file
+: run-desc ( desc -- result ) utf8 <process-reader> stream-contents but-last ;
\ No newline at end of file
From d48748c2043bbe390dec62c1e150687322595a6e Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Wed, 6 May 2009 21:34:27 -0500
Subject: [PATCH 010/128] 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 <sam@Tintin.local>
Date: Wed, 6 May 2009 21:35:42 -0500
Subject: [PATCH 011/128] 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* ;
: <frp-field> ( -- field ) "" <model> <model-field> ;
! Layout utilities
+TUPLE: layout gadget width ; C: <layout> 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 <layout> 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 [ <layout> make:, ] curry over push-all ;
+SYNTAX: ->% scan string>number '[ [ _ <layout> make:, ] [ output-model ] bi ] over push-all ;
+GENERIC: -> ( uiitem -- model )
+M: gadget -> dup , output-model ;
+M: model -> dup , ;
! : <spacer> ( -- ) <gadget> ,( 100% 100% ) ;
-! Add a % object as a possibility for pref-dim
: <box> ( gadgets type -- track )
- [ { } make:make ] dip <track> +baseline+ >>align swap [ f track-add ] each ; inline
+ [ { } make:make ] dip <track> +baseline+ >>align swap [ [ gadget>> ] [ width>> ] bi track-add ] each ; inline
: <box*> ( gadgets type -- track ) [ <box> ] [ [ model>> ] map <product> ] bi >>model ; inline
: <hbox> ( gadgets -- track ) horizontal <box> ; inline
: <hbox*> ( gadgets -- track ) horizontal <box*> ; inline
From d590e87e2688fe8901906c06f9efcba398fbc0f4 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Wed, 6 May 2009 21:36:06 -0500
Subject: [PATCH 012/128] 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>> ;
-: <tree> ( start -- tree ) V{ } clone
- [ tree boa dup children>> ] [ ".." swap tree boa ] bi swap push ;
+: <dir-tree> ( {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 <tree> ] [ children>> ] bi* (tree-insert) ;
+: tree-insert ( path tree -- ) [ unclip <dir-tree> ] [ 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> [ [ 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
+ { "/" "/" } <dir-tree> [ [ tree-insert ] curry each ] keep ;
: <dir-table> ( tree-model -- table )
<frp-list*> [ node>> 1array ] >>quot
- [ selected-value>> <switch> ]
- [ swap >>model ] bi ;
\ No newline at end of file
+ [ selected-value>> [ dup [ first ] when ] <arrow> <switch> ]
+ [ 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 <sam@Tintin.local>
Date: Wed, 6 May 2009 21:39:13 -0500
Subject: [PATCH 013/128] 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>> ;
: <dir-tree> ( {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 <dir-tree> ] [ children>> ] bi* (tree-insert) ;
From 06f0b0b98f1b294d903ac315fb345a32aaf7593e Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sat, 9 May 2009 08:01:39 -0500
Subject: [PATCH 014/128] 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 <process-reader> 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 <sam@Tintin.local>
Date: Sat, 9 May 2009 08:02:35 -0500
Subject: [PATCH 015/128] 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? ;
+
: <dir-tree> ( {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)
: <dir-table> ( tree-model -- table )
<frp-list*> [ node>> 1array ] >>quot
- [ selected-value>> [ dup [ first ] when ] <arrow> <switch> ]
- [ swap >>model ] bi
- [ dup comment>> 2array ] >>val-quot ;
\ No newline at end of file
+ [ selected-value>> <switch> ]
+ [ 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>> ;
+
+: <dir-tree> ( start -- tree ) V{ } clone
+ [ tree boa dup children>> ] [ ".." swap tree boa ] bi swap push ;
+
+DEFER: (tree-insert)
+
+: tree-insert ( path tree -- ) [ unclip <dir-tree> ] [ 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 <dir-tree> [ [ tree-insert ] curry each ] keep ;
+
+: find-path ( tree -- string ) dup node>> tuck t =
+ [ 2drop f ] [ children>> first find-path "/" glue ] if ;
+
+: <dir-table> ( tree-model -- table )
+ <frp-list*> [ node>> 1array ] >>quot
+ [ selected-value>> <switch> ]
+ [ 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 <sam@Tintin.local>
Date: Sat, 9 May 2009 08:04:46 -0500
Subject: [PATCH 016/128] 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: <n-arrow> ( int -- quot ) dup
- '[ [ _ narray <product> ] dip [ _ firstn ] prepend <arrow> ] ;
-
-: <2arrow> ( a b quot -- arrow ) 2 <n-arrow> ; inline
-: <3arrow> ( a b c quot -- arrow ) 3 <n-arrow> ; 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: <n-mapped> ( int -- quot ) dup
+ '[ [ _ narray <product> ] dip [ _ firstn ] prepend <mapped> ] ;
+
+: <2mapped> ( a b quot -- arrow ) 2 <n-mapped> ; inline
+: <3mapped> ( a b c quot -- arrow ) 3 <n-mapped> ; inline
\ No newline at end of file
From 3532a5f6c6d11de70085f351ed6dbff9c34aeccf Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sat, 9 May 2009 08:05:43 -0500
Subject: [PATCH 017/128] 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 -- )
+: <multi-model> ( 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 ;
+: <merge> ( models -- model ) basic-model <multi-model> ;
+
+TUPLE: filter-model < multi-model quot ;
+M: filter-model (model-changed) [ value>> ] dip 2dup quot>> call( a -- ? )
+ [ set-model ] [ 2drop ] if ;
+: <filter> ( model quot -- filter-model ) [ 1array filter-model <multi-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 ;
+: <fold> ( oldval quot model -- model' ) 1array fold-model <multi-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 ;
+: <switch> ( signal1 signal2 -- signal' ) [ 2array switch-model <multi-model> ] 2keep
+ [ >>original ] [ >>switcher ] bi* ;
+M: switch-model model-activated [ original>> ] keep model-changed ;
+
+
+TUPLE: mapped-model < multi-model model quot ;
+
+: <mapped> ( 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
: <frp-button> ( text -- button ) [ t swap set-control-value ] <border-button> f <model> >>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* ;
: <frp-table> ( model -- table )
- frp-table new-line-gadget dup >>renderer [ ] >>quot swap >>model
- f <model> >>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 ;
: <frp-table*> ( -- table ) f <model> <frp-table> ;
: <frp-list> ( model -- table ) <frp-table> [ 1array ] >>quot ;
: <frp-list*> ( -- table ) f <model> <frp-list> ;
@@ -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 <layout> make:, ;
@@ -47,7 +89,7 @@ GENERIC: -> ( uiitem -- model )
M: gadget -> dup , output-model ;
M: model -> dup , ;
-! : <spacer> ( -- ) <gadget> ,( 100% 100% ) ;
+: <spacer> ( -- ) <gadget> 1 <layout> make:, ;
: <box> ( gadgets type -- track )
[ { } make:make ] dip <track> +baseline+ >>align swap [ [ gadget>> ] [ width>> ] bi track-add ] each ; inline
: <box*> ( gadgets type -- track ) [ <box> ] [ [ model>> ] map <product> ] bi >>model ; inline
@@ -56,49 +98,6 @@ M: model -> dup , ;
: <vbox> ( gadgets -- track ) vertical <box> ; inline
: <vbox*> ( gadgets -- track ) vertical <box*> ; inline
-! !!! Model utilities
-TUPLE: multi-model < model ;
-: <multi-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 ;
-: <merge> ( models -- model ) merge-model <multi-model> ;
-
-TUPLE: filter-model < multi-model quot ;
-M: filter-model model-changed [ value>> ] dip [ quot>> call( val -- bool ) ] 2keep
- [ set-model ] [ 2drop ] if ;
-: <filter> ( model quot -- filter-model ) [ 1array filter-model <multi-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 ;
-: <fold> ( oldval quot model -- model' ) 1array fold-model <multi-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 ;
-: <switch> ( signal1 signal2 -- signal' ) [ 2array switch-model <multi-model> ] 2keep
- [ >>original ] [ >>switcher ] bi* ;
-
-TUPLE: mapped < model model quot ;
-
-: <mapped> ( 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 <mapped> ;
From 2678c75ac2b9e916b38afe0a380cfe8d7cc8b81d Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sat, 9 May 2009 14:08:20 -0500
Subject: [PATCH 018/128] 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: <frp-button>
{ $description "Creates an button whose model updates on clicks" } ;
HELP: <merge>
-{ $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: <filter>
From b3c84be9731029ca167816b47f884a2f1ac13544 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sat, 9 May 2009 14:23:08 -0500
Subject: [PATCH 019/128] 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 , ;
: <spacer> ( -- ) <gadget> 1 <layout> make:, ;
: <box> ( gadgets type -- track )
- [ { } make:make ] dip <track> +baseline+ >>align swap [ [ gadget>> ] [ width>> ] bi track-add ] each ; inline
+ [ { } make:make ] dip <track> swap [ [ gadget>> ] [ width>> ] bi track-add ] each ; inline
: <box*> ( gadgets type -- track ) [ <box> ] [ [ model>> ] map <product> ] bi >>model ; inline
: <hbox> ( gadgets -- track ) horizontal <box> ; inline
: <hbox*> ( gadgets -- track ) horizontal <box*> ; inline
From c7242b8516f4b8a2047559bdf6ffe50adda7bb2c Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sat, 9 May 2009 16:38:45 -0500
Subject: [PATCH 020/128] 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)
: <dir-table> ( tree-model -- table )
<frp-list*> [ node>> 1array ] >>quot
- [ selected-value>> <switch> ]
+ [ selected-value>> [ file? not ] <filter> <switch> ]
[ swap >>model ] bi ;
\ No newline at end of file
From 89efe27ab575e38ceddd538df7c2b7811dfbc352 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Wed, 13 May 2009 16:10:04 -0500
Subject: [PATCH 021/128] 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* ] <arrow> ;
+M: table (>>selected-value) [ [ 1vector ] <arrow> ] 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 <model> >>selected-value
+ f <model> >>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 <repetition> ] ?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 ;
<PRIVATE
-: update-selected-value ( table -- )
- [ selected-row drop ] [ selected-value>> ] 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>
<PRIVATE
: table-button-up ( table -- )
- dup row-action? [ row-action ] [ update-selected-value ] if ;
+ dup row-action? [ row-action ] [ update-selected-values ] if ;
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* ;
: <frp-table> ( 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 ;
: <frp-table*> ( -- table ) f <model> <frp-table> ;
@@ -74,7 +74,7 @@ TUPLE: layout gadget width ; C: <layout> 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 <sam@Tintin.local>
Date: Wed, 13 May 2009 17:17:10 -0500
Subject: [PATCH 022/128] 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* ] <arrow> ;
+M: table selected-value>> selected-values>> [ [ f ] [ peek ] if-empty ] <arrow> ;
M: table (>>selected-value) [ [ 1vector ] <arrow> ] 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 <model> >>selected-values
+ V{ } clone <model> >>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 <sam@Tintin.local>
Date: Wed, 13 May 2009 22:15:33 -0500
Subject: [PATCH 023/128] 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 ] <arrow> ;
-M: table (>>selected-value) [ [ 1vector ] change-model ] dip (>>selected-values) ;
+M: table (>>selected-value) [ [ 1vector ] <arrow> ] 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 <sam@Tintin.local>
Date: Thu, 14 May 2009 10:01:37 -0500
Subject: [PATCH 024/128] 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 <sam@Tintin.local>
Date: Thu, 14 May 2009 12:38:43 -0500
Subject: [PATCH 025/128] 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 <sam@Tintin.local>
Date: Fri, 15 May 2009 16:58:17 -0500
Subject: [PATCH 026/128] 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 ;
+
+: <illusion> ( 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 ] <arrow> ;
-M: table (>>selected-value) [ [ 1vector ] <arrow> ] dip (>>selected-values) ;
+M: table selected-value>> selected-values>> [ [ f ] [ peek ] if-empty ] <illusion> ;
+M: table (>>selected-value) [ [ 1vector ] <illusion> ] 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 <sam@Tintin.local>
Date: Fri, 15 May 2009 19:31:43 -0500
Subject: [PATCH 027/128] 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 <sam@Tintin.local>
Date: Fri, 15 May 2009 20:02:07 -0500
Subject: [PATCH 028/128] 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 ] <illusion> ;
-M: table (>>selected-value) [ [ 1vector ] <illusion> ] dip (>>selected-values) ;
+M: table (>>selected-value) [ [ [ 1vector ] [ V{ } clone ] if* ] <illusion> ] 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 <sam@Tintin.local>
Date: Sat, 16 May 2009 10:46:34 -0500
Subject: [PATCH 029/128] 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 <model> >>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 <sam@Tintin.local>
Date: Sat, 16 May 2009 19:49:27 -0500
Subject: [PATCH 030/128] 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 ] <illusion> ;
-M: table (>>selected-value) [ [ [ 1vector ] [ V{ } clone ] if* ] <illusion> ] 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 ] <illusion> ;
+M: table (>>selected-value) [ [ out>in ] <illusion> ] 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 <model> >>selected-values
+ V{ } clone <model> >>selected-indices*
sans-serif-font >>font
focus-border-color >>focus-border-color
transparent >>column-line-color ; inline
@@ -268,7 +269,8 @@ PRIVATE>
<PRIVATE
: update-selected-values ( table -- )
- [ selected-rows ] [ selected-values>> ] 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*
: <fold> ( oldval quot model -- model' ) 1array fold-model <multi-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 ;
+: <updates> ( values updates -- updater ) [ 2array updater-model <multi-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* ;
: <frp-table*> ( -- table ) f <model> <frp-table> ;
: <frp-list> ( model -- table ) <frp-table> [ 1array ] >>quot ;
: <frp-list*> ( -- table ) f <model> <frp-list> ;
+: indexed ( table -- table ) f >>val-quot ;
: <frp-field> ( -- field ) "" <model> <model-field> ;
@@ -74,7 +82,9 @@ TUPLE: layout gadget width ; C: <layout> 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 <sam@Tintin.local>
Date: Sat, 16 May 2009 19:50:16 -0500
Subject: [PATCH 031/128] 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 <sam@Tintin.local>
Date: Sat, 16 May 2009 22:58:38 -0500
Subject: [PATCH 032/128] 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 ] <illusion> ;
M: table (>>selected-value) [ [ out>in ] <illusion> ] 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 ] <illusion> ;
+M: table (>>selected-index*) [ [ out>in ] <illusion> ] 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* ;
-: <frp-table> ( 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 ;
+: <frp-table> ( model -- table ) f frp-table new-table dup >>renderer ;
: <frp-table*> ( -- table ) f <model> <frp-table> ;
: <frp-list> ( model -- table ) <frp-table> [ 1array ] >>quot ;
: <frp-list*> ( -- table ) f <model> <frp-list> ;
From 99a1119e3c9d0830e7b62ea55c402567db804e67 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sat, 16 May 2009 23:30:30 -0500
Subject: [PATCH 033/128] 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 ;
: <merge> ( models -- model ) basic-model <multi-model> ;
+: <basic> ( 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
-: <frp-button> ( text -- button ) [ t swap set-control-value ] <border-button> f <model> >>model ;
+: <frp-button> ( text -- button ) [ t swap set-control-value ] <border-button> f <basic> >>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* ;
-: <frp-table> ( model -- table ) f frp-table new-table dup >>renderer ;
-: <frp-table*> ( -- table ) f <model> <frp-table> ;
+: <frp-table> ( model -- table ) f frp-table new-table dup >>renderer
+ V{ } clone <basic> >>selected-values V{ } clone <basic> >>selected-indices* ;
+: <frp-table*> ( -- table ) V{ } clone <model> <frp-table> ;
: <frp-list> ( model -- table ) <frp-table> [ 1array ] >>quot ;
-: <frp-list*> ( -- table ) f <model> <frp-list> ;
+: <frp-list*> ( -- table ) V{ } clone <model> <frp-list> ;
: indexed ( table -- table ) f >>val-quot ;
: <frp-field> ( -- field ) "" <model> <model-field> ;
From a16f96447f3af9f47b6bf9b3185855bee6ab4fc0 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sun, 17 May 2009 17:35:07 -0500
Subject: [PATCH 034/128] 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: <n-mapped> ( int -- quot ) dup
- '[ [ _ narray <product> ] dip [ _ firstn ] prepend <mapped> ] ;
+ '[ [ _ narray <frp-product> ] dip [ _ firstn ] prepend <mapped> ] ;
: <2mapped> ( a b quot -- arrow ) 2 <n-mapped> ; inline
: <3mapped> ( a b c quot -- arrow ) 3 <n-mapped> ; 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 ;
+: <frp-product> ( models -- product ) frp-product <multi-model> ;
+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
: <frp-button> ( text -- button ) [ t swap set-control-value ] <border-button> f <basic> >>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 -- ) <pile> { 10 10 } >>gap 1 >>align string <label> T{ font { name "sans-serif" } { size 18 } } >>font { 200 100 } >>pref-dim add-gadget
- "okay" [ close-window ] quot append <border-button> add-gadget "" open-window ;
\ No newline at end of file
+:: alert ( quot string -- ) <pile> { 10 10 } >>gap 1 >>align
+ string <label> T{ font { name "sans-serif" } { size 18 } } >>font { 200 100 } >>pref-dim add-gadget
+ "okay" [ close-window ] quot append <border-button> add-gadget "" open-window ;
+
+: ask-user ( string -- model )
+ [ [let | lbl [ <label> T{ font { name "sans-serif" } { size 14 } } >>font dup , ]
+ fldm [ <frp-field> ->% 1 ]
+ btn [ "okay" <frp-button> ] |
+ btn -> [ fldm swap <updates> ]
+ [ [ drop lbl close-window f ] <mapped> , ] bi
+ ] ] <vbox> { 161 86 } >>pref-dim "" open-window ;
\ No newline at end of file
From f528ca6ac109257492903c42a6fbcbaff4e1ffe4 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Mon, 18 May 2009 17:21:15 -0500
Subject: [PATCH 035/128] frp-button improvements
---
extra/models/mapped/mapped.factor | 11 --------
extra/ui/frp/frp.factor | 40 ++++++++++++++++++++++-----
extra/ui/gadgets/alerts/alerts.factor | 2 +-
3 files changed, 34 insertions(+), 19 deletions(-)
delete mode 100644 extra/models/mapped/mapped.factor
diff --git a/extra/models/mapped/mapped.factor b/extra/models/mapped/mapped.factor
deleted file mode 100644
index 698da935e5..0000000000
--- a/extra/models/mapped/mapped.factor
+++ /dev/null
@@ -1,11 +0,0 @@
-! Copyright (C) 2009 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: macros ui.frp fry
-generalizations kernel sequences ;
-IN: models.mapped
-
-MACRO: <n-mapped> ( int -- quot ) dup
- '[ [ _ narray <frp-product> ] dip [ _ firstn ] prepend <mapped> ] ;
-
-: <2mapped> ( a b quot -- arrow ) 2 <n-mapped> ; inline
-: <3mapped> ( a b c quot -- arrow ) 3 <n-mapped> ; inline
\ No newline at end of file
diff --git a/extra/ui/frp/frp.factor b/extra/ui/frp/frp.factor
index 4f9f2da139..f59361a0ec 100644
--- a/extra/ui/frp/frp.factor
+++ b/extra/ui/frp/frp.factor
@@ -1,8 +1,8 @@
-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
-math.parser lexer ;
+USING: accessors arrays colors fonts fry generalizations kernel
+lexer macros math math.parser models models.product monads
+sequences ui.gadgets ui.gadgets.buttons ui.gadgets.buttons.private
+ui.gadgets.editors ui.gadgets.line-support ui.gadgets.scrollers
+ui.gadgets.tables ui.gadgets.tracks ui.render ;
QUALIFIED: make
IN: ui.frp
@@ -56,6 +56,14 @@ M: mapped-model (model-changed)
set-model ;
M: mapped-model model-activated [ model>> ] keep model-changed ;
+TUPLE: side-effect-model < mapped-model ;
+M: side-effect-model (model-changed) [ value>> ] [ quot>> ] bi* call( old -- ) ;
+: <$ ( model quot -- side-effect-model )
+ f side-effect-model new-model
+ swap >>quot
+ over >>model
+ [ add-dependency ] keep ;
+
TUPLE: frp-product < multi-model ;
: <frp-product> ( models -- product ) frp-product <multi-model> ;
M: frp-product model-changed
@@ -68,7 +76,11 @@ M: frp-product update-model
M: frp-product model-activated dup model-changed ;
! Gadgets
-: <frp-button> ( text -- button ) [ t swap set-control-value ] <border-button> f <basic> >>model ;
+TUPLE: frp-button < button hook ;
+: <frp-button> ( text -- button ) [ [ t swap set-control-value ] keep
+ dup hook>> [ call( button -- ) ] [ drop ] if* ]
+ frp-button new-button border-button-theme f <basic> >>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>> ;
@@ -124,4 +136,18 @@ INSTANCE: gadget-monad monad
INSTANCE: gadget monad
M: gadget monad-of drop gadget-monad ;
M: gadget-monad return drop <gadget> swap >>model ;
-M: gadget >>= output-model [ swap call( x -- y ) ] curry ;
\ No newline at end of file
+M: gadget >>= output-model [ swap call( x -- y ) ] curry ;
+
+! Macros
+
+MACRO: liftA-n ( int -- quot ) dup
+ '[ [ _ narray <frp-product> ] dip [ _ firstn ] prepend <mapped> ] ;
+
+MACRO: <$-n ( int -- quot ) dup
+ '[ [ _ narray <frp-product> ] dip [ _ firstn ] prepend <$ ] ;
+
+: liftA2 ( a b quot -- arrow ) 2 liftA-n ; inline
+: liftA3 ( a b c quot -- arrow ) 3 liftA-n ; inline
+
+: <$2 ( a b quot -- arrow ) 2 <$-n ; inline
+: <$3 ( a b c quot -- arrow ) 3 <$-n ; inline
\ No newline at end of file
diff --git a/extra/ui/gadgets/alerts/alerts.factor b/extra/ui/gadgets/alerts/alerts.factor
index ec8335e0d3..0c4a4fbd67 100644
--- a/extra/ui/gadgets/alerts/alerts.factor
+++ b/extra/ui/gadgets/alerts/alerts.factor
@@ -11,5 +11,5 @@ IN: ui.gadgets.alerts
fldm [ <frp-field> ->% 1 ]
btn [ "okay" <frp-button> ] |
btn -> [ fldm swap <updates> ]
- [ [ drop lbl close-window f ] <mapped> , ] bi
+ [ [ drop lbl close-window ] <$ , ] bi
] ] <vbox> { 161 86 } >>pref-dim "" open-window ;
\ No newline at end of file
From db3840bc40dc01c890e8a210874a76c1781d28d0 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Mon, 18 May 2009 17:21:57 -0500
Subject: [PATCH 036/128] moved with-in-vocab back to rpc
---
core/vocabs/parser/parser.factor | 39 +++++++++++++++-----------------
extra/modules/rpc/rpc.factor | 5 +++-
2 files changed, 22 insertions(+), 22 deletions(-)
diff --git a/core/vocabs/parser/parser.factor b/core/vocabs/parser/parser.factor
index 23b3feea9b..afa8f20f74 100644
--- a/core/vocabs/parser/parser.factor
+++ b/core/vocabs/parser/parser.factor
@@ -1,62 +1,59 @@
! Copyright (C) 2007, 2009 Daniel Ehrenberg, Bruno Deferrari,
! Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: assocs fry hashtables kernel namespaces sequences
+USING: assocs hashtables kernel namespaces sequences
sets strings vocabs sorting accessors arrays ;
IN: vocabs.parser
-
+
ERROR: no-word-error name ;
-
+
: word-restarts ( name possibilities -- restarts )
natural-sort
[ [ vocabulary>> "Use the " " vocabulary" surround ] keep ] { } map>assoc
swap "Defer word in current vocabulary" swap 2array
suffix ;
-
+
: <no-word-error> ( name possibilities -- error restarts )
[ drop \ no-word-error boa ] [ word-restarts ] 2bi ;
-
+
SYMBOL: use
SYMBOL: in
-
+
: (use+) ( vocab -- )
vocab-words use get push ;
-
+
: use+ ( vocab -- )
load-vocab (use+) ;
-
+
: add-use ( seq -- ) [ use+ ] each ;
-
+
: set-use ( seq -- )
[ vocab-words ] V{ } map-as sift use set ;
-
+
: add-qualified ( vocab prefix -- )
[ load-vocab vocab-words ] [ CHAR: : suffix ] bi*
[ swap [ prepend ] dip ] curry assoc-map
use get push ;
-
+
: partial-vocab ( words vocab -- assoc )
load-vocab vocab-words
[ dupd at [ no-word-error ] unless* ] curry { } map>assoc ;
-
+
: add-words-from ( words vocab -- )
partial-vocab use get push ;
-
+
: partial-vocab-excluding ( words vocab -- assoc )
load-vocab [ vocab-words keys swap diff ] keep partial-vocab ;
-
+
: add-words-excluding ( words vocab -- )
partial-vocab-excluding use get push ;
-
+
: add-renamed-word ( word vocab new-name -- )
[ load-vocab vocab-words dupd at [ ] [ no-word-error ] ?if ] dip
associate use get push ;
-
+
: check-vocab-string ( name -- name )
dup string? [ "Vocabulary name must be a string" throw ] unless ;
-
+
: set-in ( name -- )
- 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
+ check-vocab-string dup in set create-vocab (use+) ;
\ No newline at end of file
diff --git a/extra/modules/rpc/rpc.factor b/extra/modules/rpc/rpc.factor
index 1c875339b2..c6b00efc49 100644
--- a/extra/modules/rpc/rpc.factor
+++ b/extra/modules/rpc/rpc.factor
@@ -5,6 +5,9 @@ IN: modules.rpc
DEFER: get-words
+: with-in-vocab ( vocab quot -- vocab ) over
+ [ '[ _ set-in @ ] in get swap dip set-in ] dip vocab ; inline
+
: remote-quot ( addrspec vocabspec effect str -- quot )
'[ _ 5000 <inet> binary
[
@@ -20,4 +23,4 @@ DEFER: get-words
dup "-remote" append [
[ (( -- words )) [ "get-words" remote-quot ] keep call-effect ] 2keep
[ rot first2 swap define-remote ] 2curry each
- ] with-in ;
\ No newline at end of file
+ ] with-in-vocab ;
\ No newline at end of file
From 40fc26556d7f96344ad1091f8071c7c5401d5277 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Tue, 19 May 2009 16:40:39 -0500
Subject: [PATCH 037/128] manual models for alert buttons
---
extra/ui/frp/frp.factor | 7 ++++---
extra/ui/gadgets/alerts/alerts.factor | 15 +++++++++------
2 files changed, 13 insertions(+), 9 deletions(-)
diff --git a/extra/ui/frp/frp.factor b/extra/ui/frp/frp.factor
index f59361a0ec..459d52983f 100644
--- a/extra/ui/frp/frp.factor
+++ b/extra/ui/frp/frp.factor
@@ -77,9 +77,10 @@ M: frp-product model-activated dup model-changed ;
! Gadgets
TUPLE: frp-button < button hook ;
-: <frp-button> ( text -- button ) [ [ t swap set-control-value ] keep
- dup hook>> [ call( button -- ) ] [ drop ] if* ]
- frp-button new-button border-button-theme f <basic> >>model ;
+: <frp-button> ( text -- button ) [
+ [ t swap set-control-value ] keep
+ dup hook>> [ call( button -- ) ] [ drop ] if*
+ ] frp-button new-button border-button-theme f <basic> >>model ;
TUPLE: frp-table < table { quot initial: [ ] } { val-quot initial: [ ] } color-quot column-titles column-alignment ;
M: frp-table column-titles column-titles>> ;
diff --git a/extra/ui/gadgets/alerts/alerts.factor b/extra/ui/gadgets/alerts/alerts.factor
index 0c4a4fbd67..8cb6a3fd08 100644
--- a/extra/ui/gadgets/alerts/alerts.factor
+++ b/extra/ui/gadgets/alerts/alerts.factor
@@ -1,15 +1,18 @@
-USING: accessors kernel ui ui.frp ui.gadgets ui.gadgets.labels
-ui.gadgets.buttons ui.gadgets.packs locals sequences fonts io.styles ;
+USING: accessors models kernel ui ui.frp ui.gadgets ui.gadgets.labels
+ui.gadgets.editors ui.gadgets.buttons ui.gadgets.packs
+locals sequences fonts io.styles ;
IN: ui.gadgets.alerts
:: alert ( quot string -- ) <pile> { 10 10 } >>gap 1 >>align
string <label> T{ font { name "sans-serif" } { size 18 } } >>font { 200 100 } >>pref-dim add-gadget
"okay" [ close-window ] quot append <border-button> add-gadget "" open-window ;
-: ask-user ( string -- model )
- [ [let | lbl [ <label> T{ font { name "sans-serif" } { size 14 } } >>font dup , ]
+:: ask-user* ( model string -- model' )
+ [ [let | lbl [ string <label> T{ font { name "sans-serif" } { size 14 } } >>font dup , ]
fldm [ <frp-field> ->% 1 ]
- btn [ "okay" <frp-button> ] |
+ btn [ "okay" <frp-button> model >>model ] |
btn -> [ fldm swap <updates> ]
[ [ drop lbl close-window ] <$ , ] bi
- ] ] <vbox> { 161 86 } >>pref-dim "" open-window ;
\ No newline at end of file
+ ] ] <vbox> { 161 86 } >>pref-dim "" open-window ;
+
+: ask-user ( string -- model ) f <model> swap ask-user* ;
\ No newline at end of file
From d439c61ed55f19c19b82f52e9f643c1345381939 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Thu, 21 May 2009 16:36:12 -0500
Subject: [PATCH 038/128] monadic binding for models (frp)
---
extra/ui/frp/frp.factor | 45 +++++++++++++++++----------
extra/ui/gadgets/alerts/alerts.factor | 2 +-
2 files changed, 29 insertions(+), 18 deletions(-)
diff --git a/extra/ui/frp/frp.factor b/extra/ui/frp/frp.factor
index 459d52983f..e66ee0e89a 100644
--- a/extra/ui/frp/frp.factor
+++ b/extra/ui/frp/frp.factor
@@ -43,26 +43,22 @@ M: switch-model (model-changed) 2dup switcher>> =
[ >>original ] [ >>switcher ] bi* ;
M: switch-model model-activated [ original>> ] keep model-changed ;
-
TUPLE: mapped-model < multi-model model quot ;
-
-: <mapped> ( model quot -- mapped )
- f mapped-model new-model
- swap >>quot
- over >>model
- [ add-dependency ] keep ;
+: new-mapped-model ( model quot class -- const-model ) [ over 1array ] dip
+ <multi-model> swap >>quot swap >>model ;
+: <mapped> ( model quot -- mapped ) mapped-model new-mapped-model ;
M: mapped-model (model-changed)
[ [ value>> ] [ quot>> ] bi* call( old -- new ) ] [ nip ] 2bi
set-model ;
M: mapped-model model-activated [ model>> ] keep model-changed ;
TUPLE: side-effect-model < mapped-model ;
-M: side-effect-model (model-changed) [ value>> ] [ quot>> ] bi* call( old -- ) ;
-: <$ ( model quot -- side-effect-model )
- f side-effect-model new-model
- swap >>quot
- over >>model
- [ add-dependency ] keep ;
+M: side-effect-model (model-changed) [ [ value>> ] [ quot>> ] bi* call( old -- ) ] keep t swap set-model ;
+: $> ( model quot -- side-effect-model ) side-effect-model new-mapped-model ;
+
+TUPLE: quot-model < mapped-model ;
+M: quot-model (model-changed) nip [ quot>> call( -- b ) ] keep set-model ;
+: <$ ( model quot -- quot-model ) quot-model new-mapped-model ;
TUPLE: frp-product < multi-model ;
: <frp-product> ( models -- product ) frp-product <multi-model> ;
@@ -75,6 +71,15 @@ M: frp-product update-model
dup value>> swap [ set-model ] set-product-value ;
M: frp-product model-activated dup model-changed ;
+TUPLE: action-value < basic-model parent ;
+: <action-value> ( parent value -- model ) action-value new-model swap >>parent ;
+M: action-value model-activated parent>> activate-model ; ! a fake dependency of sorts
+
+TUPLE: action < multi-model quot ;
+M: action (model-changed) [ [ value>> ] [ quot>> ] bi* call( a -- b ) ] keep value>>
+ swap add-connection ;
+: <action> ( model quot -- action ) [ 1array action <multi-model> ] dip >>quot dup f <action-value> >>value value>> ;
+
! Gadgets
TUPLE: frp-button < button hook ;
: <frp-button> ( text -- button ) [
@@ -131,6 +136,7 @@ M: model -> dup , ;
! Instances
M: model fmap <mapped> ;
+M: model >>= [ swap <action> ] curry ;
SINGLETON: gadget-monad
INSTANCE: gadget-monad monad
@@ -140,15 +146,20 @@ M: gadget-monad return drop <gadget> swap >>model ;
M: gadget >>= output-model [ swap call( x -- y ) ] curry ;
! Macros
+: lift ( int -- quot ) dup
+ '[ [ _ narray <frp-product> ] dip [ _ firstn ] prepend ] ; inline
-MACRO: liftA-n ( int -- quot ) dup
- '[ [ _ narray <frp-product> ] dip [ _ firstn ] prepend <mapped> ] ;
+MACRO: liftA-n ( int -- quot ) lift [ <mapped> ] append ;
-MACRO: <$-n ( int -- quot ) dup
- '[ [ _ narray <frp-product> ] dip [ _ firstn ] prepend <$ ] ;
+MACRO: $>-n ( int -- quot ) lift [ $> ] append ;
+
+MACRO: <$-n ( int -- quot ) lift [ <$ ] append ;
: liftA2 ( a b quot -- arrow ) 2 liftA-n ; inline
: liftA3 ( a b c quot -- arrow ) 3 liftA-n ; inline
+: $>2 ( a b quot -- arrow ) 2 $>-n ; inline
+: $>3 ( a b c quot -- arrow ) 3 $>-n ; inline
+
: <$2 ( a b quot -- arrow ) 2 <$-n ; inline
: <$3 ( a b c quot -- arrow ) 3 <$-n ; inline
\ No newline at end of file
diff --git a/extra/ui/gadgets/alerts/alerts.factor b/extra/ui/gadgets/alerts/alerts.factor
index 8cb6a3fd08..38a3f539a7 100644
--- a/extra/ui/gadgets/alerts/alerts.factor
+++ b/extra/ui/gadgets/alerts/alerts.factor
@@ -12,7 +12,7 @@ IN: ui.gadgets.alerts
fldm [ <frp-field> ->% 1 ]
btn [ "okay" <frp-button> model >>model ] |
btn -> [ fldm swap <updates> ]
- [ [ drop lbl close-window ] <$ , ] bi
+ [ [ drop lbl close-window ] $> , ] bi
] ] <vbox> { 161 86 } >>pref-dim "" open-window ;
: ask-user ( string -- model ) f <model> swap ask-user* ;
\ No newline at end of file
From 4f9a9d6efe05b8d62ee40bf6451969e6a77e5844 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Fri, 22 May 2009 16:43:21 -0500
Subject: [PATCH 039/128] frp: auto-updating of action-models
---
extra/ui/frp/frp.factor | 12 +++++++-----
1 file changed, 7 insertions(+), 5 deletions(-)
diff --git a/extra/ui/frp/frp.factor b/extra/ui/frp/frp.factor
index e66ee0e89a..0508107a22 100644
--- a/extra/ui/frp/frp.factor
+++ b/extra/ui/frp/frp.factor
@@ -1,8 +1,8 @@
USING: accessors arrays colors fonts fry generalizations kernel
lexer macros math math.parser models models.product monads
sequences ui.gadgets ui.gadgets.buttons ui.gadgets.buttons.private
-ui.gadgets.editors ui.gadgets.line-support ui.gadgets.scrollers
-ui.gadgets.tables ui.gadgets.tracks ui.render ;
+ui.gadgets.editors ui.gadgets.scrollers ui.gadgets.tables
+ui.gadgets.tracks ;
QUALIFIED: make
IN: ui.frp
@@ -11,6 +11,8 @@ TUPLE: multi-model < model ;
GENERIC: (model-changed) ( model observer -- )
: <multi-model> ( models kind -- model ) f swap new-model [ [ add-dependency ] curry each ] keep ;
M: multi-model model-changed over value>> [ (model-changed) ] [ 2drop ] if ;
+M: multi-model model-activated dup dependencies>> dup length 1 =
+ [ first swap model-changed ] [ 2drop ] if ;
TUPLE: basic-model < multi-model ;
M: basic-model (model-changed) [ value>> ] dip set-model ;
@@ -50,7 +52,6 @@ TUPLE: mapped-model < multi-model model quot ;
M: mapped-model (model-changed)
[ [ value>> ] [ quot>> ] bi* call( old -- new ) ] [ nip ] 2bi
set-model ;
-M: mapped-model model-activated [ model>> ] keep model-changed ;
TUPLE: side-effect-model < mapped-model ;
M: side-effect-model (model-changed) [ [ value>> ] [ quot>> ] bi* call( old -- ) ] keep t swap set-model ;
@@ -73,11 +74,12 @@ M: frp-product model-activated dup model-changed ;
TUPLE: action-value < basic-model parent ;
: <action-value> ( parent value -- model ) action-value new-model swap >>parent ;
-M: action-value model-activated parent>> activate-model ; ! a fake dependency of sorts
+M: action-value model-activated dup parent>> dup activate-model model-changed ; ! a fake dependency of sorts
+! Update at start
TUPLE: action < multi-model quot ;
M: action (model-changed) [ [ value>> ] [ quot>> ] bi* call( a -- b ) ] keep value>>
- swap add-connection ;
+ [ swap add-connection ] 2keep model-changed ;
: <action> ( model quot -- action ) [ 1array action <multi-model> ] dip >>quot dup f <action-value> >>value value>> ;
! Gadgets
From 0ef2f1365f5cd753d9db86d5943616ab2b248db1 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Fri, 22 May 2009 16:44:20 -0500
Subject: [PATCH 040/128] generalized str-fry to fries
---
extra/{str-fry => fries}/authors.txt | 0
extra/fries/fries.factor | 14 ++++++++++++++
extra/fries/summary.txt | 1 +
extra/str-fry/str-fry.factor | 7 -------
extra/str-fry/summary.txt | 1 -
5 files changed, 15 insertions(+), 8 deletions(-)
rename extra/{str-fry => fries}/authors.txt (100%)
create mode 100644 extra/fries/fries.factor
create mode 100644 extra/fries/summary.txt
delete mode 100644 extra/str-fry/str-fry.factor
delete mode 100644 extra/str-fry/summary.txt
diff --git a/extra/str-fry/authors.txt b/extra/fries/authors.txt
similarity index 100%
rename from extra/str-fry/authors.txt
rename to extra/fries/authors.txt
diff --git a/extra/fries/fries.factor b/extra/fries/fries.factor
new file mode 100644
index 0000000000..0e7ca3a0fe
--- /dev/null
+++ b/extra/fries/fries.factor
@@ -0,0 +1,14 @@
+USING: arrays vectors combinators effects kernel math sequences splitting
+strings.parser parser ;
+IN: fries
+SYMBOL: _
+: str-fry ( str on -- quot ) split
+ [ unclip-last [ [ spin glue ] reduce-r ] 2curry ]
+ [ length 1 - 1 <effect> [ call-effect ] 2curry ] bi ;
+: gen-fry ( str on -- quot ) split
+ [ unclip-last [ [ spin 1array glue ] reduce-r ] 2curry ]
+ [ length 1 - 1 <effect> [ call-effect ] 2curry ] bi ;
+
+SYNTAX: i" parse-string rest "_" str-fry over push-all ;
+SYNTAX: i{ \ } parse-until >array { _ } gen-fry over push-all ;
+SYNTAX: iV{ \ } parse-until >vector V{ _ } gen-fry over push-all ;
diff --git a/extra/fries/summary.txt b/extra/fries/summary.txt
new file mode 100644
index 0000000000..44e9456a66
--- /dev/null
+++ b/extra/fries/summary.txt
@@ -0,0 +1 @@
+Generalized Frying
\ No newline at end of file
diff --git a/extra/str-fry/str-fry.factor b/extra/str-fry/str-fry.factor
deleted file mode 100644
index 55dba1285d..0000000000
--- a/extra/str-fry/str-fry.factor
+++ /dev/null
@@ -1,7 +0,0 @@
-USING: combinators effects kernel math sequences splitting
-strings.parser ;
-IN: str-fry
-: str-fry ( str -- quot ) "_" split
- [ unclip-last [ [ spin glue ] reduce-r ] 2curry ] ! not rot
- [ length 1 - 1 <effect> [ call-effect ] 2curry ] bi ;
-SYNTAX: I" parse-string rest str-fry over push-all ;
\ No newline at end of file
diff --git a/extra/str-fry/summary.txt b/extra/str-fry/summary.txt
deleted file mode 100644
index 7755f5ae9a..0000000000
--- a/extra/str-fry/summary.txt
+++ /dev/null
@@ -1 +0,0 @@
-String Frying
\ No newline at end of file
From 499e2e3816815e9d3f5a1c8a9573f69b52672742 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Fri, 22 May 2009 22:27:35 -0500
Subject: [PATCH 041/128] file trees start common path
---
core/sequences/sequences.factor | 2 ++
extra/file-trees/file-trees.factor | 14 +++++++---
extra/file-trees/file-trees.factor copy | 34 -------------------------
3 files changed, 13 insertions(+), 37 deletions(-)
delete mode 100644 extra/file-trees/file-trees.factor copy
diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index 0ac7e8a189..51df596278 100755
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -920,6 +920,8 @@ PRIVATE>
] [ generic-flip ] if
] unless ;
+: reduce1 ( seq quot -- result ) [ unclip ] dip reduce ; inline
+
:: reduce-r
( list identity quot: ( obj1 obj2 -- obj ) -- result )
list empty?
diff --git a/extra/file-trees/file-trees.factor b/extra/file-trees/file-trees.factor
index 77952c8425..d92309ca77 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 sequences
-ui.frp vectors make ;
+ui.frp vectors make strings ;
IN: file-trees
TUPLE: walkable-vector vector father ;
@@ -31,8 +31,16 @@ DEFER: (tree-insert)
: add-paths ( pathseq -- {{name,path}} )
"" [ [ "/" glue dup ] keep swap 2array , ] [ reduce drop ] f make ;
-: create-tree ( file-list -- tree ) [ path-components add-paths ] map
- { "/" "/" } <dir-tree> [ [ tree-insert ] curry each ] keep ;
+: go-to-path ( path tree -- tree' ) over empty? [ nip ]
+ [ [ unclip ] [ children>> ] bi* swap [ swap node>> = ] curry find nip go-to-path ] if ;
+
+: find-root ( pathseq -- root ) dup flip
+ [ [ dupd = [ ] [ drop f ] if ] reduce1 ] find-last drop
+ [ first ] dip head-slice >string path-components ;
+
+: create-tree ( file-list -- tree ) [ find-root ]
+ [ [ path-components add-paths ] map { "/" "/" } <dir-tree> [ [ tree-insert ] curry each ] keep ] bi
+ go-to-path ;
: <dir-table> ( tree-model -- table )
<frp-list*> [ node>> 1array ] >>quot
diff --git a/extra/file-trees/file-trees.factor copy b/extra/file-trees/file-trees.factor copy
deleted file mode 100644
index e3324d9834..0000000000
--- a/extra/file-trees/file-trees.factor copy
+++ /dev/null
@@ -1,34 +0,0 @@
-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>> ;
-
-: <dir-tree> ( start -- tree ) V{ } clone
- [ tree boa dup children>> ] [ ".." swap tree boa ] bi swap push ;
-
-DEFER: (tree-insert)
-
-: tree-insert ( path tree -- ) [ unclip <dir-tree> ] [ 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 <dir-tree> [ [ tree-insert ] curry each ] keep ;
-
-: find-path ( tree -- string ) dup node>> tuck t =
- [ 2drop f ] [ children>> first find-path "/" glue ] if ;
-
-: <dir-table> ( tree-model -- table )
- <frp-list*> [ node>> 1array ] >>quot
- [ selected-value>> <switch> ]
- [ swap >>model ] bi
- [ find-path ] >>val-quot ;
\ No newline at end of file
From f5b539bb00f67337ca8a434611fdfab83d1969a3 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sat, 23 May 2009 08:30:41 -0500
Subject: [PATCH 042/128] ui.gadgets.alerts: "ask-buttons" added
---
extra/ui/frp/frp.factor | 4 ++--
extra/ui/gadgets/alerts/alerts.factor | 18 +++++++++++++-----
2 files changed, 15 insertions(+), 7 deletions(-)
diff --git a/extra/ui/frp/frp.factor b/extra/ui/frp/frp.factor
index 0508107a22..ccae6fe4b0 100644
--- a/extra/ui/frp/frp.factor
+++ b/extra/ui/frp/frp.factor
@@ -85,8 +85,8 @@ M: action (model-changed) [ [ value>> ] [ quot>> ] bi* call( a -- b ) ] keep val
! Gadgets
TUPLE: frp-button < button hook ;
: <frp-button> ( text -- button ) [
- [ t swap set-control-value ] keep
- dup hook>> [ call( button -- ) ] [ drop ] if*
+ [ dup hook>> [ call( button -- ) ] [ drop ] if* ] keep
+ t swap set-control-value
] frp-button new-button border-button-theme f <basic> >>model ;
TUPLE: frp-table < table { quot initial: [ ] } { val-quot initial: [ ] } color-quot column-titles column-alignment ;
diff --git a/extra/ui/gadgets/alerts/alerts.factor b/extra/ui/gadgets/alerts/alerts.factor
index 38a3f539a7..265c0fdc74 100644
--- a/extra/ui/gadgets/alerts/alerts.factor
+++ b/extra/ui/gadgets/alerts/alerts.factor
@@ -1,10 +1,10 @@
-USING: accessors models kernel ui ui.frp ui.gadgets ui.gadgets.labels
-ui.gadgets.editors ui.gadgets.buttons ui.gadgets.packs
-locals sequences fonts io.styles ;
+USING: accessors models macros generalizations kernel ui ui.frp
+ui.gadgets ui.gadgets.labels ui.gadgets.editors ui.gadgets.buttons
+ui.gadgets.packs locals sequences fonts io.styles wrap.strings ;
IN: ui.gadgets.alerts
:: alert ( quot string -- ) <pile> { 10 10 } >>gap 1 >>align
- string <label> T{ font { name "sans-serif" } { size 18 } } >>font { 200 100 } >>pref-dim add-gadget
+ string 22 wrap-lines <label> T{ font { name "sans-serif" } { size 18 } } >>font { 200 100 } >>pref-dim add-gadget
"okay" [ close-window ] quot append <border-button> add-gadget "" open-window ;
:: ask-user* ( model string -- model' )
@@ -15,4 +15,12 @@ IN: ui.gadgets.alerts
[ [ drop lbl close-window ] $> , ] bi
] ] <vbox> { 161 86 } >>pref-dim "" open-window ;
-: ask-user ( string -- model ) f <model> swap ask-user* ;
\ No newline at end of file
+: ask-user ( string -- model ) f <model> swap ask-user* ;
+
+MACRO: ask-buttons ( buttons -- quot ) dup length [
+ [ swap
+ [ 22 wrap-lines <label> T{ font { name "sans-serif" } { size 18 } } >>font ,
+ [ [ <frp-button> [ close-window ] >>hook -> ] map ] <hbox> , ] <vbox>
+ { 200 110 } >>pref-dim "" open-window
+ ] dip firstn
+ ] 2curry ;
\ No newline at end of file
From 27b745dcc8730e6d82c014ad7ac8f8f491110848 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sun, 24 May 2009 09:36:24 -0500
Subject: [PATCH 043/128] modulization of ui.frp
---
basis/functors/functors.factor | 10 +-
core/sequences/sequences.factor | 4 +-
extra/modules/util/util.factor | 7 +
extra/monads/monads.factor | 1 +
extra/ui/frp/frp.factor | 169 +-----------------
extra/ui/frp/functors/functors.factor | 25 +++
extra/ui/frp/gadgets/gadgets.factor | 26 +++
extra/ui/frp/instances/instances.factor | 12 ++
extra/ui/frp/layout/layout.factor | 34 ++++
extra/ui/frp/signals/signals.factor | 81 +++++++++
.../frp/{frp-docs.factor => xfrp-docs.factor} | 0
11 files changed, 200 insertions(+), 169 deletions(-)
create mode 100644 extra/modules/util/util.factor
create mode 100644 extra/ui/frp/functors/functors.factor
create mode 100644 extra/ui/frp/gadgets/gadgets.factor
create mode 100644 extra/ui/frp/instances/instances.factor
create mode 100644 extra/ui/frp/layout/layout.factor
create mode 100644 extra/ui/frp/signals/signals.factor
rename extra/ui/frp/{frp-docs.factor => xfrp-docs.factor} (100%)
diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor
index edd4932c66..bf7eed8f8a 100644
--- a/basis/functors/functors.factor
+++ b/basis/functors/functors.factor
@@ -4,8 +4,8 @@ USING: accessors arrays classes.mixin classes.parser
classes.tuple classes.tuple.parser combinators effects
effects.parser fry generic generic.parser generic.standard
interpolate io.streams.string kernel lexer locals.parser
-locals.rewrite.closures locals.types make namespaces parser
-quotations sequences vocabs.parser words words.symbol ;
+locals.rewrite.closures locals.types make macros namespaces
+parser quotations sequences vocabs.parser words words.symbol ;
IN: functors
! This is a hack
@@ -111,6 +111,11 @@ SYNTAX: `GENERIC:
complete-effect parsed
\ define-simple-generic* parsed ;
+SYNTAX: `MACRO:
+ scan-param parsed
+ parse-declared*
+ \ define-macro parsed ;
+
SYNTAX: `inline [ word make-inline ] over push-all ;
SYNTAX: `call-next-method T{ fake-call-next-method } parsed ;
@@ -142,6 +147,7 @@ DEFER: ;FUNCTOR delimiter
{ "SYNTAX:" POSTPONE: `SYNTAX: }
{ "SYMBOL:" POSTPONE: `SYMBOL: }
{ "inline" POSTPONE: `inline }
+ { "MACRO:" POSTPONE: `MACRO: }
{ "call-next-method" POSTPONE: `call-next-method }
} ;
diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index 51df596278..a86c501258 100755
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -927,4 +927,6 @@ PRIVATE>
list empty?
[ identity ]
[ list rest identity quot reduce-r list first quot call ] if ;
- inline recursive
\ No newline at end of file
+ inline recursive
+
+:: combos ( list1 list2 -- result ) list2 [ [ 2array ] curry list1 swap map ] map concat ;
\ No newline at end of file
diff --git a/extra/modules/util/util.factor b/extra/modules/util/util.factor
new file mode 100644
index 0000000000..ef5a3f3e76
--- /dev/null
+++ b/extra/modules/util/util.factor
@@ -0,0 +1,7 @@
+USING: accessors assocs kernel lexer locals namespaces sequences
+vocabs vocabs.parser ;
+IN: modules.util
+SYNTAX: EXPORT-FROM: [let | v [ in get ] |
+ v vocab words>> ";" parse-tokens
+ [ load-vocab vocab-words [ clone v >>vocabulary ] assoc-map ] map
+ assoc-combine update ] ;
\ No newline at end of file
diff --git a/extra/monads/monads.factor b/extra/monads/monads.factor
index 6b35772596..f4503cbdd3 100644
--- a/extra/monads/monads.factor
+++ b/extra/monads/monads.factor
@@ -22,6 +22,7 @@ M: monad return monad-of return ;
M: monad fail monad-of fail ;
: bind ( mvalue quot -- mvalue' ) swap >>= call( quot -- mvalue ) ;
+: bind* ( mvalue quot -- mvalue' ) '[ drop @ ] bind ;
: >> ( mvalue k -- mvalue' ) '[ drop _ ] bind ;
:: lift-m2 ( m1 m2 f monad -- m3 )
diff --git a/extra/ui/frp/frp.factor b/extra/ui/frp/frp.factor
index ccae6fe4b0..f97dccdc03 100644
--- a/extra/ui/frp/frp.factor
+++ b/extra/ui/frp/frp.factor
@@ -1,167 +1,4 @@
-USING: accessors arrays colors fonts fry generalizations kernel
-lexer macros math math.parser models models.product monads
-sequences ui.gadgets ui.gadgets.buttons ui.gadgets.buttons.private
-ui.gadgets.editors ui.gadgets.scrollers ui.gadgets.tables
-ui.gadgets.tracks ;
-QUALIFIED: make
+USING: modules.util ui.frp.functors monads ;
IN: ui.frp
-
-! !!! Model utilities
-TUPLE: multi-model < model ;
-GENERIC: (model-changed) ( model observer -- )
-: <multi-model> ( models kind -- model ) f swap new-model [ [ add-dependency ] curry each ] keep ;
-M: multi-model model-changed over value>> [ (model-changed) ] [ 2drop ] if ;
-M: multi-model model-activated dup dependencies>> dup length 1 =
- [ first swap model-changed ] [ 2drop ] if ;
-
-TUPLE: basic-model < multi-model ;
-M: basic-model (model-changed) [ value>> ] dip set-model ;
-: <merge> ( models -- model ) basic-model <multi-model> ;
-: <basic> ( value -- model ) basic-model new-model ;
-
-TUPLE: filter-model < multi-model quot ;
-M: filter-model (model-changed) [ value>> ] dip 2dup quot>> call( a -- ? )
- [ set-model ] [ 2drop ] if ;
-: <filter> ( model quot -- filter-model ) [ 1array filter-model <multi-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 ;
-: <fold> ( oldval quot model -- model' ) 1array fold-model <multi-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 ;
-: <updates> ( values updates -- updater ) [ 2array updater-model <multi-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 ]
- [ dup on>> [ 2drop ] [ [ value>> ] dip set-model ] if ] if ;
-: <switch> ( signal1 signal2 -- signal' ) [ 2array switch-model <multi-model> ] 2keep
- [ >>original ] [ >>switcher ] bi* ;
-M: switch-model model-activated [ original>> ] keep model-changed ;
-
-TUPLE: mapped-model < multi-model model quot ;
-: new-mapped-model ( model quot class -- const-model ) [ over 1array ] dip
- <multi-model> swap >>quot swap >>model ;
-: <mapped> ( model quot -- mapped ) mapped-model new-mapped-model ;
-M: mapped-model (model-changed)
- [ [ value>> ] [ quot>> ] bi* call( old -- new ) ] [ nip ] 2bi
- set-model ;
-
-TUPLE: side-effect-model < mapped-model ;
-M: side-effect-model (model-changed) [ [ value>> ] [ quot>> ] bi* call( old -- ) ] keep t swap set-model ;
-: $> ( model quot -- side-effect-model ) side-effect-model new-mapped-model ;
-
-TUPLE: quot-model < mapped-model ;
-M: quot-model (model-changed) nip [ quot>> call( -- b ) ] keep set-model ;
-: <$ ( model quot -- quot-model ) quot-model new-mapped-model ;
-
-TUPLE: frp-product < multi-model ;
-: <frp-product> ( models -- product ) frp-product <multi-model> ;
-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 ;
-
-TUPLE: action-value < basic-model parent ;
-: <action-value> ( parent value -- model ) action-value new-model swap >>parent ;
-M: action-value model-activated dup parent>> dup activate-model model-changed ; ! a fake dependency of sorts
-
-! Update at start
-TUPLE: action < multi-model quot ;
-M: action (model-changed) [ [ value>> ] [ quot>> ] bi* call( a -- b ) ] keep value>>
- [ swap add-connection ] 2keep model-changed ;
-: <action> ( model quot -- action ) [ 1array action <multi-model> ] dip >>quot dup f <action-value> >>value value>> ;
-
-! Gadgets
-TUPLE: frp-button < button hook ;
-: <frp-button> ( text -- button ) [
- [ dup hook>> [ call( button -- ) ] [ drop ] if* ] keep
- t swap set-control-value
- ] frp-button new-button border-button-theme f <basic> >>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>> ;
-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* ;
-
-: <frp-table> ( model -- table ) f frp-table new-table dup >>renderer
- V{ } clone <basic> >>selected-values V{ } clone <basic> >>selected-indices* ;
-: <frp-table*> ( -- table ) V{ } clone <model> <frp-table> ;
-: <frp-list> ( model -- table ) <frp-table> [ 1array ] >>quot ;
-: <frp-list*> ( -- table ) V{ } clone <model> <frp-list> ;
-: indexed ( table -- table ) f >>val-quot ;
-
-: <frp-field> ( -- field ) "" <model> <model-field> ;
-
-! Layout utilities
-TUPLE: layout gadget width ; C: <layout> layout
-
-GENERIC: output-model ( gadget -- model )
-M: gadget output-model model>> ;
-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 ;
-
-GENERIC: , ( uiitem -- )
-M: gadget , f <layout> make:, ;
-M: model , activate-model ;
-
-SYNTAX: ,% scan string>number [ <layout> make:, ] curry over push-all ;
-SYNTAX: ->% scan string>number '[ [ _ <layout> make:, ] [ output-model ] bi ] over push-all ;
-
-GENERIC: -> ( uiitem -- model )
-M: gadget -> dup , output-model ;
-M: model -> dup , ;
-
-: <spacer> ( -- ) <gadget> 1 <layout> make:, ;
-: <box> ( gadgets type -- track )
- [ { } make:make ] dip <track> swap [ [ gadget>> ] [ width>> ] bi track-add ] each ; inline
-: <box*> ( gadgets type -- track ) [ <box> ] [ [ model>> ] map <product> ] bi >>model ; inline
-: <hbox> ( gadgets -- track ) horizontal <box> ; inline
-: <hbox*> ( gadgets -- track ) horizontal <box*> ; inline
-: <vbox> ( gadgets -- track ) vertical <box> ; inline
-: <vbox*> ( gadgets -- track ) vertical <box*> ; inline
-
-! Instances
-M: model fmap <mapped> ;
-M: model >>= [ swap <action> ] curry ;
-
-SINGLETON: gadget-monad
-INSTANCE: gadget-monad monad
-INSTANCE: gadget monad
-M: gadget monad-of drop gadget-monad ;
-M: gadget-monad return drop <gadget> swap >>model ;
-M: gadget >>= output-model [ swap call( x -- y ) ] curry ;
-
-! Macros
-: lift ( int -- quot ) dup
- '[ [ _ narray <frp-product> ] dip [ _ firstn ] prepend ] ; inline
-
-MACRO: liftA-n ( int -- quot ) lift [ <mapped> ] append ;
-
-MACRO: $>-n ( int -- quot ) lift [ $> ] append ;
-
-MACRO: <$-n ( int -- quot ) lift [ <$ ] append ;
-
-: liftA2 ( a b quot -- arrow ) 2 liftA-n ; inline
-: liftA3 ( a b c quot -- arrow ) 3 liftA-n ; inline
-
-: $>2 ( a b quot -- arrow ) 2 $>-n ; inline
-: $>3 ( a b c quot -- arrow ) 3 $>-n ; inline
-
-: <$2 ( a b quot -- arrow ) 2 <$-n ; inline
-: <$3 ( a b c quot -- arrow ) 3 <$-n ; inline
\ No newline at end of file
+EXPORT-FROM: ui.frp.signals ui.frp.gadgets ui.frp.instances ui.frp.layout ;
+FMAPS: $> <$ fmap FOR & | ;
\ No newline at end of file
diff --git a/extra/ui/frp/functors/functors.factor b/extra/ui/frp/functors/functors.factor
new file mode 100644
index 0000000000..2808faf190
--- /dev/null
+++ b/extra/ui/frp/functors/functors.factor
@@ -0,0 +1,25 @@
+USING: fry functors generalizations kernel macros peg peg-lexer
+sequences ;
+IN: ui.frp.functors
+
+FUNCTOR: fmaps ( W P -- )
+W IS ${W}
+<p> IS <${P}>
+w-n DEFINES ${W}-n-${P}
+w-2 DEFINES 2${W}-${P}
+w-3 DEFINES 3${W}-${P}
+w-4 DEFINES 4${W}-${P}
+WHERE
+MACRO: w-n ( int -- quot ) dup '[ [ _ narray <p> ] dip [ _ firstn ] prepend W ] ;
+: w-2 ( a b quot -- mapped ) 2 w-n ; inline
+: w-3 ( a b c quot -- mapped ) 3 w-n ; inline
+: w-4 ( a b c d quot -- mapped ) 4 w-n ; inline
+;FUNCTOR
+
+ON-BNF: FMAPS:
+tokenizer = <foreign factor>
+token = !("FOR"|";").
+middle = "FOR" => [[ drop ignore ]]
+endexpr = ";" => [[ drop ignore ]]
+expr = token* middle token* endexpr => [[ first2 combos [ first2 fmaps ] each ignore ]]
+;ON-BNF
\ No newline at end of file
diff --git a/extra/ui/frp/gadgets/gadgets.factor b/extra/ui/frp/gadgets/gadgets.factor
new file mode 100644
index 0000000000..02bc8f45cb
--- /dev/null
+++ b/extra/ui/frp/gadgets/gadgets.factor
@@ -0,0 +1,26 @@
+USING: accessors arrays kernel models ui.frp.signals ui.gadgets
+ui.gadgets.buttons ui.gadgets.buttons.private
+ui.gadgets.editors ui.gadgets.tables ;
+IN: ui.frp.gadgets
+
+TUPLE: frp-button < button hook ;
+: <frp-button> ( text -- button ) [
+ [ dup hook>> [ call( button -- ) ] [ drop ] if* ] keep
+ t swap set-control-value
+ ] frp-button new-button border-button-theme f <basic> >>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>> ;
+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* ;
+
+: <frp-table> ( model -- table ) f frp-table new-table dup >>renderer
+ V{ } clone <basic> >>selected-values V{ } clone <basic> >>selected-indices* ;
+: <frp-table*> ( -- table ) V{ } clone <model> <frp-table> ;
+: <frp-list> ( model -- table ) <frp-table> [ 1array ] >>quot ;
+: <frp-list*> ( -- table ) V{ } clone <model> <frp-list> ;
+: indexed ( table -- table ) f >>val-quot ;
+
+: <frp-field> ( -- field ) "" <model> <model-field> ;
\ No newline at end of file
diff --git a/extra/ui/frp/instances/instances.factor b/extra/ui/frp/instances/instances.factor
new file mode 100644
index 0000000000..8ab7531621
--- /dev/null
+++ b/extra/ui/frp/instances/instances.factor
@@ -0,0 +1,12 @@
+USING: accessors kernel models monads ui.frp.signals ui.frp.layout ui.gadgets ;
+IN: ui.frp.instances
+
+M: model >>= [ swap <action> ] curry ;
+M: model fmap <mapped> ;
+
+SINGLETON: gadget-monad
+INSTANCE: gadget-monad monad
+INSTANCE: gadget monad
+M: gadget monad-of drop gadget-monad ;
+M: gadget-monad return drop <gadget> swap >>model ;
+M: gadget >>= output-model [ swap call( x -- y ) ] curry ;
diff --git a/extra/ui/frp/layout/layout.factor b/extra/ui/frp/layout/layout.factor
new file mode 100644
index 0000000000..508f30b2ab
--- /dev/null
+++ b/extra/ui/frp/layout/layout.factor
@@ -0,0 +1,34 @@
+USING: accessors fry kernel lexer math.parser models sequences
+ui.frp.signals ui.gadgets ui.gadgets.editors ui.gadgets.scrollers
+ui.gadgets.tables ui.gadgets.tracks ;
+QUALIFIED: make
+IN: ui.frp.layout
+TUPLE: layout gadget width ; C: <layout> layout
+
+GENERIC: output-model ( gadget -- model )
+M: gadget output-model model>> ;
+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 ;
+
+GENERIC: , ( uiitem -- )
+M: gadget , f <layout> make:, ;
+M: model , activate-model ;
+
+SYNTAX: ,% scan string>number [ <layout> make:, ] curry over push-all ;
+SYNTAX: ->% scan string>number '[ [ _ <layout> make:, ] [ output-model ] bi ] over push-all ;
+
+GENERIC: -> ( uiitem -- model )
+M: gadget -> dup , output-model ;
+M: model -> dup , ;
+
+: <spacer> ( -- ) <gadget> 1 <layout> make:, ;
+: <box> ( gadgets type -- track )
+ [ { } make:make ] dip <track> swap [ [ gadget>> ] [ width>> ] bi track-add ] each ; inline
+: <box*> ( gadgets type -- track ) [ <box> ] [ [ model>> ] map <|> ] bi >>model ; inline
+: <hbox> ( gadgets -- track ) horizontal <box> ; inline
+: <hbox*> ( gadgets -- track ) horizontal <box*> ; inline
+: <vbox> ( gadgets -- track ) vertical <box> ; inline
+: <vbox*> ( gadgets -- track ) vertical <box*> ; inline
\ No newline at end of file
diff --git a/extra/ui/frp/signals/signals.factor b/extra/ui/frp/signals/signals.factor
new file mode 100644
index 0000000000..461b8f0732
--- /dev/null
+++ b/extra/ui/frp/signals/signals.factor
@@ -0,0 +1,81 @@
+USING: accessors arrays kernel models models.product sequences ;
+IN: ui.frp.signals
+
+TUPLE: multi-model < model ;
+GENERIC: (model-changed) ( model observer -- )
+: <multi-model> ( models kind -- model ) f swap new-model [ [ add-dependency ] curry each ] keep ;
+M: multi-model model-changed over value>> [ (model-changed) ] [ 2drop ] if ;
+M: multi-model model-activated dup dependencies>> dup length 1 =
+ [ first swap model-changed ] [ 2drop ] if ;
+
+TUPLE: basic-model < multi-model ;
+M: basic-model (model-changed) [ value>> ] dip set-model ;
+: <merge> ( models -- model ) basic-model <multi-model> ;
+: <basic> ( value -- model ) basic-model new-model ;
+
+TUPLE: filter-model < multi-model quot ;
+M: filter-model (model-changed) [ value>> ] dip 2dup quot>> call( a -- ? )
+ [ set-model ] [ 2drop ] if ;
+: <filter> ( model quot -- filter-model ) [ 1array filter-model <multi-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 ;
+: <fold> ( oldval quot model -- model' ) 1array fold-model <multi-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 ;
+: <updates> ( values updates -- updater ) [ 2array updater-model <multi-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 ]
+ [ dup on>> [ 2drop ] [ [ value>> ] dip set-model ] if ] if ;
+: <switch> ( signal1 signal2 -- signal' ) [ 2array switch-model <multi-model> ] 2keep
+ [ >>original ] [ >>switcher ] bi* ;
+M: switch-model model-activated [ original>> ] keep model-changed ;
+
+TUPLE: mapped-model < multi-model model quot ;
+: new-mapped-model ( model quot class -- const-model ) [ over 1array ] dip
+ <multi-model> swap >>quot swap >>model ;
+: <mapped> ( model quot -- mapped ) mapped-model new-mapped-model ;
+M: mapped-model (model-changed)
+ [ [ value>> ] [ quot>> ] bi* call( old -- new ) ] [ nip ] 2bi
+ set-model ;
+
+TUPLE: side-effect-model < mapped-model ;
+M: side-effect-model (model-changed) [ [ value>> ] [ quot>> ] bi* call( old -- ) ] keep t swap set-model ;
+: $> ( model quot -- side-effect-model ) side-effect-model new-mapped-model ;
+
+TUPLE: quot-model < mapped-model ;
+M: quot-model (model-changed) nip [ quot>> call( -- b ) ] keep set-model ;
+: <$ ( model quot -- quot-model ) quot-model new-mapped-model ;
+
+TUPLE: action-value < basic-model parent ;
+: <action-value> ( parent value -- model ) action-value new-model swap >>parent ;
+M: action-value model-activated dup parent>> dup activate-model model-changed ; ! a fake dependency of sorts
+
+TUPLE: action < multi-model quot ;
+M: action (model-changed) [ [ value>> ] [ quot>> ] bi* call( a -- b ) ] keep value>>
+ [ swap add-connection ] 2keep model-changed ;
+: <action> ( model quot -- action ) [ 1array action <multi-model> ] dip >>quot dup f <action-value> >>value value>> ;
+
+TUPLE: | < multi-model ;
+: <|> ( models -- product ) | <multi-model> ;
+M: | model-changed
+ nip
+ dup dependencies>> [ value>> ] all?
+ [ dup [ value>> ] product-value >>value notify-connections
+ ] [ drop ] if ;
+M: | update-model
+ dup value>> swap [ set-model ] set-product-value ;
+M: | model-activated dup model-changed ;
+
+TUPLE: & < | ;
+: <&> ( models -- product ) & <multi-model> ;
+M: & model-changed [ call-next-method ] keep
+ [ dependencies>> [ f swap set-model ] each ] with-locked-model ;
\ No newline at end of file
diff --git a/extra/ui/frp/frp-docs.factor b/extra/ui/frp/xfrp-docs.factor
similarity index 100%
rename from extra/ui/frp/frp-docs.factor
rename to extra/ui/frp/xfrp-docs.factor
From 22c071778aa58e7e98d34ddd03f865dd7abe48a9 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sun, 24 May 2009 10:05:17 -0500
Subject: [PATCH 044/128] |-products work correctly
---
extra/ui/frp/signals/signals.factor | 10 ++++++----
1 file changed, 6 insertions(+), 4 deletions(-)
diff --git a/extra/ui/frp/signals/signals.factor b/extra/ui/frp/signals/signals.factor
index 461b8f0732..184dd05365 100644
--- a/extra/ui/frp/signals/signals.factor
+++ b/extra/ui/frp/signals/signals.factor
@@ -66,16 +66,18 @@ M: action (model-changed) [ [ value>> ] [ quot>> ] bi* call( a -- b ) ] keep val
TUPLE: | < multi-model ;
: <|> ( models -- product ) | <multi-model> ;
+GENERIC: models-changed ( product -- )
+M: | models-changed drop ;
M: | model-changed
nip
dup dependencies>> [ value>> ] all?
- [ dup [ value>> ] product-value >>value notify-connections
- ] [ drop ] if ;
+ [ [ dup [ value>> ] product-value >>value notify-connections ] keep models-changed ]
+ [ drop ] if ;
M: | update-model
dup value>> swap [ set-model ] set-product-value ;
M: | model-activated dup model-changed ;
+! Only when everything's true does he make it false
TUPLE: & < | ;
: <&> ( models -- product ) & <multi-model> ;
-M: & model-changed [ call-next-method ] keep
- [ dependencies>> [ f swap set-model ] each ] with-locked-model ;
\ No newline at end of file
+M: & models-changed dependencies>> [ f swap (>>value) ] each ;
\ No newline at end of file
From 96d29b7dbaf1fa0cf69160fe76f607651198b3d5 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sun, 24 May 2009 15:35:03 -0500
Subject: [PATCH 045/128] illusion models activated automatically
---
basis/models/illusion/illusion.factor | 2 +-
extra/ui/frp/gadgets/gadgets.factor | 6 ++++--
extra/ui/frp/signals/signals.factor | 1 +
extra/ui/gadgets/alerts/alerts.factor | 4 ++--
extra/ui/gadgets/comboboxes/comboboxes.factor | 6 +++---
5 files changed, 11 insertions(+), 8 deletions(-)
diff --git a/basis/models/illusion/illusion.factor b/basis/models/illusion/illusion.factor
index 6cab6e6371..f41a4a2444 100644
--- a/basis/models/illusion/illusion.factor
+++ b/basis/models/illusion/illusion.factor
@@ -5,7 +5,7 @@ TUPLE: illusion < arrow ;
: <illusion> ( model quot -- illusion )
illusion new V{ } clone >>connections V{ } clone >>dependencies 0 >>ref
- swap >>quot over >>model [ add-dependency ] keep ;
+ swap >>quot over >>model [ add-dependency ] keep dup activate-model ;
: backtalk ( value object -- )
[ quot>> [undo] call( a -- b ) ] [ model>> ] bi set-model ;
diff --git a/extra/ui/frp/gadgets/gadgets.factor b/extra/ui/frp/gadgets/gadgets.factor
index 02bc8f45cb..08c7b44002 100644
--- a/extra/ui/frp/gadgets/gadgets.factor
+++ b/extra/ui/frp/gadgets/gadgets.factor
@@ -4,10 +4,12 @@ ui.gadgets.editors ui.gadgets.tables ;
IN: ui.frp.gadgets
TUPLE: frp-button < button hook ;
-: <frp-button> ( text -- button ) [
+: <frp-button> ( gadget -- button ) [
[ dup hook>> [ call( button -- ) ] [ drop ] if* ] keep
t swap set-control-value
- ] frp-button new-button border-button-theme f <basic> >>model ;
+ ] frp-button new-button f <basic> >>model ;
+
+: <frp-bevel-button> ( text -- button ) <frp-button> border-button-theme ;
TUPLE: frp-table < table { quot initial: [ ] } { val-quot initial: [ ] } color-quot column-titles column-alignment ;
M: frp-table column-titles column-titles>> ;
diff --git a/extra/ui/frp/signals/signals.factor b/extra/ui/frp/signals/signals.factor
index 184dd05365..c7c9736111 100644
--- a/extra/ui/frp/signals/signals.factor
+++ b/extra/ui/frp/signals/signals.factor
@@ -38,6 +38,7 @@ M: switch-model (model-changed) 2dup switcher>> =
: <switch> ( signal1 signal2 -- signal' ) [ 2array switch-model <multi-model> ] 2keep
[ >>original ] [ >>switcher ] bi* ;
M: switch-model model-activated [ original>> ] keep model-changed ;
+: >behavior ( event -- behavior ) t <model> swap <switch> ;
TUPLE: mapped-model < multi-model model quot ;
: new-mapped-model ( model quot class -- const-model ) [ over 1array ] dip
diff --git a/extra/ui/gadgets/alerts/alerts.factor b/extra/ui/gadgets/alerts/alerts.factor
index 265c0fdc74..e948c92d43 100644
--- a/extra/ui/gadgets/alerts/alerts.factor
+++ b/extra/ui/gadgets/alerts/alerts.factor
@@ -10,7 +10,7 @@ IN: ui.gadgets.alerts
:: ask-user* ( model string -- model' )
[ [let | lbl [ string <label> T{ font { name "sans-serif" } { size 14 } } >>font dup , ]
fldm [ <frp-field> ->% 1 ]
- btn [ "okay" <frp-button> model >>model ] |
+ btn [ "okay" <frp-bevel-button> model >>model ] |
btn -> [ fldm swap <updates> ]
[ [ drop lbl close-window ] $> , ] bi
] ] <vbox> { 161 86 } >>pref-dim "" open-window ;
@@ -20,7 +20,7 @@ IN: ui.gadgets.alerts
MACRO: ask-buttons ( buttons -- quot ) dup length [
[ swap
[ 22 wrap-lines <label> T{ font { name "sans-serif" } { size 18 } } >>font ,
- [ [ <frp-button> [ close-window ] >>hook -> ] map ] <hbox> , ] <vbox>
+ [ [ <frp-bevel-button> [ close-window ] >>hook -> ] map ] <hbox> , ] <vbox>
{ 200 110 } >>pref-dim "" open-window
] dip firstn
] 2curry ;
\ No newline at end of file
diff --git a/extra/ui/gadgets/comboboxes/comboboxes.factor b/extra/ui/gadgets/comboboxes/comboboxes.factor
index a937b73d35..137150001c 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 colors.constants fonts ;
+ui.gadgets ui.gadgets.glass ui.gadgets.labels
+ui.gadgets.tables ui.gestures ;
IN: ui.gadgets.comboboxes
TUPLE: combo-table < table spawner ;
@@ -19,4 +19,4 @@ combobox H{
: <combobox> ( options -- combobox ) [ first [ combobox new-label ] keep <model> >>model ] keep
[ 1array ] map <model> trivial-renderer combo-table new-table
- >>table dup font>> COLOR: gray >>background 12 >>size >>font ;
\ No newline at end of file
+ >>table ;
\ No newline at end of file
From 101ecfbd6367ec335d23b72535decb4e1e625e64 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sun, 24 May 2009 17:30:03 -0500
Subject: [PATCH 046/128] added general purpose alert
---
extra/ui/gadgets/alerts/alerts.factor | 2 ++
1 file changed, 2 insertions(+)
diff --git a/extra/ui/gadgets/alerts/alerts.factor b/extra/ui/gadgets/alerts/alerts.factor
index e948c92d43..edecb90ee3 100644
--- a/extra/ui/gadgets/alerts/alerts.factor
+++ b/extra/ui/gadgets/alerts/alerts.factor
@@ -7,6 +7,8 @@ IN: ui.gadgets.alerts
string 22 wrap-lines <label> T{ font { name "sans-serif" } { size 18 } } >>font { 200 100 } >>pref-dim add-gadget
"okay" [ close-window ] quot append <border-button> add-gadget "" open-window ;
+: alert* ( str -- ) [ ] swap alert ;
+
:: ask-user* ( model string -- model' )
[ [let | lbl [ string <label> T{ font { name "sans-serif" } { size 14 } } >>font dup , ]
fldm [ <frp-field> ->% 1 ]
From 624de10b1ec711ab18721c8f6efc04adeba2ddc1 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sun, 24 May 2009 22:10:56 -0500
Subject: [PATCH 047/128] updated modules.util to use manifests
---
extra/file-trees/file-trees.factor | 3 ++-
extra/modules/using/tests/tests.factor | 4 ----
extra/modules/util/util.factor | 6 +++---
.../modules/remote-loading/authors.txt | 0
.../modules/remote-loading/remote-loading.factor | 0
.../modules/remote-loading/summary.txt | 0
{extra => unmaintained}/modules/rpc-server/authors.txt | 0
.../modules/rpc-server/rpc-server.factor | 2 +-
{extra => unmaintained}/modules/rpc-server/summary.txt | 0
{extra => unmaintained}/modules/rpc/authors.txt | 0
{extra => unmaintained}/modules/rpc/rpc-docs.factor | 0
{extra => unmaintained}/modules/rpc/rpc.factor | 4 ++--
{extra => unmaintained}/modules/rpc/summary.txt | 0
{extra => unmaintained}/modules/uploads/authors.txt | 0
{extra => unmaintained}/modules/uploads/summary.txt | 0
{extra => unmaintained}/modules/uploads/uploads.factor | 0
{extra => unmaintained}/modules/using/authors.txt | 0
{extra => unmaintained}/modules/using/summary.txt | 0
{extra => unmaintained}/modules/using/tests/tags.txt | 0
.../modules/using/tests/test-server.factor | 0
unmaintained/modules/using/tests/tests.factor | 4 ++++
{extra => unmaintained}/modules/using/using-docs.factor | 5 +++--
{extra => unmaintained}/modules/using/using.factor | 8 ++++----
23 files changed, 19 insertions(+), 17 deletions(-)
delete mode 100644 extra/modules/using/tests/tests.factor
rename {extra => unmaintained}/modules/remote-loading/authors.txt (100%)
rename {extra => unmaintained}/modules/remote-loading/remote-loading.factor (100%)
rename {extra => unmaintained}/modules/remote-loading/summary.txt (100%)
rename {extra => unmaintained}/modules/rpc-server/authors.txt (100%)
rename {extra => unmaintained}/modules/rpc-server/rpc-server.factor (91%)
rename {extra => unmaintained}/modules/rpc-server/summary.txt (100%)
rename {extra => unmaintained}/modules/rpc/authors.txt (100%)
rename {extra => unmaintained}/modules/rpc/rpc-docs.factor (100%)
rename {extra => unmaintained}/modules/rpc/rpc.factor (83%)
rename {extra => unmaintained}/modules/rpc/summary.txt (100%)
rename {extra => unmaintained}/modules/uploads/authors.txt (100%)
rename {extra => unmaintained}/modules/uploads/summary.txt (100%)
rename {extra => unmaintained}/modules/uploads/uploads.factor (100%)
rename {extra => unmaintained}/modules/using/authors.txt (100%)
rename {extra => unmaintained}/modules/using/summary.txt (100%)
rename {extra => unmaintained}/modules/using/tests/tags.txt (100%)
rename {extra => unmaintained}/modules/using/tests/test-server.factor (100%)
create mode 100644 unmaintained/modules/using/tests/tests.factor
rename {extra => unmaintained}/modules/using/using-docs.factor (82%)
rename {extra => unmaintained}/modules/using/using.factor (80%)
diff --git a/extra/file-trees/file-trees.factor b/extra/file-trees/file-trees.factor
index d92309ca77..a3108aa922 100644
--- a/extra/file-trees/file-trees.factor
+++ b/extra/file-trees/file-trees.factor
@@ -1,6 +1,7 @@
USING: accessors arrays delegate delegate.protocols
io.pathnames kernel locals sequences
-ui.frp vectors make strings ;
+vectors make strings ;
+EXCLUDE: ui.frp => , ;
IN: file-trees
TUPLE: walkable-vector vector father ;
diff --git a/extra/modules/using/tests/tests.factor b/extra/modules/using/tests/tests.factor
deleted file mode 100644
index 894075acf8..0000000000
--- a/extra/modules/using/tests/tests.factor
+++ /dev/null
@@ -1,4 +0,0 @@
-USING: modules.using ;
-IN: modules.using.tests
-USING: tools.test localhost::modules.test-server ;
-[ "hello world" ] [ rpc-hello ] unit-test
\ No newline at end of file
diff --git a/extra/modules/util/util.factor b/extra/modules/util/util.factor
index ef5a3f3e76..4e92d4139f 100644
--- a/extra/modules/util/util.factor
+++ b/extra/modules/util/util.factor
@@ -1,7 +1,7 @@
USING: accessors assocs kernel lexer locals namespaces sequences
vocabs vocabs.parser ;
IN: modules.util
-SYNTAX: EXPORT-FROM: [let | v [ in get ] |
- v vocab words>> ";" parse-tokens
- [ load-vocab vocab-words [ clone v >>vocabulary ] assoc-map ] map
+SYNTAX: EXPORT-FROM: [let | v [ current-vocab ] |
+ v words>> ";" parse-tokens
+ [ load-vocab vocab-words [ clone v name>> >>vocabulary ] assoc-map ] map
assoc-combine update ] ;
\ No newline at end of file
diff --git a/extra/modules/remote-loading/authors.txt b/unmaintained/modules/remote-loading/authors.txt
similarity index 100%
rename from extra/modules/remote-loading/authors.txt
rename to unmaintained/modules/remote-loading/authors.txt
diff --git a/extra/modules/remote-loading/remote-loading.factor b/unmaintained/modules/remote-loading/remote-loading.factor
similarity index 100%
rename from extra/modules/remote-loading/remote-loading.factor
rename to unmaintained/modules/remote-loading/remote-loading.factor
diff --git a/extra/modules/remote-loading/summary.txt b/unmaintained/modules/remote-loading/summary.txt
similarity index 100%
rename from extra/modules/remote-loading/summary.txt
rename to unmaintained/modules/remote-loading/summary.txt
diff --git a/extra/modules/rpc-server/authors.txt b/unmaintained/modules/rpc-server/authors.txt
similarity index 100%
rename from extra/modules/rpc-server/authors.txt
rename to unmaintained/modules/rpc-server/authors.txt
diff --git a/extra/modules/rpc-server/rpc-server.factor b/unmaintained/modules/rpc-server/rpc-server.factor
similarity index 91%
rename from extra/modules/rpc-server/rpc-server.factor
rename to unmaintained/modules/rpc-server/rpc-server.factor
index 525ff35a09..d818170372 100644
--- a/extra/modules/rpc-server/rpc-server.factor
+++ b/unmaintained/modules/rpc-server/rpc-server.factor
@@ -25,7 +25,7 @@ MEMO: mem-do-rpc ( args word -- bytes ) do-rpc ; inline
: (service) ( -- ) serving-vocabs get-global empty? [ start-serving-vocabs ] when
current-vocab serving-vocabs get-global adjoin
"get-words" create-in
- in get [ vocab vocab-words [ stack-effect ] { } assoc-map-as ] curry
+ current-vocab name>> [ vocab vocab-words [ stack-effect ] { } assoc-map-as ] curry
(( -- words )) define-inline ;
SYNTAX: service \ do-rpc "executer" set (service) ;
diff --git a/extra/modules/rpc-server/summary.txt b/unmaintained/modules/rpc-server/summary.txt
similarity index 100%
rename from extra/modules/rpc-server/summary.txt
rename to unmaintained/modules/rpc-server/summary.txt
diff --git a/extra/modules/rpc/authors.txt b/unmaintained/modules/rpc/authors.txt
similarity index 100%
rename from extra/modules/rpc/authors.txt
rename to unmaintained/modules/rpc/authors.txt
diff --git a/extra/modules/rpc/rpc-docs.factor b/unmaintained/modules/rpc/rpc-docs.factor
similarity index 100%
rename from extra/modules/rpc/rpc-docs.factor
rename to unmaintained/modules/rpc/rpc-docs.factor
diff --git a/extra/modules/rpc/rpc.factor b/unmaintained/modules/rpc/rpc.factor
similarity index 83%
rename from extra/modules/rpc/rpc.factor
rename to unmaintained/modules/rpc/rpc.factor
index c6b00efc49..fe65c9cb37 100644
--- a/extra/modules/rpc/rpc.factor
+++ b/unmaintained/modules/rpc/rpc.factor
@@ -1,12 +1,12 @@
USING: accessors compiler.units combinators fry generalizations io
-io.encodings.binary io.sockets kernel namespaces
+io.encodings.binary io.sockets kernel
parser sequences serialize vocabs vocabs.parser words ;
IN: modules.rpc
DEFER: get-words
: with-in-vocab ( vocab quot -- vocab ) over
- [ '[ _ set-in @ ] in get swap dip set-in ] dip vocab ; inline
+ [ '[ _ set-current-vocab @ ] current-vocab name>> swap dip set-current-vocab ] dip vocab ; inline
: remote-quot ( addrspec vocabspec effect str -- quot )
'[ _ 5000 <inet> binary
diff --git a/extra/modules/rpc/summary.txt b/unmaintained/modules/rpc/summary.txt
similarity index 100%
rename from extra/modules/rpc/summary.txt
rename to unmaintained/modules/rpc/summary.txt
diff --git a/extra/modules/uploads/authors.txt b/unmaintained/modules/uploads/authors.txt
similarity index 100%
rename from extra/modules/uploads/authors.txt
rename to unmaintained/modules/uploads/authors.txt
diff --git a/extra/modules/uploads/summary.txt b/unmaintained/modules/uploads/summary.txt
similarity index 100%
rename from extra/modules/uploads/summary.txt
rename to unmaintained/modules/uploads/summary.txt
diff --git a/extra/modules/uploads/uploads.factor b/unmaintained/modules/uploads/uploads.factor
similarity index 100%
rename from extra/modules/uploads/uploads.factor
rename to unmaintained/modules/uploads/uploads.factor
diff --git a/extra/modules/using/authors.txt b/unmaintained/modules/using/authors.txt
similarity index 100%
rename from extra/modules/using/authors.txt
rename to unmaintained/modules/using/authors.txt
diff --git a/extra/modules/using/summary.txt b/unmaintained/modules/using/summary.txt
similarity index 100%
rename from extra/modules/using/summary.txt
rename to unmaintained/modules/using/summary.txt
diff --git a/extra/modules/using/tests/tags.txt b/unmaintained/modules/using/tests/tags.txt
similarity index 100%
rename from extra/modules/using/tests/tags.txt
rename to unmaintained/modules/using/tests/tags.txt
diff --git a/extra/modules/using/tests/test-server.factor b/unmaintained/modules/using/tests/test-server.factor
similarity index 100%
rename from extra/modules/using/tests/test-server.factor
rename to unmaintained/modules/using/tests/test-server.factor
diff --git a/unmaintained/modules/using/tests/tests.factor b/unmaintained/modules/using/tests/tests.factor
new file mode 100644
index 0000000000..a0adca2646
--- /dev/null
+++ b/unmaintained/modules/using/tests/tests.factor
@@ -0,0 +1,4 @@
+QUALIFIED-WITH: modules.using m
+IN: modules.using.tests
+m:USING: tools.test localhost::modules.test-server ;
+[ "hello world" ] [ rpc-hello ] unit-test
\ No newline at end of file
diff --git a/extra/modules/using/using-docs.factor b/unmaintained/modules/using/using-docs.factor
similarity index 82%
rename from extra/modules/using/using-docs.factor
rename to unmaintained/modules/using/using-docs.factor
index c78e546525..15f99964d8 100644
--- a/extra/modules/using/using-docs.factor
+++ b/unmaintained/modules/using/using-docs.factor
@@ -1,4 +1,5 @@
-USING: modules.using modules.rpc-server help.syntax help.markup strings ;
+USING: modules.rpc-server help.syntax help.markup strings ;
+QUALIFIED-WITH: modules.using m
IN: modules
HELP: service
@@ -6,7 +7,7 @@ HELP: service
{ $description "Starts a server for requests for remote procedure calls." } ;
ARTICLE: { "modules" "remote-loading" } "Using the remote-loading vocabulary"
-"If loaded, starts serving vocabularies, accessable through a " { $link POSTPONE: USING: } " form" ;
+"If loaded, starts serving vocabularies, accessable through a " { $link POSTPONE: m:USING: } " form" ;
HELP: USING:
{ $syntax "USING: rpc-server::module fetch-sever::module { module qualified-name } { module => word ... } ... ;" }
diff --git a/extra/modules/using/using.factor b/unmaintained/modules/using/using.factor
similarity index 80%
rename from extra/modules/using/using.factor
rename to unmaintained/modules/using/using.factor
index b0891aa391..57bf3c67cd 100644
--- a/extra/modules/using/using.factor
+++ b/unmaintained/modules/using/using.factor
@@ -1,4 +1,4 @@
-USING: assocs kernel modules.remote-loading modules.rpc
+USING: accessors assocs kernel modules.remote-loading modules.rpc
namespaces peg peg.ebnf peg-lexer sequences vocabs vocabs.parser
strings ;
IN: modules.using
@@ -9,9 +9,9 @@ IN: modules.using
: >partial-vocab ( words assoc -- assoc )
[ dupd at [ no-word-error ] unless* ] curry { } map>assoc ;
-: remote-load ( addr vocabspec -- voab ) [ "modules.remote-loading" remote-vocab (use+) ] dip get-vocab ;
+: remote-load ( addr vocabspec -- voab ) [ "modules.remote-loading" remote-vocab use-vocab ] dip get-vocab ;
-: load'em ( vocab words/? -- ) [ swap >partial-vocab ] when* use get push ;
+: load'em ( vocab words/? -- ) [ swap >partial-vocab ] when* manifest get qualified-vocabs>> push ;
EBNF: modulize
tokenpart = (!(':').)+ => [[ >string ]]
@@ -30,7 +30,7 @@ qualified = modspec sym => [[ first2 >qualified ]]
unqualified = modspec => [[ vocab-words ]]
words = ("=>" sym+ )? => [[ [ f ] [ second ] if-empty ]]
long = "{" ( qualified | unqualified ) words "}" => [[ rest first2 load'em ignore ]]
-short = modspec => [[ use+ ignore ]]
+short = modspec => [[ use-vocab ignore ]]
wordSpec = long | short
using = wordSpec+ ";" => [[ drop ignore ]]
;ON-BNF
\ No newline at end of file
From 10c391f3ab6b48b50c7d7e16610bfefa907fd890 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Mon, 25 May 2009 15:28:05 -0500
Subject: [PATCH 048/128] removed shadowed imports from old modules
---
extra/drills/deployed/deploy.factor | 18 +++++------
extra/drills/deployed/deployed.factor | 4 +--
extra/drills/drills.factor | 3 +-
extra/merger/deploy.factor | 14 ++++----
extra/merger/merger.factor | 3 +-
extra/ui/frp/gadgets/gadgets.factor | 2 +-
extra/ui/frp/signals/signals.factor | 20 ++++++------
extra/ui/frp/xfrp-docs.factor | 46 ---------------------------
8 files changed, 33 insertions(+), 77 deletions(-)
delete mode 100644 extra/ui/frp/xfrp-docs.factor
diff --git a/extra/drills/deployed/deploy.factor b/extra/drills/deployed/deploy.factor
index eaa0d3bb69..c1e93078f7 100644
--- a/extra/drills/deployed/deploy.factor
+++ b/extra/drills/deployed/deploy.factor
@@ -1,14 +1,14 @@
USING: tools.deploy.config ;
H{
- { deploy-unicode? f }
- { deploy-threads? t }
- { deploy-math? t }
{ deploy-name "drills" }
- { deploy-ui? t }
+ { deploy-c-types? t }
{ "stop-after-last-window?" t }
- { deploy-word-props? f }
- { deploy-c-types? f }
- { deploy-io 2 }
- { deploy-word-defs? f }
- { deploy-reflection 1 }
+ { deploy-unicode? t }
+ { deploy-threads? t }
+ { deploy-reflection 6 }
+ { deploy-word-defs? t }
+ { deploy-math? t }
+ { deploy-ui? t }
+ { deploy-word-props? t }
+ { deploy-io 3 }
}
diff --git a/extra/drills/deployed/deployed.factor b/extra/drills/deployed/deployed.factor
index 43873c99bb..5681c73438 100644
--- a/extra/drills/deployed/deployed.factor
+++ b/extra/drills/deployed/deployed.factor
@@ -1,11 +1,11 @@
-USING: accessors arrays cocoa.dialogs combinators continuations
+USING: arrays cocoa.dialogs combinators continuations
fry grouping io.encodings.utf8 io.files io.styles kernel math
math.parser models models.arrow models.history namespaces random
sequences splitting ui ui.gadgets.alerts ui.gadgets.book-extras
ui.gadgets.books ui.gadgets.buttons ui.gadgets.frames
ui.gadgets.grids ui.gadgets.labels ui.gadgets.tracks fonts
wrap.strings system ;
-
+EXCLUDE: accessors => change-model ;
IN: drills.deployed
SYMBOLS: it startLength ;
: big ( gadget -- gadget ) T{ font { name "sans-serif" } { size 30 } } >>font ;
diff --git a/extra/drills/drills.factor b/extra/drills/drills.factor
index 9ee4e9b6eb..8251851511 100644
--- a/extra/drills/drills.factor
+++ b/extra/drills/drills.factor
@@ -1,10 +1,11 @@
-USING: accessors arrays cocoa.dialogs combinators continuations
+USING: arrays cocoa.dialogs combinators continuations
fry grouping io.encodings.utf8 io.files io.styles kernel math
math.parser models models.arrow models.history namespaces random
sequences splitting ui ui.gadgets.alerts ui.gadgets.book-extras
ui.gadgets.books ui.gadgets.buttons ui.gadgets.frames
ui.gadgets.grids ui.gadgets.labels ui.gadgets.tracks fonts
wrap.strings ;
+EXCLUDE: accessors => change-model ;
IN: drills
SYMBOLS: it startLength ;
diff --git a/extra/merger/deploy.factor b/extra/merger/deploy.factor
index adaab737c3..39a73eab82 100644
--- a/extra/merger/deploy.factor
+++ b/extra/merger/deploy.factor
@@ -1,14 +1,14 @@
USING: tools.deploy.config ;
H{
- { deploy-math? t }
- { deploy-io 2 }
- { deploy-unicode? t }
+ { deploy-name "Merger" }
{ deploy-c-types? f }
{ "stop-after-last-window?" t }
- { deploy-ui? t }
- { deploy-reflection 1 }
- { deploy-name "Merger" }
- { deploy-word-props? f }
+ { deploy-unicode? f }
{ deploy-threads? t }
+ { deploy-reflection 1 }
{ deploy-word-defs? f }
+ { deploy-math? t }
+ { deploy-ui? t }
+ { deploy-word-props? f }
+ { deploy-io 2 }
}
diff --git a/extra/merger/merger.factor b/extra/merger/merger.factor
index c4986bf47f..ee9207e4ca 100644
--- a/extra/merger/merger.factor
+++ b/extra/merger/merger.factor
@@ -1,4 +1,5 @@
-USING: accessors arrays fry io.directories kernel models sequences sets ui
+USING: accessors arrays fry io.directories kernel
+models sequences sets ui
ui.gadgets ui.gadgets.buttons ui.gadgets.labeled
ui.gadgets.tracks ui.gadgets.labels ui.gadgets.glass
math.rectangles cocoa.dialogs ;
diff --git a/extra/ui/frp/gadgets/gadgets.factor b/extra/ui/frp/gadgets/gadgets.factor
index 08c7b44002..f80ecf55dc 100644
--- a/extra/ui/frp/gadgets/gadgets.factor
+++ b/extra/ui/frp/gadgets/gadgets.factor
@@ -21,7 +21,7 @@ M: frp-table row-color color-quot>> [ call( a -- b ) ] [ drop f ] if* ;
: <frp-table> ( model -- table ) f frp-table new-table dup >>renderer
V{ } clone <basic> >>selected-values V{ } clone <basic> >>selected-indices* ;
: <frp-table*> ( -- table ) V{ } clone <model> <frp-table> ;
-: <frp-list> ( model -- table ) <frp-table> [ 1array ] >>quot ;
+: <frp-list> ( column-model -- table ) <frp-table> [ 1array ] >>quot ;
: <frp-list*> ( -- table ) V{ } clone <model> <frp-list> ;
: indexed ( table -- table ) f >>val-quot ;
diff --git a/extra/ui/frp/signals/signals.factor b/extra/ui/frp/signals/signals.factor
index c7c9736111..8dc87a7fbb 100644
--- a/extra/ui/frp/signals/signals.factor
+++ b/extra/ui/frp/signals/signals.factor
@@ -10,25 +10,25 @@ M: multi-model model-activated dup dependencies>> dup length 1 =
TUPLE: basic-model < multi-model ;
M: basic-model (model-changed) [ value>> ] dip set-model ;
-: <merge> ( models -- model ) basic-model <multi-model> ;
-: <basic> ( value -- model ) basic-model new-model ;
+: <merge> ( models -- signal ) basic-model <multi-model> ;
+: <basic> ( value -- signal ) basic-model new-model ;
TUPLE: filter-model < multi-model quot ;
M: filter-model (model-changed) [ value>> ] dip 2dup quot>> call( a -- ? )
[ set-model ] [ 2drop ] if ;
-: <filter> ( model quot -- filter-model ) [ 1array filter-model <multi-model> ] dip >>quot ;
+: <filter> ( model quot -- filter-signal ) [ 1array filter-model <multi-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 ;
-: <fold> ( oldval quot model -- model' ) 1array fold-model <multi-model> swap >>quot
+: <fold> ( oldval quot model -- signal ) 1array fold-model <multi-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 ;
-: <updates> ( values updates -- updater ) [ 2array updater-model <multi-model> ] 2keep
+: <updates> ( values updates -- signal ) [ 2array updater-model <multi-model> ] 2keep
[ >>values ] [ >>updates ] bi* ;
TUPLE: switch-model < multi-model original switcher on ;
@@ -41,20 +41,20 @@ M: switch-model model-activated [ original>> ] keep model-changed ;
: >behavior ( event -- behavior ) t <model> swap <switch> ;
TUPLE: mapped-model < multi-model model quot ;
-: new-mapped-model ( model quot class -- const-model ) [ over 1array ] dip
+: new-mapped-model ( model quot class -- mapped-model ) [ over 1array ] dip
<multi-model> swap >>quot swap >>model ;
-: <mapped> ( model quot -- mapped ) mapped-model new-mapped-model ;
+: <mapped> ( model quot -- signal ) mapped-model new-mapped-model ;
M: mapped-model (model-changed)
[ [ value>> ] [ quot>> ] bi* call( old -- new ) ] [ nip ] 2bi
set-model ;
TUPLE: side-effect-model < mapped-model ;
M: side-effect-model (model-changed) [ [ value>> ] [ quot>> ] bi* call( old -- ) ] keep t swap set-model ;
-: $> ( model quot -- side-effect-model ) side-effect-model new-mapped-model ;
+: $> ( model quot -- signal ) side-effect-model new-mapped-model ;
TUPLE: quot-model < mapped-model ;
M: quot-model (model-changed) nip [ quot>> call( -- b ) ] keep set-model ;
-: <$ ( model quot -- quot-model ) quot-model new-mapped-model ;
+: <$ ( model quot -- signal ) quot-model new-mapped-model ;
TUPLE: action-value < basic-model parent ;
: <action-value> ( parent value -- model ) action-value new-model swap >>parent ;
@@ -63,7 +63,7 @@ M: action-value model-activated dup parent>> dup activate-model model-changed ;
TUPLE: action < multi-model quot ;
M: action (model-changed) [ [ value>> ] [ quot>> ] bi* call( a -- b ) ] keep value>>
[ swap add-connection ] 2keep model-changed ;
-: <action> ( model quot -- action ) [ 1array action <multi-model> ] dip >>quot dup f <action-value> >>value value>> ;
+: <action> ( model quot -- action-signal ) [ 1array action <multi-model> ] dip >>quot dup f <action-value> >>value value>> ;
TUPLE: | < multi-model ;
: <|> ( models -- product ) | <multi-model> ;
diff --git a/extra/ui/frp/xfrp-docs.factor b/extra/ui/frp/xfrp-docs.factor
deleted file mode 100644
index fb63d7f1b9..0000000000
--- a/extra/ui/frp/xfrp-docs.factor
+++ /dev/null
@@ -1,46 +0,0 @@
-USING: help.markup help.syntax models monads sequences
-ui.gadgets.buttons ui.gadgets.tracks ;
-IN: ui.frp
-
-! Layout utilities
-
-HELP: ,
-{ $values { "uiitem" "a gadget or model" } }
-{ $description "Used in a series of gadgets created by a box, accumulating the gadget" } ;
-HELP: ->
-{ $values { "uiitem" "a gadget or model" } { "model" model } }
-{ $description "Like " { $link , } "but passes its model on for further use." } ;
-HELP: <hbox>
-{ $values { "gadgets" "a list of gadgets" } { "track" track } }
-{ $syntax "[ gadget , gadget , ... ] <hbox>" }
-{ $description "Creates an horizontal track containing the gadgets listed in the quotation" } ;
-HELP: <vbox>
-{ $values { "gadgets" "a list of gadgets" } { "track" track } }
-{ $syntax "[ gadget , gadget , ... ] <hbox>" }
-{ $description "Creates an vertical track containing the gadgets listed in the quotation" } ;
-
-! Gadgets
-HELP: <frp-button>
-{ $values { "text" "the button's label" } { "button" button } }
-{ $description "Creates an button whose model updates on clicks" } ;
-
-HELP: <merge>
-{ $values { "models" "a list of models" } { "model" basic-model } }
-{ $description "Creates a model that merges the updates of others" } ;
-
-HELP: <filter>
-{ $values { "model" model } { "quot" "quotation with stack effect ( a b -- c )" } { "filter-model" filter-model } }
-{ $description "Creates a model that uses the updates of another model when they satisfy a given predicate" } ;
-
-HELP: <fold>
-{ $values { "oldval" "starting value" } { "quot" "applied to update and previous values" } { "model" model } { "model'" model } }
-{ $description "Similar to " { $link reduce } " but works on models, applying a quotation to the previous and new values at each update" } ;
-
-HELP: <switch>
-{ $values { "signal1" model } { "signal2" model } { "signal'" model } }
-{ $description "Creates a model that starts with the behavior of model1 and switches to the behavior of model2 on its update" } ;
-
-ARTICLE: { "frp" "instances" } "FRP Instances"
-"Models are all functors, as " { $link fmap } " corresponds directly to the " { $link "models.arrow" } " vocabulary. "
-"Also, a gadget is a monad. Binding recieves a model and creates a new gadget." ;
-
From 27623f3a48d5149a11f0c645d65135a42ed4c6fa Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Mon, 25 May 2009 15:29:44 -0500
Subject: [PATCH 049/128] ui.frp documentation added
---
extra/darcs-ui-demo/commands/commands.factor | 34 +++++++++
extra/darcs-ui-demo/darcs-ui-demo.factor | 72 +++++++++++++++++++
extra/darcs-ui-demo/icons/add.tiff | Bin 0 -> 3012 bytes
extra/darcs-ui-demo/icons/app.tiff | Bin 0 -> 3012 bytes
extra/darcs-ui-demo/icons/pull.tiff | Bin 0 -> 3949 bytes
extra/darcs-ui-demo/icons/push.tiff | Bin 0 -> 3985 bytes
extra/darcs-ui-demo/icons/rec.tiff | Bin 0 -> 3952 bytes
extra/darcs-ui-demo/icons/rem.tiff | Bin 0 -> 3012 bytes
extra/darcs-ui-demo/icons/send.tiff | Bin 0 -> 3949 bytes
extra/ui/frp/frp-docs.factor | 13 ++++
extra/ui/frp/functors/functors-docs.factor | 10 +++
extra/ui/frp/gadgets/gadgets-docs.factor | 31 ++++++++
extra/ui/frp/instances/instances-docs.factor | 9 +++
extra/ui/frp/layout/layout-docs.factor | 30 ++++++++
extra/ui/frp/signals/signals-docs.factor | 30 ++++++++
15 files changed, 229 insertions(+)
create mode 100644 extra/darcs-ui-demo/commands/commands.factor
create mode 100644 extra/darcs-ui-demo/darcs-ui-demo.factor
create mode 100644 extra/darcs-ui-demo/icons/add.tiff
create mode 100644 extra/darcs-ui-demo/icons/app.tiff
create mode 100644 extra/darcs-ui-demo/icons/pull.tiff
create mode 100644 extra/darcs-ui-demo/icons/push.tiff
create mode 100644 extra/darcs-ui-demo/icons/rec.tiff
create mode 100644 extra/darcs-ui-demo/icons/rem.tiff
create mode 100644 extra/darcs-ui-demo/icons/send.tiff
create mode 100644 extra/ui/frp/frp-docs.factor
create mode 100644 extra/ui/frp/functors/functors-docs.factor
create mode 100644 extra/ui/frp/gadgets/gadgets-docs.factor
create mode 100644 extra/ui/frp/instances/instances-docs.factor
create mode 100644 extra/ui/frp/layout/layout-docs.factor
create mode 100644 extra/ui/frp/signals/signals-docs.factor
diff --git a/extra/darcs-ui-demo/commands/commands.factor b/extra/darcs-ui-demo/commands/commands.factor
new file mode 100644
index 0000000000..a8148d3b6c
--- /dev/null
+++ b/extra/darcs-ui-demo/commands/commands.factor
@@ -0,0 +1,34 @@
+USING: arrays closures continuations darcs-ui io.encodings.utf8
+io.launcher kernel regexp sequences fries xml xml.data xml.traversal
+ui.gadgets.alerts ;
+IN: darcs-ui-demo.commands
+
+: extract ( tag name -- string ) tag-named children>string ;
+: prepare-patches ( changelog -- table-columns )
+ string>xml "patch" tags-named
+ [ [ "name" extract ]
+ [ [ "author" attr ] [ "local_date" attr ] bi ]
+ bi 3array
+ ] map ;
+: patches ( method search -- table-columns )
+ [ drop "" ] [ i" --_ \"_\"" ] if-empty
+ i" darcs changes --xml-output _" run-desc prepare-patches ;
+
+: whatsnew ( -- matches ) "darcs whatsnew" run-desc R/ ^[^+-].*/m all-matching-subseqs ;
+
+: pull ( repo -- ) i" darcs pull -a _" [ try-process ] [ 2drop "Can't connect" alert* ] recover ; inline
+: repo-push ( repo -- ) i{ "darcs" "push" "-a" _ } [ try-process ] [ 2drop "Push refused" alert* ] recover ; inline
+: send ( repo -- ) i{ "darcs" "send" "-a" _ } [ try-process ] [ 2drop "Sending failed" alert* ] recover ; inline
+: app ( file -- ) i{ "darcs" "apply" "-a" _ } [ try-process ] [ 2drop "Applying failed" alert* ] recover ; inline
+: record ( quot name author -- ) i{ "darcs" "record" "--skip-long-comment" "-m" _ "--author" _ }
+ utf8 rot with-process-writer ; inline
+
+: cnts ( file patch -- result ) i" exact \"_\"" swap i{ "darcs" "show" "contents" "--match" _ _ }
+ [ run-desc ] [ 2drop "File doesn't exist for selected patch" ] recover ;
+: files ( -- str ) "darcs show files" [ run-desc ] [ drop "Error showing files" alert* ] recover ;
+
+: init-repo ( -- ) "darcs init" try-process ;
+: add-repo-file ( files -- ) { "darcs" "add" "-r" } prepend
+ [ try-process ] [ 2drop "File already exists in repository" alert* ] recover ;
+: remove-repo-file ( files -- ) { "darcs" "remove" } prepend
+ [ try-process ] [ 2drop "File doesn't exist in repository" alert* ] recover ;
\ No newline at end of file
diff --git a/extra/darcs-ui-demo/darcs-ui-demo.factor b/extra/darcs-ui-demo/darcs-ui-demo.factor
new file mode 100644
index 0000000000..ccbda7b4b2
--- /dev/null
+++ b/extra/darcs-ui-demo/darcs-ui-demo.factor
@@ -0,0 +1,72 @@
+USING: accessors arrays cocoa.dialogs closures continuations
+darcs-ui.commands fry file-trees io io.files io.directories
+io.encodings.utf8 kernel math models monads sequences
+splitting ui ui.gadgets.alerts ui.frp ui.gadgets.comboboxes
+ui.gadgets.labels ui.gadgets.scrollers ui.baseline-alignment
+ui.images unicode.case ;
+EXCLUDE: fries => _ ;
+IN: darcs-ui-demo
+: <patch-viewer> ( columns -- scroller ) <frp-table>
+ [ first ] >>val-quot
+ { "Patch" "Author" "Date" } >>column-titles
+ <scroller> ;
+
+: <change-list> ( {str} -- gadget ) <frp-list> t >>multiple-selection? indexed <scroller> ;
+
+: answer ( length indices -- ) [ index [ "y" ] [ "n" ] if write ] curry each flush ;
+
+: patches-quot ( -- model-of-quot )
+ [ whatsnew [ length <model> ] keep <model>
+ [ <change-list> ->% 1 "okay" <frp-button> [ close-window ] >>hook
+ -> <updates> [ [ answer ] 2curry ] 2fmap-&
+ ] <vbox> { 229 200 } >>pref-dim "select changes" open-window
+ ] [ drop [ ] "No changes!" alert f <model> ] recover ;
+
+: <darcs-button> ( str -- button ) i" vocab:darcs-ui-demo/icons/_.tiff" <image-name> <frp-button> ;
+: <patch-button> ( str -- model ) <darcs-button> -> [ drop patches-quot ] bind ;
+
+: load-pref ( name file -- model ) "_darcs/prefs/" prepend dup exists?
+ [ utf8 [ readln ] with-file-reader <model> nip ]
+ [ '[ dup _ utf8 set-file-contents ] swap ask-user swap fmap ] if ;
+
+: toolbar ( -- file-updates patch-updates )
+ "add" <darcs-button> -> [ drop open-dir-panel [ add-repo-file ] when* ] $>
+ "rem" <darcs-button> -> [ drop open-panel [ remove-repo-file ] when* ] $>
+ 2array <merge> >behavior
+ "rec" <patch-button> dup [ drop "Patch Name:" ask-user ] bind dup
+ C[ drop "Your Name:" "author" load-pref ] bind C[ record ] 3$>-&
+ "push" <darcs-button> -> [ "Push To:" "defaultrepo" load-pref ] bind* C[ repo-push ] $> ,
+ "pull" <darcs-button> -> [ "Pull From:" "defaultrepo" load-pref ] bind* C[ pull ] $>
+ "send" <darcs-button> -> [ "Send To:" "defaultrepo" load-pref ] bind* C[ send ] $> ,
+ "app" <darcs-button> -> C[ open-dir-panel [ first app ] when* ] $> 3array <merge> >behavior ;
+
+: darcs-window ( -- ) [
+ [
+ toolbar
+ <spacer>
+ { "PATCHES:" "MATCHES:"
+ "FROM-TAG:" "FROM-PATCH:" "FROM-MATCH:"
+ "TO-TAG:" "TO-MATCH:" "TO-PATCH:"
+ } <combobox> -> [ but-last >lower ] fmap
+ <frp-field> { 100 10 } >>pref-dim ->% 1
+ ] <hbox> +baseline+ >>align ,
+ [
+ C[ rot drop patches ] 3fmap-| <patch-viewer> ->% .5
+ [ C[ drop files "\n" split create-tree ] fmap <dir-table> <scroller> ->% .5
+ [ file? ] <filter> [ comment>> ] fmap
+ ] dip
+ ] <hbox> ,% .5
+ C[ cnts ] 2fmap-| "Select a patch and file to see its historical contents" <model>
+ swap <switch> <label-control> <scroller> ,% .5
+ ] <vbox> "darcs" open-window ;
+
+DEFER: open-file
+: create-repo ( -- ) "The selected folder is not a darcs repo. Would you like to create one?" { "yes" "no" } ask-buttons
+ [ C[ drop [ init-repo darcs-window ] [ drop "Can't write to folder" alert* ] recover ] $> activate-model ]
+ [ [ drop open-file ] $> activate-model ] bi* ;
+
+: open-file ( -- ) [ open-dir-panel
+ [ first [ "_darcs" exists? [ darcs-window ] [ create-repo ] if ] with-directory ] unless-empty
+ ] with-ui ;
+
+MAIN: open-file
\ No newline at end of file
diff --git a/extra/darcs-ui-demo/icons/add.tiff b/extra/darcs-ui-demo/icons/add.tiff
new file mode 100644
index 0000000000000000000000000000000000000000..c17d99617bec62c056b63d24d675bda9bf589843
GIT binary patch
literal 3012
zcmeH_&yUhT6vt;+H7lp}u;{KHns}%&(g8M_w4u8PjgdfstR`}0p}X63X-R3)O89Z$
zkKm8d#EXA`e+VEyjwFurDuV>GF4=6oXqyl7=Dj!XJMU3VLr)RH3PO>u2%+e5-A2Ki
zKJx43imAK8iGF5Ss`%~WXHhV!s`&o7meA@i^>gD*)6w5H^Y1E6vm#f;qr<eX__caX
zcguobyRaIHuZrcWeWEMO1~(CfAjLIRv7{9R*S0TA!xd7J9G9O7r%t)1d$wZ=N$G`n
z7)?9XQ|0*8>qRxTQ^j-Ftt*6ho+o(+lI@(4q%6xMks_&7oMprtA1t@*$F0U=CKlYn
zC@qg!4Jo*gRIzKsD3PR;AWSHlCJQMhN|s%)&2kL7#d`NxlV}HhN4MC_Fav(Ly@&CN
z9YI?x46z4zE3h#n<2wsG!t8rIKZ5Y?!p~0N826(+e4pEQzu<jz`==z@#t)bF4t}&!
z|H(@I<6r*Br$Bw5ofjDJ#2C9F66^JPwAE_ScDwx>olb{d1)S@4yO#p>`~5zh&*z~5
z_5W*ZHs61FR>fkG0-Jt|*O`^3X%q-kBbUoj;HEVSg#yjz^TGYI*(?R17w|#sPkNiq
z>LxS>g8>~5hnE6(hWWt#Gnq^P*x-X0oL>j(fsglbmBy+**WfkQYx6yiUq^%gAG`*y
zxxVr^*MR+|@b7BVe6BGXjc8bKjq!L)!-8u}CKDPKTw^+&(y;iO8nfAqh6V2<?3Gg5
JV{}8L_XFM=yb%BZ
literal 0
HcmV?d00001
diff --git a/extra/darcs-ui-demo/icons/app.tiff b/extra/darcs-ui-demo/icons/app.tiff
new file mode 100644
index 0000000000000000000000000000000000000000..e823240eac87bc1b77eb97446df16387d0633d5d
GIT binary patch
literal 3012
zcmdT_ZA?>V6u!5ufP77Zh%j*lG}j>XLW$ejQAmJINI(fFFopt_f~EEYC{mgX#*d*t
zNSKKc+z1IQB*TPgh+@JZxXBpsV<Y_92*f}_7P5(K;#c{&drsGj-4=yl_G5=U-1DCI
ze4qDyn~}jpG7PI`7|8^~Fy0$qFUI*7pJ=lbYYjT9{H(4_Z_;oNzaHY``VtM7do&{^
z!;-8!r%$z4>ay*}PipN3t*V4eOo+FsZAObxXDyc7jOR^NYMX{DE-|0gslk(&=j2Wm
zt3ku%Wn{{&X7hQ2-YQorRMDy^d1+;_QCDNGG{|EWZ*vLW@s%Z|>a3IxT;8zKaObR6
zi<;+aYHAcUaSC%~86T@ssrVQruT(}uBf6^AWG%Kuo2nuZ%$bEgZ^O(~rEn&s(3*|B
zK97%8#PA5@9nZT$At=951r{4^(3wzs4T@xTG3$&BJ!1j-C-T88>&8nMDYj{EA1ih8
zEGe@dE?xqDx2P{+*g%&Y7VKV8&IGeTBENH(4Pkct6_W8{-`wDLvHRWpA9nMf^+GNg
za7GV-y&U-8kgu;VbL7YoX3w5I|3%Kyf`Wnz0%&S#N|>0K5F#QXZXr-8;GFMk1SNZ#
z|HTIn9th>-<v*vSq;%+Xx`E;0VFC5@W6%FJ{F5p9Z=k%Jo1449rvUFoMMb?+S68=k
z_3Bjt>yLnK6Z&JHo0}6ZU%uSr>FG)5k7DBVGSXwmj@?{dUKafP{65EeJN=U8<m8yB
z{~X7S!AG>qkLXKkGMOIIKIHao#GpG^ivBp_;^G|W|Bs=eq3=URH4w2_?<4<3MMd|q
zjwcyyY>}k!Sv)>I{>*GPKkn-4dUp5j-6f?`c@Fl}BQ_u)An^9>+rycenV(>N6rh8=
z)fm$H`uaa8zoew3XB{0K&l?*XmtkKC1Ol=H2M*kz{oLH#i&(3GodDInl^9aBTAe}m
zsi~=sgoK3WBO@b^VOs|T0A9F%ezbr6`gMw{0ek@RPuPs82Wh>%y}zZWr$5(dG%IUs
zYZU7O<of{+z~|DXOJDW$^sM^$`22!<aR@R`0KZ9_$H3c=gxnTvHrvydmKF!{cfkM0
zEX$G)51CB18$JB8t*!0R>C>l|r>CbWev~W5W<8SNT)w-sv?S!`=P$OmxBoggIJg2^
z>JRlnCXq;PE-Wkv{r&x`(0N4l;r@M(J(|y^{-G1s+S)p!)oK@TkB0jC`W#ZJ^fSn*
z|J0wiW@l%Gfq{WloTVpYV`D2g%RfM#4Um5kVE;wb|47Vu3O#y=o_v~?mNuo=>*=jH
z4A6ZJF&GS;_wL<W3knK)a^=dEm220oO+x-5a1bDR>8$Z4csDdO^iy8p;o&KXiHTWw
zD+JuzJlMtH{Dj)=_Ak)4CpZI7@m=lg?EJ~!-=E@({Sm(u>z~ACWo1>-8RU8XJ8bR(
zlwo0EeYLf<0^T5@si}$Hr^n!D7Z(?W<mBXO=oGp+67Rd4=x?mVVzD$+3`pAn%7<*?
z(YqUEWn}_#7{{z{b$56Fe&WQ58So|8rx_8E?yG7b9Z6(lWI4{cfcXu%^l3hl9U#m+
zN}*6>qc@9)SA<!){|1rXR*2>qaq85m35o-M`B+nKB=;{YEL@zKnGuXe<1Fq)2xOGA
zSS#2q5uF7OygLP$@%)`Tch=yy7x$zQ-=5LYQQ^#)Gxt%?N$8O-`FGZd?^a3Fe*--`
zUR_=N?d0U-`uzO-`q0pjqoShX8!s=f95|yhv=^W^bvNJ#(7mU6sc!P~s=0`{$#5S1
z<Z?NW_e6m&2fKqV9KtsYpm_uX6w4Q&cb4v_7~^Ge#2Dh2Y$!MCjR-MUv2J&tWG4db
G3;Gj#sp!rC
literal 0
HcmV?d00001
diff --git a/extra/darcs-ui-demo/icons/pull.tiff b/extra/darcs-ui-demo/icons/pull.tiff
new file mode 100644
index 0000000000000000000000000000000000000000..b89d6339f18e491bb9e1fb57d54a86d642ad87b7
GIT binary patch
literal 3949
zcmd^CeNa@_6~Av6A}n7EL4qGiUnXr<G3+i2qPt;9U=fW4L?98=V0M=W>@2%)ySoOK
zHkeYYMvXdZ8k>+QDN3y-Q8ArpY3n%J&UB{JW}1H3B-2_(qxb=`i_9e1^z@v!A1qW!
z>$HFME@$uWp7T4ubMJlky?s<xvK+?ZUSdr4K4VM~?Gu>vDQOZd0$<%KdPPsG=;BSa
z`Fy3>YID+<>9pFV2K>|M`Md&yR&UVhP(-FJDJxwjQ!?godfhe4OZobSwfwC2Q89_#
z&+^&hW~;|lQe9nvWabo|0`*hd#Ge>Po)2<KYijIEM+&RU?L}4)P1huNtc-D5#P)Wt
z3;kRV;!KNO!p8}_>uOBsKaV)IC4~P#*b>5*2)l6+$QdVoi-ctfge@UFpRiZxpt{T?
zx_oY1ORJa19n$ilO|12Kyn@5SKjpNFZkOmbdxa+ChUQ0EEImY|9b1s6*DqZtdH;)F
zbR9x+fz{Ifa#_Eb^i3ABZgf8%9&xgK#=dMksnL_o*s4Q#qJopYf|nWVeT=cRS0;Ur
z<}s$!F!qa{q9;0BW~*KB@)n`R<}|8C2hXT@Ta!_>W^tvq(q$4_Z7Vw6LTzVNowd_$
z)i<f0C@$(SbU0iN!E5F_9BodIp~I*$(@`}bCbve#OBAo&sH(55=DniWX1C$>Q0sH`
zkMYfJvqNYX-F7}tU8pKn6uFz44K-!uVKp2XRjppH%b?M;x3{a?^VOoeMT6HwuhHr>
zI$bU@ay>q$*W8io^gM#aq*>VNqiIf$TAGmBDmpZ_dQF~MtHDAFUMf|Fhth3xd2OPT
zr_yGNxY27=sT6!zN$9XmPGO1`MIvfEUqnNLNo*6{wYZH!v9?Gv-G!ndTD7f1Xsa)?
zIRvK%D;Mhu!sO|JsTmD-%ZLf!x-_(qn1$hDLq6PB++j`hlHnkF%>^f3=ytrKER+3%
z#o?ioZhQQS;5i%@gJn#P9ExRgatU*k!QB_eGQ{Z-e*BNQ*<n9sa9I&Qo5MX2!HMU&
zxhy_hH-VcM#Y%2|jQ)Zc{XB+M*h6SMr;~6d;$p65k}vxi%}O>4t$VA7QBMz`nyt1-
z-S|y7W=!78g|l$bD~m)~cCUOAOU(bHFL`#}>NJDnXh!AtM#$2u4%{LmOn!>r>vqVL
zd|_tA%NG|rj*i)X_(#}&c0{rrXGejI#^k3s@reJQ)KX~H?fYuun`7TOeFeJDOn~d{
zac~?C{ELyF;>069<^4N#k~HgIEp#3k+j8EI+5xa1^g~-e;<o~lc}|Q28I8$LapDo5
z@+g0%Ix^)~mOQ$l*WZ0E0OC>79s|#SAADy5P_^f`lIg@_x5;Qseu@*1_>@Qaq;r=#
zTvo-7p^YamgZu3<aQ5E<-{3fuZ#nlx#;RApP-xd5A&Z;8#79P${1hi1@hOk;Ne634
zPmI`F@(0v)de_l_?^FPs2S?%gcl}V>HTYRZsqc4OyaIoA@M#mWH0;ST$xrc;uAhEJ
ze9EJI(jh(M#5PW8XgSu{^LzNlJEJ(K5%9cs9cEYU8Rz72JQDFmO1iJ<X%%UN6%<cd
zxof=j<S^L!M!<#nq(gcbk6nv=?y8;F#gm_a>+lV5zcT`lcMS#;7p;CBd5P1wIE*&Z
zNF?6kZ=McX58VWF?{#QBehEkqW3h9JpIfs(===FCa2&h=!jYTsaN`?+xU5C^sv|ww
zqM~;IGU5^6ih0lWT!ZF!M<8|OE_&^vCu*eqFKck~D!TvjVC`<d+VXn9b8-~c?z;jT
z`mRHct^c-i<+ibmWiMR7iNx+}WM0u;p0#Mr!;L+DGw$=c*M`Az;u@r^*zqY6@X5{O
z8HVP8suu?)w*1l$jeXbP>D`xM-4BMrergm7oQH3xEU}&-UR3Z7AR%Yf{=&|m1Szln
zz*Tsr{~{=tcV9y))u3OL)byp6_ZHd?O_&F6!rC{l0`;nvgA>VxmeUju^RT-^lf@;b
zF5etj|JEgVX8$Fq@3{g`zVs_dDR^!G*^ytk`w-7gF4%DDYeL^dBkEJ1TxcF7KN`jF
zxK~`<tW>4ZezvIn*r)Y4x0+o;u=Yp8@X)#g0eMzVBj(W>s8N2XPX4o}=GN`;W4#&m
z<=N_n#GI<V$>p0rH@z_Mc|-qIsM>iEs`n1T*T4TEq?Uc_3Tmc=wXu_0q)w(h<B<mR
z&^<kU{xm0<vaIVyUh^CN+HGgRb$l4A_Wd1JeD`B`YWrWIy7w~Pw>tu|v<EB0`PfZq
zREOR;=sHE-N@5ALxADo#z8!oTwN~u<8<<|a0H#fUhVrc+!^+o&VBVVj;|V#{hmbdY
z4Y4{iVX8eV$+Rh0{>l)PZvF^Lx<7<vyDx%q+Xrxe#kN4gf{H%mq@&Gv4reGr|IQ>N
znYx0-J3j*B_6wl#orO7dd&g6r-1vz+Z9Y8%NuT!MUYoRz6n*orlS(?r(Z&?I=g!Hq
z7CJc&-@QWnbFcG{%!%elM)wQ8JxaQCwrTIDpAU51Q=>CMMsp=iIs=5sch~k$5^8qS
literal 0
HcmV?d00001
diff --git a/extra/darcs-ui-demo/icons/push.tiff b/extra/darcs-ui-demo/icons/push.tiff
new file mode 100644
index 0000000000000000000000000000000000000000..56513ebb3203d07b3542ceb28a540220c90003fc
GIT binary patch
literal 3985
zcmeHJdr*|u6~EtyE(=MOOsU0$IG++&O@Un=CfSuod5F9gH;YwFMsaspV1w-L?0$h2
z8#P2wN=#xD(;768+G!`G)1+x0)hJ2KOv5DYXp%OGt<9)0zCeT(5X1D>bC=hGSUM(u
zb$a3K_dDmFdw%zvbH9gP&+cVxMgwEwF~(T%*j34Ve`zHSvsE&bJ7kBu+~Jfm3KJx~
z$zro}oyBW359sJWUMs~V>NJVE#rIJVQInRLzElihtkN#KjLXucqSX&cfyXG~ZS4Cj
zfh{pv+|D$EA)lO?-C?)#>%`IjHzsh)Cow$M#JOp;V2jfwlh+VQe2LX<VNB2vuBeus
zWEYwVhng#V_!W*_D~uUrf1mKIvSIuw$L3-D6~``0f_$!W|1uvIl^mOgaX81a)x&vN
zhQqnRWh*O}C904{8ZKht2DfajbW1sQi^Jt~xJ<IOgnWnh$5*jCh8=mu7RG6{4=nOo
zzr!Eihv9JE2YvMw=6p168z-_n>Z%&i1TlfJ>Gbg!&0&l!{}r96p>bQ{4#rxd8JpcS
zZi|XzEJV%Nk>;dSkJDtSu*#CzT4u8+tGW-ht0Y@VvTD_0y+-fMu$J4hYh2dCnt~OU
znhJ}yM3tJ7<k5L5ot0MEBzY>=+ub@(vdYAds*W%>t5uTEMXpFz73mF<>~O5Fuu(r^
zwK3Xgsnlhvv{pM@6;fR6eX5k;Bv(nP&X}1s5{<NERk<uXb!v5Wb#-iYLaf78rly`~
z)tY#9e0&Uf#JD%uWs@hy?v5Zb-!5!LW6SLBSl@<XEsjdHtw<dgt5FkCu;io4q(kYl
zIc1x}E^%s;+3~2HtWpI_Bay5g+xQkH#Nsof(IhE}tGW!wdWWl!%4ki|B&jExDCn@8
z!RE29FUqu4TJ3IPPKi$(ah^OeamDJJt?-+mywp4qzr-lnVH?$zDy$xB87X5ux7w-E
z)zncI%KpV>(4q6)_VhD~=L&)!7FhuK@VPJ{z=s9CLQsrgk?<X({xkn9{9wdRD}*_t
zb~ab|;V2GzU$~Ra9N|?8ca7l?A>1$iLcjQNj9Az_5=n^n;ZVXUf^pnme4Fn|3?!-D
z=4SlLA3(-!wo%@hn@ML((ISkjBBezfon>Jy0e*ODAIZ;0;=%quzT*lA0`K&MAqu{Z
zPq5vp5^(2YLC9-`BColZDQ3~5ld;F{5BlYM1qvK22<i>u=loj^G0G6|)1!l^IeZQ2
z^&di*qYgNtS6=_-3p=iV`UqZJJ3mbMEqR2<<x1y~Yq0)$5M^zH#M6Pc{LrCqJ~LzJ
zLj$gVT#Cbb1wsOuFUMO+Nr)^^I*7yEI)LK61CZbBhnT$&XFJL<^g#iJI+kPLuO1xA
z4}_9GBW^N;+v(Q7CzmAe1_{*3O8Z;HvA+*%_FScFKjb(1kk!zE4fQn`csGyoF;YG@
z>|eVe>}EVv^I5g+-KcxF=LV^5??XvzAJ#qRMR60!9xqJKUxlr$AGPm!v2m*hgYV>G
z@Mr<99e)I`Q$8VzDe4xH7wBpqpmlw)wt6RsWxp5e_Vl25x1Tiiz`VB?wwL;l-}nJe
zz4{;q4(4Fss1bc1*Wma1K+K-RBShpXorn8T($b4{O;`Rq*>eTv=X+4~rWau=_v4>!
z26*4dL*LO==si}2S0?pGh{z!h%AutPrl#(jO7X64tl4!LYo5J~hj(7aLnLeWUV-bN
z7pYs?aj0npx?V~{*B`Rc{U;NiEDRqzYr=wM#Bmj+FLcAay9?`fbz${Womlx~CyWi3
zkY9fhxm%}@x{EOEzKoyzwhKbW)A*z@8fTx2#<|}l;_T}>JggEU>6rPR5yFBjW$9a9
ztZeFpzU~6DYtK(FPn<{Y_6sl`;PH3hHF**K-WZ89tufS}1RTf~5g5Qf%K6)b#{4X0
z(QCaZXu5>l#tRc9XWMyXJ^nSaw)hF@+4bkK{1=^ARCNfyvq$0hWAkuwXC%ISIR-B-
z6ERCcALJuBa0>BmZQ#A0w-K}P$UwB`@C1qVyyMN;c>(F0&me8%X{2vDgRGyOLtgVm
zsN_GQ!L$U&H{6ZSx6j8%+vj1GN=Tsn-|ioubI{;-=w0;8(@qvTbIDmPok-qt3c9M3
zNZon{8T-zG{dgN*wnyMtbvRBuy#Oa#R9F!u@V!qJpL6g*Z(bHe!fQAtf|MSTx$hE|
zZ2A(~s(&E$nXf2*9bRpS#$Pti!)NspPP`C>pDz`7{r^*Z3On^64rOxFMQFF4hPL4}
zW@l~E)ut+kK5t!!6VKj*j=FFdY5ybfrw%fWRglt@_doSD5*tr}rPhK4C_<lEDqcT%
zU?IMs{TrsQ&om5l9_IW=!BQTFn6jy#&Ag4*TUo4`(Y7;Fz>Z9@|5ocWiI~m<eQz-~
Xmt?fw-=i<TQQHmg;YsWNXViZK+he*r
literal 0
HcmV?d00001
diff --git a/extra/darcs-ui-demo/icons/rec.tiff b/extra/darcs-ui-demo/icons/rec.tiff
new file mode 100644
index 0000000000000000000000000000000000000000..06dc4c9e213b505c64f0f81b8835b890064838c8
GIT binary patch
literal 3952
zcmd^AYfKbZ6uz@+p%7b*)=IHDTGO?SF#7<NEr`1+ZB<%8qu4*P><+L2b~d{stYReX
zA1SPVswF0ZQK2!`{!nY835_C}sFha1`mBf|Z&@pf3qG>9=gjQFvMN5(e?8>e`<-*Y
zbMD-8?+nSw<WoXMy9iO7CxnCzj-f>Q)0>4%o=wRSM8T0G*x1E+d_Hd#9jqo=MKmf^
zj7}A&)2LbX99>L|E_N=|P^k2a42u=x2+6mK_O#CpZ2IbN*pTy3Fq}*vTJo9E<gn>e
zQkH?3SOqJO<8bp_A`C_@L}9Jrb1(J6Og6g+s;2;rnRl27VN}3#3q>2mnF`<&Gjk=r
zAGv)++Cqq*1pZF8%>P23Df3q3cGv`H`cR)OaYZQdOqowXF7i%Xmn;-)>+F{79Fc_%
zsaUy(%hx$XKHtH9X*CIUn_xGJycx9e^I;YlFAK3_v(#~M^FEQH|KSgwgIw-Gs?=X*
zQvFbDXd%;Ddx6hm6k0-F<`31Vm`upmKf#51Iuwi9OvujJguMIXQ0!whA>%kgj#k7c
zI&DT%E-$i~e741!p!}!in3A=a6O^lBlU2#Kg?x_Xi}iMX`TDO`nAYc-;>^m#`SDJj
zGvAiai$>O&pJ#RGoC!)J-c%iM40B3Wl8Ctp%Jk$ERuqK1Tnn5>bX-*2Y&Oeo%;yUQ
zdoHVvo}-)}7H>Ca>CzS@`Kp1Jpv)0Pn~viO3k#zQwb6n-n}ain<5U_>qlp4Vlw+M$
zG&-ZKj*nn5=_xGfgK1VrwDdsHCLy1*q;u+M6$cB2vC>kD;8NNxHqjzjSzOwfDXbL}
zl*%yHSBZC8h8|&9Eu8UJW7&9gbqj?&!M+^Y$j_e>8>@|t=YqpfSeB+(oP1vTA`864
z4p@DDOq@>~JTW|DbwGwDFe6|B_Qv660yYO5mSfOc=rT8WY~T!@J8y-<E`(Dh6N#6M
zhKnb?`talD5eyT+6=W1>aBea)O5zM=FmL&|0{D2pe#|e-d%ieiFq8ao62ZLh=Wm~6
zJ|JU!>xMFsgM1t_C7}MSfck0ztB?-?ETfV5MBoWb+K^uH8$OjH9PsTX2MNIsBWO}L
zS^Vpc`3`(SM(t$eEK1=;QTS(xdgrJ?4&UgJje!<LMn)2Y!7yXx%9T#D*?c%BC+8xL
z=o|Eg890x+H??{5<|SDymhO!ki@gUA{z@-hx=e51Zk0y#F^==7d)+lcLPGG_rxq0z
zwH!Hegx<K(Oj}#qo<VbSGsSt-p&s*I#X>_vNos0pe0h1fr>Uulwzs#x6iwHgDC$#E
zQsXiIWv10=rxq6%d+^!YJ344b0G{#Nhvsoln5WTdr;fBncz8I;%E~IJtE;1(on5aD
z%)@-F^CDZI*N1N3UNO*p=ML@e_92k_V>mu1-qF!XU9Qao`UUzIHY_6}qolsRp7!+g
zJcFj%T6%QN8oEC=RvK@BAE>(nIajV+p?mlKOfxc!CC}T(gb5SKh7B7UIy*b*-Me>(
z;o5-%^q5{xPii#u6aYu`G49vmy*qvS46Us_PMywm4OlPOIF2J*wrug-yVpx)+=KBR
z?Yj0itu+|vS*@1V2LOGHcU-+nZ{2F4=gys{_4R*9C@J~ggY|+<uh)}ZyLNf+-@i|L
z0rz`lTt9S(o(QNNxQ-OBs-g{z7ieRHjE06rx^?STFV+jTWy_Y4ef##&zP`R;xVXK7
zo`N;bLVtc&s|RsLrJ{8lM^BWN!Z}=}S1!xA47_s34vO`HZOM`)WY3;GUXRB^{dn-;
z0liRFO^-u8tQic9*H>23n>TL)Zqa4{^2*9eFV+jTxpU`|ZQHha1_lNw0(;ik)kSYM
zHqxVsiS$gs9&kVCA5C09Z$Y2%&IaO#AGUa~Ua(D{KApH+F88BHkLW;uKXtqB!rgRB
z__M5x9*16?!G8Hh^fB(1G<er#ZI9bcOG``LSTES{dj@y6q^0FHefaR9bmqOjb9cA3
z(eqHRcIi@D1Mdfp4OqXeUD_||Wc1Q&a1XK0i@uL5SFH-Is;+`<^ut~TD2_4*ANtpi
z@Wtd2`Woc#-o1MO>jdw??@yaHjg*v>w6wu<KYsFrJ^}bg<b!w|!2NNEwL%`|W1W$V
z=lQ8sRaG857q8d*%0NBlVg5+<ac=C`v814&Ailb~+Jo=Ps~GA~k9nB?Di#qDLCRb%
z__tH;#q%G@a2|DKWv+6}dmWoOb0%3|RFnkYh3=Y~8gENWi*(+&9-cS)7{__|Uz>#b
oH!+1mL1JQJNM2svjE%*`PWWaXuBfQEh$H&B5ZA&y>i!S*FJ*7F&;S4c
literal 0
HcmV?d00001
diff --git a/extra/darcs-ui-demo/icons/rem.tiff b/extra/darcs-ui-demo/icons/rem.tiff
new file mode 100644
index 0000000000000000000000000000000000000000..14d6a66efe989ecb258f10aa71849d0724121b3a
GIT binary patch
literal 3012
zcmeH`&2G~`5XX02Ky6Ot&_Y`dmN*z8;!RS4WGiV8AVicnK?R9i-NbDz*LLJsvWfC>
z$V22|K;ps!@E}RZ$1xJij)_eqQrZKKgj8EUdv<nb{xf4)QP5L_u#6D*4Iz|>-kT`6
zv&Vj2ts0ukpK9m2l@q>y`XcapEhl_<uB4RuOYK5`({!|V&C>g7)2K={;rJ-)%f4AR
zHCN?*^U`X_eojzp_NgW_8{9<TgCnky6DrDE-nH#ZLwEU%C?%z5{F$SgnrAx(pB7&T
zM~SRcJCjddy<TKvtDJD*x^<Zl&+|m@P_&(Ml9nWiq%tIvNwO2k#z)Il{iM}+%*28!
z^hy+FHN>DGv1*${uaLBuB1|ZeB?~DgN}?{<A{v8cvEDt_B-%zl&>c22%z#H|?_s=T
zb7+HY!`?%@5!e_G<9iF6WA^><Jcsbk!p|b`Zs<pQ_(5oIeZ~9e?k`ESi4P)s8$Vjg
z|70ou$!|aRIZ)qc@jL^rotW8ewOX{@ZvR22)1fy3V!Pe$mGpW&I-k#DrQh$znjh-F
z)wuaLyq(qmHLG&DOiQH_RTPC53WW$*gCF*<`-iXl=Ko4#Fc{F`aJUkvw^%F&_2=_>
z8Uj6mANC=B6_6AB(8u32uF?+ut8$0Fb!&t*#r1|+jYgwb0gdr^94nwPnM`5@G^W#O
VtgK68Hk;8nfj-s&rL-F}y`LGZ<j4R3
literal 0
HcmV?d00001
diff --git a/extra/darcs-ui-demo/icons/send.tiff b/extra/darcs-ui-demo/icons/send.tiff
new file mode 100644
index 0000000000000000000000000000000000000000..3d9b1f5e719ada260abd9cf436243b72ebb38e30
GIT binary patch
literal 3949
zcmds4dsvg_75@@oRXbPv%yo9_vnRSoQ=Jlsc9U>XK|5W!H4w{17$gJ;kPAsLfEQY&
zq99eFSf~t@dIReNPDN1^omW6EB7zeTt;KS$OhHh(-`@8N;gY(w+q3@DkDTxQo%5da
zJMTH~`{g5UZp<8pvE0Hi+!}^qCXI{}81`>Th*~P=d4{X?YF)Tm!*lVP&vOfwDO6Nv
zgf=z{MdTy2<Jm3{+1QDMwuFRhvt+6BGVT<HQL6M>@gJReKE8gumud*(%goQ2`HX$A
zOs84m>FG+G8I@Wkr{nmmzn<Yx%guR|Yy8}IYLjFdt)6%d5fO&SbuxzG*bp3P&})dD
zlTGkcX(WpaDb{+6U5Nb>!9NQ#;yQ|@M*JnkT2ch@c|!feSj?S3vDAp)pja=DrFj__
zwI)uh2n*NqNQZ2A#wL2j>GX1?j<-T3Q)@M9ZLnS*LVS(uqfyMOMn~GQH*M|g7S3j^
z|Hm8M2P56%ciH}OUb{YO8%-pO(XJlWINbRR^IiHVNA@&^@z_sJ)X=DHK`O)SnaeP*
zWQ^Kok%KZtz%b{s9TvrEf@P6%Jx?kRQ>YyIU!N)E^AsVD{P*5+vvJe7$io%O<F#_H
zcz17Ee5A}SgulqiAyyQt)F|cpU|y^;N~IIUI`V_*Q56wP%>q7;b<syU@_pPqd3v=v
zDpEoA!`g11-CSO%HdrY)sI`$iTkGHRohCVGLqbL3rEd?j5zUbwuGecs0)fF`ur|!M
zR%^oqWKZk_HbQ|=IFESD)5WRu!LjpHy5Evy>?#yKBVj6?HM<~dnOZ4O_y}yRZ3HCI
zBp#b;DLIr{g+{MXt9UeZuv8tRcjWUY@rIe?v5L_pjN_s+CN>_=fvO@Gb(C7`McOEL
zvT+cYn+U1V%~KI8kMdcnP|8(0lG#bPVA$DwVtj<}zl#_%LFy9FLdFzEiZ$9uUrC1r
zBU?t4kv*5I$VMB;jxtl3e=?Tj(6Ns_xtZ|m9L^ZbWh{sfotwt7U@?bAaDFn3xdgvz
z^0&(4{9@QnA~>&^?9A(&Uz+g5OPpUZR>OHGaDF|4r*PgF!~f<Oep`lQVSYn|#}Tr4
zD#1=1@u)wygszJF5|Ir_I);w)3rL)#Fy*yMAUeZX?BNVY5oHh8G|NoeV=;<Z&mZB<
z*4B2rx3~A8tE=mMp-`AEkw}KjvAO;tKgvP5%v(f!cc!Lp#j|IF=;&xietsT?hMs>5
z|ED=q4CSC)l+%>Q%F61Mz`#I!^UV;3o<C=$y{8ZD-A{}%7E{|;-3*)JDHr9W+%%7+
zrRC&+RjV*KIDmnH0R(Nk3~^%V|0I%4=kfIEQ<iI$zdtDVa4j72p2~`j)}ZH6FIKEO
zjT5(raGc1|`tK*l8iv>y-!12H`(8WJ($YXV2|xQpTUc03^z-vWeSJOJI=b-Ax?&u<
z@f;av2e9qb)9)qeB?H)B^&CD)rKoFaMN3Nye0_aExkq{x5P<&veth*+8{F5Q!v5-K
zgu5R}g?&go+>H+owIN~Omm{))=!u{Au=CU>wWuGt*9YOh`5bERJV1Y6ALzQr_R8AY
zI!mjKM(e{icq9~&9D_*t>(|(DuniHL&%j@ojg?X9tVkl$5U_eL*6wb`#{6z16+A}j
z@h8|@F@RNDN>F?I9(L^54$3*USG2CWx;lLEpcQUwk6~}s0Jao%LjHaMBoW)7tf
zoI9*+%xyqGOb+~_Gm(&cADfOm!q(&e!0z$^1Z+8j>iWBAZf?fPl`F^fit4?+kI;Pg
z9vq_&W5?efA!6GVtO!a%T+Us>mj&;zWLARX_rs7`17CFpB9n@-@lZRd`4Mu;`tj%F
z)2OU#B3!-j@$nhy746v%orCsl?%cUqp`oE@Y-)ys`Vc-U?SZ#87w;Jg;i1@xz%>O(
z&TnO9nIsx9A74krrXtAKeU8Mu4kQ=$Ap2S$f|83-d9xAQw{HXG9J?Q4u^3fVm1t=A
zJM5MFkxX)UsCL08z6dUUiBM-gfbx_3tk}87K(+H8yj7n<@nJEx7Ib2BK^L;FK7lml
zB+6?V(Aanf<a=v$KP)UJdyyQSogJvVbqn@Ux!8Q67w?2;z}IjDj*|D`yRHO(3fslX
z{N+)2H#!f_{z=efH9?!*iiEs&WL|lUkdz{nRo_B)R~J@FB(Nmh^!Xqc=XZ1FWXYsb
z)ZVOvC}KB0y3`9V!f!8*gIHGp2QvB_4zjY$e*@kQOoms?Q3P(PKzMo!l)Jt_LU9k=
z<MVOxS~XIVlR-HtH%&mFMGtp(l$V#GvZ@+(;eWxJGu?>U(*n2942V2d!&R9FN&H!(
z#Fb#F^b@@0x|*!xB&4Z#5SDQlu_rpQOuG-o=dYo*_68`Y={YCkWKRzdJbc)SvWf~U
z4Eq%N;x4Q{@Br%%+=u+b<D_rtaF*_1WqD{C>EUNkWmH0!(}Li%MucQGLwlkFF65k?
zEWOO;aCdW~ImnM7_TtQ*Jv%EXC<tZc75IZZ6Y8Q4s7Q?RXd6B#=|swfZlqoA8Ik1k
zU5GzroTomjW9@8=vt~Dn&R)d&_3JTx`t-Ggo$VEu%biHxZ@7BpGRn)!uw0W3`|vD?
z!ZZIXp)rdhvQT#QDk`sE2j!&Pv<liQT32&(6Px4Q*%BN)T!`EQhw<6L!`OG|$Otyq
z$IczdFTk18r%`t88k(CLG2E+>b2V$`%yjxrx!q8Y%a<-9apMNmR9E4``O<ONTsQZt
zy-|Z3HPxW|J9Fkt`c7wiMQb6K6|sH1c=6&sdwcr_vu4f8advioYL3nI7x_6kId#vN
jF(ZX?vdp75nvdFkN`%(;^6+Sm&Gi@gQ4adwDtrA4-X=&u
literal 0
HcmV?d00001
diff --git a/extra/ui/frp/frp-docs.factor b/extra/ui/frp/frp-docs.factor
new file mode 100644
index 0000000000..1e9c0b771f
--- /dev/null
+++ b/extra/ui/frp/frp-docs.factor
@@ -0,0 +1,13 @@
+USING: help.syntax help.markup ;
+IN: ui.frp
+ARTICLE: { "ui.frp" "index" } "Functional Reactive Programming"
+"The " { $vocab-link "ui.frp" } " vocabulary is a take on functional reactive programming for user interfaces. The library is implimented as a set of models collectively called signals, and is made up of multiple submodles, all of which can be imported collectively from ui.frp" $nl
+{ $vocab-subsection "Using signals:" "ui.frp.signals" }
+{ $vocab-subsection "Creating user interfaces:" "ui.frp.layout" }
+{ $vocab-subsection "Using gadgets:" "ui.frp.gadgets" }
+{ $vocab-subsection "Combining signals:" "ui.frp.functors" }
+{ $vocab-subsection "Typeclass instances:" "ui.frp.instances" }
+"To get the hang of using the library, check out " { $vocab-link "darcs-ui-demo" } $nl
+"For more information about frp, go to http://haskell.org/haskellwiki/Functional_Reactive_Programming"
+;
+ABOUT: { "ui.frp" "index" }
\ No newline at end of file
diff --git a/extra/ui/frp/functors/functors-docs.factor b/extra/ui/frp/functors/functors-docs.factor
new file mode 100644
index 0000000000..256be95702
--- /dev/null
+++ b/extra/ui/frp/functors/functors-docs.factor
@@ -0,0 +1,10 @@
+USING: help.markup help.syntax ui.frp.signals ;
+IN: ui.frp.functors
+
+ARTICLE: { "ui.frp.functors" "signal-collection" } "Signal Collection"
+"While " { $vocab-link "models.arrow.smart" } " use arrows and products to apply a quotation to the values of more than one signal, frp has more than one kind of arrow, as well as more than one kind of product" $nl
+"A simple pattern is used to generate the requisite 'smart mapping' functions: "
+"if 'word' maps a function on a model, then '2word; would map on two models. "
+"The product is specified on the end: '2word-product'. " { $link | } " updates when any of the model it collects updates, while " { $link & } " updates when all dependencies have new values. "
+"Examples of collection functions are 2fmap-| and 2$>-&" ;
+ABOUT: { "ui.frp.functors" "signal-collection" }
\ No newline at end of file
diff --git a/extra/ui/frp/gadgets/gadgets-docs.factor b/extra/ui/frp/gadgets/gadgets-docs.factor
new file mode 100644
index 0000000000..208e87f4a3
--- /dev/null
+++ b/extra/ui/frp/gadgets/gadgets-docs.factor
@@ -0,0 +1,31 @@
+USING: help.markup help.syntax ui.gadgets.buttons
+ui.gadgets.editors ui.frp.gadgets ;
+IN: ui.frp.gadgets
+
+HELP: <frp-button>
+{ $values { "gadget" "the button's label" } { "button" button } }
+{ $description "Creates an button whose signal updates on clicks. " } ;
+
+HELP: <frp-table>
+{ $values { "model" "values the table is to display" } { "table" frp-table } }
+{ $description "Creates an " { $link frp-table } } ;
+
+HELP: <frp-table*>
+{ $values { "table" frp-table } }
+{ $description "Creates an " { $link frp-table } " with no initial values to display" } ;
+
+HELP: <frp-list>
+{ $values { "column-model" "values the table is to display" } { "table" frp-table } }
+{ $description "Creates an " { $link frp-table } " with a val-quot that renders each element as its own row" } ;
+
+HELP: <frp-list*>
+{ $values { "table" frp-table } }
+{ $description "Creates an frp-list with no initial values to display" } ;
+
+HELP: indexed
+{ $values { "table" frp-table } }
+{ $description "Sets the output model of an frp-table to the selected-index, rather than the selected-value" } ;
+
+HELP: <frp-field>
+{ $values { "field" model-field } }
+{ $description "Creates a field with an empty initial value" } ;
\ No newline at end of file
diff --git a/extra/ui/frp/instances/instances-docs.factor b/extra/ui/frp/instances/instances-docs.factor
new file mode 100644
index 0000000000..12d5fdbe21
--- /dev/null
+++ b/extra/ui/frp/instances/instances-docs.factor
@@ -0,0 +1,9 @@
+USING: help.markup help.syntax monads ui.frp.signals ;
+IN: ui.frp.instances
+IN: ui.frp.instances
+ARTICLE: { "ui.frp.instances" "explanation" } "FRP Instances"
+"Signals are all functors, as " { $link fmap } " corresponds directly to " { $link <mapped> } $nl
+"Moduls also impliment monad functionalities. " { $link bind } "ing switches between two models. " $nl
+"Also, a gadget is a monad. Binding recieves a model and adds the resulting gadget onto the parent. " $nl
+"Examples of these instances can be seen in the " { $vocab-link "darcs-ui-demo" } " vocabulary." ;
+ABOUT: { "ui.frp.instances" "explanation" }
\ No newline at end of file
diff --git a/extra/ui/frp/layout/layout-docs.factor b/extra/ui/frp/layout/layout-docs.factor
new file mode 100644
index 0000000000..3679572669
--- /dev/null
+++ b/extra/ui/frp/layout/layout-docs.factor
@@ -0,0 +1,30 @@
+USING: help.markup help.syntax models ui.gadgets.tracks ui.frp.layout ;
+IN: ui.frp.layout
+
+HELP: ,
+{ $values { "uiitem" "a gadget or model" } }
+{ $description "Used in a series of gadgets created by a box, accumulating the gadget" } ;
+
+HELP: ,%
+{ $syntax "gadget ,% width" }
+{ $description "Like ',' but stretches the gadget to always fill a percent of the parent" } ;
+
+HELP: ->
+{ $values { "uiitem" "a gadget or model" } { "model" model } }
+{ $description "Like ',' but passes its model on for further use." } ;
+
+HELP: ->%
+{ $syntax "gadget ,% width" }
+{ $description "Like '->' but stretches the gadget to always fill a percent of the parent" } ;
+
+HELP: <spacer>
+{ $description "Grows to fill any empty space in a box" } ;
+
+HELP: <hbox>
+{ $values { "gadgets" "a list of gadgets" } { "track" track } }
+{ $syntax "[ gadget , gadget , ... ] <hbox>" }
+{ $description "Creates an horizontal track containing the gadgets listed in the quotation" } ;
+HELP: <vbox>
+{ $values { "gadgets" "a list of gadgets" } { "track" track } }
+{ $syntax "[ gadget , gadget , ... ] <hbox>" }
+{ $description "Creates an vertical track containing the gadgets listed in the quotation" } ;
\ No newline at end of file
diff --git a/extra/ui/frp/signals/signals-docs.factor b/extra/ui/frp/signals/signals-docs.factor
new file mode 100644
index 0000000000..2cc455c7ff
--- /dev/null
+++ b/extra/ui/frp/signals/signals-docs.factor
@@ -0,0 +1,30 @@
+USING: help.markup help.syntax models models.arrow sequences ui.frp.signals ;
+IN: ui.frp.signals
+
+HELP: <merge>
+{ $values { "models" "a list of models" } { "signal" basic-model } }
+{ $description "Creates a signal that merges the updates of others" } ;
+
+HELP: <filter>
+{ $values { "model" model } { "quot" "quotation with stack effect ( a b -- c )" } { "filter-signal" filter-model } }
+{ $description "Creates a signal that uses the updates of another model only when they satisfy a given predicate" } ;
+
+HELP: <fold>
+{ $values { "oldval" "starting value" } { "quot" "applied to update and previous values" } { "model" model } { "signal" model } }
+{ $description "Similar to " { $link reduce } " but works on models, applying a quotation to the previous and new values at each update" } ;
+
+HELP: <switch>
+{ $values { "signal1" model } { "signal2" model } { "signal'" model } }
+{ $description "Creates a signal that starts with the behavior of signal1 and switches to the behavior of signal2 on its update" } ;
+
+HELP: <mapped>
+{ $values { "model" model } { "quot" "applied to model's value on updates" } { "signal" model } }
+{ $description "The signal version of an " { $link <arrow> } } ;
+
+HELP: $>
+{ $values { "model" model } { "quot" "applied to model's value on updates" } { "signal" model } }
+{ $description "Like " { $link <mapped> } ", but doesn't produce a new value" } ;
+
+HELP: <$
+{ $values { "model" model } { "quot" "applied to model's value on updates" } { "signal" model } }
+{ $description "Opposite of " { $link <$ } "- gives output, but takes no input" } ;
\ No newline at end of file
From 07ec9de32b371f164fee6e6b741e7ed6f92f1313 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Mon, 25 May 2009 15:31:43 -0500
Subject: [PATCH 050/128] darcs-ui-demo uses bevel buttons
---
extra/darcs-ui-demo/darcs-ui-demo.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/darcs-ui-demo/darcs-ui-demo.factor b/extra/darcs-ui-demo/darcs-ui-demo.factor
index ccbda7b4b2..fadd4cf7a5 100644
--- a/extra/darcs-ui-demo/darcs-ui-demo.factor
+++ b/extra/darcs-ui-demo/darcs-ui-demo.factor
@@ -17,7 +17,7 @@ IN: darcs-ui-demo
: patches-quot ( -- model-of-quot )
[ whatsnew [ length <model> ] keep <model>
- [ <change-list> ->% 1 "okay" <frp-button> [ close-window ] >>hook
+ [ <change-list> ->% 1 "okay" <frp-bevel-button> [ close-window ] >>hook
-> <updates> [ [ answer ] 2curry ] 2fmap-&
] <vbox> { 229 200 } >>pref-dim "select changes" open-window
] [ drop [ ] "No changes!" alert f <model> ] recover ;
From e0216e2fe891c939ecd455ff28f85b20ecf98bd0 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Tue, 26 May 2009 14:26:11 -0500
Subject: [PATCH 051/128] fixed hang bug in ui.gadgets.tables
---
basis/pseudo-slots/pseudo-slots.factor | 14 --------------
basis/ui/gadgets/tables/tables.factor | 12 +++++++-----
2 files changed, 7 insertions(+), 19 deletions(-)
delete mode 100644 basis/pseudo-slots/pseudo-slots.factor
diff --git a/basis/pseudo-slots/pseudo-slots.factor b/basis/pseudo-slots/pseudo-slots.factor
deleted file mode 100644
index 27308beab3..0000000000
--- a/basis/pseudo-slots/pseudo-slots.factor
+++ /dev/null
@@ -1,14 +0,0 @@
-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 8848a0fe77..2ec0ca4c59 100644
--- a/basis/ui/gadgets/tables/tables.factor
+++ b/basis/ui/gadgets/tables/tables.factor
@@ -2,11 +2,11 @@
! 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 pseudo-slots sequences ui.gadgets
+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
+ui.gadgets.menus ui.gadgets.line-support models
+combinators combinators.short-circuit
fonts locals strings vectors ;
IN: ui.gadgets.tables
@@ -52,7 +52,9 @@ multiple-selection? ;
: in>out ( vector -- val/f ) [ f ] [ peek ] if-empty ;
: out>in ( val/f -- vector ) [ 1vector ] [ V{ } clone ] if* ;
IN: accessors
-PSEUDO-SLOTS: selected-value selected-index selected-index* ;
+SLOT: selected-value
+SLOT: selected-index
+SLOT: selected-index*
M: table selected-value>> selected-values>> [ in>out ] <illusion> ;
M: table (>>selected-value) [ [ out>in ] <illusion> ] dip (>>selected-values) ;
M: table selected-index>> selected-indices>> in>out ;
@@ -257,7 +259,7 @@ PRIVATE>
: (selected-rows) ( table -- {row} )
[ selected-indices>> ] keep
- [ nth-row [ 1vector ] [ drop V{ } clone ] if ] curry map concat ;
+ [ nth-row [ 1array ] [ drop { } ] if ] curry map concat >vector ;
: selected-rows ( table -- {value} )
[ (selected-rows) ] [ renderer>> ] bi [ row-value ] curry map ;
From 3c4850bb5cbc0405b8628b50b7929dae9a285ba7 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Tue, 26 May 2009 14:40:57 -0500
Subject: [PATCH 052/128] no reexporting
---
extra/darcs-ui-demo/darcs-ui-demo.factor | 3 ++-
extra/file-trees/file-trees.factor | 3 +--
extra/modules/util/util.factor | 7 -------
extra/ui/frp/authors.txt | 1 -
extra/ui/frp/frp-docs.factor | 13 -------------
extra/ui/frp/frp.factor | 4 ----
extra/ui/frp/signals/signals.factor | 6 ++++--
extra/ui/gadgets/alerts/alerts.factor | 5 +++--
8 files changed, 10 insertions(+), 32 deletions(-)
delete mode 100644 extra/modules/util/util.factor
delete mode 100644 extra/ui/frp/authors.txt
delete mode 100644 extra/ui/frp/frp-docs.factor
delete mode 100644 extra/ui/frp/frp.factor
diff --git a/extra/darcs-ui-demo/darcs-ui-demo.factor b/extra/darcs-ui-demo/darcs-ui-demo.factor
index fadd4cf7a5..739254b6c8 100644
--- a/extra/darcs-ui-demo/darcs-ui-demo.factor
+++ b/extra/darcs-ui-demo/darcs-ui-demo.factor
@@ -1,7 +1,8 @@
USING: accessors arrays cocoa.dialogs closures continuations
darcs-ui.commands fry file-trees io io.files io.directories
io.encodings.utf8 kernel math models monads sequences
-splitting ui ui.gadgets.alerts ui.frp ui.gadgets.comboboxes
+splitting ui ui.gadgets.alerts ui.frp.gadgets ui.frp.layout
+ui.frp.signals ui.frp.instances ui.gadgets.comboboxes
ui.gadgets.labels ui.gadgets.scrollers ui.baseline-alignment
ui.images unicode.case ;
EXCLUDE: fries => _ ;
diff --git a/extra/file-trees/file-trees.factor b/extra/file-trees/file-trees.factor
index a3108aa922..fa9411cfbf 100644
--- a/extra/file-trees/file-trees.factor
+++ b/extra/file-trees/file-trees.factor
@@ -1,7 +1,6 @@
USING: accessors arrays delegate delegate.protocols
io.pathnames kernel locals sequences
-vectors make strings ;
-EXCLUDE: ui.frp => , ;
+vectors make strings ui.frp.signals ui.frp.gadgets ;
IN: file-trees
TUPLE: walkable-vector vector father ;
diff --git a/extra/modules/util/util.factor b/extra/modules/util/util.factor
deleted file mode 100644
index 4e92d4139f..0000000000
--- a/extra/modules/util/util.factor
+++ /dev/null
@@ -1,7 +0,0 @@
-USING: accessors assocs kernel lexer locals namespaces sequences
-vocabs vocabs.parser ;
-IN: modules.util
-SYNTAX: EXPORT-FROM: [let | v [ current-vocab ] |
- v words>> ";" parse-tokens
- [ load-vocab vocab-words [ clone v name>> >>vocabulary ] assoc-map ] map
- assoc-combine update ] ;
\ No newline at end of file
diff --git a/extra/ui/frp/authors.txt b/extra/ui/frp/authors.txt
deleted file mode 100644
index 2300f69f11..0000000000
--- a/extra/ui/frp/authors.txt
+++ /dev/null
@@ -1 +0,0 @@
-Sam Anklesaria
diff --git a/extra/ui/frp/frp-docs.factor b/extra/ui/frp/frp-docs.factor
deleted file mode 100644
index 1e9c0b771f..0000000000
--- a/extra/ui/frp/frp-docs.factor
+++ /dev/null
@@ -1,13 +0,0 @@
-USING: help.syntax help.markup ;
-IN: ui.frp
-ARTICLE: { "ui.frp" "index" } "Functional Reactive Programming"
-"The " { $vocab-link "ui.frp" } " vocabulary is a take on functional reactive programming for user interfaces. The library is implimented as a set of models collectively called signals, and is made up of multiple submodles, all of which can be imported collectively from ui.frp" $nl
-{ $vocab-subsection "Using signals:" "ui.frp.signals" }
-{ $vocab-subsection "Creating user interfaces:" "ui.frp.layout" }
-{ $vocab-subsection "Using gadgets:" "ui.frp.gadgets" }
-{ $vocab-subsection "Combining signals:" "ui.frp.functors" }
-{ $vocab-subsection "Typeclass instances:" "ui.frp.instances" }
-"To get the hang of using the library, check out " { $vocab-link "darcs-ui-demo" } $nl
-"For more information about frp, go to http://haskell.org/haskellwiki/Functional_Reactive_Programming"
-;
-ABOUT: { "ui.frp" "index" }
\ No newline at end of file
diff --git a/extra/ui/frp/frp.factor b/extra/ui/frp/frp.factor
deleted file mode 100644
index f97dccdc03..0000000000
--- a/extra/ui/frp/frp.factor
+++ /dev/null
@@ -1,4 +0,0 @@
-USING: modules.util ui.frp.functors monads ;
-IN: ui.frp
-EXPORT-FROM: ui.frp.signals ui.frp.gadgets ui.frp.instances ui.frp.layout ;
-FMAPS: $> <$ fmap FOR & | ;
\ No newline at end of file
diff --git a/extra/ui/frp/signals/signals.factor b/extra/ui/frp/signals/signals.factor
index 8dc87a7fbb..3c6c4103bc 100644
--- a/extra/ui/frp/signals/signals.factor
+++ b/extra/ui/frp/signals/signals.factor
@@ -1,4 +1,4 @@
-USING: accessors arrays kernel models models.product sequences ;
+USING: accessors arrays kernel monads models models.product sequences ui.frp.functors ;
IN: ui.frp.signals
TUPLE: multi-model < model ;
@@ -81,4 +81,6 @@ M: | model-activated dup model-changed ;
! Only when everything's true does he make it false
TUPLE: & < | ;
: <&> ( models -- product ) & <multi-model> ;
-M: & models-changed dependencies>> [ f swap (>>value) ] each ;
\ No newline at end of file
+M: & models-changed dependencies>> [ f swap (>>value) ] each ;
+
+FMAPS: $> <$ fmap FOR & | ;
\ No newline at end of file
diff --git a/extra/ui/gadgets/alerts/alerts.factor b/extra/ui/gadgets/alerts/alerts.factor
index edecb90ee3..599bdd7279 100644
--- a/extra/ui/gadgets/alerts/alerts.factor
+++ b/extra/ui/gadgets/alerts/alerts.factor
@@ -1,5 +1,6 @@
-USING: accessors models macros generalizations kernel ui ui.frp
-ui.gadgets ui.gadgets.labels ui.gadgets.editors ui.gadgets.buttons
+USING: accessors models macros generalizations kernel ui
+ui.frp.gadgets ui.frp.signals ui.frp.layout ui.gadgets
+ui.gadgets.labels ui.gadgets.editors ui.gadgets.buttons
ui.gadgets.packs locals sequences fonts io.styles wrap.strings ;
IN: ui.gadgets.alerts
From 9755132d01c555e13b9f1eeecada0fad9fa00b7a Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Tue, 26 May 2009 16:56:05 -0500
Subject: [PATCH 053/128] removed occurences of peek in new tables
---
basis/inverse/vectors/vectors.factor | 2 +-
basis/ui/gadgets/tables/tables.factor | 6 +++---
2 files changed, 4 insertions(+), 4 deletions(-)
diff --git a/basis/inverse/vectors/vectors.factor b/basis/inverse/vectors/vectors.factor
index d2cca00af0..4672aed3ec 100644
--- a/basis/inverse/vectors/vectors.factor
+++ b/basis/inverse/vectors/vectors.factor
@@ -9,7 +9,7 @@ IN: inverse.vectors
\ 1vector [ 1 undo-nvector ] define-inverse
-\ peek [ 1vector ] define-inverse
+\ last [ 1vector ] define-inverse
! if is too general to undo, but its derivatives aren't
diff --git a/basis/ui/gadgets/tables/tables.factor b/basis/ui/gadgets/tables/tables.factor
index 2ec0ca4c59..fdeb7e05f9 100644
--- a/basis/ui/gadgets/tables/tables.factor
+++ b/basis/ui/gadgets/tables/tables.factor
@@ -49,7 +49,7 @@ mouse-index
focused?
multiple-selection? ;
-: in>out ( vector -- val/f ) [ f ] [ peek ] if-empty ;
+: in>out ( vector -- val/f ) [ f ] [ last ] if-empty ;
: out>in ( val/f -- vector ) [ 1vector ] [ V{ } clone ] if* ;
IN: accessors
SLOT: selected-value
@@ -264,7 +264,7 @@ PRIVATE>
: selected-rows ( table -- {value} )
[ (selected-rows) ] [ renderer>> ] bi [ row-value ] curry map ;
-: multiple>single ( values -- value/f ? ) [ f f ] [ peek t ] if-empty ;
+: multiple>single ( values -- value/f ? ) [ f f ] [ last t ] if-empty ;
: (selected-row) ( table -- value/f ? ) (selected-rows) multiple>single ;
: selected-row ( table -- value/f ? ) selected-rows multiple>single ;
@@ -306,7 +306,7 @@ PRIVATE>
M: table model-changed
nip dup update-selected-indices [ V{ } clone ] unless* {
[ >>selected-indices f >>mouse-index drop ]
- [ [ f ] [ peek ] if-empty show-row-summary ]
+ [ [ f ] [ last ] if-empty show-row-summary ]
[ drop update-selected-values ]
[ drop relayout ]
} 2cleave ;
From ef52d1b94d6a18e0d9d62c18068d26d54eafa780 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Wed, 27 May 2009 10:26:26 -0500
Subject: [PATCH 054/128] ui.gadgets.tables uses arrays, not vectors
---
basis/inverse/inverse.factor | 16 ++++++++++++++--
basis/inverse/vectors/authors.txt | 1 -
basis/inverse/vectors/summary.txt | 1 -
basis/inverse/vectors/vectors.factor | 24 ------------------------
basis/ui/gadgets/tables/tables.factor | 25 +++++++++++++------------
5 files changed, 27 insertions(+), 40 deletions(-)
delete mode 100644 basis/inverse/vectors/authors.txt
delete mode 100755 basis/inverse/vectors/summary.txt
delete mode 100644 basis/inverse/vectors/vectors.factor
diff --git a/basis/inverse/inverse.factor b/basis/inverse/inverse.factor
index cf97a0b2c8..7a9e821b37 100755
--- a/basis/inverse/inverse.factor
+++ b/basis/inverse/inverse.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2007, 2009 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel words summary slots quotations
+USING: accessors kernel locals words summary slots quotations
sequences assocs math arrays stack-checker effects
continuations debugger classes.tuple namespaces make vectors
bit-arrays byte-arrays strings sbufs math.functions macros
@@ -231,6 +231,18 @@ DEFER: __
\ output>sequence 2 [ [undo] '[ dup _ assure-same-class _ input<sequence ] ] define-pop-inverse
\ input<sequence 1 [ [undo] '[ _ { } output>sequence ] ] define-pop-inverse
+! conditionals
+
+:: undo-if-empty ( result a b -- seq )
+ a call( -- b ) result = [ { } ] [ 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
+
! Constructor inverse
: deconstruct-pred ( class -- quot )
"predicate" word-prop [ dupd call assure ] curry ;
@@ -283,4 +295,4 @@ M: no-match summary drop "Fall through in switch" ;
reverse [ [ [undo] ] dip compose ] { } assoc>map
recover-chain ;
-MACRO: switch ( quot-alist -- ) [switch] ;
+MACRO: switch ( quot-alist -- ) [switch] ;
\ No newline at end of file
diff --git a/basis/inverse/vectors/authors.txt b/basis/inverse/vectors/authors.txt
deleted file mode 100644
index f990dd0ed2..0000000000
--- a/basis/inverse/vectors/authors.txt
+++ /dev/null
@@ -1 +0,0 @@
-Daniel Ehrenberg
diff --git a/basis/inverse/vectors/summary.txt b/basis/inverse/vectors/summary.txt
deleted file mode 100755
index cb3c22991d..0000000000
--- a/basis/inverse/vectors/summary.txt
+++ /dev/null
@@ -1 +0,0 @@
-Inverses of Common Words on Vectors
diff --git a/basis/inverse/vectors/vectors.factor b/basis/inverse/vectors/vectors.factor
deleted file mode 100644
index 4672aed3ec..0000000000
--- a/basis/inverse/vectors/vectors.factor
+++ /dev/null
@@ -1,24 +0,0 @@
-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
- firstn ; inline
-
-\ 1vector [ 1 undo-nvector ] define-inverse
-
-\ last [ 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 fdeb7e05f9..e3ffa9237d 100644
--- a/basis/ui/gadgets/tables/tables.factor
+++ b/basis/ui/gadgets/tables/tables.factor
@@ -7,7 +7,7 @@ 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 models
combinators combinators.short-circuit
-fonts locals strings vectors ;
+fonts locals strings sorting ;
IN: ui.gadgets.tables
! Row rendererer protocol
@@ -49,8 +49,8 @@ mouse-index
focused?
multiple-selection? ;
-: in>out ( vector -- val/f ) [ f ] [ last ] if-empty ;
-: out>in ( val/f -- vector ) [ 1vector ] [ V{ } clone ] if* ;
+: in>out ( array -- val/f ) [ f ] [ first ] if-empty ;
+: out>in ( val/f -- array ) [ 1array ] [ { } ] if* ;
IN: accessors
SLOT: selected-value
SLOT: selected-index
@@ -63,15 +63,16 @@ M: table selected-index*>> selected-indices*>> [ in>out ] <illusion> ;
M: table (>>selected-index*) [ [ out>in ] <illusion> ] dip (>>selected-indices*) ;
IN: ui.gadgets.tables
-: push-selected-index ( table n -- table ) 2dup swap selected-indices>> index [ drop ] [ over selected-indices>> push ] if ;
+: push-selected-index ( table n -- table ) 2dup swap selected-indices>> index
+ [ drop ] [ over selected-indices>> swap suffix natural-sort >>selected-indices ] if ;
: new-table ( rows renderer class -- table )
new-line-gadget
swap >>renderer
swap >>model
- V{ } clone >>selected-indices
- V{ } clone <model> >>selected-values
- V{ } clone <model> >>selected-indices*
+ { } >>selected-indices
+ { } <model> >>selected-values
+ { } <model> >>selected-indices*
sans-serif-font >>font
focus-border-color >>focus-border-color
transparent >>column-line-color ; inline
@@ -259,12 +260,12 @@ PRIVATE>
: (selected-rows) ( table -- {row} )
[ selected-indices>> ] keep
- [ nth-row [ 1array ] [ drop { } ] if ] curry map concat >vector ;
+ [ nth-row [ 1array ] [ drop { } ] if ] curry map concat ;
: selected-rows ( table -- {value} )
[ (selected-rows) ] [ renderer>> ] bi [ row-value ] curry map ;
-: multiple>single ( values -- value/f ? ) [ f f ] [ last t ] if-empty ;
+: multiple>single ( values -- value/f ? ) [ f f ] [ first t ] if-empty ;
: (selected-row) ( table -- value/f ? ) (selected-rows) multiple>single ;
: selected-row ( table -- value/f ? ) selected-rows multiple>single ;
@@ -290,7 +291,7 @@ PRIVATE>
{
[ model>> value>> empty? not ]
[ selection-required?>> ]
- [ drop V{ 0 } clone ]
+ [ drop { 0 } ]
} 1&& ;
: (update-selected-indices) ( table -- {n}/f )
@@ -304,9 +305,9 @@ PRIVATE>
} 1|| ;
M: table model-changed
- nip dup update-selected-indices [ V{ } clone ] unless* {
+ nip dup update-selected-indices [ { } ] unless* {
[ >>selected-indices f >>mouse-index drop ]
- [ [ f ] [ last ] if-empty show-row-summary ]
+ [ [ f ] [ first ] if-empty show-row-summary ]
[ drop update-selected-values ]
[ drop relayout ]
} 2cleave ;
From d0c5b43dc5a5c036e28c6af5444f1585a74eb1da Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Wed, 27 May 2009 16:49:40 -0500
Subject: [PATCH 055/128] all signals update on activation
---
extra/ui/frp/signals/signals.factor | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/extra/ui/frp/signals/signals.factor b/extra/ui/frp/signals/signals.factor
index 3c6c4103bc..a08a49e329 100644
--- a/extra/ui/frp/signals/signals.factor
+++ b/extra/ui/frp/signals/signals.factor
@@ -5,8 +5,8 @@ TUPLE: multi-model < model ;
GENERIC: (model-changed) ( model observer -- )
: <multi-model> ( models kind -- model ) f swap new-model [ [ add-dependency ] curry each ] keep ;
M: multi-model model-changed over value>> [ (model-changed) ] [ 2drop ] if ;
-M: multi-model model-activated dup dependencies>> dup length 1 =
- [ first swap model-changed ] [ 2drop ] if ;
+M: multi-model model-activated dup dependencies>> [ value>> ] find nip
+ [ swap model-changed ] [ drop ] if* ;
TUPLE: basic-model < multi-model ;
M: basic-model (model-changed) [ value>> ] dip set-model ;
From bf3d2d3d97dffe0ae8df4bf496403572167cc174 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Wed, 27 May 2009 19:37:24 -0500
Subject: [PATCH 056/128] selective closures
---
extra/closures/closures.factor | 9 ++-
extra/darcs-ui | 1 +
extra/darcs-ui-demo/commands/commands.factor | 34 ---------
extra/darcs-ui-demo/darcs-ui-demo.factor | 73 -------------------
extra/darcs-ui-demo/icons/add.tiff | Bin 3012 -> 0 bytes
extra/darcs-ui-demo/icons/app.tiff | Bin 3012 -> 0 bytes
extra/darcs-ui-demo/icons/pull.tiff | Bin 3949 -> 0 bytes
extra/darcs-ui-demo/icons/push.tiff | Bin 3985 -> 0 bytes
extra/darcs-ui-demo/icons/rec.tiff | Bin 3952 -> 0 bytes
extra/darcs-ui-demo/icons/rem.tiff | Bin 3012 -> 0 bytes
extra/darcs-ui-demo/icons/send.tiff | Bin 3949 -> 0 bytes
extra/ui/frp/functors/authors.txt | 1 +
extra/ui/frp/gadgets/authors.txt | 1 +
extra/ui/frp/instances/authors.txt | 1 +
extra/ui/frp/instances/instances-docs.factor | 2 +-
extra/ui/frp/layout/authors.txt | 1 +
extra/ui/frp/signals/authors.txt | 1 +
17 files changed, 13 insertions(+), 111 deletions(-)
create mode 160000 extra/darcs-ui
delete mode 100644 extra/darcs-ui-demo/commands/commands.factor
delete mode 100644 extra/darcs-ui-demo/darcs-ui-demo.factor
delete mode 100644 extra/darcs-ui-demo/icons/add.tiff
delete mode 100644 extra/darcs-ui-demo/icons/app.tiff
delete mode 100644 extra/darcs-ui-demo/icons/pull.tiff
delete mode 100644 extra/darcs-ui-demo/icons/push.tiff
delete mode 100644 extra/darcs-ui-demo/icons/rec.tiff
delete mode 100644 extra/darcs-ui-demo/icons/rem.tiff
delete mode 100644 extra/darcs-ui-demo/icons/send.tiff
create mode 100644 extra/ui/frp/functors/authors.txt
create mode 100644 extra/ui/frp/gadgets/authors.txt
create mode 100644 extra/ui/frp/instances/authors.txt
create mode 100644 extra/ui/frp/layout/authors.txt
create mode 100644 extra/ui/frp/signals/authors.txt
diff --git a/extra/closures/closures.factor b/extra/closures/closures.factor
index 1411fa96c0..7fd08db998 100644
--- a/extra/closures/closures.factor
+++ b/extra/closures/closures.factor
@@ -1,4 +1,7 @@
-USING: fry namespaces kernel sequences parser ;
+USING: assocs io.pathnames fry namespaces kernel sequences parser ;
IN: closures
-: delayed-bind ( quot -- quot' ) '[ namestack [ set-namestack @ ] curry ] ;
-SYNTAX: C[ parse-quotation delayed-bind over push-all ;
+SYMBOL: |
+: delayed-bind-with ( vars quot -- quot' ) '[ _ dup [ get ] map zip [ _ bind ] curry ] ;
+SYNTAX: C[ | parse-until parse-quotation delayed-bind-with over push-all ;
+! Common ones
+SYNTAX: DIR[ parse-quotation { current-directory } swap delayed-bind-with over push-all ;
\ No newline at end of file
diff --git a/extra/darcs-ui b/extra/darcs-ui
new file mode 160000
index 0000000000..54edac761a
--- /dev/null
+++ b/extra/darcs-ui
@@ -0,0 +1 @@
+Subproject commit 54edac761ab48bee66f8db0210c27d52b72a94ef
diff --git a/extra/darcs-ui-demo/commands/commands.factor b/extra/darcs-ui-demo/commands/commands.factor
deleted file mode 100644
index a8148d3b6c..0000000000
--- a/extra/darcs-ui-demo/commands/commands.factor
+++ /dev/null
@@ -1,34 +0,0 @@
-USING: arrays closures continuations darcs-ui io.encodings.utf8
-io.launcher kernel regexp sequences fries xml xml.data xml.traversal
-ui.gadgets.alerts ;
-IN: darcs-ui-demo.commands
-
-: extract ( tag name -- string ) tag-named children>string ;
-: prepare-patches ( changelog -- table-columns )
- string>xml "patch" tags-named
- [ [ "name" extract ]
- [ [ "author" attr ] [ "local_date" attr ] bi ]
- bi 3array
- ] map ;
-: patches ( method search -- table-columns )
- [ drop "" ] [ i" --_ \"_\"" ] if-empty
- i" darcs changes --xml-output _" run-desc prepare-patches ;
-
-: whatsnew ( -- matches ) "darcs whatsnew" run-desc R/ ^[^+-].*/m all-matching-subseqs ;
-
-: pull ( repo -- ) i" darcs pull -a _" [ try-process ] [ 2drop "Can't connect" alert* ] recover ; inline
-: repo-push ( repo -- ) i{ "darcs" "push" "-a" _ } [ try-process ] [ 2drop "Push refused" alert* ] recover ; inline
-: send ( repo -- ) i{ "darcs" "send" "-a" _ } [ try-process ] [ 2drop "Sending failed" alert* ] recover ; inline
-: app ( file -- ) i{ "darcs" "apply" "-a" _ } [ try-process ] [ 2drop "Applying failed" alert* ] recover ; inline
-: record ( quot name author -- ) i{ "darcs" "record" "--skip-long-comment" "-m" _ "--author" _ }
- utf8 rot with-process-writer ; inline
-
-: cnts ( file patch -- result ) i" exact \"_\"" swap i{ "darcs" "show" "contents" "--match" _ _ }
- [ run-desc ] [ 2drop "File doesn't exist for selected patch" ] recover ;
-: files ( -- str ) "darcs show files" [ run-desc ] [ drop "Error showing files" alert* ] recover ;
-
-: init-repo ( -- ) "darcs init" try-process ;
-: add-repo-file ( files -- ) { "darcs" "add" "-r" } prepend
- [ try-process ] [ 2drop "File already exists in repository" alert* ] recover ;
-: remove-repo-file ( files -- ) { "darcs" "remove" } prepend
- [ try-process ] [ 2drop "File doesn't exist in repository" alert* ] recover ;
\ No newline at end of file
diff --git a/extra/darcs-ui-demo/darcs-ui-demo.factor b/extra/darcs-ui-demo/darcs-ui-demo.factor
deleted file mode 100644
index 739254b6c8..0000000000
--- a/extra/darcs-ui-demo/darcs-ui-demo.factor
+++ /dev/null
@@ -1,73 +0,0 @@
-USING: accessors arrays cocoa.dialogs closures continuations
-darcs-ui.commands fry file-trees io io.files io.directories
-io.encodings.utf8 kernel math models monads sequences
-splitting ui ui.gadgets.alerts ui.frp.gadgets ui.frp.layout
-ui.frp.signals ui.frp.instances ui.gadgets.comboboxes
-ui.gadgets.labels ui.gadgets.scrollers ui.baseline-alignment
-ui.images unicode.case ;
-EXCLUDE: fries => _ ;
-IN: darcs-ui-demo
-: <patch-viewer> ( columns -- scroller ) <frp-table>
- [ first ] >>val-quot
- { "Patch" "Author" "Date" } >>column-titles
- <scroller> ;
-
-: <change-list> ( {str} -- gadget ) <frp-list> t >>multiple-selection? indexed <scroller> ;
-
-: answer ( length indices -- ) [ index [ "y" ] [ "n" ] if write ] curry each flush ;
-
-: patches-quot ( -- model-of-quot )
- [ whatsnew [ length <model> ] keep <model>
- [ <change-list> ->% 1 "okay" <frp-bevel-button> [ close-window ] >>hook
- -> <updates> [ [ answer ] 2curry ] 2fmap-&
- ] <vbox> { 229 200 } >>pref-dim "select changes" open-window
- ] [ drop [ ] "No changes!" alert f <model> ] recover ;
-
-: <darcs-button> ( str -- button ) i" vocab:darcs-ui-demo/icons/_.tiff" <image-name> <frp-button> ;
-: <patch-button> ( str -- model ) <darcs-button> -> [ drop patches-quot ] bind ;
-
-: load-pref ( name file -- model ) "_darcs/prefs/" prepend dup exists?
- [ utf8 [ readln ] with-file-reader <model> nip ]
- [ '[ dup _ utf8 set-file-contents ] swap ask-user swap fmap ] if ;
-
-: toolbar ( -- file-updates patch-updates )
- "add" <darcs-button> -> [ drop open-dir-panel [ add-repo-file ] when* ] $>
- "rem" <darcs-button> -> [ drop open-panel [ remove-repo-file ] when* ] $>
- 2array <merge> >behavior
- "rec" <patch-button> dup [ drop "Patch Name:" ask-user ] bind dup
- C[ drop "Your Name:" "author" load-pref ] bind C[ record ] 3$>-&
- "push" <darcs-button> -> [ "Push To:" "defaultrepo" load-pref ] bind* C[ repo-push ] $> ,
- "pull" <darcs-button> -> [ "Pull From:" "defaultrepo" load-pref ] bind* C[ pull ] $>
- "send" <darcs-button> -> [ "Send To:" "defaultrepo" load-pref ] bind* C[ send ] $> ,
- "app" <darcs-button> -> C[ open-dir-panel [ first app ] when* ] $> 3array <merge> >behavior ;
-
-: darcs-window ( -- ) [
- [
- toolbar
- <spacer>
- { "PATCHES:" "MATCHES:"
- "FROM-TAG:" "FROM-PATCH:" "FROM-MATCH:"
- "TO-TAG:" "TO-MATCH:" "TO-PATCH:"
- } <combobox> -> [ but-last >lower ] fmap
- <frp-field> { 100 10 } >>pref-dim ->% 1
- ] <hbox> +baseline+ >>align ,
- [
- C[ rot drop patches ] 3fmap-| <patch-viewer> ->% .5
- [ C[ drop files "\n" split create-tree ] fmap <dir-table> <scroller> ->% .5
- [ file? ] <filter> [ comment>> ] fmap
- ] dip
- ] <hbox> ,% .5
- C[ cnts ] 2fmap-| "Select a patch and file to see its historical contents" <model>
- swap <switch> <label-control> <scroller> ,% .5
- ] <vbox> "darcs" open-window ;
-
-DEFER: open-file
-: create-repo ( -- ) "The selected folder is not a darcs repo. Would you like to create one?" { "yes" "no" } ask-buttons
- [ C[ drop [ init-repo darcs-window ] [ drop "Can't write to folder" alert* ] recover ] $> activate-model ]
- [ [ drop open-file ] $> activate-model ] bi* ;
-
-: open-file ( -- ) [ open-dir-panel
- [ first [ "_darcs" exists? [ darcs-window ] [ create-repo ] if ] with-directory ] unless-empty
- ] with-ui ;
-
-MAIN: open-file
\ No newline at end of file
diff --git a/extra/darcs-ui-demo/icons/add.tiff b/extra/darcs-ui-demo/icons/add.tiff
deleted file mode 100644
index c17d99617bec62c056b63d24d675bda9bf589843..0000000000000000000000000000000000000000
GIT binary patch
literal 0
HcmV?d00001
literal 3012
zcmeH_&yUhT6vt;+H7lp}u;{KHns}%&(g8M_w4u8PjgdfstR`}0p}X63X-R3)O89Z$
zkKm8d#EXA`e+VEyjwFurDuV>GF4=6oXqyl7=Dj!XJMU3VLr)RH3PO>u2%+e5-A2Ki
zKJx43imAK8iGF5Ss`%~WXHhV!s`&o7meA@i^>gD*)6w5H^Y1E6vm#f;qr<eX__caX
zcguobyRaIHuZrcWeWEMO1~(CfAjLIRv7{9R*S0TA!xd7J9G9O7r%t)1d$wZ=N$G`n
z7)?9XQ|0*8>qRxTQ^j-Ftt*6ho+o(+lI@(4q%6xMks_&7oMprtA1t@*$F0U=CKlYn
zC@qg!4Jo*gRIzKsD3PR;AWSHlCJQMhN|s%)&2kL7#d`NxlV}HhN4MC_Fav(Ly@&CN
z9YI?x46z4zE3h#n<2wsG!t8rIKZ5Y?!p~0N826(+e4pEQzu<jz`==z@#t)bF4t}&!
z|H(@I<6r*Br$Bw5ofjDJ#2C9F66^JPwAE_ScDwx>olb{d1)S@4yO#p>`~5zh&*z~5
z_5W*ZHs61FR>fkG0-Jt|*O`^3X%q-kBbUoj;HEVSg#yjz^TGYI*(?R17w|#sPkNiq
z>LxS>g8>~5hnE6(hWWt#Gnq^P*x-X0oL>j(fsglbmBy+**WfkQYx6yiUq^%gAG`*y
zxxVr^*MR+|@b7BVe6BGXjc8bKjq!L)!-8u}CKDPKTw^+&(y;iO8nfAqh6V2<?3Gg5
JV{}8L_XFM=yb%BZ
diff --git a/extra/darcs-ui-demo/icons/app.tiff b/extra/darcs-ui-demo/icons/app.tiff
deleted file mode 100644
index e823240eac87bc1b77eb97446df16387d0633d5d..0000000000000000000000000000000000000000
GIT binary patch
literal 0
HcmV?d00001
literal 3012
zcmdT_ZA?>V6u!5ufP77Zh%j*lG}j>XLW$ejQAmJINI(fFFopt_f~EEYC{mgX#*d*t
zNSKKc+z1IQB*TPgh+@JZxXBpsV<Y_92*f}_7P5(K;#c{&drsGj-4=yl_G5=U-1DCI
ze4qDyn~}jpG7PI`7|8^~Fy0$qFUI*7pJ=lbYYjT9{H(4_Z_;oNzaHY``VtM7do&{^
z!;-8!r%$z4>ay*}PipN3t*V4eOo+FsZAObxXDyc7jOR^NYMX{DE-|0gslk(&=j2Wm
zt3ku%Wn{{&X7hQ2-YQorRMDy^d1+;_QCDNGG{|EWZ*vLW@s%Z|>a3IxT;8zKaObR6
zi<;+aYHAcUaSC%~86T@ssrVQruT(}uBf6^AWG%Kuo2nuZ%$bEgZ^O(~rEn&s(3*|B
zK97%8#PA5@9nZT$At=951r{4^(3wzs4T@xTG3$&BJ!1j-C-T88>&8nMDYj{EA1ih8
zEGe@dE?xqDx2P{+*g%&Y7VKV8&IGeTBENH(4Pkct6_W8{-`wDLvHRWpA9nMf^+GNg
za7GV-y&U-8kgu;VbL7YoX3w5I|3%Kyf`Wnz0%&S#N|>0K5F#QXZXr-8;GFMk1SNZ#
z|HTIn9th>-<v*vSq;%+Xx`E;0VFC5@W6%FJ{F5p9Z=k%Jo1449rvUFoMMb?+S68=k
z_3Bjt>yLnK6Z&JHo0}6ZU%uSr>FG)5k7DBVGSXwmj@?{dUKafP{65EeJN=U8<m8yB
z{~X7S!AG>qkLXKkGMOIIKIHao#GpG^ivBp_;^G|W|Bs=eq3=URH4w2_?<4<3MMd|q
zjwcyyY>}k!Sv)>I{>*GPKkn-4dUp5j-6f?`c@Fl}BQ_u)An^9>+rycenV(>N6rh8=
z)fm$H`uaa8zoew3XB{0K&l?*XmtkKC1Ol=H2M*kz{oLH#i&(3GodDInl^9aBTAe}m
zsi~=sgoK3WBO@b^VOs|T0A9F%ezbr6`gMw{0ek@RPuPs82Wh>%y}zZWr$5(dG%IUs
zYZU7O<of{+z~|DXOJDW$^sM^$`22!<aR@R`0KZ9_$H3c=gxnTvHrvydmKF!{cfkM0
zEX$G)51CB18$JB8t*!0R>C>l|r>CbWev~W5W<8SNT)w-sv?S!`=P$OmxBoggIJg2^
z>JRlnCXq;PE-Wkv{r&x`(0N4l;r@M(J(|y^{-G1s+S)p!)oK@TkB0jC`W#ZJ^fSn*
z|J0wiW@l%Gfq{WloTVpYV`D2g%RfM#4Um5kVE;wb|47Vu3O#y=o_v~?mNuo=>*=jH
z4A6ZJF&GS;_wL<W3knK)a^=dEm220oO+x-5a1bDR>8$Z4csDdO^iy8p;o&KXiHTWw
zD+JuzJlMtH{Dj)=_Ak)4CpZI7@m=lg?EJ~!-=E@({Sm(u>z~ACWo1>-8RU8XJ8bR(
zlwo0EeYLf<0^T5@si}$Hr^n!D7Z(?W<mBXO=oGp+67Rd4=x?mVVzD$+3`pAn%7<*?
z(YqUEWn}_#7{{z{b$56Fe&WQ58So|8rx_8E?yG7b9Z6(lWI4{cfcXu%^l3hl9U#m+
zN}*6>qc@9)SA<!){|1rXR*2>qaq85m35o-M`B+nKB=;{YEL@zKnGuXe<1Fq)2xOGA
zSS#2q5uF7OygLP$@%)`Tch=yy7x$zQ-=5LYQQ^#)Gxt%?N$8O-`FGZd?^a3Fe*--`
zUR_=N?d0U-`uzO-`q0pjqoShX8!s=f95|yhv=^W^bvNJ#(7mU6sc!P~s=0`{$#5S1
z<Z?NW_e6m&2fKqV9KtsYpm_uX6w4Q&cb4v_7~^Ge#2Dh2Y$!MCjR-MUv2J&tWG4db
G3;Gj#sp!rC
diff --git a/extra/darcs-ui-demo/icons/pull.tiff b/extra/darcs-ui-demo/icons/pull.tiff
deleted file mode 100644
index b89d6339f18e491bb9e1fb57d54a86d642ad87b7..0000000000000000000000000000000000000000
GIT binary patch
literal 0
HcmV?d00001
literal 3949
zcmd^CeNa@_6~Av6A}n7EL4qGiUnXr<G3+i2qPt;9U=fW4L?98=V0M=W>@2%)ySoOK
zHkeYYMvXdZ8k>+QDN3y-Q8ArpY3n%J&UB{JW}1H3B-2_(qxb=`i_9e1^z@v!A1qW!
z>$HFME@$uWp7T4ubMJlky?s<xvK+?ZUSdr4K4VM~?Gu>vDQOZd0$<%KdPPsG=;BSa
z`Fy3>YID+<>9pFV2K>|M`Md&yR&UVhP(-FJDJxwjQ!?godfhe4OZobSwfwC2Q89_#
z&+^&hW~;|lQe9nvWabo|0`*hd#Ge>Po)2<KYijIEM+&RU?L}4)P1huNtc-D5#P)Wt
z3;kRV;!KNO!p8}_>uOBsKaV)IC4~P#*b>5*2)l6+$QdVoi-ctfge@UFpRiZxpt{T?
zx_oY1ORJa19n$ilO|12Kyn@5SKjpNFZkOmbdxa+ChUQ0EEImY|9b1s6*DqZtdH;)F
zbR9x+fz{Ifa#_Eb^i3ABZgf8%9&xgK#=dMksnL_o*s4Q#qJopYf|nWVeT=cRS0;Ur
z<}s$!F!qa{q9;0BW~*KB@)n`R<}|8C2hXT@Ta!_>W^tvq(q$4_Z7Vw6LTzVNowd_$
z)i<f0C@$(SbU0iN!E5F_9BodIp~I*$(@`}bCbve#OBAo&sH(55=DniWX1C$>Q0sH`
zkMYfJvqNYX-F7}tU8pKn6uFz44K-!uVKp2XRjppH%b?M;x3{a?^VOoeMT6HwuhHr>
zI$bU@ay>q$*W8io^gM#aq*>VNqiIf$TAGmBDmpZ_dQF~MtHDAFUMf|Fhth3xd2OPT
zr_yGNxY27=sT6!zN$9XmPGO1`MIvfEUqnNLNo*6{wYZH!v9?Gv-G!ndTD7f1Xsa)?
zIRvK%D;Mhu!sO|JsTmD-%ZLf!x-_(qn1$hDLq6PB++j`hlHnkF%>^f3=ytrKER+3%
z#o?ioZhQQS;5i%@gJn#P9ExRgatU*k!QB_eGQ{Z-e*BNQ*<n9sa9I&Qo5MX2!HMU&
zxhy_hH-VcM#Y%2|jQ)Zc{XB+M*h6SMr;~6d;$p65k}vxi%}O>4t$VA7QBMz`nyt1-
z-S|y7W=!78g|l$bD~m)~cCUOAOU(bHFL`#}>NJDnXh!AtM#$2u4%{LmOn!>r>vqVL
zd|_tA%NG|rj*i)X_(#}&c0{rrXGejI#^k3s@reJQ)KX~H?fYuun`7TOeFeJDOn~d{
zac~?C{ELyF;>069<^4N#k~HgIEp#3k+j8EI+5xa1^g~-e;<o~lc}|Q28I8$LapDo5
z@+g0%Ix^)~mOQ$l*WZ0E0OC>79s|#SAADy5P_^f`lIg@_x5;Qseu@*1_>@Qaq;r=#
zTvo-7p^YamgZu3<aQ5E<-{3fuZ#nlx#;RApP-xd5A&Z;8#79P${1hi1@hOk;Ne634
zPmI`F@(0v)de_l_?^FPs2S?%gcl}V>HTYRZsqc4OyaIoA@M#mWH0;ST$xrc;uAhEJ
ze9EJI(jh(M#5PW8XgSu{^LzNlJEJ(K5%9cs9cEYU8Rz72JQDFmO1iJ<X%%UN6%<cd
zxof=j<S^L!M!<#nq(gcbk6nv=?y8;F#gm_a>+lV5zcT`lcMS#;7p;CBd5P1wIE*&Z
zNF?6kZ=McX58VWF?{#QBehEkqW3h9JpIfs(===FCa2&h=!jYTsaN`?+xU5C^sv|ww
zqM~;IGU5^6ih0lWT!ZF!M<8|OE_&^vCu*eqFKck~D!TvjVC`<d+VXn9b8-~c?z;jT
z`mRHct^c-i<+ibmWiMR7iNx+}WM0u;p0#Mr!;L+DGw$=c*M`Az;u@r^*zqY6@X5{O
z8HVP8suu?)w*1l$jeXbP>D`xM-4BMrergm7oQH3xEU}&-UR3Z7AR%Yf{=&|m1Szln
zz*Tsr{~{=tcV9y))u3OL)byp6_ZHd?O_&F6!rC{l0`;nvgA>VxmeUju^RT-^lf@;b
zF5etj|JEgVX8$Fq@3{g`zVs_dDR^!G*^ytk`w-7gF4%DDYeL^dBkEJ1TxcF7KN`jF
zxK~`<tW>4ZezvIn*r)Y4x0+o;u=Yp8@X)#g0eMzVBj(W>s8N2XPX4o}=GN`;W4#&m
z<=N_n#GI<V$>p0rH@z_Mc|-qIsM>iEs`n1T*T4TEq?Uc_3Tmc=wXu_0q)w(h<B<mR
z&^<kU{xm0<vaIVyUh^CN+HGgRb$l4A_Wd1JeD`B`YWrWIy7w~Pw>tu|v<EB0`PfZq
zREOR;=sHE-N@5ALxADo#z8!oTwN~u<8<<|a0H#fUhVrc+!^+o&VBVVj;|V#{hmbdY
z4Y4{iVX8eV$+Rh0{>l)PZvF^Lx<7<vyDx%q+Xrxe#kN4gf{H%mq@&Gv4reGr|IQ>N
znYx0-J3j*B_6wl#orO7dd&g6r-1vz+Z9Y8%NuT!MUYoRz6n*orlS(?r(Z&?I=g!Hq
z7CJc&-@QWnbFcG{%!%elM)wQ8JxaQCwrTIDpAU51Q=>CMMsp=iIs=5sch~k$5^8qS
diff --git a/extra/darcs-ui-demo/icons/push.tiff b/extra/darcs-ui-demo/icons/push.tiff
deleted file mode 100644
index 56513ebb3203d07b3542ceb28a540220c90003fc..0000000000000000000000000000000000000000
GIT binary patch
literal 0
HcmV?d00001
literal 3985
zcmeHJdr*|u6~EtyE(=MOOsU0$IG++&O@Un=CfSuod5F9gH;YwFMsaspV1w-L?0$h2
z8#P2wN=#xD(;768+G!`G)1+x0)hJ2KOv5DYXp%OGt<9)0zCeT(5X1D>bC=hGSUM(u
zb$a3K_dDmFdw%zvbH9gP&+cVxMgwEwF~(T%*j34Ve`zHSvsE&bJ7kBu+~Jfm3KJx~
z$zro}oyBW359sJWUMs~V>NJVE#rIJVQInRLzElihtkN#KjLXucqSX&cfyXG~ZS4Cj
zfh{pv+|D$EA)lO?-C?)#>%`IjHzsh)Cow$M#JOp;V2jfwlh+VQe2LX<VNB2vuBeus
zWEYwVhng#V_!W*_D~uUrf1mKIvSIuw$L3-D6~``0f_$!W|1uvIl^mOgaX81a)x&vN
zhQqnRWh*O}C904{8ZKht2DfajbW1sQi^Jt~xJ<IOgnWnh$5*jCh8=mu7RG6{4=nOo
zzr!Eihv9JE2YvMw=6p168z-_n>Z%&i1TlfJ>Gbg!&0&l!{}r96p>bQ{4#rxd8JpcS
zZi|XzEJV%Nk>;dSkJDtSu*#CzT4u8+tGW-ht0Y@VvTD_0y+-fMu$J4hYh2dCnt~OU
znhJ}yM3tJ7<k5L5ot0MEBzY>=+ub@(vdYAds*W%>t5uTEMXpFz73mF<>~O5Fuu(r^
zwK3Xgsnlhvv{pM@6;fR6eX5k;Bv(nP&X}1s5{<NERk<uXb!v5Wb#-iYLaf78rly`~
z)tY#9e0&Uf#JD%uWs@hy?v5Zb-!5!LW6SLBSl@<XEsjdHtw<dgt5FkCu;io4q(kYl
zIc1x}E^%s;+3~2HtWpI_Bay5g+xQkH#Nsof(IhE}tGW!wdWWl!%4ki|B&jExDCn@8
z!RE29FUqu4TJ3IPPKi$(ah^OeamDJJt?-+mywp4qzr-lnVH?$zDy$xB87X5ux7w-E
z)zncI%KpV>(4q6)_VhD~=L&)!7FhuK@VPJ{z=s9CLQsrgk?<X({xkn9{9wdRD}*_t
zb~ab|;V2GzU$~Ra9N|?8ca7l?A>1$iLcjQNj9Az_5=n^n;ZVXUf^pnme4Fn|3?!-D
z=4SlLA3(-!wo%@hn@ML((ISkjBBezfon>Jy0e*ODAIZ;0;=%quzT*lA0`K&MAqu{Z
zPq5vp5^(2YLC9-`BColZDQ3~5ld;F{5BlYM1qvK22<i>u=loj^G0G6|)1!l^IeZQ2
z^&di*qYgNtS6=_-3p=iV`UqZJJ3mbMEqR2<<x1y~Yq0)$5M^zH#M6Pc{LrCqJ~LzJ
zLj$gVT#Cbb1wsOuFUMO+Nr)^^I*7yEI)LK61CZbBhnT$&XFJL<^g#iJI+kPLuO1xA
z4}_9GBW^N;+v(Q7CzmAe1_{*3O8Z;HvA+*%_FScFKjb(1kk!zE4fQn`csGyoF;YG@
z>|eVe>}EVv^I5g+-KcxF=LV^5??XvzAJ#qRMR60!9xqJKUxlr$AGPm!v2m*hgYV>G
z@Mr<99e)I`Q$8VzDe4xH7wBpqpmlw)wt6RsWxp5e_Vl25x1Tiiz`VB?wwL;l-}nJe
zz4{;q4(4Fss1bc1*Wma1K+K-RBShpXorn8T($b4{O;`Rq*>eTv=X+4~rWau=_v4>!
z26*4dL*LO==si}2S0?pGh{z!h%AutPrl#(jO7X64tl4!LYo5J~hj(7aLnLeWUV-bN
z7pYs?aj0npx?V~{*B`Rc{U;NiEDRqzYr=wM#Bmj+FLcAay9?`fbz${Womlx~CyWi3
zkY9fhxm%}@x{EOEzKoyzwhKbW)A*z@8fTx2#<|}l;_T}>JggEU>6rPR5yFBjW$9a9
ztZeFpzU~6DYtK(FPn<{Y_6sl`;PH3hHF**K-WZ89tufS}1RTf~5g5Qf%K6)b#{4X0
z(QCaZXu5>l#tRc9XWMyXJ^nSaw)hF@+4bkK{1=^ARCNfyvq$0hWAkuwXC%ISIR-B-
z6ERCcALJuBa0>BmZQ#A0w-K}P$UwB`@C1qVyyMN;c>(F0&me8%X{2vDgRGyOLtgVm
zsN_GQ!L$U&H{6ZSx6j8%+vj1GN=Tsn-|ioubI{;-=w0;8(@qvTbIDmPok-qt3c9M3
zNZon{8T-zG{dgN*wnyMtbvRBuy#Oa#R9F!u@V!qJpL6g*Z(bHe!fQAtf|MSTx$hE|
zZ2A(~s(&E$nXf2*9bRpS#$Pti!)NspPP`C>pDz`7{r^*Z3On^64rOxFMQFF4hPL4}
zW@l~E)ut+kK5t!!6VKj*j=FFdY5ybfrw%fWRglt@_doSD5*tr}rPhK4C_<lEDqcT%
zU?IMs{TrsQ&om5l9_IW=!BQTFn6jy#&Ag4*TUo4`(Y7;Fz>Z9@|5ocWiI~m<eQz-~
Xmt?fw-=i<TQQHmg;YsWNXViZK+he*r
diff --git a/extra/darcs-ui-demo/icons/rec.tiff b/extra/darcs-ui-demo/icons/rec.tiff
deleted file mode 100644
index 06dc4c9e213b505c64f0f81b8835b890064838c8..0000000000000000000000000000000000000000
GIT binary patch
literal 0
HcmV?d00001
literal 3952
zcmd^AYfKbZ6uz@+p%7b*)=IHDTGO?SF#7<NEr`1+ZB<%8qu4*P><+L2b~d{stYReX
zA1SPVswF0ZQK2!`{!nY835_C}sFha1`mBf|Z&@pf3qG>9=gjQFvMN5(e?8>e`<-*Y
zbMD-8?+nSw<WoXMy9iO7CxnCzj-f>Q)0>4%o=wRSM8T0G*x1E+d_Hd#9jqo=MKmf^
zj7}A&)2LbX99>L|E_N=|P^k2a42u=x2+6mK_O#CpZ2IbN*pTy3Fq}*vTJo9E<gn>e
zQkH?3SOqJO<8bp_A`C_@L}9Jrb1(J6Og6g+s;2;rnRl27VN}3#3q>2mnF`<&Gjk=r
zAGv)++Cqq*1pZF8%>P23Df3q3cGv`H`cR)OaYZQdOqowXF7i%Xmn;-)>+F{79Fc_%
zsaUy(%hx$XKHtH9X*CIUn_xGJycx9e^I;YlFAK3_v(#~M^FEQH|KSgwgIw-Gs?=X*
zQvFbDXd%;Ddx6hm6k0-F<`31Vm`upmKf#51Iuwi9OvujJguMIXQ0!whA>%kgj#k7c
zI&DT%E-$i~e741!p!}!in3A=a6O^lBlU2#Kg?x_Xi}iMX`TDO`nAYc-;>^m#`SDJj
zGvAiai$>O&pJ#RGoC!)J-c%iM40B3Wl8Ctp%Jk$ERuqK1Tnn5>bX-*2Y&Oeo%;yUQ
zdoHVvo}-)}7H>Ca>CzS@`Kp1Jpv)0Pn~viO3k#zQwb6n-n}ain<5U_>qlp4Vlw+M$
zG&-ZKj*nn5=_xGfgK1VrwDdsHCLy1*q;u+M6$cB2vC>kD;8NNxHqjzjSzOwfDXbL}
zl*%yHSBZC8h8|&9Eu8UJW7&9gbqj?&!M+^Y$j_e>8>@|t=YqpfSeB+(oP1vTA`864
z4p@DDOq@>~JTW|DbwGwDFe6|B_Qv660yYO5mSfOc=rT8WY~T!@J8y-<E`(Dh6N#6M
zhKnb?`talD5eyT+6=W1>aBea)O5zM=FmL&|0{D2pe#|e-d%ieiFq8ao62ZLh=Wm~6
zJ|JU!>xMFsgM1t_C7}MSfck0ztB?-?ETfV5MBoWb+K^uH8$OjH9PsTX2MNIsBWO}L
zS^Vpc`3`(SM(t$eEK1=;QTS(xdgrJ?4&UgJje!<LMn)2Y!7yXx%9T#D*?c%BC+8xL
z=o|Eg890x+H??{5<|SDymhO!ki@gUA{z@-hx=e51Zk0y#F^==7d)+lcLPGG_rxq0z
zwH!Hegx<K(Oj}#qo<VbSGsSt-p&s*I#X>_vNos0pe0h1fr>Uulwzs#x6iwHgDC$#E
zQsXiIWv10=rxq6%d+^!YJ344b0G{#Nhvsoln5WTdr;fBncz8I;%E~IJtE;1(on5aD
z%)@-F^CDZI*N1N3UNO*p=ML@e_92k_V>mu1-qF!XU9Qao`UUzIHY_6}qolsRp7!+g
zJcFj%T6%QN8oEC=RvK@BAE>(nIajV+p?mlKOfxc!CC}T(gb5SKh7B7UIy*b*-Me>(
z;o5-%^q5{xPii#u6aYu`G49vmy*qvS46Us_PMywm4OlPOIF2J*wrug-yVpx)+=KBR
z?Yj0itu+|vS*@1V2LOGHcU-+nZ{2F4=gys{_4R*9C@J~ggY|+<uh)}ZyLNf+-@i|L
z0rz`lTt9S(o(QNNxQ-OBs-g{z7ieRHjE06rx^?STFV+jTWy_Y4ef##&zP`R;xVXK7
zo`N;bLVtc&s|RsLrJ{8lM^BWN!Z}=}S1!xA47_s34vO`HZOM`)WY3;GUXRB^{dn-;
z0liRFO^-u8tQic9*H>23n>TL)Zqa4{^2*9eFV+jTxpU`|ZQHha1_lNw0(;ik)kSYM
zHqxVsiS$gs9&kVCA5C09Z$Y2%&IaO#AGUa~Ua(D{KApH+F88BHkLW;uKXtqB!rgRB
z__M5x9*16?!G8Hh^fB(1G<er#ZI9bcOG``LSTES{dj@y6q^0FHefaR9bmqOjb9cA3
z(eqHRcIi@D1Mdfp4OqXeUD_||Wc1Q&a1XK0i@uL5SFH-Is;+`<^ut~TD2_4*ANtpi
z@Wtd2`Woc#-o1MO>jdw??@yaHjg*v>w6wu<KYsFrJ^}bg<b!w|!2NNEwL%`|W1W$V
z=lQ8sRaG857q8d*%0NBlVg5+<ac=C`v814&Ailb~+Jo=Ps~GA~k9nB?Di#qDLCRb%
z__tH;#q%G@a2|DKWv+6}dmWoOb0%3|RFnkYh3=Y~8gENWi*(+&9-cS)7{__|Uz>#b
oH!+1mL1JQJNM2svjE%*`PWWaXuBfQEh$H&B5ZA&y>i!S*FJ*7F&;S4c
diff --git a/extra/darcs-ui-demo/icons/rem.tiff b/extra/darcs-ui-demo/icons/rem.tiff
deleted file mode 100644
index 14d6a66efe989ecb258f10aa71849d0724121b3a..0000000000000000000000000000000000000000
GIT binary patch
literal 0
HcmV?d00001
literal 3012
zcmeH`&2G~`5XX02Ky6Ot&_Y`dmN*z8;!RS4WGiV8AVicnK?R9i-NbDz*LLJsvWfC>
z$V22|K;ps!@E}RZ$1xJij)_eqQrZKKgj8EUdv<nb{xf4)QP5L_u#6D*4Iz|>-kT`6
zv&Vj2ts0ukpK9m2l@q>y`XcapEhl_<uB4RuOYK5`({!|V&C>g7)2K={;rJ-)%f4AR
zHCN?*^U`X_eojzp_NgW_8{9<TgCnky6DrDE-nH#ZLwEU%C?%z5{F$SgnrAx(pB7&T
zM~SRcJCjddy<TKvtDJD*x^<Zl&+|m@P_&(Ml9nWiq%tIvNwO2k#z)Il{iM}+%*28!
z^hy+FHN>DGv1*${uaLBuB1|ZeB?~DgN}?{<A{v8cvEDt_B-%zl&>c22%z#H|?_s=T
zb7+HY!`?%@5!e_G<9iF6WA^><Jcsbk!p|b`Zs<pQ_(5oIeZ~9e?k`ESi4P)s8$Vjg
z|70ou$!|aRIZ)qc@jL^rotW8ewOX{@ZvR22)1fy3V!Pe$mGpW&I-k#DrQh$znjh-F
z)wuaLyq(qmHLG&DOiQH_RTPC53WW$*gCF*<`-iXl=Ko4#Fc{F`aJUkvw^%F&_2=_>
z8Uj6mANC=B6_6AB(8u32uF?+ut8$0Fb!&t*#r1|+jYgwb0gdr^94nwPnM`5@G^W#O
VtgK68Hk;8nfj-s&rL-F}y`LGZ<j4R3
diff --git a/extra/darcs-ui-demo/icons/send.tiff b/extra/darcs-ui-demo/icons/send.tiff
deleted file mode 100644
index 3d9b1f5e719ada260abd9cf436243b72ebb38e30..0000000000000000000000000000000000000000
GIT binary patch
literal 0
HcmV?d00001
literal 3949
zcmds4dsvg_75@@oRXbPv%yo9_vnRSoQ=Jlsc9U>XK|5W!H4w{17$gJ;kPAsLfEQY&
zq99eFSf~t@dIReNPDN1^omW6EB7zeTt;KS$OhHh(-`@8N;gY(w+q3@DkDTxQo%5da
zJMTH~`{g5UZp<8pvE0Hi+!}^qCXI{}81`>Th*~P=d4{X?YF)Tm!*lVP&vOfwDO6Nv
zgf=z{MdTy2<Jm3{+1QDMwuFRhvt+6BGVT<HQL6M>@gJReKE8gumud*(%goQ2`HX$A
zOs84m>FG+G8I@Wkr{nmmzn<Yx%guR|Yy8}IYLjFdt)6%d5fO&SbuxzG*bp3P&})dD
zlTGkcX(WpaDb{+6U5Nb>!9NQ#;yQ|@M*JnkT2ch@c|!feSj?S3vDAp)pja=DrFj__
zwI)uh2n*NqNQZ2A#wL2j>GX1?j<-T3Q)@M9ZLnS*LVS(uqfyMOMn~GQH*M|g7S3j^
z|Hm8M2P56%ciH}OUb{YO8%-pO(XJlWINbRR^IiHVNA@&^@z_sJ)X=DHK`O)SnaeP*
zWQ^Kok%KZtz%b{s9TvrEf@P6%Jx?kRQ>YyIU!N)E^AsVD{P*5+vvJe7$io%O<F#_H
zcz17Ee5A}SgulqiAyyQt)F|cpU|y^;N~IIUI`V_*Q56wP%>q7;b<syU@_pPqd3v=v
zDpEoA!`g11-CSO%HdrY)sI`$iTkGHRohCVGLqbL3rEd?j5zUbwuGecs0)fF`ur|!M
zR%^oqWKZk_HbQ|=IFESD)5WRu!LjpHy5Evy>?#yKBVj6?HM<~dnOZ4O_y}yRZ3HCI
zBp#b;DLIr{g+{MXt9UeZuv8tRcjWUY@rIe?v5L_pjN_s+CN>_=fvO@Gb(C7`McOEL
zvT+cYn+U1V%~KI8kMdcnP|8(0lG#bPVA$DwVtj<}zl#_%LFy9FLdFzEiZ$9uUrC1r
zBU?t4kv*5I$VMB;jxtl3e=?Tj(6Ns_xtZ|m9L^ZbWh{sfotwt7U@?bAaDFn3xdgvz
z^0&(4{9@QnA~>&^?9A(&Uz+g5OPpUZR>OHGaDF|4r*PgF!~f<Oep`lQVSYn|#}Tr4
zD#1=1@u)wygszJF5|Ir_I);w)3rL)#Fy*yMAUeZX?BNVY5oHh8G|NoeV=;<Z&mZB<
z*4B2rx3~A8tE=mMp-`AEkw}KjvAO;tKgvP5%v(f!cc!Lp#j|IF=;&xietsT?hMs>5
z|ED=q4CSC)l+%>Q%F61Mz`#I!^UV;3o<C=$y{8ZD-A{}%7E{|;-3*)JDHr9W+%%7+
zrRC&+RjV*KIDmnH0R(Nk3~^%V|0I%4=kfIEQ<iI$zdtDVa4j72p2~`j)}ZH6FIKEO
zjT5(raGc1|`tK*l8iv>y-!12H`(8WJ($YXV2|xQpTUc03^z-vWeSJOJI=b-Ax?&u<
z@f;av2e9qb)9)qeB?H)B^&CD)rKoFaMN3Nye0_aExkq{x5P<&veth*+8{F5Q!v5-K
zgu5R}g?&go+>H+owIN~Omm{))=!u{Au=CU>wWuGt*9YOh`5bERJV1Y6ALzQr_R8AY
zI!mjKM(e{icq9~&9D_*t>(|(DuniHL&%j@ojg?X9tVkl$5U_eL*6wb`#{6z16+A}j
z@h8|@F@RNDN>F?I9(L^54$3*USG2CWx;lLEpcQUwk6~}s0Jao%LjHaMBoW)7tf
zoI9*+%xyqGOb+~_Gm(&cADfOm!q(&e!0z$^1Z+8j>iWBAZf?fPl`F^fit4?+kI;Pg
z9vq_&W5?efA!6GVtO!a%T+Us>mj&;zWLARX_rs7`17CFpB9n@-@lZRd`4Mu;`tj%F
z)2OU#B3!-j@$nhy746v%orCsl?%cUqp`oE@Y-)ys`Vc-U?SZ#87w;Jg;i1@xz%>O(
z&TnO9nIsx9A74krrXtAKeU8Mu4kQ=$Ap2S$f|83-d9xAQw{HXG9J?Q4u^3fVm1t=A
zJM5MFkxX)UsCL08z6dUUiBM-gfbx_3tk}87K(+H8yj7n<@nJEx7Ib2BK^L;FK7lml
zB+6?V(Aanf<a=v$KP)UJdyyQSogJvVbqn@Ux!8Q67w?2;z}IjDj*|D`yRHO(3fslX
z{N+)2H#!f_{z=efH9?!*iiEs&WL|lUkdz{nRo_B)R~J@FB(Nmh^!Xqc=XZ1FWXYsb
z)ZVOvC}KB0y3`9V!f!8*gIHGp2QvB_4zjY$e*@kQOoms?Q3P(PKzMo!l)Jt_LU9k=
z<MVOxS~XIVlR-HtH%&mFMGtp(l$V#GvZ@+(;eWxJGu?>U(*n2942V2d!&R9FN&H!(
z#Fb#F^b@@0x|*!xB&4Z#5SDQlu_rpQOuG-o=dYo*_68`Y={YCkWKRzdJbc)SvWf~U
z4Eq%N;x4Q{@Br%%+=u+b<D_rtaF*_1WqD{C>EUNkWmH0!(}Li%MucQGLwlkFF65k?
zEWOO;aCdW~ImnM7_TtQ*Jv%EXC<tZc75IZZ6Y8Q4s7Q?RXd6B#=|swfZlqoA8Ik1k
zU5GzroTomjW9@8=vt~Dn&R)d&_3JTx`t-Ggo$VEu%biHxZ@7BpGRn)!uw0W3`|vD?
z!ZZIXp)rdhvQT#QDk`sE2j!&Pv<liQT32&(6Px4Q*%BN)T!`EQhw<6L!`OG|$Otyq
z$IczdFTk18r%`t88k(CLG2E+>b2V$`%yjxrx!q8Y%a<-9apMNmR9E4``O<ONTsQZt
zy-|Z3HPxW|J9Fkt`c7wiMQb6K6|sH1c=6&sdwcr_vu4f8advioYL3nI7x_6kId#vN
jF(ZX?vdp75nvdFkN`%(;^6+Sm&Gi@gQ4adwDtrA4-X=&u
diff --git a/extra/ui/frp/functors/authors.txt b/extra/ui/frp/functors/authors.txt
new file mode 100644
index 0000000000..2300f69f11
--- /dev/null
+++ b/extra/ui/frp/functors/authors.txt
@@ -0,0 +1 @@
+Sam Anklesaria
diff --git a/extra/ui/frp/gadgets/authors.txt b/extra/ui/frp/gadgets/authors.txt
new file mode 100644
index 0000000000..2300f69f11
--- /dev/null
+++ b/extra/ui/frp/gadgets/authors.txt
@@ -0,0 +1 @@
+Sam Anklesaria
diff --git a/extra/ui/frp/instances/authors.txt b/extra/ui/frp/instances/authors.txt
new file mode 100644
index 0000000000..2300f69f11
--- /dev/null
+++ b/extra/ui/frp/instances/authors.txt
@@ -0,0 +1 @@
+Sam Anklesaria
diff --git a/extra/ui/frp/instances/instances-docs.factor b/extra/ui/frp/instances/instances-docs.factor
index 12d5fdbe21..8b26d208ad 100644
--- a/extra/ui/frp/instances/instances-docs.factor
+++ b/extra/ui/frp/instances/instances-docs.factor
@@ -5,5 +5,5 @@ ARTICLE: { "ui.frp.instances" "explanation" } "FRP Instances"
"Signals are all functors, as " { $link fmap } " corresponds directly to " { $link <mapped> } $nl
"Moduls also impliment monad functionalities. " { $link bind } "ing switches between two models. " $nl
"Also, a gadget is a monad. Binding recieves a model and adds the resulting gadget onto the parent. " $nl
-"Examples of these instances can be seen in the " { $vocab-link "darcs-ui-demo" } " vocabulary." ;
+"Examples of these instances can be seen in the " { $vocab-link "darcs-ui" } " vocabulary." ;
ABOUT: { "ui.frp.instances" "explanation" }
\ No newline at end of file
diff --git a/extra/ui/frp/layout/authors.txt b/extra/ui/frp/layout/authors.txt
new file mode 100644
index 0000000000..2300f69f11
--- /dev/null
+++ b/extra/ui/frp/layout/authors.txt
@@ -0,0 +1 @@
+Sam Anklesaria
diff --git a/extra/ui/frp/signals/authors.txt b/extra/ui/frp/signals/authors.txt
new file mode 100644
index 0000000000..2300f69f11
--- /dev/null
+++ b/extra/ui/frp/signals/authors.txt
@@ -0,0 +1 @@
+Sam Anklesaria
From 65060e8a3e0c45f0f77fef87ded21d3bba62a4ce Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Thu, 28 May 2009 19:01:53 -0500
Subject: [PATCH 057/128] removed models.illusion dependency
---
basis/models/illusion/illusion.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/basis/models/illusion/illusion.factor b/basis/models/illusion/illusion.factor
index f41a4a2444..1b3a297c5b 100644
--- a/basis/models/illusion/illusion.factor
+++ b/basis/models/illusion/illusion.factor
@@ -1,4 +1,4 @@
-USING: accessors models models.arrow inverse inverse.vectors kernel ;
+USING: accessors models models.arrow inverse kernel ;
IN: models.illusion
TUPLE: illusion < arrow ;
From 3645d28b1afd0504ea250a7ce48279f078010c0c Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Thu, 28 May 2009 21:17:24 -0500
Subject: [PATCH 058/128] no default size for alerts
---
extra/darcs-ui | 2 +-
extra/ui/gadgets/alerts/alerts.factor | 2 +-
2 files changed, 2 insertions(+), 2 deletions(-)
diff --git a/extra/darcs-ui b/extra/darcs-ui
index 54edac761a..98627a6ce4 160000
--- a/extra/darcs-ui
+++ b/extra/darcs-ui
@@ -1 +1 @@
-Subproject commit 54edac761ab48bee66f8db0210c27d52b72a94ef
+Subproject commit 98627a6ce4a1ef23691cfb752fecf056e2eacd01
diff --git a/extra/ui/gadgets/alerts/alerts.factor b/extra/ui/gadgets/alerts/alerts.factor
index 599bdd7279..8c04362b28 100644
--- a/extra/ui/gadgets/alerts/alerts.factor
+++ b/extra/ui/gadgets/alerts/alerts.factor
@@ -24,6 +24,6 @@ MACRO: ask-buttons ( buttons -- quot ) dup length [
[ swap
[ 22 wrap-lines <label> T{ font { name "sans-serif" } { size 18 } } >>font ,
[ [ <frp-bevel-button> [ close-window ] >>hook -> ] map ] <hbox> , ] <vbox>
- { 200 110 } >>pref-dim "" open-window
+ "" open-window
] dip firstn
] 2curry ;
\ No newline at end of file
From 588a04c62d55f4d776489790a8cbfea255c41956 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sat, 30 May 2009 10:58:32 -0500
Subject: [PATCH 059/128] ui.frp book gadgets
---
basis/inverse/inverse.factor | 4 +++
extra/darcs-ui | 2 +-
extra/drills/drills.factor | 2 +-
extra/ui/frp/gadgets/gadgets.factor | 27 ++++++++++++++-----
extra/ui/frp/layout/layout.factor | 18 +++++--------
extra/ui/frp/signals/signals.factor | 2 +-
extra/ui/gadgets/alerts/alerts.factor | 4 +--
.../ui/gadgets/book-extras/book-extras.factor | 13 ++++++---
8 files changed, 44 insertions(+), 28 deletions(-)
diff --git a/basis/inverse/inverse.factor b/basis/inverse/inverse.factor
index 7a9e821b37..70af955c77 100755
--- a/basis/inverse/inverse.factor
+++ b/basis/inverse/inverse.factor
@@ -243,6 +243,10 @@ DEFER: __
\ if* 2 [ swap [ undo-if* ] 2curry ] define-pop-inverse
+! misc
+\ join 1 [ [ split ] curry ] define-pop-inverse
+\ split 1 [ [ join ] curry ] define-pop-inverse
+
! Constructor inverse
: deconstruct-pred ( class -- quot )
"predicate" word-prop [ dupd call assure ] curry ;
diff --git a/extra/darcs-ui b/extra/darcs-ui
index 98627a6ce4..4112107342 160000
--- a/extra/darcs-ui
+++ b/extra/darcs-ui
@@ -1 +1 @@
-Subproject commit 98627a6ce4a1ef23691cfb752fecf056e2eacd01
+Subproject commit 4112107342733e412dda8c1b747aa2ec1f27ddb6
diff --git a/extra/drills/drills.factor b/extra/drills/drills.factor
index 8251851511..1da1fcaa1d 100644
--- a/extra/drills/drills.factor
+++ b/extra/drills/drills.factor
@@ -11,7 +11,7 @@ IN: drills
SYMBOLS: it startLength ;
: big ( gadget -- gadget ) T{ font { name "sans-serif" } { size 30 } } >>font ;
: card ( model quot -- button ) <arrow> <label-control> big [ next ] <book-btn> ;
-: op ( quot str -- gadget ) <label> big swap <book-bevel-btn> ;
+: op ( quot str -- gadget ) <label> big swap <book-border-btn> ;
: show ( model -- gadget ) dup it set-global [ random ] <arrow>
{ [ [ first ] card ]
diff --git a/extra/ui/frp/gadgets/gadgets.factor b/extra/ui/frp/gadgets/gadgets.factor
index f80ecf55dc..1fd6563082 100644
--- a/extra/ui/frp/gadgets/gadgets.factor
+++ b/extra/ui/frp/gadgets/gadgets.factor
@@ -1,15 +1,15 @@
-USING: accessors arrays kernel models ui.frp.signals ui.gadgets
-ui.gadgets.buttons ui.gadgets.buttons.private
-ui.gadgets.editors ui.gadgets.tables ;
+USING: accessors arrays kernel models monads ui.frp.signals ui.gadgets
+ui.gadgets.buttons ui.gadgets.buttons.private ui.gadgets.editors
+ui.gadgets.tables sequences splitting models.illusion
+ui.gadgets.scrollers documents ;
IN: ui.frp.gadgets
TUPLE: frp-button < button hook ;
: <frp-button> ( gadget -- button ) [
[ dup hook>> [ call( button -- ) ] [ drop ] if* ] keep
- t swap set-control-value
+ dup set-control-value
] frp-button new-button f <basic> >>model ;
-
-: <frp-bevel-button> ( text -- button ) <frp-button> border-button-theme ;
+: <frp-border-button> ( text -- button ) <frp-button> border-button-theme ;
TUPLE: frp-table < table { quot initial: [ ] } { val-quot initial: [ ] } color-quot column-titles column-alignment ;
M: frp-table column-titles column-titles>> ;
@@ -25,4 +25,17 @@ M: frp-table row-color color-quot>> [ call( a -- b ) ] [ drop f ] if* ;
: <frp-list*> ( -- table ) V{ } clone <model> <frp-list> ;
: indexed ( table -- table ) f >>val-quot ;
-: <frp-field> ( -- field ) "" <model> <model-field> ;
\ No newline at end of file
+GENERIC: output-model ( gadget -- model )
+M: gadget output-model model>> ;
+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 ;
+M: multiline-editor output-model model>> [ "\n" join ] <illusion> ;
+
+: <frp-field> ( -- field ) "" <model> <model-field> ;
+: <frp-editor> ( model -- editor ) [ "\n" split document new-model ] bind <multiline-editor> swap >>model ;
+
+IN: accessors
+M: frp-button text>> children>> first text>> ;
\ No newline at end of file
diff --git a/extra/ui/frp/layout/layout.factor b/extra/ui/frp/layout/layout.factor
index 508f30b2ab..6e6689dce3 100644
--- a/extra/ui/frp/layout/layout.factor
+++ b/extra/ui/frp/layout/layout.factor
@@ -1,18 +1,10 @@
-USING: accessors fry kernel lexer math.parser models sequences
-ui.frp.signals ui.gadgets ui.gadgets.editors ui.gadgets.scrollers
-ui.gadgets.tables ui.gadgets.tracks ;
+USING: accessors fry kernel lexer math.parser models
+sequences ui.frp.signals ui.gadgets.tracks ui.gadgets
+ui.frp.gadgets ui.gadgets.books ;
QUALIFIED: make
IN: ui.frp.layout
TUPLE: layout gadget width ; C: <layout> layout
-GENERIC: output-model ( gadget -- model )
-M: gadget output-model model>> ;
-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 ;
-
GENERIC: , ( uiitem -- )
M: gadget , f <layout> make:, ;
M: model , activate-model ;
@@ -31,4 +23,6 @@ M: model -> dup , ;
: <hbox> ( gadgets -- track ) horizontal <box> ; inline
: <hbox*> ( gadgets -- track ) horizontal <box*> ; inline
: <vbox> ( gadgets -- track ) vertical <box> ; inline
-: <vbox*> ( gadgets -- track ) vertical <box*> ; inline
\ No newline at end of file
+: <vbox*> ( gadgets -- track ) vertical <box*> ; inline
+
+: <frp-book> ( gadgets -- book ) { } make:make [ gadget>> ] map f <book> ; inline
\ No newline at end of file
diff --git a/extra/ui/frp/signals/signals.factor b/extra/ui/frp/signals/signals.factor
index a08a49e329..9813165b1d 100644
--- a/extra/ui/frp/signals/signals.factor
+++ b/extra/ui/frp/signals/signals.factor
@@ -21,7 +21,7 @@ M: filter-model (model-changed) [ value>> ] dip 2dup quot>> call( a -- ? )
TUPLE: fold-model < multi-model oldval quot ;
M: fold-model (model-changed) [ [ value>> ] [ [ oldval>> ] [ quot>> ] bi ] bi*
call( val oldval -- newval ) ] keep set-model ;
-: <fold> ( oldval quot model -- signal ) 1array fold-model <multi-model> swap >>quot
+: <fold> ( model oldval quot -- signal ) rot 1array fold-model <multi-model> swap >>quot
swap [ >>oldval ] [ >>value ] bi ;
TUPLE: updater-model < multi-model values updates ;
diff --git a/extra/ui/gadgets/alerts/alerts.factor b/extra/ui/gadgets/alerts/alerts.factor
index 8c04362b28..d7085302e0 100644
--- a/extra/ui/gadgets/alerts/alerts.factor
+++ b/extra/ui/gadgets/alerts/alerts.factor
@@ -13,7 +13,7 @@ IN: ui.gadgets.alerts
:: ask-user* ( model string -- model' )
[ [let | lbl [ string <label> T{ font { name "sans-serif" } { size 14 } } >>font dup , ]
fldm [ <frp-field> ->% 1 ]
- btn [ "okay" <frp-bevel-button> model >>model ] |
+ btn [ "okay" <frp-border-button> model >>model ] |
btn -> [ fldm swap <updates> ]
[ [ drop lbl close-window ] $> , ] bi
] ] <vbox> { 161 86 } >>pref-dim "" open-window ;
@@ -23,7 +23,7 @@ IN: ui.gadgets.alerts
MACRO: ask-buttons ( buttons -- quot ) dup length [
[ swap
[ 22 wrap-lines <label> T{ font { name "sans-serif" } { size 18 } } >>font ,
- [ [ <frp-bevel-button> [ close-window ] >>hook -> ] map ] <hbox> , ] <vbox>
+ [ [ <frp-border-button> [ close-window ] >>hook -> ] map ] <hbox> , ] <vbox>
"" open-window
] dip firstn
] 2curry ;
\ No newline at end of file
diff --git a/extra/ui/gadgets/book-extras/book-extras.factor b/extra/ui/gadgets/book-extras/book-extras.factor
index 9e94747919..41e16e0f9f 100644
--- a/extra/ui/gadgets/book-extras/book-extras.factor
+++ b/extra/ui/gadgets/book-extras/book-extras.factor
@@ -5,8 +5,13 @@ IN: ui.gadgets.book-extras
: |<< ( book -- ) 0 swap set-control-value ;
: next ( book -- ) model>> [ 1 + ] change-model ;
: prev ( book -- ) model>> [ 1 - ] change-model ;
-: (book-t) ( quot -- quot ) '[ : owner ( gadget -- book ) parent>> dup book? [ owner ] unless ; owner @ ] ;
+: owner ( gadget -- book ) parent>> dup book? [ owner ] unless ;
+: (book-t) ( quot -- quot ) '[ owner @ ] ;
: <book-btn> ( label quot -- button ) (book-t) <button> ;
-: <book-bevel-btn> ( label quot -- button ) (book-t) <border-button> ;
-: >>> ( label -- button ) [ next ] <book-btn> ;
-: <<< ( label -- button ) [ prev ] <book-btn> ;
\ No newline at end of file
+: <book-border-btn> ( label quot -- button ) (book-t) <border-button> ;
+: >>> ( gadget -- ) owner next ;
+: <<< ( gadget -- ) owner prev ;
+: go-to ( gadget number -- ) swap owner model>> set-model ;
+
+: <forward-btn> ( label -- button ) [ >>> ] <button> ;
+: <backward-btn> ( label -- button ) [ <<< ] <button> ;
From 3adff7ebe90877e81f5513b3af0e7ccbe8b1a5bb Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sat, 30 May 2009 12:13:13 -0500
Subject: [PATCH 060/128] fixed fold-model
---
extra/ui/frp/signals/signals.factor | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/extra/ui/frp/signals/signals.factor b/extra/ui/frp/signals/signals.factor
index 9813165b1d..650acb37c8 100644
--- a/extra/ui/frp/signals/signals.factor
+++ b/extra/ui/frp/signals/signals.factor
@@ -18,11 +18,11 @@ M: filter-model (model-changed) [ value>> ] dip 2dup quot>> call( a -- ? )
[ set-model ] [ 2drop ] if ;
: <filter> ( model quot -- filter-signal ) [ 1array filter-model <multi-model> ] dip >>quot ;
-TUPLE: fold-model < multi-model oldval quot ;
-M: fold-model (model-changed) [ [ value>> ] [ [ oldval>> ] [ quot>> ] bi ] bi*
+TUPLE: fold-model < multi-model quot ;
+M: fold-model (model-changed) [ [ value>> ] [ [ value>> ] [ quot>> ] bi ] bi*
call( val oldval -- newval ) ] keep set-model ;
: <fold> ( model oldval quot -- signal ) rot 1array fold-model <multi-model> swap >>quot
- swap [ >>oldval ] [ >>value ] bi ;
+ swap >>value ;
TUPLE: updater-model < multi-model values updates ;
M: updater-model (model-changed) tuck updates>> =
From b2770a31b5100ef91b75eef9b1e04587f58935f5 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sat, 30 May 2009 12:51:35 -0500
Subject: [PATCH 061/128] frp-editors use field-models
---
basis/inverse/inverse.factor | 4 ----
extra/ui/frp/gadgets/gadgets.factor | 11 +++++++----
2 files changed, 7 insertions(+), 8 deletions(-)
diff --git a/basis/inverse/inverse.factor b/basis/inverse/inverse.factor
index 70af955c77..7a9e821b37 100755
--- a/basis/inverse/inverse.factor
+++ b/basis/inverse/inverse.factor
@@ -243,10 +243,6 @@ DEFER: __
\ if* 2 [ swap [ undo-if* ] 2curry ] define-pop-inverse
-! misc
-\ join 1 [ [ split ] curry ] define-pop-inverse
-\ split 1 [ [ join ] curry ] define-pop-inverse
-
! Constructor inverse
: deconstruct-pred ( class -- quot )
"predicate" word-prop [ dupd call assure ] curry ;
diff --git a/extra/ui/frp/gadgets/gadgets.factor b/extra/ui/frp/gadgets/gadgets.factor
index 1fd6563082..3568d4036d 100644
--- a/extra/ui/frp/gadgets/gadgets.factor
+++ b/extra/ui/frp/gadgets/gadgets.factor
@@ -1,7 +1,7 @@
USING: accessors arrays kernel models monads ui.frp.signals ui.gadgets
ui.gadgets.buttons ui.gadgets.buttons.private ui.gadgets.editors
-ui.gadgets.tables sequences splitting models.illusion
-ui.gadgets.scrollers documents ;
+ui.gadgets.tables sequences splitting
+ui.gadgets.scrollers ui.gadgets.borders ;
IN: ui.frp.gadgets
TUPLE: frp-button < button hook ;
@@ -32,10 +32,13 @@ M: table output-model dup multiple-selection?>>
[ 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 ;
-M: multiline-editor output-model model>> [ "\n" join ] <illusion> ;
: <frp-field> ( -- field ) "" <model> <model-field> ;
-: <frp-editor> ( model -- editor ) [ "\n" split document new-model ] bind <multiline-editor> swap >>model ;
+: <frp-field*> ( model -- field ) "" <model> swap <switch> <model-field> ;
+: <frp-editor> ( model -- gadget )
+ model-field [ <multiline-editor> ] dip new-border dup gadget-child >>editor
+ field-theme swap >>field-model { 1 0 } >>align ;
+: <frp-editor*> ( model -- editor ) "" <model> swap <switch> <frp-editor> ;
IN: accessors
M: frp-button text>> children>> first text>> ;
\ No newline at end of file
From 3a8267f30f9984757172d1416a17a26e49988822 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sun, 31 May 2009 11:40:03 -0500
Subject: [PATCH 062/128] illusion-models selectively activated
---
basis/models/illusion/illusion.factor | 4 +++-
basis/ui/gadgets/tables/tables.factor | 4 ++--
2 files changed, 5 insertions(+), 3 deletions(-)
diff --git a/basis/models/illusion/illusion.factor b/basis/models/illusion/illusion.factor
index 1b3a297c5b..00169792a9 100644
--- a/basis/models/illusion/illusion.factor
+++ b/basis/models/illusion/illusion.factor
@@ -5,7 +5,9 @@ TUPLE: illusion < arrow ;
: <illusion> ( model quot -- illusion )
illusion new V{ } clone >>connections V{ } clone >>dependencies 0 >>ref
- swap >>quot over >>model [ add-dependency ] keep dup activate-model ;
+ swap >>quot over >>model [ add-dependency ] keep ;
+
+: <activated-illusion> ( model quot -- illusion ) <illusion> dup activate-model ;
: backtalk ( value object -- )
[ quot>> [undo] call( a -- b ) ] [ model>> ] bi set-model ;
diff --git a/basis/ui/gadgets/tables/tables.factor b/basis/ui/gadgets/tables/tables.factor
index e3ffa9237d..c0b792785d 100644
--- a/basis/ui/gadgets/tables/tables.factor
+++ b/basis/ui/gadgets/tables/tables.factor
@@ -56,11 +56,11 @@ SLOT: selected-value
SLOT: selected-index
SLOT: selected-index*
M: table selected-value>> selected-values>> [ in>out ] <illusion> ;
-M: table (>>selected-value) [ [ out>in ] <illusion> ] dip (>>selected-values) ;
+M: table (>>selected-value) [ [ out>in ] <activated-illusion> ] 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 ] <illusion> ;
-M: table (>>selected-index*) [ [ out>in ] <illusion> ] dip (>>selected-indices*) ;
+M: table (>>selected-index*) [ [ out>in ] <activated-illusion> ] dip (>>selected-indices*) ;
IN: ui.gadgets.tables
: push-selected-index ( table n -- table ) 2dup swap selected-indices>> index
From e7cc0d02c698655f5fa7800083a44bc615f75493 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sun, 31 May 2009 11:56:39 -0500
Subject: [PATCH 063/128] "NS[" syntax added to closures
---
extra/closures/closures.factor | 10 ++++++++--
1 file changed, 8 insertions(+), 2 deletions(-)
diff --git a/extra/closures/closures.factor b/extra/closures/closures.factor
index 7fd08db998..eb5a293fed 100644
--- a/extra/closures/closures.factor
+++ b/extra/closures/closures.factor
@@ -1,7 +1,13 @@
-USING: assocs io.pathnames fry namespaces kernel sequences parser ;
+USING: assocs io.pathnames fry namespaces namespaces.private kernel sequences parser ;
IN: closures
SYMBOL: |
+
+! Selective Binding
: delayed-bind-with ( vars quot -- quot' ) '[ _ dup [ get ] map zip [ _ bind ] curry ] ;
SYNTAX: C[ | parse-until parse-quotation delayed-bind-with over push-all ;
! Common ones
-SYNTAX: DIR[ parse-quotation { current-directory } swap delayed-bind-with over push-all ;
\ No newline at end of file
+SYNTAX: DIR[ parse-quotation { current-directory } swap delayed-bind-with over push-all ;
+
+! Namespace Binding
+: bind-to-namespace ( quot -- quot' ) '[ namespace [ _ bind ] curry ] ;
+SYNTAX: NS[ parse-quotation bind-to-namespace over push-all ;
\ No newline at end of file
From 47edda1f6618805c6b9538b655e77d292158e005 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sun, 31 May 2009 11:57:05 -0500
Subject: [PATCH 064/128] frp model activation changes
---
extra/file-trees/file-trees.factor | 2 +-
extra/ui/frp/gadgets/gadgets.factor | 21 +++++++++++++++++++--
extra/ui/frp/layout/layout.factor | 10 ++++------
extra/ui/frp/signals/signals-docs.factor | 2 +-
extra/ui/frp/signals/signals.factor | 8 ++++----
5 files changed, 29 insertions(+), 14 deletions(-)
diff --git a/extra/file-trees/file-trees.factor b/extra/file-trees/file-trees.factor
index fa9411cfbf..0329021f57 100644
--- a/extra/file-trees/file-trees.factor
+++ b/extra/file-trees/file-trees.factor
@@ -44,5 +44,5 @@ DEFER: (tree-insert)
: <dir-table> ( tree-model -- table )
<frp-list*> [ node>> 1array ] >>quot
- [ selected-value>> [ file? not ] <filter> <switch> ]
+ [ selected-value>> [ file? not ] <filter> swap <switch> ]
[ swap >>model ] bi ;
\ No newline at end of file
diff --git a/extra/ui/frp/gadgets/gadgets.factor b/extra/ui/frp/gadgets/gadgets.factor
index 3568d4036d..7df9a4e8c9 100644
--- a/extra/ui/frp/gadgets/gadgets.factor
+++ b/extra/ui/frp/gadgets/gadgets.factor
@@ -33,12 +33,29 @@ M: table output-model dup multiple-selection?>>
M: model-field output-model field-model>> ;
M: scroller output-model viewport>> children>> first output-model ;
+TUPLE: frp-field < field frp-model ;
+
+M: model-field graft*
+ [ [ field-model>> value>> ] [ editor>> ] bi set-editor-string ]
+ [ dup editor>> model>> add-connection ]
+ bi ;
+
+! frp-fields observe the underlying editor, relaying the string to the
+! frp-model. Also, however, they relay the frp-model to the document and
+! relayout
+
+! Frp boxes should unactivate all models attatched to them
+
+! Table gadgets should have slots for their illusions, not requireing manual activation
+! and allowing deactivation an superior memory management
+
: <frp-field> ( -- field ) "" <model> <model-field> ;
-: <frp-field*> ( model -- field ) "" <model> swap <switch> <model-field> ;
+: <frp-field*> ( model -- field ) "" <model> <switch> <model-field> ;
: <frp-editor> ( model -- gadget )
model-field [ <multiline-editor> ] dip new-border dup gadget-child >>editor
field-theme swap >>field-model { 1 0 } >>align ;
-: <frp-editor*> ( model -- editor ) "" <model> swap <switch> <frp-editor> ;
+: <frp-editor*> ( model -- editor ) "" <model> <switch> <frp-editor> ;
+: after-empty ( model quot -- model' ) fmap "" <model> <switch> ; inline
IN: accessors
M: frp-button text>> children>> first text>> ;
\ No newline at end of file
diff --git a/extra/ui/frp/layout/layout.factor b/extra/ui/frp/layout/layout.factor
index 6e6689dce3..b2d888470d 100644
--- a/extra/ui/frp/layout/layout.factor
+++ b/extra/ui/frp/layout/layout.factor
@@ -1,5 +1,5 @@
USING: accessors fry kernel lexer math.parser models
-sequences ui.frp.signals ui.gadgets.tracks ui.gadgets
+sequences ui.gadgets.tracks ui.gadgets models.product
ui.frp.gadgets ui.gadgets.books ;
QUALIFIED: make
IN: ui.frp.layout
@@ -7,7 +7,7 @@ TUPLE: layout gadget width ; C: <layout> layout
GENERIC: , ( uiitem -- )
M: gadget , f <layout> make:, ;
-M: model , activate-model ;
+M: model , make:, ;
SYNTAX: ,% scan string>number [ <layout> make:, ] curry over push-all ;
SYNTAX: ->% scan string>number '[ [ _ <layout> make:, ] [ output-model ] bi ] over push-all ;
@@ -18,11 +18,9 @@ M: model -> dup , ;
: <spacer> ( -- ) <gadget> 1 <layout> make:, ;
: <box> ( gadgets type -- track )
- [ { } make:make ] dip <track> swap [ [ gadget>> ] [ width>> ] bi track-add ] each ; inline
-: <box*> ( gadgets type -- track ) [ <box> ] [ [ model>> ] map <|> ] bi >>model ; inline
+ [ { } make:make dup [ layout? ] filter ] dip <track> swap [ [ gadget>> ] [ width>> ] bi track-add ] each
+ swap [ model? ] filter [ <product> >>model ] unless-empty ; inline
: <hbox> ( gadgets -- track ) horizontal <box> ; inline
-: <hbox*> ( gadgets -- track ) horizontal <box*> ; inline
: <vbox> ( gadgets -- track ) vertical <box> ; inline
-: <vbox*> ( gadgets -- track ) vertical <box*> ; inline
: <frp-book> ( gadgets -- book ) { } make:make [ gadget>> ] map f <book> ; inline
\ No newline at end of file
diff --git a/extra/ui/frp/signals/signals-docs.factor b/extra/ui/frp/signals/signals-docs.factor
index 2cc455c7ff..e2b14234e1 100644
--- a/extra/ui/frp/signals/signals-docs.factor
+++ b/extra/ui/frp/signals/signals-docs.factor
@@ -15,7 +15,7 @@ HELP: <fold>
HELP: <switch>
{ $values { "signal1" model } { "signal2" model } { "signal'" model } }
-{ $description "Creates a signal that starts with the behavior of signal1 and switches to the behavior of signal2 on its update" } ;
+{ $description "Creates a signal that starts with the behavior of signal2 and switches to the behavior of signal1 on its update" } ;
HELP: <mapped>
{ $values { "model" model } { "quot" "applied to model's value on updates" } { "signal" model } }
diff --git a/extra/ui/frp/signals/signals.factor b/extra/ui/frp/signals/signals.factor
index 650acb37c8..145c25c0d6 100644
--- a/extra/ui/frp/signals/signals.factor
+++ b/extra/ui/frp/signals/signals.factor
@@ -35,10 +35,10 @@ 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 ;
-: <switch> ( signal1 signal2 -- signal' ) [ 2array switch-model <multi-model> ] 2keep
+: <switch> ( signal1 signal2 -- signal' ) swap [ 2array switch-model <multi-model> ] 2keep
[ >>original ] [ >>switcher ] bi* ;
M: switch-model model-activated [ original>> ] keep model-changed ;
-: >behavior ( event -- behavior ) t <model> swap <switch> ;
+: >behavior ( event -- behavior ) t <model> <switch> ;
TUPLE: mapped-model < multi-model model quot ;
: new-mapped-model ( model quot class -- mapped-model ) [ over 1array ] dip
@@ -64,7 +64,7 @@ TUPLE: action < multi-model quot ;
M: action (model-changed) [ [ value>> ] [ quot>> ] bi* call( a -- b ) ] keep value>>
[ swap add-connection ] 2keep model-changed ;
: <action> ( model quot -- action-signal ) [ 1array action <multi-model> ] dip >>quot dup f <action-value> >>value value>> ;
-
+<PRIVATE
TUPLE: | < multi-model ;
: <|> ( models -- product ) | <multi-model> ;
GENERIC: models-changed ( product -- )
@@ -82,5 +82,5 @@ M: | model-activated dup model-changed ;
TUPLE: & < | ;
: <&> ( models -- product ) & <multi-model> ;
M: & models-changed dependencies>> [ f swap (>>value) ] each ;
-
+PRIVATE>
FMAPS: $> <$ fmap FOR & | ;
\ No newline at end of file
From b705306558f0088f9b052adc72bbc783819f05a3 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sun, 31 May 2009 16:11:06 -0500
Subject: [PATCH 065/128] frp-editor is its own class
---
extra/ui/frp/gadgets/gadgets.factor | 50 +++++++++++++--------------
extra/ui/gadgets/alerts/alerts.factor | 2 +-
2 files changed, 25 insertions(+), 27 deletions(-)
diff --git a/extra/ui/frp/gadgets/gadgets.factor b/extra/ui/frp/gadgets/gadgets.factor
index 7df9a4e8c9..9e0776752f 100644
--- a/extra/ui/frp/gadgets/gadgets.factor
+++ b/extra/ui/frp/gadgets/gadgets.factor
@@ -7,7 +7,7 @@ IN: ui.frp.gadgets
TUPLE: frp-button < button hook ;
: <frp-button> ( gadget -- button ) [
[ dup hook>> [ call( button -- ) ] [ drop ] if* ] keep
- dup set-control-value
+ [ dup set-control-value ] [ f swap set-control-value ] bi
] frp-button new-button f <basic> >>model ;
: <frp-border-button> ( text -- button ) <frp-button> border-button-theme ;
@@ -25,37 +25,35 @@ M: frp-table row-color color-quot>> [ call( a -- b ) ] [ drop f ] if* ;
: <frp-list*> ( -- table ) V{ } clone <model> <frp-list> ;
: indexed ( table -- table ) f >>val-quot ;
+TUPLE: frp-field < field frp-model ;
+: <frp-field> ( model -- gadget ) frp-field new-field swap >>frp-model ;
+M: frp-field graft*
+ [ [ frp-model>> value>> ] [ editor>> ] bi set-editor-string ]
+ [ dup editor>> model>> add-connection ]
+ [ dup frp-model>> add-connection ] tri ;
+M: frp-field ungraft*
+ [ dup editor>> model>> remove-connection ]
+ [ dup frp-model>> remove-connection ] bi ;
+M: frp-field model-changed 2dup frp-model>> =
+ [ [ value>> ] [ editor>> ] bi* set-editor-string ]
+ [ nip [ editor>> editor-string ] [ frp-model>> ] bi set-model ] if ;
+: after-empty ( model quot -- model' ) fmap "" <model> <switch> ; inline ! pattern for editors, labels
+
+: <frp-field*> ( -- field ) "" <model> <frp-field> ;
+: <empty-field> ( model -- field ) "" <model> <switch> <frp-field> ;
+: <frp-editor> ( model -- gadget )
+ frp-field [ <multiline-editor> ] dip new-border dup gadget-child >>editor
+ field-theme swap >>frp-model { 1 0 } >>align ;
+: <empty-editor> ( model -- editor ) "" <model> <switch> <frp-editor> ;
+: <frp-editor*> ( -- editor ) "" <model> <frp-editor> ;
+
GENERIC: output-model ( gadget -- model )
M: gadget output-model model>> ;
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: frp-field output-model frp-model>> ;
M: scroller output-model viewport>> children>> first output-model ;
-TUPLE: frp-field < field frp-model ;
-
-M: model-field graft*
- [ [ field-model>> value>> ] [ editor>> ] bi set-editor-string ]
- [ dup editor>> model>> add-connection ]
- bi ;
-
-! frp-fields observe the underlying editor, relaying the string to the
-! frp-model. Also, however, they relay the frp-model to the document and
-! relayout
-
-! Frp boxes should unactivate all models attatched to them
-
-! Table gadgets should have slots for their illusions, not requireing manual activation
-! and allowing deactivation an superior memory management
-
-: <frp-field> ( -- field ) "" <model> <model-field> ;
-: <frp-field*> ( model -- field ) "" <model> <switch> <model-field> ;
-: <frp-editor> ( model -- gadget )
- model-field [ <multiline-editor> ] dip new-border dup gadget-child >>editor
- field-theme swap >>field-model { 1 0 } >>align ;
-: <frp-editor*> ( model -- editor ) "" <model> <switch> <frp-editor> ;
-: after-empty ( model quot -- model' ) fmap "" <model> <switch> ; inline
-
IN: accessors
M: frp-button text>> children>> first text>> ;
\ No newline at end of file
diff --git a/extra/ui/gadgets/alerts/alerts.factor b/extra/ui/gadgets/alerts/alerts.factor
index d7085302e0..f29b8e8bf7 100644
--- a/extra/ui/gadgets/alerts/alerts.factor
+++ b/extra/ui/gadgets/alerts/alerts.factor
@@ -12,7 +12,7 @@ IN: ui.gadgets.alerts
:: ask-user* ( model string -- model' )
[ [let | lbl [ string <label> T{ font { name "sans-serif" } { size 14 } } >>font dup , ]
- fldm [ <frp-field> ->% 1 ]
+ fldm [ <frp-field*> ->% 1 ]
btn [ "okay" <frp-border-button> model >>model ] |
btn -> [ fldm swap <updates> ]
[ [ drop lbl close-window ] $> , ] bi
From 733dbe45856aaeb51a533f779f5c71274ac7f6b8 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sun, 31 May 2009 21:49:55 -0500
Subject: [PATCH 066/128] switch models revert on false value
---
extra/ui/frp/signals/signals.factor | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/extra/ui/frp/signals/signals.factor b/extra/ui/frp/signals/signals.factor
index 145c25c0d6..04364536e6 100644
--- a/extra/ui/frp/signals/signals.factor
+++ b/extra/ui/frp/signals/signals.factor
@@ -32,9 +32,9 @@ M: updater-model (model-changed) tuck updates>> =
[ >>values ] [ >>updates ] 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 ;
+M: switch-model model-changed 2dup switcher>> =
+ [ [ value>> ] dip over [ t >>on set-model ] [ nip f swap (>>on) ] if ]
+ [ dup on>> [ 2drop ] [ [ value>> ] dip over [ set-model ] [ 2drop ] if ] if ] if ;
: <switch> ( signal1 signal2 -- signal' ) swap [ 2array switch-model <multi-model> ] 2keep
[ >>original ] [ >>switcher ] bi* ;
M: switch-model model-activated [ original>> ] keep model-changed ;
From 6819fcda4c294866c448875ba6d3da161286a0a6 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Mon, 1 Jun 2009 07:39:07 -0500
Subject: [PATCH 067/128] switch models reupdate on second switch
---
extra/ui/frp/signals/signals.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/ui/frp/signals/signals.factor b/extra/ui/frp/signals/signals.factor
index 04364536e6..63a5f9c1f1 100644
--- a/extra/ui/frp/signals/signals.factor
+++ b/extra/ui/frp/signals/signals.factor
@@ -33,7 +33,7 @@ M: updater-model (model-changed) tuck updates>> =
TUPLE: switch-model < multi-model original switcher on ;
M: switch-model model-changed 2dup switcher>> =
- [ [ value>> ] dip over [ t >>on set-model ] [ nip f swap (>>on) ] if ]
+ [ [ value>> ] dip over [ t >>on set-model ] [ nip [ original>> ] keep f >>on model-changed ] if ]
[ dup on>> [ 2drop ] [ [ value>> ] dip over [ set-model ] [ 2drop ] if ] if ] if ;
: <switch> ( signal1 signal2 -- signal' ) swap [ 2array switch-model <multi-model> ] 2keep
[ >>original ] [ >>switcher ] bi* ;
From b74b8478f3ad86365c59078d03621551ac81d64f Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Thu, 4 Jun 2009 21:22:30 -0500
Subject: [PATCH 068/128] ui.frp templates separate model, view
---
extra/ui/frp/layout/layout.factor | 45 +++++++++++++++++++++----------
1 file changed, 31 insertions(+), 14 deletions(-)
diff --git a/extra/ui/frp/layout/layout.factor b/extra/ui/frp/layout/layout.factor
index b2d888470d..ce2f8ed098 100644
--- a/extra/ui/frp/layout/layout.factor
+++ b/extra/ui/frp/layout/layout.factor
@@ -1,26 +1,43 @@
-USING: accessors fry kernel lexer math.parser models
-sequences ui.gadgets.tracks ui.gadgets models.product
-ui.frp.gadgets ui.gadgets.books ;
-QUALIFIED: make
+USING: accessors assocs arrays fry kernel lexer make math math.parser
+models models.product namespaces parser sequences
+ui.frp.gadgets ui.gadgets ui.gadgets.books ui.gadgets.tracks
+words tools.continuations ;
IN: ui.frp.layout
-TUPLE: layout gadget width ; C: <layout> layout
-GENERIC: , ( uiitem -- )
-M: gadget , f <layout> make:, ;
-M: model , make:, ;
+: <layout> ( gadget width -- gadget ) over set ;
-SYNTAX: ,% scan string>number [ <layout> make:, ] curry over push-all ;
-SYNTAX: ->% scan string>number '[ [ _ <layout> make:, ] [ output-model ] bi ] over push-all ;
+SYNTAX: ,% scan string>number [ <layout> , ] curry over push-all ;
+SYNTAX: ->% scan string>number '[ [ _ <layout> , ] [ output-model ] bi ] over push-all ;
GENERIC: -> ( uiitem -- model )
M: gadget -> dup , output-model ;
M: model -> dup , ;
-: <spacer> ( -- ) <gadget> 1 <layout> make:, ;
+: <spacer> ( -- ) <gadget> 1 <layout> , ;
+
+SYMBOL: wordnames
+
: <box> ( gadgets type -- track )
- [ { } make:make dup [ layout? ] filter ] dip <track> swap [ [ gadget>> ] [ width>> ] bi track-add ] each
- swap [ model? ] filter [ <product> >>model ] unless-empty ; inline
+ [ { } make [ [ model? ] filter ] [ [ word? ] filter ] [ [ gadget? ] filter ] tri ] dip <track>
+ swap [ dup get track-add ] each
+ tuck [ [ swap 2array ] curry wordnames get swap change-at ] curry each
+ swap [ <product> >>model ] unless-empty ; inline
: <hbox> ( gadgets -- track ) horizontal <box> ; inline
: <vbox> ( gadgets -- track ) vertical <box> ; inline
-: <frp-book> ( gadgets -- book ) { } make:make [ gadget>> ] map f <book> ; inline
\ No newline at end of file
+: <frp-book> ( gadgets -- book ) { } make [ gadget>> ] map f <book> ; inline
+
+SYNTAX: $ CREATE-WORD dup [ , ] curry (( -- )) define-declared "$" expect
+ word [ [ building get length swap wordnames get set-at ] [ , ] bi ] curry over push-all ;
+
+GENERIC# insert-item 1 ( item location -- )
+M: gadget insert-item first2 spin [ dup get track-add ] keep
+ -rot [ but-last insert-nth ] change-children drop ;
+M: model insert-item first model>> swap add-connection ;
+
+: insert-items ( makelist -- ) f swap [ dup word?
+ [ wordnames get at nip ] [ over insert-item ] if
+ ] each drop ;
+
+: with-interface ( quot: ( -- gadget ) -- gadget ) H{ } clone wordnames
+ [ { } make insert-items ] with-variable ; inline
\ No newline at end of file
From acf9159f319b8e2ea8dda49bf9ce809271d537f6 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Thu, 4 Jun 2009 21:24:25 -0500
Subject: [PATCH 069/128] set-n allows dynamic variable assigning in outer
scopes
---
extra/set-n/set-n.factor | 5 +++++
1 file changed, 5 insertions(+)
create mode 100644 extra/set-n/set-n.factor
diff --git a/extra/set-n/set-n.factor b/extra/set-n/set-n.factor
new file mode 100644
index 0000000000..97aa95199d
--- /dev/null
+++ b/extra/set-n/set-n.factor
@@ -0,0 +1,5 @@
+USING: assocs kernel math namespaces sequences ;
+IN: set-n
+: get* ( var n -- val ) namestack swap tail-slice* assoc-stack ;
+
+: set* ( val var n -- ) 1 + namestack [ length swap - ] keep nth set-at ;
\ No newline at end of file
From 58192d7e6e0c80de475cae95800b979f016751e1 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sat, 6 Jun 2009 20:58:12 -0500
Subject: [PATCH 070/128] ui.frp.layout fixed- now works normally
---
extra/fries/fries.factor | 3 +--
extra/ui/frp/layout/layout.factor | 16 +++++++++-------
extra/ui/gadgets/alerts/alerts.factor | 7 ++++---
3 files changed, 14 insertions(+), 12 deletions(-)
diff --git a/extra/fries/fries.factor b/extra/fries/fries.factor
index 0e7ca3a0fe..6639607a11 100644
--- a/extra/fries/fries.factor
+++ b/extra/fries/fries.factor
@@ -1,7 +1,6 @@
USING: arrays vectors combinators effects kernel math sequences splitting
-strings.parser parser ;
+strings.parser parser fry ;
IN: fries
-SYMBOL: _
: str-fry ( str on -- quot ) split
[ unclip-last [ [ spin glue ] reduce-r ] 2curry ]
[ length 1 - 1 <effect> [ call-effect ] 2curry ] bi ;
diff --git a/extra/ui/frp/layout/layout.factor b/extra/ui/frp/layout/layout.factor
index ce2f8ed098..17fc4a8abd 100644
--- a/extra/ui/frp/layout/layout.factor
+++ b/extra/ui/frp/layout/layout.factor
@@ -4,7 +4,7 @@ ui.frp.gadgets ui.gadgets ui.gadgets.books ui.gadgets.tracks
words tools.continuations ;
IN: ui.frp.layout
-: <layout> ( gadget width -- gadget ) over set ;
+TUPLE: layout gadget size ; C: <layout> layout
SYNTAX: ,% scan string>number [ <layout> , ] curry over push-all ;
SYNTAX: ->% scan string>number '[ [ _ <layout> , ] [ output-model ] bi ] over push-all ;
@@ -16,10 +16,11 @@ M: model -> dup , ;
: <spacer> ( -- ) <gadget> 1 <layout> , ;
SYMBOL: wordnames
-
+: layouts ( gadgets -- layouts ) [ [ gadget? ] [ layout? ] bi or ] filter
+ [ dup layout? [ f <layout> ] unless ] map ;
: <box> ( gadgets type -- track )
- [ { } make [ [ model? ] filter ] [ [ word? ] filter ] [ [ gadget? ] filter ] tri ] dip <track>
- swap [ dup get track-add ] each
+ [ { } make [ [ model? ] filter ] [ [ word? ] filter ] [ layouts ] tri ] dip <track>
+ swap [ [ gadget>> ] [ size>> ] bi track-add ] each
tuck [ [ swap 2array ] curry wordnames get swap change-at ] curry each
swap [ <product> >>model ] unless-empty ; inline
: <hbox> ( gadgets -- track ) horizontal <box> ; inline
@@ -31,13 +32,14 @@ SYNTAX: $ CREATE-WORD dup [ , ] curry (( -- )) define-declared "$" expect
word [ [ building get length swap wordnames get set-at ] [ , ] bi ] curry over push-all ;
GENERIC# insert-item 1 ( item location -- )
-M: gadget insert-item first2 spin [ dup get track-add ] keep
+M: gadget insert-item [ f <layout> ] dip insert-item ;
+M: layout insert-item first2 spin [ [ gadget>> ] [ size>> ] bi track-add ] keep gadget>>
-rot [ but-last insert-nth ] change-children drop ;
M: model insert-item first model>> swap add-connection ;
: insert-items ( makelist -- ) f swap [ dup word?
- [ wordnames get at nip ] [ over insert-item ] if
+ [ nip ] [ over [ wordnames get at insert-item ] [ wordnames get [ first2 1 + 2array ] change-at ] bi ] if
] each drop ;
: with-interface ( quot: ( -- gadget ) -- gadget ) H{ } clone wordnames
- [ { } make insert-items ] with-variable ; inline
\ No newline at end of file
+ [ { } make insert-items ] with-variable ; inline
diff --git a/extra/ui/gadgets/alerts/alerts.factor b/extra/ui/gadgets/alerts/alerts.factor
index f29b8e8bf7..abebf458b4 100644
--- a/extra/ui/gadgets/alerts/alerts.factor
+++ b/extra/ui/gadgets/alerts/alerts.factor
@@ -1,7 +1,8 @@
-USING: accessors models macros generalizations kernel ui
-ui.frp.gadgets ui.frp.signals ui.frp.layout ui.gadgets
+USING: accessors models macros make generalizations kernel
+ui ui.frp.gadgets ui.frp.signals ui.frp.layout ui.gadgets
ui.gadgets.labels ui.gadgets.editors ui.gadgets.buttons
-ui.gadgets.packs locals sequences fonts io.styles wrap.strings ;
+ui.gadgets.packs locals sequences fonts io.styles
+wrap.strings ;
IN: ui.gadgets.alerts
:: alert ( quot string -- ) <pile> { 10 10 } >>gap 1 >>align
From 5b4466161c3ced391d2453738865a694361c8a45 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sun, 7 Jun 2009 13:33:04 -0500
Subject: [PATCH 071/128] persistency vocab completely hides db for storage
---
extra/persistency/persistency.factor | 35 ++++++++++++++++++++++++++++
1 file changed, 35 insertions(+)
create mode 100644 extra/persistency/persistency.factor
diff --git a/extra/persistency/persistency.factor b/extra/persistency/persistency.factor
new file mode 100644
index 0000000000..9a4b99c457
--- /dev/null
+++ b/extra/persistency/persistency.factor
@@ -0,0 +1,35 @@
+USING: accessors arrays byte-arrays calendar classes classes.tuple
+classes.tuple.parser combinators db db.tuples db.types kernel
+math prettyprint sequences strings unicode.case urls words
+tools.continuations ;
+IN: persistency
+
+TUPLE: persistent id ;
+UNION: bool word POSTPONE: f ;
+PREDICATE: short-string < string length 100 <= ;
+: db-ize ( class -- db-class ) {
+ { bool [ BOOLEAN ] }
+ { string [ TEXT ] }
+ { short-string [ { VARCHAR 100 } ] }
+ { float [ DOUBLE ] }
+ { timestamp [ TIMESTAMP ] }
+ { fixnum [ INTEGER ] }
+ { byte-array [ BLOB ] }
+ { url [ URL ] }
+ [ drop FACTOR-BLOB ]
+} case ;
+
+: add-types ( table -- table' ) [ [ first dup >upper ] [ second db-ize ] bi 3array ] map
+{ "id" "ID" +db-assigned-id+ } prefix ;
+
+SYNTAX: STORED-TUPLE: parse-tuple-definition [ drop persistent ] dip [ define-tuple-class ]
+ [ nip [ dup unparse >upper ] [ add-types ] bi* define-persistent ] 3bi ;
+
+: define-db ( database class -- ) swap [ [ recreate-table ] with-db ] [ "database" set-word-prop ] 2bi ;
+
+: w/db ( query quot -- ) [ dup class "database" word-prop ] dip with-db ; inline
+: get-tuples ( query -- tuples ) [ select-tuples ] w/db ;
+: get-tuple ( query -- tuple ) [ select-tuple ] w/db ;
+: store-tuple ( tuple -- ) [ insert-tuple ] w/db ;
+: modify-tuple ( tuple -- ) [ update-tuple ] w/db ;
+: remove-tuples ( tuple -- ) [ delete-tuples ] w/db ;
From e8cbb5b2289eb8d0cf9eb9d448e4ae9104cf3a99 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sun, 7 Jun 2009 17:03:32 -0500
Subject: [PATCH 072/128] frp.layout works with books
---
extra/persistency/persistency.factor | 5 +++--
extra/ui/frp/layout/layout.factor | 33 ++++++++++++++++++----------
2 files changed, 24 insertions(+), 14 deletions(-)
diff --git a/extra/persistency/persistency.factor b/extra/persistency/persistency.factor
index 9a4b99c457..683318f98b 100644
--- a/extra/persistency/persistency.factor
+++ b/extra/persistency/persistency.factor
@@ -6,11 +6,12 @@ IN: persistency
TUPLE: persistent id ;
UNION: bool word POSTPONE: f ;
-PREDICATE: short-string < string length 100 <= ;
+UNION: short-string string ;
+
: db-ize ( class -- db-class ) {
{ bool [ BOOLEAN ] }
- { string [ TEXT ] }
{ short-string [ { VARCHAR 100 } ] }
+ { string [ TEXT ] }
{ float [ DOUBLE ] }
{ timestamp [ TIMESTAMP ] }
{ fixnum [ INTEGER ] }
diff --git a/extra/ui/frp/layout/layout.factor b/extra/ui/frp/layout/layout.factor
index 17fc4a8abd..48cb0398e0 100644
--- a/extra/ui/frp/layout/layout.factor
+++ b/extra/ui/frp/layout/layout.factor
@@ -16,30 +16,39 @@ M: model -> dup , ;
: <spacer> ( -- ) <gadget> 1 <layout> , ;
SYMBOL: wordnames
-: layouts ( gadgets -- layouts ) [ [ gadget? ] [ layout? ] bi or ] filter
- [ dup layout? [ f <layout> ] unless ] map ;
+: insert-layout ( track layout -- track ) [ gadget>> ] [ size>> ] bi track-add ; inline
+: layouts ( sized? gadgets -- layouts ) [ [ gadget? ] [ layout? ] bi or ] filter swap
+ [ [ dup layout? [ f <layout> ] unless ] map ] when ;
+: make-layout ( building sized? -- models words layouts ) [ swap layouts ] curry
+ [ { } make [ [ model? ] filter ] [ [ word? ] filter ] ] dip tri ; inline
+: handle-words ( words gadget -- gadget ) tuck
+ [ [ swap 2array ] curry wordnames get swap change-at ] curry each ;
: <box> ( gadgets type -- track )
- [ { } make [ [ model? ] filter ] [ [ word? ] filter ] [ layouts ] tri ] dip <track>
- swap [ [ gadget>> ] [ size>> ] bi track-add ] each
- tuck [ [ swap 2array ] curry wordnames get swap change-at ] curry each
+ [ t make-layout ] dip <track>
+ swap [ insert-layout ] each
+ handle-words
swap [ <product> >>model ] unless-empty ; inline
: <hbox> ( gadgets -- track ) horizontal <box> ; inline
: <vbox> ( gadgets -- track ) vertical <box> ; inline
-: <frp-book> ( gadgets -- book ) { } make [ gadget>> ] map f <book> ; inline
+: <frp-book> ( gadgets -- book ) f make-layout f <book> handle-words ; inline
SYNTAX: $ CREATE-WORD dup [ , ] curry (( -- )) define-declared "$" expect
word [ [ building get length swap wordnames get set-at ] [ , ] bi ] curry over push-all ;
+: insert-gadget ( number parent gadget -- ) -rot [ but-last insert-nth ] change-children drop ;
+
GENERIC# insert-item 1 ( item location -- )
-M: gadget insert-item [ f <layout> ] dip insert-item ;
-M: layout insert-item first2 spin [ [ gadget>> ] [ size>> ] bi track-add ] keep gadget>>
- -rot [ but-last insert-nth ] change-children drop ;
-M: model insert-item first model>> swap add-connection ;
+M: gadget insert-item dup first book? [ first2 spin [ add-gadget ] keep insert-gadget ]
+ [ [ f <layout> ] dip insert-item ] if ;
+M: layout insert-item first2 spin [ insert-layout ] keep gadget>> insert-gadget ;
+M: model insert-item dup first book? [ "Books can't contain models" throw ]
+ [ first model>> swap add-connection ] if ;
: insert-items ( makelist -- ) f swap [ dup word?
- [ nip ] [ over [ wordnames get at insert-item ] [ wordnames get [ first2 1 + 2array ] change-at ] bi ] if
- ] each drop ;
+ [ nip ] [
+ over [ wordnames get at insert-item ] [ wordnames get [ first2 1 + 2array ] change-at ] bi
+ ] if ] each drop ;
: with-interface ( quot: ( -- gadget ) -- gadget ) H{ } clone wordnames
[ { } make insert-items ] with-variable ; inline
From 95d2147dd5a1233306f9deaffec67daea183c20b Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sun, 7 Jun 2009 17:43:07 -0500
Subject: [PATCH 073/128] frp books automatically add models
---
extra/ui/frp/layout/layout.factor | 6 ++++--
1 file changed, 4 insertions(+), 2 deletions(-)
diff --git a/extra/ui/frp/layout/layout.factor b/extra/ui/frp/layout/layout.factor
index 48cb0398e0..a4f0b09409 100644
--- a/extra/ui/frp/layout/layout.factor
+++ b/extra/ui/frp/layout/layout.factor
@@ -5,6 +5,7 @@ words tools.continuations ;
IN: ui.frp.layout
TUPLE: layout gadget size ; C: <layout> layout
+ERROR: no-models models ;
SYNTAX: ,% scan string>number [ <layout> , ] curry over push-all ;
SYNTAX: ->% scan string>number '[ [ _ <layout> , ] [ output-model ] bi ] over push-all ;
@@ -31,7 +32,8 @@ SYMBOL: wordnames
: <hbox> ( gadgets -- track ) horizontal <box> ; inline
: <vbox> ( gadgets -- track ) vertical <box> ; inline
-: <frp-book> ( gadgets -- book ) f make-layout f <book> handle-words ; inline
+: <frp-book> ( quot: ( -- model ) -- book ) f make-layout roll dup activate-model <book> handle-words
+ swap [ no-models ] unless-empty ; inline
SYNTAX: $ CREATE-WORD dup [ , ] curry (( -- )) define-declared "$" expect
word [ [ building get length swap wordnames get set-at ] [ , ] bi ] curry over push-all ;
@@ -42,7 +44,7 @@ GENERIC# insert-item 1 ( item location -- )
M: gadget insert-item dup first book? [ first2 spin [ add-gadget ] keep insert-gadget ]
[ [ f <layout> ] dip insert-item ] if ;
M: layout insert-item first2 spin [ insert-layout ] keep gadget>> insert-gadget ;
-M: model insert-item dup first book? [ "Books can't contain models" throw ]
+M: model insert-item dup first book? [ no-models ]
[ first model>> swap add-connection ] if ;
: insert-items ( makelist -- ) f swap [ dup word?
From 1aca6455dea231cb1cc0ef8f0395a70584e210b0 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sun, 7 Jun 2009 18:42:20 -0500
Subject: [PATCH 074/128] frp templating sizes bug fixed
---
extra/persistency/persistency.factor | 3 ++-
extra/ui/frp/layout/layout.factor | 7 ++++++-
2 files changed, 8 insertions(+), 2 deletions(-)
diff --git a/extra/persistency/persistency.factor b/extra/persistency/persistency.factor
index 683318f98b..d8bf0e9806 100644
--- a/extra/persistency/persistency.factor
+++ b/extra/persistency/persistency.factor
@@ -28,7 +28,8 @@ SYNTAX: STORED-TUPLE: parse-tuple-definition [ drop persistent ] dip [ define-tu
: define-db ( database class -- ) swap [ [ recreate-table ] with-db ] [ "database" set-word-prop ] 2bi ;
-: w/db ( query quot -- ) [ dup class "database" word-prop ] dip with-db ; inline
+: query>tuple ( tuple/query -- tuple ) dup query? [ tuple>> ] when ;
+: w/db ( query quot -- ) [ dup query>tuple class "database" word-prop ] dip with-db ; inline
: get-tuples ( query -- tuples ) [ select-tuples ] w/db ;
: get-tuple ( query -- tuple ) [ select-tuple ] w/db ;
: store-tuple ( tuple -- ) [ insert-tuple ] w/db ;
diff --git a/extra/ui/frp/layout/layout.factor b/extra/ui/frp/layout/layout.factor
index a4f0b09409..b5893c7aa3 100644
--- a/extra/ui/frp/layout/layout.factor
+++ b/extra/ui/frp/layout/layout.factor
@@ -34,16 +34,19 @@ SYMBOL: wordnames
: <frp-book> ( quot: ( -- model ) -- book ) f make-layout roll dup activate-model <book> handle-words
swap [ no-models ] unless-empty ; inline
+: <frp-book*> ( quot -- book ) f make-layout f <book> handle-words
+ swap [ no-models ] unless-empty ; inline
SYNTAX: $ CREATE-WORD dup [ , ] curry (( -- )) define-declared "$" expect
word [ [ building get length swap wordnames get set-at ] [ , ] bi ] curry over push-all ;
: insert-gadget ( number parent gadget -- ) -rot [ but-last insert-nth ] change-children drop ;
+: insert-size ( number parent size -- ) -rot [ but-last insert-nth ] change-sizes drop ;
GENERIC# insert-item 1 ( item location -- )
M: gadget insert-item dup first book? [ first2 spin [ add-gadget ] keep insert-gadget ]
[ [ f <layout> ] dip insert-item ] if ;
-M: layout insert-item first2 spin [ insert-layout ] keep gadget>> insert-gadget ;
+M: layout insert-item first2 spin [ insert-layout ] keep [ gadget>> insert-gadget ] [ size>> insert-size ] 3bi ;
M: model insert-item dup first book? [ no-models ]
[ first model>> swap add-connection ] if ;
@@ -54,3 +57,5 @@ M: model insert-item dup first book? [ no-models ]
: with-interface ( quot: ( -- gadget ) -- gadget ) H{ } clone wordnames
[ { } make insert-items ] with-variable ; inline
+
+! while children are changed, sizes aren't
\ No newline at end of file
From 5f3ca1072bb8d69db91a53b01d2ddf810bd9fe1f Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Wed, 10 Jun 2009 16:15:02 -0500
Subject: [PATCH 075/128] ui.frp uses placeholders for templating
---
core/sequences/sequences.factor | 3 +-
extra/closures/closures.factor | 4 +-
extra/persistency/persistency.factor | 20 ++-------
extra/ui/frp/gadgets/gadgets.factor | 9 ++--
extra/ui/frp/layout/layout.factor | 60 +++++++++++++--------------
extra/ui/frp/signals/signals.factor | 6 ++-
extra/ui/gadgets/alerts/alerts.factor | 8 ++--
7 files changed, 48 insertions(+), 62 deletions(-)
diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index 20a94f411a..5c27079b45 100755
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -941,4 +941,5 @@ PRIVATE>
[ list rest identity quot reduce-r list first quot call ] if ;
inline recursive
-:: combos ( list1 list2 -- result ) list2 [ [ 2array ] curry list1 swap map ] map concat ;
\ No newline at end of file
+:: combos ( list1 list2 -- result ) list2 [ [ 2array ] curry list1 swap map ] map concat ;
+: (head-slice) ( seq n -- seq' ) over length over < [ drop ] [ head-slice ] if ;
\ No newline at end of file
diff --git a/extra/closures/closures.factor b/extra/closures/closures.factor
index eb5a293fed..79fcf7564e 100644
--- a/extra/closures/closures.factor
+++ b/extra/closures/closures.factor
@@ -1,9 +1,9 @@
-USING: assocs io.pathnames fry namespaces namespaces.private kernel sequences parser ;
+USING: assocs io.pathnames fry namespaces namespaces.private kernel sequences parser hashtables ;
IN: closures
SYMBOL: |
! Selective Binding
-: delayed-bind-with ( vars quot -- quot' ) '[ _ dup [ get ] map zip [ _ bind ] curry ] ;
+: delayed-bind-with ( vars quot -- quot' ) '[ _ dup [ get ] map zip >hashtable [ _ bind ] curry ] ;
SYNTAX: C[ | parse-until parse-quotation delayed-bind-with over push-all ;
! Common ones
SYNTAX: DIR[ parse-quotation { current-directory } swap delayed-bind-with over push-all ;
diff --git a/extra/persistency/persistency.factor b/extra/persistency/persistency.factor
index d8bf0e9806..e56a81fd7c 100644
--- a/extra/persistency/persistency.factor
+++ b/extra/persistency/persistency.factor
@@ -5,28 +5,14 @@ tools.continuations ;
IN: persistency
TUPLE: persistent id ;
-UNION: bool word POSTPONE: f ;
-UNION: short-string string ;
-: db-ize ( class -- db-class ) {
- { bool [ BOOLEAN ] }
- { short-string [ { VARCHAR 100 } ] }
- { string [ TEXT ] }
- { float [ DOUBLE ] }
- { timestamp [ TIMESTAMP ] }
- { fixnum [ INTEGER ] }
- { byte-array [ BLOB ] }
- { url [ URL ] }
- [ drop FACTOR-BLOB ]
-} case ;
-
-: add-types ( table -- table' ) [ [ first dup >upper ] [ second db-ize ] bi 3array ] map
-{ "id" "ID" +db-assigned-id+ } prefix ;
+: add-types ( table -- table' ) [ dup array? [ first ] when dup >upper FACTOR-BLOB 3array ] map
+ { "id" "ID" +db-assigned-id+ } prefix ;
SYNTAX: STORED-TUPLE: parse-tuple-definition [ drop persistent ] dip [ define-tuple-class ]
[ nip [ dup unparse >upper ] [ add-types ] bi* define-persistent ] 3bi ;
-: define-db ( database class -- ) swap [ [ recreate-table ] with-db ] [ "database" set-word-prop ] 2bi ;
+: define-db ( database class -- ) swap [ [ ensure-table ] with-db ] [ "database" set-word-prop ] 2bi ;
: query>tuple ( tuple/query -- tuple ) dup query? [ tuple>> ] when ;
: w/db ( query quot -- ) [ dup query>tuple class "database" word-prop ] dip with-db ; inline
diff --git a/extra/ui/frp/gadgets/gadgets.factor b/extra/ui/frp/gadgets/gadgets.factor
index 9e0776752f..31a8364696 100644
--- a/extra/ui/frp/gadgets/gadgets.factor
+++ b/extra/ui/frp/gadgets/gadgets.factor
@@ -37,15 +37,16 @@ M: frp-field ungraft*
M: frp-field model-changed 2dup frp-model>> =
[ [ value>> ] [ editor>> ] bi* set-editor-string ]
[ nip [ editor>> editor-string ] [ frp-model>> ] bi set-model ] if ;
-: after-empty ( model quot -- model' ) fmap "" <model> <switch> ; inline ! pattern for editors, labels
-: <frp-field*> ( -- field ) "" <model> <frp-field> ;
+: <frp-field*> ( -- field ) f <model> <frp-field> ;
: <empty-field> ( model -- field ) "" <model> <switch> <frp-field> ;
+: <empty-field*> ( -- field ) "" <model> <frp-field> ;
: <frp-editor> ( model -- gadget )
frp-field [ <multiline-editor> ] dip new-border dup gadget-child >>editor
field-theme swap >>frp-model { 1 0 } >>align ;
-: <empty-editor> ( model -- editor ) "" <model> <switch> <frp-editor> ;
-: <frp-editor*> ( -- editor ) "" <model> <frp-editor> ;
+: <frp-editor*> ( -- editor ) f <model> <frp-editor> ;
+: <empty-editor*> ( -- field ) "" <model> <frp-editor> ;
+: <empty-editor> ( model -- field ) "" <model> <switch> <frp-editor> ;
GENERIC: output-model ( gadget -- model )
M: gadget output-model model>> ;
diff --git a/extra/ui/frp/layout/layout.factor b/extra/ui/frp/layout/layout.factor
index b5893c7aa3..6da8be3a8d 100644
--- a/extra/ui/frp/layout/layout.factor
+++ b/extra/ui/frp/layout/layout.factor
@@ -1,11 +1,18 @@
-USING: accessors assocs arrays fry kernel lexer make math math.parser
-models models.product namespaces parser sequences
-ui.frp.gadgets ui.gadgets ui.gadgets.books ui.gadgets.tracks
-words tools.continuations ;
+USING: accessors fry kernel lexer make math.parser models
+models.product namespaces parser sequences ui.frp.gadgets
+ui.gadgets ui.gadgets.books ui.gadgets.tracks vectors words ;
+QUALIFIED: make
IN: ui.frp.layout
TUPLE: layout gadget size ; C: <layout> layout
-ERROR: no-models models ;
+TUPLE: placeholder < gadget ;
+ERROR: no-models-in-books models ;
+
+DEFER: insert-item
+HOOK: , building ( uiitem -- )
+M: vector , make:, ;
+M: f , dup placeholder? [ building set ] [ "No location to add UI item" throw ] if ;
+M: placeholder , [ building get insert-item ] keep relayout ;
SYNTAX: ,% scan string>number [ <layout> , ] curry over push-all ;
SYNTAX: ->% scan string>number '[ [ _ <layout> , ] [ output-model ] bi ] over push-all ;
@@ -16,46 +23,37 @@ M: model -> dup , ;
: <spacer> ( -- ) <gadget> 1 <layout> , ;
-SYMBOL: wordnames
-: insert-layout ( track layout -- track ) [ gadget>> ] [ size>> ] bi track-add ; inline
+: add-layout ( track layout -- track ) [ gadget>> ] [ size>> ] bi track-add ; inline
: layouts ( sized? gadgets -- layouts ) [ [ gadget? ] [ layout? ] bi or ] filter swap
[ [ dup layout? [ f <layout> ] unless ] map ] when ;
-: make-layout ( building sized? -- models words layouts ) [ swap layouts ] curry
- [ { } make [ [ model? ] filter ] [ [ word? ] filter ] ] dip tri ; inline
-: handle-words ( words gadget -- gadget ) tuck
- [ [ swap 2array ] curry wordnames get swap change-at ] curry each ;
+: make-layout ( building sized? -- models layouts ) [ swap layouts ] curry
+ [ { } make [ [ model? ] filter ] ] dip bi ; inline
: <box> ( gadgets type -- track )
[ t make-layout ] dip <track>
- swap [ insert-layout ] each
- handle-words
+ swap [ add-layout ] each
swap [ <product> >>model ] unless-empty ; inline
: <hbox> ( gadgets -- track ) horizontal <box> ; inline
: <vbox> ( gadgets -- track ) vertical <box> ; inline
-: <frp-book> ( quot: ( -- model ) -- book ) f make-layout roll dup activate-model <book> handle-words
- swap [ no-models ] unless-empty ; inline
-: <frp-book*> ( quot -- book ) f make-layout f <book> handle-words
- swap [ no-models ] unless-empty ; inline
+: make-book ( models gadgets model -- book ) <book> swap [ no-models-in-books ] unless-empty ;
+: <frp-book> ( quot: ( -- model ) -- book ) f make-layout rot 0 >>value make-book ; inline
+: <frp-book*> ( quot -- book ) f make-layout f make-book ; inline
-SYNTAX: $ CREATE-WORD dup [ , ] curry (( -- )) define-declared "$" expect
- word [ [ building get length swap wordnames get set-at ] [ , ] bi ] curry over push-all ;
+SYNTAX: $ CREATE-WORD placeholder new
+ [ [ , ] curry (( -- )) define-declared "$" expect ]
+ [ [ , ] curry ] bi over push-all ;
: insert-gadget ( number parent gadget -- ) -rot [ but-last insert-nth ] change-children drop ;
: insert-size ( number parent size -- ) -rot [ but-last insert-nth ] change-sizes drop ;
+: insertion-point ( gadget placeholder -- number parent gadget ) dup parent>> [ children>> index ] keep rot ;
GENERIC# insert-item 1 ( item location -- )
-M: gadget insert-item dup first book? [ first2 spin [ add-gadget ] keep insert-gadget ]
- [ [ f <layout> ] dip insert-item ] if ;
-M: layout insert-item first2 spin [ insert-layout ] keep [ gadget>> insert-gadget ] [ size>> insert-size ] 3bi ;
-M: model insert-item dup first book? [ no-models ]
+M: gadget insert-item dup parent>> track? [ [ f <layout> ] dip insert-item ]
+ [ insertion-point [ add-gadget ] keep insert-gadget ] if ;
+M: layout insert-item insertion-point [ add-layout ] keep [ gadget>> insert-gadget ] [ size>> insert-size ] 3bi ;
+M: model insert-item dup first book? [ no-models-in-books ]
[ first model>> swap add-connection ] if ;
-: insert-items ( makelist -- ) f swap [ dup word?
- [ nip ] [
- over [ wordnames get at insert-item ] [ wordnames get [ first2 1 + 2array ] change-at ] bi
- ] if ] each drop ;
+: insert-items ( makelist -- ) f swap [ dup placeholder? [ nip ] [ over insert-item ] if ] each drop ;
-: with-interface ( quot: ( -- gadget ) -- gadget ) H{ } clone wordnames
- [ { } make insert-items ] with-variable ; inline
-
-! while children are changed, sizes aren't
\ No newline at end of file
+: with-interface ( quot: ( -- gadget ) -- gadget ) { } make insert-items ; inline
\ No newline at end of file
diff --git a/extra/ui/frp/signals/signals.factor b/extra/ui/frp/signals/signals.factor
index 63a5f9c1f1..61604a0b47 100644
--- a/extra/ui/frp/signals/signals.factor
+++ b/extra/ui/frp/signals/signals.factor
@@ -1,4 +1,5 @@
USING: accessors arrays kernel monads models models.product sequences ui.frp.functors ;
+FROM: models.product => product ;
IN: ui.frp.signals
TUPLE: multi-model < model ;
@@ -36,7 +37,7 @@ M: switch-model model-changed 2dup switcher>> =
[ [ value>> ] dip over [ t >>on set-model ] [ nip [ original>> ] keep f >>on model-changed ] if ]
[ dup on>> [ 2drop ] [ [ value>> ] dip over [ set-model ] [ 2drop ] if ] if ] if ;
: <switch> ( signal1 signal2 -- signal' ) swap [ 2array switch-model <multi-model> ] 2keep
- [ >>original ] [ >>switcher ] bi* ;
+ [ [ value>> >>value ] [ >>original ] bi ] [ >>switcher ] bi* ;
M: switch-model model-activated [ original>> ] keep model-changed ;
: >behavior ( event -- behavior ) t <model> <switch> ;
@@ -65,6 +66,7 @@ M: action (model-changed) [ [ value>> ] [ quot>> ] bi* call( a -- b ) ] keep val
[ swap add-connection ] 2keep model-changed ;
: <action> ( model quot -- action-signal ) [ 1array action <multi-model> ] dip >>quot dup f <action-value> >>value value>> ;
<PRIVATE
+
TUPLE: | < multi-model ;
: <|> ( models -- product ) | <multi-model> ;
GENERIC: models-changed ( product -- )
@@ -83,4 +85,4 @@ TUPLE: & < | ;
: <&> ( models -- product ) & <multi-model> ;
M: & models-changed dependencies>> [ f swap (>>value) ] each ;
PRIVATE>
-FMAPS: $> <$ fmap FOR & | ;
\ No newline at end of file
+FMAPS: $> <$ fmap FOR & | product ;
\ No newline at end of file
diff --git a/extra/ui/gadgets/alerts/alerts.factor b/extra/ui/gadgets/alerts/alerts.factor
index abebf458b4..427c423ea5 100644
--- a/extra/ui/gadgets/alerts/alerts.factor
+++ b/extra/ui/gadgets/alerts/alerts.factor
@@ -1,4 +1,4 @@
-USING: accessors models macros make generalizations kernel
+USING: accessors models macros generalizations kernel
ui ui.frp.gadgets ui.frp.signals ui.frp.layout ui.gadgets
ui.gadgets.labels ui.gadgets.editors ui.gadgets.buttons
ui.gadgets.packs locals sequences fonts io.styles
@@ -11,16 +11,14 @@ IN: ui.gadgets.alerts
: alert* ( str -- ) [ ] swap alert ;
-:: ask-user* ( model string -- model' )
+:: ask-user ( string -- model' )
[ [let | lbl [ string <label> T{ font { name "sans-serif" } { size 14 } } >>font dup , ]
fldm [ <frp-field*> ->% 1 ]
- btn [ "okay" <frp-border-button> model >>model ] |
+ btn [ "okay" <frp-border-button> ] |
btn -> [ fldm swap <updates> ]
[ [ drop lbl close-window ] $> , ] bi
] ] <vbox> { 161 86 } >>pref-dim "" open-window ;
-: ask-user ( string -- model ) f <model> swap ask-user* ;
-
MACRO: ask-buttons ( buttons -- quot ) dup length [
[ swap
[ 22 wrap-lines <label> T{ font { name "sans-serif" } { size 18 } } >>font ,
From c03ec9f0532e6bc5bc8e6817823801bcbbe58b9b Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Thu, 11 Jun 2009 09:13:52 -0500
Subject: [PATCH 076/128] frp ,? word added
---
extra/ui/frp/gadgets/gadgets.factor | 16 +++++++++++++---
extra/ui/frp/layout/layout.factor | 28 +++++++++++++++++++---------
2 files changed, 32 insertions(+), 12 deletions(-)
diff --git a/extra/ui/frp/gadgets/gadgets.factor b/extra/ui/frp/gadgets/gadgets.factor
index 31a8364696..d88c3dcb61 100644
--- a/extra/ui/frp/gadgets/gadgets.factor
+++ b/extra/ui/frp/gadgets/gadgets.factor
@@ -1,7 +1,7 @@
USING: accessors arrays kernel models monads ui.frp.signals ui.gadgets
ui.gadgets.buttons ui.gadgets.buttons.private ui.gadgets.editors
-ui.gadgets.tables sequences splitting
-ui.gadgets.scrollers ui.gadgets.borders ;
+ui.gadgets.tables sequences splitting ui.gadgets.labels
+ui.gadgets.scrollers ui.gadgets.borders classes ;
IN: ui.frp.gadgets
TUPLE: frp-button < button hook ;
@@ -57,4 +57,14 @@ M: frp-field output-model frp-model>> ;
M: scroller output-model viewport>> children>> first output-model ;
IN: accessors
-M: frp-button text>> children>> first text>> ;
\ No newline at end of file
+M: frp-button text>> children>> first text>> ;
+
+IN: ui.frp.gadgets
+GENERIC: (unique) ( gadget -- a )
+M: label (unique) text>> ;
+M: button (unique) text>> ;
+M: editor (unique) editor-string ;
+M: gadget (unique) children>> ;
+M: frp-field (unique) frp-model>> (unique) ;
+M: model (unique) [ dependencies>> ] [ value>> ] bi@ 2array ;
+: unique ( a -- b ) [ class ] [ (unique) ] bi 2array ;
\ No newline at end of file
diff --git a/extra/ui/frp/layout/layout.factor b/extra/ui/frp/layout/layout.factor
index 6da8be3a8d..30296cd11b 100644
--- a/extra/ui/frp/layout/layout.factor
+++ b/extra/ui/frp/layout/layout.factor
@@ -1,18 +1,22 @@
-USING: accessors fry kernel lexer make math.parser models
+USING: accessors arrays fry kernel lexer make math.parser models
models.product namespaces parser sequences ui.frp.gadgets
-ui.gadgets ui.gadgets.books ui.gadgets.tracks vectors words ;
+ui.gadgets ui.gadgets.books ui.gadgets.tracks vectors words
+combinators ;
QUALIFIED: make
IN: ui.frp.layout
+PREDICATE: true < word t = ;
+SYMBOL: inserting
TUPLE: layout gadget size ; C: <layout> layout
TUPLE: placeholder < gadget ;
ERROR: no-models-in-books models ;
DEFER: insert-item
-HOOK: , building ( uiitem -- )
-M: vector , make:, ;
-M: f , dup placeholder? [ building set ] [ "No location to add UI item" throw ] if ;
-M: placeholder , [ building get insert-item ] keep relayout ;
+HOOK: , inserting ( uiitem -- )
+M: f , make:, ;
+M: placeholder , [ inserting get insert-item ] keep relayout ;
+M: true , dup placeholder? [ inserting set ] [ "No location to add UI item" throw ] if ;
+SYNTAX: UI[ parse-quotation '[ [ t inserting _ with-variable ] ] over push-all ;
SYNTAX: ,% scan string>number [ <layout> , ] curry over push-all ;
SYNTAX: ->% scan string>number '[ [ _ <layout> , ] [ output-model ] bi ] over push-all ;
@@ -21,11 +25,17 @@ GENERIC: -> ( uiitem -- model )
M: gadget -> dup , output-model ;
M: model -> dup , ;
+: ,? ( uiitem -- ) inserting get parent>> children>> over
+ [ [ unique ] bi@ = ] curry find drop [ drop ] [ , ] if ;
+
+: ->? ( uiitem -- model ) dup ,? output-model ;
+
: <spacer> ( -- ) <gadget> 1 <layout> , ;
: add-layout ( track layout -- track ) [ gadget>> ] [ size>> ] bi track-add ; inline
: layouts ( sized? gadgets -- layouts ) [ [ gadget? ] [ layout? ] bi or ] filter swap
- [ [ dup layout? [ f <layout> ] unless ] map ] when ;
+ [ [ dup layout? [ f <layout> ] unless ] map ]
+ [ [ dup gadget? [ gadget>> ] unless ] map ] if ;
: make-layout ( building sized? -- models layouts ) [ swap layouts ] curry
[ { } make [ [ model? ] filter ] ] dip bi ; inline
: <box> ( gadgets type -- track )
@@ -51,8 +61,8 @@ GENERIC# insert-item 1 ( item location -- )
M: gadget insert-item dup parent>> track? [ [ f <layout> ] dip insert-item ]
[ insertion-point [ add-gadget ] keep insert-gadget ] if ;
M: layout insert-item insertion-point [ add-layout ] keep [ gadget>> insert-gadget ] [ size>> insert-size ] 3bi ;
-M: model insert-item dup first book? [ no-models-in-books ]
- [ first model>> swap add-connection ] if ;
+M: model insert-item parent>> dup book? [ no-models-in-books ]
+ [ dup model>> dup product? [ nip swap add-connection ] [ drop [ 1array <product> ] dip (>>model) ] if ] if ;
: insert-items ( makelist -- ) f swap [ dup placeholder? [ nip ] [ over insert-item ] if ] each drop ;
From b265e3afea2cc0b65ecb61e29398799cde823067 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sun, 14 Jun 2009 11:42:31 -0500
Subject: [PATCH 077/128] ui.frp connection reordering supported
---
core/sequences/sequences.factor | 4 ++-
extra/ui/frp/functors/functors-docs.factor | 2 +-
extra/ui/frp/functors/functors.factor | 9 +++++
extra/ui/frp/gadgets/gadgets.factor | 35 ++++++++++++--------
extra/ui/frp/instances/authors.txt | 1 -
extra/ui/frp/instances/instances-docs.factor | 9 -----
extra/ui/frp/instances/instances.factor | 12 -------
extra/ui/frp/layout/layout.factor | 4 +--
extra/ui/frp/signals/signals.factor | 33 ++++++++++++++----
9 files changed, 64 insertions(+), 45 deletions(-)
delete mode 100644 extra/ui/frp/instances/authors.txt
delete mode 100644 extra/ui/frp/instances/instances-docs.factor
delete mode 100644 extra/ui/frp/instances/instances.factor
diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index 5c27079b45..ab4772de51 100755
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -942,4 +942,6 @@ PRIVATE>
inline recursive
:: combos ( list1 list2 -- result ) list2 [ [ 2array ] curry list1 swap map ] map concat ;
-: (head-slice) ( seq n -- seq' ) over length over < [ drop ] [ head-slice ] if ;
\ No newline at end of file
+: (head-slice) ( seq n -- seq' ) over length over < [ drop ] [ head-slice ] if ;
+: find-all ( seq quot -- elts ) [ [ length iota ] keep ] dip
+ [ dupd call( a -- ? ) [ 2array ] [ 2drop f ] if ] curry 2map [ ] filter ; inline
\ No newline at end of file
diff --git a/extra/ui/frp/functors/functors-docs.factor b/extra/ui/frp/functors/functors-docs.factor
index 256be95702..e6c5c0f8d5 100644
--- a/extra/ui/frp/functors/functors-docs.factor
+++ b/extra/ui/frp/functors/functors-docs.factor
@@ -1,4 +1,4 @@
-USING: help.markup help.syntax ui.frp.signals ;
+USING: help.markup help.syntax ui.frp.signals ui.frp.signals.private ;
IN: ui.frp.functors
ARTICLE: { "ui.frp.functors" "signal-collection" } "Signal Collection"
diff --git a/extra/ui/frp/functors/functors.factor b/extra/ui/frp/functors/functors.factor
index 2808faf190..cda6a0effa 100644
--- a/extra/ui/frp/functors/functors.factor
+++ b/extra/ui/frp/functors/functors.factor
@@ -1,5 +1,6 @@
USING: fry functors generalizations kernel macros peg peg-lexer
sequences ;
+FROM: ui.frp.signals => #1 ;
IN: ui.frp.functors
FUNCTOR: fmaps ( W P -- )
@@ -9,11 +10,19 @@ w-n DEFINES ${W}-n-${P}
w-2 DEFINES 2${W}-${P}
w-3 DEFINES 3${W}-${P}
w-4 DEFINES 4${W}-${P}
+w-n* DEFINES ${W}-n-${P}*
+w-2* DEFINES 2${W}-${P}*
+w-3* DEFINES 3${W}-${P}*
+w-4* DEFINES 4${W}-${P}*
WHERE
MACRO: w-n ( int -- quot ) dup '[ [ _ narray <p> ] dip [ _ firstn ] prepend W ] ;
: w-2 ( a b quot -- mapped ) 2 w-n ; inline
: w-3 ( a b c quot -- mapped ) 3 w-n ; inline
: w-4 ( a b c d quot -- mapped ) 4 w-n ; inline
+MACRO: w-n* ( int -- quot ) dup '[ [ _ narray <p> #1 ] dip [ _ firstn ] prepend W ] ;
+: w-2* ( a b quot -- mapped ) 2 w-n* ; inline
+: w-3* ( a b c quot -- mapped ) 3 w-n* ; inline
+: w-4* ( a b c d quot -- mapped ) 4 w-n* ; inline
;FUNCTOR
ON-BNF: FMAPS:
diff --git a/extra/ui/frp/gadgets/gadgets.factor b/extra/ui/frp/gadgets/gadgets.factor
index d88c3dcb61..e5dae45b99 100644
--- a/extra/ui/frp/gadgets/gadgets.factor
+++ b/extra/ui/frp/gadgets/gadgets.factor
@@ -1,17 +1,17 @@
USING: accessors arrays kernel models monads ui.frp.signals ui.gadgets
ui.gadgets.buttons ui.gadgets.buttons.private ui.gadgets.editors
ui.gadgets.tables sequences splitting ui.gadgets.labels
-ui.gadgets.scrollers ui.gadgets.borders classes ;
+ui.gadgets.scrollers ui.gadgets.borders ;
IN: ui.frp.gadgets
-TUPLE: frp-button < button hook ;
+TUPLE: frp-button < button hook value ;
: <frp-button> ( gadget -- button ) [
- [ dup hook>> [ call( button -- ) ] [ drop ] if* ] keep
- [ dup set-control-value ] [ f swap set-control-value ] bi
+ [ [ [ value>> ] [ ] bi or ] keep set-control-value ]
+ [ dup hook>> [ call( button -- ) ] [ drop ] if* ] bi
] frp-button new-button f <basic> >>model ;
: <frp-border-button> ( text -- button ) <frp-button> border-button-theme ;
-TUPLE: frp-table < table { quot initial: [ ] } { val-quot initial: [ ] } color-quot column-titles column-alignment ;
+TUPLE: frp-table < table { quot initial: [ ] } { val-quot initial: [ ] } color-quot column-titles column-alignment actions ;
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* ;
@@ -19,14 +19,16 @@ 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* ;
: <frp-table> ( model -- table ) f frp-table new-table dup >>renderer
- V{ } clone <basic> >>selected-values V{ } clone <basic> >>selected-indices* ;
+ V{ } clone <basic> >>selected-values V{ } clone <basic> >>selected-indices*
+ f <basic> >>actions dup [ actions>> set-model ] curry >>action ;
: <frp-table*> ( -- table ) V{ } clone <model> <frp-table> ;
: <frp-list> ( column-model -- table ) <frp-table> [ 1array ] >>quot ;
: <frp-list*> ( -- table ) V{ } clone <model> <frp-list> ;
: indexed ( table -- table ) f >>val-quot ;
TUPLE: frp-field < field frp-model ;
-: <frp-field> ( model -- gadget ) frp-field new-field swap >>frp-model ;
+: init-field ( field -- field' ) [ [ ] [ "" ] if* ] change-value ;
+: <frp-field> ( model -- gadget ) frp-field new-field swap init-field >>frp-model ;
M: frp-field graft*
[ [ frp-model>> value>> ] [ editor>> ] bi set-editor-string ]
[ dup editor>> model>> add-connection ]
@@ -38,13 +40,13 @@ M: frp-field model-changed 2dup frp-model>> =
[ [ value>> ] [ editor>> ] bi* set-editor-string ]
[ nip [ editor>> editor-string ] [ frp-model>> ] bi set-model ] if ;
-: <frp-field*> ( -- field ) f <model> <frp-field> ;
+: <frp-field*> ( -- field ) "" <model> <frp-field> ;
: <empty-field> ( model -- field ) "" <model> <switch> <frp-field> ;
: <empty-field*> ( -- field ) "" <model> <frp-field> ;
: <frp-editor> ( model -- gadget )
frp-field [ <multiline-editor> ] dip new-border dup gadget-child >>editor
- field-theme swap >>frp-model { 1 0 } >>align ;
-: <frp-editor*> ( -- editor ) f <model> <frp-editor> ;
+ field-theme swap init-field >>frp-model { 1 0 } >>align ;
+: <frp-editor*> ( -- editor ) "" <model> <frp-editor> ;
: <empty-editor*> ( -- field ) "" <model> <frp-editor> ;
: <empty-editor> ( model -- field ) "" <model> <switch> <frp-editor> ;
@@ -60,11 +62,18 @@ IN: accessors
M: frp-button text>> children>> first text>> ;
IN: ui.frp.gadgets
-GENERIC: (unique) ( gadget -- a )
M: label (unique) text>> ;
M: button (unique) text>> ;
M: editor (unique) editor-string ;
M: gadget (unique) children>> ;
M: frp-field (unique) frp-model>> (unique) ;
-M: model (unique) [ dependencies>> ] [ value>> ] bi@ 2array ;
-: unique ( a -- b ) [ class ] [ (unique) ] bi 2array ;
\ No newline at end of file
+M: gadget null-val drop f ;
+M: table null-val multiple-selection?>> [ V{ } clone ] [ f ] if ;
+M: frp-field null-val drop "" ;
+
+SINGLETON: gadget-monad
+INSTANCE: gadget-monad monad
+INSTANCE: gadget monad
+M: gadget monad-of drop gadget-monad ;
+M: gadget-monad return drop <gadget> swap >>model ;
+M: gadget >>= output-model [ swap call( x -- y ) ] curry ;
\ No newline at end of file
diff --git a/extra/ui/frp/instances/authors.txt b/extra/ui/frp/instances/authors.txt
deleted file mode 100644
index 2300f69f11..0000000000
--- a/extra/ui/frp/instances/authors.txt
+++ /dev/null
@@ -1 +0,0 @@
-Sam Anklesaria
diff --git a/extra/ui/frp/instances/instances-docs.factor b/extra/ui/frp/instances/instances-docs.factor
deleted file mode 100644
index 8b26d208ad..0000000000
--- a/extra/ui/frp/instances/instances-docs.factor
+++ /dev/null
@@ -1,9 +0,0 @@
-USING: help.markup help.syntax monads ui.frp.signals ;
-IN: ui.frp.instances
-IN: ui.frp.instances
-ARTICLE: { "ui.frp.instances" "explanation" } "FRP Instances"
-"Signals are all functors, as " { $link fmap } " corresponds directly to " { $link <mapped> } $nl
-"Moduls also impliment monad functionalities. " { $link bind } "ing switches between two models. " $nl
-"Also, a gadget is a monad. Binding recieves a model and adds the resulting gadget onto the parent. " $nl
-"Examples of these instances can be seen in the " { $vocab-link "darcs-ui" } " vocabulary." ;
-ABOUT: { "ui.frp.instances" "explanation" }
\ No newline at end of file
diff --git a/extra/ui/frp/instances/instances.factor b/extra/ui/frp/instances/instances.factor
deleted file mode 100644
index 8ab7531621..0000000000
--- a/extra/ui/frp/instances/instances.factor
+++ /dev/null
@@ -1,12 +0,0 @@
-USING: accessors kernel models monads ui.frp.signals ui.frp.layout ui.gadgets ;
-IN: ui.frp.instances
-
-M: model >>= [ swap <action> ] curry ;
-M: model fmap <mapped> ;
-
-SINGLETON: gadget-monad
-INSTANCE: gadget-monad monad
-INSTANCE: gadget monad
-M: gadget monad-of drop gadget-monad ;
-M: gadget-monad return drop <gadget> swap >>model ;
-M: gadget >>= output-model [ swap call( x -- y ) ] curry ;
diff --git a/extra/ui/frp/layout/layout.factor b/extra/ui/frp/layout/layout.factor
index 30296cd11b..af7432ae43 100644
--- a/extra/ui/frp/layout/layout.factor
+++ b/extra/ui/frp/layout/layout.factor
@@ -1,7 +1,7 @@
USING: accessors arrays fry kernel lexer make math.parser models
models.product namespaces parser sequences ui.frp.gadgets
ui.gadgets ui.gadgets.books ui.gadgets.tracks vectors words
-combinators ;
+combinators ui.frp.signals ;
QUALIFIED: make
IN: ui.frp.layout
@@ -26,7 +26,7 @@ M: gadget -> dup , output-model ;
M: model -> dup , ;
: ,? ( uiitem -- ) inserting get parent>> children>> over
- [ [ unique ] bi@ = ] curry find drop [ drop ] [ , ] if ;
+ [ unique= ] curry find drop [ drop ] [ , ] if ;
: ->? ( uiitem -- model ) dup ,? output-model ;
diff --git a/extra/ui/frp/signals/signals.factor b/extra/ui/frp/signals/signals.factor
index 61604a0b47..7777274c20 100644
--- a/extra/ui/frp/signals/signals.factor
+++ b/extra/ui/frp/signals/signals.factor
@@ -1,14 +1,32 @@
-USING: accessors arrays kernel monads models models.product sequences ui.frp.functors ;
+USING: accessors arrays kernel monads models models.product sequences ui.frp.functors
+classes ui.tools.inspector tools.continuations ;
FROM: models.product => product ;
IN: ui.frp.signals
-TUPLE: multi-model < model ;
+GENERIC: (unique) ( gadget -- a )
+M: model (unique) ;
+: unique ( a -- b ) [ class ] [ (unique) ] bi 2array ;
+: unique= ( a b -- ? ) [ unique ] bi@ = ;
+
+GENERIC: null-val ( gadget -- model )
+M: model null-val drop f ;
+
+TUPLE: multi-model < model important? ;
GENERIC: (model-changed) ( model observer -- )
: <multi-model> ( models kind -- model ) f swap new-model [ [ add-dependency ] curry each ] keep ;
M: multi-model model-changed over value>> [ (model-changed) ] [ 2drop ] if ;
M: multi-model model-activated dup dependencies>> [ value>> ] find nip
[ swap model-changed ] [ drop ] if* ;
+: #1 ( model -- model' ) t >>important? ;
+
+IN: models
+: notify-connections ( model -- )
+ dup connections>> dup [ dup multi-model? [ important?>> ] [ drop f ] if ] find-all
+ [ second tuck [ remove ] dip prefix ] each
+ [ model-changed ] with each ;
+IN: ui.frp.signals
+
TUPLE: basic-model < multi-model ;
M: basic-model (model-changed) [ value>> ] dip set-model ;
: <merge> ( models -- signal ) basic-model <multi-model> ;
@@ -32,9 +50,10 @@ M: updater-model (model-changed) tuck updates>> =
: <updates> ( values updates -- signal ) [ 2array updater-model <multi-model> ] 2keep
[ >>values ] [ >>updates ] bi* ;
+SYMBOL: switch
TUPLE: switch-model < multi-model original switcher on ;
-M: switch-model model-changed 2dup switcher>> =
- [ [ value>> ] dip over [ t >>on set-model ] [ nip [ original>> ] keep f >>on model-changed ] if ]
+M: switch-model (model-changed) 2dup switcher>> =
+ [ [ value>> ] dip over switch = [ nip [ original>> ] keep f >>on model-changed ] [ t >>on set-model ] if ]
[ dup on>> [ 2drop ] [ [ value>> ] dip over [ set-model ] [ 2drop ] if ] if ] if ;
: <switch> ( signal1 signal2 -- signal' ) swap [ 2array switch-model <multi-model> ] 2keep
[ [ value>> >>value ] [ >>original ] bi ] [ >>switcher ] bi* ;
@@ -80,9 +99,11 @@ M: | update-model
dup value>> swap [ set-model ] set-product-value ;
M: | model-activated dup model-changed ;
-! Only when everything's true does he make it false
TUPLE: & < | ;
: <&> ( models -- product ) & <multi-model> ;
-M: & models-changed dependencies>> [ f swap (>>value) ] each ;
+M: & models-changed dependencies>> [ [ null-val ] keep (>>value) ] each ;
PRIVATE>
+
+M: model >>= [ swap <action> ] curry ;
+M: model fmap <mapped> ;
FMAPS: $> <$ fmap FOR & | product ;
\ No newline at end of file
From fee59b772bb6a9e6e7865039f1cd29c3e45d3a4f Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sun, 14 Jun 2009 12:58:55 -0500
Subject: [PATCH 078/128] ui.frp: no restarts needed for compilation
---
extra/ui/frp/signals/signals.factor | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/extra/ui/frp/signals/signals.factor b/extra/ui/frp/signals/signals.factor
index 7777274c20..e7b6374527 100644
--- a/extra/ui/frp/signals/signals.factor
+++ b/extra/ui/frp/signals/signals.factor
@@ -1,5 +1,4 @@
-USING: accessors arrays kernel monads models models.product sequences ui.frp.functors
-classes ui.tools.inspector tools.continuations ;
+USING: accessors arrays kernel monads models models.product sequences classes ;
FROM: models.product => product ;
IN: ui.frp.signals
@@ -106,4 +105,5 @@ PRIVATE>
M: model >>= [ swap <action> ] curry ;
M: model fmap <mapped> ;
+USE: ui.frp.functors
FMAPS: $> <$ fmap FOR & | product ;
\ No newline at end of file
From 8051218ee03781db02609af5bbc04eeeeff18a0c Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sun, 14 Jun 2009 13:08:49 -0500
Subject: [PATCH 079/128] ui.frp examples updated
---
extra/darcs-ui | 2 +-
extra/recipes/recipes.factor | 49 ++++++++++++++++++++++++++++++++++++
2 files changed, 50 insertions(+), 1 deletion(-)
create mode 100644 extra/recipes/recipes.factor
diff --git a/extra/darcs-ui b/extra/darcs-ui
index 4112107342..e2554b2eba 160000
--- a/extra/darcs-ui
+++ b/extra/darcs-ui
@@ -1 +1 @@
-Subproject commit 4112107342733e412dda8c1b747aa2ec1f27ddb6
+Subproject commit e2554b2ebae120bbd315ccbca8aa833bc8cb830e
diff --git a/extra/recipes/recipes.factor b/extra/recipes/recipes.factor
new file mode 100644
index 0000000000..788dfb1a51
--- /dev/null
+++ b/extra/recipes/recipes.factor
@@ -0,0 +1,49 @@
+USING: accessors arrays db.tuples db.sqlite persistency
+io.files.temp kernel monads sequences ui ui.frp.gadgets
+ui.frp.layout ui.frp.signals ui.gadgets.scrollers ui.gadgets.labels
+colors.constants ui.pens.solid combinators math locals strings
+ui.tools.inspector ;
+FROM: sets => prune ;
+IN: recipes
+STORED-TUPLE: recipe title votes txt genre ;
+: <recipe> ( title genre text -- recipe ) recipe new swap >>txt swap >>genre swap >>title ;
+"recipes.db" temp-file <sqlite-db> recipe define-db
+: top-recipes ( -- recipes ) <query> T{ recipe } >>tuple "votes" >>order get-tuples ;
+: top-genres ( -- genres ) top-recipes [ genre>> ] map prune 5 (head-slice) ;
+: interface ( -- book ) [
+ [
+ [ $ TOOLBAR $ <spacer> $ GENRES $ ] <hbox> { 5 0 } >>gap COLOR: gray <solid> >>interior ,
+ $ RECIPES $
+ ] <vbox> ,
+ [
+ [ "Title:" <label> , $ TITLE $ "Genre:" <label> , $ GENRE $ ] <hbox> ,
+ $ BODY $
+ $ BUTTON $
+ ] <vbox> ,
+ ] <frp-book*> { 350 245 } >>pref-dim ;
+:: recipe-browser ( -- ) [
+ interface
+ <frp-table*> :> tbl
+ "okay" <frp-border-button> BUTTON -> :> ok
+ "Submit Recipe" <frp-button> [ store-tuple ] >>value TOOLBAR -> :> submit
+ submit ok [ [ drop ] ] <$ 2array <merge> [ drop ] >>value :> quot
+ ok t <basic> "all" <frp-button> GENRES -> 3array <merge> [ top-recipes ] <$ :> updates
+ updates [ top-genres UI[ <frp-button> GENRES ->? ] map <merge> ] bind*
+ [ text>> T{ recipe } swap >>genre get-tuples ] fmap
+ tbl swap updates 2array <merge> >>model
+ [ [ title>> ] [ genre>> ] bi 2array ] >>quot
+ { "Title" "Genre" } >>column-titles dup <scroller> RECIPES ,% 1
+ actions>> submit [ "" dup dup <recipe> ] <$ 2array <merge>
+ { [ [ title>> ] fmap <frp-field> TITLE ->% .5 ]
+ [ [ genre>> ] fmap <frp-field> GENRE ->% .5 ]
+ [ [ txt>> ] fmap <frp-editor> BODY ->% 1 ]
+ } cleave
+ [ <recipe> ] 3fmap-|
+ [ [ 1 ] <$ ]
+ [ quot ok <updates> #1 [ call( recipe -- ) 0 ] 2fmap-& ] bi
+ 2array <merge> 0 <basic> <switch> >>model
+ ] with-interface "recipes" open-window ;
+
+MAIN: recipe-browser
+
+! should clear out old values on submission
\ No newline at end of file
From 63f3c5dedd01569366e5209a79d79ec6c940d020 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Tue, 16 Jun 2009 14:36:01 -0500
Subject: [PATCH 080/128] persistency allows sql types for slots
---
basis/db/queries/queries.factor | 6 +++-
extra/persistency/persistency.factor | 9 ++++--
extra/recipes/recipes.factor | 41 ++++++++++++++++++----------
3 files changed, 37 insertions(+), 19 deletions(-)
diff --git a/basis/db/queries/queries.factor b/basis/db/queries/queries.factor
index c4aa47d383..d2674205b1 100755
--- a/basis/db/queries/queries.factor
+++ b/basis/db/queries/queries.factor
@@ -4,7 +4,7 @@ USING: accessors kernel math namespaces make sequences random
strings math.parser math.intervals combinators math.bitwise
nmake db db.tuples db.types classes words shuffle arrays
destructors continuations db.tuples.private prettyprint
-db.private byte-arrays ;
+db.private byte-arrays strings.parser parser ;
IN: db.queries
GENERIC: where ( specs obj -- )
@@ -130,6 +130,10 @@ M: integer where ( spec obj -- ) object-where ;
M: string where ( spec obj -- ) object-where ;
+TUPLE: pattern value ; C: <pattern> pattern
+SYNTAX: %" parse-string <pattern> parsed ;
+M: pattern where value>> over column-name>> 0% " LIKE " 0% bind# ;
+
: filter-slots ( tuple specs -- specs' )
[
slot-name>> swap get-slot-named
diff --git a/extra/persistency/persistency.factor b/extra/persistency/persistency.factor
index e56a81fd7c..479d39a2b7 100644
--- a/extra/persistency/persistency.factor
+++ b/extra/persistency/persistency.factor
@@ -6,10 +6,13 @@ IN: persistency
TUPLE: persistent id ;
-: add-types ( table -- table' ) [ dup array? [ first ] when dup >upper FACTOR-BLOB 3array ] map
- { "id" "ID" +db-assigned-id+ } prefix ;
+: add-types ( table -- table' ) [ dup array? [ [ first dup >upper ] [ second ] bi 3array ]
+ [ dup >upper FACTOR-BLOB 3array ] if
+ ] map { "id" "ID" +db-assigned-id+ } prefix ;
-SYNTAX: STORED-TUPLE: parse-tuple-definition [ drop persistent ] dip [ define-tuple-class ]
+: remove-types ( table -- table' ) [ dup array? [ first ] when ] map ;
+
+SYNTAX: STORED-TUPLE: parse-tuple-definition [ drop persistent ] dip [ remove-types define-tuple-class ]
[ nip [ dup unparse >upper ] [ add-types ] bi* define-persistent ] 3bi ;
: define-db ( database class -- ) swap [ [ ensure-table ] with-db ] [ "database" set-word-prop ] 2bi ;
diff --git a/extra/recipes/recipes.factor b/extra/recipes/recipes.factor
index 788dfb1a51..f9663403f5 100644
--- a/extra/recipes/recipes.factor
+++ b/extra/recipes/recipes.factor
@@ -1,18 +1,23 @@
-USING: accessors arrays db.tuples db.sqlite persistency
+USING: accessors arrays db.tuples db.sqlite persistency db.queries
io.files.temp kernel monads sequences ui ui.frp.gadgets
ui.frp.layout ui.frp.signals ui.gadgets.scrollers ui.gadgets.labels
-colors.constants ui.pens.solid combinators math locals strings
-ui.tools.inspector ;
+colors.constants ui.pens.solid combinators math locals strings fries
+ui.images db.types ;
FROM: sets => prune ;
IN: recipes
-STORED-TUPLE: recipe title votes txt genre ;
-: <recipe> ( title genre text -- recipe ) recipe new swap >>txt swap >>genre swap >>title ;
+STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } { genre { VARCHAR 100 } } ;
+: <recipe> ( title genre text -- recipe ) recipe new swap >>txt swap >>genre swap >>title 0 >>votes ;
"recipes.db" temp-file <sqlite-db> recipe define-db
-: top-recipes ( -- recipes ) <query> T{ recipe } >>tuple "votes" >>order get-tuples ;
-: top-genres ( -- genres ) top-recipes [ genre>> ] map prune 5 (head-slice) ;
+: top-recipes ( offset search -- recipes ) <query> T{ recipe } rot >>title >>tuple
+ "votes" >>order 30 >>limit swap >>offset get-tuples ;
+: top-genres ( -- genres ) f f top-recipes [ genre>> ] map prune 4 (head-slice) ;
+: <image-button> ( str -- button ) i" vocab:recipes/icons/_.tiff" <image-name> <frp-button> ;
+
: interface ( -- book ) [
[
- [ $ TOOLBAR $ <spacer> $ GENRES $ ] <hbox> { 5 0 } >>gap COLOR: gray <solid> >>interior ,
+ [ $ TOOLBAR $ <spacer> $ SEARCH $ ] <hbox> COLOR: AliceBlue <solid> >>interior ,
+ [ "Genres:" <label> , <spacer> $ GENRES $ ] <hbox>
+ { 5 0 } >>gap COLOR: gray <solid> >>interior ,
$ RECIPES $
] <vbox> ,
[
@@ -21,19 +26,27 @@ STORED-TUPLE: recipe title votes txt genre ;
$ BUTTON $
] <vbox> ,
] <frp-book*> { 350 245 } >>pref-dim ;
+
:: recipe-browser ( -- ) [
interface
<frp-table*> :> tbl
"okay" <frp-border-button> BUTTON -> :> ok
- "Submit Recipe" <frp-button> [ store-tuple ] >>value TOOLBAR -> :> submit
+ "submit" <image-button> [ store-tuple ] >>value TOOLBAR -> :> submit
+ "love" <image-button> TOOLBAR -> [ 1 ] <$
+ "hate" <image-button> -> [ -1 ] <$ 2array <merge> :> votes
+ "back" <image-button> -> [ -30 ] <$
+ "more" <image-button> -> [ 30 ] <$ 2array <merge> :> viewed
+ <frp-field*> SEARCH ->% 1 :> search
submit ok [ [ drop ] ] <$ 2array <merge> [ drop ] >>value :> quot
- ok t <basic> "all" <frp-button> GENRES -> 3array <merge> [ top-recipes ] <$ :> updates
+ viewed 0 [ + ] <fold> search ok t <basic> "all" <frp-button> GENRES -> 3array <merge>
+ [ drop [ f ] [ "%" dup surround <pattern> ] if-empty top-recipes ] 3fmap-| :> updates
updates [ top-genres UI[ <frp-button> GENRES ->? ] map <merge> ] bind*
[ text>> T{ recipe } swap >>genre get-tuples ] fmap
tbl swap updates 2array <merge> >>model
[ [ title>> ] [ genre>> ] bi 2array ] >>quot
- { "Title" "Genre" } >>column-titles dup <scroller> RECIPES ,% 1
- actions>> submit [ "" dup dup <recipe> ] <$ 2array <merge>
+ { "Title" "Genre" } >>column-titles dup <scroller> RECIPES ,% 1 actions>> :> val
+ val votes [ [ + ] curry change-votes store-tuple ] 2$>-| ,
+ val submit [ "" dup dup <recipe> ] <$ 2array <merge>
{ [ [ title>> ] fmap <frp-field> TITLE ->% .5 ]
[ [ genre>> ] fmap <frp-field> GENRE ->% .5 ]
[ [ txt>> ] fmap <frp-editor> BODY ->% 1 ]
@@ -44,6 +57,4 @@ STORED-TUPLE: recipe title votes txt genre ;
2array <merge> 0 <basic> <switch> >>model
] with-interface "recipes" open-window ;
-MAIN: recipe-browser
-
-! should clear out old values on submission
\ No newline at end of file
+MAIN: recipe-browser
\ No newline at end of file
From 48c63c5efbe6f51f26d7f3b4d465f3d759d1c591 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Tue, 16 Jun 2009 15:50:48 -0500
Subject: [PATCH 081/128] misc ui.frp fixes
---
extra/recipes/recipes.factor | 13 +++++++------
extra/ui/frp/signals/signals.factor | 4 +---
2 files changed, 8 insertions(+), 9 deletions(-)
diff --git a/extra/recipes/recipes.factor b/extra/recipes/recipes.factor
index f9663403f5..3fa65d336d 100644
--- a/extra/recipes/recipes.factor
+++ b/extra/recipes/recipes.factor
@@ -32,21 +32,22 @@ STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } {
<frp-table*> :> tbl
"okay" <frp-border-button> BUTTON -> :> ok
"submit" <image-button> [ store-tuple ] >>value TOOLBAR -> :> submit
- "love" <image-button> TOOLBAR -> [ 1 ] <$
- "hate" <image-button> -> [ -1 ] <$ 2array <merge> :> votes
+ "love" <image-button> 1 >>value TOOLBAR ->
+ "hate" <image-button> -1 >>value -> 2array <merge> :> votes
"back" <image-button> -> [ -30 ] <$
"more" <image-button> -> [ 30 ] <$ 2array <merge> :> viewed
<frp-field*> SEARCH ->% 1 :> search
submit ok [ [ drop ] ] <$ 2array <merge> [ drop ] >>value :> quot
- viewed 0 [ + ] <fold> search ok t <basic> "all" <frp-button> GENRES -> 3array <merge>
+ viewed 0 [ + ] <fold> search ok t <basic> "all" <frp-button> GENRES ->
+ tbl selected-value>> votes [ [ + ] curry change-votes modify-tuple ] 2$>-|
+ 4array <merge>
[ drop [ f ] [ "%" dup surround <pattern> ] if-empty top-recipes ] 3fmap-| :> updates
updates [ top-genres UI[ <frp-button> GENRES ->? ] map <merge> ] bind*
[ text>> T{ recipe } swap >>genre get-tuples ] fmap
tbl swap updates 2array <merge> >>model
[ [ title>> ] [ genre>> ] bi 2array ] >>quot
- { "Title" "Genre" } >>column-titles dup <scroller> RECIPES ,% 1 actions>> :> val
- val votes [ [ + ] curry change-votes store-tuple ] 2$>-| ,
- val submit [ "" dup dup <recipe> ] <$ 2array <merge>
+ { "Title" "Genre" } >>column-titles dup <scroller> RECIPES ,% 1 actions>>
+ submit [ "" dup dup <recipe> ] <$ 2array <merge>
{ [ [ title>> ] fmap <frp-field> TITLE ->% .5 ]
[ [ genre>> ] fmap <frp-field> GENRE ->% .5 ]
[ [ txt>> ] fmap <frp-editor> BODY ->% 1 ]
diff --git a/extra/ui/frp/signals/signals.factor b/extra/ui/frp/signals/signals.factor
index e7b6374527..e48d477465 100644
--- a/extra/ui/frp/signals/signals.factor
+++ b/extra/ui/frp/signals/signals.factor
@@ -92,10 +92,8 @@ M: | models-changed drop ;
M: | model-changed
nip
dup dependencies>> [ value>> ] all?
- [ [ dup [ value>> ] product-value >>value notify-connections ] keep models-changed ]
+ [ [ dup [ value>> ] product-value swap set-model ] keep models-changed ]
[ drop ] if ;
-M: | update-model
- dup value>> swap [ set-model ] set-product-value ;
M: | model-activated dup model-changed ;
TUPLE: & < | ;
From 6132608cc23cb936a87b3ab3783b1419f9355ae0 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Wed, 17 Jun 2009 12:35:09 -0500
Subject: [PATCH 082/128] extra sequences functions moved out of core
---
core/sequences/sequences.factor | 39 +++++++++++----------------
core/vocabs/parser/parser.factor | 6 ++---
extra/file-trees/file-trees.factor | 3 ++-
extra/fries/fries.factor | 2 +-
extra/recipes/recipes.factor | 4 +--
extra/ui/frp/functors/functors.factor | 2 +-
extra/ui/frp/gadgets/gadgets.factor | 3 ++-
extra/ui/frp/signals/signals.factor | 3 ++-
8 files changed, 28 insertions(+), 34 deletions(-)
mode change 100644 => 100755 core/vocabs/parser/parser.factor
diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index ab4772de51..6eea872343 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 locals slots.private math
+USING: accessors kernel kernel.private slots.private math
math.private math.order ;
IN: sequences
@@ -358,8 +358,14 @@ PRIVATE>
<PRIVATE
+: ((each)) ( seq -- n quot )
+ [ length ] keep [ nth-unsafe ] curry ; inline
+
: (each) ( seq quot -- n quot' )
- [ [ length ] keep [ nth-unsafe ] curry ] dip compose ; inline
+ [ ((each)) ] dip compose ; inline
+
+: (each-index) ( seq quot -- n quot' )
+ [ ((each)) [ keep ] curry ] dip compose ; inline
: (collect) ( quot into -- quot' )
[ [ keep ] dip set-nth-unsafe ] 2curry ; inline
@@ -498,19 +504,18 @@ PRIVATE>
: follow ( obj quot -- seq )
[ dup ] swap [ keep ] curry produce nip ; inline
-: prepare-index ( seq quot -- seq n quot )
- [ dup length ] dip ; inline
-
: each-index ( seq quot -- )
- prepare-index 2each ; inline
+ (each-index) each-integer ; inline
: interleave ( seq between quot -- )
- swap [ drop ] [ [ 2dip call ] 2curry ] 2bi
- [ [ 0 = ] 2dip if ] 2curry
- each-index ; inline
+ pick empty? [ 3drop ] [
+ [ [ drop first-unsafe ] dip call ]
+ [ [ rest-slice ] 2dip [ bi* ] 2curry each ]
+ 3bi
+ ] if ; inline
: map-index ( seq quot -- newseq )
- prepare-index 2map ; inline
+ [ dup length iota ] dip 2map ; inline
: reduce-index ( seq identity quot -- )
swapd each-index ; inline
@@ -931,17 +936,3 @@ PRIVATE>
[ array-flip ] [ generic-flip ] if
] [ generic-flip ] if
] unless ;
-
-: reduce1 ( seq quot -- result ) [ unclip ] dip reduce ; inline
-
-:: 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
-
-:: combos ( list1 list2 -- result ) list2 [ [ 2array ] curry list1 swap map ] map concat ;
-: (head-slice) ( seq n -- seq' ) over length over < [ drop ] [ head-slice ] if ;
-: find-all ( seq quot -- elts ) [ [ length iota ] keep ] dip
- [ dupd call( a -- ? ) [ 2array ] [ 2drop f ] if ] curry 2map [ ] filter ; inline
\ No newline at end of file
diff --git a/core/vocabs/parser/parser.factor b/core/vocabs/parser/parser.factor
old mode 100644
new mode 100755
index 98b8b8d0e8..0bfb607a52
--- a/core/vocabs/parser/parser.factor
+++ b/core/vocabs/parser/parser.factor
@@ -6,7 +6,7 @@ sets strings vocabs sorting accessors arrays compiler.units
combinators vectors splitting continuations math
parser.notes ;
IN: vocabs.parser
-
+
ERROR: no-word-error name ;
: word-restarts ( possibilities -- restarts )
@@ -17,7 +17,7 @@ ERROR: no-word-error name ;
word-restarts
swap "Defer word in current vocabulary" swap 2array
suffix ;
-
+
: <no-word-error> ( name possibilities -- error restarts )
[ drop \ no-word-error boa ] [ word-restarts-with-defer ] 2bi ;
@@ -198,4 +198,4 @@ PRIVATE>
2dup qualified-search dup [ 2nip ] [ drop vocab-search ] if ;
: search ( name -- word/f )
- manifest get search-manifest ;
\ No newline at end of file
+ manifest get search-manifest ;
diff --git a/extra/file-trees/file-trees.factor b/extra/file-trees/file-trees.factor
index 0329021f57..adfb7d67de 100644
--- a/extra/file-trees/file-trees.factor
+++ b/extra/file-trees/file-trees.factor
@@ -1,6 +1,7 @@
USING: accessors arrays delegate delegate.protocols
io.pathnames kernel locals sequences
-vectors make strings ui.frp.signals ui.frp.gadgets ;
+vectors make strings ui.frp.signals ui.frp.gadgets
+sequences.extras ;
IN: file-trees
TUPLE: walkable-vector vector father ;
diff --git a/extra/fries/fries.factor b/extra/fries/fries.factor
index 6639607a11..f67d0d7cd3 100644
--- a/extra/fries/fries.factor
+++ b/extra/fries/fries.factor
@@ -1,5 +1,5 @@
USING: arrays vectors combinators effects kernel math sequences splitting
-strings.parser parser fry ;
+strings.parser parser fry sequences.extras ;
IN: fries
: str-fry ( str on -- quot ) split
[ unclip-last [ [ spin glue ] reduce-r ] 2curry ]
diff --git a/extra/recipes/recipes.factor b/extra/recipes/recipes.factor
index 3fa65d336d..cec82a457d 100644
--- a/extra/recipes/recipes.factor
+++ b/extra/recipes/recipes.factor
@@ -1,7 +1,7 @@
USING: accessors arrays db.tuples db.sqlite persistency db.queries
io.files.temp kernel monads sequences ui ui.frp.gadgets
ui.frp.layout ui.frp.signals ui.gadgets.scrollers ui.gadgets.labels
-colors.constants ui.pens.solid combinators math locals strings fries
+colors.constants ui.pens.solid combinators math locals strings
ui.images db.types ;
FROM: sets => prune ;
IN: recipes
@@ -11,7 +11,7 @@ STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } {
: top-recipes ( offset search -- recipes ) <query> T{ recipe } rot >>title >>tuple
"votes" >>order 30 >>limit swap >>offset get-tuples ;
: top-genres ( -- genres ) f f top-recipes [ genre>> ] map prune 4 (head-slice) ;
-: <image-button> ( str -- button ) i" vocab:recipes/icons/_.tiff" <image-name> <frp-button> ;
+: <image-button> ( str -- button ) "vocab:recipes/icons/" ".tiff" surround <image-name> <frp-button> ;
: interface ( -- book ) [
[
diff --git a/extra/ui/frp/functors/functors.factor b/extra/ui/frp/functors/functors.factor
index cda6a0effa..1b31151013 100644
--- a/extra/ui/frp/functors/functors.factor
+++ b/extra/ui/frp/functors/functors.factor
@@ -1,5 +1,5 @@
USING: fry functors generalizations kernel macros peg peg-lexer
-sequences ;
+sequences sequences.extras ;
FROM: ui.frp.signals => #1 ;
IN: ui.frp.functors
diff --git a/extra/ui/frp/gadgets/gadgets.factor b/extra/ui/frp/gadgets/gadgets.factor
index e5dae45b99..ddcde69eaf 100644
--- a/extra/ui/frp/gadgets/gadgets.factor
+++ b/extra/ui/frp/gadgets/gadgets.factor
@@ -6,8 +6,9 @@ IN: ui.frp.gadgets
TUPLE: frp-button < button hook value ;
: <frp-button> ( gadget -- button ) [
+ [ dup hook>> [ call( button -- ) ] [ drop ] if* ]
[ [ [ value>> ] [ ] bi or ] keep set-control-value ]
- [ dup hook>> [ call( button -- ) ] [ drop ] if* ] bi
+ [ model>> f swap (>>value) ] tri
] frp-button new-button f <basic> >>model ;
: <frp-border-button> ( text -- button ) <frp-button> border-button-theme ;
diff --git a/extra/ui/frp/signals/signals.factor b/extra/ui/frp/signals/signals.factor
index e48d477465..b5389f7bb9 100644
--- a/extra/ui/frp/signals/signals.factor
+++ b/extra/ui/frp/signals/signals.factor
@@ -1,4 +1,5 @@
-USING: accessors arrays kernel monads models models.product sequences classes ;
+USING: accessors arrays kernel monads models models.product sequences classes
+sequences.extras ;
FROM: models.product => product ;
IN: ui.frp.signals
From 979d0c9d48a2ebc201295d233ac057086d73f219 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Wed, 17 Jun 2009 12:56:32 -0500
Subject: [PATCH 083/128] forgot recipes' sequences.extra dep
---
extra/recipes/recipes.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/recipes/recipes.factor b/extra/recipes/recipes.factor
index cec82a457d..88595b551a 100644
--- a/extra/recipes/recipes.factor
+++ b/extra/recipes/recipes.factor
@@ -2,7 +2,7 @@ USING: accessors arrays db.tuples db.sqlite persistency db.queries
io.files.temp kernel monads sequences ui ui.frp.gadgets
ui.frp.layout ui.frp.signals ui.gadgets.scrollers ui.gadgets.labels
colors.constants ui.pens.solid combinators math locals strings
-ui.images db.types ;
+ui.images db.types sequences.extras ;
FROM: sets => prune ;
IN: recipes
STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } { genre { VARCHAR 100 } } ;
From 4d2d9f86b49594d789ce7d20877fada9365a356e Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Wed, 17 Jun 2009 18:05:54 -0500
Subject: [PATCH 084/128] ui.frp.layout checks namespace only to 1 level
---
extra/ui/frp/layout/layout.factor | 13 +++++++------
1 file changed, 7 insertions(+), 6 deletions(-)
diff --git a/extra/ui/frp/layout/layout.factor b/extra/ui/frp/layout/layout.factor
index af7432ae43..038b739e52 100644
--- a/extra/ui/frp/layout/layout.factor
+++ b/extra/ui/frp/layout/layout.factor
@@ -1,21 +1,22 @@
-USING: accessors arrays fry kernel lexer make math.parser models
+USING: accessors assocs arrays fry kernel lexer make math.parser models
models.product namespaces parser sequences ui.frp.gadgets
ui.gadgets ui.gadgets.books ui.gadgets.tracks vectors words
combinators ui.frp.signals ;
QUALIFIED: make
IN: ui.frp.layout
-PREDICATE: true < word t = ;
SYMBOL: inserting
TUPLE: layout gadget size ; C: <layout> layout
TUPLE: placeholder < gadget ;
ERROR: no-models-in-books models ;
DEFER: insert-item
-HOOK: , inserting ( uiitem -- )
-M: f , make:, ;
-M: placeholder , [ inserting get insert-item ] keep relayout ;
-M: true , dup placeholder? [ inserting set ] [ "No location to add UI item" throw ] if ;
+: , ( uiitem -- ) inserting namespace at {
+ { f [ make:, ] }
+ { t [ dup placeholder? [ inserting set ] [ "No location to add UI item" throw ] if ] }
+ [ placeholder? [ [ inserting get insert-item ] keep relayout ] [ drop ] if ]
+} case ;
+
SYNTAX: UI[ parse-quotation '[ [ t inserting _ with-variable ] ] over push-all ;
SYNTAX: ,% scan string>number [ <layout> , ] curry over push-all ;
From 5f903930a3b9971354741dff61725845c5916564 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Thu, 18 Jun 2009 15:32:11 -0500
Subject: [PATCH 085/128] fold-model improvements
---
extra/darcs-ui | 2 +-
extra/recipes/recipes.factor | 4 ++--
extra/ui/frp/signals/signals.factor | 21 ++++++++++++++++-----
3 files changed, 19 insertions(+), 8 deletions(-)
diff --git a/extra/darcs-ui b/extra/darcs-ui
index e2554b2eba..8a2deafe64 160000
--- a/extra/darcs-ui
+++ b/extra/darcs-ui
@@ -1 +1 @@
-Subproject commit e2554b2ebae120bbd315ccbca8aa833bc8cb830e
+Subproject commit 8a2deafe64cba990453126befbbbf2eed0ffd8f8
diff --git a/extra/recipes/recipes.factor b/extra/recipes/recipes.factor
index 88595b551a..125f187e7f 100644
--- a/extra/recipes/recipes.factor
+++ b/extra/recipes/recipes.factor
@@ -27,7 +27,7 @@ STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } {
] <vbox> ,
] <frp-book*> { 350 245 } >>pref-dim ;
-:: recipe-browser ( -- ) [
+:: recipe-browser ( -- ) [ [
interface
<frp-table*> :> tbl
"okay" <frp-border-button> BUTTON -> :> ok
@@ -56,6 +56,6 @@ STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } {
[ [ 1 ] <$ ]
[ quot ok <updates> #1 [ call( recipe -- ) 0 ] 2fmap-& ] bi
2array <merge> 0 <basic> <switch> >>model
- ] with-interface "recipes" open-window ;
+ ] with-interface "recipes" open-window ] with-ui ;
MAIN: recipe-browser
\ No newline at end of file
diff --git a/extra/ui/frp/signals/signals.factor b/extra/ui/frp/signals/signals.factor
index b5389f7bb9..4db526dbb3 100644
--- a/extra/ui/frp/signals/signals.factor
+++ b/extra/ui/frp/signals/signals.factor
@@ -30,6 +30,7 @@ IN: ui.frp.signals
TUPLE: basic-model < multi-model ;
M: basic-model (model-changed) [ value>> ] dip set-model ;
: <merge> ( models -- signal ) basic-model <multi-model> ;
+: <2merge> ( model1 model2 -- signal ) 2array <merge> ;
: <basic> ( value -- signal ) basic-model new-model ;
TUPLE: filter-model < multi-model quot ;
@@ -37,11 +38,18 @@ M: filter-model (model-changed) [ value>> ] dip 2dup quot>> call( a -- ? )
[ set-model ] [ 2drop ] if ;
: <filter> ( model quot -- filter-signal ) [ 1array filter-model <multi-model> ] dip >>quot ;
-TUPLE: fold-model < multi-model quot ;
-M: fold-model (model-changed) [ [ value>> ] [ [ value>> ] [ quot>> ] bi ] bi*
- call( val oldval -- newval ) ] keep set-model ;
-: <fold> ( model oldval quot -- signal ) rot 1array fold-model <multi-model> swap >>quot
+TUPLE: fold-model < multi-model quot base values ;
+M: fold-model (model-changed) 2dup base>> =
+ [ [ [ value>> ] [ [ values>> ] [ quot>> ] bi ] bi* swapd reduce* ] keep set-model ]
+ [ [ [ value>> ] [ values>> ] bi* push ]
+ [ [ [ value>> ] [ [ value>> ] [ quot>> ] bi ] bi* call( val oldval -- newval ) ] keep set-model ] 2bi
+ ] if ;
+M: fold-model model-activated drop ;
+: new-fold-model ( deps -- model ) fold-model <multi-model> V{ } clone >>values ;
+: <fold> ( model oldval quot -- signal ) rot 1array new-fold-model swap >>quot
swap >>value ;
+: <fold*> ( model oldmodel quot -- signal ) over [ [ 2array new-fold-model ] dip >>quot ]
+ dip [ >>base ] [ value>> >>value ] bi ;
TUPLE: updater-model < multi-model values updates ;
M: updater-model (model-changed) tuck updates>> =
@@ -105,4 +113,7 @@ PRIVATE>
M: model >>= [ swap <action> ] curry ;
M: model fmap <mapped> ;
USE: ui.frp.functors
-FMAPS: $> <$ fmap FOR & | product ;
\ No newline at end of file
+FMAPS: $> <$ fmap FOR & | product ;
+
+! only used in construction
+: with-self ( quot: ( model -- model ) -- model ) [ f <basic> dup ] dip call swap [ add-dependency ] keep ; inline
\ No newline at end of file
From 0f7c3956d14a0dcb8b0d38ea202b88b848ee4daf Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Thu, 18 Jun 2009 15:54:24 -0500
Subject: [PATCH 086/128] frp-action-fields
---
extra/ui/frp/gadgets/gadgets.factor | 3 +++
1 file changed, 3 insertions(+)
diff --git a/extra/ui/frp/gadgets/gadgets.factor b/extra/ui/frp/gadgets/gadgets.factor
index ddcde69eaf..15b1aa4c30 100644
--- a/extra/ui/frp/gadgets/gadgets.factor
+++ b/extra/ui/frp/gadgets/gadgets.factor
@@ -51,6 +51,9 @@ M: frp-field model-changed 2dup frp-model>> =
: <empty-editor*> ( -- field ) "" <model> <frp-editor> ;
: <empty-editor> ( model -- field ) "" <model> <switch> <frp-editor> ;
+: <frp-action-field> ( -- field ) f <action-field> dup [ set-control-value ] curry >>quot
+ f <model> >>model ;
+
GENERIC: output-model ( gadget -- model )
M: gadget output-model model>> ;
M: table output-model dup multiple-selection?>>
From 08c386f5345c7654d7fd529e87ac1ac7ea69a0bf Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sun, 21 Jun 2009 21:07:16 -0500
Subject: [PATCH 087/128] dynamic lambdas
---
extra/set-n/set-n.factor | 10 +++++++---
1 file changed, 7 insertions(+), 3 deletions(-)
diff --git a/extra/set-n/set-n.factor b/extra/set-n/set-n.factor
index 97aa95199d..04731b0e27 100644
--- a/extra/set-n/set-n.factor
+++ b/extra/set-n/set-n.factor
@@ -1,5 +1,9 @@
-USING: assocs kernel math namespaces sequences ;
+USING: accessors assocs fry generalizations kernel math
+namespaces parser sequences words ;
IN: set-n
-: get* ( var n -- val ) namestack swap tail-slice* assoc-stack ;
+: get* ( var n -- val ) namestack dup length rot - head assoc-stack ;
-: set* ( val var n -- ) 1 + namestack [ length swap - ] keep nth set-at ;
\ No newline at end of file
+: set* ( val var n -- ) 1 + namestack [ length swap - ] keep nth set-at ;
+
+! dynamic lambda
+SYNTAX: :| (:) dup in>> dup length [ spin '[ _ narray _ swap zip _ bind ] ] 2curry dip define-declared ;
\ No newline at end of file
From b8633e5e1216a2f19447b953ef0a84548874fd9c Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sun, 21 Jun 2009 21:08:24 -0500
Subject: [PATCH 088/128] fixed point signals
---
extra/ui/frp/signals/signals.factor | 9 ++++++++-
1 file changed, 8 insertions(+), 1 deletion(-)
diff --git a/extra/ui/frp/signals/signals.factor b/extra/ui/frp/signals/signals.factor
index 4db526dbb3..24bf2b4148 100644
--- a/extra/ui/frp/signals/signals.factor
+++ b/extra/ui/frp/signals/signals.factor
@@ -77,7 +77,8 @@ M: mapped-model (model-changed)
set-model ;
TUPLE: side-effect-model < mapped-model ;
-M: side-effect-model (model-changed) [ [ value>> ] [ quot>> ] bi* call( old -- ) ] keep t swap set-model ;
+M: side-effect-model (model-changed) [ value>> ] dip [ quot>> call( old -- ) ] 2keep set-model ;
+
: $> ( model quot -- signal ) side-effect-model new-mapped-model ;
TUPLE: quot-model < mapped-model ;
@@ -115,5 +116,11 @@ M: model fmap <mapped> ;
USE: ui.frp.functors
FMAPS: $> <$ fmap FOR & | product ;
+! for side effects
+TUPLE: (frp-when) < multi-model quot cond ;
+: frp-when ( model quot cond -- model ) rot 1array (frp-when) <multi-model> swap >>cond swap >>quot ;
+M: (frp-when) (model-changed) [ quot>> ] 2keep
+ [ value>> ] [ cond>> ] bi* call( a -- ? ) [ call( model -- ) ] [ 2drop ] if ;
+
! only used in construction
: with-self ( quot: ( model -- model ) -- model ) [ f <basic> dup ] dip call swap [ add-dependency ] keep ; inline
\ No newline at end of file
From 2a26670099d5f191e39d2939ae77ec6e4b6937a5 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sun, 21 Jun 2009 21:08:50 -0500
Subject: [PATCH 089/128] image buttons built in
---
extra/recipes/recipes.factor | 1 -
extra/ui/frp/gadgets/gadgets.factor | 14 +++++++++-----
2 files changed, 9 insertions(+), 6 deletions(-)
diff --git a/extra/recipes/recipes.factor b/extra/recipes/recipes.factor
index 125f187e7f..89c0eab393 100644
--- a/extra/recipes/recipes.factor
+++ b/extra/recipes/recipes.factor
@@ -11,7 +11,6 @@ STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } {
: top-recipes ( offset search -- recipes ) <query> T{ recipe } rot >>title >>tuple
"votes" >>order 30 >>limit swap >>offset get-tuples ;
: top-genres ( -- genres ) f f top-recipes [ genre>> ] map prune 4 (head-slice) ;
-: <image-button> ( str -- button ) "vocab:recipes/icons/" ".tiff" surround <image-name> <frp-button> ;
: interface ( -- book ) [
[
diff --git a/extra/ui/frp/gadgets/gadgets.factor b/extra/ui/frp/gadgets/gadgets.factor
index 15b1aa4c30..b865170193 100644
--- a/extra/ui/frp/gadgets/gadgets.factor
+++ b/extra/ui/frp/gadgets/gadgets.factor
@@ -1,9 +1,9 @@
-USING: accessors arrays kernel models monads ui.frp.signals ui.gadgets
-ui.gadgets.buttons ui.gadgets.buttons.private ui.gadgets.editors
-ui.gadgets.tables sequences splitting ui.gadgets.labels
-ui.gadgets.scrollers ui.gadgets.borders ;
+USING: accessors arrays kernel models monads
+sequences ui.frp.signals ui.gadgets ui.gadgets.borders
+ui.gadgets.buttons ui.gadgets.buttons.private
+ui.gadgets.editors ui.gadgets.labels ui.gadgets.scrollers
+ui.gadgets.tables ui.images vocabs.parser ;
IN: ui.frp.gadgets
-
TUPLE: frp-button < button hook value ;
: <frp-button> ( gadget -- button ) [
[ dup hook>> [ call( button -- ) ] [ drop ] if* ]
@@ -54,6 +54,10 @@ M: frp-field model-changed 2dup frp-model>> =
: <frp-action-field> ( -- field ) f <action-field> dup [ set-control-value ] curry >>quot
f <model> >>model ;
+: image-button ( filename path -- button ) ".tiff" surround <image-name> <frp-button> ;
+SYNTAX: <image-button> current-vocab name>> "vocab:" "/icons/" surround
+ [ image-button ] curry over push-all ;
+
GENERIC: output-model ( gadget -- model )
M: gadget output-model model>> ;
M: table output-model dup multiple-selection?>>
From ea052600bf8177d9dda0a6ac9fafe4531300a0dc Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Wed, 24 Jun 2009 20:06:12 -0500
Subject: [PATCH 090/128] simplification of frp
---
extra/recipes/recipes.factor | 12 +++----
extra/ui/frp/gadgets/gadgets.factor | 5 ---
extra/ui/frp/layout/layout.factor | 55 +++++++++++++++--------------
extra/ui/frp/signals/signals.factor | 14 +++-----
4 files changed, 38 insertions(+), 48 deletions(-)
diff --git a/extra/recipes/recipes.factor b/extra/recipes/recipes.factor
index 89c0eab393..4c793c31c8 100644
--- a/extra/recipes/recipes.factor
+++ b/extra/recipes/recipes.factor
@@ -2,7 +2,7 @@ USING: accessors arrays db.tuples db.sqlite persistency db.queries
io.files.temp kernel monads sequences ui ui.frp.gadgets
ui.frp.layout ui.frp.signals ui.gadgets.scrollers ui.gadgets.labels
colors.constants ui.pens.solid combinators math locals strings
-ui.images db.types sequences.extras ;
+ui.images db.types sequences.extras ui.tools.inspector ;
FROM: sets => prune ;
IN: recipes
STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } { genre { VARCHAR 100 } } ;
@@ -14,8 +14,8 @@ STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } {
: interface ( -- book ) [
[
- [ $ TOOLBAR $ <spacer> $ SEARCH $ ] <hbox> COLOR: AliceBlue <solid> >>interior ,
- [ "Genres:" <label> , <spacer> $ GENRES $ ] <hbox>
+ [ $ TOOLBAR $ ] <hbox> COLOR: AliceBlue <solid> >>interior ,
+ [ "Genres:" <label> , <spacer> $ ALL $ $ GENRES $ ] <hbox>
{ 5 0 } >>gap COLOR: gray <solid> >>interior ,
$ RECIPES $
] <vbox> ,
@@ -35,13 +35,13 @@ STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } {
"hate" <image-button> -1 >>value -> 2array <merge> :> votes
"back" <image-button> -> [ -30 ] <$
"more" <image-button> -> [ 30 ] <$ 2array <merge> :> viewed
- <frp-field*> SEARCH ->% 1 :> search
+ <spacer> <frp-field*> ->% 1 :> search
submit ok [ [ drop ] ] <$ 2array <merge> [ drop ] >>value :> quot
- viewed 0 [ + ] <fold> search ok t <basic> "all" <frp-button> GENRES ->
+ viewed 0 [ + ] <fold> search ok t <basic> "all" <frp-button> ALL ->
tbl selected-value>> votes [ [ + ] curry change-votes modify-tuple ] 2$>-|
4array <merge>
[ drop [ f ] [ "%" dup surround <pattern> ] if-empty top-recipes ] 3fmap-| :> updates
- updates [ top-genres UI[ <frp-button> GENRES ->? ] map <merge> ] bind*
+ updates [ top-genres [ <frp-button> GENRES -> ] map <merge> ] bind*
[ text>> T{ recipe } swap >>genre get-tuples ] fmap
tbl swap updates 2array <merge> >>model
[ [ title>> ] [ genre>> ] bi 2array ] >>quot
diff --git a/extra/ui/frp/gadgets/gadgets.factor b/extra/ui/frp/gadgets/gadgets.factor
index b865170193..3c9bbda1b3 100644
--- a/extra/ui/frp/gadgets/gadgets.factor
+++ b/extra/ui/frp/gadgets/gadgets.factor
@@ -70,11 +70,6 @@ IN: accessors
M: frp-button text>> children>> first text>> ;
IN: ui.frp.gadgets
-M: label (unique) text>> ;
-M: button (unique) text>> ;
-M: editor (unique) editor-string ;
-M: gadget (unique) children>> ;
-M: frp-field (unique) frp-model>> (unique) ;
M: gadget null-val drop f ;
M: table null-val multiple-selection?>> [ V{ } clone ] [ f ] if ;
M: frp-field null-val drop "" ;
diff --git a/extra/ui/frp/layout/layout.factor b/extra/ui/frp/layout/layout.factor
index 038b739e52..cfdc1e2b86 100644
--- a/extra/ui/frp/layout/layout.factor
+++ b/extra/ui/frp/layout/layout.factor
@@ -1,23 +1,24 @@
-USING: accessors assocs arrays fry kernel lexer make math.parser models
-models.product namespaces parser sequences ui.frp.gadgets
+USING: accessors assocs arrays fry kernel make math.parser models
+models.product namespaces sequences ui.frp.gadgets parser lexer
ui.gadgets ui.gadgets.books ui.gadgets.tracks vectors words
-combinators ui.frp.signals ;
+combinators ui.frp.signals monads sequences.extras ;
QUALIFIED: make
IN: ui.frp.layout
-SYMBOL: inserting
TUPLE: layout gadget size ; C: <layout> layout
-TUPLE: placeholder < gadget ;
-ERROR: no-models-in-books models ;
+TUPLE: placeholder < gadget members ;
+: <placeholder> ( -- placeholder ) placeholder new V{ } clone >>members ;
-DEFER: insert-item
-: , ( uiitem -- ) inserting namespace at {
- { f [ make:, ] }
- { t [ dup placeholder? [ inserting set ] [ "No location to add UI item" throw ] if ] }
- [ placeholder? [ [ inserting get insert-item ] keep relayout ] [ drop ] if ]
-} case ;
+: (remove-members) ( placeholder members -- ) [ [ model? ] filter swap parent>> model>> [ remove-connection ] curry each ]
+ [ [ gadget? ] filter swap parent>> children>> [ delete ] curry each ] 2bi ;
+: remove-members ( placeholder -- ) dup members>> [ drop ] [ [ (remove-members) ] keep empty ] if-empty ;
+: add-member ( obj placeholder -- ) over layout? [ [ gadget>> ] dip ] when members>> push ;
-SYNTAX: UI[ parse-quotation '[ [ t inserting _ with-variable ] ] over push-all ;
+: , ( item -- ) make:, ;
+: make* ( quot -- list ) { } make ; inline
+
+DEFER: with-interface
+: insertion-quot ( quot -- quot' ) <placeholder> dup , swap '[ [ _ , @ ] with-interface ] ;
SYNTAX: ,% scan string>number [ <layout> , ] curry over push-all ;
SYNTAX: ->% scan string>number '[ [ _ <layout> , ] [ output-model ] bi ] over push-all ;
@@ -26,11 +27,6 @@ GENERIC: -> ( uiitem -- model )
M: gadget -> dup , output-model ;
M: model -> dup , ;
-: ,? ( uiitem -- ) inserting get parent>> children>> over
- [ unique= ] curry find drop [ drop ] [ , ] if ;
-
-: ->? ( uiitem -- model ) dup ,? output-model ;
-
: <spacer> ( -- ) <gadget> 1 <layout> , ;
: add-layout ( track layout -- track ) [ gadget>> ] [ size>> ] bi track-add ; inline
@@ -38,7 +34,7 @@ M: model -> dup , ;
[ [ dup layout? [ f <layout> ] unless ] map ]
[ [ dup gadget? [ gadget>> ] unless ] map ] if ;
: make-layout ( building sized? -- models layouts ) [ swap layouts ] curry
- [ { } make [ [ model? ] filter ] ] dip bi ; inline
+ [ make* [ [ model? ] filter ] ] dip bi ; inline
: <box> ( gadgets type -- track )
[ t make-layout ] dip <track>
swap [ add-layout ] each
@@ -46,11 +42,11 @@ M: model -> dup , ;
: <hbox> ( gadgets -- track ) horizontal <box> ; inline
: <vbox> ( gadgets -- track ) vertical <box> ; inline
-: make-book ( models gadgets model -- book ) <book> swap [ no-models-in-books ] unless-empty ;
+: make-book ( models gadgets model -- book ) <book> swap [ "No models in books" throw ] unless-empty ;
: <frp-book> ( quot: ( -- model ) -- book ) f make-layout rot 0 >>value make-book ; inline
: <frp-book*> ( quot -- book ) f make-layout f make-book ; inline
-SYNTAX: $ CREATE-WORD placeholder new
+SYNTAX: $ CREATE-WORD <placeholder>
[ [ , ] curry (( -- )) define-declared "$" expect ]
[ [ , ] curry ] bi over push-all ;
@@ -58,13 +54,18 @@ SYNTAX: $ CREATE-WORD placeholder new
: insert-size ( number parent size -- ) -rot [ but-last insert-nth ] change-sizes drop ;
: insertion-point ( gadget placeholder -- number parent gadget ) dup parent>> [ children>> index ] keep rot ;
-GENERIC# insert-item 1 ( item location -- )
-M: gadget insert-item dup parent>> track? [ [ f <layout> ] dip insert-item ]
+GENERIC# (insert-item) 1 ( item location -- )
+M: gadget (insert-item) dup parent>> track? [ [ f <layout> ] dip (insert-item) ]
[ insertion-point [ add-gadget ] keep insert-gadget ] if ;
-M: layout insert-item insertion-point [ add-layout ] keep [ gadget>> insert-gadget ] [ size>> insert-size ] 3bi ;
-M: model insert-item parent>> dup book? [ no-models-in-books ]
+M: layout (insert-item) insertion-point [ add-layout ] keep [ gadget>> insert-gadget ] [ size>> insert-size ] 3bi ;
+M: model (insert-item) parent>> dup book? [ "No models in books" throw ]
[ dup model>> dup product? [ nip swap add-connection ] [ drop [ 1array <product> ] dip (>>model) ] if ] if ;
+: insert-item ( item location -- ) [ add-member ] 2keep (insert-item) ;
-: insert-items ( makelist -- ) f swap [ dup placeholder? [ nip ] [ over insert-item ] if ] each drop ;
+: insert-items ( makelist -- ) f swap [ dup placeholder?
+ [ nip [ dup get [ drop ] [ remove-members ] if ] [ on ] [ ] tri ]
+ [ over insert-item ] if ] each drop ;
-: with-interface ( quot: ( -- gadget ) -- gadget ) { } make insert-items ; inline
\ No newline at end of file
+: with-interface ( quot -- ) make* [ insert-items ] with-scope ; inline
+
+M: model >>= [ swap insertion-quot <action> ] curry ;
\ No newline at end of file
diff --git a/extra/ui/frp/signals/signals.factor b/extra/ui/frp/signals/signals.factor
index 24bf2b4148..707c271159 100644
--- a/extra/ui/frp/signals/signals.factor
+++ b/extra/ui/frp/signals/signals.factor
@@ -3,11 +3,6 @@ sequences.extras ;
FROM: models.product => product ;
IN: ui.frp.signals
-GENERIC: (unique) ( gadget -- a )
-M: model (unique) ;
-: unique ( a -- b ) [ class ] [ (unique) ] bi 2array ;
-: unique= ( a b -- ? ) [ unique ] bi@ = ;
-
GENERIC: null-val ( gadget -- model )
M: model null-val drop f ;
@@ -111,16 +106,15 @@ TUPLE: & < | ;
M: & models-changed dependencies>> [ [ null-val ] keep (>>value) ] each ;
PRIVATE>
-M: model >>= [ swap <action> ] curry ;
-M: model fmap <mapped> ;
-USE: ui.frp.functors
-FMAPS: $> <$ fmap FOR & | product ;
-
! for side effects
TUPLE: (frp-when) < multi-model quot cond ;
: frp-when ( model quot cond -- model ) rot 1array (frp-when) <multi-model> swap >>cond swap >>quot ;
M: (frp-when) (model-changed) [ quot>> ] 2keep
[ value>> ] [ cond>> ] bi* call( a -- ? ) [ call( model -- ) ] [ 2drop ] if ;
+M: model fmap <mapped> ;
+USE: ui.frp.functors
+FMAPS: $> <$ fmap FOR & | product ;
+
! only used in construction
: with-self ( quot: ( model -- model ) -- model ) [ f <basic> dup ] dip call swap [ add-dependency ] keep ; inline
\ No newline at end of file
From 5ef2e957e36a3703b24dd59133dae197c6fdcae4 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Thu, 25 Jun 2009 15:55:09 -0500
Subject: [PATCH 091/128] frp: using unparent rather than manual child removal
---
extra/ui/frp/layout/layout.factor | 7 ++++---
1 file changed, 4 insertions(+), 3 deletions(-)
diff --git a/extra/ui/frp/layout/layout.factor b/extra/ui/frp/layout/layout.factor
index cfdc1e2b86..4527b1f092 100644
--- a/extra/ui/frp/layout/layout.factor
+++ b/extra/ui/frp/layout/layout.factor
@@ -1,7 +1,7 @@
USING: accessors assocs arrays fry kernel make math.parser models
models.product namespaces sequences ui.frp.gadgets parser lexer
ui.gadgets ui.gadgets.books ui.gadgets.tracks vectors words
-combinators ui.frp.signals monads sequences.extras ;
+combinators ui.frp.signals monads sequences.extras ui.tools.inspector ;
QUALIFIED: make
IN: ui.frp.layout
@@ -10,7 +10,8 @@ TUPLE: placeholder < gadget members ;
: <placeholder> ( -- placeholder ) placeholder new V{ } clone >>members ;
: (remove-members) ( placeholder members -- ) [ [ model? ] filter swap parent>> model>> [ remove-connection ] curry each ]
- [ [ gadget? ] filter swap parent>> children>> [ delete ] curry each ] 2bi ;
+ [ nip [ gadget? ] filter [ unparent ] each ] 2bi ;
+
: remove-members ( placeholder -- ) dup members>> [ drop ] [ [ (remove-members) ] keep empty ] if-empty ;
: add-member ( obj placeholder -- ) over layout? [ [ gadget>> ] dip ] when members>> push ;
@@ -62,7 +63,7 @@ M: model (insert-item) parent>> dup book? [ "No models in books" throw ]
[ dup model>> dup product? [ nip swap add-connection ] [ drop [ 1array <product> ] dip (>>model) ] if ] if ;
: insert-item ( item location -- ) [ add-member ] 2keep (insert-item) ;
-: insert-items ( makelist -- ) f swap [ dup placeholder?
+: insert-items ( makelist -- ) t swap [ dup placeholder?
[ nip [ dup get [ drop ] [ remove-members ] if ] [ on ] [ ] tri ]
[ over insert-item ] if ] each drop ;
From 5a465d016bb94d4a6f5936abb02367cb8282acc8 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Thu, 25 Jun 2009 16:09:23 -0500
Subject: [PATCH 092/128] changed frp demo to a gui sudoku solver
---
extra/darcs-ui | 1 -
extra/gui-sudoku/authors.txt | 1 +
extra/gui-sudoku/gui-sudoku.factor | 32 +++++++++++++++++++++++++++
extra/gui-sudoku/summary.txt | 1 +
extra/persistency/authors.txt | 1 +
extra/recipes/authors.txt | 1 +
extra/recipes/icons/back.tiff | Bin 0 -> 2718 bytes
extra/recipes/icons/hate.tiff | Bin 0 -> 2718 bytes
extra/recipes/icons/love.tiff | Bin 0 -> 2718 bytes
extra/recipes/icons/more.tiff | Bin 0 -> 2718 bytes
extra/recipes/icons/submit.tiff | Bin 0 -> 2718 bytes
extra/recipes/summary.txt | 1 +
extra/sequences/extras/extras.factor | 22 ++++++++++++++++++
13 files changed, 59 insertions(+), 1 deletion(-)
delete mode 160000 extra/darcs-ui
create mode 100644 extra/gui-sudoku/authors.txt
create mode 100644 extra/gui-sudoku/gui-sudoku.factor
create mode 100644 extra/gui-sudoku/summary.txt
create mode 100644 extra/persistency/authors.txt
create mode 100644 extra/recipes/authors.txt
create mode 100644 extra/recipes/icons/back.tiff
create mode 100644 extra/recipes/icons/hate.tiff
create mode 100644 extra/recipes/icons/love.tiff
create mode 100644 extra/recipes/icons/more.tiff
create mode 100644 extra/recipes/icons/submit.tiff
create mode 100644 extra/recipes/summary.txt
create mode 100644 extra/sequences/extras/extras.factor
diff --git a/extra/darcs-ui b/extra/darcs-ui
deleted file mode 160000
index 8a2deafe64..0000000000
--- a/extra/darcs-ui
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit 8a2deafe64cba990453126befbbbf2eed0ffd8f8
diff --git a/extra/gui-sudoku/authors.txt b/extra/gui-sudoku/authors.txt
new file mode 100644
index 0000000000..ce0899f16e
--- /dev/null
+++ b/extra/gui-sudoku/authors.txt
@@ -0,0 +1 @@
+Sam Anklesaria
\ No newline at end of file
diff --git a/extra/gui-sudoku/gui-sudoku.factor b/extra/gui-sudoku/gui-sudoku.factor
new file mode 100644
index 0000000000..884271a6f3
--- /dev/null
+++ b/extra/gui-sudoku/gui-sudoku.factor
@@ -0,0 +1,32 @@
+USING: accessors arrays combinators.short-circuit grouping kernel lists
+lists.lazy locals math math.functions math.parser math.ranges
+models.product monads random sequences sets ui ui.frp.gadgets
+ui.frp.layout ui.frp.signals ui.gadgets.alerts vectors ;
+IN: gui-sudoku
+
+: row ( index -- row ) 1 + 9 / ceiling ;
+: col ( index -- col ) 9 mod 1 + ;
+: sq ( index -- square ) [ row ] [ col ] bi [ 3 / ceiling ] bi@ 2array ;
+: near ( a pos -- ? ) { [ [ row ] bi@ = ] [ [ col ] bi@ = ] [ [ sq ] bi@ = ] } 2|| ;
+MEMO:: solutions ( puzzle -- solutions )
+ f puzzle index
+ [ :> pos
+ 1 9 [a,b] 80 iota [ pos near ] filter [ puzzle nth ] map prune diff
+ [ 1array puzzle pos cut-slice rest surround ] map >list [ solutions ] bind
+ ] [ puzzle list-monad return ] if* ;
+
+: solution ( puzzle -- solution ) dup solutions dup +nil+ = [ drop "Unsolvable" alert* ] [ nip car ] if ;
+: hint ( puzzle -- puzzle' ) [ [ f swap indices random dup ] [ solution ] bi nth ] keep swapd >vector [ set-nth ] keep ;
+
+: do-sudoku ( -- ) [ [ [ $ SUDOKU $ ] <vbox> { 280 220 } >>pref-dim
+ [
+ 81 [ "" ] replicate <basic> <switch> [ SUDOKU [ <basic> ] map 9 group [ 3 group ] map 3 group
+ [ [ [ <spacer> [ [ <frp-field> ->% 2 [ string>number ] fmap ]
+ map <spacer> ] map concat ] <hbox> , ] map concat <spacer> ] map concat <product> dup
+ [ "Hint" <frp-border-button> -> "Solve" <frp-border-button> -> ] <hbox> , swapd [ <updates> ] 2bi@
+ [ [ hint ] fmap ] [ [ solution ] fmap ] bi* <2merge> [ [ [ number>string ] [ "" ] if* ] map ] fmap
+ ] bind
+ ] with-self SUDOKU ,
+ ] with-interface "Sudoku Sleuth" open-window ] with-ui ;
+
+MAIN: do-sudoku
\ No newline at end of file
diff --git a/extra/gui-sudoku/summary.txt b/extra/gui-sudoku/summary.txt
new file mode 100644
index 0000000000..d66e7be7f2
--- /dev/null
+++ b/extra/gui-sudoku/summary.txt
@@ -0,0 +1 @@
+graphical sudoku solver
\ No newline at end of file
diff --git a/extra/persistency/authors.txt b/extra/persistency/authors.txt
new file mode 100644
index 0000000000..ce0899f16e
--- /dev/null
+++ b/extra/persistency/authors.txt
@@ -0,0 +1 @@
+Sam Anklesaria
\ No newline at end of file
diff --git a/extra/recipes/authors.txt b/extra/recipes/authors.txt
new file mode 100644
index 0000000000..ce0899f16e
--- /dev/null
+++ b/extra/recipes/authors.txt
@@ -0,0 +1 @@
+Sam Anklesaria
\ No newline at end of file
diff --git a/extra/recipes/icons/back.tiff b/extra/recipes/icons/back.tiff
new file mode 100644
index 0000000000000000000000000000000000000000..27b8112046af309995f9802434e462f8289c593f
GIT binary patch
literal 2718
zcmeH}e@IhN6vyA&rcXCb=g<7PO)#~{a#+K3b2_L%%^ws+P~b1ZT)EVKD7wi|QELWj
z)}kyVBTXwMQ$w1F6pBGXi?mEh)X+ksp#M6ZH@7vxKSo;+)O&p1IrrRq&-dMTAKa6Y
zLTn}of=>{P7iigL>qM;HZp06Qg*_xfKTN(KNm}>}f{ER9-$s&Y@JV_w>1gyB=yT2E
zCrNK(9A}U|=C~i}Yx12(NPog%Rg!Qb1I)fV8EBC|+#-L*uQ<;8C$E_LK<7WXa9Ndi
z!M+PY5F+D<?5(p!N-$-WUYep?Qds&r1R;rRxji)m32d>vWtVRJeG@Ew>xPx@I>4C9
z9vT7(+cmMmvsvAl409`YV0QTid|1AYIz1qeI@?7fQR#8NXS@{VzqG^j=PNMvsmZ|H
z%56v}=UR`FJ7&3NfrJVW#8IionuQ|+FH7Og$9m8&)WECxYBTzUI+$2&fXT&1t7z;!
z0wxW993@Ip`9k0G641|UU~HxoMyJo%jOIbQK|@;M?Q)=s_iS{k8b)WzVEA1D481*J
z7iznb4I1&qoYOtyh45rT4g;@qpkJSDH>x}K8Z_bx9mEQ4_^ftlD`*D2pz;v~>Ry&z
zC~65Y?*~uB+9^Bb0yTHzK|34;W!-Ezdyi=|C$9?38uZ@B=22nde5yI;d??gEj)bC4
z3KShon~+~#t6}=b#CeX&{Dugq>5BkGI|q)pF(I#wVW7Cv9WD+E;gT-KDoR?S*Q~>&
zL0eulLvpa(|EWS72Iso?kkje_nKv0w+b@L36qb$`%~V-Qu4Uf!{MamJ_E9w-Dtm>H
z+qwbj24Wys$WW~})|OaoCVA+vG6?D(O5xf_8U#m?zpFvl2y`7lpW76|LEI27;t{-^
zNEPj8b!DkTC;h{@Nf`4&JdOSCXg44(2z`dp^XWWvO@Y;eq5h!r(`{G82jL@8h!oj_
qBqOOv8j^ve8{2ezHzGlHAlr~lNFd^i(C>$pk0Cdj|JUF01%3jeVq=*A
literal 0
HcmV?d00001
diff --git a/extra/recipes/icons/hate.tiff b/extra/recipes/icons/hate.tiff
new file mode 100644
index 0000000000000000000000000000000000000000..d7d5f8e748505e052da59d908a0033873db4ff65
GIT binary patch
literal 2718
zcmc)M4{Q@v90%~<wd-tIwskA*oG!Wu&Z#V#5Wq!=F*6z>3yBc_1ZLEXfPsjKgb-yK
zVH(UPBr^Xd&M*U!Ws(h;4reX0b!%mT4d@JG1+%iauC!g-`+w~{f5+O|W|O=nCZ_rH
z-n~EfefM7P(%M>h2ms0fbi;UDls+0^_EQKd<X{Vfw69dTlwmT;I?!XY)^;bOzg1?m
z&P;Bytiy6qy8jqsP1fTG#+I%xWlB<IQ$KST7-l2E$lRSSo0+nV>sMx6|M`FFaU2jr
z{vQbrNIW)|5(bqW16BAFRNjlmldgiwd5TrRTR_w})tnQN3y=u)%@LpK1kqgsvZo%T
zOD}<Zv9>@OTKT5vTILq|Y^*$7vx6w1|0v^iy?Ac*TcUeaQ0S{5yu<95JsX!P-km_S
zHK17k+ueuYT(wkmJuxKoRS~YoNVuPJh;(_&+W5q0pj_XJ>&sGR4C6ZW&!PBQOEF`D
zJ8dQGNy9B%kM*+bZGse4x=EK2bV7XU$83Lf8H9nS2f5Q_B-WXm#-CYvK>p)>NKwUU
zstn~u2hQt@EQ0&xUA(=D#5(TC!aG)P6wkd1DJnlnl_6hi1!?r7H1SeHKG*w5D0<99
zqQ{I`c*ir<!eAYwsQeAOjPY;qxA|cj|J#Q8*okryIbxcFv#(jopM3#RRL)10A&$0y
zFtj_3?RosfOj{nAX<L--u!)H0_moSXgP;*d_T%$Ox97ZTA8=>tfp>1xFp=-e0^!y?
zGM`v?O$Gb&I^Z02z}mOqb046(58kyGX4<MCc4{54zr0dB^R0!1zs{dm?9_8Lyz_04
zt{er{v3&s<`yhPyVF<PqK(ynjiqMy468gMgUa{`=yX5iXAdR&H`zw7$v};3S@Q^te
zJX9D)QAGZoS;oGRSw;Rt<hq6CT_SppR0cmS3En(tCJPa1U-OA7MX2^89`FF~YI-ct
zyqFC%6%iWYwkN++eEm9A;psB`BcS*Oa1Y;mcKTzBG`+u=+)n7L6({9uy*Y}{393x@
z-i`Y&V#XkHL9~0vi_?vk1S0bZwmf=P^7fjP$sy3Fia>cE9=!hVX^|f`Z}oq$SVbgL
zp!vaJ(bH*Gd~WPJOO<KYY81!dywDYA7mV23;e7Mjty2v)WvanSG-G?p2QC~xU>WQ0
z1Z4u}lSG@*`0h?!zR8$}e{c$s1zAza8`b7*le=w_eY4G3R%Bd~tk>ELwf^sHe@&;#
zbZfO@`Emn}v!Q#?edvDlfTrARs5a`E%H+9LuVvkfN-)RZ9luJoA9b5H0p>7Bhx8~1
c8BlHp?OdzZ+O>XKfAD&}R2ekS=|cMa4cH%1KL7v#
literal 0
HcmV?d00001
diff --git a/extra/recipes/icons/love.tiff b/extra/recipes/icons/love.tiff
new file mode 100644
index 0000000000000000000000000000000000000000..ae2fa7b430117574b0e6b3770882a5c53958a186
GIT binary patch
literal 2718
zcmc)Me`p(J7zgm@(k5%tTz{-}ZLR1mSr;aPFox_Oi$B2mqp%HO8-jnxil7Mo;g|@H
zR;TNjv&`W{op$S7i>t16rO8IDZSAr)vzBD7En9KQHepGV%U$j+mrHVaeJ*WcnpF1=
z1PPzqoA-U*_j~W<IIg)FHUPj{0D~8gmh7<v7C+^Xf?^zDkp7iv*D*{^+W<v4tdG?)
zMd>!97c-`%wgKCf+4^hDJxl#KgISa9uVZR5ZSzIuUNA03LJ3o!ZC5b&<*aYdS%3TA
z{WuQ@A^#683M45NNGZQVN}8_5qk$xZg7NemqEVf*CS3td7%!ksJ+@OBHpF7?dY86v
zmQ7(zKBAu=#kJ8yA87ogW#V(MZHu~!5>c0d=#;SrmlkxaO7U*UMKqZ%BZ3)W%vchi
zeSL>~-V~Fa#Uz(9+UQF9`&cdP#@a<BNtq#dK?_|(Zcu%%?2rbG8X_x+4%vQ6`kfXn
z?7<ul{zsJ8ik|{4I0ov>-YsH(i7NJ+$iI<Y8wQfM9Y%c){XV84KKH?9@jHtoe!Gg$
zkbijeR5CDPpxsB}dY3)YTONvhQ$p^BJoLojR2=VViu+0)-nw7twgiRKW)2C6{G;wt
zRp=?>g&r1JZ)@W9Dw>R#w-v-bI|!#NAUT@W@m*%ZcUe{>4{h6%xN#N|fAoSf@hYTZ
z0jhmuGNcR7fIRY2HQ#9_;jc<pBsrgbTDiOzGtS&yhOZ6eA9vyUEg%o?Ht?M+7yg_j
zD-pkc(k?l-rfU^<3;jN3jzRR&+gXt_>(6n=%19xWC=>hE#=J)$ZR#Lq1gWl-`s)c$
zF1Kfi1KW3pk6TFSXnCG866t&1CJyd`3{AXAl@Xgc2~p3%EZN=0@+Vj>*ik|93BAv4
z79B4`h9>?=m7!kk2gQ4QnaH^p_JqGQlZ8W-%kW=6^`bb~g8NuRn-RY?4(e|gmYW|m
z3f+z4p`$Dbw6D(MI-5R{N8f`CO{Tkdll~b<-1HPse5dR9PV0@};c^n#UzN7-VZ)3(
z@iAm*(Gb<OO8Td9{fPqV)j{CCXnKf0S$>QA#7g{aRcWH*ttRE?PLM`AAf?hh+w(KT
z`BAts)C1nZPhsM~<KQ{6vvU01hIZ~VD<AAABY^|!=7qjDY@)Lj&JXkf$8mSui=H7|
z8-Yy^+l}~=!=g%5jn<$VRI9tc!eo1AOIhpGz6xL9{nhfJ=9)LL-}uYq<Q+3o@hD7=
zkLfQkR#cB3L^jlj)+758y{-4z9;h@uQfoEpze{N{^ylW>>?~~BxKU?7MW`4VktvVf
Sr;q71dTn|x&9nEvtoaN3C0C9B
literal 0
HcmV?d00001
diff --git a/extra/recipes/icons/more.tiff b/extra/recipes/icons/more.tiff
new file mode 100644
index 0000000000000000000000000000000000000000..b4ec27b303a24002ffca11a1ee80959af9d199f8
GIT binary patch
literal 2718
zcmeH}Ye*DP6vyxEs_UzAQS*_yyN0PfEEg$keXMRopr#2C1WKk6rlqMpG&K<w-C7eh
z%P0%UNYhBkS4fKZ#V{zyNXwK$4J|Yh`qsZQtGjL=gaudnP-pnfIdks4|1)!kxp$(X
z*jC1vlrh08^45B9$rg_d>=!em7LMRgy4Z!|3}OKjQZwJ?%n7wI$9Lu|mSO?LVtxNn
z&T%PEBe;$FybI@~i>(GYS7yFgl38+_^syc1W}xq5pdY)Or*Z$Z1(v&6t>pxGs%+T7
ztL{)0JEpBw9nWxUHv6LwnfH}Y6**|ODNSEV7G}-nfA(T_p%p_PtC3o_H-gWZ(qu|2
zHoMS<Pjh$hdG0PI=O3c5ITGOo_BFDQm1~9Ni)+I2#4wi0`3D<CHXL+f7V;Z$#Tr
z4)zt;A6w~ps@mf)I#Xp7BQup4o>t?{REeJ9=~BG=QjYG|IXGD(SIdG#Oco;gqnzf+
zAq<Y6Uo|f#axgrlLFdbCL|k@)lxpd$tR)hC?@ybA{tsywoXExCSP2dnODdEFj<$TA
zlBNUb8csAB-EWidd?c0LQ3gV@Y|imDGV451*luPLiaJEl^f;ilZwJzAeJX-7%(ZL6
znOibkcr08sxvkcy?e|CNqfn^M+Cs92U;Y;@^@a@TO~O@?*(^f&Ge0C<@j`Hls78@2
z^496|KD#ae*Lwqv;#!X!S<QAxZV+fW)j;>wXoJ#DU!+v}A~@M1-%wi@O9F(<Sp1^Q
zSXq}G3HJm@syD~Q7AeiUH;&}FY9s-)0h+)(<N~Jd4#bK2^(bnWBfd}y#c^Sx38eKB
z9{wD=JrD!+Qzee(yF-ycyRV7Oc?-wlFL`yyqa|@3yO^($^87ytKarLM|4oVsCt@?f
qYwRQxL^!dZh$Lc&*d?OLM-dT(lGsgbC#1wWVtGNKi~sibXW%!V<W*4s
literal 0
HcmV?d00001
diff --git a/extra/recipes/icons/submit.tiff b/extra/recipes/icons/submit.tiff
new file mode 100644
index 0000000000000000000000000000000000000000..7c982679d88bbef0b5d73d71f481914a89773ab1
GIT binary patch
literal 2718
zcmcguX-r&I6n^gww8Iidv}m!KpfSefj~Yz%4=D+d5K~JknqY{*5(!X#7->yPV{Hln
z!3Kkn3{Cq(OB>lTWn>9-T6UPQ4+;dP?92eezzkbkhVAp72XA~OodSQnlkeS=d(S=J
zxo5eVlP9@%Igaz^IKjYXPv@-Uwtp&ai*sW;JOh0s*^lRCvcM_WHtikd6{5_OGJj}C
z7MSeg)Hm|JJL~KO|B`dvkAGQ`J(~DeIQMNzPRSp0%Fpw!%Iv=_vw!-(b$0Im9zsk^
z%un(0@y|qTY^-yiIe7GdPI@&rH)FqJWn~2>vl$2EQ8hO;i4+gn`KMudc^UKb^Dy-E
zpt7O@#PfYpQr-dXqLS{h!fd&Mjd2)_MpTrSL*LSZxw$#I%Ln`9ao)p~eOkBMY#13H
zMs;;H8XFt2v9TfECm|u>D&z6qgG<%46RYK=CAh+Z-Hx%*QPkDdp@PM$ySp2mot+pP
z8w0DEpZDZoe$nVL7;s0UL2XS9v|26hGM}Y2JL4E<_S#xoQCLub%*;%rq^2SxBLiBE
z#(wL>i7J~~?O3{g-4uWPxZf^L72TZ%*&rAP2gSG;n6DCSELJ9y34?5p*4o<IK($g^
zTZ<;<&*IIS7*9*Xy@&`T`uJRQ#j&uk09T-V%vvm%nVErwf#liQSutj-tE=c`ak~{B
zj&yHtTo!~lR~%hkT_|UDLq1kjRiUJ$M8w3z1avwbN{Wk7TvR0bt}QKv*;opPy<X(a
z%ge*pk&%c!a-`=Ij`MKELGjox7UzxFvSeUuIu-SIQV<mtg@Awnt3MmeK6@RX7|wi9
zZFY8aps%kF4_GgdOz7|LM_+HRC{sSn6Ma}1`2`#QM8ffxFLX&h$jQn?U|?VxvrKg?
zzTYwyRYOCAnDh4bb`-H#5L#LNNHWdT7t_<z&{h79HPa<*^nQia0yos0<x!a)1q;hh
zP*Bh%X7{knwj??^=B!pc3pPtX)~BvubLs*dRsPT?@wolD2lV$Vu(-I0;NW1Yr$drq
z+3e(?dz7+VlE37;f%VJ4z<?;<*Hz%r_>b5$pT~N8C``X8kRR@bt3R9(dva}U4Iv>R
z$$N3odqgp!I_h9~Aek^SY{WxT4mKWq1IOKWU{xznc*YkwX~|-*(m5KTp`jOCan#q>
zi#in3-I%qQ@pv*Fn?uofeETrW*#iDN#UVfY3iNtCM%nv9eX?(ko&KU8+lCpBCbO_P
z8HcsH_c4<rp!hV0Yu|k)`ae80gz2d%SP#HKJuG3?+ylqtMQn~mW3AyMOk}wuKk7B8
zFDIg~uu!aT${XqL=N{6#OJ^iZ{#}Wos&lZH2Vwb!0tL~2$j!|~Sy`EAe~S4p=~8_6
zij_vAStcEMj}JBef$@f4(U$c(?!~&}T5_~lKh%R(R^xJAdgEw>g@w7Q-RIP5^_Zw6
z`;63Oi}qVmSPl~3gtqjK==b{ix=iayk@fjG7j@;u_|JNIc|~}5czi*~JRfl*?$mq6
zh>wNh58qJadV9JjE0xM`+1{6uj(qm?^rW+&3WD$!<Dma|y9fREqyDG2QYpg=Og_f&
TA_Kia^1Y|Y)Zb*w`Bwc41A8hW
literal 0
HcmV?d00001
diff --git a/extra/recipes/summary.txt b/extra/recipes/summary.txt
new file mode 100644
index 0000000000..98b1eceb31
--- /dev/null
+++ b/extra/recipes/summary.txt
@@ -0,0 +1 @@
+Database backed recipe sharing
\ No newline at end of file
diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor
new file mode 100644
index 0000000000..37d1d9487a
--- /dev/null
+++ b/extra/sequences/extras/extras.factor
@@ -0,0 +1,22 @@
+USING: arrays kernel locals math sequences ;
+IN: sequences.extras
+: reduce1 ( seq quot -- result ) [ unclip ] dip reduce ; inline
+
+:: 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
+
+! Quot must have static stack effect, unlike "reduce"
+:: reduce* ( seq id quot -- result ) seq
+ [ id ]
+ [ unclip id swap quot call( prev elt -- next ) quot reduce* ] if-empty ; inline recursive
+
+:: combos ( list1 list2 -- result ) list2 [ [ 2array ] curry list1 swap map ] map concat ;
+: (head-slice) ( seq n -- seq' ) over length over < [ drop ] [ head-slice ] if ;
+: find-all ( seq quot -- elts ) [ [ length iota ] keep ] dip
+ [ dupd call( a -- ? ) [ 2array ] [ 2drop f ] if ] curry 2map [ ] filter ; inline
+
+: empty ( seq -- ) 0 swap shorten ;
\ No newline at end of file
From 93641c534db34db0db05bc19f12fd59b598ab2f8 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Thu, 25 Jun 2009 23:23:09 -0500
Subject: [PATCH 093/128] frp documentation updated
---
extra/ui/frp/gadgets/gadgets-docs.factor | 42 ++++++++++++++++++++++--
extra/ui/frp/gadgets/gadgets.factor | 4 +--
extra/ui/frp/layout/layout-docs.factor | 27 +++++++++++++--
extra/ui/frp/signals/signals-docs.factor | 22 ++++++++++++-
4 files changed, 86 insertions(+), 9 deletions(-)
diff --git a/extra/ui/frp/gadgets/gadgets-docs.factor b/extra/ui/frp/gadgets/gadgets-docs.factor
index 208e87f4a3..b3440aefb3 100644
--- a/extra/ui/frp/gadgets/gadgets-docs.factor
+++ b/extra/ui/frp/gadgets/gadgets-docs.factor
@@ -1,11 +1,15 @@
-USING: help.markup help.syntax ui.gadgets.buttons
-ui.gadgets.editors ui.frp.gadgets ;
+USING: accessors help.markup help.syntax ui.gadgets.buttons
+ui.gadgets.editors ui.frp.gadgets models ui.gadgets ;
IN: ui.frp.gadgets
HELP: <frp-button>
{ $values { "gadget" "the button's label" } { "button" button } }
{ $description "Creates an button whose signal updates on clicks. " } ;
+HELP: <frp-border-button>
+{ $values { "text" "the button's label" } { "button" button } }
+{ $description "Creates an button whose signal updates on clicks. " } ;
+
HELP: <frp-table>
{ $values { "model" "values the table is to display" } { "table" frp-table } }
{ $description "Creates an " { $link frp-table } } ;
@@ -27,5 +31,37 @@ HELP: indexed
{ $description "Sets the output model of an frp-table to the selected-index, rather than the selected-value" } ;
HELP: <frp-field>
+{ $values { "model" model } { "gadget" model-field } }
+{ $description "Creates a field with an initial value" } ;
+
+HELP: <frp-field*>
{ $values { "field" model-field } }
-{ $description "Creates a field with an empty initial value" } ;
\ No newline at end of file
+{ $description "Creates a field with an empty initial value" } ;
+
+HELP: <empty-field>
+{ $values { "model" model } { "field" model-field } }
+{ $description "Creates a field with an empty initial value that switches to another signal on its update" } ;
+
+HELP: <frp-editor>
+{ $values { "model" model } { "gadget" model-field } }
+{ $description "Creates an editor with an initial value" } ;
+
+HELP: <frp-editor*>
+{ $values { "editor" "an editor" } }
+{ $description "Creates a editor with an empty initial value" } ;
+
+HELP: <empty-editor>
+{ $values { "model" model } { "editor" "an editor" } }
+{ $description "Creates a field with an empty initial value that switches to another signal on its update" } ;
+
+HELP: <frp-action-field>
+{ $values { "field" action-field } }
+{ $description "Field that updates its model with its contents when the user hits the return key" } ;
+
+HELP: <image-button>
+{ $syntax "filename <image-button>" }
+{ $description "Creates a button using a tiff image named as specified found in the icons subdirectory of the vocabulary path" } ;
+
+HELP: output-model
+{ $values { "gadget" gadget } { "model" model } }
+{ $description "Returns the model a gadget uses for output. Often the same as " { $link model>> } } ;
\ No newline at end of file
diff --git a/extra/ui/frp/gadgets/gadgets.factor b/extra/ui/frp/gadgets/gadgets.factor
index 3c9bbda1b3..6355271e96 100644
--- a/extra/ui/frp/gadgets/gadgets.factor
+++ b/extra/ui/frp/gadgets/gadgets.factor
@@ -43,13 +43,11 @@ M: frp-field model-changed 2dup frp-model>> =
: <frp-field*> ( -- field ) "" <model> <frp-field> ;
: <empty-field> ( model -- field ) "" <model> <switch> <frp-field> ;
-: <empty-field*> ( -- field ) "" <model> <frp-field> ;
: <frp-editor> ( model -- gadget )
frp-field [ <multiline-editor> ] dip new-border dup gadget-child >>editor
field-theme swap init-field >>frp-model { 1 0 } >>align ;
: <frp-editor*> ( -- editor ) "" <model> <frp-editor> ;
-: <empty-editor*> ( -- field ) "" <model> <frp-editor> ;
-: <empty-editor> ( model -- field ) "" <model> <switch> <frp-editor> ;
+: <empty-editor> ( model -- editor ) "" <model> <switch> <frp-editor> ;
: <frp-action-field> ( -- field ) f <action-field> dup [ set-control-value ] curry >>quot
f <model> >>model ;
diff --git a/extra/ui/frp/layout/layout-docs.factor b/extra/ui/frp/layout/layout-docs.factor
index 3679572669..f91f099588 100644
--- a/extra/ui/frp/layout/layout-docs.factor
+++ b/extra/ui/frp/layout/layout-docs.factor
@@ -2,7 +2,7 @@ USING: help.markup help.syntax models ui.gadgets.tracks ui.frp.layout ;
IN: ui.frp.layout
HELP: ,
-{ $values { "uiitem" "a gadget or model" } }
+{ $values { "item" "a gadget or model" } }
{ $description "Used in a series of gadgets created by a box, accumulating the gadget" } ;
HELP: ,%
@@ -24,7 +24,30 @@ HELP: <hbox>
{ $values { "gadgets" "a list of gadgets" } { "track" track } }
{ $syntax "[ gadget , gadget , ... ] <hbox>" }
{ $description "Creates an horizontal track containing the gadgets listed in the quotation" } ;
+
HELP: <vbox>
{ $values { "gadgets" "a list of gadgets" } { "track" track } }
{ $syntax "[ gadget , gadget , ... ] <hbox>" }
-{ $description "Creates an vertical track containing the gadgets listed in the quotation" } ;
\ No newline at end of file
+{ $description "Creates an vertical track containing the gadgets listed in the quotation" } ;
+
+HELP: $
+{ $syntax "$ PLACEHOLDER-NAME $" }
+{ $description "Defines an insertion point in a template named PLACEHOLDER-NAME which can be used by calling its name" } ;
+
+HELP: with-interface
+{ $values { "quot" "quotation that builds a template and inserts into it" } }
+{ $description "Create templates, used with " { $link POSTPONE: $ } } ;
+
+ARTICLE: { "ui.frp.layout" "about" } "GUI Layout"
+"Laying out GUIs works the same way as building lists with " { $vocab-link "make" }
+". Gadgets are layed out using " { $vocab-link "ui.gadgets.tracks" } " through " { $link <hbox> } " and " { $link <vbox> } ", which allow both fixed and percentage widths. "
+{ $link , } " and " { $link -> } " add a signal or gadget to the gadget you're building. "
+"Also, books can be made with " { $link <frp-book> } ". "
+{ $link <spacer> } "s add flexable space between items. " $nl
+"Using " { $link with-interface } ", one can pre-build templates to add items to later: "
+"Like in Java's StringTemplate, placeholders are defined using $ PLACERHOLDER-NAME $ "
+"Using PLACEHOLDER-NAME again sets it as the current insertion point. "
+"For examples using normal layout, see the " { $vocab-link "gui-sudoku" } " demo. "
+"For examples of templating, see " { $vocab-link "recipes" } " demo. " ;
+
+ABOUT: { "ui.frp.layout" "about" }
\ No newline at end of file
diff --git a/extra/ui/frp/signals/signals-docs.factor b/extra/ui/frp/signals/signals-docs.factor
index e2b14234e1..e542424c2a 100644
--- a/extra/ui/frp/signals/signals-docs.factor
+++ b/extra/ui/frp/signals/signals-docs.factor
@@ -27,4 +27,24 @@ HELP: $>
HELP: <$
{ $values { "model" model } { "quot" "applied to model's value on updates" } { "signal" model } }
-{ $description "Opposite of " { $link <$ } "- gives output, but takes no input" } ;
\ No newline at end of file
+{ $description "Opposite of " { $link <$ } "- gives output, but takes no input" } ;
+
+HELP: frp-when
+{ $values { "model" model } { "quot" "called on the model if the quot yields true" } { "cond" "a quotation called on the model's value, yielding a boolean value" } }
+{ $description "Calls quot when model updates if its value meets the condition set in cond" } ;
+
+HELP: with-self
+{ $values { "quot" "quotation that recieves its own return value" } { "model" model } }
+{ $description "Fixed points for signals: the quot reacts to the same signal to gives" } ;
+
+HELP: #1
+{ $values { "model" model } { "model'" model } }
+{ $description "Moves a signal to the top of its dependencies' connections, thus being notified before the others" } ;
+
+ARTICLE: { "signals" "about" } "FRP Signals"
+"Unlike models, which always have a value, signals have discrete start and end times. "
+"They are the core of the frp library: program flow using frp is controlled entirely through manipulating and combining signals. "
+"The output signals of some gadgets (see " { $vocab-link "ui.frp.gadgets" } " ) can be manipulated and used as the input signals of others. "
+"To combine signals see " { $vocab-link "ui.frp.functors" } ;
+
+ABOUT: { "signals" "about" }
\ No newline at end of file
From 96fccd9c6c7c5c91c46a49b00cfcc260edc2c680 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Fri, 26 Jun 2009 15:25:50 -0500
Subject: [PATCH 094/128] added summary/ author files
---
extra/recipes/recipes.factor | 21 +++++++++++----------
extra/ui/frp/functors/summary.txt | 1 +
extra/ui/frp/gadgets/gadgets-docs.factor | 4 ++--
extra/ui/frp/gadgets/gadgets.factor | 15 +++++++--------
extra/ui/frp/gadgets/summary.txt | 1 +
extra/ui/frp/layout/layout.factor | 8 ++++----
extra/ui/frp/layout/summary.txt | 1 +
extra/ui/frp/signals/signals.factor | 4 ++--
extra/ui/frp/{ => signals}/summary.txt | 0
9 files changed, 29 insertions(+), 26 deletions(-)
create mode 100644 extra/ui/frp/functors/summary.txt
create mode 100644 extra/ui/frp/gadgets/summary.txt
create mode 100644 extra/ui/frp/layout/summary.txt
rename extra/ui/frp/{ => signals}/summary.txt (100%)
diff --git a/extra/recipes/recipes.factor b/extra/recipes/recipes.factor
index 4c793c31c8..bccabdc0cf 100644
--- a/extra/recipes/recipes.factor
+++ b/extra/recipes/recipes.factor
@@ -1,10 +1,11 @@
-USING: accessors arrays db.tuples db.sqlite persistency db.queries
-io.files.temp kernel monads sequences ui ui.frp.gadgets
-ui.frp.layout ui.frp.signals ui.gadgets.scrollers ui.gadgets.labels
-colors.constants ui.pens.solid combinators math locals strings
-ui.images db.types sequences.extras ui.tools.inspector ;
+USING: accessors arrays colors.constants combinators db.queries
+db.sqlite db.tuples db.types io.files.temp kernel locals math
+monads persistency sequences sequences.extras ui ui.frp.gadgets
+ui.frp.layout ui.frp.signals ui.gadgets.labels
+ui.gadgets.scrollers ui.pens.solid ;
FROM: sets => prune ;
IN: recipes
+
STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } { genre { VARCHAR 100 } } ;
: <recipe> ( title genre text -- recipe ) recipe new swap >>txt swap >>genre swap >>title 0 >>votes ;
"recipes.db" temp-file <sqlite-db> recipe define-db
@@ -30,11 +31,11 @@ STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } {
interface
<frp-table*> :> tbl
"okay" <frp-border-button> BUTTON -> :> ok
- "submit" <image-button> [ store-tuple ] >>value TOOLBAR -> :> submit
- "love" <image-button> 1 >>value TOOLBAR ->
- "hate" <image-button> -1 >>value -> 2array <merge> :> votes
- "back" <image-button> -> [ -30 ] <$
- "more" <image-button> -> [ 30 ] <$ 2array <merge> :> viewed
+ IMAGE-BUTTON: submit [ store-tuple ] >>value TOOLBAR -> :> submit
+ IMAGE-BUTTON: love 1 >>value TOOLBAR ->
+ IMAGE-BUTTON: hate -1 >>value -> 2array <merge> :> votes
+ IMAGE-BUTTON: back -> [ -30 ] <$
+ IMAGE-BUTTON: more -> [ 30 ] <$ 2array <merge> :> viewed
<spacer> <frp-field*> ->% 1 :> search
submit ok [ [ drop ] ] <$ 2array <merge> [ drop ] >>value :> quot
viewed 0 [ + ] <fold> search ok t <basic> "all" <frp-button> ALL ->
diff --git a/extra/ui/frp/functors/summary.txt b/extra/ui/frp/functors/summary.txt
new file mode 100644
index 0000000000..6b4e8d2465
--- /dev/null
+++ b/extra/ui/frp/functors/summary.txt
@@ -0,0 +1 @@
+Used by ui.frp.signals to combine models
\ No newline at end of file
diff --git a/extra/ui/frp/gadgets/gadgets-docs.factor b/extra/ui/frp/gadgets/gadgets-docs.factor
index b3440aefb3..0df9194746 100644
--- a/extra/ui/frp/gadgets/gadgets-docs.factor
+++ b/extra/ui/frp/gadgets/gadgets-docs.factor
@@ -58,8 +58,8 @@ HELP: <frp-action-field>
{ $values { "field" action-field } }
{ $description "Field that updates its model with its contents when the user hits the return key" } ;
-HELP: <image-button>
-{ $syntax "filename <image-button>" }
+HELP: IMAGE-BUTTON:
+{ $syntax "IMAGE-BUTTON: filename" }
{ $description "Creates a button using a tiff image named as specified found in the icons subdirectory of the vocabulary path" } ;
HELP: output-model
diff --git a/extra/ui/frp/gadgets/gadgets.factor b/extra/ui/frp/gadgets/gadgets.factor
index 6355271e96..a1e4480064 100644
--- a/extra/ui/frp/gadgets/gadgets.factor
+++ b/extra/ui/frp/gadgets/gadgets.factor
@@ -1,9 +1,9 @@
-USING: accessors arrays kernel models monads
-sequences ui.frp.signals ui.gadgets ui.gadgets.borders
-ui.gadgets.buttons ui.gadgets.buttons.private
-ui.gadgets.editors ui.gadgets.labels ui.gadgets.scrollers
-ui.gadgets.tables ui.images vocabs.parser ;
+USING: accessors arrays kernel models monads sequences
+ui.frp.signals ui.gadgets ui.gadgets.borders ui.gadgets.buttons
+ui.gadgets.buttons.private ui.gadgets.editors
+ui.gadgets.scrollers ui.gadgets.tables ui.images vocabs.parser lexer ;
IN: ui.frp.gadgets
+
TUPLE: frp-button < button hook value ;
: <frp-button> ( gadget -- button ) [
[ dup hook>> [ call( button -- ) ] [ drop ] if* ]
@@ -52,9 +52,8 @@ M: frp-field model-changed 2dup frp-model>> =
: <frp-action-field> ( -- field ) f <action-field> dup [ set-control-value ] curry >>quot
f <model> >>model ;
-: image-button ( filename path -- button ) ".tiff" surround <image-name> <frp-button> ;
-SYNTAX: <image-button> current-vocab name>> "vocab:" "/icons/" surround
- [ image-button ] curry over push-all ;
+SYNTAX: IMAGE-BUTTON: scan current-vocab name>> "vocab:" "/icons/" surround ".tiff" surround
+ <image-name> [ <frp-button> ] curry over push-all ;
GENERIC: output-model ( gadget -- model )
M: gadget output-model model>> ;
diff --git a/extra/ui/frp/gadgets/summary.txt b/extra/ui/frp/gadgets/summary.txt
new file mode 100644
index 0000000000..b792b817db
--- /dev/null
+++ b/extra/ui/frp/gadgets/summary.txt
@@ -0,0 +1 @@
+Gadgets using signals as their models
\ No newline at end of file
diff --git a/extra/ui/frp/layout/layout.factor b/extra/ui/frp/layout/layout.factor
index 4527b1f092..5e810f6139 100644
--- a/extra/ui/frp/layout/layout.factor
+++ b/extra/ui/frp/layout/layout.factor
@@ -1,7 +1,7 @@
-USING: accessors assocs arrays fry kernel make math.parser models
-models.product namespaces sequences ui.frp.gadgets parser lexer
-ui.gadgets ui.gadgets.books ui.gadgets.tracks vectors words
-combinators ui.frp.signals monads sequences.extras ui.tools.inspector ;
+USING: accessors arrays fry kernel lexer make math.parser
+models models.product monads namespaces parser sequences
+sequences.extras ui.frp.gadgets ui.frp.signals ui.gadgets
+ui.gadgets.books ui.gadgets.tracks words ;
QUALIFIED: make
IN: ui.frp.layout
diff --git a/extra/ui/frp/layout/summary.txt b/extra/ui/frp/layout/summary.txt
new file mode 100644
index 0000000000..30b5ef59c6
--- /dev/null
+++ b/extra/ui/frp/layout/summary.txt
@@ -0,0 +1 @@
+Syntax for easily building GUIs and using templates
\ No newline at end of file
diff --git a/extra/ui/frp/signals/signals.factor b/extra/ui/frp/signals/signals.factor
index 707c271159..194ff5d25c 100644
--- a/extra/ui/frp/signals/signals.factor
+++ b/extra/ui/frp/signals/signals.factor
@@ -1,5 +1,5 @@
-USING: accessors arrays kernel monads models models.product sequences classes
-sequences.extras ;
+USING: accessors arrays kernel models models.product monads
+sequences sequences.extras ;
FROM: models.product => product ;
IN: ui.frp.signals
diff --git a/extra/ui/frp/summary.txt b/extra/ui/frp/signals/summary.txt
similarity index 100%
rename from extra/ui/frp/summary.txt
rename to extra/ui/frp/signals/summary.txt
From 244ad935776cd7ddf0ee969f1da69857b0b71f0e Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Fri, 26 Jun 2009 15:28:23 -0500
Subject: [PATCH 095/128] gui-sudoku makes sudokus too
---
extra/gui-sudoku/gui-sudoku.factor | 34 ++++++++++++++++++------------
1 file changed, 21 insertions(+), 13 deletions(-)
diff --git a/extra/gui-sudoku/gui-sudoku.factor b/extra/gui-sudoku/gui-sudoku.factor
index 884271a6f3..d89b5b2f1a 100644
--- a/extra/gui-sudoku/gui-sudoku.factor
+++ b/extra/gui-sudoku/gui-sudoku.factor
@@ -1,32 +1,40 @@
USING: accessors arrays combinators.short-circuit grouping kernel lists
lists.lazy locals math math.functions math.parser math.ranges
models.product monads random sequences sets ui ui.frp.gadgets
-ui.frp.layout ui.frp.signals ui.gadgets.alerts vectors ;
+ui.frp.layout ui.frp.signals ui.gadgets.alerts vectors fry
+ui.gadgets.labels memoize ;
IN: gui-sudoku
: row ( index -- row ) 1 + 9 / ceiling ;
: col ( index -- col ) 9 mod 1 + ;
: sq ( index -- square ) [ row ] [ col ] bi [ 3 / ceiling ] bi@ 2array ;
: near ( a pos -- ? ) { [ [ row ] bi@ = ] [ [ col ] bi@ = ] [ [ sq ] bi@ = ] } 2|| ;
-MEMO:: solutions ( puzzle -- solutions )
- f puzzle index
+: nth-or-lower ( n seq -- elt ) [ length 1 - 2dup > [ nip ] [ drop ] if ] keep nth ;
+
+MEMO:: solutions ( puzzle random? -- solutions )
+ f puzzle random? [ indices [ f ] [ random? swap nth-or-lower ] if-empty ] [ index ] if
[ :> pos
1 9 [a,b] 80 iota [ pos near ] filter [ puzzle nth ] map prune diff
- [ 1array puzzle pos cut-slice rest surround ] map >list [ solutions ] bind
+ [ 1array puzzle pos cut-slice rest surround ] map >list [ random? solutions ] bind
] [ puzzle list-monad return ] if* ;
-: solution ( puzzle -- solution ) dup solutions dup +nil+ = [ drop "Unsolvable" alert* ] [ nip car ] if ;
-: hint ( puzzle -- puzzle' ) [ [ f swap indices random dup ] [ solution ] bi nth ] keep swapd >vector [ set-nth ] keep ;
+: solution ( puzzle random? -- solution ) dupd solutions dup +nil+ = [ drop "Unsolvable" alert* ] [ nip car ] if \ solutions reset-memoized ;
+: hint ( puzzle -- puzzle' ) [ [ f swap indices random dup ] [ f solution ] bi nth ] keep swapd >vector [ set-nth ] keep ;
+: create ( difficulty -- puzzle ) 81 [ f ] replicate
+ 40 random solution [ [ dup length random f spin set-nth ] curry times ] keep ;
-: do-sudoku ( -- ) [ [ [ $ SUDOKU $ ] <vbox> { 280 220 } >>pref-dim
+: do-sudoku ( -- ) [ [
[
- 81 [ "" ] replicate <basic> <switch> [ SUDOKU [ <basic> ] map 9 group [ 3 group ] map 3 group
+ 81 [ "" ] replicate <basic> <switch> [ [ <basic> ] map 9 group [ 3 group ] map 3 group
[ [ [ <spacer> [ [ <frp-field> ->% 2 [ string>number ] fmap ]
- map <spacer> ] map concat ] <hbox> , ] map concat <spacer> ] map concat <product> dup
- [ "Hint" <frp-border-button> -> "Solve" <frp-border-button> -> ] <hbox> , swapd [ <updates> ] 2bi@
- [ [ hint ] fmap ] [ [ solution ] fmap ] bi* <2merge> [ [ [ number>string ] [ "" ] if* ] map ] fmap
+ map <spacer> ] map concat ] <hbox> , ] map concat <spacer> ] map concat <product>
+ [ "Difficulty:" <label> , "1" <basic> <frp-field> -> [ string>number 1 or 1 + 10 * ] fmap
+ "Generate" <frp-border-button> -> <updates> [ create ] fmap <spacer>
+ "Hint" <frp-border-button> -> "Solve" <frp-border-button> -> ] <hbox> ,
+ roll [ swap <updates> ] curry bi@
+ [ [ hint ] fmap ] [ [ f solution ] fmap ] bi* 3array <merge> [ [ [ number>string ] [ "" ] if* ] map ] fmap
] bind
- ] with-self SUDOKU ,
- ] with-interface "Sudoku Sleuth" open-window ] with-ui ;
+ ] with-self , ] <vbox> { 280 220 } >>pref-dim
+ "Sudoku Sleuth" open-window ] with-ui ;
MAIN: do-sudoku
\ No newline at end of file
From 07c8c00a124d6c33b44fc0d4d412e9943dd3e0bd Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sat, 27 Jun 2009 13:22:48 -0500
Subject: [PATCH 096/128] fixed binding bugs in frp
---
extra/ui/frp/layout/layout.factor | 25 ++++++++++++++-----------
extra/ui/frp/signals/signals.factor | 2 --
2 files changed, 14 insertions(+), 13 deletions(-)
diff --git a/extra/ui/frp/layout/layout.factor b/extra/ui/frp/layout/layout.factor
index 5e810f6139..bee0adec93 100644
--- a/extra/ui/frp/layout/layout.factor
+++ b/extra/ui/frp/layout/layout.factor
@@ -1,7 +1,7 @@
USING: accessors arrays fry kernel lexer make math.parser
-models models.product monads namespaces parser sequences
+models monads namespaces parser sequences
sequences.extras ui.frp.gadgets ui.frp.signals ui.gadgets
-ui.gadgets.books ui.gadgets.tracks words ;
+ui.gadgets.books ui.gadgets.tracks words ui.tools.inspector ;
QUALIFIED: make
IN: ui.frp.layout
@@ -18,8 +18,11 @@ TUPLE: placeholder < gadget members ;
: , ( item -- ) make:, ;
: make* ( quot -- list ) { } make ; inline
+! Just take the previous mentioned placeholder and use it
+! If there is no previously mentioned placeholder, we're probably making a box, and will create the placeholder ourselves
DEFER: with-interface
-: insertion-quot ( quot -- quot' ) <placeholder> dup , swap '[ [ _ , @ ] with-interface ] ;
+: insertion-quot ( quot -- quot' ) make:building get [ placeholder? ] find-last nip [ <placeholder> dup , ] unless*
+ swap '[ [ _ , @ ] with-interface ] ;
SYNTAX: ,% scan string>number [ <layout> , ] curry over push-all ;
SYNTAX: ->% scan string>number '[ [ _ <layout> , ] [ output-model ] bi ] over push-all ;
@@ -39,7 +42,7 @@ M: model -> dup , ;
: <box> ( gadgets type -- track )
[ t make-layout ] dip <track>
swap [ add-layout ] each
- swap [ <product> >>model ] unless-empty ; inline
+ swap [ <|> >>model ] unless-empty ; inline
: <hbox> ( gadgets -- track ) horizontal <box> ; inline
: <vbox> ( gadgets -- track ) vertical <box> ; inline
@@ -59,14 +62,14 @@ GENERIC# (insert-item) 1 ( item location -- )
M: gadget (insert-item) dup parent>> track? [ [ f <layout> ] dip (insert-item) ]
[ insertion-point [ add-gadget ] keep insert-gadget ] if ;
M: layout (insert-item) insertion-point [ add-layout ] keep [ gadget>> insert-gadget ] [ size>> insert-size ] 3bi ;
-M: model (insert-item) parent>> dup book? [ "No models in books" throw ]
- [ dup model>> dup product? [ nip swap add-connection ] [ drop [ 1array <product> ] dip (>>model) ] if ] if ;
-: insert-item ( item location -- ) [ add-member ] 2keep (insert-item) ;
+M: model (insert-item) dup inspector parent>> dup book? [ "No models in books" throw ]
+ [ dup model>> dup |? [ nip swap add-connection ] [ drop [ 1array <|> ] dip (>>model) ] if ] if ;
+: insert-item ( item location -- ) [ dup get [ drop ] [ remove-members ] if ] [ on ] [ ] tri
+ [ add-member ] 2keep (insert-item) ;
-: insert-items ( makelist -- ) t swap [ dup placeholder?
- [ nip [ dup get [ drop ] [ remove-members ] if ] [ on ] [ ] tri ]
- [ over insert-item ] if ] each drop ;
+: insert-items ( makelist -- ) t swap [ dup placeholder? [ nip ] [ over insert-item ] if ] each drop ;
: with-interface ( quot -- ) make* [ insert-items ] with-scope ; inline
-M: model >>= [ swap insertion-quot <action> ] curry ;
\ No newline at end of file
+M: model >>= [ swap insertion-quot <action> ] curry ;
+! Temporary places should be cleared at insertion, not on mention
\ No newline at end of file
diff --git a/extra/ui/frp/signals/signals.factor b/extra/ui/frp/signals/signals.factor
index 194ff5d25c..36a8b565a1 100644
--- a/extra/ui/frp/signals/signals.factor
+++ b/extra/ui/frp/signals/signals.factor
@@ -88,7 +88,6 @@ TUPLE: action < multi-model quot ;
M: action (model-changed) [ [ value>> ] [ quot>> ] bi* call( a -- b ) ] keep value>>
[ swap add-connection ] 2keep model-changed ;
: <action> ( model quot -- action-signal ) [ 1array action <multi-model> ] dip >>quot dup f <action-value> >>value value>> ;
-<PRIVATE
TUPLE: | < multi-model ;
: <|> ( models -- product ) | <multi-model> ;
@@ -104,7 +103,6 @@ M: | model-activated dup model-changed ;
TUPLE: & < | ;
: <&> ( models -- product ) & <multi-model> ;
M: & models-changed dependencies>> [ [ null-val ] keep (>>value) ] each ;
-PRIVATE>
! for side effects
TUPLE: (frp-when) < multi-model quot cond ;
From 721a6dc3ab99fbedc175ab9fdca32db223eb9375 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sat, 27 Jun 2009 13:31:22 -0500
Subject: [PATCH 097/128] "<$" made generic + moved to monads
---
extra/monads/monads.factor | 1 +
extra/ui/frp/functors/functors-docs.factor | 2 +-
extra/ui/frp/layout/layout.factor | 4 ++--
extra/ui/frp/signals/signals-docs.factor | 2 +-
extra/ui/frp/signals/signals.factor | 2 +-
5 files changed, 6 insertions(+), 5 deletions(-)
diff --git a/extra/monads/monads.factor b/extra/monads/monads.factor
index f4503cbdd3..9a3e605c7f 100644
--- a/extra/monads/monads.factor
+++ b/extra/monads/monads.factor
@@ -7,6 +7,7 @@ IN: monads
! Functors
GENERIC# fmap 1 ( functor quot -- functor' )
+GENERIC# <$ 1 ( functor quot -- functor' )
! Monads
diff --git a/extra/ui/frp/functors/functors-docs.factor b/extra/ui/frp/functors/functors-docs.factor
index e6c5c0f8d5..256be95702 100644
--- a/extra/ui/frp/functors/functors-docs.factor
+++ b/extra/ui/frp/functors/functors-docs.factor
@@ -1,4 +1,4 @@
-USING: help.markup help.syntax ui.frp.signals ui.frp.signals.private ;
+USING: help.markup help.syntax ui.frp.signals ;
IN: ui.frp.functors
ARTICLE: { "ui.frp.functors" "signal-collection" } "Signal Collection"
diff --git a/extra/ui/frp/layout/layout.factor b/extra/ui/frp/layout/layout.factor
index bee0adec93..bea2700dc2 100644
--- a/extra/ui/frp/layout/layout.factor
+++ b/extra/ui/frp/layout/layout.factor
@@ -1,7 +1,7 @@
USING: accessors arrays fry kernel lexer make math.parser
models monads namespaces parser sequences
sequences.extras ui.frp.gadgets ui.frp.signals ui.gadgets
-ui.gadgets.books ui.gadgets.tracks words ui.tools.inspector ;
+ui.gadgets.books ui.gadgets.tracks words ;
QUALIFIED: make
IN: ui.frp.layout
@@ -62,7 +62,7 @@ GENERIC# (insert-item) 1 ( item location -- )
M: gadget (insert-item) dup parent>> track? [ [ f <layout> ] dip (insert-item) ]
[ insertion-point [ add-gadget ] keep insert-gadget ] if ;
M: layout (insert-item) insertion-point [ add-layout ] keep [ gadget>> insert-gadget ] [ size>> insert-size ] 3bi ;
-M: model (insert-item) dup inspector parent>> dup book? [ "No models in books" throw ]
+M: model (insert-item) parent>> dup book? [ "No models in books" throw ]
[ dup model>> dup |? [ nip swap add-connection ] [ drop [ 1array <|> ] dip (>>model) ] if ] if ;
: insert-item ( item location -- ) [ dup get [ drop ] [ remove-members ] if ] [ on ] [ ] tri
[ add-member ] 2keep (insert-item) ;
diff --git a/extra/ui/frp/signals/signals-docs.factor b/extra/ui/frp/signals/signals-docs.factor
index e542424c2a..1996213ee2 100644
--- a/extra/ui/frp/signals/signals-docs.factor
+++ b/extra/ui/frp/signals/signals-docs.factor
@@ -1,4 +1,4 @@
-USING: help.markup help.syntax models models.arrow sequences ui.frp.signals ;
+USING: help.markup help.syntax models models.arrow sequences ui.frp.signals monads ;
IN: ui.frp.signals
HELP: <merge>
diff --git a/extra/ui/frp/signals/signals.factor b/extra/ui/frp/signals/signals.factor
index 36a8b565a1..dcb4d3e315 100644
--- a/extra/ui/frp/signals/signals.factor
+++ b/extra/ui/frp/signals/signals.factor
@@ -78,7 +78,7 @@ M: side-effect-model (model-changed) [ value>> ] dip [ quot>> call( old -- ) ] 2
TUPLE: quot-model < mapped-model ;
M: quot-model (model-changed) nip [ quot>> call( -- b ) ] keep set-model ;
-: <$ ( model quot -- signal ) quot-model new-mapped-model ;
+M: model <$ quot-model new-mapped-model ;
TUPLE: action-value < basic-model parent ;
: <action-value> ( parent value -- model ) action-value new-model swap >>parent ;
From 568f55f105905f4e9a01dbefe3015292569b5ff5 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Tue, 21 Jul 2009 19:40:06 -0500
Subject: [PATCH 098/128] product specifiers removed from frp signals
---
extra/recipes/recipes.factor | 8 ++--
extra/{gui-sudoku => sudokus}/authors.txt | 0
.../sudokus.factor} | 2 +-
extra/{gui-sudoku => sudokus}/summary.txt | 0
extra/ui/frp/functors/authors.txt | 1 -
extra/ui/frp/functors/functors-docs.factor | 10 -----
extra/ui/frp/functors/functors.factor | 34 -----------------
extra/ui/frp/functors/summary.txt | 1 -
extra/ui/frp/gadgets/gadgets.factor | 3 --
extra/ui/frp/layout/layout.factor | 7 ++--
extra/ui/frp/signals/signals.factor | 37 +++++++------------
.../ui/frp/signals/templates/templates.factor | 23 ++++++++++++
12 files changed, 45 insertions(+), 81 deletions(-)
rename extra/{gui-sudoku => sudokus}/authors.txt (100%)
rename extra/{gui-sudoku/gui-sudoku.factor => sudokus/sudokus.factor} (98%)
rename extra/{gui-sudoku => sudokus}/summary.txt (100%)
delete mode 100644 extra/ui/frp/functors/authors.txt
delete mode 100644 extra/ui/frp/functors/functors-docs.factor
delete mode 100644 extra/ui/frp/functors/functors.factor
delete mode 100644 extra/ui/frp/functors/summary.txt
create mode 100644 extra/ui/frp/signals/templates/templates.factor
diff --git a/extra/recipes/recipes.factor b/extra/recipes/recipes.factor
index bccabdc0cf..71d2c41524 100644
--- a/extra/recipes/recipes.factor
+++ b/extra/recipes/recipes.factor
@@ -39,9 +39,9 @@ STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } {
<spacer> <frp-field*> ->% 1 :> search
submit ok [ [ drop ] ] <$ 2array <merge> [ drop ] >>value :> quot
viewed 0 [ + ] <fold> search ok t <basic> "all" <frp-button> ALL ->
- tbl selected-value>> votes [ [ + ] curry change-votes modify-tuple ] 2$>-|
+ tbl selected-value>> votes [ [ + ] curry change-votes modify-tuple ] 2$>
4array <merge>
- [ drop [ f ] [ "%" dup surround <pattern> ] if-empty top-recipes ] 3fmap-| :> updates
+ [ drop [ f ] [ "%" dup surround <pattern> ] if-empty top-recipes ] 3fmap :> updates
updates [ top-genres [ <frp-button> GENRES -> ] map <merge> ] bind*
[ text>> T{ recipe } swap >>genre get-tuples ] fmap
tbl swap updates 2array <merge> >>model
@@ -52,9 +52,9 @@ STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } {
[ [ genre>> ] fmap <frp-field> GENRE ->% .5 ]
[ [ txt>> ] fmap <frp-editor> BODY ->% 1 ]
} cleave
- [ <recipe> ] 3fmap-|
+ [ <recipe> ] 3fmap
[ [ 1 ] <$ ]
- [ quot ok <updates> #1 [ call( recipe -- ) 0 ] 2fmap-& ] bi
+ [ quot ok <updates> #1 [ call( recipe -- ) 0 ] 2fmap ] bi
2array <merge> 0 <basic> <switch> >>model
] with-interface "recipes" open-window ] with-ui ;
diff --git a/extra/gui-sudoku/authors.txt b/extra/sudokus/authors.txt
similarity index 100%
rename from extra/gui-sudoku/authors.txt
rename to extra/sudokus/authors.txt
diff --git a/extra/gui-sudoku/gui-sudoku.factor b/extra/sudokus/sudokus.factor
similarity index 98%
rename from extra/gui-sudoku/gui-sudoku.factor
rename to extra/sudokus/sudokus.factor
index d89b5b2f1a..efc127f2a5 100644
--- a/extra/gui-sudoku/gui-sudoku.factor
+++ b/extra/sudokus/sudokus.factor
@@ -3,7 +3,7 @@ lists.lazy locals math math.functions math.parser math.ranges
models.product monads random sequences sets ui ui.frp.gadgets
ui.frp.layout ui.frp.signals ui.gadgets.alerts vectors fry
ui.gadgets.labels memoize ;
-IN: gui-sudoku
+IN: sudokus
: row ( index -- row ) 1 + 9 / ceiling ;
: col ( index -- col ) 9 mod 1 + ;
diff --git a/extra/gui-sudoku/summary.txt b/extra/sudokus/summary.txt
similarity index 100%
rename from extra/gui-sudoku/summary.txt
rename to extra/sudokus/summary.txt
diff --git a/extra/ui/frp/functors/authors.txt b/extra/ui/frp/functors/authors.txt
deleted file mode 100644
index 2300f69f11..0000000000
--- a/extra/ui/frp/functors/authors.txt
+++ /dev/null
@@ -1 +0,0 @@
-Sam Anklesaria
diff --git a/extra/ui/frp/functors/functors-docs.factor b/extra/ui/frp/functors/functors-docs.factor
deleted file mode 100644
index 256be95702..0000000000
--- a/extra/ui/frp/functors/functors-docs.factor
+++ /dev/null
@@ -1,10 +0,0 @@
-USING: help.markup help.syntax ui.frp.signals ;
-IN: ui.frp.functors
-
-ARTICLE: { "ui.frp.functors" "signal-collection" } "Signal Collection"
-"While " { $vocab-link "models.arrow.smart" } " use arrows and products to apply a quotation to the values of more than one signal, frp has more than one kind of arrow, as well as more than one kind of product" $nl
-"A simple pattern is used to generate the requisite 'smart mapping' functions: "
-"if 'word' maps a function on a model, then '2word; would map on two models. "
-"The product is specified on the end: '2word-product'. " { $link | } " updates when any of the model it collects updates, while " { $link & } " updates when all dependencies have new values. "
-"Examples of collection functions are 2fmap-| and 2$>-&" ;
-ABOUT: { "ui.frp.functors" "signal-collection" }
\ No newline at end of file
diff --git a/extra/ui/frp/functors/functors.factor b/extra/ui/frp/functors/functors.factor
deleted file mode 100644
index 1b31151013..0000000000
--- a/extra/ui/frp/functors/functors.factor
+++ /dev/null
@@ -1,34 +0,0 @@
-USING: fry functors generalizations kernel macros peg peg-lexer
-sequences sequences.extras ;
-FROM: ui.frp.signals => #1 ;
-IN: ui.frp.functors
-
-FUNCTOR: fmaps ( W P -- )
-W IS ${W}
-<p> IS <${P}>
-w-n DEFINES ${W}-n-${P}
-w-2 DEFINES 2${W}-${P}
-w-3 DEFINES 3${W}-${P}
-w-4 DEFINES 4${W}-${P}
-w-n* DEFINES ${W}-n-${P}*
-w-2* DEFINES 2${W}-${P}*
-w-3* DEFINES 3${W}-${P}*
-w-4* DEFINES 4${W}-${P}*
-WHERE
-MACRO: w-n ( int -- quot ) dup '[ [ _ narray <p> ] dip [ _ firstn ] prepend W ] ;
-: w-2 ( a b quot -- mapped ) 2 w-n ; inline
-: w-3 ( a b c quot -- mapped ) 3 w-n ; inline
-: w-4 ( a b c d quot -- mapped ) 4 w-n ; inline
-MACRO: w-n* ( int -- quot ) dup '[ [ _ narray <p> #1 ] dip [ _ firstn ] prepend W ] ;
-: w-2* ( a b quot -- mapped ) 2 w-n* ; inline
-: w-3* ( a b c quot -- mapped ) 3 w-n* ; inline
-: w-4* ( a b c d quot -- mapped ) 4 w-n* ; inline
-;FUNCTOR
-
-ON-BNF: FMAPS:
-tokenizer = <foreign factor>
-token = !("FOR"|";").
-middle = "FOR" => [[ drop ignore ]]
-endexpr = ";" => [[ drop ignore ]]
-expr = token* middle token* endexpr => [[ first2 combos [ first2 fmaps ] each ignore ]]
-;ON-BNF
\ No newline at end of file
diff --git a/extra/ui/frp/functors/summary.txt b/extra/ui/frp/functors/summary.txt
deleted file mode 100644
index 6b4e8d2465..0000000000
--- a/extra/ui/frp/functors/summary.txt
+++ /dev/null
@@ -1 +0,0 @@
-Used by ui.frp.signals to combine models
\ No newline at end of file
diff --git a/extra/ui/frp/gadgets/gadgets.factor b/extra/ui/frp/gadgets/gadgets.factor
index a1e4480064..a5a16676ef 100644
--- a/extra/ui/frp/gadgets/gadgets.factor
+++ b/extra/ui/frp/gadgets/gadgets.factor
@@ -67,9 +67,6 @@ IN: accessors
M: frp-button text>> children>> first text>> ;
IN: ui.frp.gadgets
-M: gadget null-val drop f ;
-M: table null-val multiple-selection?>> [ V{ } clone ] [ f ] if ;
-M: frp-field null-val drop "" ;
SINGLETON: gadget-monad
INSTANCE: gadget-monad monad
diff --git a/extra/ui/frp/layout/layout.factor b/extra/ui/frp/layout/layout.factor
index bea2700dc2..88443dc479 100644
--- a/extra/ui/frp/layout/layout.factor
+++ b/extra/ui/frp/layout/layout.factor
@@ -42,7 +42,7 @@ M: model -> dup , ;
: <box> ( gadgets type -- track )
[ t make-layout ] dip <track>
swap [ add-layout ] each
- swap [ <|> >>model ] unless-empty ; inline
+ swap [ <collection> >>model ] unless-empty ; inline
: <hbox> ( gadgets -- track ) horizontal <box> ; inline
: <vbox> ( gadgets -- track ) vertical <box> ; inline
@@ -63,7 +63,7 @@ M: gadget (insert-item) dup parent>> track? [ [ f <layout> ] dip (insert-item) ]
[ insertion-point [ add-gadget ] keep insert-gadget ] if ;
M: layout (insert-item) insertion-point [ add-layout ] keep [ gadget>> insert-gadget ] [ size>> insert-size ] 3bi ;
M: model (insert-item) parent>> dup book? [ "No models in books" throw ]
- [ dup model>> dup |? [ nip swap add-connection ] [ drop [ 1array <|> ] dip (>>model) ] if ] if ;
+ [ dup model>> dup collection? [ nip swap add-connection ] [ drop [ 1array <collection> ] dip (>>model) ] if ] if ;
: insert-item ( item location -- ) [ dup get [ drop ] [ remove-members ] if ] [ on ] [ ] tri
[ add-member ] 2keep (insert-item) ;
@@ -71,5 +71,4 @@ M: model (insert-item) parent>> dup book? [ "No models in books" throw ]
: with-interface ( quot -- ) make* [ insert-items ] with-scope ; inline
-M: model >>= [ swap insertion-quot <action> ] curry ;
-! Temporary places should be cleared at insertion, not on mention
\ No newline at end of file
+M: model >>= [ swap insertion-quot <action> ] curry ;
\ No newline at end of file
diff --git a/extra/ui/frp/signals/signals.factor b/extra/ui/frp/signals/signals.factor
index dcb4d3e315..9ba2fc6cd2 100644
--- a/extra/ui/frp/signals/signals.factor
+++ b/extra/ui/frp/signals/signals.factor
@@ -1,11 +1,8 @@
USING: accessors arrays kernel models models.product monads
sequences sequences.extras ;
-FROM: models.product => product ;
+FROM: syntax => >> ;
IN: ui.frp.signals
-GENERIC: null-val ( gadget -- model )
-M: model null-val drop f ;
-
TUPLE: multi-model < model important? ;
GENERIC: (model-changed) ( model observer -- )
: <multi-model> ( models kind -- model ) f swap new-model [ [ add-dependency ] curry each ] keep ;
@@ -47,9 +44,9 @@ M: fold-model model-activated drop ;
dip [ >>base ] [ value>> >>value ] bi ;
TUPLE: updater-model < multi-model values updates ;
-M: updater-model (model-changed) tuck updates>> =
+M: updater-model (model-changed) [ tuck updates>> =
[ [ values>> value>> ] keep set-model ]
- [ drop ] if ;
+ [ drop ] if ] keep f swap (>>value) ;
: <updates> ( values updates -- signal ) [ 2array updater-model <multi-model> ] 2keep
[ >>values ] [ >>updates ] bi* ;
@@ -61,7 +58,7 @@ M: switch-model (model-changed) 2dup switcher>> =
: <switch> ( signal1 signal2 -- signal' ) swap [ 2array switch-model <multi-model> ] 2keep
[ [ value>> >>value ] [ >>original ] bi ] [ >>switcher ] bi* ;
M: switch-model model-activated [ original>> ] keep model-changed ;
-: >behavior ( event -- behavior ) t <model> <switch> ;
+: >behavior ( event -- behavior ) t >>value ;
TUPLE: mapped-model < multi-model model quot ;
: new-mapped-model ( model quot class -- mapped-model ) [ over 1array ] dip
@@ -89,20 +86,14 @@ M: action (model-changed) [ [ value>> ] [ quot>> ] bi* call( a -- b ) ] keep val
[ swap add-connection ] 2keep model-changed ;
: <action> ( model quot -- action-signal ) [ 1array action <multi-model> ] dip >>quot dup f <action-value> >>value value>> ;
-TUPLE: | < multi-model ;
-: <|> ( models -- product ) | <multi-model> ;
-GENERIC: models-changed ( product -- )
-M: | models-changed drop ;
-M: | model-changed
+TUPLE: collection < multi-model ;
+: <collection> ( models -- product ) collection <multi-model> ;
+M: collection (model-changed)
nip
dup dependencies>> [ value>> ] all?
- [ [ dup [ value>> ] product-value swap set-model ] keep models-changed ]
+ [ dup [ value>> ] product-value swap set-model ]
[ drop ] if ;
-M: | model-activated dup model-changed ;
-
-TUPLE: & < | ;
-: <&> ( models -- product ) & <multi-model> ;
-M: & models-changed dependencies>> [ [ null-val ] keep (>>value) ] each ;
+M: collection model-activated dup (model-changed) ;
! for side effects
TUPLE: (frp-when) < multi-model quot cond ;
@@ -110,9 +101,9 @@ TUPLE: (frp-when) < multi-model quot cond ;
M: (frp-when) (model-changed) [ quot>> ] 2keep
[ value>> ] [ cond>> ] bi* call( a -- ? ) [ call( model -- ) ] [ 2drop ] if ;
-M: model fmap <mapped> ;
-USE: ui.frp.functors
-FMAPS: $> <$ fmap FOR & | product ;
-
! only used in construction
-: with-self ( quot: ( model -- model ) -- model ) [ f <basic> dup ] dip call swap [ add-dependency ] keep ; inline
\ No newline at end of file
+: with-self ( quot: ( model -- model ) -- model ) [ f <basic> dup ] dip call swap [ add-dependency ] keep ; inline
+
+USE: ui.frp.signals.templates
+M: model fmap <mapped> ;
+<< { "$>" "<$" "fmap" } [ fmaps ] each >>
\ No newline at end of file
diff --git a/extra/ui/frp/signals/templates/templates.factor b/extra/ui/frp/signals/templates/templates.factor
new file mode 100644
index 0000000000..bb08e03ea3
--- /dev/null
+++ b/extra/ui/frp/signals/templates/templates.factor
@@ -0,0 +1,23 @@
+USING: kernel sequences functors fry macros generalizations ;
+IN: ui.frp.signals.templates
+FROM: ui.frp.signals => <collection> #1 ;
+FUNCTOR: fmaps ( W -- )
+W IS ${W}
+w-n DEFINES ${W}-n
+w-2 DEFINES 2${W}
+w-3 DEFINES 3${W}
+w-4 DEFINES 4${W}
+w-n* DEFINES ${W}-n*
+w-2* DEFINES 2${W}*
+w-3* DEFINES 3${W}*
+w-4* DEFINES 4${W}*
+WHERE
+MACRO: w-n ( int -- quot ) dup '[ [ _ narray <collection> ] dip [ _ firstn ] prepend W ] ;
+: w-2 ( a b quot -- mapped ) 2 w-n ; inline
+: w-3 ( a b c quot -- mapped ) 3 w-n ; inline
+: w-4 ( a b c d quot -- mapped ) 4 w-n ; inline
+MACRO: w-n* ( int -- quot ) dup '[ [ _ narray <collection> #1 ] dip [ _ firstn ] prepend W ] ;
+: w-2* ( a b quot -- mapped ) 2 w-n* ; inline
+: w-3* ( a b c quot -- mapped ) 3 w-n* ; inline
+: w-4* ( a b c d quot -- mapped ) 4 w-n* ; inline
+;FUNCTOR
\ No newline at end of file
From 58d8aacb74242d0c416b677c7d4a9baa9fcaca38 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Wed, 22 Jul 2009 09:46:52 -0500
Subject: [PATCH 099/128] generalized image buttons
---
extra/recipes/recipes.factor | 10 +++++-----
extra/ui/frp/gadgets/gadgets-docs.factor | 6 +++++-
extra/ui/frp/gadgets/gadgets.factor | 6 ++++--
extra/ui/frp/layout/layout-docs.factor | 8 ++++----
extra/ui/frp/signals/signals-docs.factor | 7 +++----
5 files changed, 21 insertions(+), 16 deletions(-)
diff --git a/extra/recipes/recipes.factor b/extra/recipes/recipes.factor
index 71d2c41524..4ad9397504 100644
--- a/extra/recipes/recipes.factor
+++ b/extra/recipes/recipes.factor
@@ -31,11 +31,11 @@ STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } {
interface
<frp-table*> :> tbl
"okay" <frp-border-button> BUTTON -> :> ok
- IMAGE-BUTTON: submit [ store-tuple ] >>value TOOLBAR -> :> submit
- IMAGE-BUTTON: love 1 >>value TOOLBAR ->
- IMAGE-BUTTON: hate -1 >>value -> 2array <merge> :> votes
- IMAGE-BUTTON: back -> [ -30 ] <$
- IMAGE-BUTTON: more -> [ 30 ] <$ 2array <merge> :> viewed
+ IMG-FRP-BTN: submit [ store-tuple ] >>value TOOLBAR -> :> submit
+ IMG-FRP-BTN: love 1 >>value TOOLBAR ->
+ IMG-FRP-BTN: hate -1 >>value -> 2array <merge> :> votes
+ IMG-FRP-BTN: back -> [ -30 ] <$
+ IMG-FRP-BTN: more -> [ 30 ] <$ 2array <merge> :> viewed
<spacer> <frp-field*> ->% 1 :> search
submit ok [ [ drop ] ] <$ 2array <merge> [ drop ] >>value :> quot
viewed 0 [ + ] <fold> search ok t <basic> "all" <frp-button> ALL ->
diff --git a/extra/ui/frp/gadgets/gadgets-docs.factor b/extra/ui/frp/gadgets/gadgets-docs.factor
index 0df9194746..ee0c764e60 100644
--- a/extra/ui/frp/gadgets/gadgets-docs.factor
+++ b/extra/ui/frp/gadgets/gadgets-docs.factor
@@ -58,10 +58,14 @@ HELP: <frp-action-field>
{ $values { "field" action-field } }
{ $description "Field that updates its model with its contents when the user hits the return key" } ;
-HELP: IMAGE-BUTTON:
+HELP: IMG-FRP-BTN:
{ $syntax "IMAGE-BUTTON: filename" }
{ $description "Creates a button using a tiff image named as specified found in the icons subdirectory of the vocabulary path" } ;
+HELP: IMG-BTN:
+{ $syntax "[ do-something ] IMAGE-BUTTON: filename" }
+{ $description "Creates a button using a tiff image named as specified found in the icons subdirectory of the vocabulary path, calling the specified quotation on click" } ;
+
HELP: output-model
{ $values { "gadget" gadget } { "model" model } }
{ $description "Returns the model a gadget uses for output. Often the same as " { $link model>> } } ;
\ No newline at end of file
diff --git a/extra/ui/frp/gadgets/gadgets.factor b/extra/ui/frp/gadgets/gadgets.factor
index a5a16676ef..db693e350c 100644
--- a/extra/ui/frp/gadgets/gadgets.factor
+++ b/extra/ui/frp/gadgets/gadgets.factor
@@ -52,8 +52,10 @@ M: frp-field model-changed 2dup frp-model>> =
: <frp-action-field> ( -- field ) f <action-field> dup [ set-control-value ] curry >>quot
f <model> >>model ;
-SYNTAX: IMAGE-BUTTON: scan current-vocab name>> "vocab:" "/icons/" surround ".tiff" surround
- <image-name> [ <frp-button> ] curry over push-all ;
+: image-prep ( -- image ) scan current-vocab name>> "vocab:" "/icons/" surround ".tiff" surround <image-name> ;
+SYNTAX: IMG-FRP-BTN: image-prep [ <frp-button> ] curry over push-all ;
+
+SYNTAX: IMG-BTN: image-prep [ swap <button> ] curry over push-all ;
GENERIC: output-model ( gadget -- model )
M: gadget output-model model>> ;
diff --git a/extra/ui/frp/layout/layout-docs.factor b/extra/ui/frp/layout/layout-docs.factor
index f91f099588..2f475deb4d 100644
--- a/extra/ui/frp/layout/layout-docs.factor
+++ b/extra/ui/frp/layout/layout-docs.factor
@@ -38,16 +38,16 @@ HELP: with-interface
{ $values { "quot" "quotation that builds a template and inserts into it" } }
{ $description "Create templates, used with " { $link POSTPONE: $ } } ;
-ARTICLE: { "ui.frp.layout" "about" } "GUI Layout"
+ARTICLE: "ui.frp.layout" "GUI Layout"
"Laying out GUIs works the same way as building lists with " { $vocab-link "make" }
". Gadgets are layed out using " { $vocab-link "ui.gadgets.tracks" } " through " { $link <hbox> } " and " { $link <vbox> } ", which allow both fixed and percentage widths. "
{ $link , } " and " { $link -> } " add a signal or gadget to the gadget you're building. "
"Also, books can be made with " { $link <frp-book> } ". "
{ $link <spacer> } "s add flexable space between items. " $nl
"Using " { $link with-interface } ", one can pre-build templates to add items to later: "
-"Like in Java's StringTemplate, placeholders are defined using $ PLACERHOLDER-NAME $ "
+"Like in the StringTemplate framework for java, placeholders are defined using $ PLACERHOLDER-NAME $ "
"Using PLACEHOLDER-NAME again sets it as the current insertion point. "
-"For examples using normal layout, see the " { $vocab-link "gui-sudoku" } " demo. "
+"For examples using normal layout, see the " { $vocab-link "sudokus" } " demo. "
"For examples of templating, see " { $vocab-link "recipes" } " demo. " ;
-ABOUT: { "ui.frp.layout" "about" }
\ No newline at end of file
+ABOUT: "ui.frp.layout"
\ No newline at end of file
diff --git a/extra/ui/frp/signals/signals-docs.factor b/extra/ui/frp/signals/signals-docs.factor
index 1996213ee2..397c1e2044 100644
--- a/extra/ui/frp/signals/signals-docs.factor
+++ b/extra/ui/frp/signals/signals-docs.factor
@@ -41,10 +41,9 @@ HELP: #1
{ $values { "model" model } { "model'" model } }
{ $description "Moves a signal to the top of its dependencies' connections, thus being notified before the others" } ;
-ARTICLE: { "signals" "about" } "FRP Signals"
+ARTICLE: "signals" "FRP Signals"
"Unlike models, which always have a value, signals have discrete start and end times. "
"They are the core of the frp library: program flow using frp is controlled entirely through manipulating and combining signals. "
-"The output signals of some gadgets (see " { $vocab-link "ui.frp.gadgets" } " ) can be manipulated and used as the input signals of others. "
-"To combine signals see " { $vocab-link "ui.frp.functors" } ;
+"The output signals of some gadgets (see " { $vocab-link "ui.frp.gadgets" } " ) can be manipulated and used as the input signals of others. " ;
-ABOUT: { "signals" "about" }
\ No newline at end of file
+ABOUT: "signals"
\ No newline at end of file
From 3adec5c396dc71ca12b0f30a51736f087b3e26d5 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Wed, 22 Jul 2009 10:28:27 -0500
Subject: [PATCH 100/128] separated run-desc from launcher
---
extra/run-desc/run-desc.factor | 3 +++
1 file changed, 3 insertions(+)
create mode 100644 extra/run-desc/run-desc.factor
diff --git a/extra/run-desc/run-desc.factor b/extra/run-desc/run-desc.factor
new file mode 100644
index 0000000000..6acf66d1b0
--- /dev/null
+++ b/extra/run-desc/run-desc.factor
@@ -0,0 +1,3 @@
+USING: io io.encodings.utf8 io.launcher kernel sequences ;
+IN: run-desc
+: run-desc ( desc -- result ) utf8 [ contents [ but-last ] [ f ] if* ] with-process-reader ;
From 77a128fc331bf41cf7aacf6dff2f960adad8acb8 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Mon, 27 Jul 2009 21:44:18 -0500
Subject: [PATCH 101/128] some non-reflective frp deployment working
---
extra/monads/monads.factor | 1 +
extra/persistency/persistency.factor | 5 ++---
extra/ui/frp/gadgets/gadgets.factor | 15 +++++++++------
extra/ui/frp/layout/layout.factor | 9 ++++++---
extra/ui/frp/signals/signals.factor | 4 ----
extra/ui/gadgets/alerts/alerts.factor | 2 +-
6 files changed, 19 insertions(+), 17 deletions(-)
diff --git a/extra/monads/monads.factor b/extra/monads/monads.factor
index 9a3e605c7f..a859c36f2e 100644
--- a/extra/monads/monads.factor
+++ b/extra/monads/monads.factor
@@ -8,6 +8,7 @@ IN: monads
! Functors
GENERIC# fmap 1 ( functor quot -- functor' )
GENERIC# <$ 1 ( functor quot -- functor' )
+GENERIC# $> 1 ( functor quot -- functor' )
! Monads
diff --git a/extra/persistency/persistency.factor b/extra/persistency/persistency.factor
index 479d39a2b7..8100bce353 100644
--- a/extra/persistency/persistency.factor
+++ b/extra/persistency/persistency.factor
@@ -1,7 +1,6 @@
USING: accessors arrays byte-arrays calendar classes classes.tuple
classes.tuple.parser combinators db db.tuples db.types kernel
-math prettyprint sequences strings unicode.case urls words
-tools.continuations ;
+math sequences strings unicode.case urls words ;
IN: persistency
TUPLE: persistent id ;
@@ -13,7 +12,7 @@ TUPLE: persistent id ;
: remove-types ( table -- table' ) [ dup array? [ first ] when ] map ;
SYNTAX: STORED-TUPLE: parse-tuple-definition [ drop persistent ] dip [ remove-types define-tuple-class ]
- [ nip [ dup unparse >upper ] [ add-types ] bi* define-persistent ] 3bi ;
+ [ nip [ dup name>> >upper ] [ add-types ] bi* define-persistent ] 3bi ;
: define-db ( database class -- ) swap [ [ ensure-table ] with-db ] [ "database" set-word-prop ] 2bi ;
diff --git a/extra/ui/frp/gadgets/gadgets.factor b/extra/ui/frp/gadgets/gadgets.factor
index db693e350c..a1287c7363 100644
--- a/extra/ui/frp/gadgets/gadgets.factor
+++ b/extra/ui/frp/gadgets/gadgets.factor
@@ -1,6 +1,6 @@
-USING: accessors arrays kernel models monads sequences
+USING: accessors assocs arrays kernel models monads sequences
ui.frp.signals ui.gadgets ui.gadgets.borders ui.gadgets.buttons
-ui.gadgets.buttons.private ui.gadgets.editors
+ui.gadgets.buttons.private ui.gadgets.editors words images.loader
ui.gadgets.scrollers ui.gadgets.tables ui.images vocabs.parser lexer ;
IN: ui.frp.gadgets
@@ -52,10 +52,11 @@ M: frp-field model-changed 2dup frp-model>> =
: <frp-action-field> ( -- field ) f <action-field> dup [ set-control-value ] curry >>quot
f <model> >>model ;
-: image-prep ( -- image ) scan current-vocab name>> "vocab:" "/icons/" surround ".tiff" surround <image-name> ;
-SYNTAX: IMG-FRP-BTN: image-prep [ <frp-button> ] curry over push-all ;
+: image-prep ( -- quot ) scan current-vocab name>> "vocab:" "/icons/" surround ".tiff" surround [ <image-name> ] [ load-image ] [ ] tri
+ [ \ cached-image "memoize" word-prop set-at ] 3curry ;
+SYNTAX: IMG-FRP-BTN: image-prep [ <frp-button> ] append over push-all ;
-SYNTAX: IMG-BTN: image-prep [ swap <button> ] curry over push-all ;
+SYNTAX: IMG-BTN: image-prep [ swap <button> ] append over push-all ;
GENERIC: output-model ( gadget -- model )
M: gadget output-model model>> ;
@@ -75,4 +76,6 @@ INSTANCE: gadget-monad monad
INSTANCE: gadget monad
M: gadget monad-of drop gadget-monad ;
M: gadget-monad return drop <gadget> swap >>model ;
-M: gadget >>= output-model [ swap call( x -- y ) ] curry ;
\ No newline at end of file
+M: gadget >>= output-model [ swap call( x -- y ) ] curry ;
+
+! Make sure prop removal really destroys normal db code
\ No newline at end of file
diff --git a/extra/ui/frp/layout/layout.factor b/extra/ui/frp/layout/layout.factor
index 88443dc479..c3c32cd76f 100644
--- a/extra/ui/frp/layout/layout.factor
+++ b/extra/ui/frp/layout/layout.factor
@@ -21,8 +21,8 @@ TUPLE: placeholder < gadget members ;
! Just take the previous mentioned placeholder and use it
! If there is no previously mentioned placeholder, we're probably making a box, and will create the placeholder ourselves
DEFER: with-interface
-: insertion-quot ( quot -- quot' ) make:building get [ placeholder? ] find-last nip [ <placeholder> dup , ] unless*
- swap '[ [ _ , @ ] with-interface ] ;
+: insertion-quot ( quot -- quot' ) make:building get [ [ placeholder? ] find-last nip [ <placeholder> dup , ] unless*
+ swap '[ [ _ , @ ] with-interface ] ] when* ;
SYNTAX: ,% scan string>number [ <layout> , ] curry over push-all ;
SYNTAX: ->% scan string>number '[ [ _ <layout> , ] [ output-model ] bi ] over push-all ;
@@ -71,4 +71,7 @@ M: model (insert-item) parent>> dup book? [ "No models in books" throw ]
: with-interface ( quot -- ) make* [ insert-items ] with-scope ; inline
-M: model >>= [ swap insertion-quot <action> ] curry ;
\ No newline at end of file
+M: model >>= [ swap insertion-quot <action> ] curry ;
+M: model fmap insertion-quot <mapped> ;
+M: model $> insertion-quot side-effect-model new-mapped-model ;
+M: model <$ insertion-quot quot-model new-mapped-model ;
\ No newline at end of file
diff --git a/extra/ui/frp/signals/signals.factor b/extra/ui/frp/signals/signals.factor
index 9ba2fc6cd2..681ffafeae 100644
--- a/extra/ui/frp/signals/signals.factor
+++ b/extra/ui/frp/signals/signals.factor
@@ -71,11 +71,8 @@ M: mapped-model (model-changed)
TUPLE: side-effect-model < mapped-model ;
M: side-effect-model (model-changed) [ value>> ] dip [ quot>> call( old -- ) ] 2keep set-model ;
-: $> ( model quot -- signal ) side-effect-model new-mapped-model ;
-
TUPLE: quot-model < mapped-model ;
M: quot-model (model-changed) nip [ quot>> call( -- b ) ] keep set-model ;
-M: model <$ quot-model new-mapped-model ;
TUPLE: action-value < basic-model parent ;
: <action-value> ( parent value -- model ) action-value new-model swap >>parent ;
@@ -105,5 +102,4 @@ M: (frp-when) (model-changed) [ quot>> ] 2keep
: with-self ( quot: ( model -- model ) -- model ) [ f <basic> dup ] dip call swap [ add-dependency ] keep ; inline
USE: ui.frp.signals.templates
-M: model fmap <mapped> ;
<< { "$>" "<$" "fmap" } [ fmaps ] each >>
\ No newline at end of file
diff --git a/extra/ui/gadgets/alerts/alerts.factor b/extra/ui/gadgets/alerts/alerts.factor
index 427c423ea5..dc81aff15e 100644
--- a/extra/ui/gadgets/alerts/alerts.factor
+++ b/extra/ui/gadgets/alerts/alerts.factor
@@ -1,4 +1,4 @@
-USING: accessors models macros generalizations kernel
+USING: accessors models monads macros generalizations kernel
ui ui.frp.gadgets ui.frp.signals ui.frp.layout ui.gadgets
ui.gadgets.labels ui.gadgets.editors ui.gadgets.buttons
ui.gadgets.packs locals sequences fonts io.styles
From 7a5309f075c813834b2fdd9eac459b5b311f5d87 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Tue, 28 Jul 2009 11:40:58 -0500
Subject: [PATCH 102/128] comboboxes use frp
---
extra/ui/frp/gadgets/gadgets.factor | 10 ++++-----
extra/ui/gadgets/comboboxes/comboboxes.factor | 21 +++++++++----------
2 files changed, 15 insertions(+), 16 deletions(-)
diff --git a/extra/ui/frp/gadgets/gadgets.factor b/extra/ui/frp/gadgets/gadgets.factor
index a1287c7363..f39ca3accd 100644
--- a/extra/ui/frp/gadgets/gadgets.factor
+++ b/extra/ui/frp/gadgets/gadgets.factor
@@ -19,9 +19,10 @@ 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* ;
-: <frp-table> ( model -- table ) f frp-table new-table dup >>renderer
+: new-frp-table ( model class -- table ) f swap new-table dup >>renderer
V{ } clone <basic> >>selected-values V{ } clone <basic> >>selected-indices*
f <basic> >>actions dup [ actions>> set-model ] curry >>action ;
+: <frp-table> ( model -- table ) frp-table new-frp-table ;
: <frp-table*> ( -- table ) V{ } clone <model> <frp-table> ;
: <frp-list> ( column-model -- table ) <frp-table> [ 1array ] >>quot ;
: <frp-list*> ( -- table ) V{ } clone <model> <frp-list> ;
@@ -52,11 +53,10 @@ M: frp-field model-changed 2dup frp-model>> =
: <frp-action-field> ( -- field ) f <action-field> dup [ set-control-value ] curry >>quot
f <model> >>model ;
-: image-prep ( -- quot ) scan current-vocab name>> "vocab:" "/icons/" surround ".tiff" surround [ <image-name> ] [ load-image ] [ ] tri
- [ \ cached-image "memoize" word-prop set-at ] 3curry ;
-SYNTAX: IMG-FRP-BTN: image-prep [ <frp-button> ] append over push-all ;
+: image-prep ( -- image ) scan current-vocab name>> "vocab:" "/icons/" surround ".tiff" surround <image-name> dup cached-image drop ;
+SYNTAX: IMG-FRP-BTN: image-prep [ <frp-button> ] curry over push-all ;
-SYNTAX: IMG-BTN: image-prep [ swap <button> ] append over push-all ;
+SYNTAX: IMG-BTN: image-prep [ swap <button> ] curry over push-all ;
GENERIC: output-model ( gadget -- model )
M: gadget output-model model>> ;
diff --git a/extra/ui/gadgets/comboboxes/comboboxes.factor b/extra/ui/gadgets/comboboxes/comboboxes.factor
index 137150001c..eddd105e24 100644
--- a/extra/ui/gadgets/comboboxes/comboboxes.factor
+++ b/extra/ui/gadgets/comboboxes/comboboxes.factor
@@ -1,22 +1,21 @@
-USING: accessors arrays kernel math.rectangles models sequences
-ui.gadgets ui.gadgets.glass ui.gadgets.labels
-ui.gadgets.tables ui.gestures ;
+USING: accessors arrays kernel math.rectangles sequences
+ui.frp.gadgets ui.frp.signals ui.gadgets ui.gadgets.glass
+ui.gadgets.labels ui.gadgets.tables ui.gestures ;
IN: ui.gadgets.comboboxes
-TUPLE: combo-table < table spawner ;
+TUPLE: combo-table < frp-table spawner ;
-M: combo-table handle-gesture [ call-next-method ] 2keep swap
+M: combo-table handle-gesture [ call-next-method drop ] 2keep swap
T{ button-up } = [
[ spawner>> ]
- [ selected-value>> value>> [ swap set-control-value ] [ drop ] if* ]
- [ hide-glass ] tri drop t
- ] [ drop ] if ;
+ [ selected-row [ swap set-control-value ] [ 2drop ] if ]
+ [ hide-glass ] tri
+ ] [ drop ] if t ;
TUPLE: combobox < label-control table ;
combobox H{
{ T{ button-down } [ dup table>> over >>spawner <zero-rect> show-glass ] }
} set-gestures
-: <combobox> ( options -- combobox ) [ first [ combobox new-label ] keep <model> >>model ] keep
- [ 1array ] map <model> trivial-renderer combo-table new-table
- >>table ;
\ No newline at end of file
+: <combobox> ( options -- combobox ) [ first [ combobox new-label ] keep <basic> >>model ] keep
+ <basic> combo-table new-frp-table [ 1array ] >>quot >>table ;
\ No newline at end of file
From 0c104ca1269e7184ac8866e5899e3b8a39348c29 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Tue, 28 Jul 2009 15:34:49 -0500
Subject: [PATCH 103/128] db configurations factored out through db.info
---
extra/db/info/info.factor | 15 +++++++++++++++
extra/persistency/persistency.factor | 2 +-
extra/recipes/recipes.factor | 4 ++--
extra/ui/frp/gadgets/gadgets.factor | 4 +---
4 files changed, 19 insertions(+), 6 deletions(-)
create mode 100644 extra/db/info/info.factor
diff --git a/extra/db/info/info.factor b/extra/db/info/info.factor
new file mode 100644
index 0000000000..66409f2834
--- /dev/null
+++ b/extra/db/info/info.factor
@@ -0,0 +1,15 @@
+USING: accessors sequences generalizations io.encodings.utf8 db.postgresql parser combinators vocabs.parser db.sqlite
+io.files ;
+IN: db.info
+! having sensative (and likely to change) information directly in source code seems a bad idea
+: get-info ( -- lines ) current-vocab name>> "vocab:" "/dbinfo.txt" surround utf8 file-lines ;
+SYNTAX: get-psql-info <postgresql-db> get-info 5 firstn
+ {
+ [ >>host ]
+ [ >>port ]
+ [ >>username ]
+ [ [ f ] [ ] if-empty >>password ]
+ [ >>database ]
+ } spread parsed ;
+
+SYNTAX: get-sqlite-info get-info first <sqlite-db> parsed ;
\ No newline at end of file
diff --git a/extra/persistency/persistency.factor b/extra/persistency/persistency.factor
index 8100bce353..1604c66b40 100644
--- a/extra/persistency/persistency.factor
+++ b/extra/persistency/persistency.factor
@@ -22,4 +22,4 @@ SYNTAX: STORED-TUPLE: parse-tuple-definition [ drop persistent ] dip [ remove-ty
: get-tuple ( query -- tuple ) [ select-tuple ] w/db ;
: store-tuple ( tuple -- ) [ insert-tuple ] w/db ;
: modify-tuple ( tuple -- ) [ update-tuple ] w/db ;
-: remove-tuples ( tuple -- ) [ delete-tuples ] w/db ;
+: remove-tuples ( tuple -- ) [ delete-tuples ] w/db ;
\ No newline at end of file
diff --git a/extra/recipes/recipes.factor b/extra/recipes/recipes.factor
index 4ad9397504..528663d370 100644
--- a/extra/recipes/recipes.factor
+++ b/extra/recipes/recipes.factor
@@ -1,5 +1,5 @@
USING: accessors arrays colors.constants combinators db.queries
-db.sqlite db.tuples db.types io.files.temp kernel locals math
+db.info db.tuples db.types kernel locals math
monads persistency sequences sequences.extras ui ui.frp.gadgets
ui.frp.layout ui.frp.signals ui.gadgets.labels
ui.gadgets.scrollers ui.pens.solid ;
@@ -8,7 +8,7 @@ IN: recipes
STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } { genre { VARCHAR 100 } } ;
: <recipe> ( title genre text -- recipe ) recipe new swap >>txt swap >>genre swap >>title 0 >>votes ;
-"recipes.db" temp-file <sqlite-db> recipe define-db
+get-psql-info recipe define-db
: top-recipes ( offset search -- recipes ) <query> T{ recipe } rot >>title >>tuple
"votes" >>order 30 >>limit swap >>offset get-tuples ;
: top-genres ( -- genres ) f f top-recipes [ genre>> ] map prune 4 (head-slice) ;
diff --git a/extra/ui/frp/gadgets/gadgets.factor b/extra/ui/frp/gadgets/gadgets.factor
index f39ca3accd..59dfd987a8 100644
--- a/extra/ui/frp/gadgets/gadgets.factor
+++ b/extra/ui/frp/gadgets/gadgets.factor
@@ -76,6 +76,4 @@ INSTANCE: gadget-monad monad
INSTANCE: gadget monad
M: gadget monad-of drop gadget-monad ;
M: gadget-monad return drop <gadget> swap >>model ;
-M: gadget >>= output-model [ swap call( x -- y ) ] curry ;
-
-! Make sure prop removal really destroys normal db code
\ No newline at end of file
+M: gadget >>= output-model [ swap call( x -- y ) ] curry ;
\ No newline at end of file
From eb59431c3fa2fe7f2cf672bed964f71767056454 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Wed, 29 Jul 2009 15:48:54 -0500
Subject: [PATCH 104/128] modules.using rewrite
---
.../modules/rpc-server}/authors.txt | 0
.../modules/rpc-server/rpc-server-docs.factor | 5 +++
extra/modules/rpc-server/rpc-server.factor | 34 ++++++++++++++
extra/modules/rpc-server/summary.txt | 1 +
.../modules/rpc}/authors.txt | 0
.../modules/rpc/rpc-docs.factor | 0
extra/modules/rpc/rpc.factor | 22 +++++++++
.../modules/rpc/summary.txt | 0
.../rpc => extra/modules/using}/authors.txt | 0
extra/modules/using/summary.txt | 1 +
extra/modules/using/using-docs.factor | 13 ++++++
extra/modules/using/using.factor | 27 +++++++++++
.../remote-loading/remote-loading.factor | 4 --
.../modules/remote-loading/summary.txt | 1 -
.../modules/rpc-server/rpc-server.factor | 45 -------------------
unmaintained/modules/rpc-server/summary.txt | 1 -
unmaintained/modules/rpc/rpc.factor | 26 -----------
unmaintained/modules/uploads/authors.txt | 1 -
unmaintained/modules/uploads/summary.txt | 1 -
unmaintained/modules/uploads/uploads.factor | 5 ---
unmaintained/modules/using/authors.txt | 1 -
unmaintained/modules/using/summary.txt | 1 -
unmaintained/modules/using/tests/tags.txt | 1 -
.../modules/using/tests/test-server.factor | 3 --
unmaintained/modules/using/tests/tests.factor | 4 --
unmaintained/modules/using/using-docs.factor | 15 -------
unmaintained/modules/using/using.factor | 36 ---------------
27 files changed, 103 insertions(+), 145 deletions(-)
rename {unmaintained/modules/remote-loading => extra/modules/rpc-server}/authors.txt (100%)
create mode 100644 extra/modules/rpc-server/rpc-server-docs.factor
create mode 100644 extra/modules/rpc-server/rpc-server.factor
create mode 100644 extra/modules/rpc-server/summary.txt
rename {unmaintained/modules/rpc-server => extra/modules/rpc}/authors.txt (100%)
rename {unmaintained => extra}/modules/rpc/rpc-docs.factor (100%)
create mode 100644 extra/modules/rpc/rpc.factor
rename {unmaintained => extra}/modules/rpc/summary.txt (100%)
rename {unmaintained/modules/rpc => extra/modules/using}/authors.txt (100%)
create mode 100644 extra/modules/using/summary.txt
create mode 100644 extra/modules/using/using-docs.factor
create mode 100644 extra/modules/using/using.factor
delete mode 100644 unmaintained/modules/remote-loading/remote-loading.factor
delete mode 100644 unmaintained/modules/remote-loading/summary.txt
delete mode 100644 unmaintained/modules/rpc-server/rpc-server.factor
delete mode 100644 unmaintained/modules/rpc-server/summary.txt
delete mode 100644 unmaintained/modules/rpc/rpc.factor
delete mode 100644 unmaintained/modules/uploads/authors.txt
delete mode 100644 unmaintained/modules/uploads/summary.txt
delete mode 100644 unmaintained/modules/uploads/uploads.factor
delete mode 100644 unmaintained/modules/using/authors.txt
delete mode 100644 unmaintained/modules/using/summary.txt
delete mode 100644 unmaintained/modules/using/tests/tags.txt
delete mode 100644 unmaintained/modules/using/tests/test-server.factor
delete mode 100644 unmaintained/modules/using/tests/tests.factor
delete mode 100644 unmaintained/modules/using/using-docs.factor
delete mode 100644 unmaintained/modules/using/using.factor
diff --git a/unmaintained/modules/remote-loading/authors.txt b/extra/modules/rpc-server/authors.txt
similarity index 100%
rename from unmaintained/modules/remote-loading/authors.txt
rename to extra/modules/rpc-server/authors.txt
diff --git a/extra/modules/rpc-server/rpc-server-docs.factor b/extra/modules/rpc-server/rpc-server-docs.factor
new file mode 100644
index 0000000000..fc2c2344dd
--- /dev/null
+++ b/extra/modules/rpc-server/rpc-server-docs.factor
@@ -0,0 +1,5 @@
+USING: help.syntax help.markup modules.rpc-server modules.using ;
+IN: modules.rpc-server
+HELP: service
+{ $syntax "IN: my-vocab service" }
+{ $description "Allows words defined in the vocabulary to be used as remote procedure calls by " { $link POSTPONE: USING*: } } ;
\ No newline at end of file
diff --git a/extra/modules/rpc-server/rpc-server.factor b/extra/modules/rpc-server/rpc-server.factor
new file mode 100644
index 0000000000..c079f485d4
--- /dev/null
+++ b/extra/modules/rpc-server/rpc-server.factor
@@ -0,0 +1,34 @@
+USING: accessors assocs concurrency.distributed
+concurrency.messaging continuations effects init kernel
+namespaces sequences sets threads vocabs vocabs.parser ;
+IN: modules.rpc-server
+<PRIVATE
+TUPLE: rpc-request args vocabspec wordname ;
+SYMBOL: serving-vocabs serving-vocabs [ V{ } clone ] initialize
+
+: register-gets-thread ( -- )
+ [ receive [ data>> dup serving-vocabs get-global index
+ [ vocab-words [ stack-effect ] { } assoc-map-as ]
+ [ \ no-vocab boa ] if
+ ] keep reply-synchronous
+ t ] "get-words" spawn-server "gets-thread" swap register-process ;
+
+: register-does-thread ( -- )
+ [ receive [ data>> dup vocabspec>> serving-vocabs get-global index
+ [ [ args>> ] [ wordname>> ] [ vocabspec>> vocab-words ] tri at [ execute ] curry with-datastack ]
+ [ vocabspec>> \ no-vocab boa ] if
+ ] keep reply-synchronous
+ t ] "do-word" spawn-server "does-thread" swap register-process ;
+
+: register-loads-thread ( -- )
+ [ [ receive vocab ] keep reply-synchronous t ] "load-words" spawn-server "loads-thread" swap register-process ;
+
+: add-vocabs-hook ( -- )
+ [ 9012 start-node
+ register-gets-thread
+ register-does-thread
+ register-loads-thread
+ ] "start-serving-vocabs" add-init-hook ;
+PRIVATE>
+SYNTAX: service add-vocabs-hook
+ current-vocab name>> serving-vocabs get-global adjoin ;
diff --git a/extra/modules/rpc-server/summary.txt b/extra/modules/rpc-server/summary.txt
new file mode 100644
index 0000000000..3688644814
--- /dev/null
+++ b/extra/modules/rpc-server/summary.txt
@@ -0,0 +1 @@
+Serve factor words as rpcs
\ No newline at end of file
diff --git a/unmaintained/modules/rpc-server/authors.txt b/extra/modules/rpc/authors.txt
similarity index 100%
rename from unmaintained/modules/rpc-server/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/extra/modules/rpc/rpc.factor b/extra/modules/rpc/rpc.factor
new file mode 100644
index 0000000000..e088ab2844
--- /dev/null
+++ b/extra/modules/rpc/rpc.factor
@@ -0,0 +1,22 @@
+USING: accessors assocs concurrency.distributed
+concurrency.messaging fry generalizations io.sockets kernel
+locals namespaces parser sequences vocabs vocabs.parser words ;
+IN: modules.rpc
+
+TUPLE: rpc-request args vocabspec wordname ;
+
+: send-with-check ( message thread -- reply/* ) send-synchronous dup no-vocab? [ throw ] when ;
+
+:: define-remote ( str effect addrspec vocabspec -- )
+ str create-in effect [ in>> length ] [ out>> length ] bi
+ '[ _ narray vocabspec str rpc-request boa "does-thread" addrspec 9012 <inet> <remote-process> send-with-check _ firstn ]
+ effect define-declared ;
+
+:: remote-vocab ( addrspec vocabspec -- vocab )
+ vocabspec "-remote" append dup vocab [ dup set-current-vocab
+ vocabspec "gets-thread" addrspec 9012 <inet> <remote-process> send-with-check
+ [ first2 addrspec vocabspec define-remote ] each
+ ] unless ;
+
+: remote-load ( addr vocabspec -- voabspec ) [ swap
+ "loads-thread" swap 9012 <inet> <remote-process> send-synchronous ] keep [ dictionary get-global set-at ] keep ;
\ No newline at end of file
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/rpc/authors.txt b/extra/modules/using/authors.txt
similarity index 100%
rename from unmaintained/modules/rpc/authors.txt
rename to extra/modules/using/authors.txt
diff --git a/extra/modules/using/summary.txt b/extra/modules/using/summary.txt
new file mode 100644
index 0000000000..62fdb05d5b
--- /dev/null
+++ b/extra/modules/using/summary.txt
@@ -0,0 +1 @@
+Improved module import syntax with network transparency
\ No newline at end of file
diff --git a/extra/modules/using/using-docs.factor b/extra/modules/using/using-docs.factor
new file mode 100644
index 0000000000..f03d51bbf7
--- /dev/null
+++ b/extra/modules/using/using-docs.factor
@@ -0,0 +1,13 @@
+USING: help.syntax help.markup strings modules.using ;
+IN: modules
+ARTICLE: { "modules.using" "use" } "Using the modules.using vocab"
+"This vocabulary defines " { $link POSTPONE: USING*: } " as an alternative to " { $link POSTPONE: USING: } " which makes qualified imports easier. "
+"Secondly, it allows loading vocabularies from remote servers, as long as the remote vocabulary can be accessed at compile time. "
+"Finally, the word can treat words in remote vocabularies as remote procedure calls. Any inputs are passed to the imported words as normal, and the result will appear on the stack- the only difference is that the word isn't called locally." ;
+ABOUT: { "modules.using" "use" }
+
+IN: syntax
+HELP: USING*:
+{ $syntax "USING: rpc-server::module fetch-sever:module { module qualified-name } { module => word ... } { qualified-module } { module EXCEPT word ... } { module word => importname } ;" }
+{ $description "Adds vocabularies to the search path. Vocabularies can be loaded off a server or called as an rpc if preceded by a valid hostname. Bracketed pairs facilitate all types of qualified imports on both remote and local modules." }
+"To use the 'USING*:' without explicitly importing modules.using first, add '\"modules.using\" require' to your .factor-boot-rc" ;
\ No newline at end of file
diff --git a/extra/modules/using/using.factor b/extra/modules/using/using.factor
new file mode 100644
index 0000000000..2e4a097510
--- /dev/null
+++ b/extra/modules/using/using.factor
@@ -0,0 +1,27 @@
+USING: kernel modules.rpc peg peg-lexer peg.ebnf sequences
+strings vocabs.parser ;
+IN: modules.using
+
+EBNF: modulize
+tokenpart = (!(':').)+ => [[ >string ]]
+s = ':' => [[ drop ignore ]]
+rpc = tokenpart s s tokenpart => [[ first2 remote-vocab ]]
+remote = tokenpart s tokenpart => [[ first2 remote-load ]]
+module = rpc | remote | tokenpart
+;EBNF
+
+IN: syntax
+ON-BNF: USING*:
+tokenizer = <foreign factor>
+sym = !(";"|"}"|"=>"|"EXCEPT").
+modspec = sym => [[ modulize ]]
+qualified-with = modspec sym => [[ first2 add-qualified ignore ]]
+qualified = modspec => [[ dup add-qualified ignore ]]
+from = modspec "=>" sym+ => [[ first3 nip add-words-from ignore ]]
+exclude = modspec "EXCEPT" sym+ => [[ first3 nip add-words-excluding ignore ]]
+rename = modspec sym "=>" sym => [[ first4 nip swapd add-renamed-word ignore ]]
+long = "{" ( from | exclude | rename | qualified-with | qualified ) "}" => [[ drop ignore ]]
+short = modspec => [[ use-vocab ignore ]]
+wordSpec = long | short
+using = wordSpec+ ";" => [[ drop ignore ]]
+;ON-BNF
\ No newline at end of file
diff --git a/unmaintained/modules/remote-loading/remote-loading.factor b/unmaintained/modules/remote-loading/remote-loading.factor
deleted file mode 100644
index 7a51f2488d..0000000000
--- a/unmaintained/modules/remote-loading/remote-loading.factor
+++ /dev/null
@@ -1,4 +0,0 @@
-USING: modules.rpc-server vocabs ;
-IN: modules.remote-loading mem-service
-
-: get-vocab ( vocabstr -- vocab ) vocab ;
\ No newline at end of file
diff --git a/unmaintained/modules/remote-loading/summary.txt b/unmaintained/modules/remote-loading/summary.txt
deleted file mode 100644
index 304f8550e4..0000000000
--- a/unmaintained/modules/remote-loading/summary.txt
+++ /dev/null
@@ -1 +0,0 @@
-required for listeners allowing remote loading of modules
\ No newline at end of file
diff --git a/unmaintained/modules/rpc-server/rpc-server.factor b/unmaintained/modules/rpc-server/rpc-server.factor
deleted file mode 100644
index 0c881adef6..0000000000
--- a/unmaintained/modules/rpc-server/rpc-server.factor
+++ /dev/null
@@ -1,45 +0,0 @@
-USING: accessors assocs continuations effects io
-io.encodings.binary io.servers.connection kernel
-memoize namespaces parser sets sequences serialize
-threads vocabs vocabs.parser words ;
-IN: modules.rpc-server
-
-SYMBOL: serving-vocabs V{ } clone serving-vocabs set-global
-
-: do-rpc ( args word -- bytes )
- [ execute ] curry with-datastack object>bytes ; inline
-
-MEMO: mem-do-rpc ( args word -- bytes ) do-rpc ; inline
-
-: process ( vocabspec -- )
- vocab-words [ deserialize ] dip deserialize
- swap at "executer" get execute( args word -- bytes ) write flush ;
-
-: (serve) ( -- )
- deserialize dup serving-vocabs get-global index
- [ process ] [ drop ] if ;
-
-: start-serving-vocabs ( -- )
- [
- binary <threaded-server>
- 5000 >>insecure
- [ (serve) ] >>handler
- start-server
- ] in-thread ;
-
-: (service) ( -- )
- serving-vocabs get-global empty? [ start-serving-vocabs ] when
- current-vocab serving-vocabs get-global adjoin
- "get-words" create-in
- in get [ vocab vocab-words [ stack-effect ] { } assoc-map-as ] curry
- (( -- words )) define-inline ;
-
-SYNTAX: service \ do-rpc "executer" set (service) ;
-SYNTAX: mem-service \ mem-do-rpc "executer" set (service) ;
-
-load-vocab-hook [
- [
- dup words>> values
- \ mem-do-rpc "memoize" word-prop [ delete-at ] curry each
- ] append
-] change-global
diff --git a/unmaintained/modules/rpc-server/summary.txt b/unmaintained/modules/rpc-server/summary.txt
deleted file mode 100644
index 396a1c8686..0000000000
--- a/unmaintained/modules/rpc-server/summary.txt
+++ /dev/null
@@ -1 +0,0 @@
-remote procedure call server
\ No newline at end of file
diff --git a/unmaintained/modules/rpc/rpc.factor b/unmaintained/modules/rpc/rpc.factor
deleted file mode 100644
index fe65c9cb37..0000000000
--- a/unmaintained/modules/rpc/rpc.factor
+++ /dev/null
@@ -1,26 +0,0 @@
-USING: accessors compiler.units combinators fry generalizations io
-io.encodings.binary io.sockets kernel
-parser sequences serialize vocabs vocabs.parser words ;
-IN: modules.rpc
-
-DEFER: get-words
-
-: with-in-vocab ( vocab quot -- vocab ) over
- [ '[ _ set-current-vocab @ ] current-vocab name>> swap dip set-current-vocab ] dip vocab ; inline
-
-: remote-quot ( addrspec vocabspec effect str -- quot )
- '[ _ 5000 <inet> binary
- [
- _ serialize _ in>> length narray serialize _ serialize flush deserialize dup length firstn
- ] with-client
- ] ;
-
-: define-remote ( addrspec vocabspec effect str -- ) [
- [ remote-quot ] 2keep create-in -rot define-declared word make-inline
- ] with-compilation-unit ;
-
-: remote-vocab ( addrspec vocabspec -- vocab )
- dup "-remote" append [
- [ (( -- words )) [ "get-words" remote-quot ] keep call-effect ] 2keep
- [ rot first2 swap define-remote ] 2curry each
- ] with-in-vocab ;
\ No newline at end of file
diff --git a/unmaintained/modules/uploads/authors.txt b/unmaintained/modules/uploads/authors.txt
deleted file mode 100644
index 2300f69f11..0000000000
--- a/unmaintained/modules/uploads/authors.txt
+++ /dev/null
@@ -1 +0,0 @@
-Sam Anklesaria
diff --git a/unmaintained/modules/uploads/summary.txt b/unmaintained/modules/uploads/summary.txt
deleted file mode 100644
index 1ba8ffe0f8..0000000000
--- a/unmaintained/modules/uploads/summary.txt
+++ /dev/null
@@ -1 +0,0 @@
-module pushing in remote-loading listeners
\ No newline at end of file
diff --git a/unmaintained/modules/uploads/uploads.factor b/unmaintained/modules/uploads/uploads.factor
deleted file mode 100644
index 137a2c91d5..0000000000
--- a/unmaintained/modules/uploads/uploads.factor
+++ /dev/null
@@ -1,5 +0,0 @@
-USING: assocs modules.rpc-server vocabs
-modules.remote-loading words ;
-IN: modules.uploads service
-
-: upload-vocab ( word binary -- ) \ get-vocab "memoize" word-prop set-at ;
\ No newline at end of file
diff --git a/unmaintained/modules/using/authors.txt b/unmaintained/modules/using/authors.txt
deleted file mode 100644
index 2300f69f11..0000000000
--- a/unmaintained/modules/using/authors.txt
+++ /dev/null
@@ -1 +0,0 @@
-Sam Anklesaria
diff --git a/unmaintained/modules/using/summary.txt b/unmaintained/modules/using/summary.txt
deleted file mode 100644
index 6bafda776a..0000000000
--- a/unmaintained/modules/using/summary.txt
+++ /dev/null
@@ -1 +0,0 @@
-improved module import syntax
\ No newline at end of file
diff --git a/unmaintained/modules/using/tests/tags.txt b/unmaintained/modules/using/tests/tags.txt
deleted file mode 100644
index 6bf68304bb..0000000000
--- a/unmaintained/modules/using/tests/tags.txt
+++ /dev/null
@@ -1 +0,0 @@
-unportable
diff --git a/unmaintained/modules/using/tests/test-server.factor b/unmaintained/modules/using/tests/test-server.factor
deleted file mode 100644
index 3e6b736ae1..0000000000
--- a/unmaintained/modules/using/tests/test-server.factor
+++ /dev/null
@@ -1,3 +0,0 @@
-USING: modules.rpc-server io.servers.connection ;
-IN: modules.test-server service
-: rpc-hello ( -- str ) "hello world" stop-this-server ;
\ No newline at end of file
diff --git a/unmaintained/modules/using/tests/tests.factor b/unmaintained/modules/using/tests/tests.factor
deleted file mode 100644
index a0adca2646..0000000000
--- a/unmaintained/modules/using/tests/tests.factor
+++ /dev/null
@@ -1,4 +0,0 @@
-QUALIFIED-WITH: modules.using m
-IN: modules.using.tests
-m:USING: tools.test localhost::modules.test-server ;
-[ "hello world" ] [ rpc-hello ] unit-test
\ No newline at end of file
diff --git a/unmaintained/modules/using/using-docs.factor b/unmaintained/modules/using/using-docs.factor
deleted file mode 100644
index 15f99964d8..0000000000
--- a/unmaintained/modules/using/using-docs.factor
+++ /dev/null
@@ -1,15 +0,0 @@
-USING: modules.rpc-server help.syntax help.markup strings ;
-QUALIFIED-WITH: modules.using m
-IN: modules
-
-HELP: service
-{ $syntax "IN: module service" }
-{ $description "Starts a server for requests for remote procedure calls." } ;
-
-ARTICLE: { "modules" "remote-loading" } "Using the remote-loading vocabulary"
-"If loaded, starts serving vocabularies, accessable through a " { $link POSTPONE: m:USING: } " form" ;
-
-HELP: USING:
-{ $syntax "USING: rpc-server::module fetch-sever::module { module qualified-name } { module => word ... } ... ;" }
-{ $description "Adds vocabularies to the front of the search path. Vocabularies can be fetched remotely, if preceded by a valid hostname. Name pairs facilitate imports like in the "
-{ $link POSTPONE: QUALIFIED: } " or " { $link POSTPONE: FROM: } " forms." } ;
\ No newline at end of file
diff --git a/unmaintained/modules/using/using.factor b/unmaintained/modules/using/using.factor
deleted file mode 100644
index 57bf3c67cd..0000000000
--- a/unmaintained/modules/using/using.factor
+++ /dev/null
@@ -1,36 +0,0 @@
-USING: accessors assocs kernel modules.remote-loading modules.rpc
-namespaces peg peg.ebnf peg-lexer sequences vocabs vocabs.parser
-strings ;
-IN: modules.using
-
-: >qualified ( vocab prefix -- assoc )
- [ vocab-words ] [ 58 suffix ] bi* [ swap [ prepend ] dip ] curry assoc-map ;
-
-: >partial-vocab ( words assoc -- assoc )
- [ dupd at [ no-word-error ] unless* ] curry { } map>assoc ;
-
-: remote-load ( addr vocabspec -- voab ) [ "modules.remote-loading" remote-vocab use-vocab ] dip get-vocab ;
-
-: load'em ( vocab words/? -- ) [ swap >partial-vocab ] when* manifest get qualified-vocabs>> push ;
-
-EBNF: modulize
-tokenpart = (!(':').)+ => [[ >string ]]
-s = ':' => [[ drop ignore ]]
-rpc = tokenpart s s tokenpart => [[ first2 remote-vocab ]]
-remote = tokenpart s tokenpart => [[ first2 remote-load ]]
-plain = tokenpart => [[ load-vocab ]]
-module = rpc | remote | plain
-;EBNF
-
-ON-BNF: USING:
-tokenizer = <foreign factor>
-sym = !(";"|"}"|"=>").
-modspec = sym => [[ modulize ]]
-qualified = modspec sym => [[ first2 >qualified ]]
-unqualified = modspec => [[ vocab-words ]]
-words = ("=>" sym+ )? => [[ [ f ] [ second ] if-empty ]]
-long = "{" ( qualified | unqualified ) words "}" => [[ rest first2 load'em ignore ]]
-short = modspec => [[ use-vocab ignore ]]
-wordSpec = long | short
-using = wordSpec+ ";" => [[ drop ignore ]]
-;ON-BNF
\ No newline at end of file
From 3f1b35e21b6144f23610422db49d66481872d197 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Wed, 29 Jul 2009 16:24:14 -0500
Subject: [PATCH 105/128] modules.using: fixed help-lint errors
---
extra/modules/using/using-docs.factor | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/extra/modules/using/using-docs.factor b/extra/modules/using/using-docs.factor
index f03d51bbf7..257ad3315b 100644
--- a/extra/modules/using/using-docs.factor
+++ b/extra/modules/using/using-docs.factor
@@ -3,11 +3,11 @@ IN: modules
ARTICLE: { "modules.using" "use" } "Using the modules.using vocab"
"This vocabulary defines " { $link POSTPONE: USING*: } " as an alternative to " { $link POSTPONE: USING: } " which makes qualified imports easier. "
"Secondly, it allows loading vocabularies from remote servers, as long as the remote vocabulary can be accessed at compile time. "
-"Finally, the word can treat words in remote vocabularies as remote procedure calls. Any inputs are passed to the imported words as normal, and the result will appear on the stack- the only difference is that the word isn't called locally." ;
+"Finally, the word can treat words in remote vocabularies as remote procedure calls. Any inputs are passed to the imported words as normal, and the result will appear on the stack- the only difference is that the word isn't called locally." ;
ABOUT: { "modules.using" "use" }
IN: syntax
HELP: USING*:
{ $syntax "USING: rpc-server::module fetch-sever:module { module qualified-name } { module => word ... } { qualified-module } { module EXCEPT word ... } { module word => importname } ;" }
-{ $description "Adds vocabularies to the search path. Vocabularies can be loaded off a server or called as an rpc if preceded by a valid hostname. Bracketed pairs facilitate all types of qualified imports on both remote and local modules." }
+{ $description "Adds vocabularies to the search path. Vocabularies can be loaded off a server or called as an rpc if preceded by a valid hostname. Bracketed pairs facilitate all types of qualified imports on both remote and local modules." }
"To use the 'USING*:' without explicitly importing modules.using first, add '\"modules.using\" require' to your .factor-boot-rc" ;
\ No newline at end of file
From 9c0668180d2f40be23d545a5255550596d87a2d0 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Thu, 30 Jul 2009 17:12:06 -0500
Subject: [PATCH 106/128] ui.frp: template creation moved to runtime
---
extra/ui/frp/gadgets/gadgets.factor | 6 +++++-
extra/ui/frp/layout/layout.factor | 14 ++++++++------
2 files changed, 13 insertions(+), 7 deletions(-)
diff --git a/extra/ui/frp/gadgets/gadgets.factor b/extra/ui/frp/gadgets/gadgets.factor
index 59dfd987a8..c3bdb757dc 100644
--- a/extra/ui/frp/gadgets/gadgets.factor
+++ b/extra/ui/frp/gadgets/gadgets.factor
@@ -1,7 +1,8 @@
USING: accessors assocs arrays kernel models monads sequences
ui.frp.signals ui.gadgets ui.gadgets.borders ui.gadgets.buttons
ui.gadgets.buttons.private ui.gadgets.editors words images.loader
-ui.gadgets.scrollers ui.gadgets.tables ui.images vocabs.parser lexer ;
+ui.gadgets.scrollers ui.gadgets.tables ui.images vocabs.parser lexer
+models.range ui.gadgets.sliders ;
IN: ui.frp.gadgets
TUPLE: frp-button < button hook value ;
@@ -53,6 +54,8 @@ M: frp-field model-changed 2dup frp-model>> =
: <frp-action-field> ( -- field ) f <action-field> dup [ set-control-value ] curry >>quot
f <model> >>model ;
+: <frp-slider> ( init page min max step -- slider ) <range> horizontal <slider> ;
+
: image-prep ( -- image ) scan current-vocab name>> "vocab:" "/icons/" surround ".tiff" surround <image-name> dup cached-image drop ;
SYNTAX: IMG-FRP-BTN: image-prep [ <frp-button> ] curry over push-all ;
@@ -65,6 +68,7 @@ M: table output-model dup multiple-selection?>>
[ dup val-quot>> [ selected-value>> ] [ selected-index*>> ] if ] if ;
M: frp-field output-model frp-model>> ;
M: scroller output-model viewport>> children>> first output-model ;
+M: slider output-model model>> range-model ;
IN: accessors
M: frp-button text>> children>> first text>> ;
diff --git a/extra/ui/frp/layout/layout.factor b/extra/ui/frp/layout/layout.factor
index c3c32cd76f..47916e5393 100644
--- a/extra/ui/frp/layout/layout.factor
+++ b/extra/ui/frp/layout/layout.factor
@@ -1,10 +1,11 @@
-USING: accessors arrays fry kernel lexer make math.parser
+USING: accessors assocs arrays fry kernel lexer make math.parser
models monads namespaces parser sequences
sequences.extras ui.frp.gadgets ui.frp.signals ui.gadgets
ui.gadgets.books ui.gadgets.tracks words ;
QUALIFIED: make
IN: ui.frp.layout
+SYMBOL: templates
TUPLE: layout gadget size ; C: <layout> layout
TUPLE: placeholder < gadget members ;
: <placeholder> ( -- placeholder ) placeholder new V{ } clone >>members ;
@@ -22,7 +23,7 @@ TUPLE: placeholder < gadget members ;
! If there is no previously mentioned placeholder, we're probably making a box, and will create the placeholder ourselves
DEFER: with-interface
: insertion-quot ( quot -- quot' ) make:building get [ [ placeholder? ] find-last nip [ <placeholder> dup , ] unless*
- swap '[ [ _ , @ ] with-interface ] ] when* ;
+ templates get spin '[ [ _ templates set _ , @ ] with-interface ] ] when* ;
SYNTAX: ,% scan string>number [ <layout> , ] curry over push-all ;
SYNTAX: ->% scan string>number '[ [ _ <layout> , ] [ output-model ] bi ] over push-all ;
@@ -50,9 +51,10 @@ M: model -> dup , ;
: <frp-book> ( quot: ( -- model ) -- book ) f make-layout rot 0 >>value make-book ; inline
: <frp-book*> ( quot -- book ) f make-layout f make-book ; inline
-SYNTAX: $ CREATE-WORD <placeholder>
- [ [ , ] curry (( -- )) define-declared "$" expect ]
- [ [ , ] curry ] bi over push-all ;
+ERROR: not-in-template word ;
+SYNTAX: $ CREATE-WORD dup
+ [ [ dup templates get at [ nip , ] [ not-in-template ] if* ] curry (( -- )) define-declared "$" expect ]
+ [ [ <placeholder> [ swap templates get set-at ] keep , ] curry ] bi over push-all ;
: insert-gadget ( number parent gadget -- ) -rot [ but-last insert-nth ] change-children drop ;
: insert-size ( number parent size -- ) -rot [ but-last insert-nth ] change-sizes drop ;
@@ -69,7 +71,7 @@ M: model (insert-item) parent>> dup book? [ "No models in books" throw ]
: insert-items ( makelist -- ) t swap [ dup placeholder? [ nip ] [ over insert-item ] if ] each drop ;
-: with-interface ( quot -- ) make* [ insert-items ] with-scope ; inline
+: with-interface ( quot -- ) [ make* ] curry H{ } clone templates rot with-variable [ insert-items ] with-scope ; inline
M: model >>= [ swap insertion-quot <action> ] curry ;
M: model fmap insertion-quot <mapped> ;
From c27c4d1fdfb6fd3c33d884e524916c4e3c94907b Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Thu, 30 Jul 2009 17:12:49 -0500
Subject: [PATCH 107/128] modules.using: added licenses
---
extra/modules/rpc-server/rpc-server.factor | 2 ++
extra/modules/rpc/rpc.factor | 2 ++
extra/modules/using/using.factor | 2 ++
3 files changed, 6 insertions(+)
diff --git a/extra/modules/rpc-server/rpc-server.factor b/extra/modules/rpc-server/rpc-server.factor
index c079f485d4..ffc2e404db 100644
--- a/extra/modules/rpc-server/rpc-server.factor
+++ b/extra/modules/rpc-server/rpc-server.factor
@@ -1,3 +1,5 @@
+! Copyright (C) 2009 Sam Anklesaria.
+! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs concurrency.distributed
concurrency.messaging continuations effects init kernel
namespaces sequences sets threads vocabs vocabs.parser ;
diff --git a/extra/modules/rpc/rpc.factor b/extra/modules/rpc/rpc.factor
index e088ab2844..724a779f7e 100644
--- a/extra/modules/rpc/rpc.factor
+++ b/extra/modules/rpc/rpc.factor
@@ -1,3 +1,5 @@
+! Copyright (C) 2009 Sam Anklesaria.
+! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs concurrency.distributed
concurrency.messaging fry generalizations io.sockets kernel
locals namespaces parser sequences vocabs vocabs.parser words ;
diff --git a/extra/modules/using/using.factor b/extra/modules/using/using.factor
index 2e4a097510..5a13f58587 100644
--- a/extra/modules/using/using.factor
+++ b/extra/modules/using/using.factor
@@ -1,3 +1,5 @@
+! Copyright (C) 2009 Sam Anklesaria.
+! See http://factorcode.org/license.txt for BSD license.
USING: kernel modules.rpc peg peg-lexer peg.ebnf sequences
strings vocabs.parser ;
IN: modules.using
From 24e5d416a763747f8512a88fe64e86768e606011 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Fri, 31 Jul 2009 11:10:14 -0500
Subject: [PATCH 108/128] added various author files
---
basis/models/illusion/authors.txt | 1 +
extra/modules/using/using-docs.factor | 2 +-
2 files changed, 2 insertions(+), 1 deletion(-)
create mode 100644 basis/models/illusion/authors.txt
diff --git a/basis/models/illusion/authors.txt b/basis/models/illusion/authors.txt
new file mode 100644
index 0000000000..ce0899f16e
--- /dev/null
+++ b/basis/models/illusion/authors.txt
@@ -0,0 +1 @@
+Sam Anklesaria
\ No newline at end of file
diff --git a/extra/modules/using/using-docs.factor b/extra/modules/using/using-docs.factor
index 257ad3315b..cfc0687944 100644
--- a/extra/modules/using/using-docs.factor
+++ b/extra/modules/using/using-docs.factor
@@ -1,5 +1,5 @@
USING: help.syntax help.markup strings modules.using ;
-IN: modules
+IN: modules.using
ARTICLE: { "modules.using" "use" } "Using the modules.using vocab"
"This vocabulary defines " { $link POSTPONE: USING*: } " as an alternative to " { $link POSTPONE: USING: } " which makes qualified imports easier. "
"Secondly, it allows loading vocabularies from remote servers, as long as the remote vocabulary can be accessed at compile time. "
From 0e1b014ea0593840756ff41d0da61571f4d8e7fd Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Fri, 31 Jul 2009 11:10:51 -0500
Subject: [PATCH 109/128] simplified main word definition
---
extra/enter/authors.txt | 1 +
extra/enter/enter.factor | 8 ++++++++
2 files changed, 9 insertions(+)
create mode 100644 extra/enter/authors.txt
create mode 100644 extra/enter/enter.factor
diff --git a/extra/enter/authors.txt b/extra/enter/authors.txt
new file mode 100644
index 0000000000..ce0899f16e
--- /dev/null
+++ b/extra/enter/authors.txt
@@ -0,0 +1 @@
+Sam Anklesaria
\ No newline at end of file
diff --git a/extra/enter/enter.factor b/extra/enter/enter.factor
new file mode 100644
index 0000000000..845182c726
--- /dev/null
+++ b/extra/enter/enter.factor
@@ -0,0 +1,8 @@
+! Copyright (C) 2009 Sam Anklesaria.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors kernel parser vocabs.parser words ;
+IN: enter
+! main words are usually only used for entry, doing initialization, etc
+! it makes sense, then to define it all at once, rather than factoring it out into a seperate word
+! and then declaring it main
+SYNTAX: ENTER: gensym [ parse-definition (( -- )) define-declared ] keep current-vocab (>>main) ;
\ No newline at end of file
From 92cc62de85e8b2ec1d93f7b06b963dd96786ab00 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Fri, 31 Jul 2009 11:11:49 -0500
Subject: [PATCH 110/128] algebraic data types
---
extra/classes/algebraic/algebraic-docs.factor | 5 +++++
extra/classes/algebraic/algebraic.factor | 10 ++++++++++
extra/classes/algebraic/authors.txt | 1 +
extra/classes/algebraic/summary.txt | 1 +
4 files changed, 17 insertions(+)
create mode 100644 extra/classes/algebraic/algebraic-docs.factor
create mode 100644 extra/classes/algebraic/algebraic.factor
create mode 100644 extra/classes/algebraic/authors.txt
create mode 100644 extra/classes/algebraic/summary.txt
diff --git a/extra/classes/algebraic/algebraic-docs.factor b/extra/classes/algebraic/algebraic-docs.factor
new file mode 100644
index 0000000000..4d641a80e6
--- /dev/null
+++ b/extra/classes/algebraic/algebraic-docs.factor
@@ -0,0 +1,5 @@
+USING: help.markup help.syntax ;
+IN: classes.algebraic
+HELP: DATA:
+{ $syntax "DATA: class constructor | constructor arg ... | ... ;" }
+{ $description "Creates a haskell style algebraic data type. For each constructor, a seperate tuple is created, and the resulting tuples are added to a union class." } ;
\ No newline at end of file
diff --git a/extra/classes/algebraic/algebraic.factor b/extra/classes/algebraic/algebraic.factor
new file mode 100644
index 0000000000..09ff137797
--- /dev/null
+++ b/extra/classes/algebraic/algebraic.factor
@@ -0,0 +1,10 @@
+USING: classes.parser classes.tuple classes.union kernel peg
+peg-lexer sequences ;
+IN: classes.algebraic
+
+ON-BNF: DATA:
+tokenizer = <foreign factor>
+delimit = "|" => [[ drop ignore ]]
+tuple = (!("|"|";").)+ => [[ unclip create-class-in [ tuple rot define-tuple-class ] keep ]]
+expr = . tuple (delimit tuple)* ";" => [[ first3 swap prefix [ create-class-in ] dip define-union-class ignore ]]
+;ON-BNF
\ No newline at end of file
diff --git a/extra/classes/algebraic/authors.txt b/extra/classes/algebraic/authors.txt
new file mode 100644
index 0000000000..ce0899f16e
--- /dev/null
+++ b/extra/classes/algebraic/authors.txt
@@ -0,0 +1 @@
+Sam Anklesaria
\ No newline at end of file
diff --git a/extra/classes/algebraic/summary.txt b/extra/classes/algebraic/summary.txt
new file mode 100644
index 0000000000..082638e8d5
--- /dev/null
+++ b/extra/classes/algebraic/summary.txt
@@ -0,0 +1 @@
+Haskell-like algebraic data types
\ No newline at end of file
From 6de5f0964b78c6f1ee13229b0223748ab2731c4b Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Fri, 31 Jul 2009 11:41:50 -0500
Subject: [PATCH 111/128] font syntax for gadgets
---
extra/fonts/syntax/authors.txt | 1 +
extra/fonts/syntax/summary.txt | 1 +
extra/fonts/syntax/syntax-docs.factor | 6 ++++++
extra/fonts/syntax/syntax.factor | 16 ++++++++++++++++
4 files changed, 24 insertions(+)
create mode 100644 extra/fonts/syntax/authors.txt
create mode 100644 extra/fonts/syntax/summary.txt
create mode 100644 extra/fonts/syntax/syntax-docs.factor
create mode 100644 extra/fonts/syntax/syntax.factor
diff --git a/extra/fonts/syntax/authors.txt b/extra/fonts/syntax/authors.txt
new file mode 100644
index 0000000000..ce0899f16e
--- /dev/null
+++ b/extra/fonts/syntax/authors.txt
@@ -0,0 +1 @@
+Sam Anklesaria
\ No newline at end of file
diff --git a/extra/fonts/syntax/summary.txt b/extra/fonts/syntax/summary.txt
new file mode 100644
index 0000000000..35dcf4ec8b
--- /dev/null
+++ b/extra/fonts/syntax/summary.txt
@@ -0,0 +1 @@
+Syntax for modifying gadget fonts
\ No newline at end of file
diff --git a/extra/fonts/syntax/syntax-docs.factor b/extra/fonts/syntax/syntax-docs.factor
new file mode 100644
index 0000000000..7edd6d7e47
--- /dev/null
+++ b/extra/fonts/syntax/syntax-docs.factor
@@ -0,0 +1,6 @@
+USING: help.syntax help.markup ;
+IN: fonts.syntax
+
+HELP: FONT:
+{ $syntax "\"testing\" <label> FONT: 18 serif bold ... ;" }
+{ $description "Used after a gadget to change font settings. Attributes can be in any order: the first number is set as the size, the style attributes like bold and italic will set the bold? and italic? slots, and font-names like serif or monospace will set the name slot." } ;
\ No newline at end of file
diff --git a/extra/fonts/syntax/syntax.factor b/extra/fonts/syntax/syntax.factor
new file mode 100644
index 0000000000..1cda01da4d
--- /dev/null
+++ b/extra/fonts/syntax/syntax.factor
@@ -0,0 +1,16 @@
+USING: accessors arrays classes.algebraic combinators io.styles
+kernel math parser sequences fry ;
+IN: fonts.syntax
+
+DATA: fontname serif | monospace ;
+
+: install ( object quot -- quot/? ) over [ curry ] [ 2drop [ ] ] if ;
+
+: >>name* ( object fontname -- object ) name>> >>name ;
+
+SYNTAX: FONT: \ ; parse-until {
+ [ [ number? ] find nip [ >>size ] install ]
+ [ [ italic = ] find nip [ >>italic? ] install ]
+ [ [ bold = ] find nip [ >>bold? ] install ]
+ [ [ fontname? ] find nip [ >>name* ] install ]
+} cleave 4array concat '[ dup font>> @ drop ] over push-all ;
From 7f33da63ce06560dfd3bdc88a3d0274fcb461dec Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sat, 1 Aug 2009 15:18:24 -0500
Subject: [PATCH 112/128] split + renamed ui.frp for better integration with
other libs
---
extra/file-trees/file-trees.factor | 6 +-
.../combinators}/authors.txt | 0
.../combinators/combinators-docs.factor | 41 +++++++++
.../combinators/combinators.factor} | 32 +++----
extra/models/combinators/summary.txt | 1 +
.../combinators}/templates/templates.factor | 4 +-
extra/modules/rpc-server/rpc-server.factor | 15 ++--
extra/recipes/recipes.factor | 52 +++++------
extra/sudokus/sudokus.factor | 24 ++---
extra/ui/frp/gadgets/gadgets.factor | 83 ------------------
extra/ui/frp/gadgets/summary.txt | 1 -
extra/ui/frp/signals/signals-docs.factor | 49 -----------
extra/ui/frp/signals/summary.txt | 1 -
extra/ui/gadgets/alerts/alerts.factor | 10 +--
extra/ui/gadgets/comboboxes/comboboxes.factor | 11 +--
.../layout => gadgets/controls}/authors.txt | 0
.../controls/controls-docs.factor} | 52 +++++------
extra/ui/gadgets/controls/controls.factor | 87 +++++++++++++++++++
extra/ui/gadgets/controls/summary.txt | 1 +
.../signals => gadgets/layout}/authors.txt | 0
.../layout/layout-docs.factor | 14 +--
.../ui/{frp => gadgets}/layout/layout.factor | 28 +++---
extra/ui/{frp => gadgets}/layout/summary.txt | 0
23 files changed, 255 insertions(+), 257 deletions(-)
rename extra/{ui/frp/gadgets => models/combinators}/authors.txt (100%)
create mode 100644 extra/models/combinators/combinators-docs.factor
rename extra/{ui/frp/signals/signals.factor => models/combinators/combinators.factor} (77%)
create mode 100644 extra/models/combinators/summary.txt
rename extra/{ui/frp/signals => models/combinators}/templates/templates.factor (89%)
delete mode 100644 extra/ui/frp/gadgets/gadgets.factor
delete mode 100644 extra/ui/frp/gadgets/summary.txt
delete mode 100644 extra/ui/frp/signals/signals-docs.factor
delete mode 100644 extra/ui/frp/signals/summary.txt
rename extra/ui/{frp/layout => gadgets/controls}/authors.txt (100%)
rename extra/ui/{frp/gadgets/gadgets-docs.factor => gadgets/controls/controls-docs.factor} (64%)
create mode 100644 extra/ui/gadgets/controls/controls.factor
create mode 100644 extra/ui/gadgets/controls/summary.txt
rename extra/ui/{frp/signals => gadgets/layout}/authors.txt (100%)
rename extra/ui/{frp => gadgets}/layout/layout-docs.factor (84%)
rename extra/ui/{frp => gadgets}/layout/layout.factor (74%)
rename extra/ui/{frp => gadgets}/layout/summary.txt (100%)
diff --git a/extra/file-trees/file-trees.factor b/extra/file-trees/file-trees.factor
index adfb7d67de..b253ef0c96 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 sequences
-vectors make strings ui.frp.signals ui.frp.gadgets
+vectors make strings models.combinators ui.gadgets.controls
sequences.extras ;
IN: file-trees
@@ -44,6 +44,6 @@ DEFER: (tree-insert)
go-to-path ;
: <dir-table> ( tree-model -- table )
- <frp-list*> [ node>> 1array ] >>quot
- [ selected-value>> [ file? not ] <filter> swap <switch> ]
+ <list*> [ node>> 1array ] >>quot
+ [ selected-value>> [ file? not ] filter-model swap switch-models ]
[ swap >>model ] bi ;
\ No newline at end of file
diff --git a/extra/ui/frp/gadgets/authors.txt b/extra/models/combinators/authors.txt
similarity index 100%
rename from extra/ui/frp/gadgets/authors.txt
rename to extra/models/combinators/authors.txt
diff --git a/extra/models/combinators/combinators-docs.factor b/extra/models/combinators/combinators-docs.factor
new file mode 100644
index 0000000000..5ccfe1f758
--- /dev/null
+++ b/extra/models/combinators/combinators-docs.factor
@@ -0,0 +1,41 @@
+USING: help.markup help.syntax models models.arrow sequences monads ;
+IN: models.combinators
+
+HELP: merge
+{ $values { "models" "a list of models" } { "model" basic-model } }
+{ $description "Creates a model that merges the updates of others" } ;
+
+HELP: filter-model
+{ $values { "model" model } { "quot" "quotation with stack effect ( a b -- c )" } { "filter-model" filter-model } }
+{ $description "Creates a model that uses the updates of another model only when they satisfy a given predicate" } ;
+
+HELP: fold
+{ $values { "oldval" "starting value" } { "quot" "applied to update and previous values" } { "model" model } { "model" model } }
+{ $description "Similar to " { $link reduce } " but works on models, applying a quotation to the previous and new values at each update" } ;
+
+HELP: switch-models
+{ $values { "model1" model } { "model2" model } { "model'" model } }
+{ $description "Creates a model that starts with the behavior of model2 and switches to the behavior of model1 on its update" } ;
+
+HELP: <mapped>
+{ $values { "model" model } { "quot" "applied to model's value on updates" } { "model" model } }
+{ $description "An expanded version of " { $link <arrow> } ". Use " { $link fmap } " instead." } ;
+
+HELP: when-model
+{ $values { "model" model } { "quot" "called on the model if the quot yields true" } { "cond" "a quotation called on the model's value, yielding a boolean value" } }
+{ $description "Calls quot when model updates if its value meets the condition set in cond" } ;
+
+HELP: with-self
+{ $values { "quot" "quotation that recieves its own return value" } { "model" model } }
+{ $description "Fixed points for models: the quot reacts to the same model to gives" } ;
+
+HELP: #1
+{ $values { "model" model } { "model'" model } }
+{ $description "Moves a model to the top of its dependencies' connections, thus being notified before the others" } ;
+
+ARTICLE: "models.combinators" "Extending models"
+"The " { $vocab-link "models.combinators" } " library expands models to have discrete start and end times. "
+"Also, it provides methods of manipulating and combining models, expecially useful when programming user interfaces: "
+"The output models of some gadgets (see " { $vocab-link "ui.gadgets.controls" } " ) can be manipulated and used as the input models of others. " ;
+
+ABOUT: "models.combinators"
\ No newline at end of file
diff --git a/extra/ui/frp/signals/signals.factor b/extra/models/combinators/combinators.factor
similarity index 77%
rename from extra/ui/frp/signals/signals.factor
rename to extra/models/combinators/combinators.factor
index 681ffafeae..c7b864d404 100644
--- a/extra/ui/frp/signals/signals.factor
+++ b/extra/models/combinators/combinators.factor
@@ -1,7 +1,7 @@
USING: accessors arrays kernel models models.product monads
sequences sequences.extras ;
FROM: syntax => >> ;
-IN: ui.frp.signals
+IN: models.combinators
TUPLE: multi-model < model important? ;
GENERIC: (model-changed) ( model observer -- )
@@ -17,18 +17,18 @@ IN: models
dup connections>> dup [ dup multi-model? [ important?>> ] [ drop f ] if ] find-all
[ second tuck [ remove ] dip prefix ] each
[ model-changed ] with each ;
-IN: ui.frp.signals
+IN: models.combinators
TUPLE: basic-model < multi-model ;
M: basic-model (model-changed) [ value>> ] dip set-model ;
-: <merge> ( models -- signal ) basic-model <multi-model> ;
-: <2merge> ( model1 model2 -- signal ) 2array <merge> ;
-: <basic> ( value -- signal ) basic-model new-model ;
+: merge ( models -- model ) basic-model <multi-model> ;
+: 2merge ( model1 model2 -- model ) 2array merge ;
+: <basic> ( value -- model ) basic-model new-model ;
TUPLE: filter-model < multi-model quot ;
M: filter-model (model-changed) [ value>> ] dip 2dup quot>> call( a -- ? )
[ set-model ] [ 2drop ] if ;
-: <filter> ( model quot -- filter-signal ) [ 1array filter-model <multi-model> ] dip >>quot ;
+: filter-model ( model quot -- filter-model ) [ 1array \ filter-model <multi-model> ] dip >>quot ;
TUPLE: fold-model < multi-model quot base values ;
M: fold-model (model-changed) 2dup base>> =
@@ -38,16 +38,16 @@ M: fold-model (model-changed) 2dup base>> =
] if ;
M: fold-model model-activated drop ;
: new-fold-model ( deps -- model ) fold-model <multi-model> V{ } clone >>values ;
-: <fold> ( model oldval quot -- signal ) rot 1array new-fold-model swap >>quot
+: fold ( model oldval quot -- model ) rot 1array new-fold-model swap >>quot
swap >>value ;
-: <fold*> ( model oldmodel quot -- signal ) over [ [ 2array new-fold-model ] dip >>quot ]
+: fold* ( model oldmodel quot -- model ) over [ [ 2array new-fold-model ] dip >>quot ]
dip [ >>base ] [ value>> >>value ] bi ;
TUPLE: updater-model < multi-model values updates ;
M: updater-model (model-changed) [ tuck updates>> =
[ [ values>> value>> ] keep set-model ]
[ drop ] if ] keep f swap (>>value) ;
-: <updates> ( values updates -- signal ) [ 2array updater-model <multi-model> ] 2keep
+: updates ( values updates -- model ) [ 2array updater-model <multi-model> ] 2keep
[ >>values ] [ >>updates ] bi* ;
SYMBOL: switch
@@ -55,7 +55,7 @@ TUPLE: switch-model < multi-model original switcher on ;
M: switch-model (model-changed) 2dup switcher>> =
[ [ value>> ] dip over switch = [ nip [ original>> ] keep f >>on model-changed ] [ t >>on set-model ] if ]
[ dup on>> [ 2drop ] [ [ value>> ] dip over [ set-model ] [ 2drop ] if ] if ] if ;
-: <switch> ( signal1 signal2 -- signal' ) swap [ 2array switch-model <multi-model> ] 2keep
+: switch-models ( model1 model2 -- model' ) swap [ 2array switch-model <multi-model> ] 2keep
[ [ value>> >>value ] [ >>original ] bi ] [ >>switcher ] bi* ;
M: switch-model model-activated [ original>> ] keep model-changed ;
: >behavior ( event -- behavior ) t >>value ;
@@ -63,7 +63,7 @@ M: switch-model model-activated [ original>> ] keep model-changed ;
TUPLE: mapped-model < multi-model model quot ;
: new-mapped-model ( model quot class -- mapped-model ) [ over 1array ] dip
<multi-model> swap >>quot swap >>model ;
-: <mapped> ( model quot -- signal ) mapped-model new-mapped-model ;
+: <mapped> ( model quot -- model ) mapped-model new-mapped-model ;
M: mapped-model (model-changed)
[ [ value>> ] [ quot>> ] bi* call( old -- new ) ] [ nip ] 2bi
set-model ;
@@ -81,7 +81,7 @@ M: action-value model-activated dup parent>> dup activate-model model-changed ;
TUPLE: action < multi-model quot ;
M: action (model-changed) [ [ value>> ] [ quot>> ] bi* call( a -- b ) ] keep value>>
[ swap add-connection ] 2keep model-changed ;
-: <action> ( model quot -- action-signal ) [ 1array action <multi-model> ] dip >>quot dup f <action-value> >>value value>> ;
+: <action> ( model quot -- action-model ) [ 1array action <multi-model> ] dip >>quot dup f <action-value> >>value value>> ;
TUPLE: collection < multi-model ;
: <collection> ( models -- product ) collection <multi-model> ;
@@ -93,13 +93,13 @@ M: collection (model-changed)
M: collection model-activated dup (model-changed) ;
! for side effects
-TUPLE: (frp-when) < multi-model quot cond ;
-: frp-when ( model quot cond -- model ) rot 1array (frp-when) <multi-model> swap >>cond swap >>quot ;
-M: (frp-when) (model-changed) [ quot>> ] 2keep
+TUPLE: (when-model) < multi-model quot cond ;
+: when-model ( model quot cond -- model ) rot 1array (when-model) <multi-model> swap >>cond swap >>quot ;
+M: (when-model) (model-changed) [ quot>> ] 2keep
[ value>> ] [ cond>> ] bi* call( a -- ? ) [ call( model -- ) ] [ 2drop ] if ;
! only used in construction
: with-self ( quot: ( model -- model ) -- model ) [ f <basic> dup ] dip call swap [ add-dependency ] keep ; inline
-USE: ui.frp.signals.templates
+USE: models.combinators.templates
<< { "$>" "<$" "fmap" } [ fmaps ] each >>
\ No newline at end of file
diff --git a/extra/models/combinators/summary.txt b/extra/models/combinators/summary.txt
new file mode 100644
index 0000000000..1e5347e3fd
--- /dev/null
+++ b/extra/models/combinators/summary.txt
@@ -0,0 +1 @@
+Model combination and manipulation
\ No newline at end of file
diff --git a/extra/ui/frp/signals/templates/templates.factor b/extra/models/combinators/templates/templates.factor
similarity index 89%
rename from extra/ui/frp/signals/templates/templates.factor
rename to extra/models/combinators/templates/templates.factor
index bb08e03ea3..685ad93774 100644
--- a/extra/ui/frp/signals/templates/templates.factor
+++ b/extra/models/combinators/templates/templates.factor
@@ -1,6 +1,6 @@
USING: kernel sequences functors fry macros generalizations ;
-IN: ui.frp.signals.templates
-FROM: ui.frp.signals => <collection> #1 ;
+IN: models.combinators.templates
+FROM: models.combinators => <collection> #1 ;
FUNCTOR: fmaps ( W -- )
W IS ${W}
w-n DEFINES ${W}-n
diff --git a/extra/modules/rpc-server/rpc-server.factor b/extra/modules/rpc-server/rpc-server.factor
index ffc2e404db..cb7e652a39 100644
--- a/extra/modules/rpc-server/rpc-server.factor
+++ b/extra/modules/rpc-server/rpc-server.factor
@@ -25,12 +25,11 @@ SYMBOL: serving-vocabs serving-vocabs [ V{ } clone ] initialize
: register-loads-thread ( -- )
[ [ receive vocab ] keep reply-synchronous t ] "load-words" spawn-server "loads-thread" swap register-process ;
-: add-vocabs-hook ( -- )
- [ 9012 start-node
- register-gets-thread
- register-does-thread
- register-loads-thread
- ] "start-serving-vocabs" add-init-hook ;
PRIVATE>
-SYNTAX: service add-vocabs-hook
- current-vocab name>> serving-vocabs get-global adjoin ;
+SYNTAX: service current-vocab name>> serving-vocabs get-global adjoin ;
+
+[ 9012 start-node
+ register-gets-thread
+ register-does-thread
+ register-loads-thread
+] "start-serving-vocabs" add-init-hook
\ No newline at end of file
diff --git a/extra/recipes/recipes.factor b/extra/recipes/recipes.factor
index 528663d370..a99e65cf5c 100644
--- a/extra/recipes/recipes.factor
+++ b/extra/recipes/recipes.factor
@@ -1,14 +1,14 @@
USING: accessors arrays colors.constants combinators db.queries
-db.info db.tuples db.types kernel locals math
-monads persistency sequences sequences.extras ui ui.frp.gadgets
-ui.frp.layout ui.frp.signals ui.gadgets.labels
-ui.gadgets.scrollers ui.pens.solid ;
+db.sqlite db.tuples db.types kernel locals math
+monads persistency sequences sequences.extras ui ui.gadgets.controls
+ui.gadgets.layout models.combinators ui.gadgets.labels
+ui.gadgets.scrollers ui.pens.solid io.files.temp ;
FROM: sets => prune ;
IN: recipes
STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } { genre { VARCHAR 100 } } ;
: <recipe> ( title genre text -- recipe ) recipe new swap >>txt swap >>genre swap >>title 0 >>votes ;
-get-psql-info recipe define-db
+"recipes.db" temp-file <sqlite-db> recipe define-db
: top-recipes ( offset search -- recipes ) <query> T{ recipe } rot >>title >>tuple
"votes" >>order 30 >>limit swap >>offset get-tuples ;
: top-genres ( -- genres ) f f top-recipes [ genre>> ] map prune 4 (head-slice) ;
@@ -25,37 +25,37 @@ get-psql-info recipe define-db
$ BODY $
$ BUTTON $
] <vbox> ,
- ] <frp-book*> { 350 245 } >>pref-dim ;
+ ] <book*> { 350 245 } >>pref-dim ;
:: recipe-browser ( -- ) [ [
interface
- <frp-table*> :> tbl
- "okay" <frp-border-button> BUTTON -> :> ok
- IMG-FRP-BTN: submit [ store-tuple ] >>value TOOLBAR -> :> submit
- IMG-FRP-BTN: love 1 >>value TOOLBAR ->
- IMG-FRP-BTN: hate -1 >>value -> 2array <merge> :> votes
- IMG-FRP-BTN: back -> [ -30 ] <$
- IMG-FRP-BTN: more -> [ 30 ] <$ 2array <merge> :> viewed
- <spacer> <frp-field*> ->% 1 :> search
- submit ok [ [ drop ] ] <$ 2array <merge> [ drop ] >>value :> quot
- viewed 0 [ + ] <fold> search ok t <basic> "all" <frp-button> ALL ->
+ <table*> :> tbl
+ "okay" <model-border-btn> BUTTON -> :> ok
+ IMG-MODEL-BTN: submit [ store-tuple ] >>value TOOLBAR -> :> submit
+ IMG-MODEL-BTN: love 1 >>value TOOLBAR ->
+ IMG-MODEL-BTN: hate -1 >>value -> 2array merge :> votes
+ IMG-MODEL-BTN: back -> [ -30 ] <$
+ IMG-MODEL-BTN: more -> [ 30 ] <$ 2array merge :> viewed
+ <spacer> <model-field*> ->% 1 :> search
+ submit ok [ [ drop ] ] <$ 2array merge [ drop ] >>value :> quot
+ viewed 0 [ + ] fold search ok t <basic> "all" <model-btn> ALL ->
tbl selected-value>> votes [ [ + ] curry change-votes modify-tuple ] 2$>
- 4array <merge>
- [ drop [ f ] [ "%" dup surround <pattern> ] if-empty top-recipes ] 3fmap :> updates
- updates [ top-genres [ <frp-button> GENRES -> ] map <merge> ] bind*
+ 4array merge
+ [ drop [ f ] [ "%" dup surround <pattern> ] if-empty top-recipes ] 3fmap :> ups
+ ups [ top-genres [ <model-btn> GENRES -> ] map merge ] bind*
[ text>> T{ recipe } swap >>genre get-tuples ] fmap
- tbl swap updates 2array <merge> >>model
+ tbl swap ups 2merge >>model
[ [ title>> ] [ genre>> ] bi 2array ] >>quot
{ "Title" "Genre" } >>column-titles dup <scroller> RECIPES ,% 1 actions>>
- submit [ "" dup dup <recipe> ] <$ 2array <merge>
- { [ [ title>> ] fmap <frp-field> TITLE ->% .5 ]
- [ [ genre>> ] fmap <frp-field> GENRE ->% .5 ]
- [ [ txt>> ] fmap <frp-editor> BODY ->% 1 ]
+ submit [ "" dup dup <recipe> ] <$ 2array merge
+ { [ [ title>> ] fmap <model-field> TITLE ->% .5 ]
+ [ [ genre>> ] fmap <model-field> GENRE ->% .5 ]
+ [ [ txt>> ] fmap <model-editor> BODY ->% 1 ]
} cleave
[ <recipe> ] 3fmap
[ [ 1 ] <$ ]
- [ quot ok <updates> #1 [ call( recipe -- ) 0 ] 2fmap ] bi
- 2array <merge> 0 <basic> <switch> >>model
+ [ quot ok updates #1 [ call( recipe -- ) 0 ] 2fmap ] bi
+ 2merge 0 <basic> switch-models >>model
] with-interface "recipes" open-window ] with-ui ;
MAIN: recipe-browser
\ No newline at end of file
diff --git a/extra/sudokus/sudokus.factor b/extra/sudokus/sudokus.factor
index efc127f2a5..9de9a6fe7c 100644
--- a/extra/sudokus/sudokus.factor
+++ b/extra/sudokus/sudokus.factor
@@ -1,8 +1,8 @@
USING: accessors arrays combinators.short-circuit grouping kernel lists
lists.lazy locals math math.functions math.parser math.ranges
-models.product monads random sequences sets ui ui.frp.gadgets
-ui.frp.layout ui.frp.signals ui.gadgets.alerts vectors fry
-ui.gadgets.labels memoize ;
+models.product monads random sequences sets ui ui.gadgets.controls
+ui.gadgets.layout models.combinators ui.gadgets.alerts vectors fry
+ui.gadgets.labels ;
IN: sudokus
: row ( index -- row ) 1 + 9 / ceiling ;
@@ -11,28 +11,28 @@ IN: sudokus
: near ( a pos -- ? ) { [ [ row ] bi@ = ] [ [ col ] bi@ = ] [ [ sq ] bi@ = ] } 2|| ;
: nth-or-lower ( n seq -- elt ) [ length 1 - 2dup > [ nip ] [ drop ] if ] keep nth ;
-MEMO:: solutions ( puzzle random? -- solutions )
+:: solutions ( puzzle random? -- solutions )
f puzzle random? [ indices [ f ] [ random? swap nth-or-lower ] if-empty ] [ index ] if
[ :> pos
1 9 [a,b] 80 iota [ pos near ] filter [ puzzle nth ] map prune diff
[ 1array puzzle pos cut-slice rest surround ] map >list [ random? solutions ] bind
] [ puzzle list-monad return ] if* ;
-: solution ( puzzle random? -- solution ) dupd solutions dup +nil+ = [ drop "Unsolvable" alert* ] [ nip car ] if \ solutions reset-memoized ;
+: solution ( puzzle random? -- solution ) dupd solutions dup +nil+ = [ drop "Unsolvable" alert* ] [ nip car ] if ;
: hint ( puzzle -- puzzle' ) [ [ f swap indices random dup ] [ f solution ] bi nth ] keep swapd >vector [ set-nth ] keep ;
: create ( difficulty -- puzzle ) 81 [ f ] replicate
40 random solution [ [ dup length random f spin set-nth ] curry times ] keep ;
: do-sudoku ( -- ) [ [
[
- 81 [ "" ] replicate <basic> <switch> [ [ <basic> ] map 9 group [ 3 group ] map 3 group
- [ [ [ <spacer> [ [ <frp-field> ->% 2 [ string>number ] fmap ]
+ 81 [ "" ] replicate <basic> switch-models [ [ <basic> ] map 9 group [ 3 group ] map 3 group
+ [ [ [ <spacer> [ [ <model-field> ->% 2 [ string>number ] fmap ]
map <spacer> ] map concat ] <hbox> , ] map concat <spacer> ] map concat <product>
- [ "Difficulty:" <label> , "1" <basic> <frp-field> -> [ string>number 1 or 1 + 10 * ] fmap
- "Generate" <frp-border-button> -> <updates> [ create ] fmap <spacer>
- "Hint" <frp-border-button> -> "Solve" <frp-border-button> -> ] <hbox> ,
- roll [ swap <updates> ] curry bi@
- [ [ hint ] fmap ] [ [ f solution ] fmap ] bi* 3array <merge> [ [ [ number>string ] [ "" ] if* ] map ] fmap
+ [ "Difficulty:" <label> , "1" <basic> <model-field> -> [ string>number 1 or 1 + 10 * ] fmap
+ "Generate" <model-border-btn> -> updates [ create ] fmap <spacer>
+ "Hint" <model-border-btn> -> "Solve" <model-border-btn> -> ] <hbox> ,
+ roll [ swap updates ] curry bi@
+ [ [ hint ] fmap ] [ [ f solution ] fmap ] bi* 3array merge [ [ [ number>string ] [ "" ] if* ] map ] fmap
] bind
] with-self , ] <vbox> { 280 220 } >>pref-dim
"Sudoku Sleuth" open-window ] with-ui ;
diff --git a/extra/ui/frp/gadgets/gadgets.factor b/extra/ui/frp/gadgets/gadgets.factor
deleted file mode 100644
index c3bdb757dc..0000000000
--- a/extra/ui/frp/gadgets/gadgets.factor
+++ /dev/null
@@ -1,83 +0,0 @@
-USING: accessors assocs arrays kernel models monads sequences
-ui.frp.signals ui.gadgets ui.gadgets.borders ui.gadgets.buttons
-ui.gadgets.buttons.private ui.gadgets.editors words images.loader
-ui.gadgets.scrollers ui.gadgets.tables ui.images vocabs.parser lexer
-models.range ui.gadgets.sliders ;
-IN: ui.frp.gadgets
-
-TUPLE: frp-button < button hook value ;
-: <frp-button> ( gadget -- button ) [
- [ dup hook>> [ call( button -- ) ] [ drop ] if* ]
- [ [ [ value>> ] [ ] bi or ] keep set-control-value ]
- [ model>> f swap (>>value) ] tri
- ] frp-button new-button f <basic> >>model ;
-: <frp-border-button> ( text -- button ) <frp-button> border-button-theme ;
-
-TUPLE: frp-table < table { quot initial: [ ] } { val-quot initial: [ ] } color-quot column-titles column-alignment actions ;
-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* ;
-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* ;
-
-: new-frp-table ( model class -- table ) f swap new-table dup >>renderer
- V{ } clone <basic> >>selected-values V{ } clone <basic> >>selected-indices*
- f <basic> >>actions dup [ actions>> set-model ] curry >>action ;
-: <frp-table> ( model -- table ) frp-table new-frp-table ;
-: <frp-table*> ( -- table ) V{ } clone <model> <frp-table> ;
-: <frp-list> ( column-model -- table ) <frp-table> [ 1array ] >>quot ;
-: <frp-list*> ( -- table ) V{ } clone <model> <frp-list> ;
-: indexed ( table -- table ) f >>val-quot ;
-
-TUPLE: frp-field < field frp-model ;
-: init-field ( field -- field' ) [ [ ] [ "" ] if* ] change-value ;
-: <frp-field> ( model -- gadget ) frp-field new-field swap init-field >>frp-model ;
-M: frp-field graft*
- [ [ frp-model>> value>> ] [ editor>> ] bi set-editor-string ]
- [ dup editor>> model>> add-connection ]
- [ dup frp-model>> add-connection ] tri ;
-M: frp-field ungraft*
- [ dup editor>> model>> remove-connection ]
- [ dup frp-model>> remove-connection ] bi ;
-M: frp-field model-changed 2dup frp-model>> =
- [ [ value>> ] [ editor>> ] bi* set-editor-string ]
- [ nip [ editor>> editor-string ] [ frp-model>> ] bi set-model ] if ;
-
-: <frp-field*> ( -- field ) "" <model> <frp-field> ;
-: <empty-field> ( model -- field ) "" <model> <switch> <frp-field> ;
-: <frp-editor> ( model -- gadget )
- frp-field [ <multiline-editor> ] dip new-border dup gadget-child >>editor
- field-theme swap init-field >>frp-model { 1 0 } >>align ;
-: <frp-editor*> ( -- editor ) "" <model> <frp-editor> ;
-: <empty-editor> ( model -- editor ) "" <model> <switch> <frp-editor> ;
-
-: <frp-action-field> ( -- field ) f <action-field> dup [ set-control-value ] curry >>quot
- f <model> >>model ;
-
-: <frp-slider> ( init page min max step -- slider ) <range> horizontal <slider> ;
-
-: image-prep ( -- image ) scan current-vocab name>> "vocab:" "/icons/" surround ".tiff" surround <image-name> dup cached-image drop ;
-SYNTAX: IMG-FRP-BTN: image-prep [ <frp-button> ] curry over push-all ;
-
-SYNTAX: IMG-BTN: image-prep [ swap <button> ] curry over push-all ;
-
-GENERIC: output-model ( gadget -- model )
-M: gadget output-model model>> ;
-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: frp-field output-model frp-model>> ;
-M: scroller output-model viewport>> children>> first output-model ;
-M: slider output-model model>> range-model ;
-
-IN: accessors
-M: frp-button text>> children>> first text>> ;
-
-IN: ui.frp.gadgets
-
-SINGLETON: gadget-monad
-INSTANCE: gadget-monad monad
-INSTANCE: gadget monad
-M: gadget monad-of drop gadget-monad ;
-M: gadget-monad return drop <gadget> swap >>model ;
-M: gadget >>= output-model [ swap call( x -- y ) ] curry ;
\ No newline at end of file
diff --git a/extra/ui/frp/gadgets/summary.txt b/extra/ui/frp/gadgets/summary.txt
deleted file mode 100644
index b792b817db..0000000000
--- a/extra/ui/frp/gadgets/summary.txt
+++ /dev/null
@@ -1 +0,0 @@
-Gadgets using signals as their models
\ No newline at end of file
diff --git a/extra/ui/frp/signals/signals-docs.factor b/extra/ui/frp/signals/signals-docs.factor
deleted file mode 100644
index 397c1e2044..0000000000
--- a/extra/ui/frp/signals/signals-docs.factor
+++ /dev/null
@@ -1,49 +0,0 @@
-USING: help.markup help.syntax models models.arrow sequences ui.frp.signals monads ;
-IN: ui.frp.signals
-
-HELP: <merge>
-{ $values { "models" "a list of models" } { "signal" basic-model } }
-{ $description "Creates a signal that merges the updates of others" } ;
-
-HELP: <filter>
-{ $values { "model" model } { "quot" "quotation with stack effect ( a b -- c )" } { "filter-signal" filter-model } }
-{ $description "Creates a signal that uses the updates of another model only when they satisfy a given predicate" } ;
-
-HELP: <fold>
-{ $values { "oldval" "starting value" } { "quot" "applied to update and previous values" } { "model" model } { "signal" model } }
-{ $description "Similar to " { $link reduce } " but works on models, applying a quotation to the previous and new values at each update" } ;
-
-HELP: <switch>
-{ $values { "signal1" model } { "signal2" model } { "signal'" model } }
-{ $description "Creates a signal that starts with the behavior of signal2 and switches to the behavior of signal1 on its update" } ;
-
-HELP: <mapped>
-{ $values { "model" model } { "quot" "applied to model's value on updates" } { "signal" model } }
-{ $description "The signal version of an " { $link <arrow> } } ;
-
-HELP: $>
-{ $values { "model" model } { "quot" "applied to model's value on updates" } { "signal" model } }
-{ $description "Like " { $link <mapped> } ", but doesn't produce a new value" } ;
-
-HELP: <$
-{ $values { "model" model } { "quot" "applied to model's value on updates" } { "signal" model } }
-{ $description "Opposite of " { $link <$ } "- gives output, but takes no input" } ;
-
-HELP: frp-when
-{ $values { "model" model } { "quot" "called on the model if the quot yields true" } { "cond" "a quotation called on the model's value, yielding a boolean value" } }
-{ $description "Calls quot when model updates if its value meets the condition set in cond" } ;
-
-HELP: with-self
-{ $values { "quot" "quotation that recieves its own return value" } { "model" model } }
-{ $description "Fixed points for signals: the quot reacts to the same signal to gives" } ;
-
-HELP: #1
-{ $values { "model" model } { "model'" model } }
-{ $description "Moves a signal to the top of its dependencies' connections, thus being notified before the others" } ;
-
-ARTICLE: "signals" "FRP Signals"
-"Unlike models, which always have a value, signals have discrete start and end times. "
-"They are the core of the frp library: program flow using frp is controlled entirely through manipulating and combining signals. "
-"The output signals of some gadgets (see " { $vocab-link "ui.frp.gadgets" } " ) can be manipulated and used as the input signals of others. " ;
-
-ABOUT: "signals"
\ No newline at end of file
diff --git a/extra/ui/frp/signals/summary.txt b/extra/ui/frp/signals/summary.txt
deleted file mode 100644
index 3b49d34fa8..0000000000
--- a/extra/ui/frp/signals/summary.txt
+++ /dev/null
@@ -1 +0,0 @@
-Utilities for functional reactive programming in user interfaces
diff --git a/extra/ui/gadgets/alerts/alerts.factor b/extra/ui/gadgets/alerts/alerts.factor
index dc81aff15e..254e282139 100644
--- a/extra/ui/gadgets/alerts/alerts.factor
+++ b/extra/ui/gadgets/alerts/alerts.factor
@@ -1,5 +1,5 @@
USING: accessors models monads macros generalizations kernel
-ui ui.frp.gadgets ui.frp.signals ui.frp.layout ui.gadgets
+ui ui.gadgets.controls models.combinators ui.gadgets.layout ui.gadgets
ui.gadgets.labels ui.gadgets.editors ui.gadgets.buttons
ui.gadgets.packs locals sequences fonts io.styles
wrap.strings ;
@@ -13,16 +13,16 @@ IN: ui.gadgets.alerts
:: ask-user ( string -- model' )
[ [let | lbl [ string <label> T{ font { name "sans-serif" } { size 14 } } >>font dup , ]
- fldm [ <frp-field*> ->% 1 ]
- btn [ "okay" <frp-border-button> ] |
- btn -> [ fldm swap <updates> ]
+ fldm [ <model-field*> ->% 1 ]
+ btn [ "okay" <model-border-btn> ] |
+ btn -> [ fldm swap updates ]
[ [ drop lbl close-window ] $> , ] bi
] ] <vbox> { 161 86 } >>pref-dim "" open-window ;
MACRO: ask-buttons ( buttons -- quot ) dup length [
[ swap
[ 22 wrap-lines <label> T{ font { name "sans-serif" } { size 18 } } >>font ,
- [ [ <frp-border-button> [ close-window ] >>hook -> ] map ] <hbox> , ] <vbox>
+ [ [ <model-border-btn> [ close-window ] >>hook -> ] map ] <hbox> , ] <vbox>
"" open-window
] dip firstn
] 2curry ;
\ No newline at end of file
diff --git a/extra/ui/gadgets/comboboxes/comboboxes.factor b/extra/ui/gadgets/comboboxes/comboboxes.factor
index eddd105e24..3eb118050e 100644
--- a/extra/ui/gadgets/comboboxes/comboboxes.factor
+++ b/extra/ui/gadgets/comboboxes/comboboxes.factor
@@ -1,14 +1,15 @@
USING: accessors arrays kernel math.rectangles sequences
-ui.frp.gadgets ui.frp.signals ui.gadgets ui.gadgets.glass
-ui.gadgets.labels ui.gadgets.tables ui.gestures ;
+ui.gadgets.controls models.combinators ui.gadgets ui.gadgets.glass
+ui.gadgets.labels ui.gestures ;
+QUALIFIED-WITH: ui.gadgets.tables tbl
IN: ui.gadgets.comboboxes
-TUPLE: combo-table < frp-table spawner ;
+TUPLE: combo-table < table spawner ;
M: combo-table handle-gesture [ call-next-method drop ] 2keep swap
T{ button-up } = [
[ spawner>> ]
- [ selected-row [ swap set-control-value ] [ 2drop ] if ]
+ [ tbl:selected-row [ swap set-control-value ] [ 2drop ] if ]
[ hide-glass ] tri
] [ drop ] if t ;
@@ -18,4 +19,4 @@ combobox H{
} set-gestures
: <combobox> ( options -- combobox ) [ first [ combobox new-label ] keep <basic> >>model ] keep
- <basic> combo-table new-frp-table [ 1array ] >>quot >>table ;
\ No newline at end of file
+ <basic> combo-table new-table [ 1array ] >>quot >>table ;
\ No newline at end of file
diff --git a/extra/ui/frp/layout/authors.txt b/extra/ui/gadgets/controls/authors.txt
similarity index 100%
rename from extra/ui/frp/layout/authors.txt
rename to extra/ui/gadgets/controls/authors.txt
diff --git a/extra/ui/frp/gadgets/gadgets-docs.factor b/extra/ui/gadgets/controls/controls-docs.factor
similarity index 64%
rename from extra/ui/frp/gadgets/gadgets-docs.factor
rename to extra/ui/gadgets/controls/controls-docs.factor
index ee0c764e60..1df6005656 100644
--- a/extra/ui/frp/gadgets/gadgets-docs.factor
+++ b/extra/ui/gadgets/controls/controls-docs.factor
@@ -1,40 +1,40 @@
USING: accessors help.markup help.syntax ui.gadgets.buttons
-ui.gadgets.editors ui.frp.gadgets models ui.gadgets ;
-IN: ui.frp.gadgets
+ui.gadgets.editors models ui.gadgets ;
+IN: ui.gadgets.controls
-HELP: <frp-button>
+HELP: <model-btn>
{ $values { "gadget" "the button's label" } { "button" button } }
{ $description "Creates an button whose signal updates on clicks. " } ;
-HELP: <frp-border-button>
+HELP: <model-border-btn>
{ $values { "text" "the button's label" } { "button" button } }
{ $description "Creates an button whose signal updates on clicks. " } ;
-HELP: <frp-table>
-{ $values { "model" "values the table is to display" } { "table" frp-table } }
-{ $description "Creates an " { $link frp-table } } ;
+HELP: <table>
+{ $values { "model" "values the table is to display" } { "table" table } }
+{ $description "Creates an " { $link table } } ;
-HELP: <frp-table*>
-{ $values { "table" frp-table } }
-{ $description "Creates an " { $link frp-table } " with no initial values to display" } ;
+HELP: <table*>
+{ $values { "table" table } }
+{ $description "Creates an " { $link table } " with no initial values to display" } ;
-HELP: <frp-list>
-{ $values { "column-model" "values the table is to display" } { "table" frp-table } }
-{ $description "Creates an " { $link frp-table } " with a val-quot that renders each element as its own row" } ;
+HELP: <list>
+{ $values { "column-model" "values the table is to display" } { "table" table } }
+{ $description "Creates an " { $link table } " with a val-quot that renders each element as its own row" } ;
-HELP: <frp-list*>
-{ $values { "table" frp-table } }
-{ $description "Creates an frp-list with no initial values to display" } ;
+HELP: <list*>
+{ $values { "table" table } }
+{ $description "Creates an model-list with no initial values to display" } ;
HELP: indexed
-{ $values { "table" frp-table } }
-{ $description "Sets the output model of an frp-table to the selected-index, rather than the selected-value" } ;
+{ $values { "table" table } }
+{ $description "Sets the output model of an table to the selected-index, rather than the selected-value" } ;
-HELP: <frp-field>
+HELP: <model-field>
{ $values { "model" model } { "gadget" model-field } }
{ $description "Creates a field with an initial value" } ;
-HELP: <frp-field*>
+HELP: <model-field*>
{ $values { "field" model-field } }
{ $description "Creates a field with an empty initial value" } ;
@@ -42,11 +42,11 @@ HELP: <empty-field>
{ $values { "model" model } { "field" model-field } }
{ $description "Creates a field with an empty initial value that switches to another signal on its update" } ;
-HELP: <frp-editor>
+HELP: <model-editor>
{ $values { "model" model } { "gadget" model-field } }
{ $description "Creates an editor with an initial value" } ;
-HELP: <frp-editor*>
+HELP: <model-editor*>
{ $values { "editor" "an editor" } }
{ $description "Creates a editor with an empty initial value" } ;
@@ -54,16 +54,16 @@ HELP: <empty-editor>
{ $values { "model" model } { "editor" "an editor" } }
{ $description "Creates a field with an empty initial value that switches to another signal on its update" } ;
-HELP: <frp-action-field>
+HELP: <model-action-field>
{ $values { "field" action-field } }
{ $description "Field that updates its model with its contents when the user hits the return key" } ;
-HELP: IMG-FRP-BTN:
-{ $syntax "IMAGE-BUTTON: filename" }
+HELP: IMG-MODEL-BTN:
+{ $syntax "IMAGE-MODEL-BTN: filename" }
{ $description "Creates a button using a tiff image named as specified found in the icons subdirectory of the vocabulary path" } ;
HELP: IMG-BTN:
-{ $syntax "[ do-something ] IMAGE-BUTTON: filename" }
+{ $syntax "[ do-something ] IMAGE-BTN: filename" }
{ $description "Creates a button using a tiff image named as specified found in the icons subdirectory of the vocabulary path, calling the specified quotation on click" } ;
HELP: output-model
diff --git a/extra/ui/gadgets/controls/controls.factor b/extra/ui/gadgets/controls/controls.factor
new file mode 100644
index 0000000000..a90d8ecc98
--- /dev/null
+++ b/extra/ui/gadgets/controls/controls.factor
@@ -0,0 +1,87 @@
+USING: accessors assocs arrays kernel models monads sequences
+models.combinators ui.gadgets ui.gadgets.borders ui.gadgets.buttons
+ui.gadgets.buttons.private ui.gadgets.editors words images.loader
+ui.gadgets.scrollers ui.images vocabs.parser lexer
+models.range ui.gadgets.sliders ;
+QUALIFIED-WITH: ui.gadgets.sliders slider
+QUALIFIED-WITH: ui.gadgets.tables tbl
+EXCLUDE: ui.gadgets.editors => model-field ;
+IN: ui.gadgets.controls
+
+TUPLE: model-btn < button hook value ;
+: <model-btn> ( gadget -- button ) [
+ [ dup hook>> [ call( button -- ) ] [ drop ] if* ]
+ [ [ [ value>> ] [ ] bi or ] keep set-control-value ]
+ [ model>> f swap (>>value) ] tri
+ ] model-btn new-button f <basic> >>model ;
+: <model-border-btn> ( text -- button ) <model-btn> border-button-theme ;
+
+TUPLE: table < tbl:table { quot initial: [ ] } { val-quot initial: [ ] } color-quot column-titles column-alignment actions ;
+M: table tbl:column-titles column-titles>> ;
+M: table tbl:column-alignment column-alignment>> ;
+M: table tbl:row-columns quot>> [ call( a -- b ) ] [ drop f ] if* ;
+M: table tbl:row-value val-quot>> [ call( a -- b ) ] [ drop f ] if* ;
+M: table tbl:row-color color-quot>> [ call( a -- b ) ] [ drop f ] if* ;
+
+: new-table ( model class -- table ) f swap tbl:new-table dup >>renderer
+ V{ } clone <basic> >>selected-values V{ } clone <basic> >>selected-indices*
+ f <basic> >>actions dup [ actions>> set-model ] curry >>action ;
+: <table> ( model -- table ) table new-table ;
+: <table*> ( -- table ) V{ } clone <model> <table> ;
+: <list> ( column-model -- table ) <table> [ 1array ] >>quot ;
+: <list*> ( -- table ) V{ } clone <model> <list> ;
+: indexed ( table -- table ) f >>val-quot ;
+
+TUPLE: model-field < field model* ;
+: init-field ( field -- field' ) [ [ ] [ "" ] if* ] change-value ;
+: <model-field> ( model -- gadget ) model-field new-field swap init-field >>model* ;
+M: model-field graft*
+ [ [ model*>> value>> ] [ editor>> ] bi set-editor-string ]
+ [ dup editor>> model>> add-connection ]
+ [ dup model*>> add-connection ] tri ;
+M: model-field ungraft*
+ [ dup editor>> model>> remove-connection ]
+ [ dup model*>> remove-connection ] bi ;
+M: model-field model-changed 2dup model*>> =
+ [ [ value>> ] [ editor>> ] bi* set-editor-string ]
+ [ nip [ editor>> editor-string ] [ model*>> ] bi set-model ] if ;
+
+: <model-field*> ( -- field ) "" <model> <model-field> ;
+: <empty-field> ( model -- field ) "" <model> switch-models <model-field> ;
+: (model-editor) ( model class -- gadget )
+ model-field [ new-editor ] dip new-border dup gadget-child >>editor
+ field-theme swap init-field >>model* { 1 0 } >>align ;
+: <model-editor> ( model -- gadget ) multiline-editor (model-editor) ;
+: <model-editor*> ( -- editor ) "" <model> <model-editor> ;
+: <empty-editor> ( model -- editor ) "" <model> switch-models <model-editor> ;
+
+: <model-action-field> ( -- field ) f <action-field> dup [ set-control-value ] curry >>quot
+ f <model> >>model ;
+
+: <slider> ( init page min max step -- slider ) <range> horizontal slider:<slider> ;
+
+: image-prep ( -- image ) scan current-vocab name>> "vocab:" "/icons/" surround ".tiff" surround <image-name> dup cached-image drop ;
+SYNTAX: IMG-MODEL-BTN: image-prep [ <model-btn> ] curry over push-all ;
+
+SYNTAX: IMG-BTN: image-prep [ swap <button> ] curry over push-all ;
+
+GENERIC: output-model ( gadget -- model )
+M: gadget output-model model>> ;
+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 model*>> ;
+M: scroller output-model viewport>> children>> first output-model ;
+M: slider output-model model>> range-model ;
+
+IN: accessors
+M: model-btn text>> children>> first text>> ;
+
+IN: ui.gadgets.controls
+
+SINGLETON: gadget-monad
+INSTANCE: gadget-monad monad
+INSTANCE: gadget monad
+M: gadget monad-of drop gadget-monad ;
+M: gadget-monad return drop <gadget> swap >>model ;
+M: gadget >>= output-model [ swap call( x -- y ) ] curry ;
\ No newline at end of file
diff --git a/extra/ui/gadgets/controls/summary.txt b/extra/ui/gadgets/controls/summary.txt
new file mode 100644
index 0000000000..eeef94d7be
--- /dev/null
+++ b/extra/ui/gadgets/controls/summary.txt
@@ -0,0 +1 @@
+Gadgets with expanded model usage
\ No newline at end of file
diff --git a/extra/ui/frp/signals/authors.txt b/extra/ui/gadgets/layout/authors.txt
similarity index 100%
rename from extra/ui/frp/signals/authors.txt
rename to extra/ui/gadgets/layout/authors.txt
diff --git a/extra/ui/frp/layout/layout-docs.factor b/extra/ui/gadgets/layout/layout-docs.factor
similarity index 84%
rename from extra/ui/frp/layout/layout-docs.factor
rename to extra/ui/gadgets/layout/layout-docs.factor
index 2f475deb4d..cd8f62b6ad 100644
--- a/extra/ui/frp/layout/layout-docs.factor
+++ b/extra/ui/gadgets/layout/layout-docs.factor
@@ -1,5 +1,5 @@
-USING: help.markup help.syntax models ui.gadgets.tracks ui.frp.layout ;
-IN: ui.frp.layout
+USING: help.markup help.syntax models ui.gadgets.tracks ;
+IN: ui.gadgets.layout
HELP: ,
{ $values { "item" "a gadget or model" } }
@@ -38,16 +38,16 @@ HELP: with-interface
{ $values { "quot" "quotation that builds a template and inserts into it" } }
{ $description "Create templates, used with " { $link POSTPONE: $ } } ;
-ARTICLE: "ui.frp.layout" "GUI Layout"
+ARTICLE: "ui.gadgets.layout" "GUI Layout"
"Laying out GUIs works the same way as building lists with " { $vocab-link "make" }
". Gadgets are layed out using " { $vocab-link "ui.gadgets.tracks" } " through " { $link <hbox> } " and " { $link <vbox> } ", which allow both fixed and percentage widths. "
-{ $link , } " and " { $link -> } " add a signal or gadget to the gadget you're building. "
-"Also, books can be made with " { $link <frp-book> } ". "
+{ $link , } " and " { $link -> } " add a model or gadget to the gadget you're building. "
+"Also, books can be made with " { $link <book> } ". "
{ $link <spacer> } "s add flexable space between items. " $nl
"Using " { $link with-interface } ", one can pre-build templates to add items to later: "
"Like in the StringTemplate framework for java, placeholders are defined using $ PLACERHOLDER-NAME $ "
"Using PLACEHOLDER-NAME again sets it as the current insertion point. "
"For examples using normal layout, see the " { $vocab-link "sudokus" } " demo. "
-"For examples of templating, see " { $vocab-link "recipes" } " demo. " ;
+"For examples of templating, see the " { $vocab-link "recipes" } " demo. " ;
-ABOUT: "ui.frp.layout"
\ No newline at end of file
+ABOUT: "ui.gadgets.layout"
\ No newline at end of file
diff --git a/extra/ui/frp/layout/layout.factor b/extra/ui/gadgets/layout/layout.factor
similarity index 74%
rename from extra/ui/frp/layout/layout.factor
rename to extra/ui/gadgets/layout/layout.factor
index 47916e5393..f155b292e1 100644
--- a/extra/ui/frp/layout/layout.factor
+++ b/extra/ui/gadgets/layout/layout.factor
@@ -1,9 +1,10 @@
USING: accessors assocs arrays fry kernel lexer make math.parser
models monads namespaces parser sequences
-sequences.extras ui.frp.gadgets ui.frp.signals ui.gadgets
-ui.gadgets.books ui.gadgets.tracks words ;
+sequences.extras models.combinators ui.gadgets
+ui.gadgets.tracks words ui.gadgets.controls ;
QUALIFIED: make
-IN: ui.frp.layout
+QUALIFIED-WITH: ui.gadgets.books book
+IN: ui.gadgets.layout
SYMBOL: templates
TUPLE: layout gadget size ; C: <layout> layout
@@ -47,9 +48,9 @@ M: model -> dup , ;
: <hbox> ( gadgets -- track ) horizontal <box> ; inline
: <vbox> ( gadgets -- track ) vertical <box> ; inline
-: make-book ( models gadgets model -- book ) <book> swap [ "No models in books" throw ] unless-empty ;
-: <frp-book> ( quot: ( -- model ) -- book ) f make-layout rot 0 >>value make-book ; inline
-: <frp-book*> ( quot -- book ) f make-layout f make-book ; inline
+: make-book ( models gadgets model -- book ) book:<book> swap [ "No models in books" throw ] unless-empty ;
+: <book> ( quot: ( -- model ) -- book ) f make-layout rot 0 >>value make-book ; inline
+: <book*> ( quot -- book ) f make-layout f make-book ; inline
ERROR: not-in-template word ;
SYNTAX: $ CREATE-WORD dup
@@ -58,16 +59,17 @@ SYNTAX: $ CREATE-WORD dup
: insert-gadget ( number parent gadget -- ) -rot [ but-last insert-nth ] change-children drop ;
: insert-size ( number parent size -- ) -rot [ but-last insert-nth ] change-sizes drop ;
-: insertion-point ( gadget placeholder -- number parent gadget ) dup parent>> [ children>> index ] keep rot ;
+: insertion-point ( placeholder -- number parent ) dup parent>> [ children>> index ] keep ;
-GENERIC# (insert-item) 1 ( item location -- )
-M: gadget (insert-item) dup parent>> track? [ [ f <layout> ] dip (insert-item) ]
- [ insertion-point [ add-gadget ] keep insert-gadget ] if ;
-M: layout (insert-item) insertion-point [ add-layout ] keep [ gadget>> insert-gadget ] [ size>> insert-size ] 3bi ;
-M: model (insert-item) parent>> dup book? [ "No models in books" throw ]
+GENERIC# add-gadget-at 1 ( item location -- )
+M: gadget add-gadget-at dup parent>> track? [ [ f <layout> ] dip add-gadget-at ]
+ [ insertion-point rot [ add-gadget ] keep insert-gadget ] if ;
+M: layout add-gadget-at insertion-point rot [ add-layout ] keep [ gadget>> insert-gadget ] [ size>> insert-size ] 3bi ;
+M: model add-gadget-at parent>> dup book:book? [ "No models in books" throw ]
[ dup model>> dup collection? [ nip swap add-connection ] [ drop [ 1array <collection> ] dip (>>model) ] if ] if ;
+: track-add-at ( item location size -- ) swap [ <layout> ] dip add-gadget-at ;
: insert-item ( item location -- ) [ dup get [ drop ] [ remove-members ] if ] [ on ] [ ] tri
- [ add-member ] 2keep (insert-item) ;
+ [ add-member ] 2keep add-gadget-at ;
: insert-items ( makelist -- ) t swap [ dup placeholder? [ nip ] [ over insert-item ] if ] each drop ;
diff --git a/extra/ui/frp/layout/summary.txt b/extra/ui/gadgets/layout/summary.txt
similarity index 100%
rename from extra/ui/frp/layout/summary.txt
rename to extra/ui/gadgets/layout/summary.txt
From a2110549623b322e60764e01b7040ac039ead688 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Mon, 3 Aug 2009 10:12:20 -0500
Subject: [PATCH 113/128] textmate bundle work- stopped by modules bug
---
basis/editors/textmate/textmate.factor | 3 +-
extra/modules/rpc-server/rpc-server.factor | 2 +-
extra/modules/using/using-docs.factor | 1 -
extra/modules/using/using.factor | 1 -
.../Cycle Vocabs:Docs:Tests.tmCommand | 32 +++
.../Commands/Edit Word Docs.tmCommand | 32 +++
misc/Factor.tmbundle/Commands/Edit.tmCommand | 32 +++
.../Commands/Expand Selection.tmCommand | 29 +++
misc/Factor.tmbundle/Commands/Fix.tmCommand | 32 +++
.../Commands/Help for Word.tmCommand | 2 +-
...on.tmCommand => Infer Selection.tmCommand} | 6 +-
.../Commands/Insert Inferrence.tmCommand | 27 ++
.../Commands/Profile.tmCommand | 32 +++
.../Factor.tmbundle/Commands/Reload.tmCommand | 26 ++
misc/Factor.tmbundle/Commands/Reset.tmCommand | 32 +++
.../Commands/Scaffold.tmCommand | 32 +++
.../Commands/See Word.tmCommand | 2 +-
.../Commands/Set Breakpoint.tmCommand | 32 +++
.../Commands/Show Using.tmCommand | 27 ++
misc/Factor.tmbundle/Commands/Usage.tmCommand | 30 +++
.../Commands/Vocab Usage.tmCommand | 29 +++
.../Commands/Vocab Uses.tmCommand | 29 +++
.../Commands/Walk Selection.tmCommand | 31 +++
misc/Factor.tmbundle/Commands/Watch.tmCommand | 32 +++
.../Macros/Extract as New Word.tmMacro | 239 ++++++++++++++++++
.../Support/lib/do_scaffold.rb | 16 ++
misc/Factor.tmbundle/Support/lib/tm_factor.rb | 4 +
misc/Factor.tmbundle/info.plist | 22 ++
28 files changed, 806 insertions(+), 8 deletions(-)
create mode 100644 misc/Factor.tmbundle/Commands/Cycle Vocabs:Docs:Tests.tmCommand
create mode 100644 misc/Factor.tmbundle/Commands/Edit Word Docs.tmCommand
create mode 100644 misc/Factor.tmbundle/Commands/Edit.tmCommand
create mode 100644 misc/Factor.tmbundle/Commands/Expand Selection.tmCommand
create mode 100644 misc/Factor.tmbundle/Commands/Fix.tmCommand
rename misc/Factor.tmbundle/Commands/{Infer Effect of Selection.tmCommand => Infer Selection.tmCommand} (76%)
create mode 100644 misc/Factor.tmbundle/Commands/Insert Inferrence.tmCommand
create mode 100644 misc/Factor.tmbundle/Commands/Profile.tmCommand
create mode 100644 misc/Factor.tmbundle/Commands/Reload.tmCommand
create mode 100644 misc/Factor.tmbundle/Commands/Reset.tmCommand
create mode 100644 misc/Factor.tmbundle/Commands/Scaffold.tmCommand
create mode 100644 misc/Factor.tmbundle/Commands/Set Breakpoint.tmCommand
create mode 100644 misc/Factor.tmbundle/Commands/Show Using.tmCommand
create mode 100644 misc/Factor.tmbundle/Commands/Usage.tmCommand
create mode 100644 misc/Factor.tmbundle/Commands/Vocab Usage.tmCommand
create mode 100644 misc/Factor.tmbundle/Commands/Vocab Uses.tmCommand
create mode 100644 misc/Factor.tmbundle/Commands/Walk Selection.tmCommand
create mode 100644 misc/Factor.tmbundle/Commands/Watch.tmCommand
create mode 100644 misc/Factor.tmbundle/Macros/Extract as New Word.tmMacro
create mode 100644 misc/Factor.tmbundle/Support/lib/do_scaffold.rb
diff --git a/basis/editors/textmate/textmate.factor b/basis/editors/textmate/textmate.factor
index 65395bd590..72af2ba030 100644
--- a/basis/editors/textmate/textmate.factor
+++ b/basis/editors/textmate/textmate.factor
@@ -1,5 +1,5 @@
USING: definitions io.launcher kernel math math.parser parser
-namespaces prettyprint editors make ;
+namespaces prettyprint editors make vocabs.loader ;
IN: editors.textmate
: textmate ( file line -- )
@@ -7,3 +7,4 @@ IN: editors.textmate
run-detached drop ;
[ textmate ] edit-hook set-global
+"get-using" require
diff --git a/extra/modules/rpc-server/rpc-server.factor b/extra/modules/rpc-server/rpc-server.factor
index cb7e652a39..7ac50ab61f 100644
--- a/extra/modules/rpc-server/rpc-server.factor
+++ b/extra/modules/rpc-server/rpc-server.factor
@@ -32,4 +32,4 @@ SYNTAX: service current-vocab name>> serving-vocabs get-global adjoin ;
register-gets-thread
register-does-thread
register-loads-thread
-] "start-serving-vocabs" add-init-hook
\ No newline at end of file
+] "modules.rpc-server" add-init-hook
\ No newline at end of file
diff --git a/extra/modules/using/using-docs.factor b/extra/modules/using/using-docs.factor
index cfc0687944..f3c25f9201 100644
--- a/extra/modules/using/using-docs.factor
+++ b/extra/modules/using/using-docs.factor
@@ -6,7 +6,6 @@ ARTICLE: { "modules.using" "use" } "Using the modules.using vocab"
"Finally, the word can treat words in remote vocabularies as remote procedure calls. Any inputs are passed to the imported words as normal, and the result will appear on the stack- the only difference is that the word isn't called locally." ;
ABOUT: { "modules.using" "use" }
-IN: syntax
HELP: USING*:
{ $syntax "USING: rpc-server::module fetch-sever:module { module qualified-name } { module => word ... } { qualified-module } { module EXCEPT word ... } { module word => importname } ;" }
{ $description "Adds vocabularies to the search path. Vocabularies can be loaded off a server or called as an rpc if preceded by a valid hostname. Bracketed pairs facilitate all types of qualified imports on both remote and local modules." }
diff --git a/extra/modules/using/using.factor b/extra/modules/using/using.factor
index 5a13f58587..5691caaf6a 100644
--- a/extra/modules/using/using.factor
+++ b/extra/modules/using/using.factor
@@ -12,7 +12,6 @@ remote = tokenpart s tokenpart => [[ first2 remote-load ]]
module = rpc | remote | tokenpart
;EBNF
-IN: syntax
ON-BNF: USING*:
tokenizer = <foreign factor>
sym = !(";"|"}"|"=>"|"EXCEPT").
diff --git a/misc/Factor.tmbundle/Commands/Cycle Vocabs:Docs:Tests.tmCommand b/misc/Factor.tmbundle/Commands/Cycle Vocabs:Docs:Tests.tmCommand
new file mode 100644
index 0000000000..8c4ec6365d
--- /dev/null
+++ b/misc/Factor.tmbundle/Commands/Cycle Vocabs:Docs:Tests.tmCommand
@@ -0,0 +1,32 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>beforeRunningCommand</key>
+ <string>nop</string>
+ <key>bundleUUID</key>
+ <string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
+ <key>command</key>
+ <string>#! /Applications/factor/factor
+
+"TM_FILEPATH" os-env [ parent-directory ] [ file-name dup ] bi {
+{ [ dup "docs.factor" tail? ] [ drop 11 tail* "tests.factor" append append ] }
+{ [ "-tests.factor" tail? ] [ 13 tail* ".factor" append append ] }
+[ 7 tail* [ "-docs.factor" append append ] keep over exists? [ drop ] [ scaffold-help ] if ]
+} cond 0 textmate</string>
+ <key>fallbackInput</key>
+ <string>word</string>
+ <key>input</key>
+ <string>none</string>
+ <key>keyEquivalent</key>
+ <string>^@ </string>
+ <key>name</key>
+ <string>Cycle Vocabs/Docs/Tests</string>
+ <key>output</key>
+ <string>discard</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>uuid</key>
+ <string>D348BE40-6F51-4471-B300-DDDA70ED8C8C</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Commands/Edit Word Docs.tmCommand b/misc/Factor.tmbundle/Commands/Edit Word Docs.tmCommand
new file mode 100644
index 0000000000..bc447eee7a
--- /dev/null
+++ b/misc/Factor.tmbundle/Commands/Edit Word Docs.tmCommand
@@ -0,0 +1,32 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>beforeRunningCommand</key>
+ <string>nop</string>
+ <key>bundleUUID</key>
+ <string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
+ <key>command</key>
+ <string>#!/usr/bin/env ruby
+
+require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
+
+doc = STDIN.read
+word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
+puts factor_eval(%Q(#{doc_using_statements(doc)} USING: help.topics editors ;\n \\ #{word} >link edit))</string>
+ <key>fallbackInput</key>
+ <string>word</string>
+ <key>input</key>
+ <string>document</string>
+ <key>keyEquivalent</key>
+ <string>@D</string>
+ <key>name</key>
+ <string>Edit Word Docs</string>
+ <key>output</key>
+ <string>discard</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>uuid</key>
+ <string>D95A617C-E1C6-44DA-9126-04171CB21299</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Commands/Edit.tmCommand b/misc/Factor.tmbundle/Commands/Edit.tmCommand
new file mode 100644
index 0000000000..4f077c448f
--- /dev/null
+++ b/misc/Factor.tmbundle/Commands/Edit.tmCommand
@@ -0,0 +1,32 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>beforeRunningCommand</key>
+ <string>nop</string>
+ <key>bundleUUID</key>
+ <string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
+ <key>command</key>
+ <string>#!/usr/bin/env ruby
+
+require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
+
+doc = STDIN.read
+word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
+puts factor_eval(%Q(#{doc_using_statements(doc)} USE: editors\n \\ #{word} edit))</string>
+ <key>fallbackInput</key>
+ <string>word</string>
+ <key>input</key>
+ <string>document</string>
+ <key>keyEquivalent</key>
+ <string>@E</string>
+ <key>name</key>
+ <string>Edit</string>
+ <key>output</key>
+ <string>discard</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>uuid</key>
+ <string>C573487C-DD7D-497F-A728-52D7962D95E2</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Commands/Expand Selection.tmCommand b/misc/Factor.tmbundle/Commands/Expand Selection.tmCommand
new file mode 100644
index 0000000000..d2b69dc469
--- /dev/null
+++ b/misc/Factor.tmbundle/Commands/Expand Selection.tmCommand
@@ -0,0 +1,29 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>beforeRunningCommand</key>
+ <string>nop</string>
+ <key>bundleUUID</key>
+ <string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
+ <key>command</key>
+ <string>#!/usr/bin/env ruby
+
+require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
+
+doc = STDIN.read
+puts factor_eval(%Q(#{doc_using_statements(doc)} USE: ui.tools.operations\n [ #{ENV["TM_SELECTED_TEXT"} ] com-expand-macros))</string>
+ <key>fallbackInput</key>
+ <string>word</string>
+ <key>input</key>
+ <string>document</string>
+ <key>name</key>
+ <string>Expand Selection</string>
+ <key>output</key>
+ <string>showAsTooltip</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>uuid</key>
+ <string>8465B33D-7CA0-4337-945C-4078346D64BC</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Commands/Fix.tmCommand b/misc/Factor.tmbundle/Commands/Fix.tmCommand
new file mode 100644
index 0000000000..a49f8a49ae
--- /dev/null
+++ b/misc/Factor.tmbundle/Commands/Fix.tmCommand
@@ -0,0 +1,32 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>beforeRunningCommand</key>
+ <string>nop</string>
+ <key>bundleUUID</key>
+ <string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
+ <key>command</key>
+ <string>#!/usr/bin/env ruby
+
+require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
+
+doc = STDIN.read
+word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
+puts factor_run(%Q(#{doc_using_statements(doc)} USE: editors\n \\ #{word} fix))</string>
+ <key>fallbackInput</key>
+ <string>word</string>
+ <key>input</key>
+ <string>document</string>
+ <key>keyEquivalent</key>
+ <string>@F</string>
+ <key>name</key>
+ <string>Fix</string>
+ <key>output</key>
+ <string>discard</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>uuid</key>
+ <string>D02D9D74-E073-48AE-A78E-B40FFFA519D5</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Commands/Help for Word.tmCommand b/misc/Factor.tmbundle/Commands/Help for Word.tmCommand
index 0ff133c891..350c01d344 100644
--- a/misc/Factor.tmbundle/Commands/Help for Word.tmCommand
+++ b/misc/Factor.tmbundle/Commands/Help for Word.tmCommand
@@ -11,7 +11,7 @@ require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
doc = STDIN.read
word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
-factor_run(%Q(#{doc_using_statements(doc)} USE: ui.tools.workspace\n \\ #{word} help-window))</string>
+factor_run(%Q(#{doc_using_statements(doc)} USE: help\n \\ #{word} help))</string>
<key>fallbackInput</key>
<string>word</string>
<key>input</key>
diff --git a/misc/Factor.tmbundle/Commands/Infer Effect of Selection.tmCommand b/misc/Factor.tmbundle/Commands/Infer Selection.tmCommand
similarity index 76%
rename from misc/Factor.tmbundle/Commands/Infer Effect of Selection.tmCommand
rename to misc/Factor.tmbundle/Commands/Infer Selection.tmCommand
index 378294e6c1..c7b6ec8c86 100644
--- a/misc/Factor.tmbundle/Commands/Infer Effect of Selection.tmCommand
+++ b/misc/Factor.tmbundle/Commands/Infer Selection.tmCommand
@@ -10,13 +10,15 @@
require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
doc = STDIN.read
-puts factor_eval(%Q(#{doc_using_statements(doc)} USE: inference\n [ #{ENV["TM_SELECTED_TEXT"]} ] infer.))</string>
+puts factor_eval(%Q(#{doc_using_statements(doc)} USE: stack-checker\n [ #{ENV["TM_SELECTED_TEXT"]} ] infer.))</string>
<key>fallbackInput</key>
<string>word</string>
<key>input</key>
<string>document</string>
+ <key>keyEquivalent</key>
+ <string>^i</string>
<key>name</key>
- <string>Infer Effect of Selection</string>
+ <string>Infer Selection</string>
<key>output</key>
<string>showAsTooltip</string>
<key>scope</key>
diff --git a/misc/Factor.tmbundle/Commands/Insert Inferrence.tmCommand b/misc/Factor.tmbundle/Commands/Insert Inferrence.tmCommand
new file mode 100644
index 0000000000..366cdfc2eb
--- /dev/null
+++ b/misc/Factor.tmbundle/Commands/Insert Inferrence.tmCommand
@@ -0,0 +1,27 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>beforeRunningCommand</key>
+ <string>nop</string>
+ <key>command</key>
+ <string>#!/usr/bin/env ruby
+
+require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
+
+doc = STDIN.read
+puts factor_eval(%Q(#{doc_using_statements(doc)} USE: stack-checker\n [ #{ENV["TM_SELECTED_TEXT"]} ] infer.))</string>
+ <key>fallbackInput</key>
+ <string>word</string>
+ <key>input</key>
+ <string>document</string>
+ <key>name</key>
+ <string>Insert Inferrence</string>
+ <key>output</key>
+ <string>afterSelectedText</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>uuid</key>
+ <string>DBC0A0CA-5368-43A7-864B-7B9C4034AD08</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Commands/Profile.tmCommand b/misc/Factor.tmbundle/Commands/Profile.tmCommand
new file mode 100644
index 0000000000..108ad7b842
--- /dev/null
+++ b/misc/Factor.tmbundle/Commands/Profile.tmCommand
@@ -0,0 +1,32 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>beforeRunningCommand</key>
+ <string>nop</string>
+ <key>bundleUUID</key>
+ <string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
+ <key>command</key>
+ <string>#!/usr/bin/env ruby
+
+require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
+
+doc = STDIN.read
+word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
+puts factor_run(%Q(#{doc_using_statements(doc)} USE: tools.profiler\n [ #{word} ] profile))</string>
+ <key>fallbackInput</key>
+ <string>word</string>
+ <key>input</key>
+ <string>document</string>
+ <key>keyEquivalent</key>
+ <string>^p</string>
+ <key>name</key>
+ <string>Profile</string>
+ <key>output</key>
+ <string>discard</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>uuid</key>
+ <string>7FF52332-CA5B-4D46-99EF-DAE0659DB478</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Commands/Reload.tmCommand b/misc/Factor.tmbundle/Commands/Reload.tmCommand
new file mode 100644
index 0000000000..1dcd350ecd
--- /dev/null
+++ b/misc/Factor.tmbundle/Commands/Reload.tmCommand
@@ -0,0 +1,26 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>beforeRunningCommand</key>
+ <string>nop</string>
+ <key>command</key>
+ <string>#!/usr/bin/env ruby
+
+require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
+doc = STDIN.read
+factor_run(%Q(USE: vocabs.loader\n "#{doc[/\bIN:\s(\S+)/, 1]}" reload))</string>
+ <key>input</key>
+ <string>document</string>
+ <key>keyEquivalent</key>
+ <string>^r</string>
+ <key>name</key>
+ <string>Reload</string>
+ <key>output</key>
+ <string>discard</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>uuid</key>
+ <string>8088D204-FFD7-4384-8FDD-A01536FFD0E7</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Commands/Reset.tmCommand b/misc/Factor.tmbundle/Commands/Reset.tmCommand
new file mode 100644
index 0000000000..ae15b9ddd6
--- /dev/null
+++ b/misc/Factor.tmbundle/Commands/Reset.tmCommand
@@ -0,0 +1,32 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>beforeRunningCommand</key>
+ <string>nop</string>
+ <key>bundleUUID</key>
+ <string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
+ <key>command</key>
+ <string>#!/usr/bin/env ruby
+
+require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
+
+doc = STDIN.read
+word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
+puts factor_eval(%Q(#{doc_using_statements(doc)} USE: tools.annotations\n \\ #{word} reset))</string>
+ <key>fallbackInput</key>
+ <string>word</string>
+ <key>input</key>
+ <string>document</string>
+ <key>keyEquivalent</key>
+ <string>^~r</string>
+ <key>name</key>
+ <string>Reset</string>
+ <key>output</key>
+ <string>discard</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>uuid</key>
+ <string>71F08D9B-3D24-4E78-84C9-82CA736554D1</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Commands/Scaffold.tmCommand b/misc/Factor.tmbundle/Commands/Scaffold.tmCommand
new file mode 100644
index 0000000000..fe195725d7
--- /dev/null
+++ b/misc/Factor.tmbundle/Commands/Scaffold.tmCommand
@@ -0,0 +1,32 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>beforeRunningCommand</key>
+ <string>nop</string>
+ <key>bundleUUID</key>
+ <string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
+ <key>command</key>
+ <string>res=$(CocoaDialog inputbox --title "Scaffold Setup" \
+ --informative-text "Vocab Name:" \
+ --button1 "Okay" --button2 "Cancel")
+
+[[ $(head -n1 <<<"$res") == "2" ]] && exit_discard
+res=$(tail -n1 <<<"$res")
+"$TM_BUNDLE_SUPPORT/lib/do_scaffolding.rb" res</string>
+ <key>fallbackInput</key>
+ <string>word</string>
+ <key>input</key>
+ <string>none</string>
+ <key>keyEquivalent</key>
+ <string>@N</string>
+ <key>name</key>
+ <string>Scaffold</string>
+ <key>output</key>
+ <string>discard</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>uuid</key>
+ <string>0CDA009F-8518-4C45-AB0E-D11B281131BF</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Commands/See Word.tmCommand b/misc/Factor.tmbundle/Commands/See Word.tmCommand
index 4502e235be..ca1cf42320 100644
--- a/misc/Factor.tmbundle/Commands/See Word.tmCommand
+++ b/misc/Factor.tmbundle/Commands/See Word.tmCommand
@@ -11,7 +11,7 @@ require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
doc = STDIN.read
word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
-puts factor_eval(%Q(#{doc_using_statements(doc)} USE: prettyprint\n \\ #{word} see))</string>
+puts factor_eval(%Q(#{doc_using_statements(doc)} USE: see\n \\ #{word} see))</string>
<key>fallbackInput</key>
<string>word</string>
<key>input</key>
diff --git a/misc/Factor.tmbundle/Commands/Set Breakpoint.tmCommand b/misc/Factor.tmbundle/Commands/Set Breakpoint.tmCommand
new file mode 100644
index 0000000000..1066c78eea
--- /dev/null
+++ b/misc/Factor.tmbundle/Commands/Set Breakpoint.tmCommand
@@ -0,0 +1,32 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>beforeRunningCommand</key>
+ <string>nop</string>
+ <key>bundleUUID</key>
+ <string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
+ <key>command</key>
+ <string>#!/usr/bin/env ruby
+
+require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
+
+doc = STDIN.read
+word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
+puts factor_eval(%Q(#{doc_using_statements(doc)} USE: tools.annotations\n \\ #{word} breakpoint))</string>
+ <key>fallbackInput</key>
+ <string>word</string>
+ <key>input</key>
+ <string>document</string>
+ <key>keyEquivalent</key>
+ <string>^b</string>
+ <key>name</key>
+ <string>Set Breakpoint</string>
+ <key>output</key>
+ <string>discard</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>uuid</key>
+ <string>E4614756-DF2E-433A-8935-197159C67AB8</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Commands/Show Using.tmCommand b/misc/Factor.tmbundle/Commands/Show Using.tmCommand
new file mode 100644
index 0000000000..22681bd76e
--- /dev/null
+++ b/misc/Factor.tmbundle/Commands/Show Using.tmCommand
@@ -0,0 +1,27 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>beforeRunningCommand</key>
+ <string>nop</string>
+ <key>command</key>
+ <string>#! /Applications/factor/factor
+USE: modules.using
+USING*: environment localhost::get-using io ;
+"TM_FILEPATH" os-env get-using write</string>
+ <key>fallbackInput</key>
+ <string>word</string>
+ <key>input</key>
+ <string>none</string>
+ <key>keyEquivalent</key>
+ <string>^u</string>
+ <key>name</key>
+ <string>Show Using</string>
+ <key>output</key>
+ <string>showAsTooltip</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>uuid</key>
+ <string>86DD4385-4029-4EFE-B546-1EC8EB5EB932</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Commands/Usage.tmCommand b/misc/Factor.tmbundle/Commands/Usage.tmCommand
new file mode 100644
index 0000000000..459a7fea66
--- /dev/null
+++ b/misc/Factor.tmbundle/Commands/Usage.tmCommand
@@ -0,0 +1,30 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>beforeRunningCommand</key>
+ <string>nop</string>
+ <key>bundleUUID</key>
+ <string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
+ <key>command</key>
+ <string>#!/usr/bin/env ruby
+
+require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
+
+doc = STDIN.read
+word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
+puts factor_eval(%Q(#{doc_using_statements(doc)} USE: tools.crossref\n \\ #{word} usage.))</string>
+ <key>fallbackInput</key>
+ <string>word</string>
+ <key>input</key>
+ <string>document</string>
+ <key>name</key>
+ <string>Usage</string>
+ <key>output</key>
+ <string>showAsTooltip</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>uuid</key>
+ <string>3043A033-A113-4283-BCBB-3DE2CCC8F63E</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Commands/Vocab Usage.tmCommand b/misc/Factor.tmbundle/Commands/Vocab Usage.tmCommand
new file mode 100644
index 0000000000..70687d96a2
--- /dev/null
+++ b/misc/Factor.tmbundle/Commands/Vocab Usage.tmCommand
@@ -0,0 +1,29 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>beforeRunningCommand</key>
+ <string>nop</string>
+ <key>bundleUUID</key>
+ <string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
+ <key>command</key>
+ <string>#!/usr/bin/env ruby
+
+require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
+
+word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
+puts factor_eval(%Q(USE: tools.crossref\n "#{word}" vocab-usage.))</string>
+ <key>fallbackInput</key>
+ <string>word</string>
+ <key>input</key>
+ <string>none</string>
+ <key>name</key>
+ <string>Vocab Usage</string>
+ <key>output</key>
+ <string>showAsTooltip</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>uuid</key>
+ <string>B1F81321-B760-474F-875D-78FB52752E1B</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Commands/Vocab Uses.tmCommand b/misc/Factor.tmbundle/Commands/Vocab Uses.tmCommand
new file mode 100644
index 0000000000..e8acb98eb1
--- /dev/null
+++ b/misc/Factor.tmbundle/Commands/Vocab Uses.tmCommand
@@ -0,0 +1,29 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>beforeRunningCommand</key>
+ <string>nop</string>
+ <key>bundleUUID</key>
+ <string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
+ <key>command</key>
+ <string>#!/usr/bin/env ruby
+
+require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
+
+word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
+puts factor_eval(%Q(USE: tools.crossref\n "#{word}" vocab-uses.))</string>
+ <key>fallbackInput</key>
+ <string>word</string>
+ <key>input</key>
+ <string>none</string>
+ <key>name</key>
+ <string>Vocab Uses</string>
+ <key>output</key>
+ <string>showAsTooltip</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>uuid</key>
+ <string>BC3E2E39-3B79-460C-B05E-BD00BAACB90E</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Commands/Walk Selection.tmCommand b/misc/Factor.tmbundle/Commands/Walk Selection.tmCommand
new file mode 100644
index 0000000000..641e6db2c6
--- /dev/null
+++ b/misc/Factor.tmbundle/Commands/Walk Selection.tmCommand
@@ -0,0 +1,31 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>beforeRunningCommand</key>
+ <string>nop</string>
+ <key>bundleUUID</key>
+ <string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
+ <key>command</key>
+ <string>#!/usr/bin/env ruby
+
+require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
+
+doc = STDIN.read
+puts factor_run(%Q(#{doc_using_statements(doc)} USE: tools.walker\n [ #{ENV["TM_SELECTED_TEXT"]} ] walk))</string>
+ <key>fallbackInput</key>
+ <string>word</string>
+ <key>input</key>
+ <string>document</string>
+ <key>keyEquivalent</key>
+ <string>^w</string>
+ <key>name</key>
+ <string>Walk Selection</string>
+ <key>output</key>
+ <string>discard</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>uuid</key>
+ <string>57C2BAAC-0474-404F-AA91-DFD02EC2A3ED</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Commands/Watch.tmCommand b/misc/Factor.tmbundle/Commands/Watch.tmCommand
new file mode 100644
index 0000000000..e2c95017d9
--- /dev/null
+++ b/misc/Factor.tmbundle/Commands/Watch.tmCommand
@@ -0,0 +1,32 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>beforeRunningCommand</key>
+ <string>nop</string>
+ <key>bundleUUID</key>
+ <string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
+ <key>command</key>
+ <string>#!/usr/bin/env ruby
+
+require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
+
+doc = STDIN.read
+word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
+puts factor_eval(%Q(#{doc_using_statements(doc)} USE: tools.annotations\n \\ #{word} watch))</string>
+ <key>fallbackInput</key>
+ <string>word</string>
+ <key>input</key>
+ <string>document</string>
+ <key>keyEquivalent</key>
+ <string>^~w</string>
+ <key>name</key>
+ <string>Watch</string>
+ <key>output</key>
+ <string>discard</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>uuid</key>
+ <string>1C86869F-1030-4F74-B242-6357A080E127</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Macros/Extract as New Word.tmMacro b/misc/Factor.tmbundle/Macros/Extract as New Word.tmMacro
new file mode 100644
index 0000000000..537a5aca8a
--- /dev/null
+++ b/misc/Factor.tmbundle/Macros/Extract as New Word.tmMacro
@@ -0,0 +1,239 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>commands</key>
+ <array>
+ <dict>
+ <key>command</key>
+ <string>cut:</string>
+ </dict>
+ <dict>
+ <key>argument</key>
+ <string>m</string>
+ <key>command</key>
+ <string>insertText:</string>
+ </dict>
+ <dict>
+ <key>argument</key>
+ <string>y</string>
+ <key>command</key>
+ <string>insertText:</string>
+ </dict>
+ <dict>
+ <key>argument</key>
+ <string>-</string>
+ <key>command</key>
+ <string>insertText:</string>
+ </dict>
+ <dict>
+ <key>argument</key>
+ <string>w</string>
+ <key>command</key>
+ <string>insertText:</string>
+ </dict>
+ <dict>
+ <key>argument</key>
+ <string>o</string>
+ <key>command</key>
+ <string>insertText:</string>
+ </dict>
+ <dict>
+ <key>argument</key>
+ <string>r</string>
+ <key>command</key>
+ <string>insertText:</string>
+ </dict>
+ <dict>
+ <key>argument</key>
+ <string>d</string>
+ <key>command</key>
+ <string>insertText:</string>
+ </dict>
+ <dict>
+ <key>argument</key>
+ <dict>
+ <key>action</key>
+ <string>findPrevious</string>
+ <key>findInProjectIgnoreCase</key>
+ <true/>
+ <key>findString</key>
+ <string>: </string>
+ <key>ignoreCase</key>
+ <true/>
+ <key>replaceAllScope</key>
+ <string>document</string>
+ <key>replaceString</key>
+ <string>table</string>
+ <key>wrapAround</key>
+ <true/>
+ </dict>
+ <key>command</key>
+ <string>findWithOptions:</string>
+ </dict>
+ <dict>
+ <key>command</key>
+ <string>moveToBeginningOfLine:</string>
+ </dict>
+ <dict>
+ <key>command</key>
+ <string>paste:</string>
+ </dict>
+ <dict>
+ <key>command</key>
+ <string>moveToBeginningOfLineAndModifySelection:</string>
+ </dict>
+ <dict>
+ <key>argument</key>
+ <dict>
+ <key>beforeRunningCommand</key>
+ <string>nop</string>
+ <key>command</key>
+ <string>#!/usr/bin/env ruby
+
+require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
+
+doc = STDIN.read
+puts factor_eval(%Q(#{doc_using_statements(doc)} USE: stack-checker\n [ #{ENV["TM_SELECTED_TEXT"]} ] infer.))</string>
+ <key>fallbackInput</key>
+ <string>word</string>
+ <key>input</key>
+ <string>document</string>
+ <key>name</key>
+ <string>Insert Inferrence</string>
+ <key>output</key>
+ <string>afterSelectedText</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>uuid</key>
+ <string>DBC0A0CA-5368-43A7-864B-7B9C4034AD08</string>
+ </dict>
+ <key>command</key>
+ <string>executeCommandWithOptions:</string>
+ </dict>
+ <dict>
+ <key>command</key>
+ <string>insertNewline:</string>
+ </dict>
+ <dict>
+ <key>argument</key>
+ <dict>
+ <key>action</key>
+ <string>findPrevious</string>
+ <key>findInProjectIgnoreCase</key>
+ <true/>
+ <key>findString</key>
+ <string>(</string>
+ <key>ignoreCase</key>
+ <true/>
+ <key>replaceAllScope</key>
+ <string>document</string>
+ <key>replaceString</key>
+ <string>table</string>
+ <key>wrapAround</key>
+ <true/>
+ </dict>
+ <key>command</key>
+ <string>findWithOptions:</string>
+ </dict>
+ <dict>
+ <key>command</key>
+ <string>moveToEndOfLineAndModifySelection:</string>
+ </dict>
+ <dict>
+ <key>command</key>
+ <string>cut:</string>
+ </dict>
+ <dict>
+ <key>argument</key>
+ <string> </string>
+ <key>command</key>
+ <string>insertText:</string>
+ </dict>
+ <dict>
+ <key>argument</key>
+ <string>;</string>
+ <key>command</key>
+ <string>insertText:</string>
+ </dict>
+ <dict>
+ <key>command</key>
+ <string>moveToBeginningOfLine:</string>
+ </dict>
+ <dict>
+ <key>argument</key>
+ <string>:</string>
+ <key>command</key>
+ <string>insertText:</string>
+ </dict>
+ <dict>
+ <key>argument</key>
+ <string> </string>
+ <key>command</key>
+ <string>insertText:</string>
+ </dict>
+ <dict>
+ <key>argument</key>
+ <string>m</string>
+ <key>command</key>
+ <string>insertText:</string>
+ </dict>
+ <dict>
+ <key>argument</key>
+ <string>y</string>
+ <key>command</key>
+ <string>insertText:</string>
+ </dict>
+ <dict>
+ <key>argument</key>
+ <string>-</string>
+ <key>command</key>
+ <string>insertText:</string>
+ </dict>
+ <dict>
+ <key>argument</key>
+ <string>w</string>
+ <key>command</key>
+ <string>insertText:</string>
+ </dict>
+ <dict>
+ <key>argument</key>
+ <string>o</string>
+ <key>command</key>
+ <string>insertText:</string>
+ </dict>
+ <dict>
+ <key>argument</key>
+ <string>r</string>
+ <key>command</key>
+ <string>insertText:</string>
+ </dict>
+ <dict>
+ <key>argument</key>
+ <string>d</string>
+ <key>command</key>
+ <string>insertText:</string>
+ </dict>
+ <dict>
+ <key>argument</key>
+ <string> </string>
+ <key>command</key>
+ <string>insertText:</string>
+ </dict>
+ <dict>
+ <key>command</key>
+ <string>paste:</string>
+ </dict>
+ <dict>
+ <key>argument</key>
+ <string> </string>
+ <key>command</key>
+ <string>insertText:</string>
+ </dict>
+ </array>
+ <key>name</key>
+ <string>Extract as New Word</string>
+ <key>uuid</key>
+ <string>82E740D1-8D20-48AF-8470-C85C251D4870</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Support/lib/do_scaffold.rb b/misc/Factor.tmbundle/Support/lib/do_scaffold.rb
new file mode 100644
index 0000000000..a0cc2bf033
--- /dev/null
+++ b/misc/Factor.tmbundle/Support/lib/do_scaffold.rb
@@ -0,0 +1,16 @@
+#!/usr/bin/env ruby
+
+require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
+
+path = ENV["TM_FILEPATH"]
+if path.include?("factor/work") then
+ s = "scaffold-work"
+elsif path.include?("factor/basis") then
+ s = "scaffold-basis"
+elsif path.include?("factor/core") then
+ s = "scaffold-core"
+else
+ s = "scaffold-extra"
+end
+
+puts factor_eval(%Q(USE: tools.scaffold\n "#{ARGV.first}" #{s}))
\ No newline at end of file
diff --git a/misc/Factor.tmbundle/Support/lib/tm_factor.rb b/misc/Factor.tmbundle/Support/lib/tm_factor.rb
index 2775a12ae9..48f318651a 100644
--- a/misc/Factor.tmbundle/Support/lib/tm_factor.rb
+++ b/misc/Factor.tmbundle/Support/lib/tm_factor.rb
@@ -32,6 +32,10 @@ def doc_using_statements(document)
document.scan(/\b(USING:\s[^;]*\s;|USE:\s+\S+|IN:\s\S+)/).join("\n") << "\n"
end
+def doc_vocab(document)
+ document.sub(/\bIN:\s(\S+)/, %Q("\\1"))
+end
+
def line_current_word(line, point)
left = line.rindex(/\s/, point - 1) || 0; right = line.index(/\s/, point) || line.length
line[left..right]
diff --git a/misc/Factor.tmbundle/info.plist b/misc/Factor.tmbundle/info.plist
index 1ea756a1a5..19d58def86 100644
--- a/misc/Factor.tmbundle/info.plist
+++ b/misc/Factor.tmbundle/info.plist
@@ -2,18 +2,40 @@
<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
<plist version="1.0">
<dict>
+ <key>deleted</key>
+ <array>
+ <string>4D090AD9-76F9-4A0B-B3F2-7428B7C15FBA</string>
+ </array>
<key>name</key>
<string>Factor</string>
<key>ordering</key>
<array>
+ <string>82E740D1-8D20-48AF-8470-C85C251D4870</string>
<string>3C9C9C2A-314A-475B-A4E4-A68BAAF3F36E</string>
<string>141517D7-73E0-4475-A481-71102575A175</string>
<string>CAD3BB10-C480-4C0E-9518-94D61F7A0C0B</string>
+ <string>8088D204-FFD7-4384-8FDD-A01536FFD0E7</string>
<string>15A984BD-BC65-43E8-878A-267788C8DA70</string>
<string>8E01DDAF-959B-4237-ADB9-C133A4ACCE90</string>
<string>35484754-DBF9-4381-BB25-00CAB64DF4A1</string>
<string>BC5BE120-734B-40DF-8B6B-5D3243614B27</string>
<string>B619FCC0-2DF2-4657-82A8-0E5676A10254</string>
+ <string>DBC0A0CA-5368-43A7-864B-7B9C4034AD08</string>
+ <string>86DD4385-4029-4EFE-B546-1EC8EB5EB932</string>
+ <string>3043A033-A113-4283-BCBB-3DE2CCC8F63E</string>
+ <string>B1F81321-B760-474F-875D-78FB52752E1B</string>
+ <string>BC3E2E39-3B79-460C-B05E-BD00BAACB90E</string>
+ <string>8465B33D-7CA0-4337-945C-4078346D64BC</string>
+ <string>57C2BAAC-0474-404F-AA91-DFD02EC2A3ED</string>
+ <string>E4614756-DF2E-433A-8935-197159C67AB8</string>
+ <string>1C86869F-1030-4F74-B242-6357A080E127</string>
+ <string>D02D9D74-E073-48AE-A78E-B40FFFA519D5</string>
+ <string>C573487C-DD7D-497F-A728-52D7962D95E2</string>
+ <string>D95A617C-E1C6-44DA-9126-04171CB21299</string>
+ <string>71F08D9B-3D24-4E78-84C9-82CA736554D1</string>
+ <string>7FF52332-CA5B-4D46-99EF-DAE0659DB478</string>
+ <string>0CDA009F-8518-4C45-AB0E-D11B281131BF</string>
+ <string>D348BE40-6F51-4471-B300-DDDA70ED8C8C</string>
</array>
<key>uuid</key>
<string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
From dcd6bc316c97e89665d1bca39a027128a34139a8 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Mon, 3 Aug 2009 14:06:00 -0500
Subject: [PATCH 114/128] textmate snippets for factor bundle
---
.../Commands/Create New Vocabulary.tmCommand | 32 +++++
.../Commands/Edit Word.tmCommand | 32 +++++
.../Commands/Fix Word.tmCommand | 32 +++++
.../Commands/Reload in Listener.tmCommand | 26 ++++
.../Commands/Reset Word.tmCommand | 32 +++++
.../Commands/Update Using.tmCommand | 27 +++++
.../Commands/Watch Word.tmCommand | 32 +++++
.../Macros/Extract as New Word.tmMacro | 4 +
.../Preferences/Miscellaneous.tmPreferences | 26 ++++
misc/Factor.tmbundle/Snippets/:.tmSnippet | 16 +++
misc/Factor.tmbundle/Snippets/::.tmSnippet | 16 +++
.../Snippets/[ expanded.tmSnippet | 21 ++++
misc/Factor.tmbundle/Snippets/[.tmSnippet | 18 +++
misc/Factor.tmbundle/Snippets/bi.tmSnippet | 18 +++
.../Factor.tmbundle/Snippets/cleave.tmSnippet | 21 ++++
misc/Factor.tmbundle/Snippets/cond.tmSnippet | 19 +++
.../Snippets/functor.tmSnippet | 21 ++++
misc/Factor.tmbundle/Snippets/if.tmSnippet | 18 +++
misc/Factor.tmbundle/Snippets/let.tmSnippet | 19 +++
.../Factor.tmbundle/Snippets/spread.tmSnippet | 21 ++++
misc/Factor.tmbundle/Snippets/tri.tmSnippet | 19 +++
.../Snippets/{ expanded.tmSnippet | 19 +++
misc/Factor.tmbundle/Snippets/{.tmSnippet | 18 +++
misc/Factor.tmbundle/info.plist | 112 +++++++++++++++++-
24 files changed, 617 insertions(+), 2 deletions(-)
create mode 100644 misc/Factor.tmbundle/Commands/Create New Vocabulary.tmCommand
create mode 100644 misc/Factor.tmbundle/Commands/Edit Word.tmCommand
create mode 100644 misc/Factor.tmbundle/Commands/Fix Word.tmCommand
create mode 100644 misc/Factor.tmbundle/Commands/Reload in Listener.tmCommand
create mode 100644 misc/Factor.tmbundle/Commands/Reset Word.tmCommand
create mode 100644 misc/Factor.tmbundle/Commands/Update Using.tmCommand
create mode 100644 misc/Factor.tmbundle/Commands/Watch Word.tmCommand
create mode 100644 misc/Factor.tmbundle/Preferences/Miscellaneous.tmPreferences
create mode 100644 misc/Factor.tmbundle/Snippets/:.tmSnippet
create mode 100644 misc/Factor.tmbundle/Snippets/::.tmSnippet
create mode 100644 misc/Factor.tmbundle/Snippets/[ expanded.tmSnippet
create mode 100644 misc/Factor.tmbundle/Snippets/[.tmSnippet
create mode 100644 misc/Factor.tmbundle/Snippets/bi.tmSnippet
create mode 100644 misc/Factor.tmbundle/Snippets/cleave.tmSnippet
create mode 100644 misc/Factor.tmbundle/Snippets/cond.tmSnippet
create mode 100644 misc/Factor.tmbundle/Snippets/functor.tmSnippet
create mode 100644 misc/Factor.tmbundle/Snippets/if.tmSnippet
create mode 100644 misc/Factor.tmbundle/Snippets/let.tmSnippet
create mode 100644 misc/Factor.tmbundle/Snippets/spread.tmSnippet
create mode 100644 misc/Factor.tmbundle/Snippets/tri.tmSnippet
create mode 100644 misc/Factor.tmbundle/Snippets/{ expanded.tmSnippet
create mode 100644 misc/Factor.tmbundle/Snippets/{.tmSnippet
diff --git a/misc/Factor.tmbundle/Commands/Create New Vocabulary.tmCommand b/misc/Factor.tmbundle/Commands/Create New Vocabulary.tmCommand
new file mode 100644
index 0000000000..df19e2ea58
--- /dev/null
+++ b/misc/Factor.tmbundle/Commands/Create New Vocabulary.tmCommand
@@ -0,0 +1,32 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>beforeRunningCommand</key>
+ <string>nop</string>
+ <key>bundleUUID</key>
+ <string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
+ <key>command</key>
+ <string>res=$(CocoaDialog inputbox --title "Scaffold Setup" \
+ --informative-text "Vocab Name:" \
+ --button1 "Okay" --button2 "Cancel")
+
+[[ $(head -n1 <<<"$res") == "2" ]] && exit_discard
+res=$(tail -n1 <<<"$res")
+"$TM_BUNDLE_SUPPORT/lib/do_scaffolding.rb" res</string>
+ <key>fallbackInput</key>
+ <string>word</string>
+ <key>input</key>
+ <string>none</string>
+ <key>keyEquivalent</key>
+ <string>@N</string>
+ <key>name</key>
+ <string>Create New Vocabulary</string>
+ <key>output</key>
+ <string>discard</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>uuid</key>
+ <string>0CDA009F-8518-4C45-AB0E-D11B281131BF</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Commands/Edit Word.tmCommand b/misc/Factor.tmbundle/Commands/Edit Word.tmCommand
new file mode 100644
index 0000000000..ab4fa2aab7
--- /dev/null
+++ b/misc/Factor.tmbundle/Commands/Edit Word.tmCommand
@@ -0,0 +1,32 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>beforeRunningCommand</key>
+ <string>nop</string>
+ <key>bundleUUID</key>
+ <string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
+ <key>command</key>
+ <string>#!/usr/bin/env ruby
+
+require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
+
+doc = STDIN.read
+word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
+puts factor_eval(%Q(#{doc_using_statements(doc)} USE: editors\n \\ #{word} edit))</string>
+ <key>fallbackInput</key>
+ <string>word</string>
+ <key>input</key>
+ <string>document</string>
+ <key>keyEquivalent</key>
+ <string>@E</string>
+ <key>name</key>
+ <string>Edit Word</string>
+ <key>output</key>
+ <string>discard</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>uuid</key>
+ <string>C573487C-DD7D-497F-A728-52D7962D95E2</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Commands/Fix Word.tmCommand b/misc/Factor.tmbundle/Commands/Fix Word.tmCommand
new file mode 100644
index 0000000000..25a852c55b
--- /dev/null
+++ b/misc/Factor.tmbundle/Commands/Fix Word.tmCommand
@@ -0,0 +1,32 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>beforeRunningCommand</key>
+ <string>nop</string>
+ <key>bundleUUID</key>
+ <string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
+ <key>command</key>
+ <string>#!/usr/bin/env ruby
+
+require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
+
+doc = STDIN.read
+word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
+puts factor_run(%Q(#{doc_using_statements(doc)} USE: editors\n \\ #{word} fix))</string>
+ <key>fallbackInput</key>
+ <string>word</string>
+ <key>input</key>
+ <string>document</string>
+ <key>keyEquivalent</key>
+ <string>@F</string>
+ <key>name</key>
+ <string>Fix Word</string>
+ <key>output</key>
+ <string>discard</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>uuid</key>
+ <string>D02D9D74-E073-48AE-A78E-B40FFFA519D5</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Commands/Reload in Listener.tmCommand b/misc/Factor.tmbundle/Commands/Reload in Listener.tmCommand
new file mode 100644
index 0000000000..cec58f2930
--- /dev/null
+++ b/misc/Factor.tmbundle/Commands/Reload in Listener.tmCommand
@@ -0,0 +1,26 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>beforeRunningCommand</key>
+ <string>nop</string>
+ <key>command</key>
+ <string>#!/usr/bin/env ruby
+
+require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
+doc = STDIN.read
+factor_run(%Q(USE: vocabs.loader\n "#{doc[/\bIN:\s(\S+)/, 1]}" reload))</string>
+ <key>input</key>
+ <string>document</string>
+ <key>keyEquivalent</key>
+ <string>^r</string>
+ <key>name</key>
+ <string>Reload in Listener</string>
+ <key>output</key>
+ <string>discard</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>uuid</key>
+ <string>8088D204-FFD7-4384-8FDD-A01536FFD0E7</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Commands/Reset Word.tmCommand b/misc/Factor.tmbundle/Commands/Reset Word.tmCommand
new file mode 100644
index 0000000000..0a9808a0cf
--- /dev/null
+++ b/misc/Factor.tmbundle/Commands/Reset Word.tmCommand
@@ -0,0 +1,32 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>beforeRunningCommand</key>
+ <string>nop</string>
+ <key>bundleUUID</key>
+ <string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
+ <key>command</key>
+ <string>#!/usr/bin/env ruby
+
+require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
+
+doc = STDIN.read
+word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
+puts factor_eval(%Q(#{doc_using_statements(doc)} USE: tools.annotations\n \\ #{word} reset))</string>
+ <key>fallbackInput</key>
+ <string>word</string>
+ <key>input</key>
+ <string>document</string>
+ <key>keyEquivalent</key>
+ <string>^~r</string>
+ <key>name</key>
+ <string>Reset Word</string>
+ <key>output</key>
+ <string>discard</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>uuid</key>
+ <string>71F08D9B-3D24-4E78-84C9-82CA736554D1</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Commands/Update Using.tmCommand b/misc/Factor.tmbundle/Commands/Update Using.tmCommand
new file mode 100644
index 0000000000..3fb4d20bbf
--- /dev/null
+++ b/misc/Factor.tmbundle/Commands/Update Using.tmCommand
@@ -0,0 +1,27 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>beforeRunningCommand</key>
+ <string>nop</string>
+ <key>command</key>
+ <string>#! /Applications/factor/factor
+USE: modules.using
+USING*: environment localhost::get-using io ;
+"TM_FILEPATH" os-env get-using write</string>
+ <key>fallbackInput</key>
+ <string>word</string>
+ <key>input</key>
+ <string>none</string>
+ <key>keyEquivalent</key>
+ <string>^u</string>
+ <key>name</key>
+ <string>Update Using</string>
+ <key>output</key>
+ <string>showAsTooltip</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>uuid</key>
+ <string>86DD4385-4029-4EFE-B546-1EC8EB5EB932</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Commands/Watch Word.tmCommand b/misc/Factor.tmbundle/Commands/Watch Word.tmCommand
new file mode 100644
index 0000000000..3a4612e440
--- /dev/null
+++ b/misc/Factor.tmbundle/Commands/Watch Word.tmCommand
@@ -0,0 +1,32 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>beforeRunningCommand</key>
+ <string>nop</string>
+ <key>bundleUUID</key>
+ <string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
+ <key>command</key>
+ <string>#!/usr/bin/env ruby
+
+require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
+
+doc = STDIN.read
+word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
+puts factor_eval(%Q(#{doc_using_statements(doc)} USE: tools.annotations\n \\ #{word} watch))</string>
+ <key>fallbackInput</key>
+ <string>word</string>
+ <key>input</key>
+ <string>document</string>
+ <key>keyEquivalent</key>
+ <string>^~w</string>
+ <key>name</key>
+ <string>Watch Word</string>
+ <key>output</key>
+ <string>discard</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>uuid</key>
+ <string>1C86869F-1030-4F74-B242-6357A080E127</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Macros/Extract as New Word.tmMacro b/misc/Factor.tmbundle/Macros/Extract as New Word.tmMacro
index 537a5aca8a..940349c23e 100644
--- a/misc/Factor.tmbundle/Macros/Extract as New Word.tmMacro
+++ b/misc/Factor.tmbundle/Macros/Extract as New Word.tmMacro
@@ -231,8 +231,12 @@ puts factor_eval(%Q(#{doc_using_statements(doc)} USE: stack-checker\n [ #{ENV["T
<string>insertText:</string>
</dict>
</array>
+ <key>keyEquivalent</key>
+ <string>@E</string>
<key>name</key>
<string>Extract as New Word</string>
+ <key>scope</key>
+ <string>source.factor</string>
<key>uuid</key>
<string>82E740D1-8D20-48AF-8470-C85C251D4870</string>
</dict>
diff --git a/misc/Factor.tmbundle/Preferences/Miscellaneous.tmPreferences b/misc/Factor.tmbundle/Preferences/Miscellaneous.tmPreferences
new file mode 100644
index 0000000000..abf592ddc8
--- /dev/null
+++ b/misc/Factor.tmbundle/Preferences/Miscellaneous.tmPreferences
@@ -0,0 +1,26 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>name</key>
+ <string>Miscellaneous</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>settings</key>
+ <dict>
+ <key>increaseIndentPattern</key>
+ <string>^:.*$</string>
+ <key>shellVariables</key>
+ <array>
+ <dict>
+ <key>name</key>
+ <string>TM_COMMENT_START</string>
+ <key>value</key>
+ <string>! </string>
+ </dict>
+ </array>
+ </dict>
+ <key>uuid</key>
+ <string>D60675B0-9BF4-4CCF-9066-CA14FE836981</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Snippets/:.tmSnippet b/misc/Factor.tmbundle/Snippets/:.tmSnippet
new file mode 100644
index 0000000000..48bf5b244d
--- /dev/null
+++ b/misc/Factor.tmbundle/Snippets/:.tmSnippet
@@ -0,0 +1,16 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>content</key>
+ <string>: $1 ( $2 -- $3 ) $0 ;</string>
+ <key>name</key>
+ <string>:</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>tabTrigger</key>
+ <string>:</string>
+ <key>uuid</key>
+ <string>7903894E-CB75-43ED-8635-C0E65F94DEBB</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Snippets/::.tmSnippet b/misc/Factor.tmbundle/Snippets/::.tmSnippet
new file mode 100644
index 0000000000..83c394d72f
--- /dev/null
+++ b/misc/Factor.tmbundle/Snippets/::.tmSnippet
@@ -0,0 +1,16 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>content</key>
+ <string>:: $1 ( $2 -- $3 ) $0 ;</string>
+ <key>name</key>
+ <string>::</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>tabTrigger</key>
+ <string>::</string>
+ <key>uuid</key>
+ <string>9A96D386-F7B9-47DC-9CAE-E4BAD1F81748</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Snippets/[ expanded.tmSnippet b/misc/Factor.tmbundle/Snippets/[ expanded.tmSnippet
new file mode 100644
index 0000000000..d26bdc2ee4
--- /dev/null
+++ b/misc/Factor.tmbundle/Snippets/[ expanded.tmSnippet
@@ -0,0 +1,21 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>content</key>
+ <string>[
+ $0
+] </string>
+ <key>keyEquivalent</key>
+ <string>~[</string>
+ <key>name</key>
+ <string>[ expanded</string>
+ <key>scope</key>
+ <string>source.factor
+</string>
+ <key>tabTrigger</key>
+ <string>“</string>
+ <key>uuid</key>
+ <string>F771F82B-6B2B-4DAE-9A2A-E1042D3B08AD</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Snippets/[.tmSnippet b/misc/Factor.tmbundle/Snippets/[.tmSnippet
new file mode 100644
index 0000000000..b5f82f64a2
--- /dev/null
+++ b/misc/Factor.tmbundle/Snippets/[.tmSnippet
@@ -0,0 +1,18 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>content</key>
+ <string>[ $TM_SELECTED_TEXT$0 ] </string>
+ <key>keyEquivalent</key>
+ <string>[</string>
+ <key>name</key>
+ <string>[</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>tabTrigger</key>
+ <string>[</string>
+ <key>uuid</key>
+ <string>3F17AF0F-4DE0-4A86-A649-CB65907F0DA5</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Snippets/bi.tmSnippet b/misc/Factor.tmbundle/Snippets/bi.tmSnippet
new file mode 100644
index 0000000000..6313564a0f
--- /dev/null
+++ b/misc/Factor.tmbundle/Snippets/bi.tmSnippet
@@ -0,0 +1,18 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>content</key>
+ <string>
+ [ $1 ]
+ [ $2 ] bi </string>
+ <key>name</key>
+ <string>bi</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>tabTrigger</key>
+ <string>bi</string>
+ <key>uuid</key>
+ <string>8D69F968-D322-4008-A540-209B32A97F5D</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Snippets/cleave.tmSnippet b/misc/Factor.tmbundle/Snippets/cleave.tmSnippet
new file mode 100644
index 0000000000..3af7632d0c
--- /dev/null
+++ b/misc/Factor.tmbundle/Snippets/cleave.tmSnippet
@@ -0,0 +1,21 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>content</key>
+ <string>{
+ [ $1 ]
+ [ $2 ]
+ [ $3 ]
+ [ $4 ]
+} cleave </string>
+ <key>name</key>
+ <string>cleave</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>tabTrigger</key>
+ <string>cleave</string>
+ <key>uuid</key>
+ <string>E51383D9-1C82-4ACE-AE45-633E6CE35245</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Snippets/cond.tmSnippet b/misc/Factor.tmbundle/Snippets/cond.tmSnippet
new file mode 100644
index 0000000000..1b2f3269af
--- /dev/null
+++ b/misc/Factor.tmbundle/Snippets/cond.tmSnippet
@@ -0,0 +1,19 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>content</key>
+ <string>{
+ { [ $1 ] [ $2 ] }
+ { [ $3 ] [ $4 ] }
+$5} cond </string>
+ <key>name</key>
+ <string>cond</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>tabTrigger</key>
+ <string>cond</string>
+ <key>uuid</key>
+ <string>C8E068DE-A117-43AE-9916-99AF2C21BD24</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Snippets/functor.tmSnippet b/misc/Factor.tmbundle/Snippets/functor.tmSnippet
new file mode 100644
index 0000000000..a30fdfe120
--- /dev/null
+++ b/misc/Factor.tmbundle/Snippets/functor.tmSnippet
@@ -0,0 +1,21 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>content</key>
+ <string>
+FUNCTOR: $1 ( $2 -- $3 )
+$4
+WHERE
+$0
+;FUNCTOR</string>
+ <key>name</key>
+ <string>functor</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>tabTrigger</key>
+ <string>functor</string>
+ <key>uuid</key>
+ <string>B9DA0999-D710-4693-8056-9E4B8BDAC7E9</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Snippets/if.tmSnippet b/misc/Factor.tmbundle/Snippets/if.tmSnippet
new file mode 100644
index 0000000000..96e9cc52b8
--- /dev/null
+++ b/misc/Factor.tmbundle/Snippets/if.tmSnippet
@@ -0,0 +1,18 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>content</key>
+ <string>
+ [ $1 ]
+ [ $2 ] if </string>
+ <key>name</key>
+ <string>if</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>tabTrigger</key>
+ <string>if</string>
+ <key>uuid</key>
+ <string>AD9D0A71-2371-4756-86D7-A084B4A3FE2F</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Snippets/let.tmSnippet b/misc/Factor.tmbundle/Snippets/let.tmSnippet
new file mode 100644
index 0000000000..eecde87c5e
--- /dev/null
+++ b/misc/Factor.tmbundle/Snippets/let.tmSnippet
@@ -0,0 +1,19 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>content</key>
+ <string>
+ [let | $1 [ $2 ] $3|
+ $0
+ ] </string>
+ <key>name</key>
+ <string>let</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>tabTrigger</key>
+ <string>let</string>
+ <key>uuid</key>
+ <string>1B3CF04D-B23D-4D9A-A648-7191315CDF96</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Snippets/spread.tmSnippet b/misc/Factor.tmbundle/Snippets/spread.tmSnippet
new file mode 100644
index 0000000000..ba5007a4e7
--- /dev/null
+++ b/misc/Factor.tmbundle/Snippets/spread.tmSnippet
@@ -0,0 +1,21 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>content</key>
+ <string>{
+ [ $1 ]
+ [ $2 ]
+ [ $3 ]
+ [ $4 ]
+} spread </string>
+ <key>name</key>
+ <string>spread</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>tabTrigger</key>
+ <string>spread</string>
+ <key>uuid</key>
+ <string>3DE1C097-6F69-4562-9C49-C897FF5AB909</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Snippets/tri.tmSnippet b/misc/Factor.tmbundle/Snippets/tri.tmSnippet
new file mode 100644
index 0000000000..02bd5a5c9a
--- /dev/null
+++ b/misc/Factor.tmbundle/Snippets/tri.tmSnippet
@@ -0,0 +1,19 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>content</key>
+ <string>
+ [ $1 ]
+ [ $2 ]
+ [ $3 ] tri </string>
+ <key>name</key>
+ <string>tri</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>tabTrigger</key>
+ <string>tri</string>
+ <key>uuid</key>
+ <string>B8B7B5ED-C75C-4BD1-906A-220C9956F91F</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Snippets/{ expanded.tmSnippet b/misc/Factor.tmbundle/Snippets/{ expanded.tmSnippet
new file mode 100644
index 0000000000..14bd6beaac
--- /dev/null
+++ b/misc/Factor.tmbundle/Snippets/{ expanded.tmSnippet
@@ -0,0 +1,19 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>content</key>
+ <string>{
+ $0
+} </string>
+ <key>keyEquivalent</key>
+ <string>~{</string>
+ <key>name</key>
+ <string>{ expanded</string>
+ <key>scope</key>
+ <string>source.factor
+</string>
+ <key>uuid</key>
+ <string>275EA395-6026-481A-81C5-1F71D8026972</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/Snippets/{.tmSnippet b/misc/Factor.tmbundle/Snippets/{.tmSnippet
new file mode 100644
index 0000000000..c252965639
--- /dev/null
+++ b/misc/Factor.tmbundle/Snippets/{.tmSnippet
@@ -0,0 +1,18 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>content</key>
+ <string>{ $TM_SELECTED_TEXT$0 } </string>
+ <key>keyEquivalent</key>
+ <string>{</string>
+ <key>name</key>
+ <string>{</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>tabTrigger</key>
+ <string>[</string>
+ <key>uuid</key>
+ <string>B4448FB0-B7F9-4FFD-AB4B-EAD31A5920CB</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/info.plist b/misc/Factor.tmbundle/info.plist
index 19d58def86..4c101835b1 100644
--- a/misc/Factor.tmbundle/info.plist
+++ b/misc/Factor.tmbundle/info.plist
@@ -6,12 +6,105 @@
<array>
<string>4D090AD9-76F9-4A0B-B3F2-7428B7C15FBA</string>
</array>
+ <key>mainMenu</key>
+ <dict>
+ <key>excludedItems</key>
+ <array>
+ <string>DBC0A0CA-5368-43A7-864B-7B9C4034AD08</string>
+ <string>1B3CF04D-B23D-4D9A-A648-7191315CDF96</string>
+ <string>3F17AF0F-4DE0-4A86-A649-CB65907F0DA5</string>
+ <string>B4448FB0-B7F9-4FFD-AB4B-EAD31A5920CB</string>
+ <string>C8E068DE-A117-43AE-9916-99AF2C21BD24</string>
+ <string>AD9D0A71-2371-4756-86D7-A084B4A3FE2F</string>
+ <string>8D69F968-D322-4008-A540-209B32A97F5D</string>
+ <string>B8B7B5ED-C75C-4BD1-906A-220C9956F91F</string>
+ <string>E51383D9-1C82-4ACE-AE45-633E6CE35245</string>
+ <string>3DE1C097-6F69-4562-9C49-C897FF5AB909</string>
+ <string>B9DA0999-D710-4693-8056-9E4B8BDAC7E9</string>
+ <string>7903894E-CB75-43ED-8635-C0E65F94DEBB</string>
+ <string>9A96D386-F7B9-47DC-9CAE-E4BAD1F81748</string>
+ </array>
+ <key>items</key>
+ <array>
+ <string>0CDA009F-8518-4C45-AB0E-D11B281131BF</string>
+ <string>8088D204-FFD7-4384-8FDD-A01536FFD0E7</string>
+ <string>CAD3BB10-C480-4C0E-9518-94D61F7A0C0B</string>
+ <string>82E740D1-8D20-48AF-8470-C85C251D4870</string>
+ <string>D348BE40-6F51-4471-B300-DDDA70ED8C8C</string>
+ <string>86DD4385-4029-4EFE-B546-1EC8EB5EB932</string>
+ <string>9D99C141-EC9D-4C9E-9C08-0CA4EAEA2F3E</string>
+ <string>1C72489C-15A1-4B44-BCDF-438962D4F3EB</string>
+ <string>9E5EC5B6-AABD-4657-A663-D3C558051216</string>
+ <string>219C4AB2-742E-48FE-92E1-CB2EC19C8A24</string>
+ <string>D25BF2AE-0595-44AE-B97A-9F20D4E28173</string>
+ </array>
+ <key>submenus</key>
+ <dict>
+ <key>1C72489C-15A1-4B44-BCDF-438962D4F3EB</key>
+ <dict>
+ <key>items</key>
+ <array>
+ <string>3043A033-A113-4283-BCBB-3DE2CCC8F63E</string>
+ <string>B1F81321-B760-474F-875D-78FB52752E1B</string>
+ <string>BC3E2E39-3B79-460C-B05E-BD00BAACB90E</string>
+ </array>
+ <key>name</key>
+ <string>Cross Ref</string>
+ </dict>
+ <key>219C4AB2-742E-48FE-92E1-CB2EC19C8A24</key>
+ <dict>
+ <key>items</key>
+ <array>
+ <string>57C2BAAC-0474-404F-AA91-DFD02EC2A3ED</string>
+ <string>E4614756-DF2E-433A-8935-197159C67AB8</string>
+ <string>1C86869F-1030-4F74-B242-6357A080E127</string>
+ <string>71F08D9B-3D24-4E78-84C9-82CA736554D1</string>
+ </array>
+ <key>name</key>
+ <string>Debugging</string>
+ </dict>
+ <key>9D99C141-EC9D-4C9E-9C08-0CA4EAEA2F3E</key>
+ <dict>
+ <key>items</key>
+ <array>
+ <string>D02D9D74-E073-48AE-A78E-B40FFFA519D5</string>
+ <string>C573487C-DD7D-497F-A728-52D7962D95E2</string>
+ <string>D95A617C-E1C6-44DA-9126-04171CB21299</string>
+ </array>
+ <key>name</key>
+ <string>Edit</string>
+ </dict>
+ <key>9E5EC5B6-AABD-4657-A663-D3C558051216</key>
+ <dict>
+ <key>items</key>
+ <array>
+ <string>7FF52332-CA5B-4D46-99EF-DAE0659DB478</string>
+ <string>15A984BD-BC65-43E8-878A-267788C8DA70</string>
+ <string>8E01DDAF-959B-4237-ADB9-C133A4ACCE90</string>
+ <string>B619FCC0-2DF2-4657-82A8-0E5676A10254</string>
+ <string>8465B33D-7CA0-4337-945C-4078346D64BC</string>
+ </array>
+ <key>name</key>
+ <string>Tools</string>
+ </dict>
+ <key>D25BF2AE-0595-44AE-B97A-9F20D4E28173</key>
+ <dict>
+ <key>items</key>
+ <array>
+ <string>35484754-DBF9-4381-BB25-00CAB64DF4A1</string>
+ <string>BC5BE120-734B-40DF-8B6B-5D3243614B27</string>
+ </array>
+ <key>name</key>
+ <string>Help</string>
+ </dict>
+ </dict>
+ </dict>
<key>name</key>
<string>Factor</string>
<key>ordering</key>
<array>
- <string>82E740D1-8D20-48AF-8470-C85C251D4870</string>
<string>3C9C9C2A-314A-475B-A4E4-A68BAAF3F36E</string>
+ <string>D60675B0-9BF4-4CCF-9066-CA14FE836981</string>
<string>141517D7-73E0-4475-A481-71102575A175</string>
<string>CAD3BB10-C480-4C0E-9518-94D61F7A0C0B</string>
<string>8088D204-FFD7-4384-8FDD-A01536FFD0E7</string>
@@ -27,8 +120,8 @@
<string>BC3E2E39-3B79-460C-B05E-BD00BAACB90E</string>
<string>8465B33D-7CA0-4337-945C-4078346D64BC</string>
<string>57C2BAAC-0474-404F-AA91-DFD02EC2A3ED</string>
- <string>E4614756-DF2E-433A-8935-197159C67AB8</string>
<string>1C86869F-1030-4F74-B242-6357A080E127</string>
+ <string>E4614756-DF2E-433A-8935-197159C67AB8</string>
<string>D02D9D74-E073-48AE-A78E-B40FFFA519D5</string>
<string>C573487C-DD7D-497F-A728-52D7962D95E2</string>
<string>D95A617C-E1C6-44DA-9126-04171CB21299</string>
@@ -36,6 +129,21 @@
<string>7FF52332-CA5B-4D46-99EF-DAE0659DB478</string>
<string>0CDA009F-8518-4C45-AB0E-D11B281131BF</string>
<string>D348BE40-6F51-4471-B300-DDDA70ED8C8C</string>
+ <string>1B3CF04D-B23D-4D9A-A648-7191315CDF96</string>
+ <string>3F17AF0F-4DE0-4A86-A649-CB65907F0DA5</string>
+ <string>F771F82B-6B2B-4DAE-9A2A-E1042D3B08AD</string>
+ <string>B4448FB0-B7F9-4FFD-AB4B-EAD31A5920CB</string>
+ <string>275EA395-6026-481A-81C5-1F71D8026972</string>
+ <string>C8E068DE-A117-43AE-9916-99AF2C21BD24</string>
+ <string>AD9D0A71-2371-4756-86D7-A084B4A3FE2F</string>
+ <string>8D69F968-D322-4008-A540-209B32A97F5D</string>
+ <string>B8B7B5ED-C75C-4BD1-906A-220C9956F91F</string>
+ <string>E51383D9-1C82-4ACE-AE45-633E6CE35245</string>
+ <string>3DE1C097-6F69-4562-9C49-C897FF5AB909</string>
+ <string>B9DA0999-D710-4693-8056-9E4B8BDAC7E9</string>
+ <string>7903894E-CB75-43ED-8635-C0E65F94DEBB</string>
+ <string>9A96D386-F7B9-47DC-9CAE-E4BAD1F81748</string>
+ <string>82E740D1-8D20-48AF-8470-C85C251D4870</string>
</array>
<key>uuid</key>
<string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
From a7ff4c7884875135b54619ad09f6fa1b7521e528 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Mon, 3 Aug 2009 22:29:02 -0500
Subject: [PATCH 115/128] not using message passing threads for modules
---
.../modules/rpc-server/rpc-server-docs.factor | 2 +-
extra/modules/rpc-server/rpc-server.factor | 36 +++++++++----------
extra/modules/rpc/rpc.factor | 17 +++++----
extra/modules/using/using-docs.factor | 3 +-
4 files changed, 28 insertions(+), 30 deletions(-)
diff --git a/extra/modules/rpc-server/rpc-server-docs.factor b/extra/modules/rpc-server/rpc-server-docs.factor
index fc2c2344dd..f1d4be4465 100644
--- a/extra/modules/rpc-server/rpc-server-docs.factor
+++ b/extra/modules/rpc-server/rpc-server-docs.factor
@@ -2,4 +2,4 @@ USING: help.syntax help.markup modules.rpc-server modules.using ;
IN: modules.rpc-server
HELP: service
{ $syntax "IN: my-vocab service" }
-{ $description "Allows words defined in the vocabulary to be used as remote procedure calls by " { $link POSTPONE: USING*: } } ;
\ No newline at end of file
+{ $description "Allows words defined in the vocabulary to be used as remote procedure calls by " { $link POSTPONE: USING*: } ;
\ No newline at end of file
diff --git a/extra/modules/rpc-server/rpc-server.factor b/extra/modules/rpc-server/rpc-server.factor
index 7ac50ab61f..bafdc55335 100644
--- a/extra/modules/rpc-server/rpc-server.factor
+++ b/extra/modules/rpc-server/rpc-server.factor
@@ -1,35 +1,31 @@
! Copyright (C) 2009 Sam Anklesaria.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs concurrency.distributed
-concurrency.messaging continuations effects init kernel
-namespaces sequences sets threads vocabs vocabs.parser ;
+USING: accessors assocs combinators continuations effects
+io.encodings.binary io.servers.connection kernel namespaces
+sequences serialize sets threads vocabs vocabs.parser init ;
IN: modules.rpc-server
+
<PRIVATE
TUPLE: rpc-request args vocabspec wordname ;
SYMBOL: serving-vocabs serving-vocabs [ V{ } clone ] initialize
-: register-gets-thread ( -- )
- [ receive [ data>> dup serving-vocabs get-global index
+: getter ( -- ) deserialize dup serving-vocabs get-global index
[ vocab-words [ stack-effect ] { } assoc-map-as ]
- [ \ no-vocab boa ] if
- ] keep reply-synchronous
- t ] "get-words" spawn-server "gets-thread" swap register-process ;
+ [ \ no-vocab boa ] if serialize ;
-: register-does-thread ( -- )
- [ receive [ data>> dup vocabspec>> serving-vocabs get-global index
+: doer ( -- ) deserialize dup vocabspec>> serving-vocabs get-global index
[ [ args>> ] [ wordname>> ] [ vocabspec>> vocab-words ] tri at [ execute ] curry with-datastack ]
- [ vocabspec>> \ no-vocab boa ] if
- ] keep reply-synchronous
- t ] "do-word" spawn-server "does-thread" swap register-process ;
-
-: register-loads-thread ( -- )
- [ [ receive vocab ] keep reply-synchronous t ] "load-words" spawn-server "loads-thread" swap register-process ;
+ [ vocabspec>> \ no-vocab boa ] if serialize ;
PRIVATE>
SYNTAX: service current-vocab name>> serving-vocabs get-global adjoin ;
-[ 9012 start-node
- register-gets-thread
- register-does-thread
- register-loads-thread
+[ [ binary <threaded-server>
+ "rpcs" >>name 9012 >>insecure
+ [ break deserialize {
+ { [ "getter" ] [ getter ] }
+ { [ "doer" ] [ doer ] }
+ { [ "loader" ] [ deserialize vocab serialize ] }
+ } case ] >>handler
+ start-server ] in-thread drop
] "modules.rpc-server" add-init-hook
\ No newline at end of file
diff --git a/extra/modules/rpc/rpc.factor b/extra/modules/rpc/rpc.factor
index 724a779f7e..75b5ef3fe5 100644
--- a/extra/modules/rpc/rpc.factor
+++ b/extra/modules/rpc/rpc.factor
@@ -1,24 +1,27 @@
! Copyright (C) 2009 Sam Anklesaria.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs concurrency.distributed
-concurrency.messaging fry generalizations io.sockets kernel
-locals namespaces parser sequences vocabs vocabs.parser words ;
+USING: accessors assocs fry generalizations io.encodings.binary
+io.sockets kernel locals namespaces parser sequences serialize
+vocabs vocabs.parser words tools.continuations io ;
IN: modules.rpc
TUPLE: rpc-request args vocabspec wordname ;
-: send-with-check ( message thread -- reply/* ) send-synchronous dup no-vocab? [ throw ] when ;
+: send-with-check ( message -- reply/* )
+ serialize flush deserialize dup no-vocab? [ throw ] when ;
:: define-remote ( str effect addrspec vocabspec -- )
str create-in effect [ in>> length ] [ out>> length ] bi
- '[ _ narray vocabspec str rpc-request boa "does-thread" addrspec 9012 <inet> <remote-process> send-with-check _ firstn ]
+ '[ _ narray vocabspec str rpc-request boa addrspec 9012 <inet> binary
+ [ "doer" serialize serialize send-with-check ] with-client _ firstn ]
effect define-declared ;
:: remote-vocab ( addrspec vocabspec -- vocab )
vocabspec "-remote" append dup vocab [ dup set-current-vocab
- vocabspec "gets-thread" addrspec 9012 <inet> <remote-process> send-with-check
+ vocabspec addrspec 9012 <inet> binary [ "getter" serialize send-with-check ] with-client
[ first2 addrspec vocabspec define-remote ] each
] unless ;
: remote-load ( addr vocabspec -- voabspec ) [ swap
- "loads-thread" swap 9012 <inet> <remote-process> send-synchronous ] keep [ dictionary get-global set-at ] keep ;
\ No newline at end of file
+ 9012 <inet> binary [ "loader" serialize serialize flush deserialize ] with-client ] keep
+ [ dictionary get-global set-at ] keep ;
\ No newline at end of file
diff --git a/extra/modules/using/using-docs.factor b/extra/modules/using/using-docs.factor
index f3c25f9201..0f67f2b0ee 100644
--- a/extra/modules/using/using-docs.factor
+++ b/extra/modules/using/using-docs.factor
@@ -8,5 +8,4 @@ ABOUT: { "modules.using" "use" }
HELP: USING*:
{ $syntax "USING: rpc-server::module fetch-sever:module { module qualified-name } { module => word ... } { qualified-module } { module EXCEPT word ... } { module word => importname } ;" }
-{ $description "Adds vocabularies to the search path. Vocabularies can be loaded off a server or called as an rpc if preceded by a valid hostname. Bracketed pairs facilitate all types of qualified imports on both remote and local modules." }
-"To use the 'USING*:' without explicitly importing modules.using first, add '\"modules.using\" require' to your .factor-boot-rc" ;
\ No newline at end of file
+{ $description "Adds vocabularies to the search path. Vocabularies can be loaded off a server or called as an rpc if preceded by a valid hostname. Bracketed pairs facilitate all types of qualified imports on both remote and local modules." } ;
\ No newline at end of file
From bc0711cbe596339d8bd26d0f7cd6b808a1d98977 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Mon, 3 Aug 2009 23:12:34 -0500
Subject: [PATCH 116/128] modules vocab in working order
---
extra/modules/rpc-server/rpc-server-docs.factor | 2 +-
extra/modules/rpc-server/rpc-server.factor | 16 ++++++++--------
extra/modules/rpc/rpc.factor | 4 ++--
3 files changed, 11 insertions(+), 11 deletions(-)
diff --git a/extra/modules/rpc-server/rpc-server-docs.factor b/extra/modules/rpc-server/rpc-server-docs.factor
index f1d4be4465..fc2c2344dd 100644
--- a/extra/modules/rpc-server/rpc-server-docs.factor
+++ b/extra/modules/rpc-server/rpc-server-docs.factor
@@ -2,4 +2,4 @@ USING: help.syntax help.markup modules.rpc-server modules.using ;
IN: modules.rpc-server
HELP: service
{ $syntax "IN: my-vocab service" }
-{ $description "Allows words defined in the vocabulary to be used as remote procedure calls by " { $link POSTPONE: USING*: } ;
\ No newline at end of file
+{ $description "Allows words defined in the vocabulary to be used as remote procedure calls by " { $link POSTPONE: USING*: } } ;
\ No newline at end of file
diff --git a/extra/modules/rpc-server/rpc-server.factor b/extra/modules/rpc-server/rpc-server.factor
index bafdc55335..073804fa8c 100644
--- a/extra/modules/rpc-server/rpc-server.factor
+++ b/extra/modules/rpc-server/rpc-server.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs combinators continuations effects
io.encodings.binary io.servers.connection kernel namespaces
-sequences serialize sets threads vocabs vocabs.parser init ;
+sequences serialize sets threads vocabs vocabs.parser init io ;
IN: modules.rpc-server
<PRIVATE
@@ -11,21 +11,21 @@ SYMBOL: serving-vocabs serving-vocabs [ V{ } clone ] initialize
: getter ( -- ) deserialize dup serving-vocabs get-global index
[ vocab-words [ stack-effect ] { } assoc-map-as ]
- [ \ no-vocab boa ] if serialize ;
+ [ \ no-vocab boa ] if serialize flush ;
: doer ( -- ) deserialize dup vocabspec>> serving-vocabs get-global index
[ [ args>> ] [ wordname>> ] [ vocabspec>> vocab-words ] tri at [ execute ] curry with-datastack ]
- [ vocabspec>> \ no-vocab boa ] if serialize ;
+ [ vocabspec>> \ no-vocab boa ] if serialize flush ;
PRIVATE>
SYNTAX: service current-vocab name>> serving-vocabs get-global adjoin ;
[ [ binary <threaded-server>
"rpcs" >>name 9012 >>insecure
- [ break deserialize {
- { [ "getter" ] [ getter ] }
- { [ "doer" ] [ doer ] }
- { [ "loader" ] [ deserialize vocab serialize ] }
+ [ deserialize {
+ { "getter" [ getter ] }
+ { "doer" [ doer ] }
+ { "loader" [ deserialize vocab serialize flush ] }
} case ] >>handler
- start-server ] in-thread drop
+ start-server ] in-thread
] "modules.rpc-server" add-init-hook
\ No newline at end of file
diff --git a/extra/modules/rpc/rpc.factor b/extra/modules/rpc/rpc.factor
index 75b5ef3fe5..b394090d55 100644
--- a/extra/modules/rpc/rpc.factor
+++ b/extra/modules/rpc/rpc.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs fry generalizations io.encodings.binary
io.sockets kernel locals namespaces parser sequences serialize
-vocabs vocabs.parser words tools.continuations io ;
+vocabs vocabs.parser words io ;
IN: modules.rpc
TUPLE: rpc-request args vocabspec wordname ;
@@ -13,7 +13,7 @@ TUPLE: rpc-request args vocabspec wordname ;
:: define-remote ( str effect addrspec vocabspec -- )
str create-in effect [ in>> length ] [ out>> length ] bi
'[ _ narray vocabspec str rpc-request boa addrspec 9012 <inet> binary
- [ "doer" serialize serialize send-with-check ] with-client _ firstn ]
+ [ "doer" serialize send-with-check ] with-client _ firstn ]
effect define-declared ;
:: remote-vocab ( addrspec vocabspec -- vocab )
From 70428241bd2f6f96e31b121690f337c466bed942 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Tue, 4 Aug 2009 16:01:40 -0500
Subject: [PATCH 117/128] textmate bundle scaffolding
---
basis/editors/textmate/textmate.factor | 5 ++-
.../Commands/Create New Vocabulary.tmCommand | 32 -------------------
.../Cycle Vocabs:Docs:Tests.tmCommand | 18 +++++++----
.../{Edit.tmCommand => Edit Vocab.tmCommand} | 8 ++---
misc/Factor.tmbundle/Commands/Fix.tmCommand | 32 -------------------
.../Factor.tmbundle/Commands/Reload.tmCommand | 26 ---------------
misc/Factor.tmbundle/Commands/Reset.tmCommand | 32 -------------------
.../Commands/Scaffold.tmCommand | 32 -------------------
.../Commands/Show Using.tmCommand | 14 ++++----
.../Commands/Update Using.tmCommand | 27 ----------------
misc/Factor.tmbundle/Commands/Watch.tmCommand | 32 -------------------
.../Macros/Extract as New Word.tmMacro | 2 +-
.../Preferences/Miscellaneous.tmPreferences | 2 +-
.../Snippets/[ expanded.tmSnippet | 4 +--
misc/Factor.tmbundle/Snippets/[.tmSnippet | 2 +-
misc/Factor.tmbundle/Snippets/bi.tmSnippet | 2 +-
.../Factor.tmbundle/Snippets/cleave.tmSnippet | 2 +-
.../Snippets/functor.tmSnippet | 3 +-
misc/Factor.tmbundle/Snippets/if.tmSnippet | 2 +-
misc/Factor.tmbundle/Snippets/let.tmSnippet | 2 +-
.../Factor.tmbundle/Snippets/spread.tmSnippet | 2 +-
misc/Factor.tmbundle/Snippets/tri.tmSnippet | 2 +-
.../Snippets/{ expanded.tmSnippet | 4 +--
misc/Factor.tmbundle/Snippets/{.tmSnippet | 2 +-
.../Support/lib/do_scaffold.rb | 16 ----------
.../Vocabulary.tmTemplate/info.plist | 28 ++++++++++++++++
misc/Factor.tmbundle/info.plist | 15 +++++----
27 files changed, 77 insertions(+), 271 deletions(-)
delete mode 100644 misc/Factor.tmbundle/Commands/Create New Vocabulary.tmCommand
rename misc/Factor.tmbundle/Commands/{Edit.tmCommand => Edit Vocab.tmCommand} (85%)
delete mode 100644 misc/Factor.tmbundle/Commands/Fix.tmCommand
delete mode 100644 misc/Factor.tmbundle/Commands/Reload.tmCommand
delete mode 100644 misc/Factor.tmbundle/Commands/Reset.tmCommand
delete mode 100644 misc/Factor.tmbundle/Commands/Scaffold.tmCommand
delete mode 100644 misc/Factor.tmbundle/Commands/Update Using.tmCommand
delete mode 100644 misc/Factor.tmbundle/Commands/Watch.tmCommand
delete mode 100644 misc/Factor.tmbundle/Support/lib/do_scaffold.rb
create mode 100644 misc/Factor.tmbundle/Templates/Vocabulary.tmTemplate/info.plist
diff --git a/basis/editors/textmate/textmate.factor b/basis/editors/textmate/textmate.factor
index 72af2ba030..561beee4e3 100644
--- a/basis/editors/textmate/textmate.factor
+++ b/basis/editors/textmate/textmate.factor
@@ -1,10 +1,9 @@
USING: definitions io.launcher kernel math math.parser parser
-namespaces prettyprint editors make vocabs.loader ;
+namespaces prettyprint editors make ;
IN: editors.textmate
: textmate ( file line -- )
[ "mate" , "-a" , "-l" , number>string , , ] { } make
run-detached drop ;
-[ textmate ] edit-hook set-global
-"get-using" require
+[ textmate ] edit-hook set-global
\ No newline at end of file
diff --git a/misc/Factor.tmbundle/Commands/Create New Vocabulary.tmCommand b/misc/Factor.tmbundle/Commands/Create New Vocabulary.tmCommand
deleted file mode 100644
index df19e2ea58..0000000000
--- a/misc/Factor.tmbundle/Commands/Create New Vocabulary.tmCommand
+++ /dev/null
@@ -1,32 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
-<plist version="1.0">
-<dict>
- <key>beforeRunningCommand</key>
- <string>nop</string>
- <key>bundleUUID</key>
- <string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
- <key>command</key>
- <string>res=$(CocoaDialog inputbox --title "Scaffold Setup" \
- --informative-text "Vocab Name:" \
- --button1 "Okay" --button2 "Cancel")
-
-[[ $(head -n1 <<<"$res") == "2" ]] && exit_discard
-res=$(tail -n1 <<<"$res")
-"$TM_BUNDLE_SUPPORT/lib/do_scaffolding.rb" res</string>
- <key>fallbackInput</key>
- <string>word</string>
- <key>input</key>
- <string>none</string>
- <key>keyEquivalent</key>
- <string>@N</string>
- <key>name</key>
- <string>Create New Vocabulary</string>
- <key>output</key>
- <string>discard</string>
- <key>scope</key>
- <string>source.factor</string>
- <key>uuid</key>
- <string>0CDA009F-8518-4C45-AB0E-D11B281131BF</string>
-</dict>
-</plist>
diff --git a/misc/Factor.tmbundle/Commands/Cycle Vocabs:Docs:Tests.tmCommand b/misc/Factor.tmbundle/Commands/Cycle Vocabs:Docs:Tests.tmCommand
index 8c4ec6365d..e21ad950e2 100644
--- a/misc/Factor.tmbundle/Commands/Cycle Vocabs:Docs:Tests.tmCommand
+++ b/misc/Factor.tmbundle/Commands/Cycle Vocabs:Docs:Tests.tmCommand
@@ -7,19 +7,23 @@
<key>bundleUUID</key>
<string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
<key>command</key>
- <string>#! /Applications/factor/factor
+ <string>#!/usr/bin/env ruby
+require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
-"TM_FILEPATH" os-env [ parent-directory ] [ file-name dup ] bi {
-{ [ dup "docs.factor" tail? ] [ drop 11 tail* "tests.factor" append append ] }
-{ [ "-tests.factor" tail? ] [ 13 tail* ".factor" append append ] }
-[ 7 tail* [ "-docs.factor" append append ] keep over exists? [ drop ] [ scaffold-help ] if ]
-} cond 0 textmate</string>
+x = ENV["TM_FILEPATH"][/\/([^\/]+\.factor)/,1]
+y = x.sub("-tests","").sub("docs", "tests")
+if x == y then
+ z = x.sub(".factor","")
+ factor_eval(%Q(USING: tools.scaffold #{z} ;\n"#{z}" scaffold-help))
+ y = x.sub(".factor", "-docs.factor")
+end
+exec "mate #{ENV["TM_FILEPATH"][/(.*\/)[^\/]+\.factor/,1] << y}"</string>
<key>fallbackInput</key>
<string>word</string>
<key>input</key>
<string>none</string>
<key>keyEquivalent</key>
- <string>^@ </string>
+ <string>^@`</string>
<key>name</key>
<string>Cycle Vocabs/Docs/Tests</string>
<key>output</key>
diff --git a/misc/Factor.tmbundle/Commands/Edit.tmCommand b/misc/Factor.tmbundle/Commands/Edit Vocab.tmCommand
similarity index 85%
rename from misc/Factor.tmbundle/Commands/Edit.tmCommand
rename to misc/Factor.tmbundle/Commands/Edit Vocab.tmCommand
index 4f077c448f..1ed5787f98 100644
--- a/misc/Factor.tmbundle/Commands/Edit.tmCommand
+++ b/misc/Factor.tmbundle/Commands/Edit Vocab.tmCommand
@@ -13,20 +13,20 @@ require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
doc = STDIN.read
word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
-puts factor_eval(%Q(#{doc_using_statements(doc)} USE: editors\n \\ #{word} edit))</string>
+puts factor_eval(%Q(#{doc_using_statements(doc)} USE: editors\n "#{word}" edit-vocab))</string>
<key>fallbackInput</key>
<string>word</string>
<key>input</key>
<string>document</string>
<key>keyEquivalent</key>
- <string>@E</string>
+ <string>@V</string>
<key>name</key>
- <string>Edit</string>
+ <string>Edit Vocab</string>
<key>output</key>
<string>discard</string>
<key>scope</key>
<string>source.factor</string>
<key>uuid</key>
- <string>C573487C-DD7D-497F-A728-52D7962D95E2</string>
+ <string>0034EC1C-DAD1-498F-82FD-BEF7015F84EE</string>
</dict>
</plist>
diff --git a/misc/Factor.tmbundle/Commands/Fix.tmCommand b/misc/Factor.tmbundle/Commands/Fix.tmCommand
deleted file mode 100644
index a49f8a49ae..0000000000
--- a/misc/Factor.tmbundle/Commands/Fix.tmCommand
+++ /dev/null
@@ -1,32 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
-<plist version="1.0">
-<dict>
- <key>beforeRunningCommand</key>
- <string>nop</string>
- <key>bundleUUID</key>
- <string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
- <key>command</key>
- <string>#!/usr/bin/env ruby
-
-require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
-
-doc = STDIN.read
-word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
-puts factor_run(%Q(#{doc_using_statements(doc)} USE: editors\n \\ #{word} fix))</string>
- <key>fallbackInput</key>
- <string>word</string>
- <key>input</key>
- <string>document</string>
- <key>keyEquivalent</key>
- <string>@F</string>
- <key>name</key>
- <string>Fix</string>
- <key>output</key>
- <string>discard</string>
- <key>scope</key>
- <string>source.factor</string>
- <key>uuid</key>
- <string>D02D9D74-E073-48AE-A78E-B40FFFA519D5</string>
-</dict>
-</plist>
diff --git a/misc/Factor.tmbundle/Commands/Reload.tmCommand b/misc/Factor.tmbundle/Commands/Reload.tmCommand
deleted file mode 100644
index 1dcd350ecd..0000000000
--- a/misc/Factor.tmbundle/Commands/Reload.tmCommand
+++ /dev/null
@@ -1,26 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
-<plist version="1.0">
-<dict>
- <key>beforeRunningCommand</key>
- <string>nop</string>
- <key>command</key>
- <string>#!/usr/bin/env ruby
-
-require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
-doc = STDIN.read
-factor_run(%Q(USE: vocabs.loader\n "#{doc[/\bIN:\s(\S+)/, 1]}" reload))</string>
- <key>input</key>
- <string>document</string>
- <key>keyEquivalent</key>
- <string>^r</string>
- <key>name</key>
- <string>Reload</string>
- <key>output</key>
- <string>discard</string>
- <key>scope</key>
- <string>source.factor</string>
- <key>uuid</key>
- <string>8088D204-FFD7-4384-8FDD-A01536FFD0E7</string>
-</dict>
-</plist>
diff --git a/misc/Factor.tmbundle/Commands/Reset.tmCommand b/misc/Factor.tmbundle/Commands/Reset.tmCommand
deleted file mode 100644
index ae15b9ddd6..0000000000
--- a/misc/Factor.tmbundle/Commands/Reset.tmCommand
+++ /dev/null
@@ -1,32 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
-<plist version="1.0">
-<dict>
- <key>beforeRunningCommand</key>
- <string>nop</string>
- <key>bundleUUID</key>
- <string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
- <key>command</key>
- <string>#!/usr/bin/env ruby
-
-require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
-
-doc = STDIN.read
-word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
-puts factor_eval(%Q(#{doc_using_statements(doc)} USE: tools.annotations\n \\ #{word} reset))</string>
- <key>fallbackInput</key>
- <string>word</string>
- <key>input</key>
- <string>document</string>
- <key>keyEquivalent</key>
- <string>^~r</string>
- <key>name</key>
- <string>Reset</string>
- <key>output</key>
- <string>discard</string>
- <key>scope</key>
- <string>source.factor</string>
- <key>uuid</key>
- <string>71F08D9B-3D24-4E78-84C9-82CA736554D1</string>
-</dict>
-</plist>
diff --git a/misc/Factor.tmbundle/Commands/Scaffold.tmCommand b/misc/Factor.tmbundle/Commands/Scaffold.tmCommand
deleted file mode 100644
index fe195725d7..0000000000
--- a/misc/Factor.tmbundle/Commands/Scaffold.tmCommand
+++ /dev/null
@@ -1,32 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
-<plist version="1.0">
-<dict>
- <key>beforeRunningCommand</key>
- <string>nop</string>
- <key>bundleUUID</key>
- <string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
- <key>command</key>
- <string>res=$(CocoaDialog inputbox --title "Scaffold Setup" \
- --informative-text "Vocab Name:" \
- --button1 "Okay" --button2 "Cancel")
-
-[[ $(head -n1 <<<"$res") == "2" ]] && exit_discard
-res=$(tail -n1 <<<"$res")
-"$TM_BUNDLE_SUPPORT/lib/do_scaffolding.rb" res</string>
- <key>fallbackInput</key>
- <string>word</string>
- <key>input</key>
- <string>none</string>
- <key>keyEquivalent</key>
- <string>@N</string>
- <key>name</key>
- <string>Scaffold</string>
- <key>output</key>
- <string>discard</string>
- <key>scope</key>
- <string>source.factor</string>
- <key>uuid</key>
- <string>0CDA009F-8518-4C45-AB0E-D11B281131BF</string>
-</dict>
-</plist>
diff --git a/misc/Factor.tmbundle/Commands/Show Using.tmCommand b/misc/Factor.tmbundle/Commands/Show Using.tmCommand
index 22681bd76e..b710e64e3d 100644
--- a/misc/Factor.tmbundle/Commands/Show Using.tmCommand
+++ b/misc/Factor.tmbundle/Commands/Show Using.tmCommand
@@ -5,10 +5,12 @@
<key>beforeRunningCommand</key>
<string>nop</string>
<key>command</key>
- <string>#! /Applications/factor/factor
-USE: modules.using
-USING*: environment localhost::get-using io ;
-"TM_FILEPATH" os-env get-using write</string>
+ <string>#!/usr/bin/env ruby
+
+require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
+
+factor_run(%Q(USING: namespaces parser ;
+auto-use? t set "#{ENV["TM_FILEPATH"]}" run-file auto-use? f set))</string>
<key>fallbackInput</key>
<string>word</string>
<key>input</key>
@@ -18,10 +20,10 @@ USING*: environment localhost::get-using io ;
<key>name</key>
<string>Show Using</string>
<key>output</key>
- <string>showAsTooltip</string>
+ <string>discard</string>
<key>scope</key>
<string>source.factor</string>
<key>uuid</key>
- <string>86DD4385-4029-4EFE-B546-1EC8EB5EB932</string>
+ <string>93AF1721-C14D-428A-B5A0-34CEFAA3B3C5</string>
</dict>
</plist>
diff --git a/misc/Factor.tmbundle/Commands/Update Using.tmCommand b/misc/Factor.tmbundle/Commands/Update Using.tmCommand
deleted file mode 100644
index 3fb4d20bbf..0000000000
--- a/misc/Factor.tmbundle/Commands/Update Using.tmCommand
+++ /dev/null
@@ -1,27 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
-<plist version="1.0">
-<dict>
- <key>beforeRunningCommand</key>
- <string>nop</string>
- <key>command</key>
- <string>#! /Applications/factor/factor
-USE: modules.using
-USING*: environment localhost::get-using io ;
-"TM_FILEPATH" os-env get-using write</string>
- <key>fallbackInput</key>
- <string>word</string>
- <key>input</key>
- <string>none</string>
- <key>keyEquivalent</key>
- <string>^u</string>
- <key>name</key>
- <string>Update Using</string>
- <key>output</key>
- <string>showAsTooltip</string>
- <key>scope</key>
- <string>source.factor</string>
- <key>uuid</key>
- <string>86DD4385-4029-4EFE-B546-1EC8EB5EB932</string>
-</dict>
-</plist>
diff --git a/misc/Factor.tmbundle/Commands/Watch.tmCommand b/misc/Factor.tmbundle/Commands/Watch.tmCommand
deleted file mode 100644
index e2c95017d9..0000000000
--- a/misc/Factor.tmbundle/Commands/Watch.tmCommand
+++ /dev/null
@@ -1,32 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
-<plist version="1.0">
-<dict>
- <key>beforeRunningCommand</key>
- <string>nop</string>
- <key>bundleUUID</key>
- <string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
- <key>command</key>
- <string>#!/usr/bin/env ruby
-
-require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
-
-doc = STDIN.read
-word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
-puts factor_eval(%Q(#{doc_using_statements(doc)} USE: tools.annotations\n \\ #{word} watch))</string>
- <key>fallbackInput</key>
- <string>word</string>
- <key>input</key>
- <string>document</string>
- <key>keyEquivalent</key>
- <string>^~w</string>
- <key>name</key>
- <string>Watch</string>
- <key>output</key>
- <string>discard</string>
- <key>scope</key>
- <string>source.factor</string>
- <key>uuid</key>
- <string>1C86869F-1030-4F74-B242-6357A080E127</string>
-</dict>
-</plist>
diff --git a/misc/Factor.tmbundle/Macros/Extract as New Word.tmMacro b/misc/Factor.tmbundle/Macros/Extract as New Word.tmMacro
index 940349c23e..e1bd29651e 100644
--- a/misc/Factor.tmbundle/Macros/Extract as New Word.tmMacro
+++ b/misc/Factor.tmbundle/Macros/Extract as New Word.tmMacro
@@ -232,7 +232,7 @@ puts factor_eval(%Q(#{doc_using_statements(doc)} USE: stack-checker\n [ #{ENV["T
</dict>
</array>
<key>keyEquivalent</key>
- <string>@E</string>
+ <string>@W</string>
<key>name</key>
<string>Extract as New Word</string>
<key>scope</key>
diff --git a/misc/Factor.tmbundle/Preferences/Miscellaneous.tmPreferences b/misc/Factor.tmbundle/Preferences/Miscellaneous.tmPreferences
index abf592ddc8..fa19e503b4 100644
--- a/misc/Factor.tmbundle/Preferences/Miscellaneous.tmPreferences
+++ b/misc/Factor.tmbundle/Preferences/Miscellaneous.tmPreferences
@@ -9,7 +9,7 @@
<key>settings</key>
<dict>
<key>increaseIndentPattern</key>
- <string>^:.*$</string>
+ <string>^:</string>
<key>shellVariables</key>
<array>
<dict>
diff --git a/misc/Factor.tmbundle/Snippets/[ expanded.tmSnippet b/misc/Factor.tmbundle/Snippets/[ expanded.tmSnippet
index d26bdc2ee4..19035a17ef 100644
--- a/misc/Factor.tmbundle/Snippets/[ expanded.tmSnippet
+++ b/misc/Factor.tmbundle/Snippets/[ expanded.tmSnippet
@@ -4,8 +4,8 @@
<dict>
<key>content</key>
<string>[
- $0
-] </string>
+ $TM_SELECTED_TEXT$0
+]</string>
<key>keyEquivalent</key>
<string>~[</string>
<key>name</key>
diff --git a/misc/Factor.tmbundle/Snippets/[.tmSnippet b/misc/Factor.tmbundle/Snippets/[.tmSnippet
index b5f82f64a2..94cd7f731c 100644
--- a/misc/Factor.tmbundle/Snippets/[.tmSnippet
+++ b/misc/Factor.tmbundle/Snippets/[.tmSnippet
@@ -3,7 +3,7 @@
<plist version="1.0">
<dict>
<key>content</key>
- <string>[ $TM_SELECTED_TEXT$0 ] </string>
+ <string>[ $TM_SELECTED_TEXT$0 ]</string>
<key>keyEquivalent</key>
<string>[</string>
<key>name</key>
diff --git a/misc/Factor.tmbundle/Snippets/bi.tmSnippet b/misc/Factor.tmbundle/Snippets/bi.tmSnippet
index 6313564a0f..401ba702d7 100644
--- a/misc/Factor.tmbundle/Snippets/bi.tmSnippet
+++ b/misc/Factor.tmbundle/Snippets/bi.tmSnippet
@@ -5,7 +5,7 @@
<key>content</key>
<string>
[ $1 ]
- [ $2 ] bi </string>
+ [ $2 ] bi</string>
<key>name</key>
<string>bi</string>
<key>scope</key>
diff --git a/misc/Factor.tmbundle/Snippets/cleave.tmSnippet b/misc/Factor.tmbundle/Snippets/cleave.tmSnippet
index 3af7632d0c..ab77ff043a 100644
--- a/misc/Factor.tmbundle/Snippets/cleave.tmSnippet
+++ b/misc/Factor.tmbundle/Snippets/cleave.tmSnippet
@@ -8,7 +8,7 @@
[ $2 ]
[ $3 ]
[ $4 ]
-} cleave </string>
+} cleave</string>
<key>name</key>
<string>cleave</string>
<key>scope</key>
diff --git a/misc/Factor.tmbundle/Snippets/functor.tmSnippet b/misc/Factor.tmbundle/Snippets/functor.tmSnippet
index a30fdfe120..39c1a85e8b 100644
--- a/misc/Factor.tmbundle/Snippets/functor.tmSnippet
+++ b/misc/Factor.tmbundle/Snippets/functor.tmSnippet
@@ -8,7 +8,8 @@ FUNCTOR: $1 ( $2 -- $3 )
$4
WHERE
$0
-;FUNCTOR</string>
+;FUNCTOR
+</string>
<key>name</key>
<string>functor</string>
<key>scope</key>
diff --git a/misc/Factor.tmbundle/Snippets/if.tmSnippet b/misc/Factor.tmbundle/Snippets/if.tmSnippet
index 96e9cc52b8..83bb519b88 100644
--- a/misc/Factor.tmbundle/Snippets/if.tmSnippet
+++ b/misc/Factor.tmbundle/Snippets/if.tmSnippet
@@ -5,7 +5,7 @@
<key>content</key>
<string>
[ $1 ]
- [ $2 ] if </string>
+ [ $2 ] if</string>
<key>name</key>
<string>if</string>
<key>scope</key>
diff --git a/misc/Factor.tmbundle/Snippets/let.tmSnippet b/misc/Factor.tmbundle/Snippets/let.tmSnippet
index eecde87c5e..f1e8a388f7 100644
--- a/misc/Factor.tmbundle/Snippets/let.tmSnippet
+++ b/misc/Factor.tmbundle/Snippets/let.tmSnippet
@@ -6,7 +6,7 @@
<string>
[let | $1 [ $2 ] $3|
$0
- ] </string>
+ ]</string>
<key>name</key>
<string>let</string>
<key>scope</key>
diff --git a/misc/Factor.tmbundle/Snippets/spread.tmSnippet b/misc/Factor.tmbundle/Snippets/spread.tmSnippet
index ba5007a4e7..8193a7d94b 100644
--- a/misc/Factor.tmbundle/Snippets/spread.tmSnippet
+++ b/misc/Factor.tmbundle/Snippets/spread.tmSnippet
@@ -8,7 +8,7 @@
[ $2 ]
[ $3 ]
[ $4 ]
-} spread </string>
+} spread</string>
<key>name</key>
<string>spread</string>
<key>scope</key>
diff --git a/misc/Factor.tmbundle/Snippets/tri.tmSnippet b/misc/Factor.tmbundle/Snippets/tri.tmSnippet
index 02bd5a5c9a..5dcb037778 100644
--- a/misc/Factor.tmbundle/Snippets/tri.tmSnippet
+++ b/misc/Factor.tmbundle/Snippets/tri.tmSnippet
@@ -6,7 +6,7 @@
<string>
[ $1 ]
[ $2 ]
- [ $3 ] tri </string>
+ [ $3 ] tri</string>
<key>name</key>
<string>tri</string>
<key>scope</key>
diff --git a/misc/Factor.tmbundle/Snippets/{ expanded.tmSnippet b/misc/Factor.tmbundle/Snippets/{ expanded.tmSnippet
index 14bd6beaac..e6e3ffe5de 100644
--- a/misc/Factor.tmbundle/Snippets/{ expanded.tmSnippet
+++ b/misc/Factor.tmbundle/Snippets/{ expanded.tmSnippet
@@ -4,8 +4,8 @@
<dict>
<key>content</key>
<string>{
- $0
-} </string>
+ $TM_SELECTED_TEXT$0
+}</string>
<key>keyEquivalent</key>
<string>~{</string>
<key>name</key>
diff --git a/misc/Factor.tmbundle/Snippets/{.tmSnippet b/misc/Factor.tmbundle/Snippets/{.tmSnippet
index c252965639..ff5141b3a1 100644
--- a/misc/Factor.tmbundle/Snippets/{.tmSnippet
+++ b/misc/Factor.tmbundle/Snippets/{.tmSnippet
@@ -3,7 +3,7 @@
<plist version="1.0">
<dict>
<key>content</key>
- <string>{ $TM_SELECTED_TEXT$0 } </string>
+ <string>{ $TM_SELECTED_TEXT$0 }</string>
<key>keyEquivalent</key>
<string>{</string>
<key>name</key>
diff --git a/misc/Factor.tmbundle/Support/lib/do_scaffold.rb b/misc/Factor.tmbundle/Support/lib/do_scaffold.rb
deleted file mode 100644
index a0cc2bf033..0000000000
--- a/misc/Factor.tmbundle/Support/lib/do_scaffold.rb
+++ /dev/null
@@ -1,16 +0,0 @@
-#!/usr/bin/env ruby
-
-require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
-
-path = ENV["TM_FILEPATH"]
-if path.include?("factor/work") then
- s = "scaffold-work"
-elsif path.include?("factor/basis") then
- s = "scaffold-basis"
-elsif path.include?("factor/core") then
- s = "scaffold-core"
-else
- s = "scaffold-extra"
-end
-
-puts factor_eval(%Q(USE: tools.scaffold\n "#{ARGV.first}" #{s}))
\ No newline at end of file
diff --git a/misc/Factor.tmbundle/Templates/Vocabulary.tmTemplate/info.plist b/misc/Factor.tmbundle/Templates/Vocabulary.tmTemplate/info.plist
new file mode 100644
index 0000000000..1ee1c3a427
--- /dev/null
+++ b/misc/Factor.tmbundle/Templates/Vocabulary.tmTemplate/info.plist
@@ -0,0 +1,28 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+ <key>command</key>
+ <string>#!/usr/bin/env ruby
+require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
+require ENV['TM_SUPPORT_PATH'] + '/lib/ui'
+
+a = TextMate::UI.request_string(:title => "Scaffold Setup", :prompt =>
+"Vocab Name:")
+b = ENV["TM_FILEPATH"]
+if b then c = b[/\/factor\/([^\/]+)\//,1]
+else c = "work"
+end
+factor_eval(%Q(USING: kernel editors tools.scaffold ; "#{a}" dup #{"scaffold-" << c} edit-vocab))</string>
+ <key>extension</key>
+ <string>factor</string>
+ <key>keyEquivalent</key>
+ <string>@N</string>
+ <key>name</key>
+ <string>Vocabulary</string>
+ <key>scope</key>
+ <string>source.factor</string>
+ <key>uuid</key>
+ <string>B6D1D91E-3EF3-4112-97DF-BFCABEBAA1C9</string>
+</dict>
+</plist>
diff --git a/misc/Factor.tmbundle/info.plist b/misc/Factor.tmbundle/info.plist
index 4c101835b1..15362802e4 100644
--- a/misc/Factor.tmbundle/info.plist
+++ b/misc/Factor.tmbundle/info.plist
@@ -3,9 +3,7 @@
<plist version="1.0">
<dict>
<key>deleted</key>
- <array>
- <string>4D090AD9-76F9-4A0B-B3F2-7428B7C15FBA</string>
- </array>
+ <array/>
<key>mainMenu</key>
<dict>
<key>excludedItems</key>
@@ -23,20 +21,21 @@
<string>B9DA0999-D710-4693-8056-9E4B8BDAC7E9</string>
<string>7903894E-CB75-43ED-8635-C0E65F94DEBB</string>
<string>9A96D386-F7B9-47DC-9CAE-E4BAD1F81748</string>
+ <string>F771F82B-6B2B-4DAE-9A2A-E1042D3B08AD</string>
+ <string>275EA395-6026-481A-81C5-1F71D8026972</string>
</array>
<key>items</key>
<array>
- <string>0CDA009F-8518-4C45-AB0E-D11B281131BF</string>
<string>8088D204-FFD7-4384-8FDD-A01536FFD0E7</string>
<string>CAD3BB10-C480-4C0E-9518-94D61F7A0C0B</string>
<string>82E740D1-8D20-48AF-8470-C85C251D4870</string>
<string>D348BE40-6F51-4471-B300-DDDA70ED8C8C</string>
- <string>86DD4385-4029-4EFE-B546-1EC8EB5EB932</string>
<string>9D99C141-EC9D-4C9E-9C08-0CA4EAEA2F3E</string>
<string>1C72489C-15A1-4B44-BCDF-438962D4F3EB</string>
<string>9E5EC5B6-AABD-4657-A663-D3C558051216</string>
<string>219C4AB2-742E-48FE-92E1-CB2EC19C8A24</string>
<string>D25BF2AE-0595-44AE-B97A-9F20D4E28173</string>
+ <string>93AF1721-C14D-428A-B5A0-34CEFAA3B3C5</string>
</array>
<key>submenus</key>
<dict>
@@ -70,6 +69,7 @@
<string>D02D9D74-E073-48AE-A78E-B40FFFA519D5</string>
<string>C573487C-DD7D-497F-A728-52D7962D95E2</string>
<string>D95A617C-E1C6-44DA-9126-04171CB21299</string>
+ <string>0034EC1C-DAD1-498F-82FD-BEF7015F84EE</string>
</array>
<key>name</key>
<string>Edit</string>
@@ -106,6 +106,7 @@
<string>3C9C9C2A-314A-475B-A4E4-A68BAAF3F36E</string>
<string>D60675B0-9BF4-4CCF-9066-CA14FE836981</string>
<string>141517D7-73E0-4475-A481-71102575A175</string>
+ <string>B6D1D91E-3EF3-4112-97DF-BFCABEBAA1C9</string>
<string>CAD3BB10-C480-4C0E-9518-94D61F7A0C0B</string>
<string>8088D204-FFD7-4384-8FDD-A01536FFD0E7</string>
<string>15A984BD-BC65-43E8-878A-267788C8DA70</string>
@@ -114,7 +115,7 @@
<string>BC5BE120-734B-40DF-8B6B-5D3243614B27</string>
<string>B619FCC0-2DF2-4657-82A8-0E5676A10254</string>
<string>DBC0A0CA-5368-43A7-864B-7B9C4034AD08</string>
- <string>86DD4385-4029-4EFE-B546-1EC8EB5EB932</string>
+ <string>93AF1721-C14D-428A-B5A0-34CEFAA3B3C5</string>
<string>3043A033-A113-4283-BCBB-3DE2CCC8F63E</string>
<string>B1F81321-B760-474F-875D-78FB52752E1B</string>
<string>BC3E2E39-3B79-460C-B05E-BD00BAACB90E</string>
@@ -124,10 +125,10 @@
<string>E4614756-DF2E-433A-8935-197159C67AB8</string>
<string>D02D9D74-E073-48AE-A78E-B40FFFA519D5</string>
<string>C573487C-DD7D-497F-A728-52D7962D95E2</string>
+ <string>0034EC1C-DAD1-498F-82FD-BEF7015F84EE</string>
<string>D95A617C-E1C6-44DA-9126-04171CB21299</string>
<string>71F08D9B-3D24-4E78-84C9-82CA736554D1</string>
<string>7FF52332-CA5B-4D46-99EF-DAE0659DB478</string>
- <string>0CDA009F-8518-4C45-AB0E-D11B281131BF</string>
<string>D348BE40-6F51-4471-B300-DDDA70ED8C8C</string>
<string>1B3CF04D-B23D-4D9A-A648-7191315CDF96</string>
<string>3F17AF0F-4DE0-4A86-A649-CB65907F0DA5</string>
From c05e91a7a33a903a5bfebbf4021d87ca5ebe60ed Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Tue, 4 Aug 2009 17:16:34 -0500
Subject: [PATCH 118/128] replaced redundancies
---
extra/classes/algebraic/algebraic-docs.factor | 5 -----
extra/classes/algebraic/algebraic.factor | 10 ----------
extra/classes/algebraic/authors.txt | 1 -
extra/classes/algebraic/summary.txt | 1 -
extra/fonts/syntax/syntax.factor | 4 ++--
extra/sequences/extras/extras.factor | 5 +----
extra/ui/gadgets/layout/layout.factor | 2 +-
7 files changed, 4 insertions(+), 24 deletions(-)
delete mode 100644 extra/classes/algebraic/algebraic-docs.factor
delete mode 100644 extra/classes/algebraic/algebraic.factor
delete mode 100644 extra/classes/algebraic/authors.txt
delete mode 100644 extra/classes/algebraic/summary.txt
diff --git a/extra/classes/algebraic/algebraic-docs.factor b/extra/classes/algebraic/algebraic-docs.factor
deleted file mode 100644
index 4d641a80e6..0000000000
--- a/extra/classes/algebraic/algebraic-docs.factor
+++ /dev/null
@@ -1,5 +0,0 @@
-USING: help.markup help.syntax ;
-IN: classes.algebraic
-HELP: DATA:
-{ $syntax "DATA: class constructor | constructor arg ... | ... ;" }
-{ $description "Creates a haskell style algebraic data type. For each constructor, a seperate tuple is created, and the resulting tuples are added to a union class." } ;
\ No newline at end of file
diff --git a/extra/classes/algebraic/algebraic.factor b/extra/classes/algebraic/algebraic.factor
deleted file mode 100644
index 09ff137797..0000000000
--- a/extra/classes/algebraic/algebraic.factor
+++ /dev/null
@@ -1,10 +0,0 @@
-USING: classes.parser classes.tuple classes.union kernel peg
-peg-lexer sequences ;
-IN: classes.algebraic
-
-ON-BNF: DATA:
-tokenizer = <foreign factor>
-delimit = "|" => [[ drop ignore ]]
-tuple = (!("|"|";").)+ => [[ unclip create-class-in [ tuple rot define-tuple-class ] keep ]]
-expr = . tuple (delimit tuple)* ";" => [[ first3 swap prefix [ create-class-in ] dip define-union-class ignore ]]
-;ON-BNF
\ No newline at end of file
diff --git a/extra/classes/algebraic/authors.txt b/extra/classes/algebraic/authors.txt
deleted file mode 100644
index ce0899f16e..0000000000
--- a/extra/classes/algebraic/authors.txt
+++ /dev/null
@@ -1 +0,0 @@
-Sam Anklesaria
\ No newline at end of file
diff --git a/extra/classes/algebraic/summary.txt b/extra/classes/algebraic/summary.txt
deleted file mode 100644
index 082638e8d5..0000000000
--- a/extra/classes/algebraic/summary.txt
+++ /dev/null
@@ -1 +0,0 @@
-Haskell-like algebraic data types
\ No newline at end of file
diff --git a/extra/fonts/syntax/syntax.factor b/extra/fonts/syntax/syntax.factor
index 1cda01da4d..c296dfb3df 100644
--- a/extra/fonts/syntax/syntax.factor
+++ b/extra/fonts/syntax/syntax.factor
@@ -1,8 +1,8 @@
-USING: accessors arrays classes.algebraic combinators io.styles
+USING: accessors arrays variants combinators io.styles
kernel math parser sequences fry ;
IN: fonts.syntax
-DATA: fontname serif | monospace ;
+VARIANT: fontname serif monospace ;
: install ( object quot -- quot/? ) over [ curry ] [ 2drop [ ] ] if ;
diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor
index 37d1d9487a..d8e5e45d3b 100644
--- a/extra/sequences/extras/extras.factor
+++ b/extra/sequences/extras/extras.factor
@@ -15,8 +15,5 @@ IN: sequences.extras
[ unclip id swap quot call( prev elt -- next ) quot reduce* ] if-empty ; inline recursive
:: combos ( list1 list2 -- result ) list2 [ [ 2array ] curry list1 swap map ] map concat ;
-: (head-slice) ( seq n -- seq' ) over length over < [ drop ] [ head-slice ] if ;
: find-all ( seq quot -- elts ) [ [ length iota ] keep ] dip
- [ dupd call( a -- ? ) [ 2array ] [ 2drop f ] if ] curry 2map [ ] filter ; inline
-
-: empty ( seq -- ) 0 swap shorten ;
\ No newline at end of file
+ [ dupd call( a -- ? ) [ 2array ] [ 2drop f ] if ] curry 2map [ ] filter ; inline
\ No newline at end of file
diff --git a/extra/ui/gadgets/layout/layout.factor b/extra/ui/gadgets/layout/layout.factor
index f155b292e1..309c86c5f6 100644
--- a/extra/ui/gadgets/layout/layout.factor
+++ b/extra/ui/gadgets/layout/layout.factor
@@ -14,7 +14,7 @@ TUPLE: placeholder < gadget members ;
: (remove-members) ( placeholder members -- ) [ [ model? ] filter swap parent>> model>> [ remove-connection ] curry each ]
[ nip [ gadget? ] filter [ unparent ] each ] 2bi ;
-: remove-members ( placeholder -- ) dup members>> [ drop ] [ [ (remove-members) ] keep empty ] if-empty ;
+: remove-members ( placeholder -- ) dup members>> [ drop ] [ [ (remove-members) ] keep delete-all ] if-empty ;
: add-member ( obj placeholder -- ) over layout? [ [ gadget>> ] dip ] when members>> push ;
: , ( item -- ) make:, ;
From f9cc05e14aa6e383ae96a4a749ef77d9346da0a4 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Tue, 4 Aug 2009 21:57:27 -0500
Subject: [PATCH 119/128] gadgets.controls.refactoring
---
extra/ui/gadgets/controls/controls.factor | 11 +++++------
1 file changed, 5 insertions(+), 6 deletions(-)
diff --git a/extra/ui/gadgets/controls/controls.factor b/extra/ui/gadgets/controls/controls.factor
index a90d8ecc98..26c6184d4c 100644
--- a/extra/ui/gadgets/controls/controls.factor
+++ b/extra/ui/gadgets/controls/controls.factor
@@ -33,7 +33,7 @@ M: table tbl:row-color color-quot>> [ call( a -- b ) ] [ drop f ] if* ;
: indexed ( table -- table ) f >>val-quot ;
TUPLE: model-field < field model* ;
-: init-field ( field -- field' ) [ [ ] [ "" ] if* ] change-value ;
+: init-field ( model -- model' ) [ [ ] [ "" ] if* ] change-value ;
: <model-field> ( model -- gadget ) model-field new-field swap init-field >>model* ;
M: model-field graft*
[ [ model*>> value>> ] [ editor>> ] bi set-editor-string ]
@@ -45,13 +45,12 @@ M: model-field ungraft*
M: model-field model-changed 2dup model*>> =
[ [ value>> ] [ editor>> ] bi* set-editor-string ]
[ nip [ editor>> editor-string ] [ model*>> ] bi set-model ] if ;
-
+
+: (new-field) ( editor field -- gadget ) [ new-editor ] dip new-border dup gadget-child >>editor
+ field-theme { 1 0 } >>align ; inline
: <model-field*> ( -- field ) "" <model> <model-field> ;
: <empty-field> ( model -- field ) "" <model> switch-models <model-field> ;
-: (model-editor) ( model class -- gadget )
- model-field [ new-editor ] dip new-border dup gadget-child >>editor
- field-theme swap init-field >>model* { 1 0 } >>align ;
-: <model-editor> ( model -- gadget ) multiline-editor (model-editor) ;
+: <model-editor> ( model -- gadget ) multiline-editor model-field (new-field) swap init-field >>model* ;
: <model-editor*> ( -- editor ) "" <model> <model-editor> ;
: <empty-editor> ( model -- editor ) "" <model> switch-models <model-editor> ;
From 42d478054f0e5daf439ddc802b8663af6ed8b69d Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Wed, 5 Aug 2009 08:44:14 -0500
Subject: [PATCH 120/128] ui.gadgets.layout: add-gadget-at refactored
---
extra/recipes/recipes.factor | 2 +-
extra/ui/gadgets/layout/layout.factor | 14 ++++++++++----
2 files changed, 11 insertions(+), 5 deletions(-)
diff --git a/extra/recipes/recipes.factor b/extra/recipes/recipes.factor
index a99e65cf5c..7fd7dc559c 100644
--- a/extra/recipes/recipes.factor
+++ b/extra/recipes/recipes.factor
@@ -11,7 +11,7 @@ STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } {
"recipes.db" temp-file <sqlite-db> recipe define-db
: top-recipes ( offset search -- recipes ) <query> T{ recipe } rot >>title >>tuple
"votes" >>order 30 >>limit swap >>offset get-tuples ;
-: top-genres ( -- genres ) f f top-recipes [ genre>> ] map prune 4 (head-slice) ;
+: top-genres ( -- genres ) f f top-recipes [ genre>> ] map prune 4 short head-slice ;
: interface ( -- book ) [
[
diff --git a/extra/ui/gadgets/layout/layout.factor b/extra/ui/gadgets/layout/layout.factor
index 309c86c5f6..3949ba6ee4 100644
--- a/extra/ui/gadgets/layout/layout.factor
+++ b/extra/ui/gadgets/layout/layout.factor
@@ -35,7 +35,7 @@ M: model -> dup , ;
: <spacer> ( -- ) <gadget> 1 <layout> , ;
-: add-layout ( track layout -- track ) [ gadget>> ] [ size>> ] bi track-add ; inline
+: add-layout ( track layout -- track ) [ gadget>> ] [ size>> ] bi track-add ;
: layouts ( sized? gadgets -- layouts ) [ [ gadget? ] [ layout? ] bi or ] filter swap
[ [ dup layout? [ f <layout> ] unless ] map ]
[ [ dup gadget? [ gadget>> ] unless ] map ] if ;
@@ -61,10 +61,16 @@ SYNTAX: $ CREATE-WORD dup
: insert-size ( number parent size -- ) -rot [ but-last insert-nth ] change-sizes drop ;
: insertion-point ( placeholder -- number parent ) dup parent>> [ children>> index ] keep ;
+GENERIC: >layout ( gadget -- layout )
+M: gadget >layout f <layout> ;
+M: layout >layout ;
+
+GENERIC# (add-gadget-at) 2 ( parent item n -- )
+M: gadget (add-gadget-at) -rot [ add-gadget ] keep insert-gadget ;
+M: track (add-gadget-at) -rot >layout [ add-layout ] keep [ gadget>> insert-gadget ] [ size>> insert-size ] 3bi ;
+
GENERIC# add-gadget-at 1 ( item location -- )
-M: gadget add-gadget-at dup parent>> track? [ [ f <layout> ] dip add-gadget-at ]
- [ insertion-point rot [ add-gadget ] keep insert-gadget ] if ;
-M: layout add-gadget-at insertion-point rot [ add-layout ] keep [ gadget>> insert-gadget ] [ size>> insert-size ] 3bi ;
+M: object add-gadget-at insertion-point -rot (add-gadget-at) ;
M: model add-gadget-at parent>> dup book:book? [ "No models in books" throw ]
[ dup model>> dup collection? [ nip swap add-connection ] [ drop [ 1array <collection> ] dip (>>model) ] if ] if ;
: track-add-at ( item location size -- ) swap [ <layout> ] dip add-gadget-at ;
From 0c4b9a0d58d19258abed9ec92de380ab7e366beb Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Wed, 5 Aug 2009 16:24:56 -0500
Subject: [PATCH 121/128] simplified ui.gadgets.tables
---
.../search-tables/search-tables.factor | 2 +-
basis/ui/gadgets/tables/tables-docs.factor | 10 ++-
basis/ui/gadgets/tables/tables.factor | 65 +++++++++----------
basis/ui/tools/error-list/error-list.factor | 4 +-
extra/recipes/recipes.factor | 2 +-
extra/sequences/extras/extras.factor | 4 +-
extra/ui/gadgets/controls/controls.factor | 7 +-
7 files changed, 42 insertions(+), 52 deletions(-)
diff --git a/basis/ui/gadgets/search-tables/search-tables.factor b/basis/ui/gadgets/search-tables/search-tables.factor
index fc564b6ffe..9f55c7a67d 100644
--- a/basis/ui/gadgets/search-tables/search-tables.factor
+++ b/basis/ui/gadgets/search-tables/search-tables.factor
@@ -58,7 +58,7 @@ mouse-color
column-line-color
selection-required?
single-click?
-selected-value
+selection
min-rows
min-cols
max-rows
diff --git a/basis/ui/gadgets/tables/tables-docs.factor b/basis/ui/gadgets/tables/tables-docs.factor
index 4f016caa8a..81e5f0f778 100644
--- a/basis/ui/gadgets/tables/tables-docs.factor
+++ b/basis/ui/gadgets/tables/tables-docs.factor
@@ -16,19 +16,17 @@ $nl
{ $subsection column-titles } ;
ARTICLE: "ui.gadgets.tables.selection" "Table row selection"
-"At any given time, a single row in the table may be selected."
-$nl
"A few slots in the table gadget concern row selection:"
{ $table
- { { $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" } { " - if set to a model, the values of the currently selected row or rows, as determined by a " { $link row-value } " call to the renderer, is stored in this model. See " { $link "models" } "." } }
+ { { $slot "selection-index" } { " - if set to a model, 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-rows }
-{ $subsection (selected-rows) } ;
+{ $subsection (selected-rows) }
+{ $subsection selected } ;
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 353dd91270..c5cd144f18 100644
--- a/basis/ui/gadgets/tables/tables.factor
+++ b/basis/ui/gadgets/tables/tables.factor
@@ -7,7 +7,7 @@ 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 models
combinators combinators.short-circuit
-fonts locals strings sorting ;
+fonts locals strings sequences.extras sets ;
IN: ui.gadgets.tables
! Row rendererer protocol
@@ -42,40 +42,33 @@ focus-border-color
{ mouse-color initial: COLOR: black }
column-line-color
selection-required?
-selected-indices selected-values
-selected-indices*
+selection
+selection-index
+selected-indices
mouse-index
{ takes-focus? initial: t }
focused?
multiple-selection? ;
-: in>out ( array -- val/f ) [ f ] [ first ] if-empty ;
-: out>in ( val/f -- array ) [ 1array ] [ { } ] if* ;
-IN: accessors
-SLOT: selected-value
-SLOT: selected-index
-SLOT: selected-index*
-M: table selected-value>> selected-values>> [ in>out ] <illusion> ;
-M: table (>>selected-value) [ [ out>in ] <activated-illusion> ] 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 ] <illusion> ;
-M: table (>>selected-index*) [ [ out>in ] <activated-illusion> ] dip (>>selected-indices*) ;
+<PRIVATE
-IN: ui.gadgets.tables
-: push-selected-index ( table n -- table ) 2dup swap selected-indices>> index
- [ drop ] [ over selected-indices>> swap suffix natural-sort >>selected-indices ] if ;
+: push-selected-index ( table n -- table ) swap [ insert-sorted prune >array ] change-selected-indices ;
+: multiple>single ( values -- value/f ? ) [ f f ] [ first t ] if-empty ;
+: multiple>single* ( values -- value/f ) multiple>single drop ;
+: selected-index ( table -- n ) selected-indices>> multiple>single* ;
+: set-selected-index ( table n -- table ) 1array >>selected-indices ;
+PRIVATE>
+: selected ( table -- index/indices ) dup multiple-selection?>> [ selected-indices>> ] [ selected-index ] if ;
: new-table ( rows renderer class -- table )
new-line-gadget
swap >>renderer
swap >>model
- { } >>selected-indices
- { } <model> >>selected-values
- { } <model> >>selected-indices*
sans-serif-font >>font
focus-border-color >>focus-border-color
- transparent >>column-line-color ; inline
+ transparent >>column-line-color
+ f <model> >>selection-index
+ f <model> >>selection ;
: <table> ( rows renderer -- table ) table new-table ;
@@ -165,9 +158,9 @@ M: table layout*
: draw-focused-row ( table -- )
{
{ [ dup focused?>> not ] [ drop ] }
- { [ dup selected-index>> not ] [ drop ] }
+ { [ dup selected-index not ] [ drop ] }
[
- [ ] [ selected-index>> ] [ focus-border-color>> gl-color ] tri
+ [ ] [ selected-index ] [ focus-border-color>> gl-color ] tri
row-bounds gl-rect
]
} cond ;
@@ -264,16 +257,16 @@ PRIVATE>
: selected-rows ( table -- {value} )
[ (selected-rows) ] [ renderer>> ] bi [ row-value ] curry map ;
-
-: multiple>single ( values -- value/f ? ) [ f f ] [ first t ] if-empty ;
: (selected-row) ( table -- value/f ? ) (selected-rows) multiple>single ;
: selected-row ( table -- value/f ? ) selected-rows multiple>single ;
<PRIVATE
-: update-selected-values ( table -- )
- [ [ selected-rows ] [ selected-values>> ] bi set-model ]
- [ [ selected-indices>> ] [ selected-indices*>> ] bi set-model ] bi ;
+: set-table-model ( model value multiple? -- ) [ multiple>single* ] unless swap set-model ;
+
+: update-selected ( table -- )
+ [ [ selection>> ] [ selected-rows ] [ multiple-selection?>> ] tri set-table-model ]
+ [ [ selection-index>> ] [ selected-indices>> ] [ multiple-selection?>> ] tri set-table-model ] bi ;
: show-row-summary ( table n -- )
over nth-row
@@ -295,7 +288,7 @@ PRIVATE>
} 1&& ;
: (update-selected-indices) ( table -- {n}/f )
- [ selected-values>> value>> ] keep
+ [ selection>> value>> dup array? [ 1array ] unless ] keep
[ find-row-index ] curry map [ ] filter [ f ] when-empty ;
: update-selected-indices ( table -- {n}/f )
@@ -308,7 +301,7 @@ M: table model-changed
nip dup update-selected-indices [ { } ] unless* {
[ >>selected-indices f >>mouse-index drop ]
[ [ f ] [ first ] if-empty show-row-summary ]
- [ drop update-selected-values ]
+ [ drop update-selected ]
[ drop relayout ]
} 2cleave ;
@@ -324,7 +317,7 @@ M: table model-changed
: (select-row) ( table n -- )
[ scroll-to-row ]
- [ >>selected-index relayout-1 ]
+ [ set-selected-index relayout-1 ]
2bi ;
: mouse-row ( table -- n )
@@ -341,7 +334,7 @@ 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?>> [
- [ 2dup over selected-index>> (a,b) swap
+ [ 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 ;
@@ -360,7 +353,7 @@ PRIVATE>
: table-button-up ( table -- )
dup [ mouse-row ] keep valid-line? [
- dup row-action? [ row-action ] [ update-selected-values ] if
+ dup row-action? [ row-action ] [ update-selected ] if
] [ drop ] if ;
PRIVATE>
@@ -368,14 +361,14 @@ PRIVATE>
: select-row ( table n -- )
over validate-line
[ (select-row) ]
- [ drop update-selected-values ]
+ [ drop update-selected ]
[ show-row-summary ]
2tri ;
<PRIVATE
: prev/next-row ( table n -- )
- [ dup selected-index>> ] dip '[ _ + ] [ 0 ] if* select-row ;
+ [ dup selected-index ] dip '[ _ + ] [ 0 ] if* select-row ;
: previous-row ( table -- )
-1 prev/next-row ;
diff --git a/basis/ui/tools/error-list/error-list.factor b/basis/ui/tools/error-list/error-list.factor
index e9d4b50bac..1193ca237c 100644
--- a/basis/ui/tools/error-list/error-list.factor
+++ b/basis/ui/tools/error-list/error-list.factor
@@ -71,7 +71,7 @@ M: source-file-renderer filled-column drop 1 ;
60 >>min-cols
60 >>max-cols
t >>selection-required?
- error-list source-file>> >>selected-value ;
+ error-list source-file>> >>selection ;
SINGLETON: error-renderer
@@ -120,7 +120,7 @@ M: error-renderer column-alignment drop { 0 1 0 0 } ;
60 >>min-cols
60 >>max-cols
t >>selection-required?
- error-list error>> >>selected-value ;
+ error-list error>> >>selection ;
TUPLE: error-display < track ;
diff --git a/extra/recipes/recipes.factor b/extra/recipes/recipes.factor
index 7fd7dc559c..5681e4395e 100644
--- a/extra/recipes/recipes.factor
+++ b/extra/recipes/recipes.factor
@@ -39,7 +39,7 @@ STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } {
<spacer> <model-field*> ->% 1 :> search
submit ok [ [ drop ] ] <$ 2array merge [ drop ] >>value :> quot
viewed 0 [ + ] fold search ok t <basic> "all" <model-btn> ALL ->
- tbl selected-value>> votes [ [ + ] curry change-votes modify-tuple ] 2$>
+ tbl selection>> votes [ [ + ] curry change-votes modify-tuple ] 2$>
4array merge
[ drop [ f ] [ "%" dup surround <pattern> ] if-empty top-recipes ] 3fmap :> ups
ups [ top-genres [ <model-btn> GENRES -> ] map merge ] bind*
diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor
index d8e5e45d3b..5256bea5ce 100644
--- a/extra/sequences/extras/extras.factor
+++ b/extra/sequences/extras/extras.factor
@@ -16,4 +16,6 @@ IN: sequences.extras
:: combos ( list1 list2 -- result ) list2 [ [ 2array ] curry list1 swap map ] map concat ;
: find-all ( seq quot -- elts ) [ [ length iota ] keep ] dip
- [ dupd call( a -- ? ) [ 2array ] [ 2drop f ] if ] curry 2map [ ] filter ; inline
\ No newline at end of file
+ [ dupd call( a -- ? ) [ 2array ] [ 2drop f ] if ] curry 2map [ ] filter ; inline
+
+: insert-sorted ( elt seq -- seq ) 2dup [ < ] with find drop over length or swap insert-nth ;
\ No newline at end of file
diff --git a/extra/ui/gadgets/controls/controls.factor b/extra/ui/gadgets/controls/controls.factor
index 26c6184d4c..649c9052fd 100644
--- a/extra/ui/gadgets/controls/controls.factor
+++ b/extra/ui/gadgets/controls/controls.factor
@@ -24,8 +24,7 @@ M: table tbl:row-value val-quot>> [ call( a -- b ) ] [ drop f ] if* ;
M: table tbl:row-color color-quot>> [ call( a -- b ) ] [ drop f ] if* ;
: new-table ( model class -- table ) f swap tbl:new-table dup >>renderer
- V{ } clone <basic> >>selected-values V{ } clone <basic> >>selected-indices*
- f <basic> >>actions dup [ actions>> set-model ] curry >>action ;
+ f <basic> >>actions dup actions>> [ set-model ] curry >>action ;
: <table> ( model -- table ) table new-table ;
: <table*> ( -- table ) V{ } clone <model> <table> ;
: <list> ( column-model -- table ) <table> [ 1array ] >>quot ;
@@ -66,9 +65,7 @@ SYNTAX: IMG-BTN: image-prep [ swap <button> ] curry over push-all ;
GENERIC: output-model ( gadget -- model )
M: gadget output-model model>> ;
-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: table output-model dup val-quot>> [ selection>> ] [ selection-index>> ] if ;
M: model-field output-model model*>> ;
M: scroller output-model viewport>> children>> first output-model ;
M: slider output-model model>> range-model ;
From e426bc4be893c029a5744a192dfbd317a955a726 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Wed, 5 Aug 2009 16:45:22 -0500
Subject: [PATCH 122/128] moved patterns to persistency for new db prep
---
basis/db/queries/queries.factor | 6 +-----
extra/persistency/persistency.factor | 13 +++++++++----
extra/recipes/recipes.factor | 2 +-
3 files changed, 11 insertions(+), 10 deletions(-)
diff --git a/basis/db/queries/queries.factor b/basis/db/queries/queries.factor
index d2674205b1..c4aa47d383 100755
--- a/basis/db/queries/queries.factor
+++ b/basis/db/queries/queries.factor
@@ -4,7 +4,7 @@ USING: accessors kernel math namespaces make sequences random
strings math.parser math.intervals combinators math.bitwise
nmake db db.tuples db.types classes words shuffle arrays
destructors continuations db.tuples.private prettyprint
-db.private byte-arrays strings.parser parser ;
+db.private byte-arrays ;
IN: db.queries
GENERIC: where ( specs obj -- )
@@ -130,10 +130,6 @@ M: integer where ( spec obj -- ) object-where ;
M: string where ( spec obj -- ) object-where ;
-TUPLE: pattern value ; C: <pattern> pattern
-SYNTAX: %" parse-string <pattern> parsed ;
-M: pattern where value>> over column-name>> 0% " LIKE " 0% bind# ;
-
: filter-slots ( tuple specs -- specs' )
[
slot-name>> swap get-slot-named
diff --git a/extra/persistency/persistency.factor b/extra/persistency/persistency.factor
index 1604c66b40..f459eca7e4 100644
--- a/extra/persistency/persistency.factor
+++ b/extra/persistency/persistency.factor
@@ -1,6 +1,7 @@
-USING: accessors arrays byte-arrays calendar classes classes.tuple
-classes.tuple.parser combinators db db.tuples db.types kernel
-math sequences strings unicode.case urls words ;
+USING: accessors arrays byte-arrays calendar classes
+classes.tuple classes.tuple.parser combinators db db.queries
+db.tuples db.types kernel math nmake parser sequences strings
+strings.parser unicode.case urls words ;
IN: persistency
TUPLE: persistent id ;
@@ -22,4 +23,8 @@ SYNTAX: STORED-TUPLE: parse-tuple-definition [ drop persistent ] dip [ remove-ty
: get-tuple ( query -- tuple ) [ select-tuple ] w/db ;
: store-tuple ( tuple -- ) [ insert-tuple ] w/db ;
: modify-tuple ( tuple -- ) [ update-tuple ] w/db ;
-: remove-tuples ( tuple -- ) [ delete-tuples ] w/db ;
\ No newline at end of file
+: remove-tuples ( tuple -- ) [ delete-tuples ] w/db ;
+
+TUPLE: pattern value ; C: <pattern> pattern
+SYNTAX: %" parse-string <pattern> parsed ;
+M: pattern where value>> over column-name>> 0% " LIKE " 0% bind# ;
diff --git a/extra/recipes/recipes.factor b/extra/recipes/recipes.factor
index 5681e4395e..d546859589 100644
--- a/extra/recipes/recipes.factor
+++ b/extra/recipes/recipes.factor
@@ -1,4 +1,4 @@
-USING: accessors arrays colors.constants combinators db.queries
+USING: accessors arrays colors.constants combinators
db.sqlite db.tuples db.types kernel locals math
monads persistency sequences sequences.extras ui ui.gadgets.controls
ui.gadgets.layout models.combinators ui.gadgets.labels
From d65be18dce7d5bac9746a9b35b892014576abc38 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Wed, 5 Aug 2009 20:01:50 -0500
Subject: [PATCH 123/128] ui.gadgets.poppers: new ui gadget
---
extra/key-handlers/authors.txt | 1 +
extra/key-handlers/key-handlers.factor | 10 +++++
extra/ui/gadgets/layout/layout.factor | 2 +
extra/ui/gadgets/poppers/authors.txt | 1 +
extra/ui/gadgets/poppers/poppers.factor | 53 +++++++++++++++++++++++++
5 files changed, 67 insertions(+)
create mode 100644 extra/key-handlers/authors.txt
create mode 100644 extra/key-handlers/key-handlers.factor
create mode 100644 extra/ui/gadgets/poppers/authors.txt
create mode 100644 extra/ui/gadgets/poppers/poppers.factor
diff --git a/extra/key-handlers/authors.txt b/extra/key-handlers/authors.txt
new file mode 100644
index 0000000000..ce0899f16e
--- /dev/null
+++ b/extra/key-handlers/authors.txt
@@ -0,0 +1 @@
+Sam Anklesaria
\ No newline at end of file
diff --git a/extra/key-handlers/key-handlers.factor b/extra/key-handlers/key-handlers.factor
new file mode 100644
index 0000000000..b5171bece0
--- /dev/null
+++ b/extra/key-handlers/key-handlers.factor
@@ -0,0 +1,10 @@
+! Copyright (C) 2009 Sam Anklesaria.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs kernel ui.gadgets.borders ui.gestures ;
+IN: key-handlers
+
+TUPLE: key-handler < border handlers ;
+: <keys> ( gadget -- key-handler ) key-handler new-border { 0 0 } >>size ;
+
+M: key-handler handle-gesture
+ tuck handlers>> at [ call( gadget -- ) f ] [ drop t ] if* ;
\ No newline at end of file
diff --git a/extra/ui/gadgets/layout/layout.factor b/extra/ui/gadgets/layout/layout.factor
index 3949ba6ee4..bd3ab1dbc7 100644
--- a/extra/ui/gadgets/layout/layout.factor
+++ b/extra/ui/gadgets/layout/layout.factor
@@ -74,6 +74,8 @@ M: object add-gadget-at insertion-point -rot (add-gadget-at) ;
M: model add-gadget-at parent>> dup book:book? [ "No models in books" throw ]
[ dup model>> dup collection? [ nip swap add-connection ] [ drop [ 1array <collection> ] dip (>>model) ] if ] if ;
: track-add-at ( item location size -- ) swap [ <layout> ] dip add-gadget-at ;
+: (track-add-at) ( parent item n size -- ) swap [ <layout> ] dip (add-gadget-at) ;
+
: insert-item ( item location -- ) [ dup get [ drop ] [ remove-members ] if ] [ on ] [ ] tri
[ add-member ] 2keep add-gadget-at ;
diff --git a/extra/ui/gadgets/poppers/authors.txt b/extra/ui/gadgets/poppers/authors.txt
new file mode 100644
index 0000000000..ce0899f16e
--- /dev/null
+++ b/extra/ui/gadgets/poppers/authors.txt
@@ -0,0 +1 @@
+Sam Anklesaria
\ No newline at end of file
diff --git a/extra/ui/gadgets/poppers/poppers.factor b/extra/ui/gadgets/poppers/poppers.factor
new file mode 100644
index 0000000000..1b664ca407
--- /dev/null
+++ b/extra/ui/gadgets/poppers/poppers.factor
@@ -0,0 +1,53 @@
+! Copyright (C) 2009 Sam Anklesaria
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays accessors combinators kernel math
+models models.combinators namespaces sequences
+ui.gadgets ui.gadgets.controls ui.gadgets.layout
+ui.gadgets.tracks ui.gestures ui.gadgets.line-support ui ;
+EXCLUDE: ui.gadgets.editors => model-field ;
+IN: ui.gadgets.poppers
+
+TUPLE: popped < model-field { fatal? initial: t } ;
+TUPLE: popped-editor < multiline-editor ;
+: <popped> ( text -- gadget ) <basic> init-field popped-editor popped (new-field) swap >>model* ;
+
+: set-expansion ( popped size -- ) over dup parent>> [ children>> index ] [ sizes>> ] bi set-nth relayout ;
+: new-popped ( popped -- ) insertion-point "" <popped>
+ [ rot 1 + f (track-add-at) ] keep [ relayout ] [ request-focus ] bi ;
+: focus-prev ( popped -- ) dup parent>> children>> length 1 =
+ [ drop ] [
+ insertion-point [ 1 - dup -1 = [ drop 1 ] when ] [ children>> ] bi* nth
+ [ request-focus ] [ editor>> end-of-document ] bi
+ ] if ;
+: initial-popped ( popper -- ) "" <popped> [ f track-add drop ] keep request-focus ;
+
+TUPLE: popper < track { unfocus-hook initial: [ drop ] } ;
+! list of strings is model (make shown objects implement sequence protocol)
+: <popper> ( model -- popper ) vertical popper new-track swap >>model ;
+
+M: popped handle-gesture swap {
+ { gain-focus [ 1 set-expansion f ] }
+ { lose-focus [ dup parent>>
+ [ [ unfocus-hook>> call( a -- ) ] curry [ f set-expansion ] bi ]
+ [ drop ] if* f
+ ] }
+ { T{ key-up f f "RET" } [ dup editor>> delete-previous-character new-popped f ] }
+ { T{ key-up f f "BACKSPACE" } [ dup editor>> editor-string "" =
+ [ dup fatal?>> [ [ focus-prev ] [ unparent ] bi ] [ t >>fatal? drop ] if ]
+ [ f >>fatal? drop ] if f
+ ] }
+ [ swap call-next-method ]
+} case ;
+
+M: popper handle-gesture swap T{ button-down f f 1 } =
+ [ hand-click# get 2 = [ initial-popped ] [ drop ] if ] [ drop ] if f ;
+
+M: popper model-changed
+ [ children>> [ unparent ] each ]
+ [ [ value>> [ <popped> ] map ] dip [ f track-add ] reduce request-focus ] bi ;
+
+M: popped pref-dim* editor>> [ pref-dim* first ] [ line-height ] bi 2array ;
+M: popper focusable-child* children>> [ t ] [ first ] if-empty ;
+
+: tester ( -- ) { "ha" "ba" "Ra" } <model> <popper> { 100 100 } >>pref-dim "testing" open-window ;
+MAIN: tester
\ No newline at end of file
From 9d3fe3fd9a893211bc37603ba19b77c338238ec5 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Wed, 5 Aug 2009 20:04:14 -0500
Subject: [PATCH 124/128] removed demo from poppers
---
extra/ui/gadgets/poppers/poppers.factor | 7 ++-----
1 file changed, 2 insertions(+), 5 deletions(-)
diff --git a/extra/ui/gadgets/poppers/poppers.factor b/extra/ui/gadgets/poppers/poppers.factor
index 1b664ca407..1c815d5f3a 100644
--- a/extra/ui/gadgets/poppers/poppers.factor
+++ b/extra/ui/gadgets/poppers/poppers.factor
@@ -3,7 +3,7 @@
USING: arrays accessors combinators kernel math
models models.combinators namespaces sequences
ui.gadgets ui.gadgets.controls ui.gadgets.layout
-ui.gadgets.tracks ui.gestures ui.gadgets.line-support ui ;
+ui.gadgets.tracks ui.gestures ui.gadgets.line-support ;
EXCLUDE: ui.gadgets.editors => model-field ;
IN: ui.gadgets.poppers
@@ -47,7 +47,4 @@ M: popper model-changed
[ [ value>> [ <popped> ] map ] dip [ f track-add ] reduce request-focus ] bi ;
M: popped pref-dim* editor>> [ pref-dim* first ] [ line-height ] bi 2array ;
-M: popper focusable-child* children>> [ t ] [ first ] if-empty ;
-
-: tester ( -- ) { "ha" "ba" "Ra" } <model> <popper> { 100 100 } >>pref-dim "testing" open-window ;
-MAIN: tester
\ No newline at end of file
+M: popper focusable-child* children>> [ t ] [ first ] if-empty ;
\ No newline at end of file
From a352e7411e900c3745519f9d4988871c15fb0e1c Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Wed, 5 Aug 2009 21:29:48 -0500
Subject: [PATCH 125/128] reindented ui.gadgets.tables
---
basis/ui/gadgets/tables/tables.factor | 22 +++++++++++++++-------
1 file changed, 15 insertions(+), 7 deletions(-)
diff --git a/basis/ui/gadgets/tables/tables.factor b/basis/ui/gadgets/tables/tables.factor
index c5cd144f18..bb70173455 100644
--- a/basis/ui/gadgets/tables/tables.factor
+++ b/basis/ui/gadgets/tables/tables.factor
@@ -52,13 +52,15 @@ multiple-selection? ;
<PRIVATE
-: push-selected-index ( table n -- table ) swap [ insert-sorted prune >array ] change-selected-indices ;
+: push-selected-index ( table n -- table ) swap
+ [ insert-sorted prune >array ] change-selected-indices ;
: multiple>single ( values -- value/f ? ) [ f f ] [ first t ] if-empty ;
: multiple>single* ( values -- value/f ) multiple>single drop ;
: selected-index ( table -- n ) selected-indices>> multiple>single* ;
: set-selected-index ( table n -- table ) 1array >>selected-indices ;
PRIVATE>
-: selected ( table -- index/indices ) dup multiple-selection?>> [ selected-indices>> ] [ selected-index ] if ;
+: selected ( table -- index/indices ) dup multiple-selection?>>
+ [ selected-indices>> ] [ selected-index ] if ;
: new-table ( rows renderer class -- table )
new-line-gadget
@@ -262,11 +264,15 @@ PRIVATE>
<PRIVATE
-: set-table-model ( model value multiple? -- ) [ multiple>single* ] unless swap set-model ;
+: set-table-model ( model value multiple? -- )
+ [ multiple>single* ] unless swap set-model ;
: update-selected ( table -- )
[ [ selection>> ] [ selected-rows ] [ multiple-selection?>> ] tri set-table-model ]
- [ [ selection-index>> ] [ selected-indices>> ] [ multiple-selection?>> ] tri set-table-model ] bi ;
+ [
+ [ selection-index>> ] [ selected-indices>> ] [ multiple-selection?>> ] tri
+ set-table-model
+ ] bi ;
: show-row-summary ( table n -- )
over nth-row
@@ -332,11 +338,13 @@ M: table model-changed
'[ 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 ;
+: 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?>> [
- [ 2dup over selected-index (a,b) swap
+ [ 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 ;
+ swap (table-button-down)
+ ] [ table-button-down ] if ;
PRIVATE>
From dba67b18156f24a3df31feaeaec5c33b7a1291ba Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 5 Aug 2009 22:45:56 -0500
Subject: [PATCH 126/128] ui.gadgets.tables: little cleanup
---
basis/ui/gadgets/tables/tables.factor | 95 +++++++++++++++++----------
1 file changed, 59 insertions(+), 36 deletions(-)
diff --git a/basis/ui/gadgets/tables/tables.factor b/basis/ui/gadgets/tables/tables.factor
index bb70173455..eba646d08a 100644
--- a/basis/ui/gadgets/tables/tables.factor
+++ b/basis/ui/gadgets/tables/tables.factor
@@ -1,13 +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.illusion namespaces opengl sequences ui.gadgets
+USING: accessors assocs hashtables arrays colors colors.constants fry
+kernel math math.functions math.ranges 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 models
-combinators combinators.short-circuit
-fonts locals strings sequences.extras sets ;
+ui.gadgets.menus ui.gadgets.line-support models combinators
+combinators.short-circuit fonts locals strings sets sorting ;
IN: ui.gadgets.tables
! Row rendererer protocol
@@ -52,15 +51,23 @@ multiple-selection? ;
<PRIVATE
-: push-selected-index ( table n -- table ) swap
- [ insert-sorted prune >array ] change-selected-indices ;
-: multiple>single ( values -- value/f ? ) [ f f ] [ first t ] if-empty ;
-: multiple>single* ( values -- value/f ) multiple>single drop ;
-: selected-index ( table -- n ) selected-indices>> multiple>single* ;
-: set-selected-index ( table n -- table ) 1array >>selected-indices ;
+: add-selected-index ( table n -- table )
+ over selected-indices>> conjoin ;
+
+: multiple>single ( values -- value/f ? )
+ dup assoc-empty? [ drop f f ] [ keys first t ] if ;
+
+: selected-index ( table -- n )
+ selected-indices>> multiple>single drop ;
+
+: set-selected-index ( table n -- table )
+ dup associate >>selected-indices ;
+
PRIVATE>
-: selected ( table -- index/indices ) dup multiple-selection?>>
- [ selected-indices>> ] [ selected-index ] if ;
+
+: selected ( table -- index/indices )
+ [ selected-indices>> ] [ multiple-selection?>> ] bi
+ [ multiple>single drop ] unless ;
: new-table ( rows renderer class -- table )
new-line-gadget
@@ -70,7 +77,8 @@ PRIVATE>
focus-border-color >>focus-border-color
transparent >>column-line-color
f <model> >>selection-index
- f <model> >>selection ;
+ f <model> >>selection
+ H{ } clone >>selected-indices ;
: <table> ( rows renderer -- table ) table new-table ;
@@ -150,9 +158,9 @@ M: table layout*
: draw-selected-rows ( table -- )
{
- { [ dup selected-indices>> empty? ] [ drop ] }
+ { [ dup selected-indices>> assoc-empty? ] [ drop ] }
[
- [ selected-indices>> ] [ selection-color>> gl-color ] [ ] tri
+ [ selected-indices>> keys ] [ selection-color>> gl-color ] [ ] tri
[ swap row-bounds gl-fill-rect ] curry each
]
} cond ;
@@ -209,7 +217,8 @@ M: table layout*
:: row-font ( row ind table -- font )
table font>> clone
row table renderer>> row-color [ >>foreground ] when*
- ind table selected-indices>> index [ table selection-color>> >>background ] when ;
+ ind table selected-indices>> key?
+ [ table selection-color>> >>background ] when ;
: draw-columns ( columns widths alignment font gap -- )
'[ [ _ ] 3dip _ draw-column ] 3each ;
@@ -254,23 +263,32 @@ M: table pref-dim*
PRIVATE>
: (selected-rows) ( table -- {row} )
- [ selected-indices>> ] keep
- [ nth-row [ 1array ] [ drop { } ] if ] curry map concat ;
+ [ selected-indices>> keys natural-sort ] keep
+ '[ _ nth-row [ 1array ] [ drop { } ] if ] map concat ;
: selected-rows ( table -- {value} )
- [ (selected-rows) ] [ renderer>> ] bi [ row-value ] curry map ;
+ [ (selected-rows) ] [ renderer>> ] bi '[ _ row-value ] map ;
+
: (selected-row) ( table -- value/f ? ) (selected-rows) multiple>single ;
+
: selected-row ( table -- value/f ? ) selected-rows multiple>single ;
<PRIVATE
: set-table-model ( model value multiple? -- )
- [ multiple>single* ] unless swap set-model ;
+ [ multiple>single drop ] unless swap set-model ;
: update-selected ( table -- )
- [ [ selection>> ] [ selected-rows ] [ multiple-selection?>> ] tri set-table-model ]
[
- [ selection-index>> ] [ selected-indices>> ] [ multiple-selection?>> ] tri
+ [ selection>> ]
+ [ selected-rows ]
+ [ multiple-selection?>> ] tri
+ set-table-model
+ ]
+ [
+ [ selection-index>> ]
+ [ selected-indices>> ]
+ [ multiple-selection?>> ] tri
set-table-model
] bi ;
@@ -286,17 +304,17 @@ PRIVATE>
: find-row-index ( value table -- n/f )
[ model>> value>> ] [ renderer>> '[ _ row-value ] map index ] bi ;
-: initial-selected-indices ( table -- {n}/f )
+: (update-selected-indices) ( table -- set )
+ [ selection>> value>> dup array? [ 1array ] unless ] keep
+ [ find-row-index ] curry map sift unique f like ;
+
+: initial-selected-indices ( table -- set )
{
[ model>> value>> empty? not ]
[ selection-required?>> ]
- [ drop { 0 } ]
+ [ drop { 0 } unique ]
} 1&& ;
-: (update-selected-indices) ( table -- {n}/f )
- [ selection>> value>> dup array? [ 1array ] unless ] keep
- [ find-row-index ] curry map [ ] filter [ f ] when-empty ;
-
: update-selected-indices ( table -- {n}/f )
{
[ (update-selected-indices) ]
@@ -304,7 +322,7 @@ PRIVATE>
} 1|| ;
M: table model-changed
- nip dup update-selected-indices [ { } ] unless* {
+ nip dup update-selected-indices {
[ >>selected-indices f >>mouse-index drop ]
[ [ f ] [ first ] if-empty show-row-summary ]
[ drop update-selected ]
@@ -319,7 +337,7 @@ M: table model-changed
: add-selected-row ( table n -- )
[ scroll-to-row ]
- [ push-selected-index relayout-1 ] 2bi ;
+ [ add-selected-index relayout-1 ] 2bi ;
: (select-row) ( table n -- )
[ scroll-to-row ]
@@ -337,12 +355,17 @@ M: table model-changed
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?>>
+: 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?>> [
+
+: thru-button-down ( table -- )
+ dup multiple-selection?>> [
[ 2dup over selected-index (a,b) swap
- [ swap push-selected-index drop ] curry each add-selected-row ]
+ [ swap add-selected-index drop ] curry each add-selected-row ]
swap (table-button-down)
] [ table-button-down ] if ;
From 926797d4859b0967b5e63e001709820ef132a529 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 5 Aug 2009 22:56:08 -0500
Subject: [PATCH 127/128] ui.gadgets.tables: more fixes
---
basis/ui/gadgets/tables/tables.factor | 19 ++++++++++---------
1 file changed, 10 insertions(+), 9 deletions(-)
diff --git a/basis/ui/gadgets/tables/tables.factor b/basis/ui/gadgets/tables/tables.factor
index eba646d08a..3856553b96 100644
--- a/basis/ui/gadgets/tables/tables.factor
+++ b/basis/ui/gadgets/tables/tables.factor
@@ -55,7 +55,7 @@ multiple-selection? ;
over selected-indices>> conjoin ;
: multiple>single ( values -- value/f ? )
- dup assoc-empty? [ drop f f ] [ keys first t ] if ;
+ dup assoc-empty? [ drop f f ] [ values first t ] if ;
: selected-index ( table -- n )
selected-indices>> multiple>single drop ;
@@ -262,12 +262,13 @@ M: table pref-dim*
PRIVATE>
-: (selected-rows) ( table -- {row} )
- [ selected-indices>> keys natural-sort ] keep
- '[ _ nth-row [ 1array ] [ drop { } ] if ] map concat ;
+: (selected-rows) ( table -- assoc )
+ [ selected-indices>> ] keep
+ '[ _ nth-row drop ] assoc-map ;
-: selected-rows ( table -- {value} )
- [ (selected-rows) ] [ renderer>> ] bi '[ _ row-value ] map ;
+: selected-rows ( table -- assoc )
+ [ selected-indices>> ] [ ] [ renderer>> ] tri
+ '[ _ nth-row drop _ row-value ] assoc-map ;
: (selected-row) ( table -- value/f ? ) (selected-rows) multiple>single ;
@@ -306,7 +307,7 @@ PRIVATE>
: (update-selected-indices) ( table -- set )
[ selection>> value>> dup array? [ 1array ] unless ] keep
- [ find-row-index ] curry map sift unique f like ;
+ [ find-row-index ] curry map sift unique f assoc-like ;
: initial-selected-indices ( table -- set )
{
@@ -315,7 +316,7 @@ PRIVATE>
[ drop { 0 } unique ]
} 1&& ;
-: update-selected-indices ( table -- {n}/f )
+: update-selected-indices ( table -- set )
{
[ (update-selected-indices) ]
[ initial-selected-indices ]
@@ -324,7 +325,7 @@ PRIVATE>
M: table model-changed
nip dup update-selected-indices {
[ >>selected-indices f >>mouse-index drop ]
- [ [ f ] [ first ] if-empty show-row-summary ]
+ [ multiple>single drop show-row-summary ]
[ drop update-selected ]
[ drop relayout ]
} 2cleave ;
From 311774cb687757c4d7574c661d1acf51343963d8 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 5 Aug 2009 22:56:19 -0500
Subject: [PATCH 128/128] modules.rpc-server: don't start server by default
---
extra/modules/rpc-server/rpc-server.factor | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/extra/modules/rpc-server/rpc-server.factor b/extra/modules/rpc-server/rpc-server.factor
index 073804fa8c..d82f13f715 100644
--- a/extra/modules/rpc-server/rpc-server.factor
+++ b/extra/modules/rpc-server/rpc-server.factor
@@ -20,12 +20,12 @@ SYMBOL: serving-vocabs serving-vocabs [ V{ } clone ] initialize
PRIVATE>
SYNTAX: service current-vocab name>> serving-vocabs get-global adjoin ;
-[ [ binary <threaded-server>
+: start-rpc-server ( -- )
+ binary <threaded-server>
"rpcs" >>name 9012 >>insecure
[ deserialize {
{ "getter" [ getter ] }
{ "doer" [ doer ] }
{ "loader" [ deserialize vocab serialize flush ] }
} case ] >>handler
- start-server ] in-thread
-] "modules.rpc-server" add-init-hook
\ No newline at end of file
+ start-server ;