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 searchdirn -forwards
15
16field smarktop
17field smarkbot
18
19constructor new {i_w i_text args} {
20 global use_ttk NS
21 set w $i_w
22 set ctext $i_text
23
24 set default_regexpsearch [is_config_true gui.search.regexp]
25 if {[is_config_true gui.search.smartcase]} {
26 set default_casesensitive 0
27 } else {
28 set default_casesensitive 1
29 }
30
31 ${NS}::frame $w
32 ${NS}::label $w.l -text [mc Find:]
33 entry $w.ent -textvariable ${__this}::searchstring -background lightgreen
34 ${NS}::button $w.bn -text [mc Next] -command [cb find_next]
35 ${NS}::button $w.bp -text [mc Prev] -command [cb find_prev]
36 ${NS}::checkbutton $w.re -text [mc RegExp] \
37 -variable ${__this}::regexpsearch -command [cb _incrsearch]
38 ${NS}::checkbutton $w.cs -text [mc Case] \
39 -variable ${__this}::casesensitive -command [cb _incrsearch]
40 pack $w.l -side left
41 pack $w.cs -side right
42 pack $w.re -side right
43 pack $w.bp -side right
44 pack $w.bn -side right
45 pack $w.ent -side left -expand 1 -fill x
46
47 eval grid conf $w -sticky we $args
48 grid remove $w
49
50 trace add variable searchstring write [cb _incrsearch_cb]
51 bind $w.ent <Return> [cb find_next]
52 bind $w.ent <Shift-Return> [cb find_prev]
53
54 bind $w <Destroy> [list delete_this $this]
55 return $this
56}
57
58method show {} {
59 if {![visible $this]} {
60 grid $w
61 set regexpsearch $default_regexpsearch
62 set casesensitive $default_casesensitive
63 }
64 focus -force $w.ent
65}
66
67method hide {} {
68 if {[visible $this]} {
69 focus $ctext
70 grid remove $w
71 }
72}
73
74method visible {} {
75 return [winfo ismapped $w]
76}
77
78method editor {} {
79 return $w.ent
80}
81
82method _get_new_anchor {} {
83 # use start of selection if it is visible,
84 # or the bounds of the visible area
85 set top [$ctext index @0,0]
86 set bottom [$ctext index @0,[winfo height $ctext]]
87 set sel [$ctext tag ranges sel]
88 if {$sel ne {}} {
89 set spos [lindex $sel 0]
90 if {[lindex $spos 0] >= [lindex $top 0] &&
91 [lindex $spos 0] <= [lindex $bottom 0]} {
92 return $spos
93 }
94 }
95 if {$searchdirn eq "-forwards"} {
96 return $top
97 } else {
98 return $bottom
99 }
100}
101
102method _get_wrap_anchor {dir} {
103 if {$dir eq "-forwards"} {
104 return 1.0
105 } else {
106 return end
107 }
108}
109
110method _do_search {start {mlenvar {}} {dir {}} {endbound {}}} {
111 set cmd [list $ctext search]
112 if {$mlenvar ne {}} {
113 upvar $mlenvar mlen
114 lappend cmd -count mlen
115 }
116 if {$regexpsearch} {
117 lappend cmd -regexp
118 }
119 if {!$casesensitive} {
120 lappend cmd -nocase
121 }
122 if {$dir eq {}} {
123 set dir $searchdirn
124 }
125 lappend cmd $dir -- $searchstring
126 if {$endbound ne {}} {
127 set here [eval $cmd [list $start] [list $endbound]]
128 } else {
129 set here [eval $cmd [list $start]]
130 if {$here eq {}} {
131 set here [eval $cmd [_get_wrap_anchor $this $dir]]
132 }
133 }
134 return $here
135}
136
137method _incrsearch_cb {name ix op} {
138 after idle [cb _incrsearch]
139}
140
141method _incrsearch {} {
142 $ctext tag remove found 1.0 end
143 if {[catch {$ctext index anchor}]} {
144 $ctext mark set anchor [_get_new_anchor $this]
145 }
146 if {[regexp {[[:upper:]]} $searchstring]} {
147 set casesensitive 1
148 }
149 if {$searchstring ne {}} {
150 set here [_do_search $this anchor mlen]
151 if {$here ne {}} {
152 $ctext see $here
153 $ctext tag remove sel 1.0 end
154 $ctext tag add sel $here "$here + $mlen c"
155 $w.ent configure -background lightgreen
156 _set_marks $this 1
157 } else {
158 $w.ent configure -background lightpink
159 }
160 }
161}
162
163method find_prev {} {
164 find_next $this -backwards
165}
166
167method find_next {{dir -forwards}} {
168 focus $w.ent
169 $w.ent icursor end
170 set searchdirn $dir
171 $ctext mark unset anchor
172 if {$searchstring ne {}} {
173 set start [_get_new_anchor $this]
174 if {$dir eq "-forwards"} {
175 set start "$start + 1c"
176 }
177 set match [_do_search $this $start mlen]
178 $ctext tag remove sel 1.0 end
179 if {$match ne {}} {
180 $ctext see $match
181 $ctext tag add sel $match "$match + $mlen c"
182 }
183 }
184}
185
186method _mark_range {first last} {
187 set mend $first.0
188 while {1} {
189 set match [_do_search $this $mend mlen -forwards $last.end]
190 if {$match eq {}} break
191 set mend "$match + $mlen c"
192 $ctext tag add found $match $mend
193 }
194}
195
196method _set_marks {doall} {
197 set topline [lindex [split [$ctext index @0,0] .] 0]
198 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
199 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
200 # no overlap with previous
201 _mark_range $this $topline $botline
202 set smarktop $topline
203 set smarkbot $botline
204 } else {
205 if {$topline < $smarktop} {
206 _mark_range $this $topline [expr {$smarktop-1}]
207 set smarktop $topline
208 }
209 if {$botline > $smarkbot} {
210 _mark_range $this [expr {$smarkbot+1}] $botline
211 set smarkbot $botline
212 }
213 }
214}
215
216method scrolled {} {
217 if {$searchstring ne {}} {
218 after idle [cb _set_marks 0]
219 }
220}
221
222}