############################################################################### # # init.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) # Eagle Interpreter Initialization 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: $ # ############################################################################### # # NOTE: Use our own namespace here because even though we do not directly # support namespaces ourselves, we do not want to pollute the global # namespace if this script actually ends up being evaluated in Tcl. # namespace eval ::Eagle { # # NOTE: This is the procedure that detects whether or not we are # running in Eagle (otherwise, we are running in vanilla Tcl). # This procedure must function correctly in both Tcl and Eagle # and must return non-zero only when running in Eagle. This # procedure must be defined in this script file because it is # needed while this script file is being evaluated. The same # procedure is also defined in the "platform.eagle" file. # # proc isEagle {} { # # NOTE: Nothing too fancy or expensive should be done in here. In # theory, use of this routine should be rare; however, in # practice, this routine is actually used quite a bit (e.g. # by the test suite). # return [expr {[info exists ::tcl_platform(engine)] && \ [string compare -nocase eagle $::tcl_platform(engine)] == 0}] } # # NOTE: This procedure is designed to "load" (i.e. [source]) other script # files that logically belong to the package defined in this script # file. Upon success, an empty string will be returned. A script # error may be raised. This should work properly in both Tcl and # Eagle. This procedure must be defined in this script file because # it is needed while this script file is being evaluated. # # proc loadScripts { directory fileNamesOnly } { # # NOTE: Does the directory specified by the caller contain information # useful in locating the script file? # if {[string length $directory] == 0 || $directory eq "."} then { # # NOTE: The directory specified by the caller contains no useful # information, use the Tcl library directory instead, if # possible. # if {[info exists ::tcl_library] && \ [string length $::tcl_library] > 0 && \ [file isdirectory $::tcl_library]} then { # # NOTE: Ok, use the Tcl library directory. # set directory $::tcl_library } } # # NOTE: Start out with the [source] command. # set baseCommand source # # NOTE: When using Eagle, use the -withinfo option to preserve the # location information for procedures defined in the specified # script file. # if {[isEagle]} then { lappend baseCommand -withinfo true -- } # # NOTE: Load each script file specified by the caller, in the exact # order they were specified. # foreach fileNameOnly $fileNamesOnly { # # NOTE: Start with the base [source] command, maybe with some # options. # set fileCommand $baseCommand # # NOTE: Add the qualified file name, which may or may not be fully # qualified. # lappend fileCommand [file join $directory $fileNameOnly] # # NOTE: Evaluate the resulting command in the callers context. # uplevel 1 $fileCommand } # # NOTE: Success, return an empty string. # return "" } # # NOTE: This procedure is designed to "load" (i.e. [source]) other script # files that logically belong to the package defined in this script # file. Upon success, an empty string will be returned. A script # error may be raised. This should work properly in both Tcl and # Eagle. This procedure must be defined in this script file because # it is needed while this script file is being evaluated. If there # exists a global array element no($fileNameOnly) corresponding to a # particular script file to be loaded, it will be skipped. # # proc maybeLoadScripts { directory fileNamesOnly } { set matchFileNames [list] foreach fileNameOnly $fileNamesOnly { if {![info exists ::no($fileNameOnly)]} then { lappend matchFileNames $fileNameOnly } } return [uplevel 1 [list loadScripts $directory $matchFileNames]] } if {![interp issafe]} then { # # NOTE: Load the extra script library files that contain commonly used # procedures that are shared between native Tcl and Eagle. # maybeLoadScripts [file dirname [info script]] [list \ auxiliary.eagle database.eagle exec.eagle file1.eagle \ file2.eagle file3.eagle info.eagle list.eagle \ pkgt.eagle platform.eagle testlog.eagle unzip.eagle] # # NOTE: Load the extra script library files that contain procedures that # require a specific language (i.e. either native Tcl or Eagle). # if {[isEagle]} then { maybeLoadScripts [file dirname [info script]] [list \ compat.eagle csharp.eagle object.eagle process.eagle \ runopt.eagle unkobj.eagle update.eagle] } else { maybeLoadScripts [file dirname [info script]] [list shim.eagle] } } if {[isEagle]} then { ########################################################################### ############################ BEGIN Eagle ONLY ############################# ########################################################################### # # NOTE: This procedure uses the [source] command to evaluate a script # file while preserving the location information for procedures # defined with it. # # proc sourceWithInfo { args } { catch { set savedCacheFlags None object invoke -flags +NonPublic Interpreter.GetActive \ BeginNoArgumentCache savedCacheFlags } try { catch { set savedInterpreterFlags None object invoke -flags +NonPublic Interpreter.GetActive \ BeginArgumentLocation savedInterpreterFlags } try { set command [list source]; eval lappend command $args return [uplevel 1 $command] } finally { catch { object invoke -flags +NonPublic Interpreter.GetActive \ EndArgumentLocation savedInterpreterFlags } } } finally { catch { object invoke -flags +NonPublic Interpreter.GetActive \ EndNoArgumentCache savedCacheFlags } } } if {![interp issafe]} then { # # NOTE: This is the [unknown] command for Eagle. It will normally be # executed by the script engine when a command is not found. # By default, it will simply raise a script error; however, if # the "eagleUnknownObjectInvoke" runtime option is set, it will # first attempt to use the (unknown) command name as the name # of a CLR type. # # proc unknown { name args } { # # NOTE: This is an [unknown] procedure that normally produces an # appropriate error message; however, it can optionally try # to invoke a static object method. # # TODO: Add support for auto-loading packages here in the future? # if {[llength [info commands hasRuntimeOption]] > 0 && \ [hasRuntimeOption eagleUnknownObjectInvoke] && \ [llength [info commands object]] > 0 && \ [llength [info commands unknownObjectInvoke]] > 0} then { # # NOTE: In the context of the caller, attempt to invoke a static # object method using the specified arguments (which may # contain variable names). # if {[catch { eval unknownObjectInvoke 1 [list $name] $args } result] == 0} then { # # NOTE: The static object method was invoked successfully. # Return its result. # return -code ok $result } elseif {[string length $result] > 0} then { # # NOTE: Attempting to invoke the static object method raised # an error. Re-raise it now. If no error message was # provided, fallback on the default (below). # return -code error $result } } return -code error [appendArgs "invalid command name \"" $name \"] } } else { # # NOTE: This is the [unknown] command for Eagle. It will normally be # executed by the script engine when a command is not found. # It will simply raise a script error. This procedure is also # defined in "safe.eagle". # # proc unknown { name args } { # # NOTE: This is an [unknown] procedure that produces an appropriate # error message. # # TODO: Add support for auto-loading packages here in the future? # # NOTE: This command cannot use [appendArgs] because that procedure # is defined in another file that is never loaded into "safe" # interpreters. # return -code error "invalid command name \"$name\"" } } # # NOTE: This namespace and the procedure defined within it are used for # compatibility with native Tcl. # namespace eval ::tcl::tm { # # NOTE: Ideally, this procedure should be created in the "::tcl::tm" # namespace. # # proc ::tcl::tm::UnknownHandler { original name args } { # # NOTE: Do nothing except call the original handler. # uplevel 1 $original [::linsert $args 0 $name] } } # # NOTE: This procedure is normally executed by the package management # subsystem of Eagle when a package is requested that cannot be # found. By default, it will force a scan of all known package # indexes. # # proc tclPkgUnknown { name args } { # # NOTE: Force a rescan of "pkgIndex" files. This must be done in # the global scope so that the special global variable 'dir' # set by the package index loading subsystem can be accessed. # uplevel #0 [list package scan -host -normal -refresh] } # # NOTE: This procedure marks a procedure for "fast" execution; for now, # this means disabling anything that makes variable access slower # while the target procedure is executing. # # proc makeProcedureFast { name fast } { # # NOTE: This should work properly in Eagle only. # catch { uplevel 1 [list object invoke -flags +NonPublic \ Interpreter.GetActive MakeProcedureFast $name $fast] } } # # NOTE: This procedure marks a variable for "fast" access; for now, this # means disabling anything that makes variable access slower while # the target variable is being read, set, or unset. # # proc makeVariableFast { name fast } { # # NOTE: This should work properly in Eagle only. # catch { uplevel 1 [list object invoke -flags +NonPublic \ Interpreter.GetActive MakeVariableFast $name $fast] } } # # NOTE: Add script library files borrowed from native Tcl. # if {![interp issafe]} then { maybeLoadScripts [file dirname [info script]] [list word.tcl] } ########################################################################### ############################# END Eagle ONLY ############################## ########################################################################### } else { ########################################################################### ############################# BEGIN Tcl ONLY ############################## ########################################################################### # # NOTE: Exports the necessary commands from this package and import them # into the global namespace. # if {[llength [info commands exportAndImportPackageCommands]] > 0} then { exportAndImportPackageCommands [namespace current] [list \ isEagle loadScripts maybeLoadScripts isWindows isInteractive \ haveGaruda isTclThread isMono isDotNetCore isSameFileName \ getEnvironmentVariable combineFlags getCompileInfo getPlatformInfo \ getPluginName getPluginPath getPackageInstallPath appendArgs \ lappendArgs getDictionaryValue getColumnValue getRowColumnValue \ tqputs tqlog makeBinaryChannel makeAsciiChannel makeUnicodeChannel \ makeLogChannel readFile readSharedFile writeFile appendFile \ appendLogFile appendSharedFile appendSharedLogFile \ readAsciiFile writeAsciiFile readUnicodeFile \ writeUnicodeFile getDirResultPath addToPath removeFromPath \ execShell maybeGetExitCode lshuffle ldifference filter map reduce \ getLengthModifier debug findDirectories \ findDirectoriesRecursive findFiles findFilesRecursive \ copyFilesRecursive exportAndImportPackageCommands setupUnzipVars \ unzipMustBeInstalled extractZipArchive] false false } ########################################################################### ############################## END Tcl ONLY ############################### ########################################################################### } # # NOTE: Provide the Eagle "library" package to the interpreter. # package provide Eagle.Library \ [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}] }