lib/search.tcl

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