'''Incremental Search in a Text Widget'''

Here is some recently liberated code that can
count and hi-light string matches in a text
widget as each character is typed.  Probably 
not suitable for more than a couple of megabytes
of text unless tuned or customized.


[http://tclbuzz.com/imgmisc/incrsnap.jpg]

The code a single source file in namespace "incrsearch"
http://tclbuzz.com/imgmisc/incrsearch.zip

Please post good or bad news right here - [RT]
----

[Bryan Oakley] 2009-10-16 - Seeing this page reminded me I have some old code on a flash drive gathering dust that does the same thing. This is old school code, using aliases instead of ensembles, eval instead of {*}, etc. 

I think it works; at least it seemed to when I tested it briefly. You can run the demo by sourcing the file then running the command ::find::demo. 

I had big ambitions at the time I wrote this, it was destined for a commercial product that never saw the light of day. This uses the event loop to highlight all the matches in such a way that the GUI should never block while searching (it finds one match then reschedules itself to search for more). It also starts searching from the cursor position to the bottom, then top to the cursor position so that the closest next match is the first one highlighted.

My goal was to make it a proper megawidget but I don't think I quite finished the job. For example, ".find configure" doesn't return the existing configuration <shrug>. Anyone is welcome to make improvements and maybe even add it to tklib.


======
namespace eval ::find {
    namespace export find
    variable config

    namespace eval instance {}

    bind Find <Return>    {[winfo parent %W] next}
    bind Find <Control-n> {[winfo parent %W] next}
    bind Find <Control-p> {[winfo parent %W] previous}
    bind Find <Control-g> {[winfo parent %W] next}
    bind Find <Escape>    {[winfo parent %W] cancel}
}

proc ::find::demo {} {
    catch {eval destroy [winfo children .]}
    text .t
    grid .t -sticky nsew
    find::find .find -widget .t

    # grid the find widget it so it knows where it belongs, 
    # then remove it so it's not visible at startup
    grid .find -sticky ew
    grid remove .find
    grid columnconfigure . 0 -weight 1
    grid rowconfigure . 0 -weight 1

    bind .find <<Cancel>>  [list grid remove .find]
    bind . <Control-f>    {.find enable .t; grid .find}

    .t insert end "Press Control-f to start finding text\n"
    .t insert end "Press Control-n while in the find widget to find next\n"
    .t insert end "Press Control-p while in the find widget to find previous\n\n"
    .t insert end "fee fie foe fum\nfum fie\nfoe fee\nfee\nfie\nfoe\nfum\n"

    wm geometry . 600x400
    after idle [list ::focus .t]
}

proc ::find::find {path args} {
    upvar \#0 ::find::instance::$path config

    # set default config values
    # these can all be set when creating the widget
    # for example: ::find::find .find -lable "Search" 
    array set config {
        -widget {} 
        -direction forward 
        -label "Find:" 
        -textvariable {} 
        -incremental 1
        -highlight 1
    }

    _create $path

    set actual ::find::widget-$path
    rename $path $actual

    array set config $args

    interp alias {} $path {} ::find::proxy $path

    return $path
}

proc ::find::proxy {path subcommand args} {
    eval \$subcommand \$path $args
}

proc ::find::focus {path} {
    ::focus $path.e
    $path.e selection range 0 end
}

proc ::find::_create {path} {
    upvar \#0 ::find::instance::$path config

    if {$config(-textvariable) eq ""} {
        set config(-textvariable) ::find::textvar($path)
        set ::find::textvar($path) ""
    }

    ttk::frame $path -class Find
    ttk::separator $path.sep -orient horizontal

    ttk::label $path.l -text "Find:"
    ttk::entry $path.e \
        -textvariable $config(-textvariable) \
        -exportselection 0 \
        -validate key \
        -validatecommand [list ::find::restart $path %P]
    ttk::button $path.next -text "Find Next" \
        -style Toolbutton \
        -command [list $path next]
    ttk::button $path.prev -text "Find Previous" \
        -style Toolbutton \
        -command [list $path previous]
    ttk::checkbutton $path.highlight -text "Highlight" \
        -onvalue 1 -offvalue 0 \
        -variable ::find::instance::${path}(-highlight) \
        -command [list ::find::_highlight $path]
    ttk::label $path.info -anchor e
    button $path.hide -image ::find::xImage \
        -borderwidth 2 -relief groove \
        -highlightthickness 0 \
        -command [list $path cancel]

    grid $path.sep -row 0 -column 0 -columnspan 7 -sticky ew -pady 2
    grid $path.l -row 1 -column 0 -sticky e
    grid $path.e -row 1 -column 1 -sticky ew
    grid $path.next -row 1 -column 2
    grid $path.prev -row 1 -column 3
    grid $path.highlight -row 1 -column 4 
    grid $path.info -row 1 -column 5 -sticky nsew -padx {0 10}
    grid $path.hide -row 1 -column 6
    grid columnconfigure $path 5 -weight 1

    bindtags $path.e [concat Find [bindtags $path.e ]]

}

proc ::find::_currentFind {path start end} {
    upvar \#0 ::find::instance::$path config
    $config(-widget) tag remove currentFind 1.0 end
    $config(-widget) tag add currentFind $start $end
    $config(-widget) tag remove sel 1.0 end
    $config(-widget) tag add sel $start $end
    $config(-widget) mark set insert $start
    $config(-widget) see insert
}

proc ::find::configure {path args} {
    upvar \#0 ::find::instance::$path config
    array set config $args
    _highlight $path
}

proc ::find::previous {path} {
    upvar \#0 ::find::instance::$path config

    $path.info configure -text ""
    set range [$config(-widget) tag prevrange find insert]

    # if the cursor is inside the range we just found, look a 
    # little further
    if {[llength $range] == 2 
        && [$config(-widget) compare insert <= [lindex $range 1]]
        && [$config(-widget) compare insert >= [lindex $range 0]]} {
        set i [lindex $range 0]
        set range [$config(-widget) tag prevrange find $i]
    }

    # if the range is null, wrap around to the end of the widget
    if {[llength $range] == 0} {
        set range [$config(-widget) tag prevrange find end]
        $path.info configure -text "find wrapped"
        bell
    }


    if {$range == ""} {
        $path.info configure -text "pattern not found"
        bell
        return
    } else {
        eval _currentFind \$path $range
    }
}

proc ::find::next {path} {
    upvar \#0 ::find::instance::$path config

    $path.info configure -text ""
    set range [$config(-widget) tag nextrange find insert]
    if {[llength $range] == 2 
        && [$config(-widget) compare insert <= [lindex $range 1]]
        && [$config(-widget) compare insert >= [lindex $range 0]]} {
        set i [lindex $range 1]
        set range [$config(-widget) tag nextrange find $i]
    }

    # if the range is null, wrap around to the start of the widget
    if {[llength $range] == 0} {
        set range [$config(-widget) tag nextrange find 1.0]
        $path.info configure -text "find wrapped"
        bell
    }

    if {[llength $range] == 0} {
        $path.info configure -text "pattern not found"
        bell
        return
    }
    if {$range != ""} {
        eval _currentFind \$path $range
    }
}

proc ::find::_highlight {path} {
    upvar \#0 ::find::instance::$path config

    if {$config(-highlight)} {
        $config(-widget) tag configure find -background yellow -foreground black
    } else {
        $config(-widget) tag configure find -background {} -foreground {}
    }
}

proc ::find::enable {path widget} {
    if {[winfo exists $widget]} {
        $widget tag configure find -background yellow -foreground black
        $widget tag configure currentFind \
            -background [$widget tag cget sel -background] \
            -foreground [$widget tag cget sel -foreground]

        $widget tag raise find
        $widget tag raise currentFind find
        after idle [list $path focus]
    }
}

proc ::find::restart {path findString} {
    upvar \#0 ::find::instance::$path config
    $path.info configure -text ""
    if {$findString eq ""} {
        ::find::reset $path
    } else {
        ::find::begin $path $findString
    }

    return 1
}

proc ::find::cancel {path} {
    reset $path
    event generate $path <<Cancel>>
}

proc ::find::reset {path} {
    upvar \#0 ::find::instance::$path config

    $path.info configure -text ""
    foreach id [after info] {
        set info [join [after info $id]]
        if {[string match {*_doOneIteration*} $info]} {
            after cancel $id
        }
    }
    $config(-widget) tag remove currentFind 1.0 end
    $config(-widget) tag remove find 1.0 end
}

proc ::find::begin {path pattern {start insert} {direction -forwards}} {
    upvar \#0 ::find::instance::$path config

    ::find::reset $path

    set start [$config(-widget) index $start]
    
    if {$direction == "-forwards"} {
        set range1 [list $start end]
        if {![string match {1.0} $start]} {
            set range2 [list 1.0 $start]
        } else {
            set range2 {}
        }
    } else {
        set range1 [list $start 1.0]
        if {[$config(-widget) compare $start < end]} {
            set range2 [list end $start]
        } else {
            set range2 {}
        }
    }

    _schedule ::find::_doOneIteration $path $pattern $range1 $range2 $direction
}

proc ::find::_doOneIteration {path pattern range1 range2 direction} {
    upvar \#0 ::find::instance::$path config

    if {$pattern == ""} return

    if {[llength $range1] > 0} {
        set using1 1
        set range $range1
    } else {
        set using1 0
        set range $range2
    }

    if {[llength $range] == 0} return
    
    set i [$config(-widget) search \
               -nocase $direction -count count -- \
               $pattern [lindex $range 0] [lindex $range 1]]

    if {$i == "" && $using1} {
        set range1 {}
        _schedule ::find::_doOneIteration $path $pattern $range1 $range2 $direction
    }

    if {$i != ""} {
        set j [$config(-widget) index "$i + $count chars"]
        $config(-widget) tag add find $i $j
        if {[$config(-widget) tag ranges currentFind] eq ""} {
            _currentFind $path $i $j
        }
        if {[string match {-backwards} $direction]} {
            set j [$config(-widget) index "$i - 1c"]
        }
        if {$using1} {
            set range1 [lreplace $range1 0 0 $j]
        } else {
            set range2 [lreplace $range2 0 0 $j]
        }
        _schedule ::find::_doOneIteration $path $pattern $range1 $range2 $direction
    } else {
        set range [$config(-widget) tag ranges find]
        if {$range eq ""} {
            $path.info configure -text "pattern not found"
        }
    }
}

proc ::find::_schedule {args} {
    after idle [list after 1 $args]
}

proc ::find::hide {path} {grid remove $path}

image create photo ::find::xImage -data {
    R0lGODlhEAAQAPcAAAAAAIAAAACAAICAAAAAgIAAgACAgICAgMDAwP8AAAD/AP//
    AAAA//8A/wD//////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAMwAAZgAA
    mQAAzAAA/wAzAAAzMwAzZgAzmQAzzAAz/wBmAABmMwBmZgBmmQBmzABm/wCZAACZ
    MwCZZgCZmQCZzACZ/wDMAADMMwDMZgDMmQDMzADM/wD/AAD/MwD/ZgD/mQD/zAD/
    /zMAADMAMzMAZjMAmTMAzDMA/zMzADMzMzMzZjMzmTMzzDMz/zNmADNmMzNmZjNm
    mTNmzDNm/zOZADOZMzOZZjOZmTOZzDOZ/zPMADPMMzPMZjPMmTPMzDPM/zP/ADP/
    MzP/ZjP/mTP/zDP//2YAAGYAM2YAZmYAmWYAzGYA/2YzAGYzM2YzZmYzmWYzzGYz
    /2ZmAGZmM2ZmZmZmmWZmzGZm/2aZAGaZM2aZZmaZmWaZzGaZ/2bMAGbMM2bMZmbM
    mWbMzGbM/2b/AGb/M2b/Zmb/mWb/zGb//5kAAJkAM5kAZpkAmZkAzJkA/5kzAJkz
    M5kzZpkzmZkzzJkz/5lmAJlmM5lmZplmmZlmzJlm/5mZAJmZM5mZZpmZmZmZzJmZ
    /5nMAJnMM5nMZpnMmZnMzJnM/5n/AJn/M5n/Zpn/mZn/zJn//8wAAMwAM8wAZswA
    mcwAzMwA/8wzAMwzM8wzZswzmcwzzMwz/8xmAMxmM8xmZsxmmcxmzMxm/8yZAMyZ
    M8yZZsyZmcyZzMyZ/8zMAMzMM8zMZszMmczMzMzM/8z/AMz/M8z/Zsz/mcz/zMz/
    //8AAP8AM/8AZv8Amf8AzP8A//8zAP8zM/8zZv8zmf8zzP8z//9mAP9mM/9mZv9m
    mf9mzP9m//+ZAP+ZM/+ZZv+Zmf+ZzP+Z///MAP/MM//MZv/Mmf/MzP/M////AP//
    M///Zv//mf//zP///yH5BAEAABAALAAAAAAQABAAAAhQAFEIHEiwoMB/CBMqVHiQ
    m8OHEB3+axix4kQU/yRmfIhQIsWEGjde3MhtIcmREBWmpBiSZEmWJjl+7FiSJsqa
    KUWyrCgTI8+II00KNUiUYEAAOw==
}

======


<<categories>>Category Widget