#!/usr/bin/env tclsh
#
# -- tcl module generated by mk_tmModule
#
if {[file exists "/tmp"]} {set tmpdir "/tmp"}
catch {set tmpdir $::env(TMP)}
catch {set tmpdir $::env(TEMP)}
set fd [open [info script] r]
fconfigure $fd -translation binary
set data [read $fd]
close $fd
set startIndex [string first \u001A $data]
incr startIndex

#-- From snit2.tmp
#-----------------------------------------------------------------------
# TITLE:
#	snit2.tcl
#
# AUTHOR:
#	Will Duquette
#
# DESCRIPTION:
#       Snit's Not Incr Tcl, a simple object system in Pure Tcl.
#
#       Snit 2.x Loader
#
#       Copyright (C) 2003-2006 by William H. Duquette
#       This code is licensed as described in license.txt.
#
#-----------------------------------------------------------------------

package require Tcl 8.5

# Define the snit namespace and save the library directory

namespace eval ::snit:: {
    set library [file dirname [info script]]
}

# Load the kernel.

# Load the library of Snit validation types.

package provide snit 2.3.2

#-- From main2.tcl
#-----------------------------------------------------------------------
# TITLE:
#	main2.tcl
#
# AUTHOR:
#	Will Duquette
#
# DESCRIPTION:
#       Snit's Not Incr Tcl, a simple object system in Pure Tcl.
#
#       Snit 2.x Compiler and Run-Time Library
#
#       Copyright (C) 2003-2006 by William H. Duquette
#       This code is licensed as described in license.txt.
#
#-----------------------------------------------------------------------

#-----------------------------------------------------------------------
# Namespace

namespace eval ::snit:: {
    namespace export \
        compile type widget widgetadaptor typemethod method macro
}

#-----------------------------------------------------------------------
# Some Snit variables

namespace eval ::snit:: {
    variable reservedArgs {type selfns win self}

    # Widget classes which can be hulls (must have -class)
    variable hulltypes {
	toplevel tk::toplevel
	frame tk::frame ttk::frame
	labelframe tk::labelframe ttk::labelframe
    }
}

#-----------------------------------------------------------------------
# Snit Type Implementation template

namespace eval ::snit:: {
    # Template type definition: All internal and user-visible Snit
    # implementation code.
    #
    # The following placeholders will automatically be replaced with
    # the client's code, in two passes:
    #
    # First pass:
    # %COMPILEDDEFS%  The compiled type definition.
    #
    # Second pass:
    # %TYPE%          The fully qualified type name.
    # %IVARDECS%      Instance variable declarations
    # %TVARDECS%      Type variable declarations
    # %TCONSTBODY%    Type constructor body
    # %INSTANCEVARS%  The compiled instance variable initialization code.
    # %TYPEVARS%      The compiled type variable initialization code.

    # This is the overall type template.
    variable typeTemplate

    # This is the normal type proc
    variable nominalTypeProc

    # This is the "-hastypemethods no" type proc
    variable simpleTypeProc
}

set ::snit::typeTemplate {

    #-------------------------------------------------------------------
    # The type's namespace definition and the user's type variables

    namespace eval %TYPE% {%TYPEVARS%
    }

    #----------------------------------------------------------------
    # Commands for use in methods, typemethods, etc.
    #
    # These are implemented as aliases into the Snit runtime library.

    interp alias {} %TYPE%::installhull  {} ::snit::RT.installhull %TYPE%
    interp alias {} %TYPE%::install      {} ::snit::RT.install %TYPE%
    interp alias {} %TYPE%::typevariable {} ::variable
    interp alias {} %TYPE%::variable     {} ::snit::RT.variable
    interp alias {} %TYPE%::mytypevar    {} ::snit::RT.mytypevar %TYPE%
    interp alias {} %TYPE%::typevarname  {} ::snit::RT.mytypevar %TYPE%
    interp alias {} %TYPE%::myvar        {} ::snit::RT.myvar
    interp alias {} %TYPE%::varname      {} ::snit::RT.myvar
    interp alias {} %TYPE%::codename     {} ::snit::RT.codename %TYPE%
    interp alias {} %TYPE%::myproc       {} ::snit::RT.myproc %TYPE%
    interp alias {} %TYPE%::mymethod     {} ::snit::RT.mymethod 
    interp alias {} %TYPE%::mytypemethod {} ::snit::RT.mytypemethod %TYPE%
    interp alias {} %TYPE%::from         {} ::snit::RT.from %TYPE%

    #-------------------------------------------------------------------
    # Snit's internal variables

    namespace eval %TYPE% {
        # Array: General Snit Info
        #
        # ns:                The type's namespace
        # hasinstances:      T or F, from pragma -hasinstances.
        # simpledispatch:    T or F, from pragma -hasinstances.
        # canreplace:        T or F, from pragma -canreplace.
        # counter:           Count of instances created so far.
        # widgetclass:       Set by widgetclass statement.
        # hulltype:          Hull type (frame or toplevel) for widgets only.
        # exceptmethods:     Methods explicitly not delegated to *
        # excepttypemethods: Methods explicitly not delegated to *
        # tvardecs:          Type variable declarations--for dynamic methods
        # ivardecs:          Instance variable declarations--for dyn. methods
        typevariable Snit_info
        set Snit_info(ns)      %TYPE%::
        set Snit_info(hasinstances) 1
        set Snit_info(simpledispatch) 0
        set Snit_info(canreplace) 0
        set Snit_info(counter) 0
        set Snit_info(widgetclass) {}
        set Snit_info(hulltype) frame
        set Snit_info(exceptmethods) {}
        set Snit_info(excepttypemethods) {}
        set Snit_info(tvardecs) {%TVARDECS%}
        set Snit_info(ivardecs) {%IVARDECS%}

        # Array: Public methods of this type.
        # The index is the method name, or "*".
        # The value is [list $pattern $componentName], where
        # $componentName is "" for normal methods.
        typevariable Snit_typemethodInfo
        array unset Snit_typemethodInfo

        # Array: Public methods of instances of this type.
        # The index is the method name, or "*".
        # The value is [list $pattern $componentName], where
        # $componentName is "" for normal methods.
        typevariable Snit_methodInfo
        array unset Snit_methodInfo

        # Array: option information.  See dictionary.txt.
        typevariable Snit_optionInfo
        array unset Snit_optionInfo
        set Snit_optionInfo(local)     {}
        set Snit_optionInfo(delegated) {}
        set Snit_optionInfo(starcomp)  {}
        set Snit_optionInfo(except)    {}
    }

    #----------------------------------------------------------------
    # Compiled Procs
    #
    # These commands are created or replaced during compilation:


    # Snit_instanceVars selfns
    #
    # Initializes the instance variables, if any.  Called during
    # instance creation.
    
    proc %TYPE%::Snit_instanceVars {selfns} {
        %INSTANCEVARS%
    }

    # Type Constructor
    proc %TYPE%::Snit_typeconstructor {type} {
        %TVARDECS%
        namespace path [namespace parent $type]
        %TCONSTBODY%
    }

    #----------------------------------------------------------------
    # Default Procs
    #
    # These commands might be replaced during compilation:

    # Snit_destructor type selfns win self
    #
    # Default destructor for the type.  By default, it does
    # nothing.  It's replaced by any user destructor.
    # For types, it's called by method destroy; for widgettypes,
    # it's called by a destroy event handler.

    proc %TYPE%::Snit_destructor {type selfns win self} { }

    #----------------------------------------------------------
    # Compiled Definitions

    %COMPILEDDEFS%

    #----------------------------------------------------------
    # Finally, call the Type Constructor

    %TYPE%::Snit_typeconstructor %TYPE%
}

#-----------------------------------------------------------------------
# Type procs
#
# These procs expect the fully-qualified type name to be 
# substituted in for %TYPE%.

# This is the nominal type proc.  It supports typemethods and
# delegated typemethods.
set ::snit::nominalTypeProc {
    # WHD: Code for creating the type ensemble
    namespace eval %TYPE% {
        namespace ensemble create \
            -unknown [list ::snit::RT.UnknownTypemethod %TYPE% ""] \
            -prefixes 0
    }
}

# This is the simplified type proc for when there are no typemethods
# except create.  In this case, it doesn't take a method argument;
# the method is always "create".
set ::snit::simpleTypeProc {
    # Type dispatcher function.  Note: This function lives
    # in the parent of the %TYPE% namespace!  All accesses to 
    # %TYPE% variables and methods must be qualified!
    proc %TYPE% {args} {
        ::variable %TYPE%::Snit_info

        # FIRST, if the are no args, the single arg is %AUTO%
        if {[llength $args] == 0} {
            if {$Snit_info(isWidget)} {
                error "wrong \# args: should be \"%TYPE% name args\""
            }
            
            lappend args %AUTO%
        }

        # NEXT, we're going to call the create method.
        # Pass along the return code unchanged.
        if {$Snit_info(isWidget)} {
            set command [list ::snit::RT.widget.typemethod.create %TYPE%]
        } else {
            set command [list ::snit::RT.type.typemethod.create %TYPE%]
        }

        set retval [catch {uplevel 1 $command $args} result]

        if {$retval} {
            if {$retval == 1} {
                global errorInfo
                global errorCode
                return -code error -errorinfo $errorInfo \
                    -errorcode $errorCode $result
            } else {
                return -code $retval $result
            }
        }

        return $result
    }
}

#=======================================================================
# Snit Type Definition
#
# These are the procs used to define Snit types, widgets, and 
# widgetadaptors.


#-----------------------------------------------------------------------
# Snit Compilation Variables
#
# The following variables are used while Snit is compiling a type,
# and are disposed afterwards.

namespace eval ::snit:: {
    # The compiler variable contains the name of the slave interpreter
    # used to compile type definitions.
    variable compiler ""

    # The compile array accumulates information about the type or
    # widgettype being compiled.  It is cleared before and after each
    # compilation.  It has these indices:
    #
    # type:                  The name of the type being compiled, for use
    #                        in compilation procs.
    # defs:                  Compiled definitions, both standard and client.
    # which:                 type, widget, widgetadaptor
    # instancevars:          Instance variable definitions and initializations.
    # ivprocdec:             Instance variable proc declarations.
    # tvprocdec:             Type variable proc declarations.
    # typeconstructor:       Type constructor body.
    # widgetclass:           The widgetclass, for snit::widgets, only
    # hasoptions:            False, initially; set to true when first
    #                        option is defined.
    # localoptions:          Names of local options.
    # delegatedoptions:      Names of delegated options.
    # localmethods:          Names of locally defined methods.
    # delegatesmethods:      no if no delegated methods, yes otherwise.
    # hashierarchic       :  no if no hierarchic methods, yes otherwise.
    # components:            Names of defined components.
    # typecomponents:        Names of defined typecomponents.
    # typevars:              Typevariable definitions and initializations.
    # varnames:              Names of instance variables
    # typevarnames           Names of type variables
    # hasconstructor         False, initially; true when constructor is
    #                        defined.
    # resource-$opt          The option's resource name
    # class-$opt             The option's class
    # -default-$opt          The option's default value
    # -validatemethod-$opt   The option's validate method
    # -configuremethod-$opt  The option's configure method
    # -cgetmethod-$opt       The option's cget method.
    # -hastypeinfo           The -hastypeinfo pragma
    # -hastypedestroy        The -hastypedestroy pragma
    # -hastypemethods        The -hastypemethods pragma
    # -hasinfo               The -hasinfo pragma
    # -hasinstances          The -hasinstances pragma
    # -simpledispatch        The -simpledispatch pragma WHD: OBSOLETE
    # -canreplace            The -canreplace pragma
    variable compile

    # This variable accumulates method dispatch information; it has
    # the same structure as the %TYPE%::Snit_methodInfo array, and is
    # used to initialize it.
    variable methodInfo

    # This variable accumulates typemethod dispatch information; it has
    # the same structure as the %TYPE%::Snit_typemethodInfo array, and is
    # used to initialize it.
    variable typemethodInfo

    # The following variable lists the reserved type definition statement
    # names, e.g., the names you can't use as macros.  It's built at
    # compiler definition time using "info commands".
    variable reservedwords {}
}

#-----------------------------------------------------------------------
# type compilation commands
#
# The type and widgettype commands use a slave interpreter to compile
# the type definition.  These are the procs
# that are aliased into it.

# Initialize the compiler
proc ::snit::Comp.Init {} {
    variable compiler
    variable reservedwords

    if {$compiler eq ""} {
        # Create the compiler's interpreter
        set compiler [interp create]

        # Initialize the interpreter
	$compiler eval {
	    catch {close stdout}
	    catch {close stderr}
	    catch {close stdin}

            # Load package information
            # TBD: see if this can be moved outside.
	    # @mdgen NODEP: ::snit::__does_not_exist__
            catch {package require ::snit::__does_not_exist__}

            # Protect some Tcl commands our type definitions
            # will shadow.
            rename proc _proc
            rename variable _variable
        }

        # Define compilation aliases.
        $compiler alias pragma          ::snit::Comp.statement.pragma
        $compiler alias widgetclass     ::snit::Comp.statement.widgetclass
        $compiler alias hulltype        ::snit::Comp.statement.hulltype
        $compiler alias constructor     ::snit::Comp.statement.constructor
        $compiler alias destructor      ::snit::Comp.statement.destructor
        $compiler alias option          ::snit::Comp.statement.option
        $compiler alias oncget          ::snit::Comp.statement.oncget
        $compiler alias onconfigure     ::snit::Comp.statement.onconfigure
        $compiler alias method          ::snit::Comp.statement.method
        $compiler alias typemethod      ::snit::Comp.statement.typemethod
        $compiler alias typeconstructor ::snit::Comp.statement.typeconstructor
        $compiler alias proc            ::snit::Comp.statement.proc
        $compiler alias typevariable    ::snit::Comp.statement.typevariable
        $compiler alias variable        ::snit::Comp.statement.variable
        $compiler alias typecomponent   ::snit::Comp.statement.typecomponent
        $compiler alias component       ::snit::Comp.statement.component
        $compiler alias delegate        ::snit::Comp.statement.delegate
        $compiler alias expose          ::snit::Comp.statement.expose

        # Get the list of reserved words
        set reservedwords [$compiler eval {info commands}]
    }
}

# Compile a type definition, and return the results as a list of two
# items: the fully-qualified type name, and a script that will define
# the type when executed.
#
# which		type, widget, or widgetadaptor
# type          the type name
# body          the type definition
proc ::snit::Comp.Compile {which type body} {
    variable typeTemplate
    variable nominalTypeProc
    variable simpleTypeProc
    variable compile
    variable compiler
    variable methodInfo
    variable typemethodInfo

    # FIRST, qualify the name.
    if {![string match "::*" $type]} {
        # Get caller's namespace; 
        # append :: if not global namespace.
        set ns [uplevel 2 [list namespace current]]
        if {"::" != $ns} {
            append ns "::"
        }
        
        set type "$ns$type"
    }

    # NEXT, create and initialize the compiler, if needed.
    Comp.Init

    # NEXT, initialize the class data
    array unset methodInfo
    array unset typemethodInfo

    array unset compile
    set compile(type) $type
    set compile(defs) {}
    set compile(which) $which
    set compile(hasoptions) no
    set compile(localoptions) {}
    set compile(instancevars) {}
    set compile(typevars) {}
    set compile(delegatedoptions) {}
    set compile(ivprocdec) {}
    set compile(tvprocdec) {}
    set compile(typeconstructor) {}
    set compile(widgetclass) {}
    set compile(hulltype) {}
    set compile(localmethods) {}
    set compile(delegatesmethods) no
    set compile(hashierarchic) no
    set compile(components) {}
    set compile(typecomponents) {}
    set compile(varnames) {}
    set compile(typevarnames) {}
    set compile(hasconstructor) no
    set compile(-hastypedestroy) yes
    set compile(-hastypeinfo) yes
    set compile(-hastypemethods) yes
    set compile(-hasinfo) yes
    set compile(-hasinstances) yes
    set compile(-canreplace) no

    set isWidget [string match widget* $which]
    set isWidgetAdaptor [string match widgetadaptor $which]

    # NEXT, Evaluate the type's definition in the class interpreter.
    $compiler eval $body

    # NEXT, Add the standard definitions
    append compile(defs) \
        "\nset %TYPE%::Snit_info(isWidget) $isWidget\n"

    append compile(defs) \
        "\nset %TYPE%::Snit_info(isWidgetAdaptor) $isWidgetAdaptor\n"

    # Indicate whether the type can create instances that replace
    # existing commands.
    append compile(defs) "\nset %TYPE%::Snit_info(canreplace) $compile(-canreplace)\n"


    # Check pragmas for conflict.
    
    if {!$compile(-hastypemethods) && !$compile(-hasinstances)} {
        error "$which $type has neither typemethods nor instances"
    }

    # If there are typemethods, define the standard typemethods and
    # the nominal type proc.  Otherwise define the simple type proc.
    if {$compile(-hastypemethods)} {
        # Add the info typemethod unless the pragma forbids it.
        if {$compile(-hastypeinfo)} {
            Comp.statement.delegate typemethod info \
                using {::snit::RT.typemethod.info %t}
        }

        # Add the destroy typemethod unless the pragma forbids it.
        if {$compile(-hastypedestroy)} {
            Comp.statement.delegate typemethod destroy \
                using {::snit::RT.typemethod.destroy %t}
        }

        # Add the nominal type proc.
        append compile(defs) $nominalTypeProc
    } else {
        # Add the simple type proc.
        append compile(defs) $simpleTypeProc
    }

    # Add standard methods/typemethods that only make sense if the
    # type has instances.
    if {$compile(-hasinstances)} {
        # Add the info method unless the pragma forbids it.
        if {$compile(-hasinfo)} {
            Comp.statement.delegate method info \
                using {::snit::RT.method.info %t %n %w %s}
        }
        
        # Add the option handling stuff if there are any options.
        if {$compile(hasoptions)} {
            Comp.statement.variable options

            Comp.statement.delegate method cget \
                using {::snit::RT.method.cget %t %n %w %s}
            Comp.statement.delegate method configurelist \
                using {::snit::RT.method.configurelist %t %n %w %s}
            Comp.statement.delegate method configure \
                using {::snit::RT.method.configure %t %n %w %s}
        }

        # Add a default constructor, if they haven't already defined one.
        # If there are options, it will configure args; otherwise it
        # will do nothing.
        if {!$compile(hasconstructor)} {
            if {$compile(hasoptions)} {
                Comp.statement.constructor {args} {
                    $self configurelist $args
                }
            } else {
                Comp.statement.constructor {} {}
            }
        }
        
        if {!$isWidget} {
            Comp.statement.delegate method destroy \
                using {::snit::RT.method.destroy %t %n %w %s}

            Comp.statement.delegate typemethod create \
                using {::snit::RT.type.typemethod.create %t}
        } else {
            Comp.statement.delegate typemethod create \
                using {::snit::RT.widget.typemethod.create %t}
        }

        # Save the method info. 
        append compile(defs) \
            "\narray set %TYPE%::Snit_methodInfo [list [array get methodInfo]]\n"
    } else {
        append compile(defs) "\nset %TYPE%::Snit_info(hasinstances) 0\n"
    }

    # NEXT, compiling the type definition built up a set of information
    # about the type's locally defined options; add this information to
    # the compiled definition.
    Comp.SaveOptionInfo

    # NEXT, compiling the type definition built up a set of information
    # about the typemethods; save the typemethod info.
    append compile(defs) \
        "\narray set %TYPE%::Snit_typemethodInfo [list [array get typemethodInfo]]\n"

    # NEXT, if this is a widget define the hull component if it isn't
    # already defined.
    if {$isWidget} {
        Comp.DefineComponent hull
    }

    # NEXT, substitute the compiled definition into the type template
    # to get the type definition script.
    set defscript [Expand $typeTemplate \
                       %COMPILEDDEFS% $compile(defs)]

    # NEXT, substitute the defined macros into the type definition script.
    # This is done as a separate step so that the compile(defs) can 
    # contain the macros defined below.

    set defscript [Expand $defscript \
                       %TYPE%         $type \
                       %IVARDECS%     $compile(ivprocdec) \
                       %TVARDECS%     $compile(tvprocdec) \
                       %TCONSTBODY%   $compile(typeconstructor) \
                       %INSTANCEVARS% $compile(instancevars) \
                       %TYPEVARS%     $compile(typevars) \
		       ]

    array unset compile

    return [list $type $defscript]
}

# Information about locally-defined options is accumulated during
# compilation, but not added to the compiled definition--the option
# statement can appear multiple times, so it's easier this way.
# This proc fills in Snit_optionInfo with the accumulated information.
#
# It also computes the option's resource and class names if needed.
#
# Note that the information for delegated options was put in 
# Snit_optionInfo during compilation.

proc ::snit::Comp.SaveOptionInfo {} {
    variable compile

    foreach option $compile(localoptions) {
        if {$compile(resource-$option) eq ""} {
            set compile(resource-$option) [string range $option 1 end]
        }

        if {$compile(class-$option) eq ""} {
            set compile(class-$option) [Capitalize $compile(resource-$option)]
        }

        # NOTE: Don't verify that the validate, configure, and cget 
        # values name real methods; the methods might be defined outside 
        # the typedefinition using snit::method.
        
        Mappend compile(defs) {
            # Option %OPTION%
            lappend %TYPE%::Snit_optionInfo(local) %OPTION%

            set %TYPE%::Snit_optionInfo(islocal-%OPTION%)   1
            set %TYPE%::Snit_optionInfo(resource-%OPTION%)  %RESOURCE%
            set %TYPE%::Snit_optionInfo(class-%OPTION%)     %CLASS%
            set %TYPE%::Snit_optionInfo(default-%OPTION%)   %DEFAULT%
            set %TYPE%::Snit_optionInfo(validate-%OPTION%)  %VALIDATE%
            set %TYPE%::Snit_optionInfo(configure-%OPTION%) %CONFIGURE%
            set %TYPE%::Snit_optionInfo(cget-%OPTION%)      %CGET%
            set %TYPE%::Snit_optionInfo(readonly-%OPTION%)  %READONLY%
            set %TYPE%::Snit_optionInfo(typespec-%OPTION%)  %TYPESPEC%
        }   %OPTION%    $option \
            %RESOURCE%  $compile(resource-$option) \
            %CLASS%     $compile(class-$option) \
            %DEFAULT%   [list $compile(-default-$option)] \
            %VALIDATE%  [list $compile(-validatemethod-$option)] \
            %CONFIGURE% [list $compile(-configuremethod-$option)] \
            %CGET%      [list $compile(-cgetmethod-$option)] \
            %READONLY%  $compile(-readonly-$option)               \
            %TYPESPEC%  [list $compile(-type-$option)]
    }
}


# Evaluates a compiled type definition, thus making the type available.
proc ::snit::Comp.Define {compResult} {
    # The compilation result is a list containing the fully qualified
    # type name and a script to evaluate to define the type.
    set type [lindex $compResult 0]
    set defscript [lindex $compResult 1]

    # Execute the type definition script.
    # Consider using namespace eval %TYPE%.  See if it's faster.
    if {[catch {eval $defscript} result]} {
        namespace delete $type
        catch {rename $type ""}
        error $result
    }

    return $type
}

# Sets pragma options which control how the type is defined.
proc ::snit::Comp.statement.pragma {args} {
    variable compile

    set errRoot "Error in \"pragma...\""

    foreach {opt val} $args {
        switch -exact -- $opt {
            -hastypeinfo    -
            -hastypedestroy -
            -hastypemethods -
            -hasinstances   -
            -simpledispatch -
            -hasinfo        -
            -canreplace     {
                if {![string is boolean -strict $val]} {
                    error "$errRoot, \"$opt\" requires a boolean value"
                }
                set compile($opt) $val
            }
            default {
                error "$errRoot, unknown pragma"
            }
        }
    }
}

# Defines a widget's option class name.  
# This statement is only available for snit::widgets,
# not for snit::types or snit::widgetadaptors.
proc ::snit::Comp.statement.widgetclass {name} {
    variable compile

    # First, widgetclass can only be set for true widgets
    if {"widget" != $compile(which)} {
        error "widgetclass cannot be set for snit::$compile(which)s"
    }

    # Next, validate the option name.  We'll require that it begin
    # with an uppercase letter.
    set initial [string index $name 0]
    if {![string is upper $initial]} {
        error "widgetclass \"$name\" does not begin with an uppercase letter"
    }

    if {"" != $compile(widgetclass)} {
        error "too many widgetclass statements"
    }

    # Next, save it.
    Mappend compile(defs) {
        set  %TYPE%::Snit_info(widgetclass) %WIDGETCLASS%
    } %WIDGETCLASS% [list $name]

    set compile(widgetclass) $name
}

# Defines a widget's hull type.
# This statement is only available for snit::widgets,
# not for snit::types or snit::widgetadaptors.
proc ::snit::Comp.statement.hulltype {name} {
    variable compile
    variable hulltypes

    # First, hulltype can only be set for true widgets
    if {"widget" != $compile(which)} {
        error "hulltype cannot be set for snit::$compile(which)s"
    }

    # Next, it must be one of the valid hulltypes (frame, toplevel, ...)
    if {[lsearch -exact $hulltypes [string trimleft $name :]] == -1} {
        error "invalid hulltype \"$name\", should be one of\
		[join $hulltypes {, }]"
    }

    if {"" != $compile(hulltype)} {
        error "too many hulltype statements"
    }

    # Next, save it.
    Mappend compile(defs) {
        set  %TYPE%::Snit_info(hulltype) %HULLTYPE%
    } %HULLTYPE% $name

    set compile(hulltype) $name
}

# Defines a constructor.
proc ::snit::Comp.statement.constructor {arglist body} {
    variable compile

    CheckArgs "constructor" $arglist

    # Next, add a magic reference to self.
    set arglist [concat type selfns win self $arglist]

    # Next, add variable declarations to body:
    set body "%TVARDECS%\n%IVARDECS%\n$body"

    set compile(hasconstructor) yes
    append compile(defs) "proc %TYPE%::Snit_constructor [list $arglist] [list $body]\n"
} 

# Defines a destructor.
proc ::snit::Comp.statement.destructor {body} {
    variable compile

    # Next, add variable declarations to body:
    set body "%TVARDECS%\n%IVARDECS%\n$body"

    append compile(defs) "proc %TYPE%::Snit_destructor {type selfns win self} [list $body]\n\n"
} 

# Defines a type option.  The option value can be a triple, specifying
# the option's -name, resource name, and class name. 
proc ::snit::Comp.statement.option {optionDef args} {
    variable compile

    # First, get the three option names.
    set option [lindex $optionDef 0]
    set resourceName [lindex $optionDef 1]
    set className [lindex $optionDef 2]

    set errRoot "Error in \"option [list $optionDef]...\""

    # Next, validate the option name.
    if {![Comp.OptionNameIsValid $option]} {
        error "$errRoot, badly named option \"$option\""
    }

    if {$option in $compile(delegatedoptions)} {
        error "$errRoot, cannot define \"$option\" locally, it has been delegated"
    }

    if {!($option in $compile(localoptions))} {
        # Remember that we've seen this one.
        set compile(hasoptions) yes
        lappend compile(localoptions) $option
        
        # Initialize compilation info for this option.
        set compile(resource-$option)         ""
        set compile(class-$option)            ""
        set compile(-default-$option)         ""
        set compile(-validatemethod-$option)  ""
        set compile(-configuremethod-$option) ""
        set compile(-cgetmethod-$option)      ""
        set compile(-readonly-$option)        0
        set compile(-type-$option)            ""
    }

    # NEXT, see if we have a resource name.  If so, make sure it
    # isn't being redefined differently.
    if {$resourceName ne ""} {
        if {$compile(resource-$option) eq ""} {
            # If it's undefined, just save the value.
            set compile(resource-$option) $resourceName
        } elseif {$resourceName ne $compile(resource-$option)} {
            # It's been redefined differently.
            error "$errRoot, resource name redefined from \"$compile(resource-$option)\" to \"$resourceName\""
        }
    }

    # NEXT, see if we have a class name.  If so, make sure it
    # isn't being redefined differently.
    if {$className ne ""} {
        if {$compile(class-$option) eq ""} {
            # If it's undefined, just save the value.
            set compile(class-$option) $className
        } elseif {$className ne $compile(class-$option)} {
            # It's been redefined differently.
            error "$errRoot, class name redefined from \"$compile(class-$option)\" to \"$className\""
        }
    }

    # NEXT, handle the args; it's not an error to redefine these.
    if {[llength $args] == 1} {
        set compile(-default-$option) [lindex $args 0]
    } else {
        foreach {optopt val} $args {
            switch -exact -- $optopt {
                -default         -
                -validatemethod  -
                -configuremethod -
                -cgetmethod      {
                    set compile($optopt-$option) $val
                }
                -type {
                    set compile($optopt-$option) $val
                    
                    if {[llength $val] == 1} {
                        # The type spec *is* the validation object
                        append compile(defs) \
                            "\nset %TYPE%::Snit_optionInfo(typeobj-$option) [list $val]\n"
                    } else {
                        # Compilation the creation of the validation object
                        set cmd [linsert $val 1 %TYPE%::Snit_TypeObj_%AUTO%]
                        append compile(defs) \
                            "\nset %TYPE%::Snit_optionInfo(typeobj-$option) \[$cmd\]\n"
                    }
                }
                -readonly        {
                    if {![string is boolean -strict $val]} {
                        error "$errRoot, -readonly requires a boolean, got \"$val\""
                    }
                    set compile($optopt-$option) $val
                }
                default {
                    error "$errRoot, unknown option definition option \"$optopt\""
                }
            }
        }
    }
}

# 1 if the option name is valid, 0 otherwise.
proc ::snit::Comp.OptionNameIsValid {option} {
    if {![string match {-*} $option] || [string match {*[A-Z ]*} $option]} {
        return 0
    }

    return 1
}

# Defines an option's cget handler
proc ::snit::Comp.statement.oncget {option body} {
    variable compile

    set errRoot "Error in \"oncget $option...\""

    if {[lsearch -exact $compile(delegatedoptions) $option] != -1} {
        return -code error "$errRoot, option \"$option\" is delegated"
    }

    if {[lsearch -exact $compile(localoptions) $option] == -1} {
        return -code error "$errRoot, option \"$option\" unknown"
    }

    Comp.statement.method _cget$option {_option} $body
    Comp.statement.option $option -cgetmethod _cget$option
} 

# Defines an option's configure handler.
proc ::snit::Comp.statement.onconfigure {option arglist body} {
    variable compile

    if {[lsearch -exact $compile(delegatedoptions) $option] != -1} {
        return -code error "onconfigure $option: option \"$option\" is delegated"
    }

    if {[lsearch -exact $compile(localoptions) $option] == -1} {
        return -code error "onconfigure $option: option \"$option\" unknown"
    }

    if {[llength $arglist] != 1} {
        error \
       "onconfigure $option handler should have one argument, got \"$arglist\""
    }

    CheckArgs "onconfigure $option" $arglist

    # Next, add a magic reference to the option name
    set arglist [concat _option $arglist]

    Comp.statement.method _configure$option $arglist $body
    Comp.statement.option $option -configuremethod _configure$option
} 

# Defines an instance method.
proc ::snit::Comp.statement.method {method arglist body} {
    variable compile
    variable methodInfo

    # FIRST, check the method name against previously defined 
    # methods.
    Comp.CheckMethodName $method 0 ::snit::methodInfo \
        "Error in \"method [list $method]...\""

    if {[llength $method] > 1} {
        set compile(hashierarchic) yes
    }

    # Remeber this method
    lappend compile(localmethods) $method

    CheckArgs "method [list $method]" $arglist

    # Next, add magic references to type and self.
    set arglist [concat type selfns win self $arglist]

    # Next, add variable declarations to body:
    set body "%TVARDECS%\n%IVARDECS%\n# END snit method prolog\n$body"

    # Next, save the definition script.
    if {[llength $method] == 1} {
        set methodInfo($method) {0 "%t::Snit_method%m %t %n %w %s" ""}
        Mappend compile(defs) {
            proc %TYPE%::Snit_method%METHOD% %ARGLIST% %BODY% 
        } %METHOD% $method %ARGLIST% [list $arglist] %BODY% [list $body] 
    } else {
        set methodInfo($method) {0 "%t::Snit_hmethod%j %t %n %w %s" ""}

        Mappend compile(defs) {
            proc %TYPE%::Snit_hmethod%JMETHOD% %ARGLIST% %BODY% 
        } %JMETHOD% [join $method _] %ARGLIST% [list $arglist] \
            %BODY% [list $body] 
    }
} 

# Check for name collisions; save prefix information.
#
# method	The name of the method or typemethod.
# delFlag       1 if delegated, 0 otherwise.
# infoVar       The fully qualified name of the array containing 
#               information about the defined methods.
# errRoot       The root string for any error messages.

proc ::snit::Comp.CheckMethodName {method delFlag infoVar errRoot} {
    upvar $infoVar methodInfo

    # FIRST, make sure the method name is a valid Tcl list.
    if {[catch {lindex $method 0}]} {
        error "$errRoot, the name \"$method\" must have list syntax."
    }

    # NEXT, check whether we can define it.
    if {![catch {set methodInfo($method)} data]} {
        # We can't redefine methods with submethods.
        if {[lindex $data 0] == 1} {
            error "$errRoot, \"$method\" has submethods."
        }
       
        # You can't delegate a method that's defined locally,
        # and you can't define a method locally if it's been delegated.
        if {$delFlag && [lindex $data 2] eq ""} {
            error "$errRoot, \"$method\" has been defined locally."
        } elseif {!$delFlag && [lindex $data 2] ne ""} {
            error "$errRoot, \"$method\" has been delegated"
        }
    }

    # Handle hierarchical case.
    if {[llength $method] > 1} {
        set prefix {}
        set tokens $method
        while {[llength $tokens] > 1} {
            lappend prefix [lindex $tokens 0]
            set tokens [lrange $tokens 1 end]

            if {![catch {set methodInfo($prefix)} result]} {
                # Prefix is known.  If it's not a prefix, throw an
                # error.
                if {[lindex $result 0] == 0} {
                    error "$errRoot, \"$prefix\" has no submethods."
                }
            }
            
            set methodInfo($prefix) [list 1]
        }
    }
}

# Defines a typemethod method.
proc ::snit::Comp.statement.typemethod {method arglist body} {
    variable compile
    variable typemethodInfo

    # FIRST, check the typemethod name against previously defined 
    # typemethods.
    Comp.CheckMethodName $method 0 ::snit::typemethodInfo \
        "Error in \"typemethod [list $method]...\""

    CheckArgs "typemethod $method" $arglist

    # First, add magic reference to type.
    set arglist [concat type $arglist]

    # Next, add typevariable declarations to body:
    set body "%TVARDECS%\n# END snit method prolog\n$body"

    # Next, save the definition script
    if {[llength $method] == 1} {
        set typemethodInfo($method) {0 "%t::Snit_typemethod%m %t" ""}

        Mappend compile(defs) {
            proc %TYPE%::Snit_typemethod%METHOD% %ARGLIST% %BODY%
        } %METHOD% $method %ARGLIST% [list $arglist] %BODY% [list $body]
    } else {
        set typemethodInfo($method) {0 "%t::Snit_htypemethod%j %t" ""}

        Mappend compile(defs) {
            proc %TYPE%::Snit_htypemethod%JMETHOD% %ARGLIST% %BODY%
        } %JMETHOD% [join $method _] \
            %ARGLIST% [list $arglist] %BODY% [list $body]
    }
} 


# Defines a type constructor.
proc ::snit::Comp.statement.typeconstructor {body} {
    variable compile

    if {"" != $compile(typeconstructor)} {
        error "too many typeconstructors"
    }

    set compile(typeconstructor) $body
} 

# Defines a static proc in the type's namespace.
proc ::snit::Comp.statement.proc {proc arglist body} {
    variable compile

    # If "ns" is defined, the proc can see instance variables.
    if {[lsearch -exact $arglist selfns] != -1} {
        # Next, add instance variable declarations to body:
        set body "%IVARDECS%\n$body"
    }

    # The proc can always see typevariables.
    set body "%TVARDECS%\n$body"

    append compile(defs) "

        # Proc $proc
        proc [list %TYPE%::$proc $arglist $body]
    "
} 

# Defines a static variable in the type's namespace.
proc ::snit::Comp.statement.typevariable {name args} {
    variable compile

    set errRoot "Error in \"typevariable $name...\""

    set len [llength $args]
    
    if {$len > 2 ||
        ($len == 2 && [lindex $args 0] ne "-array")} {
        error "$errRoot, too many initializers"
    }

    if {[lsearch -exact $compile(varnames) $name] != -1} {
        error "$errRoot, \"$name\" is already an instance variable"
    }

    lappend compile(typevarnames) $name

    if {$len == 1} {
        append compile(typevars) \
		"\n\t    [list ::variable $name [lindex $args 0]]"
    } elseif {$len == 2} {
        append compile(typevars) \
            "\n\t    [list ::variable $name]"
        append compile(typevars) \
            "\n\t    [list array set $name [lindex $args 1]]"
    } else {
        append compile(typevars) \
		"\n\t    [list ::variable $name]"
    }

    if {$compile(tvprocdec) eq ""} {
        set compile(tvprocdec) "\n\t"
        append compile(tvprocdec) "namespace upvar [list $compile(type)]"
    }
    append compile(tvprocdec) " [list $name $name]"
} 

# Defines an instance variable; the definition will go in the
# type's create typemethod.
proc ::snit::Comp.statement.variable {name args} {
    variable compile

    set errRoot "Error in \"variable $name...\""

    set len [llength $args]
    
    if {$len > 2 ||
        ($len == 2 && [lindex $args 0] ne "-array")} {
        error "$errRoot, too many initializers"
    }

    if {[lsearch -exact $compile(typevarnames) $name] != -1} {
        error "$errRoot, \"$name\" is already a typevariable"
    }

    lappend compile(varnames) $name

    # Add a ::variable to instancevars, so that ::variable is used
    # at least once; ::variable makes the variable visible to
    # [info vars] even if no value is assigned.
    append  compile(instancevars) "\n"
    Mappend compile(instancevars) {::variable ${selfns}::%N} %N $name 

    if {$len == 1} {
        append compile(instancevars) \
            "\nset $name [list [lindex $args 0]]\n"
    } elseif {$len == 2} {
        append compile(instancevars) \
            "\narray set $name [list [lindex $args 1]]\n"
    } 

    if {$compile(ivprocdec) eq ""} {
        set compile(ivprocdec) "\n\t"
        append compile(ivprocdec) {namespace upvar $selfns}
    }
    append compile(ivprocdec) " [list $name $name]"
} 

# Defines a typecomponent, and handles component options.
#
# component     The logical name of the delegate
# args          options.

proc ::snit::Comp.statement.typecomponent {component args} {
    variable compile

    set errRoot "Error in \"typecomponent $component...\""

    # FIRST, define the component
    Comp.DefineTypecomponent $component $errRoot

    # NEXT, handle the options.
    set publicMethod ""
    set inheritFlag 0

    foreach {opt val} $args {
        switch -exact -- $opt {
            -public {
                set publicMethod $val
            }
            -inherit {
                set inheritFlag $val
                if {![string is boolean $inheritFlag]} {
    error "typecomponent $component -inherit: expected boolean value, got \"$val\""
                }
            }
            default {
                error "typecomponent $component: Invalid option \"$opt\""
            }
        }
    }

    # NEXT, if -public specified, define the method.  
    if {$publicMethod ne ""} {
        Comp.statement.delegate typemethod [list $publicMethod *] to $component
    }

    # NEXT, if "-inherit 1" is specified, delegate typemethod * to 
    # this component.
    if {$inheritFlag} {
        Comp.statement.delegate typemethod "*" to $component
    }

}


# Defines a name to be a typecomponent
# 
# The name becomes a typevariable; in addition, it gets a 
# write trace so that when it is set, all of the component mechanisms
# get updated.
#
# component     The component name

proc ::snit::Comp.DefineTypecomponent {component {errRoot "Error"}} {
    variable compile

    if {[lsearch -exact $compile(varnames) $component] != -1} {
        error "$errRoot, \"$component\" is already an instance variable"
    }

    if {[lsearch -exact $compile(typecomponents) $component] == -1} {
        # Remember we've done this.
        lappend compile(typecomponents) $component

        # Make it a type variable with no initial value
        Comp.statement.typevariable $component ""

        # Add a write trace to do the component thing.
        Mappend compile(typevars) {
            trace add variable %COMP% write \
                [list ::snit::RT.TypecomponentTrace [list %TYPE%] %COMP%]
        } %TYPE% $compile(type) %COMP% $component
    }
} 

# Defines a component, and handles component options.
#
# component     The logical name of the delegate
# args          options.
#
# TBD: Ideally, it should be possible to call this statement multiple
# times, possibly changing the option values.  To do that, I'd need
# to cache the option values and not act on them until *after* I'd
# read the entire type definition.

proc ::snit::Comp.statement.component {component args} {
    variable compile

    set errRoot "Error in \"component $component...\""

    # FIRST, define the component
    Comp.DefineComponent $component $errRoot

    # NEXT, handle the options.
    set publicMethod ""
    set inheritFlag 0

    foreach {opt val} $args {
        switch -exact -- $opt {
            -public {
                set publicMethod $val
            }
            -inherit {
                set inheritFlag $val
                if {![string is boolean $inheritFlag]} {
    error "component $component -inherit: expected boolean value, got \"$val\""
                }
            }
            default {
                error "component $component: Invalid option \"$opt\""
            }
        }
    }

    # NEXT, if -public specified, define the method.  
    if {$publicMethod ne ""} {
        Comp.statement.delegate method [list $publicMethod *] to $component
    }

    # NEXT, if -inherit is specified, delegate method/option * to 
    # this component.
    if {$inheritFlag} {
        Comp.statement.delegate method "*" to $component
        Comp.statement.delegate option "*" to $component
    }
}


# Defines a name to be a component
# 
# The name becomes an instance variable; in addition, it gets a 
# write trace so that when it is set, all of the component mechanisms
# get updated.
#
# component     The component name

proc ::snit::Comp.DefineComponent {component {errRoot "Error"}} {
    variable compile

    if {[lsearch -exact $compile(typevarnames) $component] != -1} {
        error "$errRoot, \"$component\" is already a typevariable"
    }

    if {[lsearch -exact $compile(components) $component] == -1} {
        # Remember we've done this.
        lappend compile(components) $component

        # Make it an instance variable with no initial value
        Comp.statement.variable $component ""

        # Add a write trace to do the component thing.
        Mappend compile(instancevars) {
            trace add variable ${selfns}::%COMP% write \
                [list ::snit::RT.ComponentTrace [list %TYPE%] $selfns %COMP%]
        } %TYPE% $compile(type) %COMP% $component
    }
} 

# Creates a delegated method, typemethod, or option.
proc ::snit::Comp.statement.delegate {what name args} {
    # FIRST, dispatch to correct handler.
    switch $what {
        typemethod { Comp.DelegatedTypemethod $name $args }
        method     { Comp.DelegatedMethod     $name $args }
        option     { Comp.DelegatedOption     $name $args }
        default {
            error "Error in \"delegate $what $name...\", \"$what\"?"
        }
    }

    if {([llength $args] % 2) != 0} {
        error "Error in \"delegate $what $name...\", invalid syntax"
    }
}

# Creates a delegated typemethod delegating it to a particular
# typecomponent or an arbitrary command.
#
# method    The name of the method
# arglist       Delegation options

proc ::snit::Comp.DelegatedTypemethod {method arglist} {
    variable compile
    variable typemethodInfo

    set errRoot "Error in \"delegate typemethod [list $method]...\""

    # Next, parse the delegation options.
    set component ""
    set target ""
    set exceptions {}
    set pattern ""
    set methodTail [lindex $method end]

    foreach {opt value} $arglist {
        switch -exact $opt {
            to     { set component $value  }
            as     { set target $value     }
            except { set exceptions $value }
            using  { set pattern $value    }
            default {
                error "$errRoot, unknown delegation option \"$opt\""
            }
        }
    }

    if {$component eq "" && $pattern eq ""} {
        error "$errRoot, missing \"to\""
    }

    if {$methodTail eq "*" && $target ne ""} {
        error "$errRoot, cannot specify \"as\" with \"*\""
    }

    if {$methodTail ne "*" && $exceptions ne ""} {
        error "$errRoot, can only specify \"except\" with \"*\"" 
    }

    if {$pattern ne "" && $target ne ""} {
        error "$errRoot, cannot specify both \"as\" and \"using\""
    }

    foreach token [lrange $method 1 end-1] {
        if {$token eq "*"} {
            error "$errRoot, \"*\" must be the last token."
        }
    }

    # NEXT, define the component
    if {$component ne ""} {
        Comp.DefineTypecomponent $component $errRoot
    }

    # NEXT, define the pattern.
    if {$pattern eq ""} {
        if {$methodTail eq "*"} {
            set pattern "%c %m"
        } elseif {$target ne ""} {
            set pattern "%c $target"
        } else {
            set pattern "%c %m"
        }
    }

    # Make sure the pattern is a valid list.
    if {[catch {lindex $pattern 0} result]} {
        error "$errRoot, the using pattern, \"$pattern\", is not a valid list"
    }

    # NEXT, check the method name against previously defined 
    # methods.
    Comp.CheckMethodName $method 1 ::snit::typemethodInfo $errRoot

    set typemethodInfo($method) [list 0 $pattern $component]

    if {[string equal $methodTail "*"]} {
        Mappend compile(defs) {
            set %TYPE%::Snit_info(excepttypemethods) %EXCEPT%
        } %EXCEPT% [list $exceptions]
    }
}


# Creates a delegated method delegating it to a particular
# component or command.
#
# method        The name of the method
# arglist       Delegation options.

proc ::snit::Comp.DelegatedMethod {method arglist} {
    variable compile
    variable methodInfo

    set errRoot "Error in \"delegate method [list $method]...\""

    # Next, parse the delegation options.
    set component ""
    set target ""
    set exceptions {}
    set pattern ""
    set methodTail [lindex $method end]

    foreach {opt value} $arglist {
        switch -exact $opt {
            to     { set component $value  }
            as     { set target $value     }
            except { set exceptions $value }
            using  { set pattern $value    }
            default {
                error "$errRoot, unknown delegation option \"$opt\""
            }
        }
    }

    if {$component eq "" && $pattern eq ""} {
        error "$errRoot, missing \"to\""
    }

    if {$methodTail eq "*" && $target ne ""} {
        error "$errRoot, cannot specify \"as\" with \"*\""
    }

    if {$methodTail ne "*" && $exceptions ne ""} {
        error "$errRoot, can only specify \"except\" with \"*\"" 
    }

    if {$pattern ne "" && $target ne ""} {
        error "$errRoot, cannot specify both \"as\" and \"using\""
    }

    foreach token [lrange $method 1 end-1] {
        if {$token eq "*"} {
            error "$errRoot, \"*\" must be the last token."
        }
    }

    # NEXT, we delegate some methods
    set compile(delegatesmethods) yes

    # NEXT, define the component.  Allow typecomponents.
    if {$component ne ""} {
        if {[lsearch -exact $compile(typecomponents) $component] == -1} {
            Comp.DefineComponent $component $errRoot
        }
    }

    # NEXT, define the pattern.
    if {$pattern eq ""} {
        if {$methodTail eq "*"} {
            set pattern "%c %m"
        } elseif {$target ne ""} {
            set pattern "%c $target"
        } else {
            set pattern "%c %m"
        }
    }

    # Make sure the pattern is a valid list.
    if {[catch {lindex $pattern 0} result]} {
        error "$errRoot, the using pattern, \"$pattern\", is not a valid list"
    }

    # NEXT, check the method name against previously defined 
    # methods.
    Comp.CheckMethodName $method 1 ::snit::methodInfo $errRoot

    # NEXT, save the method info.
    set methodInfo($method) [list 0 $pattern $component]

    if {[string equal $methodTail "*"]} {
        Mappend compile(defs) {
            set %TYPE%::Snit_info(exceptmethods) %EXCEPT%
        } %EXCEPT% [list $exceptions]
    }
} 

# Creates a delegated option, delegating it to a particular
# component and, optionally, to a particular option of that
# component.
#
# optionDef     The option definition
# args          definition arguments.

proc ::snit::Comp.DelegatedOption {optionDef arglist} {
    variable compile

    # First, get the three option names.
    set option [lindex $optionDef 0]
    set resourceName [lindex $optionDef 1]
    set className [lindex $optionDef 2]

    set errRoot "Error in \"delegate option [list $optionDef]...\""

    # Next, parse the delegation options.
    set component ""
    set target ""
    set exceptions {}

    foreach {opt value} $arglist {
        switch -exact $opt {
            to     { set component $value  }
            as     { set target $value     }
            except { set exceptions $value }
            default {
                error "$errRoot, unknown delegation option \"$opt\""
            }
        }
    }

    if {$component eq ""} {
        error "$errRoot, missing \"to\""
    }

    if {$option eq "*" && $target ne ""} {
        error "$errRoot, cannot specify \"as\" with \"delegate option *\""
    }

    if {$option ne "*" && $exceptions ne ""} {
        error "$errRoot, can only specify \"except\" with \"delegate option *\"" 
    }

    # Next, validate the option name

    if {"*" != $option} {
        if {![Comp.OptionNameIsValid $option]} {
            error "$errRoot, badly named option \"$option\""
        }
    }

    if {$option in $compile(localoptions)} {
        error "$errRoot, \"$option\" has been defined locally"
    }

    if {$option in $compile(delegatedoptions)} {
        error "$errRoot, \"$option\" is multiply delegated"
    }

    # NEXT, define the component
    Comp.DefineComponent $component $errRoot

    # Next, define the target option, if not specified.
    if {![string equal $option "*"] &&
        [string equal $target ""]} {
        set target $option
    }

    # NEXT, save the delegation data.
    set compile(hasoptions) yes

    if {![string equal $option "*"]} {
        lappend compile(delegatedoptions) $option

        # Next, compute the resource and class names, if they aren't
        # already defined.

        if {"" == $resourceName} {
            set resourceName [string range $option 1 end]
        }

        if {"" == $className} {
            set className [Capitalize $resourceName]
        }

        Mappend  compile(defs) {
            set %TYPE%::Snit_optionInfo(islocal-%OPTION%) 0
            set %TYPE%::Snit_optionInfo(resource-%OPTION%) %RES%
            set %TYPE%::Snit_optionInfo(class-%OPTION%) %CLASS%
            lappend %TYPE%::Snit_optionInfo(delegated) %OPTION%
            set %TYPE%::Snit_optionInfo(target-%OPTION%) [list %COMP% %TARGET%]
            lappend %TYPE%::Snit_optionInfo(delegated-%COMP%) %OPTION%
        }   %OPTION% $option \
            %COMP% $component \
            %TARGET% $target \
            %RES% $resourceName \
            %CLASS% $className 
    } else {
        Mappend  compile(defs) {
            set %TYPE%::Snit_optionInfo(starcomp) %COMP%
            set %TYPE%::Snit_optionInfo(except) %EXCEPT%
        } %COMP% $component %EXCEPT% [list $exceptions]
    }
} 

# Exposes a component, effectively making the component's command an
# instance method.
#
# component     The logical name of the delegate
# "as"          sugar; if not "", must be "as"
# methodname    The desired method name for the component's command, or ""

proc ::snit::Comp.statement.expose {component {"as" ""} {methodname ""}} {
    variable compile


    # FIRST, define the component
    Comp.DefineComponent $component

    # NEXT, define the method just as though it were in the type
    # definition.
    if {[string equal $methodname ""]} {
        set methodname $component
    }

    Comp.statement.method $methodname args [Expand {
        if {[llength $args] == 0} {
            return $%COMPONENT%
        }

        if {[string equal $%COMPONENT% ""]} {
            error "undefined component \"%COMPONENT%\""
        }


        set cmd [linsert $args 0 $%COMPONENT%]
        return [uplevel 1 $cmd]
    } %COMPONENT% $component]
}



#-----------------------------------------------------------------------
# Public commands

# Compile a type definition, and return the results as a list of two
# items: the fully-qualified type name, and a script that will define
# the type when executed.
#
# which		type, widget, or widgetadaptor
# type          the type name
# body          the type definition
proc ::snit::compile {which type body} {
    return [Comp.Compile $which $type $body]
}

proc ::snit::type {type body} {
    return [Comp.Define [Comp.Compile type $type $body]]
}

proc ::snit::widget {type body} {
    return [Comp.Define [Comp.Compile widget $type $body]]
}

proc ::snit::widgetadaptor {type body} {
    return [Comp.Define [Comp.Compile widgetadaptor $type $body]]
}

proc ::snit::typemethod {type method arglist body} {
    # Make sure the type exists.
    if {![info exists ${type}::Snit_info]} {
        error "no such type: \"$type\""
    }

    upvar ${type}::Snit_info           Snit_info
    upvar ${type}::Snit_typemethodInfo Snit_typemethodInfo

    # FIRST, check the typemethod name against previously defined 
    # typemethods.
    Comp.CheckMethodName $method 0 ${type}::Snit_typemethodInfo \
        "Cannot define \"$method\""

    # NEXT, check the arguments
    CheckArgs "snit::typemethod $type $method" $arglist

    # Next, add magic reference to type.
    set arglist [concat type $arglist]

    # Next, add typevariable declarations to body:
    set body "$Snit_info(tvardecs)\n$body"

    # Next, define it.
    if {[llength $method] == 1} {
        set Snit_typemethodInfo($method) {0 "%t::Snit_typemethod%m %t" ""}
        uplevel 1 [list proc ${type}::Snit_typemethod$method $arglist $body]
    } else {
        set Snit_typemethodInfo($method) {0 "%t::Snit_htypemethod%j %t" ""}
        set suffix [join $method _]
        uplevel 1 [list proc ${type}::Snit_htypemethod$suffix $arglist $body]
    }
}

proc ::snit::method {type method arglist body} {
    # Make sure the type exists.
    if {![info exists ${type}::Snit_info]} {
        error "no such type: \"$type\""
    }

    upvar ${type}::Snit_methodInfo  Snit_methodInfo
    upvar ${type}::Snit_info        Snit_info

    # FIRST, check the method name against previously defined 
    # methods.
    Comp.CheckMethodName $method 0 ${type}::Snit_methodInfo \
        "Cannot define \"$method\""

    # NEXT, check the arguments
    CheckArgs "snit::method $type $method" $arglist

    # Next, add magic references to type and self.
    set arglist [concat type selfns win self $arglist]

    # Next, add variable declarations to body:
    set body "$Snit_info(tvardecs)\n$Snit_info(ivardecs)\n$body"

    # Next, define it.
    if {[llength $method] == 1} {
        set Snit_methodInfo($method) {0 "%t::Snit_method%m %t %n %w %s" ""}
        uplevel 1 [list proc ${type}::Snit_method$method $arglist $body]
    } else {
        set Snit_methodInfo($method) {0 "%t::Snit_hmethod%j %t %n %w %s" ""}

        set suffix [join $method _]
        uplevel 1 [list proc ${type}::Snit_hmethod$suffix $arglist $body]
    }
}

# Defines a proc within the compiler; this proc can call other
# type definition statements, and thus can be used for meta-programming.
proc ::snit::macro {name arglist body} {
    variable compiler
    variable reservedwords

    # FIRST, make sure the compiler is defined.
    Comp.Init

    # NEXT, check the macro name against the reserved words
    if {[lsearch -exact $reservedwords $name] != -1} {
        error "invalid macro name \"$name\""
    }

    # NEXT, see if the name has a namespace; if it does, define the
    # namespace.
    set ns [namespace qualifiers $name]

    if {$ns ne ""} {
        $compiler eval "namespace eval $ns {}"
    }

    # NEXT, define the macro
    $compiler eval [list _proc $name $arglist $body]
}

#-----------------------------------------------------------------------
# Utility Functions
#
# These are utility functions used while compiling Snit types.

# Builds a template from a tagged list of text blocks, then substitutes
# all symbols in the mapTable, returning the expanded template.
proc ::snit::Expand {template args} {
    return [string map $args $template]
}

# Expands a template and appends it to a variable.
proc ::snit::Mappend {varname template args} {
    upvar $varname myvar

    append myvar [string map $args $template]
}

# Checks argument list against reserved args 
proc ::snit::CheckArgs {which arglist} {
    variable reservedArgs
    
    foreach name $reservedArgs {
        if {$name in $arglist} {
            error "$which's arglist may not contain \"$name\" explicitly"
        }
    }
}

# Capitalizes the first letter of a string.
proc ::snit::Capitalize {text} {
    return [string toupper $text 0]
}


#=======================================================================
# Snit Runtime Library
#
# These are procs used by Snit types and widgets at runtime.

#-----------------------------------------------------------------------
# Object Creation

# Creates a new instance of the snit::type given its name and the args.
#
# type		The snit::type
# name		The instance name
# args		Args to pass to the constructor

proc ::snit::RT.type.typemethod.create {type name args} {
    variable ${type}::Snit_info
    variable ${type}::Snit_optionInfo

    # FIRST, qualify the name.
    if {![string match "::*" $name]} {
        # Get caller's namespace; 
        # append :: if not global namespace.
        set ns [uplevel 1 [list namespace current]]
        if {"::" != $ns} {
            append ns "::"
        }
        
        set name "$ns$name"
    }

    # NEXT, if %AUTO% appears in the name, generate a unique 
    # command name.  Otherwise, ensure that the name isn't in use.
    if {[string match "*%AUTO%*" $name]} {
        set name [::snit::RT.UniqueName Snit_info(counter) $type $name]
    } elseif {!$Snit_info(canreplace) && [llength [info commands $name]]} {
        error "command \"$name\" already exists"
    }

    # NEXT, create the instance's namespace.
    set selfns \
        [::snit::RT.UniqueInstanceNamespace Snit_info(counter) $type]
    namespace eval $selfns {}

    # NEXT, install the dispatcher
    RT.MakeInstanceCommand $type $selfns $name

    # Initialize the options to their defaults. 
    namespace upvar ${selfns} options options

    foreach opt $Snit_optionInfo(local) {
        set options($opt) $Snit_optionInfo(default-$opt)
    }
        
    # Initialize the instance vars to their defaults.
    # selfns must be defined, as it is used implicitly.
    ${type}::Snit_instanceVars $selfns

    # Execute the type's constructor.
    set errcode [catch {
        RT.ConstructInstance $type $selfns $name $args
    } result]

    if {$errcode} {
        global errorInfo
        global errorCode
        
        set theInfo $errorInfo
        set theCode $errorCode

        ::snit::RT.DestroyObject $type $selfns $name
        error "Error in constructor: $result" $theInfo $theCode
    }

    # NEXT, return the object's name.
    return $name
}

# Creates a new instance of the snit::widget or snit::widgetadaptor
# given its name and the args.
#
# type		The snit::widget or snit::widgetadaptor
# name		The instance name
# args		Args to pass to the constructor

proc ::snit::RT.widget.typemethod.create {type name args} {
    variable ${type}::Snit_info
    variable ${type}::Snit_optionInfo

    # FIRST, if %AUTO% appears in the name, generate a unique 
    # command name.
    if {[string match "*%AUTO%*" $name]} {
        set name [::snit::RT.UniqueName Snit_info(counter) $type $name]
    }
            
    # NEXT, create the instance's namespace.
    set selfns \
        [::snit::RT.UniqueInstanceNamespace Snit_info(counter) $type]
    namespace eval $selfns { }
            
    # NEXT, Initialize the widget's own options to their defaults.
    namespace upvar $selfns options options

    foreach opt $Snit_optionInfo(local) {
        set options($opt) $Snit_optionInfo(default-$opt)
    }

    # Initialize the instance vars to their defaults.
    ${type}::Snit_instanceVars $selfns

    # NEXT, if this is a normal widget (not a widget adaptor) then create a
    # frame as its hull.  We set the frame's -class to the user's widgetclass,
    # or, if none, search for -class in the args list, otherwise default to
    # the basename of the $type with an initial upper case letter.
    if {!$Snit_info(isWidgetAdaptor)} {
        # FIRST, determine the class name
	set wclass $Snit_info(widgetclass)
        if {$Snit_info(widgetclass) eq ""} {
	    set idx [lsearch -exact $args -class]
	    if {$idx >= 0 && ($idx%2 == 0)} {
		# -class exists and is in the -option position
		set wclass [lindex $args [expr {$idx+1}]]
		set args [lreplace $args $idx [expr {$idx+1}]]
	    } else {
		set wclass [::snit::Capitalize [namespace tail $type]]
	    }
	}

        # NEXT, create the widget
        set self $name
        package require Tk
        ${type}::installhull using $Snit_info(hulltype) -class $wclass

        # NEXT, let's query the option database for our
        # widget, now that we know that it exists.
        foreach opt $Snit_optionInfo(local) {
            set dbval [RT.OptionDbGet $type $name $opt]

            if {"" != $dbval} {
                set options($opt) $dbval
            }
        }
    }

    # Execute the type's constructor, and verify that it
    # has a hull.
    set errcode [catch {
        RT.ConstructInstance $type $selfns $name $args

        ::snit::RT.Component $type $selfns hull

        # Prepare to call the object's destructor when the
        # <Destroy> event is received.  Use a Snit-specific bindtag
        # so that the widget name's tag is unencumbered.

        bind Snit$type$name <Destroy> [::snit::Expand {
            ::snit::RT.DestroyObject %TYPE% %NS% %W
        } %TYPE% $type %NS% $selfns]

        # Insert the bindtag into the list of bindtags right
        # after the widget name.
        set taglist [bindtags $name]
        set ndx [lsearch -exact $taglist $name]
        incr ndx
        bindtags $name [linsert $taglist $ndx Snit$type$name]
    } result]

    if {$errcode} {
        global errorInfo
        global errorCode

        set theInfo $errorInfo
        set theCode $errorCode
        ::snit::RT.DestroyObject $type $selfns $name
        error "Error in constructor: $result" $theInfo $theCode
    }

    # NEXT, return the object's name.
    return $name
}


# RT.MakeInstanceCommand type selfns instance
#
# type        The object type
# selfns      The instance namespace
# instance    The instance name
#
# Creates the instance proc.

proc ::snit::RT.MakeInstanceCommand {type selfns instance} {
    variable ${type}::Snit_info
        
    # FIRST, remember the instance name.  The Snit_instance variable
    # allows the instance to figure out its current name given the
    # instance namespace.

    namespace upvar $selfns Snit_instance Snit_instance

    set Snit_instance $instance

    # NEXT, qualify the proc name if it's a widget.
    if {$Snit_info(isWidget)} {
        set procname ::$instance
    } else {
        set procname $instance
    }

    # NEXT, install the new proc
    # WHD: Snit 2.0 code

    set unknownCmd [list ::snit::RT.UnknownMethod $type $selfns $instance ""]
    set createCmd [list namespace ensemble create \
                       -command $procname \
                       -unknown $unknownCmd \
                       -prefixes 0]

    namespace eval $selfns $createCmd

    # NEXT, add the trace.
    trace add command $procname {rename delete} \
        [list ::snit::RT.InstanceTrace $type $selfns $instance]
}

# This proc is called when the instance command is renamed.
# If op is delete, then new will always be "", so op is redundant.
#
# type		The fully-qualified type name
# selfns	The instance namespace
# win		The original instance/tk window name.
# old		old instance command name
# new		new instance command name
# op		rename or delete
#
# If the op is delete, we need to clean up the object; otherwise,
# we need to track the change.
#
# NOTE: In Tcl 8.4.2 there's a bug: errors in rename and delete
# traces aren't propagated correctly.  Instead, they silently
# vanish.  Add a catch to output any error message.

proc ::snit::RT.InstanceTrace {type selfns win old new op} {
    variable ${type}::Snit_info

    # Note to developers ...
    # For Tcl 8.4.0, errors thrown in trace handlers vanish silently.
    # Therefore we catch them here and create some output to help in
    # debugging such problems.

    if {[catch {
        # FIRST, clean up if necessary
        if {"" == $new} {
            if {$Snit_info(isWidget)} {
                destroy $win
            } else {
                ::snit::RT.DestroyObject $type $selfns $win
            }
        } else {
            # Otherwise, track the change.
            variable ${selfns}::Snit_instance
            set Snit_instance [uplevel 1 [list namespace which -command $new]]
            
            # Also, clear the instance caches, as many cached commands
            # might be invalid.
            RT.ClearInstanceCaches $selfns
        }
    } result]} {
        global errorInfo
        # Pop up the console on Windows wish, to enable stdout.
        # This clobbers errorInfo on unix, so save it so we can print it.
        set ei $errorInfo
        catch {console show}
        puts "Error in ::snit::RT.InstanceTrace $type $selfns $win $old $new $op:"
        puts $ei
    }
}

# Calls the instance constructor and handles related housekeeping.
proc ::snit::RT.ConstructInstance {type selfns instance arglist} {
    variable ${type}::Snit_optionInfo
    variable ${selfns}::Snit_iinfo

    # Track whether we are constructed or not.
    set Snit_iinfo(constructed) 0

    # Call the user's constructor
    eval [linsert $arglist 0 \
              ${type}::Snit_constructor $type $selfns $instance $instance]

    set Snit_iinfo(constructed) 1

    # Validate the initial set of options (including defaults)
    foreach option $Snit_optionInfo(local) {
        set value [set ${selfns}::options($option)]

        if {$Snit_optionInfo(typespec-$option) ne ""} {
            if {[catch {
                $Snit_optionInfo(typeobj-$option) validate $value
            } result]} {
                return -code error "invalid $option default: $result"
            }
        }
    }

    # Unset the configure cache for all -readonly options.
    # This ensures that the next time anyone tries to 
    # configure it, an error is thrown.
    foreach opt $Snit_optionInfo(local) {
        if {$Snit_optionInfo(readonly-$opt)} {
            unset -nocomplain ${selfns}::Snit_configureCache($opt)
        }
    }

    return
}

# Returns a unique command name.  
#
# REQUIRE: type is a fully qualified name.
# REQUIRE: name contains "%AUTO%"
# PROMISE: the returned command name is unused.
proc ::snit::RT.UniqueName {countervar type name} {
    upvar $countervar counter 
    while 1 {
        # FIRST, bump the counter and define the %AUTO% instance name;
        # then substitute it into the specified name.  Wrap around at
        # 2^31 - 2 to prevent overflow problems.
        incr counter
        if {$counter > 2147483646} {
            set counter 0
        }
        set auto "[namespace tail $type]$counter"
        set candidate [Expand $name %AUTO% $auto]
        if {![llength [info commands $candidate]]} {
            return $candidate
        }
    }
}

# Returns a unique instance namespace, fully qualified.
#
# countervar     The name of a counter variable
# type           The instance's type
#
# REQUIRE: type is fully qualified
# PROMISE: The returned namespace name is unused.

proc ::snit::RT.UniqueInstanceNamespace {countervar type} {
    upvar $countervar counter 
    while 1 {
        # FIRST, bump the counter and define the namespace name.
        # Then see if it already exists.  Wrap around at
        # 2^31 - 2 to prevent overflow problems.
        incr counter
        if {$counter > 2147483646} {
            set counter 0
        }
        set ins "${type}::Snit_inst${counter}"
        if {![namespace exists $ins]} {
            return $ins
        }
    }
}

# Retrieves an option's value from the option database.
# Returns "" if no value is found.
proc ::snit::RT.OptionDbGet {type self opt} {
    variable ${type}::Snit_optionInfo

    return [option get $self \
                $Snit_optionInfo(resource-$opt) \
                $Snit_optionInfo(class-$opt)]
}

#-----------------------------------------------------------------------
# Object Destruction

# Implements the standard "destroy" method
#
# type		The snit type
# selfns        The instance's instance namespace
# win           The instance's original name
# self          The instance's current name

proc ::snit::RT.method.destroy {type selfns win self} {
    variable ${selfns}::Snit_iinfo

    # Can't destroy the object if it isn't complete constructed.
    if {!$Snit_iinfo(constructed)} {
        return -code error "Called 'destroy' method in constructor"
    }

    # Calls Snit_cleanup, which (among other things) calls the
    # user's destructor.
    ::snit::RT.DestroyObject $type $selfns $win
}

# This is the function that really cleans up; it's automatically 
# called when any instance is destroyed, e.g., by "$object destroy"
# for types, and by the <Destroy> event for widgets.
#
# type		The fully-qualified type name.
# selfns	The instance namespace
# win		The original instance command name.

proc ::snit::RT.DestroyObject {type selfns win} {
    variable ${type}::Snit_info

    # If the variable Snit_instance doesn't exist then there's no
    # instance command for this object -- it's most likely a 
    # widgetadaptor. Consequently, there are some things that
    # we don't need to do.
    if {[info exists ${selfns}::Snit_instance]} {
        namespace upvar $selfns Snit_instance instance
            
        # First, remove the trace on the instance name, so that we
        # don't call RT.DestroyObject recursively.
        RT.RemoveInstanceTrace $type $selfns $win $instance
            
        # Next, call the user's destructor
        ${type}::Snit_destructor $type $selfns $win $instance

        # Next, if this isn't a widget, delete the instance command.
        # If it is a widget, get the hull component's name, and rename
        # it back to the widget name
                
        # Next, delete the hull component's instance command,
        # if there is one.
        if {$Snit_info(isWidget)} {
            set hullcmd [::snit::RT.Component $type $selfns hull]
            
            catch {rename $instance ""}

            # Clear the bind event
            bind Snit$type$win <Destroy> ""

            if {[llength [info commands $hullcmd]]} {
                # FIRST, rename the hull back to its original name.
                # If the hull is itself a megawidget, it will have its
                # own cleanup to do, and it might not do it properly
                # if it doesn't have the right name.
                rename $hullcmd ::$instance

                # NEXT, destroy it.
                destroy $instance
            }
        } else {
            catch {rename $instance ""}
        }
    }

    # Next, delete the instance's namespace.  This kills any
    # instance variables.
    namespace delete $selfns

    return
}

# Remove instance trace
# 
# type           The fully qualified type name
# selfns         The instance namespace
# win            The original instance name/Tk window name
# instance       The current instance name

proc ::snit::RT.RemoveInstanceTrace {type selfns win instance} {
    variable ${type}::Snit_info

    if {$Snit_info(isWidget)} {
        set procname ::$instance
    } else {
        set procname $instance
    }
        
    # NEXT, remove any trace on this name
    catch {
        trace remove command $procname {rename delete} \
            [list ::snit::RT.InstanceTrace $type $selfns $win]
    }
}

#-----------------------------------------------------------------------
# Typecomponent Management and Method Caching

# Typecomponent trace; used for write trace on typecomponent 
# variables.  Saves the new component object name, provided 
# that certain conditions are met.  Also clears the typemethod
# cache.

proc ::snit::RT.TypecomponentTrace {type component n1 n2 op} {
    namespace upvar $type \
        Snit_info           Snit_info \
        $component          cvar      \
        Snit_typecomponents Snit_typecomponents

        
    # Save the new component value.
    set Snit_typecomponents($component) $cvar

    # Clear the typemethod cache.
    # TBD: can we unset just the elements related to
    # this component?

    # WHD: Namespace 2.0 code
    namespace ensemble configure $type -map {}
}

# WHD: Snit 2.0 code
#
# RT.UnknownTypemethod type eId eCmd method args
#
# type		The type
# eId           The ensemble command ID; "" for the instance itself.
# eCmd          The ensemble command name.
# method	The unknown method name.
# args          The additional arguments, if any.
#
# This proc looks up the method relative to the specified ensemble.
# If no method is found, it assumes that the "create" method is
# desired, and that the "method" is the instance name.  In this case,
# it returns the "create" typemethod command with the instance name
# appended; this will cause the instance to be created without updating
# the -map.  If the method is found, the method's command is created and
# added to the -map; the function returns the empty list.

proc snit::RT.UnknownTypemethod {type eId eCmd method args} {
    namespace upvar $type \
        Snit_typemethodInfo  Snit_typemethodInfo \
        Snit_typecomponents  Snit_typecomponents \
        Snit_info            Snit_info
    
    # FIRST, get the pattern data and the typecomponent name.
    set implicitCreate 0
    set instanceName ""

    set fullMethod $eId
    lappend fullMethod $method
    set starredMethod [concat $eId *]
    set methodTail $method

    if {[info exists Snit_typemethodInfo($fullMethod)]} {
        set key $fullMethod
    } elseif {[info exists Snit_typemethodInfo($starredMethod)]} {
        if {[lsearch -exact $Snit_info(excepttypemethods) $methodTail] == -1} {
            set key $starredMethod
        } else {
            # WHD: The method is explicitly not delegated, so this is an error.
            # Or should we treat it as an instance name?
            return [list ]
        }
    } elseif {[llength $fullMethod] > 1} {
	return [list ]
    } elseif {$Snit_info(hasinstances)} {
        # Assume the unknown name is an instance name to create, unless
        # this is a widget and the style of the name is wrong, or the
        # name mimics a standard typemethod.

        if {[set ${type}::Snit_info(isWidget)] && 
            ![string match ".*" $method]} {
            return [list ]
        }

        # Without this check, the call "$type info" will redefine the
        # standard "::info" command, with disastrous results.  Since it's
        # a likely thing to do if !-typeinfo, put in an explicit check.
        if {$method eq "info" || $method eq "destroy"} {
            return [list ]
        }

        set implicitCreate 1
        set instanceName $method
        set key create
        set method create
    } else {
        return [list ]
    }
    
    foreach {flag pattern compName} $Snit_typemethodInfo($key) {}

    if {$flag == 1} {
        # FIRST, define the ensemble command.
        lappend eId $method

        set newCmd ${type}::Snit_ten[llength $eId]_[join $eId _]

        set unknownCmd [list ::snit::RT.UnknownTypemethod \
                            $type $eId]

        set createCmd [list namespace ensemble create \
                           -command $newCmd \
                           -unknown $unknownCmd \
                           -prefixes 0]

        namespace eval $type $createCmd
        
        # NEXT, add the method to the current ensemble
        set map [namespace ensemble configure $eCmd -map]

        dict append map $method $newCmd

        namespace ensemble configure $eCmd -map $map

        return [list ]
    }

    # NEXT, build the substitution list
    set subList [list \
                     %% % \
                     %t $type \
                     %M $fullMethod \
                     %m [lindex $fullMethod end] \
                     %j [join $fullMethod _]]
    
    if {$compName ne ""} {
        if {![info exists Snit_typecomponents($compName)]} {
            error "$type delegates typemethod \"$method\" to undefined typecomponent \"$compName\""
        }
        
        lappend subList %c [list $Snit_typecomponents($compName)]
    }

    set command {}

    foreach subpattern $pattern {
        lappend command [string map $subList $subpattern]
    }

    if {$implicitCreate} {
        # In this case, $method is the name of the instance to
        # create.  Don't cache, as we usually won't do this one
        # again.
        lappend command $instanceName
        return $command
    }


    # NEXT, if the actual command name isn't fully qualified,
    # assume it's global.
    set cmd [lindex $command 0]

    if {[string index $cmd 0] ne ":"} {
        set command [lreplace $command 0 0 "::$cmd"]
    }

    # NEXT, update the ensemble map.
    set map [namespace ensemble configure $eCmd -map]

    dict append map $method $command

    namespace ensemble configure $eCmd -map $map

    return [list ]
}

#-----------------------------------------------------------------------
# Component Management and Method Caching

# Retrieves the object name given the component name.
proc ::snit::RT.Component {type selfns name} {
    variable ${selfns}::Snit_components

    if {[catch {set Snit_components($name)} result]} {
        variable ${selfns}::Snit_instance

        error "component \"$name\" is undefined in $type $Snit_instance"
    }
    
    return $result
}

# Component trace; used for write trace on component instance 
# variables.  Saves the new component object name, provided 
# that certain conditions are met.  Also clears the method
# cache.

proc ::snit::RT.ComponentTrace {type selfns component n1 n2 op} {
    namespace upvar $type Snit_info Snit_info
    namespace upvar $selfns \
        $component      cvar            \
        Snit_components Snit_components
        
    # If they try to redefine the hull component after
    # it's been defined, that's an error--but only if
    # this is a widget or widget adaptor.
    if {"hull" == $component && 
        $Snit_info(isWidget) &&
        [info exists Snit_components($component)]} {
        set cvar $Snit_components($component)
        error "The hull component cannot be redefined"
    }

    # Save the new component value.
    set Snit_components($component) $cvar

    # Clear the instance caches.
    # TBD: can we unset just the elements related to
    # this component?
    RT.ClearInstanceCaches $selfns
}

# WHD: Snit 2.0 code
#
# RT.UnknownMethod type selfns win eId eCmd method args
#
# type       The type or widget command.
# selfns     The instance namespace.
# win        The original instance name.
# eId        The ensemble command ID; "" for the instance itself.
# eCmd       The real ensemble command name
# method     The unknown method name
# args       The additional arguments, if any.
#
# This proc looks up the method relative to the specific ensemble.
# If no method is found, it returns an empty list; this will result in
# the parent ensemble throwing an error.
# If the method is found, the ensemble's -map is extended with the 
# correct command, and the empty list is returned; this caches the
# method's command.  If the method is found, and it is also an
# ensemble, the ensemble command is created with an empty map.

proc ::snit::RT.UnknownMethod {type selfns win eId eCmd method args} {
    variable ${type}::Snit_info
    variable ${type}::Snit_methodInfo
    variable ${type}::Snit_typecomponents
    variable ${selfns}::Snit_components

    # FIRST, get the "self" value
    set self [set ${selfns}::Snit_instance]

    # FIRST, get the pattern data and the component name.
    set fullMethod $eId
    lappend fullMethod $method
    set starredMethod [concat $eId *]
    set methodTail $method

    if {[info exists Snit_methodInfo($fullMethod)]} {
        set key $fullMethod
    } elseif {[info exists Snit_methodInfo($starredMethod)] &&
              [lsearch -exact $Snit_info(exceptmethods) $methodTail] == -1} {
        set key $starredMethod
    } else {
        return [list ]
    }

    foreach {flag pattern compName} $Snit_methodInfo($key) {}

    if {$flag == 1} {
        # FIRST, define the ensemble command.
        lappend eId $method

        # Fix provided by Anton Kovalenko; previously this call erroneously
        # used ${type} rather than ${selfns}.
        set newCmd ${selfns}::Snit_en[llength $eId]_[join $eId _]

        set unknownCmd [list ::snit::RT.UnknownMethod \
                            $type $selfns $win $eId]

        set createCmd [list namespace ensemble create \
                           -command $newCmd \
                           -unknown $unknownCmd \
                           -prefixes 0]

        namespace eval $selfns $createCmd
        
        # NEXT, add the method to the current ensemble
        set map [namespace ensemble configure $eCmd -map]

        dict append map $method $newCmd

        namespace ensemble configure $eCmd -map $map

        return [list ]
    }

    # NEXT, build the substitution list
    set subList [list \
                     %% % \
                     %t $type \
                     %M $fullMethod \
                     %m [lindex $fullMethod end] \
                     %j [join $fullMethod _] \
                     %n [list $selfns] \
                     %w [list $win] \
                     %s [list $self]]

    if {$compName ne ""} {
        if {[info exists Snit_components($compName)]} {
            set compCmd $Snit_components($compName)
        } elseif {[info exists Snit_typecomponents($compName)]} {
            set compCmd $Snit_typecomponents($compName)
        } else {
            error "$type $self delegates method \"$fullMethod\" to undefined component \"$compName\""
        }

        lappend subList %c [list $compCmd]
    }

    # Note: The cached command will execute faster if it's
    # already a list.
    set command {}

    foreach subpattern $pattern {
        lappend command [string map $subList $subpattern]
    }

    # NEXT, if the actual command name isn't fully qualified,
    # assume it's global.

    set cmd [lindex $command 0]

    if {[string index $cmd 0] ne ":"} {
        set command [lreplace $command 0 0 "::$cmd"]
    }

    # NEXT, update the ensemble map.
    set map [namespace ensemble configure $eCmd -map]

    dict append map $method $command

    namespace ensemble configure $eCmd -map $map

    return [list ]
}

# Clears all instance command caches
proc ::snit::RT.ClearInstanceCaches {selfns} {
    # WHD: clear ensemble -map
    if {![info exists ${selfns}::Snit_instance]} {
        # Component variable set prior to constructor
        # via the "variable" type definition statement.
        return
    }
    set self [set ${selfns}::Snit_instance]
    namespace ensemble configure $self -map {}

    unset -nocomplain -- ${selfns}::Snit_cgetCache
    unset -nocomplain -- ${selfns}::Snit_configureCache
    unset -nocomplain -- ${selfns}::Snit_validateCache
}


#-----------------------------------------------------------------------
# Component Installation

# Implements %TYPE%::installhull.  The variables self and selfns
# must be defined in the caller's context.
#
# Installs the named widget as the hull of a 
# widgetadaptor.  Once the widget is hijacked, its new name
# is assigned to the hull component.

proc ::snit::RT.installhull {type {using "using"} {widgetType ""} args} {
    variable ${type}::Snit_info
    variable ${type}::Snit_optionInfo
    upvar 1 self self
    upvar 1 selfns selfns
    namespace upvar $selfns \
        hull    hull        \
        options options

    # FIRST, make sure we can do it.
    if {!$Snit_info(isWidget)} { 
        error "installhull is valid only for snit::widgetadaptors"
    }
            
    if {[info exists ${selfns}::Snit_instance]} {
        error "hull already installed for $type $self"
    }

    # NEXT, has it been created yet?  If not, create it using
    # the specified arguments.
    if {"using" == $using} {
        # FIRST, create the widget
        set cmd [linsert $args 0 $widgetType $self]
        set obj [uplevel 1 $cmd]
            
        # NEXT, for each option explicitly delegated to the hull
        # that doesn't appear in the usedOpts list, get the
        # option database value and apply it--provided that the
        # real option name and the target option name are different.
        # (If they are the same, then the option database was
        # already queried as part of the normal widget creation.)
        #
        # Also, we don't need to worry about implicitly delegated
        # options, as the option and target option names must be
        # the same.
        if {[info exists Snit_optionInfo(delegated-hull)]} {
                
            # FIRST, extract all option names from args
            set usedOpts {}
            set ndx [lsearch -glob $args "-*"]
            foreach {opt val} [lrange $args $ndx end] {
                lappend usedOpts $opt
            }
                
            foreach opt $Snit_optionInfo(delegated-hull) {
                set target [lindex $Snit_optionInfo(target-$opt) 1]
                
                if {"$target" == $opt} {
                    continue
                }
                    
                set result [lsearch -exact $usedOpts $target]
                    
                if {$result != -1} {
                    continue
                }

                set dbval [RT.OptionDbGet $type $self $opt]
                $obj configure $target $dbval
            }
        }
    } else {
        set obj $using
        
        if {$obj ne $self} {
            error \
                "hull name mismatch: \"$obj\" != \"$self\""
        }
    }

    # NEXT, get the local option defaults.
    foreach opt $Snit_optionInfo(local) {
        set dbval [RT.OptionDbGet $type $self $opt]
            
        if {"" != $dbval} {
            set options($opt) $dbval
        }
    }


    # NEXT, do the magic
    set i 0
    while 1 {
        incr i
        set newName "::hull${i}$self"
        if {![llength [info commands $newName]]} {
            break
        }
    }
        
    rename ::$self $newName
    RT.MakeInstanceCommand $type $selfns $self
        
    # Note: this relies on RT.ComponentTrace to do the dirty work.
    set hull $newName
        
    return
}

# Implements %TYPE%::install.
#
# Creates a widget and installs it as the named component.
# It expects self and selfns to be defined in the caller's context.

proc ::snit::RT.install {type compName "using" widgetType winPath args} {
    variable ${type}::Snit_optionInfo
    variable ${type}::Snit_info
    upvar 1 self   self
    upvar 1 selfns selfns

    namespace upvar ${selfns} \
        $compName comp        \
        hull      hull

    # We do the magic option database stuff only if $self is
    # a widget.
    if {$Snit_info(isWidget)} {
        if {"" == $hull} {
            error "tried to install \"$compName\" before the hull exists"
        }
            
        # FIRST, query the option database and save the results 
        # into args.  Insert them before the first option in the
        # list, in case there are any non-standard parameters.
        #
        # Note: there might not be any delegated options; if so,
        # don't bother.

        if {[info exists Snit_optionInfo(delegated-$compName)]} {
            set ndx [lsearch -glob $args "-*"]
                
            foreach opt $Snit_optionInfo(delegated-$compName) {
                set dbval [RT.OptionDbGet $type $self $opt]
                    
                if {"" != $dbval} {
                    set target [lindex $Snit_optionInfo(target-$opt) 1]
                    set args [linsert $args $ndx $target $dbval]
                }
            }
        }
    }
             
    # NEXT, create the component and save it.
    set cmd [concat [list $widgetType $winPath] $args]
    set comp [uplevel 1 $cmd]

    # NEXT, handle the option database for "delegate option *",
    # in widgets only.
    if {$Snit_info(isWidget) && $Snit_optionInfo(starcomp) eq $compName} {
        # FIRST, get the list of option specs from the widget.
        # If configure doesn't work, skip it.
        if {[catch {$comp configure} specs]} {
            return
        }

        # NEXT, get the set of explicitly used options from args
        set usedOpts {}
        set ndx [lsearch -glob $args "-*"]
        foreach {opt val} [lrange $args $ndx end] {
            lappend usedOpts $opt
        }

        # NEXT, "delegate option *" matches all options defined
        # by this widget that aren't defined by the widget as a whole,
        # and that aren't excepted.  Plus, we skip usedOpts.  So build 
        # a list of the options it can't match.
        set skiplist [concat \
                          $usedOpts \
                          $Snit_optionInfo(except) \
                          $Snit_optionInfo(local) \
                          $Snit_optionInfo(delegated)]
        
        # NEXT, loop over all of the component's options, and set
        # any not in the skip list for which there is an option 
        # database value.
        foreach spec $specs {
            # Skip aliases
            if {[llength $spec] != 5} {
                continue
            }

            set opt [lindex $spec 0]

            if {[lsearch -exact $skiplist $opt] != -1} {
                continue
            }

            set res [lindex $spec 1]
            set cls [lindex $spec 2]

            set dbvalue [option get $self $res $cls]

            if {"" != $dbvalue} {
                $comp configure $opt $dbvalue
            }
        }
    }

    return
}


#-----------------------------------------------------------------------
# Method/Variable Name Qualification

# Implements %TYPE%::variable.  Requires selfns.
proc ::snit::RT.variable {varname} {
    upvar 1 selfns selfns

    if {![string match "::*" $varname]} {
        uplevel 1 [list upvar 1 ${selfns}::$varname $varname]
    } else {
        # varname is fully qualified; let the standard
        # "variable" command handle it.
        uplevel 1 [list ::variable $varname]
    }
}

# Fully qualifies a typevariable name.
#
# This is used to implement the mytypevar command.

proc ::snit::RT.mytypevar {type name} {
    return ${type}::$name
}

# Fully qualifies an instance variable name.
#
# This is used to implement the myvar command.
proc ::snit::RT.myvar {name} {
    upvar 1 selfns selfns
    return ${selfns}::$name
}

# Use this like "list" to convert a proc call into a command
# string to pass to another object (e.g., as a -command).
# Qualifies the proc name properly.
#
# This is used to implement the "myproc" command.

proc ::snit::RT.myproc {type procname args} {
    set procname "${type}::$procname"
    return [linsert $args 0 $procname]
}

# DEPRECATED
proc ::snit::RT.codename {type name} {
    return "${type}::$name"
}

# Use this like "list" to convert a typemethod call into a command
# string to pass to another object (e.g., as a -command).
# Inserts the type command at the beginning.
#
# This is used to implement the "mytypemethod" command.

proc ::snit::RT.mytypemethod {type args} {
    return [linsert $args 0 $type]
}

# Use this like "list" to convert a method call into a command
# string to pass to another object (e.g., as a -command).
# Inserts the code at the beginning to call the right object, even if
# the object's name has changed.  Requires that selfns be defined
# in the calling context, eg. can only be called in instance
# code.
#
# This is used to implement the "mymethod" command.

proc ::snit::RT.mymethod {args} {
    upvar 1 selfns selfns
    return [linsert $args 0 ::snit::RT.CallInstance ${selfns}]
}

# Calls an instance method for an object given its
# instance namespace and remaining arguments (the first of which
# will be the method name.
#
# selfns		The instance namespace
# args			The arguments
#
# Uses the selfns to determine $self, and calls the method
# in the normal way.
#
# This is used to implement the "mymethod" command.

proc ::snit::RT.CallInstance {selfns args} {
    namespace upvar $selfns Snit_instance self

    set retval [catch {uplevel 1 [linsert $args 0 $self]} result]

    if {$retval} {
        if {$retval == 1} {
            global errorInfo
            global errorCode
            return -code error -errorinfo $errorInfo \
                -errorcode $errorCode $result
        } else {
            return -code $retval $result
        }
    }

    return $result
}

# Looks for the named option in the named variable.  If found,
# it and its value are removed from the list, and the value
# is returned.  Otherwise, the default value is returned.
# If the option is undelegated, it's own default value will be
# used if none is specified.
#
# Implements the "from" command.

proc ::snit::RT.from {type argvName option {defvalue ""}} {
    namespace upvar $type Snit_optionInfo Snit_optionInfo
    upvar $argvName argv

    set ioption [lsearch -exact $argv $option]

    if {$ioption == -1} {
        if {"" == $defvalue &&
            [info exists Snit_optionInfo(default-$option)]} {
            return $Snit_optionInfo(default-$option)
        } else {
            return $defvalue
        }
    }

    set ivalue [expr {$ioption + 1}]
    set value [lindex $argv $ivalue]
    
    set argv [lreplace $argv $ioption $ivalue] 

    return $value
}

#-----------------------------------------------------------------------
# Type Destruction

# Implements the standard "destroy" typemethod:
# Destroys a type completely.
#
# type		The snit type

proc ::snit::RT.typemethod.destroy {type} {
    variable ${type}::Snit_info
        
    # FIRST, destroy all instances
    foreach selfns [namespace children $type "${type}::Snit_inst*"] {
        if {![namespace exists $selfns]} {
            continue
        }

        namespace upvar $selfns Snit_instance obj
            
        if {$Snit_info(isWidget)} {
            destroy $obj
        } else {
            if {[llength [info commands $obj]]} {
                $obj destroy
            }
        }
    }

    # NEXT, get rid of the type command.
    rename $type ""

    # NEXT, destroy the type's data.
    namespace delete $type
}



#-----------------------------------------------------------------------
# Option Handling

# Implements the standard "cget" method
#
# type		The snit type
# selfns        The instance's instance namespace
# win           The instance's original name
# self          The instance's current name
# option        The name of the option

proc ::snit::RT.method.cget {type selfns win self option} {
    if {[catch {set ${selfns}::Snit_cgetCache($option)} command]} {
        set command [snit::RT.CacheCgetCommand $type $selfns $win $self $option]
        
        if {[llength $command] == 0} {
            return -code error "unknown option \"$option\""
        }
    }
            
    uplevel 1 $command
}

# Retrieves and caches the command that implements "cget" for the 
# specified option.
#
# type		The snit type
# selfns        The instance's instance namespace
# win           The instance's original name
# self          The instance's current name
# option        The name of the option

proc ::snit::RT.CacheCgetCommand {type selfns win self option} {
    variable ${type}::Snit_optionInfo
    variable ${selfns}::Snit_cgetCache
                
    if {[info exists Snit_optionInfo(islocal-$option)]} {
        # We know the item; it's either local, or explicitly delegated.
        if {$Snit_optionInfo(islocal-$option)} {
            # It's a local option.  If it has a cget method defined,
            # use it; otherwise just return the value.

            if {$Snit_optionInfo(cget-$option) eq ""} {
                set command [list set ${selfns}::options($option)]
            } else {
                # WHD: Snit 2.0 code -- simpler, no slower.
                set command [list \
                                 $self \
                                 {*}$Snit_optionInfo(cget-$option) \
                                 $option]
            }

            set Snit_cgetCache($option) $command
            return $command
        }
         
        # Explicitly delegated option; get target
        set comp [lindex $Snit_optionInfo(target-$option) 0]
        set target [lindex $Snit_optionInfo(target-$option) 1]
    } elseif {$Snit_optionInfo(starcomp) ne "" &&
              [lsearch -exact $Snit_optionInfo(except) $option] == -1} {
        # Unknown option, but unknowns are delegated; get target.
        set comp $Snit_optionInfo(starcomp)
        set target $option
    } else {
        return ""
    }
    
    # Get the component's object.
    set obj [RT.Component $type $selfns $comp]

    set command [list $obj cget $target]
    set Snit_cgetCache($option) $command

    return $command
}

# Implements the standard "configurelist" method
#
# type		The snit type
# selfns        The instance's instance namespace
# win           The instance's original name
# self          The instance's current name
# optionlist    A list of options and their values.

proc ::snit::RT.method.configurelist {type selfns win self optionlist} {
    variable ${type}::Snit_optionInfo

    foreach {option value} $optionlist {
        # FIRST, get the configure command, caching it if need be.
        if {[catch {set ${selfns}::Snit_configureCache($option)} command]} {
            set command [snit::RT.CacheConfigureCommand \
                             $type $selfns $win $self $option]

            if {[llength $command] == 0} {
                return -code error "unknown option \"$option\""
            }
        }

        # NEXT, if we have a type-validation object, use it.
        # TBD: Should test (islocal-$option) here, but islocal
        # isn't defined for implicitly delegated options.
        if {[info exists Snit_optionInfo(typeobj-$option)]
            && $Snit_optionInfo(typeobj-$option) ne ""} {
            if {[catch {
                $Snit_optionInfo(typeobj-$option) validate $value
            } result]} {
                return -code error "invalid $option value: $result"
            }
        }

        # NEXT, the caching the configure command also cached the
        # validate command, if any.  If we have one, run it.
        set valcommand [set ${selfns}::Snit_validateCache($option)]

        if {[llength $valcommand]} {
            lappend valcommand $value
            uplevel 1 $valcommand
        }

        # NEXT, configure the option with the value.
        lappend command $value
        uplevel 1 $command
    }
    
    return
}

# Retrieves and caches the command that stores the named option.
# Also stores the command that validates the name option if any;
# If none, the validate command is "", so that the cache is always
# populated.
#
# type		The snit type
# selfns        The instance's instance namespace
# win           The instance's original name
# self          The instance's current name
# option        An option name

proc ::snit::RT.CacheConfigureCommand {type selfns win self option} {
    variable ${type}::Snit_optionInfo
    variable ${selfns}::Snit_configureCache
    variable ${selfns}::Snit_validateCache

    if {[info exist Snit_optionInfo(islocal-$option)]} {
        # We know the item; it's either local, or explicitly delegated.
        
        if {$Snit_optionInfo(islocal-$option)} {
            # It's a local option.

            # If it's readonly, it throws an error if we're already 
            # constructed.
            if {$Snit_optionInfo(readonly-$option)} {
                if {[set ${selfns}::Snit_iinfo(constructed)]} {
                    error "option $option can only be set at instance creation"
                }
            }

            # If it has a validate method, cache that for later.
            if {$Snit_optionInfo(validate-$option) ne ""} {
                # WHD: Snit 2.0 code -- simpler, no slower.
                set command [list \
                                 $self \
                                 {*}$Snit_optionInfo(validate-$option) \
                                 $option]

                set Snit_validateCache($option) $command
            } else {
                set Snit_validateCache($option) ""
            }
            
            # If it has a configure method defined,
            # cache it; otherwise, just set the value.
            if {$Snit_optionInfo(configure-$option) eq ""} {
                set command [list set ${selfns}::options($option)]
            } else {
                # WHD: Snit 2.0 code -- simpler, no slower.
                set command [list \
                                 $self \
                                 {*}$Snit_optionInfo(configure-$option) \
                                 $option]
            }

            set Snit_configureCache($option) $command
            return $command
        }

        # Delegated option: get target.
        set comp [lindex $Snit_optionInfo(target-$option) 0]
        set target [lindex $Snit_optionInfo(target-$option) 1]
    } elseif {$Snit_optionInfo(starcomp) != "" &&
              [lsearch -exact $Snit_optionInfo(except) $option] == -1} {
        # Unknown option, but unknowns are delegated.
        set comp $Snit_optionInfo(starcomp)
        set target $option
    } else {
        return ""
    }

    # There is no validate command in this case; save an empty string.
    set Snit_validateCache($option) ""
        
    # Get the component's object
    set obj [RT.Component $type $selfns $comp]
    
    set command [list $obj configure $target]
    set Snit_configureCache($option) $command

    return $command
}

# Implements the standard "configure" method
#
# type		The snit type
# selfns        The instance's instance namespace
# win           The instance's original name
# self          The instance's current name
# args          A list of options and their values, possibly empty.

proc ::snit::RT.method.configure {type selfns win self args} {
    # If two or more arguments, set values as usual.
    if {[llength $args] >= 2} {
        ::snit::RT.method.configurelist $type $selfns $win $self $args
        return
    }

    # If zero arguments, acquire data for each known option
    # and return the list
    if {[llength $args] == 0} {
        set result {}
        foreach opt [RT.method.info.options $type $selfns $win $self] {
            # Refactor this, so that we don't need to call via $self.
            lappend result [RT.GetOptionDbSpec \
                                $type $selfns $win $self $opt]
        }
        
        return $result
    }

    # They want it for just one.
    set opt [lindex $args 0]

    return [RT.GetOptionDbSpec $type $selfns $win $self $opt]
}


# Retrieves the option database spec for a single option.
#
# type		The snit type
# selfns        The instance's instance namespace
# win           The instance's original name
# self          The instance's current name
# option        The name of an option
#
# TBD: This is a bad name.  What it's returning is the
# result of the configure query.

proc ::snit::RT.GetOptionDbSpec {type selfns win self opt} {
    variable ${type}::Snit_optionInfo

    namespace upvar $selfns \
        Snit_components Snit_components \
        options         options
    
    if {[info exists options($opt)]} {
        # This is a locally-defined option.  Just build the
        # list and return it.
        set res $Snit_optionInfo(resource-$opt)
        set cls $Snit_optionInfo(class-$opt)
        set def $Snit_optionInfo(default-$opt)

        return [list $opt $res $cls $def \
                    [RT.method.cget $type $selfns $win $self $opt]]
    } elseif {[info exists Snit_optionInfo(target-$opt)]} {
        # This is an explicitly delegated option.  The only
        # thing we don't have is the default.
        set res $Snit_optionInfo(resource-$opt)
        set cls $Snit_optionInfo(class-$opt)
        
        # Get the default
        set logicalName [lindex $Snit_optionInfo(target-$opt) 0]
        set comp $Snit_components($logicalName)
        set target [lindex $Snit_optionInfo(target-$opt) 1]

        if {[catch {$comp configure $target} result]} {
            set defValue {}
        } else {
            set defValue [lindex $result 3]
        }

        return [list $opt $res $cls $defValue [$self cget $opt]]
    } elseif {$Snit_optionInfo(starcomp) ne "" &&
              [lsearch -exact $Snit_optionInfo(except) $opt] == -1} {
        set logicalName $Snit_optionInfo(starcomp)
        set target $opt
        set comp $Snit_components($logicalName)

        if {[catch {set value [$comp cget $target]} result]} {
            error "unknown option \"$opt\""
        }

        if {![catch {$comp configure $target} result]} {
            # Replace the delegated option name with the local name.
            return [::snit::Expand $result $target $opt]
        }

        # configure didn't work; return simple form.
        return [list $opt "" "" "" $value]
    } else {
        error "unknown option \"$opt\""
    }
}

#-----------------------------------------------------------------------
# Type Introspection

# Implements the standard "info" typemethod.
#
# type		The snit type
# command       The info subcommand
# args          All other arguments.

proc ::snit::RT.typemethod.info {type command args} {
    global errorInfo
    global errorCode

    switch -exact $command {
	args        -
	body        -
	default     -
        typevars    -
        typemethods -
        instances {
            # TBD: it should be possible to delete this error
            # handling.
            set errflag [catch {
                uplevel 1 [linsert $args 0 \
			       ::snit::RT.typemethod.info.$command $type]
            } result]

            if {$errflag} {
                return -code error -errorinfo $errorInfo \
                    -errorcode $errorCode $result
            } else {
                return $result
            }
        }
        default {
            error "\"$type info $command\" is not defined"
        }
    }
}


# Returns a list of the type's typevariables whose names match a 
# pattern, excluding Snit internal variables.
#
# type		A Snit type
# pattern       Optional.  The glob pattern to match.  Defaults
#               to *.

proc ::snit::RT.typemethod.info.typevars {type {pattern *}} {
    set result {}
    foreach name [info vars "${type}::$pattern"] {
        set tail [namespace tail $name]
        if {![string match "Snit_*" $tail]} {
            lappend result $name
        }
    }
    
    return $result
}

# Returns a list of the type's methods whose names match a 
# pattern.  If "delegate typemethod *" is used, the list may
# not be complete.
#
# type		A Snit type
# pattern       Optional.  The glob pattern to match.  Defaults
#               to *.

proc ::snit::RT.typemethod.info.typemethods {type {pattern *}} {
    variable ${type}::Snit_typemethodInfo

    # FIRST, get the explicit names, skipping prefixes.
    set result {}

    foreach name [array names Snit_typemethodInfo -glob $pattern] {
        if {[lindex $Snit_typemethodInfo($name) 0] != 1} {
            lappend result $name
        }
    }

    # NEXT, add any from the cache that aren't explicit.
    # WHD: fixed up to use newstyle method cache/list of subcommands.
    if {[info exists Snit_typemethodInfo(*)]} {
        # First, remove "*" from the list.
        set ndx [lsearch -exact $result "*"]
        if {$ndx != -1} {
            set result [lreplace $result $ndx $ndx]
        }

        # Next, get the type's -map
        array set typemethodCache [namespace ensemble configure $type -map]

        # Next, get matching names from the cache that we don't already
        # know about.
        foreach name [array names typemethodCache -glob $pattern] {
            if {[lsearch -exact $result $name] == -1} {
                lappend result $name
            }
        }
    }

    return $result
}

# $type info args
#
# Returns a method's list of arguments. does not work for delegated
# methods, nor for the internal dispatch methods of multi-word
# methods.

proc ::snit::RT.typemethod.info.args {type method} {
    upvar ${type}::Snit_typemethodInfo  Snit_typemethodInfo

    # Snit_methodInfo: method -> list (flag cmd component)

    # flag      : 1 -> internal dispatcher for multi-word method.
    #             0 -> regular method
    #
    # cmd       : template mapping from method to command prefix, may
    #             contain placeholders for various pieces of information.
    #
    # component : is empty for normal methods.

    #parray Snit_typemethodInfo

    if {![info exists Snit_typemethodInfo($method)]} {
	return -code error "Unknown typemethod \"$method\""
    }
    foreach {flag cmd component} $Snit_typemethodInfo($method) break
    if {$flag} {
	return -code error "Unknown typemethod \"$method\""
    }
    if {$component != ""} {
	return -code error "Delegated typemethod \"$method\""
    }

    set map     [list %m $method %j [join $method _] %t $type]
    set theproc [lindex [string map $map $cmd] 0]
    return [lrange [::info args $theproc] 1 end]
}

# $type info body
#
# Returns a method's body. does not work for delegated
# methods, nor for the internal dispatch methods of multi-word
# methods.

proc ::snit::RT.typemethod.info.body {type method} {
    upvar ${type}::Snit_typemethodInfo  Snit_typemethodInfo

    # Snit_methodInfo: method -> list (flag cmd component)

    # flag      : 1 -> internal dispatcher for multi-word method.
    #             0 -> regular method
    #
    # cmd       : template mapping from method to command prefix, may
    #             contain placeholders for various pieces of information.
    #
    # component : is empty for normal methods.

    #parray Snit_typemethodInfo

    if {![info exists Snit_typemethodInfo($method)]} {
	return -code error "Unknown typemethod \"$method\""
    }
    foreach {flag cmd component} $Snit_typemethodInfo($method) break
    if {$flag} {
	return -code error "Unknown typemethod \"$method\""
    }
    if {$component != ""} {
	return -code error "Delegated typemethod \"$method\""
    }

    set map     [list %m $method %j [join $method _] %t $type]
    set theproc [lindex [string map $map $cmd] 0]
    return [RT.body [::info body $theproc]]
}

# $type info default
#
# Returns a method's list of arguments. does not work for delegated
# methods, nor for the internal dispatch methods of multi-word
# methods.

proc ::snit::RT.typemethod.info.default {type method aname dvar} {
    upvar 1 $dvar def
    upvar ${type}::Snit_typemethodInfo  Snit_typemethodInfo

    # Snit_methodInfo: method -> list (flag cmd component)

    # flag      : 1 -> internal dispatcher for multi-word method.
    #             0 -> regular method
    #
    # cmd       : template mapping from method to command prefix, may
    #             contain placeholders for various pieces of information.
    #
    # component : is empty for normal methods.

    #parray Snit_methodInfo

    if {![info exists Snit_typemethodInfo($method)]} {
	return -code error "Unknown typemethod \"$method\""
    }
    foreach {flag cmd component} $Snit_typemethodInfo($method) break
    if {$flag} {
	return -code error "Unknown typemethod \"$method\""
    }
    if {$component != ""} {
	return -code error "Delegated typemethod \"$method\""
    }

    set map     [list %m $method %j [join $method _] %t $type]
    set theproc [lindex [string map $map $cmd] 0]
    return [::info default $theproc $aname def]
}

# Returns a list of the type's instances whose names match
# a pattern.
#
# type		A Snit type
# pattern       Optional.  The glob pattern to match
#               Defaults to *
#
# REQUIRE: type is fully qualified.

proc ::snit::RT.typemethod.info.instances {type {pattern *}} {
    set result {}

    foreach selfns [namespace children $type "${type}::Snit_inst*"] {
        namespace upvar $selfns Snit_instance instance

        if {[string match $pattern $instance]} {
            lappend result $instance
        }
    }

    return $result
}

#-----------------------------------------------------------------------
# Instance Introspection

# Implements the standard "info" method.
#
# type		The snit type
# selfns        The instance's instance namespace
# win           The instance's original name
# self          The instance's current name
# command       The info subcommand
# args          All other arguments.

proc ::snit::RT.method.info {type selfns win self command args} {
    switch -exact $command {
	args        -
	body        -
	default     -
        type        -
        vars        -
        options     -
        methods     -
        typevars    -
        typemethods {
            set errflag [catch {
                uplevel 1 [linsert $args 0 ::snit::RT.method.info.$command \
			       $type $selfns $win $self]
            } result]

            if {$errflag} {
                global errorInfo
                return -code error -errorinfo $errorInfo $result
            } else {
                return $result
            }
        }
        default {
            # error "\"$self info $command\" is not defined"
            return -code error "\"$self info $command\" is not defined"
        }
    }
}

# $self info type
#
# Returns the instance's type
proc ::snit::RT.method.info.type {type selfns win self} {
    return $type
}

# $self info typevars
#
# Returns the instance's type's typevariables
proc ::snit::RT.method.info.typevars {type selfns win self {pattern *}} {
    return [RT.typemethod.info.typevars $type $pattern]
}

# $self info typemethods
#
# Returns the instance's type's typemethods
proc ::snit::RT.method.info.typemethods {type selfns win self {pattern *}} {
    return [RT.typemethod.info.typemethods $type $pattern]
}

# Returns a list of the instance's methods whose names match a 
# pattern.  If "delegate method *" is used, the list may
# not be complete.
#
# type		A Snit type
# selfns        The instance namespace
# win		The original instance name
# self          The current instance name
# pattern       Optional.  The glob pattern to match.  Defaults
#               to *.

proc ::snit::RT.method.info.methods {type selfns win self {pattern *}} {
    variable ${type}::Snit_methodInfo

    # FIRST, get the explicit names, skipping prefixes.
    set result {}

    foreach name [array names Snit_methodInfo -glob $pattern] {
        if {[lindex $Snit_methodInfo($name) 0] != 1} {
            lappend result $name
        }
    }

    # NEXT, add any from the cache that aren't explicit.
    # WHD: Fixed up to use newstyle method cache/list of subcommands.
    if {[info exists Snit_methodInfo(*)]} {
        # First, remove "*" from the list.
        set ndx [lsearch -exact $result "*"]
        if {$ndx != -1} {
            set result [lreplace $result $ndx $ndx]
        }

        # Next, get the instance's -map
        set self [set ${selfns}::Snit_instance]

        array set methodCache [namespace ensemble configure $self -map]

        # Next, get matching names from the cache that we don't already
        # know about.
        foreach name [array names methodCache -glob $pattern] {
            if {[lsearch -exact $result $name] == -1} {
                lappend result $name
            }
        }
    }

    return $result
}

# $self info args
#
# Returns a method's list of arguments. does not work for delegated
# methods, nor for the internal dispatch methods of multi-word
# methods.

proc ::snit::RT.method.info.args {type selfns win self method} {

    upvar ${type}::Snit_methodInfo  Snit_methodInfo

    # Snit_methodInfo: method -> list (flag cmd component)

    # flag      : 1 -> internal dispatcher for multi-word method.
    #             0 -> regular method
    #
    # cmd       : template mapping from method to command prefix, may
    #             contain placeholders for various pieces of information.
    #
    # component : is empty for normal methods.

    #parray Snit_methodInfo

    if {![info exists Snit_methodInfo($method)]} {
	return -code error "Unknown method \"$method\""
    }
    foreach {flag cmd component} $Snit_methodInfo($method) break
    if {$flag} {
	return -code error "Unknown method \"$method\""
    }
    if {$component != ""} {
	return -code error "Delegated method \"$method\""
    }

    set map     [list %m $method %j [join $method _] %t $type %n $selfns %w $win %s $self]
    set theproc [lindex [string map $map $cmd] 0]
    return [lrange [::info args $theproc] 4 end]
}

# $self info body
#
# Returns a method's body. does not work for delegated
# methods, nor for the internal dispatch methods of multi-word
# methods.

proc ::snit::RT.method.info.body {type selfns win self method} {

    upvar ${type}::Snit_methodInfo  Snit_methodInfo

    # Snit_methodInfo: method -> list (flag cmd component)

    # flag      : 1 -> internal dispatcher for multi-word method.
    #             0 -> regular method
    #
    # cmd       : template mapping from method to command prefix, may
    #             contain placeholders for various pieces of information.
    #
    # component : is empty for normal methods.

    #parray Snit_methodInfo

    if {![info exists Snit_methodInfo($method)]} {
	return -code error "Unknown method \"$method\""
    }
    foreach {flag cmd component} $Snit_methodInfo($method) break
    if {$flag} {
	return -code error "Unknown method \"$method\""
    }
    if {$component != ""} {
	return -code error "Delegated method \"$method\""
    }

    set map     [list %m $method %j [join $method _] %t $type %n $selfns %w $win %s $self]
    set theproc [lindex [string map $map $cmd] 0]
    return [RT.body [::info body $theproc]]
}

# $self info default
#
# Returns a method's list of arguments. does not work for delegated
# methods, nor for the internal dispatch methods of multi-word
# methods.

proc ::snit::RT.method.info.default {type selfns win self method aname dvar} {
    upvar 1 $dvar def
    upvar ${type}::Snit_methodInfo  Snit_methodInfo

    # Snit_methodInfo: method -> list (flag cmd component)

    # flag      : 1 -> internal dispatcher for multi-word method.
    #             0 -> regular method
    #
    # cmd       : template mapping from method to command prefix, may
    #             contain placeholders for various pieces of information.
    #
    # component : is empty for normal methods.

    if {![info exists Snit_methodInfo($method)]} {
	return -code error "Unknown method \"$method\""
    }
    foreach {flag cmd component} $Snit_methodInfo($method) break
    if {$flag} {
	return -code error "Unknown method \"$method\""
    }
    if {$component != ""} {
	return -code error "Delegated method \"$method\""
    }

    set map     [list %m $method %j [join $method _] %t $type %n $selfns %w $win %s $self]
    set theproc [lindex [string map $map $cmd] 0]
    return [::info default $theproc $aname def]
}

# $self info vars
#
# Returns the instance's instance variables
proc ::snit::RT.method.info.vars {type selfns win self {pattern *}} {
    set result {}
    foreach name [info vars "${selfns}::$pattern"] {
        set tail [namespace tail $name]
        if {![string match "Snit_*" $tail]} {
            lappend result $name
        }
    }

    return $result
}

# $self info options 
#
# Returns a list of the names of the instance's options
proc ::snit::RT.method.info.options {type selfns win self {pattern *}} {
    variable ${type}::Snit_optionInfo

    # First, get the local and explicitly delegated options
    set result [concat $Snit_optionInfo(local) $Snit_optionInfo(delegated)]

    # If "configure" works as for Tk widgets, add the resulting
    # options to the list.  Skip excepted options
    if {$Snit_optionInfo(starcomp) ne ""} {
        namespace upvar $selfns Snit_components Snit_components

        set logicalName $Snit_optionInfo(starcomp)
        set comp $Snit_components($logicalName)

        if {![catch {$comp configure} records]} {
            foreach record $records {
                set opt [lindex $record 0]
                if {[lsearch -exact $result $opt] == -1 &&
                    [lsearch -exact $Snit_optionInfo(except) $opt] == -1} {
                    lappend result $opt
                }
            }
        }
    }

    # Next, apply the pattern
    set names {}

    foreach name $result {
        if {[string match $pattern $name]} {
            lappend names $name
        }
    }

    return $names
}

proc ::snit::RT.body {body} {
    regsub -all ".*# END snit method prolog\n" $body {} body
    return $body
}

#-- From validate.tcl
#-----------------------------------------------------------------------
# TITLE:
#    validate.tcl
#
# AUTHOR:
#    Will Duquette
#
# DESCRIPTION:
#    Snit validation types.
#
#-----------------------------------------------------------------------

namespace eval ::snit:: { 
    namespace export \
        boolean \
        double \
        enum \
        fpixels \
        integer \
        listtype \
        pixels \
        stringtype \
        window
}

#-----------------------------------------------------------------------
# snit::boolean

snit::type ::snit::boolean {
    #-------------------------------------------------------------------
    # Type Methods

    typemethod validate {value} {
        if {![string is boolean -strict $value]} {
            return -code error -errorcode INVALID \
   "invalid boolean \"$value\", should be one of: 1, 0, true, false, yes, no, on, off"

        }

        return $value
    }

    #-------------------------------------------------------------------
    # Constructor

    # None needed; no options

    #-------------------------------------------------------------------
    # Public Methods

    method validate {value} {
        $type validate $value
    }
}

#-----------------------------------------------------------------------
# snit::double

snit::type ::snit::double {
    #-------------------------------------------------------------------
    # Options

    # -min value
    #
    # Minimum value

    option -min -default "" -readonly 1

    # -max value
    #
    # Maximum value

    option -max -default "" -readonly 1

    #-------------------------------------------------------------------
    # Type Methods

    typemethod validate {value} {
        if {![string is double -strict $value]} {
            return -code error -errorcode INVALID \
                "invalid value \"$value\", expected double"
        }

        return $value
    }

    #-------------------------------------------------------------------
    # Constructor

    constructor {args} {
        # FIRST, get the options
        $self configurelist $args

        if {"" != $options(-min) && 
            ![string is double -strict $options(-min)]} {
            return -code error \
                "invalid -min: \"$options(-min)\""
        }

        if {"" != $options(-max) && 
            ![string is double -strict $options(-max)]} {
            return -code error \
                "invalid -max: \"$options(-max)\""
        }

        if {"" != $options(-min) &&
            "" != $options(-max) && 
            $options(-max) < $options(-min)} {
            return -code error "-max < -min"
        }
    }

    #-------------------------------------------------------------------
    # Public Methods

    # Fixed method for the snit::double type.
    # WHD, 6/7/2010.
    method validate {value} {
        $type validate $value

        if {("" != $options(-min) && $value < $options(-min))       ||
            ("" != $options(-max) && $value > $options(-max))} {

            set msg "invalid value \"$value\", expected double"

            if {"" != $options(-min) && "" != $options(-max)} {
                append msg " in range $options(-min), $options(-max)"
            } elseif {"" != $options(-min)} {
                append msg " no less than $options(-min)"
            } elseif {"" != $options(-max)} {
                append msg " no greater than $options(-max)"
            }
        
            return -code error -errorcode INVALID $msg
        }

        return $value
    }
}

#-----------------------------------------------------------------------
# snit::enum

snit::type ::snit::enum {
    #-------------------------------------------------------------------
    # Options

    # -values list
    #
    # Valid values for this type

    option -values -default {} -readonly 1

    #-------------------------------------------------------------------
    # Type Methods

    typemethod validate {value} {
        # No -values specified; it's always valid
        return $value
    }

    #-------------------------------------------------------------------
    # Constructor

    constructor {args} {
        $self configurelist $args

        if {[llength $options(-values)] == 0} {
            return -code error \
                "invalid -values: \"\""
        }
    }

    #-------------------------------------------------------------------
    # Public Methods

    method validate {value} {
        if {[lsearch -exact $options(-values) $value] == -1} {
            return -code error -errorcode INVALID \
    "invalid value \"$value\", should be one of: [join $options(-values) {, }]"
        }
        
        return $value
    }
}

#-----------------------------------------------------------------------
# snit::fpixels

snit::type ::snit::fpixels {
    #-------------------------------------------------------------------
    # Options

    # -min value
    #
    # Minimum value

    option -min -default "" -readonly 1

    # -max value
    #
    # Maximum value

    option -max -default "" -readonly 1

    #-------------------------------------------------------------------
    # Instance variables

    variable min ""  ;# -min, no suffix
    variable max ""  ;# -max, no suffix

    #-------------------------------------------------------------------
    # Type Methods

    typemethod validate {value} {
        if {[catch {winfo fpixels . $value} dummy]} {
            return -code error -errorcode INVALID \
                "invalid value \"$value\", expected fpixels"
        }

        return $value
    }

    #-------------------------------------------------------------------
    # Constructor

    constructor {args} {
        # FIRST, get the options
        $self configurelist $args

        if {"" != $options(-min) && 
            [catch {winfo fpixels . $options(-min)} min]} {
            return -code error \
                "invalid -min: \"$options(-min)\""
        }

        if {"" != $options(-max) && 
            [catch {winfo fpixels . $options(-max)} max]} {
            return -code error \
                "invalid -max: \"$options(-max)\""
        }

        if {"" != $min &&
            "" != $max && 
            $max < $min} {
            return -code error "-max < -min"
        }
    }

    #-------------------------------------------------------------------
    # Public Methods

    method validate {value} {
        $type validate $value
        
        set val [winfo fpixels . $value]

        if {("" != $min && $val < $min) ||
            ("" != $max && $val > $max)} {

            set msg "invalid value \"$value\", expected fpixels"

            if {"" != $min && "" != $max} {
                append msg " in range $options(-min), $options(-max)"
            } elseif {"" != $min} {
                append msg " no less than $options(-min)"
            }
        
            return -code error -errorcode INVALID $msg
        }

        return $value
    }
}

#-----------------------------------------------------------------------
# snit::integer

snit::type ::snit::integer {
    #-------------------------------------------------------------------
    # Options

    # -min value
    #
    # Minimum value

    option -min -default "" -readonly 1

    # -max value
    #
    # Maximum value

    option -max -default "" -readonly 1

    #-------------------------------------------------------------------
    # Type Methods

    typemethod validate {value} {
        if {![string is integer -strict $value]} {
            return -code error -errorcode INVALID \
                "invalid value \"$value\", expected integer"
        }

        return $value
    }

    #-------------------------------------------------------------------
    # Constructor

    constructor {args} {
        # FIRST, get the options
        $self configurelist $args

        if {"" != $options(-min) && 
            ![string is integer -strict $options(-min)]} {
            return -code error \
                "invalid -min: \"$options(-min)\""
        }

        if {"" != $options(-max) && 
            ![string is integer -strict $options(-max)]} {
            return -code error \
                "invalid -max: \"$options(-max)\""
        }

        if {"" != $options(-min) &&
            "" != $options(-max) && 
            $options(-max) < $options(-min)} {
            return -code error "-max < -min"
        }
    }

    #-------------------------------------------------------------------
    # Public Methods

    method validate {value} {
        $type validate $value

        if {("" != $options(-min) && $value < $options(-min))       ||
            ("" != $options(-max) && $value > $options(-max))} {

            set msg "invalid value \"$value\", expected integer"

            if {"" != $options(-min) && "" != $options(-max)} {
                append msg " in range $options(-min), $options(-max)"
            } elseif {"" != $options(-min)} {
                append msg " no less than $options(-min)"
            }
        
            return -code error -errorcode INVALID $msg
        }

        return $value
    }
}

#-----------------------------------------------------------------------
# snit::list

snit::type ::snit::listtype {
    #-------------------------------------------------------------------
    # Options

    # -type type
    #
    # Specifies a value type

    option -type -readonly 1

    # -minlen len
    #
    # Minimum list length

    option -minlen -readonly 1 -default 0

    # -maxlen len
    #
    # Maximum list length

    option -maxlen -readonly 1

    #-------------------------------------------------------------------
    # Type Methods

    typemethod validate {value} {
        if {[catch {llength $value} result]} {
            return -code error -errorcode INVALID \
                "invalid value \"$value\", expected list"
        }

        return $value
    }

    #-------------------------------------------------------------------
    # Constructor
    
    constructor {args} {
        # FIRST, get the options
        $self configurelist $args

        if {"" != $options(-minlen) && 
            (![string is integer -strict $options(-minlen)] ||
             $options(-minlen) < 0)} {
            return -code error \
                "invalid -minlen: \"$options(-minlen)\""
        }

        if {"" == $options(-minlen)} {
            set options(-minlen) 0
        }

        if {"" != $options(-maxlen) && 
            ![string is integer -strict $options(-maxlen)]} {
            return -code error \
                "invalid -maxlen: \"$options(-maxlen)\""
        }

        if {"" != $options(-maxlen) && 
            $options(-maxlen) < $options(-minlen)} {
            return -code error "-maxlen < -minlen"
        }
    }


    #-------------------------------------------------------------------
    # Methods

    method validate {value} {
        $type validate $value

        set len [llength $value]

        if {$len < $options(-minlen)} {
            return -code error -errorcode INVALID \
              "value has too few elements; at least $options(-minlen) expected"
        } elseif {"" != $options(-maxlen)} {
            if {$len > $options(-maxlen)} {
                return -code error -errorcode INVALID \
         "value has too many elements; no more than $options(-maxlen) expected"
            }
        }

        # NEXT, check each value
        if {"" != $options(-type)} {
            foreach item $value {
                set cmd $options(-type)
                lappend cmd validate $item
                uplevel \#0 $cmd
            }
        }
        
        return $value
    }
}

#-----------------------------------------------------------------------
# snit::pixels

snit::type ::snit::pixels {
    #-------------------------------------------------------------------
    # Options

    # -min value
    #
    # Minimum value

    option -min -default "" -readonly 1

    # -max value
    #
    # Maximum value

    option -max -default "" -readonly 1

    #-------------------------------------------------------------------
    # Instance variables

    variable min ""  ;# -min, no suffix
    variable max ""  ;# -max, no suffix

    #-------------------------------------------------------------------
    # Type Methods

    typemethod validate {value} {
        if {[catch {winfo pixels . $value} dummy]} {
            return -code error -errorcode INVALID \
                "invalid value \"$value\", expected pixels"
        }

        return $value
    }

    #-------------------------------------------------------------------
    # Constructor

    constructor {args} {
        # FIRST, get the options
        $self configurelist $args

        if {"" != $options(-min) && 
            [catch {winfo pixels . $options(-min)} min]} {
            return -code error \
                "invalid -min: \"$options(-min)\""
        }

        if {"" != $options(-max) && 
            [catch {winfo pixels . $options(-max)} max]} {
            return -code error \
                "invalid -max: \"$options(-max)\""
        }

        if {"" != $min &&
            "" != $max && 
            $max < $min} {
            return -code error "-max < -min"
        }
    }

    #-------------------------------------------------------------------
    # Public Methods

    method validate {value} {
        $type validate $value
        
        set val [winfo pixels . $value]

        if {("" != $min && $val < $min) ||
            ("" != $max && $val > $max)} {

            set msg "invalid value \"$value\", expected pixels"

            if {"" != $min && "" != $max} {
                append msg " in range $options(-min), $options(-max)"
            } elseif {"" != $min} {
                append msg " no less than $options(-min)"
            }
        
            return -code error -errorcode INVALID $msg
        }

        return $value
    }
}

#-----------------------------------------------------------------------
# snit::stringtype

snit::type ::snit::stringtype {
    #-------------------------------------------------------------------
    # Options

    # -minlen len
    #
    # Minimum list length

    option -minlen -readonly 1 -default 0

    # -maxlen len
    #
    # Maximum list length

    option -maxlen -readonly 1

    # -nocase 0|1
    #
    # globs and regexps are case-insensitive if -nocase 1.

    option -nocase -readonly 1 -default 0

    # -glob pattern
    #
    # Glob-match pattern, or ""

    option -glob -readonly 1

    # -regexp regexp
    #
    # Regular expression to match
    
    option -regexp -readonly 1
    
    #-------------------------------------------------------------------
    # Type Methods

    typemethod validate {value} {
        # By default, any string (hence, any Tcl value) is valid.
        return $value
    }

    #-------------------------------------------------------------------
    # Constructor
    
    constructor {args} {
        # FIRST, get the options
        $self configurelist $args

        # NEXT, validate -minlen and -maxlen
        if {"" != $options(-minlen) && 
            (![string is integer -strict $options(-minlen)] ||
             $options(-minlen) < 0)} {
            return -code error \
                "invalid -minlen: \"$options(-minlen)\""
        }

        if {"" == $options(-minlen)} {
            set options(-minlen) 0
        }

        if {"" != $options(-maxlen) && 
            ![string is integer -strict $options(-maxlen)]} {
            return -code error \
                "invalid -maxlen: \"$options(-maxlen)\""
        }

        if {"" != $options(-maxlen) && 
            $options(-maxlen) < $options(-minlen)} {
            return -code error "-maxlen < -minlen"
        }

        # NEXT, validate -nocase
        if {[catch {snit::boolean validate $options(-nocase)} result]} {
            return -code error "invalid -nocase: $result"
        }

        # Validate the glob
        if {"" != $options(-glob) && 
            [catch {string match $options(-glob) ""} dummy]} {
            return -code error \
                "invalid -glob: \"$options(-glob)\""
        }

        # Validate the regexp
        if {"" != $options(-regexp) && 
            [catch {regexp $options(-regexp) ""} dummy]} {
            return -code error \
                "invalid -regexp: \"$options(-regexp)\""
        }
    }


    #-------------------------------------------------------------------
    # Methods

    method validate {value} {
        # Usually we'd call [$type validate $value] here, but
        # as it's a no-op, don't bother.

        # FIRST, validate the length.
        set len [string length $value]

        if {$len < $options(-minlen)} {
            return -code error -errorcode INVALID \
              "too short: at least $options(-minlen) characters expected"
        } elseif {"" != $options(-maxlen)} {
            if {$len > $options(-maxlen)} {
                return -code error -errorcode INVALID \
         "too long: no more than $options(-maxlen) characters expected"
            }
        }

        # NEXT, check the glob match, with or without case.
        if {"" != $options(-glob)} {
            if {$options(-nocase)} {
                set result [string match -nocase $options(-glob) $value]
            } else {
                set result [string match $options(-glob) $value]
            }
            
            if {!$result} {
                return -code error -errorcode INVALID \
                    "invalid value \"$value\""
            }
        }
        
        # NEXT, check regexp match with or without case
        if {"" != $options(-regexp)} {
            if {$options(-nocase)} {
                set result [regexp -nocase -- $options(-regexp) $value]
            } else {
                set result [regexp -- $options(-regexp) $value]
            }
            
            if {!$result} {
                return -code error -errorcode INVALID \
                    "invalid value \"$value\""
            }
        }
        
        return $value
    }
}

#-----------------------------------------------------------------------
# snit::window

snit::type ::snit::window {
    #-------------------------------------------------------------------
    # Type Methods

    typemethod validate {value} {
        if {![winfo exists $value]} {
            return -code error -errorcode INVALID \
                "invalid value \"$value\", value is not a window"
        }

        return $value
    }

    #-------------------------------------------------------------------
    # Constructor

    # None needed; no options

    #-------------------------------------------------------------------
    # Public Methods

    method validate {value} {
        $type validate $value
    }
}

#-- From shistory.tmp


package require snit
namespace eval ::dgtools {}
snit::type ::dgtools::shistory {

    option -home ""
    variable index -1
    variable history
    constructor {args} {
        $self configurelist $args
        set history [list]
    }
    
    
    method back {} {
        incr index -1
        return [lindex $history $index]
    }
    method canBackward {} {
        if {$index > 0} {
            return true
        } else {
            return false
        }
    }
    method canFirst {} {
        if {$index == 0} {
            return false
        } else {
            return true
        }
        
    }
    method canForward {} {
        if {[llength $history] > [expr {$index+1}]} {
            return true
        } else {
            return false
        }
    }
    method canLast {} {
        if {$index == [expr {[llength $history] -1}]} {
            return false
        } else {
            return true
        }
    }
    method current {} {
        return [lindex $history $index]
    }
    
    method first {} {
        set index 0
        return [lindex $history $index]
    }
    method forward {} {
        incr index +1
        return [lindex $history $index]
    }
    method getHistory {} {
        return $history
    }
    
    method insert {item} {
        set item [regsub {/$} $item ""]
        if {$item ne [lindex $history $index]} {
            incr index
            if {$item ne [lindex $history $index]} {
                set history [linsert $history $index $item]
            } else {
                incr index -1
            }
        }
        return $item
    }
    
    method home {} {
        return $options(-home)
    }
    
    method resetHistory {} {
        set index -1
        set history [list]

    }
    method last {} {
        set index [llength $history]
        incr index -1
        return [lindex $history $index]
    }
}

package provide dgtools::shistory 0.2



if {[info exists argv0] && $argv0 eq [info script] && [regexp {shistory} $argv0]} {
    set dpath dgtools
    set pfile [file rootname [file tail [info script]]]
    package require dgtools::dgtutils
    source [file join [file dirname [info script]] dgtutils.tcl]
    if {[llength $argv] == 1 && [lindex $argv 0] eq "--version"} {    
        puts [dgtools::getVersion [info script]]
    } elseif {[llength $argv] == 1 && [lindex $argv 0] eq "--test"} {
        package require tcltest
        set argv [list] 
        tcltest::test dummy-1.1 {
            Calling my proc should always return a list of at least length 3
        } -body {
            set result 1
        } -result {1}
        tcltest::test history-1.1 {
            Starting a history
        } -body {
            set sh [::dgtools::shistory %AUTO% -home h]
            return [$sh home]
        } -result {h}
        tcltest::test history-1.2 {
            insert a value
        } -body {
            $sh insert a
            return [$sh current]
        } -result {a}
        tcltest::test history-1.3 {
            insert a value repeated
        } -body {
            $sh insert a
            $sh insert a
            $sh insert a
            llength [$sh getHistory]
        } -result {1}
        tcltest::test history-1.4 {
            can back with 1 item
        } -body {
             $sh canBackward
        } -result {false}
        tcltest::test history-1.5 {
            can back with 2 items
        } -body {
            $sh insert b
            $sh canBackward
        } -result {true}
        tcltest::test history-1.6 {
            can forward at the end?
        } -body {
            $sh canForward
        } -result {false}
        tcltest::test history-1.7 {
            can forward if going back?
        } -body {
            $sh back
            $sh canForward
        } -result {true}
        tcltest::test history-1.8 {
            insert in the middle
        } -body {
            $sh insert c
            $sh insert c
            $sh getHistory
        } -result {a c b}
        tcltest::test history-1.9 {
            check first
        } -body {
            $sh first
        } -result {a}
        tcltest::test history-1.10 {
            canBackward at first
        } -body {
            $sh canBackward
        } -result {false}
        tcltest::test history-1.11 {
            canForward at first
        } -body {
            $sh canForward
        } -result {true}
        tcltest::test history-1.12 {
            canForward at end
        } -body {
            $sh last
            $sh canForward
        } -result {false}
        tcltest::test history-1.13 {
            canBackward at last
        } -body {
            $sh canBackward
        } -result {true}
        tcltest::cleanupTests
    } elseif {[llength $argv] == 1 && ([lindex $argv 0] eq "--license" || [lindex $argv 0] eq "--man" || [lindex $argv 0] eq "--html" || [lindex $argv 0] eq "--markdown")} {
        dgtools::manual [lindex $argv 0] [info script]
    } elseif {[llength $argv] == 1 && [lindex $argv 0] eq "--install"} {
        dgtools::install [info script]
    } else {
        puts "\n    -------------------------------------"
        puts "     The dgtools::[file rootname [file tail [info script]]] package for Tcl"
        puts "    -------------------------------------\n"
        puts "Copyright (c) 2019  Dr. Detlef Groth, E-mail: detlef(at)dgroth(dot)de\n"
        puts "License: MIT - License see manual page"
        puts "\nThe dgtools::[file rootname [file tail [info script]]] package provides a list with text entries which can used as" 
        puts "history data structure for programmers of the Tcl/Tk Programming language"
        puts ""
        puts "Usage: [info nameofexe] [info script] option\n"
        puts "    Valid options are:\n"
        puts "        --help    : printing out this help page"
        puts "        --test    : running some test code"
        puts "        --license : printing the license to the terminal"
        puts "        --install : install shistory as Tcl module"        
        puts "        --man     : printing the man page in pandoc markdown to the terminal"
        puts "        --markdown: printing the man page in simple markdown to the terminal"
        puts "        --html    : printing the man page in html code to the terminal"
        puts "                    if the Markdown package from tcllib is available"
        puts "        --version : printing the package version to the terminal"        
        puts ""
        puts "    The --man option can be used to generate the documentation pages as well with"
        puts "    a command like: "
        puts ""
        puts "    tclsh [file tail [info script]] --man | pandoc -t html -s > temp.html\n"
        
    }

}

#-- From dgwutils.tmp

package provide dgw::dgwutils 0.2
namespace eval dgw {
    variable htmltemplate {
<!DOCTYPE html>
<html>
<head>
<meta http-equiv="Content-Security-Policy" content="default-src 'self' data: ; script-src 'self' 'nonce-d717cfb5d902616b7024920ae20346a8494f7832145c90e0' ; style-src 'self' 'unsafe-inline'" />
<meta name="viewport" content="width=device-width, initial-scale=1.0">
<meta name="title" content="$document(title)">
<meta name="author" content="$document(author)">
<title>$document(title)</title>
<style>
body {
    margin-left: 5%; margin-right: 5%;
    font-family: Palatino, "Palatino Linotype", "Palatino LT STD", "Book Antiqua", Georgia, serif;
}
pre {
padding-top:	1ex;
padding-bottom:	1ex;
padding-left:	2ex;
padding-right:	1ex;
width:		100%;
color: 		black;
background: 	#ffefdf;
border-top:        1px solid #6A6A6A;
border-bottom:     1px solid #6A6A6A;

font-family: Consolas, "Liberation Mono", Menlo, Courier, monospace;
}
pre.synopsis {
    background: #ddefff;
}

code {
    font-family: Consolas, "Liberation Mono", Menlo, Courier, monospace;
}

h1 {
font-family:	sans-serif;
font-size:	120%;
background: 	transparent;
text-align:	center;
}
h3 {
font-family:	sans-serif;
font-size:	110%;
background: 	transparent;
text-align:	center;
}
h2 {
margin-top: 	1em;
font-family:	sans-serif;
font-size:	110%;
color:		#005A9C;
text-align:	left;
background-color:  #eeeeee;
padding: 0.4em;

}
</style>
</head>
<body>
<div class="title"><h1>$document(title)</h1></div>
<div class="author"><h3>$document(author)</h3></div>
<div class="date"><h3>$document(date)</h3></div>
}
} 


proc dgw::displayCode {fname} {
    destroy .
    set filename $fname
    if [catch {open $filename r} infh] {
        puts stderr "Cannot open $filename: $infh"
        exit
    } else {
        set flag false
        while {[gets $infh line] >= 0} {
            if {[regexp {^\s+# DEMO START} $line]} {
                set flag true
            } elseif {[regexp {^\s+# DEMO END} $line]} {
                break
            } elseif {$flag} {
                puts [string range $line 6 end]
            }
            
        }
        close $infh
    }
}

proc dgw::getVersion {fname} {
    set basename [file rootname [file tail $fname]]
    return [package present dgw::$basename]

}
proc dgw::runExample {fname {eval true}} {
    set filename $fname
    set example false
    set excode false
    set code ""
    if [catch {open $filename r} infh] {
        puts stderr "Cannot open $filename: $infh"
        exit
    } else {
        while {[gets $infh line] >= 0} {
            if {[regexp -nocase {^\s*#'\s+#{2,3}\s.+Example} $line]} {
                set example true
            } elseif {$example && [regexp {^\s*#'\s+```} $line]} {
                set example false
                set excode true
            } elseif {$excode && [regexp {^\s*#'\s+```} $line]} {
                if {$eval} {
                    namespace eval :: $code
                } else {
                    return $code
                }
                break
            } elseif {$excode && [regexp {^\s*#'\s(.+)} $line -> c]} {
                append code "$c\n"
            }
        }
        close $infh
    }
    return $code
}

proc dgw::manual {mode filename} {
    variable htmltemplate
    destroy .
    set basename [file tail [file rootname $filename]]
    set version [package provide dgw::$basename]
    set markdown ""
    if {$mode eq "--html"} {
        if {[package version Markdown] eq ""} {
            error "Error: For html mode you need package Markdown from tcllib. \nDownload and install tcllib from http://core.tcl.tk"
        } else {
            package require Markdown   
        }
    }
    if [catch {open $filename r} infh] {
        puts stderr "Cannot open $filename: $infh"
        exit
    } else {
        set flag false
        while {[gets $infh line] >= 0} {
            if {$mode eq "--license"} {
                if {[regexp {^# LICENSE START} $line]} {
                    set flag true
                    continue
                } elseif {$flag && [regexp {^\s*#' +#include +"(.*)"} $line -> include]} {
                    if [catch {open $include r} iinfh] {
                        puts stderr "Cannot open $filename: $include"
                        exit 0
                    } else {
                        while {[gets $iinfh iline] >= 0} {
                            set md $iline
                            set md [regsub -all {<.+?>} $md ""]
                            set md [regsub -all {^\s*## (.+)} $md "\\1\n[string repeat - 15]"]
                            set md [regsub -all {__PKGNAME__} $md dgw::$basename]
                            set md [regsub -all {__BASENAME__} $md $basename]                        
                            set md [regsub -all {__PKGVERSION__} $md $version]
                            set md [regsub -all {__DATE__} $md [clock format [clock seconds] -format "%Y-%m-%d"]] 
                            puts "$md"
                        }
                        close $iinfh
                    }
                } elseif {$flag && [regexp {^# LICENSE END} $line]} {
                    puts ""
                    break
                } elseif {$flag} {
                    set line [regsub -all {__PKGNAME__} $line dgw::$basename]
                    set line [regsub -all {__BASENAME__} $line $basename]                        
                    set line [regsub -all {__PKGVERSION__} $line $version]
                    set line [regsub -all {__DATE__} $line [clock format [clock seconds] -format "%Y-%m-%d"]]
                    puts [string range $line 2 end]
                }
            } else {
                if {[regexp {^\s*#' +#include +"(.*)"} $line -> include]} {
                    puts "including $include"
                    if [catch {open $include r} iinfh] {
                        puts stderr "Cannot open $filename: $include"
                        exit 0
                    } else {
                        while {[gets $iinfh iline] >= 0} {
                            set md "$iline"
                            set md [regsub -all {__PKGNAME__} $md dgw::$basename]
                            set md [regsub -all {__BASENAME__} $md $basename]                        
                            set md [regsub -all {__PKGVERSION__} $md $version]
                            set md [regsub -all {__DATE__} $md [clock format [clock seconds] -format "%Y-%m-%d"]] 
                            if {$mode eq "--man"} {
                                puts "$md" 
                            } else {
                                append markdown "$md\n"
                            }
                        }
                        close $iinfh
                    }
                } elseif {[regexp {^\s*#' ?(.*)} $line -> md]} {
                    set md [regsub -all {__PKGNAME__} $md dgw::$basename]
                    set md [regsub -all {__BASENAME__} $md $basename]                        
                    set md [regsub -all {__PKGVERSION__} $md $version]
                    set md [regsub -all {__DATE__} $md [clock format [clock seconds] -format "%Y-%m-%d"]] 
                    if {$mode eq "--man"} {
                        puts "$md" 
                    } else {
                        append markdown "$md\n"
                    }
                }
            }
            
        }
        close $infh
        if {$mode eq "--html" || $mode eq "--markdown"} {
            set titleflag false
            array set document [list title "Documentation" author "NN" date  [clock format [clock seconds] -format "%Y-%m-%d"]]
            set mdhtml ""
            set indent ""
            set header $htmltemplate
            foreach line [split $markdown "\n"] {
                if {$titleflag && [regexp {^---} $line]} {
                    set titleflag false
                    set header [subst -nobackslashes -nocommands $header]
                } elseif {$titleflag} {
                    if {[regexp {^([a-z]+): +(.+)} $line -> key value]} {
                        set document($key) $value
                    }
                } elseif {[regexp {^---} $line]} {
                    set titleflag true
                } elseif {[regexp {^```} $line] && $indent eq ""} {
                    append mdhtml "\n"
                    set indent "    "
                } elseif {[regexp {^```} $line] && $indent eq "    "} {
                    set indent ""
                    append mdhtml "\n"
                } else {
                    append mdhtml "$indent$line\n"
                }
            }
            if {$mode eq "--html"} {
                set htm [Markdown::convert $mdhtml]
                set html ""
                set synopsis false
                foreach line [split $htm "\n"] {
                    if {[regexp {^<h2>} $line]} {
                        set synopsis false
                    } 
                    if {[regexp -nocase {^<h2>.*SYNOPSIS} $line]} {
                        set synopsis true
                    }
                    if {$synopsis && [regexp {<pre>} $line]} {
                        set line [regsub {<pre>} $line "<pre class='synopsis'>"]
                    }
                    append html "$line\n"
                }
                set out [open [file rootname $filename].html w 0644]
                puts $out $header
                puts $out $html
                puts $out "</body>\n</html>"
                close $out
                puts stderr "Success: file [file rootname $filename].html was written!"
            } else {
                puts $mdhtml
            }
                
        }
    }
}

proc dgw::install {filename} {
    destroy .
    set dpath dgw
    set pfile [file rootname [file tail $filename]]
    set done false
    foreach dir [tcl::tm::path list] {
        if {[file writable $dir]} {
            puts "\nWriteable Tcl module path is: $dir"
            set ddir [file join $dir $dpath]
            if {![file exists $ddir]} {
                file mkdir $ddir
            }
            set fname [file join $dir $dpath $pfile-[package provide ${dpath}::$pfile].tm]
            file copy -force [info script] $fname
            puts "Done: ${dpath}::$pfile Tcl module installed to ${fname}!\n"
            puts "To test your installation try:\n"
            puts "\$ tclsh"
            puts "% package require ${dpath}::$pfile\n"
            
            set done true
            break
        }
    }  
    if {!$done} {
        puts "Error: No writable Tcl module path found!"
        puts "Create an environment variable TCL8_6_TM_PATH pointing to a directory where you can write files in."
        puts "In Linux for a bash shell you can do this for instance with: export TCL8_6_TM_PATH=/home/user/.local/lib/tcl8.6"
        puts "To make this permanent add this line to your .bashrc file!"
    }
}

#-- From hyperhelp.tcl
#!/bin/sh
# The next line executes Tcl with the script \
exec tclsh "$0" "$@"
#' ---
#' title:  __PKGNAME__ __PKGVERSION__
#' author: Dr. Detlef Groth, Schwielowsee, Germany
#' documentclass: scrartcl
#' geometry:
#' - top=20mm
#' - right=20mm
#' - left=20mm
#' - bottom=30mm
#' ---
#' 
#'
#' ## NAME
#'
#' **dgw::hyperhelp**  - a help system with hypertext facilitites and table of contents
#' 
#' 
#' ## <a name='toc'></a>TABLE OF CONTENTS
#' 
#'  - [SYNOPSIS](#synopsis)
#'  - [DESCRIPTION](#description)
#'  - [COMMAND](#command)
#'  - [METHODS](#methods)
#'  - [EXAMPLE](#example)
#'  - [MARKUP LANGUAGE](#formatting)
#'  - [INSTALLATION](#install)
#'  - [SEE ALSO](#see)
#'  - [CHANGES](#changes)
#'  - [TODO](#todo)
#'  - [AUTHOR](#authors)
#'  - [LICENSE AND COPYRIGHT](#license)
#' 
#' 
#' ## <a name='synopsis'>SYNOPSIS</a>
#' 
#' Usage as package:
#' 
#' ```
#' package require dgw::hyperhelp
#' dgw::hyperhelp pathName -helpfile filename ?-option value ...?
#' pathName help topic
#' ```
#' 
#' Usage as command line application:
#' 
#' ```
#' tclsh hyperhelp.tcl filename ?--commandsubst true?
#' ```
#'
#' ## <a name='description'>DESCRIPTION</a>
#' 
#' The **dgw::hyperhelp** package is hypertext help system which can be easily embedded into Tk applications. It is based on code
#' of the Tclers Wiki mainly be Keith Vetter see the [Tclers-Wiki](https://wiki.tcl-lang.org/page/A+Hypertext+Help+System)
#' The difference of this package to the wiki code is, that it works on external files, provides some `subst` support for variables 
#' and commands as well as a browser like toolbar. It can be as well used as standalone applications for browsing the help files.
#' Markup syntax was modified towards Markdown to simplify writing help pages as this is a common documentation language. 
#' In practice you can create a document which is a valid Markdown document and at the same time an usable help file. 
#' The file [hyperhelp-markdown-sample.md](hyperhelp-markdown-sample.md) gives an example for such a file.


package require Tk
package require tile

#if {[catch {package require dgtools::shistory}]} {
#    tcl::tm::path add [file join [file dirname [info script]] .. libs]
#    lappend auto_path [file join [file dirname [info script]] .. libs]
#}
#interp alias {} ::button {} ::ttk::button
set haveTile078 1

package require dgtools::shistory

#proc thingy name {proc $name args "namespace eval $name \$args"}

#thingy hist

#' 
#' ## <a name='command'>COMMAND</a>
#' 
#' **dgw::hyperhelp** *pathName -helpfile fileName ?-option value ...?*
#' 
#' > creates a new *hyperhelp* widget using the given widget *pathName* and with the given *fileName*.
#'
#' ## <a name='options'>OPTIONS</a>
#' 
#' The **dgw::hyperhelp** snit widget supports the following options which 
#' should be set only at widget creation:

namespace eval dgw { }

snit::widget ::dgw::hyperhelp {
    variable W                                  ;# Various widgets
    variable pages                              ;# All the help pages
    variable alias                              ;# Alias to help pages
    variable state
    variable font "Times New Roman"
    variable var
    variable sh
    variable npages 0
    variable ptitle ""
    variable fonts
    variable sentry 
    #' 
    #'   __-bottomnavigation__ _boolean_
    #' 
    #'  > Configures the hyperhelp widget if at the bottom of each help page a textual navigation line should be displayed. Default *false*.
    option -bottomnavigation false
    
    #' 
    #'   __-commandsubst__ _boolean_
    #' 
    #'  > Configures the hyperhelp widget to do substitutions using Tcl commands within the text.
    #'    This might give some security issues if you load help files from dubious sources, 
    #'  although for this most critical commands like file, exec and socket are disaable even if this option is set to true.
    #'  Default: false
    
    option -commandsubst false
    
    #' 
    #'   __-dismissbutton__ _boolean_
    #' 
    #'  > Configures the hyperhelp widget to display at the button a "Dismiss" button. Useful if the help page is direct parent in a toplevel to destroy this toplevel. Default: *false*.
    option -dismissbutton false
    
    #' 
    #'   __-font__ _fontname_
    #' 
    #'  > Configures the hyperhelp widget to use the given font. 
    #' Fontnames should be given as `[list fontname size]` such as for example 
    #' `\[list {Linux Libertine} 12\]`. If no fontname is given the hyperhelp widget 
    #' tries out a few standard font names on Linux and Windows System. 
    #' If none of those fonts is found, it falls back to "Times New Roman" which should be available on all platforms.
    option -font ""

    #' 
    #'   __-helpfile__ _fileName_
    #' 
    #'  > Configures the hyperhelp widget with the given helpfile 
    #'    option to be displayed within the widget.
    option -helpfile ""
    
    #' 
    #'   __-toctree__ _boolean_
    #' 
    #'  > Should the toc tree widget on the left be displayed. 
    #'    For simple help pages, consisting only of one, two, three pages the 
    #'    treeview widget might be overkill. Please note, that this widget is also 
    #'    not shown if there is no table of contents page, regardless of the _-toctree_ option.
    #'    Must be set at creation time currently.
    #'    Default: *true*
    option -toctree true
    
    #' 
    #'   __-toolbar__ _boolean_
    #' 
    #'  > Should the toolbar on top be displayed. For simple help pages, 
    #'    consisting only of one, two pages the toolbar might be overkill. 
    #'    Must be set at creation time currently.
    #'    Default: *true*
    option -toolbar true
    constructor {args} {
        $self configurelist $args
        #parray options
        set font ""
        if {$options(-font) eq ""} {
            set ff [font families] 
            set size 12
            foreach f [list {Linux Libertine} {Alegreya} {Constantia} {Georgia} {Palatino Linotype} {Times New Roman} {Cambria}] {
                set idx [lsearch -exact $ff $f]
                if { $idx > -1} {
                    set options(-font) [list [lindex $f $idx] 12]
                    set font $f ;#[list $f 12]
                    break
                }
            } 
            if {$font eq ""} {
                set options(-font) [list "Times New Roman" 12]
                set font "Times New Roman"
            } 
        } else {
            set font [lindex $options(-font) 0]
            set size [lindex $options(-font) 1]
        }
        set fonts(fixed) [font create -family "Courier" -size [expr {$size-1}]]
        set fonts(std)  [font create -family $font -size $size]
        set fonts(italic)  [font create -family $font -size $size -slant italic]
        set fonts(bold)  [font create -family $font -size $size -weight bold]
        set fonts(hdr)  [font create -family $font -size [expr {$size+4}]]
        set fonts(hdr3)  [font create -family $font -size [expr {$size+4}]]
        set font $fonts(std)
        array unset var
        array unset pages
        set pages(ERROR!) "page does not exists"
        array unset alias
        array unset state
        array set state {seen {} current {} all {} allTOC {} haveTOC 0}
        array set W {top .helpSystem main "" tree ""}
        array set alias {index Index previous Previous back Back forward Forward 
            search Search history History next Next}
        array set var [list]
        set sh [::dgtools::shistory %AUTO% -home ""]
        set W(top) $win
        $self ReadHelpFiles
        $self Help 
    }
    onconfigure -font value {
        #puts "configuring font"
        set f [lindex $value 0]
        foreach fnt [array names fonts] {
            font configure $fonts($fnt) -family $fnt
        }
        set options(-font) $value
    }
 
    ## BON HELP
    ##+##########################################################################
    #
    # Help Section
    #
    # Based on https://wiki.tcl-lang.org/1194
    #
    #  AddPage title aliases text  -- register a hypertext page
    #  Help ?title?                -- bring up a toplevel showing the specified page
    #                                 or a index of titles, if not specified
    #
    # Hypertext pages are in a subset of Wiki format:
    #   indented lines come in fixed font without evaluation;
    #   blank lines break paragraphs
    #   a line starting with "   * " gets a bullet
    #   a line starting with "   - " gets a dash
    #   a line starting with "   1 " will be a numbered list
    #    repeating the initial *,- or "1" will indent the list
    #   a line starting with "   | " will be an indented block paragraph (one level only)
    #
    #   text enclosed by '''<text>''' is embolden
    #   text enclosed by ''<text>'' is italics
    #   all lines without leading blanks are displayed without explicit
    #      linebreak (but possibly word-wrapped)
    #   a link is the title of another page in brackets (see examples at
    #      end). Links are displayed underlined and blue (or purple if they
    #      have been visited before), and change the cursor to a pointing
    #      hand. Clicking on a link of course brings up that page.
    #
    # In addition, you get "Index", "Search" (case-insensitive regexp in
    # titles and full text), "History", and "Back" links at the bottom of
    # pages.
 
 
    ##+##########################################################################
    #
    # Help -- initializes and creates the help dialog
    #
    #' 
    #' ## <a name='methods'>METHODS</a>
    #' 
    #' The *hyperhelp* widget provides the following methods:
    #' 
    
    #' *pathName* **help** *topic*
    #'
    #' > Displays the given topic within widget. If the page does not exists an error page is shown.
    
    method help {{title ""}} {
        $self DoDisplay 
        #raise $W(top)
        $self Show $title 
        set ptitle $title
    }
    method Help {{title ""}} {
        $self help $title
    }
    
    #'
    #' *pathName* **getTitle**
    #'
    #' > Returns the current topic shown in the hyperhelp browser.
    
    method getTitle {} {
        return $ptitle
    }
    
    #'
    #' *pathName* **getPages**
    #'
    #' > Returns the page names for the current help file.
    
    method getPages {} {
        return [array names pages]
    }


    ##+##########################################################################
    #
    # ReadHelpFiles -- reads "help.txt" in the packages directory
    # and creates all the help pages.
    #
    method ReadHelpFiles {} {
        set fname $options(-helpfile)
        #set fname [file join $dir help.txt]
        set fin [open $fname r]
        set data [read $fin] ; list
        close $fin
        # remove pandoc header
        regsub -- {^-{3,}\s*\ntitle:.+?\n---\n} $data "" data
        regsub -all -line {^-{5,}$} $data \x01 data
        regsub -all -line {^\#\s.*$\n} $data {} data
        regsub -all -line {^ {4,5}([-+*]) } $data "    \\1\\1 " data
        set t [clock seconds]
        set cmds [list file open exec send socket] 
        foreach cmd $cmds {
            rename ::$cmd ::${cmd}.orig$t
        }
        set x 0
        foreach section [split $data \x01] {
            set section [regsub -all {^(\s*)## +<a name=["']([^>]+)['"]>\s*([^<]+)\s*</a>} $section "title: \\3\nalias: \\2"]
            set n [regexp -line {^(title:|##)\s*(.*?) *$} $section => => title]
            if {! $n} {
                tk_messageBox -title "Error!" -icon error -message "Bad help section\n'[string range $section 0 400]'" -type ok
                continue
            }
            #puts "'${title}'"
            
            set n [regexp -line {^icon:\s*(.*?) *$} $section => icon]
            if {! $n} {
                set var("icon,$title") filenew16
            } else {
                set  var("icon,$title") $icon
            }
            if {[incr x] == 1} {
                set var(home) $title
                $sh configure -home $title
            }
            set npages $x
            set aliases {}
            foreach {. ali} [regexp -all -line -inline {^alias:\s*(.*?) *$} $section] {
                if {$ali eq "Home" || $ali eq "home"} {
                    set var(home) $ali
                }
                lappend aliases $ali
            }
            # make subst more save
            # did not got interp alias to work
            
            regsub -all -line {^(title:|alias:|icon:).*$\n} $section {} section
            regsub -all {\[\[} $section "````" section
            regsub -all {\]\]} $section "´´´´" section
            regsub -all {\[} $section "``" section
            regsub -all {\]} $section "´´" section
            regsub -all {````} $section "\[" section
            regsub -all {´´´´} $section "\]" section
            #set i [interp create -safe]
            #interp eval $i package require tdbc
            # not available in save interpr
            #interp eval $i [list subst "$section"]
            set sect ""
            foreach line [split $section "\n"] {
                if {$options(-commandsubst)} {
                    catch { set line [subst $line] } 
                } else {
                    catch { set line [subst -nocommands $line] } 
                }
                set line [regsub -all {\[([^]]+)\]} $line "(Error: \\1)"]
                append sect "$line\n"
            }  
            set section $sect
            #interp eval $i set section $section
            #$i eval subst $section
            
            regsub -all {``} $section "\[" section
            regsub -all {´´} $section "\]" section
            #puts "adding $title"
            $self AddPage $title $aliases $section
        }

        foreach cmd $cmds {
            rename ::${cmd}.orig$t ::$cmd 
        }
        if {$x > 1} {
            # todo catch nox existing display
            $self BuildTOC
        } 
        if {$x == 1} {
            #pack forget $win.status
        }
    }
    
    ##+##########################################################################
    #
    # AddPage -- Adds another page to the help system
    #
    method AddPage {title aliases body} {
        regsub -all {\n } $body "\n" body
        set title [string trim $title]
        set body [string trim $body "\n"]
        regsub -all {\\\n} $body {} body            ;# Remove escaped lines
        regsub -all {[ \t]+\n} $body "\n" body      ;# Remove trailing spaces
        regsub -all {([^\n])\n([^\s])} $body {\1 \2} body ;# Unwrap paragraphs
        
        set pages($title) $body
        
        lappend aliases [string tolower $title]
        foreach name $aliases { set alias([string tolower $name]) $title }
        
        if {[lsearch $state(all) $title] == -1} {
            set state(all) [lsort [lappend state(all) $title]]
        }
    }
    
    typeconstructor {
        image create photo acthelp16 -data {
            R0lGODlhEAAQAIMAAPwCBAQ6XAQCBCyCvARSjAQ+ZGSm1ARCbEyWzESOxIy6
            3ARalAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAQ/EEgQqhUz00GE
            Jx2WFUY3BZw5HYh4cu6mSkEy06B72LHkiYFST0NRLIaa4I0oQyZhTKInSq2e
            AlaaMAuYEv0RACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24g
            Mi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZl
            ZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs=
        }
        
        image create photo bookmark -data {
            R0lGODlhEAAQAIQAAPwCBCwqLLSytLy+vERGRFRWVDQ2NKSmpAQCBKyurMTG
            xISChJyanHR2dIyKjGxubHRydGRmZIyOjFxeXHx6fAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAVbICACwWie
            Y1CibCCsrBkMb0zchSEcNYskCtqBBzshFkOGQFk0IRqOxqPBODRHCMhCQKte
            Rc9FI/KQWGOIyFYgkDC+gPR4snCcfRGKOIKIgSMQE31+f4OEYCZ+IQAh/mhD
            cmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENv
            ciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3
            LmRldmVsY29yLmNvbQA7
        }
        image create photo bell -data {
            R0lGODlhDwAOAIIAAPwCBISCBPz+BIQCBMTCxISChPz+/AQCBCH5BAEAAAAA
            LAAAAAAPAA4AAAM+CLrR+zCIAWsgLVRGRBhOVQiG94WPVAbHaZHYAWqRYLbg
            e88RsbInGuBCEhRYrZYm4xk4nYdoKzKIbiKHawIAIf5oQ3JlYXRlZCBieSBC
            TVBUb0dJRiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4
            LiBBbGwgcmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5j
            b20AOw==
        }

        image create photo idea -data {
            R0lGODlhEAAQAIMAAPwCBAQCBPz+BPzerPz+xPyqXPz+/ISChFxaXKSipDQy
            NAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAARMEEgZap14BjG6
            CJkmEMVQCF+4mQPBpthWtuYJxkJJGK6dbQRCgMBB3XCDzQamMhpDGlvuCFUy
            oQDLBUsJHBDUKuKQCKsUCIVZtc34IwAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lG
            IFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCBy
            aWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7
        }
        image create photo reload-16 -data {
            R0lGODlhEAAQAIUAAPwCBCRaJBxWJBxOHBRGBCxeLLTatCSKFCymJBQ6BAwm
            BNzu3AQCBAQOBCRSJKzWrGy+ZDy+NBxSHFSmTBxWHLTWtCyaHCSSFCx6PETK
            NBQ+FBwaHCRKJMTixLy6vExOTKyqrFxaXDQyNDw+PBQSFHx6fCwuLJyenDQ2
            NISChLSytJSSlFxeXAwODCQmJBweHAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAaB
            QIBQGBAMBALCcCksGA4IQkJBUDIDC6gVwGhshY5HlMn9DiCRL1MyYE8iiapa
            SKlALBdMRiPckDkdeXt9HgxkGhWDXB4fH4ZMGnxcICEiI45kQiQkDCUmJZsk
            mUIiJyiPQgyoQwwpH35LqqgMKiEjq5obqh8rLCMtowAkLqovuH5BACH+aENy
            ZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29y
            IDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cu
            ZGV2ZWxjb3IuY29tADs=
        }

        image create photo klipper-16 -data {
            R0lGODlhEAAQAIYAAPwCBFQyDEwuFEQuDISGhFRSVEQqFEQuFPz+/PTy7Nze
            3PT29Ozu7DQyNJx6VIxuRIRiLEwuDIxSFHxSHKSipLSytGRiZGRCHDwmFOzm
            3HxOHIRWHOTazHRCFHxOFEwyFNTKvHROHFxeXJRqLIxWFFw6DFQ2DNTCrIRa
            JJxuPMSynHRKHIxqRMSqjGRGHMSifJxeFKyGXHxKFLyaXKyObGxGFEwyDKyO
            XIxeHKSOdFQ6FIx2THRKFFw+FKx6NKRmFKxuFLyCPLyOTLyabLSefLyijFw6
            FJRmJIxWHHRGFFQ2FAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAA
            LAAAAAAQABAAAAfFgAAAAQIDBAWIiAMGA4IABwgJCgUICwwKDQ4PEBGCEQsS
            EwUUFQQWDRepGJ4ZEggIDbENrxobAZ4cHa+7uxAeH4IGICEIIsbGFggjJCWC
            JicovLwpIcAAGCorCBbc3AoILB2rgy2u0q8OLrcAJS8wr8nJrzEy6yUz79si
            vDQ1jQA2buB4tU8eghw6xgnYwePcqxcdbAjq4eMHECA+ggiZMYRIESPjShyB
            gQPJBB48OsiokaTDOoACItgwYULJhw8BbIzzEwgAIf5oQ3JlYXRlZCBieSBC
            TVBUb0dJRiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4
            LiBBbGwgcmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5j
            b20AOw==
        }
        image create photo fileopen16 -data {
            R0lGODlhEAAQAIUAAPwCBAQCBOSmZPzSnPzChPzGhPyuZEwyHExOTFROTFxa
            VFRSTMSGTPT29Ozu7Nze3NTS1MzKzMTGxLy6vLS2tLSytDQyNOTm5OTi5Ly+
            vKyqrKSmpIyOjLR+RNTW1MzOzJyenGxqZBweHKSinJSWlExKTMTCxKyurGxu
            bBQSFAwKDJyanERCRERGRAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAaR
            QIBwGCgGhkhkEWA8HpNPojFJFU6ryitTiw0IBgRBkxsYFAiGtDodDZwPCERC
            EV8sEk0CI9FoOB4BEBESExQVFgEEBw8PFxcYEBIZGhscCEwdCxAPGA8eHxkU
            GyAhIkwHEREQqxEZExUjJCVWCBAZJhEmGRUnoygpQioZGxsnxsQrHByzQiJx
            z3EsLSwWpkJ+QQAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9u
            IDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2
            ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7
        }
        image create photo actreload16 -data {
            R0lGODlhEAAQAIUAAPwCBCRaJBxWJBxOHBRGBCxeLLTatCSKFCymJBQ6BAwm
            BNzu3AQCBAQOBCRSJKzWrGy+ZDy+NBxSHFSmTBxWHLTWtCyaHCSSFCx6PETK
            NBQ+FBwaHCRKJMTixLy6vExOTKyqrFxaXDQyNDw+PBQSFHx6fCwuLJyenDQ2
            NISChLSytJSSlFxeXAwODCQmJBweHAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAaB
            QIBQGBAMBALCcCksGA4IQkJBUDIDC6gVwGhshY5HlMn9DiCRL1MyYE8iiapa
            SKlALBdMRiPckDkdeXt9HgxkGhWDXB4fH4ZMGnxcICEiI45kQiQkDCUmJZsk
            mUIiJyiPQgyoQwwpH35LqqgMKiEjq5obqh8rLCMtowAkLqovuH5BACH+aENy
            ZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29y
            IDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cu
            ZGV2ZWxjb3IuY29tADs=
        }
        image create photo start-16 -data {
            R0lGODlhEAAQAIUAAPwCBBRSdBRObCQ2TAQCBBxObISevNzu/BRGZPz6/FzC
            3Pz+/HTS5ByyzJze7Mzq9ITC3AQWLAyWvBSavFyuxAwaLAQSHBRWfBSOrDzW
            5AyixCS61ETW3CzG1AQeLAweLAxefBSStEze7CSWtCyatBSCnAwmPBRWdByi
            xAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAZr
            QIBwSCwah4HjUTBQEogFw/M4BQgMh2pxijAkFAhBYJwUPq8LRsPxWDwgkSHh
            elA0JJIJnlKRWy4YGRoSGxwcHRsecgAfICEiGhMjJBglVVMRgBkgJp0El0MR
            JyhaRFqipUoAFqmqrapHfkEAIf5oQ3JlYXRlZCBieSBCTVBUb0dJRiBQcm8g
            dmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwgcmlnaHRz
            IHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw==
        }
        image create photo navback16 -data {
            R0lGODlhEAAQAIUAAPwCBBRSdBRObCQ2TBxObISevAQCBNzu/BRGZPz6/FzC
            3Pz+/HTS5ByyzJze7Mzq9ITC3AQWLAyWvBSavFyuxAwaLAwSHBRafBSOrDzW
            5AyixCS61ETW3CzG1AQeLAweLAxefBSStEze7CSWtCyatBSCnBRWfAwmPBRW
            dByixAQSHAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAZi
            QIBwSCwah4HjUTBQFgkFg3MoKBykU0QhoUAIAuAksbpgNByPxQMSGVsVDYlk
            IqdUiJYLJqORbDgcHRseRR8gISIaEyMkGCVYRBEmeyAnlgaQkSgpmU4RAZ1O
            KqFOpFNGfkEAIf5oQ3JlYXRlZCBieSBCTVBUb0dJRiBQcm8gdmVyc2lvbiAy
            LjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwgcmlnaHRzIHJlc2VydmVk
            Lg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw==
        }
        image create photo finish-16 -data {
            R0lGODlhEAAQAIUAAPwCBAwyTBRObAw2VDR+nAQCBCRKZOzy/KTe7Pz+/KTK
            3Nzu/Lze7FS+1AyexAyuzBSavAyOtBSmzOTy/BRqjNTm9IzO5ETS3ETa5By6
            1AyixByixBRmjAQGDBxCXGSivCySrCSWtBTC3AQOHAQWHAxWdEze7AQKFBRC
            XAwqPAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAZt
            QIBwSCwahYGjUjBQGgWE5LCgNBwITSFVKOgKDAZEIqodChSLw4HRcIyTW4Dg
            0HhAIhGIZEIJxA0VFhcYGRAaGBscHXEeHyAhIQ4iiBwjAHEBJCMjJCUmiSdl
            RyigU0oolURxRSmrTpevsUN+QQAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBy
            byB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdo
            dHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7
        }
        image create photo navforward16 -data {
            R0lGODlhEAAQAIUAAPwCBAwyTBRObAw2VDR+nCRKZOzy/KTe7Pz+/KTK3Nzu
            /Lze7FS+1AyexAyuzBSavAyOtBSmzOTy/BRqjNTm9IzO5ETS3ETa5By61Ayi
            xByixBRmjAQGDBxCXGSivCySrCSWtBTC3AQOHAQWHAxWdEze7AQKFBRCXAwq
            PAQCBAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAZj
            QIBwSCwahYGjUjBQGgWEpHNYMBCaT4G2UDggos+EwmBYMBpf6VBgYDgeEMgj
            IpmoAQVKxXLBPDIXGhscRB0eHyAgDSGBGyJFASMiIiMkJYImUwAnmJqbjp4A
            KCmhAKSlTn5BACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24g
            Mi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZl
            ZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs=
        }
        image create photo navhome16 -data {
            R0lGODlhEAAQAIUAAPwCBDw6PBQWFCQiJAQCBFxeXMTCxJyanDwyLDQqLFRS
            VLSytJSSlISChCQmJERGRFRWVGxubKSmpJyenGRmZLy+vOzq7OTi5Ly6vGRi
            ZPTy9Pz6/OTm5ExOTPT29BwaHNza3NS6tJRqRGQqBNy6pIyKjDwGBPTe1JSW
            lDQyNOTGrNRiBGwmBIRaLNymdLxWBHxGFNySXCwqLKyqrNR6LKxGBNTS1NTW
            1Jw+BEweDDQ2NAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAao
            QIBwCAgIiEjAgAAoGA6I5DBBUBgWjIZDqnwYGgVIoTGQQgyRiGRCgZCR1nTF
            csFkHm9hBp2paDYbHAsZHW9eERkYGh4eGx4ag3gfSgMTIBshIiMkGyAlCCZT
            EpciJyQjGxcoKUQBEhcbIiorLB4XEltDrhcaLS4vtbcJra8bMDHAGrcyrTMX
            HjA0NSypEsO6EzY3IzU4OdoTzK0BCAkDMgkIOjJlAH5BACH+aENyZWF0ZWQg
            YnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcs
            MTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxj
            b3IuY29tADs=
        }
        image create photo nav1leftarrow16 -data {
            R0lGODlhEAAQAIAAAP///wAAACH5BAEAAAAALAAAAAAQABAAAAIdhI+pyxqd
            woNGTmgvy9px/IEWBWRkKZ2oWrKu4hcAIf5oQ3JlYXRlZCBieSBCTVBUb0dJ
            RiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwg
            cmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw==
        }
        image create photo nav1rightarrow16 -data {
            R0lGODlhEAAQAIAAAPwCBAQCBCH5BAEAAAAALAAAAAAQABAAAAIdhI+pyxCt
            woNHTmpvy3rxnnwQh1mUI52o6rCu6hcAIf5oQ3JlYXRlZCBieSBCTVBUb0dJ
            RiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwg
            cmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw==
        }

        image create photo playend16 -data {
            R0lGODlhEAAQAIAAAPwCBAQCBCH5BAEAAAAALAAAAAAQABAAAAIjhI+py8Eb
            3ENRggrxjRnrVIWcIoYd91FaenysMU6wTNeLXwAAIf5oQ3JlYXRlZCBieSBC
            TVBUb0dJRiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4
            LiBBbGwgcmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5j
            b20AOw==
        }
        image create photo playstart16 -data {
            R0lGODlhEAAQAIAAAPwCBAQCBCH5BAEAAAAALAAAAAAQABAAAAIjhI+pyxud
            wlNyguqkqRZh3h0gl43hpoElqlHt9UKw7NG27BcAIf5oQ3JlYXRlZCBieSBC
            TVBUb0dJRiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4
            LiBBbGwgcmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5j
            b20AOw==
        }
        image create photo history -data {
            R0lGODlhEAAQAIUAAPwCBEQ2LEw6POTSrOzWtNS2lAQCBOzatPTm3PTq3Myy
            jEw+NOzm1Pz29Pz+/Pz6/Pz27FRGPFxKRPTu3Pzy7Pz69Pz67KSGbPzy3Pzu
            3PTizPzu1Pzq1PTmzOzaxPTixPTmxOzWvOTOtKyWdOTGpOTStNS+nIRmVLym
            hNzCnOzavLyefAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAaH
            QIBwGCgOj0jBgFAwGJDJAyJBUDihwgWj4XhAqhEJNDKhVLwUSUDyPJIrlgYl
            LSG0hYELhgLJTBJOd1kaGxgYHB0egkQfHBwgHyEigkUBIwMkBwcEJSZ3ARYW
            JCcnKCYpJJ5HAQUqFhSjJysoKItOCgehJBISI4tCtyERa79HTrx2WEiBUH5B
            ACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERl
            dmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6
            Ly93d3cuZGV2ZWxjb3IuY29tADs=
        }

        image create photo help -data {
            R0lGODlhEAAQAIEAAPwCBAQChAQCBAAAACH5BAEAAAAALAAAAAAQABAAAAIz
            hH+hIeiwVmtOUcjENaxqjVjhByaBSZZVl24Y1V6iEVMzkD4bqD700bshgh1f
            zwd0IfwFACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41
            DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4N
            Cmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs=
        }
        image create photo hinfo -data {
            R0lGODlhEAAQAIYAAPwCBBQ+XBRCZAw+XAw6XBRCXCRObCxihCxqjCRijBRS
            fAwyVCxehDx6nER+pPz+/BxKZAwmPFyWtGyevCRSbBxWfAxGbHSqxGSatCxu
            lBxahBRKbAQiNEyKrBRKdAw6ZAwiNESSLCyCDBxWBDRulBwyRHS6ZDSWHCyK
            FDQyNCxqlAQmRAwiPMzalPyCBMQCBCx+DAwuRBQqPITCdFxaXCyOFAQeNAwm
            RAxKdPz6/GyyVMTCxKSirAQCBGzKZAwqTAweNFyuRDyeJFzCTITOdAQiPAQa
            NHzCbES6NEy6PESyNDyqLDymJPz+xAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAA
            LAAAAAAQABAAAAfBgACCAAECAwSDiYMFBgcICQoLC4qCBQwNDg8PEJERlAYN
            EhOaFBUWnokBBw4SFxgOGRobCxyJBQkNHZoPpR4fICEiIiMBCSSYmgoKFgsl
            JicoKQQKCSoZmgW+KywtLi8pMDEbFRqaAcwyMyc0NSkiNjc4ObsrKyU6Ozw9
            7j4lNhGSfsgAEkQIDxr7YAwh0qKIDSM2jgRpgbDHPhFIMiZRsoTJkhMgobUD
            MKKkySYjUKockYJSypcrWypKQbOmTT+BAAAh/mhDcmVhdGVkIGJ5IEJNUFRv
            R0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFs
            bCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7
        }
        image create photo sheet -data {
            R0lGODlhEAAQAIIAAPwCBAQCBAT+/Pz+/KSipPz+BAAAAAAAACH5BAEAAAAA
            LAAAAAAQABAAAANFCBDc7iqIKUW98WkWpx1DAIphR41ouWya+YVpoBAaCKtM
            oRfsyue8WGC3YxBii5+RtiEWmASFdDVs6GRTKfCa7UK6AH8CACH+aENyZWF0
            ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5
            OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2
            ZWxjb3IuY29tADs=
        }

        image create photo folder -data {
            R0lGODlhEAAQAIYAAPwCBAQCBExKTBwWHMzKzOzq7ERCRExGTCwqLARqnAQ+
            ZHR2dKyqrNTOzHx2fCQiJMTi9NTu9HzC3AxmnAQ+XPTm7Dy67DymzITC3IzG
            5AxypHRydKymrMzOzOzu7BweHByy9AyGtFyy1IzG3NTu/ARupFRSVByazBR6
            rAyGvFyuzJTK3MTm9BR+tAxWhHS61MTi7Pz+/IymvCxulBRelAx2rHS63Pz6
            /PTy9PTu9Nza3ISitBRupFSixNTS1CxqnDQyNMzGzOTi5MTCxMTGxGxubGxq
            bLy2vLSutGRiZLy6vLSytKyurDQuNFxaXKSipDw6PAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAA
            LAAAAAAQABAAAAfDgACCAAECg4eIAAMEBQYHCImDBgkKCwwNBQIBBw4Bhw8Q
            ERITFJYEFQUFnoIPFhcYoRkaFBscHR4Ggh8gIRciEiMQJBkltCa6JyUoKSkX
            KhIrLCQYuQAPLS4TEyUhKb0qLzDVAjEFMjMuNBMoNcw21QY3ODkFOjs82RM1
            PfDzFRU3fOggcM7Fj2pAgggRokOHDx9DhhAZUqQaISBGhjwMEvEIkiIHEgUA
            kgSJkiNLmFSMJChAEydPGBSBwvJQgAc0/QQCACH+aENyZWF0ZWQgYnkgQk1Q
            VG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4g
            QWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29t
            ADs=
        }
        image create photo book -data {
            R0lGODlhEAAQAIQAAPwCBAQCBDyKhDSChGSinFSWlEySjCx+fHSqrGSipESO
            jCR6dKTGxISytIy6vFSalBxydAQeHHyurAxubARmZCR+fBx2dDyKjPz+/MzK
            zLTS1IyOjAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAVkICCOZGmK
            QXCWqTCoa0oUxnDAZIrsSaEMCxwgwGggHI3E47eA4AKRogQxcy0mFFhgEW3M
            CoOKBZsdUrhFxSUMyT7P3bAlhcnk4BoHvb4RBuABGHwpJn+BGX1CLAGJKzmK
            jpF+IQAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0K
            qSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpo
            dHRwOi8vd3d3LmRldmVsY29yLmNvbQA7}
        image create photo bookopen -data {
            R0lGODlhEAAQAIUAAPwCBAQCBExCNGSenHRmVCwqJPTq1GxeTHRqXPz+/Dwy
            JPTq3Ny+lOzexPzy5HRuVFSWlNzClPTexIR2ZOzevPz29AxqbPz6/IR+ZDyK
            jPTy5IyCZPz27ESOjJySfDSGhPTm1PTizJSKdDSChNzWxMS2nIR6ZKyijNzO
            rOzWtIx+bLSifNTGrMy6lIx+ZCRWRAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAae
            QEAAQCwWBYJiYEAoGAFIw0E5QCScAIVikUgQqNargtFwdB9KSDhxiEjMiUlg
            HlB3E48IpdKdLCxzEAQJFxUTblwJGH9zGQgVGhUbbhxdG4wBHQQaCwaTb10e
            mB8EBiAhInp8CSKYIw8kDRSfDiUmJ4xCIxMoKSoRJRMrJyy5uhMtLisTLCQk
            C8bHGBMj1daARgEjLyN03kPZc09FfkEAIf5oQ3JlYXRlZCBieSBCTVBUb0dJ
            RiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwg
            cmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw==
        }
        image create photo filenew16 -data {
            R0lGODlhEAAQAIUAAPwCBFxaXNze3Ly2rJyanPz+/Ozq7GxqbPz6/GxubNTK
            xDQyNIyKhHRydERCROTi3PT29Pz29Pzy7PTq3My2pPzu5PTi1NS+rPTq5PTe
            zMyynPTm1Pz69OzWvMyqjPTu5PTm3OzOtOzGrMSehNTCtNS+tAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAZ/
            QAAgQCwWhUhhQMBkDgKEQFIpKFgLhgMiOl1eC4iEYrtIer+MxsFRRgYe3wLk
            MWC0qXE5/T6sfiMSExR8Z1YRFRMWF4RwYIcYFhkahH6AGBuRk2YCCBwSFZgd
            HR6UgB8gkR0hpJsSGCAZoiEiI4QKtyQlFBQeHrVmC8HCw21+QQAh/mhDcmVh
            dGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAx
            OTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRl
            dmVsY29yLmNvbQA7
        }
        image create photo textfile -data {
            R0lGODlhEAAQAIUAAPwCBFxaXNze3Ly2rJSWjPz+/Ozq7GxqbJyanPT29HRy
            dMzOzDQyNIyKjERCROTi3Pz69PTy7Pzy7PTu5Ozm3LyqlJyWlJSSjJSOhOzi
            1LyulPz27PTq3PTm1OzezLyqjIyKhJSKfOzaxPz29OzizLyidIyGdIyCdOTO
            pLymhOzavOTStMTCtMS+rMS6pMSynMSulLyedAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAaQ
            QIAQECgajcNkQMBkDgKEQFK4LFgLhkMBIVUKroWEYlEgMLxbBKLQUBwc52Hg
            AQ4LBo049atWQyIPA3pEdFcQEhMUFYNVagQWFxgZGoxfYRsTHB0eH5UJCJAY
            ICEinUoPIxIcHCQkIiIllQYEGCEhJicoKYwPmiQeKisrKLFKLCwtLi8wHyUl
            MYwM0tPUDH5BACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24g
            Mi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZl
            ZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs=
        }


    }
    ##+##########################################################################
    #
    # DoDisplay -- Creates our help display. If we have tile 0.7.8 then
    # we will also have a TOC pane.
    #
    method DoDisplay {} {
        set W(top) $win
        set TOP $win
        #wm title $TOP "Help"
        #wm transient $TOP .
        if {[winfo exists $TOP.status]} {
            return
        }
        frame $TOP.status
        if {$options(-toolbar) && $npages > 1} {
            pack $TOP.status -side top -expand false -anchor n
        }
        pack [button $TOP.status.refresh -image reload-16  -relief groove -borderwidth 2\
              -command [mymethod Refresh]] -padx 3 -pady 4 -side left -ipadx 2 -ipady 2
        pack [button $TOP.status.home -image navhome16  -relief groove -borderwidth 2\
              -command [mymethod Show]] -padx 3 -pady 4 -side left -ipadx 2 -ipady 2
        pack [button $TOP.status.index -image klipper-16  -relief groove -borderwidth 2 \
              -command [mymethod Show index]] -padx 3 -pady 4 -side left -ipadx 2 -ipady 2    
        #pack [button $TOP.status.first -image start-16  -relief groove -borderwidth 2 -state disabled] -padx 3 -pady 4 -side left -ipadx 2 -ipady 2
        pack [button $TOP.status.backward -image navback16  -relief groove -borderwidth 2 \
              -command [mymethod Show Back] -state disabled] -padx 3 -pady 4 -side left -ipadx 2 -ipady 2
        set W(backward) $TOP.status.backward 
        
        pack [button $TOP.status.forward -image navforward16  -relief groove -borderwidth 2 -state disabled \
              -command [mymethod Show Forward]]  -padx 3 -pady 4 -side left     -ipadx 2 -ipady 2
        set W(forward) $TOP.status.forward 
        
        #    pack [button $TOP.status.last -image finish-16  -relief groove -borderwidth 2 -state disabled]  -padx 3 -pady 4 -side left     -ipadx 2 -ipady 2
        pack [ttk::separator $TOP.status.sep -orient vertical] -side left -expand false -padx 5 -fill y -pady 3
        #   pack [button $TOP.status.bl -image playstart16 -command { puts First } -relief groove -borderwidth 2] -side left -padx 2
        pack [button $TOP.status.bb -image nav1leftarrow16 -command [mymethod Show Previous] -relief groove -borderwidth 2] -side left -padx 2
        pack [button $TOP.status.bf -image nav1rightarrow16 -command  [mymethod Show Next] -relief groove -borderwidth 2] -side left -padx 2
        #pack [button $TOP.status.b1 -image playend16 -command { puts Last } -relief groove -borderwidth 2] -side left -padx 2
        pack [entry  $TOP.status.e -textvar [myvar state(search)]] -side left -padx 5 
        set sentry $TOP.status.e
        bind $TOP.status.e <Return> [mymethod DoToolSearch]
        pack [button $TOP.status.be -text Search! -command [mymethod DoToolSearch]] -side left -padx 5
        frame $TOP.bottom -bd 2 -relief ridge
        
        button $TOP.b -text "Dismiss" -command [list destroy [winfo parent $TOP]]
        if {$options(-dismissbutton)} {
            pack $TOP.bottom -side bottom -fill both
            pack $TOP.b -side bottom -expand 1 -pady 10 -in $TOP.bottom
        }
        
        set P $TOP.p
        if {$::haveTile078} {                       ;# Need tags on treeview
            set state(haveTOC) 1
            ::ttk::panedwindow $P -orient horizontal
            
            pack $P -side top -fill both -expand 1
            frame $P.toc -relief ridge
            frame $P.help -bd 2 -relief ridge
            $self CreateTOC $P.toc
            $self CreateHelp $P.help
            if {$options(-toctree) && $npages > 1 && [llength [$W(tree) children ""]] > 0} {
                $P add $P.toc
            }
            $P add $P.help
        } else {
            set state(haveTOC) 0
            frame $P
            pack $P -side top -fill both -expand 1
            $self CreateHelp $P
        }

        #bind $TOP <Map> [list apply { TOP {
        #    bind $TOP <Map> {}
        #    CenterWindow $TOP 
        #}} $TOP]
        #pack $fr -side top -fill both -expand true
 
    }
    ##+##########################################################################
    #
    # CreateTOC -- Creates a TOC display from tile's treeview widget
    #
    method CreateTOC {TOC} {
        set W(tree) $TOC.tree
        ttk::scrollbar $TOC.sby -orient vert -command "$W(tree) yview"
        #scrollbar $TOC.sbx -orient hori -command "$W(tree) xview"
        
        ::ttk::treeview $W(tree) -padding {2 2 2 2} -selectmode browse \
              -yscrollcommand "$TOC.sby set" ;#$ -xscrollcommand "$TOC.sbx set"
        # todo: must be recalled after font changes !! (Done)
        ttk::style configure Treeview \
              -rowheight [expr {[font metrics $font -linespace] + 5}]
        ttk::style configure Treeview.Item \
              -padding {2 3 2 2}
        #$W(tree) configure -rowheight 20
        grid $W(tree) $TOC.sby -sticky news
        #grid $TOC.sbx -sticky ew
        grid rowconfigure $TOC 0 -weight 1
        grid columnconfigure $TOC 0 -weight 1
        
        $W(tree) heading #0 -text "Table of Contents"
        $W(tree) tag configure link -foreground blue
        # NB. binding to buttonpress sometimes "misses" clicks
        $W(tree) tag bind link <Key-Return> [mymethod ButtonPress]
        $W(tree) tag bind link <Button-1> [mymethod ButtonPress]
        $W(tree) tag bind link <<TreeviewSelect>> [mymethod ButtonPress]
        bind $W(tree) <<TreeviewOpen>> [mymethod TreeviewUpdateImages true]
        bind $W(tree) <<TreeviewClose>> [mymethod TreeviewUpdateImages false]
        $self BuildTOC
    }
    ##+##########################################################################
    #
    # CreateHelp -- Creates our main help widget
    #
    method CreateHelp {w} {
 
        set W(main) $w.t ;# normal
        text $w.t -border 5 -relief flat -wrap word -state disabled -width 60 \
              -yscrollcommand "$w.s set" -padx 5 -font $fonts(std)
        $W(tree) tag configure std -font [$W(main) cget -font]
        
        ttk::scrollbar $w.s -orient vert -command "$w.t yview"
        pack $w.s -fill y -side right
        pack $w.t -fill both -expand 1 -side left
        
        $w.t tag config link -foreground blue -underline 1
        $w.t tag config seen -foreground purple4 -underline 1
        $w.t tag bind link <Enter> "$w.t config -cursor hand2"
        $w.t tag bind link <Leave> "$w.t config -cursor {}"
        $w.t tag bind link <1> [mymethod Click $w.t %x %y]
        $w.t tag config hdr -font $fonts(hdr)
        $w.t tag config hdr3 -font $fonts(hdr3)
        $w.t tag config hr -justify center
        $w.t tag config fix -font $fonts(fixed)
        $w.t tag config bold -font $fonts(bold)
        $w.t tag config italic -font $fonts(italic)
        set l1 [font measure $font "   "]
        set l2 [font measure $font "   \u2022   "]
        set l3 [font measure $font "       \u2013   "]
        set l3 [expr {$l2 + ($l2 - $l1)}]
        $w.t tag config bullet -lmargin1 $l1 -lmargin2 $l2
        $w.t tag config number -lmargin1 $l1 -lmargin2 $l2
        $w.t tag config dash -lmargin1 $l1 -lmargin2 $l2
        $w.t tag config bar -lmargin1 $l2 -lmargin2 $l2
        
        # this should not work as the widget is disabled
        #        bind $w.t <n> [list ::Help::Next $w.t 1]
        #        bind $w.t <p> [list ::Help::Next $w.t -1]
        #        bind $w.t <b> [list ::Help::Back $w.t]
        #        bind $w.t <Key-space> [bind Text <Key-Next>]
        
        # Create the bitmap for our bullet
        if {0 && [lsearch [image names] bullet] == -1} {
            image create bitmap bullet -data {
                #define bullet_width  11
                #define bullet_height 9
                static char bullet_bits[] = {
                    0x00,0x00, 0x00,0x00, 0x70,0x00, 0xf8,0x00, 0xf8,0x00,
                    0xf8,0x00, 0x70,0x00, 0x00,0x00, 0x00,0x00
                };
            }
        }
        # bindings
        #    foreach tag [$w.t tag names] {
        #        puts $tag
        #        $w.t tag bind $tag <KeyPress> { puts %K }
        #    }
        #bind $w.t <KeyPress> {
        #    puts %K
        #}
        # but this should work as is bind on the toplevel
        # some keys are reserved for navigation of the toc widget 
        # such us Left, Right, Up, Down
        if {[info exists W(top)] && [winfo exists $W(top)]} {
            bind $w.t <Enter> [mymethod Bindings %W true]
            bind $w.t <Leave> [mymethod Bindings %W false]
            wm protocol [winfo toplevel $w.t] WM_DELETE_WINDOW [mymethod DestroyToplevel]
        }
        
    }
    method DestroyToplevel {} {
        $self Bindings $W(main) false
        destroy [winfo toplevel $W(top)]
    }
    method Bindings {w on} {
        if {$on} {
            bind all <Key-space> [list tk::TextScrollPages $w +1 ]
            bind all <Key-BackSpace> [list tk::TextScrollPages $w -1 ]
            bind all <Key-Next> [list tk::TextScrollPages $w +1 ]
            bind all <Key-Prior> [list tk::TextScrollPages $w -1 ]
            bind all <Control-k> [list tk::TextScrollPages $w -1 ]
            bind all <Control-j> [list tk::TextScrollPages $w +1 ]
            bind all <Control-b> [list tk::TextScrollPages $w -1 ]
            bind all <Control-space> [list tk::TextScrollPages $w +1 ]
            bind all <Control-h> [mymethod Show Back]
            bind all <Alt-Left> [mymethod Show Back]
            bind all <Control-l> [mymethod Show Forward]
            bind all <Alt-Right> [mymethod Show Forward]
            bind all <n> [mymethod Next $w 1]
            bind all <p> [mymethod Next $w -1]
            bind all <b> [mymethod Back $w]
            bind all <Control-plus> [mymethod changeFontSize +2]
            bind all <Control-minus> [mymethod changeFontSize -2]

        } else {
            bind all <Key-space>     {}
            bind all <Key-BackSpace> {}
            bind all <Key-Next>      {}
            bind all <Key-Prior>     {}
            bind all <Control-k> {}
            bind all <Control-j> {}
            bind all <Control-b> {}
            bind all <Control-space> {}
            bind all) <Control-h> {}
            bind all <Alt-Left> {}
            bind all <Control-l> {}
            bind all <Alt-Right> {}
            bind all <n> {}
            bind all <p> {}
            bind all <b> {}
            bind all <Control-plus> {}
            bind all <Control-minus> {}

            
        }
    }
    method changeFontSize {i} {
        #set size [font configure $font -size]
        #if {$size < 0} {
        #    # pixel
        #    incr size [expr {$i*-1}]
        #} else {
        #    incr size $i
        #}
        #font configure $font -size $size
        foreach fnt [array names fonts] {
            font configure $fonts($fnt) -size [expr {[font configure $fonts($fnt) -size] + $i}]
        }
        #set font 
        #$W(tree) tag configure std -font $font
        ttk::style configure Treeview \
              -rowheight [expr {[ttk::style configure Treeview -rowheight] + $i}]
    }

    ##+##########################################################################
    #
    # Click -- Handles clicking a link on the help page
    #
    method Click {w x y} {
        set range [$w tag prevrange link "[$w index @$x,$y] + 1 char"]
        if {[llength $range]} { $self Show [eval $w get $range]}
    }
    ##+##########################################################################
    #
    # Back -- Goes back in help history
    #
    method Back {w} {
        if {[$sh canBackward]} {
            set back [$sh back]
            $self Show $back
        }
    }
    #
    # Forward -- Goes forward in help history
    method Forward {w} {
        if {[$sh canForward]} {
            set forw [$sh forward]
            $self Show $forw
        }
    }
    ##+##########################################################################
    #
    # Next -- Goes to next help page
    #
    method Next {w dir} {
        set what $state(all)
        if {$state(allTOC) ne {}} {set what $state(allTOC)} ;# TOC order if we can
        
        set n [lsearch -exact $what $state(current)]
        set n [expr {($n + $dir) % [llength $what]}]
        set next [lindex $what $n]
        $self Show $next
    }
    ##+##########################################################################
    #
    # ::Help::Listpage -- Puts up a help page with a bunch of links (all or history)
    #
    method Listpage {w llist} {
        foreach i $llist {$w insert end \n; $self Showlink $w $i}
    }
    ##+##########################################################################
    #
    # Search -- Creates search help page
    #
    method Search {w} {
        if {$options(-toolbar)} {
            focus $sentry
        } else {
            $w insert end "\nSearch phrase:      "
            entry $w.e -textvar [myvar state(search)]
            $w window create end -window $w.e
            focus $w.e
            #$w.e select range 0 end
            $w.e icursor end
            bind $w.e <Return> [mymethod DoToolSearch]
            button $w.b -text Search! -command [mymethod DoToolSearch]
            $w insert end " "
            $w window create end -window $w.b
        }
    }
    ##+##########################################################################
    #
    # DoSearch -- Does actual help search
    #
    method DoToolSearch {} {
        $W(main) config -state normal
        $W(main) delete 1.0 end
        $self Search $W(main)
        $self DoSearch $W(main)
        $W(main) config -state disabled

    }
    method DoSearch {w} {
        $w config -state normal
        $w insert end "\n\nSearch results for '$state(search)':\n"
        foreach i $state(all) {
            if {[regexp -nocase $state(search) $i]} { ;# Found in title
                $w insert end \n
                $self Showlink $w $i
            } elseif {[regexp -nocase -indices -- $state(search) $pages($i) pos]} {
                set p1 [expr {[lindex $pos 0]-20}]
                set p2 [expr {[lindex $pos 1]+20}]
                regsub -all \n [string range $pages($i) $p1 $p2] " " context
                $w insert end \n
                $self Showlink $w $i
                $w insert end " - ...$context..."
            }
        }
        $w config -state disabled ;#normal
    }
    ##+##########################################################################
    #
    # Showlink -- Displays link specially
    #
    method Showlink {w link {tag {}}} {
        if {[regexp {(\.png|\.gif)$} $link]} {
            set imgName [file tail [file rootname $link]]
            set imgFile [file join [file dirname $options(-helpfile)] $link]
            if {[file exists $imgFile]} {
                image create photo $imgName -file $imgFile
                #puts "Image:'$link'"
                $w image create end -image $imgName
            } else {
                $w insert end "(Error: file $link does not exists)"
            }
        } else {
            set tag [concat $tag link]
            set title [$self FindPage $link]
            if {[lsearch -exact $state(seen) $title] > -1} {
                lappend tag seen
            }
            $w insert end $link $tag
        }
    }
    ##+##########################################################################
    #
    # FindPage -- Finds actual pages given a possible alias
    #
    method FindPage {title} {
        if {[info exists pages($title)]} { return $title }
        set title2 [string tolower $title]
        if {[info exists alias($title2)]} { return $alias($title2) }
        return "ERROR!"
    }
    ##+##########################################################################
    #
    # Show -- Shows help or meta-help page
    #
    method Show {{title ""}} {
        set title [string trim $title]
        if {$title eq ""} {
            set title $var(home)
        }
        
        set w $W(main)
        set title [$self FindPage $title]
        
        if {[lsearch -exact $state(seen) $title] == -1} {lappend state(seen) $title}
        $w config -state normal
        $w delete 1.0 end
        $w insert end $title hdr "\n"
        set next 0                                  ;# Some pages have no next page
        switch -- $title {
            Back     { $self Back $w; return}
            Forward  { $self Forward $w; return}        
            History  { $self Listpage $w [$sh getHistory]}
            Next     { $self Next $w 1; return}
            Previous { $self Next $w -1; return}
            Index    { $self Listpage $w $state(all)}
            Search   { $self Search $w}
            default  { $self ShowPage $w $title ; set next 1 }
        }
        
        # Add bottom of the page links
        if {$options(-bottomnavigation)} {
            $w insert end \n------\n {}
            if {! $state(haveTOC) && [info exists alias(toc)]} {
                $w insert end TOC link " - " {}
            }
            $w insert end Index link " - " {} Search link
            if {$next} {
                $w insert end " - " {} Previous link " - " {} Next link
            }
            if {[llength [$sh getHistory]]} {
                $w insert end " - " {} History link " - " {} Back link
            }
            
            $w insert end \n
        }
        $sh insert $title
        if {[$sh canBackward]} {
            $W(backward) configure -state active
        } else {
            $W(backward) configure -state disabled
        }
        if {[$sh canForward]} {
            $W(forward) configure -state active
            
        } else {
            $W(forward) configure -state disabled
        }
        
        
        $w config -state disabled ;#disabled
        set state(current) $title
    }
    ##+##########################################################################
    #
    # ShowPage -- Shows a text help page, doing wiki type transforms
    #
    method ShowPage {w title} {
        set endash \u2013
        set emdash \u2014
        set bullet \u2022
        
        $w insert end \n                            ;# Space down from the title
        if {! [info exists pages($title)]} {
            set lines [list "This help page is missing." "" "See \[Index\] for a list of existing pages!"]
        } else {
            # image fix
            set txt [regsub -all {([^ ]{3}!)\[.*?\]\((.+?)\)} $pages($title) "\\1\[\\2\]"]
            # link fix
            set txt [regsub -all {([^!])\[(.*?)\]\((.+?)\)} $txt "\\1\[\\2\]"]
            set txt [regsub -all {\n!} $txt "\n"]
            set lines [split $txt \n]
        }
        
        set ind ""
        foreach line $lines {
            set tag {}
            set op1 ""
            if {[regexp -line {^[-_]{3,4}\s*$} $line]} {
                $w insert end "[string repeat _ 30]\n" hr
                continue
            } elseif {[regexp -line {^[#]{3,5}\s(.+)} $line -> txt]} {
                $w insert end "$txt\n" hdr3
                continue
            } elseif {[regexp -line {^>\s*$} $line]} {
                set ind "   | "
                $w insert end "\n"
                continue
            } elseif {[regexp -line {^>(\s+[-*].+)} $line -> rest]} {

                set  ind "   |"
                set line $rest
                #puts $line
                #continue
            } elseif {[regexp -line {^>\s([A-Z0-9a-z].+)} $line -> rest]} {
                #puts  $line
                set  ind "   | "
                set line $rest
                #continue
            } elseif {[regexp {^\s*$} $line]} {
                set ind ""
            }
            set line "$ind$line"
            if {[regexp -line {^ +\|*\s*([-1*|]+)\s+(.*)} $line -> op txt]} {
                set ind2 ""
                if {[regexp -line {^ +\|} $line ]} {
                    set ind2 "         "
                } 
                set op1 [string index $op 0]
                set lvl [expr {[string length $op] - 1}]
                set indent $ind2[string repeat "     " $lvl]
                if {$op1 eq "1"} {                  ;# Number
                    if {! [info exists number($lvl)]} { set number($lvl) 0 }
                    set tag number
                    incr number($lvl)
                    $w insert end "$indent $number($lvl). " $tag
                } elseif {$op1 eq "*"} {            ;# Bullet
                    set tag bullet
                    $w insert end "$indent $bullet " $tag
                } elseif {$op1 eq "-"} {            ;# Dash
                    set tag dash
                    $w insert end "$indent $endash " $tag
                } elseif {$op1 eq "|"} {            ;# Bar
                    set tag bar
                }
                set line $txt
            } elseif {[string match "  *" $line]} {  ;# Line beginning w/ a space
                $w insert end "$line\n" fix
                unset -nocomplain number
                continue
            }
            if {$op1 ne "1"} {unset -nocomplain number}
            
            while {1} {                             ;# Look for markups
                set link0 [set bold0 [set ital0 $line]]
                set n1 [regexp {^(.*?)[[](.*?)[]](.*$)} $line -> link0 link link1]
                set n2 [regexp {^(.*?)('{3}|[*]{2})(.*?)('{3}|[*]{2})(\s*.*$)} $line -> bold0 x bold y bold1]
                set n3 [regexp {^(.*?)('{2}|[*]{1})([^\s].*?)('{2}|[*]{1})(\s*.*$)} $line -> ital0 x ital y ital1]
                set n4 [regexp {^(.*?)`(.*?)`(\s*.*$)} $line -> tt0 tt tt1]
                if {$n4} {
                    set len4 [expr {$n4 ? [string length $tt0] : 9999}]
                }

                if {$n1 == 0 && $n2 == 0 && $n3 == 0 && $n4 == 0} break
                
                set len1 [expr {$n1 ? [string length $link0] : 9999}]
                set len2 [expr {$n2 ? [string length $bold0] : 9999}]
                set len3 [expr {$n3 ? [string length $ital0] : 9999}]
                set len4 [expr {$n4 ? [string length $tt0] : 9999}]
                set l1 [lindex [lsort -integer [list $len1 $len2 $len3 $len4]] 0]
                if {false} {
                    if {$len1 < $len3} {
                        $w insert end $link0 $tag
                        $self Showlink $w $link $tag
                        set line $link1
                    } elseif {$len2 <= $len3} {
                        $w insert end $bold0 $tag $bold [concat $tag bold]
                        set line $bold1
                    } else  {
                        $w insert end $ital0 $tag $ital [concat $tag italic]
                        set line $ital1
                    }
                }
                if {$len1 == $l1} {
                    $w insert end $link0 $tag
                    $self Showlink $w $link $tag
                    set line $link1
                } elseif {$len2 == $l1} {
                    $w insert end $bold0 $tag $bold [concat $tag bold]
                    set line $bold1
                } elseif {$len3 == $l1}  {
                    $w insert end $ital0 $tag $ital [concat $tag italic]
                    set line $ital1
                } else {
                    $w insert end $tt0 $tag $tt [concat $tag fix]
                    set line $tt1
                }
                #$w insert end $ital0 $tag $ital [concat $tag italic]
                    #set line $ital1
                # else 
                #    $w insert end $tt0 $tag $tt1 [concat $tag fix]
                #    set line $tt1
                #
            }
            $w insert end "$line\n" $tag
        }
    }
    ##+##########################################################################
    #
    # BuildTOC -- Fills in our TOC widget based on a TOC page
    #
    method BuildTOC {} {
        set state(allTOC) {}                        ;# All pages in TOC ordering
        if {! [winfo exists $W(tree)]} return
        set tocData $pages([$self FindPage toc])
        $W(tree) delete [$W(tree) child {}]
        #$W(tree) configure -padding {50 10 2 2}
        unset -nocomplain parent
        set parent() {}
        
        regsub -all {'{2,}} $tocData {} tocData
        regsub -all {\(#.+?\)} $tocData "" tocData
        regsub -all { {4,5}([-*+]) }   $tocData  "    \\1\\1 " tocData
        #puts $tocData
        foreach line [split $tocData \n] {
            
            set n [regexp {^\s*([-*]+)\s*(.*)} $line => dashes txt]
            if {! $n} continue
            
            set isLink [regexp {^\[(.*)\]$} $txt => txt]
            set pDashes [string range $dashes 1 end]
            if {[info exists var("icon,$txt")]} {
                set icon $var("icon,$txt")
            } else {
                set icon filenew16
            }
            set parent($dashes) [$W(tree) insert $parent($pDashes) end -text " $txt" -tag std -image $icon]
            if {$parent($pDashes) ne ""} {
                $W(tree) item $parent($pDashes) -image book
            }
            if {$isLink} {
                $W(tree) item $parent($dashes) -tag [list link std]
                
                set ptitle [$self FindPage $txt]
                if {[lsearch $state(allTOC) $ptitle] == -1} {
                    lappend state(allTOC) $ptitle
                }
            }
        }
    }
    ##+##########################################################################
    #
    # ButtonPress -- Handles clicking on a TOC link
    # !!! Sometimes misses clicks, so we're using TreeviewSelection instead
    #
    method ButtonPress {} {
        set id [$W(tree) selection]
        set title [$W(tree) item $id -text]
        $self Show $title
    }
    ##+##########################################################################
    #
    # TreeviewSelection -- Handles clicking on any item in the TOC
    #
    method TreeviewSelection {} {
 
        set id [$W(tree) selection]
        set title [$W(tree) item $id -text]
        set tag [$W(tree) item $id -tag]
        if {$tag eq "link"} {
            $self Show $title
        } else {                                    ;# Make all children visible
            set last [lindex [$W(tree) children $id] end]
            if {$last ne {} && [$W(tree) item $id -open]} {
                $W(tree) see $last
            }
        }
    }
    ##+###########################################################################
    #
    # TreeviewUpdateImages -- check if children are visible and update icon
    # 
    method TreeviewUpdateImages {open} {
        # event fires before 
        # the children are indeed displayed or hided
        set item [$W(tree) focus]
        if {$open} {
            if {[llength [$W(tree) children $item]] > 0} {
                $W(tree) item $item -image bookopen
            }
        } else {
            if {[llength [$W(tree) children $item]] > 0} {
                $W(tree) item $item -image book
            }
        }
    }
    method CenterWindow {w} {
        wm withdraw $w
        set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
               - [winfo vrootx [winfo parent $w]]]
        set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
               - [winfo vrooty [winfo parent $w]]]
        wm geom $w +$x+$y
        wm deiconify $w
    }
    ##+##########################################################################
    #
    # Refresh -- resets all help info and updates widget
    #
    method Refresh {} {
        set current $state(current)
        array unset pages
        set pages(ERROR!) "page does not exists"
        array unset state
        array set state {seen {} current {} all {} allTOC {} haveTOC 0}
        array unset alias
        
        foreach title {Back History Next Previous Index Search} {
            set alias([string tolower $title]) $title
        }
        $sh resetHistory
        $self ReadHelpFiles 
        $self Show $current
    }
    ##+##########################################################################
    #
    # Sanity -- Checks for missing help links
    #
    method Sanity {} {
        set missing {}
        foreach page $state(all) {
            set m [$self CheckLinks $page]
            if {$m ne {}} {
                set missing [concat $missing $m]
            }
        }
        return $missing
    }
    ##+##########################################################################
    #
    # CheckLinks -- Checks one page for missing help links
    #
    method CheckLinks {title} {
        set missing {}
        set title [$self FindPage $title]
        foreach {. link} [regexp -all -inline {\[(.*?)\]} $pages($title)] {
            if {! [info exists alias([string tolower $link])]} {
                lappend missing $link
            }
        }
        return $missing
    }

    method WIKIFIX {txt} {
        regsub -all {\n } $txt "\n" txt
        return $txt
        
    }
}
## EON HELP
package provide dgw::hyperhelp 0.8.1
#' 
#' ## <a name='example'>EXAMPLE</a>
#' 
#' ```
#' package require dgw::hyperhelp
#' set helpfile [file join [file dirname [info script]] hyperhelp-docu.txt]
#' set hhelp [dgw::hyperhelp .help -helpfile $helpfile]
#' pack $hhelp -side top -fill both -expand true
#' $hhelp help overview
#' ```

#' 
#' ## <a name='formatting'>MARKUP LANGUAGE</a>
#'
#' The Markup language of the hyperhelp widget is similar to Tclers Wiki and Markdown markup.
#' Here are the most important markup commands. For a detailed description have a look at the 
#' file `hyperhelp-docu.txt` which contains the hyperhelp documentation with detailed markup rules.
#'
#' *Page structure:*
#' 
#' A help page in the help file is basically started with the title tag at the beginning of a line and adds with 6 dashes. See here an example for three help pages. 
#' To shorten links in the document later as well an `alias` can be given afterwards. There is also support for Markdown headers as the last page shows.
#'
#' 
#'     title: Hyperhelp Title Page
#'     alias: main
#'
#'     Free text can be written here with standard *Markdown* 
#'     or ''Wiki'' syntax markup.
#'
#'     ------
#'     title: Other Page title
#'     alias: other
#'     icon: acthelp16
#'
#'     Follows more text for the second help page. You can link
#'     to the [main] page here also.
#'     ------
#' 
#'     ## <a name="aliasname">Page title</a>
#'     
#'     Text for the next page after this Markdown like header, the anchor is now an alis 
#'     which can be used for links like here [aliasname], the link [Page title] points to the same page.
#'
#' For the second page an other icon than the standard file icon was given for the help page. This icon is
#' used for the treeview widget on the left displayed left of the page title.
#' The following icons are currently available: acthelp16, bookmark, idea, navhome16, help, sheet, folder, textfile.
#' 
#' *"Table of Contents" page:*
#' 
#' There is a special page called "Table of Contents". The unnumbered list, probably nested, of this page will be used
#' for the navigation outline tree on the left. Below is the example for the contents page which
#' comes with the hyperhelp help file "hyperhelp-docu.txt". The "Table of Contents" page should be the first page
#' in your documentation. Please indent only with standard Markdown syntax compatible, so two spaces 
#' for first level and four spaces for second level.
#' 
#'     title: Table of Contents 
#'     alias: TOC
#'       - [Welcome to the Help System]
#'       - [What's New]
#'       - Formatting
#'         - [Basic Formatting]
#'         - [Aliases]
#'         - [Lists]
#'         - [Substitutions]
#'         - [Images]
#'         - [Code Blocks]
#'         - [Indentation]
#'       - [Creating the TOC]
#'       - [Key Bindings]
#'       - [To Do]
#'     
#'     -------
#
#'
#' *Font styles:*
#' 
#' > - '''bold''' - **bold** (Wiki syntax), \*\*bold\*\* - **bold** (Markdown syntax)
#'   - ''italic'' - *italic* (Wiki syntax), \*italic\* - *italic* (Markdown syntax)
#'   - \`code\`  - `code`
#' 
#' *Links:*
#' 
#' > - hyperlinks to other help pages within the same document are created using brackets: `[overview]` -> [overview](#overview)
#'   - image links, where images will be embedded and shown `[image.png]`
#'   - also image display and hyperlinks in Markdown format are supported. Therefore `![](image.png)` displays an image and 
#'     `[Page title](#alias)`  creates a link to the page "Page title"
#' 
#' *Code blocks:*
#' 
#' > - code blocks are started by indenting a line with three spaces
#'   - the block continues until less than three leading whitespace character are found on the text
#'
#' *Indentation:*
#'
#' > - indented blocks are done by using the pipe symbol `|` or the greater symbol  as in Markdown syntax
#'   - indenting ends on lines without whitespaces as can be seen the following example
#'
#' 
#'      > * indented one with `code text`
#'        * indented two with **bold text**
#'        * indented three with *italic text*
#' 
#'      this text is again unindented
#' 
#' 
#' *Substitutions:*
#'
#' > - you can substitute variables and commands within the help page
#'   - command substition is done using double brackets like in `[[package require dgw::hyperhelp]]` would embed the package version of the hyperhelp package
#'   - variable substitution is done using the Dollar variable prefix, for instance `$::tcl_patchLevel` would embed the actual Tcl version
#'   - caution: be sure to not load files from unknown sources, command substitution should not work with commands like `file`, `exec` or `socket`. 
#'     But anyway only use your own help files
#'
#' *Lists:*
#' 
#' > - support for list and nested lists using the standard `* item` and `** subitem`` syntax
#'   - numbered lists can be done with starting a line with `1. ` followed by a white space such as in ` 1. item` and ` 11. subitem`
#'   - dashed lists can be done with single and double dashes 
#'
#' *Key bindings:*
#' 
#' > The  hyperhelp  window  provides  some  standard  key bindings to navigate the content:
#' 
#' > * space, next: scroll down
#' * backspace, prior: scroll up
#' * Ctrl-k, Ctrl-j: scroll in half page steps up and down
#' * Ctrl-space, Ctrl-b: scroll down or up
#' * Ctrl-h, Alt-Left, b: browse back history if possible
#' * Ctrl-l, Alt-Right: browse forward in history if possible
#' * n, p: browse forward or backward in page order
#' * Control-Plus, Control-Minus changes in font-size
#' * Up, Down, Left, Right etc are used for navigation in the treeview widget
#'
#'  
#' ## <a name='install'>INSTALLATION</a>
#' 
#' Installation is easy you can install and use the **__PKGNAME__** package if you have a working install of:
#'
#' - the snit package  which can be found in [tcllib - https://core.tcl-lang.org/tcllib](https://core.tcl-lang.org/tcllib)
#' - the dgtools::shistory package which can be found at the same side as the dgw::hyperhelp package
#' 
#' For installation you copy the complete *dgw* and the *dgtools* folder into a path 
#' of your *auto_path* list of Tcl or you append the *auto_path* list with the parent dir of the *dgw* directory.
#' Alternatively you can install the package as a Tcl module by creating a file dgw/__BASENAME__-__PKGVERSION__.tm in your Tcl module path.
#' The latter in many cases can be achieved by using the _--install_ option of __BASENAME__.tcl. 
#' Try "tclsh __BASENAME__.tcl --install" for this purpose. Please note, that in the latter case you must redo this 
#' for the `dgtools::shistory` package.
#' 
#' ## <a name='demo'>DEMO</a>
#'
#' Example code for this package can  be executed by running this file using the following command line:
#'
#' ```
#' $ wish __BASENAME__.tcl --demo
#' ```

#' The example code used for this demo can be seen in the terminal by using the following command line:
#'
#' ```
#' $ wish __BASENAME__.tcl --code
#' ```
#'
#' ## <a name='docu'>DOCUMENTATION</a>
#'
#' The script contains embedded the documentation in Markdown format. 
#' To extract the documentation you need that the dgwutils.tcl file is in 
#' the same directory with the file `__BASENAME__.tcl`. 
#' Then you can use the following command lines:
#' 
#' ```
#' $ tclsh __BASENAME__.tcl --markdown
#' ```
#'
#' This will extract the embedded manual pages in standard Markdown format. You can as well use this markdown output directly to create html pages for the documentation by using the *--html* flag.
#' 
#' ```
#' $ tclsh __BASENAME__.tcl --html
#' ```
#' 
#' This will directly create a HTML page `__BASENAME__.html` which contains the formatted documentation. 
#' Github-Markdown can be extracted by using the *--man* switch:
#' 

#' ```
#' $ tclsh __BASENAME__.tcl --man
#' ```
#'
#' The output of this command can be used to feed a markdown processor for conversion into a 
#' html or pdf document. If you have pandoc installed for instance, you could execute the following commands:
#'
#' ```
#' tclsh ../__BASENAME__.tcl --man > __BASENAME__.md
#' pandoc -i __BASENAME__.md -s -o __BASENAME__.html
#' pandoc -i __BASENAME__.md -s -o __BASENAME__.tex
#' pdflatex __BASENAME__.tex
#' ```
#' 
#' ## <a name='see'>SEE ALSO</a>
#'
#' - [dgw - package](http://chiselapp.com/user/dgroth/repository/tclcode/index)
#' - [shtmlview - package](http://chiselapp.com/user/dgroth/repository/tclcode/index)
#'
#' ## <a name='todo'>TODO</a>
#'
#' * some more template files (done)
#' * tests (done, could be more)
#' * github url
#'
#' ## <a name='changes'>CHANGES</a>
#' 
#' - 2020-02-01 Release 0.5 - first published version
#' - 2020-02-05 Release 0.6 - catching errors for missing images and wrong Tcl code inside substitutions
#' - 2020-02-07 Release 0.7 
#'     - options _-toolbar_, _-toctree_ for switchable display
#'     - single page, automatic hiding of toctree and toolbar
#'     - outline widget only shown if TOC exists
#'     - adding Control-Plus, Control-Minus for font changes
#'     - fix indentation and italic within indentation is now possible
#'     - basic Markdown support 
#' - 2020-02-16 Release 0.8.0
#'     - fix for Ctrl.j, Ctrk-k keys
#'     - disabled default command substitutions
#' - 2020-02-19 Release 0.8.1
#'     - removed bug in the within page search
#'     - insertion cursors for search remains in the widget
#'     - fixed bug in help page 
#'
#' ## <a name='authors'>AUTHOR(s)</a>
#' 
#' The *__PKGNAME__* package was written by Dr. Detlef Groth, Schwielowsee, Germany using Keith Vetters code from the Tclers Wiki as starting point.
#' 
#' ## <a name='license'>LICENSE AND COPYRIGHT</a>
#' 
#' The __PKGNAME__ package version __PKGVERSION__
#' 
#' Copyright (c) 2019-20  Dr. Detlef Groth, E-mail: <detlef(at)dgroth(dot)de>
#' This library is free software; you can use, modify, and redistribute it
#' for any purpose, provided that existing copyright notices are retained
#' in all copies and that this notice is included verbatim in any
#' distributions.
#' 
#' This software is distributed WITHOUT ANY WARRANTY; without even the
#' implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#'
if {[info exists argv0] && $argv0 eq [info script] && [regexp hyperhelp $argv0]} {
    set dpath dgw
    set pfile [file rootname [file tail [info script]]]
    package require dgw::dgwutils
    #source [file join [file dirname [info script]] dgwutils.tcl]
    if {[llength $argv] >= 1 && [file exists [lindex $argv 0]]} {    
        set sub false
        # todo deal with --option and topic
        if {[llength $argv] > 1 && [lindex $argv 1] eq "--commandsubst"} {
            set sub true
        }
        set hhelp [dgw::hyperhelp .win -helpfile [lindex $argv 0] -commandsubst $sub] ;#-font [{Alegreya 12}]
        if {[llength $argv] == 2 && !$sub} {
            $hhelp Help [lindex $argv 1]
        } elseif {[llength $argv] == 3} {
            $hhelp Help [lindex $argv 2]
        }

        pack .win -side top -fill both -expand true
    } elseif {[llength $argv] == 1 && [lindex $argv 0] eq "--version"} {    
        puts [dgw::getVersion [info script]]
        destroy .
    } elseif {[llength $argv] == 1 && [lindex $argv 0] eq "--demo"} {    
        dgw::runExample [info script]
    } elseif {[llength $argv] == 1 && [lindex $argv 0] eq "--code"} {
        puts [dgw::runExample [info script] false]
        destroy .
    } elseif {[llength $argv] == 1 && [lindex $argv 0] eq "--test"} {
        package require tcltest
        set argv [list] 
        tcltest::test dummy-1.1 {
            Calling my proc should always return a list of at least length 3
        } -body {
            set result 1
        } -result {1}
        tcltest::test gui-2.1 {
            starting hyperhelp
        } -body {
            package require dgw::hyperhelp
            set helpfile [file join [file dirname [info script]] hyperhelp-docu.txt]
            set hhelp [dgw::hyperhelp .help -helpfile $helpfile]
            pack $hhelp -side top -fill both -expand true
            $hhelp help "What's New"
            $hhelp help "overview"            
            $hhelp help "toc"       
            $hhelp help "What's New"
            set result [$hhelp getTitle]
            $hhelp help "What's New"
            set pages [$hhelp getPages]
            foreach page $pages {
                $hhelp help $page
                update idletasks
                after 500
            }
            $hhelp help "What's New"
            destroy .help
            set result
        } -result {What's New}
        tcltest::test gui-2.2 {
            simple on page side
        } -body {
            package require dgw::hyperhelp
            set helpfile [file join [file dirname [info script]] hyperhelp-onepage-sample.txt]
            set hhelp [dgw::hyperhelp .help -helpfile $helpfile]
            pack $hhelp -side top -fill both -expand true
            set result [$hhelp getTitle]
            set pages [$hhelp getPages]
            foreach page $pages {
                $hhelp help $page
                update idletasks
                after 500
            }
            destroy .help
            set result 1
        } -result {1}
        tcltest::test gui-2.3 {
            notoc test with several pages
        } -body {
            package require dgw::hyperhelp
            set helpfile [file join [file dirname [info script]] hyperhelp-notoc-sample.txt]
            set hhelp [dgw::hyperhelp .help -helpfile $helpfile]
            pack $hhelp -side top -fill both -expand true
            set result [$hhelp getTitle]
            set pages [$hhelp getPages]
            foreach page $pages {
                $hhelp help $page
                update idletasks
                after 500
            }
            destroy .help
            set result 1
        } -result {1}
        tcltest::test gui-2.4 {
            markdown test
        } -body {
            package require dgw::hyperhelp
            set helpfile [file join [file dirname [info script]] hyperhelp-markdown-sample.md]
            set hhelp [dgw::hyperhelp .help -helpfile $helpfile]
            pack $hhelp -side top -fill both -expand true
            set result [$hhelp getTitle]
            set pages [$hhelp getPages]
            foreach page $pages {
                $hhelp help $page
                update idletasks
                after 500
            }
            destroy .help
            set result 1
        } -result {1}
        tcltest::cleanupTests
        destroy .
    } elseif {[llength $argv] == 1 && ([lindex $argv 0] eq "--license" || [lindex $argv 0] eq "--man" || [lindex $argv 0] eq "--html" || [lindex $argv 0] eq "--markdown")} {
        dgw::manual [lindex $argv 0] [info script]
    } elseif {[llength $argv] == 1 && [lindex $argv 0] eq "--install"} {
        dgw::install [info script]
    } else {
        destroy .
        puts "\n    -------------------------------------"
        puts "     The ${dpath}::$pfile package for Tcl"
        puts "    -------------------------------------\n"
        puts "Copyright (c) 2019  Dr. Detlef Groth, E-mail: detlef(at)dgroth(dot)de\n"
        puts "License: MIT - License see manual page"
        puts "\nThe ${dpath}::$pfile package provides a help viewer widget with hyperhelp"
        puts "text facilities and a browser like toolbar"
        puts ""
        puts "Usage: [info nameofexe] [info script] option|filename\n"
        puts "    filename is a help file with hyperhelp markup"
        puts "    Valid options are:\n"
        puts "        --help    : printing out this help page"
        puts "        --demo    : runs a small demo application."
        puts "        --code    : shows the demo code."
        puts "        --test    : running some test code"
        puts "        --license : printing the license to the terminal"
        puts "        --install : install ${dpath}::$pfile as Tcl module"        
        puts "        --man     : printing the man page in pandoc markdown to the terminal"
        puts "        --markdown: printing the man page in simple markdown to the terminal"
        puts "        --html    : printing the man page in html code to the terminal"
        puts "                    if the Markdown package from tcllib is available"
        puts ""
        puts "    The --man option can be used to generate the documentation pages as well with"
        puts "    a command like: "
        puts ""
        puts "    tclsh [file tail [info script]] --man | pandoc -t html -s > temp.html\n"
    }
    if {[lindex $argv 0] eq "demo"} {
        panedwindow .pw
        set hfile [file join [file dirname [info script]] help.txt]
        set hhelp [hyperhelp::hyperhelp .pw.win -helpfile $hfile]
        $hhelp Help overview
        set hhelp2 [hyperhelp::hyperhelp .pw.win2 -helpfile $hfile]
        $hhelp2 Help overview
        pack .pw -side left -fill both -expand yes
        .pw add $hhelp $hhelp2
        
    }
}



package provide hyperhelp 0.8.1
#-- End of script section
