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