ADDED tcl/8.4/Garuda1.0/Garuda.dll Index: tcl/8.4/Garuda1.0/Garuda.dll ================================================================== --- tcl/8.4/Garuda1.0/Garuda.dll +++ tcl/8.4/Garuda1.0/Garuda.dll cannot compute difference between binary files ADDED tcl/8.4/Garuda1.0/Garuda.dll.asc Index: tcl/8.4/Garuda1.0/Garuda.dll.asc ================================================================== --- tcl/8.4/Garuda1.0/Garuda.dll.asc +++ tcl/8.4/Garuda1.0/Garuda.dll.asc @@ -0,0 +1,18 @@ +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v2 +Comment: Eagle Package Repository + +iQIcBAABCAAGBQJYAbNgAAoJEFAslq9JXcLZeP4P/3F6JMaeNrkCRnxyxu2KHLcH +AoiR6AUMSq5WCg99a1hW0eIg+DZ4LNqSsxlF8Er/+vf36ySIgKSUnisZLucg+A3x +5I6Vsie6fskCMUZ401eTf9t1sDSA5s9wpmF+wC9sNIGI6p7yr+Kazp3h3lz6yBLc +o4zRbgFnAelwtyAzx3KPCIyduqHwVnAN09jvjJQVArXbNdrHIdDm7/2X2XBFnQEY +If5ai0rv9MBbtHmH8aM/1xGRJOzZgcaJPJ7xSbheGCgkMrPlcpFVSDxdxyGGcIlj +vxGop5dt7f6UDlLcEKQsqFfBnZ2EeNRaxC7DVK/YtoxWtH/EYaLi7dmmnbL1aOwB +6NFPAaNnLysCWE+W9BeOA5KbDzcnZGcsDG6VbLpE9dBM8tr72n/KT4EXmXBFTcwf +J6rt5EFQowR+s8p5NjOAugfyTBvSkrJCMV9MWJwV/HFL+jWUAdPVOYFFLOdyVZkB +dUM5P4yHW/JI/S1lFFHfWgoaX7+lXZrMJAFAgPowgPaWIEgCk23nsT+u6g/62RSd +twqUoiwAr8N5V0OVcW8f7Ar9UwIueqbZzX1AwkLGluo6e7YULCE/uUDDp3nHFTpN +7wL+6smKIltB1XqvoxDF57E3cKwlPS6RKHRL/Jtk6fyqY0ytxNnL8RmusqegO7ZE +03LkdmUkQKrCXobLL9N0 +=+sU5 +-----END PGP SIGNATURE----- ADDED tcl/8.4/Garuda1.0/Scripts/ex_winForms.tcl Index: tcl/8.4/Garuda1.0/Scripts/ex_winForms.tcl ================================================================== --- tcl/8.4/Garuda1.0/Scripts/ex_winForms.tcl +++ tcl/8.4/Garuda1.0/Scripts/ex_winForms.tcl @@ -0,0 +1,69 @@ +############################################################################### +# +# ex_winForms.tcl -- +# +# Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. +# +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: $ +# +############################################################################### + +package require Tk +package require Garuda + +wm withdraw . + +if {![info exists i]} then { set i 0 }; incr i + +set toplevel [toplevel .example$i] + +wm title $toplevel "Garuda Example (TkWindow #$i)" +wm geometry $toplevel 350x100 + +bind $toplevel {console show} + +set script [string map [list %i% $i] { + # + # NOTE: This script can use any of the commands provided by + # Eagle (e.g. [object invoke] to invoke .NET Framework + # objects). + # + proc handleClickEvent { sender e } { + set title "About Garuda Example #%i%" + + if {[tcl ready]} then { + msgBox [appendArgs "Tcl version is: " \ + [tcl eval [tcl master] info patchlevel] \n \ + "Eagle version is: " [info engine patchlevel]] $title + } else { + msgBox "Tcl is not ready." $title + } + } + + object load -import System.Windows.Forms + interp alias {} msgBox {} object invoke MessageBox Show + + set form [object create -alias Form] + + $form Width 350; $form Height 100 + $form Text "Garuda Example (WinForm #%i%)" + $form Show + + set button [object create -alias Button] + + $button Left [expr {([$form ClientSize.Width] - [$button Width]) / 2}] + $button Top [expr {([$form ClientSize.Height] - [$button Height]) / 2}] + + $button Text "Click Here" + $button add_Click handleClickEvent + + object invoke $form.Controls Add $button +}] + +set button [button $toplevel.run -text "Click Here" \ + -command [list eagle $script]] + +pack $button -padx 20 -pady 20 -ipadx 10 -ipady 10 ADDED tcl/8.4/Garuda1.0/Scripts/ex_winForms.tcl.asc Index: tcl/8.4/Garuda1.0/Scripts/ex_winForms.tcl.asc ================================================================== --- tcl/8.4/Garuda1.0/Scripts/ex_winForms.tcl.asc +++ tcl/8.4/Garuda1.0/Scripts/ex_winForms.tcl.asc @@ -0,0 +1,18 @@ +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v2 +Comment: Eagle Package Repository + +iQIcBAABCAAGBQJYAbN0AAoJEFAslq9JXcLZXQIP/jYpRRRQUSRCgyA1S6ZH+Gfk +01npl8dkeeF+crDlQgXwkrNzZnTw227YlY3egHNZ87k+sl28+aalHDP29t+ba6Kq +u3JE9YZts9VOUxtT8H+GS6RhOgkxwLUIoxVe+erUWAo7jvxrKxXmuCtBrqrwK4PA +WiPxajtM2arKp86Wz3AEU2QwLBf1vrGXqZLk2VMbvwlw6xvicckNGWfuT/FOqGVq +9wv3Gdglzh6p387MJ0QPzlr7mwAe3VV7AdICz9GHM0rSDAtM0monw9MSyNmQq9si +HXM49KXGGt0kVEtvZnXroaZrqXbwaaOvD1EKDwqvJ12oTD/sHfa+iR/R0LBo0+0Y +XfL5mLGrzKYj6G+xiR7/TeViigPBFl4ErgeujAhJw7gyp8qxW7zBsH8Ga15hoEEp +smEkSH2C+ujihdBKPmbvcOeuUMBntxoNFb8QF6qSSyqlfx5id3I9U3iUsmuhXNo7 +z9VvCfmfMHRMO4XiLO7KtswhAo9yaDTB6ag4GtTnwZAEbQfrnXzA3fGf/HuhovP2 +Axw0Ak+XbnROIQvaug6wVBjLpEyGHtjEigBBYBi84NvyrN0YOksFyqiq7OStk6s1 +obHxaORoHVf13ccN1JxuHcG2RgCI3kKELs/VfRGfSjvngWMUdWnWcJS4+W3suLjZ +YvQ0D3MQ+35JhRbBvqLx +=zLO2 +-----END PGP SIGNATURE----- ADDED tcl/8.4/Garuda1.0/Tests/all.tcl Index: tcl/8.4/Garuda1.0/Tests/all.tcl ================================================================== --- tcl/8.4/Garuda1.0/Tests/all.tcl +++ tcl/8.4/Garuda1.0/Tests/all.tcl @@ -0,0 +1,803 @@ +############################################################################### +# +# all.tcl -- +# +# This file contains a top-level script to run all of the Garuda tests. +# Execute it by invoking "source all.eagle". +# +# Extensible Adaptable Generalized Logic Engine (Eagle) +# Test Suite File +# +# Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. +# +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: $ +# +############################################################################### + +if {![package vsatisfies [package provide Tcl] 8.4]} then { + error "need Tcl 8.4 or higher" +} + +if {[catch {package present Eagle}] == 0} then { + error "need native Tcl" +} + +namespace eval ::Garuda { + ############################################################################# + #**************************** SHARED PROCEDURES ***************************** + ############################################################################# + + # + # NOTE: Stolen from "helper.tcl" because this procedure is needed prior to + # the Garuda package being loaded. + # + proc lappendUnique { varName args } { + upvar 1 $varName list + + foreach arg $args { + if {[lsearch -exact $list $arg] == -1} then { + lappend list $arg + } + } + } + + # + # NOTE: Stolen from "helper.tcl" because this procedure is needed prior to + # the Garuda package being loaded. + # + proc maybeFullName { command } { + set which [namespace which $command] + + if {[string length $which] > 0} then { + return $which + } + + return $command + } + + # + # NOTE: Stolen from "helper.tcl" because this procedure is needed prior to + # the Garuda package being loaded. + # + proc fileNormalize { path {force false} } { + variable noNormalize + + if {$force || !$noNormalize} then { + return [file normalize $path] + } + + return $path + } + + # + # NOTE: Stolen from "helper.tcl" because this procedure is needed prior to + # the Garuda package being loaded. + # + proc isValidDirectory { path } { + variable logCommand + variable verbose + + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level -1] 0]] + + eval $logCommand [list \ + "$caller: Checking for directory \"$path\" from \"[pwd]\"..."] + } + } + + # + # NOTE: For now, just make sure the path refers to an existing directory. + # + return [expr {[string length $path] > 0 && [file exists $path] && \ + [file isdirectory $path]}] + } + + # + # NOTE: Stolen from "helper.tcl" because this procedure is needed prior to + # the Garuda package being loaded. + # + proc isValidFile { path } { + variable logCommand + variable verbose + + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level -1] 0]] + + eval $logCommand [list \ + "$caller: Checking for file \"$path\" from \"[pwd]\"..."] + } + } + + # + # NOTE: For now, just make sure the path refers to an existing file. + # + return [expr {[string length $path] > 0 && [file exists $path] && \ + [file isfile $path]}] + } + + ############################################################################# + #**************************** UTILITY PROCEDURES **************************** + ############################################################################# + + proc findPackagePath { + varNames varSuffixes name version platforms configurations directory + binaryFileName indexFileName } { + global env + + # + # NOTE: Construct the name of the base name of the directory that should + # contain the package itself, including its binary. + # + set nameAndVersion [join [list $name $version] ""] + + # + # NOTE: Check if the package can be found using the list of environment + # variables specified by the caller. + # + foreach varName $varNames { + # + # NOTE: Check each of the environment variable name suffixes specified + # by the caller prior to trying the environment variable name by + # itself. + # + foreach varSuffix $varSuffixes { + set newVarName ${varName}${varSuffix} + + if {[info exists env($newVarName)]} then { + set path [file join [string trim $env($newVarName)] \ + $binaryFileName] + + if {[isValidFile $path]} then { + set path [file join [file dirname $path] \ + $indexFileName] + + if {[isValidFile $path]} then { + return [file dirname $path] + } + } + } + } + + if {[info exists env($varName)]} then { + set path [file join [string trim $env($varName)] \ + $binaryFileName] + + if {[isValidFile $path]} then { + set path [file join [file dirname $path] \ + $indexFileName] + + if {[isValidFile $path]} then { + return [file dirname $path] + } + } + } + } + + # + # NOTE: Check the in-development directories for the package being tested, + # based on the provided build platforms and configurations. + # + foreach platform $platforms { + foreach configuration $configurations { + set path [file join $directory bin $platform \ + $configuration $binaryFileName] + + if {[isValidFile $path]} then { + set path [file join [file dirname $path] \ + $indexFileName] + + if {[isValidFile $path]} then { + return [file dirname $path] + } + } + } + } + + # + # NOTE: Check the in-deployment directory for the package being tested. + # + set path [file join $directory $nameAndVersion \ + $binaryFileName] + + if {[isValidFile $path]} then { + set path [file join [file dirname $path] \ + $indexFileName] + + if {[isValidFile $path]} then { + return [file dirname $path] + } + } + + return "" + } + + proc addToAutoPath { directory } { + global auto_path + + # + # NOTE: Attempt to make absolutely sure that the specified directory is + # not already present in the auto-path by checking several of the + # various forms it may take. + # + if {[lsearch -exact $auto_path $directory] == -1 && \ + [lsearch -exact $auto_path [fileNormalize $directory true]] == -1 && \ + [lsearch -exact $auto_path [file nativename $directory]] == -1} then { + # + # BUGFIX: Make sure that the specified directory is the *FIRST* one + # that gets searched for the package being tested; otherwise, + # we may end up loading and testing the wrong package binary. + # + set auto_path [linsert $auto_path 0 $directory] + } + } + + ############################################################################# + #********************** TEST VARIABLE SETUP PROCEDURES ********************** + ############################################################################# + + proc setupTestPackageConfigurations { force } { + variable testPackageConfigurations; # DEFAULT: {DebugDll ReleaseDll ""} + + if {$force || ![info exists testPackageConfigurations]} then { + # + # NOTE: Always start with no configurations. + # + set testPackageConfigurations [list] + + # + # NOTE: If there is a build suffix, use it to enhance the default list + # of configurations. + # + if {[info exists ::test_flags(-suffix)] && \ + [string length $::test_flags(-suffix)] > 0} then { + # + # NOTE: First, add each of the default configurations with the build + # suffix appended to them. + # + lappend testPackageConfigurations DebugDll${::test_flags(-suffix)} + lappend testPackageConfigurations ReleaseDll${::test_flags(-suffix)} + } + + lappend testPackageConfigurations DebugDll ReleaseDll "" + } + } + + proc setupTestVariables {} { + global tcl_platform + + ########################################################################### + #*********** NATIVE PACKAGE DIAGNOSTIC CONFIGURATION VARIABLES ************ + ########################################################################### + + # + # NOTE: Display diagnostic messages while searching for the package being + # tested and setting up the tests? This variable may be shared with + # the package being tested; therefore, change it with care. + # + variable verbose; # DEFAULT: true + + if {![info exists verbose]} then { + set verbose true + } + + # + # NOTE: The Tcl command used to log warnings, errors, and other messages + # generated by the package being tested. This variable may be shared + # with the package being tested; therefore, change it with care. + # + variable logCommand; # DEFAULT: tclLog + + if {![info exists logCommand]} then { + set logCommand tclLog + } + + # + # NOTE: When this is non-zero, the [file normalize] sub-command will not + # be used on the assembly path. This is necessary in some special + # environments due to a bug in Tcl where it will resolve junctions + # as part of the path normalization process. + # + variable noNormalize; # DEFAULT: false + + if {![info exists noNormalize]} then { + set noNormalize false + } + + ########################################################################### + #********************* NATIVE PACKAGE TEST VARIABLES ********************** + ########################################################################### + + # + # NOTE: Automatically run all the tests now instead of waiting for the + # runPackageTests procedure to be executed? + # + variable startTests; # DEFAULT: true + + if {![info exists startTests]} then { + set startTests true + } + + # + # NOTE: The environment variable names to check when attempting to find the + # Garuda binary directory. This list is used during the file search + # process from within the [runPackageTests] procedure. + # + variable testEnvVars; # DEFAULT: "Garuda_Dll Garuda GarudaLkg Lkg" + + if {![info exists testEnvVars]} then { + set testEnvVars [list Garuda_Dll Garuda GarudaLkg Lkg] + } + + # + # NOTE: The strings to append to the environment variable names listed + # above when attempting to find the Garuda binary directory. This + # list is used during the file search process from within the + # [runPackageTests] procedure. + # + variable testEnvVarSuffixes; # DEFAULT: "_Temp Temp _Build Build" + + if {![info exists testEnvVarSuffixes]} then { + set testEnvVarSuffixes [list _Temp Temp _Build Build] + } + + # + # NOTE: The build platforms for the package being tested that we know about + # and support. + # + variable testPackagePlatforms; # DEFAULT: "Win32 x64" OR "x64 Win32" + + if {![info exists testPackagePlatforms]} then { + # + # NOTE: Attempt to select the appropriate platforms (architectures) + # for this machine. + # + if {[info exists tcl_platform(machine)] && \ + $tcl_platform(machine) eq "amd64"} then { + # + # NOTE: We are running on an x64 machine, prefer it over x86. + # + set testPackagePlatforms [list x64 Win32] + } else { + # + # NOTE: We are running on an x86 machine, prefer it over x64. + # + set testPackagePlatforms [list Win32 x64] + } + } + + # + # NOTE: The build configurations for the package being tested that we know + # about and support. + # + setupTestPackageConfigurations false + + # + # NOTE: The name of the package being tested. + # + variable testPackageName; # DEFAULT: Garuda + + if {![info exists testPackageName]} then { + set testPackageName \ + [lindex [split [string trim [namespace current] :] :] 0] + } + + # + # NOTE: The version of the package being tested. + # + variable testPackageVersion; # DEFAULT: 1.0 + + if {![info exists testPackageVersion]} then { + set testPackageVersion 1.0 + } + + # + # NOTE: The name of the dynamic link library file containing the native + # code for the package being tested. + # + variable testBinaryFileName; # DEFAULT: Garuda.dll + + if {![info exists testBinaryFileName]} then { + set testBinaryFileName $testPackageName[info sharedlibextension] + } + + # + # NOTE: The name of the Tcl package index file. + # + variable testPackageIndexFileName; # DEFAULT: pkgIndex.tcl + + if {![info exists testPackageIndexFileName]} then { + set testPackageIndexFileName pkgIndex.tcl + } + + # + # NOTE: The name of the directory where the dynamic link library file + # containing the native code for the package being tested resides. + # + variable testBinaryPath; # DEFAULT: + + # + # NOTE: The names of the Eagle test suite files to run. + # + variable testFileNames; # DEFAULT: tcl-load.eagle + + if {![info exists testFileNames]} then { + set testFileNames [list tcl-load.eagle] + } + + # + # NOTE: The name of the main Eagle test suite file. + # + variable testSuiteFileName; # DEFAULT: all.eagle + + if {![info exists testSuiteFileName]} then { + set testSuiteFileName all.eagle + } + } + + ############################################################################# + #************************** TEST STARTUP PROCEDURE ************************** + ############################################################################# + + proc runPackageTests { directory } { + global argv + global auto_path + variable envVars + variable envVarSuffixes + variable logCommand + variable rootRegistryKeyName + variable testBinaryFileName + variable testBinaryPath + variable testEnvVars + variable testEnvVarSuffixes + variable testFileNames + variable testPackageConfigurations + variable testPackageIndexFileName + variable testPackageName + variable testPackagePlatforms + variable testPackageVersion + variable testSuiteFileName + variable useEnvironment + variable useRegistry + variable useRelativePath + variable verbose + + # + # HACK: Scan for and then process the "-baseDirectory", "-configuration", + # "-suffix", "-preTest", and "-postTest" command line arguments. The + # first one may be used to override the base directory that is used + # when attempting to locate the package binaries and the master Eagle + # test suite file (e.g. "all.eagle"). The next two are needed by the + # "helper.tcl" script to locate the proper Eagle assembly to load and + # use for the tests. The final two may be needed to support various + # tests. + # + foreach {name value} $argv { + switch -exact -- $name { + -baseDirectory { + # + # NOTE: Use the base directory from the command line verbatim. This + # will be picked up and used later in this procedure to help + # locate the package binaries as well as the master Eagle test + # suite file (e.g. "all.eagle"). + # + set [string trimleft $name -] $value + + # + # NOTE: Show that we set this option (in the log). + # + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level 0] 0]] + + eval $logCommand [list \ + "$caller: Set option \"$name\" to value \"$value\"."] + } + } + } + -configuration - + -suffix { + # + # NOTE: This will be picked up by the "helper.tcl" file. + # + set ::test_flags($name) $value + + # + # NOTE: Show that we set this option (in the log). + # + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level 0] 0]] + + eval $logCommand [list \ + "$caller: Set option \"$name\" to value \"$value\"."] + } + } + + # + # HACK: If we are changing the suffix, re-check the test package + # configurations. + # + if {$name eq "-suffix"} then { + setupTestPackageConfigurations true + } + } + -preTest - + -postTest { + # + # NOTE: Set the local variable (minus leading dashes) to the value, + # which is a script to evaluate before/after the test itself. + # + set [string trimleft $name -] $value + + # + # NOTE: Show that we set this option (in the log). + # + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level 0] 0]] + + eval $logCommand [list \ + "$caller: Set option \"$name\" to value \"$value\"."] + } + } + } + } + } + + # + # NOTE: Skip setting the base directory if it already exists (e.g. it has + # been set via the command line). + # + if {![info exists baseDirectory]} then { + # + # NOTE: When running in development [within the source tree], this should + # give us the "Native" directory. When running in deployment (e.g. + # "\lib\Garuda1.0\tests"), this should give us the application + # (or Tcl) library directory (i.e. the one containing the various + # package sub-directories). + # + set baseDirectory [file dirname [file dirname $directory]] + + # + # NOTE: Attempt to detect if we are running in development [within the + # source tree] by checking if the base directory is now "Native". + # In that case, we need to go up another level to obtain the root + # Eagle source code directory (i.e. the directory with the "bin", + # "Library", and "Native" sub-directories). + # + if {[file tail $baseDirectory] eq "Native"} then { + set baseDirectory [file dirname $baseDirectory] + } + } + + # + # NOTE: Show the effective base directory now. + # + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level 0] 0]] + + eval $logCommand [list \ + "$caller: Base directory is \"$baseDirectory\"."] + } + } + + # + # NOTE: Attempt to find binary file for the package being tested using the + # configured platforms, configurations, and file name. + # + if {[info exists testBinaryPath]} then { + # + # NOTE: The path has probably been pre-configured by an external script; + # therefore, just use it verbatim. + # + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level 0] 0]] + + eval $logCommand [list \ + "$caller: Using existing binary path \"$testBinaryPath\"..."] + } + } + } else { + set path [findPackagePath $testEnvVars $testEnvVarSuffixes \ + $testPackageName $testPackageVersion $testPackagePlatforms \ + $testPackageConfigurations $baseDirectory $testBinaryFileName \ + $testPackageIndexFileName] + + if {[isValidDirectory $path]} then { + set testBinaryPath $path + } + } + + # + # NOTE: Double-check that the configured directory is valid. + # + if {[info exists testBinaryPath] && \ + [isValidDirectory $testBinaryPath]} then { + # + # NOTE: Success, we found the necessary binary file. Add the directory + # containing the file to the Tcl package search path if it is not + # already present. + # + if {[lsearch -exact $auto_path $testBinaryPath] != -1} then { + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level 0] 0]] + + eval $logCommand [list \ + "$caller: Binary path already present in \"auto_path\"."] + } + } + } else { + addToAutoPath $testBinaryPath + } + + # + # NOTE: Evaluate the pre-test script now, if any. This must be done + # prior to loading the actual Tcl package; otherwise, we cannot + # impact the (embedded) Eagle interpreter creation process. + # + if {[info exists preTest]} then { + uplevel #0 $preTest + } + + # + # NOTE: Attempt to require the package being tested now. This should + # end up sourcing the "helper.tcl" file, which must also provide + # us with the "envVars", "rootRegistryKeyName", "useEnvironment", + # "useRegistry", and "useRelativePath" Tcl variables that we need. + # + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level 0] 0]] + + eval $logCommand [list \ + "$caller: Using final binary path \"$testBinaryPath\"..."] + } + } + + package require $testPackageName $testPackageVersion + + # + # NOTE: Configure the Eagle test suite to run only the specified file(s) + # unless it has already been configured otherwise. + # + if {[lsearch -exact $argv -file] != -1} then { + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level 0] 0]] + + eval $logCommand [list \ + "$caller: Option \"-file\" already present in \"argv\"."] + } + } + } else { + # + # NOTE: No file option found, add it. + # + lappend argv -file $testFileNames + + # + # NOTE: Show that we set this option (in the log). + # + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level 0] 0]] + + eval $logCommand [list \ + "$caller: Set option \"-file\" to \"$testFileNames\"."] + } + } + } + + # + # NOTE: Build the list of directories to search for the main Eagle test + # suite file. + # + set testSuiteDirectories [list] + + eval lappendUnique testSuiteDirectories [list \ + [file join $baseDirectory Library] $baseDirectory] + + if {$useRelativePath} then { + eval lappendUnique testSuiteDirectories [getRelativePathList \ + [list $directory [file dirname $directory] \ + $baseDirectory [file dirname $baseDirectory] \ + [file dirname [file dirname $baseDirectory]]] \ + $testPackageConfigurations] + } + + if {$useEnvironment} then { + eval lappendUnique testSuiteDirectories [getEnvironmentPathList \ + $envVars $envVarSuffixes] + } + + if {$useRegistry} then { + eval lappendUnique testSuiteDirectories [getRegistryPathList \ + $rootRegistryKeyName Path] + } + + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level 0] 0]] + + eval $logCommand [list \ + "$caller: Final list of directories to search:\ + $testSuiteDirectories"] + } + } + + # + # NOTE: Search for the main Eagle test suite file in all the configured + # directories, stopping when found. + # + foreach testSuiteDirectory $testSuiteDirectories { + set testFileName [file join $testSuiteDirectory Tests \ + $testSuiteFileName] + + if {[isValidFile $testFileName]} then { + break + } + } + + # + # NOTE: Did we find the main Eagle test suite file? + # + if {[info exists testFileName] && [isValidFile $testFileName]} then { + # + # NOTE: Attempt to run the Eagle test suite now. + # + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level 0] 0]] + + eval $logCommand [list \ + "$caller: Using final test file name \"$testFileName\"..."] + } + } + + uplevel #0 [list source $testFileName] + + # + # NOTE: Evaluate the post-test script now, if any. + # + if {[info exists postTest]} then { + uplevel #0 $postTest + } + } else { + error "cannot locate Eagle test suite file: $testSuiteFileName" + } + } else { + error "cannot locate package binary file: $testBinaryFileName" + } + } + + ############################################################################# + #******************************* TEST STARTUP ******************************* + ############################################################################# + + # + # NOTE: First, setup the script variables associated with the package tests. + # + setupTestVariables + + # + # NOTE: Next, save the package test path for later use. + # + if {![info exists packageTestPath]} then { + set packageTestPath [fileNormalize [file dirname [info script]] true] + } + + # + # NOTE: Finally, if enabled, start the package tests now. + # + if {$startTests} then { + runPackageTests $packageTestPath + } +} ADDED tcl/8.4/Garuda1.0/Tests/all.tcl.asc Index: tcl/8.4/Garuda1.0/Tests/all.tcl.asc ================================================================== --- tcl/8.4/Garuda1.0/Tests/all.tcl.asc +++ tcl/8.4/Garuda1.0/Tests/all.tcl.asc @@ -0,0 +1,18 @@ +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v2 +Comment: Eagle Package Repository + +iQIcBAABCAAGBQJYAbN7AAoJEFAslq9JXcLZ1rYP/j6OcmcXCyBJCIPm5LUqlD8v +nXh38eeIK9/9q0I4Cj9qZwEveEcgVx3sT5gfCt8TuSLjIIl8YaQRcF4RxVIJGYrr +7/eBC2rnQoOIaKfnuxS3pEGP6u8qUOQGXTAJB15V3VaR6/cBgUhsfFIFPLBxBpOp +xl3y9jmexhaSJncn1M2QGp6OQEdcjL5KRTSbtQN+VAFuq+S2WN1gwByRsadMC/zM +ACdiMAcgoDa3YE0Sn8gurwHc3VWfB9afmybRdAq1w2c6Nnde9Y2tgcXrEjLC8kEu +Q9XJiz3+V712nI8EDg4XMOSLK0Ip2gtrQfflCzebJvpIINTwuVw+CRWuNaNBJNfA +Ru++51Hj1VjRMEe5KWnZbC6jnfuX+i6gI9oZDeqVnRfdiIu4nfbj7rQpaap+0XOG +Xg4kCcFoJBLo6X/QC9D7TfU0gET2OrLY+YQCNCGEP2nRbHk07IfEVmO5gGRdrLOx +ed+Ig7Iq7ObP2ANcfxNtk/+zXTvouOtLPWcvoTbCr0HByUIrmPvHGVD1kQwfUsqY +XbwEEvRFpObfvXwXb8iuyiuNof4QdQ0PhRu4hLz52hWSLaaQokHHdoqNz7EVe3zo +GAWULeQ9u6vzKsMppSIUZnksJ+UcTiMOqWQYiqWteFgLUk1sh3ARtuxCsxlcMr0i +UXcn7D5EIeDm9+/CLNNg +=/RQz +-----END PGP SIGNATURE----- ADDED tcl/8.4/Garuda1.0/helper.tcl Index: tcl/8.4/Garuda1.0/helper.tcl ================================================================== --- tcl/8.4/Garuda1.0/helper.tcl +++ tcl/8.4/Garuda1.0/helper.tcl @@ -0,0 +1,1384 @@ +############################################################################### +# +# helper.tcl -- Eagle Package for Tcl (Garuda) +# +# Extensible Adaptable Generalized Logic Engine (Eagle) +# Package Loading Helper File +# +# Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. +# +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: $ +# +############################################################################### + +if {![package vsatisfies [package provide Tcl] 8.4]} then { + error "need Tcl 8.4 or higher" +} + +if {[catch {package present Eagle}] == 0} then { + error "need native Tcl" +} + +############################################################################### + +namespace eval ::Garuda { + ############################################################################# + #**************************** SHARED PROCEDURES ***************************** + ############################################################################# + + proc noLog { string } { + # + # NOTE: Do nothing. This will end up returning success to the native code + # that uses the configured log command. Returning success from the + # configured log command means "yes, please log this to the attached + # debugger (and/or the system debugger) as well". Returning an error + # from the configured log command will prevent this behavior. Other + # than that, returning an error from the configured log command is + # completely harmless. + # + } + + # + # NOTE: Also defined in and used by "all.tcl". + # + proc lappendUnique { varName args } { + upvar 1 $varName list + + foreach arg $args { + if {[lsearch -exact $list $arg] == -1} then { + lappend list $arg + } + } + } + + # + # NOTE: Also defined in and used by "all.tcl". + # + proc maybeFullName { command } { + set which [namespace which $command] + + if {[string length $which] > 0} then { + return $which + } + + return $command + } + + proc fileNormalize { path {force false} } { + variable noNormalize + + if {$force || !$noNormalize} then { + return [file normalize $path] + } + + return $path + } + + # + # NOTE: Also defined in and used by "all.tcl". + # + proc isValidDirectory { path } { + variable logCommand + variable verbose + + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level -1] 0]] + + eval $logCommand [list \ + "$caller: Checking for directory \"$path\" from \"[pwd]\"..."] + } + } + + # + # NOTE: For now, just make sure the path refers to an existing directory. + # + return [expr {[string length $path] > 0 && [file exists $path] && \ + [file isdirectory $path]}] + } + + # + # NOTE: Also defined in and used by "all.tcl". + # + proc isValidFile { path } { + variable logCommand + variable verbose + + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level -1] 0]] + + eval $logCommand [list \ + "$caller: Checking for file \"$path\" from \"[pwd]\"..."] + } + } + + # + # NOTE: For now, just make sure the path refers to an existing file. + # + return [expr {[string length $path] > 0 && [file exists $path] && \ + [file isfile $path]}] + } + + ############################################################################# + #**************************** UTILITY PROCEDURES **************************** + ############################################################################# + + proc isLoaded { fileName {varName ""} } { + variable logCommand + variable verbose + + # + # NOTE: If requested by the caller, give them access to all loaded package + # entries that we may find. + # + if {[string length $varName] > 0} then { + upvar 1 $varName loaded + } + + # + # NOTE: In Tcl 8.5 and higher, the [lsearch -exact -index] could be used + # here instead of this search loop; however, this package needs to + # work with Tcl 8.4 and higher. + # + foreach loaded [info loaded] { + # + # HACK: Exact matching is being used here. Is this reliable? + # + if {[lindex $loaded 0] eq $fileName} then { + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level 0] 0]] + + eval $logCommand [list \ + "$caller: Package binary file \"$fileName\" is loaded."] + } + } + + return true + } + } + + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level 0] 0]] + + eval $logCommand [list \ + "$caller: Package binary file \"$fileName\" is not loaded."] + } + } + + return false + } + + proc getWindowsDirectory {} { + global env + + if {[info exists env(SystemRoot)]} then { + return [fileNormalize $env(SystemRoot) true] + } elseif {[info exists env(WinDir)]} then { + return [fileNormalize $env(WinDir) true] + } + + return "" + } + + proc getFrameworkDirectory { version } { + set directory [getWindowsDirectory] + + if {[string length $directory] > 0} then { + return [file join $directory Microsoft.NET Framework \ + v[string trimleft $version v]] + } + + return "" + } + + proc checkFrameworkDirectory { version } { + set directory [getFrameworkDirectory $version] + + if {[string length $directory] > 0 && \ + [isValidDirectory $directory]} then { + return true + } + + return false + } + + proc readFile { fileName } { + set channel [open $fileName RDONLY] + fconfigure $channel -encoding binary -translation binary + set result [read $channel] + close $channel + return $result + } + + proc getClrVersion { fileName } { + # + # NOTE: This procedure may not work properly within a safe interpreter; + # therefore, handle that case specially. + # + if {![interp issafe] && [isValidFile $fileName]} then { + # + # NOTE: The string "ClrVersion\0", encoded in UCS-2, represented as + # byte values. + # + append header \x43\x00\x6C\x00\x72\x00\x56\x00\x65\x00\x72 + append header \x00\x73\x00\x69\x00\x6F\x00\x6E\x00\x00\x00 + + # + # NOTE: Read all the data from the package binary file. + # + set data [readFile $fileName] + + # + # NOTE: Search for the header string within the binary data. + # + set index(0) [string first $header $data] + + # + # NOTE: No header string, return nothing. + # + if {$index(0) == -1} then { + return "" + } + + # + # NOTE: Advance the first index to just beyond the header. + # + incr index(0) [string length $header] + + # + # NOTE: Search for the following NUL character, encoded in UCS-2, + # represented as byte values. Due to how the characters are + # encoded, this search also includes the trailing zero byte + # from the previous character. + # + set index(1) [string first \x00\x00\x00 $data $index(0)] + + # + # NOTE: No following NUL character, return nothing. + # + if {$index(1) == -1} then { + return "" + } + + # + # NOTE: Grab the CLR version number embedded in the file data just + # after the header. + # + return [encoding convertfrom unicode [string range $data $index(0) \ + $index(1)]] + } + + # + # NOTE: This is a safe interpreter, for now just skip trying to read + # from the package binary file and return nothing. + # + return "" + } + + # + # WARNING: Other than appending to the configured log file, if any, this + # procedure is absolutely forbidden from having any side effects. + # + proc shouldUseMinimumClr { fileName {default true} } { + global env + variable clrVersions + variable logCommand + variable useMinimumClr + variable verbose + + # + # NOTE: The package has been configured to use the minimum supported CLR + # version; therefore, return true. + # + if {[info exists useMinimumClr] && $useMinimumClr} then { + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level 0] 0]] + + eval $logCommand [list \ + "$caller: Using minimum CLR version (variable)..."] + } + } + + return true + } + + # + # NOTE: The environment has been configured to use the minimum supported + # CLR version; therefore, return true. + # + if {[info exists env(UseMinimumClr)]} then { + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level 0] 0]] + + eval $logCommand [list \ + "$caller: Using minimum CLR version (environment)..."] + } + } + + return true + } + + # + # NOTE: The latest supported version of the CLR is not installed on this + # machine; therefore, return true. + # + if {![checkFrameworkDirectory [lindex $clrVersions end]]} then { + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level 0] 0]] + + eval $logCommand [list \ + "$caller: Using minimum CLR version (missing)..."] + } + } + + return true + } + + # + # NOTE: Unless forbidden from doing so, check the version of the CLR that + # this package binary was compiled for (i.e. the CLR version is + # + if {![info exists env(NoClrVersion)]} then { + set version [getClrVersion $fileName] + + # + # NOTE: The CLR version was not queried from the package binary, return + # the specified default result. + # + if {[string length $version] == 0} then { + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level 0] 0]] + + if {$default} then { + eval $logCommand [list \ + "$caller: Using minimum CLR version (default)..."] + } else { + eval $logCommand [list \ + "$caller: Using latest CLR version (default)..."] + } + } + } + + return $default + } + + # + # NOTE: The CLR version queried from the package binary is the minimum + # supported; therefore, return true. + # + if {$version eq [lindex $clrVersions 0]} then { + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level 0] 0]] + + eval $logCommand [list \ + "$caller: Using minimum CLR version (assembly)..."] + } + } + + return true + } + } + + # + # NOTE: Ok, use the latest supported version of the CLR. + # + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level 0] 0]] + + eval $logCommand [list \ + "$caller: Using latest CLR version..."] + } + } + + return false + } + + # + # WARNING: Other than appending to the configured log file, if any, this + # procedure is absolutely forbidden from having side effects. + # + proc shouldUseIsolation {} { + global env + variable logCommand + variable useIsolation + variable verbose + + # + # NOTE: The package has been configured to use interpreter isolation; + # therefore, return true. + # + if {[info exists useIsolation] && $useIsolation} then { + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level 0] 0]] + + eval $logCommand [list \ + "$caller: Using interpreter isolation (variable)..."] + } + } + + return true + } + + # + # NOTE: The environment has been configured to use interpreter isolation; + # therefore, return true. + # + if {[info exists env(UseIsolation)]} then { + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level 0] 0]] + + eval $logCommand [list \ + "$caller: Using interpreter isolation (environment)..."] + } + } + + return true + } + + # + # NOTE: Ok, disable interpreter isolation. + # + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level 0] 0]] + + eval $logCommand [list \ + "$caller: Not using interpreter isolation..."] + } + } + + return false + } + + # + # WARNING: Other than appending to the configured log file, if any, this + # procedure is absolutely forbidden from having side effects. + # + proc shouldUseSafeInterp {} { + global env + variable logCommand + variable useSafeInterp + variable verbose + + # + # NOTE: The package has been configured to use a "safe" interpreter; + # therefore, return true. + # + if {[info exists useSafeInterp] && $useSafeInterp} then { + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level 0] 0]] + + eval $logCommand [list \ + "$caller: Using a \"safe\" interpreter (variable)..."] + } + } + + return true + } + + # + # NOTE: The environment has been configured to use a "safe" interpreter; + # therefore, return true. + # + if {[info exists env(UseSafeInterp)]} then { + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level 0] 0]] + + eval $logCommand [list \ + "$caller: Using a \"safe\" interpreter (environment)..."] + } + } + + return true + } + + # + # NOTE: Ok, disable "safe" interpreter use. + # + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level 0] 0]] + + eval $logCommand [list \ + "$caller: Not using a \"safe\" interpreter..."] + } + } + + return false + } + + proc getEnvironmentPathList { varNames varSuffixes } { + global env + + set result [list] + + # + # NOTE: Check for a valid file or directory name in the values of each + # environment variable name specified by the caller. If so, add + # it to the result list. + # + foreach varName $varNames { + # + # NOTE: Check each of the environment variable name suffixes specified + # by the caller prior to trying the environment variable name by + # itself. + # + foreach varSuffix $varSuffixes { + set newVarName ${varName}${varSuffix} + + if {[info exists env($newVarName)]} then { + set path [string trim $env($newVarName)] + + if {[isValidDirectory $path] || [isValidFile $path]} then { + lappend result $path + } + } + } + + if {[info exists env($varName)]} then { + set path [string trim $env($varName)] + + if {[isValidDirectory $path] || [isValidFile $path]} then { + lappend result $path + } + } + } + + return $result + } + + proc getRegistryPathList { rootKeyName valueName } { + set result [list] + + catch { + package require registry; # NOTE: Tcl for Windows only. + + foreach keyName [registry keys $rootKeyName] { + set subKeyName $rootKeyName\\$keyName + + if {[catch {string trim [registry get \ + $subKeyName $valueName]} path] == 0} then { + if {[isValidDirectory $path] || [isValidFile $path]} then { + lappend result $path + } + } + } + } + + return $result + } + + proc getRelativePathList { directories configurations } { + set result [list] + + foreach directory $directories { + foreach configuration $configurations { + set path [file join $directory $configuration Eagle bin] + + if {[isValidDirectory $path] || [isValidFile $path]} then { + lappend result $path + } + + set path [file join $directory $configuration bin] + + if {[isValidDirectory $path] || [isValidFile $path]} then { + lappend result $path + } + + set path [file join $directory $configuration Eagle] + + if {[isValidDirectory $path] || [isValidFile $path]} then { + lappend result $path + } + + set path [file join $directory $configuration] + + if {[isValidDirectory $path] || [isValidFile $path]} then { + lappend result $path + } + } + } + + return $result + } + + proc probeAssemblyFile { directory configuration fileName } { + variable assemblyBaseName + variable packageBinaryFileName + + set path $directory; # maybe it is really a file? + + if {[isValidFile $path]} then { + return $path + } + + set clrPath [expr { + [shouldUseMinimumClr $packageBinaryFileName] ? "CLRv2" : "CLRv4" + }] + + if {[string length $configuration] > 0} then { + set path [file join $directory $assemblyBaseName bin \ + $configuration bin $clrPath $fileName] + + if {[isValidFile $path]} then { + return $path + } + + set path [file join $directory $assemblyBaseName bin \ + $configuration bin $fileName] + + if {[isValidFile $path]} then { + return $path + } + + set path [file join $directory bin $configuration bin \ + $clrPath $fileName] + + if {[isValidFile $path]} then { + return $path + } + + set path [file join $directory bin $configuration bin \ + $fileName] + + if {[isValidFile $path]} then { + return $path + } + + set path [file join $directory $assemblyBaseName bin \ + $configuration $clrPath $fileName] + + if {[isValidFile $path]} then { + return $path + } + + set path [file join $directory $assemblyBaseName bin \ + $configuration $fileName] + + if {[isValidFile $path]} then { + return $path + } + + set path [file join $directory bin $configuration \ + $clrPath $fileName] + + if {[isValidFile $path]} then { + return $path + } + + set path [file join $directory bin $configuration \ + $fileName] + + if {[isValidFile $path]} then { + return $path + } + } else { + set path [file join $directory $assemblyBaseName bin \ + $clrPath $fileName] + + if {[isValidFile $path]} then { + return $path + } + + set path [file join $directory $assemblyBaseName bin \ + $fileName] + + if {[isValidFile $path]} then { + return $path + } + + set path [file join $directory bin $clrPath $fileName] + + if {[isValidFile $path]} then { + return $path + } + + set path [file join $directory bin $fileName] + + if {[isValidFile $path]} then { + return $path + } + } + + return "" + } + + proc findAssemblyFile { directories configurations fileNames } { + foreach directory $directories { + foreach configuration $configurations { + foreach fileName $fileNames { + set path [probeAssemblyFile $directory $configuration $fileName] + + if {[isValidFile $path]} then { + return $path + } + } + } + } + + return "" + } + + ############################################################################# + #************************ PACKAGE HELPER PROCEDURES ************************* + ############################################################################# + + proc haveEagle { {varName ""} } { + # + # NOTE: Attempt to determine if Eagle has been loaded successfully and is + # currently available for use. First, check that there is a global + # command named "eagle". Second, make sure we can use that command + # to evaluate a trivial Eagle script that fetches the name of the + # script engine itself from the Eagle interpreter. Finally, compare + # that result with "eagle" to make sure it is really Eagle. + # + if {[llength [info commands ::eagle]] > 0 && \ + [catch {::eagle {set ::tcl_platform(engine)}} engine] == 0 && \ + [string equal -nocase $engine eagle]} then { + # + # NOTE: Ok, it looks like Eagle is loaded and ready for use. If the + # caller wants the patch level, use the specified variable name + # to store it in the context of the caller. + # + if {[string length $varName] > 0} then { + upvar 1 $varName version + } + + # + # NOTE: Fetch the full patch level of the Eagle script engine. + # + if {[catch {::eagle {set ::eagle_platform(patchLevel)}} \ + version] == 0} then { + # + # NOTE: Finally, verify that the result looks like a proper patch + # level using a suitable regular expression. + # + if {[regexp -- {^\d+\.\d+\.\d+\.\d+$} $version]} then { + return true + } + } + } + + return false + } + + ############################################################################# + #********************* PACKAGE VARIABLE SETUP PROCEDURE ********************* + ############################################################################# + + proc setupHelperVariables { directory } { + ########################################################################### + #*********** NATIVE PACKAGE DIAGNOSTIC CONFIGURATION VARIABLES ************ + ########################################################################### + + # + # NOTE: Display diagnostic messages while starting up this package? This + # is used by the code in the CLR assembly manager contained in this + # package. This is also used by the package test suite. + # + variable verbose; # DEFAULT: false + + if {![info exists verbose]} then { + set verbose false + } + + # + # NOTE: The Tcl command used to log warnings, errors, and other messages + # generated by the package. This is used by the code in the CLR + # assembly manager contained in this package. This is also used by + # the package test suite. + # + variable logCommand; # DEFAULT: [namespace current]::noLog + + if {![info exists logCommand]} then { + set logCommand [namespace current]::noLog + } + + # + # NOTE: When this is non-zero, the [file normalize] sub-command will not + # be used on the assembly path. This is necessary in some special + # environments due to a bug in Tcl where it will resolve junctions + # as part of the path normalization process. + # + variable noNormalize; # DEFAULT: false + + if {![info exists noNormalize]} then { + set noNormalize false + } + + ########################################################################### + #********************* NATIVE PACKAGE NAME VARIABLES ********************** + ########################################################################### + + # + # NOTE: The name of the package we will provide to Tcl. + # + variable packageName; # DEFAULT: Garuda + + if {![info exists packageName]} then { + set packageName [lindex [split [string trim [namespace current] :] :] 0] + } + + # + # NOTE: The name of the dynamic link library containing the native code for + # this package. + # + variable packageBinaryFileNameOnly; # DEFAULT: Garuda.dll + + if {![info exists packageBinaryFileNameOnly]} then { + set packageBinaryFileNameOnly $packageName[info sharedlibextension] + } + + # + # NOTE: The fully qualified file name for the package binary. + # + variable packageBinaryFileName; # DEFAULT: ${directory}/Garuda.dll + + if {![info exists packageBinaryFileName]} then { + set packageBinaryFileName [fileNormalize [file join $directory \ + $packageBinaryFileNameOnly] true] + } + + ########################################################################### + #************* NATIVE PACKAGE GENERAL CONFIGURATION VARIABLES ************* + ########################################################################### + + # + # NOTE: The fully qualified path and file name for the Eagle CLR assembly + # to be loaded. This is used by the code in the CLR assembly manager + # contained in this package. + # + variable assemblyPath; # DEFAULT: + + # + # NOTE: The fully qualified type name of the CLR method(s) to execute + # within the Eagle CLR assembly. This is used by the code in the + # CLR assembly manager contained in this package. + # + variable typeName; # DEFAULT: Eagle._Components.Public.NativePackage + + if {![info exists typeName]} then { + set typeName Eagle._Components.Public.NativePackage + } + + # + # NOTE: The name of the CLR method to execute when starting up the bridge + # between Eagle and Tcl. This is used by the code in the CLR + # assembly manager contained in this package. + # + variable startupMethodName; # DEFAULT: Startup + + if {![info exists startupMethodName]} then { + set startupMethodName Startup + } + + # + # NOTE: The name of the CLR method to execute when issuing control + # directives to the bridge between Eagle and Tcl. This is used by + # the code in the CLR assembly manager contained in this package. + # + variable controlMethodName; # DEFAULT: Control + + if {![info exists controlMethodName]} then { + set controlMethodName Control + } + + # + # NOTE: The name of the managed method to execute when detaching a specific + # Tcl interpreter from the bridge between Eagle and Tcl. This is + # used by the code in the CLR assembly manager contained in this + # package. + # + variable detachMethodName; # DEFAULT: Detach + + if {![info exists detachMethodName]} then { + set detachMethodName Detach + } + + # + # NOTE: The name of the managed method to execute when completely shutting + # down the bridge between Eagle and Tcl. This is used by the code in + # the CLR assembly manager contained in this package. + # + variable shutdownMethodName; # DEFAULT: Shutdown + + if {![info exists shutdownMethodName]} then { + set shutdownMethodName Shutdown + } + + # + # NOTE: The user arguments to pass to all of the managed methods. If this + # value is specified, it MUST be a well-formed Tcl list. This is + # used by the code in the CLR assembly manager contained in this + # package. + # + variable methodArguments; # DEFAULT: NONE + + if {![info exists methodArguments]} then { + set methodArguments [list] + } + + # + # NOTE: The extra method flags to use when invoking the CLR methods. Refer + # to the MethodFlags enumeration for full details. This is used by + # the code in the CLR assembly manager contained in this package. An + # example of a useful value here is 0x40 (i.e. METHOD_PROTOCOL_V1R2). + # + variable methodFlags; # DEFAULT: 0x0 + + if {![info exists methodFlags]} then { + set methodFlags 0x0 + } + + # + # NOTE: Start the CLR immediately upon loading the package? This is used + # by the code in the CLR assembly manager contained in this package. + # + variable startClr; # DEFAULT: true + + if {![info exists startClr]} then { + set startClr true + } + + # + # NOTE: Start the bridge between Eagle and Tcl immediately upon loading + # the package? This is used by the code in the CLR assembly manager + # contained in this package. + # + variable startBridge; # DEFAULT: true + + if {![info exists startBridge]} then { + set startBridge true + } + + # + # NOTE: Attempt to stop and release the CLR when unloading the package? + # This is used by the code in the CLR assembly manager contained + # in this package. + # + variable stopClr; # DEFAULT: true + + if {![info exists stopClr]} then { + set stopClr true + } + + ########################################################################### + #*************** NATIVE PACKAGE CLR CONFIGURATION VARIABLES *************** + ########################################################################### + + # + # NOTE: This is the list of CLR versions supported by this package. In + # the future, this list may need to be updated. + # + variable clrVersions; # DEFAULT: "v2.0.50727 v4.0.30319" + + if {![info exists clrVersions]} then { + set clrVersions [list v2.0.50727 v4.0.30319] + } + + # + # NOTE: Use the minimum supported version of the CLR? By default, we want + # to load the latest known version of the CLR (e.g. "v4.0.30319"). + # However, this loading behavior can now be overridden by setting the + # environment variable named "UseMinimumClr" [to anything] -OR- by + # setting this Tcl variable to non-zero. In that case, the minimum + # supported version of the CLR will be loaded instead (e.g. + # "v2.0.50727"). This Tcl variable is primarily used by the compiled + # code for this package. + # + variable useMinimumClr; # DEFAULT: false + + if {![info exists useMinimumClr]} then { + set useMinimumClr [shouldUseMinimumClr $packageBinaryFileName] + } elseif {$verbose} then { + # + # HACK: Make sure the setting value ends up in the log file. + # + shouldUseMinimumClr $packageBinaryFileName; # NOTE: No side effects. + } + + ########################################################################### + #*********** NATIVE PACKAGE INTERPRETER CONFIGURATION VARIABLES *********** + ########################################################################### + + # + # NOTE: Use an isolated Eagle interpreter even if the Tcl interpreter that + # the package has been loaded into is "unsafe"? + # + variable useIsolation; # DEFAULT: false + + if {![info exists useIsolation]} then { + set useIsolation [shouldUseIsolation] + } elseif {$verbose} then { + # + # HACK: Make sure the setting value ends up in the log file. + # + shouldUseIsolation; # NOTE: No side effects. + } + + # + # NOTE: Use a "safe" Eagle interpreter even if the Tcl interpreter that the + # package has been loaded into is "unsafe"? + # + variable useSafeInterp; # DEFAULT: false + + if {![info exists useSafeInterp]} then { + set useSafeInterp [shouldUseSafeInterp] + } elseif {$verbose} then { + # + # HACK: Make sure the setting value ends up in the log file. + # + shouldUseSafeInterp; # NOTE: No side effects. + } + + ########################################################################### + #******************** MANAGED ASSEMBLY NAME VARIABLES ********************* + ########################################################################### + + # + # NOTE: The Eagle build configurations we know about and support. This + # list is used during the CLR assembly search process in the [setup] + # procedure (below). + # + variable assemblyConfigurations; # DEFAULT: {Debug Release ""} + + if {![info exists assemblyConfigurations]} then { + set assemblyConfigurations [list] + + # + # HACK: When running under the auspices of the Eagle test suite, select + # the matching build configuration and suffix, if any. + # + set assemblyConfiguration "" + + if {[info exists ::test_flags(-configuration)] && \ + [string length $::test_flags(-configuration)] > 0} then { + append assemblyConfiguration $::test_flags(-configuration) + + if {[info exists ::test_flags(-suffix)] && \ + [string length $::test_flags(-suffix)] > 0} then { + append assemblyConfiguration $::test_flags(-suffix) + } + } + + if {[string length $assemblyConfiguration] > 0} then { + lappend assemblyConfigurations $assemblyConfiguration + } + + # + # NOTE: Remove the temporary assembly configuration variable. + # + unset assemblyConfiguration + + # + # NOTE: If there is a build suffix, use it to enhance the default list + # of configurations. + # + if {[info exists ::test_flags(-suffix)] && \ + [string length $::test_flags(-suffix)] > 0} then { + # + # NOTE: First, add each of the default configurations with the build + # suffix appended to them. + # + lappend assemblyConfigurations Debug${::test_flags(-suffix)} + lappend assemblyConfigurations Release${::test_flags(-suffix)} + } + + # + # NOTE: Finally, always add the default build configurations last. + # + lappend assemblyConfigurations Debug Release "" + } + + # + # NOTE: The possible file names for the Eagle CLR assembly, where X is the + # major version of the CLR. + # + variable assemblyFileNames; # DEFAULT: "Eagle_CLRvX.dll Eagle.dll" + + if {![info exists assemblyFileNames]} then { + set assemblyFileNames [list] + + # + # NOTE: If the minimum supported version of the CLR has been (or will be) + # loaded, add the decorated Eagle assembly file name specific to + # CLR version 2.0.50727; otherise, add the decorated Eagle assembly + # file name specific to CLR version 4.0.30319. + # + if {[shouldUseMinimumClr $packageBinaryFileName]} then { + # + # NOTE: Either we cannot or should not use the latest known version of + # the CLR; therefore, use the minimum supported version. In this + # situation, the Eagle assembly specific to the v2 CLR will be + # checked first. + # + lappend assemblyFileNames Eagle_CLRv2.dll + } else { + # + # NOTE: The latest known version of the CLR is available for use and we + # have not been prevented from using it. In this situation, the + # Eagle assembly specific to the v4 CLR will be checked first. + # + # TODO: Should we provide the ability to fallback to the v2 CLR version + # of the assembly here (i.e. should "Eagle_CLRv2.dll" be added to + # this list right after "Eagle_CLRv4.dll")? This is always legal + # because the v4 CLR can load v2 CLR assemblies. + # + lappend assemblyFileNames Eagle_CLRv4.dll + } + + # + # NOTE: Fallback to the generic assembly file name that is CLR version + # neutral (i.e. the version of the CLR it refers to is unknown). + # + lappend assemblyFileNames Eagle.dll + } + + # + # NOTE: The base name for the Eagle CLR assembly. + # + variable assemblyBaseName; # DEFAULT: Eagle + + if {![info exists assemblyBaseName]} then { + set assemblyBaseName [file rootname [lindex $assemblyFileNames end]] + } + + ########################################################################### + #******************* MANAGED ASSEMBLY SEARCH VARIABLES ******************** + ########################################################################### + + # + # NOTE: Use the configured environment variables when searching for the + # Eagle CLR assembly? + # + variable useEnvironment; # DEFAULT: true + + if {![info exists useEnvironment]} then { + set useEnvironment true + } + + # + # NOTE: The environment variable names to check when attempting to find the + # Eagle root directory. This list is used during the assembly search + # process from within the [setupAndLoad] procedure. + # + variable envVars; # DEFAULT: "Eagle_Dll Eagle EagleLkg Lkg" + + if {![info exists envVars]} then { + set envVars [list Eagle_Dll Eagle EagleLkg Lkg] + } + + # + # NOTE: The strings to append to the environment variable names listed + # above when attempting to find the Eagle root directory. This list + # is used during the assembly search process from within the + # [setupAndLoad] procedure. + # + variable envVarSuffixes; # DEFAULT: "Temp Build" + + if {![info exists envVarSuffixes]} then { + set envVarSuffixes [list Temp Build] + } + + # + # NOTE: Use the various relative paths based on the location of this script + # file? This is primarily for use during development, when the Eagle + # CLR assembly will be in the build output directory. + # + variable useRelativePath; # DEFAULT: true + + if {![info exists useRelativePath]} then { + set useRelativePath true + } + + # + # NOTE: Use the configured Windows registry keys when searching for the + # Eagle CLR assembly? + # + variable useRegistry; # DEFAULT: true + + if {![info exists useRegistry]} then { + set useRegistry true + } + + # + # NOTE: The registry key where all the versions of Eagle installed on this + # machine (via the setup) can be found. + # + variable rootRegistryKeyName; # DEFAULT: HKEY_LOCAL_MACHINE\Software\Eagle + + if {![info exists rootRegistryKeyName]} then { + set rootRegistryKeyName HKEY_LOCAL_MACHINE\\Software\\Eagle + } + } + + ############################################################################# + #************************ PACKAGE STARTUP PROCEDURE ************************* + ############################################################################# + + proc setupAndLoad { directory } { + variable assemblyConfigurations + variable assemblyFileNames + variable assemblyPath + variable envVars + variable envVarSuffixes + variable logCommand + variable packageBinaryFileName + variable packageName + variable rootRegistryKeyName + variable useEnvironment + variable useRegistry + variable useRelativePath + variable verbose + + if {[info exists assemblyPath]} then { + # + # NOTE: The managed assembly path has been pre-configured by an external + # script; therefore, just use it verbatim. + # + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level 0] 0]] + + eval $logCommand [list \ + "$caller: Using existing assembly path \"$assemblyPath\"..."] + } + } + } else { + # + # NOTE: Build the list of directories to search for the managed assembly. + # + set directories [list] + + if {$useRelativePath} then { + eval lappendUnique directories [getRelativePathList [list \ + $directory [file dirname $directory] \ + [file dirname [file dirname $directory]] \ + [file dirname [file dirname [file dirname $directory]]]] \ + $assemblyConfigurations] + } + + if {$useEnvironment} then { + eval lappendUnique directories [getEnvironmentPathList \ + $envVars $envVarSuffixes] + } + + if {$useRegistry} then { + eval lappendUnique directories [getRegistryPathList \ + $rootRegistryKeyName Path] + } + + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level 0] 0]] + + eval $logCommand [list \ + "$caller: Final list of directories to search: $directories"] + } + } + + # + # NOTE: Attempt to find the Eagle managed assembly file using the list of + # candidate directories. + # + set path [findAssemblyFile $directories $assemblyConfigurations \ + $assemblyFileNames] + + if {[isValidFile $path]} then { + # + # NOTE: This will end up being used by code (the native code for this + # package) that may have a different current working directory; + # therefore, make sure to normalize it first. + # + set assemblyPath [fileNormalize $path] + } + + # + # NOTE: If no managed assembly path could be found, use the default one. + # This is very unlikely to result in the package being successfully + # loaded. + # + if {![info exists assemblyPath] || \ + [string length $assemblyPath] == 0} then { + # + # NOTE: Choose the last (default) managed assembly file name residing + # in the same directory as the package. This will end up being + # used by code (the native code for this package) that may have + # a different current working directory; therefore, make sure to + # normalize it first. + # + set assemblyPath [fileNormalize [file join $directory [lindex \ + $assemblyFileNames end]]] + + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level 0] 0]] + + eval $logCommand [list \ + "$caller: Using default assembly path \"$assemblyPath\"..."] + } + } + } + } + + # + # NOTE: Attempt to load the dynamic link library for the package now that + # the managed assembly path has been set [to something]. + # + if {$verbose} then { + catch { + set caller [maybeFullName [lindex [info level 0] 0]] + + eval $logCommand [list \ + "$caller: Using final assembly path \"$assemblyPath\"..."] + } + } + + load $packageBinaryFileName $packageName + } + + ############################################################################# + #***************************** PACKAGE STARTUP ****************************** + ############################################################################# + + # + # NOTE: First, arrange to have the "haveEagle" helper procedure exported + # from this namespace and imported into the global namespace. + # + set namespace [namespace current]; namespace export -clear haveEagle + namespace eval :: [list namespace forget ::${namespace}::*] + namespace eval :: [list namespace import -force ::${namespace}::haveEagle] + + # + # NOTE: Next, save the package path for later use. + # + if {![info exists packagePath]} then { + set packagePath [fileNormalize [file dirname [info script]] true] + } + + # + # NOTE: Next, setup the script variables associated with this package. + # + setupHelperVariables $packagePath + + # + # NOTE: Finally, attempt to setup and load the package right now. + # + setupAndLoad $packagePath +} ADDED tcl/8.4/Garuda1.0/helper.tcl.asc Index: tcl/8.4/Garuda1.0/helper.tcl.asc ================================================================== --- tcl/8.4/Garuda1.0/helper.tcl.asc +++ tcl/8.4/Garuda1.0/helper.tcl.asc @@ -0,0 +1,18 @@ +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v2 +Comment: Eagle Package Repository + +iQIcBAABCAAGBQJYAbNkAAoJEFAslq9JXcLZKg4P/RMXnLSMHWnKmrn7szC5zIRL +xokIX2xOq8efJgrqo/G/EBlEzZe04iqhVRDdlFcTecGwKSkztCqQo1eTjBxxXf7e +Wen5LilE99VdbZHkdTgxX+EL4rwx3s0kaXdktglIb0xmiJptuJHsRbwpXQtl/Afa +wScDZ8pRGMCm23S/uztw2HL7mR5j1IFdiA0jgIb71hPjbwz07Qf53WpwVunFkZI6 +YfR14Q0Ytdr0PSRTVfaYSU5CCoTXKgqBOkeGXv94w/kN4H4y/JVDv0QHa7Ih/xHU +D+0LSpfq+Suxy0KcEKQ25S/2gHQZPm+CrlZZZFaXxUGjT6BenpGaSaoSDTVlrb76 +EeTQENMjJcpQdLYFKvsD6DCRpvhe9SN1XE2J4nxGj5hvkp0SNoCwQsAJzWEm6pox +hnfBWMNOGDdtI8rZJu4ujYCllqbGOUsAMV3W53U9nx4VXefJ0sPdi1eVTm+dsxB5 +Q/Sj+LxOVwoOc9Tpk9gJMT4NjtJlf4Jjxe/rppc5cBtLdOSprPyBpdPvEBhcp4ve +xoyONuI4S29/TE81Vb5xWjon0AJOfniVgRhF97EoNOQAc28dWLUzwX/0HOIFOZil +872DtCQa66KrOG83wwmR/DpUt6pDbPHFtxF1nOKE9LvypmYxXIcfQ+0oVCgT2/gt +xmwHFJetulqa6p28hPn1 +=I5E0 +-----END PGP SIGNATURE----- ADDED tcl/8.4/Garuda1.0/msvcr100.dll Index: tcl/8.4/Garuda1.0/msvcr100.dll ================================================================== --- tcl/8.4/Garuda1.0/msvcr100.dll +++ tcl/8.4/Garuda1.0/msvcr100.dll cannot compute difference between binary files ADDED tcl/8.4/Garuda1.0/msvcr100.dll.asc Index: tcl/8.4/Garuda1.0/msvcr100.dll.asc ================================================================== --- tcl/8.4/Garuda1.0/msvcr100.dll.asc +++ tcl/8.4/Garuda1.0/msvcr100.dll.asc @@ -0,0 +1,18 @@ +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v2 +Comment: Eagle Package Repository + +iQIcBAABCAAGBQJYAbNqAAoJEFAslq9JXcLZ0oIQAIq1bal4dfgFgwHEC3W/Zw+Y +C1+OkubOZYhQhOyup6ypJmxwdKtjuFkrKwV+1ykQTaZHUO9v7n6kdQ6bZ+rY7o5M +nF37AjyhATkA95NKkDYP/HZAOVNkNCVWR+eRKOH0PeQb8Qb4pJEvviKMwRA5O5wz +JSs8E9zQSIqPbdZlmPZrZri8kIZx4AwymSpR+a8rEwfdPtnDMpcUAmMnyDRy2JI4 +y8pDlgCrQnDNn6Iq7Dn5V0IMGZm1fljVKIF80BIaW2CWf+f/TYdkFJEY08Ttev7l +16GQr7cYS7xM9PKgSfHPsMfrlJ8HuWhBh801MJDM1ounihKgas8y6GQrpokFNFsb +Gzq9mQ1b3td4CEJw5MClzN2EgWe1hF3dx+kdR9aEOPMEakpaoyyTAmzSV+f5FJem ++4I6JlMUO5SlxCdC+FjMEV1ISlSmX91AwDMOSSEhZId7D5y4IXxHZVuyML9JjMNg +KKYZdII1MsdDowemzLWT+gVIDhvPQVe0b4E2PKlIwM+rk9RceKufq4fNx/ThnA4k +d2LmEryioi01yivzUMpYJx9wQE5TzHNGgiJMFywsCuiPimztwuCZtaw3zGadPXy9 +vZ+yKiNg37JqOJbNxNG7Zuag10/xqxNZLkCZ3TpGgg2tn+igM2jQ48SXxiFPMNKg +MTUxCCWawS3oUa8iBH4d +=VfUA +-----END PGP SIGNATURE----- ADDED tcl/8.4/Garuda1.0/pkgIndex.tcl Index: tcl/8.4/Garuda1.0/pkgIndex.tcl ================================================================== --- tcl/8.4/Garuda1.0/pkgIndex.tcl +++ tcl/8.4/Garuda1.0/pkgIndex.tcl @@ -0,0 +1,21 @@ +############################################################################### +# +# pkgIndex.tcl -- Eagle Package for Tcl (Garuda) +# +# Extensible Adaptable Generalized Logic Engine (Eagle) +# Package Index File +# +# Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. +# +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: $ +# +############################################################################### + +if {![package vsatisfies [package provide Tcl] 8.4]} then {return} +if {[string length [package provide Eagle]] > 0} then {return} + +package ifneeded Garuda 1.0 \ + [list source [file join $dir helper.tcl]] ADDED tcl/8.4/Garuda1.0/pkgIndex.tcl.asc Index: tcl/8.4/Garuda1.0/pkgIndex.tcl.asc ================================================================== --- tcl/8.4/Garuda1.0/pkgIndex.tcl.asc +++ tcl/8.4/Garuda1.0/pkgIndex.tcl.asc @@ -0,0 +1,18 @@ +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v2 +Comment: Eagle Package Repository + +iQIcBAABCAAGBQJYAbNtAAoJEFAslq9JXcLZYuAP/RCSxh/WgVsBXu/U1shJNUGS +A9ysrUxJZ/JOxpusyw90xWOt2IB7Z/n5xA8AXg1M+l/zbmPwKWOzDOESVXrq+OAh ++U9nlpaXzFD+s4KWy5Vcijsba3d9b/DAAIuoNet9sQhGtKPDAgBS7zP42nELrER/ +SpPySSGjgPsI9AZKWwTiUrsoSplSZZjjbId4MUbhNOHVS3UwCEb2CmZPNFkmfhQ2 +oRtBLt0eXpvVACGn+MiH9aNAUYTJMdxj93cOUmC/oQ5uC7Ut617EodThMbeLUae3 +FOeba/P8E7z2hrG5JxpZ0kqykCd2TxTxriU5d9VBJmNbqAgFxhfxcWmBfBbEv0SI +HTm/HG2CcohCRbQtQX3GPlq3RDSlcvkK3DATUiE3f0dzHlzSrCeG6XwXj5qKPAtb +F1pW8RwVnOWHI9EZlZt1IUuTUhJKsA1Cb3pDejjeDRF21lJ24sHGYDagoNxTkxRx ++htvIkEBMPzotSr4tZREPKircnz4CbIHICdmV286VgTg+Ik+Fapev4LqFGfc0Mzk +LQ3dzV+YKE9b2idMrVliUFXs8vD5xiFSBS6tn4WnH4s3Kowtp4Js2VOPAwaemKdg +6fOoes7dqZ8hZ2AiSTc5WVaWlDI1lS6GQqAOcAqukFgbRbH+xZET3ZqX+eTmzABN +00DL1R115XUb3VZMR7Lg +=5tfL +-----END PGP SIGNATURE-----