basis/ui/gadgets/search-tables/search-tables.factor

   1 ! Copyright (C) 2008, 2009 Slava Pestov
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors calendar combinators.short-circuit delegate fry
   4 kernel locals models models.delay models.search
   5 ui.baseline-alignment ui.gadgets ui.gadgets.borders
   6 ui.gadgets.buttons ui.gadgets.editors ui.gadgets.labels
   7 ui.gadgets.scrollers ui.gadgets.tables ui.gadgets.theme
   8 ui.gadgets.tracks ui.gestures ui.pens ui.pens.image ;
   9 IN: ui.gadgets.search-tables
  10
  11 TUPLE: search-table < track table field ;
  12
  13 : find-search-table ( gadget -- search-table/f )
  14     [ search-table? ] find-parent ;
  15
  16 TUPLE: search-field < track field ;
  17
  18 : clear-search-field ( search-field -- )
  19     field>> editor>> clear-editor ;
  20
  21 : <clear-button-pen> ( -- pen )
  22     "clear-button" theme-image <image-pen> dup
  23     "clear-button-clicked" theme-image <image-pen> dup dup <button-pen> ;
  24
  25 : <clear-button> ( search-field -- button )
  26     [ f ] dip '[ drop _ clear-search-field ] <button>
  27     <clear-button-pen> >>interior
  28     dup dup interior>> pen-pref-dim >>min-dim ;
  29
  30 : <search-field> ( model -- gadget )
  31     horizontal search-field new-track
  32         0 >>fill
  33         { 5 5 } >>gap
  34         +baseline+ >>align
  35         swap <model-field> 10 >>min-cols >>field
  36         dup field>> "Search:" label-on-left 1 track-add
  37         dup <clear-button> f track-add ;
  38
  39 M: search-field focusable-child* field>> ;
  40
  41 : pass-to-table ( gesture gadget -- ? )
  42     find-search-table table>> handle-gesture ;
  43
  44 M: search-field handle-gesture
  45     over key-gesture? [
  46         { [ pass-to-table ] [ call-next-method ] } 2&&
  47     ] [ call-next-method ] if ;
  48
  49 ! A protocol with customizable slots
  50 SLOT-PROTOCOL: table-protocol
  51 renderer
  52 action
  53 hook
  54 font
  55 selection-color
  56 focus-border-color
  57 mouse-color
  58 column-line-color
  59 selection-required?
  60 single-click?
  61 selection
  62 min-rows
  63 min-cols
  64 max-rows
  65 max-cols ;
  66
  67 CONSULT: table-protocol search-table table>> ;
  68
  69 :: <search-table> ( values renderer quot -- gadget )
  70     f <model> :> search
  71     vertical search-table new-track
  72         values >>model
  73         search <search-field> >>field
  74         dup field>> { 2 2 } <filled-border> f track-add
  75         values search 500 milliseconds <delay> quot <string-search>
  76         renderer <table> f >>takes-focus? >>table
  77         dup table>> <scroller> 1 track-add ; inline
  78
  79 M: search-table model-changed
  80     nip field>> clear-search-field ;
  81
  82 M: search-table focusable-child* field>> ;