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