/*  * 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 onint 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,