1+ # incremental search panel
2+ # based on code from gitk, Copyright (C) Paul Mackerras
3+
4+ class searchbar {
5+
6+ field w
7+ field ctext
8+
9+ field searchstring {}
10+ field casesensitive 1
11+ field searchdirn -forwards
12+
13+ field smarktop
14+ field smarkbot
15+
16+ constructor 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+
42+ method show {} {
43+ if {![winfo ismapped $w ]} {
44+ grid $w
45+ }
46+ focus -force $w .ent
47+ }
48+
49+ method hide {} {
50+ if {[winfo ismapped $w ]} {
51+ focus $ctext
52+ grid remove $w
53+ }
54+ }
55+
56+ method _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+
76+ method _get_wrap_anchor {dir} {
77+ if {$dir eq " -forwards"
78+ return 1.0
79+ } else {
80+ return end
81+ }
82+ }
83+
84+ method _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+
108+ method _incrsearch_cb {name ix op} {
109+ after idle [cb _incrsearch]
110+ }
111+
112+ method _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+
131+ method find_prev {} {
132+ find_next $this -backwards
133+ }
134+
135+ method 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+
154+ method _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+
164+ method _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+
184+ method scrolled {} {
185+ if {$searchstring ne {}} {
186+ after idle [cb _set_marks 0]
187+ }
188+ }
189+
190+ }
0 commit comments