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