1# incremental search panel
2# based on code from gitk, Copyright (C) Paul Mackerras
3
4class searchbar {
5
6field w
7field ctext
8
9field searchstring {}
10field regexpsearch
11field default_regexpsearch
12field casesensitive
13field default_casesensitive
14field smartcase
15field searchdirn -forwards
16
17field history
18field history_index
19
20field smarktop
21field smarkbot
22
23constructor new {i_w i_text args} {
24 global use_ttk NS
25 set w $i_w
26 set ctext $i_text
27
28 set default_regexpsearch [is_config_true gui.search.regexp]
29 switch -- [get_config gui.search.case] {
30 no {
31 set default_casesensitive 0
32 set smartcase 0
33 }
34 smart {
35 set default_casesensitive 0
36 set smartcase 1
37 }
38 yes -
39 default {
40 set default_casesensitive 1
41 set smartcase 0
42 }
43 }
44
45 set history [list]
46
47 ${NS}::frame $w
48 ${NS}::label $w.l -text [mc Find:]
49 tentry $w.ent -textvariable ${__this}::searchstring -background lightgreen
50 ${NS}::button $w.bn -text [mc Next] -command [cb find_next]
51 ${NS}::button $w.bp -text [mc Prev] -command [cb find_prev]
52 ${NS}::checkbutton $w.re -text [mc RegExp] \
53 -variable ${__this}::regexpsearch -command [cb _incrsearch]
54 ${NS}::checkbutton $w.cs -text [mc Case] \
55 -variable ${__this}::casesensitive -command [cb _incrsearch]
56 pack $w.l -side left
57 pack $w.cs -side right
58 pack $w.re -side right
59 pack $w.bp -side right
60 pack $w.bn -side right
61 pack $w.ent -side left -expand 1 -fill x
62
63 eval grid conf $w -sticky we $args
64 grid remove $w
65
66 trace add variable searchstring write [cb _incrsearch_cb]
67 bind $w.ent <Return> [cb find_next]
68 bind $w.ent <Shift-Return> [cb find_prev]
69 bind $w.ent <Key-Up> [cb _prev_search]
70 bind $w.ent <Key-Down> [cb _next_search]
71
72 bind $w <Destroy> [list delete_this $this]
73 return $this
74}
75
76method show {} {
77 if {![visible $this]} {
78 grid $w
79 $w.ent delete 0 end
80 set regexpsearch $default_regexpsearch
81 set casesensitive $default_casesensitive
82 set history_index [llength $history]
83 }
84 focus -force $w.ent
85}
86
87method hide {} {
88 if {[visible $this]} {
89 focus $ctext
90 grid remove $w
91 _save_search $this
92 }
93}
94
95method visible {} {
96 return [winfo ismapped $w]
97}
98
99method editor {} {
100 return $w.ent
101}
102
103method _get_new_anchor {} {
104 # use start of selection if it is visible,
105 # or the bounds of the visible area
106 set top [$ctext index @0,0]
107 set bottom [$ctext index @0,[winfo height $ctext]]
108 set sel [$ctext tag ranges sel]
109 if {$sel ne {}} {
110 set spos [lindex $sel 0]
111 if {[lindex $spos 0] >= [lindex $top 0] &&
112 [lindex $spos 0] <= [lindex $bottom 0]} {
113 return $spos
114 }
115 }
116 if {$searchdirn eq "-forwards"} {
117 return $top
118 } else {
119 return $bottom
120 }
121}
122
123method _get_wrap_anchor {dir} {
124 if {$dir eq "-forwards"} {
125 return 1.0
126 } else {
127 return end
128 }
129}
130
131method _do_search {start {mlenvar {}} {dir {}} {endbound {}}} {
132 set cmd [list $ctext search]
133 if {$mlenvar ne {}} {
134 upvar $mlenvar mlen
135 lappend cmd -count mlen
136 }
137 if {$regexpsearch} {
138 lappend cmd -regexp
139 }
140 if {!$casesensitive} {
141 lappend cmd -nocase
142 }
143 if {$dir eq {}} {
144 set dir $searchdirn
145 }
146 lappend cmd $dir -- $searchstring
147 if {[catch {
148 if {$endbound ne {}} {
149 set here [eval $cmd [list $start] [list $endbound]]
150 } else {
151 set here [eval $cmd [list $start]]
152 if {$here eq {}} {
153 set here [eval $cmd [_get_wrap_anchor $this $dir]]
154 }
155 }
156 } err]} { set here {} }
157 return $here
158}
159
160method _incrsearch_cb {name ix op} {
161 after idle [cb _incrsearch]
162}
163
164method _incrsearch {} {
165 $ctext tag remove found 1.0 end
166 if {[catch {$ctext index anchor}]} {
167 $ctext mark set anchor [_get_new_anchor $this]
168 }
169 if {$searchstring ne {}} {
170 if {$smartcase && [regexp {[[:upper:]]} $searchstring]} {
171 set casesensitive 1
172 }
173 set here [_do_search $this anchor mlen]
174 if {$here ne {}} {
175 $ctext see $here
176 $ctext tag remove sel 1.0 end
177 $ctext tag add sel $here "$here + $mlen c"
178 #$w.ent configure -background lightgreen
179 $w.ent state !pressed
180 _set_marks $this 1
181 } else {
182 #$w.ent configure -background lightpink
183 $w.ent state pressed
184 }
185 } elseif {$smartcase} {
186 # clearing the field resets the smart case detection
187 set casesensitive 0
188 }
189}
190
191method _save_search {} {
192 if {$searchstring eq {}} {
193 return
194 }
195 if {[llength $history] > 0} {
196 foreach {s_regexp s_case s_expr} [lindex $history end] break
197 } else {
198 set s_regexp $regexpsearch
199 set s_case $casesensitive
200 set s_expr ""
201 }
202 if {$searchstring eq $s_expr} {
203 # update modes
204 set history [lreplace $history end end \
205 [list $regexpsearch $casesensitive $searchstring]]
206 } else {
207 lappend history [list $regexpsearch $casesensitive $searchstring]
208 }
209 set history_index [llength $history]
210}
211
212method _prev_search {} {
213 if {$history_index > 0} {
214 incr history_index -1
215 foreach {s_regexp s_case s_expr} [lindex $history $history_index] break
216 $w.ent delete 0 end
217 $w.ent insert 0 $s_expr
218 set regexpsearch $s_regexp
219 set casesensitive $s_case
220 }
221}
222
223method _next_search {} {
224 if {$history_index < [llength $history]} {
225 incr history_index
226 }
227 if {$history_index < [llength $history]} {
228 foreach {s_regexp s_case s_expr} [lindex $history $history_index] break
229 } else {
230 set s_regexp $default_regexpsearch
231 set s_case $default_casesensitive
232 set s_expr ""
233 }
234 $w.ent delete 0 end
235 $w.ent insert 0 $s_expr
236 set regexpsearch $s_regexp
237 set casesensitive $s_case
238}
239
240method find_prev {} {
241 find_next $this -backwards
242}
243
244method find_next {{dir -forwards}} {
245 focus $w.ent
246 $w.ent icursor end
247 set searchdirn $dir
248 $ctext mark unset anchor
249 if {$searchstring ne {}} {
250 _save_search $this
251 set start [_get_new_anchor $this]
252 if {$dir eq "-forwards"} {
253 set start "$start + 1c"
254 }
255 set match [_do_search $this $start mlen]
256 $ctext tag remove sel 1.0 end
257 if {$match ne {}} {
258 $ctext see $match
259 $ctext tag add sel $match "$match + $mlen c"
260 }
261 }
262}
263
264method _mark_range {first last} {
265 set mend $first.0
266 while {1} {
267 set match [_do_search $this $mend mlen -forwards $last.end]
268 if {$match eq {}} break
269 set mend "$match + $mlen c"
270 $ctext tag add found $match $mend
271 }
272}
273
274method _set_marks {doall} {
275 set topline [lindex [split [$ctext index @0,0] .] 0]
276 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
277 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
278 # no overlap with previous
279 _mark_range $this $topline $botline
280 set smarktop $topline
281 set smarkbot $botline
282 } else {
283 if {$topline < $smarktop} {
284 _mark_range $this $topline [expr {$smarktop-1}]
285 set smarktop $topline
286 }
287 if {$botline > $smarkbot} {
288 _mark_range $this [expr {$smarkbot+1}] $botline
289 set smarkbot $botline
290 }
291 }
292}
293
294method scrolled {} {
295 if {$searchstring ne {}} {
296 after idle [cb _set_marks 0]
297 }
298}
299
300}