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