1# incremental search panel
2# based on code from gitk, Copyright (C) Paul Mackerras
34
class searchbar {
56
field w
7field ctext
89
field searchstring {}
10field casesensitive 1
11field searchdirn -forwards
1213
field smarktop
14field smarkbot
1516
constructor new {i_w i_text args} {
17global use_ttk NS
18set w $i_w
19set ctext $i_text
2021
${NS}::frame $w
22${NS}::label $w.l -text [mc Find:]
23entry $w.ent -textvariable ${__this}::searchstring -background lightgreen
24${NS}::button $w.bn -text [mc Next] -command [cb find_next]
25${NS}::button $w.bp -text [mc Prev] -command [cb find_prev]
26${NS}::checkbutton $w.cs -text [mc Case-Sensitive] \
27-variable ${__this}::casesensitive -command [cb _incrsearch]
28pack $w.l -side left
29pack $w.cs -side right
30pack $w.bp -side right
31pack $w.bn -side right
32pack $w.ent -side left -expand 1 -fill x
3334
eval grid conf $w -sticky we $args
35grid remove $w
3637
trace add variable searchstring write [cb _incrsearch_cb]
3839
bind $w <Destroy> [list delete_this $this]
40return $this
41}
4243
method show {} {
44if {![visible $this]} {
45grid $w
46}
47focus -force $w.ent
48}
4950
method hide {} {
51if {[visible $this]} {
52focus $ctext
53grid remove $w
54}
55}
5657
method visible {} {
58return [winfo ismapped $w]
59}
6061
method editor {} {
62return $w.ent
63}
6465
method _get_new_anchor {} {
66# use start of selection if it is visible,
67# or the bounds of the visible area
68set top [$ctext index @0,0]
69set bottom [$ctext index @0,[winfo height $ctext]]
70set sel [$ctext tag ranges sel]
71if {$sel ne {}} {
72set spos [lindex $sel 0]
73if {[lindex $spos 0] >= [lindex $top 0] &&
74[lindex $spos 0] <= [lindex $bottom 0]} {
75return $spos
76}
77}
78if {$searchdirn eq "-forwards"} {
79return $top
80} else {
81return $bottom
82}
83}
8485
method _get_wrap_anchor {dir} {
86if {$dir eq "-forwards"} {
87return 1.0
88} else {
89return end
90}
91}
9293
method _do_search {start {mlenvar {}} {dir {}} {endbound {}}} {
94set cmd [list $ctext search]
95if {$mlenvar ne {}} {
96upvar $mlenvar mlen
97lappend cmd -count mlen
98}
99if {!$casesensitive} {
100lappend cmd -nocase
101}
102if {$dir eq {}} {
103set dir $searchdirn
104}
105lappend cmd $dir -- $searchstring
106if {$endbound ne {}} {
107set here [eval $cmd [list $start] [list $endbound]]
108} else {
109set here [eval $cmd [list $start]]
110if {$here eq {}} {
111set here [eval $cmd [_get_wrap_anchor $this $dir]]
112}
113}
114return $here
115}
116117
method _incrsearch_cb {name ix op} {
118after idle [cb _incrsearch]
119}
120121
method _incrsearch {} {
122$ctext tag remove found 1.0 end
123if {[catch {$ctext index anchor}]} {
124$ctext mark set anchor [_get_new_anchor $this]
125}
126if {$searchstring ne {}} {
127set here [_do_search $this anchor mlen]
128if {$here ne {}} {
129$ctext see $here
130$ctext tag remove sel 1.0 end
131$ctext tag add sel $here "$here + $mlen c"
132$w.ent configure -background lightgreen
133_set_marks $this 1
134} else {
135$w.ent configure -background lightpink
136}
137}
138}
139140
method find_prev {} {
141find_next $this -backwards
142}
143144
method find_next {{dir -forwards}} {
145focus $w.ent
146$w.ent icursor end
147set searchdirn $dir
148$ctext mark unset anchor
149if {$searchstring ne {}} {
150set start [_get_new_anchor $this]
151if {$dir eq "-forwards"} {
152set start "$start + 1c"
153}
154set match [_do_search $this $start mlen]
155$ctext tag remove sel 1.0 end
156if {$match ne {}} {
157$ctext see $match
158$ctext tag add sel $match "$match + $mlen c"
159}
160}
161}
162163
method _mark_range {first last} {
164set mend $first.0
165while {1} {
166set match [_do_search $this $mend mlen -forwards $last.end]
167if {$match eq {}} break
168set mend "$match + $mlen c"
169$ctext tag add found $match $mend
170}
171}
172173
method _set_marks {doall} {
174set topline [lindex [split [$ctext index @0,0] .] 0]
175set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
176if {$doall || $botline < $smarktop || $topline > $smarkbot} {
177# no overlap with previous
178_mark_range $this $topline $botline
179set smarktop $topline
180set smarkbot $botline
181} else {
182if {$topline < $smarktop} {
183_mark_range $this $topline [expr {$smarktop-1}]
184set smarktop $topline
185}
186if {$botline > $smarkbot} {
187_mark_range $this [expr {$smarkbot+1}] $botline
188set smarkbot $botline
189}
190}
191}
192193
method scrolled {} {
194if {$searchstring ne {}} {
195after idle [cb _set_marks 0]
196}
197}
198199
}