Logo Search packages:      
Sourcecode: tcl8.4 version File versions  Download package

tclMacOSA.c

/* 
 * tclMacOSA.c --
 *
 *    This contains the initialization routines, and the implementation of
 *    the OSA and Component commands.  These commands allow you to connect
 *    with the AppleScript or any other OSA component to compile and execute
 *    scripts.
 *
 * Copyright (c) 1996 Lucent Technologies and Jim Ingham
 * Copyright (c) 1997 Sun Microsystems, Inc.
 *
 * See the file "License Terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclMacOSA.c,v 1.10 2002/10/09 11:54:30 das Exp $
 */

#define MAC_TCL

#include <Aliases.h>
#include <string.h>
#include <AppleEvents.h>
#include <AppleScript.h>
#include <OSA.h>
#include <OSAGeneric.h>
#include <Script.h>

#include <FullPath.h>
#include <components.h>

#include <resources.h>
#include <FSpCompat.h>
/* 
 * The following two Includes are from the More Files package.
 */
#include <MoreFiles.h>
#include <FullPath.h>

#include "tcl.h"
#include "tclInt.h"

/*
 * I need this only for the call to FspGetFullPath,
 * I'm really not poking my nose where it does not belong!
 */
#include "tclMacInt.h"

/*
 * Data structures used by the OSA code.
 */
typedef struct tclOSAScript {
    OSAID scriptID;
    OSType languageID;
    long modeFlags;
} tclOSAScript;

typedef struct tclOSAContext {
      OSAID contextID;
} tclOSAContext;

typedef struct tclOSAComponent {
      char *theName;
      ComponentInstance theComponent; /* The OSA Component represented */
      long componentFlags;
      OSType languageID;
      char *languageName;
      Tcl_HashTable contextTable;    /* Hash Table linking the context names & ID's */
      Tcl_HashTable scriptTable;
      Tcl_Interp *theInterp;
      OSAActiveUPP defActiveProc;
      long defRefCon;
} tclOSAComponent;

/*
 * Prototypes for static procedures. 
 */

static pascal OSErr     TclOSAActiveProc _ANSI_ARGS_((long refCon));
static int        TclOSACompileCmd _ANSI_ARGS_((Tcl_Interp *interp,
                      tclOSAComponent *OSAComponent, int argc,
                      CONST char **argv));
static int        tclOSADecompileCmd _ANSI_ARGS_((Tcl_Interp * Interp,
                      tclOSAComponent *OSAComponent, int argc,
                      CONST char **argv));
static int        tclOSADeleteCmd _ANSI_ARGS_((Tcl_Interp *interp,
                      tclOSAComponent *OSAComponent, int argc,
                      CONST char **argv));
static int        tclOSAExecuteCmd _ANSI_ARGS_((Tcl_Interp *interp,
                      tclOSAComponent *OSAComponent, int argc,
                      CONST char **argv));
static int        tclOSAInfoCmd _ANSI_ARGS_((Tcl_Interp *interp,
                      tclOSAComponent *OSAComponent, int argc,
                      CONST char **argv));
static int        tclOSALoadCmd _ANSI_ARGS_((Tcl_Interp *interp,
                      tclOSAComponent *OSAComponent, int argc,
                      CONST char **argv));
static int        tclOSARunCmd _ANSI_ARGS_((Tcl_Interp *interp,
                      tclOSAComponent *OSAComponent, int argc,
                      CONST char **argv));
static int        tclOSAStoreCmd _ANSI_ARGS_((Tcl_Interp *interp,
                      tclOSAComponent *OSAComponent, int argc,
                      CONST char **argv));
static void       GetRawDataFromDescriptor _ANSI_ARGS_((AEDesc *theDesc,
                      Ptr destPtr, Size destMaxSize, Size *actSize));
static OSErr            GetCStringFromDescriptor _ANSI_ARGS_((
                      AEDesc *sourceDesc, char *resultStr,
                      Size resultMaxSize,Size *resultSize));
static int        Tcl_OSAComponentCmd _ANSI_ARGS_((ClientData clientData,
                      Tcl_Interp *interp, int argc, CONST char **argv)); 
static void             getSortedHashKeys _ANSI_ARGS_((Tcl_HashTable *theTable,
                      CONST char *pattern, Tcl_DString *theResult));
static int        ASCIICompareProc _ANSI_ARGS_((const void *first,
                      const void *second));
static int        Tcl_OSACmd _ANSI_ARGS_((ClientData clientData,
                      Tcl_Interp *interp, int argc, CONST char **argv)); 
static void             tclOSAClose _ANSI_ARGS_((ClientData clientData));
/*static void           tclOSACloseAll _ANSI_ARGS_((ClientData clientData));*/
static tclOSAComponent *tclOSAMakeNewComponent _ANSI_ARGS_((Tcl_Interp *interp,
                      char *cmdName, char *languageName,
                      OSType scriptSubtype, long componentFlags));  
static int        prepareScriptData _ANSI_ARGS_((int argc, CONST char **argv,
                      Tcl_DString *scrptData ,AEDesc *scrptDesc)); 
static void             tclOSAResultFromID _ANSI_ARGS_((Tcl_Interp *interp,
                      ComponentInstance theComponent, OSAID resultID));
static void             tclOSAASError _ANSI_ARGS_((Tcl_Interp * interp,
                      ComponentInstance theComponent, char *scriptSource));
static int        tclOSAGetContextID _ANSI_ARGS_((tclOSAComponent *theComponent, 
                      CONST char *contextName, OSAID *theContext));
static void             tclOSAAddContext _ANSI_ARGS_((tclOSAComponent *theComponent, 
                      char *contextName, const OSAID theContext));                                    
static int        tclOSAMakeContext _ANSI_ARGS_((tclOSAComponent *theComponent, 
                      CONST char *contextName, OSAID *theContext));                                   
static int        tclOSADeleteContext _ANSI_ARGS_((tclOSAComponent *theComponent,
                      CONST char *contextName)); 
static int        tclOSALoad _ANSI_ARGS_((Tcl_Interp *interp, 
                      tclOSAComponent *theComponent, CONST char *resourceName, 
                      int resourceNumber, CONST char *fileName,OSAID *resultID));
static int        tclOSAStore _ANSI_ARGS_((Tcl_Interp *interp, 
                      tclOSAComponent *theComponent, CONST char *resourceName, 
                      int resourceNumber, CONST char *scriptName, CONST char *fileName));
static int        tclOSAAddScript _ANSI_ARGS_((tclOSAComponent *theComponent,
                      char *scriptName, long modeFlags, OSAID scriptID));           
static int        tclOSAGetScriptID _ANSI_ARGS_((tclOSAComponent *theComponent,
                      CONST char *scriptName, OSAID *scriptID)); 
static tclOSAScript *   tclOSAGetScript _ANSI_ARGS_((tclOSAComponent *theComponent,
                      CONST char *scriptName)); 
static int        tclOSADeleteScript _ANSI_ARGS_((tclOSAComponent *theComponent,
                      CONST char *scriptName,char *errMsg));

/*
 * "export" is a MetroWerks specific pragma.  It flags the linker that  
 * any symbols that are defined when this pragma is on will be exported 
 * to shared libraries that link with this library.
 */
 

#pragma export on
int Tclapplescript_Init( Tcl_Interp *interp );
#pragma export reset

/*
 *----------------------------------------------------------------------
 *
 * Tclapplescript_Init --
 *
 *    Initializes the the OSA command which opens connections to
 *    OSA components, creates the AppleScript command, which opens an 
 *    instance of the AppleScript component,and constructs the table of
 *    available languages.
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side Effects:
 *    Opens one connection to the AppleScript component, if 
 *    available.  Also builds up a table of available OSA languages,
 *    and creates the OSA command.
 *
 *----------------------------------------------------------------------
 */

int 
Tclapplescript_Init(
    Tcl_Interp *interp)       /* Tcl interpreter. */
{
    char *errMsg = NULL;
    OSErr myErr = noErr;
    Boolean gotAppleScript = false;
    Boolean GotOneOSALanguage = false;
    ComponentDescription compDescr = {
      kOSAComponentType,
      (OSType) 0,
      (OSType) 0,
      (long) 0,
      (long) 0
    }, *foundComp;
    Component curComponent = (Component) 0;
    ComponentInstance curOpenComponent;
    Tcl_HashTable *ComponentTable;
    Tcl_HashTable *LanguagesTable;
    Tcl_HashEntry *hashEntry;
    int newPtr;
    AEDesc componentName = { typeNull, NULL };
    char nameStr[32];               
    Size nameLen;
    long appleScriptFlags;
      
    /* 
     * Perform the required stubs magic...
     */
      
    if (!Tcl_InitStubs(interp, "8.2", 0)) {
      return TCL_ERROR;
    }

    /* 
     * Here We Will Get The Available Osa Languages, Since They Can Only Be 
     * Registered At Startup...  If You Dynamically Load Components, This
     * Will Fail, But This Is Not A Common Thing To Do.
     */
       
    LanguagesTable = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
      
    if (LanguagesTable == NULL) {
      panic("Memory Error Allocating Languages Hash Table");
    }
      
    Tcl_SetAssocData(interp, "OSAScript_LangTable", NULL, LanguagesTable);
    Tcl_InitHashTable(LanguagesTable, TCL_STRING_KEYS);
      
                  
    while ((curComponent = FindNextComponent(curComponent, &compDescr)) != 0) {
      int nbytes = sizeof(ComponentDescription);
      foundComp = (ComponentDescription *)
          ckalloc(sizeof(ComponentDescription));
      myErr = GetComponentInfo(curComponent, foundComp, NULL, NULL, NULL);
      if (foundComp->componentSubType ==
            kOSAGenericScriptingComponentSubtype) {
          /* Skip the generic component */
          ckfree((char *) foundComp);
      } else {
          GotOneOSALanguage = true;

          /*
           * This is gross: looks like I have to open the component just  
           * to get its name!!! GetComponentInfo is supposed to return
           * the name, but AppleScript always returns an empty string.
           */
                  
          curOpenComponent = OpenComponent(curComponent);
          if (curOpenComponent == NULL) {
            Tcl_AppendResult(interp,"Error opening component",
                  (char *) NULL);
            return TCL_ERROR;
          }
                   
          myErr = OSAScriptingComponentName(curOpenComponent,&componentName);
          if (myErr == noErr) {
            myErr = GetCStringFromDescriptor(&componentName,
                  nameStr, 31, &nameLen);
            AEDisposeDesc(&componentName);
          }
          CloseComponent(curOpenComponent);

          if (myErr == noErr) {
            hashEntry = Tcl_CreateHashEntry(LanguagesTable,
                  nameStr, &newPtr);
            Tcl_SetHashValue(hashEntry, (ClientData) foundComp);
          } else {
            Tcl_AppendResult(interp,"Error getting componentName.",
                  (char *) NULL);
            return TCL_ERROR;
          }
                  
          /*
           * Make sure AppleScript is loaded, otherwise we will
           * not bother to make the AppleScript command.
           */
          if (foundComp->componentSubType == kAppleScriptSubtype) {
            appleScriptFlags = foundComp->componentFlags;
            gotAppleScript = true;
          }             
      }
    }                   

    /*
     * Create the OSA command.
     */
      
    if (!GotOneOSALanguage) {
      Tcl_AppendResult(interp,"Could not find any OSA languages",
            (char *) NULL);
      return TCL_ERROR;
    }
      
    /*
     * Create the Component Assoc Data & put it in the interpreter.
     */
      
    ComponentTable = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
      
    if (ComponentTable == NULL) {
      panic("Memory Error Allocating Hash Table");
    }
      
    Tcl_SetAssocData(interp, "OSAScript_CompTable", NULL, ComponentTable);
                  
    Tcl_InitHashTable(ComponentTable, TCL_STRING_KEYS);

    /*
     * The OSA command is not currently supported.     
    Tcl_CreateCommand(interp, "OSA", Tcl_OSACmd, (ClientData) NULL,
          (Tcl_CmdDeleteProc *) NULL);
     */
     
    /* 
     * Open up one AppleScript component, with a default context
     * and tie it to the AppleScript command.
     * If the user just wants single-threaded AppleScript execution
     * this should be enough.
     *
     */
       
    if (gotAppleScript) {
      if (tclOSAMakeNewComponent(interp, "AppleScript",
            "AppleScript English", kAppleScriptSubtype,
            appleScriptFlags) == NULL ) {
          return TCL_ERROR;
      }
    }

    return Tcl_PkgProvide(interp, "OSAConnect", "1.0");
}

/*
 *---------------------------------------------------------------------- 
 *
 * Tcl_OSACmd --
 *
 *    This is the command that provides the interface to the OSA
 *    component manager.  The subcommands are: close: close a component, 
 *    info: get info on components open, and open: get a new connection
 *    with the Scripting Component
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *    Depends on the subcommand, see the user documentation
 *    for more details.
 *
 *----------------------------------------------------------------------
 */
 
int 
Tcl_OSACmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int argc,
    CONST char **argv)
{
    static unsigned short componentCmdIndex = 0;
    char autoName[32];
    char c;
    int length;
    Tcl_HashTable *ComponentTable = NULL;
      

    if (argc == 1) {
      Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
            argv[0], " option\"", (char *) NULL);
      return TCL_ERROR;
    }
      
    c = *argv[1];
    length = strlen(argv[1]);
      
    /*
     * Query out the Component Table, since most of these commands use it...
     */
      
    ComponentTable = (Tcl_HashTable *) Tcl_GetAssocData(interp,
          "OSAScript_CompTable", (Tcl_InterpDeleteProc **) NULL);
      
    if (ComponentTable == NULL) {
      Tcl_AppendResult(interp, "Error, could not get the Component Table",
            " from the Associated data.", (char *) NULL);
      return TCL_ERROR;
    }
      
    if (c == 'c' && strncmp(argv[1],"close",length) == 0) {
      Tcl_HashEntry *hashEntry;
      if (argc != 3) {
          Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
                argv[0], " ",argv[1], " componentName\"",
                (char *) NULL);
          return TCL_ERROR;
      }
            
      if ((hashEntry = Tcl_FindHashEntry(ComponentTable,argv[2])) == NULL) {
          Tcl_AppendResult(interp, "Component \"", argv[2], "\" not found",
                (char *) NULL);
          return TCL_ERROR;
      } else {
          Tcl_DeleteCommand(interp,argv[2]);
          return TCL_OK;
      }
    } else if (c == 'o' && strncmp(argv[1],"open",length) == 0) {
      /*
       * Default language is AppleScript.
       */
      OSType scriptSubtype = kAppleScriptSubtype;
      char *languageName = "AppleScript English";
      char *errMsg = NULL;
      ComponentDescription *theCD;

      argv += 2;
      argc -= 2;
             
      while (argc > 0 ) {
          if (*argv[0] == '-') {
            c = *(argv[0] + 1);
            if (c == 'l' && strcmp(argv[0] + 1, "language") == 0) {
                if (argc == 1) {
                  Tcl_AppendResult(interp,
                        "Error - no language provided for the -language switch",
                        (char *) NULL);
                  return TCL_ERROR;
                } else {
                  Tcl_HashEntry *hashEntry;
                  Tcl_HashSearch search;
                  Boolean gotIt = false;
                  Tcl_HashTable *LanguagesTable;
                                    
                  /*
                   * Look up the language in the languages table
                   * Do a simple strstr match, so AppleScript
                   * will match "AppleScript English"...
                   */
                                    
                  LanguagesTable = Tcl_GetAssocData(interp,
                        "OSAScript_LangTable",
                        (Tcl_InterpDeleteProc **) NULL);
                                          
                  for (hashEntry =
                         Tcl_FirstHashEntry(LanguagesTable, &search);
                       hashEntry != NULL;
                       hashEntry = Tcl_NextHashEntry(&search)) {
                      languageName = Tcl_GetHashKey(LanguagesTable,
                            hashEntry);
                      if (strstr(languageName,argv[1]) != NULL) {
                        theCD = (ComponentDescription *)
                            Tcl_GetHashValue(hashEntry);
                        gotIt = true;
                        break;
                      }
                  }
                  if (!gotIt) {
                      Tcl_AppendResult(interp,
                            "Error, could not find the language \"",
                            argv[1],
                            "\" in the list of known languages.",
                            (char *) NULL);
                      return TCL_ERROR;
                  }
                }
            }
            argc -= 2;
            argv += 2;                    
          } else {
            Tcl_AppendResult(interp, "Expected a flag, but got ",
                  argv[0], (char *) NULL);
            return TCL_ERROR;
          }
      }
                  
      sprintf(autoName, "OSAComponent%-d", componentCmdIndex++);
      if (tclOSAMakeNewComponent(interp, autoName, languageName,
            theCD->componentSubType, theCD->componentFlags) == NULL ) {
          return TCL_ERROR;
      } else {
          Tcl_SetResult(interp,autoName,TCL_VOLATILE);
          return TCL_OK;      
      }
            
    } else if (c == 'i' && strncmp(argv[1],"info",length) == 0) {
      if (argc == 2) {
          Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
                argv[0], " ", argv[1], " what\"",
                (char *) NULL);
          return TCL_ERROR;
      }
                  
      c = *argv[2];
      length = strlen(argv[2]);
            
      if (c == 'c' && strncmp(argv[2], "components", length) == 0) {
          Tcl_DString theResult;
                  
          Tcl_DStringInit(&theResult);
                  
          if (argc == 3) {
            getSortedHashKeys(ComponentTable,(char *) NULL, &theResult);
          } else if (argc == 4) {
            getSortedHashKeys(ComponentTable, argv[3], &theResult);
          } else {
            Tcl_AppendResult(interp, "Error: wrong # of arguments",
                  ", should be \"", argv[0], " ", argv[1], " ",
                  argv[2], " ?pattern?\".", (char *) NULL);
            return TCL_ERROR;
          }
          Tcl_DStringResult(interp, &theResult);
          return TCL_OK;                  
      } else if (c == 'l' && strncmp(argv[2],"languages",length) == 0) {
          Tcl_DString theResult;
          Tcl_HashTable *LanguagesTable;
                  
          Tcl_DStringInit(&theResult);
          LanguagesTable = Tcl_GetAssocData(interp,
                "OSAScript_LangTable", (Tcl_InterpDeleteProc **) NULL);
                                          
          if (argc == 3) {
            getSortedHashKeys(LanguagesTable, (char *) NULL, &theResult);
          } else if (argc == 4) {
            getSortedHashKeys(LanguagesTable, argv[3], &theResult);
          } else {
            Tcl_AppendResult(interp, "Error: wrong # of arguments",
                  ", should be \"", argv[0], " ", argv[1], " ",
                  argv[2], " ?pattern?\".", (char *) NULL);
            return TCL_ERROR;
          }
          Tcl_DStringResult(interp,&theResult);
          return TCL_OK;                  
      } else {
          Tcl_AppendResult(interp, "Unknown option: ", argv[2],
                " for OSA info, should be one of",
                " \"components\" or \"languages\"",
                (char *) NULL);
          return TCL_ERROR;
      }
    } else {
      Tcl_AppendResult(interp, "Unknown option: ", argv[1],
            ", should be one of \"open\", \"close\" or \"info\".",
            (char *) NULL);
      return TCL_ERROR;
    }
    return TCL_OK;
}

/* 
 *----------------------------------------------------------------------
 *
 * Tcl_OSAComponentCmd --
 *
 *    This is the command that provides the interface with an OSA
 *    component.  The sub commands are:
 *    - compile ? -context context? scriptData
 *          compiles the script data, returns the ScriptID
 *    - decompile ? -context context? scriptData
 *          decompiles the script data, source code
 *    - execute ?-context context? scriptData
 *          compiles and runs script data
 *    - info what: get component info
 *    - load ?-flags values? fileName
 *          loads & compiles script data from fileName
 *    - run scriptId ?options?
 *          executes the compiled script 
 *
 * Results:
 *    A standard Tcl result
 *
 * Side Effects:
 *    Depends on the subcommand, see the user documentation
 *    for more details.
 *
 *----------------------------------------------------------------------
 */
 
int 
Tcl_OSAComponentCmd(
    ClientData clientData,
    Tcl_Interp *interp, 
    int argc,
    CONST char **argv)
{
    int length;
    char c;
      
    tclOSAComponent *OSAComponent = (tclOSAComponent *) clientData;
      
    if (argc == 1) {
      Tcl_AppendResult(interp, "wrong # args: should be \"",
            argv[0], " option ?arg ...?\"",
            (char *) NULL);
      return TCL_ERROR;
    }
      
    c = *argv[1];
    length = strlen(argv[1]);
    if (c == 'c' && strncmp(argv[1], "compile", length) == 0) {
      return TclOSACompileCmd(interp, OSAComponent, argc, argv);
    } else if (c == 'l' && strncmp(argv[1], "load", length) == 0) {
      return tclOSALoadCmd(interp, OSAComponent, argc, argv);
    } else if (c == 'e' && strncmp(argv[1], "execute", length) == 0) {
      return tclOSAExecuteCmd(interp, OSAComponent, argc, argv);
    } else if (c == 'i' && strncmp(argv[1], "info", length) == 0) {
      return tclOSAInfoCmd(interp, OSAComponent, argc, argv);
    } else if (c == 'd' && strncmp(argv[1], "decompile", length) == 0) {
      return tclOSADecompileCmd(interp, OSAComponent, argc, argv);
    } else if (c == 'd' && strncmp(argv[1], "delete", length) == 0) {
      return tclOSADeleteCmd(interp, OSAComponent, argc, argv);
    } else if (c == 'r' && strncmp(argv[1], "run", length) == 0) {
      return tclOSARunCmd(interp, OSAComponent, argc, argv);
    } else if (c == 's' && strncmp(argv[1], "store", length) == 0) {
      return tclOSAStoreCmd(interp, OSAComponent, argc, argv);
    } else {
      Tcl_AppendResult(interp,"bad option \"", argv[1],
            "\": should be compile, decompile, delete, ",
             "execute, info, load, run or store",
             (char *) NULL);
      return TCL_ERROR;
    }

    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclOSACompileCmd --
 *
 *    This is the compile subcommand for the component command.
 *
 * Results:
 *    A standard Tcl result
 *
 * Side Effects:
 *    Compiles the script data either into a script or a script
 *    context.  Adds the script to the component's script or context
 *    table.  Sets interp's result to the name of the new script or
 *    context.
 *
 *----------------------------------------------------------------------
 */
 
static int 
TclOSACompileCmd(
    Tcl_Interp *interp,
    tclOSAComponent *OSAComponent,
    int argc,
    CONST char **argv)
{
    int  tclError = TCL_OK;
    int augment = 1;
    int makeContext = 0;
    char c;
    char autoName[16];
    char buffer[32];
    char *resultName;
    Boolean makeNewContext = false;
    Tcl_DString scrptData;
    AEDesc scrptDesc = { typeNull, NULL };
    long modeFlags = kOSAModeCanInteract;
    OSAID resultID = kOSANullScript;
    OSAID contextID = kOSANullScript;
    OSAID parentID = kOSANullScript;
    OSAError osaErr = noErr;
      
    if (!(OSAComponent->componentFlags && kOSASupportsCompiling)) {
      Tcl_AppendResult(interp,
            "OSA component does not support compiling",
            (char *) NULL);
      return TCL_ERROR;
    }

    /* 
     * This signals that we should make up a name, which is the
     * default behavior:
     */
       
    autoName[0] = '\0';
    resultName = NULL;
      
    if (argc == 2) {
      numArgs:
      Tcl_AppendResult(interp,
            "wrong # args: should be \"", argv[0], " ", argv[1],
            " ?options? code\"",(char *) NULL);
      return TCL_ERROR;
    } 

    argv += 2;
    argc -= 2;

    /*
     * Do the argument parsing.
     */
      
    while (argc > 0) {
            
      if (*argv[0] == '-') {
          c = *(argv[0] + 1);
                  
          /*
           * "--" is the only switch that has no value, stops processing
           */
                  
          if (c == '-' && *(argv[0] + 2) == '\0') {
            argv += 1;
            argc--;
            break;
          }
                  
          /*
           * So we can check here a switch with no value.
           */
                  
          if (argc == 1)  {
            Tcl_AppendResult(interp,
                  "no value given for switch: ",
                  argv[0], (char *) NULL);
            return TCL_ERROR;
          }
                  
          if (c == 'c' && strcmp(argv[0] + 1, "context") == 0) {
            if (Tcl_GetBoolean(interp, argv[1], &makeContext) != TCL_OK) {
                return TCL_ERROR;
            }
          } else if (c == 'a' && strcmp(argv[0] + 1, "augment") == 0) {
            /*
             * Augment the current context which implies making a context.
             */

            if (Tcl_GetBoolean(interp, argv[1], &augment) != TCL_OK) {
                return TCL_ERROR;
            }
            makeContext = 1;
          } else if (c == 'n' && strcmp(argv[0] + 1, "name") == 0) {
            strncpy(autoName, argv[1], 15);
            autoName[15] = '\0';
            resultName = autoName;
          } else if (c == 'p' && strcmp(argv[0] + 1,"parent") == 0) {
            /*
             * Since this implies we are compiling into a context, 
             * set makeContext here
             */
            if (tclOSAGetContextID(OSAComponent,
                  argv[1], &parentID) != TCL_OK) {
                Tcl_AppendResult(interp, "context not found \"",
                      argv[1], "\"", (char *) NULL);
                return TCL_ERROR;
            }
            makeContext = 1;
          } else {
            Tcl_AppendResult(interp, "bad option \"", argv[0],
                  "\": should be -augment, -context, -name or -parent",
                   (char *) NULL);
            return TCL_ERROR;
          }
          argv += 2;
          argc -= 2;
                  
      } else {
          break;
      }
    }

    /*
     * Make sure we have some data left...
     */
    if (argc == 0) {
      goto numArgs;
    }
      
    /* 
     * Now if we are making a context, see if it is a new one... 
     * There are three options here:
     * 1) There was no name provided, so we autoName it
     * 2) There was a name, then check and see if it already exists
     *  a) If yes, then makeNewContext is false
     *  b) Otherwise we are making a new context
     */

    if (makeContext) {
      modeFlags |= kOSAModeCompileIntoContext;
      if (resultName == NULL) {
          /*
           * Auto name the new context.
           */
          resultName = autoName;
          resultID = kOSANullScript;
          makeNewContext = true;
      } else if (tclOSAGetContextID(OSAComponent,
            resultName, &resultID) == TCL_OK) {
      } else { 
          makeNewContext = true;
      }
            
      /*
       * Deal with the augment now...
       */
      if (augment && !makeNewContext) {
          modeFlags |= kOSAModeAugmentContext;
      }
    } else if (resultName == NULL) {
      resultName = autoName; /* Auto name the script */
    }
      
    /*
     * Ok, now we have the options, so we can compile the script data.
     */
                  
    if (prepareScriptData(argc, argv, &scrptData, &scrptDesc) == TCL_ERROR) {
      Tcl_DStringResult(interp, &scrptData);
      AEDisposeDesc(&scrptDesc);
      return TCL_ERROR;
    }

    /* 
     * If we want to use a parent context, we have to make the context 
     * by hand. Note, parentID is only specified when you make a new context. 
     */
      
    if (parentID != kOSANullScript && makeNewContext) {
      AEDesc contextDesc = { typeNull, NULL };

      osaErr = OSAMakeContext(OSAComponent->theComponent,
            &contextDesc, parentID, &resultID);
      modeFlags |= kOSAModeAugmentContext;
    }
      
    osaErr = OSACompile(OSAComponent->theComponent, &scrptDesc,
          modeFlags, &resultID);                                              
    if (osaErr == noErr) {
       
      if (makeContext) {
          /* 
           * For the compiled context to be active, you need to run 
           * the code that is in the context.
           */
          OSAID activateID;

          osaErr = OSAExecute(OSAComponent->theComponent, resultID,
                resultID, kOSAModeCanInteract, &activateID);
          OSADispose(OSAComponent->theComponent, activateID);

          if (osaErr == noErr) {
            if (makeNewContext) {
                /*
                 * If we have compiled into a context, 
                 * this is added to the context table 
                 */
                               
                tclOSAAddContext(OSAComponent, resultName, resultID);
            }
                        
            Tcl_SetResult(interp, resultName, TCL_VOLATILE);
            tclError = TCL_OK;
          }
      } else {
          /*
           * For a script, we return the script name.
           */
          tclOSAAddScript(OSAComponent, resultName, modeFlags, resultID);
          Tcl_SetResult(interp, resultName, TCL_VOLATILE);
          tclError = TCL_OK;  
      }
    }
      
    /* 
     * This catches the error either from the original compile, 
     * or from the execute in case makeContext == true
     */
                                          
    if (osaErr == errOSAScriptError) {
      OSADispose(OSAComponent->theComponent, resultID);
      tclOSAASError(interp, OSAComponent->theComponent,
            Tcl_DStringValue(&scrptData));
      tclError = TCL_ERROR;
    } else if (osaErr != noErr)  {
      sprintf(buffer, "Error #%-6ld compiling script", osaErr);
      Tcl_AppendResult(interp, buffer, (char *) NULL);
      tclError = TCL_ERROR;         
    } 

    Tcl_DStringFree(&scrptData);
    AEDisposeDesc(&scrptDesc);
      
    return tclError;
}

/*
 *----------------------------------------------------------------------
 *
 * tclOSADecompileCmd --
 *
 *    This implements the Decompile subcommand of the component command
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side Effects:
 *    Decompiles the script, and sets interp's result to the
 *    decompiled script data.
 *
 *----------------------------------------------------------------------
 */
            
static int 
tclOSADecompileCmd(
    Tcl_Interp * interp,
    tclOSAComponent *OSAComponent,
    int argc, 
    CONST char **argv)
{
    AEDesc resultingSourceData = { typeChar, NULL };
    OSAID scriptID;
    Boolean isContext;
    long result;
    OSErr sysErr = noErr;
            
    if (argc == 2) {
      Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
            argv[0], " ",argv[1], " scriptName \"", (char *) NULL );
      return TCL_ERROR;
    }
      
    if (!(OSAComponent->componentFlags && kOSASupportsGetSource)) {
      Tcl_AppendResult(interp,
            "Error, this component does not support get source",
            (char *) NULL);
      return TCL_ERROR;
    }
      
    if (tclOSAGetScriptID(OSAComponent, argv[2], &scriptID) == TCL_OK) {
      isContext = false;
    } else if (tclOSAGetContextID(OSAComponent, argv[2], &scriptID)
          == TCL_OK ) {
      isContext = true;
    } else { 
      Tcl_AppendResult(interp, "Could not find script \"",
            argv[2], "\"", (char *) NULL);
      return TCL_ERROR;
    }
      
    OSAGetScriptInfo(OSAComponent->theComponent, scriptID,
          kOSACanGetSource, &result);
                                    
    sysErr = OSAGetSource(OSAComponent->theComponent, 
          scriptID, typeChar, &resultingSourceData);
      
    if (sysErr == noErr) {
      Tcl_DString theResult;
      Tcl_DStringInit(&theResult);

      Tcl_DStringAppend(&theResult, *resultingSourceData.dataHandle,
            GetHandleSize(resultingSourceData.dataHandle));
      Tcl_DStringResult(interp, &theResult);
      AEDisposeDesc(&resultingSourceData);
      return TCL_OK;
    } else {
      Tcl_AppendResult(interp, "Error getting source data", (char *) NULL);
      AEDisposeDesc(&resultingSourceData);
      return TCL_ERROR;
    }
}                 
           
/*
 *----------------------------------------------------------------------
 *
 * tclOSADeleteCmd --
 *
 *    This implements the Delete subcommand of the Component command.
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side Effects:
 *    Deletes a script from the script list of the given component.
 *    Removes all references to the script, and frees the memory
 *    associated with it.
 *
 *----------------------------------------------------------------------
 */
 
static int 
tclOSADeleteCmd(
    Tcl_Interp *interp,
    tclOSAComponent *OSAComponent,
    int argc,
    CONST char **argv)
{
    char c,*errMsg = NULL;
    int length;
      
    if (argc < 4) {
      Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
            argv[0], " ", argv[1], " what scriptName", (char *) NULL);
      return TCL_ERROR;
    }
      
    c = *argv[2];
    length = strlen(argv[2]);
    if (c == 'c' && strncmp(argv[2], "context", length) == 0) {
      if (strcmp(argv[3], "global") == 0) {
          Tcl_AppendResult(interp, "You cannot delete the global context",
                (char *) NULL);
          return TCL_ERROR;
      } else if (tclOSADeleteContext(OSAComponent, argv[3]) != TCL_OK) {
          Tcl_AppendResult(interp, "Error deleting script \"", argv[2],
                "\": ", errMsg, (char *) NULL);
          ckfree(errMsg);
          return TCL_ERROR;
      }
    } else if (c == 's' && strncmp(argv[2], "script", length) == 0) {
      if (tclOSADeleteScript(OSAComponent, argv[3], errMsg) != TCL_OK) {
          Tcl_AppendResult(interp, "Error deleting script \"", argv[3],
                "\": ", errMsg, (char *) NULL);
          ckfree(errMsg);
          return TCL_ERROR;
      }
    } else {
      Tcl_AppendResult(interp,"Unknown value ", argv[2],
            " should be one of ",
            "\"context\" or \"script\".",
            (char *) NULL );
      return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------- 
 *
 * tclOSAExecuteCmd --
 *
 *    This implements the execute subcommand of the component command.
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *    Executes the given script data, and sets interp's result to
 *    the OSA component's return value.
 *
 *---------------------------------------------------------------------- 
 */
 
static int 
tclOSAExecuteCmd(
    Tcl_Interp *interp,
    tclOSAComponent *OSAComponent,
    int argc,
    CONST char **argv)
{
    int tclError = TCL_OK, resID = 128;
    char c,buffer[32],
      *contextName = NULL,*scriptName = NULL, *resName = NULL;
    Boolean makeNewContext = false,makeContext = false;
    AEDesc scrptDesc = { typeNull, NULL };
    long modeFlags = kOSAModeCanInteract;
    OSAID resultID = kOSANullScript,
      contextID = kOSANullScript,
      parentID = kOSANullScript;
    Tcl_DString scrptData;
    OSAError osaErr = noErr;
    OSErr  sysErr = noErr;

    if (argc == 2) {
      Tcl_AppendResult(interp,
            "Error, no script data for \"", argv[0],
            " run\"", (char *) NULL);
      return TCL_ERROR;
    } 

    argv += 2;
    argc -= 2;

    /*
     * Set the context to the global context by default.
     * Then parse the argument list for switches
     */
    tclOSAGetContextID(OSAComponent, "global", &contextID);
      
    while (argc > 0) {
            
      if (*argv[0] == '-') {
          c = *(argv[0] + 1);

          /*
           * "--" is the only switch that has no value.
           */
                  
          if (c == '-' && *(argv[0] + 2) == '\0') {
            argv += 1;
            argc--;
            break;
          }
                  
          /*
           * So we can check here for a switch with no value.
           */
                  
          if (argc == 1)  {
            Tcl_AppendResult(interp,
                  "Error, no value given for switch ",
                  argv[0], (char *) NULL);
            return TCL_ERROR;
          }
                  
          if (c == 'c' && strcmp(argv[0] + 1, "context") == 0) {
            if (tclOSAGetContextID(OSAComponent,
                  argv[1], &contextID) == TCL_OK) {
            } else {
                Tcl_AppendResult(interp, "Script context \"",
                      argv[1], "\" not found", (char *) NULL);
                return TCL_ERROR;
            }
          } else { 
            Tcl_AppendResult(interp, "Error, invalid switch ", argv[0],
                  " should be \"-context\"", (char *) NULL);
            return TCL_ERROR;
          }
                  
          argv += 2;
          argc -= 2;
      } else {
          break;
      }
    }
      
    if (argc == 0) {
      Tcl_AppendResult(interp, "Error, no script data", (char *) NULL);
      return TCL_ERROR;
    }
            
    if (prepareScriptData(argc, argv, &scrptData, &scrptDesc) == TCL_ERROR) {
      Tcl_DStringResult(interp, &scrptData);
      AEDisposeDesc(&scrptDesc);
      return TCL_ERROR;
    }
    /*
     * Now try to compile and run, but check to make sure the
     * component supports the one shot deal
     */
    if (OSAComponent->componentFlags && kOSASupportsConvenience) {
      osaErr = OSACompileExecute(OSAComponent->theComponent,
            &scrptDesc, contextID, modeFlags, &resultID);
    } else {
      /*
       * If not, we have to do this ourselves
       */
      if (OSAComponent->componentFlags && kOSASupportsCompiling) {
          OSAID compiledID = kOSANullScript;
          osaErr = OSACompile(OSAComponent->theComponent, &scrptDesc,
                modeFlags, &compiledID);
          if (osaErr == noErr) {
            osaErr = OSAExecute(OSAComponent->theComponent, compiledID,
                  contextID, modeFlags, &resultID);
          }
          OSADispose(OSAComponent->theComponent, compiledID);
      } else {
          /*
           * The scripting component had better be able to load text data...
           */
          OSAID loadedID = kOSANullScript;
                  
          scrptDesc.descriptorType = OSAComponent->languageID;
          osaErr = OSALoad(OSAComponent->theComponent, &scrptDesc,
                modeFlags, &loadedID);
          if (osaErr == noErr) {
            OSAExecute(OSAComponent->theComponent, loadedID,
                  contextID, modeFlags, &resultID);
          }
          OSADispose(OSAComponent->theComponent, loadedID);
      }
    }
    if (osaErr == errOSAScriptError) {
      tclOSAASError(interp, OSAComponent->theComponent,
            Tcl_DStringValue(&scrptData));
      tclError = TCL_ERROR;
    } else if (osaErr != noErr) {
      sprintf(buffer, "Error #%-6ld compiling script", osaErr);
      Tcl_AppendResult(interp, buffer, (char *) NULL);
      tclError = TCL_ERROR;         
    } else  {
      tclOSAResultFromID(interp, OSAComponent->theComponent, resultID);
      osaErr = OSADispose(OSAComponent->theComponent, resultID);
      tclError = TCL_OK;
    } 

    Tcl_DStringFree(&scrptData);
    AEDisposeDesc(&scrptDesc);      

    return tclError;    
} 

/*
 *----------------------------------------------------------------------
 *
 * tclOSAInfoCmd --
 *
 * This implements the Info subcommand of the component command
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *    Info on scripts and contexts.  See the user documentation for details.
 *
 *----------------------------------------------------------------------
 */
static int 
tclOSAInfoCmd(
    Tcl_Interp *interp,
    tclOSAComponent *OSAComponent,
    int argc, 
    CONST char **argv)
{
    char c;
    int length;
    Tcl_DString theResult;
      
    if (argc == 2) {
      Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
            argv[0], " ", argv[1], " what \"", (char *) NULL );
      return TCL_ERROR;
    }
      
    c = *argv[2];
    length = strlen(argv[2]);
    if (c == 's' && strncmp(argv[2], "scripts", length) == 0) {
      Tcl_DStringInit(&theResult);
      if (argc == 3) {
          getSortedHashKeys(&OSAComponent->scriptTable, (char *) NULL,
                &theResult);
      } else if (argc == 4) {
          getSortedHashKeys(&OSAComponent->scriptTable, argv[3], &theResult);
      } else {
          Tcl_AppendResult(interp, "Error: wrong # of arguments,",
                " should be \"", argv[0], " ", argv[1], " ",
                argv[2], " ?pattern?", (char *) NULL);
          return TCL_ERROR;
      }
      Tcl_DStringResult(interp, &theResult);
      return TCL_OK;                
    } else if (c == 'c' && strncmp(argv[2], "contexts", length) == 0) {
      Tcl_DStringInit(&theResult);        
      if (argc == 3) {
          getSortedHashKeys(&OSAComponent->contextTable, (char *) NULL,
               &theResult);
      } else if (argc == 4) {
          getSortedHashKeys(&OSAComponent->contextTable,
                argv[3], &theResult);
      } else {
          Tcl_AppendResult(interp, "Error: wrong # of arguments for ,",
                " should be \"", argv[0], " ", argv[1], " ",
                argv[2], " ?pattern?", (char *) NULL);
          return TCL_ERROR;
      }
      Tcl_DStringResult(interp, &theResult);
      return TCL_OK;                
    } else if (c == 'l' && strncmp(argv[2], "language", length) == 0) {
      Tcl_SetResult(interp, OSAComponent->languageName, TCL_STATIC);
      return TCL_OK;
    } else {
      Tcl_AppendResult(interp, "Unknown argument \"", argv[2],
            "\" for \"", argv[0], " info \", should be one of ",
            "\"scripts\" \"language\", or \"contexts\"",
            (char *) NULL);
      return TCL_ERROR;
    } 
}
           
/*
 *----------------------------------------------------------------------
 *
 * tclOSALoadCmd --
 *
 *    This is the load subcommand for the Component Command
 *
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *    Loads script data from the given file, creates a new context
 *    for it, and sets interp's result to the name of the new context.
 *
 *----------------------------------------------------------------------
 */
 
static int 
tclOSALoadCmd(
    Tcl_Interp *interp,
    tclOSAComponent *OSAComponent,
    int argc,
    CONST char **argv)
{
    int tclError = TCL_OK, resID = 128;
    char c, autoName[24],
      *contextName = NULL, *scriptName = NULL;
    CONST char *resName = NULL;
    Boolean makeNewContext = false, makeContext = false;
    AEDesc scrptDesc = { typeNull, NULL };
    long modeFlags = kOSAModeCanInteract;
    OSAID resultID = kOSANullScript,
      contextID = kOSANullScript,
      parentID = kOSANullScript;
    OSAError osaErr = noErr;
    OSErr  sysErr = noErr;
    long scptInfo;
      
    autoName[0] = '\0';
    scriptName = autoName;
    contextName = autoName;
      
    if (argc == 2) {
      Tcl_AppendResult(interp,
            "Error, no data for \"", argv[0], " ", argv[1],
            "\"", (char *) NULL);
      return TCL_ERROR;
    } 

    argv += 2;
    argc -= 2;

    /*
     * Do the argument parsing.
     */
      
    while (argc > 0) {
            
      if (*argv[0] == '-') {
          c = *(argv[0] + 1);
                  
          /*
           * "--" is the only switch that has no value.
           */
                  
          if (c == '-' && *(argv[0] + 2) == '\0') {
            argv += 1;
            argc--;
            break;
          }
                  
          /*
           * So we can check here a switch with no value.
           */
                  
          if (argc == 1)  {
            Tcl_AppendResult(interp, "Error, no value given for switch ",
                  argv[0], (char *) NULL);
            return TCL_ERROR;
          }
                  
          if (c == 'r' && strcmp(argv[0] + 1, "rsrcname") == 0) {
            resName = argv[1];
          } else if (c == 'r' && strcmp(argv[0] + 1, "rsrcid") == 0) {
            if (Tcl_GetInt(interp, argv[1], &resID) != TCL_OK) {
                Tcl_AppendResult(interp,
                      "Error getting resource ID", (char *) NULL);
                return TCL_ERROR;
            }
          } else {
            Tcl_AppendResult(interp, "Error, invalid switch ", argv[0],
                  " should be \"--\", \"-rsrcname\" or \"-rsrcid\"",
                  (char *) NULL);
            return TCL_ERROR;
          }
                  
          argv += 2;
          argc -= 2;
      } else {
          break;
      }
    }
    /*
     * Ok, now we have the options, so we can load the resource,
     */
    if (argc == 0) {
      Tcl_AppendResult(interp, "Error, no filename given", (char *) NULL);
      return TCL_ERROR;
    }
      
    if (tclOSALoad(interp, OSAComponent, resName, resID,
          argv[0], &resultID) != TCL_OK) {
      Tcl_AppendResult(interp, "Error in load command", (char *) NULL);
      return TCL_ERROR;
    }
       
    /*
     *  Now find out whether we have a script, or a script context.
     */
       
    OSAGetScriptInfo(OSAComponent->theComponent, resultID,
          kOSAScriptIsTypeScriptContext, &scptInfo);
    
    if (scptInfo) {
      autoName[0] = '\0';
      tclOSAAddContext(OSAComponent, autoName, resultID);
            
      Tcl_SetResult(interp, autoName, TCL_VOLATILE);
    } else {
      /*
       * For a script, we return the script name
       */
      autoName[0] = '\0';
      tclOSAAddScript(OSAComponent, autoName, kOSAModeCanInteract, resultID);
      Tcl_SetResult(interp, autoName, TCL_VOLATILE);
    }             
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * tclOSARunCmd --
 *
 *    This implements the run subcommand of the component command
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *    Runs the given compiled script, and returns the OSA
 *    component's result.
 *
 *----------------------------------------------------------------------
 */
 
static int 
tclOSARunCmd(
    Tcl_Interp *interp,
    tclOSAComponent *OSAComponent,
    int argc,
    CONST char **argv)
{
    int tclError = TCL_OK,
      resID = 128;
    char c, *contextName = NULL,
      *scriptName = NULL, 
      *resName = NULL;
    AEDesc scrptDesc = { typeNull, NULL };
    long modeFlags = kOSAModeCanInteract;
    OSAID resultID = kOSANullScript,
      contextID = kOSANullScript,
      parentID = kOSANullScript;
    OSAError osaErr = noErr;
    OSErr sysErr = noErr;
    CONST char *componentName = argv[0];
    OSAID scriptID;
      
    if (argc == 2) {
      Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
            argv[0], " ", argv[1], " scriptName", (char *) NULL);
      return TCL_ERROR;
    }
      
    /*
     * Set the context to the global context for this component,
     * as a default
     */
    if (tclOSAGetContextID(OSAComponent, "global", &contextID) != TCL_OK) {
      Tcl_AppendResult(interp,
            "Could not find the global context for component ",
            OSAComponent->theName, (char *) NULL );
      return TCL_ERROR;
    }

    /*
     * Now parse the argument list for switches
     */
    argv += 2;
    argc -= 2;
      
    while (argc > 0) {
      if (*argv[0] == '-') {
          c = *(argv[0] + 1);
          /*
           * "--" is the only switch that has no value
           */
          if (c == '-' && *(argv[0] + 2) == '\0') {
            argv += 1;
            argc--;
            break;
          }
                  
          /*
           * So we can check here for a switch with no value.
           */
          if (argc == 1)  {
            Tcl_AppendResult(interp, "Error, no value given for switch ",
                  argv[0], (char *) NULL);
            return TCL_ERROR;
          }
                  
          if (c == 'c' && strcmp(argv[0] + 1, "context") == 0) {
            if (argc == 1) {
                Tcl_AppendResult(interp,
                      "Error - no context provided for the -context switch",
                      (char *) NULL);
                return TCL_ERROR;
            } else if (tclOSAGetContextID(OSAComponent,
                  argv[1], &contextID) == TCL_OK) {
            } else {
                Tcl_AppendResult(interp, "Script context \"", argv[1],
                      "\" not found", (char *) NULL);
                return TCL_ERROR;
            } 
          } else {
            Tcl_AppendResult(interp, "Error, invalid switch ", argv[0],
                  " for ", componentName,
                  " should be \"-context\"", (char *) NULL);
            return TCL_ERROR;
          }
          argv += 2;
          argc -= 2;
      } else {
          break;
      }
    }
      
    if (tclOSAGetScriptID(OSAComponent, argv[0], &scriptID) != TCL_OK) {
      if (tclOSAGetContextID(OSAComponent, argv[0], &scriptID) != TCL_OK) {
          Tcl_AppendResult(interp, "Could not find script \"",
                argv[2], "\"", (char *) NULL);
          return TCL_ERROR;
      }
    }
      
    sysErr = OSAExecute(OSAComponent->theComponent,
          scriptID, contextID, modeFlags, &resultID);
                                          
    if (sysErr == errOSAScriptError) {
      tclOSAASError(interp, OSAComponent->theComponent, (char *) NULL);
      tclError = TCL_ERROR;
    } else if (sysErr != noErr) {
      char buffer[32];
      sprintf(buffer, "Error #%6.6d encountered in run", sysErr);
      Tcl_SetResult(interp, buffer, TCL_VOLATILE);
      tclError = TCL_ERROR;
    } else {
      tclOSAResultFromID(interp, OSAComponent->theComponent, resultID );
    }
    OSADispose(OSAComponent->theComponent, resultID);

    return tclError;          
}

/*
 *----------------------------------------------------------------------
 *
 * tclOSAStoreCmd --
 *
 *    This implements the store subcommand of the component command
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *    Runs the given compiled script, and returns the OSA
 *    component's result.
 *
 *----------------------------------------------------------------------
 */
 
static int 
tclOSAStoreCmd(
    Tcl_Interp *interp,
    tclOSAComponent *OSAComponent,
    int argc,
    CONST char **argv)
{
    int tclError = TCL_OK, resID = 128;
    char c, *contextName = NULL, *scriptName = NULL;
    CONST char *resName = NULL;
    Boolean makeNewContext = false, makeContext = false;
    AEDesc scrptDesc = { typeNull, NULL };
    long modeFlags = kOSAModeCanInteract;
    OSAID resultID = kOSANullScript,
      contextID = kOSANullScript,
      parentID = kOSANullScript;
    OSAError osaErr = noErr;
    OSErr  sysErr = noErr;
            
    if (argc == 2) {
      Tcl_AppendResult(interp, "Error, no data for \"", argv[0],
            " ",argv[1], "\"", (char *) NULL);
      return TCL_ERROR;
    } 

    argv += 2;
    argc -= 2;

    /*
     * Do the argument parsing
     */
      
    while (argc > 0) {
      if (*argv[0] == '-') {
          c = *(argv[0] + 1);
                  
          /*
           * "--" is the only switch that has no value
           */
          if (c == '-' && *(argv[0] + 2) == '\0') {
            argv += 1;
            argc--;
            break;
          }
                  
          /*
           * So we can check here a switch with no value.
           */
          if (argc == 1)  {
            Tcl_AppendResult(interp,
                  "Error, no value given for switch ",
                  argv[0], (char *) NULL);
            return TCL_ERROR;
          }
                  
          if (c == 'r' && strcmp(argv[0] + 1, "rsrcname") == 0) {
            resName = argv[1];
          } else if (c == 'r' && strcmp(argv[0] + 1, "rsrcid") == 0) {
            if (Tcl_GetInt(interp, argv[1], &resID) != TCL_OK) {
                Tcl_AppendResult(interp,
                      "Error getting resource ID", (char *) NULL);
                return TCL_ERROR;
            }
          } else {
            Tcl_AppendResult(interp, "Error, invalid switch ", argv[0],
                  " should be \"--\", \"-rsrcname\" or \"-rsrcid\"",
                  (char *) NULL);
            return TCL_ERROR;
          }
                  
          argv += 2;
          argc -= 2;
      } else {
          break;
      }
    }
    /*
     * Ok, now we have the options, so we can load the resource,
     */
    if (argc != 2) {
      Tcl_AppendResult(interp, "Error, wrong # of arguments, should be ",
            argv[0], " ", argv[1], "?option flag? scriptName fileName",
            (char *) NULL);
      return TCL_ERROR;
    }
      
    if (tclOSAStore(interp, OSAComponent, resName, resID,
          argv[0], argv[1]) != TCL_OK) {
      Tcl_AppendResult(interp, "Error in load command", (char *) NULL);
      return TCL_ERROR;
    } else {
      Tcl_ResetResult(interp);
      tclError = TCL_OK;
    }
    
    return tclError;
}

/*
 *----------------------------------------------------------------------
 *
 * tclOSAMakeNewComponent --
 *
 *    Makes a command cmdName to represent a new connection to the
 *    OSA component with componentSubType scriptSubtype.
 *
 * Results: 
 *    Returns the tclOSAComponent structure for the connection.
 *
 * Side Effects: 
 *    Adds a new element to the component table.  If there is an
 *    error, then the result of the Tcl interpreter interp is set
 *    to an appropriate error message.
 *
 *----------------------------------------------------------------------
 */
 
tclOSAComponent *
tclOSAMakeNewComponent(
    Tcl_Interp *interp,
    char *cmdName,
    char *languageName, 
    OSType scriptSubtype,
    long componentFlags) 
{
    char buffer[32];
    AEDesc resultingName = {typeNull, NULL};
    AEDesc nullDesc = {typeNull, NULL };
    OSAID globalContext;
    char global[] = "global";
    int nbytes;
    ComponentDescription requestedComponent = {
      kOSAComponentType,
      (OSType) 0,
      (OSType) 0,
      (long int) 0,
      (long int) 0
    };
    Tcl_HashTable *ComponentTable;
    Component foundComponent = NULL;
    OSAActiveUPP myActiveProcUPP;
                  
    tclOSAComponent *newComponent;
    Tcl_HashEntry *hashEntry;
    int newPtr;
      
    requestedComponent.componentSubType = scriptSubtype;
    nbytes = sizeof(tclOSAComponent);
    newComponent = (tclOSAComponent *) ckalloc(sizeof(tclOSAComponent));
    if (newComponent == NULL) {
      goto CleanUp;
    }
      
    foundComponent = FindNextComponent(0, &requestedComponent);
    if (foundComponent == 0) {
      Tcl_AppendResult(interp,
            "Could not find component of requested type", (char *) NULL);
      goto CleanUp;
    } 
      
    newComponent->theComponent = OpenComponent(foundComponent); 
      
    if (newComponent->theComponent == NULL) {
      Tcl_AppendResult(interp,
            "Could not open component of the requested type",
            (char *) NULL);
      goto CleanUp;
    }
                                          
    newComponent->languageName = (char *) ckalloc(strlen(languageName) + 1);
    strcpy(newComponent->languageName,languageName);
      
    newComponent->componentFlags = componentFlags;
      
    newComponent->theInterp = interp;
      
    Tcl_InitHashTable(&newComponent->contextTable, TCL_STRING_KEYS);
    Tcl_InitHashTable(&newComponent->scriptTable, TCL_STRING_KEYS);
            
    if (tclOSAMakeContext(newComponent, global, &globalContext) != TCL_OK) {
      sprintf(buffer, "%-6.6ld", globalContext);
      Tcl_AppendResult(interp, "Error ", buffer, " making ", global,
            " context.", (char *) NULL);
      goto CleanUp;
    }
    
    newComponent->languageID = scriptSubtype;
      
    newComponent->theName = (char *) ckalloc(strlen(cmdName) + 1 );
    strcpy(newComponent->theName, cmdName);

    Tcl_CreateCommand(interp, newComponent->theName, Tcl_OSAComponentCmd,
          (ClientData) newComponent, tclOSAClose);
                              
    /*
     * Register the new component with the component table
     */ 

    ComponentTable = (Tcl_HashTable *) Tcl_GetAssocData(interp,
          "OSAScript_CompTable", (Tcl_InterpDeleteProc **) NULL);
      
    if (ComponentTable == NULL) {
      Tcl_AppendResult(interp, "Error, could not get the Component Table",
            " from the Associated data.", (char *) NULL);
      return (tclOSAComponent *) NULL;
    }
      
    hashEntry = Tcl_CreateHashEntry(ComponentTable,
          newComponent->theName, &newPtr);      
    Tcl_SetHashValue(hashEntry, (ClientData) newComponent);

    /*
     * Set the active proc to call Tcl_DoOneEvent() while idle
     */
    if (OSAGetActiveProc(newComponent->theComponent,
          &newComponent->defActiveProc, &newComponent->defRefCon) != noErr ) {
      /* TODO -- clean up here... */
    }

    myActiveProcUPP = NewOSAActiveUPP(TclOSAActiveProc);
    OSASetActiveProc(newComponent->theComponent,
          myActiveProcUPP, (long) newComponent);
    return newComponent;
      
    CleanUp:
      
    ckfree((char *) newComponent);
    return (tclOSAComponent *) NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * tclOSAClose --
 *
 *    This procedure closes the connection to an OSA component, and 
 *    deletes all the script and context data associated with it.
 *    It is the command deletion callback for the component's command.
 *
 * Results:
 *    None
 *
 * Side effects:
 *    Closes the connection, and releases all the script data.
 *
 *----------------------------------------------------------------------
 */

void 
tclOSAClose(
    ClientData clientData) 
{
    tclOSAComponent *theComponent = (tclOSAComponent *) clientData;
    Tcl_HashEntry *hashEntry;
    Tcl_HashSearch search;
    tclOSAScript *theScript;
    Tcl_HashTable *ComponentTable;
      
    /* 
     * Delete the context and script tables 
     * the memory for the language name, and
     * the hash entry.
     */
      
    for (hashEntry = Tcl_FirstHashEntry(&theComponent->scriptTable, &search);
       hashEntry != NULL;
       hashEntry = Tcl_NextHashEntry(&search)) {

      theScript = (tclOSAScript *) Tcl_GetHashValue(hashEntry);
      OSADispose(theComponent->theComponent, theScript->scriptID);      
      ckfree((char *) theScript);
      Tcl_DeleteHashEntry(hashEntry);
    }
      
    for (hashEntry = Tcl_FirstHashEntry(&theComponent->contextTable, &search);
       hashEntry != NULL;
       hashEntry = Tcl_NextHashEntry(&search)) {

      Tcl_DeleteHashEntry(hashEntry);
    }
      
    ckfree(theComponent->languageName);
    ckfree(theComponent->theName);
      
    /*
     * Finally close the component
     */
      
    CloseComponent(theComponent->theComponent);
      
    ComponentTable = (Tcl_HashTable *)
      Tcl_GetAssocData(theComponent->theInterp,
            "OSAScript_CompTable", (Tcl_InterpDeleteProc **) NULL);
      
    if (ComponentTable == NULL) {
      panic("Error, could not get the Component Table from the Associated data.");
    }
      
    hashEntry = Tcl_FindHashEntry(ComponentTable, theComponent->theName);
    if (hashEntry != NULL) {
      Tcl_DeleteHashEntry(hashEntry);
    }
    
    ckfree((char *) theComponent);
}

/*
 *----------------------------------------------------------------------
 *
 * tclOSAGetContextID  --
 *
 *    This returns the context ID, given the component name.
 *
 * Results:
 *    A context ID
 *
 * Side effects:
 *    None
 *
 *----------------------------------------------------------------------
 */

static int 
tclOSAGetContextID(
    tclOSAComponent *theComponent, 
    CONST char *contextName, 
    OSAID *theContext)
{
    Tcl_HashEntry *hashEntry;
    tclOSAContext *contextStruct;
      
    if ((hashEntry = Tcl_FindHashEntry(&theComponent->contextTable,
          contextName)) == NULL ) {             
      return TCL_ERROR;
    } else {
      contextStruct = (tclOSAContext *) Tcl_GetHashValue(hashEntry);
      *theContext = contextStruct->contextID;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * tclOSAAddContext  --
 *
 *    This adds the context ID, with the name contextName.  If the
 *    name is passed in as a NULL string, space is malloc'ed for the
 *    string and a new name is made up, if the string is empty, you
 *    must have allocated enough space ( 24 characters is fine) for
 *    the name, which is made up and passed out.
 *
 * Results:
 *    Nothing
 *
 * Side effects:
 *    Adds the script context to the component's context table.
 *
 *----------------------------------------------------------------------
 */

static void 
tclOSAAddContext(
    tclOSAComponent *theComponent, 
    char *contextName,
    const OSAID theContext)
{
    static unsigned short contextIndex = 0;
    tclOSAContext *contextStruct;
    Tcl_HashEntry *hashEntry;
    int newPtr;

    if (contextName == NULL) {
      contextName = ckalloc(16 + TCL_INTEGER_SPACE);
      sprintf(contextName, "OSAContext%d", contextIndex++);
    } else if (*contextName == '\0') {
      sprintf(contextName, "OSAContext%d", contextIndex++);
    }
      
    hashEntry = Tcl_CreateHashEntry(&theComponent->contextTable,
          contextName, &newPtr);    

    contextStruct = (tclOSAContext *) ckalloc(sizeof(tclOSAContext));
    contextStruct->contextID = theContext;
    Tcl_SetHashValue(hashEntry,(ClientData) contextStruct);
}

/*
 *----------------------------------------------------------------------
 *
 * tclOSADeleteContext  --
 *
 *    This deletes the context struct, with the name contextName.  
 *
 * Results:
 *    A normal Tcl result
 *
 * Side effects:
 *    Removes the script context to the component's context table,
 *    and deletes the data associated with it.
 *
 *----------------------------------------------------------------------
 */

static int 
tclOSADeleteContext(
    tclOSAComponent *theComponent,
    CONST char *contextName) 
{
    Tcl_HashEntry *hashEntry;
    tclOSAContext *contextStruct;
      
    hashEntry = Tcl_FindHashEntry(&theComponent->contextTable, contextName);
    if (hashEntry == NULL) {
      return TCL_ERROR;
    } 
    /*
     * Dispose of the script context data
     */
    contextStruct = (tclOSAContext *) Tcl_GetHashValue(hashEntry);
    OSADispose(theComponent->theComponent,contextStruct->contextID);
    /*
     * Then the hash entry
     */
    ckfree((char *) contextStruct);
    Tcl_DeleteHashEntry(hashEntry);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * tclOSAMakeContext  --
 *
 *    This makes the context with name contextName, and returns the ID.
 *
 * Results:
 *    A standard Tcl result
 *
 * Side effects:
 *    Makes a new context, adds it to the context table, and returns 
 *    the new contextID in the variable theContext.
 *
 *----------------------------------------------------------------------
 */

static int 
tclOSAMakeContext(
    tclOSAComponent *theComponent, 
    CONST char *contextName,
    OSAID *theContext)
{
    AEDesc contextNameDesc = {typeNull, NULL};
    OSAError osaErr = noErr;

    AECreateDesc(typeChar, contextName, strlen(contextName), &contextNameDesc);
    osaErr = OSAMakeContext(theComponent->theComponent, &contextNameDesc,
          kOSANullScript, theContext);
                                                
    AEDisposeDesc(&contextNameDesc);
      
    if (osaErr == noErr) {
      char name[24];
      strncpy(name, contextName, 23);
      name[23] = '\0';
      tclOSAAddContext(theComponent, name, *theContext);
    } else {
      *theContext = (OSAID) osaErr;
      return TCL_ERROR;
    }
      
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * tclOSAStore --
 *
 *    This stores a script resource from the file named in fileName.
 *
 *    Most of this routine is caged from the Tcl Source, from the
 *    Tcl_MacSourceCmd routine.  This is good, since it ensures this
 *    follows the same convention for looking up files as Tcl.
 *
 * Returns
 *    A standard Tcl result.
 *
 * Side Effects:
 *    The given script data is stored in the file fileName.
 *
 *----------------------------------------------------------------------
 */
 
int
tclOSAStore(
    Tcl_Interp *interp,
    tclOSAComponent *theComponent,
    CONST char *resourceName,
    int resourceNumber, 
    CONST char *scriptName,
    CONST char *fileName)
{
    Handle resHandle;
    Str255 rezName;
    int result = TCL_OK;
    short saveRef, fileRef = -1;
    char idStr[16 + TCL_INTEGER_SPACE];
    FSSpec fileSpec;
    Tcl_DString ds, buffer;
    CONST char *nativeName;
    OSErr myErr = noErr;
    OSAID scriptID;
    Size scriptSize;
    AEDesc scriptData;

    /*
     * First extract the script data
     */
      
    if (tclOSAGetScriptID(theComponent, scriptName, &scriptID) != TCL_OK ) {
      if (tclOSAGetContextID(theComponent, scriptName, &scriptID)
            != TCL_OK) {
          Tcl_AppendResult(interp, "Error getting script ",
                scriptName, (char *) NULL);
          return TCL_ERROR;
      }
    }
      
    myErr = OSAStore(theComponent->theComponent, scriptID,
          typeOSAGenericStorage, kOSAModeNull, &scriptData);
    if (myErr != noErr) {
      sprintf(idStr, "%d", myErr);
      Tcl_AppendResult(interp, "Error #", idStr,
            " storing script ", scriptName, (char *) NULL);
      return TCL_ERROR;
    }

    /*
     * Now try to open the output file
     */
      
    saveRef = CurResFile();
      
    if (fileName != NULL) {
      OSErr err;
            
      if (Tcl_TranslateFileName(interp, fileName, &buffer) == NULL) {
          return TCL_ERROR;
      }
      nativeName = Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&buffer), 
          Tcl_DStringLength(&buffer), &ds);
      err = FSpLocationFromPath(strlen(nativeName), nativeName, &fileSpec);
            
      Tcl_DStringFree(&ds);
      Tcl_DStringFree(&buffer);
      if ((err != noErr) && (err != fnfErr)) {
          Tcl_AppendResult(interp,
                "Error getting a location for the file: \"", 
                fileName, "\".", NULL);
          return TCL_ERROR;
      }
            
      FSpCreateResFileCompatTcl(&fileSpec,
            'WiSH', 'osas', smSystemScript);    
      myErr = ResError();
      
      if ((myErr != noErr) && (myErr != dupFNErr)) {
          sprintf(idStr, "%d", myErr);
          Tcl_AppendResult(interp, "Error #", idStr,
                " creating new resource file ", fileName, (char *) NULL);
          result = TCL_ERROR;
          goto rezEvalCleanUp;
      }
            
      fileRef = FSpOpenResFileCompatTcl(&fileSpec, fsRdWrPerm);
      if (fileRef == -1) {
          Tcl_AppendResult(interp, "Error reading the file: \"", 
                fileName, "\".", NULL);
          result = TCL_ERROR;
          goto rezEvalCleanUp;
      }
      UseResFile(fileRef);
    } else {
      /*
       * The default behavior will search through all open resource files.
       * This may not be the behavior you desire.  If you want the behavior
       * of this call to *only* search the application resource fork, you
       * must call UseResFile at this point to set it to the application
       * file.  This means you must have already obtained the application's 
       * fileRef when the application started up.
       */
    }
      
    /*
     * Load the resource by name 
     */
    if (resourceName != NULL) {
      strcpy((char *) rezName + 1, resourceName);
      rezName[0] = strlen(resourceName);
      resHandle = Get1NamedResource('scpt', rezName);
      myErr = ResError();
      if (resHandle == NULL) {
          /*
           * These signify either the resource or the resource
           * type were not found
           */
          if (myErr == resNotFound || myErr == noErr) {
            short uniqueID;
            while ((uniqueID = Unique1ID('scpt') ) < 128) {}
            AddResource(scriptData.dataHandle, 'scpt', uniqueID, rezName);
            WriteResource(resHandle);
            result = TCL_OK;
            goto rezEvalCleanUp;
          } else {
            /*
             * This means there was some other error, for now
             * I just bag out.
             */
            sprintf(idStr, "%d", myErr);
            Tcl_AppendResult(interp, "Error #", idStr,
                  " opening scpt resource named ", resourceName,
                  " in file ", fileName, (char *) NULL);
            result = TCL_ERROR;
            goto rezEvalCleanUp;
          }
      }
      /*
       * Or ID
       */ 
    } else {
      resHandle = Get1Resource('scpt', resourceNumber);
      rezName[0] = 0;
      rezName[1] = '\0';
      myErr = ResError();
      if (resHandle == NULL) {
          /*
           * These signify either the resource or the resource
           * type were not found
           */
          if (myErr == resNotFound || myErr == noErr) {
            AddResource(scriptData.dataHandle, 'scpt',
                  resourceNumber, rezName);
            WriteResource(resHandle);
            result = TCL_OK;
            goto rezEvalCleanUp;
          } else {
            /*
             * This means there was some other error, for now
             * I just bag out */
            sprintf(idStr, "%d", myErr);
            Tcl_AppendResult(interp, "Error #", idStr,
                  " opening scpt resource named ", resourceName,
                  " in file ", fileName,(char *) NULL);
            result = TCL_ERROR;
            goto rezEvalCleanUp;
          }
      } 
    }
      
    /* 
     * We get to here if the resource exists 
     * we just copy into it... 
     */
       
    scriptSize = GetHandleSize(scriptData.dataHandle);
    SetHandleSize(resHandle, scriptSize);
    HLock(scriptData.dataHandle);
    HLock(resHandle);
    BlockMove(*scriptData.dataHandle, *resHandle,scriptSize);
    HUnlock(scriptData.dataHandle);
    HUnlock(resHandle);
    ChangedResource(resHandle);
    WriteResource(resHandle);
    result = TCL_OK;
    goto rezEvalCleanUp;
                  
    rezEvalError:
    sprintf(idStr, "ID=%d", resourceNumber);
    Tcl_AppendResult(interp, "The resource \"",
          (resourceName != NULL ? resourceName : idStr),
          "\" could not be loaded from ",
          (fileName != NULL ? fileName : "application"),
          ".", NULL);

    rezEvalCleanUp:
    if (fileRef != -1) {
      CloseResFile(fileRef);
    }

    UseResFile(saveRef);
      
    return result;
}

/*----------------------------------------------------------------------
 *
 * tclOSALoad --
 *
 *    This loads a script resource from the file named in fileName.
 *    Most of this routine is caged from the Tcl Source, from the
 *    Tcl_MacSourceCmd routine.  This is good, since it ensures this
 *    follows the same convention for looking up files as Tcl.
 *
 * Returns
 *    A standard Tcl result.
 *
 * Side Effects:
 *    A new script element is created from the data in the file.
 *    The script ID is passed out in the variable resultID.
 *
 *----------------------------------------------------------------------
 */
 
int
tclOSALoad(
    Tcl_Interp *interp,
    tclOSAComponent *theComponent,
    CONST char *resourceName,
    int resourceNumber, 
    CONST char *fileName,
    OSAID *resultID)
{
    Handle sourceData;
    Str255 rezName;
    int result = TCL_OK;
    short saveRef, fileRef = -1;
    char idStr[16 + TCL_INTEGER_SPACE];
    FSSpec fileSpec;
    Tcl_DString ds, buffer;
    CONST char *nativeName;

    saveRef = CurResFile();
      
    if (fileName != NULL) {
      OSErr err;
            
      if (Tcl_TranslateFileName(interp, fileName, &buffer) == NULL) {
          return TCL_ERROR;
      }
      nativeName = Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&buffer), 
          Tcl_DStringLength(&buffer), &ds);
      err = FSpLocationFromPath(strlen(nativeName), nativeName, &fileSpec);
      Tcl_DStringFree(&ds);
      Tcl_DStringFree(&buffer);
      if (err != noErr) {
          Tcl_AppendResult(interp, "Error finding the file: \"", 
                fileName, "\".", NULL);
          return TCL_ERROR;
      }
                  
      fileRef = FSpOpenResFileCompatTcl(&fileSpec, fsRdPerm);
      if (fileRef == -1) {
          Tcl_AppendResult(interp, "Error reading the file: \"", 
                fileName, "\".", NULL);
          return TCL_ERROR;
      }
      UseResFile(fileRef);
    } else {
      /*
       * The default behavior will search through all open resource files.
       * This may not be the behavior you desire.  If you want the behavior
       * of this call to *only* search the application resource fork, you
       * must call UseResFile at this point to set it to the application
       * file.  This means you must have already obtained the application's 
       * fileRef when the application started up.
       */
    }
      
    /*
     * Load the resource by name or ID
     */
    if (resourceName != NULL) {
      strcpy((char *) rezName + 1, resourceName);
      rezName[0] = strlen(resourceName);
      sourceData = GetNamedResource('scpt', rezName);
    } else {
      sourceData = GetResource('scpt', (short) resourceNumber);
    }
      
    if (sourceData == NULL) {
      result = TCL_ERROR;
    } else {
      AEDesc scriptDesc;
      OSAError osaErr;
            
      scriptDesc.descriptorType = typeOSAGenericStorage;
      scriptDesc.dataHandle = sourceData;
            
      osaErr = OSALoad(theComponent->theComponent, &scriptDesc,
            kOSAModeNull, resultID);
            
      ReleaseResource(sourceData);
            
      if (osaErr != noErr) {
          result = TCL_ERROR;
          goto rezEvalError;
      }
                  
      goto rezEvalCleanUp;
    }
      
    rezEvalError:
    sprintf(idStr, "ID=%d", resourceNumber);
    Tcl_AppendResult(interp, "The resource \"",
          (resourceName != NULL ? resourceName : idStr),
          "\" could not be loaded from ",
          (fileName != NULL ? fileName : "application"),
          ".", NULL);

    rezEvalCleanUp:
    if (fileRef != -1) {
      CloseResFile(fileRef);
    }

    UseResFile(saveRef);
      
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * tclOSAGetScriptID  --
 *
 *    This returns the context ID, gibven the component name.
 *
 * Results:
 *    A standard Tcl result
 *
 * Side effects:
 *    Passes out the script ID in the variable scriptID.
 *
 *----------------------------------------------------------------------
 */

static int 
tclOSAGetScriptID(
    tclOSAComponent *theComponent,
    CONST char *scriptName,
    OSAID *scriptID) 
{
    tclOSAScript *theScript;
      
    theScript = tclOSAGetScript(theComponent, scriptName);
    if (theScript == NULL) {
      return TCL_ERROR;
    }
      
    *scriptID = theScript->scriptID;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * tclOSAAddScript  --
 *
 *    This adds a script to theComponent's script table, with the
 *    given name & ID.
 *
 * Results:
 *    A standard Tcl result
 *
 * Side effects:
 *    Adds an element to the component's script table.
 *
 *----------------------------------------------------------------------
 */

static int 
tclOSAAddScript(
    tclOSAComponent *theComponent,
    char *scriptName,
    long modeFlags,
    OSAID scriptID) 
{
    Tcl_HashEntry *hashEntry;
    int newPtr;
    static int scriptIndex = 0;
    tclOSAScript *theScript;
      
    if (*scriptName == '\0') {
      sprintf(scriptName, "OSAScript%d", scriptIndex++);
    }
      
    hashEntry = Tcl_CreateHashEntry(&theComponent->scriptTable,
          scriptName, &newPtr);
    if (newPtr == 0) {
      theScript = (tclOSAScript *) Tcl_GetHashValue(hashEntry);
      OSADispose(theComponent->theComponent, theScript->scriptID);
    } else {            
      theScript = (tclOSAScript *) ckalloc(sizeof(tclOSAScript));
      if (theScript == NULL) {
          return TCL_ERROR;
      }
    }
            
    theScript->scriptID = scriptID;
    theScript->languageID = theComponent->languageID;
    theScript->modeFlags = modeFlags;
      
    Tcl_SetHashValue(hashEntry,(ClientData) theScript);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * tclOSAGetScriptID  --
 *
 *    This returns the script structure, given the component and script name.
 *
 * Results:
 *    A pointer to the script structure.
 *
 * Side effects:
 *    None
 *
 *----------------------------------------------------------------------
 */
 
static tclOSAScript *
tclOSAGetScript(
    tclOSAComponent *theComponent,
    CONST char *scriptName)
{
    Tcl_HashEntry *hashEntry;
      
    hashEntry = Tcl_FindHashEntry(&theComponent->scriptTable, scriptName);
    if (hashEntry == NULL) {
      return NULL;
    }
      
    return (tclOSAScript *) Tcl_GetHashValue(hashEntry);
}

/*
 *----------------------------------------------------------------------
 *
 * tclOSADeleteScript  --
 *
 *    This deletes the script given by scriptName.
 *
 * Results:
 *    A standard Tcl result
 *
 * Side effects:
 *    Deletes the script from the script table, and frees up the
 *    resources associated with it.  If there is an error, then
 *    space for the error message is malloc'ed, and passed out in
 *    the variable errMsg.
 *
 *----------------------------------------------------------------------
 */

static int
tclOSADeleteScript(
    tclOSAComponent *theComponent,
    CONST char *scriptName,
    char *errMsg) 
{
    Tcl_HashEntry *hashEntry;
    tclOSAScript *scriptPtr;

    hashEntry = Tcl_FindHashEntry(&theComponent->scriptTable, scriptName);
    if (hashEntry == NULL) {
      errMsg = ckalloc(17);
      strcpy(errMsg,"Script not found");
      return TCL_ERROR;
    }
      
    scriptPtr = (tclOSAScript *) Tcl_GetHashValue(hashEntry);
    OSADispose(theComponent->theComponent, scriptPtr->scriptID);
    ckfree((char *) scriptPtr);
    Tcl_DeleteHashEntry(hashEntry);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclOSAActiveProc --
 *
 *    This is passed to each component.  It is run periodically
 *    during script compilation and script execution.  It in turn
 *    calls Tcl_DoOneEvent to process the event queue.  We also call
 *    the default Active proc which will let the user cancel the script
 *    by hitting Command-.
 * 
 * Results:
 *    A standard MacOS system error
 *
 * Side effects:
 *    Any Tcl code may run while calling Tcl_DoOneEvent.
 *
 *----------------------------------------------------------------------
 */
 
static pascal OSErr 
TclOSAActiveProc(
    long refCon)
{
    tclOSAComponent *theComponent = (tclOSAComponent *) refCon;
      
    Tcl_DoOneEvent(TCL_DONT_WAIT);
    InvokeOSAActiveUPP(theComponent->defRefCon, theComponent->defActiveProc);
      
    return noErr;
}

/*
 *----------------------------------------------------------------------
 *
 * ASCIICompareProc --
 *
 *    Trivial ascii compare for use with qsort. 
 *
 * Results:
 *    strcmp of the two input strings
 *
 * Side effects:
 *    None
 *
 *----------------------------------------------------------------------
 */
static int 
ASCIICompareProc(const void *first,const void *second)
{
    int order;
    
    char *firstString = *((char **) first);
    char *secondString = *((char **) second);

    order = strcmp(firstString, secondString);
      
    return order;
}

#define REALLOC_INCR 30
/*
 *----------------------------------------------------------------------
 *
 * getSortedHashKeys --
 *
 *    returns an alphabetically sorted list of the keys of the hash
 *    theTable which match the string "pattern" in the DString
 *    theResult. pattern == NULL matches all.
 *
 * Results:
 *    None
 *
 * Side effects:
 *    ReInitializes the DString theResult, then copies the names of
 *    the matching keys into the string as list elements.
 *
 *----------------------------------------------------------------------
 */
 
static void 
getSortedHashKeys(
    Tcl_HashTable *theTable,
    CONST char *pattern,
    Tcl_DString *theResult)
{
    Tcl_HashSearch search;
    Tcl_HashEntry *hPtr;
    Boolean compare = true;
    char *keyPtr;
    static char **resultArgv = NULL;
    static int totSize = 0;
    int totElem = 0, i;
      
    if (pattern == NULL || *pattern == '\0' || 
          (*pattern == '*' && *(pattern + 1) == '\0')) {
      compare = false;
    }
      
    for (hPtr = Tcl_FirstHashEntry(theTable,&search), totElem = 0;
       hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
                  
      keyPtr = (char *) Tcl_GetHashKey(theTable, hPtr);
      if (!compare || Tcl_StringMatch(keyPtr, pattern)) {
          totElem++;          
          if (totElem >= totSize) {
            totSize += REALLOC_INCR;
            resultArgv = (char **) ckrealloc((char *) resultArgv,
                  totSize * sizeof(char *));
          }
          resultArgv[totElem - 1] = keyPtr;
      } 
    }
            
    Tcl_DStringInit(theResult);
    if (totElem == 1) {
      Tcl_DStringAppendElement(theResult, resultArgv[0]);
    } else if (totElem > 1) {
      qsort((VOID *) resultArgv, (size_t) totElem, sizeof (char *),
            ASCIICompareProc);

      for (i = 0; i < totElem; i++) {
          Tcl_DStringAppendElement(theResult, resultArgv[i]);
      }
    } 
}

/*
 *----------------------------------------------------------------------
 *
 * prepareScriptData --
 *
 *    Massages the input data in the argv array, concating the 
 *    elements, with a " " between each, and replacing \n with \r,
 *    and \\n with "  ".  Puts the result in the the DString scrptData,
 *    and copies the result to the AEdesc scrptDesc.
 *
 * Results:
 *    Standard Tcl result
 *
 * Side effects:
 *    Creates a new Handle (with AECreateDesc) for the script data.
 *    Stores the script in scrptData, or the error message if there
 *    is an error creating the descriptor.
 *
 *----------------------------------------------------------------------
 */
 
static int
prepareScriptData(
    int argc,
    CONST char **argv,
    Tcl_DString *scrptData,
    AEDesc *scrptDesc) 
{
    char * ptr;
    int i;
    char buffer[7];
    OSErr sysErr = noErr;
    Tcl_DString encodedText;

    Tcl_DStringInit(scrptData);

    for (i = 0; i < argc; i++) {
      Tcl_DStringAppend(scrptData, argv[i], -1);
      Tcl_DStringAppend(scrptData, " ", 1);
    }

    /*
     * First replace the \n's with \r's in the script argument
     * Also replace "\\n" with "  ".
     */

    for (ptr = scrptData->string; *ptr != '\0'; ptr++) {
      if (*ptr == '\n') {
          *ptr = '\r';
      } else if (*ptr == '\\') {
          if (*(ptr + 1) == '\n') {
            *ptr = ' ';
            *(ptr + 1) = ' ';
          }
      }
    }

    Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(scrptData),
          Tcl_DStringLength(scrptData), &encodedText);
    sysErr = AECreateDesc(typeChar, Tcl_DStringValue(&encodedText),
          Tcl_DStringLength(&encodedText), scrptDesc);
    Tcl_DStringFree(&encodedText);

    if (sysErr != noErr) {
      sprintf(buffer, "%6d", sysErr);
      Tcl_DStringFree(scrptData);
      Tcl_DStringAppend(scrptData, "Error #", 7);
      Tcl_DStringAppend(scrptData, buffer, -1);
      Tcl_DStringAppend(scrptData, " creating Script Data Descriptor.", 33);
      return TCL_ERROR;                         
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * tclOSAResultFromID --
 *
 *    Gets a human readable version of the result from the script ID
 *    and returns it in the result of the interpreter interp
 *
 * Results:
 *    None
 *
 * Side effects:
 *    Sets the result of interp to the human readable version of resultID.
 *  
 *
 *----------------------------------------------------------------------
 */
 
void 
tclOSAResultFromID(
    Tcl_Interp *interp,
    ComponentInstance theComponent,
    OSAID resultID )
{
    OSErr myErr = noErr;
    AEDesc resultDesc;
    Tcl_DString resultStr;
      
    Tcl_DStringInit(&resultStr);
      
    myErr = OSADisplay(theComponent, resultID, typeChar,
          kOSAModeNull, &resultDesc);
    Tcl_DStringAppend(&resultStr, (char *) *resultDesc.dataHandle,
          GetHandleSize(resultDesc.dataHandle));
    Tcl_DStringResult(interp,&resultStr);
}

/*
 *----------------------------------------------------------------------
 *
 * tclOSAASError --
 *
 *    Gets the error message from the AppleScript component, and adds
 *    it to interp's result. If the script data is known, will point
 *    out the offending bit of code.  This MUST BE A NULL TERMINATED
 *    C-STRING, not a typeChar.
 *
 * Results:
 *    None
 *
 * Side effects:
 *    Sets the result of interp to error, plus the relevant portion
 *    of the script.
 *
 *----------------------------------------------------------------------
 */
 
void 
tclOSAASError(
    Tcl_Interp * interp,
    ComponentInstance theComponent,
    char *scriptData )
{
    OSErr myErr = noErr;
    AEDesc errResult,errLimits;
    Tcl_DString errStr;
    DescType returnType;
    Size returnSize;
    short srcStart,srcEnd;
    char buffer[16];
      
    Tcl_DStringInit(&errStr);
    Tcl_DStringAppend(&errStr, "An AppleScript error was encountered.\n", -1); 
      
    OSAScriptError(theComponent, kOSAErrorNumber,
          typeShortInteger, &errResult);
      
    sprintf(buffer, "Error #%-6.6d\n", (short int) **errResult.dataHandle);

    AEDisposeDesc(&errResult);
      
    Tcl_DStringAppend(&errStr,buffer, 15);
      
    OSAScriptError(theComponent, kOSAErrorMessage, typeChar, &errResult);
    Tcl_DStringAppend(&errStr, (char *) *errResult.dataHandle,
          GetHandleSize(errResult.dataHandle));
    AEDisposeDesc(&errResult);
      
    if (scriptData != NULL) {
      int lowerB, upperB;
            
      myErr = OSAScriptError(theComponent, kOSAErrorRange,
            typeOSAErrorRange, &errResult);
            
      myErr = AECoerceDesc(&errResult, typeAERecord, &errLimits);
      myErr = AEGetKeyPtr(&errLimits, keyOSASourceStart,
            typeShortInteger, &returnType, &srcStart,
            sizeof(short int), &returnSize);
      myErr = AEGetKeyPtr(&errLimits, keyOSASourceEnd, typeShortInteger,
            &returnType, &srcEnd, sizeof(short int), &returnSize);
      AEDisposeDesc(&errResult);
      AEDisposeDesc(&errLimits);

      Tcl_DStringAppend(&errStr, "\nThe offending bit of code was:\n\t", -1);
      /*
       * Get the full line on which the error occured:
       */
      for (lowerB = srcStart; lowerB > 0; lowerB--) {
          if (*(scriptData + lowerB ) == '\r') {
            lowerB++;
            break;
          }
      }
            
      for (upperB = srcEnd; *(scriptData + upperB) != '\0'; upperB++) {
          if (*(scriptData + upperB) == '\r') {
            break;
          }
      }

      Tcl_DStringAppend(&errStr, scriptData+lowerB, srcStart - lowerB);
      Tcl_DStringAppend(&errStr, "_", 1);
      Tcl_DStringAppend(&errStr, scriptData+srcStart, upperB - srcStart);
    }
      
    Tcl_DStringResult(interp,&errStr);
}

/*
 *----------------------------------------------------------------------
 *
 * GetRawDataFromDescriptor --
 *
 *    Get the data from a descriptor.
 *
 * Results:
 *    None
 *
 * Side effects:
 *    None.
 *
 *----------------------------------------------------------------------
 */
 
static void
GetRawDataFromDescriptor(
    AEDesc *theDesc,
    Ptr destPtr,
    Size destMaxSize,
    Size *actSize)
  {
      Size copySize;

      if (theDesc->dataHandle) {
        HLock((Handle)theDesc->dataHandle);
        *actSize = GetHandleSize((Handle)theDesc->dataHandle);
        copySize = *actSize < destMaxSize ? *actSize : destMaxSize;
        BlockMove(*theDesc->dataHandle, destPtr, copySize);
        HUnlock((Handle)theDesc->dataHandle);
      } else {
        *actSize = 0;
      }
      
  }

/*
 *----------------------------------------------------------------------
 *
 * GetRawDataFromDescriptor --
 *
 *    Get the data from a descriptor.  Assume it's a C string.
 *
 * Results:
 *    None
 *
 * Side effects:
 *    None.
 *
 *----------------------------------------------------------------------
 */
 
static OSErr
GetCStringFromDescriptor(
    AEDesc *sourceDesc,
    char *resultStr,
    Size resultMaxSize,
    Size *resultSize)
{
    OSErr err;
    AEDesc resultDesc;

    resultDesc.dataHandle = nil;
                        
    err = AECoerceDesc(sourceDesc, typeChar, &resultDesc);
            
    if (!err) {
      GetRawDataFromDescriptor(&resultDesc, (Ptr) resultStr,
            resultMaxSize - 1, resultSize);
      resultStr[*resultSize] = 0;
    } else {
      err = errAECoercionFail;
    }
                  
    if (resultDesc.dataHandle) {
      AEDisposeDesc(&resultDesc);
    }
    
    return err;
}

Generated by  Doxygen 1.6.0   Back to index