/* * 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.1.1.1 2007/07/10 15:04:23 duncan Exp $ */ #define MAC_TCL #include #include #include #include #include #include #include #include #include #include #include /* * The following two Includes are from the More Files package. */ #include #include #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; }