| 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 regexpsearch |
| 11 | field default_regexpsearch |
| 12 | field casesensitive |
| 13 | field default_casesensitive |
| 14 | field smartcase |
| 15 | field searchdirn -forwards |
| 16 | |
| 17 | field history |
| 18 | field history_index |
| 19 | |
| 20 | field smarktop |
| 21 | field smarkbot |
| 22 | |
| 23 | constructor new {i_w i_text args} { |
| 24 | set w $i_w |
| 25 | set ctext $i_text |
| 26 | |
| 27 | set default_regexpsearch [is_config_true gui.search.regexp] |
| 28 | switch -- [get_config gui.search.case] { |
| 29 | no { |
| 30 | set default_casesensitive 0 |
| 31 | set smartcase 0 |
| 32 | } |
| 33 | smart { |
| 34 | set default_casesensitive 0 |
| 35 | set smartcase 1 |
| 36 | } |
| 37 | yes - |
| 38 | default { |
| 39 | set default_casesensitive 1 |
| 40 | set smartcase 0 |
| 41 | } |
| 42 | } |
| 43 | |
| 44 | set history [list] |
| 45 | |
| 46 | ttk::frame $w |
| 47 | ttk::label $w.l -text [mc Find:] |
| 48 | tentry $w.ent -textvariable ${__this}::searchstring -background lightgreen |
| 49 | ttk::button $w.bn -text [mc Next] -command [cb find_next] |
| 50 | ttk::button $w.bp -text [mc Prev] -command [cb find_prev] |
| 51 | ttk::checkbutton $w.re -text [mc RegExp] \ |
| 52 | -variable ${__this}::regexpsearch -command [cb _incrsearch] |
| 53 | ttk::checkbutton $w.cs -text [mc Case] \ |
| 54 | -variable ${__this}::casesensitive -command [cb _incrsearch] |
| 55 | pack $w.l -side left |
| 56 | pack $w.cs -side right |
| 57 | pack $w.re -side right |
| 58 | pack $w.bp -side right |
| 59 | pack $w.bn -side right |
| 60 | pack $w.ent -side left -expand 1 -fill x |
| 61 | |
| 62 | eval grid conf $w -sticky we $args |
| 63 | grid remove $w |
| 64 | |
| 65 | trace add variable searchstring write [cb _incrsearch_cb] |
| 66 | bind $w.ent <Return> [cb find_next] |
| 67 | bind $w.ent <Shift-Return> [cb find_prev] |
| 68 | bind $w.ent <Key-Up> [cb _prev_search] |
| 69 | bind $w.ent <Key-Down> [cb _next_search] |
| 70 | |
| 71 | bind $w <Destroy> [list delete_this $this] |
| 72 | return $this |
| 73 | } |
| 74 | |
| 75 | method show {} { |
| 76 | if {![visible $this]} { |
| 77 | grid $w |
| 78 | $w.ent delete 0 end |
| 79 | set regexpsearch $default_regexpsearch |
| 80 | set casesensitive $default_casesensitive |
| 81 | set history_index [llength $history] |
| 82 | } |
| 83 | focus -force $w.ent |
| 84 | } |
| 85 | |
| 86 | method hide {} { |
| 87 | if {[visible $this]} { |
| 88 | focus $ctext |
| 89 | grid remove $w |
| 90 | _save_search $this |
| 91 | } |
| 92 | } |
| 93 | |
| 94 | method visible {} { |
| 95 | return [winfo ismapped $w] |
| 96 | } |
| 97 | |
| 98 | method editor {} { |
| 99 | return $w.ent |
| 100 | } |
| 101 | |
| 102 | method _get_new_anchor {} { |
| 103 | # use start of selection if it is visible, |
| 104 | # or the bounds of the visible area |
| 105 | set top [$ctext index @0,0] |
| 106 | set bottom [$ctext index @0,[winfo height $ctext]] |
| 107 | set sel [$ctext tag ranges sel] |
| 108 | if {$sel ne {}} { |
| 109 | set spos [lindex $sel 0] |
| 110 | if {[lindex $spos 0] >= [lindex $top 0] && |
| 111 | [lindex $spos 0] <= [lindex $bottom 0]} { |
| 112 | return $spos |
| 113 | } |
| 114 | } |
| 115 | if {$searchdirn eq "-forwards"} { |
| 116 | return $top |
| 117 | } else { |
| 118 | return $bottom |
| 119 | } |
| 120 | } |
| 121 | |
| 122 | method _get_wrap_anchor {dir} { |
| 123 | if {$dir eq "-forwards"} { |
| 124 | return 1.0 |
| 125 | } else { |
| 126 | return end |
| 127 | } |
| 128 | } |
| 129 | |
| 130 | method _do_search {start {mlenvar {}} {dir {}} {endbound {}}} { |
| 131 | set cmd [list $ctext search] |
| 132 | if {$mlenvar ne {}} { |
| 133 | upvar $mlenvar mlen |
| 134 | lappend cmd -count mlen |
| 135 | } |
| 136 | if {$regexpsearch} { |
| 137 | lappend cmd -regexp |
| 138 | } |
| 139 | if {!$casesensitive} { |
| 140 | lappend cmd -nocase |
| 141 | } |
| 142 | if {$dir eq {}} { |
| 143 | set dir $searchdirn |
| 144 | } |
| 145 | lappend cmd $dir -- $searchstring |
| 146 | if {[catch { |
| 147 | if {$endbound ne {}} { |
| 148 | set here [eval $cmd [list $start] [list $endbound]] |
| 149 | } else { |
| 150 | set here [eval $cmd [list $start]] |
| 151 | if {$here eq {}} { |
| 152 | set here [eval $cmd [_get_wrap_anchor $this $dir]] |
| 153 | } |
| 154 | } |
| 155 | } err]} { set here {} } |
| 156 | return $here |
| 157 | } |
| 158 | |
| 159 | method _incrsearch_cb {name ix op} { |
| 160 | after idle [cb _incrsearch] |
| 161 | } |
| 162 | |
| 163 | method _incrsearch {} { |
| 164 | $ctext tag remove found 1.0 end |
| 165 | if {[catch {$ctext index anchor}]} { |
| 166 | $ctext mark set anchor [_get_new_anchor $this] |
| 167 | } |
| 168 | if {$searchstring ne {}} { |
| 169 | if {$smartcase && [regexp {[[:upper:]]} $searchstring]} { |
| 170 | set casesensitive 1 |
| 171 | } |
| 172 | set here [_do_search $this anchor mlen] |
| 173 | if {$here ne {}} { |
| 174 | $ctext see $here |
| 175 | $ctext tag remove sel 1.0 end |
| 176 | $ctext tag add sel $here "$here + $mlen c" |
| 177 | #$w.ent configure -background lightgreen |
| 178 | $w.ent state !pressed |
| 179 | _set_marks $this 1 |
| 180 | } else { |
| 181 | #$w.ent configure -background lightpink |
| 182 | $w.ent state pressed |
| 183 | } |
| 184 | } elseif {$smartcase} { |
| 185 | # clearing the field resets the smart case detection |
| 186 | set casesensitive 0 |
| 187 | } |
| 188 | } |
| 189 | |
| 190 | method _save_search {} { |
| 191 | if {$searchstring eq {}} { |
| 192 | return |
| 193 | } |
| 194 | if {[llength $history] > 0} { |
| 195 | foreach {s_regexp s_case s_expr} [lindex $history end] break |
| 196 | } else { |
| 197 | set s_regexp $regexpsearch |
| 198 | set s_case $casesensitive |
| 199 | set s_expr "" |
| 200 | } |
| 201 | if {$searchstring eq $s_expr} { |
| 202 | # update modes |
| 203 | set history [lreplace $history end end \ |
| 204 | [list $regexpsearch $casesensitive $searchstring]] |
| 205 | } else { |
| 206 | lappend history [list $regexpsearch $casesensitive $searchstring] |
| 207 | } |
| 208 | set history_index [llength $history] |
| 209 | } |
| 210 | |
| 211 | method _prev_search {} { |
| 212 | if {$history_index > 0} { |
| 213 | incr history_index -1 |
| 214 | foreach {s_regexp s_case s_expr} [lindex $history $history_index] break |
| 215 | $w.ent delete 0 end |
| 216 | $w.ent insert 0 $s_expr |
| 217 | set regexpsearch $s_regexp |
| 218 | set casesensitive $s_case |
| 219 | } |
| 220 | } |
| 221 | |
| 222 | method _next_search {} { |
| 223 | if {$history_index < [llength $history]} { |
| 224 | incr history_index |
| 225 | } |
| 226 | if {$history_index < [llength $history]} { |
| 227 | foreach {s_regexp s_case s_expr} [lindex $history $history_index] break |
| 228 | } else { |
| 229 | set s_regexp $default_regexpsearch |
| 230 | set s_case $default_casesensitive |
| 231 | set s_expr "" |
| 232 | } |
| 233 | $w.ent delete 0 end |
| 234 | $w.ent insert 0 $s_expr |
| 235 | set regexpsearch $s_regexp |
| 236 | set casesensitive $s_case |
| 237 | } |
| 238 | |
| 239 | method find_prev {} { |
| 240 | find_next $this -backwards |
| 241 | } |
| 242 | |
| 243 | method find_next {{dir -forwards}} { |
| 244 | focus $w.ent |
| 245 | $w.ent icursor end |
| 246 | set searchdirn $dir |
| 247 | $ctext mark unset anchor |
| 248 | if {$searchstring ne {}} { |
| 249 | _save_search $this |
| 250 | set start [_get_new_anchor $this] |
| 251 | if {$dir eq "-forwards"} { |
| 252 | set start "$start + 1c" |
| 253 | } |
| 254 | set match [_do_search $this $start mlen] |
| 255 | $ctext tag remove sel 1.0 end |
| 256 | if {$match ne {}} { |
| 257 | $ctext see $match |
| 258 | $ctext tag add sel $match "$match + $mlen c" |
| 259 | } |
| 260 | } |
| 261 | } |
| 262 | |
| 263 | method _mark_range {first last} { |
| 264 | set mend $first.0 |
| 265 | while {1} { |
| 266 | set match [_do_search $this $mend mlen -forwards $last.end] |
| 267 | if {$match eq {}} break |
| 268 | set mend "$match + $mlen c" |
| 269 | $ctext tag add found $match $mend |
| 270 | } |
| 271 | } |
| 272 | |
| 273 | method _set_marks {doall} { |
| 274 | set topline [lindex [split [$ctext index @0,0] .] 0] |
| 275 | set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0] |
| 276 | if {$doall || $botline < $smarktop || $topline > $smarkbot} { |
| 277 | # no overlap with previous |
| 278 | _mark_range $this $topline $botline |
| 279 | set smarktop $topline |
| 280 | set smarkbot $botline |
| 281 | } else { |
| 282 | if {$topline < $smarktop} { |
| 283 | _mark_range $this $topline [expr {$smarktop-1}] |
| 284 | set smarktop $topline |
| 285 | } |
| 286 | if {$botline > $smarkbot} { |
| 287 | _mark_range $this [expr {$smarkbot+1}] $botline |
| 288 | set smarkbot $botline |
| 289 | } |
| 290 | } |
| 291 | } |
| 292 | |
| 293 | method scrolled {} { |
| 294 | if {$searchstring ne {}} { |
| 295 | after idle [cb _set_marks 0] |
| 296 | } |
| 297 | } |
| 298 | |
| 299 | } |