or #RRGGBB triplet"    }    return $value}# ----------------------------------------------------------------------------#  Command Widget::_test_string# ----------------------------------------------------------------------------proc Widget::_test_string { option value arg } {    set value}# ----------------------------------------------------------------------------#  Command Widget::_test_flag# ----------------------------------------------------------------------------proc Widget::_test_flag { option value arg } {    set len [string length $value]    set res ""    for {set i 0} {$i < $len} {incr i} {        set c [string index $value $i]        if { [string first $c $arg] == -1 } {            return -code error "bad [string range $option 1 end] value \"$value\": characters must be in \"$arg\""        }        if { [string first $c $res] == -1 } {            append res $c        }    }    return $res}# -----------------------------------------------------------------------------#  Command Widget::_test_enum# -----------------------------------------------------------------------------proc Widget::_test_enum { option value arg } {    if { [lsearch $arg $value] == -1 } {        set last [lindex   $arg end]        set sub  [lreplace $arg end end]        if { [llength $sub] } {            set str "[join $sub ", "] or $last"        } else {            set str $last        }        return -code error "bad [string range $option 1 end] value \"$value\": must be $str"    }    return $value}# -----------------------------------------------------------------------------#  Command Widget::_test_int# -----------------------------------------------------------------------------proc Widget::_test_int { option value arg } {    if { ![string is int -strict $value] || \	    ([string length $arg] && \	    ![expr [string map [list %d $value] $arg]]) } {		    return -code error "bad $option value\			    \"$value\": must be integer ($arg)"    }    return $value}# -----------------------------------------------------------------------------#  Command Widget::_test_boolean# -----------------------------------------------------------------------------proc Widget::_test_boolean { option value arg } {    if { ![string is boolean -strict $value] } {        return -code error "bad $option value \"$value\": must be boolean"    }    # Get the canonical form of the boolean value (1 for true, 0 for false)    return [string is true $value]}# -----------------------------------------------------------------------------#  Command Widget::_test_padding# -----------------------------------------------------------------------------proc Widget::_test_padding { option values arg } {    set len [llength $values]    if {$len < 1 || $len > 2} {        return -code error "bad pad value \"$values\":\                        must be positive screen distance"    }    foreach value $values {        if { ![string is int -strict $value] || \            ([string length $arg] && \            ![expr [string map [list %d $value] $arg]]) } {                return -code error "bad pad value \"$value\":\                                must be positive screen distance ($arg)"        }    }    return $values}# Widget::_get_padding --##       Return the requesting padding value for a padding option.## Arguments:#	path		Widget to get the options for.#       option          The name of the padding option.#	index		The index of the padding.  If the index is empty,#                       the first padding value is returned.## Results:#	Return a numeric value that can be used for padding.proc Widget::_get_padding { path option {index 0} } {    set pad [Widget::cget $path $option]    set val [lindex $pad $index]    if {$val == ""} { set val [lindex $pad 0] }    return $val}# -----------------------------------------------------------------------------#  Command Widget::focusNext#  Same as tk_focusNext, but call Widget::focusOK# -----------------------------------------------------------------------------proc Widget::focusNext { w } {    set cur $w    while 1 {	# Descend to just before the first child of the current widget.	set parent $cur	set children [winfo children $cur]	set i -1	# Look for the next sibling that isn't a top-level.	while 1 {	    incr i	    if {$i < [llength $children]} {		set cur [lindex $children $i]		if {[winfo toplevel $cur] == $cur} {		    continue		} else {		    break		}	    }	    # No more siblings, so go to the current widget's parent.	    # If it's a top-level, break out of the loop, otherwise	    # look for its next sibling.	    set cur $parent	    if {[winfo toplevel $cur] == $cur} {		break	    }	    set parent [winfo parent $parent]	    set children [winfo children $parent]	    set i [lsearch -exact $children $cur]	}	if {($cur == $w) || [focusOK $cur]} {	    return $cur	}    }}# -----------------------------------------------------------------------------#  Command Widget::focusPrev#  Same as tk_focusPrev, but call Widget::focusOK# -----------------------------------------------------------------------------proc Widget::focusPrev { w } {    set cur $w    while 1 {	# Collect information about the current window's position	# among its siblings.  Also, if the window is a top-level,	# then reposition to just after the last child of the window.    	if {[winfo toplevel $cur] == $cur}  {	    set parent $cur	    set children [winfo children $cur]	    set i [llength $children]	} else {	    set parent [winfo parent $cur]	    set children [winfo children $parent]	    set i [lsearch -exact $children $cur]	}	# Go to the previous sibling, then descend to its last descendant	# (highest in stacking order.  While doing this, ignore top-levels	# and their descendants.  When we run out of descendants, go up	# one level to the parent.	while {$i > 0} {	    incr i -1	    set cur [lindex $children $i]	    if {[winfo toplevel $cur] == $cur} {		continue	    }	    set parent $cur	    set children [winfo children $parent]	    set i [llength $children]	}	set cur $parent	if {($cur == $w) || [focusOK $cur]} {	    return $cur	}    }}# ----------------------------------------------------------------------------#  Command Widget::focusOK#  Same as tk_focusOK, but handles -editable option and whole tags list.# ----------------------------------------------------------------------------proc Widget::focusOK { w } {    set code [catch {$w cget -takefocus} value]    if { $code == 1 } {        return 0    }    if {($code == 0) && ($value != "")} {	if {$value == 0} {	    return 0	} elseif {$value == 1} {	    return [winfo viewable $w]	} else {	    set value [uplevel \#0 $value $w]            if {$value != ""} {		return $value	    }        }    }    if {![winfo viewable $w]} {	return 0    }    set code [catch {$w cget -state} value]    if {($code == 0) && ($value == "disabled")} {	return 0    }    set code [catch {$w cget -editable} value]    if {($code == 0) && ($value == 0)} {        return 0    }    set top [winfo toplevel $w]    foreach tags [bindtags $w] {        if { ![string equal $tags $top]  &&             ![string equal $tags "all"] &&             [regexp Key [bind $tags]] } {            return 1        }    }    return 0}proc Widget::traverseTo { w } {    set focus [focus]    if {![string equal $focus ""]} {	event generate $focus <<TraverseOut>>    }    focus $w    event generate $w <<TraverseIn>>}# Widget::varForOption --##	Retrieve a fully qualified variable name for the option specified.#	If the option is not one for which a variable exists, throw an error #	(ie, those options that map directly to widget options).## Arguments:#	path	megawidget to get an option var for.#	option	option to get a var for.## Results:#	varname	name of the variable, fully qualified, suitable for tracing.proc Widget::varForOption {path option} {    variable _class    variable _optiontype    set class $_class($path)    upvar 0 ${class}::$path:opt pathopt    if { ![info exists pathopt($option)] } {	error "unable to find variable for option \"$option\""    }    set varname "::Widget::${class}::$path:opt($option)"    return $varname}# Widget::getVariable --##       Get a variable from within the namespace of the widget.## Arguments:#	path		Megawidget to get the variable for.#	varName		The variable name to retrieve.#       newVarName	The variable name to refer to in the calling proc.## Results:#	Creates a reference to newVarName in the calling proc.proc Widget::getVariable { path varName {newVarName ""} } {    variable _class    set class $_class($path)    if {![string length $newVarName]} { set newVarName $varName }    uplevel 1 [list upvar \#0 ${class}::$path:$varName $newVarName]}# Widget::options --##       Return a key-value list of options for a widget.  This can#       be used to serialize the options of a widget and pass them#       on to a new widget with the same options.## Arguments:#	path		Widget to get the options for.#	args		A list of options.  If empty, all options are returned.## Results:#	Returns list of options as: -option value -option value ...proc Widget::options { path args } {    if {[llength $args]} {        foreach option $args {            lappend options [_get_configure $path $option]        }    } else {        set options [_get_configure $path {}]    }    set result [list]    foreach list $options {        if {[llength $list] < 5} { continue }        lappend result [lindex $list 0] [lindex $list end]    }    return $result}# Widget::getOption --##	Given a list of widgets, determine which option value to use.#	The widgets are given to the command in order of highest to#	lowest.  Starting with the lowest widget, whichever one does#	not match the default option value is returned as the value.#	If all the widgets are default, we return the highest widget's#	value.## Arguments:#	option		The option to check.#	default		The default value.  If any widget in the list#			does not match this default, its value is used.#	args		A list of widgets.## Results:#	Returns the value of the given option to use.#proc Widget::getOption { option default args } {    for {set i [expr [llength $args] -1]} {$i >= 0} {incr i -1} {	set widget [lindex $args $i]	set value  [Widget::cget $widget $option]	if {[string equal $value $default]} { continue }	return $value    }    return $value}proc Widget::nextIndex { path node } {    Widget::getVariable $path autoIndex    if {![info exists autoIndex]} { set autoIndex -1 }    return [string map [list #auto [incr autoIndex]] $node]}proc Widget::exists { path } {    variable _class    return [info exists _class($path)]}