/*=========================================================================

  Program:   Visualization Toolkit
  Module:    vtkbwidgets.h
  Language:  C++
  Date:      $Date$
  Version:   $Revision$

Copyright (c) 2000-2001 Kitware Inc. 469 Clifton Corporate Parkway,
Clifton Park, NY, 12065, USA.
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:

 * Redistributions of source code must retain the above copyright notice,
   this list of conditions and the following disclaimer.

 * Redistributions in binary form must reproduce the above copyright notice,
   this list of conditions and the following disclaimer in the documentation
   and/or other materials provided with the distribution.

 * Neither the name of Kitware nor the names of any contributors may be used
   to endorse or promote products derived from this software without specific 
   prior written permission.

 * Modified source versions must be plainly marked as such, and must not be
   misrepresented as being the original software.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

=========================================================================*/

/*
BWidget ToolKit
Copyright (c) 1998-1999 UNIFIX. 
Copyright (c) 2001-2002 ActiveState Corp. 

The following terms apply to all files associated with the software
unless explicitly disclaimed in individual files.

The authors hereby grant permission to use, copy, modify, distribute,
and license this software and its documentation for any purpose, provided
that existing copyright notices are retained in all copies and that this
notice is included verbatim in any distributions. No written agreement,
license, or royalty fee is required for any of the authorized uses.
Modifications to this software may be copyrighted by their authors
and need not follow the licensing terms described here, provided that
the new terms are clearly indicated on the first page of each file where
they apply.

IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.

THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
MODIFICATIONS.

GOVERNMENT USE: If you are acquiring this software on behalf of the
U.S. government, the Government shall have only "Restricted Rights"
in the software and related documentation as defined in the Federal 
Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2).  If you
are acquiring the software on behalf of the Department of Defense, the
software shall be classified as "Commercial Computer Software" and the
Government shall have only "Restricted Rights" as defined in Clause
252.227-7013 (c) (1) of DFARs.  Notwithstanding the foregoing, the
authors grant the U.S. Government and others acting in its behalf
permission to use and distribute the software in accordance with the
terms specified in this license. 
*/

const char* bwidgets1 =
"# ----------------------------------------------------------------------------\n"
"#  widget.tcl\n"
"#  This file is part of Unifix BWidget Toolkit\n"
"#  Id\n"
"# ----------------------------------------------------------------------------\n"
"namespace eval Widget {\n"
"    variable _optiontype\n"
"    variable _class\n"
"    variable _tk_widget\n"
"\n"
"    array set _optiontype {\n"
"        TkResource Widget::_test_tkresource\n"
"        BwResource Widget::_test_bwresource\n"
"        Enum       Widget::_test_enum\n"
"        Int        Widget::_test_int\n"
"        Boolean    Widget::_test_boolean\n"
"        String     Widget::_test_string\n"
"        Flag       Widget::_test_flag\n"
"        Synonym    Widget::_test_synonym\n"
"        Color      Widget::_test_color\n"
"    }\n"
"\n"
"    proc use {} {}\n"
"}\n"
"\n"
"\n"
"\n"
"proc Widget::tkinclude { class tkwidget subpath args } {\n"
"    foreach {cmd lopt} $args {\n"
"        # cmd can be\n"
"        #   include      options to include            lopt = {opt ...}\n"
"        #   remove       options to remove             lopt = {opt ...}\n"
"        #   rename       options to rename             lopt = {opt newopt ...}\n"
"        #   prefix       options to prefix             lopt = {pref opt opt ..}\n"
"        #   initialize   set default value for options lopt = {opt value ...}\n"
"        #   readonly     set readonly flag for options lopt = {opt flag ...}\n"
"        switch -- $cmd {\n"
"            remove {\n"
"                foreach option $lopt {\n"
"                    set remove($option) 1\n"
"                }\n"
"            }\n"
"            include {\n"
"                foreach option $lopt {\n"
"                    set include($option) 1\n"
"                }\n"
"            }\n"
"            prefix {\n"
"                set prefix [lindex $lopt 0]\n"
"                foreach option [lrange $lopt 1 end] {\n"
"                    set rename($option) \"-$prefix[string range $option 1 end]\"\n"
"                }\n"
"            }\n"
"            rename     -\n"
"            readonly   -\n"
"            initialize {\n"
"                array set $cmd $lopt\n"
"            }\n"
"            default {\n"
"                return -code error \"invalid argument \\\"$cmd\\\"\"\n"
"            }\n"
"        }\n"
"    }\n"
"\n"
"    namespace eval $class {}\n"
"    upvar 0 ${class}::opt classopt\n"
"    upvar 0 ${class}::map classmap\n"
"    upvar 0 ${class}::map$subpath submap\n"
"    upvar 0 ${class}::optionExports exports\n"
"\n"
"    set foo [$tkwidget \".ericFoo###\"]\n"
"    # create resources informations from tk widget resources\n"
"    foreach optdesc [_get_tkwidget_options $tkwidget] {\n"
"        set option [lindex $optdesc 0]\n"
"        if { (![info exists include] || [info exists include($option)]) &&\n"
"             ![info exists remove($option)] } {\n"
"            if { [llength $optdesc] == 3 } {\n"
"                # option is a synonym\n"
"                set syn [lindex $optdesc 1]\n"
"                if { ![info exists remove($syn)] } {\n"
"                    # original option is not removed\n"
"                    if { [info exists rename($syn)] } {\n"
"                        set classopt($option) [list Synonym $rename($syn)]\n"
"                    } else {\n"
"                        set classopt($option) [list Synonym $syn]\n"
"                    }\n"
"                }\n"
"            } else {\n"
"                if { [info exists rename($option)] } {\n"
"                    set realopt $option\n"
"                    set option  $rename($option)\n"
"                } else {\n"
"                    set realopt $option\n"
"                }\n"
"                if { [info exists initialize($option)] } {\n"
"                    set value $initialize($option)\n"
"                } else {\n"
"                    set value [lindex $optdesc 1]\n"
"                }\n"
"                if { [info exists readonly($option)] } {\n"
"                    set ro $readonly($option)\n"
"                } else {\n"
"                    set ro 0\n"
"                }\n"
"                set classopt($option) \\\n"
"                       [list TkResource $value $ro [list $tkwidget $realopt]]\n"
"\n"
"               # Add an option database entry for this option\n"
"               set optionDbName \".[lindex [_configure_option $option \"\"] 0]\"\n"
"               if { ![string equal $subpath \":cmd\"] } {\n"
"                   set optionDbName \"$subpath$optionDbName\"\n"
"               }\n"
"               option add *${class}$optionDbName $value widgetDefault\n"
"               lappend exports($option) \"$optionDbName\"\n"
"\n"
"               # Store the forward and backward mappings for this\n"
"               # option <-> realoption pair\n"
"                lappend classmap($option) $subpath \"\" $realopt\n"
"               set submap($realopt) $option\n"
"            }\n"
"        }\n"
"    }\n"
"    ::destroy $foo\n"
"}\n"
"\n"
"# ----------------------------------------------------------------------------\n"
"#  Command Widget::declare\n"
"#    Declares new options to BWidget class.\n"
"# ----------------------------------------------------------------------------\n"
"proc Widget::declare { class optlist } {\n"
"    variable _optiontype\n"
"\n"
"    namespace eval $class {}\n"
"    upvar 0 ${class}::opt classopt\n"
"    upvar 0 ${class}::optionExports exports\n"
"    upvar 0 ${class}::optionClass optionClass\n"
"\n"
"    foreach optdesc $optlist {\n"
"        set option  [lindex $optdesc 0]\n"
"        set optdesc [lrange $optdesc 1 end]\n"
"        set type    [lindex $optdesc 0]\n"
"\n"
"        if { ![info exists _optiontype($type)] } {\n"
"            # invalid resource type\n"
"            return -code error \"invalid option type \\\"$type\\\"\"\n"
"        }\n"
"\n"
"        if { ![string compare $type \"Synonym\"] } {\n"
"            # test existence of synonym option\n"
"            set syn [lindex $optdesc 1]\n"
"            if { ![info exists classopt($syn)] } {\n"
"                return -code error \"unknow option \\\"$syn\\\" for Synonym \\\"$option\\\"\"\n"
"            }\n"
"            set classopt($option) [list Synonym $syn]\n"
"            continue\n"
"        }\n"
"\n"
"        # all other resource may have default value, readonly flag and\n"
"        # optional arg depending on type\n"
"        set value [lindex $optdesc 1]\n"
"        set ro    [lindex $optdesc 2]\n"
"        set arg   [lindex $optdesc 3]\n"
"\n"
"        if { ![string compare $type \"BwResource\"] } {\n"
"            set subclass    [lindex $arg 0]\n"
"            set realopt     [lindex $arg 1]\n"
"            if { ![string length $realopt] } {\n"
"                set realopt $option\n"
"            }\n"
"\n"
"            upvar 0 ${subclass}::opt subclassopt\n"
"            if { ![info exists subclassopt($realopt)] } {\n"
"                return -code error \"unknow option \\\"$realopt\\\"\"\n"
"            }\n"
"            set suboptdesc $subclassopt($realopt)\n"
"            if { $value == \"\" } {\n"
"                # We initialize default value\n"
"                set value [lindex $suboptdesc 1]\n"
"            }\n"
"            set type [lindex $suboptdesc 0]\n"
"            set ro   [lindex $suboptdesc 2]\n"
"            set arg  [lindex $suboptdesc 3]\n"
"           set optionDbName \".[lindex [_configure_option $option \"\"] 0]\"\n"
"           option add *${class}${optionDbName} $value widgetDefault\n"
"           set exports($option) $optionDbName\n"
"            set classopt($option) [list $type $value $ro $arg]\n"
"            continue\n"
"        }\n"
"\n"
"        # retreive default value for TkResource\n"
"        if { ![string compare $type \"TkResource\"] } {\n"
"            set tkwidget [lindex $arg 0]\n"
"           set foo [$tkwidget \".ericFoo##\"]\n"
"            set realopt  [lindex $arg 1]\n"
"            if { ![string length $realopt] } {\n"
"                set realopt $option\n"
"            }\n"
"            set tkoptions [_get_tkwidget_options $tkwidget]\n"
"            if { ![string length $value] } {\n"
"                # We initialize default value\n"
"               set ind [lsearch $tkoptions [list $realopt *]]\n"
"                set value [lindex [lindex $tkoptions $ind] end]\n"
"            }\n"
"           set optionDbName \".[lindex [_configure_option $option \"\"] 0]\"\n"
"           option add *${class}${optionDbName} $value widgetDefault\n"
"           set exports($option) $optionDbName\n"
"            set classopt($option) [list TkResource $value $ro \\\n"
"                   [list $tkwidget $realopt]]\n"
"           set optionClass($option) [lindex [$foo configure $realopt] 1]\n"
"           ::destroy $foo\n"
"            continue\n"
"        }\n"
"\n"
"       set optionDbName \".[lindex [_configure_option $option \"\"] 0]\"\n"
"       option add *${class}${optionDbName} $value widgetDefault\n"
"       set exports($option) $optionDbName\n"
"        # for any other resource type, we keep original optdesc\n"
"        set classopt($option) [list $type $value $ro $arg]\n"
"    }\n"
"}\n"
"\n"
"\n"
"# ----------------------------------------------------------------------------\n"
"#  Command Widget::addmap\n"
"# ----------------------------------------------------------------------------\n"
"proc Widget::addmap { class subclass subpath options } {\n"
"    upvar 0 ${class}::opt classopt\n"
"    upvar 0 ${class}::optionExports exports\n"
"    upvar 0 ${class}::optionClass optionClass\n"
"    upvar 0 ${class}::map classmap\n"
"    upvar 0 ${class}::map$subpath submap\n"
"\n"
"    foreach {option realopt} $options {\n"
"        if { ![string length $realopt] } {\n"
"            set realopt $option\n"
"        }\n"
"       set val [lindex $classopt($option) 1]\n"
"       set optDb \".[lindex [_configure_option $realopt \"\"] 0]\"\n"
"       if { ![string equal $subpath \":cmd\"] } {\n"
"           set optDb \"$subpath$optDb\"\n"
"       }\n"
"       option add *${class}${optDb} $val widgetDefault\n"
"       lappend exports($option) $optDb\n"
"       # Store the forward and backward mappings for this\n"
"       # option <-> realoption pair\n"
"        lappend classmap($option) $subpath $subclass $realopt\n"
"       set submap($realopt) $option\n"
"    }\n"
"}\n"
"\n"
"\n"
"# ----------------------------------------------------------------------------\n"
"#  Command Widget::syncoptions\n"
"# ----------------------------------------------------------------------------\n"
"proc Widget::syncoptions { class subclass subpath options } {\n"
"    upvar 0 ${class}::sync classync\n"
"\n"
"    foreach {option realopt} $options {\n"
"        if { ![string length $realopt] } {\n"
"            set realopt $option\n"
"        }\n"
"        set classync($option) [list $subpath $subclass $realopt]\n"
"    }\n"
"}\n"
"\n"
"\n"
"# ----------------------------------------------------------------------------\n"
"#  Command Widget::init\n"
"# ----------------------------------------------------------------------------\n"
"proc Widget::init { class path options } {\n"
"    upvar 0 ${class}::opt classopt\n"
"    upvar 0 ${class}::$path:opt  pathopt\n"
"    upvar 0 ${class}::$path:mod  pathmod\n"
"    upvar 0 ${class}::map classmap\n"
"    upvar 0 ${class}::$path:init pathinit\n"
"\n"
"    if { [info exists pathopt] } {\n"
"       unset pathopt\n"
"    }\n"
"    if { [info exists pathmod] } {\n"
"       unset pathmod\n"
"    }\n"
"    # We prefer to use the actual widget for option db queries, but if it\n"
"    set fpath $path\n"
"    set rdbclass [string map [list :: \"\"] $class]\n"
"    if { ![winfo exists $path] } {\n"
"       set fpath \".#BWidgetClass#$class\"\n"
"       if { ![winfo exists $fpath] } {\n"
"           frame $fpath -class $rdbclass\n"
"       }\n"
"    }\n"
"    foreach {option optdesc} [array get classopt] {\n"
"        set pathmod($option) 0\n"
"       if { [info exists classmap($option)] } {\n"
"           continue\n"
"       }\n"
"        set type [lindex $optdesc 0]\n"
"        if { ![string compare $type \"Synonym\"] } {\n"
"           continue\n"
"        }\n"
"        if { ![string compare $type \"TkResource\"] } {\n"
"            set alt [lindex [lindex $optdesc 3] 1]\n"
"        } else {\n"
"            set alt \"\"\n"
"        }\n"
"        set optdb [lindex [_configure_option $option $alt] 0]\n"
"        set def   [option get $fpath $optdb $rdbclass]\n"
"        if { [string length $def] } {\n"
"            set pathopt($option) $def\n"
"        } else {\n"
"            set pathopt($option) [lindex $optdesc 1]\n"
"        }\n"
"    }\n"
"\n"
"    set Widget::_class($path) $class\n"
"    foreach {option value} $options {\n"
"        if { ![info exists classopt($option)] } {\n"
"            unset pathopt\n"
"            unset pathmod\n"
"            return -code error \"unknown option \\\"$option\\\"\"\n"
"        }\n"
"        set optdesc $classopt($option)\n"
"        set type    [lindex $optdesc 0]\n"
"        if { ![string compare $type \"Synonym\"] } {\n"
"            set option  [lindex $optdesc 1]\n"
"            set optdesc $classopt($option)\n"
"            set type    [lindex $optdesc 0]\n"
"        }\n"
"        set pathopt($option) [$Widget::_optiontype($type) $option $value [lindex $optdesc 3]]\n"
"       set pathinit($option) $pathopt($option)\n"
"    }\n"
"}\n"
"\n"
"\n"
"\n"
"\n"
"# ----------------------------------------------------------------------------\n"
"#  Command Widget::destroy\n"
"# ----------------------------------------------------------------------------\n"
"proc Widget::destroy { path } {\n"
"    variable _class\n"
"\n"
"    set class $_class($path)\n"
"    upvar 0 ${class}::$path:opt pathopt\n"
"    upvar 0 ${class}::$path:mod pathmod\n"
"    upvar 0 ${class}::$path:init pathinit\n"
"\n"
"    if {[info exists pathopt]} {\n"
"        unset pathopt\n"
"    }\n"
"    if {[info exists pathmod]} {\n"
"        unset pathmod\n"
"    }\n"
"    if {[info exists pathinit]} {\n"
"        unset pathinit\n"
"    }\n"
"}\n"
"# ----------------------------------------------------------------------------\n"
"#  Command Widget::configure\n"
"# ----------------------------------------------------------------------------\n"
"proc Widget::configure { path options } {\n"
"    set len [llength $options]\n"
"    if { $len <= 1 } {\n"
"        return [_get_configure $path $options]\n"
"    } elseif { $len % 2 == 1 } {\n"
"        return -code error \"incorrect number of arguments\"\n"
"    }\n"
"\n"
"    variable _class\n"
"    variable _optiontype\n"
"\n"
"    set class $_class($path)\n"
"    upvar 0 ${class}::opt  classopt\n"
"    upvar 0 ${class}::map  classmap\n"
"    upvar 0 ${class}::$path:opt pathopt\n"
"    upvar 0 ${class}::$path:mod pathmod\n"
"\n"
"    set window [_get_window $class $path]\n"
"    foreach {option value} $options {\n"
"        if { ![info exists classopt($option)] } {\n"
"            return -code error \"unknown option \\\"$option\\\"\"\n"
"        }\n"
"        set optdesc $classopt($option)\n"
"        set type    [lindex $optdesc 0]\n"
"        if { ![string compare $type \"Synonym\"] } {\n"
"            set option  [lindex $optdesc 1]\n"
"            set optdesc $classopt($option)\n"
"            set type    [lindex $optdesc 0]\n"
"        }\n"
"        if { ![lindex $optdesc 2] } {\n"
"            set newval [$_optiontype($type) $option $value [lindex $optdesc 3]]\n"
"            if { [info exists classmap($option)] } {\n"
"               set window [_get_window $class $window]\n"
"                foreach {subpath subclass realopt} $classmap($option) {\n"
"                    if { [string length $subclass] } {\n"
"                       set curval [${subclass}::cget $window$subpath $realopt]\n"
"                        ${subclass}::configure $window$subpath $realopt $newval\n"
"                    } else {\n"
"                       set curval [$window$subpath cget $realopt]\n"
"                        $window$subpath configure $realopt $newval\n"
"                    }\n"
"                }\n"
"            } else {\n"
"               set curval $pathopt($option)\n"
"               set pathopt($option) $newval\n"
"           }\n"
"           set pathmod($option) [expr {![string equal $newval $curval]}]\n"
"        }\n"
"    }\n"
"\n"
"    return {}\n"
"}\n"
"\n"
"\n"
"# ----------------------------------------------------------------------------\n"
"#  Command Widget::cget\n"
"# ----------------------------------------------------------------------------\n"
"proc Widget::cget { path option } {\n"
"    if { ![info exists ::Widget::_class($path)] } {\n"
"        return -code error \"unknown widget $path\"\n"
"    }\n"
"\n"
"    set class $::Widget::_class($path)\n"
"    if { ![info exists ${class}::opt($option)] } {\n"
"        return -code error \"unknown option \\\"$option\\\"\"\n"
"    }\n"
"\n"
"    set optdesc [set ${class}::opt($option)]\n"
"    set type    [lindex $optdesc 0]\n"
"    if { ![string compare $type \"Synonym\"] } {\n"
"        set option [lindex $optdesc 1]\n"
"    }\n"
"\n"
"    if { [info exists ${class}::map($option)] } {\n"
"       foreach {subpath subclass realopt} [set ${class}::map($option)] {break}\n"
"       set path \"[_get_window $class $path]$subpath\"\n"
"       return [$path cget $realopt]\n"
"    }\n"
"    upvar 0 ${class}::$path:opt pathopt\n"
"    set pathopt($option)\n"
"}\n"
"\n"
"\n"
"# ----------------------------------------------------------------------------\n"
"#  Command Widget::subcget\n"
"# ----------------------------------------------------------------------------\n"
"proc Widget::subcget { path subwidget } {\n"
"    set class $::Widget::_class($path)\n"
"    upvar 0 ${class}::$path:opt pathopt\n"
"    upvar 0 ${class}::map$subwidget submap\n"
"    upvar 0 ${class}::$path:init pathinit\n"
"\n"
"    set result {}\n"
"    foreach realopt [array names submap] {\n"
"       if { [info exists pathinit($submap($realopt))] } {\n"
"           lappend result $realopt $pathopt($submap($realopt))\n"
"       }\n"
"    }\n"
"    return $result\n"
"}\n"
"\n"
"\n"
"# ----------------------------------------------------------------------------\n"
"#  Command Widget::hasChanged\n"
"# ----------------------------------------------------------------------------\n"
"proc Widget::hasChanged { path option pvalue } {\n"
"    upvar    $pvalue value\n"
"    set class $::Widget::_class($path)\n"
"    upvar 0 ${class}::$path:mod pathmod\n"
"\n"
"    set value   [Widget::cget $path $option]\n"
"    set result  $pathmod($option)\n"
"    set pathmod($option) 0\n"
"\n"
"    return $result\n"
"}\n"
"\n"
"proc Widget::hasChangedX { path option args } {\n"
"    set class $::Widget::_class($path)\n"
"    upvar 0 ${class}::$path:mod pathmod\n"
"\n"
"    set result  $pathmod($option)\n"
"    set pathmod($option) 0\n"
"    foreach option $args {\n"
"       lappend result $pathmod($option)\n"
"       set pathmod($option) 0\n"
"    }\n"
"\n"
"    set result\n"
"}\n"
"\n"
"\n"
"\n"
"proc Widget::setoption { path option value } {\n"
"    Widget::configure $path [list $option $value]\n"
"}\n"
"# ----------------------------------------------------------------------------\n"
"#  Command Widget::getoption\n"
"# ----------------------------------------------------------------------------\n"
"proc Widget::getoption { path option } {\n"
"#    set class $::Widget::_class($path)\n"
"#    upvar 0 ${class}::$path:opt pathopt\n"
"\n"
"#    return $pathopt($option)\n"
"    return [Widget::cget $path $option]\n"
"}\n"
"\n"
"# Widget::getMegawidgetOption --\n"
"#\n"
"#      Bypass the superfluous checks in cget and just directly peer at the\n"
"#      widgets data space.  This is much more fragile than cget, so it \n"
"#      should only be used with great care, in places where speed is critical.\n"
"#\n"
"# Arguments:\n"
"#      path    widget to lookup options for.\n"
"#      option  option to retrieve.\n"
"#\n"
"# Results:\n"
"#      value   option value.\n"
"\n"
"proc Widget::getMegawidgetOption {path option} {\n"
"    set class $::Widget::_class($path)\n"
"    upvar 0 ${class}::${path}:opt pathopt\n"
"    set pathopt($option)\n"
"}\n"
"\n"
"# Widget::setMegawidgetOption --\n"
"#\n"
"#      Bypass the superfluous checks in cget and just directly poke at the\n"
"#      widgets data space.  This is much more fragile than configure, so it \n"
"#      should only be used with great care, in places where speed is critical.\n"
"#\n"
"# Arguments:\n"
"#      path    widget to lookup options for.\n"
"#      option  option to retrieve.\n"
"#      value   option value.\n"
"#\n"
"# Results:\n"
"#      value   option value.\n"
"\n"
"proc Widget::setMegawidgetOption {path option value} {\n"
"    set class $::Widget::_class($path)\n"
"    upvar 0 ${class}::${path}:opt pathopt\n"
"    set pathopt($option) $value\n"
"}\n"
"\n"
"# ----------------------------------------------------------------------------\n"
"#  Command Widget::_get_window\n"
"#  returns the window corresponding to widget path\n"
"# ----------------------------------------------------------------------------\n"
"proc Widget::_get_window { class path } {\n"
"    set idx [string last \"#\" $path]\n"
"    if { $idx != -1 && ![string compare [string range $path [expr {$idx+1}] end] $class] } {\n"
"        return [string range $path 0 [expr {$idx-1}]]\n"
"    } else {\n"
"        return $path\n"
"    }\n"
"}\n"
"\n"
"\n"
"\n"
"# ----------------------------------------------------------------------------\n"
"#  Command Widget::_configure_option\n"
"# ----------------------------------------------------------------------------\n"
"proc Widget::_configure_option { option altopt } {\n"
"    variable _optiondb\n"
"    variable _optionclass\n"
"\n"
"    if { [info exists _optiondb($option)] } {\n"
"        set optdb $_optiondb($option)\n"
"    } else {\n"
"        set optdb [string range $option 1 end]\n"
"    }\n"
"    if { [info exists _optionclass($option)] } {\n"
"        set optclass $_optionclass($option)\n"
"    } elseif { [string length $altopt] } {\n"
"        if { [info exists _optionclass($altopt)] } {\n"
"            set optclass $_optionclass($altopt)\n"
"        } else {\n"
"            set optclass [string range $altopt 1 end]\n"
"        }\n"
"    } else {\n"
"        set optclass [string range $option 1 end]\n"
"    }\n"
"    return [list $optdb $optclass]\n"
"}\n"
"\n"
"\n"
"# ----------------------------------------------------------------------------\n"
"#  Command Widget::_get_tkwidget_options\n"
"# ----------------------------------------------------------------------------\n"
"proc Widget::_get_tkwidget_options { tkwidget } {\n"
"    variable _tk_widget\n"
"    variable _optiondb\n"
"    variable _optionclass\n"
"    \n"
"    set widget \".#BWidget#$tkwidget\"\n"
"    if { ![winfo exists $widget] || ![info exists _tk_widget($tkwidget)] } {\n"
"        set widget [$tkwidget $widget]\n"
"        set config [$widget configure]\n"
"        foreach optlist $config {\n"
"            set opt [lindex $optlist 0]\n"
"            if { [llength $optlist] == 2 } {\n"
"                set refsyn [lindex $optlist 1]\n"
"                # search for class\n"
"                set idx [lsearch $config [list * $refsyn *]]\n"
"                if { $idx == -1 } {\n"
"                    if { [string index $refsyn 0] == \"-\" } {\n"
"                        # search for option (tk8.1b1 bug)\n"
"                        set idx [lsearch $config [list $refsyn * *]]\n"
"                    } else {\n"
"                        # last resort\n"
"                        set idx [lsearch $config [list -[string tolower $refsyn] * *]]\n"
"                    }\n"
"                    if { $idx == -1 } {\n"
"                        # fed up with \"can't read classopt()\"\n"
"                        return -code error \"can't find option of synonym $opt\"\n"
"                    }\n"
"                }\n"
"                set syn [lindex [lindex $config $idx] 0]\n"
"               # JDC: used 4 (was 3) to get def from optiondb\n"
"                set def [lindex [lindex $config $idx] 4]\n"
"                lappend _tk_widget($tkwidget) [list $opt $syn $def]\n"
"            } else {\n"
"               # JDC: used 4 (was 3) to get def from optiondb\n"
"                set def [lindex $optlist 4]\n"
"                lappend _tk_widget($tkwidget) [list $opt $def]\n"
"                set _optiondb($opt)    [lindex $optlist 1]\n"
"                set _optionclass($opt) [lindex $optlist 2]\n"
"            }\n"
"        }\n"
"    }\n"
"    return $_tk_widget($tkwidget)\n"
"}\n"
"\n"
"\n"
"# ----------------------------------------------------------------------------\n"
"#  Command Widget::_test_tkresource\n"
"# ----------------------------------------------------------------------------\n"
"proc Widget::_test_tkresource { option value arg } {\n"
"#    set tkwidget [lindex $arg 0]\n"
"#    set realopt  [lindex $arg 1]\n"
"    foreach {tkwidget realopt} $arg break\n"
"    set path     \".#BWidget#$tkwidget\"\n"
"    set old      [$path cget $realopt]\n"
"    $path configure $realopt $value\n"
"    set res      [$path cget $realopt]\n"
"    $path configure $realopt $old\n"
"\n"
"    return $res\n"
"}\n"
"\n"
"\n"
"# ----------------------------------------------------------------------------\n"
"#  Command Widget::_test_bwresource\n"
"# ----------------------------------------------------------------------------\n"
"proc Widget::_test_bwresource { option value arg } {\n"
"    return -code error \"bad option type BwResource in widget\"\n"
"}\n"
"\n"
"\n"
"# ----------------------------------------------------------------------------\n"
"#  Command Widget::_test_synonym\n"
"# ----------------------------------------------------------------------------\n"
"proc Widget::_test_synonym { option value arg } {\n"
"    return -code error \"bad option type Synonym in widget\"\n"
"}\n"
"\n"
"# ----------------------------------------------------------------------------\n"
"#  Command Widget::_test_color\n"
"# ----------------------------------------------------------------------------\n"
"proc Widget::_test_color { option value arg } {\n"
"    if {[catch {winfo rgb . $value} color]} {\n"
"        return -code error \"bad $option value \\\"$value\\\": must be a colorname \\\n"
"               or #RRGGBB triplet\"\n"
"    }\n"
"\n"
"    return $value\n"
"}\n"
"\n"
"\n"
"# ----------------------------------------------------------------------------\n"
"#  Command Widget::_test_string\n"
"# ----------------------------------------------------------------------------\n"
"proc Widget::_test_string { option value arg } {\n"
"    set value\n"
"}\n"
"\n"
"\n"
"# ----------------------------------------------------------------------------\n"
"#  Command Widget::_test_flag\n"
"# ----------------------------------------------------------------------------\n"
"proc Widget::_test_flag { option value arg } {\n"
"    set len [string length $value]\n"
"    set res \"\"\n"
"    for {set i 0} {$i < $len} {incr i} {\n"
"        set c [string index $value $i]\n"
"        if { [string first $c $arg] == -1 } {\n"
"            return -code error \"bad [string range $option 1 end] value \\\"$value\\\": characters must be in \\\"$arg\\\"\"\n"
"        }\n"
"        if { [string first $c $res] == -1 } {\n"
"            append res $c\n"
"        }\n"
"    }\n"
"    return $res\n"
"}\n"
"\n"
"\n"
"# -----------------------------------------------------------------------------\n"
"#  Command Widget::_test_enum\n"
"# -----------------------------------------------------------------------------\n"
"proc Widget::_test_enum { option value arg } {\n"
"    if { [lsearch $arg $value] == -1 } {\n"
"        set last [lindex   $arg end]\n"
"        set sub  [lreplace $arg end end]\n"
"        if { [llength $sub] } {\n"
"            set str \"[join $sub \", \"] or $last\"\n"
"        } else {\n"
"            set str $last\n"
"        }\n"
"        return -code error \"bad [string range $option 1 end] value \\\"$value\\\": must be $str\"\n"
"    }\n"
"    return $value\n"
"}\n"
"\n"
"\n"
"# -----------------------------------------------------------------------------\n"
"#  Command Widget::_test_int\n"
"# -----------------------------------------------------------------------------\n"
"proc Widget::_test_int { option value arg } {\n"
"    if { ![string is int -strict $value] || \\\n"
"           ([string length $arg] && \\\n"
"           ![expr [string map [list %d $value] $arg]]) } {\n"
"                   return -code error \"bad $option value\\\n"
"                           \\\"$value\\\": must be integer ($arg)\"\n"
"    }\n"
"    return $value\n"
"}\n"
"\n"
"\n"
"# -----------------------------------------------------------------------------\n"
"#  Command Widget::_test_boolean\n"
"# -----------------------------------------------------------------------------\n"
"proc Widget::_test_boolean { option value arg } {\n"
"    if { ![string is boolean -strict $value] } {\n"
"        return -code error \"bad $option value \\\"$value\\\": must be boolean\"\n"
"    }\n"
"\n"
"    # Get the canonical form of the boolean value (1 for true, 0 for false)\n"
"    return [string is true $value]\n"
"}\n"
"\n"
"\n"
"# -----------------------------------------------------------------------------\n"
"#  Command Widget::focusNext\n"
"#  Same as tk_focusNext, but call Widget::focusOK\n"
"# -----------------------------------------------------------------------------\n"
"proc Widget::focusNext { w } {\n"
"    set cur $w\n"
"    while 1 {\n"
"\n"
"       # Descend to just before the first child of the current widget.\n"
"\n"
"       set parent $cur\n"
"       set children [winfo children $cur]\n"
"       set i -1\n"
"\n"
"       # Look for the next sibling that isnt a top-level.\n"
"\n"
"       while 1 {\n"
"           incr i\n"
"           if {$i < [llength $children]} {\n"
"               set cur [lindex $children $i]\n"
"               if {[winfo toplevel $cur] == $cur} {\n"
"                   continue\n"
"               } else {\n"
"                   break\n"
"               }\n"
"           }\n"
"\n"
"           # No more siblings, so go to the current widget's parent.\n"
"           # If it's a top-level, break out of the loop, otherwise\n"
"           # look for its next sibling.\n"
"\n"
"           set cur $parent\n"
"           if {[winfo toplevel $cur] == $cur} {\n"
"               break\n"
"           }\n"
"           set parent [winfo parent $parent]\n"
"           set children [winfo children $parent]\n"
"           set i [lsearch -exact $children $cur]\n"
"       }\n"
"       if {($cur == $w) || [focusOK $cur]} {\n"
"           return $cur\n"
"       }\n"
"    }\n"
"}\n"
"\n"
"\n"
"# -----------------------------------------------------------------------------\n"
"#  Command Widget::focusPrev\n"
"#  Same as tk_focusPrev, but call Widget::focusOK\n"
"# -----------------------------------------------------------------------------\n"
"proc Widget::focusPrev { w } {\n"
"    set cur $w\n"
"    while 1 {\n"
"\n"
"       # Collect information about the current windows position\n"
"       # among its siblings.  Also, if the window is a top-level,\n"
"       # then reposition to just after the last child of the window.\n"
"    \n"
"       if {[winfo toplevel $cur] == $cur}  {\n"
"           set parent $cur\n"
"           set children [winfo children $cur]\n"
"           set i [llength $children]\n"
"       } else {\n"
"           set parent [winfo parent $cur]\n"
"           set children [winfo children $parent]\n"
"           set i [lsearch -exact $children $cur]\n"
"       }\n"
"\n"
"       # Go to the previous sibling, then descend to its last descendant\n"
"       # (highest in stacking order.  While doing this, ignore top-levels\n"
"       # and their descendants.  When we run out of descendants, go up\n"
"       # one level to the parent.\n"
"\n"
"       while {$i > 0} {\n"
"           incr i -1\n"
"           set cur [lindex $children $i]\n"
"           if {[winfo toplevel $cur] == $cur} {\n"
"               continue\n"
"           }\n"
"           set parent $cur\n"
"           set children [winfo children $parent]\n"
"           set i [llength $children]\n"
"       }\n"
"       set cur $parent\n"
"       if {($cur == $w) || [focusOK $cur]} {\n"
"           return $cur\n"
"       }\n"
"    }\n"
"}\n"
"\n"
"\n"
"# ----------------------------------------------------------------------------\n"
"#  Command Widget::focusOK\n"
"#  Same as tk_focusOK, but handles -editable option and whole tags list.\n"
"# ----------------------------------------------------------------------------\n"
"proc Widget::focusOK { w } {\n"
"    set code [catch {$w cget -takefocus} value]\n"
"    if { $code == 1 } {\n"
"        return 0\n"
"    }\n"
"    if {($code == 0) && ($value != \"\")} {\n"
"       if {$value == 0} {\n"
"           return 0\n"
"       } elseif {$value == 1} {\n"
"           return [winfo viewable $w]\n"
"       } else {\n"
"           set value [uplevel \\#0 $value $w]\n"
"            if {$value != \"\"} {\n"
"               return $value\n"
"           }\n"
"        }\n"
"    }\n"
"    if {![winfo viewable $w]} {\n"
"       return 0\n"
"    }\n"
"    set code [catch {$w cget -state} value]\n"
"    if {($code == 0) && ($value == \"disabled\")} {\n"
"       return 0\n"
"    }\n"
"    set code [catch {$w cget -editable} value]\n"
"    if {($code == 0) && !$value} {\n"
"        return 0\n"
"    }\n"
"\n"
"    set top [winfo toplevel $w]\n"
"    foreach tags [bindtags $w] {\n"
"        if { [string compare $tags $top]  &&\n"
"             [string compare $tags \"all\"] &&\n"
"             [regexp Key [bind $tags]] } {\n"
"            return 1\n"
"        }\n"
"    }\n"
"    return 0\n"
"}\n"
"\n"
"# Widget::varForOption --\n"
"#\n"
"#      Retrieve a fully qualified variable name for the option specified.\n"
"#      If the option is not one for which a variable exists, throw an error \n"
"#      (ie, those options that map directly to widget options).\n"
"#\n"
"# Arguments:\n"
"#      path    megawidget to get an option var for.\n"
"#      option  option to get a var for.\n"
"#\n"
"# Results:\n"
"#      varname name of the variable, fully qualified, suitable for tracing.\n"
"\n"
"proc Widget::varForOption {path option} {\n"
"    variable _class\n"
"    variable _optiontype\n"
"\n"
"    set class $_class($path)\n"
"    upvar 0 ${class}::$path:opt pathopt\n"
"\n"
"    if { ![info exists pathopt($option)] } {\n"
"       error \"unable to find variable for option \\\"$option\\\"\"\n"
"    }\n"
"    set varname \"::Widget::${class}::$path:opt($option)\"\n"
"    return $varname\n"
"}\n"
"\n"
"\n";


const char* bwidgets2 =
"# ------------------------------------------------------------------------------\n"
"#  scrollframe.tcl\n"
"#  This file is part of Unifix BWidget Toolkit\n"
"#  Id\n"
"# ------------------------------------------------------------------------------\n"
"\n"
"namespace eval ScrollableFrame {\n"
"    Widget::declare ScrollableFrame {\n"
"        {-background        TkResource \"\" 0 frame}\n"
"        {-width             Int        0  0 {}}\n"
"        {-height            Int        0  0 {}}\n"
"        {-areawidth         Int        0  0 {}}\n"
"        {-areaheight        Int        0  0 {}}\n"
"        {-constrainedwidth  Boolean    0 0}\n"
"        {-constrainedheight Boolean    0 0}\n"
"        {-xscrollcommand    TkResource \"\" 0 canvas}\n"
"        {-yscrollcommand    TkResource \"\" 0 canvas}\n"
"        {-xscrollincrement  TkResource \"\" 0 canvas}\n"
"        {-yscrollincrement  TkResource \"\" 0 canvas}\n"
"        {-bg                Synonym    -background}\n"
"    }\n"
"\n"
"    Widget::addmap ScrollableFrame \"\" :cmd {\n"
"        -background {} -width {} -height {} \n"
"        -xscrollcommand {} -yscrollcommand {}\n"
"        -xscrollincrement {} -yscrollincrement {}\n"
"    }\n"
"    Widget::addmap ScrollableFrame \"\" .frame {-background {}}\n"
"\n"
"    variable _widget\n"
"\n"
"    bind BwScrollableFrame <Configure> {ScrollableFrame::_resize %W}\n"
"    bind BwScrollableFrame <Destroy>   {Widget::destroy %W; rename %W {}}\n"
"\n"
"    proc ::ScrollableFrame { path args } { return [eval ScrollableFrame::create $path $args] }\n"
"    proc use {} {}\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command ScrollableFrame::create\n"
"# ------------------------------------------------------------------------------\n"
"proc ScrollableFrame::create { path args } {\n"
"    Widget::init ScrollableFrame $path $args\n"
"\n"
"    set canvas [eval canvas $path [Widget::subcget $path :cmd] \\\n"
"                    -highlightthickness 0 -borderwidth 0 -relief flat]\n"
"\n"
"    set frame  [eval frame $path.frame [Widget::subcget $path .frame] \\\n"
"                    -highlightthickness 0 -borderwidth 0 -relief flat]\n"
"\n"
"    $canvas create window 0 0 -anchor nw -window $frame -tags win \\\n"
"        -width  [Widget::cget $path -areawidth] \\\n"
"        -height [Widget::cget $path -areaheight]\n"
"\n"
"    bind $frame <Configure> \"$canvas:cmd configure -scrollregion {0 0 %w %h}\"\n"
"    bindtags $path [list $path BwScrollableFrame [winfo toplevel $path] all]\n"
"\n"
"    rename $path ::$path:cmd\n"
"    proc ::$path { cmd args } \"return \\[eval ScrollableFrame::\\$cmd $path \\$args\\]\"\n"
"\n"
"    return $canvas\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command ScrollableFrame::configure\n"
"# ------------------------------------------------------------------------------\n"
"proc ScrollableFrame::configure { path args } {\n"
"    set res [Widget::configure $path $args]\n"
"    set upd 0\n"
"\n"
"    set modcw [Widget::hasChanged $path -constrainedwidth cw]\n"
"    set modw  [Widget::hasChanged $path -areawidth w]\n"
"    if { $modcw || (!$cw && $modw) } {\n"
"        if { $cw } {\n"
"            set w [winfo width $path]\n"
"        }\n"
"        set upd 1\n"
"    }\n"
"\n"
"    set modch [Widget::hasChanged $path -constrainedheight ch]\n"
"    set modh  [Widget::hasChanged $path -areaheight h]\n"
"    if { $modch || (!$ch && $modh) } {\n"
"        if { $ch } {\n"
"            set h [winfo height $path]\n"
"        }\n"
"        set upd 1\n"
"    }\n"
"\n"
"    if { $upd } {\n"
"        $path:cmd itemconfigure win -width $w -height $h\n"
"    }\n"
"    return $res\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command ScrollableFrame::cget\n"
"# ------------------------------------------------------------------------------\n"
"proc ScrollableFrame::cget { path option } {\n"
"    return [Widget::cget $path $option]\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command ScrollableFrame::getframe\n"
"# ------------------------------------------------------------------------------\n"
"proc ScrollableFrame::getframe { path } {\n"
"    return $path.frame\n"
"}\n"
"\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command ScrollableFrame::xview\n"
"# ------------------------------------------------------------------------------\n"
"proc ScrollableFrame::xview { path args } {\n"
"    return [eval $path:cmd xview $args]\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command ScrollableFrame::yview\n"
"# ------------------------------------------------------------------------------\n"
"proc ScrollableFrame::yview { path args } {\n"
"    return [eval $path:cmd yview $args]\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command ScrollableFrame::_resize\n"
"# ------------------------------------------------------------------------------\n"
"proc ScrollableFrame::_resize { path } {\n"
"    if { [Widget::getoption $path -constrainedwidth] } {\n"
"        $path:cmd itemconfigure win -width [winfo width $path]\n"
"    }\n"
"    if { [Widget::getoption $path -constrainedheight] } {\n"
"        $path:cmd itemconfigure win -height [winfo height $path]\n"
"    }\n"
"}\n"
"\n"
"\n";

const char* bwidgets3 =
"# -----------------------------------------------------------------------------\n"
"#  scrollw.tcl\n"
"#  This file is part of Unifix BWidget Toolkit\n"
"#  Id\n"
"# -----------------------------------------------------------------------------\n"
"namespace eval ScrolledWindow {\n"
"    Widget::declare ScrolledWindow {\n"
"        {-background  TkResource \"\"   0 button}\n"
"        {-scrollbar   Enum       both 0 {none both vertical horizontal}}\n"
"        {-auto        Enum       both 0 {none both vertical horizontal}}\n"
"        {-sides       Enum       se   0 {ne en nw wn se es sw ws}}\n"
"        {-size        Int        0    1 \"%d >= 0\"}\n"
"        {-ipad        Int        1    1 \"%d >= 0\"}\n"
"        {-managed     Boolean    1    1}\n"
"        {-relief      TkResource flat 0 frame}\n"
"        {-borderwidth TkResource 0    0 frame}\n"
"        {-bg          Synonym    -background}\n"
"        {-bd          Synonym    -borderwidth}\n"
"    }\n"
"\n"
"    Widget::addmap ScrolledWindow \"\" ._grid.f {-relief {} -borderwidth {}}\n"
"\n"
"    proc ::ScrolledWindow {path args} {\n"
"        return [eval ScrolledWindow::create $path $args]\n"
"    }\n"
"    proc use {} {}\n"
"}\n"
"\n"
"\n"
"# -----------------------------------------------------------------------------\n"
"#  Command ScrolledWindow::create\n"
"# -----------------------------------------------------------------------------\n"
"proc ScrolledWindow::create { path args } {\n"
"    upvar \\#0 ScrolledWindow::$path data\n"
"\n"
"    Widget::init ScrolledWindow $path $args\n"
"\n"
"    set bg     [Widget::cget $path -background]\n"
"    set sbsize [Widget::cget $path -size]\n"
"    set ipad   [Widget::cget $path -ipad]\n"
"    set sw     [frame $path \\\n"
"                    -relief flat -borderwidth 0 -background $bg \\\n"
"                    -highlightthickness 0 -takefocus 0]\n"
"    set grid   [frame $path._grid \\\n"
"                    -relief flat -borderwidth 0 -background $bg \\\n"
"                    -highlightthickness 0 -takefocus 0]\n"
"    set fv     [frame $grid.vframe \\\n"
"                    -relief flat -borderwidth 0 -background $bg \\\n"
"                    -highlightthickness 0 -takefocus 0]\n"
"    set fh     [frame $grid.hframe \\\n"
"                    -relief flat -borderwidth 0 -background $bg \\\n"
"                    -highlightthickness 0 -takefocus 0]\n"
"    eval frame $grid.f -background $bg -highlightthickness 0 \\\n"
"        [Widget::subcget $path ._grid.f]\n"
"\n"
"    scrollbar $grid.hscroll \\\n"
"        -highlightthickness 0 -takefocus 0 \\\n"
"        -orient  horiz \\\n"
"        -relief  sunken        \\\n"
"        -bg      $bg\n"
"    scrollbar $grid.vscroll \\\n"
"        -highlightthickness 0 -takefocus 0 \\\n"
"        -orient  vert          \\\n"
"        -relief  sunken        \\\n"
"        -bg      $bg\n"
"\n"
"    set data(realized) 0\n"
"\n"
"    _setData $path \\\n"
"        [Widget::cget $path -scrollbar] \\\n"
"        [Widget::cget $path -auto] \\\n"
"        [Widget::cget $path -sides]\n"
"\n"
"    if {[Widget::cget $path -managed]} {\n"
"        set data(hsb,packed) $data(hsb,present)\n"
"        set data(vsb,packed) $data(vsb,present)\n"
"    } else {\n"
"        set data(hsb,packed) 0\n"
"        set data(vsb,packed) 0\n"
"    }\n"
"    if {$sbsize} {\n"
"        $grid.vscroll configure -width $sbsize\n"
"        $grid.hscroll configure -width $sbsize\n"
"    } else {\n"
"        set sbsize [$grid.vscroll cget -width]\n"
"    }\n"
"    set size [expr {$sbsize+$ipad}]\n"
"\n"
"    $grid.vframe configure -width  $size\n"
"    $grid.hframe configure -height $size\n"
"    set vplaceopt [list -in $grid.vframe -x [expr {(1-$data(vsb,west))*$ipad}] -y 0 -width [expr {-$ipad}]]\n"
"    set hplaceopt [list -in $grid.hframe -x 0 -y [expr {(1-$data(hsb,north))*$ipad}] -height [expr {-$ipad}]]\n"
"    pack propagate $grid.vframe 0\n"
"    pack propagate $grid.hframe 0\n"
"    pack $grid.vscroll -in $grid.vframe\n"
"    pack $grid.hscroll -in $grid.hframe\n"
"\n"
"    bind $grid.hscroll <Configure> \\\n"
"        \"ScrolledWindow::_setSBSize $grid.hscroll $size -relwidth 1.0 -relheight 1.0 $hplaceopt\"\n"
"    bind $grid.vscroll <Configure> \\\n"
"        \"ScrolledWindow::_setSBSize $grid.vscroll $size -relwidth 1.0 -relheight 1.0 $vplaceopt\"\n"
"\n"
"    grid $grid.hframe \\\n"
"        -column     [expr {$data(vsb,west)*$data(vsb,packed)}] \\\n"
"        -row        [expr {1-$data(hsb,north)}]  \\\n"
"        -columnspan [expr {2-$data(vsb,packed)}] \\\n"
"        -sticky we\n"
"    grid $grid.vframe \\\n"
"        -column  [expr {1-$data(vsb,west)}] \\\n"
"        -row     [expr {$data(hsb,north)*$data(hsb,packed)}] \\\n"
"        -rowspan [expr {2-$data(hsb,packed)}] \\\n"
"        -sticky ns\n"
"\n"
"    grid $grid.f \\\n"
"        -column     [expr {$data(vsb,west)*$data(vsb,packed)}]  \\\n"
"        -row        [expr {$data(hsb,north)*$data(hsb,packed)}] \\\n"
"        -columnspan [expr {2-$data(vsb,packed)}] \\\n"
"        -rowspan    [expr {2-$data(hsb,packed)}] \\\n"
"        -sticky     nwse\n"
"\n"
"    grid columnconfigure $grid $data(vsb,west)  -weight 1\n"
"    grid rowconfigure    $grid $data(hsb,north) -weight 1\n"
"    pack $grid -fill both -expand yes\n"
"\n"
"    bind $grid <Configure> \"ScrolledWindow::_realize $path\"\n"
"    bind $grid <Destroy>   \"ScrolledWindow::_destroy $path\"\n"
"    raise $grid.f\n"
"    rename $path ::$path:cmd\n"
"    proc ::$path { cmd args } \"return \\[eval ScrolledWindow::\\$cmd $path \\$args\\]\"\n"
"\n"
"    return $path\n"
"}\n"
"\n"
"\n"
"# -----------------------------------------------------------------------------\n"
"#  Command ScrolledWindow::getframe\n"
"# -----------------------------------------------------------------------------\n"
"proc ScrolledWindow::getframe { path } {\n"
"    return $path\n"
"}\n"
"\n"
"\n"
"# -----------------------------------------------------------------------------\n"
"#  Command ScrolledWindow::setwidget\n"
"# -----------------------------------------------------------------------------\n"
"proc ScrolledWindow::setwidget { path widget } {\n"
"    upvar \\#0 ScrolledWindow::$path data\n"
"\n"
"    set grid   $path._grid\n"
"\n"
"    pack $widget -in $grid.f -fill both -expand yes\n"
"\n"
"    $grid.hscroll configure -command \"$widget xview\"\n"
"    $grid.vscroll configure -command \"$widget yview\"\n"
"    $widget configure \\\n"
"        -xscrollcommand \"ScrolledWindow::_set_hscroll $path\" \\\n"
"        -yscrollcommand \"ScrolledWindow::_set_vscroll $path\"\n"
"}\n"
"\n"
"\n"
"# -----------------------------------------------------------------------------\n"
"#  Command ScrolledWindow::configure\n"
"# -----------------------------------------------------------------------------\n"
"proc ScrolledWindow::configure { path args } {\n"
"    upvar \\#0 ScrolledWindow::$path data\n"
"\n"
"    set grid $path._grid\n"
"    set res [Widget::configure $path $args]\n"
"    if { [Widget::hasChanged $path -background bg] } {\n"
"        $path configure -background $bg\n"
"        $grid configure -background $bg\n"
"        $grid.f configure -background $bg\n"
"        catch {$grid.hscroll configure -background $bg}\n"
"        catch {$grid.vscroll configure -background $bg}\n"
"    }\n"
"\n"
"    if {[Widget::hasChanged $path -scrollbar scrollbar] |\n"
"        [Widget::hasChanged $path -auto      auto]     |\n"
"        [Widget::hasChanged $path -sides     sides]} {\n"
"        _setData $path $scrollbar $auto $sides\n"
"        set hscroll [$grid.hscroll get]\n"
"        set vmin    [lindex $hscroll 0]\n"
"        set vmax    [lindex $hscroll 1]\n"
"        set data(hsb,packed) [expr {$data(hsb,present) &&\n"
"                                    (!$data(hsb,auto) || ($vmin != 0 || $vmax != 1))}]\n"
"        set vscroll [$grid.vscroll get]\n"
"        set vmin    [lindex $vscroll 0]\n"
"        set vmax    [lindex $vscroll 1]\n"
"        set data(vsb,packed) [expr {$data(vsb,present) &&\n"
"                                    (!$data(vsb,auto) || ($vmin != 0 || $vmax != 1))}]\n"
"\n"
"        set ipad [Widget::cget $path -ipad]\n"
"        place configure $grid.vscroll \\\n"
"            -x [expr {(1-$data(vsb,west))*$ipad}]\n"
"        place configure $grid.hscroll \\\n"
"            -y [expr {(1-$data(hsb,north))*$ipad}]\n"
"\n"
"        grid configure $grid.hframe \\\n"
"            -column     [expr {$data(vsb,west)*$data(vsb,packed)}] \\\n"
"            -row        [expr {1-$data(hsb,north)}]  \\\n"
"            -columnspan [expr {2-$data(vsb,packed)}]\n"
"        grid configure $grid.vframe \\\n"
"            -column  [expr {1-$data(vsb,west)}] \\\n"
"            -row     [expr {$data(hsb,north)*$data(hsb,packed)}] \\\n"
"            -rowspan [expr {2-$data(hsb,packed)}]\n"
"        grid configure $grid.f \\\n"
"            -column     [expr {$data(vsb,west)*$data(vsb,packed)}] \\\n"
"            -row        [expr {$data(hsb,north)*$data(hsb,packed)}] \\\n"
"            -columnspan [expr {2-$data(vsb,packed)}] \\\n"
"            -rowspan    [expr {2-$data(hsb,packed)}]\n"
"        grid columnconfigure $grid $data(vsb,west)             -weight 1\n"
"        grid columnconfigure $grid [expr {1-$data(vsb,west)}]  -weight 0\n"
"        grid rowconfigure    $grid $data(hsb,north)            -weight 1\n"
"        grid rowconfigure    $grid [expr {1-$data(hsb,north)}] -weight 0\n"
"    }\n"
"    return $res\n"
"}\n"
"\n"
"\n"
"# -----------------------------------------------------------------------------\n"
"#  Command ScrolledWindow::cget\n"
"# -----------------------------------------------------------------------------\n"
"proc ScrolledWindow::cget { path option } {\n"
"    return [Widget::cget $path $option]\n"
"}\n"
"\n"
"\n"
"# -----------------------------------------------------------------------------\n"
"#  Command ScrolledWindow::_destroy\n"
"# -----------------------------------------------------------------------------\n"
"proc ScrolledWindow::_destroy { path } {\n"
"    upvar \\#0 ScrolledWindow::$path data\n"
"\n"
"    unset data\n"
"    Widget::destroy $path\n"
"    rename $path {}\n"
"}\n"
"\n"
"\n"
"# -----------------------------------------------------------------------------\n"
"#  Command ScrolledWindow::_set_hscroll\n"
"# -----------------------------------------------------------------------------\n"
"proc ScrolledWindow::_set_hscroll { path vmin vmax } {\n"
"    upvar \\#0 ScrolledWindow::$path data\n"
"\n"
"    if {$data(realized) && $data(hsb,present)} {\n"
"        set grid $path._grid\n"
"        if {$data(hsb,auto)} {\n"
"            if {$data(hsb,packed) && $vmin == 0 && $vmax == 1} {\n"
"                set data(hsb,packed) 0\n"
"                grid configure $grid.f $grid.vframe -row 0 -rowspan 2\n"
"            } elseif {!$data(hsb,packed) && ($vmin != 0 || $vmax != 1)} {\n"
"                set data(hsb,packed) 1\n"
"                grid configure $grid.f $grid.vframe -row $data(hsb,north) -rowspan 1\n"
"            }\n"
"        }\n"
"       update idletask\n"
"        $grid.hscroll set $vmin $vmax\n"
"    }\n"
"}\n"
"\n"
"\n"
"# -----------------------------------------------------------------------------\n"
"#  Command ScrolledWindow::_set_vscroll\n"
"# -----------------------------------------------------------------------------\n"
"proc ScrolledWindow::_set_vscroll { path vmin vmax } {\n"
"    upvar \\#0 ScrolledWindow::$path data\n"
"\n"
"    if {$data(realized) && $data(vsb,present)} {\n"
"        set grid $path._grid\n"
"        if {$data(vsb,auto)} {\n"
"            if {$data(vsb,packed) && $vmin == 0 && $vmax == 1} {\n"
"                set data(vsb,packed) 0\n"
"                grid configure $grid.f $grid.hframe -column 0 -columnspan 2\n"
"            } elseif {!$data(vsb,packed) && ($vmin != 0 || $vmax != 1) } {\n"
"                set data(vsb,packed) 1\n"
"                grid configure $grid.f $grid.hframe -column $data(vsb,west) -columnspan 1\n"
"            }\n"
"        }\n"
"       update idletask\n"
"        $grid.vscroll set $vmin $vmax\n"
"    }\n"
"}\n"
"\n"
"\n"
"proc ScrolledWindow::_setData {path scrollbar auto sides} {\n"
"    upvar \\#0 ScrolledWindow::$path data\n"
"\n"
"    set sb    [lsearch {none horizontal vertical both} $scrollbar]\n"
"    set auto  [lsearch {none horizontal vertical both} $auto]\n"
"    set north [string match *n* $sides]\n"
"    set west  [string match *w* $sides]\n"
"\n"
"    set data(hsb,present)  [expr {($sb & 1) != 0}]\n"
"    set data(hsb,auto)     [expr {($auto & 1) != 0}]\n"
"    set data(hsb,north)    $north\n"
"\n"
"    set data(vsb,present)  [expr {($sb & 2) != 0}]\n"
"    set data(vsb,auto)     [expr {($auto & 2) != 0}]\n"
"    set data(vsb,west)     $west\n"
"}\n"
"\n"
"\n"
"proc ScrolledWindow::_setSBSize {sb size args} {\n"
"    $sb configure -width $size\n"
"    eval place $sb $args\n"
"}\n"
"\n"
"\n"
"# -----------------------------------------------------------------------------\n"
"#  Command ScrolledWindow::_realize\n"
"# -----------------------------------------------------------------------------\n"
"proc ScrolledWindow::_realize { path } {\n"
"    upvar \\#0 ScrolledWindow::$path data\n"
"\n"
"    set grid $path._grid\n"
"    bind $grid <Configure> {}\n"
"    set data(realized) 1\n"
"    place $grid -anchor nw -x 0 -y 0 -relwidth 1.0 -relheight 1.0\n"
"}\n"
"\n";

const char* bwidgets4 =
"#  tree.tcl\n"
"#  This file is part of Unifix BWidget Toolkit\n"
"\n"
"namespace eval Tree {\n"
"    namespace eval Node {\n"
"        Widget::declare Tree::Node {\n"
"            {-text       String     \"\"      0}\n"
"            {-font       TkResource \"\"      0 listbox}\n"
"            {-image      TkResource \"\"      0 label}\n"
"            {-window     String     \"\"      0}\n"
"            {-fill       TkResource black   0 {listbox -foreground}}\n"
"            {-data       String     \"\"      0}\n"
"            {-open       Boolean    0       0}\n"
"           {-selectable Boolean    1       0}\n"
"            {-drawcross  Enum       auto    0 {auto allways never}}\n"
"        }\n"
"    }\n"
"\n"
"    Widget::tkinclude Tree canvas .c \\\n"
"           remove     {\n"
"       -insertwidth -insertbackground -insertborderwidth -insertofftime\n"
"       -insertontime -selectborderwidth -closeenough -confine -scrollregion \n"
"       -xscrollincrement -yscrollincrement -width -height\n"
"    } \\\n"
"           initialize {\n"
"       -relief sunken -borderwidth 2 -takefocus 1 \n"
"       -highlightthickness 1 -width 200\n"
"    }\n"
"\n"
"    Widget::declare Tree {\n"
"        {-deltax           Int 10 0 \"%d >= 0\"}\n"
"        {-deltay           Int 15 0 \"%d >= 0\"}\n"
"        {-padx             Int 20 0 \"%d >= 0\"}\n"
"        {-background       TkResource \"\" 0 listbox}\n"
"        {-selectbackground TkResource \"\" 0 listbox}\n"
"        {-selectforeground TkResource \"\" 0 listbox}\n"
"       {-selectcommand    String     \"\" 0}\n"
"        {-width            TkResource \"\" 0 listbox}\n"
"        {-height           TkResource \"\" 0 listbox}\n"
"        {-selectfill       Boolean 0  0}\n"
"        {-showlines        Boolean 1  0}\n"
"        {-linesfill        TkResource black  0 {listbox -foreground}}\n"
"        {-linestipple      TkResource \"\"     0 {label -bitmap}}\n"
"        {-redraw           Boolean 1  0}\n"
"        {-opencmd          String  \"\" 0}\n"
"        {-closecmd         String  \"\" 0}\n"
"        {-dropovermode     Flag    \"wpn\" 0 \"wpn\"}\n"
"        {-bg               Synonym -background}\n"
"    }\n"
"\n"
"    Widget::addmap Tree \"\" .c {-deltay -yscrollincrement}\n"
"\n"
"    # Trees on windows have a white (system window) background\n"
"    if { $::tcl_platform(platform) == \"windows\" } {\n"
"       option add *Tree.c.background SystemWindow widgetDefault\n"
"       option add *TreeNode.fill SystemWindowText widgetDefault\n"
"    }\n"
"\n"
"    bind TreeSentinalStart <Button-1> {\n"
"       if { $::Tree::sentinal(%W) } {\n"
"           set ::Tree::sentinal(%W) 0\n"
"           break\n"
"       }\n"
"    }\n"
"    \n"
"    bind TreeSentinalEnd <Button-1> {\n"
"       set ::Tree::sentinal(%W) 0\n"
"    }\n"
"    \n"
"    bind TreeFocus <Button-1> [list focus %W]\n"
"\n"
"    proc ::Tree { path args } { return [eval Tree::create $path $args] }\n"
"    proc use {} {}\n"
"\n"
"    variable _edit\n"
"}\n"
"\n"
"proc Tree::refocus {container component} {\n"
"    if { [string equal $container [::focus]] } {\n"
"       ::focus $component\n"
"    }\n"
"    return\n"
"}\n"
"\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::create\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::create { path args } {\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    Widget::init Tree $path $args\n"
"    set ::Tree::sentinal($path.c) 0\n"
"    \n"
"    set data(root)         {{}}\n"
"    set data(selnodes)     {}\n"
"    set data(upd,level)    0\n"
"    set data(upd,nodes)    {}\n"
"    set data(upd,afterid)  \"\"\n"
"    set data(dnd,scroll)   \"\"\n"
"    set data(dnd,afterid)  \"\"\n"
"    set data(dnd,selnodes) {}\n"
"    set data(dnd,node)     \"\"\n"
"\n"
"    frame $path -class Tree -bd 0 -highlightthickness 0 -relief flat \\\n"
"           -takefocus 0\n"
"    eval canvas $path.c [Widget::subcget $path .c] -xscrollincrement 8\n"
"    bindtags $path.c [list TreeSentinalStart TreeFocus $path.c Canvas \\\n"
"           [winfo toplevel $path] all TreeSentinalEnd]\n"
"    pack $path.c -expand yes -fill both\n"
"    $path.c bind cross <ButtonPress-1> [list Tree::_cross_event $path]\n"
"\n"
"    # Added by ericm@scriptics.com\n"
"    # These allow keyboard traversal of the tree\n"
"    bind $path.c <KeyPress-Up>    \"Tree::_keynav up $path\"\n"
"    bind $path.c <KeyPress-Down>  \"Tree::_keynav down $path\"\n"
"    bind $path.c <KeyPress-Right> \"Tree::_keynav right $path\"\n"
"    bind $path.c <KeyPress-Left>  \"Tree::_keynav left $path\"\n"
"    bind $path.c <KeyPress-space> \"+Tree::_keynav space $path\"\n"
"\n"
"    # These allow keyboard control of the scrolling\n"
"    bind $path.c <Control-KeyPress-Up>    \"$path.c yview scroll -1 units\"\n"
"    bind $path.c <Control-KeyPress-Down>  \"$path.c yview scroll  1 units\"\n"
"    bind $path.c <Control-KeyPress-Left>  \"$path.c xview scroll -1 units\"\n"
"    bind $path.c <Control-KeyPress-Right> \"$path.c xview scroll  1 units\"\n"
"    # ericm@scriptics.com\n"
"\n"
"    bind $path <Configure> \"Tree::_update_scrollregion $path\"\n"
"    bind $path <Destroy>   \"Tree::_destroy $path\"\n"
"    bind $path <FocusIn>   [list after idle {Tree::refocus %W %W.c}]\n"
"\n"
"    rename $path ::$path:cmd\n"
"    proc ::$path { cmd args } \"return \\[eval Tree::\\$cmd $path \\$args\\]\"\n"
"\n"
"    set w [Widget::cget $path -width]\n"
"    set h [Widget::cget $path -height]\n"
"    set dy [Widget::cget $path -deltay]\n"
"    $path.c configure -width [expr {$w*8}] -height [expr {$h*$dy}]\n"
"\n"
"    # ericm\n"
"    # Bind <Button-1> to select the clicked node -- no reason not to, right?\n"
"    Tree::bindText  $path <Button-1> \"$path selection set\"\n"
"    Tree::bindImage $path <Button-1> \"$path selection set\"\n"
"\n"
"\n"
"    # Add sentinal bindings for double-clicking on items, to handle the \n"
"    # gnarly Tk bug wherein:\n"
"    # ButtonClick\n"
"    # ButtonClick\n"
"    # On a canvas item translates into button click on the item, button click\n"
"    # on the canvas, double-button on the item, single button click on the\n"
"    # canvas (which can happen if the double-button on the item causes some\n"
"    # other event to be handled in between when the button clicks are examined\n"
"    # for the canvas)\n"
"    $path.c bind TreeItemSentinal <Double-Button-1> \\\n"
"           \"set ::Tree::sentinal($path.c) 1\"\n"
"    # ericm\n"
"\n"
"    return $path\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::configure\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::configure { path args } {\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    set res [Widget::configure $path $args]\n"
"\n"
"    set ch1 [expr {[Widget::hasChanged $path -deltax val] |\n"
"                   [Widget::hasChanged $path -deltay dy]  |\n"
"                   [Widget::hasChanged $path -padx val]   |\n"
"                   [Widget::hasChanged $path -showlines val]}]\n"
"\n"
"    set ch2 [expr {[Widget::hasChanged $path -selectbackground val] |\n"
"                   [Widget::hasChanged $path -selectforeground val]}]\n"
"\n"
"    if { [Widget::hasChanged $path -linesfill   fill] |\n"
"         [Widget::hasChanged $path -linestipple stipple] } {\n"
"        $path.c itemconfigure line  -fill $fill -stipple $stipple\n"
"        $path.c itemconfigure cross -foreground $fill\n"
"    }\n"
"\n"
"    if { $ch1 } {\n"
"        _redraw_idle $path 3\n"
"    } elseif { $ch2 } {\n"
"        _redraw_idle $path 1\n"
"    }\n"
"\n"
"    if { [Widget::hasChanged $path -height h] } {\n"
"        $path.c configure -height [expr {$h*$dy}]\n"
"    }\n"
"    if { [Widget::hasChanged $path -width w] } {\n"
"        $path.c configure -width [expr {$w*8}]\n"
"    }\n"
"\n"
"    if { [Widget::hasChanged $path -redraw bool] && $bool } {\n"
"        set upd $data(upd,level)\n"
"        set data(upd,level) 0\n"
"        _redraw_idle $path $upd\n"
"    }\n"
"\n"
"##    set force [Widget::hasChanged $path -dragendcmd dragend]\n"
"\n"
"    return $res\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::cget\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::cget { path option } {\n"
"    return [Widget::cget $path $option]\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::insert\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::insert { path index parent node args } {\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    if { [info exists data($node)] } {\n"
"        return -code error \"node \\\"$node\\\" already exists\"\n"
"    }\n"
"    if { ![info exists data($parent)] } {\n"
"        return -code error \"node \\\"$parent\\\" does not exist\"\n"
"    }\n"
"\n"
"    Widget::init Tree::Node $path.$node $args\n"
"    if { ![string compare $index \"end\"] } {\n"
"        lappend data($parent) $node\n"
"    } else {\n"
"        incr index\n"
"        set data($parent) [linsert $data($parent) $index $node]\n"
"    }\n"
"    set data($node) [list $parent]\n"
"\n"
"    if { ![string compare $parent \"root\"] } {\n"
"        _redraw_idle $path 3\n"
"    } elseif { [visible $path $parent] } {\n"
"        # parent is visible...\n"
"        if { [Widget::getMegawidgetOption $path.$parent -open] } {\n"
"            # ...and opened -> redraw whole\n"
"            _redraw_idle $path 3\n"
"        } else {\n"
"            # ...and closed -> redraw cross\n"
"            lappend data(upd,nodes) $parent 8\n"
"            _redraw_idle $path 2\n"
"        }\n"
"    }\n"
"    return $node\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::itemconfigure\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::itemconfigure { path node args } {\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    if { ![string compare $node \"root\"] || ![info exists data($node)] } {\n"
"        return -code error \"node \\\"$node\\\" does not exist\"\n"
"    }\n"
"\n"
"    set result [Widget::configure $path.$node $args]\n"
"    if { [visible $path $node] } {\n"
"        set lopt   {}\n"
"        set flag   0\n"
"        foreach opt {-window -image -drawcross -font -text -fill} {\n"
"            set flag [expr {$flag << 1}]\n"
"            if { [Widget::hasChanged $path.$node $opt val] } {\n"
"                set flag [expr {$flag | 1}]\n"
"            }\n"
"        }\n"
"\n"
"        if { [Widget::hasChanged $path.$node -open val] } {\n"
"            if {[llength $data($node)] > 1} {\n"
"                # node have subnodes - full redraw\n"
"                _redraw_idle $path 3\n"
"            } else {\n"
"                # force a redraw of the plus/minus sign\n"
"                set flag [expr {$flag | 8}]\n"
"            }\n"
"        } \n"
"       if { $data(upd,level) < 3 && $flag } {\n"
"            if { [set idx [lsearch $data(upd,nodes) $node]] == -1 } {\n"
"                lappend data(upd,nodes) $node $flag\n"
"            } else {\n"
"                incr idx\n"
"                set flag [expr {[lindex $data(upd,nodes) $idx] | $flag}]\n"
"                set data(upd,nodes) [lreplace $data(upd,nodes) $idx $idx $flag]\n"
"            }\n"
"            _redraw_idle $path 2\n"
"        }\n"
"    }\n"
"    return $result\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::itemcget\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::itemcget { path node option } {\n"
"    # Instead of upvar'ing $path as data for this test, just directly refer to\n"
"    # it, as that is faster.\n"
"    if { ![string compare $node \"root\"] || \\\n"
"           ![info exists ::Tree::${path}($node)] } {\n"
"        return -code error \"node \\\"$node\\\" does not exist\"\n"
"    }\n"
"\n"
"    return [Widget::cget $path.$node $option]\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::bindText\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::bindText { path event script } {\n"
"    if { $script != \"\" } {\n"
"        $path.c bind \"node\" $event \\\n"
"            \"$script \\[Tree::_get_node_name $path current 2\\]\"\n"
"    } else {\n"
"        $path.c bind \"node\" $event {}\n"
"    }\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::bindImage\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::bindImage { path event script } {\n"
"    if { $script != \"\" } {\n"
"        $path.c bind \"img\" $event \\\n"
"               \"$script \\[Tree::_get_node_name $path current 2\\]\"\n"
"    } else {\n"
"        $path.c bind \"img\" $event {}\n"
"    }\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::delete\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::delete { path args } {\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    foreach lnodes $args {\n"
"        foreach node $lnodes {\n"
"            if { [string compare $node \"root\"] && [info exists data($node)] } {\n"
"                set parent [lindex $data($node) 0]\n"
"                set idx    [lsearch $data($parent) $node]\n"
"                set data($parent) [lreplace $data($parent) $idx $idx]\n"
"                _subdelete $path [list $node]\n"
"            }\n"
"        }\n"
"    }\n"
"\n"
"    set sel $data(selnodes)\n"
"    set data(selnodes) {}\n"
"    eval selection $path set $sel\n"
"    _redraw_idle $path 3\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::move\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::move { path parent node index } {\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    if { ![string compare $node \"root\"] || ![info exists data($node)] } {\n"
"        return -code error \"node \\\"$node\\\" does not exist\"\n"
"    }\n"
"    if { ![info exists data($parent)] } {\n"
"        return -code error \"node \\\"$parent\\\" does not exist\"\n"
"    }\n"
"    set p $parent\n"
"    while { [string compare $p \"root\"] } {\n"
"        if { ![string compare $p $node] } {\n"
"            return -code error \"node \\\"$parent\\\" is a descendant of \\\"$node\\\"\"\n"
"        }\n"
"        set p [parent $path $p]\n"
"    }\n"
"\n"
"    set oldp        [lindex $data($node) 0]\n"
"    set idx         [lsearch $data($oldp) $node]\n"
"    set data($oldp) [lreplace $data($oldp) $idx $idx]\n"
"    set data($node) [concat [list $parent] [lrange $data($node) 1 end]]\n"
"    if { ![string compare $index \"end\"] } {\n"
"        lappend data($parent) $node\n"
"    } else {\n"
"        incr index\n"
"        set data($parent) [linsert $data($parent) $index $node]\n"
"    }\n"
"    if { (![string compare $oldp \"root\"] ||\n"
"          ([visible $path $oldp] && [Widget::getoption $path.$oldp   -open])) ||\n"
"         (![string compare $parent \"root\"] ||\n"
"          ([visible $path $parent] && [Widget::getoption $path.$parent -open])) } {\n"
"        _redraw_idle $path 3\n"
"    }\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::reorder\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::reorder { path node neworder } {\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    if { ![info exists data($node)] } {\n"
"        return -code error \"node \\\"$node\\\" does not exist\"\n"
"    }\n"
"    set children [lrange $data($node) 1 end]\n"
"    if { [llength $children] } {\n"
"        set children [BWidget::lreorder $children $neworder]\n"
"        set data($node) [linsert $children 0 [lindex $data($node) 0]]\n"
"        if { [visible $path $node] && [Widget::getoption $path.$node -open] } {\n"
"            _redraw_idle $path 3\n"
"        }\n"
"    }\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::selection\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::selection { path cmd args } {\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    switch -- $cmd {\n"
"        set {\n"
"            set data(selnodes) {}\n"
"            foreach node $args {\n"
"                if { [info exists data($node)] } {\n"
"                   if { [Widget::getoption $path.$node -selectable] } {\n"
"                       if { [lsearch $data(selnodes) $node] == -1 } {\n"
"                           lappend data(selnodes) $node\n"
"                       }\n"
"                   }\n"
"                }\n"
"            }\n"
"\n"
"           if { ![string equal $data(selnodes) \"\"] } {\n"
"               set selectcmd [Widget::getoption $path -selectcommand]\n"
"               if { ![string equal $selectcmd \"\"] } {\n"
"                   lappend selectcmd $path\n"
"                   lappend selectcmd $data(selnodes)\n"
"                   uplevel \\#0 $selectcmd\n"
"               }\n"
"           }\n"
"        }\n"
"        add {\n"
"            foreach node $args {\n"
"                if { [info exists data($node)] } {\n"
"                   if { [Widget::getoption $path.$node -selectable] } {\n"
"                       if { [lsearch $data(selnodes) $node] == -1 } {\n"
"                           lappend data(selnodes) $node\n"
"                       }\n"
"                   }\n"
"                }\n"
"            }\n"
"        }\n"
"       range {\n"
"           # Here's our algorithm:\n"
"           #   make a list of all nodes, then take the range from node1\n"
"           #       to node2 and select those nodes\n"
"           # This works because of how this widget handles redraws:\n"
"           # the tree is always completely redraw, always from top to bottom.\n"
"           # So the list of visible nodes *is* the list of nodes, and we can\n"
"           # use that to decide which nodes to select.\n"
"           foreach {node1 node2} $args break\n"
"           if { [info exists data($node1)] && [info exists data($node2)] } {\n"
"               set nodes {}\n"
"               foreach nodeItem [$path.c find withtag node] {\n"
"                   set node [Tree::_get_node_name $path $nodeItem 2]\n"
"                   if { [Widget::getoption $path.$node -selectable] } {\n"
"                       lappend nodes $node\n"
"                   }\n"
"               }\n"
"               # surles: Set the root string to the first element on the list.\n"
"               if {$node1 == \"root\"} {\n"
"                   set node1 [lindex $nodes 0]\n"
"               }\n"
"               if {$node2 == \"root\"} {\n"
"                   set node2 [lindex $nodes 0]\n"
"               }\n"
"\n"
"               # Find the first visible ancestor of node1, starting with node1\n"
"               while {[set index1 [lsearch -exact $nodes $node1]] == -1} {\n"
"                   set node1 [lindex $data($node1) 0]\n"
"               }\n"
"               # Find the first visible ancestor of node2, starting with node2\n"
"               while {[set index2 [lsearch -exact $nodes $node2]] == -1} {\n"
"                   set node2 [lindex $data($node2) 0]\n"
"               }\n"
"               # If the nodes were given in backwards order, flip the\n"
"               # indices now\n"
"               if { $index2 < $index1 } {\n"
"                   incr index1 $index2\n"
"                   set index2 [expr {$index1 - $index2}]\n"
"                   set index1 [expr {$index1 - $index2}]\n"
"               }\n"
"               set data(selnodes) [lrange $nodes $index1 $index2]\n"
"           }\n"
"       }\n"
"        remove {\n"
"            foreach node $args {\n"
"                if { [set idx [lsearch $data(selnodes) $node]] != -1 } {\n"
"                    set data(selnodes) [lreplace $data(selnodes) $idx $idx]\n"
"                }\n"
"            }\n"
"        }\n"
"        clear {\n"
"            set data(selnodes) {}\n"
"        }\n"
"        get {\n"
"            return $data(selnodes)\n"
"        }\n"
"        includes {\n"
"            return [expr {[lsearch $data(selnodes) $args] != -1}]\n"
"        }\n"
"        default {\n"
"            return\n"
"        }\n"
"    }\n"
"    _redraw_idle $path 1\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::exists\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::exists { path node } {\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    return [info exists data($node)]\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::visible\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::visible { path node } {\n"
"    set idn [$path.c find withtag n:$node]\n"
"    return [llength $idn]\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::parent\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::parent { path node } {\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    if { ![info exists data($node)] } {\n"
"        return -code error \"node \\\"$node\\\" does not exist\"\n"
"    }\n"
"    return [lindex $data($node) 0]\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::index\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::index { path node } {\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    if { ![string compare $node \"root\"] || ![info exists data($node)] } {\n"
"        return -code error \"node \\\"$node\\\" does not exist\"\n"
"    }\n"
"    set parent [lindex $data($node) 0]\n"
"    return [expr {[lsearch $data($parent) $node] - 1}]\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Tree::find\n"
"#     Returns the node given a position.\n"
"#  findInfo     @x,y ?confine?\n"
"#               lineNumber\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::find {path findInfo {confine \"\"}} {\n"
"    if {[regexp -- {^@([0-9]+),([0-9]+)$} $findInfo match x y]} {\n"
"        set x [$path.c canvasx $x]\n"
"        set y [$path.c canvasy $y]\n"
"    } elseif {[regexp -- {^[0-9]+$} $findInfo lineNumber]} {\n"
"        set dy [Widget::getoption $path -deltay]\n"
"        set y  [expr {$dy*($lineNumber+0.5)}]\n"
"        set confine \"\"\n"
"    } else {\n"
"        return -code error \"invalid find spec \\\"$findInfo\\\"\"\n"
"    }\n"
"\n"
"    set found  0\n"
"    set region [$path.c bbox all]\n"
"    if {[llength $region]} {\n"
"        set xi [lindex $region 0]\n"
"        set xs [lindex $region 2]\n"
"        foreach id [$path.c find overlapping $xi $y $xs $y] {\n"
"            set ltags [$path.c gettags $id]\n"
"            set item  [lindex $ltags 1]\n"
"            if { ![string compare $item \"node\"] ||\n"
"                 ![string compare $item \"img\"]  ||\n"
"                 ![string compare $item \"win\"] } {\n"
"                # item is the label or image/window of the node\n"
"                set node  [Tree::_get_node_name $path $id 2]\n"
"                set found 1\n"
"                break\n"
"            }\n"
"        }\n"
"    }\n"
"\n"
"    if {$found} {\n"
"        if {[string compare $confine \"confine\"] == 0} {\n"
"            # test if x stand inside node bbox\n"
"            set xi [expr {[lindex [$path.c coords n:$node] 0]-[Widget::cget $path -padx]}]\n"
"            set xs [lindex [$path.c bbox n:$node] 2]\n"
"            if {$x >= $xi && $x <= $xs} {\n"
"                return $node\n"
"            }\n"
"        } else {\n"
"            return $node\n"
"        }\n"
"    }\n"
"    return \"\"\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::line\n"
"#     Returns the line where is drawn a node.\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::line {path node} {\n"
"    set item [$path.c find withtag n:$node]\n"
"    if {[string length $item]} {\n"
"        set dy   [Widget::getoption $path -deltay]\n"
"        set y    [lindex [$path.c coords $item] 1]\n"
"        set line [expr {int($y/$dy)}]\n"
"    } else {\n"
"        set line -1\n"
"    }\n"
"    return $line\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::nodes\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::nodes { path node {first \"\"} {last \"\"} } {\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    if { ![info exists data($node)] } {\n"
"        return -code error \"node \\\"$node\\\" does not exist\"\n"
"    }\n"
"\n"
"    if { ![string length $first] } {\n"
"        return [lrange $data($node) 1 end]\n"
"    }\n"
"\n"
"    if { ![string length $last] } {\n"
"        return [lindex [lrange $data($node) 1 end] $first]\n"
"    } else {\n"
"        return [lrange [lrange $data($node) 1 end] $first $last]\n"
"    }\n"
"}\n"
"\n"
"\n"
"# Tree::visiblenodes --\n"
"#\n"
"#      Retrieve a list of all the nodes in a tree.\n"
"#\n"
"# Arguments:\n"
"#      path    tree to retrieve nodes for.\n"
"#\n"
"# Results:\n"
"#      nodes   list of nodes in the tree.\n"
"\n"
"proc Tree::visiblenodes { path } {\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    # Root is always open (?), so all of its children automatically get added\n"
"    # to the result, and to the stack.\n"
"    set st [lrange $data(root) 1 end]\n"
"    set result $st\n"
"\n"
"    while { [llength $st] } { \n"
"       set node [lindex $st end]\n"
"       set st [lreplace $st end end]\n"
"       # Danger, danger!  Using getMegawidgetOption is fragile, but much\n"
"       # much faster than going through cget.\n"
"       if { [Widget::getMegawidgetOption $path.$node -open] } {\n"
"           set nodes [lrange $data($node) 1 end]\n"
"           set result [concat $result $nodes]\n"
"           set st [concat $st $nodes]\n"
"       }\n"
"    }\n"
"    return $result\n"
"}\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::see\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::see { path node } {\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    if { [Widget::getoption $path -redraw] && $data(upd,afterid) != \"\" } {\n"
"        after cancel $data(upd,afterid)\n"
"        _redraw_tree $path\n"
"    }\n"
"    set idn [$path.c find withtag n:$node]\n"
"    if { $idn != \"\" } {\n"
"        Tree::_see $path $idn right\n"
"        Tree::_see $path $idn left\n"
"    }\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::opentree\n"
"# ------------------------------------------------------------------------------\n"
"# JDC: added option recursive\n"
"proc Tree::opentree { path node {recursive 1} } {\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    if { ![string compare $node \"root\"] || ![info exists data($node)] } {\n"
"        return -code error \"node \\\"$node\\\" does not exist\"\n"
"    }\n"
"\n"
"    _recexpand $path $node 1 $recursive [Widget::getoption $path -opencmd]\n"
"    _redraw_idle $path 3\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::closetree\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::closetree { path node {recursive 1} } {\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    if { ![string compare $node \"root\"] || ![info exists data($node)] } {\n"
"        return -code error \"node \\\"$node\\\" does not exist\"\n"
"    }\n"
"\n"
"    _recexpand $path $node 0 $recursive [Widget::getoption $path -closecmd]\n"
"    _redraw_idle $path 3\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::edit\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::edit { path node text {verifycmd \"\"} {clickres 0} {select 1}} {\n"
"    variable _edit\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    if { [Widget::getoption $path -redraw] && $data(upd,afterid) != \"\" } {\n"
"        after cancel $data(upd,afterid)\n"
"        _redraw_tree $path\n"
"    }\n"
"    set idn [$path.c find withtag n:$node]\n"
"    if { $idn != \"\" } {\n"
"        Tree::_see $path $idn right\n"
"        Tree::_see $path $idn left\n"
"\n"
"        set oldfg  [$path.c itemcget $idn -fill]\n"
"        set sbg    [Widget::getoption $path -selectbackground]\n"
"        set coords [$path.c coords $idn]\n"
"        set x      [lindex $coords 0]\n"
"        set y      [lindex $coords 1]\n"
"        set bd     [expr {[$path.c cget -borderwidth]+[$path.c cget -highlightthickness]}]\n"
"        set w      [expr {[winfo width $path] - 2*$bd}]\n"
"        set wmax   [expr {[$path.c canvasx $w]-$x}]\n"
"\n"
"        set _edit(text) $text\n"
"        set _edit(wait) 0\n"
"\n"
"        $path.c itemconfigure $idn    -fill [Widget::getoption $path -background]\n"
"        $path.c itemconfigure s:$node -fill {} -outline {}\n"
"\n"
"        set frame  [frame $path.edit \\\n"
"                        -relief flat -borderwidth 0 -highlightthickness 0 \\\n"
"                        -background [Widget::getoption $path -background]]\n"
"        set ent    [entry $frame.edit \\\n"
"                        -width              0     \\\n"
"                        -relief             solid \\\n"
"                        -borderwidth        1     \\\n"
"                        -highlightthickness 0     \\\n"
"                        -foreground         [Widget::getoption $path.$node -fill] \\\n"
"                        -background         [Widget::getoption $path -background] \\\n"
"                        -selectforeground   [Widget::getoption $path -selectforeground] \\\n"
"                        -selectbackground   $sbg  \\\n"
"                        -font               [Widget::getoption $path.$node -font] \\\n"
"                        -textvariable       Tree::_edit(text)]\n"
"        pack $ent -ipadx 8 -anchor w\n"
"\n"
"        set idw [$path.c create window $x $y -window $frame -anchor w]\n"
"        trace variable Tree::_edit(text) w \"Tree::_update_edit_size $path $ent $idw $wmax\"\n"
"        tkwait visibility $ent\n"
"        grab  $frame\n"
"        BWidget::focus set $ent\n"
"\n"
"        _update_edit_size $path $ent $idw $wmax\n"
"        update\n"
"        if { $select } {\n"
"            $ent selection range 0 end\n"
"            $ent icursor end\n"
"            $ent xview end\n"
"        }\n"
"\n"
"        bindtags $ent [list $ent Entry]\n"
"        bind $ent <Escape> {set Tree::_edit(wait) 0}\n"
"        bind $ent <Return> {set Tree::_edit(wait) 1}\n"
"        if { $clickres == 0 || $clickres == 1 } {\n"
"            bind $frame <Button>  \"set Tree::_edit(wait) $clickres\"\n"
"        }\n"
"\n"
"        set ok 0\n"
"        while { !$ok } {\n"
"            tkwait variable Tree::_edit(wait)\n"
"            if { !$_edit(wait) || $verifycmd == \"\" ||\n"
"                 [uplevel \\#0 $verifycmd [list $_edit(text)]] } {\n"
"                set ok 1\n"
"            }\n"
"        }\n"
"\n"
"        trace vdelete Tree::_edit(text) w \"Tree::_update_edit_size $path $ent $idw $wmax\"\n"
"        grab release $frame\n"
"        BWidget::focus release $ent\n"
"        destroy $frame\n"
"        $path.c delete $idw\n"
"        $path.c itemconfigure $idn    -fill $oldfg\n"
"        $path.c itemconfigure s:$node -fill $sbg -outline $sbg\n"
"\n"
"        if { $_edit(wait) } {\n"
"            return $_edit(text)\n"
"        }\n"
"    }\n"
"    return \"\"\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::xview\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::xview { path args } {\n"
"    return [eval $path.c xview $args]\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::yview\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::yview { path args } {\n"
"    return [eval $path.c yview $args]\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::_update_edit_size\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::_update_edit_size { path entry idw wmax args } {\n"
"    set entw [winfo reqwidth $entry]\n"
"    if { $entw+8 >= $wmax } {\n"
"        $path.c itemconfigure $idw -width $wmax\n"
"    } else {\n"
"        $path.c itemconfigure $idw -width 0\n"
"    }\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::_destroy\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::_destroy { path } {\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    if { $data(upd,afterid) != \"\" } {\n"
"        after cancel $data(upd,afterid)\n"
"    }\n"
"    if { $data(dnd,afterid) != \"\" } {\n"
"        after cancel $data(dnd,afterid)\n"
"    }\n"
"    _subdelete $path [lrange $data(root) 1 end]\n"
"    Widget::destroy $path\n"
"    unset data\n"
"    rename $path {}\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::_see\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::_see { path idn side } {\n"
"    set bbox [$path.c bbox $idn]\n"
"    set scrl [$path.c cget -scrollregion]\n"
"\n"
"    set ymax [lindex $scrl 3]\n"
"    set dy   [$path.c cget -yscrollincrement]\n"
"    set yv   [$path yview]\n"
"    set yv0  [expr {round([lindex $yv 0]*$ymax/$dy)}]\n"
"    set yv1  [expr {round([lindex $yv 1]*$ymax/$dy)}]\n"
"    set y    [expr {int([lindex [$path.c coords $idn] 1]/$dy)}]\n"
"    if { $y < $yv0 } {\n"
"        $path.c yview scroll [expr {$y-$yv0}] units\n"
"    } elseif { $y >= $yv1 } {\n"
"        $path.c yview scroll [expr {$y-$yv1+1}] units\n"
"    }\n"
"\n"
"    set xmax [lindex $scrl 2]\n"
"    set dx   [$path.c cget -xscrollincrement]\n"
"    set xv   [$path xview]\n"
"    if { ![string compare $side \"right\"] } {\n"
"        set xv1 [expr {round([lindex $xv 1]*$xmax/$dx)}]\n"
"        set x1  [expr {int([lindex $bbox 2]/$dx)}]\n"
"        if { $x1 >= $xv1 } {\n"
"            $path.c xview scroll [expr {$x1-$xv1+1}] units\n"
"        }\n"
"    } else {\n"
"        set xv0 [expr {round([lindex $xv 0]*$xmax/$dx)}]\n"
"        set x0  [expr {int([lindex $bbox 0]/$dx)}]\n"
"        if { $x0 < $xv0 } {\n"
"            $path.c xview scroll [expr {$x0-$xv0}] units\n"
"        }\n"
"    }\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::_recexpand\n"
"# ------------------------------------------------------------------------------\n"
"# JDC : added option recursive\n"
"proc Tree::_recexpand { path node expand recursive cmd } {\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    if { [Widget::getoption $path.$node -open] != $expand } {\n"
"        Widget::setoption $path.$node -open $expand\n"
"        if { $cmd != \"\" } {\n"
"            uplevel \\#0 $cmd $node\n"
"        }\n"
"    }\n"
"\n"
"    if { $recursive } {\n"
"       foreach subnode [lrange $data($node) 1 end] {\n"
"           _recexpand $path $subnode $expand $recursive $cmd\n"
"       }\n"
"    }\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::_subdelete\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::_subdelete { path lnodes } {\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    while { [llength $lnodes] } {\n"
"        set lsubnodes [list]\n"
"        foreach node $lnodes {\n"
"            foreach subnode [lrange $data($node) 1 end] {\n"
"                lappend lsubnodes $subnode\n"
"            }\n"
"            unset data($node)\n"
"            if { [set win [Widget::getoption $path.$node -window]] != \"\" } {\n"
"                destroy $win\n"
"            }\n"
"            Widget::destroy $path.$node\n"
"        }\n"
"        set lnodes $lsubnodes\n"
"    }\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::_update_scrollregion\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::_update_scrollregion { path } {\n"
"    set bd   [expr {2*([$path.c cget -borderwidth]+[$path.c cget -highlightthickness])}]\n"
"    set w    [expr {[winfo width  $path] - $bd}]\n"
"    set h    [expr {[winfo height $path] - $bd}]\n"
"    set xinc [$path.c cget -xscrollincrement]\n"
"    set yinc [$path.c cget -yscrollincrement]\n"
"    set bbox [$path.c bbox node]\n"
"    if { [llength $bbox] } {\n"
"        set xs [lindex $bbox 2]\n"
"        set ys [lindex $bbox 3]\n"
"\n"
"        if { $w < $xs } {\n"
"            set w [expr {int($xs)}]\n"
"            if { [set r [expr {$w % $xinc}]] } {\n"
"                set w [expr {$w+$xinc-$r}]\n"
"            }\n"
"        }\n"
"        if { $h < $ys } {\n"
"            set h [expr {int($ys)}]\n"
"            if { [set r [expr {$h % $yinc}]] } {\n"
"                set h [expr {$h+$yinc-$r}]\n"
"            }\n"
"        }\n"
"    }\n"
"\n"
"    $path.c configure -scrollregion [list 0 0 $w $h]\n"
"\n"
"    if {[Widget::getoption $path -selectfill]} {\n"
"        _redraw_selection $path\n"
"    }\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::_cross_event\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::_cross_event { path } {\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    set node [Tree::_get_node_name $path current 1]\n"
"    if { [Widget::getoption $path.$node -open] } {\n"
"        Tree::itemconfigure $path $node -open 0\n"
"        if { [set cmd [Widget::getoption $path -closecmd]] != \"\" } {\n"
"            uplevel \\#0 $cmd $node\n"
"        }\n"
"    } else {\n"
"        Tree::itemconfigure $path $node -open 1\n"
"        if { [set cmd [Widget::getoption $path -opencmd]] != \"\" } {\n"
"            uplevel \\#0 $cmd $node\n"
"        }\n"
"    }\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::_draw_node\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::_draw_node { path node x0 y0 deltax deltay padx showlines } {\n"
"    global   env\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    set x1 [expr {$x0+$deltax+5}]\n"
"    set y1 $y0\n"
"    if { $showlines } {\n"
"        $path.c create line $x0 $y0 $x1 $y0 \\\n"
"            -fill    [Widget::getoption $path -linesfill]   \\\n"
"            -stipple [Widget::getoption $path -linestipple] \\\n"
"            -tags    line\n"
"    }\n"
"    $path.c create text [expr {$x1+$padx}] $y0 \\\n"
"        -text   [Widget::getoption $path.$node -text] \\\n"
"        -fill   [Widget::getoption $path.$node -fill] \\\n"
"        -font   [Widget::getoption $path.$node -font] \\\n"
"        -anchor w \\\n"
"        -tags   \"TreeItemSentinal node n:$node\"\n"
"    set len [expr {[llength $data($node)] > 1}]\n"
"    set dc  [Widget::getoption $path.$node -drawcross]\n"
"    set exp [Widget::getoption $path.$node -open]\n"
"\n"
"    if { $len && $exp } {\n"
"        set y1 [_draw_subnodes $path [lrange $data($node) 1 end] \\\n"
"                    [expr {$x0+$deltax}] $y0 $deltax $deltay $padx $showlines]\n"
"    }\n"
"\n"
"    if { [string compare $dc \"never\"] && ($len || ![string compare $dc \"allways\"]) } {\n"
"        if { $exp } {\n"
"            set bmp bwminus\n"
"        } else {\n"
"            set bmp bwplus\n"
"        }\n"
"$path.c create rectangle [expr $x0-4] [expr $y0-4] [expr $x0+4] [expr $y0+4] -fill black\n"
"        $path.c create image $x0 $y0 \\\n"
"            -image     $bmp \\\n"
"            -tags       \"cross c:$node\" -anchor c\n"
"    }\n"
"\n"
"    if { [set win [Widget::getoption $path.$node -window]] != \"\" } {\n"
"        $path.c create window $x1 $y0 -window $win -anchor w \\\n"
"               -tags \"TreeItemSentinal win i:$node\"\n"
"    } elseif { [set img [Widget::getoption $path.$node -image]] != \"\" } {\n"
"        $path.c create image $x1 $y0 -image $img -anchor w \\\n"
"               -tags \"TreeItemSentinal img i:$node\"\n"
"    }\n"
"    return $y1\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::_draw_subnodes\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::_draw_subnodes { path nodes x0 y0 deltax deltay padx showlines } {\n"
"    set y1 $y0\n"
"    foreach node $nodes {\n"
"        set yp $y1\n"
"        set y1 [_draw_node $path $node $x0 [expr {$y1+$deltay}] $deltax $deltay $padx $showlines]\n"
"    }\n"
"    if { $showlines && [llength $nodes] } {\n"
"        set id [$path.c create line $x0 $y0 $x0 [expr {$yp+$deltay}] \\\n"
"                    -fill    [Widget::getoption $path -linesfill]   \\\n"
"                    -stipple [Widget::getoption $path -linestipple] \\\n"
"                    -tags    line]\n"
"\n"
"        $path.c lower $id\n"
"    }\n"
"    return $y1\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::_update_nodes\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::_update_nodes { path } {\n"
"    global   env\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    set deltax [Widget::getoption $path -deltax]\n"
"    set padx   [Widget::getoption $path -padx]\n"
"    foreach {node flag} $data(upd,nodes) {\n"
"        set idn [$path.c find withtag \"n:$node\"]\n"
"        if { $idn == \"\" } {\n"
"            continue\n"
"        }\n"
"        set c  [$path.c coords $idn]\n"
"        set x0 [expr {[lindex $c 0]-$padx}]\n"
"        set y0 [lindex $c 1]\n"
"        if { $flag & 48 } {\n"
"            # -window or -image modified\n"
"            set win  [Widget::getoption $path.$node -window]\n"
"            set img  [Widget::getoption $path.$node -image]\n"
"            set idi  [$path.c find withtag i:$node]\n"
"            set type [lindex [$path.c gettags $idi] 1]\n"
"            if { [string length $win] } {\n"
"                if { ![string compare $type \"win\"] } {\n"
"                    $path.c itemconfigure $idi -window $win\n"
"                } else {\n"
"                    $path.c delete $idi\n"
"                    $path.c create window $x0 $y0 -window $win -anchor w \\\n"
"                           -tags \"TreeItemSentinal win i:$node\"\n"
"                }\n"
"            } elseif { [string length $img] } {\n"
"                if { ![string compare $type \"img\"] } {\n"
"                    $path.c itemconfigure $idi -image $img\n"
"                } else {\n"
"                    $path.c delete $idi\n"
"                    $path.c create image $x0 $y0 -image $img -anchor w \\\n"
"                           -tags \"TreeItemSentinal img i:$node\"\n"
"                }\n"
"            } else {\n"
"                $path.c delete $idi\n"
"            }\n"
"        }\n"
"\n"
"        if { $flag & 8 } {\n"
"            # -drawcross modified\n"
"            set len [expr {[llength $data($node)] > 1}]\n"
"            set dc  [Widget::getoption $path.$node -drawcross]\n"
"            set exp [Widget::getoption $path.$node -open]\n"
"            set idc [$path.c find withtag c:$node]\n"
"\n"
"            if { [string compare $dc \"never\"] && ($len || ![string compare $dc \"allways\"]) } {\n"
"                if { $exp } {\n"
"                    set bmp bwminus\n"
"                } else {\n"
"                    set bmp bwplus\n"
"                }\n"
"                if { $idc == \"\" } {\n"
"                    $path.c create image [expr {$x0-$deltax-5}] $y0 \\\n"
"                        -image     $bmp \\\n"
"                        -tags       \"cross c:$node\" -anchor c\n"
"                } else {\n"
"                    $path.c itemconfigure $idc -image $bmp\n"
"                }\n"
"            } else {\n"
"                $path.c delete $idc\n"
"            }\n"
"        }\n"
"\n"
"        if { $flag & 7 } {\n"
"            # -font, -text or -fill modified\n"
"            $path.c itemconfigure $idn \\\n"
"                -text [Widget::getoption $path.$node -text] \\\n"
"                -fill [Widget::getoption $path.$node -fill] \\\n"
"                -font [Widget::getoption $path.$node -font]\n"
"        }\n"
"    }\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::_draw_tree\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::_draw_tree { path } {\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    $path.c delete all\n"
"    set cursor [$path.c cget -cursor]\n"
"    $path.c configure -cursor watch\n"
"    _draw_subnodes $path [lrange $data(root) 1 end] 8 \\\n"
"        [expr {-[Widget::getoption $path -deltay]/2}] \\\n"
"        [Widget::getoption $path -deltax] \\\n"
"        [Widget::getoption $path -deltay] \\\n"
"        [Widget::getoption $path -padx]   \\\n"
"        [Widget::getoption $path -showlines]\n"
"    $path.c configure -cursor $cursor\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::_redraw_tree\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::_redraw_tree { path } {\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    if { [Widget::getoption $path -redraw] } {\n"
"        if { $data(upd,level) == 2 } {\n"
"            _update_nodes $path\n"
"        } elseif { $data(upd,level) == 3 } {\n"
"            _draw_tree $path\n"
"        }\n"
"        _redraw_selection $path\n"
"        _update_scrollregion $path\n"
"        set data(upd,nodes)   {}\n"
"        set data(upd,level)   0\n"
"        set data(upd,afterid) \"\"\n"
"    }\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::_redraw_selection\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::_redraw_selection { path } {\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    set selbg [Widget::getoption $path -selectbackground]\n"
"    set selfg [Widget::getoption $path -selectforeground]\n"
"    set fill  [Widget::getoption $path -selectfill]\n"
"    if {$fill} {\n"
"        set scroll [$path.c cget -scrollregion]\n"
"        if {[llength $scroll]} {\n"
"            set xmax [expr {[lindex $scroll 2]-1}]\n"
"        } else {\n"
"            set xmax [winfo width $path]\n"
"        }\n"
"    }\n"
"    foreach id [$path.c find withtag sel] {\n"
"        set node [Tree::_get_node_name $path $id 1]\n"
"        $path.c itemconfigure \"n:$node\" -fill [Widget::getoption $path.$node -fill]\n"
"    }\n"
"    $path.c delete sel\n"
"    foreach node $data(selnodes) {\n"
"        set bbox [$path.c bbox \"n:$node\"]\n"
"        if { [llength $bbox] } {\n"
"            if {$fill} {\n"
"                set bbox [list 0 [lindex $bbox 1] $xmax [lindex $bbox 3]]\n"
"            }\n"
"            set id [eval $path.c create rectangle $bbox \\\n"
"                   -fill $selbg -outline $selbg -tags [list \"sel s:$node\"]]\n"
"            $path.c itemconfigure \"n:$node\" -fill $selfg\n"
"            $path.c lower $id\n"
"        }\n"
"    }\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::_redraw_idle\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::_redraw_idle { path level } {\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    if { [Widget::getoption $path -redraw] && $data(upd,afterid) == \"\" } {\n"
"        set data(upd,afterid) [after idle Tree::_redraw_tree $path]\n"
"    }\n"
"    if { $level > $data(upd,level) } {\n"
"        set data(upd,level) $level\n"
"    }\n"
"    return \"\"\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::_init_drag_cmd\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::_init_drag_cmd { path X Y top } {\n"
"    set path [winfo parent $path]\n"
"    set ltags [$path.c gettags current]\n"
"    set item  [lindex $ltags 1]\n"
"    if { ![string compare $item \"node\"] ||\n"
"         ![string compare $item \"img\"]  ||\n"
"         ![string compare $item \"win\"] } {\n"
"        set node [Tree::_get_node_name $path current 2]\n"
"        if { [set cmd [Widget::getoption $path -draginitcmd]] != \"\" } {\n"
"            return [uplevel \\#0 $cmd [list $path $node $top]]\n"
"        }\n"
"        if { [set type [Widget::getoption $path -dragtype]] == \"\" } {\n"
"            set type \"TREE_NODE\"\n"
"        }\n"
"        if { [set img [Widget::getoption $path.$node -image]] != \"\" } {\n"
"            pack [label $top.l -image $img -padx 0 -pady 0]\n"
"        }\n"
"        return [list $type {copy move link} $node]\n"
"    }\n"
"    return {}\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::_drop_cmd\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::_drop_cmd { path source X Y op type dnddata } {\n"
"    set path [winfo parent $path]\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    $path.c delete drop\n"
"    if { [string length $data(dnd,afterid)] } {\n"
"        after cancel $data(dnd,afterid)\n"
"        set data(dnd,afterid) \"\"\n"
"    }\n"
"    set data(dnd,scroll) \"\"\n"
"    if { [llength $data(dnd,node)] } {\n"
"        if { [set cmd [Widget::getoption $path -dropcmd]] != \"\" } {\n"
"            return [uplevel \\#0 $cmd [list $path $source $data(dnd,node) $op $type $dnddata]]\n"
"        }\n"
"    }\n"
"    return 0\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::_over_cmd\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::_over_cmd { path source event X Y op type dnddata } {\n"
"    set path [winfo parent $path]\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    if { ![string compare $event \"leave\"] } {\n"
"        # we leave the window tree\n"
"        $path.c delete drop\n"
"        if { [string length $data(dnd,afterid)] } {\n"
"            after cancel $data(dnd,afterid)\n"
"            set data(dnd,afterid) \"\"\n"
"        }\n"
"        set data(dnd,scroll) \"\"\n"
"        return 0\n"
"    }\n"
"\n"
"    if { ![string compare $event \"enter\"] } {\n"
"        # we enter the window tree - dnd data initialization\n"
"        set mode [Widget::getoption $path -dropovermode]\n"
"        set data(dnd,mode) 0\n"
"        foreach c {w p n} {\n"
"            set data(dnd,mode) [expr {($data(dnd,mode) << 1) | ([string first $c $mode] != -1)}]\n"
"        }\n"
"        set bbox [$path.c bbox all]\n"
"        if { [llength $bbox] } {\n"
"            set data(dnd,xs) [lindex $bbox 2]\n"
"            set data(dnd,empty) 0\n"
"        } else {\n"
"            set data(dnd,xs) 0\n"
"            set data(dnd,empty) 1\n"
"        }\n"
"        set data(dnd,node) {}\n"
"    }\n"
"\n"
"    set x [expr {$X-[winfo rootx $path]}]\n"
"    set y [expr {$Y-[winfo rooty $path]}]\n"
"    $path.c delete drop\n"
"    set data(dnd,node) {}\n"
"\n"
"    # test for auto-scroll unless mode is widget only\n"
"    if { $data(dnd,mode) != 4 && [_auto_scroll $path $x $y] != \"\" } {\n"
"        return 2\n"
"    }\n"
"\n"
"    if { $data(dnd,mode) & 4 } {\n"
"        # dropovermode includes widget\n"
"        set target [list widget]\n"
"        set vmode  4\n"
"    } else {\n"
"        set target [list \"\"]\n"
"        set vmode  0\n"
"    }\n"
"    if { ($data(dnd,mode) & 2) && $data(dnd,empty) } {\n"
"        # dropovermode includes position and tree is empty\n"
"        lappend target [list root 0]\n"
"        set vmode  [expr {$vmode | 2}]\n"
"    }\n"
"\n"
"    set xc [$path.c canvasx $x]\n"
"    set xs $data(dnd,xs)\n"
"    if { $xc <= $xs } {\n"
"        set yc   [$path.c canvasy $y]\n"
"        set dy   [$path.c cget -yscrollincrement]\n"
"        set line [expr {int($yc/$dy)}]\n"
"        set xi   0\n"
"        set yi   [expr {$line*$dy}]\n"
"        set ys   [expr {$yi+$dy}]\n"
"        set found 0\n"
"        foreach id [$path.c find overlapping $xi $yi $xs $ys] {\n"
"            set ltags [$path.c gettags $id]\n"
"            set item  [lindex $ltags 1]\n"
"            if { ![string compare $item \"node\"] ||\n"
"                 ![string compare $item \"img\"]  ||\n"
"                 ![string compare $item \"win\"] } {\n"
"                # item is the label or image/window of the node\n"
"                set node [Tree::_get_node_name $path $id 2]\n"
"               set found 1\n"
"               break\n"
"           }\n"
"       }\n"
"       if {$found} {\n"
"            set xi [expr {[lindex [$path.c coords n:$node] 0]-[Widget::getoption $path -padx]-1}]\n"
"                if { $data(dnd,mode) & 1 } {\n"
"                    # dropovermode includes node\n"
"                    lappend target $node\n"
"                    set vmode [expr {$vmode | 1}]\n"
"                } else {\n"
"                    lappend target \"\"\n"
"                }\n"
"\n"
"                if { $data(dnd,mode) & 2 } {\n"
"                    # dropovermode includes position\n"
"                    if { $yc >= $yi+$dy/2 } {\n"
"                        # position is after $node\n"
"                        if { [Widget::getoption $path.$node -open] &&\n"
"                             [llength $data($node)] > 1 } {\n"
"                            # $node is open and have subnodes\n"
"                            # drop position is 0 in children of $node\n"
"                            set parent $node\n"
"                            set index  0\n"
"                            set xli    [expr {$xi-5}]\n"
"                        } else {\n"
"                            # $node is not open and doesn't have subnodes\n"
"                            # drop position is after $node in children of parent of $node\n"
"                            set parent [lindex $data($node) 0]\n"
"                            set index  [lsearch $data($parent) $node]\n"
"                            set xli    [expr {$xi-[Widget::getoption $path -deltax]-5}]\n"
"                        }\n"
"                        set yl $ys\n"
"                    } else {\n"
"                        # position is before $node\n"
"                        # drop position is before $node in children of parent of $node\n"
"                        set parent [lindex $data($node) 0]\n"
"                        set index  [expr {[lsearch $data($parent) $node] - 1}]\n"
"                        set xli    [expr {$xi-[Widget::getoption $path -deltax]-5}]\n"
"                        set yl     $yi\n"
"                    }\n"
"                    lappend target [list $parent $index]\n"
"                    set vmode  [expr {$vmode | 2}]\n"
"                } else {\n"
"                    lappend target {}\n"
"                }\n"
"\n"
"                if { ($vmode & 3) == 3 } {\n"
"                    # result have both node and position\n"
"                    # we compute what is the preferred method\n"
"                    if { $yc-$yi <= 3 || $ys-$yc <= 3 } {\n"
"                        lappend target \"position\"\n"
"                    } else {\n"
"                        lappend target \"node\"\n"
"                    }\n"
"                }\n"
"            }\n"
"        }\n"
"\n"
"    if { $vmode && [set cmd [Widget::getoption $path -dropovercmd]] != \"\" } {\n"
"        # user-defined dropover command\n"
"        set res     [uplevel \\#0 $cmd [list $path $source $target $op $type $dnddata]]\n"
"        set code    [lindex $res 0]\n"
"        set newmode 0\n"
"        if { $code & 1 } {\n"
"            # update vmode\n"
"            set mode [lindex $res 1]\n"
"            if { ($vmode & 1) && ![string compare $mode \"node\"] } {\n"
"                set newmode 1\n"
"            } elseif { ($vmode & 2) && ![string compare $mode \"position\"] } {\n"
"                set newmode 2\n"
"            } elseif { ($vmode & 4) && ![string compare $mode \"widget\"] } {\n"
"                set newmode 4\n"
"            }\n"
"        }\n"
"        set vmode $newmode\n"
"    } else {\n"
"        if { ($vmode & 3) == 3 } {\n"
"            # result have both item and position\n"
"            # we choose the preferred method\n"
"            if { ![string compare [lindex $target 3] \"position\"] } {\n"
"                set vmode [expr {$vmode & ~1}]\n"
"            } else {\n"
"                set vmode [expr {$vmode & ~2}]\n"
"            }\n"
"        }\n"
"\n"
"        if { $data(dnd,mode) == 4 || $data(dnd,mode) == 0 } {\n"
"            # dropovermode is widget or empty - recall is not necessary\n"
"            set code 1\n"
"        } else {\n"
"            set code 3\n"
"        }\n"
"    }\n"
"\n"
"    if {!$data(dnd,empty)} {\n"
"       # draw dnd visual following vmode\n"
"       if { $vmode & 1 } {\n"
"           set data(dnd,node) [list \"node\" [lindex $target 1]]\n"
"           $path.c create rectangle $xi $yi $xs $ys -tags drop\n"
"       } elseif { $vmode & 2 } {\n"
"           set data(dnd,node) [concat \"position\" [lindex $target 2]]\n"
"           $path.c create line $xli [expr {$yl-$dy/2}] $xli $yl $xs $yl -tags drop\n"
"       } elseif { $vmode & 4 } {\n"
"           set data(dnd,node) [list \"widget\"]\n"
"       } else {\n"
"           set code [expr {$code & 2}]\n"
"       }\n"
"    }\n"
"\n"
"    if { $code & 1 } {\n"
"        DropSite::setcursor based_arrow_down\n"
"    } else {\n"
"        DropSite::setcursor dot\n"
"    }\n"
"    return $code\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::_auto_scroll\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::_auto_scroll { path x y } {\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    set xmax   [winfo width  $path]\n"
"    set ymax   [winfo height $path]\n"
"    set scroll {}\n"
"    if { $y <= 6 } {\n"
"        if { [lindex [$path.c yview] 0] > 0 } {\n"
"            set scroll [list yview -1]\n"
"            DropSite::setcursor sb_up_arrow\n"
"        }\n"
"    } elseif { $y >= $ymax-6 } {\n"
"        if { [lindex [$path.c yview] 1] < 1 } {\n"
"            set scroll [list yview 1]\n"
"            DropSite::setcursor sb_down_arrow\n"
"        }\n"
"    } elseif { $x <= 6 } {\n"
"        if { [lindex [$path.c xview] 0] > 0 } {\n"
"            set scroll [list xview -1]\n"
"            DropSite::setcursor sb_left_arrow\n"
"        }\n"
"    } elseif { $x >= $xmax-6 } {\n"
"        if { [lindex [$path.c xview] 1] < 1 } {\n"
"            set scroll [list xview 1]\n"
"            DropSite::setcursor sb_right_arrow\n"
"        }\n"
"    }\n"
"\n"
"    if { [string length $data(dnd,afterid)] && [string compare $data(dnd,scroll) $scroll] } {\n"
"        after cancel $data(dnd,afterid)\n"
"        set data(dnd,afterid) \"\"\n"
"    }\n"
"\n"
"    set data(dnd,scroll) $scroll\n"
"    if { [string length $scroll] && ![string length $data(dnd,afterid)] } {\n"
"        set data(dnd,afterid) [after 200 Tree::_scroll $path $scroll]\n"
"    }\n"
"    return $data(dnd,afterid)\n"
"}\n"
"\n"
"\n"
"# ------------------------------------------------------------------------------\n"
"#  Command Tree::_scroll\n"
"# ------------------------------------------------------------------------------\n"
"proc Tree::_scroll { path cmd dir } {\n"
"    variable $path\n"
"    upvar 0  $path data\n"
"\n"
"    if { ($dir == -1 && [lindex [$path.c $cmd] 0] > 0) ||\n"
"         ($dir == 1  && [lindex [$path.c $cmd] 1] < 1) } {\n"
"        $path.c $cmd scroll $dir units\n"
"        set data(dnd,afterid) [after 100 Tree::_scroll $path $cmd $dir]\n"
"    } else {\n"
"        set data(dnd,afterid) \"\"\n"
"        DropSite::setcursor dot\n"
"    }\n"
"}\n"
"\n"
"# Tree::_keynav --\n"
"#\n"
"#      Handle navigational keypresses on the tree.\n"
"#\n"
"# Arguments:\n"
"#      which      tag indicating the direction of motion:\n"
"#                  up         move to the node graphically above current\n"
"#                  down       move to the node graphically below current\n"
"#                  left       close current if open, else move to parent\n"
"#                  right      open current if closed, else move to child\n"
"#                  open       open current if closed, close current if open\n"
"#       win        name of the tree widget\n"
"#\n"
"# Results:\n"
"#      None.\n"
"\n"
"proc Tree::_keynav {which win} {\n"
"    # Keyboard navigation is riddled with special cases.  In order to avoid\n"
"    # the complex logic, we will instead make a list of all the visible,\n"
"    # selectable nodes, then do a simple next or previous operation.\n"
"\n"
"    # One easy way to get all of the visible nodes is to query the canvas\n"
"    # object for all the items with the \"node\" tag; since the tree is always\n"
"    # completely redrawn, this list will be in vertical order.\n"
"    set nodes {}\n"
"    foreach nodeItem [$win.c find withtag node] {\n"
"       set node [Tree::_get_node_name $win $nodeItem 2]\n"
"       if { [Widget::cget $win.$node -selectable] } {\n"
"           lappend nodes $node\n"
"       }\n"
"    }\n"
"       \n"
"    # Keyboard navigation is all relative to the current node\n"
"    # surles: Get the current node for single or multiple selection schemas.\n"
"    set node [_get_current_node $win]\n"
"\n"
"    switch -exact -- $which {\n"
"       \"up\" {\n"
"           # Up goes to the node that is vertically above the current node\n"
"           # (NOT necessarily the current node's parent)\n"
"           if { [string equal $node \"\"] } {\n"
"               return\n"
"           }\n"
"           set index [lsearch $nodes $node]\n"
"           incr index -1\n"
"           if { $index >= 0 } {\n"
"               $win selection set [lindex $nodes $index]\n"
"               _set_current_node $win [lindex $nodes $index]\n"
"               $win see [lindex $nodes $index]\n"
"               return\n"
"           }\n"
"       }\n"
"       \"down\" {\n"
"           # Down goes to the node that is vertically below the current node\n"
"           if { [string equal $node \"\"] } {\n"
"               $win selection set [lindex $nodes 0]\n"
"               _set_current_node $win [lindex $nodes 0]\n"
"               $win see [lindex $nodes 0]\n"
"               return\n"
"           }\n"
"\n"
"           set index [lsearch $nodes $node]\n"
"           incr index\n"
"           if { $index < [llength $nodes] } {\n"
"               $win selection set [lindex $nodes $index]\n"
"               _set_current_node $win [lindex $nodes $index]\n"
"               $win see [lindex $nodes $index]\n"
"               return\n"
"           }\n"
"       }\n"
"       \"right\" {\n"
"           # On a right arrow, if the current node is closed, open it.\n"
"           # If the current node is open, go to its first child\n"
"           if { [string equal $node \"\"] } {\n"
"               return\n"
"           }\n"
"           set open [$win itemcget $node -open]\n"
"            if { $open } {\n"
"                if { [llength [$win nodes $node]] } {\n"
"                   set index [lsearch $nodes $node]\n"
"                   incr index\n"
"                   if { $index < [llength $nodes] } {\n"
"                       $win selection set [lindex $nodes $index]\n"
"                       _set_current_node $win [lindex $nodes $index]\n"
"                       $win see [lindex $nodes $index]\n"
"                       return\n"
"                   }\n"
"                }\n"
"            } else {\n"
"                $win itemconfigure $node -open 1\n"
"                if { [set cmd [Widget::getoption $win -opencmd]] != \"\" } {\n"
"                    uplevel \\#0 $cmd $node\n"
"                }\n"
"                return\n"
"            }\n"
"       }\n"
"       \"left\" {\n"
"           # On a left arrow, if the current node is open, close it.\n"
"           # If the current node is closed, go to its parent.\n"
"           if { [string equal $node \"\"] } {\n"
"               return\n"
"           }\n"
"           set open [$win itemcget $node -open]\n"
"           if { $open } {\n"
"               $win itemconfigure $node -open 0\n"
"                if { [set cmd [Widget::getoption $win -closecmd]] != \"\" } {\n"
"                    uplevel \\#0 $cmd $node\n"
"                }\n"
"               return\n"
"           } else {\n"
"               set parent [$win parent $node]\n"
"               if { [string equal $parent \"root\"] } {\n"
"                   set parent $node\n"
"                } else {\n"
"                    while { ![$win itemcget $parent -selectable] } {\n"
"                       set parent [$win parent $parent]\n"
"                       if { [string equal $parent \"root\"] } {\n"
"                           set parent $node\n"
"                           break\n"
"                       }\n"
"                    }\n"
"               }\n"
"               $win selection set $parent\n"
"               _set_current_node $win $parent\n"
"               $win see $parent\n"
"               return\n"
"           }\n"
"       }\n"
"       \"space\" {\n"
"           if { [string equal $node \"\"] } {\n"
"               return\n"
"           }\n"
"           set open [$win itemcget $node -open]\n"
"           if { [llength [$win nodes $node]] } {\n"
"\n"
"               # Toggle the open status of the chosen node.\n"
"\n"
"               $win itemconfigure $node -open [expr {$open?0:1}]\n"
"\n"
"               if {$open} {\n"
"                   # Node was open, is now closed. Call the close-cmd\n"
"\n"
"                   if { [set cmd [Widget::getoption $win -closecmd]] != \"\" } {\n"
"                       uplevel \\#0 $cmd $node\n"
"                   }\n"
"               } else {\n"
"                   # Node was closed, is now open. Call the open-cmd\n"
"\n"
"                   if { [set cmd [Widget::getoption $win -opencmd]] != \"\" } {\n"
"                       uplevel \\#0 $cmd $node\n"
"                   }\n"
"                }\n"
"           }\n"
"       }\n"
"    }\n"
"    return\n"
"}\n"
"\n"
"# Tree::_get_current_node --\n"
"#\n"
"#      Get the current node for either single or multiple\n"
"#      node selection trees.  If the tree allows for \n"
"#      multiple selection, return the cursor node.  Otherwise,\n"
"#      if there is a selection, return the first node in the\n"
"#      list.  If there is no selection, return the root node.\n"
"#\n"
"# arguments:\n"
"#       win        name of the tree widget\n"
"#\n"
"# Results:\n"
"#      The current node.\n"
"\n"
"proc Tree::_get_current_node {win} {\n"
"    if {[info exists selectTree::selectCursor($win)]} {\n"
"       set result $selectTree::selectCursor($win)\n"
"    } elseif {[set selList [$win selection get]] != {}} {\n"
"       set result [lindex $selList 0]\n"
"    } else {\n"
"       set result \"\"\n"
"    }\n"
"    return $result\n"
"}\n"
"\n"
"# Tree::_set_current_node --\n"
"#\n"
"#      Set the current node for either single or multiple\n"
"#      node selection trees.\n"
"#\n"
"# arguments:\n"
"#       win        Name of the tree widget\n"
"#      node       The current node.\n"
"#\n"
"# Results:\n"
"#      None.\n"
"\n"
"proc Tree::_set_current_node {win node} {\n"
"    if {[info exists selectTree::selectCursor($win)]} {\n"
"       set selectTree::selectCursor($win) $node\n"
"    }\n"
"    return\n"
"}\n"
"\n"
"# Tree::_get_node_name --\n"
"#\n"
"#      Given a canvas item, get the name of the tree node represented by that\n"
"#      item.\n"
"#\n"
"# Arguments:\n"
"#      path            tree to query\n"
"#      item            Optional canvas item to examine; if omitted, \n"
"#                      defaults to \"current\"\n"
"#      tagindex        Optional tag index, since the n:nodename tag is not\n"
"#                      in the same spot for all canvas items.  If omitted,\n"
"#                      defaults to \"end-1\", so it works with \"current\" item.\n"
"#\n"
"# Results:\n"
"#      node    name of the tree node.\n"
"\n"
"proc Tree::_get_node_name {path {item current} {tagindex end-1}} {\n"
"    return [string range [lindex [$path.c gettags $item] $tagindex] 2 end]\n"
"}\n"
"\n"
"\n";
