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