steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Search tables: do case folding automatically, better keyboard behavior

db4
Slava Pestov 2009-02-17 08:24:11 -06:00
parent d14fba5b98
commit 0bbe79d386
2 changed files with 30 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
basis/models/search/search.factor
View File

@ -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> ;
'[ first2 _ curry filter ] <filter> ;
: <string-search> ( values search quot -- model )
'[ swap @ [ >case-fold ] bi@ subseq? ] <search> ;

31
basis/ui/gadgets/search-tables/search-tables.factor
View File

@ -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 ;
nip field>> clear-search-field ;
M: search-table focusable-child* field>> ;