variable _class    variable _optiontype    set class $_class($path)    upvar 0 ${class}::opt  classopt    upvar 0 ${class}::map  classmap    upvar 0 ${class}::$path:opt pathopt    upvar 0 ${class}::$path:mod pathmod    set window [_get_window $class $path]    foreach {option value} $options {        if { ![info exists classopt($option)] } {            return -code error "unknown option \"$option\""        }        set optdesc $classopt($option)        set type    [lindex $optdesc 0]        if { [string equal $type "Synonym"] } {            set option  [lindex $optdesc 1]            set optdesc $classopt($option)            set type    [lindex $optdesc 0]        }        if { ![lindex $optdesc 2] } {            set newval [$_optiontype($type) $option $value [lindex $optdesc 3]]            if { [info exists classmap($option)] } {		set window [_get_window $class $window]                foreach {subpath subclass realopt} $classmap($option) {                    if { [string length $subclass] } {			set curval [${subclass}::cget $window$subpath $realopt]                        ${subclass}::configure $window$subpath $realopt $newval                    } else {			set curval [$window$subpath cget $realopt]                        $window$subpath configure $realopt $newval                    }                }            } else {		set curval $pathopt($option)		set pathopt($option) $newval	    }	    set pathmod($option) [expr {![string equal $newval $curval]}]        }    }    return {}}# ----------------------------------------------------------------------------#  Command Widget::cget# ----------------------------------------------------------------------------proc Widget::cget { path option } {    if { ![info exists ::Widget::_class($path)] } {        return -code error "unknown widget $path"    }    set class $::Widget::_class($path)    if { ![info exists ${class}::opt($option)] } {        return -code error "unknown option \"$option\""    }    set optdesc [set ${class}::opt($option)]    set type    [lindex $optdesc 0]    if {[string equal $type "Synonym"]} {        set option [lindex $optdesc 1]    }    if { [info exists ${class}::map($option)] } {	foreach {subpath subclass realopt} [set ${class}::map($option)] {break}	set path "[_get_window $class $path]$subpath"	return [$path cget $realopt]    }    upvar 0 ${class}::$path:opt pathopt    set pathopt($option)}# ----------------------------------------------------------------------------#  Command Widget::subcget# ----------------------------------------------------------------------------proc Widget::subcget { path subwidget } {    set class $::Widget::_class($path)    upvar 0 ${class}::$path:opt pathopt    upvar 0 ${class}::map$subwidget submap    upvar 0 ${class}::$path:init pathinit    set result {}    foreach realopt [array names submap] {	if { [info exists pathinit($submap($realopt))] } {	    lappend result $realopt $pathopt($submap($realopt))	}    }    return $result}# ----------------------------------------------------------------------------#  Command Widget::hasChanged# ----------------------------------------------------------------------------proc Widget::hasChanged { path option pvalue } {    upvar    $pvalue value    set class $::Widget::_class($path)    upvar 0 ${class}::$path:mod pathmod    set value   [Widget::cget $path $option]    set result  $pathmod($option)    set pathmod($option) 0    return $result}proc Widget::hasChangedX { path option args } {    set class $::Widget::_class($path)    upvar 0 ${class}::$path:mod pathmod    set result  $pathmod($option)    set pathmod($option) 0    foreach option $args {	lappend result $pathmod($option)	set pathmod($option) 0    }    set result}# ----------------------------------------------------------------------------#  Command Widget::setoption# ----------------------------------------------------------------------------proc Widget::setoption { path option value } {#    variable _class#    set class $_class($path)#    upvar 0 ${class}::$path:opt pathopt#    set pathopt($option) $value    Widget::configure $path [list $option $value]}# ----------------------------------------------------------------------------#  Command Widget::getoption# ----------------------------------------------------------------------------proc Widget::getoption { path option } {#    set class $::Widget::_class($path)#    upvar 0 ${class}::$path:opt pathopt#    return $pathopt($option)    return [Widget::cget $path $option]}# Widget::getMegawidgetOption --##	Bypass the superfluous checks in cget and just directly peer at the#	widget's data space.  This is much more fragile than cget, so it #	should only be used with great care, in places where speed is critical.## Arguments:#	path	widget to lookup options for.#	option	option to retrieve.## Results:#	value	option value.proc Widget::getMegawidgetOption {path option} {    set class $::Widget::_class($path)    upvar 0 ${class}::${path}:opt pathopt    set pathopt($option)}# Widget::setMegawidgetOption --##	Bypass the superfluous checks in cget and just directly poke at the#	widget's data space.  This is much more fragile than configure, so it #	should only be used with great care, in places where speed is critical.## Arguments:#	path	widget to lookup options for.#	option	option to retrieve.#	value	option value.## Results:#	value	option value.proc Widget::setMegawidgetOption {path option value} {    set class $::Widget::_class($path)    upvar 0 ${class}::${path}:opt pathopt    set pathopt($option) $value}# ----------------------------------------------------------------------------#  Command Widget::_get_window#  returns the window corresponding to widget path# ----------------------------------------------------------------------------proc Widget::_get_window { class path } {    set idx [string last "#" $path]    if { $idx != -1 && [string equal [string range $path [expr {$idx+1}] end] $class] } {        return [string range $path 0 [expr {$idx-1}]]    } else {        return $path    }}# ----------------------------------------------------------------------------#  Command Widget::_get_configure#  returns the configuration list of options#  (as tk widget do - [$w configure ?option?])# ----------------------------------------------------------------------------proc Widget::_get_configure { path options } {    variable _class    set class $_class($path)    upvar 0 ${class}::opt classopt    upvar 0 ${class}::map classmap    upvar 0 ${class}::$path:opt pathopt    upvar 0 ${class}::$path:mod pathmod    set len [llength $options]    if { !$len } {        set result {}        foreach option [lsort [array names classopt]] {            set optdesc $classopt($option)            set type    [lindex $optdesc 0]            if { [string equal $type "Synonym"] } {                set syn     $option                set option  [lindex $optdesc 1]                set optdesc $classopt($option)                set type    [lindex $optdesc 0]            } else {                set syn ""            }            if { [string equal $type "TkResource"] } {                set alt [lindex [lindex $optdesc 3] 1]            } else {                set alt ""            }            set res [_configure_option $option $alt]            if { $syn == "" } {                lappend result [concat $option $res [list [lindex $optdesc 1]] [list [cget $path $option]]]            } else {                lappend result [list $syn [lindex $res 0]]            }        }        return $result    } elseif { $len == 1 } {        set option  [lindex $options 0]        if { ![info exists classopt($option)] } {            return -code error "unknown option \"$option\""        }        set optdesc $classopt($option)        set type    [lindex $optdesc 0]        if { [string equal $type "Synonym"] } {            set option  [lindex $optdesc 1]            set optdesc $classopt($option)            set type    [lindex $optdesc 0]        }        if { [string equal $type "TkResource"] } {            set alt [lindex [lindex $optdesc 3] 1]        } else {            set alt ""        }        set res [_configure_option $option $alt]        return [concat $option $res [list [lindex $optdesc 1]] [list [cget $path $option]]]    }}# ----------------------------------------------------------------------------#  Command Widget::_configure_option# ----------------------------------------------------------------------------proc Widget::_configure_option { option altopt } {    variable _optiondb    variable _optionclass    if { [info exists _optiondb($option)] } {        set optdb $_optiondb($option)    } else {        set optdb [string range $option 1 end]    }    if { [info exists _optionclass($option)] } {        set optclass $_optionclass($option)    } elseif { [string length $altopt] } {        if { [info exists _optionclass($altopt)] } {            set optclass $_optionclass($altopt)        } else {            set optclass [string range $altopt 1 end]        }    } else {        set optclass [string range $option 1 end]    }    return [list $optdb $optclass]}# ----------------------------------------------------------------------------#  Command Widget::_get_tkwidget_options# ----------------------------------------------------------------------------proc Widget::_get_tkwidget_options { tkwidget } {    variable _tk_widget    variable _optiondb    variable _optionclass        set widget ".#BWidget#$tkwidget"    if { ![winfo exists $widget] || ![info exists _tk_widget($tkwidget)] } {	set widget [$tkwidget $widget]	# JDC: Withdraw toplevels, otherwise visible	if {[string equal $tkwidget "toplevel"]} {	    wm withdraw $widget	}	set config [$widget configure]	foreach optlist $config {	    set opt [lindex $optlist 0]	    if { [llength $optlist] == 2 } {		set refsyn [lindex $optlist 1]		# search for class		set idx [lsearch $config [list * $refsyn *]]		if { $idx == -1 } {		    if { [string index $refsyn 0] == "-" } {			# search for option (tk8.1b1 bug)			set idx [lsearch $config [list $refsyn * *]]		    } else {			# last resort			set idx [lsearch $config [list -[string tolower $refsyn] * *]]		    }		    if { $idx == -1 } {			# fed up with "can't read classopt()"			return -code error "can't find option of synonym $opt"		    }		}		set syn [lindex [lindex $config $idx] 0]		# JDC: used 4 (was 3) to get def from optiondb		set def [lindex [lindex $config $idx] 4]		lappend _tk_widget($tkwidget) [list $opt $syn $def]	    } else {		# JDC: used 4 (was 3) to get def from optiondb		set def [lindex $optlist 4]		lappend _tk_widget($tkwidget) [list $opt $def]		set _optiondb($opt)    [lindex $optlist 1]		set _optionclass($opt) [lindex $optlist 2]	    }	}    }    return $_tk_widget($tkwidget)}# ----------------------------------------------------------------------------#  Command Widget::_test_tkresource# ----------------------------------------------------------------------------proc Widget::_test_tkresource { option value arg } {#    set tkwidget [lindex $arg 0]#    set realopt  [lindex $arg 1]    foreach {tkwidget realopt} $arg break    set path     ".#BWidget#$tkwidget"    set old      [$path cget $realopt]    $path configure $realopt $value    set res      [$path cget $realopt]    $path configure $realopt $old    return $res}# ----------------------------------------------------------------------------#  Command Widget::_test_bwresource# ----------------------------------------------------------------------------proc Widget::_test_bwresource { option value arg } {    return -code error "bad option type BwResource in widget"}# ----------------------------------------------------------------------------#  Command Widget::_test_synonym# ----------------------------------------------------------------------------proc Widget::_test_synonym { option value arg } {    return -code error "bad option type Synonym in widget"}# ----------------------------------------------------------------------------#  Command Widget::_test_color# ----------------------------------------------------------------------------proc Widget::_test_color { option value arg } {    if {[catch {winfo rgb . $value} color]} {        return -code error "bad $option value \"$value\": must be a colorname \