lib / search.tclon commit Merge branch 'bw/searching' (ae6ec61)
   1# incremental search panel
   2# based on code from gitk, Copyright (C) Paul Mackerras
   3
   4class searchbar {
   5
   6field w
   7field ctext
   8
   9field searchstring   {}
  10field regexpsearch
  11field default_regexpsearch
  12field casesensitive
  13field default_casesensitive
  14field smartcase
  15field searchdirn     -forwards
  16
  17field history
  18field history_index
  19
  20field smarktop
  21field smarkbot
  22
  23constructor new {i_w i_text args} {
  24        global use_ttk NS
  25        set w      $i_w
  26        set ctext  $i_text
  27
  28        set default_regexpsearch [is_config_true gui.search.regexp]
  29        set smartcase [is_config_true gui.search.smartcase]
  30        if {$smartcase} {
  31                set default_casesensitive 0
  32        } else {
  33                set default_casesensitive 1
  34        }
  35
  36        set history [list]
  37
  38        ${NS}::frame  $w
  39        ${NS}::label  $w.l       -text [mc Find:]
  40        tentry  $w.ent -textvariable ${__this}::searchstring -background lightgreen
  41        ${NS}::button $w.bn      -text [mc Next] -command [cb find_next]
  42        ${NS}::button $w.bp      -text [mc Prev] -command [cb find_prev]
  43        ${NS}::checkbutton $w.re -text [mc RegExp] \
  44                -variable ${__this}::regexpsearch -command [cb _incrsearch]
  45        ${NS}::checkbutton $w.cs -text [mc Case] \
  46                -variable ${__this}::casesensitive -command [cb _incrsearch]
  47        pack   $w.l   -side left
  48        pack   $w.cs  -side right
  49        pack   $w.re  -side right
  50        pack   $w.bp  -side right
  51        pack   $w.bn  -side right
  52        pack   $w.ent -side left -expand 1 -fill x
  53
  54        eval grid conf $w -sticky we $args
  55        grid remove $w
  56
  57        trace add variable searchstring write [cb _incrsearch_cb]
  58        bind $w.ent <Return> [cb find_next]
  59        bind $w.ent <Shift-Return> [cb find_prev]
  60        bind $w.ent <Key-Up>   [cb _prev_search]
  61        bind $w.ent <Key-Down> [cb _next_search]
  62        
  63        bind $w <Destroy> [list delete_this $this]
  64        return $this
  65}
  66
  67method show {} {
  68        if {![visible $this]} {
  69                grid $w
  70                $w.ent delete 0 end
  71                set regexpsearch  $default_regexpsearch
  72                set casesensitive $default_casesensitive
  73                set history_index [llength $history]
  74        }
  75        focus -force $w.ent
  76}
  77
  78method hide {} {
  79        if {[visible $this]} {
  80                focus $ctext
  81                grid remove $w
  82                _save_search $this
  83        }
  84}
  85
  86method visible {} {
  87        return [winfo ismapped $w]
  88}
  89
  90method editor {} {
  91        return $w.ent
  92}
  93
  94method _get_new_anchor {} {
  95        # use start of selection if it is visible,
  96        # or the bounds of the visible area
  97        set top    [$ctext index @0,0]
  98        set bottom [$ctext index @0,[winfo height $ctext]]
  99        set sel    [$ctext tag ranges sel]
 100        if {$sel ne {}} {
 101                set spos [lindex $sel 0]
 102                if {[lindex $spos 0] >= [lindex $top 0] &&
 103                    [lindex $spos 0] <= [lindex $bottom 0]} {
 104                        return $spos
 105                }
 106        }
 107        if {$searchdirn eq "-forwards"} {
 108                return $top
 109        } else {
 110                return $bottom
 111        }
 112}
 113
 114method _get_wrap_anchor {dir} {
 115        if {$dir eq "-forwards"} {
 116                return 1.0
 117        } else {
 118                return end
 119        }
 120}
 121
 122method _do_search {start {mlenvar {}} {dir {}} {endbound {}}} {
 123        set cmd [list $ctext search]
 124        if {$mlenvar ne {}} {
 125                upvar $mlenvar mlen
 126                lappend cmd -count mlen
 127        }
 128        if {$regexpsearch} {
 129                lappend cmd -regexp
 130        }
 131        if {!$casesensitive} {
 132                lappend cmd -nocase
 133        }
 134        if {$dir eq {}} {
 135                set dir $searchdirn
 136        }
 137        lappend cmd $dir -- $searchstring
 138        if {[catch {
 139                if {$endbound ne {}} {
 140                        set here [eval $cmd [list $start] [list $endbound]]
 141                } else {
 142                        set here [eval $cmd [list $start]]
 143                        if {$here eq {}} {
 144                                set here [eval $cmd [_get_wrap_anchor $this $dir]]
 145                        }
 146                }
 147        } err]} { set here {} }
 148        return $here
 149}
 150
 151method _incrsearch_cb {name ix op} {
 152        after idle [cb _incrsearch]
 153}
 154
 155method _incrsearch {} {
 156        $ctext tag remove found 1.0 end
 157        if {[catch {$ctext index anchor}]} {
 158                $ctext mark set anchor [_get_new_anchor $this]
 159        }
 160        if {$smartcase} {
 161                if {[regexp {[[:upper:]]} $searchstring]} {
 162                        set casesensitive 1
 163                }
 164        }
 165        if {$searchstring ne {}} {
 166                set here [_do_search $this anchor mlen]
 167                if {$here ne {}} {
 168                        $ctext see $here
 169                        $ctext tag remove sel 1.0 end
 170                        $ctext tag add sel $here "$here + $mlen c"
 171                        #$w.ent configure -background lightgreen
 172                        $w.ent state !pressed
 173                        _set_marks $this 1
 174                } else {
 175                        #$w.ent configure -background lightpink
 176                        $w.ent state pressed
 177                }
 178        }
 179}
 180
 181method _save_search {} {
 182        if {$searchstring eq {}} {
 183                return
 184        }
 185        if {[llength $history] > 0} {
 186                foreach {s_regexp s_case s_expr} [lindex $history end] break
 187        } else {
 188                set s_regexp $regexpsearch
 189                set s_case   $casesensitive
 190                set s_expr   ""
 191        }
 192        if {$searchstring eq $s_expr} {
 193                # update modes
 194                set history [lreplace $history end end \
 195                                [list $regexpsearch $casesensitive $searchstring]]
 196        } else {
 197                lappend history [list $regexpsearch $casesensitive $searchstring]
 198        }
 199        set history_index [llength $history]
 200}
 201
 202method _prev_search {} {
 203        if {$history_index > 0} {
 204                incr history_index -1
 205                foreach {s_regexp s_case s_expr} [lindex $history $history_index] break
 206                $w.ent delete 0 end
 207                $w.ent insert 0 $s_expr
 208                set regexpsearch $s_regexp
 209                set casesensitive $s_case
 210        }
 211}
 212
 213method _next_search {} {
 214        if {$history_index < [llength $history]} {
 215                incr history_index
 216        }
 217        if {$history_index < [llength $history]} {
 218                foreach {s_regexp s_case s_expr} [lindex $history $history_index] break
 219        } else {
 220                set s_regexp $default_regexpsearch
 221                set s_case   $default_casesensitive
 222                set s_expr   ""
 223        }
 224        $w.ent delete 0 end
 225        $w.ent insert 0 $s_expr
 226        set regexpsearch $s_regexp
 227        set casesensitive $s_case
 228}
 229
 230method find_prev {} {
 231        find_next $this -backwards
 232}
 233
 234method find_next {{dir -forwards}} {
 235        focus $w.ent
 236        $w.ent icursor end
 237        set searchdirn $dir
 238        $ctext mark unset anchor
 239        if {$searchstring ne {}} {
 240                _save_search $this
 241                set start [_get_new_anchor $this]
 242                if {$dir eq "-forwards"} {
 243                        set start "$start + 1c"
 244                }
 245                set match [_do_search $this $start mlen]
 246                $ctext tag remove sel 1.0 end
 247                if {$match ne {}} {
 248                        $ctext see $match
 249                        $ctext tag add sel $match "$match + $mlen c"
 250                }
 251        }
 252}
 253
 254method _mark_range {first last} {
 255        set mend $first.0
 256        while {1} {
 257                set match [_do_search $this $mend mlen -forwards $last.end]
 258                if {$match eq {}} break
 259                set mend "$match + $mlen c"
 260                $ctext tag add found $match $mend
 261        }
 262}
 263
 264method _set_marks {doall} {
 265        set topline [lindex [split [$ctext index @0,0] .] 0]
 266        set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
 267        if {$doall || $botline < $smarktop || $topline > $smarkbot} {
 268                # no overlap with previous
 269                _mark_range $this $topline $botline
 270                set smarktop $topline
 271                set smarkbot $botline
 272        } else {
 273                if {$topline < $smarktop} {
 274                        _mark_range $this $topline [expr {$smarktop-1}]
 275                        set smarktop $topline
 276                }
 277                if {$botline > $smarkbot} {
 278                        _mark_range $this [expr {$smarkbot+1}] $botline
 279                        set smarkbot $botline
 280                }
 281        }
 282}
 283
 284method scrolled {} {
 285        if {$searchstring ne {}} {
 286                after idle [cb _set_marks 0]
 287        }
 288}
 289
 290}