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