System.Data.SQLite
Artifact Content
Not logged in

Artifact f99e11ab1fcee3b0e1581d33ae0344260a0f7dbf:


###############################################################################
#
# 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.
  #
  # <bootstrap>
  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.
  #
  # <bootstrap>
  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 ""
  }

  if {![interp issafe]} then {
    #
    # NOTE: Load the extra script library files that contain commonly used
    #       procedures that are shared between native Tcl and Eagle.
    #
    loadScripts [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 {
      loadScripts [file dirname [info script]] [list \
          compat.eagle csharp.eagle object.eagle process.eagle \
          runopt.eagle unkobj.eagle update.eagle]
    } else {
      loadScripts [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.
    #
    # <pkgIndex>
    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.
      #
      # <create>
      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".
      #
      # <create>
      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.
      #
      # <create>
      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.
    #
    # <create>
    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.
    #
    # <experimental>
    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.
    #
    # <experimental>
    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 {
      loadScripts [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 isWindows isInteractive haveGaruda \
          isTclThread isMono isSameFileName getEnvironmentVariable \
          combineFlags getCompileInfo getPlatformInfo getPluginName \
          getPluginPath 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 lshuffle ldifference filter map reduce \
          getLengthModifier debug findDirectories \
          findDirectoriesRecursive findFiles findFilesRecursive \
          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"}]
}