DELETED 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 DELETED 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 @@ -1,18 +0,0 @@ ------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----- DELETED 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 @@ -1,69 +0,0 @@ -############################################################################### -# -# 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 DELETED 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 @@ -1,18 +0,0 @@ ------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----- DELETED 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 @@ -1,803 +0,0 @@ -############################################################################### -# -# 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 - } -} DELETED 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 @@ -1,18 +0,0 @@ ------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----- DELETED 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 @@ -1,1384 +0,0 @@ -############################################################################### -# -# 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 -} DELETED 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 @@ -1,18 +0,0 @@ ------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----- DELETED 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 DELETED 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 @@ -1,18 +0,0 @@ ------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----- DELETED 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 @@ -1,21 +0,0 @@ -############################################################################### -# -# 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]] DELETED 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 @@ -1,18 +0,0 @@ ------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----- ADDED tcl/8.4/Garuda1.0/win32-x86/Garuda.dll Index: tcl/8.4/Garuda1.0/win32-x86/Garuda.dll ================================================================== --- tcl/8.4/Garuda1.0/win32-x86/Garuda.dll +++ tcl/8.4/Garuda1.0/win32-x86/Garuda.dll cannot compute difference between binary files ADDED tcl/8.4/Garuda1.0/win32-x86/Garuda.dll.asc Index: tcl/8.4/Garuda1.0/win32-x86/Garuda.dll.asc ================================================================== --- tcl/8.4/Garuda1.0/win32-x86/Garuda.dll.asc +++ tcl/8.4/Garuda1.0/win32-x86/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/win32-x86/Scripts/ex_winForms.tcl Index: tcl/8.4/Garuda1.0/win32-x86/Scripts/ex_winForms.tcl ================================================================== --- tcl/8.4/Garuda1.0/win32-x86/Scripts/ex_winForms.tcl +++ tcl/8.4/Garuda1.0/win32-x86/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/win32-x86/Scripts/ex_winForms.tcl.asc Index: tcl/8.4/Garuda1.0/win32-x86/Scripts/ex_winForms.tcl.asc ================================================================== --- tcl/8.4/Garuda1.0/win32-x86/Scripts/ex_winForms.tcl.asc +++ tcl/8.4/Garuda1.0/win32-x86/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/win32-x86/Tests/all.tcl Index: tcl/8.4/Garuda1.0/win32-x86/Tests/all.tcl ================================================================== --- tcl/8.4/Garuda1.0/win32-x86/Tests/all.tcl +++ tcl/8.4/Garuda1.0/win32-x86/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/win32-x86/Tests/all.tcl.asc Index: tcl/8.4/Garuda1.0/win32-x86/Tests/all.tcl.asc ================================================================== --- tcl/8.4/Garuda1.0/win32-x86/Tests/all.tcl.asc +++ tcl/8.4/Garuda1.0/win32-x86/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/win32-x86/helper.tcl Index: tcl/8.4/Garuda1.0/win32-x86/helper.tcl ================================================================== --- tcl/8.4/Garuda1.0/win32-x86/helper.tcl +++ tcl/8.4/Garuda1.0/win32-x86/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/win32-x86/helper.tcl.asc Index: tcl/8.4/Garuda1.0/win32-x86/helper.tcl.asc ================================================================== --- tcl/8.4/Garuda1.0/win32-x86/helper.tcl.asc +++ tcl/8.4/Garuda1.0/win32-x86/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/win32-x86/msvcr100.dll Index: tcl/8.4/Garuda1.0/win32-x86/msvcr100.dll ================================================================== --- tcl/8.4/Garuda1.0/win32-x86/msvcr100.dll +++ tcl/8.4/Garuda1.0/win32-x86/msvcr100.dll cannot compute difference between binary files ADDED tcl/8.4/Garuda1.0/win32-x86/msvcr100.dll.asc Index: tcl/8.4/Garuda1.0/win32-x86/msvcr100.dll.asc ================================================================== --- tcl/8.4/Garuda1.0/win32-x86/msvcr100.dll.asc +++ tcl/8.4/Garuda1.0/win32-x86/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/win32-x86/pkgIndex.tcl Index: tcl/8.4/Garuda1.0/win32-x86/pkgIndex.tcl ================================================================== --- tcl/8.4/Garuda1.0/win32-x86/pkgIndex.tcl +++ tcl/8.4/Garuda1.0/win32-x86/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/win32-x86/pkgIndex.tcl.asc Index: tcl/8.4/Garuda1.0/win32-x86/pkgIndex.tcl.asc ================================================================== --- tcl/8.4/Garuda1.0/win32-x86/pkgIndex.tcl.asc +++ tcl/8.4/Garuda1.0/win32-x86/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-----