tclmacosa.c

tcl是工具命令语言

 *
 *	This adds the context ID, with the name contextName.  If the
 *	name is passed in as a NULL string, space is malloc'ed for the
 *	string and a new name is made up, if the string is empty, you
 *	must have allocated enough space ( 24 characters is fine) for
 *	the name, which is made up and passed out.
 *
 * Results:
 *	Nothing
 *
 * Side effects:
 *	Adds the script context to the component's context table.
 *
 *----------------------------------------------------------------------
 */

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

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

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

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

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

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

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

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

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

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

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

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

    UseResFile(saveRef);
	
    return result;
}

/*
 *--------------------------------------------------------------------