Bwidget Source Code
Artifact [8049ee2835]
Not logged in

Artifact 8049ee283595d33f333a166773615c7e0aa04521:

Attachment "widget.patch" to ticket [6cd041bcc1] added by oehhar 2013-10-17 06:45:19.
--- U:/elmicron/tech/tcl/bwidget/checkout_bwidget/widget.tcl	Mon Sep 02 11:37:00 2013
+++ U:/elmicron/tech/tcl/bwidget/checkout_bwidget/widget_wo.tcl	Thu Oct 17 08:37:16 2013
@@ -1,1623 +1,1621 @@
-# ----------------------------------------------------------------------------
-#  widget.tcl
-#  This file is part of Unifix BWidget Toolkit
-#  $Id: widget.tcl,v 1.35.2.1 2011/11/14 14:33:29 oehhar Exp $
-# ----------------------------------------------------------------------------
-#  Index of commands:
-#     - Widget::tkinclude
-#     - Widget::bwinclude
-#     - Widget::declare
-#     - Widget::addmap
-#     - Widget::init
-#     - Widget::destroy
-#     - Widget::setoption
-#     - Widget::configure
-#     - Widget::cget
-#     - Widget::subcget
-#     - Widget::hasChanged
-#     - Widget::options
-#     - Widget::_get_tkwidget_options
-#     - Widget::_test_tkresource
-#     - Widget::_test_bwresource
-#     - Widget::_test_synonym
-#     - Widget::_test_string
-#     - Widget::_test_flag
-#     - Widget::_test_enum
-#     - Widget::_test_int
-#     - Widget::_test_boolean
-# ----------------------------------------------------------------------------
-# Each megawidget gets a namespace of the same name inside the Widget namespace
-# Each of these has an array opt, which contains information about the 
-# megawidget options.  It maps megawidget options to a list with this format:
-#     {optionType defaultValue isReadonly {additionalOptionalInfo}}
-# Option types and their additional optional info are:
-#	TkResource	{genericTkWidget genericTkWidgetOptionName}
-#	BwResource	{nothing}
-#	Enum		{list of enumeration values}
-#	Int		{Boundary information}
-#	Boolean		{nothing}
-#	String		{nothing}
-#	Flag		{string of valid flag characters}
-#	Synonym		{nothing}
-#	Color		{nothing}
-#
-# Next, each namespace has an array map, which maps class options to their
-# component widget options:
-#	map(-foreground) => {.e -foreground .f -foreground}
-#
-# Each has an array ${path}:opt, which contains the value of each megawidget
-# option for a particular instance $path of the megawidget, and an array
-# ${path}:mod, which stores the "changed" status of configuration options.
-
-# Steps for creating a bwidget megawidget:
-# 1. parse args to extract subwidget spec
-# 2. Create frame with appropriate class and command line options
-# 3. Get initialization options from optionDB, using frame
-# 4. create subwidgets
-
-# Uses newer string operations
-package require Tcl 8.1.1
-
-namespace eval Widget {
-    variable _optiontype
-    variable _class
-    variable _tk_widget
-
-    # This controls whether we try to use themed widgets from Tile
-    variable _theme 0
-
-    variable _aqua [expr {($::tcl_version >= 8.4) &&
-			  [string equal [tk windowingsystem] "aqua"]}]
-
-    array set _optiontype {
-        TkResource Widget::_test_tkresource
-        BwResource Widget::_test_bwresource
-        Enum       Widget::_test_enum
-        Int        Widget::_test_int
-        Boolean    Widget::_test_boolean
-        String     Widget::_test_string
-        Flag       Widget::_test_flag
-        Synonym    Widget::_test_synonym
-        Color      Widget::_test_color
-        Padding    Widget::_test_padding
-    }
-
-    proc use {} {}
-}
-
-
-# ----------------------------------------------------------------------------
-#  Command Widget::tkinclude
-#     Includes tk widget resources to BWidget widget.
-#  class      class name of the BWidget
-#  tkwidget   tk widget to include
-#  subpath    subpath to configure
-#  args       additionnal args for included options
-# ----------------------------------------------------------------------------
-proc Widget::tkinclude { class tkwidget subpath args } {
-    foreach {cmd lopt} $args {
-        # cmd can be
-        #   include      options to include            lopt = {opt ...}
-        #   remove       options to remove             lopt = {opt ...}
-        #   rename       options to rename             lopt = {opt newopt ...}
-        #   prefix       options to prefix             lopt = {pref opt opt ..}
-        #   initialize   set default value for options lopt = {opt value ...}
-        #   readonly     set readonly flag for options lopt = {opt flag ...}
-        switch -- $cmd {
-            remove {
-                foreach option $lopt {
-                    set remove($option) 1
-                }
-            }
-            include {
-                foreach option $lopt {
-                    set include($option) 1
-                }
-            }
-            prefix {
-                set prefix [lindex $lopt 0]
-                foreach option [lrange $lopt 1 end] {
-                    set rename($option) "-$prefix[string range $option 1 end]"
-                }
-            }
-            rename     -
-            readonly   -
-            initialize {
-                array set $cmd $lopt
-            }
-            default {
-                return -code error "invalid argument \"$cmd\""
-            }
-        }
-    }
-
-    namespace eval $class {}
-    upvar 0 ${class}::opt classopt
-    upvar 0 ${class}::map classmap
-    upvar 0 ${class}::map$subpath submap
-    upvar 0 ${class}::optionExports exports
-
-    set foo [$tkwidget ".ericFoo###"]
-    # create resources informations from tk widget resources
-    foreach optdesc [_get_tkwidget_options $tkwidget] {
-        set option [lindex $optdesc 0]
-        if { (![info exists include] || [info exists include($option)]) &&
-             ![info exists remove($option)] } {
-            if { [llength $optdesc] == 3 } {
-                # option is a synonym
-                set syn [lindex $optdesc 1]
-                if { ![info exists remove($syn)] } {
-                    # original option is not removed
-                    if { [info exists rename($syn)] } {
-                        set classopt($option) [list Synonym $rename($syn)]
-                    } else {
-                        set classopt($option) [list Synonym $syn]
-                    }
-                }
-            } else {
-                if { [info exists rename($option)] } {
-                    set realopt $option
-                    set option  $rename($option)
-                } else {
-                    set realopt $option
-                }
-                if { [info exists initialize($option)] } {
-                    set value $initialize($option)
-                } else {
-                    set value [lindex $optdesc 1]
-                }
-                if { [info exists readonly($option)] } {
-                    set ro $readonly($option)
-                } else {
-                    set ro 0
-                }
-                set classopt($option) \
-			[list TkResource $value $ro [list $tkwidget $realopt]]
-
-		# Add an option database entry for this option
-		set optionDbName ".[lindex [_configure_option $realopt ""] 0]"
-		if { ![string equal $subpath ":cmd"] } {
-		    set optionDbName "$subpath$optionDbName"
-		}
-		option add *${class}$optionDbName $value widgetDefault
-		lappend exports($option) "$optionDbName"
-
-		# Store the forward and backward mappings for this
-		# option <-> realoption pair
-                lappend classmap($option) $subpath "" $realopt
-		set submap($realopt) $option
-            }
-        }
-    }
-    ::destroy $foo
-}
-
-
-# ----------------------------------------------------------------------------
-#  Command Widget::bwinclude
-#     Includes BWidget resources to BWidget widget.
-#  class    class name of the BWidget
-#  subclass BWidget class to include
-#  subpath  subpath to configure
-#  args     additionnal args for included options
-# ----------------------------------------------------------------------------
-proc Widget::bwinclude { class subclass subpath args } {
-    foreach {cmd lopt} $args {
-        # cmd can be
-        #   include      options to include            lopt = {opt ...}
-        #   remove       options to remove             lopt = {opt ...}
-        #   rename       options to rename             lopt = {opt newopt ...}
-        #   prefix       options to prefix             lopt = {prefix opt opt ...}
-        #   initialize   set default value for options lopt = {opt value ...}
-        #   readonly     set readonly flag for options lopt = {opt flag ...}
-        switch -- $cmd {
-            remove {
-                foreach option $lopt {
-                    set remove($option) 1
-                }
-            }
-            include {
-                foreach option $lopt {
-                    set include($option) 1
-                }
-            }
-            prefix {
-                set prefix [lindex $lopt 0]
-                foreach option [lrange $lopt 1 end] {
-                    set rename($option) "-$prefix[string range $option 1 end]"
-                }
-            }
-            rename     -
-            readonly   -
-            initialize {
-                array set $cmd $lopt
-            }
-            default {
-                return -code error "invalid argument \"$cmd\""
-            }
-        }
-    }
-
-    namespace eval $class {}
-    upvar 0 ${class}::opt classopt
-    upvar 0 ${class}::map classmap
-    upvar 0 ${class}::map$subpath submap
-    upvar 0 ${class}::optionExports exports
-    upvar 0 ${subclass}::opt subclassopt
-    upvar 0 ${subclass}::optionExports subexports
-
-    # create resources informations from BWidget resources
-    foreach {option optdesc} [array get subclassopt] {
-	set subOption $option
-        if { (![info exists include] || [info exists include($option)]) &&
-             ![info exists remove($option)] } {
-            set type [lindex $optdesc 0]
-            if { [string equal $type "Synonym"] } {
-                # option is a synonym
-                set syn [lindex $optdesc 1]
-                if { ![info exists remove($syn)] } {
-                    if { [info exists rename($syn)] } {
-                        set classopt($option) [list Synonym $rename($syn)]
-                    } else {
-                        set classopt($option) [list Synonym $syn]
-                    }
-                }
-            } else {
-                if { [info exists rename($option)] } {
-                    set realopt $option
-                    set option  $rename($option)
-                } else {
-                    set realopt $option
-                }
-                if { [info exists initialize($option)] } {
-                    set value $initialize($option)
-                } else {
-                    set value [lindex $optdesc 1]
-                }
-                if { [info exists readonly($option)] } {
-                    set ro $readonly($option)
-                } else {
-                    set ro [lindex $optdesc 2]
-                }
-                set classopt($option) \
-			[list $type $value $ro [lindex $optdesc 3]]
-
-		# Add an option database entry for this option
-		foreach optionDbName $subexports($subOption) {
-		    if { ![string equal $subpath ":cmd"] } {
-			set optionDbName "$subpath$optionDbName"
-		    }
-		    # Only add the option db entry if we are overriding the
-		    # normal widget default
-		    if { [info exists initialize($option)] } {
-			option add *${class}$optionDbName $value \
-				widgetDefault
-		    }
-		    lappend exports($option) "$optionDbName"
-		}
-
-		# Store the forward and backward mappings for this
-		# option <-> realoption pair
-                lappend classmap($option) $subpath $subclass $realopt
-		set submap($realopt) $option
-            }
-        }
-    }
-}
-
-
-# ----------------------------------------------------------------------------
-#  Command Widget::declare
-#    Declares new options to BWidget class.
-# ----------------------------------------------------------------------------
-proc Widget::declare { class optlist } {
-    variable _optiontype
-
-    namespace eval $class {}
-    upvar 0 ${class}::opt classopt
-    upvar 0 ${class}::optionExports exports
-    upvar 0 ${class}::optionClass optionClass
-
-    foreach optdesc $optlist {
-        set option  [lindex $optdesc 0]
-        set optdesc [lrange $optdesc 1 end]
-        set type    [lindex $optdesc 0]
-
-        if { ![info exists _optiontype($type)] } {
-            # invalid resource type
-            return -code error "invalid option type \"$type\""
-        }
-
-        if { [string equal $type "Synonym"] } {
-            # test existence of synonym option
-            set syn [lindex $optdesc 1]
-            if { ![info exists classopt($syn)] } {
-                return -code error "unknow option \"$syn\" for Synonym \"$option\""
-            }
-            set classopt($option) [list Synonym $syn]
-            continue
-        }
-
-        # all other resource may have default value, readonly flag and
-        # optional arg depending on type
-        set value [lindex $optdesc 1]
-        set ro    [lindex $optdesc 2]
-        set arg   [lindex $optdesc 3]
-
-        if { [string equal $type "BwResource"] } {
-            # We don't keep BwResource. We simplify to type of sub BWidget
-            set subclass    [lindex $arg 0]
-            set realopt     [lindex $arg 1]
-            if { ![string length $realopt] } {
-                set realopt $option
-            }
-
-            upvar 0 ${subclass}::opt subclassopt
-            if { ![info exists subclassopt($realopt)] } {
-                return -code error "unknow option \"$realopt\""
-            }
-            set suboptdesc $subclassopt($realopt)
-            if { $value == "" } {
-                # We initialize default value
-                set value [lindex $suboptdesc 1]
-            }
-            set type [lindex $suboptdesc 0]
-            set ro   [lindex $suboptdesc 2]
-            set arg  [lindex $suboptdesc 3]
-	    set optionDbName ".[lindex [_configure_option $option ""] 0]"
-	    option add *${class}${optionDbName} $value widgetDefault
-	    set exports($option) $optionDbName
-            set classopt($option) [list $type $value $ro $arg]
-            continue
-        }
-
-        # retreive default value for TkResource
-        if { [string equal $type "TkResource"] } {
-            set tkwidget [lindex $arg 0]
-	    set foo [$tkwidget ".ericFoo##"]
-            set realopt  [lindex $arg 1]
-            if { ![string length $realopt] } {
-                set realopt $option
-            }
-            set tkoptions [_get_tkwidget_options $tkwidget]
-            if { ![string length $value] } {
-                # We initialize default value
-		set ind [lsearch $tkoptions [list $realopt *]]
-                set value [lindex [lindex $tkoptions $ind] end]
-            }
-	    set optionDbName ".[lindex [_configure_option $option ""] 0]"
-	    option add *${class}${optionDbName} $value widgetDefault
-	    set exports($option) $optionDbName
-            set classopt($option) [list TkResource $value $ro \
-		    [list $tkwidget $realopt]]
-	    set optionClass($option) [lindex [$foo configure $realopt] 1]
-	    ::destroy $foo
-            continue
-        }
-
-	set optionDbName ".[lindex [_configure_option $option ""] 0]"
-	option add *${class}${optionDbName} $value widgetDefault
-	set exports($option) $optionDbName
-        # for any other resource type, we keep original optdesc
-        set classopt($option) [list $type $value $ro $arg]
-    }
-}
-
-
-proc Widget::define { class filename args } {
-    variable ::BWidget::use
-    set use($class)      $args
-    set use($class,file) $filename
-    lappend use(classes) $class
-
-    if {[set x [lsearch -exact $args "-classonly"]] > -1} {
-	set args [lreplace $args $x $x]
-    } else {
-	interp alias {} ::${class} {} ${class}::create
-	proc ::${class}::use {} {}
-
-	bind $class <Destroy> [list Widget::destroy %W]
-    }
-
-    foreach class $args { ${class}::use }
-}
-
-
-proc Widget::create { class path {rename 1} } {
-    if {$rename} { rename $path ::$path:cmd }
-    proc ::$path { cmd args } \
-    	[subst {return \[eval \[linsert \$args 0 ${class}::\$cmd [list $path]\]\]}]
-    return $path
-}
-
-
-# ----------------------------------------------------------------------------
-#  Command Widget::addmap
-# ----------------------------------------------------------------------------
-proc Widget::addmap { class subclass subpath options } {
-    upvar 0 ${class}::opt classopt
-    upvar 0 ${class}::optionExports exports
-    upvar 0 ${class}::optionClass optionClass
-    upvar 0 ${class}::map classmap
-    upvar 0 ${class}::map$subpath submap
-
-    foreach {option realopt} $options {
-        if { ![string length $realopt] } {
-            set realopt $option
-        }
-	set val [lindex $classopt($option) 1]
-	set optDb ".[lindex [_configure_option $realopt ""] 0]"
-	if { ![string equal $subpath ":cmd"] } {
-	    set optDb "$subpath$optDb"
-	}
-	option add *${class}${optDb} $val widgetDefault
-	lappend exports($option) $optDb
-	# Store the forward and backward mappings for this
-	# option <-> realoption pair
-        lappend classmap($option) $subpath $subclass $realopt
-	set submap($realopt) $option
-    }
-}
-
-
-# ----------------------------------------------------------------------------
-#  Command Widget::syncoptions
-# ----------------------------------------------------------------------------
-proc Widget::syncoptions { class subclass subpath options } {
-    upvar 0 ${class}::sync classync
-
-    foreach {option realopt} $options {
-        if { ![string length $realopt] } {
-            set realopt $option
-        }
-        set classync($option) [list $subpath $subclass $realopt]
-    }
-}
-
-
-# ----------------------------------------------------------------------------
-#  Command Widget::init
-# ----------------------------------------------------------------------------
-proc Widget::init { class path options } {
-    variable _inuse
-    variable _class
-    variable _optiontype
-
-    upvar 0 ${class}::opt classopt
-    upvar 0 ${class}::$path:opt  pathopt
-    upvar 0 ${class}::$path:mod  pathmod
-    upvar 0 ${class}::map classmap
-    upvar 0 ${class}::$path:init pathinit
-
-    if { [info exists pathopt] } {
-	unset pathopt
-    }
-    if { [info exists pathmod] } {
-	unset pathmod
-    }
-    # We prefer to use the actual widget for option db queries, but if it
-    # doesn't exist yet, do the next best thing:  create a widget of the
-    # same class and use that.
-    set fpath $path
-    set rdbclass [string map [list :: ""] $class]
-    if { ![winfo exists $path] } {
-	set fpath ".#BWidget.#Class#$class"
-	# encapsulation frame to not pollute '.' childspace
-	if {![winfo exists ".#BWidget"]} { frame ".#BWidget" }
-	if { ![winfo exists $fpath] } {
-	    frame $fpath -class $rdbclass
-	}
-    }
-    foreach {option optdesc} [array get classopt] {
-        set pathmod($option) 0
-	if { [info exists classmap($option)] } {
-	    continue
-	}
-        set type [lindex $optdesc 0]
-        if { [string equal $type "Synonym"] } {
-	    continue
-        }
-        if { [string equal $type "TkResource"] } {
-            set alt [lindex [lindex $optdesc 3] 1]
-        } else {
-            set alt ""
-        }
-        set optdb [lindex [_configure_option $option $alt] 0]
-        set def   [option get $fpath $optdb $rdbclass]
-        if { [string length $def] } {
-            set pathopt($option) $def
-        } else {
-            set pathopt($option) [lindex $optdesc 1]
-        }
-    }
-
-    if {![info exists _inuse($class)]} { set _inuse($class) 0 }
-    incr _inuse($class)
-
-    set _class($path) $class
-    foreach {option value} $options {
-        if { ![info exists classopt($option)] } {
-            unset pathopt
-            unset pathmod
-            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]
-        }
-        # this may fail if a wrong enum element was used
-        if {[catch {
-             $_optiontype($type) $option $value [lindex $optdesc 3]
-        } msg]} {
-            if {[info exists pathopt]} {
-                unset pathopt
-            }
-            unset pathmod
-            return -code error $msg
-        }
-        set pathopt($option) $msg
-	set pathinit($option) $pathopt($option)
-    }
-}
-
-# Bastien Chevreux ([email protected])
-#
-# copyinit performs basically the same job as init, but it uses a
-#  existing template to initialize its values. So, first a perferct copy
-#  from the template is made just to be altered by any existing options
-#  afterwards.
-# But this still saves time as the first initialization parsing block is
-#  skipped.
-# As additional bonus, items that differ in just a few options can be
-#  initialized faster by leaving out the options that are equal.
-
-# This function is currently used only by ListBox::multipleinsert, but other
-#  calls should follow :)
-
-# ----------------------------------------------------------------------------
-#  Command Widget::copyinit
-# ----------------------------------------------------------------------------
-proc Widget::copyinit { class templatepath path options } {
-    variable _class
-    variable _optiontype
-    upvar 0 ${class}::opt classopt \
-	    ${class}::$path:opt	 pathopt \
-	    ${class}::$path:mod	 pathmod \
-	    ${class}::$path:init pathinit \
-	    ${class}::$templatepath:opt	  templatepathopt \
-	    ${class}::$templatepath:mod	  templatepathmod \
-	    ${class}::$templatepath:init  templatepathinit
-
-    if { [info exists pathopt] } {
-	unset pathopt
-    }
-    if { [info exists pathmod] } {
-	unset pathmod
-    }
-
-    # We use the template widget for option db copying, but it has to exist!
-    array set pathmod  [array get templatepathmod]
-    array set pathopt  [array get templatepathopt]
-    array set pathinit [array get templatepathinit]
-
-    set _class($path) $class
-    foreach {option value} $options {
-	if { ![info exists classopt($option)] } {
-	    unset pathopt
-	    unset pathmod
-	    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]
-	}
-	set pathopt($option) [$_optiontype($type) $option $value [lindex $optdesc 3]]
-	set pathinit($option) $pathopt($option)
-    }
-}
-
-# Widget::parseArgs --
-#
-#	Given a widget class and a command-line spec, cannonize and validate
-#	the given options, and return a keyed list consisting of the 
-#	component widget and its masked portion of the command-line spec, and
-#	one extra entry consisting of the portion corresponding to the 
-#	megawidget itself.
-#
-# Arguments:
-#	class	widget class to parse for.
-#	options	command-line spec
-#
-# Results:
-#	result	keyed list of portions of the megawidget and that segment of
-#		the command line in which that portion is interested.
-
-proc Widget::parseArgs {class options} {
-    variable _optiontype
-    upvar 0 ${class}::opt classopt
-    upvar 0 ${class}::map classmap
-    
-    foreach {option val} $options {
-	if { ![info exists classopt($option)] } {
-	    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"] } {
-	    # Make sure that the widget used for this TkResource exists
-	    Widget::_get_tkwidget_options [lindex [lindex $optdesc 3] 0]
-	}
-	set val [$_optiontype($type) $option $val [lindex $optdesc 3]]
-		
-	if { [info exists classmap($option)] } {
-	    foreach {subpath subclass realopt} $classmap($option) {
-		lappend maps($subpath) $realopt $val
-	    }
-	} else {
-	    lappend maps($class) $option $val
-	}
-    }
-    return [array get maps]
-}
-
-# Widget::initFromODB --
-#
-#	Initialize a megawidgets options with information from the option
-#	database and from the command-line arguments given.
-#
-# Arguments:
-#	class	class of the widget.
-#	path	path of the widget -- should already exist.
-#	options	command-line arguments.
-#
-# Results:
-#	None.
-
-proc Widget::initFromODB {class path options} {
-    variable _inuse
-    variable _class
-
-    upvar 0 ${class}::$path:opt  pathopt
-    upvar 0 ${class}::$path:mod  pathmod
-    upvar 0 ${class}::map classmap
-
-    if { [info exists pathopt] } {
-	unset pathopt
-    }
-    if { [info exists pathmod] } {
-	unset pathmod
-    }
-    # We prefer to use the actual widget for option db queries, but if it
-    # doesn't exist yet, do the next best thing:  create a widget of the
-    # same class and use that.
-    set fpath [_get_window $class $path]
-    set rdbclass [string map [list :: ""] $class]
-    if { ![winfo exists $path] } {
-	set fpath ".#BWidget.#Class#$class"
-	# encapsulation frame to not pollute '.' childspace
-	if {![winfo exists ".#BWidget"]} { frame ".#BWidget" }
-	if { ![winfo exists $fpath] } {
-	    frame $fpath -class $rdbclass
-	}
-    }
-
-    foreach {option optdesc} [array get ${class}::opt] {
-        set pathmod($option) 0
-	if { [info exists classmap($option)] } {
-	    continue
-	}
-        set type [lindex $optdesc 0]
-        if { [string equal $type "Synonym"] } {
-	    continue
-        }
-	if { [string equal $type "TkResource"] } {
-            set alt [lindex [lindex $optdesc 3] 1]
-        } else {
-            set alt ""
-        }
-        set optdb [lindex [_configure_option $option $alt] 0]
-        set def   [option get $fpath $optdb $rdbclass]
-        if { [string length $def] } {
-            set pathopt($option) $def
-        } else {
-            set pathopt($option) [lindex $optdesc 1]
-        }
-    }
-
-    if {![info exists _inuse($class)]} { set _inuse($class) 0 }
-    incr _inuse($class)
-
-    set _class($path) $class
-    array set pathopt $options
-}
-
-
-
-# ----------------------------------------------------------------------------
-#  Command Widget::destroy
-# ----------------------------------------------------------------------------
-proc Widget::destroy { path } {
-    variable _class
-    variable _inuse
-
-    if {![info exists _class($path)]} { return }
-
-    set class $_class($path)
-    upvar 0 ${class}::$path:opt pathopt
-    upvar 0 ${class}::$path:mod pathmod
-    upvar 0 ${class}::$path:init pathinit
-
-    if {[info exists _inuse($class)]} { incr _inuse($class) -1 }
-
-    if {[info exists pathopt]} {
-        unset pathopt
-    }
-    if {[info exists pathmod]} {
-        unset pathmod
-    }
-    if {[info exists pathinit]} {
-        unset pathinit
-    }
-
-    if {![string equal [info commands $path] ""]} { rename $path "" }
-
-    ## Unset any variables used in this widget.
-    foreach var [info vars ::${class}::$path:*] { unset $var }
-
-    unset _class($path)
-}
-
-
-# ----------------------------------------------------------------------------
-#  Command Widget::configure
-# ----------------------------------------------------------------------------
-proc Widget::configure { path options } {
-    set len [llength $options]
-    if { $len <= 1 } {
-        return [_get_configure $path $options]
-    } elseif { $len % 2 == 1 } {
-        return -code error "incorrect number of arguments"
-    }
-
-    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) {
-                    # Interpretation of special pointers:
-                    # | subclass | subpath | widget           | path           | class   |
-                    # +----------+---------+------------------+----------------+-context-+
-                    # | :cmd     | :cmd    | herited widget   | window:cmd     |window   |
-                    # | :cmd     | *       | subwidget        | window.subpath | window  |
-                    # | ""       | :cmd    | herited widget   | window:cmd     | window  |
-                    # | ""       | *       | own              | window         | window  |
-                    # | *        | :cmd    | own              | window         | current |
-                    # | *        | *       | subwidget        | window.subpath | current |
-                    if { [string length $subclass] && ! [string equal $subclass ":cmd"] } {
-                        if { [string equal $subpath ":cmd"] } {
-                            set subpath ""
-                        }
-                        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 } {
-    variable _class
-    if { ![info exists _class($path)] } {
-        return -code error "unknown widget $path"
-    }
-
-    set class $_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 } {
-    variable _class
-    set class $_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 } {
-    variable _class
-    upvar $pvalue value
-    set class $_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 } {
-    variable _class
-    set class $_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} {
-    variable _class
-    set class $_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} {
-    variable _class
-    set class $_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::_make_tk_widget_name
-# ----------------------------------------------------------------------------
-# Before, the widget meta name was build as: ".#BWidget.#$tkwidget"
-# This does not work for ttk widgets, as they have an "::" in their name.
-# Thus replace any "::" by "__" will do the job.
-proc Widget::_make_tk_widget_name { tkwidget } {
-    set pos 0
-    for {set pos 0} {0 <= [set pos [string first "::" $tkwidget $pos]]} {incr pos} {
-	set tkwidget [string range $tkwidget 0 [expr {$pos-1}]]__[string range $tkwidget [expr {$pos+2}] end]
-    }
-    return ".#BWidget.#$tkwidget"
-}
-
-# ----------------------------------------------------------------------------
-#  Command Widget::_get_tkwidget_options
-# ----------------------------------------------------------------------------
-proc Widget::_get_tkwidget_options { tkwidget } {
-    variable _tk_widget
-    variable _optiondb
-    variable _optionclass
-
-    set widget [_make_tk_widget_name $tkwidget]
-    # encapsulation frame to not pollute '.' childspace
-    if {![winfo exists ".#BWidget"]} { frame ".#BWidget" }
-    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     [_make_tk_widget_name $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 \
-		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 {[string equal [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 {[string equal [winfo toplevel $cur] $cur]} {
-		break
-	    }
-	    set parent [winfo parent $parent]
-	    set children [winfo children $parent]
-	    set i [lsearch -exact $children $cur]
-	}
-	if {[string equal $cur $w] || [focusOK $cur]} {
-	    return $cur
-	}
-    }
-}
-
-
-# -----------------------------------------------------------------------------
-#  Command Widget::focusPrev
-#  Same as tk_focusPrev, except:
-#	+ Don't traverse from a child to a direct ancestor
-#	+ Call Widget::focusOK instead of tk::focusOK
-# -----------------------------------------------------------------------------
-proc Widget::focusPrev { w } {
-    set cur $w
-    set origParent [winfo parent $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 {[string equal [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 {[string equal [winfo toplevel $cur] $cur]} {
-		continue
-	    }
-	    set parent $cur
-	    set children [winfo children $parent]
-	    set i [llength $children]
-	}
-	set cur $parent
-	if {[string equal $cur $w]} {
-	    return $cur
-	}
-	# If we are just at the original parent of $w, skip it as a
-	# potential focus accepter.  Extra safety in this is to see if
-	# that parent is also a proc (not a C command), which is what
-	# BWidgets makes for any megawidget.  Could possibly also check
-	# for '[info commands ::${origParent}:cmd] != ""'.  [Bug 765667]
-	if {[string equal $cur $origParent]
-	    && [info procs ::$origParent] != ""} {
-	    continue
-	}
-	if {[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 [list $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)]
-}
-
-proc Widget::theme {{bool {}}} {
-    # Private, *experimental* API that may change at any time - JH
-    variable _theme
-    if {[llength [info level 0]] == 2} {
-	# set theme-ability
-	if {[catch {package require Tk 8.5a6}]
-	    && [catch {package require tile 0.6}]
-	    && [catch {package require tile 1}]} {
-	    return -code error "BWidget's theming requires tile 0.6+"
-	} else {
-	    catch {style default BWSlim.Toolbutton -padding 0}
-	}
-	set _theme [string is true -strict $bool]
-    }
-    return $_theme
-}
+# ----------------------------------------------------------------------------
+#  widget.tcl
+#  This file is part of Unifix BWidget Toolkit
+#  $Id: widget.tcl,v 1.35.2.1 2011/11/14 14:33:29 oehhar Exp $
+# ----------------------------------------------------------------------------
+#  Index of commands:
+#     - Widget::tkinclude
+#     - Widget::bwinclude
+#     - Widget::declare
+#     - Widget::addmap
+#     - Widget::init
+#     - Widget::destroy
+#     - Widget::setoption
+#     - Widget::configure
+#     - Widget::cget
+#     - Widget::subcget
+#     - Widget::hasChanged
+#     - Widget::options
+#     - Widget::_get_tkwidget_options
+#     - Widget::_test_tkresource
+#     - Widget::_test_bwresource
+#     - Widget::_test_synonym
+#     - Widget::_test_string
+#     - Widget::_test_flag
+#     - Widget::_test_enum
+#     - Widget::_test_int
+#     - Widget::_test_boolean
+# ----------------------------------------------------------------------------
+# Each megawidget gets a namespace of the same name inside the Widget namespace
+# Each of these has an array opt, which contains information about the 
+# megawidget options.  It maps megawidget options to a list with this format:
+#     {optionType defaultValue isReadonly {additionalOptionalInfo}}
+# Option types and their additional optional info are:
+#	TkResource	{genericTkWidget genericTkWidgetOptionName}
+#	BwResource	{nothing}
+#	Enum		{list of enumeration values}
+#	Int		{Boundary information}
+#	Boolean		{nothing}
+#	String		{nothing}
+#	Flag		{string of valid flag characters}
+#	Synonym		{nothing}
+#	Color		{nothing}
+#
+# Next, each namespace has an array map, which maps class options to their
+# component widget options:
+#	map(-foreground) => {.e -foreground .f -foreground}
+#
+# Each has an array ${path}:opt, which contains the value of each megawidget
+# option for a particular instance $path of the megawidget, and an array
+# ${path}:mod, which stores the "changed" status of configuration options.
+
+# Steps for creating a bwidget megawidget:
+# 1. parse args to extract subwidget spec
+# 2. Create frame with appropriate class and command line options
+# 3. Get initialization options from optionDB, using frame
+# 4. create subwidgets
+
+# Uses newer string operations
+package require Tcl 8.1.1
+
+namespace eval Widget {
+    variable _optiontype
+    variable _class
+    variable _tk_widget
+
+    # This controls whether we try to use themed widgets from Tile
+    variable _theme 0
+
+    variable _aqua [expr {($::tcl_version >= 8.4) &&
+			  [string equal [tk windowingsystem] "aqua"]}]
+
+    array set _optiontype {
+        TkResource Widget::_test_tkresource
+        BwResource Widget::_test_bwresource
+        Enum       Widget::_test_enum
+        Int        Widget::_test_int
+        Boolean    Widget::_test_boolean
+        String     Widget::_test_string
+        Flag       Widget::_test_flag
+        Synonym    Widget::_test_synonym
+        Color      Widget::_test_color
+        Padding    Widget::_test_padding
+    }
+
+    proc use {} {}
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Widget::tkinclude
+#     Includes tk widget resources to BWidget widget.
+#  class      class name of the BWidget
+#  tkwidget   tk widget to include
+#  subpath    subpath to configure
+#  args       additionnal args for included options
+# ----------------------------------------------------------------------------
+proc Widget::tkinclude { class tkwidget subpath args } {
+    foreach {cmd lopt} $args {
+        # cmd can be
+        #   include      options to include            lopt = {opt ...}
+        #   remove       options to remove             lopt = {opt ...}
+        #   rename       options to rename             lopt = {opt newopt ...}
+        #   prefix       options to prefix             lopt = {pref opt opt ..}
+        #   initialize   set default value for options lopt = {opt value ...}
+        #   readonly     set readonly flag for options lopt = {opt flag ...}
+        switch -- $cmd {
+            remove {
+                foreach option $lopt {
+                    set remove($option) 1
+                }
+            }
+            include {
+                foreach option $lopt {
+                    set include($option) 1
+                }
+            }
+            prefix {
+                set prefix [lindex $lopt 0]
+                foreach option [lrange $lopt 1 end] {
+                    set rename($option) "-$prefix[string range $option 1 end]"
+                }
+            }
+            rename     -
+            readonly   -
+            initialize {
+                array set $cmd $lopt
+            }
+            default {
+                return -code error "invalid argument \"$cmd\""
+            }
+        }
+    }
+
+    namespace eval $class {}
+    upvar 0 ${class}::opt classopt
+    upvar 0 ${class}::map classmap
+    upvar 0 ${class}::map$subpath submap
+    upvar 0 ${class}::optionExports exports
+
+    # create resources informations from tk widget resources
+    foreach optdesc [_get_tkwidget_options $tkwidget] {
+        set option [lindex $optdesc 0]
+        if { (![info exists include] || [info exists include($option)]) &&
+             ![info exists remove($option)] } {
+            if { [llength $optdesc] == 3 } {
+                # option is a synonym
+                set syn [lindex $optdesc 1]
+                if { ![info exists remove($syn)] } {
+                    # original option is not removed
+                    if { [info exists rename($syn)] } {
+                        set classopt($option) [list Synonym $rename($syn)]
+                    } else {
+                        set classopt($option) [list Synonym $syn]
+                    }
+                }
+            } else {
+                if { [info exists rename($option)] } {
+                    set realopt $option
+                    set option  $rename($option)
+                } else {
+                    set realopt $option
+                }
+                if { [info exists initialize($option)] } {
+                    set value $initialize($option)
+                } else {
+                    set value [lindex $optdesc 1]
+                }
+                if { [info exists readonly($option)] } {
+                    set ro $readonly($option)
+                } else {
+                    set ro 0
+                }
+                set classopt($option) \
+			[list TkResource $value $ro [list $tkwidget $realopt]]
+
+		# Add an option database entry for this option
+		set optionDbName ".[lindex [_configure_option $realopt ""] 0]"
+		if { ![string equal $subpath ":cmd"] } {
+		    set optionDbName "$subpath$optionDbName"
+		}
+		option add *${class}$optionDbName $value widgetDefault
+		lappend exports($option) "$optionDbName"
+
+		# Store the forward and backward mappings for this
+		# option <-> realoption pair
+                lappend classmap($option) $subpath "" $realopt
+		set submap($realopt) $option
+            }
+        }
+    }
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Widget::bwinclude
+#     Includes BWidget resources to BWidget widget.
+#  class    class name of the BWidget
+#  subclass BWidget class to include
+#  subpath  subpath to configure
+#  args     additionnal args for included options
+# ----------------------------------------------------------------------------
+proc Widget::bwinclude { class subclass subpath args } {
+    foreach {cmd lopt} $args {
+        # cmd can be
+        #   include      options to include            lopt = {opt ...}
+        #   remove       options to remove             lopt = {opt ...}
+        #   rename       options to rename             lopt = {opt newopt ...}
+        #   prefix       options to prefix             lopt = {prefix opt opt ...}
+        #   initialize   set default value for options lopt = {opt value ...}
+        #   readonly     set readonly flag for options lopt = {opt flag ...}
+        switch -- $cmd {
+            remove {
+                foreach option $lopt {
+                    set remove($option) 1
+                }
+            }
+            include {
+                foreach option $lopt {
+                    set include($option) 1
+                }
+            }
+            prefix {
+                set prefix [lindex $lopt 0]
+                foreach option [lrange $lopt 1 end] {
+                    set rename($option) "-$prefix[string range $option 1 end]"
+                }
+            }
+            rename     -
+            readonly   -
+            initialize {
+                array set $cmd $lopt
+            }
+            default {
+                return -code error "invalid argument \"$cmd\""
+            }
+        }
+    }
+
+    namespace eval $class {}
+    upvar 0 ${class}::opt classopt
+    upvar 0 ${class}::map classmap
+    upvar 0 ${class}::map$subpath submap
+    upvar 0 ${class}::optionExports exports
+    upvar 0 ${subclass}::opt subclassopt
+    upvar 0 ${subclass}::optionExports subexports
+
+    # create resources informations from BWidget resources
+    foreach {option optdesc} [array get subclassopt] {
+	set subOption $option
+        if { (![info exists include] || [info exists include($option)]) &&
+             ![info exists remove($option)] } {
+            set type [lindex $optdesc 0]
+            if { [string equal $type "Synonym"] } {
+                # option is a synonym
+                set syn [lindex $optdesc 1]
+                if { ![info exists remove($syn)] } {
+                    if { [info exists rename($syn)] } {
+                        set classopt($option) [list Synonym $rename($syn)]
+                    } else {
+                        set classopt($option) [list Synonym $syn]
+                    }
+                }
+            } else {
+                if { [info exists rename($option)] } {
+                    set realopt $option
+                    set option  $rename($option)
+                } else {
+                    set realopt $option
+                }
+                if { [info exists initialize($option)] } {
+                    set value $initialize($option)
+                } else {
+                    set value [lindex $optdesc 1]
+                }
+                if { [info exists readonly($option)] } {
+                    set ro $readonly($option)
+                } else {
+                    set ro [lindex $optdesc 2]
+                }
+                set classopt($option) \
+			[list $type $value $ro [lindex $optdesc 3]]
+
+		# Add an option database entry for this option
+		foreach optionDbName $subexports($subOption) {
+		    if { ![string equal $subpath ":cmd"] } {
+			set optionDbName "$subpath$optionDbName"
+		    }
+		    # Only add the option db entry if we are overriding the
+		    # normal widget default
+		    if { [info exists initialize($option)] } {
+			option add *${class}$optionDbName $value \
+				widgetDefault
+		    }
+		    lappend exports($option) "$optionDbName"
+		}
+
+		# Store the forward and backward mappings for this
+		# option <-> realoption pair
+                lappend classmap($option) $subpath $subclass $realopt
+		set submap($realopt) $option
+            }
+        }
+    }
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Widget::declare
+#    Declares new options to BWidget class.
+# ----------------------------------------------------------------------------
+proc Widget::declare { class optlist } {
+    variable _optiontype
+
+    namespace eval $class {}
+    upvar 0 ${class}::opt classopt
+    upvar 0 ${class}::optionExports exports
+    upvar 0 ${class}::optionClass optionClass
+
+    foreach optdesc $optlist {
+        set option  [lindex $optdesc 0]
+        set optdesc [lrange $optdesc 1 end]
+        set type    [lindex $optdesc 0]
+
+        if { ![info exists _optiontype($type)] } {
+            # invalid resource type
+            return -code error "invalid option type \"$type\""
+        }
+
+        if { [string equal $type "Synonym"] } {
+            # test existence of synonym option
+            set syn [lindex $optdesc 1]
+            if { ![info exists classopt($syn)] } {
+                return -code error "unknow option \"$syn\" for Synonym \"$option\""
+            }
+            set classopt($option) [list Synonym $syn]
+            continue
+        }
+
+        # all other resource may have default value, readonly flag and
+        # optional arg depending on type
+        set value [lindex $optdesc 1]
+        set ro    [lindex $optdesc 2]
+        set arg   [lindex $optdesc 3]
+
+        if { [string equal $type "BwResource"] } {
+            # We don't keep BwResource. We simplify to type of sub BWidget
+            set subclass    [lindex $arg 0]
+            set realopt     [lindex $arg 1]
+            if { ![string length $realopt] } {
+                set realopt $option
+            }
+
+            upvar 0 ${subclass}::opt subclassopt
+            if { ![info exists subclassopt($realopt)] } {
+                return -code error "unknow option \"$realopt\""
+            }
+            set suboptdesc $subclassopt($realopt)
+            if { $value == "" } {
+                # We initialize default value
+                set value [lindex $suboptdesc 1]
+            }
+            set type [lindex $suboptdesc 0]
+            set ro   [lindex $suboptdesc 2]
+            set arg  [lindex $suboptdesc 3]
+	    set optionDbName ".[lindex [_configure_option $option ""] 0]"
+	    option add *${class}${optionDbName} $value widgetDefault
+	    set exports($option) $optionDbName
+            set classopt($option) [list $type $value $ro $arg]
+            continue
+        }
+
+        # retreive default value for TkResource
+        if { [string equal $type "TkResource"] } {
+            set tkwidget [lindex $arg 0]
+	    set foo [$tkwidget ".ericFoo##"]
+            set realopt  [lindex $arg 1]
+            if { ![string length $realopt] } {
+                set realopt $option
+            }
+            set tkoptions [_get_tkwidget_options $tkwidget]
+            if { ![string length $value] } {
+                # We initialize default value
+		set ind [lsearch $tkoptions [list $realopt *]]
+                set value [lindex [lindex $tkoptions $ind] end]
+            }
+	    set optionDbName ".[lindex [_configure_option $option ""] 0]"
+	    option add *${class}${optionDbName} $value widgetDefault
+	    set exports($option) $optionDbName
+            set classopt($option) [list TkResource $value $ro \
+		    [list $tkwidget $realopt]]
+	    set optionClass($option) [lindex [$foo configure $realopt] 1]
+	    ::destroy $foo
+            continue
+        }
+
+	set optionDbName ".[lindex [_configure_option $option ""] 0]"
+	option add *${class}${optionDbName} $value widgetDefault
+	set exports($option) $optionDbName
+        # for any other resource type, we keep original optdesc
+        set classopt($option) [list $type $value $ro $arg]
+    }
+}
+
+
+proc Widget::define { class filename args } {
+    variable ::BWidget::use
+    set use($class)      $args
+    set use($class,file) $filename
+    lappend use(classes) $class
+
+    if {[set x [lsearch -exact $args "-classonly"]] > -1} {
+	set args [lreplace $args $x $x]
+    } else {
+	interp alias {} ::${class} {} ${class}::create
+	proc ::${class}::use {} {}
+
+	bind $class <Destroy> [list Widget::destroy %W]
+    }
+
+    foreach class $args { ${class}::use }
+}
+
+
+proc Widget::create { class path {rename 1} } {
+    if {$rename} { rename $path ::$path:cmd }
+    proc ::$path { cmd args } \
+    	[subst {return \[eval \[linsert \$args 0 ${class}::\$cmd [list $path]\]\]}]
+    return $path
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Widget::addmap
+# ----------------------------------------------------------------------------
+proc Widget::addmap { class subclass subpath options } {
+    upvar 0 ${class}::opt classopt
+    upvar 0 ${class}::optionExports exports
+    upvar 0 ${class}::optionClass optionClass
+    upvar 0 ${class}::map classmap
+    upvar 0 ${class}::map$subpath submap
+
+    foreach {option realopt} $options {
+        if { ![string length $realopt] } {
+            set realopt $option
+        }
+	set val [lindex $classopt($option) 1]
+	set optDb ".[lindex [_configure_option $realopt ""] 0]"
+	if { ![string equal $subpath ":cmd"] } {
+	    set optDb "$subpath$optDb"
+	}
+	option add *${class}${optDb} $val widgetDefault
+	lappend exports($option) $optDb
+	# Store the forward and backward mappings for this
+	# option <-> realoption pair
+        lappend classmap($option) $subpath $subclass $realopt
+	set submap($realopt) $option
+    }
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Widget::syncoptions
+# ----------------------------------------------------------------------------
+proc Widget::syncoptions { class subclass subpath options } {
+    upvar 0 ${class}::sync classync
+
+    foreach {option realopt} $options {
+        if { ![string length $realopt] } {
+            set realopt $option
+        }
+        set classync($option) [list $subpath $subclass $realopt]
+    }
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Widget::init
+# ----------------------------------------------------------------------------
+proc Widget::init { class path options } {
+    variable _inuse
+    variable _class
+    variable _optiontype
+
+    upvar 0 ${class}::opt classopt
+    upvar 0 ${class}::$path:opt  pathopt
+    upvar 0 ${class}::$path:mod  pathmod
+    upvar 0 ${class}::map classmap
+    upvar 0 ${class}::$path:init pathinit
+
+    if { [info exists pathopt] } {
+	unset pathopt
+    }
+    if { [info exists pathmod] } {
+	unset pathmod
+    }
+    # We prefer to use the actual widget for option db queries, but if it
+    # doesn't exist yet, do the next best thing:  create a widget of the
+    # same class and use that.
+    set fpath $path
+    set rdbclass [string map [list :: ""] $class]
+    if { ![winfo exists $path] } {
+	set fpath ".#BWidget.#Class#$class"
+	# encapsulation frame to not pollute '.' childspace
+	if {![winfo exists ".#BWidget"]} { frame ".#BWidget" }
+	if { ![winfo exists $fpath] } {
+	    frame $fpath -class $rdbclass
+	}
+    }
+    foreach {option optdesc} [array get classopt] {
+        set pathmod($option) 0
+	if { [info exists classmap($option)] } {
+	    continue
+	}
+        set type [lindex $optdesc 0]
+        if { [string equal $type "Synonym"] } {
+	    continue
+        }
+        if { [string equal $type "TkResource"] } {
+            set alt [lindex [lindex $optdesc 3] 1]
+        } else {
+            set alt ""
+        }
+        set optdb [lindex [_configure_option $option $alt] 0]
+        set def   [option get $fpath $optdb $rdbclass]
+        if { [string length $def] } {
+            set pathopt($option) $def
+        } else {
+            set pathopt($option) [lindex $optdesc 1]
+        }
+    }
+
+    if {![info exists _inuse($class)]} { set _inuse($class) 0 }
+    incr _inuse($class)
+
+    set _class($path) $class
+    foreach {option value} $options {
+        if { ![info exists classopt($option)] } {
+            unset pathopt
+            unset pathmod
+            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]
+        }
+        # this may fail if a wrong enum element was used
+        if {[catch {
+             $_optiontype($type) $option $value [lindex $optdesc 3]
+        } msg]} {
+            if {[info exists pathopt]} {
+                unset pathopt
+            }
+            unset pathmod
+            return -code error $msg
+        }
+        set pathopt($option) $msg
+	set pathinit($option) $pathopt($option)
+    }
+}
+
+# Bastien Chevreux ([email protected])
+#
+# copyinit performs basically the same job as init, but it uses a
+#  existing template to initialize its values. So, first a perferct copy
+#  from the template is made just to be altered by any existing options
+#  afterwards.
+# But this still saves time as the first initialization parsing block is
+#  skipped.
+# As additional bonus, items that differ in just a few options can be
+#  initialized faster by leaving out the options that are equal.
+
+# This function is currently used only by ListBox::multipleinsert, but other
+#  calls should follow :)
+
+# ----------------------------------------------------------------------------
+#  Command Widget::copyinit
+# ----------------------------------------------------------------------------
+proc Widget::copyinit { class templatepath path options } {
+    variable _class
+    variable _optiontype
+    upvar 0 ${class}::opt classopt \
+	    ${class}::$path:opt	 pathopt \
+	    ${class}::$path:mod	 pathmod \
+	    ${class}::$path:init pathinit \
+	    ${class}::$templatepath:opt	  templatepathopt \
+	    ${class}::$templatepath:mod	  templatepathmod \
+	    ${class}::$templatepath:init  templatepathinit
+
+    if { [info exists pathopt] } {
+	unset pathopt
+    }
+    if { [info exists pathmod] } {
+	unset pathmod
+    }
+
+    # We use the template widget for option db copying, but it has to exist!
+    array set pathmod  [array get templatepathmod]
+    array set pathopt  [array get templatepathopt]
+    array set pathinit [array get templatepathinit]
+
+    set _class($path) $class
+    foreach {option value} $options {
+	if { ![info exists classopt($option)] } {
+	    unset pathopt
+	    unset pathmod
+	    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]
+	}
+	set pathopt($option) [$_optiontype($type) $option $value [lindex $optdesc 3]]
+	set pathinit($option) $pathopt($option)
+    }
+}
+
+# Widget::parseArgs --
+#
+#	Given a widget class and a command-line spec, cannonize and validate
+#	the given options, and return a keyed list consisting of the 
+#	component widget and its masked portion of the command-line spec, and
+#	one extra entry consisting of the portion corresponding to the 
+#	megawidget itself.
+#
+# Arguments:
+#	class	widget class to parse for.
+#	options	command-line spec
+#
+# Results:
+#	result	keyed list of portions of the megawidget and that segment of
+#		the command line in which that portion is interested.
+
+proc Widget::parseArgs {class options} {
+    variable _optiontype
+    upvar 0 ${class}::opt classopt
+    upvar 0 ${class}::map classmap
+    
+    foreach {option val} $options {
+	if { ![info exists classopt($option)] } {
+	    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"] } {
+	    # Make sure that the widget used for this TkResource exists
+	    Widget::_get_tkwidget_options [lindex [lindex $optdesc 3] 0]
+	}
+	set val [$_optiontype($type) $option $val [lindex $optdesc 3]]
+		
+	if { [info exists classmap($option)] } {
+	    foreach {subpath subclass realopt} $classmap($option) {
+		lappend maps($subpath) $realopt $val
+	    }
+	} else {
+	    lappend maps($class) $option $val
+	}
+    }
+    return [array get maps]
+}
+
+# Widget::initFromODB --
+#
+#	Initialize a megawidgets options with information from the option
+#	database and from the command-line arguments given.
+#
+# Arguments:
+#	class	class of the widget.
+#	path	path of the widget -- should already exist.
+#	options	command-line arguments.
+#
+# Results:
+#	None.
+
+proc Widget::initFromODB {class path options} {
+    variable _inuse
+    variable _class
+
+    upvar 0 ${class}::$path:opt  pathopt
+    upvar 0 ${class}::$path:mod  pathmod
+    upvar 0 ${class}::map classmap
+
+    if { [info exists pathopt] } {
+	unset pathopt
+    }
+    if { [info exists pathmod] } {
+	unset pathmod
+    }
+    # We prefer to use the actual widget for option db queries, but if it
+    # doesn't exist yet, do the next best thing:  create a widget of the
+    # same class and use that.
+    set fpath [_get_window $class $path]
+    set rdbclass [string map [list :: ""] $class]
+    if { ![winfo exists $path] } {
+	set fpath ".#BWidget.#Class#$class"
+	# encapsulation frame to not pollute '.' childspace
+	if {![winfo exists ".#BWidget"]} { frame ".#BWidget" }
+	if { ![winfo exists $fpath] } {
+	    frame $fpath -class $rdbclass
+	}
+    }
+
+    foreach {option optdesc} [array get ${class}::opt] {
+        set pathmod($option) 0
+	if { [info exists classmap($option)] } {
+	    continue
+	}
+        set type [lindex $optdesc 0]
+        if { [string equal $type "Synonym"] } {
+	    continue
+        }
+	if { [string equal $type "TkResource"] } {
+            set alt [lindex [lindex $optdesc 3] 1]
+        } else {
+            set alt ""
+        }
+        set optdb [lindex [_configure_option $option $alt] 0]
+        set def   [option get $fpath $optdb $rdbclass]
+        if { [string length $def] } {
+            set pathopt($option) $def
+        } else {
+            set pathopt($option) [lindex $optdesc 1]
+        }
+    }
+
+    if {![info exists _inuse($class)]} { set _inuse($class) 0 }
+    incr _inuse($class)
+
+    set _class($path) $class
+    array set pathopt $options
+}
+
+
+
+# ----------------------------------------------------------------------------
+#  Command Widget::destroy
+# ----------------------------------------------------------------------------
+proc Widget::destroy { path } {
+    variable _class
+    variable _inuse
+
+    if {![info exists _class($path)]} { return }
+
+    set class $_class($path)
+    upvar 0 ${class}::$path:opt pathopt
+    upvar 0 ${class}::$path:mod pathmod
+    upvar 0 ${class}::$path:init pathinit
+
+    if {[info exists _inuse($class)]} { incr _inuse($class) -1 }
+
+    if {[info exists pathopt]} {
+        unset pathopt
+    }
+    if {[info exists pathmod]} {
+        unset pathmod
+    }
+    if {[info exists pathinit]} {
+        unset pathinit
+    }
+
+    if {![string equal [info commands $path] ""]} { rename $path "" }
+
+    ## Unset any variables used in this widget.
+    foreach var [info vars ::${class}::$path:*] { unset $var }
+
+    unset _class($path)
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command Widget::configure
+# ----------------------------------------------------------------------------
+proc Widget::configure { path options } {
+    set len [llength $options]
+    if { $len <= 1 } {
+        return [_get_configure $path $options]
+    } elseif { $len % 2 == 1 } {
+        return -code error "incorrect number of arguments"
+    }
+
+    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) {
+                    # Interpretation of special pointers:
+                    # | subclass | subpath | widget           | path           | class   |
+                    # +----------+---------+------------------+----------------+-context-+
+                    # | :cmd     | :cmd    | herited widget   | window:cmd     |window   |
+                    # | :cmd     | *       | subwidget        | window.subpath | window  |
+                    # | ""       | :cmd    | herited widget   | window:cmd     | window  |
+                    # | ""       | *       | own              | window         | window  |
+                    # | *        | :cmd    | own              | window         | current |
+                    # | *        | *       | subwidget        | window.subpath | current |
+                    if { [string length $subclass] && ! [string equal $subclass ":cmd"] } {
+                        if { [string equal $subpath ":cmd"] } {
+                            set subpath ""
+                        }
+                        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 } {
+    variable _class
+    if { ![info exists _class($path)] } {
+        return -code error "unknown widget $path"
+    }
+
+    set class $_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 } {
+    variable _class
+    set class $_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 } {
+    variable _class
+    upvar $pvalue value
+    set class $_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 } {
+    variable _class
+    set class $_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} {
+    variable _class
+    set class $_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} {
+    variable _class
+    set class $_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::_make_tk_widget_name
+# ----------------------------------------------------------------------------
+# Before, the widget meta name was build as: ".#BWidget.#$tkwidget"
+# This does not work for ttk widgets, as they have an "::" in their name.
+# Thus replace any "::" by "__" will do the job.
+proc Widget::_make_tk_widget_name { tkwidget } {
+    set pos 0
+    for {set pos 0} {0 <= [set pos [string first "::" $tkwidget $pos]]} {incr pos} {
+	set tkwidget [string range $tkwidget 0 [expr {$pos-1}]]__[string range $tkwidget [expr {$pos+2}] end]
+    }
+    return ".#BWidget.#$tkwidget"
+}
+
+# ----------------------------------------------------------------------------
+#  Command Widget::_get_tkwidget_options
+# ----------------------------------------------------------------------------
+proc Widget::_get_tkwidget_options { tkwidget } {
+    variable _tk_widget
+    variable _optiondb
+    variable _optionclass
+
+    set widget [_make_tk_widget_name $tkwidget]
+    # encapsulation frame to not pollute '.' childspace
+    if {![winfo exists ".#BWidget"]} { frame ".#BWidget" }
+    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     [_make_tk_widget_name $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 \
+		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 {[string equal [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 {[string equal [winfo toplevel $cur] $cur]} {
+		break
+	    }
+	    set parent [winfo parent $parent]
+	    set children [winfo children $parent]
+	    set i [lsearch -exact $children $cur]
+	}
+	if {[string equal $cur $w] || [focusOK $cur]} {
+	    return $cur
+	}
+    }
+}
+
+
+# -----------------------------------------------------------------------------
+#  Command Widget::focusPrev
+#  Same as tk_focusPrev, except:
+#	+ Don't traverse from a child to a direct ancestor
+#	+ Call Widget::focusOK instead of tk::focusOK
+# -----------------------------------------------------------------------------
+proc Widget::focusPrev { w } {
+    set cur $w
+    set origParent [winfo parent $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 {[string equal [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 {[string equal [winfo toplevel $cur] $cur]} {
+		continue
+	    }
+	    set parent $cur
+	    set children [winfo children $parent]
+	    set i [llength $children]
+	}
+	set cur $parent
+	if {[string equal $cur $w]} {
+	    return $cur
+	}
+	# If we are just at the original parent of $w, skip it as a
+	# potential focus accepter.  Extra safety in this is to see if
+	# that parent is also a proc (not a C command), which is what
+	# BWidgets makes for any megawidget.  Could possibly also check
+	# for '[info commands ::${origParent}:cmd] != ""'.  [Bug 765667]
+	if {[string equal $cur $origParent]
+	    && [info procs ::$origParent] != ""} {
+	    continue
+	}
+	if {[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 [list $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)]
+}
+
+proc Widget::theme {{bool {}}} {
+    # Private, *experimental* API that may change at any time - JH
+    variable _theme
+    if {[llength [info level 0]] == 2} {
+	# set theme-ability
+	if {[catch {package require Tk 8.5a6}]
+	    && [catch {package require tile 0.6}]
+	    && [catch {package require tile 1}]} {
+	    return -code error "BWidget's theming requires tile 0.6+"
+	} else {
+	    catch {style default BWSlim.Toolbutton -padding 0}
+	}
+	set _theme [string is true -strict $bool]
+    }
+    return $_theme
+}