Posted to tcl by kostix at Sun Jan 06 23:42:13 GMT 2008view pretty

##########################################################################
# Search in text widget

proc search::glob2regexp {pattern} {
    string map {\\* \\*
		\\? \\?
		\\[ \\[
		*   .*
		?   .
		[^] \\^
		[^  [\\^
		[!  [^
		|   \\|
		+   \\+
		(   \\(
		)   \\)
		$   \\$
		.   \\.
		\"   \\"} $pattern
}

proc search::do_text_search {txt pattern dir} {
    variable options
	
    if {![string length $pattern]} {
	return 0
    }

    if {$dir == "up"} {
	set search_from sel_start
	set search_to   0.0
	set search_dir  -backwards
    } else {
	set search_from "sel_start +1char"
	set search_to	end
	set search_dir  -forwards
    }

    if {$options(case)} {
	set case ""
    } else {
	set case -nocase
    }

    switch -- $options(mode) {
	regexp {
	    set exact -regexp
	}
	glob {
	    set exact -regexp
	    set pattern [glob2regexp $pattern]
	}
	default {
	    set exact -exact
	}
    }

    if {[catch { eval [list $txt] search $search_dir $case $exact -- \
			   [list $pattern $search_from] } index]} {
	set index {}
    }

    if {![string length $index]} {
 	return 0
    } else {
	$txt tag remove search_highlight 0.0 end
	if {$exact == "-regexp"} {
	    set line [$txt get $index "$index lineend"]
	    eval regexp $case -- [list $pattern $line] match
	    $txt tag add search_highlight $index "$index + [string length $match] chars"
	    if {[string length $match] == 0} {
		set nohighlight 1
	    } else {
		set nohighlight 0
	    }
	} else {
	    $txt tag add search_highlight $index "$index + [string length $pattern] chars"
	    if {[string length $pattern] == 0} {
		set nohighlight 1
	    } else {
		set nohighlight 0
	    }
	}
	if {!$nohighlight} {
	    $txt tag configure search_highlight -background \
		[option get $txt highlightSearchBackground Text]
	    $txt mark set sel_start search_highlight.first
	    $txt mark set sel_end search_highlight.last
	    $txt see $index
	    return 1
	}
    }
}