###############################################################################
#
# tdk.eagle --
#
# Extensible Adaptable Generalized Logic Engine (Eagle)
# TclDevKit Debugger Integration Package
#
# 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 {
  if {[isEagle]} then {
    #
    # NOTE: This procedure attempts to locate an installed instance of the
    #       "modern" ActiveState TclDevKit (e.g. version 5.4.0).  If found,
    #       the directory it was installed into will be returned; otherwise,
    #       an empty string will be returned.
    #
    proc getTclDevKitDirectory {} {
      try {
        set keyName Software\\ActiveState\\TclDevKit
        set fullKeyName [appendArgs HKEY_LOCAL_MACHINE\\ $keyName]

        set version [object invoke Microsoft.Win32.Registry GetValue \
            $fullKeyName CurrentVersion null]

        if {[string length $version] > 0} then {
          set directory [object invoke Microsoft.Win32.Registry GetValue \
              [appendArgs $fullKeyName \\ $version] null null]

          if {[string length $version] > 0} then {
            return $directory
          }
        }

        set subKey [object invoke -alias \
            Microsoft.Win32.Registry.LocalMachine OpenSubKey $keyName]

        if {[string length $subKey] > 0} then {
          foreach subKeyName [$subKey GetSubKeyNames] {
            try {
              set subSubKey [$subKey -alias OpenSubKey $subKeyName]

              if {[string length $subSubKey] > 0} then {
                set directory [$subSubKey GetValue null]

                if {[string length $directory] > 0} then {
                  return $directory
                }
              }
            } finally {
              unset -nocomplain subSubKey
            }
          }
        }

        return ""
      } finally {
        unset -nocomplain subKey
      }
    }

    #
    # NOTE: This procedure evaluates the specified Tcl script, either via a
    #       normal Tcl interpreter on this thread -OR- via an isolated Tcl
    #       thread.
    #
    proc tcl_eval { interp args } {
      if {[isTclThread $interp]} then {
        eval tcl queue -eventflags Immediate -synchronous true \
            [list $interp] $args
      } else {
        eval tcl eval [list $interp] $args
      }
    }

    #
    # NOTE: This procedure attempts to load the TclDevKit remote debugger
    #       package into the specified Tcl interpreter.  By default, the
    #       "primary" Tcl interpreter will be used.  If the native Tcl
    #       interface is not ready or if the remote debugger package
    #       cannot be loaded, an error will be raised.
    #
    proc tcl_debugger_setup { {interp ""} } {
      if {![tcl ready]} then {error "native Tcl interface is not ready"}
      if {[string length $interp] == 0} then {set interp [tcl primary]}

      set directory [getTclDevKitDirectory]

      if {[string length $directory] == 0} then {
        error "the TclDevKit does not appear to be installed"
      }

      set directory [file join $directory lib tcldebugger_attach]

      tcl_eval $interp [list lappend auto_path [file normalize $directory]]
      tcl_eval $interp [list package require tcldebugger_attach]
    }

    #
    # NOTE: This procedure attempts to startup the installed TclDevKit
    #       debugger application and force it to listen on its default
    #       port (i.e. for use as a remote script debugger).  Then, it
    #       waits a brief period of time before returning (i.e. to allow
    #       the TclDevKit debugger application to fully startup).
    #
    proc tcl_debugger_startup {} {
      set directory [getTclDevKitDirectory]

      if {[string length $directory] == 0} then {
        error "the TclDevKit does not appear to be installed"
      }

      set applicationFileName [file join $directory bin [appendArgs \
          tcldebugger [info programextension]]]

      if {![file exists $applicationFileName]} then {
        error [appendArgs \
            "the TclDevKit debugger application file \"" \
            $applicationFileName "\" not found"]
      }

      global tdk_path

      if {![info exists tdk_path]} then {
        error "the TclDevKit debugger project file path is not set"
      }

      set projectFileName [file join $tdk_path remote.tpj]

      if {![file exists $projectFileName]} then {
        error [appendArgs \
            "the TclDevKit debugger project file \"" \
            $projectFileName "\" not found"]
      }

      exec $applicationFileName $projectFileName &; after 5000
    }

    #
    # NOTE: This procedure attempts to initialize the TclDevKit remote
    #       debugger in the specified Tcl interpreter.  By default, the
    #       "primary" Tcl interpreter will be used.  If the native Tcl
    #       interface is not ready or if the remote debugger package
    #       cannot be initialized, an error will be raised.
    #
    proc tcl_debugger_init {
            {interp ""} {host 127.0.0.1} {port 2576} {cdata {}} } {
      if {![tcl ready]} then {error "native Tcl interface is not ready"}
      if {[string length $interp] == 0} then {set interp [tcl primary]}

      tcl_eval $interp [list debugger_init $host $port $cdata]
    }

    #
    # NOTE: This procedure attempts to evaluate a Tcl script under control
    #       of the TclDevKit remote debugger.  By default, the "primary" Tcl
    #       interpreter will be used.  If the native Tcl interface is not
    #       ready or if the remote debugger package fails to evaluate the
    #       Tcl script, an error will be raised.
    #
    proc tcl_debugger_eval { {interp ""} args } {
      if {![tcl ready]} then {error "native Tcl interface is not ready"}
      if {[string length $interp] == 0} then {set interp [tcl primary]}

      tcl_eval $interp debugger_eval $args
    }

    #
    # NOTE: This procedure attempts to tell the TclDevKit remote debugger
    #       to break the execution of the Tcl script in progress.
    #
    proc tcl_debugger_break { {interp ""} {str ""} } {
      if {![tcl ready]} then {error "native Tcl interface is not ready"}
      if {[string length $interp] == 0} then {set interp [tcl primary]}

      tcl_eval $interp [list debugger_break $str]
    }
  }

  if {![info exists tdk_path]} then {
    set tdk_path [file dirname [info script]]
  }

  package provide Eagle.TclDevKit.Integration \
    [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}]
}
