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