tclmacresource.c

tcl是工具命令语言

	    }
	    
	    writeDone:
	    
	    if (releaseIt) {
	        ReleaseResource(resource);
	        err = ResError();
	        if (err != noErr) {
		    Tcl_AppendStringsToObj(resultPtr,
			    "error releasing resource",
		            (char *) NULL);
		    result = TCL_ERROR;
	        }
	    }
	    
	    if (limitSearch) {
		UseResFile(saveRef);
	    }

	    return result;
	default:
	    panic("Tcl_GetIndexFromObj returned unrecognized option");
	    return TCL_ERROR;	/* Should never be reached. */
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MacSourceObjCmd --
 *
 *	This procedure is invoked to process the "source" Tcl command.
 *	See the user documentation for details on what it does.  In 
 *	addition, it supports sourceing from the resource fork of
 *	type 'TEXT'.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_MacSourceObjCmd(
    ClientData dummy,			/* Not used. */
    Tcl_Interp *interp,			/* Current interpreter. */
    int objc,				/* Number of arguments. */
    Tcl_Obj *CONST objv[])		/* Argument objects. */
{
    char *errNum = "wrong # args: ";
    char *errBad = "bad argument: ";
    char *errStr;
    char *fileName = NULL, *rsrcName = NULL;
    long rsrcID = -1;
    char *string;
    int length;

    if (objc < 2 || objc > 4)  {
    	errStr = errNum;
    	goto sourceFmtErr;
    }
    
    if (objc == 2)  {
	return Tcl_FSEvalFile(interp, objv[1]);
    }
    
    /*
     * The following code supports a few older forms of this command
     * for backward compatability.
     */
    string = Tcl_GetStringFromObj(objv[1], &length);
    if (!strcmp(string, "-rsrc") || !strcmp(string, "-rsrcname")) {
	rsrcName = Tcl_GetStringFromObj(objv[2], &length);
    } else if (!strcmp(string, "-rsrcid")) {
	if (Tcl_GetLongFromObj(interp, objv[2], &rsrcID) != TCL_OK) {
	    return TCL_ERROR;
	}
    } else {
    	errStr = errBad;
    	goto sourceFmtErr;
    }
    
    if (objc == 4) {
	fileName = Tcl_GetStringFromObj(objv[3], &length);
    }
    return Tcl_MacEvalResource(interp, rsrcName, rsrcID, fileName);
	
    sourceFmtErr:
    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), errStr, "should be \"",
		Tcl_GetString(objv[0]), " fileName\" or \"",
		Tcl_GetString(objv[0]),	" -rsrc name ?fileName?\" or \"", 
		Tcl_GetString(objv[0]), " -rsrcid id ?fileName?\"",
		(char *) NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_BeepObjCmd --
 *
 *	This procedure makes the beep sound.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Makes a beep.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_BeepObjCmd(
    ClientData dummy,			/* Not used. */
    Tcl_Interp *interp,			/* Current interpreter. */
    int objc,				/* Number of arguments. */
    Tcl_Obj *CONST objv[])		/* Argument values. */
{
    Tcl_Obj *resultPtr, *objPtr;
    Handle sound;
    Str255 sndName;
    int volume = -1, length;
    char * sndArg = NULL;

    resultPtr = Tcl_GetObjResult(interp);
    if (objc == 1) {
	SysBeep(1);
	return TCL_OK;
    } else if (objc == 2) {
	if (!strcmp(Tcl_GetStringFromObj(objv[1], &length), "-list")) {
	    int count, i;
	    short id;
	    Str255 theName;
	    ResType rezType;
			
	    count = CountResources('snd ');
	    for (i = 1; i <= count; i++) {
		sound = GetIndResource('snd ', i);
		if (sound != NULL) {
		    GetResInfo(sound, &id, &rezType, theName);
		    if (theName[0] == 0) {
			continue;
		    }
		    objPtr = Tcl_NewStringObj((char *) theName + 1,
			    theName[0]);
		    Tcl_ListObjAppendElement(interp, resultPtr, objPtr);
		}
	    }
	    return TCL_OK;
	} else {
	    sndArg = Tcl_GetStringFromObj(objv[1], &length);
	}
    } else if (objc == 3) {
	if (!strcmp(Tcl_GetStringFromObj(objv[1], &length), "-volume")) {
	    Tcl_GetIntFromObj(interp, objv[2], &volume);
	} else {
	    goto beepUsage;
	}
    } else if (objc == 4) {
	if (!strcmp(Tcl_GetStringFromObj(objv[1], &length), "-volume")) {
	    Tcl_GetIntFromObj(interp, objv[2], &volume);
	    sndArg = Tcl_GetStringFromObj(objv[3], &length);
	} else {
	    goto beepUsage;
	}
    } else {
	goto beepUsage;
    }
	
    /*
     * Play the sound
     */
    if (sndArg == NULL) {
	/*
         * Set Volume for SysBeep
         */

	if (volume >= 0) {
	    SetSoundVolume(volume, SYS_BEEP_VOLUME);
	}
	SysBeep(1);

	/*
         * Reset Volume
         */

	if (volume >= 0) {
	    SetSoundVolume(0, RESET_VOLUME);
	}
    } else {
	strcpy((char *) sndName + 1, sndArg);
	sndName[0] = length;
	sound = GetNamedResource('snd ', sndName);
	if (sound != NULL) {
	    /*
             * Set Volume for Default Output device
             */

	    if (volume >= 0) {
		SetSoundVolume(volume, DEFAULT_SND_VOLUME);
	    }

	    SndPlay(NULL, (SndListHandle) sound, false);

	    /*
             * Reset Volume
             */

	    if (volume >= 0) {
		SetSoundVolume(0, RESET_VOLUME);
	    }
	} else {
	    Tcl_AppendStringsToObj(resultPtr, " \"", sndArg, 
		    "\" is not a valid sound.  (Try ",
		    Tcl_GetString(objv[0]), " -list)", NULL);
	    return TCL_ERROR;
	}
    }

    return TCL_OK;

    beepUsage:
    Tcl_WrongNumArgs(interp, 1, objv, "[-volume num] [-list | sndName]?");
    return TCL_ERROR;
}

/*
 *-----------------------------------------------------------------------------
 *
 * SetSoundVolume --
 *
 *	Set the volume for either the SysBeep or the SndPlay call depending
 *	on the value of mode (SYS_BEEP_VOLUME or DEFAULT_SND_VOLUME
 *      respectively.
 *
 *      It also stores the last channel set, and the old value of its 
 *	VOLUME.  If you call SetSoundVolume with a mode of RESET_VOLUME, 
 *	it will undo the last setting.  The volume parameter is
 *      ignored in this case.
 *
 * Side Effects:
 *	Sets the System Volume
 *
 * Results:
 *      None
 *
 *-----------------------------------------------------------------------------
 */

void
SetSoundVolume(
    int volume,              /* This is the new volume */
    enum WhichVolume mode)   /* This flag says which volume to
			      * set: SysBeep, SndPlay, or instructs us
			      * to reset the volume */
{
    static int hasSM3 = -1;
    static enum WhichVolume oldMode;
    static long oldVolume = -1;

    /*
     * The volume setting calls only work if we have SoundManager
     * 3.0 or higher.  So we check that here.
     */
    
    if (hasSM3 == -1) {
    	if (GetToolboxTrapAddress(_SoundDispatch) 
		!= GetToolboxTrapAddress(_Unimplemented)) {
	    NumVersion SMVers = SndSoundManagerVersion();
	    if (SMVers.majorRev > 2) {
	    	hasSM3 = 1;
	    } else {
		hasSM3 = 0;
	    }
	} else {
	    /*
	     * If the SoundDispatch trap is not present, then
	     * we don't have the SoundManager at all.
	     */
	    
	    hasSM3 = 0;
	}
    }
    
    /*
     * If we don't have Sound Manager 3.0, we can't set the sound volume.
     * We will just ignore the request rather than raising an error.
     */
    
    if (!hasSM3) {
    	return;
    }
    
    switch (mode) {
    	case SYS_BEEP_VOLUME:
	    GetSysBeepVolume(&oldVolume);
	    SetSysBeepVolume(volume);
	    oldMode = SYS_BEEP_VOLUME;
	    break;
	case DEFAULT_SND_VOLUME:
	    GetDefaultOutputVolume(&oldVolume);
	    SetDefaultOutputVolume(volume);
	    oldMode = DEFAULT_SND_VOLUME;
	    break;
	case RESET_VOLUME:
	    /*
	     * If oldVolume is -1 someone has made a programming error
	     * and called reset before setting the volume.  This is benign
	     * however, so we will just exit.
	     */
	  
	    if (oldVolume != -1) {	
	        if (oldMode == SYS_BEEP_VOLUME) {
	    	    SetSysBeepVolume(oldVolume);
	        } else if (oldMode == DEFAULT_SND_VOLUME) {
		    SetDefaultOutputVolume(oldVolume);
	        }
	    }
	    oldVolume = -1;
    }
}

/*
 *-----------------------------------------------------------------------------
 *
 * Tcl_MacEvalResource --
 *
 *	Used to extend the source command.  Sources Tcl code from a Text
 *	resource.  Currently only sources the resouce by name file ID may be
 *	supported at a later date.
 *
 * Side Effects:
 *	Depends on the Tcl code in the resource.
 *
 * Results:
 *      Returns a Tcl result.
 *
 *-----------------------------------------------------------------------------
 */

int
Tcl_MacEvalResource(
    Tcl_Interp *interp,		/* Interpreter in which to process file. */
    CONST char *resourceName,	/* Name of TEXT resource to source,
				   NULL if number should be used. */
    int resourceNumber,		/* Resource id of source. */
    CONST char *fileName)	/* Name of file to process.
				   NULL if application resource. */
{
    Handle sourceText;
    Str255 rezName;
    char msg[200];
    int result, iOpenedResFile = false;
    short saveRef, fileRef = -1;
    char idStr[64];
    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 = FSpOpenResFileCompat(&fileSpec, fsRdPerm);
	if (fileRef == -1) {
	    Tcl_AppendResult(interp, "Error reading the file: \"", 
		fileName, "\".", NULL);
	    return TCL_ERROR;
	}
		
	UseResFile(fileRef);
	iOpenedResFile = true;
    } 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) {
	Tcl_DString ds;
	Tcl_UtfToExternalDString(NULL, resourceName, -1, &ds);
	strcpy((char *) rezName + 1, Tcl_DStringValue(&ds));
	rezName[0] = (unsigned) Tcl_DStringLength(&ds);
	sourceText = GetNamedResource('TEXT', rezName);
	Tcl_DStringFree(&ds);
    } else {
	sourceText = GetResource('TEXT', (short) resourceNumber);
    }
	
    if (sourceText == NULL) {
	result = TCL_ERROR;
    } else {
	char *sourceStr = NULL;

	HLock(sourceText);
	sourceStr = Tcl_MacConvertTextResource(sourceText);
	HUnlock(sourceText);
	ReleaseResource(sourceText);
		
	/*
	 * We now evaluate the Tcl source
	 */
	result = Tcl_Eval(interp, sourceStr);
	ckfree(sourceStr);
	if (result == TCL_RETURN) {
	    result = TCL_OK;
	} else if (result == TCL_ERROR) {
	    sprintf(msg, "\n    (rsrc \"%.150s\" line %d)",
                    resourceName,
		    interp->errorLine);
	    Tcl_AddErrorInfo(interp, msg);
	}
				
	goto rezEvalCleanUp;
    }
	
    rezEvalError: