Symaptic: os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/mac/tclMacOSA.c@260cb5ec6c19 (annotated)

sl@0	1	/*
sl@0	2	* tclMacOSA.c --
sl@0	3	*
sl@0	4	* This contains the initialization routines, and the implementation of
sl@0	5	* the OSA and Component commands. These commands allow you to connect
sl@0	6	* with the AppleScript or any other OSA component to compile and execute
sl@0	7	* scripts.
sl@0	8	*
sl@0	9	* Copyright (c) 1996 Lucent Technologies and Jim Ingham
sl@0	10	* Copyright (c) 1997 Sun Microsystems, Inc.
sl@0	11	*
sl@0	12	* See the file "License Terms" for information on usage and redistribution
sl@0	13	* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0	14	*
sl@0	15	* RCS: @(#) $Id: tclMacOSA.c,v 1.10 2002/10/09 11:54:30 das Exp $
sl@0	16	*/
sl@0	17
sl@0	18	#define MAC_TCL
sl@0	19
sl@0	20	#include <Aliases.h>
sl@0	21	#include <string.h>
sl@0	22	#include <AppleEvents.h>
sl@0	23	#include <AppleScript.h>
sl@0	24	#include <OSA.h>
sl@0	25	#include <OSAGeneric.h>
sl@0	26	#include <Script.h>
sl@0	27
sl@0	28	#include <FullPath.h>
sl@0	29	#include <components.h>
sl@0	30
sl@0	31	#include <resources.h>
sl@0	32	#include <FSpCompat.h>
sl@0	33	/*
sl@0	34	* The following two Includes are from the More Files package.
sl@0	35	*/
sl@0	36	#include <MoreFiles.h>
sl@0	37	#include <FullPath.h>
sl@0	38
sl@0	39	#include "tcl.h"
sl@0	40	#include "tclInt.h"
sl@0	41
sl@0	42	/*
sl@0	43	* I need this only for the call to FspGetFullPath,
sl@0	44	* I'm really not poking my nose where it does not belong!
sl@0	45	*/
sl@0	46	#include "tclMacInt.h"
sl@0	47
sl@0	48	/*
sl@0	49	* Data structures used by the OSA code.
sl@0	50	*/
sl@0	51	typedef struct tclOSAScript {
sl@0	52	OSAID scriptID;
sl@0	53	OSType languageID;
sl@0	54	long modeFlags;
sl@0	55	} tclOSAScript;
sl@0	56
sl@0	57	typedef struct tclOSAContext {
sl@0	58	OSAID contextID;
sl@0	59	} tclOSAContext;
sl@0	60
sl@0	61	typedef struct tclOSAComponent {
sl@0	62	char *theName;
sl@0	63	ComponentInstance theComponent; /* The OSA Component represented */
sl@0	64	long componentFlags;
sl@0	65	OSType languageID;
sl@0	66	char *languageName;
sl@0	67	Tcl_HashTable contextTable; /* Hash Table linking the context names & ID's */
sl@0	68	Tcl_HashTable scriptTable;
sl@0	69	Tcl_Interp *theInterp;
sl@0	70	OSAActiveUPP defActiveProc;
sl@0	71	long defRefCon;
sl@0	72	} tclOSAComponent;
sl@0	73
sl@0	74	/*
sl@0	75	* Prototypes for static procedures.
sl@0	76	*/
sl@0	77
sl@0	78	static pascal OSErr TclOSAActiveProc _ANSI_ARGS_((long refCon));
sl@0	79	static int TclOSACompileCmd _ANSI_ARGS_((Tcl_Interp *interp,
sl@0	80	tclOSAComponent *OSAComponent, int argc,
sl@0	81	CONST char **argv));
sl@0	82	static int tclOSADecompileCmd _ANSI_ARGS_((Tcl_Interp * Interp,
sl@0	83	tclOSAComponent *OSAComponent, int argc,
sl@0	84	CONST char **argv));
sl@0	85	static int tclOSADeleteCmd _ANSI_ARGS_((Tcl_Interp *interp,
sl@0	86	tclOSAComponent *OSAComponent, int argc,
sl@0	87	CONST char **argv));
sl@0	88	static int tclOSAExecuteCmd _ANSI_ARGS_((Tcl_Interp *interp,
sl@0	89	tclOSAComponent *OSAComponent, int argc,
sl@0	90	CONST char **argv));
sl@0	91	static int tclOSAInfoCmd _ANSI_ARGS_((Tcl_Interp *interp,
sl@0	92	tclOSAComponent *OSAComponent, int argc,
sl@0	93	CONST char **argv));
sl@0	94	static int tclOSALoadCmd _ANSI_ARGS_((Tcl_Interp *interp,
sl@0	95	tclOSAComponent *OSAComponent, int argc,
sl@0	96	CONST char **argv));
sl@0	97	static int tclOSARunCmd _ANSI_ARGS_((Tcl_Interp *interp,
sl@0	98	tclOSAComponent *OSAComponent, int argc,
sl@0	99	CONST char **argv));
sl@0	100	static int tclOSAStoreCmd _ANSI_ARGS_((Tcl_Interp *interp,
sl@0	101	tclOSAComponent *OSAComponent, int argc,
sl@0	102	CONST char **argv));
sl@0	103	static void GetRawDataFromDescriptor _ANSI_ARGS_((AEDesc *theDesc,
sl@0	104	Ptr destPtr, Size destMaxSize, Size *actSize));
sl@0	105	static OSErr GetCStringFromDescriptor _ANSI_ARGS_((
sl@0	106	AEDesc sourceDesc, char resultStr,
sl@0	107	Size resultMaxSize,Size *resultSize));
sl@0	108	static int Tcl_OSAComponentCmd _ANSI_ARGS_((ClientData clientData,
sl@0	109	Tcl_Interp interp, int argc, CONST char *argv));
sl@0	110	static void getSortedHashKeys _ANSI_ARGS_((Tcl_HashTable *theTable,
sl@0	111	CONST char pattern, Tcl_DString theResult));
sl@0	112	static int ASCIICompareProc _ANSI_ARGS_((const void *first,
sl@0	113	const void *second));
sl@0	114	static int Tcl_OSACmd _ANSI_ARGS_((ClientData clientData,
sl@0	115	Tcl_Interp interp, int argc, CONST char *argv));
sl@0	116	static void tclOSAClose _ANSI_ARGS_((ClientData clientData));
sl@0	117	/static void tclOSACloseAll _ANSI_ARGS_((ClientData clientData));/
sl@0	118	static tclOSAComponent tclOSAMakeNewComponent _ANSI_ARGS_((Tcl_Interp interp,
sl@0	119	char cmdName, char languageName,
sl@0	120	OSType scriptSubtype, long componentFlags));
sl@0	121	static int prepareScriptData _ANSI_ARGS_((int argc, CONST char **argv,
sl@0	122	Tcl_DString scrptData ,AEDesc scrptDesc));
sl@0	123	static void tclOSAResultFromID _ANSI_ARGS_((Tcl_Interp *interp,
sl@0	124	ComponentInstance theComponent, OSAID resultID));
sl@0	125	static void tclOSAASError _ANSI_ARGS_((Tcl_Interp * interp,
sl@0	126	ComponentInstance theComponent, char *scriptSource));
sl@0	127	static int tclOSAGetContextID _ANSI_ARGS_((tclOSAComponent *theComponent,
sl@0	128	CONST char contextName, OSAID theContext));
sl@0	129	static void tclOSAAddContext _ANSI_ARGS_((tclOSAComponent *theComponent,
sl@0	130	char *contextName, const OSAID theContext));
sl@0	131	static int tclOSAMakeContext _ANSI_ARGS_((tclOSAComponent *theComponent,
sl@0	132	CONST char contextName, OSAID theContext));
sl@0	133	static int tclOSADeleteContext _ANSI_ARGS_((tclOSAComponent *theComponent,
sl@0	134	CONST char *contextName));
sl@0	135	static int tclOSALoad _ANSI_ARGS_((Tcl_Interp *interp,
sl@0	136	tclOSAComponent theComponent, CONST char resourceName,
sl@0	137	int resourceNumber, CONST char fileName,OSAID resultID));
sl@0	138	static int tclOSAStore _ANSI_ARGS_((Tcl_Interp *interp,
sl@0	139	tclOSAComponent theComponent, CONST char resourceName,
sl@0	140	int resourceNumber, CONST char scriptName, CONST char fileName));
sl@0	141	static int tclOSAAddScript _ANSI_ARGS_((tclOSAComponent *theComponent,
sl@0	142	char *scriptName, long modeFlags, OSAID scriptID));
sl@0	143	static int tclOSAGetScriptID _ANSI_ARGS_((tclOSAComponent *theComponent,
sl@0	144	CONST char scriptName, OSAID scriptID));
sl@0	145	static tclOSAScript * tclOSAGetScript _ANSI_ARGS_((tclOSAComponent *theComponent,
sl@0	146	CONST char *scriptName));
sl@0	147	static int tclOSADeleteScript _ANSI_ARGS_((tclOSAComponent *theComponent,
sl@0	148	CONST char scriptName,char errMsg));
sl@0	149
sl@0	150	/*
sl@0	151	* "export" is a MetroWerks specific pragma. It flags the linker that
sl@0	152	* any symbols that are defined when this pragma is on will be exported
sl@0	153	* to shared libraries that link with this library.
sl@0	154	*/
sl@0	155
sl@0	156
sl@0	157	#pragma export on
sl@0	158	int Tclapplescript_Init( Tcl_Interp *interp );
sl@0	159	#pragma export reset
sl@0	160
sl@0	161	/*
sl@0	162	*----------------------------------------------------------------------
sl@0	163	*
sl@0	164	* Tclapplescript_Init --
sl@0	165	*
sl@0	166	* Initializes the the OSA command which opens connections to
sl@0	167	* OSA components, creates the AppleScript command, which opens an
sl@0	168	* instance of the AppleScript component,and constructs the table of
sl@0	169	* available languages.
sl@0	170	*
sl@0	171	* Results:
sl@0	172	* A standard Tcl result.
sl@0	173	*
sl@0	174	* Side Effects:
sl@0	175	* Opens one connection to the AppleScript component, if
sl@0	176	* available. Also builds up a table of available OSA languages,
sl@0	177	* and creates the OSA command.
sl@0	178	*
sl@0	179	*----------------------------------------------------------------------
sl@0	180	*/
sl@0	181
sl@0	182	int
sl@0	183	Tclapplescript_Init(
sl@0	184	Tcl_Interp interp) / Tcl interpreter. */
sl@0	185	{
sl@0	186	char *errMsg = NULL;
sl@0	187	OSErr myErr = noErr;
sl@0	188	Boolean gotAppleScript = false;
sl@0	189	Boolean GotOneOSALanguage = false;
sl@0	190	ComponentDescription compDescr = {
sl@0	191	kOSAComponentType,
sl@0	192	(OSType) 0,
sl@0	193	(OSType) 0,
sl@0	194	(long) 0,
sl@0	195	(long) 0
sl@0	196	}, *foundComp;
sl@0	197	Component curComponent = (Component) 0;
sl@0	198	ComponentInstance curOpenComponent;
sl@0	199	Tcl_HashTable *ComponentTable;
sl@0	200	Tcl_HashTable *LanguagesTable;
sl@0	201	Tcl_HashEntry *hashEntry;
sl@0	202	int newPtr;
sl@0	203	AEDesc componentName = { typeNull, NULL };
sl@0	204	char nameStr[32];
sl@0	205	Size nameLen;
sl@0	206	long appleScriptFlags;
sl@0	207
sl@0	208	/*
sl@0	209	* Perform the required stubs magic...
sl@0	210	*/
sl@0	211
sl@0	212	if (!Tcl_InitStubs(interp, "8.2", 0)) {
sl@0	213	return TCL_ERROR;
sl@0	214	}
sl@0	215
sl@0	216	/*
sl@0	217	* Here We Will Get The Available Osa Languages, Since They Can Only Be
sl@0	218	* Registered At Startup... If You Dynamically Load Components, This
sl@0	219	* Will Fail, But This Is Not A Common Thing To Do.
sl@0	220	*/
sl@0	221
sl@0	222	LanguagesTable = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
sl@0	223
sl@0	224	if (LanguagesTable == NULL) {
sl@0	225	panic("Memory Error Allocating Languages Hash Table");
sl@0	226	}
sl@0	227
sl@0	228	Tcl_SetAssocData(interp, "OSAScript_LangTable", NULL, LanguagesTable);
sl@0	229	Tcl_InitHashTable(LanguagesTable, TCL_STRING_KEYS);
sl@0	230
sl@0	231
sl@0	232	while ((curComponent = FindNextComponent(curComponent, &compDescr)) != 0) {
sl@0	233	int nbytes = sizeof(ComponentDescription);
sl@0	234	foundComp = (ComponentDescription *)
sl@0	235	ckalloc(sizeof(ComponentDescription));
sl@0	236	myErr = GetComponentInfo(curComponent, foundComp, NULL, NULL, NULL);
sl@0	237	if (foundComp->componentSubType ==
sl@0	238	kOSAGenericScriptingComponentSubtype) {
sl@0	239	/* Skip the generic component */
sl@0	240	ckfree((char *) foundComp);
sl@0	241	} else {
sl@0	242	GotOneOSALanguage = true;
sl@0	243
sl@0	244	/*
sl@0	245	* This is gross: looks like I have to open the component just
sl@0	246	* to get its name!!! GetComponentInfo is supposed to return
sl@0	247	* the name, but AppleScript always returns an empty string.
sl@0	248	*/
sl@0	249
sl@0	250	curOpenComponent = OpenComponent(curComponent);
sl@0	251	if (curOpenComponent == NULL) {
sl@0	252	Tcl_AppendResult(interp,"Error opening component",
sl@0	253	(char *) NULL);
sl@0	254	return TCL_ERROR;
sl@0	255	}
sl@0	256
sl@0	257	myErr = OSAScriptingComponentName(curOpenComponent,&componentName);
sl@0	258	if (myErr == noErr) {
sl@0	259	myErr = GetCStringFromDescriptor(&componentName,
sl@0	260	nameStr, 31, &nameLen);
sl@0	261	AEDisposeDesc(&componentName);
sl@0	262	}
sl@0	263	CloseComponent(curOpenComponent);
sl@0	264
sl@0	265	if (myErr == noErr) {
sl@0	266	hashEntry = Tcl_CreateHashEntry(LanguagesTable,
sl@0	267	nameStr, &newPtr);
sl@0	268	Tcl_SetHashValue(hashEntry, (ClientData) foundComp);
sl@0	269	} else {
sl@0	270	Tcl_AppendResult(interp,"Error getting componentName.",
sl@0	271	(char *) NULL);
sl@0	272	return TCL_ERROR;
sl@0	273	}
sl@0	274
sl@0	275	/*
sl@0	276	* Make sure AppleScript is loaded, otherwise we will
sl@0	277	* not bother to make the AppleScript command.
sl@0	278	*/
sl@0	279	if (foundComp->componentSubType == kAppleScriptSubtype) {
sl@0	280	appleScriptFlags = foundComp->componentFlags;
sl@0	281	gotAppleScript = true;
sl@0	282	}
sl@0	283	}
sl@0	284	}
sl@0	285
sl@0	286	/*
sl@0	287	* Create the OSA command.
sl@0	288	*/
sl@0	289
sl@0	290	if (!GotOneOSALanguage) {
sl@0	291	Tcl_AppendResult(interp,"Could not find any OSA languages",
sl@0	292	(char *) NULL);
sl@0	293	return TCL_ERROR;
sl@0	294	}
sl@0	295
sl@0	296	/*
sl@0	297	* Create the Component Assoc Data & put it in the interpreter.
sl@0	298	*/
sl@0	299
sl@0	300	ComponentTable = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
sl@0	301
sl@0	302	if (ComponentTable == NULL) {
sl@0	303	panic("Memory Error Allocating Hash Table");
sl@0	304	}
sl@0	305
sl@0	306	Tcl_SetAssocData(interp, "OSAScript_CompTable", NULL, ComponentTable);
sl@0	307
sl@0	308	Tcl_InitHashTable(ComponentTable, TCL_STRING_KEYS);
sl@0	309
sl@0	310	/*
sl@0	311	* The OSA command is not currently supported.
sl@0	312	Tcl_CreateCommand(interp, "OSA", Tcl_OSACmd, (ClientData) NULL,
sl@0	313	(Tcl_CmdDeleteProc *) NULL);
sl@0	314	*/
sl@0	315
sl@0	316	/*
sl@0	317	* Open up one AppleScript component, with a default context
sl@0	318	* and tie it to the AppleScript command.
sl@0	319	* If the user just wants single-threaded AppleScript execution
sl@0	320	* this should be enough.
sl@0	321	*
sl@0	322	*/
sl@0	323
sl@0	324	if (gotAppleScript) {
sl@0	325	if (tclOSAMakeNewComponent(interp, "AppleScript",
sl@0	326	"AppleScript English", kAppleScriptSubtype,
sl@0	327	appleScriptFlags) == NULL ) {
sl@0	328	return TCL_ERROR;
sl@0	329	}
sl@0	330	}
sl@0	331
sl@0	332	return Tcl_PkgProvide(interp, "OSAConnect", "1.0");
sl@0	333	}
sl@0	334
sl@0	335	/*
sl@0	336	*----------------------------------------------------------------------
sl@0	337	*
sl@0	338	* Tcl_OSACmd --
sl@0	339	*
sl@0	340	* This is the command that provides the interface to the OSA
sl@0	341	* component manager. The subcommands are: close: close a component,
sl@0	342	* info: get info on components open, and open: get a new connection
sl@0	343	* with the Scripting Component
sl@0	344	*
sl@0	345	* Results:
sl@0	346	* A standard Tcl result.
sl@0	347	*
sl@0	348	* Side effects:
sl@0	349	* Depends on the subcommand, see the user documentation
sl@0	350	* for more details.
sl@0	351	*
sl@0	352	*----------------------------------------------------------------------
sl@0	353	*/
sl@0	354
sl@0	355	int
sl@0	356	Tcl_OSACmd(
sl@0	357	ClientData clientData,
sl@0	358	Tcl_Interp *interp,
sl@0	359	int argc,
sl@0	360	CONST char **argv)
sl@0	361	{
sl@0	362	static unsigned short componentCmdIndex = 0;
sl@0	363	char autoName[32];
sl@0	364	char c;
sl@0	365	int length;
sl@0	366	Tcl_HashTable *ComponentTable = NULL;
sl@0	367
sl@0	368
sl@0	369	if (argc == 1) {
sl@0	370	Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
sl@0	371	argv[0], " option\"", (char *) NULL);
sl@0	372	return TCL_ERROR;
sl@0	373	}
sl@0	374
sl@0	375	c = *argv[1];
sl@0	376	length = strlen(argv[1]);
sl@0	377
sl@0	378	/*
sl@0	379	* Query out the Component Table, since most of these commands use it...
sl@0	380	*/
sl@0	381
sl@0	382	ComponentTable = (Tcl_HashTable *) Tcl_GetAssocData(interp,
sl@0	383	"OSAScript_CompTable", (Tcl_InterpDeleteProc **) NULL);
sl@0	384
sl@0	385	if (ComponentTable == NULL) {
sl@0	386	Tcl_AppendResult(interp, "Error, could not get the Component Table",
sl@0	387	" from the Associated data.", (char *) NULL);
sl@0	388	return TCL_ERROR;
sl@0	389	}
sl@0	390
sl@0	391	if (c == 'c' && strncmp(argv[1],"close",length) == 0) {
sl@0	392	Tcl_HashEntry *hashEntry;
sl@0	393	if (argc != 3) {
sl@0	394	Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
sl@0	395	argv[0], " ",argv[1], " componentName\"",
sl@0	396	(char *) NULL);
sl@0	397	return TCL_ERROR;
sl@0	398	}
sl@0	399
sl@0	400	if ((hashEntry = Tcl_FindHashEntry(ComponentTable,argv[2])) == NULL) {
sl@0	401	Tcl_AppendResult(interp, "Component \"", argv[2], "\" not found",
sl@0	402	(char *) NULL);
sl@0	403	return TCL_ERROR;
sl@0	404	} else {
sl@0	405	Tcl_DeleteCommand(interp,argv[2]);
sl@0	406	return TCL_OK;
sl@0	407	}
sl@0	408	} else if (c == 'o' && strncmp(argv[1],"open",length) == 0) {
sl@0	409	/*
sl@0	410	* Default language is AppleScript.
sl@0	411	*/
sl@0	412	OSType scriptSubtype = kAppleScriptSubtype;
sl@0	413	char *languageName = "AppleScript English";
sl@0	414	char *errMsg = NULL;
sl@0	415	ComponentDescription *theCD;
sl@0	416
sl@0	417	argv += 2;
sl@0	418	argc -= 2;
sl@0	419
sl@0	420	while (argc > 0 ) {
sl@0	421	if (*argv[0] == '-') {
sl@0	422	c = *(argv[0] + 1);
sl@0	423	if (c == 'l' && strcmp(argv[0] + 1, "language") == 0) {
sl@0	424	if (argc == 1) {
sl@0	425	Tcl_AppendResult(interp,
sl@0	426	"Error - no language provided for the -language switch",
sl@0	427	(char *) NULL);
sl@0	428	return TCL_ERROR;
sl@0	429	} else {
sl@0	430	Tcl_HashEntry *hashEntry;
sl@0	431	Tcl_HashSearch search;
sl@0	432	Boolean gotIt = false;
sl@0	433	Tcl_HashTable *LanguagesTable;
sl@0	434
sl@0	435	/*
sl@0	436	* Look up the language in the languages table
sl@0	437	* Do a simple strstr match, so AppleScript
sl@0	438	* will match "AppleScript English"...
sl@0	439	*/
sl@0	440
sl@0	441	LanguagesTable = Tcl_GetAssocData(interp,
sl@0	442	"OSAScript_LangTable",
sl@0	443	(Tcl_InterpDeleteProc **) NULL);
sl@0	444
sl@0	445	for (hashEntry =
sl@0	446	Tcl_FirstHashEntry(LanguagesTable, &search);
sl@0	447	hashEntry != NULL;
sl@0	448	hashEntry = Tcl_NextHashEntry(&search)) {
sl@0	449	languageName = Tcl_GetHashKey(LanguagesTable,
sl@0	450	hashEntry);
sl@0	451	if (strstr(languageName,argv[1]) != NULL) {
sl@0	452	theCD = (ComponentDescription *)
sl@0	453	Tcl_GetHashValue(hashEntry);
sl@0	454	gotIt = true;
sl@0	455	break;
sl@0	456	}
sl@0	457	}
sl@0	458	if (!gotIt) {
sl@0	459	Tcl_AppendResult(interp,
sl@0	460	"Error, could not find the language \"",
sl@0	461	argv[1],
sl@0	462	"\" in the list of known languages.",
sl@0	463	(char *) NULL);
sl@0	464	return TCL_ERROR;
sl@0	465	}
sl@0	466	}
sl@0	467	}
sl@0	468	argc -= 2;
sl@0	469	argv += 2;
sl@0	470	} else {
sl@0	471	Tcl_AppendResult(interp, "Expected a flag, but got ",
sl@0	472	argv[0], (char *) NULL);
sl@0	473	return TCL_ERROR;
sl@0	474	}
sl@0	475	}
sl@0	476
sl@0	477	sprintf(autoName, "OSAComponent%-d", componentCmdIndex++);
sl@0	478	if (tclOSAMakeNewComponent(interp, autoName, languageName,
sl@0	479	theCD->componentSubType, theCD->componentFlags) == NULL ) {
sl@0	480	return TCL_ERROR;
sl@0	481	} else {
sl@0	482	Tcl_SetResult(interp,autoName,TCL_VOLATILE);
sl@0	483	return TCL_OK;
sl@0	484	}
sl@0	485
sl@0	486	} else if (c == 'i' && strncmp(argv[1],"info",length) == 0) {
sl@0	487	if (argc == 2) {
sl@0	488	Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
sl@0	489	argv[0], " ", argv[1], " what\"",
sl@0	490	(char *) NULL);
sl@0	491	return TCL_ERROR;
sl@0	492	}
sl@0	493
sl@0	494	c = *argv[2];
sl@0	495	length = strlen(argv[2]);
sl@0	496
sl@0	497	if (c == 'c' && strncmp(argv[2], "components", length) == 0) {
sl@0	498	Tcl_DString theResult;
sl@0	499
sl@0	500	Tcl_DStringInit(&theResult);
sl@0	501
sl@0	502	if (argc == 3) {
sl@0	503	getSortedHashKeys(ComponentTable,(char *) NULL, &theResult);
sl@0	504	} else if (argc == 4) {
sl@0	505	getSortedHashKeys(ComponentTable, argv[3], &theResult);
sl@0	506	} else {
sl@0	507	Tcl_AppendResult(interp, "Error: wrong # of arguments",
sl@0	508	", should be \"", argv[0], " ", argv[1], " ",
sl@0	509	argv[2], " ?pattern?\".", (char *) NULL);
sl@0	510	return TCL_ERROR;
sl@0	511	}
sl@0	512	Tcl_DStringResult(interp, &theResult);
sl@0	513	return TCL_OK;
sl@0	514	} else if (c == 'l' && strncmp(argv[2],"languages",length) == 0) {
sl@0	515	Tcl_DString theResult;
sl@0	516	Tcl_HashTable *LanguagesTable;
sl@0	517
sl@0	518	Tcl_DStringInit(&theResult);
sl@0	519	LanguagesTable = Tcl_GetAssocData(interp,
sl@0	520	"OSAScript_LangTable", (Tcl_InterpDeleteProc **) NULL);
sl@0	521
sl@0	522	if (argc == 3) {
sl@0	523	getSortedHashKeys(LanguagesTable, (char *) NULL, &theResult);
sl@0	524	} else if (argc == 4) {
sl@0	525	getSortedHashKeys(LanguagesTable, argv[3], &theResult);
sl@0	526	} else {
sl@0	527	Tcl_AppendResult(interp, "Error: wrong # of arguments",
sl@0	528	", should be \"", argv[0], " ", argv[1], " ",
sl@0	529	argv[2], " ?pattern?\".", (char *) NULL);
sl@0	530	return TCL_ERROR;
sl@0	531	}
sl@0	532	Tcl_DStringResult(interp,&theResult);
sl@0	533	return TCL_OK;
sl@0	534	} else {
sl@0	535	Tcl_AppendResult(interp, "Unknown option: ", argv[2],
sl@0	536	" for OSA info, should be one of",
sl@0	537	" \"components\" or \"languages\"",
sl@0	538	(char *) NULL);
sl@0	539	return TCL_ERROR;
sl@0	540	}
sl@0	541	} else {
sl@0	542	Tcl_AppendResult(interp, "Unknown option: ", argv[1],
sl@0	543	", should be one of \"open\", \"close\" or \"info\".",
sl@0	544	(char *) NULL);
sl@0	545	return TCL_ERROR;
sl@0	546	}
sl@0	547	return TCL_OK;
sl@0	548	}
sl@0	549
sl@0	550	/*
sl@0	551	*----------------------------------------------------------------------
sl@0	552	*
sl@0	553	* Tcl_OSAComponentCmd --
sl@0	554	*
sl@0	555	* This is the command that provides the interface with an OSA
sl@0	556	* component. The sub commands are:
sl@0	557	* - compile ? -context context? scriptData
sl@0	558	* compiles the script data, returns the ScriptID
sl@0	559	* - decompile ? -context context? scriptData
sl@0	560	* decompiles the script data, source code
sl@0	561	* - execute ?-context context? scriptData
sl@0	562	* compiles and runs script data
sl@0	563	* - info what: get component info
sl@0	564	* - load ?-flags values? fileName
sl@0	565	* loads & compiles script data from fileName
sl@0	566	* - run scriptId ?options?
sl@0	567	* executes the compiled script
sl@0	568	*
sl@0	569	* Results:
sl@0	570	* A standard Tcl result
sl@0	571	*
sl@0	572	* Side Effects:
sl@0	573	* Depends on the subcommand, see the user documentation
sl@0	574	* for more details.
sl@0	575	*
sl@0	576	*----------------------------------------------------------------------
sl@0	577	*/
sl@0	578
sl@0	579	int
sl@0	580	Tcl_OSAComponentCmd(
sl@0	581	ClientData clientData,
sl@0	582	Tcl_Interp *interp,
sl@0	583	int argc,
sl@0	584	CONST char **argv)
sl@0	585	{
sl@0	586	int length;
sl@0	587	char c;
sl@0	588
sl@0	589	tclOSAComponent OSAComponent = (tclOSAComponent ) clientData;
sl@0	590
sl@0	591	if (argc == 1) {
sl@0	592	Tcl_AppendResult(interp, "wrong # args: should be \"",
sl@0	593	argv[0], " option ?arg ...?\"",
sl@0	594	(char *) NULL);
sl@0	595	return TCL_ERROR;
sl@0	596	}
sl@0	597
sl@0	598	c = *argv[1];
sl@0	599	length = strlen(argv[1]);
sl@0	600	if (c == 'c' && strncmp(argv[1], "compile", length) == 0) {
sl@0	601	return TclOSACompileCmd(interp, OSAComponent, argc, argv);
sl@0	602	} else if (c == 'l' && strncmp(argv[1], "load", length) == 0) {
sl@0	603	return tclOSALoadCmd(interp, OSAComponent, argc, argv);
sl@0	604	} else if (c == 'e' && strncmp(argv[1], "execute", length) == 0) {
sl@0	605	return tclOSAExecuteCmd(interp, OSAComponent, argc, argv);
sl@0	606	} else if (c == 'i' && strncmp(argv[1], "info", length) == 0) {
sl@0	607	return tclOSAInfoCmd(interp, OSAComponent, argc, argv);
sl@0	608	} else if (c == 'd' && strncmp(argv[1], "decompile", length) == 0) {
sl@0	609	return tclOSADecompileCmd(interp, OSAComponent, argc, argv);
sl@0	610	} else if (c == 'd' && strncmp(argv[1], "delete", length) == 0) {
sl@0	611	return tclOSADeleteCmd(interp, OSAComponent, argc, argv);
sl@0	612	} else if (c == 'r' && strncmp(argv[1], "run", length) == 0) {
sl@0	613	return tclOSARunCmd(interp, OSAComponent, argc, argv);
sl@0	614	} else if (c == 's' && strncmp(argv[1], "store", length) == 0) {
sl@0	615	return tclOSAStoreCmd(interp, OSAComponent, argc, argv);
sl@0	616	} else {
sl@0	617	Tcl_AppendResult(interp,"bad option \"", argv[1],
sl@0	618	"\": should be compile, decompile, delete, ",
sl@0	619	"execute, info, load, run or store",
sl@0	620	(char *) NULL);
sl@0	621	return TCL_ERROR;
sl@0	622	}
sl@0	623
sl@0	624	return TCL_OK;
sl@0	625	}
sl@0	626
sl@0	627	/*
sl@0	628	*----------------------------------------------------------------------
sl@0	629	*
sl@0	630	* TclOSACompileCmd --
sl@0	631	*
sl@0	632	* This is the compile subcommand for the component command.
sl@0	633	*
sl@0	634	* Results:
sl@0	635	* A standard Tcl result
sl@0	636	*
sl@0	637	* Side Effects:
sl@0	638	* Compiles the script data either into a script or a script
sl@0	639	* context. Adds the script to the component's script or context
sl@0	640	* table. Sets interp's result to the name of the new script or
sl@0	641	* context.
sl@0	642	*
sl@0	643	*----------------------------------------------------------------------
sl@0	644	*/
sl@0	645
sl@0	646	static int
sl@0	647	TclOSACompileCmd(
sl@0	648	Tcl_Interp *interp,
sl@0	649	tclOSAComponent *OSAComponent,
sl@0	650	int argc,
sl@0	651	CONST char **argv)
sl@0	652	{
sl@0	653	int tclError = TCL_OK;
sl@0	654	int augment = 1;
sl@0	655	int makeContext = 0;
sl@0	656	char c;
sl@0	657	char autoName[16];
sl@0	658	char buffer[32];
sl@0	659	char *resultName;
sl@0	660	Boolean makeNewContext = false;
sl@0	661	Tcl_DString scrptData;
sl@0	662	AEDesc scrptDesc = { typeNull, NULL };
sl@0	663	long modeFlags = kOSAModeCanInteract;
sl@0	664	OSAID resultID = kOSANullScript;
sl@0	665	OSAID contextID = kOSANullScript;
sl@0	666	OSAID parentID = kOSANullScript;
sl@0	667	OSAError osaErr = noErr;
sl@0	668
sl@0	669	if (!(OSAComponent->componentFlags && kOSASupportsCompiling)) {
sl@0	670	Tcl_AppendResult(interp,
sl@0	671	"OSA component does not support compiling",
sl@0	672	(char *) NULL);
sl@0	673	return TCL_ERROR;
sl@0	674	}
sl@0	675
sl@0	676	/*
sl@0	677	* This signals that we should make up a name, which is the
sl@0	678	* default behavior:
sl@0	679	*/
sl@0	680
sl@0	681	autoName[0] = '\0';
sl@0	682	resultName = NULL;
sl@0	683
sl@0	684	if (argc == 2) {
sl@0	685	numArgs:
sl@0	686	Tcl_AppendResult(interp,
sl@0	687	"wrong # args: should be \"", argv[0], " ", argv[1],
sl@0	688	" ?options? code\"",(char *) NULL);
sl@0	689	return TCL_ERROR;
sl@0	690	}
sl@0	691
sl@0	692	argv += 2;
sl@0	693	argc -= 2;
sl@0	694
sl@0	695	/*
sl@0	696	* Do the argument parsing.
sl@0	697	*/
sl@0	698
sl@0	699	while (argc > 0) {
sl@0	700
sl@0	701	if (*argv[0] == '-') {
sl@0	702	c = *(argv[0] + 1);
sl@0	703
sl@0	704	/*
sl@0	705	* "--" is the only switch that has no value, stops processing
sl@0	706	*/
sl@0	707
sl@0	708	if (c == '-' && *(argv[0] + 2) == '\0') {
sl@0	709	argv += 1;
sl@0	710	argc--;
sl@0	711	break;
sl@0	712	}
sl@0	713
sl@0	714	/*
sl@0	715	* So we can check here a switch with no value.
sl@0	716	*/
sl@0	717
sl@0	718	if (argc == 1) {
sl@0	719	Tcl_AppendResult(interp,
sl@0	720	"no value given for switch: ",
sl@0	721	argv[0], (char *) NULL);
sl@0	722	return TCL_ERROR;
sl@0	723	}
sl@0	724
sl@0	725	if (c == 'c' && strcmp(argv[0] + 1, "context") == 0) {
sl@0	726	if (Tcl_GetBoolean(interp, argv[1], &makeContext) != TCL_OK) {
sl@0	727	return TCL_ERROR;
sl@0	728	}
sl@0	729	} else if (c == 'a' && strcmp(argv[0] + 1, "augment") == 0) {
sl@0	730	/*
sl@0	731	* Augment the current context which implies making a context.
sl@0	732	*/
sl@0	733
sl@0	734	if (Tcl_GetBoolean(interp, argv[1], &augment) != TCL_OK) {
sl@0	735	return TCL_ERROR;
sl@0	736	}
sl@0	737	makeContext = 1;
sl@0	738	} else if (c == 'n' && strcmp(argv[0] + 1, "name") == 0) {
sl@0	739	strncpy(autoName, argv[1], 15);
sl@0	740	autoName[15] = '\0';
sl@0	741	resultName = autoName;
sl@0	742	} else if (c == 'p' && strcmp(argv[0] + 1,"parent") == 0) {
sl@0	743	/*
sl@0	744	* Since this implies we are compiling into a context,
sl@0	745	* set makeContext here
sl@0	746	*/
sl@0	747	if (tclOSAGetContextID(OSAComponent,
sl@0	748	argv[1], &parentID) != TCL_OK) {
sl@0	749	Tcl_AppendResult(interp, "context not found \"",
sl@0	750	argv[1], "\"", (char *) NULL);
sl@0	751	return TCL_ERROR;
sl@0	752	}
sl@0	753	makeContext = 1;
sl@0	754	} else {
sl@0	755	Tcl_AppendResult(interp, "bad option \"", argv[0],
sl@0	756	"\": should be -augment, -context, -name or -parent",
sl@0	757	(char *) NULL);
sl@0	758	return TCL_ERROR;
sl@0	759	}
sl@0	760	argv += 2;
sl@0	761	argc -= 2;
sl@0	762
sl@0	763	} else {
sl@0	764	break;
sl@0	765	}
sl@0	766	}
sl@0	767
sl@0	768	/*
sl@0	769	* Make sure we have some data left...
sl@0	770	*/
sl@0	771	if (argc == 0) {
sl@0	772	goto numArgs;
sl@0	773	}
sl@0	774
sl@0	775	/*
sl@0	776	* Now if we are making a context, see if it is a new one...
sl@0	777	* There are three options here:
sl@0	778	* 1) There was no name provided, so we autoName it
sl@0	779	* 2) There was a name, then check and see if it already exists
sl@0	780	* a) If yes, then makeNewContext is false
sl@0	781	* b) Otherwise we are making a new context
sl@0	782	*/
sl@0	783
sl@0	784	if (makeContext) {
sl@0	785	modeFlags \|= kOSAModeCompileIntoContext;
sl@0	786	if (resultName == NULL) {
sl@0	787	/*
sl@0	788	* Auto name the new context.
sl@0	789	*/
sl@0	790	resultName = autoName;
sl@0	791	resultID = kOSANullScript;
sl@0	792	makeNewContext = true;
sl@0	793	} else if (tclOSAGetContextID(OSAComponent,
sl@0	794	resultName, &resultID) == TCL_OK) {
sl@0	795	} else {
sl@0	796	makeNewContext = true;
sl@0	797	}
sl@0	798
sl@0	799	/*
sl@0	800	* Deal with the augment now...
sl@0	801	*/
sl@0	802	if (augment && !makeNewContext) {
sl@0	803	modeFlags \|= kOSAModeAugmentContext;
sl@0	804	}
sl@0	805	} else if (resultName == NULL) {
sl@0	806	resultName = autoName; /* Auto name the script */
sl@0	807	}
sl@0	808
sl@0	809	/*
sl@0	810	* Ok, now we have the options, so we can compile the script data.
sl@0	811	*/
sl@0	812
sl@0	813	if (prepareScriptData(argc, argv, &scrptData, &scrptDesc) == TCL_ERROR) {
sl@0	814	Tcl_DStringResult(interp, &scrptData);
sl@0	815	AEDisposeDesc(&scrptDesc);
sl@0	816	return TCL_ERROR;
sl@0	817	}
sl@0	818
sl@0	819	/*
sl@0	820	* If we want to use a parent context, we have to make the context
sl@0	821	* by hand. Note, parentID is only specified when you make a new context.
sl@0	822	*/
sl@0	823
sl@0	824	if (parentID != kOSANullScript && makeNewContext) {
sl@0	825	AEDesc contextDesc = { typeNull, NULL };
sl@0	826
sl@0	827	osaErr = OSAMakeContext(OSAComponent->theComponent,
sl@0	828	&contextDesc, parentID, &resultID);
sl@0	829	modeFlags \|= kOSAModeAugmentContext;
sl@0	830	}
sl@0	831
sl@0	832	osaErr = OSACompile(OSAComponent->theComponent, &scrptDesc,
sl@0	833	modeFlags, &resultID);
sl@0	834	if (osaErr == noErr) {
sl@0	835
sl@0	836	if (makeContext) {
sl@0	837	/*
sl@0	838	* For the compiled context to be active, you need to run
sl@0	839	* the code that is in the context.
sl@0	840	*/
sl@0	841	OSAID activateID;
sl@0	842
sl@0	843	osaErr = OSAExecute(OSAComponent->theComponent, resultID,
sl@0	844	resultID, kOSAModeCanInteract, &activateID);
sl@0	845	OSADispose(OSAComponent->theComponent, activateID);
sl@0	846
sl@0	847	if (osaErr == noErr) {
sl@0	848	if (makeNewContext) {
sl@0	849	/*
sl@0	850	* If we have compiled into a context,
sl@0	851	* this is added to the context table
sl@0	852	*/
sl@0	853
sl@0	854	tclOSAAddContext(OSAComponent, resultName, resultID);
sl@0	855	}
sl@0	856
sl@0	857	Tcl_SetResult(interp, resultName, TCL_VOLATILE);
sl@0	858	tclError = TCL_OK;
sl@0	859	}
sl@0	860	} else {
sl@0	861	/*
sl@0	862	* For a script, we return the script name.
sl@0	863	*/
sl@0	864	tclOSAAddScript(OSAComponent, resultName, modeFlags, resultID);
sl@0	865	Tcl_SetResult(interp, resultName, TCL_VOLATILE);
sl@0	866	tclError = TCL_OK;
sl@0	867	}
sl@0	868	}
sl@0	869
sl@0	870	/*
sl@0	871	* This catches the error either from the original compile,
sl@0	872	* or from the execute in case makeContext == true
sl@0	873	*/
sl@0	874
sl@0	875	if (osaErr == errOSAScriptError) {
sl@0	876	OSADispose(OSAComponent->theComponent, resultID);
sl@0	877	tclOSAASError(interp, OSAComponent->theComponent,
sl@0	878	Tcl_DStringValue(&scrptData));
sl@0	879	tclError = TCL_ERROR;
sl@0	880	} else if (osaErr != noErr) {
sl@0	881	sprintf(buffer, "Error #%-6ld compiling script", osaErr);
sl@0	882	Tcl_AppendResult(interp, buffer, (char *) NULL);
sl@0	883	tclError = TCL_ERROR;
sl@0	884	}
sl@0	885
sl@0	886	Tcl_DStringFree(&scrptData);
sl@0	887	AEDisposeDesc(&scrptDesc);
sl@0	888
sl@0	889	return tclError;
sl@0	890	}
sl@0	891
sl@0	892	/*
sl@0	893	*----------------------------------------------------------------------
sl@0	894	*
sl@0	895	* tclOSADecompileCmd --
sl@0	896	*
sl@0	897	* This implements the Decompile subcommand of the component command
sl@0	898	*
sl@0	899	* Results:
sl@0	900	* A standard Tcl result.
sl@0	901	*
sl@0	902	* Side Effects:
sl@0	903	* Decompiles the script, and sets interp's result to the
sl@0	904	* decompiled script data.
sl@0	905	*
sl@0	906	*----------------------------------------------------------------------
sl@0	907	*/
sl@0	908
sl@0	909	static int
sl@0	910	tclOSADecompileCmd(
sl@0	911	Tcl_Interp * interp,
sl@0	912	tclOSAComponent *OSAComponent,
sl@0	913	int argc,
sl@0	914	CONST char **argv)
sl@0	915	{
sl@0	916	AEDesc resultingSourceData = { typeChar, NULL };
sl@0	917	OSAID scriptID;
sl@0	918	Boolean isContext;
sl@0	919	long result;
sl@0	920	OSErr sysErr = noErr;
sl@0	921
sl@0	922	if (argc == 2) {
sl@0	923	Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
sl@0	924	argv[0], " ",argv[1], " scriptName \"", (char *) NULL );
sl@0	925	return TCL_ERROR;
sl@0	926	}
sl@0	927
sl@0	928	if (!(OSAComponent->componentFlags && kOSASupportsGetSource)) {
sl@0	929	Tcl_AppendResult(interp,
sl@0	930	"Error, this component does not support get source",
sl@0	931	(char *) NULL);
sl@0	932	return TCL_ERROR;
sl@0	933	}
sl@0	934
sl@0	935	if (tclOSAGetScriptID(OSAComponent, argv[2], &scriptID) == TCL_OK) {
sl@0	936	isContext = false;
sl@0	937	} else if (tclOSAGetContextID(OSAComponent, argv[2], &scriptID)
sl@0	938	== TCL_OK ) {
sl@0	939	isContext = true;
sl@0	940	} else {
sl@0	941	Tcl_AppendResult(interp, "Could not find script \"",
sl@0	942	argv[2], "\"", (char *) NULL);
sl@0	943	return TCL_ERROR;
sl@0	944	}
sl@0	945
sl@0	946	OSAGetScriptInfo(OSAComponent->theComponent, scriptID,
sl@0	947	kOSACanGetSource, &result);
sl@0	948
sl@0	949	sysErr = OSAGetSource(OSAComponent->theComponent,
sl@0	950	scriptID, typeChar, &resultingSourceData);
sl@0	951
sl@0	952	if (sysErr == noErr) {
sl@0	953	Tcl_DString theResult;
sl@0	954	Tcl_DStringInit(&theResult);
sl@0	955
sl@0	956	Tcl_DStringAppend(&theResult, *resultingSourceData.dataHandle,
sl@0	957	GetHandleSize(resultingSourceData.dataHandle));
sl@0	958	Tcl_DStringResult(interp, &theResult);
sl@0	959	AEDisposeDesc(&resultingSourceData);
sl@0	960	return TCL_OK;
sl@0	961	} else {
sl@0	962	Tcl_AppendResult(interp, "Error getting source data", (char *) NULL);
sl@0	963	AEDisposeDesc(&resultingSourceData);
sl@0	964	return TCL_ERROR;
sl@0	965	}
sl@0	966	}
sl@0	967
sl@0	968	/*
sl@0	969	*----------------------------------------------------------------------
sl@0	970	*
sl@0	971	* tclOSADeleteCmd --
sl@0	972	*
sl@0	973	* This implements the Delete subcommand of the Component command.
sl@0	974	*
sl@0	975	* Results:
sl@0	976	* A standard Tcl result.
sl@0	977	*
sl@0	978	* Side Effects:
sl@0	979	* Deletes a script from the script list of the given component.
sl@0	980	* Removes all references to the script, and frees the memory
sl@0	981	* associated with it.
sl@0	982	*
sl@0	983	*----------------------------------------------------------------------
sl@0	984	*/
sl@0	985
sl@0	986	static int
sl@0	987	tclOSADeleteCmd(
sl@0	988	Tcl_Interp *interp,
sl@0	989	tclOSAComponent *OSAComponent,
sl@0	990	int argc,
sl@0	991	CONST char **argv)
sl@0	992	{
sl@0	993	char c,*errMsg = NULL;
sl@0	994	int length;
sl@0	995
sl@0	996	if (argc < 4) {
sl@0	997	Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
sl@0	998	argv[0], " ", argv[1], " what scriptName", (char *) NULL);
sl@0	999	return TCL_ERROR;
sl@0	1000	}
sl@0	1001
sl@0	1002	c = *argv[2];
sl@0	1003	length = strlen(argv[2]);
sl@0	1004	if (c == 'c' && strncmp(argv[2], "context", length) == 0) {
sl@0	1005	if (strcmp(argv[3], "global") == 0) {
sl@0	1006	Tcl_AppendResult(interp, "You cannot delete the global context",
sl@0	1007	(char *) NULL);
sl@0	1008	return TCL_ERROR;
sl@0	1009	} else if (tclOSADeleteContext(OSAComponent, argv[3]) != TCL_OK) {
sl@0	1010	Tcl_AppendResult(interp, "Error deleting script \"", argv[2],
sl@0	1011	"\": ", errMsg, (char *) NULL);
sl@0	1012	ckfree(errMsg);
sl@0	1013	return TCL_ERROR;
sl@0	1014	}
sl@0	1015	} else if (c == 's' && strncmp(argv[2], "script", length) == 0) {
sl@0	1016	if (tclOSADeleteScript(OSAComponent, argv[3], errMsg) != TCL_OK) {
sl@0	1017	Tcl_AppendResult(interp, "Error deleting script \"", argv[3],
sl@0	1018	"\": ", errMsg, (char *) NULL);
sl@0	1019	ckfree(errMsg);
sl@0	1020	return TCL_ERROR;
sl@0	1021	}
sl@0	1022	} else {
sl@0	1023	Tcl_AppendResult(interp,"Unknown value ", argv[2],
sl@0	1024	" should be one of ",
sl@0	1025	"\"context\" or \"script\".",
sl@0	1026	(char *) NULL );
sl@0	1027	return TCL_ERROR;
sl@0	1028	}
sl@0	1029	return TCL_OK;
sl@0	1030	}
sl@0	1031
sl@0	1032	/*
sl@0	1033	*----------------------------------------------------------------------
sl@0	1034	*
sl@0	1035	* tclOSAExecuteCmd --
sl@0	1036	*
sl@0	1037	* This implements the execute subcommand of the component command.
sl@0	1038	*
sl@0	1039	* Results:
sl@0	1040	* A standard Tcl result.
sl@0	1041	*
sl@0	1042	* Side effects:
sl@0	1043	* Executes the given script data, and sets interp's result to
sl@0	1044	* the OSA component's return value.
sl@0	1045	*
sl@0	1046	*----------------------------------------------------------------------
sl@0	1047	*/
sl@0	1048
sl@0	1049	static int
sl@0	1050	tclOSAExecuteCmd(
sl@0	1051	Tcl_Interp *interp,
sl@0	1052	tclOSAComponent *OSAComponent,
sl@0	1053	int argc,
sl@0	1054	CONST char **argv)
sl@0	1055	{
sl@0	1056	int tclError = TCL_OK, resID = 128;
sl@0	1057	char c,buffer[32],
sl@0	1058	contextName = NULL,scriptName = NULL, *resName = NULL;
sl@0	1059	Boolean makeNewContext = false,makeContext = false;
sl@0	1060	AEDesc scrptDesc = { typeNull, NULL };
sl@0	1061	long modeFlags = kOSAModeCanInteract;
sl@0	1062	OSAID resultID = kOSANullScript,
sl@0	1063	contextID = kOSANullScript,
sl@0	1064	parentID = kOSANullScript;
sl@0	1065	Tcl_DString scrptData;
sl@0	1066	OSAError osaErr = noErr;
sl@0	1067	OSErr sysErr = noErr;
sl@0	1068
sl@0	1069	if (argc == 2) {
sl@0	1070	Tcl_AppendResult(interp,
sl@0	1071	"Error, no script data for \"", argv[0],
sl@0	1072	" run\"", (char *) NULL);
sl@0	1073	return TCL_ERROR;
sl@0	1074	}
sl@0	1075
sl@0	1076	argv += 2;
sl@0	1077	argc -= 2;
sl@0	1078
sl@0	1079	/*
sl@0	1080	* Set the context to the global context by default.
sl@0	1081	* Then parse the argument list for switches
sl@0	1082	*/
sl@0	1083	tclOSAGetContextID(OSAComponent, "global", &contextID);
sl@0	1084
sl@0	1085	while (argc > 0) {
sl@0	1086
sl@0	1087	if (*argv[0] == '-') {
sl@0	1088	c = *(argv[0] + 1);
sl@0	1089
sl@0	1090	/*
sl@0	1091	* "--" is the only switch that has no value.
sl@0	1092	*/
sl@0	1093
sl@0	1094	if (c == '-' && *(argv[0] + 2) == '\0') {
sl@0	1095	argv += 1;
sl@0	1096	argc--;
sl@0	1097	break;
sl@0	1098	}
sl@0	1099
sl@0	1100	/*
sl@0	1101	* So we can check here for a switch with no value.
sl@0	1102	*/
sl@0	1103
sl@0	1104	if (argc == 1) {
sl@0	1105	Tcl_AppendResult(interp,
sl@0	1106	"Error, no value given for switch ",
sl@0	1107	argv[0], (char *) NULL);
sl@0	1108	return TCL_ERROR;
sl@0	1109	}
sl@0	1110
sl@0	1111	if (c == 'c' && strcmp(argv[0] + 1, "context") == 0) {
sl@0	1112	if (tclOSAGetContextID(OSAComponent,
sl@0	1113	argv[1], &contextID) == TCL_OK) {
sl@0	1114	} else {
sl@0	1115	Tcl_AppendResult(interp, "Script context \"",
sl@0	1116	argv[1], "\" not found", (char *) NULL);
sl@0	1117	return TCL_ERROR;
sl@0	1118	}
sl@0	1119	} else {
sl@0	1120	Tcl_AppendResult(interp, "Error, invalid switch ", argv[0],
sl@0	1121	" should be \"-context\"", (char *) NULL);
sl@0	1122	return TCL_ERROR;
sl@0	1123	}
sl@0	1124
sl@0	1125	argv += 2;
sl@0	1126	argc -= 2;
sl@0	1127	} else {
sl@0	1128	break;
sl@0	1129	}
sl@0	1130	}
sl@0	1131
sl@0	1132	if (argc == 0) {
sl@0	1133	Tcl_AppendResult(interp, "Error, no script data", (char *) NULL);
sl@0	1134	return TCL_ERROR;
sl@0	1135	}
sl@0	1136
sl@0	1137	if (prepareScriptData(argc, argv, &scrptData, &scrptDesc) == TCL_ERROR) {
sl@0	1138	Tcl_DStringResult(interp, &scrptData);
sl@0	1139	AEDisposeDesc(&scrptDesc);
sl@0	1140	return TCL_ERROR;
sl@0	1141	}
sl@0	1142	/*
sl@0	1143	* Now try to compile and run, but check to make sure the
sl@0	1144	* component supports the one shot deal
sl@0	1145	*/
sl@0	1146	if (OSAComponent->componentFlags && kOSASupportsConvenience) {
sl@0	1147	osaErr = OSACompileExecute(OSAComponent->theComponent,
sl@0	1148	&scrptDesc, contextID, modeFlags, &resultID);
sl@0	1149	} else {
sl@0	1150	/*
sl@0	1151	* If not, we have to do this ourselves
sl@0	1152	*/
sl@0	1153	if (OSAComponent->componentFlags && kOSASupportsCompiling) {
sl@0	1154	OSAID compiledID = kOSANullScript;
sl@0	1155	osaErr = OSACompile(OSAComponent->theComponent, &scrptDesc,
sl@0	1156	modeFlags, &compiledID);
sl@0	1157	if (osaErr == noErr) {
sl@0	1158	osaErr = OSAExecute(OSAComponent->theComponent, compiledID,
sl@0	1159	contextID, modeFlags, &resultID);
sl@0	1160	}
sl@0	1161	OSADispose(OSAComponent->theComponent, compiledID);
sl@0	1162	} else {
sl@0	1163	/*
sl@0	1164	* The scripting component had better be able to load text data...
sl@0	1165	*/
sl@0	1166	OSAID loadedID = kOSANullScript;
sl@0	1167
sl@0	1168	scrptDesc.descriptorType = OSAComponent->languageID;
sl@0	1169	osaErr = OSALoad(OSAComponent->theComponent, &scrptDesc,
sl@0	1170	modeFlags, &loadedID);
sl@0	1171	if (osaErr == noErr) {
sl@0	1172	OSAExecute(OSAComponent->theComponent, loadedID,
sl@0	1173	contextID, modeFlags, &resultID);
sl@0	1174	}
sl@0	1175	OSADispose(OSAComponent->theComponent, loadedID);
sl@0	1176	}
sl@0	1177	}
sl@0	1178	if (osaErr == errOSAScriptError) {
sl@0	1179	tclOSAASError(interp, OSAComponent->theComponent,
sl@0	1180	Tcl_DStringValue(&scrptData));
sl@0	1181	tclError = TCL_ERROR;
sl@0	1182	} else if (osaErr != noErr) {
sl@0	1183	sprintf(buffer, "Error #%-6ld compiling script", osaErr);
sl@0	1184	Tcl_AppendResult(interp, buffer, (char *) NULL);
sl@0	1185	tclError = TCL_ERROR;
sl@0	1186	} else {
sl@0	1187	tclOSAResultFromID(interp, OSAComponent->theComponent, resultID);
sl@0	1188	osaErr = OSADispose(OSAComponent->theComponent, resultID);
sl@0	1189	tclError = TCL_OK;
sl@0	1190	}
sl@0	1191
sl@0	1192	Tcl_DStringFree(&scrptData);
sl@0	1193	AEDisposeDesc(&scrptDesc);
sl@0	1194
sl@0	1195	return tclError;
sl@0	1196	}
sl@0	1197
sl@0	1198	/*
sl@0	1199	*----------------------------------------------------------------------
sl@0	1200	*
sl@0	1201	* tclOSAInfoCmd --
sl@0	1202	*
sl@0	1203	* This implements the Info subcommand of the component command
sl@0	1204	*
sl@0	1205	* Results:
sl@0	1206	* A standard Tcl result.
sl@0	1207	*
sl@0	1208	* Side effects:
sl@0	1209	* Info on scripts and contexts. See the user documentation for details.
sl@0	1210	*
sl@0	1211	*----------------------------------------------------------------------
sl@0	1212	*/
sl@0	1213	static int
sl@0	1214	tclOSAInfoCmd(
sl@0	1215	Tcl_Interp *interp,
sl@0	1216	tclOSAComponent *OSAComponent,
sl@0	1217	int argc,
sl@0	1218	CONST char **argv)
sl@0	1219	{
sl@0	1220	char c;
sl@0	1221	int length;
sl@0	1222	Tcl_DString theResult;
sl@0	1223
sl@0	1224	if (argc == 2) {
sl@0	1225	Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
sl@0	1226	argv[0], " ", argv[1], " what \"", (char *) NULL );
sl@0	1227	return TCL_ERROR;
sl@0	1228	}
sl@0	1229
sl@0	1230	c = *argv[2];
sl@0	1231	length = strlen(argv[2]);
sl@0	1232	if (c == 's' && strncmp(argv[2], "scripts", length) == 0) {
sl@0	1233	Tcl_DStringInit(&theResult);
sl@0	1234	if (argc == 3) {
sl@0	1235	getSortedHashKeys(&OSAComponent->scriptTable, (char *) NULL,
sl@0	1236	&theResult);
sl@0	1237	} else if (argc == 4) {
sl@0	1238	getSortedHashKeys(&OSAComponent->scriptTable, argv[3], &theResult);
sl@0	1239	} else {
sl@0	1240	Tcl_AppendResult(interp, "Error: wrong # of arguments,",
sl@0	1241	" should be \"", argv[0], " ", argv[1], " ",
sl@0	1242	argv[2], " ?pattern?", (char *) NULL);
sl@0	1243	return TCL_ERROR;
sl@0	1244	}
sl@0	1245	Tcl_DStringResult(interp, &theResult);
sl@0	1246	return TCL_OK;
sl@0	1247	} else if (c == 'c' && strncmp(argv[2], "contexts", length) == 0) {
sl@0	1248	Tcl_DStringInit(&theResult);
sl@0	1249	if (argc == 3) {
sl@0	1250	getSortedHashKeys(&OSAComponent->contextTable, (char *) NULL,
sl@0	1251	&theResult);
sl@0	1252	} else if (argc == 4) {
sl@0	1253	getSortedHashKeys(&OSAComponent->contextTable,
sl@0	1254	argv[3], &theResult);
sl@0	1255	} else {
sl@0	1256	Tcl_AppendResult(interp, "Error: wrong # of arguments for ,",
sl@0	1257	" should be \"", argv[0], " ", argv[1], " ",
sl@0	1258	argv[2], " ?pattern?", (char *) NULL);
sl@0	1259	return TCL_ERROR;
sl@0	1260	}
sl@0	1261	Tcl_DStringResult(interp, &theResult);
sl@0	1262	return TCL_OK;
sl@0	1263	} else if (c == 'l' && strncmp(argv[2], "language", length) == 0) {
sl@0	1264	Tcl_SetResult(interp, OSAComponent->languageName, TCL_STATIC);
sl@0	1265	return TCL_OK;
sl@0	1266	} else {
sl@0	1267	Tcl_AppendResult(interp, "Unknown argument \"", argv[2],
sl@0	1268	"\" for \"", argv[0], " info \", should be one of ",
sl@0	1269	"\"scripts\" \"language\", or \"contexts\"",
sl@0	1270	(char *) NULL);
sl@0	1271	return TCL_ERROR;
sl@0	1272	}
sl@0	1273	}
sl@0	1274
sl@0	1275	/*
sl@0	1276	*----------------------------------------------------------------------
sl@0	1277	*
sl@0	1278	* tclOSALoadCmd --
sl@0	1279	*
sl@0	1280	* This is the load subcommand for the Component Command
sl@0	1281	*
sl@0	1282	*
sl@0	1283	* Results:
sl@0	1284	* A standard Tcl result.
sl@0	1285	*
sl@0	1286	* Side effects:
sl@0	1287	* Loads script data from the given file, creates a new context
sl@0	1288	* for it, and sets interp's result to the name of the new context.
sl@0	1289	*
sl@0	1290	*----------------------------------------------------------------------
sl@0	1291	*/
sl@0	1292
sl@0	1293	static int
sl@0	1294	tclOSALoadCmd(
sl@0	1295	Tcl_Interp *interp,
sl@0	1296	tclOSAComponent *OSAComponent,
sl@0	1297	int argc,
sl@0	1298	CONST char **argv)
sl@0	1299	{
sl@0	1300	int tclError = TCL_OK, resID = 128;
sl@0	1301	char c, autoName[24],
sl@0	1302	contextName = NULL, scriptName = NULL;
sl@0	1303	CONST char *resName = NULL;
sl@0	1304	Boolean makeNewContext = false, makeContext = false;
sl@0	1305	AEDesc scrptDesc = { typeNull, NULL };
sl@0	1306	long modeFlags = kOSAModeCanInteract;
sl@0	1307	OSAID resultID = kOSANullScript,
sl@0	1308	contextID = kOSANullScript,
sl@0	1309	parentID = kOSANullScript;
sl@0	1310	OSAError osaErr = noErr;
sl@0	1311	OSErr sysErr = noErr;
sl@0	1312	long scptInfo;
sl@0	1313
sl@0	1314	autoName[0] = '\0';
sl@0	1315	scriptName = autoName;
sl@0	1316	contextName = autoName;
sl@0	1317
sl@0	1318	if (argc == 2) {
sl@0	1319	Tcl_AppendResult(interp,
sl@0	1320	"Error, no data for \"", argv[0], " ", argv[1],
sl@0	1321	"\"", (char *) NULL);
sl@0	1322	return TCL_ERROR;
sl@0	1323	}
sl@0	1324
sl@0	1325	argv += 2;
sl@0	1326	argc -= 2;
sl@0	1327
sl@0	1328	/*
sl@0	1329	* Do the argument parsing.
sl@0	1330	*/
sl@0	1331
sl@0	1332	while (argc > 0) {
sl@0	1333
sl@0	1334	if (*argv[0] == '-') {
sl@0	1335	c = *(argv[0] + 1);
sl@0	1336
sl@0	1337	/*
sl@0	1338	* "--" is the only switch that has no value.
sl@0	1339	*/
sl@0	1340
sl@0	1341	if (c == '-' && *(argv[0] + 2) == '\0') {
sl@0	1342	argv += 1;
sl@0	1343	argc--;
sl@0	1344	break;
sl@0	1345	}
sl@0	1346
sl@0	1347	/*
sl@0	1348	* So we can check here a switch with no value.
sl@0	1349	*/
sl@0	1350
sl@0	1351	if (argc == 1) {
sl@0	1352	Tcl_AppendResult(interp, "Error, no value given for switch ",
sl@0	1353	argv[0], (char *) NULL);
sl@0	1354	return TCL_ERROR;
sl@0	1355	}
sl@0	1356
sl@0	1357	if (c == 'r' && strcmp(argv[0] + 1, "rsrcname") == 0) {
sl@0	1358	resName = argv[1];
sl@0	1359	} else if (c == 'r' && strcmp(argv[0] + 1, "rsrcid") == 0) {
sl@0	1360	if (Tcl_GetInt(interp, argv[1], &resID) != TCL_OK) {
sl@0	1361	Tcl_AppendResult(interp,
sl@0	1362	"Error getting resource ID", (char *) NULL);
sl@0	1363	return TCL_ERROR;
sl@0	1364	}
sl@0	1365	} else {
sl@0	1366	Tcl_AppendResult(interp, "Error, invalid switch ", argv[0],
sl@0	1367	" should be \"--\", \"-rsrcname\" or \"-rsrcid\"",
sl@0	1368	(char *) NULL);
sl@0	1369	return TCL_ERROR;
sl@0	1370	}
sl@0	1371
sl@0	1372	argv += 2;
sl@0	1373	argc -= 2;
sl@0	1374	} else {
sl@0	1375	break;
sl@0	1376	}
sl@0	1377	}
sl@0	1378	/*
sl@0	1379	* Ok, now we have the options, so we can load the resource,
sl@0	1380	*/
sl@0	1381	if (argc == 0) {
sl@0	1382	Tcl_AppendResult(interp, "Error, no filename given", (char *) NULL);
sl@0	1383	return TCL_ERROR;
sl@0	1384	}
sl@0	1385
sl@0	1386	if (tclOSALoad(interp, OSAComponent, resName, resID,
sl@0	1387	argv[0], &resultID) != TCL_OK) {
sl@0	1388	Tcl_AppendResult(interp, "Error in load command", (char *) NULL);
sl@0	1389	return TCL_ERROR;
sl@0	1390	}
sl@0	1391
sl@0	1392	/*
sl@0	1393	* Now find out whether we have a script, or a script context.
sl@0	1394	*/
sl@0	1395
sl@0	1396	OSAGetScriptInfo(OSAComponent->theComponent, resultID,
sl@0	1397	kOSAScriptIsTypeScriptContext, &scptInfo);
sl@0	1398
sl@0	1399	if (scptInfo) {
sl@0	1400	autoName[0] = '\0';
sl@0	1401	tclOSAAddContext(OSAComponent, autoName, resultID);
sl@0	1402
sl@0	1403	Tcl_SetResult(interp, autoName, TCL_VOLATILE);
sl@0	1404	} else {
sl@0	1405	/*
sl@0	1406	* For a script, we return the script name
sl@0	1407	*/
sl@0	1408	autoName[0] = '\0';
sl@0	1409	tclOSAAddScript(OSAComponent, autoName, kOSAModeCanInteract, resultID);
sl@0	1410	Tcl_SetResult(interp, autoName, TCL_VOLATILE);
sl@0	1411	}
sl@0	1412	return TCL_OK;
sl@0	1413	}
sl@0	1414
sl@0	1415	/*
sl@0	1416	*----------------------------------------------------------------------
sl@0	1417	*
sl@0	1418	* tclOSARunCmd --
sl@0	1419	*
sl@0	1420	* This implements the run subcommand of the component command
sl@0	1421	*
sl@0	1422	* Results:
sl@0	1423	* A standard Tcl result.
sl@0	1424	*
sl@0	1425	* Side effects:
sl@0	1426	* Runs the given compiled script, and returns the OSA
sl@0	1427	* component's result.
sl@0	1428	*
sl@0	1429	*----------------------------------------------------------------------
sl@0	1430	*/
sl@0	1431
sl@0	1432	static int
sl@0	1433	tclOSARunCmd(
sl@0	1434	Tcl_Interp *interp,
sl@0	1435	tclOSAComponent *OSAComponent,
sl@0	1436	int argc,
sl@0	1437	CONST char **argv)
sl@0	1438	{
sl@0	1439	int tclError = TCL_OK,
sl@0	1440	resID = 128;
sl@0	1441	char c, *contextName = NULL,
sl@0	1442	*scriptName = NULL,
sl@0	1443	*resName = NULL;
sl@0	1444	AEDesc scrptDesc = { typeNull, NULL };
sl@0	1445	long modeFlags = kOSAModeCanInteract;
sl@0	1446	OSAID resultID = kOSANullScript,
sl@0	1447	contextID = kOSANullScript,
sl@0	1448	parentID = kOSANullScript;
sl@0	1449	OSAError osaErr = noErr;
sl@0	1450	OSErr sysErr = noErr;
sl@0	1451	CONST char *componentName = argv[0];
sl@0	1452	OSAID scriptID;
sl@0	1453
sl@0	1454	if (argc == 2) {
sl@0	1455	Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
sl@0	1456	argv[0], " ", argv[1], " scriptName", (char *) NULL);
sl@0	1457	return TCL_ERROR;
sl@0	1458	}
sl@0	1459
sl@0	1460	/*
sl@0	1461	* Set the context to the global context for this component,
sl@0	1462	* as a default
sl@0	1463	*/
sl@0	1464	if (tclOSAGetContextID(OSAComponent, "global", &contextID) != TCL_OK) {
sl@0	1465	Tcl_AppendResult(interp,
sl@0	1466	"Could not find the global context for component ",
sl@0	1467	OSAComponent->theName, (char *) NULL );
sl@0	1468	return TCL_ERROR;
sl@0	1469	}
sl@0	1470
sl@0	1471	/*
sl@0	1472	* Now parse the argument list for switches
sl@0	1473	*/
sl@0	1474	argv += 2;
sl@0	1475	argc -= 2;
sl@0	1476
sl@0	1477	while (argc > 0) {
sl@0	1478	if (*argv[0] == '-') {
sl@0	1479	c = *(argv[0] + 1);
sl@0	1480	/*
sl@0	1481	* "--" is the only switch that has no value
sl@0	1482	*/
sl@0	1483	if (c == '-' && *(argv[0] + 2) == '\0') {
sl@0	1484	argv += 1;
sl@0	1485	argc--;
sl@0	1486	break;
sl@0	1487	}
sl@0	1488
sl@0	1489	/*
sl@0	1490	* So we can check here for a switch with no value.
sl@0	1491	*/
sl@0	1492	if (argc == 1) {
sl@0	1493	Tcl_AppendResult(interp, "Error, no value given for switch ",
sl@0	1494	argv[0], (char *) NULL);
sl@0	1495	return TCL_ERROR;
sl@0	1496	}
sl@0	1497
sl@0	1498	if (c == 'c' && strcmp(argv[0] + 1, "context") == 0) {
sl@0	1499	if (argc == 1) {
sl@0	1500	Tcl_AppendResult(interp,
sl@0	1501	"Error - no context provided for the -context switch",
sl@0	1502	(char *) NULL);
sl@0	1503	return TCL_ERROR;
sl@0	1504	} else if (tclOSAGetContextID(OSAComponent,
sl@0	1505	argv[1], &contextID) == TCL_OK) {
sl@0	1506	} else {
sl@0	1507	Tcl_AppendResult(interp, "Script context \"", argv[1],
sl@0	1508	"\" not found", (char *) NULL);
sl@0	1509	return TCL_ERROR;
sl@0	1510	}
sl@0	1511	} else {
sl@0	1512	Tcl_AppendResult(interp, "Error, invalid switch ", argv[0],
sl@0	1513	" for ", componentName,
sl@0	1514	" should be \"-context\"", (char *) NULL);
sl@0	1515	return TCL_ERROR;
sl@0	1516	}
sl@0	1517	argv += 2;
sl@0	1518	argc -= 2;
sl@0	1519	} else {
sl@0	1520	break;
sl@0	1521	}
sl@0	1522	}
sl@0	1523
sl@0	1524	if (tclOSAGetScriptID(OSAComponent, argv[0], &scriptID) != TCL_OK) {
sl@0	1525	if (tclOSAGetContextID(OSAComponent, argv[0], &scriptID) != TCL_OK) {
sl@0	1526	Tcl_AppendResult(interp, "Could not find script \"",
sl@0	1527	argv[2], "\"", (char *) NULL);
sl@0	1528	return TCL_ERROR;
sl@0	1529	}
sl@0	1530	}
sl@0	1531
sl@0	1532	sysErr = OSAExecute(OSAComponent->theComponent,
sl@0	1533	scriptID, contextID, modeFlags, &resultID);
sl@0	1534
sl@0	1535	if (sysErr == errOSAScriptError) {
sl@0	1536	tclOSAASError(interp, OSAComponent->theComponent, (char *) NULL);
sl@0	1537	tclError = TCL_ERROR;
sl@0	1538	} else if (sysErr != noErr) {
sl@0	1539	char buffer[32];
sl@0	1540	sprintf(buffer, "Error #%6.6d encountered in run", sysErr);
sl@0	1541	Tcl_SetResult(interp, buffer, TCL_VOLATILE);
sl@0	1542	tclError = TCL_ERROR;
sl@0	1543	} else {
sl@0	1544	tclOSAResultFromID(interp, OSAComponent->theComponent, resultID );
sl@0	1545	}
sl@0	1546	OSADispose(OSAComponent->theComponent, resultID);
sl@0	1547
sl@0	1548	return tclError;
sl@0	1549	}
sl@0	1550
sl@0	1551	/*
sl@0	1552	*----------------------------------------------------------------------
sl@0	1553	*
sl@0	1554	* tclOSAStoreCmd --
sl@0	1555	*
sl@0	1556	* This implements the store subcommand of the component command
sl@0	1557	*
sl@0	1558	* Results:
sl@0	1559	* A standard Tcl result.
sl@0	1560	*
sl@0	1561	* Side effects:
sl@0	1562	* Runs the given compiled script, and returns the OSA
sl@0	1563	* component's result.
sl@0	1564	*
sl@0	1565	*----------------------------------------------------------------------
sl@0	1566	*/
sl@0	1567
sl@0	1568	static int
sl@0	1569	tclOSAStoreCmd(
sl@0	1570	Tcl_Interp *interp,
sl@0	1571	tclOSAComponent *OSAComponent,
sl@0	1572	int argc,
sl@0	1573	CONST char **argv)
sl@0	1574	{
sl@0	1575	int tclError = TCL_OK, resID = 128;
sl@0	1576	char c, contextName = NULL, scriptName = NULL;
sl@0	1577	CONST char *resName = NULL;
sl@0	1578	Boolean makeNewContext = false, makeContext = false;
sl@0	1579	AEDesc scrptDesc = { typeNull, NULL };
sl@0	1580	long modeFlags = kOSAModeCanInteract;
sl@0	1581	OSAID resultID = kOSANullScript,
sl@0	1582	contextID = kOSANullScript,
sl@0	1583	parentID = kOSANullScript;
sl@0	1584	OSAError osaErr = noErr;
sl@0	1585	OSErr sysErr = noErr;
sl@0	1586
sl@0	1587	if (argc == 2) {
sl@0	1588	Tcl_AppendResult(interp, "Error, no data for \"", argv[0],
sl@0	1589	" ",argv[1], "\"", (char *) NULL);
sl@0	1590	return TCL_ERROR;
sl@0	1591	}
sl@0	1592
sl@0	1593	argv += 2;
sl@0	1594	argc -= 2;
sl@0	1595
sl@0	1596	/*
sl@0	1597	* Do the argument parsing
sl@0	1598	*/
sl@0	1599
sl@0	1600	while (argc > 0) {
sl@0	1601	if (*argv[0] == '-') {
sl@0	1602	c = *(argv[0] + 1);
sl@0	1603
sl@0	1604	/*
sl@0	1605	* "--" is the only switch that has no value
sl@0	1606	*/
sl@0	1607	if (c == '-' && *(argv[0] + 2) == '\0') {
sl@0	1608	argv += 1;
sl@0	1609	argc--;
sl@0	1610	break;
sl@0	1611	}
sl@0	1612
sl@0	1613	/*
sl@0	1614	* So we can check here a switch with no value.
sl@0	1615	*/
sl@0	1616	if (argc == 1) {
sl@0	1617	Tcl_AppendResult(interp,
sl@0	1618	"Error, no value given for switch ",
sl@0	1619	argv[0], (char *) NULL);
sl@0	1620	return TCL_ERROR;
sl@0	1621	}
sl@0	1622
sl@0	1623	if (c == 'r' && strcmp(argv[0] + 1, "rsrcname") == 0) {
sl@0	1624	resName = argv[1];
sl@0	1625	} else if (c == 'r' && strcmp(argv[0] + 1, "rsrcid") == 0) {
sl@0	1626	if (Tcl_GetInt(interp, argv[1], &resID) != TCL_OK) {
sl@0	1627	Tcl_AppendResult(interp,
sl@0	1628	"Error getting resource ID", (char *) NULL);
sl@0	1629	return TCL_ERROR;
sl@0	1630	}
sl@0	1631	} else {
sl@0	1632	Tcl_AppendResult(interp, "Error, invalid switch ", argv[0],
sl@0	1633	" should be \"--\", \"-rsrcname\" or \"-rsrcid\"",
sl@0	1634	(char *) NULL);
sl@0	1635	return TCL_ERROR;
sl@0	1636	}
sl@0	1637
sl@0	1638	argv += 2;
sl@0	1639	argc -= 2;
sl@0	1640	} else {
sl@0	1641	break;
sl@0	1642	}
sl@0	1643	}
sl@0	1644	/*
sl@0	1645	* Ok, now we have the options, so we can load the resource,
sl@0	1646	*/
sl@0	1647	if (argc != 2) {
sl@0	1648	Tcl_AppendResult(interp, "Error, wrong # of arguments, should be ",
sl@0	1649	argv[0], " ", argv[1], "?option flag? scriptName fileName",
sl@0	1650	(char *) NULL);
sl@0	1651	return TCL_ERROR;
sl@0	1652	}
sl@0	1653
sl@0	1654	if (tclOSAStore(interp, OSAComponent, resName, resID,
sl@0	1655	argv[0], argv[1]) != TCL_OK) {
sl@0	1656	Tcl_AppendResult(interp, "Error in load command", (char *) NULL);
sl@0	1657	return TCL_ERROR;
sl@0	1658	} else {
sl@0	1659	Tcl_ResetResult(interp);
sl@0	1660	tclError = TCL_OK;
sl@0	1661	}
sl@0	1662
sl@0	1663	return tclError;
sl@0	1664	}
sl@0	1665
sl@0	1666	/*
sl@0	1667	*----------------------------------------------------------------------
sl@0	1668	*
sl@0	1669	* tclOSAMakeNewComponent --
sl@0	1670	*
sl@0	1671	* Makes a command cmdName to represent a new connection to the
sl@0	1672	* OSA component with componentSubType scriptSubtype.
sl@0	1673	*
sl@0	1674	* Results:
sl@0	1675	* Returns the tclOSAComponent structure for the connection.
sl@0	1676	*
sl@0	1677	* Side Effects:
sl@0	1678	* Adds a new element to the component table. If there is an
sl@0	1679	* error, then the result of the Tcl interpreter interp is set
sl@0	1680	* to an appropriate error message.
sl@0	1681	*
sl@0	1682	*----------------------------------------------------------------------
sl@0	1683	*/
sl@0	1684
sl@0	1685	tclOSAComponent *
sl@0	1686	tclOSAMakeNewComponent(
sl@0	1687	Tcl_Interp *interp,
sl@0	1688	char *cmdName,
sl@0	1689	char *languageName,
sl@0	1690	OSType scriptSubtype,
sl@0	1691	long componentFlags)
sl@0	1692	{
sl@0	1693	char buffer[32];
sl@0	1694	AEDesc resultingName = {typeNull, NULL};
sl@0	1695	AEDesc nullDesc = {typeNull, NULL };
sl@0	1696	OSAID globalContext;
sl@0	1697	char global[] = "global";
sl@0	1698	int nbytes;
sl@0	1699	ComponentDescription requestedComponent = {
sl@0	1700	kOSAComponentType,
sl@0	1701	(OSType) 0,
sl@0	1702	(OSType) 0,
sl@0	1703	(long int) 0,
sl@0	1704	(long int) 0
sl@0	1705	};
sl@0	1706	Tcl_HashTable *ComponentTable;
sl@0	1707	Component foundComponent = NULL;
sl@0	1708	OSAActiveUPP myActiveProcUPP;
sl@0	1709
sl@0	1710	tclOSAComponent *newComponent;
sl@0	1711	Tcl_HashEntry *hashEntry;
sl@0	1712	int newPtr;
sl@0	1713
sl@0	1714	requestedComponent.componentSubType = scriptSubtype;
sl@0	1715	nbytes = sizeof(tclOSAComponent);
sl@0	1716	newComponent = (tclOSAComponent *) ckalloc(sizeof(tclOSAComponent));
sl@0	1717	if (newComponent == NULL) {
sl@0	1718	goto CleanUp;
sl@0	1719	}
sl@0	1720
sl@0	1721	foundComponent = FindNextComponent(0, &requestedComponent);
sl@0	1722	if (foundComponent == 0) {
sl@0	1723	Tcl_AppendResult(interp,
sl@0	1724	"Could not find component of requested type", (char *) NULL);
sl@0	1725	goto CleanUp;
sl@0	1726	}
sl@0	1727
sl@0	1728	newComponent->theComponent = OpenComponent(foundComponent);
sl@0	1729
sl@0	1730	if (newComponent->theComponent == NULL) {
sl@0	1731	Tcl_AppendResult(interp,
sl@0	1732	"Could not open component of the requested type",
sl@0	1733	(char *) NULL);
sl@0	1734	goto CleanUp;
sl@0	1735	}
sl@0	1736
sl@0	1737	newComponent->languageName = (char *) ckalloc(strlen(languageName) + 1);
sl@0	1738	strcpy(newComponent->languageName,languageName);
sl@0	1739
sl@0	1740	newComponent->componentFlags = componentFlags;
sl@0	1741
sl@0	1742	newComponent->theInterp = interp;
sl@0	1743
sl@0	1744	Tcl_InitHashTable(&newComponent->contextTable, TCL_STRING_KEYS);
sl@0	1745	Tcl_InitHashTable(&newComponent->scriptTable, TCL_STRING_KEYS);
sl@0	1746
sl@0	1747	if (tclOSAMakeContext(newComponent, global, &globalContext) != TCL_OK) {
sl@0	1748	sprintf(buffer, "%-6.6ld", globalContext);
sl@0	1749	Tcl_AppendResult(interp, "Error ", buffer, " making ", global,
sl@0	1750	" context.", (char *) NULL);
sl@0	1751	goto CleanUp;
sl@0	1752	}
sl@0	1753
sl@0	1754	newComponent->languageID = scriptSubtype;
sl@0	1755
sl@0	1756	newComponent->theName = (char *) ckalloc(strlen(cmdName) + 1 );
sl@0	1757	strcpy(newComponent->theName, cmdName);
sl@0	1758
sl@0	1759	Tcl_CreateCommand(interp, newComponent->theName, Tcl_OSAComponentCmd,
sl@0	1760	(ClientData) newComponent, tclOSAClose);
sl@0	1761
sl@0	1762	/*
sl@0	1763	* Register the new component with the component table
sl@0	1764	*/
sl@0	1765
sl@0	1766	ComponentTable = (Tcl_HashTable *) Tcl_GetAssocData(interp,
sl@0	1767	"OSAScript_CompTable", (Tcl_InterpDeleteProc **) NULL);
sl@0	1768
sl@0	1769	if (ComponentTable == NULL) {
sl@0	1770	Tcl_AppendResult(interp, "Error, could not get the Component Table",
sl@0	1771	" from the Associated data.", (char *) NULL);
sl@0	1772	return (tclOSAComponent *) NULL;
sl@0	1773	}
sl@0	1774
sl@0	1775	hashEntry = Tcl_CreateHashEntry(ComponentTable,
sl@0	1776	newComponent->theName, &newPtr);
sl@0	1777	Tcl_SetHashValue(hashEntry, (ClientData) newComponent);
sl@0	1778
sl@0	1779	/*
sl@0	1780	* Set the active proc to call Tcl_DoOneEvent() while idle
sl@0	1781	*/
sl@0	1782	if (OSAGetActiveProc(newComponent->theComponent,
sl@0	1783	&newComponent->defActiveProc, &newComponent->defRefCon) != noErr ) {
sl@0	1784	/* TODO -- clean up here... */
sl@0	1785	}
sl@0	1786
sl@0	1787	myActiveProcUPP = NewOSAActiveUPP(TclOSAActiveProc);
sl@0	1788	OSASetActiveProc(newComponent->theComponent,
sl@0	1789	myActiveProcUPP, (long) newComponent);
sl@0	1790	return newComponent;
sl@0	1791
sl@0	1792	CleanUp:
sl@0	1793
sl@0	1794	ckfree((char *) newComponent);
sl@0	1795	return (tclOSAComponent *) NULL;
sl@0	1796	}
sl@0	1797
sl@0	1798	/*
sl@0	1799	*----------------------------------------------------------------------
sl@0	1800	*
sl@0	1801	* tclOSAClose --
sl@0	1802	*
sl@0	1803	* This procedure closes the connection to an OSA component, and
sl@0	1804	* deletes all the script and context data associated with it.
sl@0	1805	* It is the command deletion callback for the component's command.
sl@0	1806	*
sl@0	1807	* Results:
sl@0	1808	* None
sl@0	1809	*
sl@0	1810	* Side effects:
sl@0	1811	* Closes the connection, and releases all the script data.
sl@0	1812	*
sl@0	1813	*----------------------------------------------------------------------
sl@0	1814	*/
sl@0	1815
sl@0	1816	void
sl@0	1817	tclOSAClose(
sl@0	1818	ClientData clientData)
sl@0	1819	{
sl@0	1820	tclOSAComponent theComponent = (tclOSAComponent ) clientData;
sl@0	1821	Tcl_HashEntry *hashEntry;
sl@0	1822	Tcl_HashSearch search;
sl@0	1823	tclOSAScript *theScript;
sl@0	1824	Tcl_HashTable *ComponentTable;
sl@0	1825
sl@0	1826	/*
sl@0	1827	* Delete the context and script tables
sl@0	1828	* the memory for the language name, and
sl@0	1829	* the hash entry.
sl@0	1830	*/
sl@0	1831
sl@0	1832	for (hashEntry = Tcl_FirstHashEntry(&theComponent->scriptTable, &search);
sl@0	1833	hashEntry != NULL;
sl@0	1834	hashEntry = Tcl_NextHashEntry(&search)) {
sl@0	1835
sl@0	1836	theScript = (tclOSAScript *) Tcl_GetHashValue(hashEntry);
sl@0	1837	OSADispose(theComponent->theComponent, theScript->scriptID);
sl@0	1838	ckfree((char *) theScript);
sl@0	1839	Tcl_DeleteHashEntry(hashEntry);
sl@0	1840	}
sl@0	1841
sl@0	1842	for (hashEntry = Tcl_FirstHashEntry(&theComponent->contextTable, &search);
sl@0	1843	hashEntry != NULL;
sl@0	1844	hashEntry = Tcl_NextHashEntry(&search)) {
sl@0	1845
sl@0	1846	Tcl_DeleteHashEntry(hashEntry);
sl@0	1847	}
sl@0	1848
sl@0	1849	ckfree(theComponent->languageName);
sl@0	1850	ckfree(theComponent->theName);
sl@0	1851
sl@0	1852	/*
sl@0	1853	* Finally close the component
sl@0	1854	*/
sl@0	1855
sl@0	1856	CloseComponent(theComponent->theComponent);
sl@0	1857
sl@0	1858	ComponentTable = (Tcl_HashTable *)
sl@0	1859	Tcl_GetAssocData(theComponent->theInterp,
sl@0	1860	"OSAScript_CompTable", (Tcl_InterpDeleteProc **) NULL);
sl@0	1861
sl@0	1862	if (ComponentTable == NULL) {
sl@0	1863	panic("Error, could not get the Component Table from the Associated data.");
sl@0	1864	}
sl@0	1865
sl@0	1866	hashEntry = Tcl_FindHashEntry(ComponentTable, theComponent->theName);
sl@0	1867	if (hashEntry != NULL) {
sl@0	1868	Tcl_DeleteHashEntry(hashEntry);
sl@0	1869	}
sl@0	1870
sl@0	1871	ckfree((char *) theComponent);
sl@0	1872	}
sl@0	1873
sl@0	1874	/*
sl@0	1875	*----------------------------------------------------------------------
sl@0	1876	*
sl@0	1877	* tclOSAGetContextID --
sl@0	1878	*
sl@0	1879	* This returns the context ID, given the component name.
sl@0	1880	*
sl@0	1881	* Results:
sl@0	1882	* A context ID
sl@0	1883	*
sl@0	1884	* Side effects:
sl@0	1885	* None
sl@0	1886	*
sl@0	1887	*----------------------------------------------------------------------
sl@0	1888	*/
sl@0	1889
sl@0	1890	static int
sl@0	1891	tclOSAGetContextID(
sl@0	1892	tclOSAComponent *theComponent,
sl@0	1893	CONST char *contextName,
sl@0	1894	OSAID *theContext)
sl@0	1895	{
sl@0	1896	Tcl_HashEntry *hashEntry;
sl@0	1897	tclOSAContext *contextStruct;
sl@0	1898
sl@0	1899	if ((hashEntry = Tcl_FindHashEntry(&theComponent->contextTable,
sl@0	1900	contextName)) == NULL ) {
sl@0	1901	return TCL_ERROR;
sl@0	1902	} else {
sl@0	1903	contextStruct = (tclOSAContext *) Tcl_GetHashValue(hashEntry);
sl@0	1904	*theContext = contextStruct->contextID;
sl@0	1905	}
sl@0	1906	return TCL_OK;
sl@0	1907	}
sl@0	1908
sl@0	1909	/*
sl@0	1910	*----------------------------------------------------------------------
sl@0	1911	*
sl@0	1912	* tclOSAAddContext --
sl@0	1913	*
sl@0	1914	* This adds the context ID, with the name contextName. If the
sl@0	1915	* name is passed in as a NULL string, space is malloc'ed for the
sl@0	1916	* string and a new name is made up, if the string is empty, you
sl@0	1917	* must have allocated enough space ( 24 characters is fine) for
sl@0	1918	* the name, which is made up and passed out.
sl@0	1919	*
sl@0	1920	* Results:
sl@0	1921	* Nothing
sl@0	1922	*
sl@0	1923	* Side effects:
sl@0	1924	* Adds the script context to the component's context table.
sl@0	1925	*
sl@0	1926	*----------------------------------------------------------------------
sl@0	1927	*/
sl@0	1928
sl@0	1929	static void
sl@0	1930	tclOSAAddContext(
sl@0	1931	tclOSAComponent *theComponent,
sl@0	1932	char *contextName,
sl@0	1933	const OSAID theContext)
sl@0	1934	{
sl@0	1935	static unsigned short contextIndex = 0;
sl@0	1936	tclOSAContext *contextStruct;
sl@0	1937	Tcl_HashEntry *hashEntry;
sl@0	1938	int newPtr;
sl@0	1939
sl@0	1940	if (contextName == NULL) {
sl@0	1941	contextName = ckalloc(16 + TCL_INTEGER_SPACE);
sl@0	1942	sprintf(contextName, "OSAContext%d", contextIndex++);
sl@0	1943	} else if (*contextName == '\0') {
sl@0	1944	sprintf(contextName, "OSAContext%d", contextIndex++);
sl@0	1945	}
sl@0	1946
sl@0	1947	hashEntry = Tcl_CreateHashEntry(&theComponent->contextTable,
sl@0	1948	contextName, &newPtr);
sl@0	1949
sl@0	1950	contextStruct = (tclOSAContext *) ckalloc(sizeof(tclOSAContext));
sl@0	1951	contextStruct->contextID = theContext;
sl@0	1952	Tcl_SetHashValue(hashEntry,(ClientData) contextStruct);
sl@0	1953	}
sl@0	1954
sl@0	1955	/*
sl@0	1956	*----------------------------------------------------------------------
sl@0	1957	*
sl@0	1958	* tclOSADeleteContext --
sl@0	1959	*
sl@0	1960	* This deletes the context struct, with the name contextName.
sl@0	1961	*
sl@0	1962	* Results:
sl@0	1963	* A normal Tcl result
sl@0	1964	*
sl@0	1965	* Side effects:
sl@0	1966	* Removes the script context to the component's context table,
sl@0	1967	* and deletes the data associated with it.
sl@0	1968	*
sl@0	1969	*----------------------------------------------------------------------
sl@0	1970	*/
sl@0	1971
sl@0	1972	static int
sl@0	1973	tclOSADeleteContext(
sl@0	1974	tclOSAComponent *theComponent,
sl@0	1975	CONST char *contextName)
sl@0	1976	{
sl@0	1977	Tcl_HashEntry *hashEntry;
sl@0	1978	tclOSAContext *contextStruct;
sl@0	1979
sl@0	1980	hashEntry = Tcl_FindHashEntry(&theComponent->contextTable, contextName);
sl@0	1981	if (hashEntry == NULL) {
sl@0	1982	return TCL_ERROR;
sl@0	1983	}
sl@0	1984	/*
sl@0	1985	* Dispose of the script context data
sl@0	1986	*/
sl@0	1987	contextStruct = (tclOSAContext *) Tcl_GetHashValue(hashEntry);
sl@0	1988	OSADispose(theComponent->theComponent,contextStruct->contextID);
sl@0	1989	/*
sl@0	1990	* Then the hash entry
sl@0	1991	*/
sl@0	1992	ckfree((char *) contextStruct);
sl@0	1993	Tcl_DeleteHashEntry(hashEntry);
sl@0	1994	return TCL_OK;
sl@0	1995	}
sl@0	1996
sl@0	1997	/*
sl@0	1998	*----------------------------------------------------------------------
sl@0	1999	*
sl@0	2000	* tclOSAMakeContext --
sl@0	2001	*
sl@0	2002	* This makes the context with name contextName, and returns the ID.
sl@0	2003	*
sl@0	2004	* Results:
sl@0	2005	* A standard Tcl result
sl@0	2006	*
sl@0	2007	* Side effects:
sl@0	2008	* Makes a new context, adds it to the context table, and returns
sl@0	2009	* the new contextID in the variable theContext.
sl@0	2010	*
sl@0	2011	*----------------------------------------------------------------------
sl@0	2012	*/
sl@0	2013
sl@0	2014	static int
sl@0	2015	tclOSAMakeContext(
sl@0	2016	tclOSAComponent *theComponent,
sl@0	2017	CONST char *contextName,
sl@0	2018	OSAID *theContext)
sl@0	2019	{
sl@0	2020	AEDesc contextNameDesc = {typeNull, NULL};
sl@0	2021	OSAError osaErr = noErr;
sl@0	2022
sl@0	2023	AECreateDesc(typeChar, contextName, strlen(contextName), &contextNameDesc);
sl@0	2024	osaErr = OSAMakeContext(theComponent->theComponent, &contextNameDesc,
sl@0	2025	kOSANullScript, theContext);
sl@0	2026
sl@0	2027	AEDisposeDesc(&contextNameDesc);
sl@0	2028
sl@0	2029	if (osaErr == noErr) {
sl@0	2030	char name[24];
sl@0	2031	strncpy(name, contextName, 23);
sl@0	2032	name[23] = '\0';
sl@0	2033	tclOSAAddContext(theComponent, name, *theContext);
sl@0	2034	} else {
sl@0	2035	*theContext = (OSAID) osaErr;
sl@0	2036	return TCL_ERROR;
sl@0	2037	}
sl@0	2038
sl@0	2039	return TCL_OK;
sl@0	2040	}
sl@0	2041
sl@0	2042	/*
sl@0	2043	*----------------------------------------------------------------------
sl@0	2044	*
sl@0	2045	* tclOSAStore --
sl@0	2046	*
sl@0	2047	* This stores a script resource from the file named in fileName.
sl@0	2048	*
sl@0	2049	* Most of this routine is caged from the Tcl Source, from the
sl@0	2050	* Tcl_MacSourceCmd routine. This is good, since it ensures this
sl@0	2051	* follows the same convention for looking up files as Tcl.
sl@0	2052	*
sl@0	2053	* Returns
sl@0	2054	* A standard Tcl result.
sl@0	2055	*
sl@0	2056	* Side Effects:
sl@0	2057	* The given script data is stored in the file fileName.
sl@0	2058	*
sl@0	2059	*----------------------------------------------------------------------
sl@0	2060	*/
sl@0	2061
sl@0	2062	int
sl@0	2063	tclOSAStore(
sl@0	2064	Tcl_Interp *interp,
sl@0	2065	tclOSAComponent *theComponent,
sl@0	2066	CONST char *resourceName,
sl@0	2067	int resourceNumber,
sl@0	2068	CONST char *scriptName,
sl@0	2069	CONST char *fileName)
sl@0	2070	{
sl@0	2071	Handle resHandle;
sl@0	2072	Str255 rezName;
sl@0	2073	int result = TCL_OK;
sl@0	2074	short saveRef, fileRef = -1;
sl@0	2075	char idStr[16 + TCL_INTEGER_SPACE];
sl@0	2076	FSSpec fileSpec;
sl@0	2077	Tcl_DString ds, buffer;
sl@0	2078	CONST char *nativeName;
sl@0	2079	OSErr myErr = noErr;
sl@0	2080	OSAID scriptID;
sl@0	2081	Size scriptSize;
sl@0	2082	AEDesc scriptData;
sl@0	2083
sl@0	2084	/*
sl@0	2085	* First extract the script data
sl@0	2086	*/
sl@0	2087
sl@0	2088	if (tclOSAGetScriptID(theComponent, scriptName, &scriptID) != TCL_OK ) {
sl@0	2089	if (tclOSAGetContextID(theComponent, scriptName, &scriptID)
sl@0	2090	!= TCL_OK) {
sl@0	2091	Tcl_AppendResult(interp, "Error getting script ",
sl@0	2092	scriptName, (char *) NULL);
sl@0	2093	return TCL_ERROR;
sl@0	2094	}
sl@0	2095	}
sl@0	2096
sl@0	2097	myErr = OSAStore(theComponent->theComponent, scriptID,
sl@0	2098	typeOSAGenericStorage, kOSAModeNull, &scriptData);
sl@0	2099	if (myErr != noErr) {
sl@0	2100	sprintf(idStr, "%d", myErr);
sl@0	2101	Tcl_AppendResult(interp, "Error #", idStr,
sl@0	2102	" storing script ", scriptName, (char *) NULL);
sl@0	2103	return TCL_ERROR;
sl@0	2104	}
sl@0	2105
sl@0	2106	/*
sl@0	2107	* Now try to open the output file
sl@0	2108	*/
sl@0	2109
sl@0	2110	saveRef = CurResFile();
sl@0	2111
sl@0	2112	if (fileName != NULL) {
sl@0	2113	OSErr err;
sl@0	2114
sl@0	2115	if (Tcl_TranslateFileName(interp, fileName, &buffer) == NULL) {
sl@0	2116	return TCL_ERROR;
sl@0	2117	}
sl@0	2118	nativeName = Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&buffer),
sl@0	2119	Tcl_DStringLength(&buffer), &ds);
sl@0	2120	err = FSpLocationFromPath(strlen(nativeName), nativeName, &fileSpec);
sl@0	2121
sl@0	2122	Tcl_DStringFree(&ds);
sl@0	2123	Tcl_DStringFree(&buffer);
sl@0	2124	if ((err != noErr) && (err != fnfErr)) {
sl@0	2125	Tcl_AppendResult(interp,
sl@0	2126	"Error getting a location for the file: \"",
sl@0	2127	fileName, "\".", NULL);
sl@0	2128	return TCL_ERROR;
sl@0	2129	}
sl@0	2130
sl@0	2131	FSpCreateResFileCompatTcl(&fileSpec,
sl@0	2132	'WiSH', 'osas', smSystemScript);
sl@0	2133	myErr = ResError();
sl@0	2134
sl@0	2135	if ((myErr != noErr) && (myErr != dupFNErr)) {
sl@0	2136	sprintf(idStr, "%d", myErr);
sl@0	2137	Tcl_AppendResult(interp, "Error #", idStr,
sl@0	2138	" creating new resource file ", fileName, (char *) NULL);
sl@0	2139	result = TCL_ERROR;
sl@0	2140	goto rezEvalCleanUp;
sl@0	2141	}
sl@0	2142
sl@0	2143	fileRef = FSpOpenResFileCompatTcl(&fileSpec, fsRdWrPerm);
sl@0	2144	if (fileRef == -1) {
sl@0	2145	Tcl_AppendResult(interp, "Error reading the file: \"",
sl@0	2146	fileName, "\".", NULL);
sl@0	2147	result = TCL_ERROR;
sl@0	2148	goto rezEvalCleanUp;
sl@0	2149	}
sl@0	2150	UseResFile(fileRef);
sl@0	2151	} else {
sl@0	2152	/*
sl@0	2153	* The default behavior will search through all open resource files.
sl@0	2154	* This may not be the behavior you desire. If you want the behavior
sl@0	2155	* of this call to only search the application resource fork, you
sl@0	2156	* must call UseResFile at this point to set it to the application
sl@0	2157	* file. This means you must have already obtained the application's
sl@0	2158	* fileRef when the application started up.
sl@0	2159	*/
sl@0	2160	}
sl@0	2161
sl@0	2162	/*
sl@0	2163	* Load the resource by name
sl@0	2164	*/
sl@0	2165	if (resourceName != NULL) {
sl@0	2166	strcpy((char *) rezName + 1, resourceName);
sl@0	2167	rezName[0] = strlen(resourceName);
sl@0	2168	resHandle = Get1NamedResource('scpt', rezName);
sl@0	2169	myErr = ResError();
sl@0	2170	if (resHandle == NULL) {
sl@0	2171	/*
sl@0	2172	* These signify either the resource or the resource
sl@0	2173	* type were not found
sl@0	2174	*/
sl@0	2175	if (myErr == resNotFound \|\| myErr == noErr) {
sl@0	2176	short uniqueID;
sl@0	2177	while ((uniqueID = Unique1ID('scpt') ) < 128) {}
sl@0	2178	AddResource(scriptData.dataHandle, 'scpt', uniqueID, rezName);
sl@0	2179	WriteResource(resHandle);
sl@0	2180	result = TCL_OK;
sl@0	2181	goto rezEvalCleanUp;
sl@0	2182	} else {
sl@0	2183	/*
sl@0	2184	* This means there was some other error, for now
sl@0	2185	* I just bag out.
sl@0	2186	*/
sl@0	2187	sprintf(idStr, "%d", myErr);
sl@0	2188	Tcl_AppendResult(interp, "Error #", idStr,
sl@0	2189	" opening scpt resource named ", resourceName,
sl@0	2190	" in file ", fileName, (char *) NULL);
sl@0	2191	result = TCL_ERROR;
sl@0	2192	goto rezEvalCleanUp;
sl@0	2193	}
sl@0	2194	}
sl@0	2195	/*
sl@0	2196	* Or ID
sl@0	2197	*/
sl@0	2198	} else {
sl@0	2199	resHandle = Get1Resource('scpt', resourceNumber);
sl@0	2200	rezName[0] = 0;
sl@0	2201	rezName[1] = '\0';
sl@0	2202	myErr = ResError();
sl@0	2203	if (resHandle == NULL) {
sl@0	2204	/*
sl@0	2205	* These signify either the resource or the resource
sl@0	2206	* type were not found
sl@0	2207	*/
sl@0	2208	if (myErr == resNotFound \|\| myErr == noErr) {
sl@0	2209	AddResource(scriptData.dataHandle, 'scpt',
sl@0	2210	resourceNumber, rezName);
sl@0	2211	WriteResource(resHandle);
sl@0	2212	result = TCL_OK;
sl@0	2213	goto rezEvalCleanUp;
sl@0	2214	} else {
sl@0	2215	/*
sl@0	2216	* This means there was some other error, for now
sl@0	2217	* I just bag out */
sl@0	2218	sprintf(idStr, "%d", myErr);
sl@0	2219	Tcl_AppendResult(interp, "Error #", idStr,
sl@0	2220	" opening scpt resource named ", resourceName,
sl@0	2221	" in file ", fileName,(char *) NULL);
sl@0	2222	result = TCL_ERROR;
sl@0	2223	goto rezEvalCleanUp;
sl@0	2224	}
sl@0	2225	}
sl@0	2226	}
sl@0	2227
sl@0	2228	/*
sl@0	2229	* We get to here if the resource exists
sl@0	2230	* we just copy into it...
sl@0	2231	*/
sl@0	2232
sl@0	2233	scriptSize = GetHandleSize(scriptData.dataHandle);
sl@0	2234	SetHandleSize(resHandle, scriptSize);
sl@0	2235	HLock(scriptData.dataHandle);
sl@0	2236	HLock(resHandle);
sl@0	2237	BlockMove(scriptData.dataHandle, resHandle,scriptSize);
sl@0	2238	HUnlock(scriptData.dataHandle);
sl@0	2239	HUnlock(resHandle);
sl@0	2240	ChangedResource(resHandle);
sl@0	2241	WriteResource(resHandle);
sl@0	2242	result = TCL_OK;
sl@0	2243	goto rezEvalCleanUp;
sl@0	2244
sl@0	2245	rezEvalError:
sl@0	2246	sprintf(idStr, "ID=%d", resourceNumber);
sl@0	2247	Tcl_AppendResult(interp, "The resource \"",
sl@0	2248	(resourceName != NULL ? resourceName : idStr),
sl@0	2249	"\" could not be loaded from ",
sl@0	2250	(fileName != NULL ? fileName : "application"),
sl@0	2251	".", NULL);
sl@0	2252
sl@0	2253	rezEvalCleanUp:
sl@0	2254	if (fileRef != -1) {
sl@0	2255	CloseResFile(fileRef);
sl@0	2256	}
sl@0	2257
sl@0	2258	UseResFile(saveRef);
sl@0	2259
sl@0	2260	return result;
sl@0	2261	}
sl@0	2262
sl@0	2263	/*----------------------------------------------------------------------
sl@0	2264	*
sl@0	2265	* tclOSALoad --
sl@0	2266	*
sl@0	2267	* This loads a script resource from the file named in fileName.
sl@0	2268	* Most of this routine is caged from the Tcl Source, from the
sl@0	2269	* Tcl_MacSourceCmd routine. This is good, since it ensures this
sl@0	2270	* follows the same convention for looking up files as Tcl.
sl@0	2271	*
sl@0	2272	* Returns
sl@0	2273	* A standard Tcl result.
sl@0	2274	*
sl@0	2275	* Side Effects:
sl@0	2276	* A new script element is created from the data in the file.
sl@0	2277	* The script ID is passed out in the variable resultID.
sl@0	2278	*
sl@0	2279	*----------------------------------------------------------------------
sl@0	2280	*/
sl@0	2281
sl@0	2282	int
sl@0	2283	tclOSALoad(
sl@0	2284	Tcl_Interp *interp,
sl@0	2285	tclOSAComponent *theComponent,
sl@0	2286	CONST char *resourceName,
sl@0	2287	int resourceNumber,
sl@0	2288	CONST char *fileName,
sl@0	2289	OSAID *resultID)
sl@0	2290	{
sl@0	2291	Handle sourceData;
sl@0	2292	Str255 rezName;
sl@0	2293	int result = TCL_OK;
sl@0	2294	short saveRef, fileRef = -1;
sl@0	2295	char idStr[16 + TCL_INTEGER_SPACE];
sl@0	2296	FSSpec fileSpec;
sl@0	2297	Tcl_DString ds, buffer;
sl@0	2298	CONST char *nativeName;
sl@0	2299
sl@0	2300	saveRef = CurResFile();
sl@0	2301
sl@0	2302	if (fileName != NULL) {
sl@0	2303	OSErr err;
sl@0	2304
sl@0	2305	if (Tcl_TranslateFileName(interp, fileName, &buffer) == NULL) {
sl@0	2306	return TCL_ERROR;
sl@0	2307	}
sl@0	2308	nativeName = Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&buffer),
sl@0	2309	Tcl_DStringLength(&buffer), &ds);
sl@0	2310	err = FSpLocationFromPath(strlen(nativeName), nativeName, &fileSpec);
sl@0	2311	Tcl_DStringFree(&ds);
sl@0	2312	Tcl_DStringFree(&buffer);
sl@0	2313	if (err != noErr) {
sl@0	2314	Tcl_AppendResult(interp, "Error finding the file: \"",
sl@0	2315	fileName, "\".", NULL);
sl@0	2316	return TCL_ERROR;
sl@0	2317	}
sl@0	2318
sl@0	2319	fileRef = FSpOpenResFileCompatTcl(&fileSpec, fsRdPerm);
sl@0	2320	if (fileRef == -1) {
sl@0	2321	Tcl_AppendResult(interp, "Error reading the file: \"",
sl@0	2322	fileName, "\".", NULL);
sl@0	2323	return TCL_ERROR;
sl@0	2324	}
sl@0	2325	UseResFile(fileRef);
sl@0	2326	} else {
sl@0	2327	/*
sl@0	2328	* The default behavior will search through all open resource files.
sl@0	2329	* This may not be the behavior you desire. If you want the behavior
sl@0	2330	* of this call to only search the application resource fork, you
sl@0	2331	* must call UseResFile at this point to set it to the application
sl@0	2332	* file. This means you must have already obtained the application's
sl@0	2333	* fileRef when the application started up.
sl@0	2334	*/
sl@0	2335	}
sl@0	2336
sl@0	2337	/*
sl@0	2338	* Load the resource by name or ID
sl@0	2339	*/
sl@0	2340	if (resourceName != NULL) {
sl@0	2341	strcpy((char *) rezName + 1, resourceName);
sl@0	2342	rezName[0] = strlen(resourceName);
sl@0	2343	sourceData = GetNamedResource('scpt', rezName);
sl@0	2344	} else {
sl@0	2345	sourceData = GetResource('scpt', (short) resourceNumber);
sl@0	2346	}
sl@0	2347
sl@0	2348	if (sourceData == NULL) {
sl@0	2349	result = TCL_ERROR;
sl@0	2350	} else {
sl@0	2351	AEDesc scriptDesc;
sl@0	2352	OSAError osaErr;
sl@0	2353
sl@0	2354	scriptDesc.descriptorType = typeOSAGenericStorage;
sl@0	2355	scriptDesc.dataHandle = sourceData;
sl@0	2356
sl@0	2357	osaErr = OSALoad(theComponent->theComponent, &scriptDesc,
sl@0	2358	kOSAModeNull, resultID);
sl@0	2359
sl@0	2360	ReleaseResource(sourceData);
sl@0	2361
sl@0	2362	if (osaErr != noErr) {
sl@0	2363	result = TCL_ERROR;
sl@0	2364	goto rezEvalError;
sl@0	2365	}
sl@0	2366
sl@0	2367	goto rezEvalCleanUp;
sl@0	2368	}
sl@0	2369
sl@0	2370	rezEvalError:
sl@0	2371	sprintf(idStr, "ID=%d", resourceNumber);
sl@0	2372	Tcl_AppendResult(interp, "The resource \"",
sl@0	2373	(resourceName != NULL ? resourceName : idStr),
sl@0	2374	"\" could not be loaded from ",
sl@0	2375	(fileName != NULL ? fileName : "application"),
sl@0	2376	".", NULL);
sl@0	2377
sl@0	2378	rezEvalCleanUp:
sl@0	2379	if (fileRef != -1) {
sl@0	2380	CloseResFile(fileRef);
sl@0	2381	}
sl@0	2382
sl@0	2383	UseResFile(saveRef);
sl@0	2384
sl@0	2385	return result;
sl@0	2386	}
sl@0	2387
sl@0	2388	/*
sl@0	2389	*----------------------------------------------------------------------
sl@0	2390	*
sl@0	2391	* tclOSAGetScriptID --
sl@0	2392	*
sl@0	2393	* This returns the context ID, gibven the component name.
sl@0	2394	*
sl@0	2395	* Results:
sl@0	2396	* A standard Tcl result
sl@0	2397	*
sl@0	2398	* Side effects:
sl@0	2399	* Passes out the script ID in the variable scriptID.
sl@0	2400	*
sl@0	2401	*----------------------------------------------------------------------
sl@0	2402	*/
sl@0	2403
sl@0	2404	static int
sl@0	2405	tclOSAGetScriptID(
sl@0	2406	tclOSAComponent *theComponent,
sl@0	2407	CONST char *scriptName,
sl@0	2408	OSAID *scriptID)
sl@0	2409	{
sl@0	2410	tclOSAScript *theScript;
sl@0	2411
sl@0	2412	theScript = tclOSAGetScript(theComponent, scriptName);
sl@0	2413	if (theScript == NULL) {
sl@0	2414	return TCL_ERROR;
sl@0	2415	}
sl@0	2416
sl@0	2417	*scriptID = theScript->scriptID;
sl@0	2418	return TCL_OK;
sl@0	2419	}
sl@0	2420
sl@0	2421	/*
sl@0	2422	*----------------------------------------------------------------------
sl@0	2423	*
sl@0	2424	* tclOSAAddScript --
sl@0	2425	*
sl@0	2426	* This adds a script to theComponent's script table, with the
sl@0	2427	* given name & ID.
sl@0	2428	*
sl@0	2429	* Results:
sl@0	2430	* A standard Tcl result
sl@0	2431	*
sl@0	2432	* Side effects:
sl@0	2433	* Adds an element to the component's script table.
sl@0	2434	*
sl@0	2435	*----------------------------------------------------------------------
sl@0	2436	*/
sl@0	2437
sl@0	2438	static int
sl@0	2439	tclOSAAddScript(
sl@0	2440	tclOSAComponent *theComponent,
sl@0	2441	char *scriptName,
sl@0	2442	long modeFlags,
sl@0	2443	OSAID scriptID)
sl@0	2444	{
sl@0	2445	Tcl_HashEntry *hashEntry;
sl@0	2446	int newPtr;
sl@0	2447	static int scriptIndex = 0;
sl@0	2448	tclOSAScript *theScript;
sl@0	2449
sl@0	2450	if (*scriptName == '\0') {
sl@0	2451	sprintf(scriptName, "OSAScript%d", scriptIndex++);
sl@0	2452	}
sl@0	2453
sl@0	2454	hashEntry = Tcl_CreateHashEntry(&theComponent->scriptTable,
sl@0	2455	scriptName, &newPtr);
sl@0	2456	if (newPtr == 0) {
sl@0	2457	theScript = (tclOSAScript *) Tcl_GetHashValue(hashEntry);
sl@0	2458	OSADispose(theComponent->theComponent, theScript->scriptID);
sl@0	2459	} else {
sl@0	2460	theScript = (tclOSAScript *) ckalloc(sizeof(tclOSAScript));
sl@0	2461	if (theScript == NULL) {
sl@0	2462	return TCL_ERROR;
sl@0	2463	}
sl@0	2464	}
sl@0	2465
sl@0	2466	theScript->scriptID = scriptID;
sl@0	2467	theScript->languageID = theComponent->languageID;
sl@0	2468	theScript->modeFlags = modeFlags;
sl@0	2469
sl@0	2470	Tcl_SetHashValue(hashEntry,(ClientData) theScript);
sl@0	2471
sl@0	2472	return TCL_OK;
sl@0	2473	}
sl@0	2474
sl@0	2475	/*
sl@0	2476	*----------------------------------------------------------------------
sl@0	2477	*
sl@0	2478	* tclOSAGetScriptID --
sl@0	2479	*
sl@0	2480	* This returns the script structure, given the component and script name.
sl@0	2481	*
sl@0	2482	* Results:
sl@0	2483	* A pointer to the script structure.
sl@0	2484	*
sl@0	2485	* Side effects:
sl@0	2486	* None
sl@0	2487	*
sl@0	2488	*----------------------------------------------------------------------
sl@0	2489	*/
sl@0	2490
sl@0	2491	static tclOSAScript *
sl@0	2492	tclOSAGetScript(
sl@0	2493	tclOSAComponent *theComponent,
sl@0	2494	CONST char *scriptName)
sl@0	2495	{
sl@0	2496	Tcl_HashEntry *hashEntry;
sl@0	2497
sl@0	2498	hashEntry = Tcl_FindHashEntry(&theComponent->scriptTable, scriptName);
sl@0	2499	if (hashEntry == NULL) {
sl@0	2500	return NULL;
sl@0	2501	}
sl@0	2502
sl@0	2503	return (tclOSAScript *) Tcl_GetHashValue(hashEntry);
sl@0	2504	}
sl@0	2505
sl@0	2506	/*
sl@0	2507	*----------------------------------------------------------------------
sl@0	2508	*
sl@0	2509	* tclOSADeleteScript --
sl@0	2510	*
sl@0	2511	* This deletes the script given by scriptName.
sl@0	2512	*
sl@0	2513	* Results:
sl@0	2514	* A standard Tcl result
sl@0	2515	*
sl@0	2516	* Side effects:
sl@0	2517	* Deletes the script from the script table, and frees up the
sl@0	2518	* resources associated with it. If there is an error, then
sl@0	2519	* space for the error message is malloc'ed, and passed out in
sl@0	2520	* the variable errMsg.
sl@0	2521	*
sl@0	2522	*----------------------------------------------------------------------
sl@0	2523	*/
sl@0	2524
sl@0	2525	static int
sl@0	2526	tclOSADeleteScript(
sl@0	2527	tclOSAComponent *theComponent,
sl@0	2528	CONST char *scriptName,
sl@0	2529	char *errMsg)
sl@0	2530	{
sl@0	2531	Tcl_HashEntry *hashEntry;
sl@0	2532	tclOSAScript *scriptPtr;
sl@0	2533
sl@0	2534	hashEntry = Tcl_FindHashEntry(&theComponent->scriptTable, scriptName);
sl@0	2535	if (hashEntry == NULL) {
sl@0	2536	errMsg = ckalloc(17);
sl@0	2537	strcpy(errMsg,"Script not found");
sl@0	2538	return TCL_ERROR;
sl@0	2539	}
sl@0	2540
sl@0	2541	scriptPtr = (tclOSAScript *) Tcl_GetHashValue(hashEntry);
sl@0	2542	OSADispose(theComponent->theComponent, scriptPtr->scriptID);
sl@0	2543	ckfree((char *) scriptPtr);
sl@0	2544	Tcl_DeleteHashEntry(hashEntry);
sl@0	2545	return TCL_OK;
sl@0	2546	}
sl@0	2547
sl@0	2548	/*
sl@0	2549	*----------------------------------------------------------------------
sl@0	2550	*
sl@0	2551	* TclOSAActiveProc --
sl@0	2552	*
sl@0	2553	* This is passed to each component. It is run periodically
sl@0	2554	* during script compilation and script execution. It in turn
sl@0	2555	* calls Tcl_DoOneEvent to process the event queue. We also call
sl@0	2556	* the default Active proc which will let the user cancel the script
sl@0	2557	* by hitting Command-.
sl@0	2558	*
sl@0	2559	* Results:
sl@0	2560	* A standard MacOS system error
sl@0	2561	*
sl@0	2562	* Side effects:
sl@0	2563	* Any Tcl code may run while calling Tcl_DoOneEvent.
sl@0	2564	*
sl@0	2565	*----------------------------------------------------------------------
sl@0	2566	*/
sl@0	2567
sl@0	2568	static pascal OSErr
sl@0	2569	TclOSAActiveProc(
sl@0	2570	long refCon)
sl@0	2571	{
sl@0	2572	tclOSAComponent theComponent = (tclOSAComponent ) refCon;
sl@0	2573
sl@0	2574	Tcl_DoOneEvent(TCL_DONT_WAIT);
sl@0	2575	InvokeOSAActiveUPP(theComponent->defRefCon, theComponent->defActiveProc);
sl@0	2576
sl@0	2577	return noErr;
sl@0	2578	}
sl@0	2579
sl@0	2580	/*
sl@0	2581	*----------------------------------------------------------------------
sl@0	2582	*
sl@0	2583	* ASCIICompareProc --
sl@0	2584	*
sl@0	2585	* Trivial ascii compare for use with qsort.
sl@0	2586	*
sl@0	2587	* Results:
sl@0	2588	* strcmp of the two input strings
sl@0	2589	*
sl@0	2590	* Side effects:
sl@0	2591	* None
sl@0	2592	*
sl@0	2593	*----------------------------------------------------------------------
sl@0	2594	*/
sl@0	2595	static int
sl@0	2596	ASCIICompareProc(const void first,const void second)
sl@0	2597	{
sl@0	2598	int order;
sl@0	2599
sl@0	2600	char firstString = ((char **) first);
sl@0	2601	char secondString = ((char **) second);
sl@0	2602
sl@0	2603	order = strcmp(firstString, secondString);
sl@0	2604
sl@0	2605	return order;
sl@0	2606	}
sl@0	2607
sl@0	2608	#define REALLOC_INCR 30
sl@0	2609	/*
sl@0	2610	*----------------------------------------------------------------------
sl@0	2611	*
sl@0	2612	* getSortedHashKeys --
sl@0	2613	*
sl@0	2614	* returns an alphabetically sorted list of the keys of the hash
sl@0	2615	* theTable which match the string "pattern" in the DString
sl@0	2616	* theResult. pattern == NULL matches all.
sl@0	2617	*
sl@0	2618	* Results:
sl@0	2619	* None
sl@0	2620	*
sl@0	2621	* Side effects:
sl@0	2622	* ReInitializes the DString theResult, then copies the names of
sl@0	2623	* the matching keys into the string as list elements.
sl@0	2624	*
sl@0	2625	*----------------------------------------------------------------------
sl@0	2626	*/
sl@0	2627
sl@0	2628	static void
sl@0	2629	getSortedHashKeys(
sl@0	2630	Tcl_HashTable *theTable,
sl@0	2631	CONST char *pattern,
sl@0	2632	Tcl_DString *theResult)
sl@0	2633	{
sl@0	2634	Tcl_HashSearch search;
sl@0	2635	Tcl_HashEntry *hPtr;
sl@0	2636	Boolean compare = true;
sl@0	2637	char *keyPtr;
sl@0	2638	static char **resultArgv = NULL;
sl@0	2639	static int totSize = 0;
sl@0	2640	int totElem = 0, i;
sl@0	2641
sl@0	2642	if (pattern == NULL \|\| *pattern == '\0' \|\|
sl@0	2643	(pattern == '' && *(pattern + 1) == '\0')) {
sl@0	2644	compare = false;
sl@0	2645	}
sl@0	2646
sl@0	2647	for (hPtr = Tcl_FirstHashEntry(theTable,&search), totElem = 0;
sl@0	2648	hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
sl@0	2649
sl@0	2650	keyPtr = (char *) Tcl_GetHashKey(theTable, hPtr);
sl@0	2651	if (!compare \|\| Tcl_StringMatch(keyPtr, pattern)) {
sl@0	2652	totElem++;
sl@0	2653	if (totElem >= totSize) {
sl@0	2654	totSize += REALLOC_INCR;
sl@0	2655	resultArgv = (char *) ckrealloc((char ) resultArgv,
sl@0	2656	totSize * sizeof(char *));
sl@0	2657	}
sl@0	2658	resultArgv[totElem - 1] = keyPtr;
sl@0	2659	}
sl@0	2660	}
sl@0	2661
sl@0	2662	Tcl_DStringInit(theResult);
sl@0	2663	if (totElem == 1) {
sl@0	2664	Tcl_DStringAppendElement(theResult, resultArgv[0]);
sl@0	2665	} else if (totElem > 1) {
sl@0	2666	qsort((VOID ) resultArgv, (size_t) totElem, sizeof (char ),
sl@0	2667	ASCIICompareProc);
sl@0	2668
sl@0	2669	for (i = 0; i < totElem; i++) {
sl@0	2670	Tcl_DStringAppendElement(theResult, resultArgv[i]);
sl@0	2671	}
sl@0	2672	}
sl@0	2673	}
sl@0	2674
sl@0	2675	/*
sl@0	2676	*----------------------------------------------------------------------
sl@0	2677	*
sl@0	2678	* prepareScriptData --
sl@0	2679	*
sl@0	2680	* Massages the input data in the argv array, concating the
sl@0	2681	* elements, with a " " between each, and replacing \n with \r,
sl@0	2682	* and \\n with " ". Puts the result in the the DString scrptData,
sl@0	2683	* and copies the result to the AEdesc scrptDesc.
sl@0	2684	*
sl@0	2685	* Results:
sl@0	2686	* Standard Tcl result
sl@0	2687	*
sl@0	2688	* Side effects:
sl@0	2689	* Creates a new Handle (with AECreateDesc) for the script data.
sl@0	2690	* Stores the script in scrptData, or the error message if there
sl@0	2691	* is an error creating the descriptor.
sl@0	2692	*
sl@0	2693	*----------------------------------------------------------------------
sl@0	2694	*/
sl@0	2695
sl@0	2696	static int
sl@0	2697	prepareScriptData(
sl@0	2698	int argc,
sl@0	2699	CONST char **argv,
sl@0	2700	Tcl_DString *scrptData,
sl@0	2701	AEDesc *scrptDesc)
sl@0	2702	{
sl@0	2703	char * ptr;
sl@0	2704	int i;
sl@0	2705	char buffer[7];
sl@0	2706	OSErr sysErr = noErr;
sl@0	2707	Tcl_DString encodedText;
sl@0	2708
sl@0	2709	Tcl_DStringInit(scrptData);
sl@0	2710
sl@0	2711	for (i = 0; i < argc; i++) {
sl@0	2712	Tcl_DStringAppend(scrptData, argv[i], -1);
sl@0	2713	Tcl_DStringAppend(scrptData, " ", 1);
sl@0	2714	}
sl@0	2715
sl@0	2716	/*
sl@0	2717	* First replace the \n's with \r's in the script argument
sl@0	2718	* Also replace "\\n" with " ".
sl@0	2719	*/
sl@0	2720
sl@0	2721	for (ptr = scrptData->string; *ptr != '\0'; ptr++) {
sl@0	2722	if (*ptr == '\n') {
sl@0	2723	*ptr = '\r';
sl@0	2724	} else if (*ptr == '\\') {
sl@0	2725	if (*(ptr + 1) == '\n') {
sl@0	2726	*ptr = ' ';
sl@0	2727	*(ptr + 1) = ' ';
sl@0	2728	}
sl@0	2729	}
sl@0	2730	}
sl@0	2731
sl@0	2732	Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(scrptData),
sl@0	2733	Tcl_DStringLength(scrptData), &encodedText);
sl@0	2734	sysErr = AECreateDesc(typeChar, Tcl_DStringValue(&encodedText),
sl@0	2735	Tcl_DStringLength(&encodedText), scrptDesc);
sl@0	2736	Tcl_DStringFree(&encodedText);
sl@0	2737
sl@0	2738	if (sysErr != noErr) {
sl@0	2739	sprintf(buffer, "%6d", sysErr);
sl@0	2740	Tcl_DStringFree(scrptData);
sl@0	2741	Tcl_DStringAppend(scrptData, "Error #", 7);
sl@0	2742	Tcl_DStringAppend(scrptData, buffer, -1);
sl@0	2743	Tcl_DStringAppend(scrptData, " creating Script Data Descriptor.", 33);
sl@0	2744	return TCL_ERROR;
sl@0	2745	}
sl@0	2746
sl@0	2747	return TCL_OK;
sl@0	2748	}
sl@0	2749
sl@0	2750	/*
sl@0	2751	*----------------------------------------------------------------------
sl@0	2752	*
sl@0	2753	* tclOSAResultFromID --
sl@0	2754	*
sl@0	2755	* Gets a human readable version of the result from the script ID
sl@0	2756	* and returns it in the result of the interpreter interp
sl@0	2757	*
sl@0	2758	* Results:
sl@0	2759	* None
sl@0	2760	*
sl@0	2761	* Side effects:
sl@0	2762	* Sets the result of interp to the human readable version of resultID.
sl@0	2763	*
sl@0	2764	*
sl@0	2765	*----------------------------------------------------------------------
sl@0	2766	*/
sl@0	2767
sl@0	2768	void
sl@0	2769	tclOSAResultFromID(
sl@0	2770	Tcl_Interp *interp,
sl@0	2771	ComponentInstance theComponent,
sl@0	2772	OSAID resultID )
sl@0	2773	{
sl@0	2774	OSErr myErr = noErr;
sl@0	2775	AEDesc resultDesc;
sl@0	2776	Tcl_DString resultStr;
sl@0	2777
sl@0	2778	Tcl_DStringInit(&resultStr);
sl@0	2779
sl@0	2780	myErr = OSADisplay(theComponent, resultID, typeChar,
sl@0	2781	kOSAModeNull, &resultDesc);
sl@0	2782	Tcl_DStringAppend(&resultStr, (char ) resultDesc.dataHandle,
sl@0	2783	GetHandleSize(resultDesc.dataHandle));
sl@0	2784	Tcl_DStringResult(interp,&resultStr);
sl@0	2785	}
sl@0	2786
sl@0	2787	/*
sl@0	2788	*----------------------------------------------------------------------
sl@0	2789	*
sl@0	2790	* tclOSAASError --
sl@0	2791	*
sl@0	2792	* Gets the error message from the AppleScript component, and adds
sl@0	2793	* it to interp's result. If the script data is known, will point
sl@0	2794	* out the offending bit of code. This MUST BE A NULL TERMINATED
sl@0	2795	* C-STRING, not a typeChar.
sl@0	2796	*
sl@0	2797	* Results:
sl@0	2798	* None
sl@0	2799	*
sl@0	2800	* Side effects:
sl@0	2801	* Sets the result of interp to error, plus the relevant portion
sl@0	2802	* of the script.
sl@0	2803	*
sl@0	2804	*----------------------------------------------------------------------
sl@0	2805	*/
sl@0	2806
sl@0	2807	void
sl@0	2808	tclOSAASError(
sl@0	2809	Tcl_Interp * interp,
sl@0	2810	ComponentInstance theComponent,
sl@0	2811	char *scriptData )
sl@0	2812	{
sl@0	2813	OSErr myErr = noErr;
sl@0	2814	AEDesc errResult,errLimits;
sl@0	2815	Tcl_DString errStr;
sl@0	2816	DescType returnType;
sl@0	2817	Size returnSize;
sl@0	2818	short srcStart,srcEnd;
sl@0	2819	char buffer[16];
sl@0	2820
sl@0	2821	Tcl_DStringInit(&errStr);
sl@0	2822	Tcl_DStringAppend(&errStr, "An AppleScript error was encountered.\n", -1);
sl@0	2823
sl@0	2824	OSAScriptError(theComponent, kOSAErrorNumber,
sl@0	2825	typeShortInteger, &errResult);
sl@0	2826
sl@0	2827	sprintf(buffer, "Error #%-6.6d\n", (short int) **errResult.dataHandle);
sl@0	2828
sl@0	2829	AEDisposeDesc(&errResult);
sl@0	2830
sl@0	2831	Tcl_DStringAppend(&errStr,buffer, 15);
sl@0	2832
sl@0	2833	OSAScriptError(theComponent, kOSAErrorMessage, typeChar, &errResult);
sl@0	2834	Tcl_DStringAppend(&errStr, (char ) errResult.dataHandle,
sl@0	2835	GetHandleSize(errResult.dataHandle));
sl@0	2836	AEDisposeDesc(&errResult);
sl@0	2837
sl@0	2838	if (scriptData != NULL) {
sl@0	2839	int lowerB, upperB;
sl@0	2840
sl@0	2841	myErr = OSAScriptError(theComponent, kOSAErrorRange,
sl@0	2842	typeOSAErrorRange, &errResult);
sl@0	2843
sl@0	2844	myErr = AECoerceDesc(&errResult, typeAERecord, &errLimits);
sl@0	2845	myErr = AEGetKeyPtr(&errLimits, keyOSASourceStart,
sl@0	2846	typeShortInteger, &returnType, &srcStart,
sl@0	2847	sizeof(short int), &returnSize);
sl@0	2848	myErr = AEGetKeyPtr(&errLimits, keyOSASourceEnd, typeShortInteger,
sl@0	2849	&returnType, &srcEnd, sizeof(short int), &returnSize);
sl@0	2850	AEDisposeDesc(&errResult);
sl@0	2851	AEDisposeDesc(&errLimits);
sl@0	2852
sl@0	2853	Tcl_DStringAppend(&errStr, "\nThe offending bit of code was:\n\t", -1);
sl@0	2854	/*
sl@0	2855	* Get the full line on which the error occured:
sl@0	2856	*/
sl@0	2857	for (lowerB = srcStart; lowerB > 0; lowerB--) {
sl@0	2858	if (*(scriptData + lowerB ) == '\r') {
sl@0	2859	lowerB++;
sl@0	2860	break;
sl@0	2861	}
sl@0	2862	}
sl@0	2863
sl@0	2864	for (upperB = srcEnd; *(scriptData + upperB) != '\0'; upperB++) {
sl@0	2865	if (*(scriptData + upperB) == '\r') {
sl@0	2866	break;
sl@0	2867	}
sl@0	2868	}
sl@0	2869
sl@0	2870	Tcl_DStringAppend(&errStr, scriptData+lowerB, srcStart - lowerB);
sl@0	2871	Tcl_DStringAppend(&errStr, "_", 1);
sl@0	2872	Tcl_DStringAppend(&errStr, scriptData+srcStart, upperB - srcStart);
sl@0	2873	}
sl@0	2874
sl@0	2875	Tcl_DStringResult(interp,&errStr);
sl@0	2876	}
sl@0	2877
sl@0	2878	/*
sl@0	2879	*----------------------------------------------------------------------
sl@0	2880	*
sl@0	2881	* GetRawDataFromDescriptor --
sl@0	2882	*
sl@0	2883	* Get the data from a descriptor.
sl@0	2884	*
sl@0	2885	* Results:
sl@0	2886	* None
sl@0	2887	*
sl@0	2888	* Side effects:
sl@0	2889	* None.
sl@0	2890	*
sl@0	2891	*----------------------------------------------------------------------
sl@0	2892	*/
sl@0	2893
sl@0	2894	static void
sl@0	2895	GetRawDataFromDescriptor(
sl@0	2896	AEDesc *theDesc,
sl@0	2897	Ptr destPtr,
sl@0	2898	Size destMaxSize,
sl@0	2899	Size *actSize)
sl@0	2900	{
sl@0	2901	Size copySize;
sl@0	2902
sl@0	2903	if (theDesc->dataHandle) {
sl@0	2904	HLock((Handle)theDesc->dataHandle);
sl@0	2905	*actSize = GetHandleSize((Handle)theDesc->dataHandle);
sl@0	2906	copySize = actSize < destMaxSize ? actSize : destMaxSize;
sl@0	2907	BlockMove(*theDesc->dataHandle, destPtr, copySize);
sl@0	2908	HUnlock((Handle)theDesc->dataHandle);
sl@0	2909	} else {
sl@0	2910	*actSize = 0;
sl@0	2911	}
sl@0	2912
sl@0	2913	}
sl@0	2914
sl@0	2915	/*
sl@0	2916	*----------------------------------------------------------------------
sl@0	2917	*
sl@0	2918	* GetRawDataFromDescriptor --
sl@0	2919	*
sl@0	2920	* Get the data from a descriptor. Assume it's a C string.
sl@0	2921	*
sl@0	2922	* Results:
sl@0	2923	* None
sl@0	2924	*
sl@0	2925	* Side effects:
sl@0	2926	* None.
sl@0	2927	*
sl@0	2928	*----------------------------------------------------------------------
sl@0	2929	*/
sl@0	2930
sl@0	2931	static OSErr
sl@0	2932	GetCStringFromDescriptor(
sl@0	2933	AEDesc *sourceDesc,
sl@0	2934	char *resultStr,
sl@0	2935	Size resultMaxSize,
sl@0	2936	Size *resultSize)
sl@0	2937	{
sl@0	2938	OSErr err;
sl@0	2939	AEDesc resultDesc;
sl@0	2940
sl@0	2941	resultDesc.dataHandle = nil;
sl@0	2942
sl@0	2943	err = AECoerceDesc(sourceDesc, typeChar, &resultDesc);
sl@0	2944
sl@0	2945	if (!err) {
sl@0	2946	GetRawDataFromDescriptor(&resultDesc, (Ptr) resultStr,
sl@0	2947	resultMaxSize - 1, resultSize);
sl@0	2948	resultStr[*resultSize] = 0;
sl@0	2949	} else {
sl@0	2950	err = errAECoercionFail;
sl@0	2951	}
sl@0	2952
sl@0	2953	if (resultDesc.dataHandle) {
sl@0	2954	AEDisposeDesc(&resultDesc);
sl@0	2955	}
sl@0	2956
sl@0	2957	return err;
sl@0	2958	}

author	sl
	Tue, 10 Jun 2014 14:32:02 +0200
changeset 1	260cb5ec6c19
permissions	-rw-r--r--