tclmacresource.c

linux系统下的音频通信

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * DupOSTypeInternalRep --
 *
 *	Initialize the internal representation of an int Tcl_Obj to a
 *	copy of the internal representation of an existing int object. 
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	"copyPtr"s internal rep is set to the integer corresponding to
 *	"srcPtr"s internal rep.
 *
 *----------------------------------------------------------------------
 */

static void
DupOSTypeInternalRep(
    Tcl_Obj *srcPtr,	/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)	/* Object with internal rep to set. */
{
    copyPtr->internalRep.longValue = srcPtr->internalRep.longValue;
    copyPtr->typePtr = &osType;
}

/*
 *----------------------------------------------------------------------
 *
 * SetOSTypeFromAny --
 *
 *	Attempt to generate an integer internal form for the Tcl object
 *	"objPtr".
 *
 * Results:
 *	The return value is a standard object Tcl result. If an error occurs
 *	during conversion, an error message is left in interp->objResult
 *	unless "interp" is NULL.
 *
 * Side effects:
 *	If no error occurs, an int is stored as "objPtr"s internal
 *	representation. 
 *
 *----------------------------------------------------------------------
 */

static int
SetOSTypeFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr)		/* The object to convert. */
{
    Tcl_ObjType *oldTypePtr = objPtr->typePtr;
    char *string;
    int length;
    long newOSType;

    /*
     * Get the string representation. Make it up-to-date if necessary.
     */

    string = TclGetStringFromObj(objPtr, &length);

    if (length != 4) {
	if (interp != NULL) {
	    Tcl_ResetResult(interp);
	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		    "expected Macintosh OS type but got \"", string, "\"",
		    (char *) NULL);
	}
	return TCL_ERROR;
    }
    newOSType =  *((long *) string);
    
    /*
     * The conversion to resource type succeeded. Free the old internalRep 
     * before setting the new one.
     */

    if ((oldTypePtr != NULL) &&	(oldTypePtr->freeIntRepProc != NULL)) {
	oldTypePtr->freeIntRepProc(objPtr);
    }
    
    objPtr->internalRep.longValue = newOSType;
    objPtr->typePtr = &osType;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfOSType --
 *
 *	Update the string representation for an resource type object.
 *	Note: This procedure does not free an existing old string rep
 *	so storage will be lost if this has not already been done. 
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object's string is set to a valid string that results from
 *	the int-to-string conversion.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateStringOfOSType(
    register Tcl_Obj *objPtr)	/* Int object whose string rep to update. */
{
    objPtr->bytes = ckalloc(5);
    sprintf(objPtr->bytes, "%-4.4s", &(objPtr->internalRep.longValue));
    objPtr->length = 4;
}

/*
 *----------------------------------------------------------------------
 *
 * GetRsrcRefFromObj --
 *
 *	Given a String object containing a resource file token, return
 *	the OpenResourceFork structure that it represents, or NULL if 
 *	the token cannot be found.  If okayOnReadOnly is false, it will 
 *      also check whether the token corresponds to a read-only file, 
 *      and return NULL if it is.
 *
 * Results:
 *	A pointer to an OpenResourceFork structure, or NULL.
 *
 * Side effects:
 *	An error message may be left in resultPtr.
 *
 *----------------------------------------------------------------------
 */

static OpenResourceFork *
GetRsrcRefFromObj(
    register Tcl_Obj *objPtr,	/* String obj containing file token     */
    int okayOnReadOnly,         /* Whether this operation is okay for a *
                                 * read only file.                      */
    const char *operation,      /* String containing the operation we   *
                                 * were trying to perform, used for errors */
    Tcl_Obj *resultPtr)         /* Tcl_Obj to contain error message     */
{
    char *stringPtr;
    Tcl_HashEntry *nameHashPtr;
    OpenResourceFork *resourceRef;
    int length;
    OSErr err;
    
    stringPtr = Tcl_GetStringFromObj(objPtr, &length);
    nameHashPtr = Tcl_FindHashEntry(&nameTable, stringPtr);
    if (nameHashPtr == NULL) {
        Tcl_AppendStringsToObj(resultPtr,
	        "invalid resource file reference \"",
	        stringPtr, "\"", (char *) NULL);
        return NULL;
    }

    resourceRef = (OpenResourceFork *) Tcl_GetHashValue(nameHashPtr);
    
    if (!okayOnReadOnly) {
        err = GetResFileAttrs((short) resourceRef->fileRef);
        if (err & mapReadOnly) {
            Tcl_AppendStringsToObj(resultPtr, "cannot ", operation, 
                    " resource file \"",
                    stringPtr, "\", it was opened read only",
                    (char *) NULL);
            return NULL;
        }
    }
    return resourceRef;
}

/*
 *----------------------------------------------------------------------
 *
 * TclMacRegisterResourceFork --
 *
 *	Register an open resource fork in the table of open resources 
 *	managed by the procedures in this file.  If the resource file
 *      is already registered with the table, then no new token is made.
 *
 *      The bahavior is controlled by the value of tokenPtr, and of the 
 *	flags variable.  For tokenPtr, the possibilities are:
 *	  - NULL: The new token is auto-generated, but not returned.
 *        - The string value of tokenPtr is the empty string: Then
 *		the new token is auto-generated, and returned in tokenPtr
 *	  - tokenPtr has a value: The string value will be used for the token,
 *		unless it is already in use, in which case a new token will
 *		be generated, and returned in tokenPtr.
 *
 *      For the flags variable:  it can be one of:
 *	  - TCL_RESOURCE__INSERT_TAIL: The element is inserted at the
 *              end of the list of open resources.  Used only in Resource_Init.
 *	  - TCL_RESOURCE_DONT_CLOSE: The resource close command will not close
 *	        this resource.
 *	  - TCL_RESOURCE_CHECK_IF_OPEN: This will check to see if this file's
 *	        resource fork is already opened by this Tcl shell, and return 
 *	        an error without registering the resource fork.
 *
 * Results:
 *	Standard Tcl Result
 *
 * Side effects:
 *	An entry is added to the resource name table.
 *
 *----------------------------------------------------------------------
 */

int
TclMacRegisterResourceFork(
    short fileRef,        	/* File ref for an open resource fork. */
    Tcl_Obj *tokenPtr,		/* A Tcl Object to which to write the  *
				 * new token */
    int flags)	     		/* 1 means insert at the head of the resource
                                 * fork list, 0 means at the tail */

{
    Tcl_HashEntry *resourceHashPtr;
    Tcl_HashEntry *nameHashPtr;
    OpenResourceFork *resourceRef;
    int new;
    char *resourceId = NULL;
   
    if (!initialized) {
        ResourceInit();
    }
    
    /*
     * If we were asked to, check that this file has not been opened
     * already.
     */
     
    if (flags & TCL_RESOURCE_CHECK_IF_OPEN) {
        Tcl_HashSearch search;
        short oldFileRef;
        FCBPBRec newFileRec, oldFileRec;
        OSErr err;
        
        oldFileRec.ioCompletion = NULL;
        oldFileRec.ioFCBIndx = 0;
        oldFileRec.ioNamePtr = NULL;
        
        newFileRec.ioCompletion = NULL;
        newFileRec.ioFCBIndx = 0;
        newFileRec.ioNamePtr = NULL;
        newFileRec.ioVRefNum = 0;
        newFileRec.ioRefNum = fileRef;
        err = PBGetFCBInfo(&newFileRec, false);
            
        
        resourceHashPtr = Tcl_FirstHashEntry(&resourceTable, &search);
        while (resourceHashPtr != NULL) {
            
            oldFileRef = (short) Tcl_GetHashKey(&resourceTable,
                    resourceHashPtr);
            
            
            oldFileRec.ioVRefNum = 0;
            oldFileRec.ioRefNum = oldFileRef;
            err = PBGetFCBInfo(&oldFileRec, false);
            
            /*
             * err might not be noErr either because the file has closed 
             * out from under us somehow, which is bad but we're not going
             * to fix it here, OR because it is the ROM MAP, which has a 
             * fileRef, but can't be gotten to by PBGetFCBInfo.
             */
             
            if ((oldFileRef == fileRef) ||
                    ((err == noErr) 
                    && (newFileRec.ioFCBVRefNum == oldFileRec.ioFCBVRefNum)
                    && (newFileRec.ioFCBFlNm == oldFileRec.ioFCBFlNm))) {
                
                resourceId = (char *) Tcl_GetHashValue(resourceHashPtr);
		Tcl_SetStringObj(tokenPtr, resourceId, -1);
                return TCL_OK;
            }
            
            resourceHashPtr = Tcl_NextHashEntry(&search);
        }
        
        
    }
    
    resourceHashPtr = Tcl_CreateHashEntry(&resourceTable,
		(char *) fileRef, &new);
    if (!new) {
        if (tokenPtr != NULL) {
            resourceId = (char *) Tcl_GetHashValue(resourceHashPtr);
            Tcl_SetStringObj(tokenPtr, resourceId, -1);
        }
        return  TCL_OK;
    }
    
    
    /*
     * If we were passed in a result pointer which is not an empty
     * string, attempt to use that as the key.  If the key already
     * exists, silently fall back on resource%d...
     */
     
    if (tokenPtr != NULL) {
        char *tokenVal;
        int length;
        tokenVal = (char *) Tcl_GetStringFromObj(tokenPtr, &length);
        if (length > 0) {
            nameHashPtr = Tcl_FindHashEntry(&nameTable, tokenVal);
            if (nameHashPtr == NULL) {
                resourceId = ckalloc(length + 1);
                memcpy(resourceId, tokenVal, length);
                resourceId[length] = '\0';
            }
        }
    }
    
    if (resourceId == NULL) {	
        resourceId = (char *) ckalloc(15);
        sprintf(resourceId, "resource%d", newId);
    }
    
    Tcl_SetHashValue(resourceHashPtr, resourceId);
    newId++;

    nameHashPtr = Tcl_CreateHashEntry(&nameTable, resourceId, &new);
    if (!new) {
	panic("resource id has repeated itself");
    }
    
    resourceRef = (OpenResourceFork *) ckalloc(sizeof(OpenResourceFork));
    resourceRef->fileRef = fileRef;
    resourceRef->flags = flags;
    
    Tcl_SetHashValue(nameHashPtr, (ClientData) resourceRef);
    if (tokenPtr != NULL) {
        Tcl_SetStringObj(tokenPtr, resourceId, -1);
    }
    
    if (flags & TCL_RESOURCE_INSERT_TAIL) {
        Tcl_ListObjAppendElement(NULL, resourceForkList, tokenPtr);
    } else {
        Tcl_ListObjReplace(NULL, resourceForkList, 0, 0, 1, &tokenPtr);	
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclMacUnRegisterResourceFork --
 *
 *	Removes the entry for an open resource fork from the table of 
 *	open resources managed by the procedures in this file.
 *      If resultPtr is not NULL, it will be used for error reporting.
 *
 * Results:
 *	The fileRef for this token, or -1 if an error occured.
 *
 * Side effects:
 *	An entry is removed from the resource name table.
 *
 *----------------------------------------------------------------------
 */

short
TclMacUnRegisterResourceFork(
    char *tokenPtr,
    Tcl_Obj *resultPtr)

{
    Tcl_HashEntry *resourceHashPtr;
    Tcl_HashEntry *nameHashPtr;
    OpenResourceFork *resourceRef;
    char *resourceId = NULL;
    short fileRef;
    char *bytes;
    int i, match, index, listLen, length, elemLen;
    Tcl_Obj **elemPtrs;
    
     
    nameHashPtr = Tcl_FindHashEntry(&nameTable, tokenPtr);
    if (nameHashPtr == NULL) {
        if (resultPtr != NULL) {
	    Tcl_AppendStringsToObj(resultPtr,
		    "invalid resource file reference \"",
		    tokenPtr, "\"", (char *) NULL);
        }
	return -1;
    }
    
    resourceRef = (OpenResourceFork *) Tcl_GetHashValue(nameHashPtr);
    fileRef = resourceRef->fileRef;
        
    if ( resourceRef->flags & TCL_RESOURCE_DONT_CLOSE ) {
        if (resultPtr != NULL) {
	    Tcl_AppendStringsToObj(resultPtr,
		    "can't close \"", tokenPtr, "\" resource file", 
		    (char *) NULL);
	}
	return -1;
    }            

    Tcl_DeleteHashEntry(nameHashPtr);
    ckfree((char *) resourceRef);
    
    
    /* 
     * Now remove the resource from the resourceForkList object 
     */
     
    Tcl_ListObjGetElements(NULL, resourceForkList, &listLen, &elemPtrs);
    
 
    index = -1;
    length = strlen(tokenPtr);
    
    for (i = 0; i < listLen; i++) {
	match = 0;
	bytes = Tcl_GetStringFromObj(elemPtrs[i], &elemLen);
	if (length == elemLen) {
		match = (memcmp(bytes, tokenPtr,
			(size_t) length) == 0);
	}
	if (match) {
	    index = i;
	    break;
	}
    }
    if (!match) {
        panic("the resource Fork List is out of synch!");
    }
    
    Tcl_ListObjReplace(NULL, resourceForkList, index, 1, 0, NULL);
    
    resourceHashPtr = Tcl_FindHashEntry(&resourceTable, (char *) fileRef);
    
    if (resourceHashPtr == NULL) {
	panic("Resource & Name tables are out of synch in resource command.");
    }
    ckfree(Tcl_GetHashValue(resourceHashPtr));
    Tcl_DeleteHashEntry(resourceHashPtr);
    
    return fileRef;

}


/*
 *----------------------------------------------------------------------
 *
 * BuildResourceForkList --
 *
 *	Traverses the list of open resource forks, and builds the 
 *	list of resources forks.  Also creates a resource token for any that 
 *      are opened but not registered with our resource system.
 *      This is based on code from Apple DTS.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *      The list of resource forks is updated.
 *	The resource name table may be augmented.
 *
 *----------------------------------------------------------------------
 */

void
BuildResourceForkList()
{
    Handle currentMapHandle, mSysMapHandle;  
    Ptr tempPtr;
    FCBPBRec fileRec;
    char fileName[256];
    char appName[62];
    Tcl_Obj *nameObj;
    OSErr err;
    ProcessSerialNumber psn;
    ProcessInfoRec info;
    FSSpec fileSpec;
        
    /* 
     * Get the application name, so we can substitute
     * the token "application" for the application's resource.
     */ 
     
    GetCurrentProcess(&psn);
    info.processInfoLength = sizeof(ProcessInfoRec);
    info.processName = (StringPtr) &appName;
    info.processAppSpec = &fileSpec;
    GetProcessInformation(&psn, &info);
    p2cstr((StringPtr) appName);

    
    fileRec.ioCompletion = NULL;
    fileRec.ioVRefNum = 0;
    fileRec.ioFCBIndx = 0;
    fileRec.ioNamePtr = (StringPtr) &fileName;
    
    
    currentMapHandle = LMGetTopMapHndl();
    mSysMapHandle = LMGetSysMapHndl();
    
    while (1) {
        /* 
         * Now do the ones opened after the application.
         */
       
        nameObj = Tcl_NewObj();
        
        tempPtr = *currentMapHandle;

        fileRec.ioRefNum = *((short *) (tempPtr + 20));
        err = PBGetFCBInfo(&fileRec, false);
        
        if (err != noErr) {
            /*
             * The ROM resource map does not correspond to an opened file...
             */
             Tcl_SetStringObj(nameObj, "ROM Map", -1);
        } else {
            p2cstr((StringPtr) fileName);
            if (strcmp(fileName,(char *) appName) == 0) {
                Tcl_SetStringObj(nameObj, "application", -1);
            } else {
                Tcl_SetStringObj(nameObj, fileName, -1);
            }
            c2pstr(fileName);
        }
        
        TclMacRegisterResourceFork(fileRec.ioRefNum, nameObj, 
            TCL_RESOURCE_DONT_CLOSE | TCL_RESOURCE_INSERT_TAIL);
       
        if (currentMapHandle == mSysMapHandle) {
            break;
        }
        
        currentMapHandle = *((Handle *) (tempPtr + 16));
    }
}