System.Data.SQLite
Artifact Content
Not logged in

Artifact d967f7ae00a6cbb0352d1212fed7b7e6b261edee:


###############################################################################
#
# info.eagle --
#
# Extensible Adaptable Generalized Logic Engine (Eagle)
# Eagle Information Package 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 procedure returns the list of options that were used when
  #       compiling the Eagle core library.
  #
  proc getCompileInfo {} {
    #
    # NOTE: Return the important compile-time information for use by the
    #       setup or other callers.
    #
    return [expr {[isEagle] ? [lappend result \
        TimeStamp $::eagle_platform(timeStamp) \
        ImageRuntimeVersion $::eagle_platform(imageRuntimeVersion) \
        ModuleVersionId $::eagle_platform(moduleVersionId) \
        CompileOptions $::eagle_platform(compileOptions)] : ""}]
  }

  #
  # NOTE: This procedure returns the specified Eagle platform information,
  #       if available; otherwise a default value is returned instead.
  #
  proc getPlatformInfo { name {default ""} } {
    #
    # NOTE: Return the important platform information for use by the test
    #       suite or other callers.
    #
    return [expr {[isEagle] && [info exists ::eagle_platform($name)] && \
        [string length [string trim $::eagle_platform($name)]] > 0 ? \
        $::eagle_platform($name) : $default}]
  }

  #
  # NOTE: This procedure returns the name of the first loaded plugin that
  #       matches the specified pattern.
  #
  proc getPluginName { pattern } {
    #
    # NOTE: This should work properly in both Tcl and Eagle.
    #
    foreach loaded [info loaded] {
      if {[regexp -- $pattern [lindex $loaded end]]} then {
        return [lindex $loaded 1]
      }
    }

    return ""
  }

  #
  # NOTE: This procedure returns the fully qualified file name of the first
  #       loaded plugin that matches the specified pattern.
  #
  proc getPluginPath { pattern } {
    #
    # NOTE: This should work properly in both Tcl and Eagle.
    #
    foreach loaded [info loaded] {
      if {[regexp -- $pattern [lindex $loaded end]]} then {
        return [lindex $loaded 0]
      }
    }

    return ""
  }

  #
  # NOTE: This procedure returns the Eagle core library base path, e.g. a
  #       value like "C:\Eagle" when loaded from "C:\Eagle\bin\Eagle.dll".
  #
  proc getBasePath {} {
    set assembly [object invoke -flags +NonPublic \
        Eagle._Components.Private.GlobalState GetAssembly]

    return [object invoke -flags +NonPublic \
        Eagle._Components.Private.PathOps GetBasePath $assembly \
        [file dirname [lindex [info assembly] 1]]]
  }

  #
  # NOTE: This procedure returns the flags for the first loaded plugin that
  #       matches the specified pattern.
  #
  proc getPluginFlags { pattern } {
    foreach loaded [info loaded] {
      set plugin [lindex $loaded end]

      if {[regexp -- $pattern $plugin]} then {
        return [string map [list , " "] \
            [getDictionaryValue [info plugin $plugin] flags]]
      }
    }

    return [list]
  }

  #
  # NOTE: This procedure returns non-zero if the Eagle Native Package for
  #       Tcl (Garuda) is loaded into the primary native Tcl interpreter.
  #
  proc haveGaruda { {varName ""} } {
    #
    # NOTE: Check for a variable name to place the Garuda package Id into.
    #
    if {[string length $varName] > 0} then {
      upvar 1 $varName packageId
    }

    #
    # NOTE: Is the Eagle Package for Tcl (Garuda) available?  This check
    #       is different in Eagle and Tcl.
    #
    if {[isEagle]} then {
      return [expr {[llength [info commands tcl]] > 0 && [tcl ready] && \
          [catch {tcl eval [tcl master] {package present Garuda}}] == 0 && \
          [catch {tcl eval [tcl master] {garuda packageid}} packageId] == 0}]
    } else {
      return [expr {[catch {package present Garuda}] == 0 && \
          [catch {garuda packageid} packageId] == 0}]
    }
  }

  #
  # NOTE: This procedure returns non-zero if the specified name represents
  #       a thread managed by the native Tcl integration subsystem of Eagle.
  #
  proc isTclThread { name } {
    #
    # NOTE: For now, this check only works in Eagle.
    #
    set result false

    if {[isEagle]} then {
      catch {
        if {[llength [info commands tcl]] > 0 && [tcl ready] && \
            [lsearch -exact -- [tcl threads] $name] != -1} then {
          #
          # NOTE: The name specified by the caller appears in the
          #       list of Tcl threads for this Eagle interpreter.
          #
          set result true
        }
      }
    }

    return $result
  }

  #
  # NOTE: Provide the Eagle "info" package to the interpreter.
  #
  package provide Eagle.Information \
    [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}]
}