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