📄 tclmacosa.c
字号:
} 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, 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, 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) { tclOSAAddContext(theComponent, contextName, *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. * *---------------------------------------------------------------------- */ inttclOSAStore( Tcl_Interp *interp, tclOSAComponent *theComponent, char *resourceName, int resourceNumber, char *scriptName, char *fileName){ Handle resHandle; Str255 rezName; int result = TCL_OK; short saveRef, fileRef = -1; char idStr[64]; FSSpec fileSpec; Tcl_DString buffer; 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; Tcl_DStringInit(&buffer); nativeName = Tcl_TranslateFileName(interp, fileName, &buffer); if (nativeName == NULL) { return TCL_ERROR; } err = FSpLocationFromPath(strlen(nativeName), nativeName, &fileSpec); Tcl_DStringFree(&buffer); if ((err != noErr) && (err != fnfErr)) { Tcl_AppendResult(interp, "Error getting a location for the file: \"", fileName, "\".", NULL); return TCL_ERROR; } FSpCreateResFileCompat(&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 = FSpOpenResFileCompat(&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. * *---------------------------------------------------------------------- */ inttclOSALoad( Tcl_Interp *interp, tclOSAComponent *theComponent, char *resourceName, int resourceNumber, char *fileName, OSAID *resultID){ Handle sourceData; Str255 rezName; int result = TCL_OK; short saveRef, fileRef = -1; char idStr[64]; FSSpec fileSpec; Tcl_DString buffer; char *nativeName; saveRef = CurResFile(); if (fileName != NULL) { OSErr err; Tcl_DStringInit(&buffer); nativeName = Tcl_TranslateFileName(interp, fileName, &buffer); if (nativeName == NULL) { return TCL_ERROR; } err = FSpLocationFromPath(strlen(nativeName), nativeName, &fileSpec); Tcl_DStringFree(&buffer); if (err != noErr) { Tcl_AppendResult(interp, "Error finding the file: \"", fileName, "\".", NULL); return TCL_ERROR; } fileRef = FSpOpenResFileCompat(&fileSpec, fsRdPerm); if (fileRef == -1) { Tcl_AppendResult(interp, "Error reading the file: \"", fileName, "\".", NULL); return TCL_ERROR; } UseResFile(fileRef); } else { /* * The default behavior will search through all open resource files. * This may not be the behavior you desire. If you want the behavior * of this call to *only* search the application resource fork, you * must call UseResFile at this point to set it to the application * file. This means you must have already obtained the application's * fileRef when the application started up. */ } /* * Load the resource by name or ID */ if (resourceName != NULL) { strcpy((char *) rezName + 1, resourceName); rezName[0] = strlen(resourceName); sourceData = GetNamedResource('scpt', rezName); } else { sourceData = GetResource('scpt', (short) resourceNumber); } if (sourceData == NULL) { result = TCL_ERROR; } else { AEDesc scriptDesc; OSAError osaErr; scriptDesc.descriptorType = typeOSAGenericStorage; scriptDesc.dataHandle = sourceData; osaErr = OSALoad(theComponent->theComponent, &scriptDesc, kOSAModeNull, resultID); ReleaseResource(sourceData); if (osaErr != noErr) { result = TCL_ERROR; goto rezEvalError; } goto rezEvalCleanUp; } rezEvalError: sprintf(idStr, "ID=%d", resourceNumber); Tcl_AppendResult(interp, "The resource \"", (resourceName != NULL ? resourceName : idStr), "\" could not be loaded from ", (fileName != NULL ? fileName : "application"), ".", NULL); rezEvalCleanUp: if (fileRef != -1) { CloseResFile(fileRef); } UseResFile(saveRef); return result;}/* *---------------------------------------------------------------------- * * tclOSAGetScriptID -- * * This returns the context ID, gibven the component name. * * Results: * A standard Tcl result * * Side effects: * Passes out the script ID in the variable scriptID. * *---------------------------------------------------------------------- */static int tclOSAGetScriptID( tclOSAComponent *theComponent, char *scriptName, OSAID *scriptID) { tclOSAScript *theScript; theScript = tclOSAGetScript(theComponent, scriptName); if (theScript == NULL) { return TCL_ERROR; } *scriptID = theScript->scriptID; return TCL_OK;}/* *---------------------------------------------------------------------- * * tclOSAAddScript -- * * This adds a script to theComponent's script table, with the * given name & ID. * * Results: * A standard Tcl result
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -