Updated Tcl/Tk

git-svn-id: svn://tug.org/texlive/trunk@58056 c570f23f-e606-0410-a88d-b1316a301751

7 files changed, 1248 insertions, 0 deletions

diff --git a/Master/tlpkg/tltcl/lib/itcl4.2.1/itcl.tcl b/Master/tlpkg/tltcl/lib/itcl4.2.1/itcl.tcl
new file mode 100644
index 00000000000..15ca2200f4d
--- /dev/null
+++ b/Master/tlpkg/tltcl/lib/itcl4.2.1/itcl.tcl
@@ -0,0 +1,151 @@
+#
+# itcl.tcl
+# ----------------------------------------------------------------------
+# Invoked automatically upon startup to customize the interpreter
+# for [incr Tcl].
+# ----------------------------------------------------------------------
+#   AUTHOR:  Michael J. McLennan
+#            Bell Labs Innovations for Lucent Technologies
+#            mmclennan@lucent.com
+#            http://www.tcltk.com/itcl
+# ----------------------------------------------------------------------
+#            Copyright (c) 1993-1998  Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+proc ::itcl::delete_helper { name args } {
+    ::itcl::delete object $name
+}
+
+# ----------------------------------------------------------------------
+#  USAGE:  local <className> <objName> ?<arg> <arg>...?
+#
+#  Creates a new object called <objName> in class <className>, passing
+#  the remaining <arg>'s to the constructor.  Unlike the usual
+#  [incr Tcl] objects, however, an object created by this procedure
+#  will be automatically deleted when the local call frame is destroyed.
+#  This command is useful for creating objects that should only remain
+#  alive until a procedure exits.
+# ----------------------------------------------------------------------
+proc ::itcl::local {class name args} {
+    set ptr [uplevel [list $class $name] $args]
+    uplevel [list set itcl-local-$ptr $ptr]
+    set cmd [uplevel namespace which -command $ptr]
+    uplevel [list trace variable itcl-local-$ptr u \
+        "::itcl::delete_helper $cmd"]
+    return $ptr
+}
+
+# ----------------------------------------------------------------------
+# auto_mkindex
+# ----------------------------------------------------------------------
+# Define Itcl commands that will be recognized by the auto_mkindex
+# parser in Tcl...
+#
+
+#
+# USAGE:  itcl::class name body
+# Adds an entry for the given class declaration.
+#
+foreach __cmd {itcl::class class itcl::type type ictl::widget widget itcl::widgetadaptor widgetadaptor itcl::extendedclass extendedclass} {
+    auto_mkindex_parser::command $__cmd {name body} {
+	variable index
+	variable scriptFile
+	append index "set [list auto_index([fullname $name])]"
+	append index " \[list source \[file join \$dir [list $scriptFile]\]\]\n"
+
+	variable parser
+	variable contextStack
+	set contextStack [linsert $contextStack 0 $name]
+	$parser eval $body
+	set contextStack [lrange $contextStack 1 end]
+    }
+}
+
+#
+# USAGE:  itcl::body name arglist body
+# Adds an entry for the given method/proc body.
+#
+foreach __cmd {itcl::body body} {
+    auto_mkindex_parser::command $__cmd {name arglist body} {
+	variable index
+	variable scriptFile
+	append index "set [list auto_index([fullname $name])]"
+	append index " \[list source \[file join \$dir [list $scriptFile]\]\]\n"
+    }
+}
+
+#
+# USAGE:  itcl::configbody name arglist body
+# Adds an entry for the given method/proc body.
+#
+foreach __cmd {itcl::configbody configbody} {
+    auto_mkindex_parser::command $__cmd {name body} {
+	variable index
+	variable scriptFile
+	append index "set [list auto_index([fullname $name])]"
+	append index " \[list source \[file join \$dir [list $scriptFile]\]\]\n"
+    }
+}
+
+#
+# USAGE:  ensemble name ?body?
+# Adds an entry to the auto index list for the given ensemble name.
+#
+foreach __cmd {itcl::ensemble ensemble} {
+    auto_mkindex_parser::command $__cmd {name {body ""}} {
+	variable index
+	variable scriptFile
+	append index "set [list auto_index([fullname $name])]"
+	append index " \[list source \[file join \$dir [list $scriptFile]\]\]\n"
+    }
+}
+
+#
+# USAGE:  public arg ?arg arg...?
+#         protected arg ?arg arg...?
+#         private arg ?arg arg...?
+#
+# Evaluates the arguments as commands, so we can recognize proc
+# declarations within classes.
+#
+foreach __cmd {public protected private} {
+    auto_mkindex_parser::command $__cmd {args} {
+        variable parser
+        $parser eval $args
+    }
+}
+
+# SF bug #246 unset variable __cmd to avoid problems in user programs!!
+unset __cmd
+
+# ----------------------------------------------------------------------
+# auto_import
+# ----------------------------------------------------------------------
+# This procedure overrides the usual "auto_import" function in the
+# Tcl library.  It is invoked during "namespace import" to make see
+# if the imported commands reside in an autoloaded library.  If so,
+# stubs are created to represent the commands.  Executing a stub
+# later on causes the real implementation to be autoloaded.
+#
+# Arguments -
+# pattern	The pattern of commands being imported (like "foo::*")
+#               a canonical namespace as returned by [namespace current]
+
+proc auto_import {pattern} {
+    global auto_index
+
+    set ns [uplevel namespace current]
+    set patternList [auto_qualify $pattern $ns]
+
+    auto_load_index
+
+    foreach pattern $patternList {
+        foreach name [array names auto_index $pattern] {
+            if {"" == [info commands $name]} {
+                ::itcl::import::stub create $name
+            }
+        }
+    }
+}
diff --git a/Master/tlpkg/tltcl/lib/itcl4.2.1/itcl421.dll b/Master/tlpkg/tltcl/lib/itcl4.2.1/itcl421.dll
new file mode 100644
index 00000000000..619006997ae
--- /dev/null
+++ b/Master/tlpkg/tltcl/lib/itcl4.2.1/itcl421.dll
diff --git a/Master/tlpkg/tltcl/lib/itcl4.2.1/itclConfig.sh b/Master/tlpkg/tltcl/lib/itcl4.2.1/itclConfig.sh
new file mode 100644
index 00000000000..1616bf3702c
--- /dev/null
+++ b/Master/tlpkg/tltcl/lib/itcl4.2.1/itclConfig.sh
@@ -0,0 +1,67 @@
+# itclConfig.sh --
+#
+# This shell script (for sh) is generated automatically by Itcl's
+# configure script.  It will create shell variables for most of
+# the configuration options discovered by the configure script.
+# This script is intended to be included by the configure scripts
+# for Itcl extensions so that they don't have to figure this all
+# out for themselves.  This file does not duplicate information
+# already provided by tclConfig.sh, so you may need to use that
+# file in addition to this one.
+#
+# The information in this file is specific to a single platform.
+
+# Itcl's version number.
+itcl_VERSION='4.2.1'
+ITCL_VERSION='4.2.1'
+
+# The name of the Itcl library (may be either a .a file or a shared library):
+itcl_LIB_FILE=itcl421.dll
+ITCL_LIB_FILE=itcl421.dll
+
+# String to pass to linker to pick up the Itcl library from its
+# build directory.
+itcl_BUILD_LIB_SPEC='-L/home/siepo/xdrive/tltcl/tcl8.6.11/win/pkgs/itcl4.2.1 -litcl421'
+ITCL_BUILD_LIB_SPEC='-L/home/siepo/xdrive/tltcl/tcl8.6.11/win/pkgs/itcl4.2.1 -litcl421'
+
+# String to pass to linker to pick up the Itcl library from its
+# installed directory.
+itcl_LIB_SPEC='-L/home/siepo/tltcl/lib/itcl4.2.1 -litcl421'
+ITCL_LIB_SPEC='-L/home/siepo/tltcl/lib/itcl4.2.1 -litcl421'
+
+# The name of the Itcl stub library (a .a file):
+itcl_STUB_LIB_FILE=libitclstub421.a
+ITCL_STUB_LIB_FILE=libitclstub421.a
+
+# String to pass to linker to pick up the Itcl stub library from its
+# build directory.
+itcl_BUILD_STUB_LIB_SPEC='-L/home/siepo/xdrive/tltcl/tcl8.6.11/win/pkgs/itcl4.2.1 -litclstub421'
+ITCL_BUILD_STUB_LIB_SPEC='-L/home/siepo/xdrive/tltcl/tcl8.6.11/win/pkgs/itcl4.2.1 -litclstub421'
+
+# String to pass to linker to pick up the Itcl stub library from its
+# installed directory.
+itcl_STUB_LIB_SPEC='-L/home/siepo/tltcl/lib/itcl4.2.1 -litclstub421'
+ITCL_STUB_LIB_SPEC='-L/home/siepo/tltcl/lib/itcl4.2.1 -litclstub421'
+
+# String to pass to linker to pick up the Itcl stub library from its
+# build directory.
+itcl_BUILD_STUB_LIB_PATH='/home/siepo/xdrive/tltcl/tcl8.6.11/win/pkgs/itcl4.2.1/libitclstub421.a'
+ITCL_BUILD_STUB_LIB_PATH='/home/siepo/xdrive/tltcl/tcl8.6.11/win/pkgs/itcl4.2.1/libitclstub421.a'
+
+# String to pass to linker to pick up the Itcl stub library from its
+# installed directory.
+itcl_STUB_LIB_PATH='/home/siepo/tltcl/lib/itcl4.2.1/libitclstub421.a'
+ITCL_STUB_LIB_PATH='/home/siepo/tltcl/lib/itcl4.2.1/libitclstub421.a'
+
+# Location of the top-level source directories from which [incr Tcl]
+# was built.  This is the directory that contains generic, unix, etc.
+# If [incr Tcl] was compiled in a different place than the directory
+# containing the source files, this points to the location of the sources,
+# not the location where [incr Tcl] was compiled.
+itcl_SRC_DIR='/home/siepo/xdrive/tltcl/tcl8.6.11/pkgs/itcl4.2.1'
+ITCL_SRC_DIR='/home/siepo/xdrive/tltcl/tcl8.6.11/pkgs/itcl4.2.1'
+
+# String to pass to the compiler so that an extension can
+# find installed Itcl headers.
+itcl_INCLUDE_SPEC='-I/home/siepo/xdrive/tltcl/tcl8.6.11/pkgs/itcl4.2.1/generic'
+ITCL_INCLUDE_SPEC='-I/home/siepo/xdrive/tltcl/tcl8.6.11/pkgs/itcl4.2.1/generic'
diff --git a/Master/tlpkg/tltcl/lib/itcl4.2.1/itclHullCmds.tcl b/Master/tlpkg/tltcl/lib/itcl4.2.1/itclHullCmds.tcl
new file mode 100644
index 00000000000..282041187c6
--- /dev/null
+++ b/Master/tlpkg/tltcl/lib/itcl4.2.1/itclHullCmds.tcl
@@ -0,0 +1,562 @@
+#
+# itclHullCmds.tcl
+# ----------------------------------------------------------------------
+# Invoked automatically upon startup to customize the interpreter
+# for [incr Tcl] when one of setupcomponent or createhull is called.
+# ----------------------------------------------------------------------
+#   AUTHOR:  Arnulf P. Wiedemann
+#
+# ----------------------------------------------------------------------
+#            Copyright (c) 2008  Arnulf P. Wiedemann
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require Tk 8.6
+
+namespace eval ::itcl::internal::commands {
+
+# ======================= widgetDeleted ===========================
+
+proc widgetDeleted {oldName newName op} {
+    # The widget is beeing deleted, so we have to delete the object
+    # which had the widget as itcl_hull too!
+    # We have to get the real name from for example
+    # ::itcl::internal::widgets::hull1.lw
+    # we need only .lw here
+
+#puts stderr "widgetDeleted!$oldName!$newName!$op!"
+    set cmdName [namespace tail $oldName]
+    set flds [split $cmdName {.}]
+    set cmdName .[join [lrange $flds 1 end] {.}]
+#puts stderr "DELWIDGET![namespace current]!$cmdName![::info command $cmdName]!"
+    rename $cmdName {}
+}
+
+}
+
+namespace eval ::itcl::builtin {
+
+# ======================= createhull ===========================
+# the hull widget is a tk widget which is the (mega) widget handled behind the itcl
+# extendedclass/itcl widget.
+# It is created be renaming the itcl class object to a temporary name <itcl object name>_
+# creating the widget with the
+# appropriate options and the installing that as the "hull" widget (the container)
+# All the options in args and the options delegated to component itcl_hull are used
+# Then a unique name (hull_widget_name) in the itcl namespace is created for widget:
+# ::itcl::internal::widgets::hull<unique number><namespace tail path>
+# and widget is renamed to that name
+# Finally the <itcl object name>_ is renamed to the original <itcl object name> again
+# Component itcl_hull is created if not existent
+# itcl_hull is set to the hull_widget_name and the <itcl object name>
+# is returned to the caller
+# ==============================================================
+
+proc createhull {widget_type path args} {
+    variable hullCount
+    upvar this this
+    upvar win win
+
+
+#puts stderr "il-1![::info level -1]!$this!"
+#puts stderr "createhull!$widget_type!$path!$args!$this![::info command $this]!"
+#puts stderr "ns1![uplevel 1 namespace current]!"
+#puts stderr "ns2![uplevel 2 namespace current]!"
+#puts stderr "ns3![uplevel 3 namespace current]!"
+#puts stderr "level-1![::info level -1]!"
+#puts stderr "level-2![::info level -2]!"
+#    set my_this [namespace tail $this]
+    set my_this $this
+    set tmp $my_this
+#puts stderr "II![::info command $this]![::info command $tmp]!"
+#puts stderr "rename1!rename $my_this ${tmp}_!"
+    rename ::$my_this ${tmp}_
+    set options [list]
+    foreach {option_name value} $args {
+        switch -glob -- $option_name {
+	-class {
+	      lappend options $option_name [namespace tail $value]
+	  }
+        -* {
+            lappend options $option_name $value
+          }
+        default {
+	    return -code error "bad option name\"$option_name\" options must start with a \"-\""
+          }
+        }
+    }
+    set my_win [namespace tail $path]
+    set cmd [list $widget_type $my_win]
+#puts stderr "my_win!$my_win!cmd!$cmd!$path!"
+    if {[llength $options] > 0} {
+        lappend cmd {*}$options
+    }
+    set widget [uplevel 1 $cmd]
+#puts stderr "widget!$widget!"
+    trace add command $widget delete ::itcl::internal::commands::widgetDeleted
+    set opts [uplevel 1 info delegated options]
+    foreach entry $opts {
+        foreach {optName compName} $entry break
+	if {$compName eq "itcl_hull"} {
+	    set optInfos [uplevel 1 info delegated option $optName]
+	    set realOptName [lindex $optInfos 4]
+	    # strip off the "-" at the beginning
+	    set myOptName [string range $realOptName 1 end]
+            set my_opt_val [option get $my_win $myOptName *]
+            if {$my_opt_val ne ""} {
+                $my_win configure -$myOptName $my_opt_val
+            }
+	}
+    }
+    set idx 1
+    while {1} {
+        set widgetName ::itcl::internal::widgets::hull${idx}$my_win
+#puts stderr "widgetName!$widgetName!"
+	if {[string length [::info command $widgetName]] == 0} {
+	    break
+	}
+        incr idx
+    }
+#puts stderr "rename2!rename $widget $widgetName!"
+    set dorename 0
+    rename $widget $widgetName
+#puts stderr "rename3!rename ${tmp}_ $tmp![::info command ${tmp}_]!my_this!$my_this!"
+    rename ${tmp}_ ::$tmp
+    set exists [uplevel 1 ::info exists itcl_hull]
+    if {!$exists} {
+	# that does not yet work, beacause of problems with resolving
+        ::itcl::addcomponent $my_this itcl_hull
+    }
+    upvar itcl_hull itcl_hull
+    ::itcl::setcomponent $my_this itcl_hull $widgetName
+#puts stderr "IC![::info command $my_win]!"
+    set exists [uplevel 1 ::info exists itcl_interior]
+    if {!$exists} {
+	# that does not yet work, beacause of problems with resolving
+        ::itcl::addcomponent $this itcl_interior
+    }
+    upvar itcl_interior itcl_interior
+    set itcl_interior $my_win
+#puts stderr "hull end!win!$win!itcl_hull!$itcl_hull!itcl_interior!$itcl_interior!"
+    return $my_win
+}
+
+# ======================= addToItclOptions ===========================
+
+proc addToItclOptions {my_class my_win myOptions argsDict} {
+    upvar win win
+    upvar itcl_hull itcl_hull
+
+    set opt_lst [list configure]
+    foreach opt [lsort $myOptions] {
+#puts stderr "IOPT!$opt!$my_class!$my_win![::itcl::is class $my_class]!"
+        set isClass [::itcl::is class $my_class]
+	set found 0
+	if {$isClass} {
+            if {[catch {
+                set resource [namespace eval $my_class info option $opt -resource]
+                set class [namespace eval $my_class info option $opt -class]
+                set default_val [uplevel 2 info option $opt -default]
+                set found 1
+            } msg]} {
+#                puts stderr "MSG!$opt!$my_class!$msg!"
+            }
+        } else {
+            set tmp_win [uplevel #0 $my_class .___xx]
+
+            set my_info [$tmp_win configure $opt]
+            set resource [lindex $my_info 1]
+            set class [lindex $my_info 2]
+            set default_val [lindex $my_info 3]
+	    uplevel #0 destroy $tmp_win
+            set found 1
+        }
+	if {$found} {
+           if {[catch {
+               set val [uplevel #0 ::option get $win $resource $class]
+           } msg]} {
+               set val ""
+           }
+           if {[::dict exists $argsDict $opt]} {
+               # we have an explicitly set option
+               set val [::dict get $argsDict $opt]
+           } else {
+	       if {[string length $val] == 0} {
+                   set val $default_val
+	       }
+           }
+           set ::itcl::internal::variables::${my_win}::itcl_options($opt) $val
+           set ::itcl::internal::variables::${my_win}::__itcl_option_infos($opt) [list $resource $class $default_val]
+#puts stderr "OPT1!$opt!$val!"
+#	   uplevel 1 [list set itcl_options($opt) [list $val]]
+           if {[catch {uplevel 1 $win configure $opt [list $val]} msg]} {
+#puts stderr "addToItclOptions ERR!$msg!$my_class!$win!configure!$opt!$val!"
+	   }
+        }
+    }
+}
+
+# ======================= setupcomponent ===========================
+
+proc setupcomponent {comp using widget_type path args} {
+    upvar this this
+    upvar win win
+    upvar itcl_hull itcl_hull
+
+#puts stderr "setupcomponent!$comp!$widget_type!$path!$args!$this!$win!$itcl_hull!"
+#puts stderr "CONT![uplevel 1 info context]!"
+#puts stderr "ns1![uplevel 1 namespace current]!"
+#puts stderr "ns2![uplevel 2 namespace current]!"
+#puts stderr "ns3![uplevel 3 namespace current]!"
+    set my_comp_object  [lindex [uplevel 1 info context] 1]
+    if {[::info exists ::itcl::internal::component_objects($my_comp_object)]} {
+        set my_comp_object [set ::itcl::internal::component_objects($my_comp_object)]
+    } else {
+        set ::itcl::internal::component_objects($path) $my_comp_object
+    }
+    set options [list]
+    foreach {option_name value} $args {
+        switch -glob -- $option_name {
+        -* {
+            lappend options $option_name $value
+          }
+        default {
+	    return -code error "bad option name\"$option_name\" options must start with a \"-\""
+          }
+        }
+    }
+    if {[llength $args]} {
+        set argsDict [dict create {*}$args]
+    } else {
+        set argsDict [dict create]
+    }
+    set cmd [list $widget_type $path]
+    if {[llength $options] > 0} {
+        lappend cmd {*}$options
+    }
+#puts stderr "cmd0![::info command $widget_type]!$path![::info command $path]!"
+#puts stderr "cmd1!$cmd!"
+#    set my_comp [uplevel 3 $cmd]
+    set my_comp [uplevel #0 $cmd]
+#puts stderr 111![::info command $path]!
+    ::itcl::setcomponent $this $comp $my_comp
+    set opts [uplevel 1 info delegated options]
+    foreach entry $opts {
+        foreach {optName compName} $entry break
+	if {$compName eq $my_comp} {
+	    set optInfos [uplevel 1 info delegated option $optName]
+	    set realOptName [lindex $optInfos 4]
+	    # strip off the "-" at the beginning
+	    set myOptName [string range $realOptName 1 end]
+            set my_opt_val [option get $my_win $myOptName *]
+            if {$my_opt_val ne ""} {
+                $my_comp configure -$myOptName $my_opt_val
+            }
+	}
+    }
+    set my_class $widget_type
+    set my_parent_class [uplevel 1 namespace current]
+    if {[catch {
+        set myOptions [namespace eval $my_class {info classoptions}]
+    } msg]} {
+        set myOptions [list]
+    }
+    foreach entry [$path configure] {
+        foreach {opt dummy1 dummy2 dummy3} $entry break
+        lappend myOptions $opt
+    }
+#puts stderr "OPTS!$myOptions!"
+    addToItclOptions $widget_type $my_comp_object $myOptions $argsDict
+#puts stderr END!$path![::info command $path]!
+}
+
+proc itcl_initoptions {args} {
+puts stderr "ITCL_INITOPT!$args!"
+}
+
+# ======================= initoptions ===========================
+
+proc initoptions {args} {
+    upvar win win
+    upvar itcl_hull itcl_hull
+    upvar itcl_option_components itcl_option_components
+
+#puts stderr "INITOPT!!$win!"
+    if {[llength $args]} {
+        set argsDict [dict create {*}$args]
+    } else {
+        set argsDict [dict create]
+    }
+    set my_class [uplevel 1 namespace current]
+    set myOptions [namespace eval $my_class {info classoptions}]
+    if {[dict exists $::itcl::internal::dicts::classComponents $my_class]} {
+        set class_info_dict [dict get $::itcl::internal::dicts::classComponents $my_class]
+#    set myOptions [lsort -unique [namespace eval $my_class {info options}]]
+        foreach comp [uplevel 1 info components] {
+           if {[dict exists $class_info_dict $comp -keptoptions]} {
+               foreach my_opt [dict get $class_info_dict $comp -keptoptions] {
+                   if {[lsearch $myOptions $my_opt] < 0} {
+#puts stderr "KEOPT!$my_opt!"
+                       lappend myOptions $my_opt
+                   }
+               }
+           }
+        }
+    } else {
+        set class_info_dict [list]
+    }
+#puts stderr "OPTS!$win!$my_class![join [lsort $myOptions]] \n]!"
+    set opt_lst [list configure]
+    set my_win $win
+    foreach opt [lsort $myOptions] {
+	set found 0
+        if {[catch {
+            set resource [uplevel 1 info option $opt -resource]
+            set class [uplevel 1 info option $opt -class]
+            set default_val [uplevel 1 info option $opt -default]
+	    set found 1
+        } msg]} {
+#            puts stderr "MSG!$opt!$msg!"
+        }
+#puts stderr "OPT!$opt!$found!"
+	if {$found} {
+           if {[catch {
+               set val [uplevel #0 ::option get $my_win $resource $class]
+           } msg]} {
+               set val ""
+           }
+           if {[::dict exists $argsDict $opt]} {
+               # we have an explicitly set option
+               set val [::dict get $argsDict $opt]
+           } else {
+	       if {[string length $val] == 0} {
+                   set val $default_val
+	       }
+           }
+           set ::itcl::internal::variables::${win}::itcl_options($opt) $val
+           set ::itcl::internal::variables::${win}::__itcl_option_infos($opt) [list $resource $class $default_val]
+#puts stderr "OPT1!$opt!$val!"
+#	   uplevel 1 [list set itcl_options($opt) [list $val]]
+           if {[catch {uplevel 1 $my_win configure $opt [list $val]} msg]} {
+puts stderr "initoptions ERR!$msg!$my_class!$my_win!configure!$opt!$val!"
+	   }
+        }
+        foreach comp [dict keys $class_info_dict] {
+#puts stderr "OPT1!$opt!$comp![dict get $class_info_dict $comp]!"
+            if {[dict exists $class_info_dict $comp -keptoptions]} {
+                if {[lsearch [dict get $class_info_dict $comp -keptoptions] $opt] >= 0} {
+                    if {$found == 0} {
+                        # we use the option value of the first component for setting
+                        # the option, as the components are traversed in the dict
+                        # depending on the ordering of the component creation!!
+                        set my_info [uplevel 1 \[set $comp\] configure $opt]
+                        set resource [lindex $my_info 1]
+                        set class [lindex $my_info 2]
+                        set default_val [lindex $my_info 3]
+                        set found 2
+                        set val [uplevel #0 ::option get $my_win $resource $class]
+                        if {[::dict exists $argsDict $opt]} {
+                            # we have an explicitly set option
+                            set val [::dict get $argsDict $opt]
+                        } else {
+	                    if {[string length $val] == 0} {
+                                set val $default_val
+	                    }
+                        }
+#puts stderr "OPT2!$opt!$val!"
+		        set ::itcl::internal::variables::${win}::itcl_options($opt) $val
+		        set ::itcl::internal::variables::${win}::__itcl_option_infos($opt) [list $resource $class $default_val]
+#	                uplevel 1 [list set itcl_options($opt) [list $val]]
+                    }
+                    if {[catch {uplevel 1 \[set $comp\] configure $opt [list $val]} msg]} {
+puts stderr "initoptions ERR2!$msg!$my_class!$comp!configure!$opt!$val!"
+	            }
+		    if {![uplevel 1 info exists itcl_option_components($opt)]} {
+                        set itcl_option_components($opt) [list]
+		    }
+		    if {[lsearch [set itcl_option_components($opt)] $comp] < 0} {
+		        if {![catch {
+		            set optval [uplevel 1 [list set itcl_options($opt)]]
+                        } msg3]} {
+                                uplevel 1 \[set $comp\] configure $opt $optval
+                        }
+                        lappend itcl_option_components($opt) $comp
+		    }
+                }
+            }
+        }
+    }
+#    uplevel 1 $opt_lst
+}
+
+# ======================= setoptions ===========================
+
+proc setoptions {args} {
+
+#puts stderr "setOPT!!$args!"
+    if {[llength $args]} {
+        set argsDict [dict create {*}$args]
+    } else {
+        set argsDict [dict create]
+    }
+    set my_class [uplevel 1 namespace current]
+    set myOptions [namespace eval $my_class {info options}]
+#puts stderr "OPTS!$win!$my_class![join [lsort $myOptions]] \n]!"
+    set opt_lst [list configure]
+    foreach opt [lsort $myOptions] {
+	set found 0
+        if {[catch {
+            set resource [uplevel 1 info option $opt -resource]
+            set class [uplevel 1 info option $opt -class]
+            set default_val [uplevel 1 info option $opt -default]
+	    set found 1
+        } msg]} {
+#            puts stderr "MSG!$opt!$msg!"
+        }
+#puts stderr "OPT!$opt!$found!"
+	if {$found} {
+           set val ""
+           if {[::dict exists $argsDict $opt]} {
+               # we have an explicitly set option
+               set val [::dict get $argsDict $opt]
+           } else {
+	       if {[string length $val] == 0} {
+                   set val $default_val
+	       }
+           }
+	   set myObj [uplevel 1 set this]
+#puts stderr "myObj!$myObj!"
+           set ::itcl::internal::variables::${myObj}::itcl_options($opt) $val
+           set ::itcl::internal::variables::${myObj}::__itcl_option_infos($opt) [list $resource $class $default_val]
+#puts stderr "OPT1!$opt!$val!"
+	   uplevel 1 [list set itcl_options($opt) [list $val]]
+#           if {[catch {uplevel 1 $myObj configure $opt [list $val]} msg]} {
+#puts stderr "initoptions ERR!$msg!$my_class!$my_win!configure!$opt!$val!"
+#	   }
+        }
+    }
+#    uplevel 1 $opt_lst
+}
+
+# ========================= keepcomponentoption ======================
+#  Invoked by Tcl during evaluating constructor whenever
+#  the "keepcomponentoption" command is invoked to list the options
+#  to be kept when an ::itcl::extendedclass component has been setup
+#  for an object.
+#
+#  It checks, for all arguments, if the opt is an option of that class
+#  and of that component. If that is the case it adds the component name
+#  to the list of components for that option.
+#  The variable is the object variable: itcl_option_components($opt)
+#
+#  Handles the following syntax:
+#
+#    keepcomponentoption <componentName> <optionName> ?<optionName> ...?
+#
+# ======================================================================
+
+
+proc keepcomponentoption {args} {
+    upvar win win
+    upvar itcl_hull itcl_hull
+
+    set usage "wrong # args, should be: keepcomponentoption componentName optionName ?optionName ...?"
+
+#puts stderr "KEEP!$args![uplevel 1 namespace current]!"
+    if {[llength $args] < 2} {
+        puts stderr $usage
+	return -code error
+    }
+    set my_hull [uplevel 1 set itcl_hull]
+    set my_class [uplevel 1 namespace current]
+    set comp [lindex $args 0]
+    set args [lrange $args 1 end]
+    set class_info_dict [dict get $::itcl::internal::dicts::classComponents $my_class]
+    if {![dict exists $class_info_dict $comp]} {
+        puts stderr "keepcomponentoption cannot find component \"$comp\""
+	return -code error
+    }
+    set class_comp_dict [dict get $class_info_dict $comp]
+    if {![dict exists $class_comp_dict -keptoptions]} {
+        dict set class_comp_dict -keptoptions [list]
+    }
+    foreach opt $args {
+#puts stderr "KEEP!$opt!"
+	if {[string range $opt 0 0] ne "-"} {
+            puts stderr "keepcomponentoption: option must begin with a \"-\"!"
+	    return -code error
+	}
+        if {[lsearch [dict get $class_comp_dict -keptoptions] $opt] < 0} {
+            dict lappend class_comp_dict -keptoptions $opt
+	}
+    }
+    if {![info exists ::itcl::internal::component_objects([lindex [uplevel 1 info context] 1])]} {
+        set comp_object $::itcl::internal::component_objects([lindex [uplevel 1 info context] 1])
+    } else {
+        set comp_object "unknown_comp_obj_$comp!"
+    }
+    dict set class_info_dict $comp $class_comp_dict
+    dict set ::itcl::internal::dicts::classComponents $my_class $class_info_dict
+puts stderr "CLDI!$class_comp_dict!"
+    addToItclOptions $my_class $comp_object $args [list]
+}
+
+proc ignorecomponentoption {args} {
+puts stderr "IGNORE_COMPONENT_OPTION!$args!"
+}
+
+proc renamecomponentoption {args} {
+puts stderr "rename_COMPONENT_OPTION!$args!"
+}
+
+proc addoptioncomponent {args} {
+puts stderr "ADD_OPTION_COMPONENT!$args!"
+}
+
+proc ignoreoptioncomponent {args} {
+puts stderr "IGNORE_OPTION_COMPONENT!$args!"
+}
+
+proc renameoptioncomponent {args} {
+puts stderr "RENAME_OPTION_COMPONENT!$args!"
+}
+
+proc getEclassOptions {args} {
+    upvar win win
+
+#puts stderr "getEclassOptions!$args!$win![uplevel 1 namespace current]!"
+#parray ::itcl::internal::variables::${win}::itcl_options
+    set result [list]
+    foreach opt [array names ::itcl::internal::variables::${win}::itcl_options] {
+        if {[catch {
+            foreach {res cls def} [set ::itcl::internal::variables::${win}::__itcl_option_infos($opt)] break
+            lappend result [list $opt $res $cls $def [set ::itcl::internal::variables::${win}::itcl_options($opt)]]
+        } msg]} {
+        }
+    }
+    return $result
+}
+
+proc eclassConfigure {args} {
+    upvar win win
+
+#puts stderr "+++ eclassConfigure!$args!"
+    if {[llength $args] > 1} {
+        foreach {opt val}  $args break
+        if {[::info exists ::itcl::internal::variables::${win}::itcl_options($opt)]} {
+            set ::itcl::internal::variables::${win}::itcl_options($opt) $val
+	    return
+        }
+    } else {
+        foreach {opt}  $args break
+        if {[::info exists ::itcl::internal::variables::${win}::itcl_options($opt)]} {
+#puts stderr "OP![set ::itcl::internal::variables::${win}::itcl_options($opt)]!"
+            foreach {res cls def} [set ::itcl::internal::variables::${win}::__itcl_option_infos($opt)] break
+            return [list $opt $res $cls $def [set ::itcl::internal::variables::${win}::itcl_options($opt)]]
+        }
+    }
+    return -code error
+}
+
+}
diff --git a/Master/tlpkg/tltcl/lib/itcl4.2.1/itclWidget.tcl b/Master/tlpkg/tltcl/lib/itcl4.2.1/itclWidget.tcl
new file mode 100644
index 00000000000..5fcda510e09
--- /dev/null
+++ b/Master/tlpkg/tltcl/lib/itcl4.2.1/itclWidget.tcl
@@ -0,0 +1,447 @@
+#
+# itclWidget.tcl
+# ----------------------------------------------------------------------
+# Invoked automatically upon startup to customize the interpreter
+# for [incr Tcl] when one of ::itcl::widget or ::itcl::widgetadaptor is called.
+# ----------------------------------------------------------------------
+#   AUTHOR:  Arnulf P. Wiedemann
+#
+# ----------------------------------------------------------------------
+#            Copyright (c) 2008  Arnulf P. Wiedemann
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require Tk 8.6
+# package require itclwidget [set ::itcl::version]
+
+namespace eval ::itcl {
+
+proc widget {name args} {
+    set result [uplevel 1 ::itcl::internal::commands::genericclass widget $name $args]
+    # we handle create by owerselfs !! allow classunknown to handle that
+    oo::objdefine $result unexport create
+    return $result
+}
+
+proc widgetadaptor {name args} {
+    set result [uplevel 1 ::itcl::internal::commands::genericclass widgetadaptor $name $args]
+    # we handle create by owerselfs !! allow classunknown to handle that
+    oo::objdefine $result unexport create
+    return $result
+}
+
+} ; # end ::itcl
+
+
+namespace eval ::itcl::internal::commands {
+
+proc initWidgetOptions {varNsName widgetName className} {
+    set myDict [set ::itcl::internal::dicts::classOptions]
+    if {$myDict eq ""} {
+        return
+    }
+    if {![dict exists $myDict $className]} {
+        return
+    }
+    set myDict [dict get $myDict $className]
+    foreach option [dict keys $myDict] {
+        set infos [dict get $myDict $option]
+	set resource [dict get $infos -resource]
+	set class [dict get $infos -class]
+	set value [::option get $widgetName $resource $class]
+	if {$value eq ""} {
+	    if {[dict exists $infos -default]} {
+	        set defaultValue [dict get $infos -default]
+	        uplevel 1 set ${varNsName}::itcl_options($option) $defaultValue
+	    }
+	} else {
+	    uplevel 1 set ${varNsName}::itcl_options($option) $value
+	}
+    }
+}
+
+proc initWidgetDelegatedOptions {varNsName widgetName className args} {
+    set myDict [set ::itcl::internal::dicts::classDelegatedOptions]
+    if {$myDict eq ""} {
+        return
+    }
+    if {![dict exists $myDict $className]} {
+        return
+    }
+    set myDict [dict get $myDict $className]
+    foreach option [dict keys $myDict] {
+        set infos [dict get $myDict $option]
+	if {![dict exists $infos -resource]} {
+	    # this is the case when delegating "*"
+	    continue
+	}
+	if {![dict exists $infos -component]} {
+	    # nothing to do
+	    continue
+	}
+	# check if not in the command line options
+	# these have higher priority
+	set myOption $option
+	if {[dict exists $infos -as]} {
+	   set myOption [dict get $infos -as]
+	}
+	set noOptionSet 0
+	foreach {optName optVal} $args {
+	    if {$optName eq $myOption} {
+	        set noOptionSet 1
+		break
+	    }
+	}
+	if {$noOptionSet} {
+	    continue
+	}
+	set resource [dict get $infos -resource]
+	set class [dict get $infos -class]
+	set component [dict get $infos -component]
+	set value [::option get $widgetName $resource $class]
+	if {$component ne ""} {
+	    if {$value ne ""} {
+		set compVar [namespace eval ${varNsName}${className} "set $component"]
+		if {$compVar ne ""} {
+	            uplevel 1 $compVar configure $myOption $value
+	        }
+	    }
+	}
+    }
+}
+
+proc widgetinitobjectoptions {varNsName widgetName className} {
+#puts stderr "initWidgetObjectOptions!$varNsName!$widgetName!$className!"
+}
+
+proc deletehull {newName oldName what} {
+    if {$what eq "delete"} {
+        set name [namespace tail $newName]
+        regsub {hull[0-9]+} $name {} name
+        rename $name {}
+    }
+    if {$what eq "rename"} {
+        set name [namespace tail $newName]
+        regsub {hull[0-9]+} $name {} name
+        rename $name {}
+    }
+}
+
+proc hullandoptionsinstall {objectName className widgetClass hulltype args} {
+    if {$hulltype eq ""} {
+        set hulltype frame
+    }
+    set idx 0
+    set found 0
+    foreach {optName optValue} $args {
+	if {$optName eq "-class"} {
+	    set found 1
+	    set widgetClass $optValue
+	    break
+	}
+        incr idx
+    }
+    if {$found} {
+        set args [lreplace $args $idx [expr {$idx + 1}]]
+    }
+    if {$widgetClass eq ""} {
+        set widgetClass $className
+	set widgetClass [string totitle $widgetClass]
+    }
+    set cmd "set win $objectName; ::itcl::builtin::installhull using $hulltype -class $widgetClass $args"
+    uplevel 2 $cmd
+}
+
+} ; # end ::itcl::internal::commands
+
+namespace eval ::itcl::builtin {
+
+proc installhull {args} {
+    set cmdPath ::itcl::internal::commands
+    set className [uplevel 1 info class]
+
+    set replace 0
+    switch -- [llength $args] {
+	0	{
+		return -code error\
+		"wrong # args: should be \"[lindex [info level 0] 0]\
+		name|using <widgetType> ?arg ...?\""
+	}
+	1	{
+		set widgetName [lindex $args 0]
+		set varNsName $::itcl::internal::varNsName($widgetName)
+	}
+	default	{
+		upvar win win
+		set widgetName $win
+
+		set varNsName $::itcl::internal::varNsName($widgetName)
+	        set widgetType [lindex $args 1]
+		incr replace
+		if {[llength $args] > 3 && [lindex $args 2] eq "-class"} {
+		    set classNam [lindex $args 3]
+		    incr replace 2
+		} else {
+		    set classNam [string totitle $widgetType]
+		}
+		uplevel 1 [lreplace $args 0 $replace $widgetType $widgetName -class $classNam]
+		uplevel 1 [list ${cmdPath}::initWidgetOptions $varNsName $widgetName $className]
+	}
+    }
+
+    # initialize the itcl_hull variable
+    set i 0
+    set nam ::itcl::internal::widgets::hull
+    while {1} {
+         incr i
+	 set hullNam ${nam}${i}$widgetName
+	 if {[::info command $hullNam] eq ""} {
+	     break
+	}
+    }
+    uplevel 1 [list ${cmdPath}::sethullwindowname $widgetName]
+    uplevel 1 [list ::rename $widgetName $hullNam]
+    uplevel 1 [list ::trace add command $hullNam {delete rename} ::itcl::internal::commands::deletehull]
+    catch {${cmdPath}::checksetitclhull [list] 0}
+    namespace eval ${varNsName}${className} "set itcl_hull $hullNam"
+    catch {${cmdPath}::checksetitclhull [list] 2}
+    uplevel 1 [lreplace $args 0 $replace ${cmdPath}::initWidgetDelegatedOptions $varNsName $widgetName $className]
+}
+
+proc installcomponent {args} {
+    upvar win win
+
+    set className [uplevel 1 info class]
+    set myType [${className}::info types [namespace tail $className]]
+    set isType 0
+    if {$myType ne ""} {
+        set isType 1
+    }
+    set numArgs [llength $args]
+    set usage "usage: installcomponent <componentName> using <widgetType> <widgetPath> ?-option value ...?"
+    if {$numArgs < 4} {
+        error $usage
+    }
+    foreach {componentName using widgetType widgetPath} $args break
+    set opts [lrange $args 4 end]
+    if {$using ne "using"} {
+        error $usage
+    }
+    if {!$isType} {
+        set hullExists [uplevel 1 ::info exists itcl_hull]
+        if {!$hullExists} {
+            error "cannot install \"$componentName\" before \"itcl_hull\" exists"
+        }
+        set hullVal [uplevel 1 set itcl_hull]
+        if {$hullVal eq ""} {
+            error "cannot install \"$componentName\" before \"itcl_hull\" exists"
+        }
+    }
+    # check for delegated option and ask the option database for the values
+    # first check for number of delegated options
+    set numOpts 0
+    set starOption 0
+    set myDict [set ::itcl::internal::dicts::classDelegatedOptions]
+    if {[dict exists $myDict $className]} {
+        set myDict [dict get $myDict $className]
+	foreach option [dict keys $myDict] {
+	    if {$option eq "*"} {
+	        set starOption 1
+	    }
+	    incr numOpts
+	}
+    }
+    set myOptionDict [set ::itcl::internal::dicts::classOptions]
+    if {[dict exists $myOptionDict $className]} {
+        set myOptionDict [dict get $myOptionDict $className]
+    }
+    set cmd [list $widgetPath configure]
+    set cmd1 "set $componentName \[$widgetType $widgetPath\]"
+    uplevel 1 $cmd1
+    if {$starOption} {
+	upvar $componentName compName
+	set cmd1 [list $compName configure]
+        set configInfos [uplevel 1 $cmd1]
+	foreach entry $configInfos {
+	    if {[llength $entry] > 2} {
+	        foreach {optName resource class defaultValue} $entry break
+		set val ""
+		catch {
+		    set val [::option get $win $resource $class]
+		}
+		if {$val ne ""} {
+		    set addOpt 1
+		    if {[dict exists $myDict $$optName]} {
+		        set addOpt 0
+		    } else {
+		        set starDict [dict get $myDict "*"]
+			if {[dict exists $starDict -except]} {
+			    set exceptions [dict get $starDict -except]
+			    if {[lsearch $exceptions $optName] >= 0} {
+			        set addOpt 0
+			    }
+
+			}
+			if {[dict exists $myOptionDict $optName]} {
+			    set addOpt 0
+			}
+                    }
+		    if {$addOpt} {
+		        lappend cmd $optName $val
+		    }
+
+		}
+
+	    }
+        }
+    } else {
+        foreach optName [dict keys $myDict] {
+	    set optInfos [dict get $myDict $optName]
+	    set resource [dict get $optInfos -resource]
+	    set class [namespace tail $className]
+	    set class [string totitle $class]
+	    set val ""
+	    catch {
+	        set val [::option get $win $resource $class]
+            }
+	    if {$val ne ""} {
+		if {[dict exists $optInfos -as] } {
+	            set optName [dict get $optInfos -as]
+		}
+		lappend cmd $optName $val
+	    }
+	}
+    }
+    lappend cmd {*}$opts
+    uplevel 1 $cmd
+}
+
+} ; # end ::itcl::builtin
+
+set ::itcl::internal::dicts::hullTypes [list \
+       frame \
+       toplevel \
+       labelframe \
+       ttk:frame \
+       ttk:toplevel \
+       ttk:labelframe \
+    ]
+
+namespace eval ::itcl::builtin::Info {
+
+proc hulltypes {args} {
+    namespace upvar ::itcl::internal::dicts hullTypes hullTypes
+
+    set numArgs [llength $args]
+    if {$numArgs > 1} {
+        error "wrong # args should be: info hulltypes ?<pattern>?"
+    }
+    set pattern ""
+    if {$numArgs > 0} {
+        set pattern [lindex $args 0]
+    }
+    if {$pattern ne ""} {
+        return [lsearch -all -inline -glob $hullTypes $pattern]
+    }
+    return $hullTypes
+
+}
+
+proc widgetclasses {args} {
+    set numArgs [llength $args]
+    if {$numArgs > 1} {
+        error "wrong # args should be: info widgetclasses ?<pattern>?"
+    }
+    set pattern ""
+    if {$numArgs > 0} {
+        set pattern [lindex $args 0]
+    }
+    set myDict [set ::itcl::internal::dicts::classes]
+    if {![dict exists $myDict widget]} {
+        return [list]
+    }
+    set myDict [dict get $myDict widget]
+    set result [list]
+    if {$pattern ne ""} {
+        foreach key [dict keys $myDict] {
+	    set myInfo [dict get $myDict $key]
+	    set value [dict get $myInfo -widget]
+	    if {[string match $pattern $value]} {
+	        lappend result $value
+            }
+        }
+    } else {
+        foreach key [dict keys $myDict] {
+	    set myInfo [dict get $myDict $key]
+	    lappend result [dict get $myInfo -widget]
+	}
+    }
+    return $result
+}
+
+proc widgets {args} {
+    set numArgs [llength $args]
+    if {$numArgs > 1} {
+        error "wrong # args should be: info widgets ?<pattern>?"
+    }
+    set pattern ""
+    if {$numArgs > 0} {
+        set pattern [lindex $args 0]
+    }
+    set myDict [set ::itcl::internal::dicts::classes]
+    if {![dict exists $myDict widget]} {
+        return [list]
+    }
+    set myDict [dict get $myDict widget]
+    set result [list]
+    if {$pattern ne ""} {
+        foreach key [dict keys $myDict] {
+	    set myInfo [dict get $myDict $key]
+	    set value [dict get $myInfo -name]
+	    if {[string match $pattern $value]} {
+	        lappend result $value
+            }
+        }
+    } else {
+        foreach key [dict keys $myDict] {
+	    set myInfo [dict get $myDict $key]
+	    lappend result [dict get $myInfo -name]
+	}
+    }
+    return $result
+}
+
+proc widgetadaptors {args} {
+    set numArgs [llength $args]
+    if {$numArgs > 1} {
+        error "wrong # args should be: info widgetadaptors ?<pattern>?"
+    }
+    set pattern ""
+    if {$numArgs > 0} {
+        set pattern [lindex $args 0]
+    }
+    set myDict [set ::itcl::internal::dicts::classes]
+    if {![dict exists $myDict widgetadaptor]} {
+        return [list]
+    }
+    set myDict [dict get $myDict widgetadaptor]
+    set result [list]
+    if {$pattern ne ""} {
+        foreach key [dict keys $myDict] {
+	    set myInfo [dict get $myDict $key]
+	    set value [dict get $myInfo -name]
+	    if {[string match $pattern $value]} {
+	        lappend result $value
+            }
+        }
+    } else {
+        foreach key [dict keys $myDict] {
+	    set myInfo [dict get $myDict $key]
+	    lappend result [dict get $myInfo -name]
+	}
+    }
+    return $result
+}
+
+} ; # end ::itcl::builtin::Info
diff --git a/Master/tlpkg/tltcl/lib/itcl4.2.1/libitclstub421.a b/Master/tlpkg/tltcl/lib/itcl4.2.1/libitclstub421.a
new file mode 100644
index 00000000000..c070af8e7e7
--- /dev/null
+++ b/Master/tlpkg/tltcl/lib/itcl4.2.1/libitclstub421.a
diff --git a/Master/tlpkg/tltcl/lib/itcl4.2.1/pkgIndex.tcl b/Master/tlpkg/tltcl/lib/itcl4.2.1/pkgIndex.tcl
new file mode 100644
index 00000000000..4526cae8a10
--- /dev/null
+++ b/Master/tlpkg/tltcl/lib/itcl4.2.1/pkgIndex.tcl
@@ -0,0 +1,21 @@
+# Tcl package index file, version 1.0
+#
+# Do NOT try this command
+#
+#   if {![package vsatisfies [package provide Tcl] 8.6-]} {return}
+#
+# as a way to accept working with all of Tcl 8.6, Tcl 8.X, X>6, and
+# Tcl Y, for Y > 8.
+# Itcl is a binary package, added to an interp with [load].
+# There is no libitcl.so that will [load] into both Tcl 8 and Tcl 9.
+# The indexed libitcl.so was built to [load] into one or the other.
+# Thus the pkgIndex.tcl should only accept the version of Tcl for which
+# the indexed itcl421.dll was built.
+#
+# More work replacing the literal "8.6" below with the proper value substituted
+# by configure is the right way forward.
+
+if {![package vsatisfies [package provide Tcl] 8.6]} {return}
+
+package ifneeded itcl 4.2.1 [list load [file join $dir "itcl421.dll"] Itcl]
+package ifneeded Itcl 4.2.1 [list load [file join $dir "itcl421.dll"] Itcl]