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