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