1 ! Copyright (C) 2006, 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors assocs ui.tools.interactor ui.tools.listener
4 ui.tools.workspace help help.topics io.files io.styles kernel
5 models models.delay models.filter namespaces prettyprint
6 quotations sequences sorting source-files definitions strings
7 tools.completion tools.crossref classes.tuple ui.commands
8 ui.gadgets ui.gadgets.editors ui.gadgets.lists
9 ui.gadgets.scrollers ui.gadgets.tracks ui.gestures ui.operations
10 vocabs words vocabs.loader tools.vocabs unicode.case calendar ui
14 TUPLE: live-search < track field list ;
16 : search-value ( live-search -- value )
19 : search-gesture ( gesture live-search -- operation/f )
20 search-value object-operations
21 [ operation-gesture = ] with find nip ;
23 M: live-search handle-gesture ( gesture live-search -- ? )
24 tuck search-gesture dup [
25 over find-workspace hide-popup
26 >r search-value r> invoke-command f
31 : find-live-search ( gadget -- search )
32 [ live-search? ] find-parent ;
34 : find-search-list ( gadget -- list )
35 find-live-search list>> ;
37 TUPLE: search-field < editor ;
39 : <search-field> ( -- gadget )
40 search-field new-editor ;
43 { T{ key-down f f "UP" } [ find-search-list select-previous ] }
44 { T{ key-down f f "DOWN" } [ find-search-list select-next ] }
45 { T{ key-down f f "PAGE_UP" } [ find-search-list list-page-up ] }
46 { T{ key-down f f "PAGE_DOWN" } [ find-search-list list-page-down ] }
47 { T{ key-down f f "RET" } [ find-search-list invoke-value-action ] }
50 : <search-model> ( live-search producer -- live-search filter )
51 >r dup field>> model>> ! live-search model :: producer
52 ui-running? [ 1/5 seconds <delay> ] when
53 [ "\n" join ] r> append <filter> ;
55 : <search-list> ( live-search seq limited? presenter -- live-search list )
57 [ limited-completions ] [ completions ] ? curry
59 >r [ find-workspace hide-popup ] r> r>
62 : <live-search> ( string seq limited? presenter -- gadget )
63 { 0 1 } live-search new-track
64 <search-field> >>field
65 dup field>> f track-add
66 -roll <search-list> >>list
67 dup list>> <scroller> 1 track-add
69 over field>> set-editor-string
70 dup field>> end-of-document ;
72 M: live-search focusable-child* field>> ;
74 M: live-search pref-dim* drop { 400 200 } ;
76 : current-word ( workspace -- string )
77 listener>> input>> selected-word ;
79 : definition-candidates ( words -- candidates )
80 [ dup synopsis >lower ] { } map>assoc sort-values ;
82 : <definition-search> ( string words limited? -- gadget )
83 >r definition-candidates r> [ synopsis ] <live-search> ;
85 : word-candidates ( words -- candidates )
86 [ dup name>> >lower ] { } map>assoc ;
88 : <word-search> ( string words limited? -- gadget )
89 >r word-candidates r> [ synopsis ] <live-search> ;
91 : com-words ( workspace -- )
92 dup current-word all-words t <word-search>
93 "Word search" show-titled-popup ;
95 : show-vocab-words ( workspace vocab -- )
96 "" over words natural-sort f <word-search>
97 "Words in " rot vocab-name append show-titled-popup ;
99 : show-word-usage ( workspace word -- )
100 "" over smart-usage f <definition-search>
101 "Words and methods using " rot name>> append
104 : help-candidates ( seq -- candidates )
105 [ dup >link swap article-title >lower ] { } map>assoc
108 : <help-search> ( string -- gadget )
109 all-articles help-candidates
110 f [ article-title ] <live-search> ;
112 : com-search ( workspace -- )
113 "" <help-search> "Help search" show-titled-popup ;
115 : source-file-candidates ( seq -- candidates )
116 [ dup <pathname> swap >lower ] { } map>assoc ;
118 : <source-file-search> ( string files -- gadget )
119 source-file-candidates
120 f [ string>> ] <live-search> ;
122 : all-source-files ( -- seq )
123 source-files get keys natural-sort ;
125 : com-sources ( workspace -- )
126 "" all-source-files <source-file-search>
127 "Source file search" show-titled-popup ;
129 : show-vocab-files ( workspace vocab -- )
130 "" over vocab-files <source-file-search>
131 "Source files in " rot vocab-name append show-titled-popup ;
133 : vocab-candidates ( -- candidates )
134 all-vocabs-seq [ dup vocab-name >lower ] { } map>assoc ;
136 : <vocab-search> ( string -- gadget )
137 vocab-candidates f [ vocab-name ] <live-search> ;
139 : com-vocabs ( workspace -- )
140 dup current-word <vocab-search>
141 "Vocabulary search" show-titled-popup ;
143 : history-candidates ( seq -- candidates )
144 [ dup <input> swap >lower ] { } map>assoc ;
146 : <history-search> ( string seq -- gadget )
148 f [ string>> ] <live-search> ;
150 : listener-history ( listener -- seq )
151 input>> history>> <reversed> ;
153 : com-history ( workspace -- )
154 "" over listener>> listener-history <history-search>
155 "History search" show-titled-popup ;
157 workspace "toolbar" f {
158 { T{ key-down f { C+ } "p" } com-history }
159 { T{ key-down f f "TAB" } com-words }
160 { T{ key-down f { C+ } "u" } com-vocabs }
161 { T{ key-down f { C+ } "e" } com-sources }
162 { T{ key-down f { C+ } "h" } com-search }