Search tables: do case folding automatically, better keyboard behavior

diff --git a/basis/models/search/search.factor b/basis/models/search/search.factor
index 62e4db38acefee5ffdf1b4c69edb45f38922da4c..d1ef6b5ead5929f40f6d6c2dd1a7e85630fe02dc 100644 (file)
--- a/basis/models/search/search.factor
+++ b/basis/models/search/search.factor
@@ -1,8 +1,12 @@
-! Copyright (C) 2008 Slava Pestov
+! Copyright (C) 2008, 2009 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays fry kernel models.compose models.filter sequences ;
+USING: arrays fry kernel models.compose models.filter
+sequences unicode.case ;
 IN: models.search
 
 : <search> ( values search quot -- model )
     [ 2array <compose> ] dip
-    '[ first2 _ curry filter ] <filter> ;
\ No newline at end of file
+    '[ first2 _ curry filter ] <filter> ;
+
+: <string-search> ( values search quot -- model )
+    '[ swap @ [ >case-fold ] bi@ subseq? ] <search> ;

diff --git a/basis/ui/gadgets/search-tables/search-tables.factor b/basis/ui/gadgets/search-tables/search-tables.factor
index e278f3bc75db3df6102e34a5e403d14d5b91cbe3..4a2983bfe09627da18ae6d84f7d4a41e937a09d2 100644 (file)
--- a/basis/ui/gadgets/search-tables/search-tables.factor
+++ b/basis/ui/gadgets/search-tables/search-tables.factor
@@ -1,12 +1,17 @@
 ! Copyright (C) 2008, 2009 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel delegate fry sequences models
-models.search models.delay calendar locals ui.pens ui.pens.image
-ui.gadgets.editors ui.gadgets.labels ui.gadgets.scrollers
-ui.gadgets.tables ui.gadgets.tracks ui.gadgets.borders
-ui.gadgets.buttons ui.baseline-alignment ui.gadgets ;
+combinators.short-circuit models.search models.delay calendar locals
+ui.gestures ui.pens ui.pens.image ui.gadgets.editors ui.gadgets.labels
+ui.gadgets.scrollers ui.gadgets.tables ui.gadgets.tracks
+ui.gadgets.borders ui.gadgets.buttons ui.baseline-alignment ui.gadgets ;
 IN: ui.gadgets.search-tables
 
+TUPLE: search-table < track table field ;
+
+: find-search-table ( gadget -- search-table/f )
+    [ search-table? ] find-parent ;
+
 TUPLE: search-field < track field ;
 
 : clear-search-field ( search-field -- )
@@ -29,7 +34,15 @@ TUPLE: search-field < track field ;
         dup field>> "Search:" label-on-left 1 track-add
         dup <clear-button> f track-add ;
 
-TUPLE: search-table < track table field ;
+M: search-field focusable-child* field>> ;
+
+: pass-to-table ( gesture gadget -- ? )
+    find-search-table table>> handle-gesture ;
+
+M: search-field handle-gesture
+    over key-gesture? [
+        { [ pass-to-table ] [ call-next-method ] } 2&&
+    ] [ call-next-method ] if ;
 
 ! A protocol with customizable slots
 SLOT-PROTOCOL: table-protocol
@@ -58,9 +71,11 @@ CONSULT: table-protocol search-table table>> ;
         values >>model
         search <search-field> >>field
         dup field>> { 2 2 } <filled-border> f track-add
-        values search 500 milliseconds <delay> quot <search>
-        renderer <table> >>table
+        values search 500 milliseconds <delay> quot <string-search>
+        renderer <table> f >>takes-focus? >>table
         dup table>> <scroller> 1 track-add ;
 
 M: search-table model-changed
-    nip field>> clear-search-field ;
\ No newline at end of file
+    nip field>> clear-search-field ;
+
+M: search-table focusable-child* field>> ;
\ No newline at end of file