tclmacosa.c

linux系统下的音频通信

/* 
 * 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.
 *
 * SCCS: @(#) tclMacOSA.c 1.7 97/06/18 14:29:58
 */

#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,
			    char **argv));
static int 		tclOSADecompileCmd _ANSI_ARGS_((Tcl_Interp * Interp,
			    tclOSAComponent *OSAComponent, int argc,
			    char **argv));
static int 		tclOSADeleteCmd _ANSI_ARGS_((Tcl_Interp *interp,
			    tclOSAComponent *OSAComponent, int argc,
			    char **argv));
static int 		tclOSAExecuteCmd _ANSI_ARGS_((Tcl_Interp *interp,
			    tclOSAComponent *OSAComponent, int argc,
			    char **argv));
static int 		tclOSAInfoCmd _ANSI_ARGS_((Tcl_Interp *interp,
			    tclOSAComponent *OSAComponent, int argc,
			    char **argv));
static int 		tclOSALoadCmd _ANSI_ARGS_((Tcl_Interp *interp,
			    tclOSAComponent *OSAComponent, int argc,
			    char **argv));
static int 		tclOSARunCmd _ANSI_ARGS_((Tcl_Interp *interp,
			    tclOSAComponent *OSAComponent, int argc,
			    char **argv));
static int 		tclOSAStoreCmd _ANSI_ARGS_((Tcl_Interp *interp,
			    tclOSAComponent *OSAComponent, int argc, 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, char **argv)); 
static void 		getSortedHashKeys _ANSI_ARGS_((Tcl_HashTable *theTable,
			    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, 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, 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, 
			    char *contextName, OSAID *theContext));
static void 		tclOSAAddContext _ANSI_ARGS_((tclOSAComponent *theComponent, 
			    char *contextName, const OSAID theContext));						
static int 		tclOSAMakeContext _ANSI_ARGS_((tclOSAComponent *theComponent, 
			    char *contextName, OSAID *theContext));						
static int 		tclOSADeleteContext _ANSI_ARGS_((tclOSAComponent *theComponent,
			    char *contextName)); 
static int 		tclOSALoad _ANSI_ARGS_((Tcl_Interp *interp, 
			    tclOSAComponent *theComponent, char *resourceName, 
			    int resourceNumber, char *fileName,OSAID *resultID));
static int 		tclOSAStore _ANSI_ARGS_((Tcl_Interp *interp, 
			    tclOSAComponent *theComponent, char *resourceName, 
			    int resourceNumber, char *fileName,char *scriptName));
static int 		tclOSAAddScript _ANSI_ARGS_((tclOSAComponent *theComponent,
			    char *scriptName, long modeFlags, OSAID scriptID)); 		
static int 		tclOSAGetScriptID _ANSI_ARGS_((tclOSAComponent *theComponent,
			    char *scriptName, OSAID *scriptID)); 
static tclOSAScript *	tclOSAGetScript _ANSI_ARGS_((tclOSAComponent *theComponent,
			    char *scriptName)); 
static int 		tclOSADeleteScript _ANSI_ARGS_((tclOSAComponent *theComponent,
			    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;
	
    /* 
     * 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,
    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;