Symaptic: os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/mac/tclMacResource.c@bde4ae8d615e (annotated)

sl@0	1	/*
sl@0	2	* tclMacResource.c --
sl@0	3	*
sl@0	4	* This file contains several commands that manipulate or use
sl@0	5	* Macintosh resources. Included are extensions to the "source"
sl@0	6	* command, the mac specific "beep" and "resource" commands, and
sl@0	7	* administration for open resource file references.
sl@0	8	*
sl@0	9	* Copyright (c) 1996-1997 Sun Microsystems, Inc.
sl@0	10	*
sl@0	11	* See the file "license.terms" for information on usage and redistribution
sl@0	12	* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0	13	*
sl@0	14	* RCS: @(#) $Id: tclMacResource.c,v 1.14.2.1 2003/10/01 14:34:16 das Exp $
sl@0	15	*/
sl@0	16
sl@0	17	#include <Errors.h>
sl@0	18	#include <FSpCompat.h>
sl@0	19	#include <Processes.h>
sl@0	20	#include <Resources.h>
sl@0	21	#include <Sound.h>
sl@0	22	#include <Strings.h>
sl@0	23	#include <Traps.h>
sl@0	24	#include <LowMem.h>
sl@0	25
sl@0	26	#include "FullPath.h"
sl@0	27	#include "tcl.h"
sl@0	28	#include "tclInt.h"
sl@0	29	#include "tclMac.h"
sl@0	30	#include "tclMacInt.h"
sl@0	31	#include "tclMacPort.h"
sl@0	32
sl@0	33	/*
sl@0	34	* This flag tells the RegisterResource function to insert the
sl@0	35	* resource into the tail of the resource fork list. Needed only
sl@0	36	* Resource_Init.
sl@0	37	*/
sl@0	38
sl@0	39	#define TCL_RESOURCE_INSERT_TAIL 1
sl@0	40	/*
sl@0	41	* 2 is taken by TCL_RESOURCE_DONT_CLOSE
sl@0	42	* which is the only public flag to TclMacRegisterResourceFork.
sl@0	43	*/
sl@0	44
sl@0	45	#define TCL_RESOURCE_CHECK_IF_OPEN 4
sl@0	46
sl@0	47	/*
sl@0	48	* Pass this in the mode parameter of SetSoundVolume to determine
sl@0	49	* which volume to set.
sl@0	50	*/
sl@0	51
sl@0	52	enum WhichVolume {
sl@0	53	SYS_BEEP_VOLUME, /* This sets the volume for SysBeep calls */
sl@0	54	DEFAULT_SND_VOLUME, /* This one for SndPlay calls */
sl@0	55	RESET_VOLUME /* And this undoes the last call to SetSoundVolume */
sl@0	56	};
sl@0	57
sl@0	58	/*
sl@0	59	* Hash table to track open resource files.
sl@0	60	*/
sl@0	61
sl@0	62	typedef struct OpenResourceFork {
sl@0	63	short fileRef;
sl@0	64	int flags;
sl@0	65	} OpenResourceFork;
sl@0	66
sl@0	67
sl@0	68
sl@0	69	static Tcl_HashTable nameTable; /* Id to process number mapping. */
sl@0	70	static Tcl_HashTable resourceTable; /* Process number to id mapping. */
sl@0	71	static Tcl_Obj resourceForkList; / Ordered list of resource forks */
sl@0	72	static int appResourceIndex; /* This is the index of the application*
sl@0	73	* in the list of resource forks */
sl@0	74	static int newId = 0; /* Id source. */
sl@0	75	static int initialized = 0; /* 0 means static structures haven't
sl@0	76	* been initialized yet. */
sl@0	77	static int osTypeInit = 0; /* 0 means Tcl object of osType hasn't
sl@0	78	* been initialized yet. */
sl@0	79	/*
sl@0	80	* Prototypes for procedures defined later in this file:
sl@0	81	*/
sl@0	82
sl@0	83	static void DupOSTypeInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
sl@0	84	Tcl_Obj *copyPtr));
sl@0	85	static void ResourceInit _ANSI_ARGS_((void));
sl@0	86	static void BuildResourceForkList _ANSI_ARGS_((void));
sl@0	87	static int SetOSTypeFromAny _ANSI_ARGS_((Tcl_Interp *interp,
sl@0	88	Tcl_Obj *objPtr));
sl@0	89	static void UpdateStringOfOSType _ANSI_ARGS_((Tcl_Obj *objPtr));
sl@0	90	static OpenResourceFork* GetRsrcRefFromObj _ANSI_ARGS_((Tcl_Obj *objPtr,
sl@0	91	int okayOnReadOnly, const char *operation,
sl@0	92	Tcl_Obj *resultPtr));
sl@0	93
sl@0	94	static void SetSoundVolume(int volume, enum WhichVolume mode);
sl@0	95
sl@0	96	/*
sl@0	97	* The structures below defines the Tcl object type defined in this file by
sl@0	98	* means of procedures that can be invoked by generic object code.
sl@0	99	*/
sl@0	100
sl@0	101	static Tcl_ObjType osType = {
sl@0	102	"ostype", /* name */
sl@0	103	(Tcl_FreeInternalRepProc ) NULL, / freeIntRepProc */
sl@0	104	DupOSTypeInternalRep, /* dupIntRepProc */
sl@0	105	UpdateStringOfOSType, /* updateStringProc */
sl@0	106	SetOSTypeFromAny /* setFromAnyProc */
sl@0	107	};
sl@0	108
sl@0	109	/*
sl@0	110	*----------------------------------------------------------------------
sl@0	111	*
sl@0	112	* Tcl_ResourceObjCmd --
sl@0	113	*
sl@0	114	* This procedure is invoked to process the "resource" Tcl command.
sl@0	115	* See the user documentation for details on what it does.
sl@0	116	*
sl@0	117	* Results:
sl@0	118	* A standard Tcl result.
sl@0	119	*
sl@0	120	* Side effects:
sl@0	121	* See the user documentation.
sl@0	122	*
sl@0	123	*----------------------------------------------------------------------
sl@0	124	*/
sl@0	125
sl@0	126	int
sl@0	127	Tcl_ResourceObjCmd(
sl@0	128	ClientData clientData, /* Not used. */
sl@0	129	Tcl_Interp interp, / Current interpreter. */
sl@0	130	int objc, /* Number of arguments. */
sl@0	131	Tcl_Obj CONST objv[]) / Argument values. */
sl@0	132	{
sl@0	133	Tcl_Obj resultPtr, objPtr;
sl@0	134	int index, result;
sl@0	135	long fileRef, rsrcId;
sl@0	136	FSSpec fileSpec;
sl@0	137	char *stringPtr;
sl@0	138	char errbuf[16];
sl@0	139	OpenResourceFork *resourceRef;
sl@0	140	Handle resource = NULL;
sl@0	141	OSErr err;
sl@0	142	int count, i, limitSearch = false, length;
sl@0	143	short id, saveRef, resInfo;
sl@0	144	Str255 theName;
sl@0	145	OSType rezType;
sl@0	146	int gotInt, releaseIt = 0, force;
sl@0	147	char *resourceId = NULL;
sl@0	148	long size;
sl@0	149	char macPermision;
sl@0	150	int mode;
sl@0	151
sl@0	152	static CONST char *switches[] = {"close", "delete" ,"files", "list",
sl@0	153	"open", "read", "types", "write", (char *) NULL
sl@0	154	};
sl@0	155
sl@0	156	enum {
sl@0	157	RESOURCE_CLOSE, RESOURCE_DELETE, RESOURCE_FILES, RESOURCE_LIST,
sl@0	158	RESOURCE_OPEN, RESOURCE_READ, RESOURCE_TYPES, RESOURCE_WRITE
sl@0	159	};
sl@0	160
sl@0	161	static CONST char *writeSwitches[] = {
sl@0	162	"-id", "-name", "-file", "-force", (char *) NULL
sl@0	163	};
sl@0	164
sl@0	165	enum {
sl@0	166	RESOURCE_WRITE_ID, RESOURCE_WRITE_NAME,
sl@0	167	RESOURCE_WRITE_FILE, RESOURCE_FORCE
sl@0	168	};
sl@0	169
sl@0	170	static CONST char deleteSwitches[] = {"-id", "-name", "-file", (char ) NULL};
sl@0	171
sl@0	172	enum {RESOURCE_DELETE_ID, RESOURCE_DELETE_NAME, RESOURCE_DELETE_FILE};
sl@0	173
sl@0	174	resultPtr = Tcl_GetObjResult(interp);
sl@0	175
sl@0	176	if (objc < 2) {
sl@0	177	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
sl@0	178	return TCL_ERROR;
sl@0	179	}
sl@0	180
sl@0	181	if (Tcl_GetIndexFromObj(interp, objv[1], switches, "option", 0, &index)
sl@0	182	!= TCL_OK) {
sl@0	183	return TCL_ERROR;
sl@0	184	}
sl@0	185	if (!initialized) {
sl@0	186	ResourceInit();
sl@0	187	}
sl@0	188	result = TCL_OK;
sl@0	189
sl@0	190	switch (index) {
sl@0	191	case RESOURCE_CLOSE:
sl@0	192	if (objc != 3) {
sl@0	193	Tcl_WrongNumArgs(interp, 2, objv, "resourceRef");
sl@0	194	return TCL_ERROR;
sl@0	195	}
sl@0	196	stringPtr = Tcl_GetStringFromObj(objv[2], &length);
sl@0	197	fileRef = TclMacUnRegisterResourceFork(stringPtr, resultPtr);
sl@0	198
sl@0	199	if (fileRef >= 0) {
sl@0	200	CloseResFile((short) fileRef);
sl@0	201	return TCL_OK;
sl@0	202	} else {
sl@0	203	return TCL_ERROR;
sl@0	204	}
sl@0	205	case RESOURCE_DELETE:
sl@0	206	if (!((objc >= 3) && (objc <= 9) && ((objc % 2) == 1))) {
sl@0	207	Tcl_WrongNumArgs(interp, 2, objv,
sl@0	208	"?-id resourceId? ?-name resourceName? ?-file \
sl@0	209	resourceRef? resourceType");
sl@0	210	return TCL_ERROR;
sl@0	211	}
sl@0	212
sl@0	213	i = 2;
sl@0	214	fileRef = -1;
sl@0	215	gotInt = false;
sl@0	216	resourceId = NULL;
sl@0	217	limitSearch = false;
sl@0	218
sl@0	219	while (i < (objc - 2)) {
sl@0	220	if (Tcl_GetIndexFromObj(interp, objv[i], deleteSwitches,
sl@0	221	"option", 0, &index) != TCL_OK) {
sl@0	222	return TCL_ERROR;
sl@0	223	}
sl@0	224
sl@0	225	switch (index) {
sl@0	226	case RESOURCE_DELETE_ID:
sl@0	227	if (Tcl_GetLongFromObj(interp, objv[i+1], &rsrcId)
sl@0	228	!= TCL_OK) {
sl@0	229	return TCL_ERROR;
sl@0	230	}
sl@0	231	gotInt = true;
sl@0	232	break;
sl@0	233	case RESOURCE_DELETE_NAME:
sl@0	234	resourceId = Tcl_GetStringFromObj(objv[i+1], &length);
sl@0	235	if (length > 255) {
sl@0	236	Tcl_AppendStringsToObj(resultPtr,"-name argument ",
sl@0	237	"too long, must be < 255 characters",
sl@0	238	(char *) NULL);
sl@0	239	return TCL_ERROR;
sl@0	240	}
sl@0	241	strcpy((char *) theName, resourceId);
sl@0	242	resourceId = (char *) theName;
sl@0	243	c2pstr(resourceId);
sl@0	244	break;
sl@0	245	case RESOURCE_DELETE_FILE:
sl@0	246	resourceRef = GetRsrcRefFromObj(objv[i+1], 0,
sl@0	247	"delete from", resultPtr);
sl@0	248	if (resourceRef == NULL) {
sl@0	249	return TCL_ERROR;
sl@0	250	}
sl@0	251	limitSearch = true;
sl@0	252	break;
sl@0	253	}
sl@0	254	i += 2;
sl@0	255	}
sl@0	256
sl@0	257	if ((resourceId == NULL) && !gotInt) {
sl@0	258	Tcl_AppendStringsToObj(resultPtr,"you must specify either ",
sl@0	259	"\"-id\" or \"-name\" or both ",
sl@0	260	"to \"resource delete\"",
sl@0	261	(char *) NULL);
sl@0	262	return TCL_ERROR;
sl@0	263	}
sl@0	264
sl@0	265	if (Tcl_GetOSTypeFromObj(interp, objv[i], &rezType) != TCL_OK) {
sl@0	266	return TCL_ERROR;
sl@0	267	}
sl@0	268
sl@0	269	if (limitSearch) {
sl@0	270	saveRef = CurResFile();
sl@0	271	UseResFile((short) resourceRef->fileRef);
sl@0	272	}
sl@0	273
sl@0	274	SetResLoad(false);
sl@0	275
sl@0	276	if (gotInt == true) {
sl@0	277	if (limitSearch) {
sl@0	278	resource = Get1Resource(rezType, rsrcId);
sl@0	279	} else {
sl@0	280	resource = GetResource(rezType, rsrcId);
sl@0	281	}
sl@0	282	err = ResError();
sl@0	283
sl@0	284	if (err == resNotFound \|\| resource == NULL) {
sl@0	285	Tcl_AppendStringsToObj(resultPtr, "resource not found",
sl@0	286	(char *) NULL);
sl@0	287	result = TCL_ERROR;
sl@0	288	goto deleteDone;
sl@0	289	} else if (err != noErr) {
sl@0	290	char buffer[16];
sl@0	291
sl@0	292	sprintf(buffer, "%12d", err);
sl@0	293	Tcl_AppendStringsToObj(resultPtr, "resource error #",
sl@0	294	buffer, "occured while trying to find resource",
sl@0	295	(char *) NULL);
sl@0	296	result = TCL_ERROR;
sl@0	297	goto deleteDone;
sl@0	298	}
sl@0	299	}
sl@0	300
sl@0	301	if (resourceId != NULL) {
sl@0	302	Handle tmpResource;
sl@0	303	if (limitSearch) {
sl@0	304	tmpResource = Get1NamedResource(rezType,
sl@0	305	(StringPtr) resourceId);
sl@0	306	} else {
sl@0	307	tmpResource = GetNamedResource(rezType,
sl@0	308	(StringPtr) resourceId);
sl@0	309	}
sl@0	310	err = ResError();
sl@0	311
sl@0	312	if (err == resNotFound \|\| tmpResource == NULL) {
sl@0	313	Tcl_AppendStringsToObj(resultPtr, "resource not found",
sl@0	314	(char *) NULL);
sl@0	315	result = TCL_ERROR;
sl@0	316	goto deleteDone;
sl@0	317	} else if (err != noErr) {
sl@0	318	char buffer[16];
sl@0	319
sl@0	320	sprintf(buffer, "%12d", err);
sl@0	321	Tcl_AppendStringsToObj(resultPtr, "resource error #",
sl@0	322	buffer, "occured while trying to find resource",
sl@0	323	(char *) NULL);
sl@0	324	result = TCL_ERROR;
sl@0	325	goto deleteDone;
sl@0	326	}
sl@0	327
sl@0	328	if (gotInt) {
sl@0	329	if (resource != tmpResource) {
sl@0	330	Tcl_AppendStringsToObj(resultPtr,
sl@0	331	"\"-id\" and \"-name\" ",
sl@0	332	"values do not point to the same resource",
sl@0	333	(char *) NULL);
sl@0	334	result = TCL_ERROR;
sl@0	335	goto deleteDone;
sl@0	336	}
sl@0	337	} else {
sl@0	338	resource = tmpResource;
sl@0	339	}
sl@0	340	}
sl@0	341
sl@0	342	resInfo = GetResAttrs(resource);
sl@0	343
sl@0	344	if ((resInfo & resProtected) == resProtected) {
sl@0	345	Tcl_AppendStringsToObj(resultPtr, "resource ",
sl@0	346	"cannot be deleted: it is protected.",
sl@0	347	(char *) NULL);
sl@0	348	result = TCL_ERROR;
sl@0	349	goto deleteDone;
sl@0	350	} else if ((resInfo & resSysHeap) == resSysHeap) {
sl@0	351	Tcl_AppendStringsToObj(resultPtr, "resource",
sl@0	352	"cannot be deleted: it is in the system heap.",
sl@0	353	(char *) NULL);
sl@0	354	result = TCL_ERROR;
sl@0	355	goto deleteDone;
sl@0	356	}
sl@0	357
sl@0	358	/*
sl@0	359	* Find the resource file, if it was not specified,
sl@0	360	* so we can flush the changes now. Perhaps this is
sl@0	361	* a little paranoid, but better safe than sorry.
sl@0	362	*/
sl@0	363
sl@0	364	RemoveResource(resource);
sl@0	365
sl@0	366	if (!limitSearch) {
sl@0	367	UpdateResFile(HomeResFile(resource));
sl@0	368	} else {
sl@0	369	UpdateResFile(resourceRef->fileRef);
sl@0	370	}
sl@0	371
sl@0	372
sl@0	373	deleteDone:
sl@0	374
sl@0	375	SetResLoad(true);
sl@0	376	if (limitSearch) {
sl@0	377	UseResFile(saveRef);
sl@0	378	}
sl@0	379	return result;
sl@0	380
sl@0	381	case RESOURCE_FILES:
sl@0	382	if ((objc < 2) \|\| (objc > 3)) {
sl@0	383	Tcl_SetStringObj(resultPtr,
sl@0	384	"wrong # args: should be \"resource files \
sl@0	385	?resourceId?\"", -1);
sl@0	386	return TCL_ERROR;
sl@0	387	}
sl@0	388
sl@0	389	if (objc == 2) {
sl@0	390	stringPtr = Tcl_GetStringFromObj(resourceForkList, &length);
sl@0	391	Tcl_SetStringObj(resultPtr, stringPtr, length);
sl@0	392	} else {
sl@0	393	FCBPBRec fileRec;
sl@0	394	Handle pathHandle;
sl@0	395	short pathLength;
sl@0	396	Str255 fileName;
sl@0	397	Tcl_DString dstr;
sl@0	398
sl@0	399	if (strcmp(Tcl_GetString(objv[2]), "ROM Map") == 0) {
sl@0	400	Tcl_SetStringObj(resultPtr,"no file path for ROM Map", -1);
sl@0	401	return TCL_ERROR;
sl@0	402	}
sl@0	403
sl@0	404	resourceRef = GetRsrcRefFromObj(objv[2], 1, "files", resultPtr);
sl@0	405	if (resourceRef == NULL) {
sl@0	406	return TCL_ERROR;
sl@0	407	}
sl@0	408
sl@0	409	fileRec.ioCompletion = NULL;
sl@0	410	fileRec.ioFCBIndx = 0;
sl@0	411	fileRec.ioNamePtr = fileName;
sl@0	412	fileRec.ioVRefNum = 0;
sl@0	413	fileRec.ioRefNum = resourceRef->fileRef;
sl@0	414	err = PBGetFCBInfo(&fileRec, false);
sl@0	415	if (err != noErr) {
sl@0	416	Tcl_SetStringObj(resultPtr,
sl@0	417	"could not get FCB for resource file", -1);
sl@0	418	return TCL_ERROR;
sl@0	419	}
sl@0	420
sl@0	421	err = GetFullPath(fileRec.ioFCBVRefNum, fileRec.ioFCBParID,
sl@0	422	fileRec.ioNamePtr, &pathLength, &pathHandle);
sl@0	423	if ( err != noErr) {
sl@0	424	Tcl_SetStringObj(resultPtr,
sl@0	425	"could not get file path from token", -1);
sl@0	426	return TCL_ERROR;
sl@0	427	}
sl@0	428
sl@0	429	HLock(pathHandle);
sl@0	430	Tcl_ExternalToUtfDString(NULL, *pathHandle, pathLength, &dstr);
sl@0	431
sl@0	432	Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&dstr), Tcl_DStringLength(&dstr));
sl@0	433	HUnlock(pathHandle);
sl@0	434	DisposeHandle(pathHandle);
sl@0	435	Tcl_DStringFree(&dstr);
sl@0	436	}
sl@0	437	return TCL_OK;
sl@0	438	case RESOURCE_LIST:
sl@0	439	if (!((objc == 3) \|\| (objc == 4))) {
sl@0	440	Tcl_WrongNumArgs(interp, 2, objv, "resourceType ?resourceRef?");
sl@0	441	return TCL_ERROR;
sl@0	442	}
sl@0	443	if (Tcl_GetOSTypeFromObj(interp, objv[2], &rezType) != TCL_OK) {
sl@0	444	return TCL_ERROR;
sl@0	445	}
sl@0	446
sl@0	447	if (objc == 4) {
sl@0	448	resourceRef = GetRsrcRefFromObj(objv[3], 1,
sl@0	449	"list", resultPtr);
sl@0	450	if (resourceRef == NULL) {
sl@0	451	return TCL_ERROR;
sl@0	452	}
sl@0	453
sl@0	454	saveRef = CurResFile();
sl@0	455	UseResFile((short) resourceRef->fileRef);
sl@0	456	limitSearch = true;
sl@0	457	}
sl@0	458
sl@0	459	Tcl_ResetResult(interp);
sl@0	460	if (limitSearch) {
sl@0	461	count = Count1Resources(rezType);
sl@0	462	} else {
sl@0	463	count = CountResources(rezType);
sl@0	464	}
sl@0	465	SetResLoad(false);
sl@0	466	for (i = 1; i <= count; i++) {
sl@0	467	if (limitSearch) {
sl@0	468	resource = Get1IndResource(rezType, i);
sl@0	469	} else {
sl@0	470	resource = GetIndResource(rezType, i);
sl@0	471	}
sl@0	472	if (resource != NULL) {
sl@0	473	GetResInfo(resource, &id, (ResType *) &rezType, theName);
sl@0	474	if (theName[0] != 0) {
sl@0	475
sl@0	476	objPtr = Tcl_NewStringObj((char *) theName + 1,
sl@0	477	theName[0]);
sl@0	478	} else {
sl@0	479	objPtr = Tcl_NewIntObj(id);
sl@0	480	}
sl@0	481	ReleaseResource(resource);
sl@0	482	result = Tcl_ListObjAppendElement(interp, resultPtr,
sl@0	483	objPtr);
sl@0	484	if (result != TCL_OK) {
sl@0	485	Tcl_DecrRefCount(objPtr);
sl@0	486	break;
sl@0	487	}
sl@0	488	}
sl@0	489	}
sl@0	490	SetResLoad(true);
sl@0	491
sl@0	492	if (limitSearch) {
sl@0	493	UseResFile(saveRef);
sl@0	494	}
sl@0	495
sl@0	496	return TCL_OK;
sl@0	497	case RESOURCE_OPEN: {
sl@0	498	Tcl_DString ds, buffer;
sl@0	499	CONST char str, native;
sl@0	500	int length;
sl@0	501
sl@0	502	if (!((objc == 3) \|\| (objc == 4))) {
sl@0	503	Tcl_WrongNumArgs(interp, 2, objv, "fileName ?permissions?");
sl@0	504	return TCL_ERROR;
sl@0	505	}
sl@0	506	str = Tcl_GetStringFromObj(objv[2], &length);
sl@0	507	if (Tcl_TranslateFileName(interp, str, &buffer) == NULL) {
sl@0	508	return TCL_ERROR;
sl@0	509	}
sl@0	510	native = Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&buffer),
sl@0	511	Tcl_DStringLength(&buffer), &ds);
sl@0	512	err = FSpLocationFromPath(Tcl_DStringLength(&ds), native, &fileSpec);
sl@0	513	Tcl_DStringFree(&ds);
sl@0	514	Tcl_DStringFree(&buffer);
sl@0	515
sl@0	516	if (!((err == noErr) \|\| (err == fnfErr))) {
sl@0	517	Tcl_AppendStringsToObj(resultPtr, "invalid path", (char *) NULL);
sl@0	518	return TCL_ERROR;
sl@0	519	}
sl@0	520
sl@0	521	/*
sl@0	522	* Get permissions for the file. We really only understand
sl@0	523	* read-only and shared-read-write. If no permissions are
sl@0	524	* given we default to read only.
sl@0	525	*/
sl@0	526
sl@0	527	if (objc == 4) {
sl@0	528	stringPtr = Tcl_GetStringFromObj(objv[3], &length);
sl@0	529	mode = TclGetOpenMode(interp, stringPtr, &index);
sl@0	530	if (mode == -1) {
sl@0	531	/* TODO: TclGetOpenMode doesn't work with Obj commands. */
sl@0	532	return TCL_ERROR;
sl@0	533	}
sl@0	534	switch (mode & (O_RDONLY \| O_WRONLY \| O_RDWR)) {
sl@0	535	case O_RDONLY:
sl@0	536	macPermision = fsRdPerm;
sl@0	537	break;
sl@0	538	case O_WRONLY:
sl@0	539	case O_RDWR:
sl@0	540	macPermision = fsRdWrShPerm;
sl@0	541	break;
sl@0	542	default:
sl@0	543	panic("Tcl_ResourceObjCmd: invalid mode value");
sl@0	544	break;
sl@0	545	}
sl@0	546	} else {
sl@0	547	macPermision = fsRdPerm;
sl@0	548	}
sl@0	549
sl@0	550	/*
sl@0	551	* Don't load in any of the resources in the file, this could
sl@0	552	* cause problems if you open a file that has CODE resources...
sl@0	553	*/
sl@0	554
sl@0	555	SetResLoad(false);
sl@0	556	fileRef = (long) FSpOpenResFileCompat(&fileSpec, macPermision);
sl@0	557	SetResLoad(true);
sl@0	558
sl@0	559	if (fileRef == -1) {
sl@0	560	err = ResError();
sl@0	561	if (((err == fnfErr) \|\| (err == eofErr)) &&
sl@0	562	(macPermision == fsRdWrShPerm)) {
sl@0	563	/*
sl@0	564	* No resource fork existed for this file. Since we are
sl@0	565	* opening it for writing we will create the resource fork
sl@0	566	* now.
sl@0	567	*/
sl@0	568
sl@0	569	HCreateResFile(fileSpec.vRefNum, fileSpec.parID,
sl@0	570	fileSpec.name);
sl@0	571	fileRef = (long) FSpOpenResFileCompat(&fileSpec,
sl@0	572	macPermision);
sl@0	573	if (fileRef == -1) {
sl@0	574	goto openError;
sl@0	575	}
sl@0	576	} else if (err == fnfErr) {
sl@0	577	Tcl_AppendStringsToObj(resultPtr,
sl@0	578	"file does not exist", (char *) NULL);
sl@0	579	return TCL_ERROR;
sl@0	580	} else if (err == eofErr) {
sl@0	581	Tcl_AppendStringsToObj(resultPtr,
sl@0	582	"file does not contain resource fork", (char *) NULL);
sl@0	583	return TCL_ERROR;
sl@0	584	} else {
sl@0	585	openError:
sl@0	586	Tcl_AppendStringsToObj(resultPtr,
sl@0	587	"error opening resource file", (char *) NULL);
sl@0	588	return TCL_ERROR;
sl@0	589	}
sl@0	590	}
sl@0	591
sl@0	592	/*
sl@0	593	* The FspOpenResFile function does not set the ResFileAttrs.
sl@0	594	* Even if you open the file read only, the mapReadOnly
sl@0	595	* attribute is not set. This means we can't detect writes to a
sl@0	596	* read only resource fork until the write fails, which is bogus.
sl@0	597	* So set it here...
sl@0	598	*/
sl@0	599
sl@0	600	if (macPermision == fsRdPerm) {
sl@0	601	SetResFileAttrs(fileRef, mapReadOnly);
sl@0	602	}
sl@0	603
sl@0	604	Tcl_SetStringObj(resultPtr, "", 0);
sl@0	605	if (TclMacRegisterResourceFork(fileRef, resultPtr,
sl@0	606	TCL_RESOURCE_CHECK_IF_OPEN) != TCL_OK) {
sl@0	607	CloseResFile(fileRef);
sl@0	608	return TCL_ERROR;
sl@0	609	}
sl@0	610	return TCL_OK;
sl@0	611	}
sl@0	612	case RESOURCE_READ:
sl@0	613	if (!((objc == 4) \|\| (objc == 5))) {
sl@0	614	Tcl_WrongNumArgs(interp, 2, objv,
sl@0	615	"resourceType resourceId ?resourceRef?");
sl@0	616	return TCL_ERROR;
sl@0	617	}
sl@0	618
sl@0	619	if (Tcl_GetOSTypeFromObj(interp, objv[2], &rezType) != TCL_OK) {
sl@0	620	return TCL_ERROR;
sl@0	621	}
sl@0	622
sl@0	623	if (Tcl_GetLongFromObj((Tcl_Interp *) NULL, objv[3], &rsrcId)
sl@0	624	!= TCL_OK) {
sl@0	625	resourceId = Tcl_GetStringFromObj(objv[3], &length);
sl@0	626	}
sl@0	627
sl@0	628	if (objc == 5) {
sl@0	629	stringPtr = Tcl_GetStringFromObj(objv[4], &length);
sl@0	630	} else {
sl@0	631	stringPtr = NULL;
sl@0	632	}
sl@0	633
sl@0	634	resource = Tcl_MacFindResource(interp, rezType, resourceId,
sl@0	635	rsrcId, stringPtr, &releaseIt);
sl@0	636
sl@0	637	if (resource != NULL) {
sl@0	638	size = GetResourceSizeOnDisk(resource);
sl@0	639	Tcl_SetByteArrayObj(resultPtr, (unsigned char ) resource, size);
sl@0	640
sl@0	641	/*
sl@0	642	* Don't release the resource unless WE loaded it...
sl@0	643	*/
sl@0	644
sl@0	645	if (releaseIt) {
sl@0	646	ReleaseResource(resource);
sl@0	647	}
sl@0	648	return TCL_OK;
sl@0	649	} else {
sl@0	650	Tcl_AppendStringsToObj(resultPtr, "could not load resource",
sl@0	651	(char *) NULL);
sl@0	652	return TCL_ERROR;
sl@0	653	}
sl@0	654	case RESOURCE_TYPES:
sl@0	655	if (!((objc == 2) \|\| (objc == 3))) {
sl@0	656	Tcl_WrongNumArgs(interp, 2, objv, "?resourceRef?");
sl@0	657	return TCL_ERROR;
sl@0	658	}
sl@0	659
sl@0	660	if (objc == 3) {
sl@0	661	resourceRef = GetRsrcRefFromObj(objv[2], 1,
sl@0	662	"get types of", resultPtr);
sl@0	663	if (resourceRef == NULL) {
sl@0	664	return TCL_ERROR;
sl@0	665	}
sl@0	666
sl@0	667	saveRef = CurResFile();
sl@0	668	UseResFile((short) resourceRef->fileRef);
sl@0	669	limitSearch = true;
sl@0	670	}
sl@0	671
sl@0	672	if (limitSearch) {
sl@0	673	count = Count1Types();
sl@0	674	} else {
sl@0	675	count = CountTypes();
sl@0	676	}
sl@0	677	for (i = 1; i <= count; i++) {
sl@0	678	if (limitSearch) {
sl@0	679	Get1IndType((ResType *) &rezType, i);
sl@0	680	} else {
sl@0	681	GetIndType((ResType *) &rezType, i);
sl@0	682	}
sl@0	683	objPtr = Tcl_NewOSTypeObj(rezType);
sl@0	684	result = Tcl_ListObjAppendElement(interp, resultPtr, objPtr);
sl@0	685	if (result != TCL_OK) {
sl@0	686	Tcl_DecrRefCount(objPtr);
sl@0	687	break;
sl@0	688	}
sl@0	689	}
sl@0	690
sl@0	691	if (limitSearch) {
sl@0	692	UseResFile(saveRef);
sl@0	693	}
sl@0	694
sl@0	695	return result;
sl@0	696	case RESOURCE_WRITE:
sl@0	697	if ((objc < 4) \|\| (objc > 11)) {
sl@0	698	Tcl_WrongNumArgs(interp, 2, objv,
sl@0	699	"?-id resourceId? ?-name resourceName? ?-file resourceRef?\
sl@0	700	?-force? resourceType data");
sl@0	701	return TCL_ERROR;
sl@0	702	}
sl@0	703
sl@0	704	i = 2;
sl@0	705	gotInt = false;
sl@0	706	resourceId = NULL;
sl@0	707	limitSearch = false;
sl@0	708	force = 0;
sl@0	709
sl@0	710	while (i < (objc - 2)) {
sl@0	711	if (Tcl_GetIndexFromObj(interp, objv[i], writeSwitches,
sl@0	712	"switch", 0, &index) != TCL_OK) {
sl@0	713	return TCL_ERROR;
sl@0	714	}
sl@0	715
sl@0	716	switch (index) {
sl@0	717	case RESOURCE_WRITE_ID:
sl@0	718	if (Tcl_GetLongFromObj(interp, objv[i+1], &rsrcId)
sl@0	719	!= TCL_OK) {
sl@0	720	return TCL_ERROR;
sl@0	721	}
sl@0	722	gotInt = true;
sl@0	723	i += 2;
sl@0	724	break;
sl@0	725	case RESOURCE_WRITE_NAME:
sl@0	726	resourceId = Tcl_GetStringFromObj(objv[i+1], &length);
sl@0	727	strcpy((char *) theName, resourceId);
sl@0	728	resourceId = (char *) theName;
sl@0	729	c2pstr(resourceId);
sl@0	730	i += 2;
sl@0	731	break;
sl@0	732	case RESOURCE_WRITE_FILE:
sl@0	733	resourceRef = GetRsrcRefFromObj(objv[i+1], 0,
sl@0	734	"write to", resultPtr);
sl@0	735	if (resourceRef == NULL) {
sl@0	736	return TCL_ERROR;
sl@0	737	}
sl@0	738	limitSearch = true;
sl@0	739	i += 2;
sl@0	740	break;
sl@0	741	case RESOURCE_FORCE:
sl@0	742	force = 1;
sl@0	743	i += 1;
sl@0	744	break;
sl@0	745	}
sl@0	746	}
sl@0	747	if (Tcl_GetOSTypeFromObj(interp, objv[i], &rezType) != TCL_OK) {
sl@0	748	return TCL_ERROR;
sl@0	749	}
sl@0	750	stringPtr = (char *) Tcl_GetByteArrayFromObj(objv[i+1], &length);
sl@0	751
sl@0	752	if (gotInt == false) {
sl@0	753	rsrcId = UniqueID(rezType);
sl@0	754	}
sl@0	755	if (resourceId == NULL) {
sl@0	756	resourceId = (char *) "\p";
sl@0	757	}
sl@0	758	if (limitSearch) {
sl@0	759	saveRef = CurResFile();
sl@0	760	UseResFile((short) resourceRef->fileRef);
sl@0	761	}
sl@0	762
sl@0	763	/*
sl@0	764	* If we are adding the resource by number, then we must make sure
sl@0	765	* there is not already a resource of that number. We are not going
sl@0	766	* load it here, since we want to detect whether we loaded it or
sl@0	767	* not. Remember that releasing some resources in particular menu
sl@0	768	* related ones, can be fatal.
sl@0	769	*/
sl@0	770
sl@0	771	if (gotInt == true) {
sl@0	772	SetResLoad(false);
sl@0	773	resource = Get1Resource(rezType,rsrcId);
sl@0	774	SetResLoad(true);
sl@0	775	}
sl@0	776
sl@0	777	if (resource == NULL) {
sl@0	778	/*
sl@0	779	* We get into this branch either if there was not already a
sl@0	780	* resource of this type & id, or the id was not specified.
sl@0	781	*/
sl@0	782
sl@0	783	resource = NewHandle(length);
sl@0	784	if (resource == NULL) {
sl@0	785	resource = NewHandleSys(length);
sl@0	786	if (resource == NULL) {
sl@0	787	panic("could not allocate memory to write resource");
sl@0	788	}
sl@0	789	}
sl@0	790	HLock(resource);
sl@0	791	memcpy(*resource, stringPtr, length);
sl@0	792	HUnlock(resource);
sl@0	793	AddResource(resource, rezType, (short) rsrcId,
sl@0	794	(StringPtr) resourceId);
sl@0	795	releaseIt = 1;
sl@0	796	} else {
sl@0	797	/*
sl@0	798	* We got here because there was a resource of this type
sl@0	799	* & ID in the file.
sl@0	800	*/
sl@0	801
sl@0	802	if (*resource == NULL) {
sl@0	803	releaseIt = 1;
sl@0	804	} else {
sl@0	805	releaseIt = 0;
sl@0	806	}
sl@0	807
sl@0	808	if (!force) {
sl@0	809	/*
sl@0	810	*We only overwrite extant resources
sl@0	811	* when the -force flag has been set.
sl@0	812	*/
sl@0	813
sl@0	814	sprintf(errbuf,"%d", rsrcId);
sl@0	815
sl@0	816	Tcl_AppendStringsToObj(resultPtr, "the resource ",
sl@0	817	errbuf, " already exists, use \"-force\"",
sl@0	818	" to overwrite it.", (char *) NULL);
sl@0	819
sl@0	820	result = TCL_ERROR;
sl@0	821	goto writeDone;
sl@0	822	} else if (GetResAttrs(resource) & resProtected) {
sl@0	823	/*
sl@0	824	*
sl@0	825	* Next, check to see if it is protected...
sl@0	826	*/
sl@0	827
sl@0	828	sprintf(errbuf,"%d", rsrcId);
sl@0	829	Tcl_AppendStringsToObj(resultPtr,
sl@0	830	"could not write resource id ",
sl@0	831	errbuf, " of type ",
sl@0	832	Tcl_GetStringFromObj(objv[i],&length),
sl@0	833	", it was protected.",(char *) NULL);
sl@0	834	result = TCL_ERROR;
sl@0	835	goto writeDone;
sl@0	836	} else {
sl@0	837	/*
sl@0	838	* Be careful, the resource might already be in memory
sl@0	839	* if something else loaded it.
sl@0	840	*/
sl@0	841
sl@0	842	if (*resource == 0) {
sl@0	843	LoadResource(resource);
sl@0	844	err = ResError();
sl@0	845	if (err != noErr) {
sl@0	846	sprintf(errbuf,"%d", rsrcId);
sl@0	847	Tcl_AppendStringsToObj(resultPtr,
sl@0	848	"error loading resource ",
sl@0	849	errbuf, " of type ",
sl@0	850	Tcl_GetStringFromObj(objv[i],&length),
sl@0	851	" to overwrite it", (char *) NULL);
sl@0	852	goto writeDone;
sl@0	853	}
sl@0	854	}
sl@0	855
sl@0	856	SetHandleSize(resource, length);
sl@0	857	if ( MemError() != noErr ) {
sl@0	858	panic("could not allocate memory to write resource");
sl@0	859	}
sl@0	860
sl@0	861	HLock(resource);
sl@0	862	memcpy(*resource, stringPtr, length);
sl@0	863	HUnlock(resource);
sl@0	864
sl@0	865	ChangedResource(resource);
sl@0	866
sl@0	867	/*
sl@0	868	* We also may have changed the name...
sl@0	869	*/
sl@0	870
sl@0	871	SetResInfo(resource, rsrcId, (StringPtr) resourceId);
sl@0	872	}
sl@0	873	}
sl@0	874
sl@0	875	err = ResError();
sl@0	876	if (err != noErr) {
sl@0	877	Tcl_AppendStringsToObj(resultPtr,
sl@0	878	"error adding resource to resource map",
sl@0	879	(char *) NULL);
sl@0	880	result = TCL_ERROR;
sl@0	881	goto writeDone;
sl@0	882	}
sl@0	883
sl@0	884	WriteResource(resource);
sl@0	885	err = ResError();
sl@0	886	if (err != noErr) {
sl@0	887	Tcl_AppendStringsToObj(resultPtr,
sl@0	888	"error writing resource to disk",
sl@0	889	(char *) NULL);
sl@0	890	result = TCL_ERROR;
sl@0	891	}
sl@0	892
sl@0	893	writeDone:
sl@0	894
sl@0	895	if (releaseIt) {
sl@0	896	ReleaseResource(resource);
sl@0	897	err = ResError();
sl@0	898	if (err != noErr) {
sl@0	899	Tcl_AppendStringsToObj(resultPtr,
sl@0	900	"error releasing resource",
sl@0	901	(char *) NULL);
sl@0	902	result = TCL_ERROR;
sl@0	903	}
sl@0	904	}
sl@0	905
sl@0	906	if (limitSearch) {
sl@0	907	UseResFile(saveRef);
sl@0	908	}
sl@0	909
sl@0	910	return result;
sl@0	911	default:
sl@0	912	panic("Tcl_GetIndexFromObj returned unrecognized option");
sl@0	913	return TCL_ERROR; /* Should never be reached. */
sl@0	914	}
sl@0	915	}
sl@0	916
sl@0	917	/*
sl@0	918	*----------------------------------------------------------------------
sl@0	919	*
sl@0	920	* Tcl_MacSourceObjCmd --
sl@0	921	*
sl@0	922	* This procedure is invoked to process the "source" Tcl command.
sl@0	923	* See the user documentation for details on what it does. In
sl@0	924	* addition, it supports sourceing from the resource fork of
sl@0	925	* type 'TEXT'.
sl@0	926	*
sl@0	927	* Results:
sl@0	928	* A standard Tcl result.
sl@0	929	*
sl@0	930	* Side effects:
sl@0	931	* See the user documentation.
sl@0	932	*
sl@0	933	*----------------------------------------------------------------------
sl@0	934	*/
sl@0	935
sl@0	936	int
sl@0	937	Tcl_MacSourceObjCmd(
sl@0	938	ClientData dummy, /* Not used. */
sl@0	939	Tcl_Interp interp, / Current interpreter. */
sl@0	940	int objc, /* Number of arguments. */
sl@0	941	Tcl_Obj CONST objv[]) / Argument objects. */
sl@0	942	{
sl@0	943	char *errNum = "wrong # args: ";
sl@0	944	char *errBad = "bad argument: ";
sl@0	945	char *errStr;
sl@0	946	char fileName = NULL, rsrcName = NULL;
sl@0	947	long rsrcID = -1;
sl@0	948	char *string;
sl@0	949	int length;
sl@0	950
sl@0	951	if (objc < 2 \|\| objc > 4) {
sl@0	952	errStr = errNum;
sl@0	953	goto sourceFmtErr;
sl@0	954	}
sl@0	955
sl@0	956	if (objc == 2) {
sl@0	957	return Tcl_FSEvalFile(interp, objv[1]);
sl@0	958	}
sl@0	959
sl@0	960	/*
sl@0	961	* The following code supports a few older forms of this command
sl@0	962	* for backward compatability.
sl@0	963	*/
sl@0	964	string = Tcl_GetStringFromObj(objv[1], &length);
sl@0	965	if (!strcmp(string, "-rsrc") \|\| !strcmp(string, "-rsrcname")) {
sl@0	966	rsrcName = Tcl_GetStringFromObj(objv[2], &length);
sl@0	967	} else if (!strcmp(string, "-rsrcid")) {
sl@0	968	if (Tcl_GetLongFromObj(interp, objv[2], &rsrcID) != TCL_OK) {
sl@0	969	return TCL_ERROR;
sl@0	970	}
sl@0	971	} else {
sl@0	972	errStr = errBad;
sl@0	973	goto sourceFmtErr;
sl@0	974	}
sl@0	975
sl@0	976	if (objc == 4) {
sl@0	977	fileName = Tcl_GetStringFromObj(objv[3], &length);
sl@0	978	}
sl@0	979	return Tcl_MacEvalResource(interp, rsrcName, rsrcID, fileName);
sl@0	980
sl@0	981	sourceFmtErr:
sl@0	982	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), errStr, "should be \"",
sl@0	983	Tcl_GetString(objv[0]), " fileName\" or \"",
sl@0	984	Tcl_GetString(objv[0]), " -rsrc name ?fileName?\" or \"",
sl@0	985	Tcl_GetString(objv[0]), " -rsrcid id ?fileName?\"",
sl@0	986	(char *) NULL);
sl@0	987	return TCL_ERROR;
sl@0	988	}
sl@0	989
sl@0	990	/*
sl@0	991	*----------------------------------------------------------------------
sl@0	992	*
sl@0	993	* Tcl_BeepObjCmd --
sl@0	994	*
sl@0	995	* This procedure makes the beep sound.
sl@0	996	*
sl@0	997	* Results:
sl@0	998	* A standard Tcl result.
sl@0	999	*
sl@0	1000	* Side effects:
sl@0	1001	* Makes a beep.
sl@0	1002	*
sl@0	1003	*----------------------------------------------------------------------
sl@0	1004	*/
sl@0	1005
sl@0	1006	int
sl@0	1007	Tcl_BeepObjCmd(
sl@0	1008	ClientData dummy, /* Not used. */
sl@0	1009	Tcl_Interp interp, / Current interpreter. */
sl@0	1010	int objc, /* Number of arguments. */
sl@0	1011	Tcl_Obj CONST objv[]) / Argument values. */
sl@0	1012	{
sl@0	1013	Tcl_Obj resultPtr, objPtr;
sl@0	1014	Handle sound;
sl@0	1015	Str255 sndName;
sl@0	1016	int volume = -1, length;
sl@0	1017	char * sndArg = NULL;
sl@0	1018
sl@0	1019	resultPtr = Tcl_GetObjResult(interp);
sl@0	1020	if (objc == 1) {
sl@0	1021	SysBeep(1);
sl@0	1022	return TCL_OK;
sl@0	1023	} else if (objc == 2) {
sl@0	1024	if (!strcmp(Tcl_GetStringFromObj(objv[1], &length), "-list")) {
sl@0	1025	int count, i;
sl@0	1026	short id;
sl@0	1027	Str255 theName;
sl@0	1028	ResType rezType;
sl@0	1029
sl@0	1030	count = CountResources('snd ');
sl@0	1031	for (i = 1; i <= count; i++) {
sl@0	1032	sound = GetIndResource('snd ', i);
sl@0	1033	if (sound != NULL) {
sl@0	1034	GetResInfo(sound, &id, &rezType, theName);
sl@0	1035	if (theName[0] == 0) {
sl@0	1036	continue;
sl@0	1037	}
sl@0	1038	objPtr = Tcl_NewStringObj((char *) theName + 1,
sl@0	1039	theName[0]);
sl@0	1040	Tcl_ListObjAppendElement(interp, resultPtr, objPtr);
sl@0	1041	}
sl@0	1042	}
sl@0	1043	return TCL_OK;
sl@0	1044	} else {
sl@0	1045	sndArg = Tcl_GetStringFromObj(objv[1], &length);
sl@0	1046	}
sl@0	1047	} else if (objc == 3) {
sl@0	1048	if (!strcmp(Tcl_GetStringFromObj(objv[1], &length), "-volume")) {
sl@0	1049	Tcl_GetIntFromObj(interp, objv[2], &volume);
sl@0	1050	} else {
sl@0	1051	goto beepUsage;
sl@0	1052	}
sl@0	1053	} else if (objc == 4) {
sl@0	1054	if (!strcmp(Tcl_GetStringFromObj(objv[1], &length), "-volume")) {
sl@0	1055	Tcl_GetIntFromObj(interp, objv[2], &volume);
sl@0	1056	sndArg = Tcl_GetStringFromObj(objv[3], &length);
sl@0	1057	} else {
sl@0	1058	goto beepUsage;
sl@0	1059	}
sl@0	1060	} else {
sl@0	1061	goto beepUsage;
sl@0	1062	}
sl@0	1063
sl@0	1064	/*
sl@0	1065	* Play the sound
sl@0	1066	*/
sl@0	1067	if (sndArg == NULL) {
sl@0	1068	/*
sl@0	1069	* Set Volume for SysBeep
sl@0	1070	*/
sl@0	1071
sl@0	1072	if (volume >= 0) {
sl@0	1073	SetSoundVolume(volume, SYS_BEEP_VOLUME);
sl@0	1074	}
sl@0	1075	SysBeep(1);
sl@0	1076
sl@0	1077	/*
sl@0	1078	* Reset Volume
sl@0	1079	*/
sl@0	1080
sl@0	1081	if (volume >= 0) {
sl@0	1082	SetSoundVolume(0, RESET_VOLUME);
sl@0	1083	}
sl@0	1084	} else {
sl@0	1085	strcpy((char *) sndName + 1, sndArg);
sl@0	1086	sndName[0] = length;
sl@0	1087	sound = GetNamedResource('snd ', sndName);
sl@0	1088	if (sound != NULL) {
sl@0	1089	/*
sl@0	1090	* Set Volume for Default Output device
sl@0	1091	*/
sl@0	1092
sl@0	1093	if (volume >= 0) {
sl@0	1094	SetSoundVolume(volume, DEFAULT_SND_VOLUME);
sl@0	1095	}
sl@0	1096
sl@0	1097	SndPlay(NULL, (SndListHandle) sound, false);
sl@0	1098
sl@0	1099	/*
sl@0	1100	* Reset Volume
sl@0	1101	*/
sl@0	1102
sl@0	1103	if (volume >= 0) {
sl@0	1104	SetSoundVolume(0, RESET_VOLUME);
sl@0	1105	}
sl@0	1106	} else {
sl@0	1107	Tcl_AppendStringsToObj(resultPtr, " \"", sndArg,
sl@0	1108	"\" is not a valid sound. (Try ",
sl@0	1109	Tcl_GetString(objv[0]), " -list)", NULL);
sl@0	1110	return TCL_ERROR;
sl@0	1111	}
sl@0	1112	}
sl@0	1113
sl@0	1114	return TCL_OK;
sl@0	1115
sl@0	1116	beepUsage:
sl@0	1117	Tcl_WrongNumArgs(interp, 1, objv, "[-volume num] [-list \| sndName]?");
sl@0	1118	return TCL_ERROR;
sl@0	1119	}
sl@0	1120
sl@0	1121	/*
sl@0	1122	*-----------------------------------------------------------------------------
sl@0	1123	*
sl@0	1124	* SetSoundVolume --
sl@0	1125	*
sl@0	1126	* Set the volume for either the SysBeep or the SndPlay call depending
sl@0	1127	* on the value of mode (SYS_BEEP_VOLUME or DEFAULT_SND_VOLUME
sl@0	1128	* respectively.
sl@0	1129	*
sl@0	1130	* It also stores the last channel set, and the old value of its
sl@0	1131	* VOLUME. If you call SetSoundVolume with a mode of RESET_VOLUME,
sl@0	1132	* it will undo the last setting. The volume parameter is
sl@0	1133	* ignored in this case.
sl@0	1134	*
sl@0	1135	* Side Effects:
sl@0	1136	* Sets the System Volume
sl@0	1137	*
sl@0	1138	* Results:
sl@0	1139	* None
sl@0	1140	*
sl@0	1141	*-----------------------------------------------------------------------------
sl@0	1142	*/
sl@0	1143
sl@0	1144	void
sl@0	1145	SetSoundVolume(
sl@0	1146	int volume, /* This is the new volume */
sl@0	1147	enum WhichVolume mode) /* This flag says which volume to
sl@0	1148	* set: SysBeep, SndPlay, or instructs us
sl@0	1149	* to reset the volume */
sl@0	1150	{
sl@0	1151	static int hasSM3 = -1;
sl@0	1152	static enum WhichVolume oldMode;
sl@0	1153	static long oldVolume = -1;
sl@0	1154
sl@0	1155	/*
sl@0	1156	* The volume setting calls only work if we have SoundManager
sl@0	1157	* 3.0 or higher. So we check that here.
sl@0	1158	*/
sl@0	1159
sl@0	1160	if (hasSM3 == -1) {
sl@0	1161	if (GetToolboxTrapAddress(_SoundDispatch)
sl@0	1162	!= GetToolboxTrapAddress(_Unimplemented)) {
sl@0	1163	NumVersion SMVers = SndSoundManagerVersion();
sl@0	1164	if (SMVers.majorRev > 2) {
sl@0	1165	hasSM3 = 1;
sl@0	1166	} else {
sl@0	1167	hasSM3 = 0;
sl@0	1168	}
sl@0	1169	} else {
sl@0	1170	/*
sl@0	1171	* If the SoundDispatch trap is not present, then
sl@0	1172	* we don't have the SoundManager at all.
sl@0	1173	*/
sl@0	1174
sl@0	1175	hasSM3 = 0;
sl@0	1176	}
sl@0	1177	}
sl@0	1178
sl@0	1179	/*
sl@0	1180	* If we don't have Sound Manager 3.0, we can't set the sound volume.
sl@0	1181	* We will just ignore the request rather than raising an error.
sl@0	1182	*/
sl@0	1183
sl@0	1184	if (!hasSM3) {
sl@0	1185	return;
sl@0	1186	}
sl@0	1187
sl@0	1188	switch (mode) {
sl@0	1189	case SYS_BEEP_VOLUME:
sl@0	1190	GetSysBeepVolume(&oldVolume);
sl@0	1191	SetSysBeepVolume(volume);
sl@0	1192	oldMode = SYS_BEEP_VOLUME;
sl@0	1193	break;
sl@0	1194	case DEFAULT_SND_VOLUME:
sl@0	1195	GetDefaultOutputVolume(&oldVolume);
sl@0	1196	SetDefaultOutputVolume(volume);
sl@0	1197	oldMode = DEFAULT_SND_VOLUME;
sl@0	1198	break;
sl@0	1199	case RESET_VOLUME:
sl@0	1200	/*
sl@0	1201	* If oldVolume is -1 someone has made a programming error
sl@0	1202	* and called reset before setting the volume. This is benign
sl@0	1203	* however, so we will just exit.
sl@0	1204	*/
sl@0	1205
sl@0	1206	if (oldVolume != -1) {
sl@0	1207	if (oldMode == SYS_BEEP_VOLUME) {
sl@0	1208	SetSysBeepVolume(oldVolume);
sl@0	1209	} else if (oldMode == DEFAULT_SND_VOLUME) {
sl@0	1210	SetDefaultOutputVolume(oldVolume);
sl@0	1211	}
sl@0	1212	}
sl@0	1213	oldVolume = -1;
sl@0	1214	}
sl@0	1215	}
sl@0	1216
sl@0	1217	/*
sl@0	1218	*-----------------------------------------------------------------------------
sl@0	1219	*
sl@0	1220	* Tcl_MacEvalResource --
sl@0	1221	*
sl@0	1222	* Used to extend the source command. Sources Tcl code from a Text
sl@0	1223	* resource. Currently only sources the resouce by name file ID may be
sl@0	1224	* supported at a later date.
sl@0	1225	*
sl@0	1226	* Side Effects:
sl@0	1227	* Depends on the Tcl code in the resource.
sl@0	1228	*
sl@0	1229	* Results:
sl@0	1230	* Returns a Tcl result.
sl@0	1231	*
sl@0	1232	*-----------------------------------------------------------------------------
sl@0	1233	*/
sl@0	1234
sl@0	1235	int
sl@0	1236	Tcl_MacEvalResource(
sl@0	1237	Tcl_Interp interp, / Interpreter in which to process file. */
sl@0	1238	CONST char resourceName, / Name of TEXT resource to source,
sl@0	1239	NULL if number should be used. */
sl@0	1240	int resourceNumber, /* Resource id of source. */
sl@0	1241	CONST char fileName) / Name of file to process.
sl@0	1242	NULL if application resource. */
sl@0	1243	{
sl@0	1244	Handle sourceText;
sl@0	1245	Str255 rezName;
sl@0	1246	char msg[200];
sl@0	1247	int result, iOpenedResFile = false;
sl@0	1248	short saveRef, fileRef = -1;
sl@0	1249	char idStr[64];
sl@0	1250	FSSpec fileSpec;
sl@0	1251	Tcl_DString ds, buffer;
sl@0	1252	CONST char *nativeName;
sl@0	1253
sl@0	1254	saveRef = CurResFile();
sl@0	1255
sl@0	1256	if (fileName != NULL) {
sl@0	1257	OSErr err;
sl@0	1258
sl@0	1259	if (Tcl_TranslateFileName(interp, fileName, &buffer) == NULL) {
sl@0	1260	return TCL_ERROR;
sl@0	1261	}
sl@0	1262	nativeName = Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&buffer),
sl@0	1263	Tcl_DStringLength(&buffer), &ds);
sl@0	1264	err = FSpLocationFromPath(strlen(nativeName), nativeName,
sl@0	1265	&fileSpec);
sl@0	1266	Tcl_DStringFree(&ds);
sl@0	1267	Tcl_DStringFree(&buffer);
sl@0	1268	if (err != noErr) {
sl@0	1269	Tcl_AppendResult(interp, "Error finding the file: \"",
sl@0	1270	fileName, "\".", NULL);
sl@0	1271	return TCL_ERROR;
sl@0	1272	}
sl@0	1273
sl@0	1274	fileRef = FSpOpenResFileCompat(&fileSpec, fsRdPerm);
sl@0	1275	if (fileRef == -1) {
sl@0	1276	Tcl_AppendResult(interp, "Error reading the file: \"",
sl@0	1277	fileName, "\".", NULL);
sl@0	1278	return TCL_ERROR;
sl@0	1279	}
sl@0	1280
sl@0	1281	UseResFile(fileRef);
sl@0	1282	iOpenedResFile = true;
sl@0	1283	} else {
sl@0	1284	/*
sl@0	1285	* The default behavior will search through all open resource files.
sl@0	1286	* This may not be the behavior you desire. If you want the behavior
sl@0	1287	* of this call to only search the application resource fork, you
sl@0	1288	* must call UseResFile at this point to set it to the application
sl@0	1289	* file. This means you must have already obtained the application's
sl@0	1290	* fileRef when the application started up.
sl@0	1291	*/
sl@0	1292	}
sl@0	1293
sl@0	1294	/*
sl@0	1295	* Load the resource by name or ID
sl@0	1296	*/
sl@0	1297	if (resourceName != NULL) {
sl@0	1298	Tcl_DString ds;
sl@0	1299	Tcl_UtfToExternalDString(NULL, resourceName, -1, &ds);
sl@0	1300	strcpy((char *) rezName + 1, Tcl_DStringValue(&ds));
sl@0	1301	rezName[0] = (unsigned) Tcl_DStringLength(&ds);
sl@0	1302	sourceText = GetNamedResource('TEXT', rezName);
sl@0	1303	Tcl_DStringFree(&ds);
sl@0	1304	} else {
sl@0	1305	sourceText = GetResource('TEXT', (short) resourceNumber);
sl@0	1306	}
sl@0	1307
sl@0	1308	if (sourceText == NULL) {
sl@0	1309	result = TCL_ERROR;
sl@0	1310	} else {
sl@0	1311	char *sourceStr = NULL;
sl@0	1312
sl@0	1313	HLock(sourceText);
sl@0	1314	sourceStr = Tcl_MacConvertTextResource(sourceText);
sl@0	1315	HUnlock(sourceText);
sl@0	1316	ReleaseResource(sourceText);
sl@0	1317
sl@0	1318	/*
sl@0	1319	* We now evaluate the Tcl source
sl@0	1320	*/
sl@0	1321	result = Tcl_Eval(interp, sourceStr);
sl@0	1322	ckfree(sourceStr);
sl@0	1323	if (result == TCL_RETURN) {
sl@0	1324	result = TCL_OK;
sl@0	1325	} else if (result == TCL_ERROR) {
sl@0	1326	sprintf(msg, "\n (rsrc \"%.150s\" line %d)",
sl@0	1327	resourceName,
sl@0	1328	interp->errorLine);
sl@0	1329	Tcl_AddErrorInfo(interp, msg);
sl@0	1330	}
sl@0	1331
sl@0	1332	goto rezEvalCleanUp;
sl@0	1333	}
sl@0	1334
sl@0	1335	rezEvalError:
sl@0	1336	sprintf(idStr, "ID=%d", resourceNumber);
sl@0	1337	Tcl_AppendResult(interp, "The resource \"",
sl@0	1338	(resourceName != NULL ? resourceName : idStr),
sl@0	1339	"\" could not be loaded from ",
sl@0	1340	(fileName != NULL ? fileName : "application"),
sl@0	1341	".", NULL);
sl@0	1342
sl@0	1343	rezEvalCleanUp:
sl@0	1344
sl@0	1345	/*
sl@0	1346	* TRICKY POINT: The code that you are sourcing here could load a
sl@0	1347	* shared library. This will go AHEAD of the resource we stored away
sl@0	1348	* in saveRef on the resource path.
sl@0	1349	* If you restore the saveRef in this case, you will never be able
sl@0	1350	* to get to the resources in the shared library, since you are now
sl@0	1351	* pointing too far down on the resource list.
sl@0	1352	* So, we only reset the current resource file if WE opened a resource
sl@0	1353	* explicitly, and then only if the CurResFile is still the
sl@0	1354	* one we opened...
sl@0	1355	*/
sl@0	1356
sl@0	1357	if (iOpenedResFile && (CurResFile() == fileRef)) {
sl@0	1358	UseResFile(saveRef);
sl@0	1359	}
sl@0	1360
sl@0	1361	if (fileRef != -1) {
sl@0	1362	CloseResFile(fileRef);
sl@0	1363	}
sl@0	1364
sl@0	1365	return result;
sl@0	1366	}
sl@0	1367
sl@0	1368	/*
sl@0	1369	*-----------------------------------------------------------------------------
sl@0	1370	*
sl@0	1371	* Tcl_MacConvertTextResource --
sl@0	1372	*
sl@0	1373	* Converts a TEXT resource into a Tcl suitable string.
sl@0	1374	*
sl@0	1375	* Side Effects:
sl@0	1376	* Mallocs the returned memory, converts '\r' to '\n', and appends a NULL.
sl@0	1377	*
sl@0	1378	* Results:
sl@0	1379	* A new malloced string.
sl@0	1380	*
sl@0	1381	*-----------------------------------------------------------------------------
sl@0	1382	*/
sl@0	1383
sl@0	1384	char *
sl@0	1385	Tcl_MacConvertTextResource(
sl@0	1386	Handle resource) /* Handle to TEXT resource. */
sl@0	1387	{
sl@0	1388	int i, size;
sl@0	1389	char *resultStr;
sl@0	1390	Tcl_DString dstr;
sl@0	1391
sl@0	1392	size = GetResourceSizeOnDisk(resource);
sl@0	1393
sl@0	1394	Tcl_ExternalToUtfDString(NULL, *resource, size, &dstr);
sl@0	1395
sl@0	1396	size = Tcl_DStringLength(&dstr) + 1;
sl@0	1397	resultStr = (char *) ckalloc((unsigned) size);
sl@0	1398
sl@0	1399	memcpy((VOID ) resultStr, (VOID ) Tcl_DStringValue(&dstr), (size_t) size);
sl@0	1400
sl@0	1401	Tcl_DStringFree(&dstr);
sl@0	1402
sl@0	1403	for (i=0; i<size; i++) {
sl@0	1404	if (resultStr[i] == '\r') {
sl@0	1405	resultStr[i] = '\n';
sl@0	1406	}
sl@0	1407	}
sl@0	1408
sl@0	1409	return resultStr;
sl@0	1410	}
sl@0	1411
sl@0	1412	/*
sl@0	1413	*-----------------------------------------------------------------------------
sl@0	1414	*
sl@0	1415	* Tcl_MacFindResource --
sl@0	1416	*
sl@0	1417	* Higher level interface for loading resources.
sl@0	1418	*
sl@0	1419	* Side Effects:
sl@0	1420	* Attempts to load a resource.
sl@0	1421	*
sl@0	1422	* Results:
sl@0	1423	* A handle on success.
sl@0	1424	*
sl@0	1425	*-----------------------------------------------------------------------------
sl@0	1426	*/
sl@0	1427
sl@0	1428	Handle
sl@0	1429	Tcl_MacFindResource(
sl@0	1430	Tcl_Interp interp, / Interpreter in which to process file. */
sl@0	1431	long resourceType, /* Type of resource to load. */
sl@0	1432	CONST char resourceName, / Name of resource to find,
sl@0	1433	* NULL if number should be used. */
sl@0	1434	int resourceNumber, /* Resource id of source. */
sl@0	1435	CONST char resFileRef, / Registered resource file reference,
sl@0	1436	* NULL if searching all open resource files. */
sl@0	1437	int releaseIt) / Should we release this resource when done. */
sl@0	1438	{
sl@0	1439	Tcl_HashEntry *nameHashPtr;
sl@0	1440	OpenResourceFork *resourceRef;
sl@0	1441	int limitSearch = false;
sl@0	1442	short saveRef;
sl@0	1443	Handle resource;
sl@0	1444
sl@0	1445	if (resFileRef != NULL) {
sl@0	1446	nameHashPtr = Tcl_FindHashEntry(&nameTable, resFileRef);
sl@0	1447	if (nameHashPtr == NULL) {
sl@0	1448	Tcl_AppendResult(interp, "invalid resource file reference \"",
sl@0	1449	resFileRef, "\"", (char *) NULL);
sl@0	1450	return NULL;
sl@0	1451	}
sl@0	1452	resourceRef = (OpenResourceFork *) Tcl_GetHashValue(nameHashPtr);
sl@0	1453	saveRef = CurResFile();
sl@0	1454	UseResFile((short) resourceRef->fileRef);
sl@0	1455	limitSearch = true;
sl@0	1456	}
sl@0	1457
sl@0	1458	/*
sl@0	1459	* Some system resources (for example system resources) should not
sl@0	1460	* be released. So we set autoload to false, and try to get the resource.
sl@0	1461	* If the Master Pointer of the returned handle is null, then resource was
sl@0	1462	* not in memory, and it is safe to release it. Otherwise, it is not.
sl@0	1463	*/
sl@0	1464
sl@0	1465	SetResLoad(false);
sl@0	1466
sl@0	1467	if (resourceName == NULL) {
sl@0	1468	if (limitSearch) {
sl@0	1469	resource = Get1Resource(resourceType, resourceNumber);
sl@0	1470	} else {
sl@0	1471	resource = GetResource(resourceType, resourceNumber);
sl@0	1472	}
sl@0	1473	} else {
sl@0	1474	Str255 rezName;
sl@0	1475	Tcl_DString ds;
sl@0	1476	Tcl_UtfToExternalDString(NULL, resourceName, -1, &ds);
sl@0	1477	strcpy((char *) rezName + 1, Tcl_DStringValue(&ds));
sl@0	1478	rezName[0] = (unsigned) Tcl_DStringLength(&ds);
sl@0	1479	if (limitSearch) {
sl@0	1480	resource = Get1NamedResource(resourceType,
sl@0	1481	rezName);
sl@0	1482	} else {
sl@0	1483	resource = GetNamedResource(resourceType,
sl@0	1484	rezName);
sl@0	1485	}
sl@0	1486	Tcl_DStringFree(&ds);
sl@0	1487	}
sl@0	1488
sl@0	1489	if (resource != NULL && *resource == NULL) {
sl@0	1490	*releaseIt = 1;
sl@0	1491	LoadResource(resource);
sl@0	1492	} else {
sl@0	1493	*releaseIt = 0;
sl@0	1494	}
sl@0	1495
sl@0	1496	SetResLoad(true);
sl@0	1497
sl@0	1498
sl@0	1499	if (limitSearch) {
sl@0	1500	UseResFile(saveRef);
sl@0	1501	}
sl@0	1502
sl@0	1503	return resource;
sl@0	1504	}
sl@0	1505
sl@0	1506	/*
sl@0	1507	*----------------------------------------------------------------------
sl@0	1508	*
sl@0	1509	* ResourceInit --
sl@0	1510	*
sl@0	1511	* Initialize the structures used for resource management.
sl@0	1512	*
sl@0	1513	* Results:
sl@0	1514	* None.
sl@0	1515	*
sl@0	1516	* Side effects:
sl@0	1517	* Read the code.
sl@0	1518	*
sl@0	1519	*----------------------------------------------------------------------
sl@0	1520	*/
sl@0	1521
sl@0	1522	static void
sl@0	1523	ResourceInit()
sl@0	1524	{
sl@0	1525
sl@0	1526	initialized = 1;
sl@0	1527	Tcl_InitHashTable(&nameTable, TCL_STRING_KEYS);
sl@0	1528	Tcl_InitHashTable(&resourceTable, TCL_ONE_WORD_KEYS);
sl@0	1529	resourceForkList = Tcl_NewObj();
sl@0	1530	Tcl_IncrRefCount(resourceForkList);
sl@0	1531
sl@0	1532	BuildResourceForkList();
sl@0	1533
sl@0	1534	}
sl@0	1535	/***/
sl@0	1536
sl@0	1537	/Tcl_RegisterObjType(typePtr) /
sl@0	1538
sl@0	1539	/*
sl@0	1540	*----------------------------------------------------------------------
sl@0	1541	*
sl@0	1542	* Tcl_NewOSTypeObj --
sl@0	1543	*
sl@0	1544	* This procedure is used to create a new resource name type object.
sl@0	1545	*
sl@0	1546	* Results:
sl@0	1547	* The newly created object is returned. This object will have a NULL
sl@0	1548	* string representation. The returned object has ref count 0.
sl@0	1549	*
sl@0	1550	* Side effects:
sl@0	1551	* None.
sl@0	1552	*
sl@0	1553	*----------------------------------------------------------------------
sl@0	1554	*/
sl@0	1555
sl@0	1556	Tcl_Obj *
sl@0	1557	Tcl_NewOSTypeObj(
sl@0	1558	OSType newOSType) /* Int used to initialize the new object. */
sl@0	1559	{
sl@0	1560	register Tcl_Obj *objPtr;
sl@0	1561
sl@0	1562	if (!osTypeInit) {
sl@0	1563	osTypeInit = 1;
sl@0	1564	Tcl_RegisterObjType(&osType);
sl@0	1565	}
sl@0	1566
sl@0	1567	objPtr = Tcl_NewObj();
sl@0	1568	objPtr->bytes = NULL;
sl@0	1569	objPtr->internalRep.longValue = newOSType;
sl@0	1570	objPtr->typePtr = &osType;
sl@0	1571	return objPtr;
sl@0	1572	}
sl@0	1573
sl@0	1574	/*
sl@0	1575	*----------------------------------------------------------------------
sl@0	1576	*
sl@0	1577	* Tcl_SetOSTypeObj --
sl@0	1578	*
sl@0	1579	* Modify an object to be a resource type and to have the
sl@0	1580	* specified long value.
sl@0	1581	*
sl@0	1582	* Results:
sl@0	1583	* None.
sl@0	1584	*
sl@0	1585	* Side effects:
sl@0	1586	* The object's old string rep, if any, is freed. Also, any old
sl@0	1587	* internal rep is freed.
sl@0	1588	*
sl@0	1589	*----------------------------------------------------------------------
sl@0	1590	*/
sl@0	1591
sl@0	1592	void
sl@0	1593	Tcl_SetOSTypeObj(
sl@0	1594	Tcl_Obj objPtr, / Object whose internal rep to init. */
sl@0	1595	OSType newOSType) /* Integer used to set object's value. */
sl@0	1596	{
sl@0	1597	register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
sl@0	1598
sl@0	1599	if (!osTypeInit) {
sl@0	1600	osTypeInit = 1;
sl@0	1601	Tcl_RegisterObjType(&osType);
sl@0	1602	}
sl@0	1603
sl@0	1604	if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
sl@0	1605	oldTypePtr->freeIntRepProc(objPtr);
sl@0	1606	}
sl@0	1607
sl@0	1608	objPtr->internalRep.longValue = newOSType;
sl@0	1609	objPtr->typePtr = &osType;
sl@0	1610
sl@0	1611	Tcl_InvalidateStringRep(objPtr);
sl@0	1612	}
sl@0	1613
sl@0	1614	/*
sl@0	1615	*----------------------------------------------------------------------
sl@0	1616	*
sl@0	1617	* Tcl_GetOSTypeFromObj --
sl@0	1618	*
sl@0	1619	* Attempt to return an int from the Tcl object "objPtr". If the object
sl@0	1620	* is not already an int, an attempt will be made to convert it to one.
sl@0	1621	*
sl@0	1622	* Results:
sl@0	1623	* The return value is a standard Tcl object result. If an error occurs
sl@0	1624	* during conversion, an error message is left in interp->objResult
sl@0	1625	* unless "interp" is NULL.
sl@0	1626	*
sl@0	1627	* Side effects:
sl@0	1628	* If the object is not already an int, the conversion will free
sl@0	1629	* any old internal representation.
sl@0	1630	*
sl@0	1631	*----------------------------------------------------------------------
sl@0	1632	*/
sl@0	1633
sl@0	1634	int
sl@0	1635	Tcl_GetOSTypeFromObj(
sl@0	1636	Tcl_Interp interp, / Used for error reporting if not NULL. */
sl@0	1637	Tcl_Obj objPtr, / The object from which to get a int. */
sl@0	1638	OSType osTypePtr) / Place to store resulting int. */
sl@0	1639	{
sl@0	1640	register int result;
sl@0	1641
sl@0	1642	if (!osTypeInit) {
sl@0	1643	osTypeInit = 1;
sl@0	1644	Tcl_RegisterObjType(&osType);
sl@0	1645	}
sl@0	1646
sl@0	1647	if (objPtr->typePtr == &osType) {
sl@0	1648	*osTypePtr = objPtr->internalRep.longValue;
sl@0	1649	return TCL_OK;
sl@0	1650	}
sl@0	1651
sl@0	1652	result = SetOSTypeFromAny(interp, objPtr);
sl@0	1653	if (result == TCL_OK) {
sl@0	1654	*osTypePtr = objPtr->internalRep.longValue;
sl@0	1655	}
sl@0	1656	return result;
sl@0	1657	}
sl@0	1658
sl@0	1659	/*
sl@0	1660	*----------------------------------------------------------------------
sl@0	1661	*
sl@0	1662	* DupOSTypeInternalRep --
sl@0	1663	*
sl@0	1664	* Initialize the internal representation of an int Tcl_Obj to a
sl@0	1665	* copy of the internal representation of an existing int object.
sl@0	1666	*
sl@0	1667	* Results:
sl@0	1668	* None.
sl@0	1669	*
sl@0	1670	* Side effects:
sl@0	1671	* "copyPtr"s internal rep is set to the integer corresponding to
sl@0	1672	* "srcPtr"s internal rep.
sl@0	1673	*
sl@0	1674	*----------------------------------------------------------------------
sl@0	1675	*/
sl@0	1676
sl@0	1677	static void
sl@0	1678	DupOSTypeInternalRep(
sl@0	1679	Tcl_Obj srcPtr, / Object with internal rep to copy. */
sl@0	1680	Tcl_Obj copyPtr) / Object with internal rep to set. */
sl@0	1681	{
sl@0	1682	copyPtr->internalRep.longValue = srcPtr->internalRep.longValue;
sl@0	1683	copyPtr->typePtr = &osType;
sl@0	1684	}
sl@0	1685
sl@0	1686	/*
sl@0	1687	*----------------------------------------------------------------------
sl@0	1688	*
sl@0	1689	* SetOSTypeFromAny --
sl@0	1690	*
sl@0	1691	* Attempt to generate an integer internal form for the Tcl object
sl@0	1692	* "objPtr".
sl@0	1693	*
sl@0	1694	* Results:
sl@0	1695	* The return value is a standard object Tcl result. If an error occurs
sl@0	1696	* during conversion, an error message is left in interp->objResult
sl@0	1697	* unless "interp" is NULL.
sl@0	1698	*
sl@0	1699	* Side effects:
sl@0	1700	* If no error occurs, an int is stored as "objPtr"s internal
sl@0	1701	* representation.
sl@0	1702	*
sl@0	1703	*----------------------------------------------------------------------
sl@0	1704	*/
sl@0	1705
sl@0	1706	static int
sl@0	1707	SetOSTypeFromAny(
sl@0	1708	Tcl_Interp interp, / Used for error reporting if not NULL. */
sl@0	1709	Tcl_Obj objPtr) / The object to convert. */
sl@0	1710	{
sl@0	1711	Tcl_ObjType *oldTypePtr = objPtr->typePtr;
sl@0	1712	char *string;
sl@0	1713	int length;
sl@0	1714	long newOSType;
sl@0	1715
sl@0	1716	/*
sl@0	1717	* Get the string representation. Make it up-to-date if necessary.
sl@0	1718	*/
sl@0	1719
sl@0	1720	string = Tcl_GetStringFromObj(objPtr, &length);
sl@0	1721
sl@0	1722	if (length != 4) {
sl@0	1723	if (interp != NULL) {
sl@0	1724	Tcl_ResetResult(interp);
sl@0	1725	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
sl@0	1726	"expected Macintosh OS type but got \"", string, "\"",
sl@0	1727	(char *) NULL);
sl@0	1728	}
sl@0	1729	return TCL_ERROR;
sl@0	1730	}
sl@0	1731	newOSType = ((long ) string);
sl@0	1732
sl@0	1733	/*
sl@0	1734	* The conversion to resource type succeeded. Free the old internalRep
sl@0	1735	* before setting the new one.
sl@0	1736	*/
sl@0	1737
sl@0	1738	if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
sl@0	1739	oldTypePtr->freeIntRepProc(objPtr);
sl@0	1740	}
sl@0	1741
sl@0	1742	objPtr->internalRep.longValue = newOSType;
sl@0	1743	objPtr->typePtr = &osType;
sl@0	1744	return TCL_OK;
sl@0	1745	}
sl@0	1746
sl@0	1747	/*
sl@0	1748	*----------------------------------------------------------------------
sl@0	1749	*
sl@0	1750	* UpdateStringOfOSType --
sl@0	1751	*
sl@0	1752	* Update the string representation for an resource type object.
sl@0	1753	* Note: This procedure does not free an existing old string rep
sl@0	1754	* so storage will be lost if this has not already been done.
sl@0	1755	*
sl@0	1756	* Results:
sl@0	1757	* None.
sl@0	1758	*
sl@0	1759	* Side effects:
sl@0	1760	* The object's string is set to a valid string that results from
sl@0	1761	* the int-to-string conversion.
sl@0	1762	*
sl@0	1763	*----------------------------------------------------------------------
sl@0	1764	*/
sl@0	1765
sl@0	1766	static void
sl@0	1767	UpdateStringOfOSType(
sl@0	1768	register Tcl_Obj objPtr) / Int object whose string rep to update. */
sl@0	1769	{
sl@0	1770	objPtr->bytes = ckalloc(5);
sl@0	1771	sprintf(objPtr->bytes, "%-4.4s", &(objPtr->internalRep.longValue));
sl@0	1772	objPtr->length = 4;
sl@0	1773	}
sl@0	1774
sl@0	1775	/*
sl@0	1776	*----------------------------------------------------------------------
sl@0	1777	*
sl@0	1778	* GetRsrcRefFromObj --
sl@0	1779	*
sl@0	1780	* Given a String object containing a resource file token, return
sl@0	1781	* the OpenResourceFork structure that it represents, or NULL if
sl@0	1782	* the token cannot be found. If okayOnReadOnly is false, it will
sl@0	1783	* also check whether the token corresponds to a read-only file,
sl@0	1784	* and return NULL if it is.
sl@0	1785	*
sl@0	1786	* Results:
sl@0	1787	* A pointer to an OpenResourceFork structure, or NULL.
sl@0	1788	*
sl@0	1789	* Side effects:
sl@0	1790	* An error message may be left in resultPtr.
sl@0	1791	*
sl@0	1792	*----------------------------------------------------------------------
sl@0	1793	*/
sl@0	1794
sl@0	1795	static OpenResourceFork *
sl@0	1796	GetRsrcRefFromObj(
sl@0	1797	register Tcl_Obj objPtr, / String obj containing file token */
sl@0	1798	int okayOnReadOnly, /* Whether this operation is okay for a *
sl@0	1799	* read only file. */
sl@0	1800	const char operation, / String containing the operation we *
sl@0	1801	* were trying to perform, used for errors */
sl@0	1802	Tcl_Obj resultPtr) / Tcl_Obj to contain error message */
sl@0	1803	{
sl@0	1804	char *stringPtr;
sl@0	1805	Tcl_HashEntry *nameHashPtr;
sl@0	1806	OpenResourceFork *resourceRef;
sl@0	1807	int length;
sl@0	1808	OSErr err;
sl@0	1809
sl@0	1810	stringPtr = Tcl_GetStringFromObj(objPtr, &length);
sl@0	1811	nameHashPtr = Tcl_FindHashEntry(&nameTable, stringPtr);
sl@0	1812	if (nameHashPtr == NULL) {
sl@0	1813	Tcl_AppendStringsToObj(resultPtr,
sl@0	1814	"invalid resource file reference \"",
sl@0	1815	stringPtr, "\"", (char *) NULL);
sl@0	1816	return NULL;
sl@0	1817	}
sl@0	1818
sl@0	1819	resourceRef = (OpenResourceFork *) Tcl_GetHashValue(nameHashPtr);
sl@0	1820
sl@0	1821	if (!okayOnReadOnly) {
sl@0	1822	err = GetResFileAttrs((short) resourceRef->fileRef);
sl@0	1823	if (err & mapReadOnly) {
sl@0	1824	Tcl_AppendStringsToObj(resultPtr, "cannot ", operation,
sl@0	1825	" resource file \"",
sl@0	1826	stringPtr, "\", it was opened read only",
sl@0	1827	(char *) NULL);
sl@0	1828	return NULL;
sl@0	1829	}
sl@0	1830	}
sl@0	1831	return resourceRef;
sl@0	1832	}
sl@0	1833
sl@0	1834	/*
sl@0	1835	*----------------------------------------------------------------------
sl@0	1836	*
sl@0	1837	* TclMacRegisterResourceFork --
sl@0	1838	*
sl@0	1839	* Register an open resource fork in the table of open resources
sl@0	1840	* managed by the procedures in this file. If the resource file
sl@0	1841	* is already registered with the table, then no new token is made.
sl@0	1842	*
sl@0	1843	* The behavior is controlled by the value of tokenPtr, and of the
sl@0	1844	* flags variable. For tokenPtr, the possibilities are:
sl@0	1845	* - NULL: The new token is auto-generated, but not returned.
sl@0	1846	* - The string value of tokenPtr is the empty string: Then
sl@0	1847	* the new token is auto-generated, and returned in tokenPtr
sl@0	1848	* - tokenPtr has a value: The string value will be used for the token,
sl@0	1849	* unless it is already in use, in which case a new token will
sl@0	1850	* be generated, and returned in tokenPtr.
sl@0	1851	*
sl@0	1852	* For the flags variable: it can be one of:
sl@0	1853	* - TCL_RESOURCE__INSERT_TAIL: The element is inserted at the
sl@0	1854	* end of the list of open resources. Used only in Resource_Init.
sl@0	1855	* - TCL_RESOURCE_DONT_CLOSE: The resource close command will not close
sl@0	1856	* this resource.
sl@0	1857	* - TCL_RESOURCE_CHECK_IF_OPEN: This will check to see if this file's
sl@0	1858	* resource fork is already opened by this Tcl shell, and return
sl@0	1859	* an error without registering the resource fork.
sl@0	1860	*
sl@0	1861	* Results:
sl@0	1862	* Standard Tcl Result
sl@0	1863	*
sl@0	1864	* Side effects:
sl@0	1865	* An entry may be added to the resource name table.
sl@0	1866	*
sl@0	1867	*----------------------------------------------------------------------
sl@0	1868	*/
sl@0	1869
sl@0	1870	int
sl@0	1871	TclMacRegisterResourceFork(
sl@0	1872	short fileRef, /* File ref for an open resource fork. */
sl@0	1873	Tcl_Obj tokenPtr, / A Tcl Object to which to write the *
sl@0	1874	* new token */
sl@0	1875	int flags) /* 1 means insert at the head of the resource
sl@0	1876	* fork list, 0 means at the tail */
sl@0	1877
sl@0	1878	{
sl@0	1879	Tcl_HashEntry *resourceHashPtr;
sl@0	1880	Tcl_HashEntry *nameHashPtr;
sl@0	1881	OpenResourceFork *resourceRef;
sl@0	1882	int new;
sl@0	1883	char *resourceId = NULL;
sl@0	1884
sl@0	1885	if (!initialized) {
sl@0	1886	ResourceInit();
sl@0	1887	}
sl@0	1888
sl@0	1889	/*
sl@0	1890	* If we were asked to, check that this file has not been opened
sl@0	1891	* already with a different permission. It it has, then return an error.
sl@0	1892	*/
sl@0	1893
sl@0	1894	new = 1;
sl@0	1895
sl@0	1896	if (flags & TCL_RESOURCE_CHECK_IF_OPEN) {
sl@0	1897	Tcl_HashSearch search;
sl@0	1898	short oldFileRef, filePermissionFlag;
sl@0	1899	FCBPBRec newFileRec, oldFileRec;
sl@0	1900	OSErr err;
sl@0	1901
sl@0	1902	oldFileRec.ioCompletion = NULL;
sl@0	1903	oldFileRec.ioFCBIndx = 0;
sl@0	1904	oldFileRec.ioNamePtr = NULL;
sl@0	1905
sl@0	1906	newFileRec.ioCompletion = NULL;
sl@0	1907	newFileRec.ioFCBIndx = 0;
sl@0	1908	newFileRec.ioNamePtr = NULL;
sl@0	1909	newFileRec.ioVRefNum = 0;
sl@0	1910	newFileRec.ioRefNum = fileRef;
sl@0	1911	err = PBGetFCBInfo(&newFileRec, false);
sl@0	1912	filePermissionFlag = ( newFileRec.ioFCBFlags >> 12 ) & 0x1;
sl@0	1913
sl@0	1914
sl@0	1915	resourceHashPtr = Tcl_FirstHashEntry(&resourceTable, &search);
sl@0	1916	while (resourceHashPtr != NULL) {
sl@0	1917	oldFileRef = (short) Tcl_GetHashKey(&resourceTable,
sl@0	1918	resourceHashPtr);
sl@0	1919	if (oldFileRef == fileRef) {
sl@0	1920	new = 0;
sl@0	1921	break;
sl@0	1922	}
sl@0	1923	oldFileRec.ioVRefNum = 0;
sl@0	1924	oldFileRec.ioRefNum = oldFileRef;
sl@0	1925	err = PBGetFCBInfo(&oldFileRec, false);
sl@0	1926
sl@0	1927	/*
sl@0	1928	* err might not be noErr either because the file has closed
sl@0	1929	* out from under us somehow, which is bad but we're not going
sl@0	1930	* to fix it here, OR because it is the ROM MAP, which has a
sl@0	1931	* fileRef, but can't be gotten to by PBGetFCBInfo.
sl@0	1932	*/
sl@0	1933	if ((err == noErr)
sl@0	1934	&& (newFileRec.ioFCBVRefNum == oldFileRec.ioFCBVRefNum)
sl@0	1935	&& (newFileRec.ioFCBFlNm == oldFileRec.ioFCBFlNm)) {
sl@0	1936	/*
sl@0	1937	* In MacOS 8.1 it seems like we get different file refs even
sl@0	1938	* though we pass the same file & permissions. This is not
sl@0	1939	* what Inside Mac says should happen, but it does, so if it
sl@0	1940	* does, then close the new res file and return the original
sl@0	1941	* one...
sl@0	1942	*/
sl@0	1943
sl@0	1944	if (filePermissionFlag == ((oldFileRec.ioFCBFlags >> 12) & 0x1)) {
sl@0	1945	CloseResFile(fileRef);
sl@0	1946	new = 0;
sl@0	1947	break;
sl@0	1948	} else {
sl@0	1949	if (tokenPtr != NULL) {
sl@0	1950	Tcl_SetStringObj(tokenPtr, "Resource already open with different permissions.", -1);
sl@0	1951	}
sl@0	1952	return TCL_ERROR;
sl@0	1953	}
sl@0	1954	}
sl@0	1955	resourceHashPtr = Tcl_NextHashEntry(&search);
sl@0	1956	}
sl@0	1957	}
sl@0	1958
sl@0	1959
sl@0	1960	/*
sl@0	1961	* If the file has already been opened with these same permissions, then it
sl@0	1962	* will be in our list and we will have set new to 0 above.
sl@0	1963	* So we will just return the token (if tokenPtr is non-null)
sl@0	1964	*/
sl@0	1965
sl@0	1966	if (new) {
sl@0	1967	resourceHashPtr = Tcl_CreateHashEntry(&resourceTable,
sl@0	1968	(char *) fileRef, &new);
sl@0	1969	}
sl@0	1970
sl@0	1971	if (!new) {
sl@0	1972	if (tokenPtr != NULL) {
sl@0	1973	resourceId = (char *) Tcl_GetHashValue(resourceHashPtr);
sl@0	1974	Tcl_SetStringObj(tokenPtr, resourceId, -1);
sl@0	1975	}
sl@0	1976	return TCL_OK;
sl@0	1977	}
sl@0	1978
sl@0	1979	/*
sl@0	1980	* If we were passed in a result pointer which is not an empty
sl@0	1981	* string, attempt to use that as the key. If the key already
sl@0	1982	* exists, silently fall back on resource%d...
sl@0	1983	*/
sl@0	1984
sl@0	1985	if (tokenPtr != NULL) {
sl@0	1986	char *tokenVal;
sl@0	1987	int length;
sl@0	1988	tokenVal = Tcl_GetStringFromObj(tokenPtr, &length);
sl@0	1989	if (length > 0) {
sl@0	1990	nameHashPtr = Tcl_FindHashEntry(&nameTable, tokenVal);
sl@0	1991	if (nameHashPtr == NULL) {
sl@0	1992	resourceId = ckalloc(length + 1);
sl@0	1993	memcpy(resourceId, tokenVal, length);
sl@0	1994	resourceId[length] = '\0';
sl@0	1995	}
sl@0	1996	}
sl@0	1997	}
sl@0	1998
sl@0	1999	if (resourceId == NULL) {
sl@0	2000	resourceId = (char *) ckalloc(15);
sl@0	2001	sprintf(resourceId, "resource%d", newId);
sl@0	2002	}
sl@0	2003
sl@0	2004	Tcl_SetHashValue(resourceHashPtr, resourceId);
sl@0	2005	newId++;
sl@0	2006
sl@0	2007	nameHashPtr = Tcl_CreateHashEntry(&nameTable, resourceId, &new);
sl@0	2008	if (!new) {
sl@0	2009	panic("resource id has repeated itself");
sl@0	2010	}
sl@0	2011
sl@0	2012	resourceRef = (OpenResourceFork *) ckalloc(sizeof(OpenResourceFork));
sl@0	2013	resourceRef->fileRef = fileRef;
sl@0	2014	resourceRef->flags = flags;
sl@0	2015
sl@0	2016	Tcl_SetHashValue(nameHashPtr, (ClientData) resourceRef);
sl@0	2017	if (tokenPtr != NULL) {
sl@0	2018	Tcl_SetStringObj(tokenPtr, resourceId, -1);
sl@0	2019	}
sl@0	2020
sl@0	2021	if (flags & TCL_RESOURCE_INSERT_TAIL) {
sl@0	2022	Tcl_ListObjAppendElement(NULL, resourceForkList, tokenPtr);
sl@0	2023	} else {
sl@0	2024	Tcl_ListObjReplace(NULL, resourceForkList, 0, 0, 1, &tokenPtr);
sl@0	2025	}
sl@0	2026	return TCL_OK;
sl@0	2027	}
sl@0	2028
sl@0	2029	/*
sl@0	2030	*----------------------------------------------------------------------
sl@0	2031	*
sl@0	2032	* TclMacUnRegisterResourceFork --
sl@0	2033	*
sl@0	2034	* Removes the entry for an open resource fork from the table of
sl@0	2035	* open resources managed by the procedures in this file.
sl@0	2036	* If resultPtr is not NULL, it will be used for error reporting.
sl@0	2037	*
sl@0	2038	* Results:
sl@0	2039	* The fileRef for this token, or -1 if an error occured.
sl@0	2040	*
sl@0	2041	* Side effects:
sl@0	2042	* An entry is removed from the resource name table.
sl@0	2043	*
sl@0	2044	*----------------------------------------------------------------------
sl@0	2045	*/
sl@0	2046
sl@0	2047	short
sl@0	2048	TclMacUnRegisterResourceFork(
sl@0	2049	char *tokenPtr,
sl@0	2050	Tcl_Obj *resultPtr)
sl@0	2051
sl@0	2052	{
sl@0	2053	Tcl_HashEntry *resourceHashPtr;
sl@0	2054	Tcl_HashEntry *nameHashPtr;
sl@0	2055	OpenResourceFork *resourceRef;
sl@0	2056	char *resourceId = NULL;
sl@0	2057	short fileRef;
sl@0	2058	char *bytes;
sl@0	2059	int i, match, index, listLen, length, elemLen;
sl@0	2060	Tcl_Obj **elemPtrs;
sl@0	2061
sl@0	2062
sl@0	2063	nameHashPtr = Tcl_FindHashEntry(&nameTable, tokenPtr);
sl@0	2064	if (nameHashPtr == NULL) {
sl@0	2065	if (resultPtr != NULL) {
sl@0	2066	Tcl_AppendStringsToObj(resultPtr,
sl@0	2067	"invalid resource file reference \"",
sl@0	2068	tokenPtr, "\"", (char *) NULL);
sl@0	2069	}
sl@0	2070	return -1;
sl@0	2071	}
sl@0	2072
sl@0	2073	resourceRef = (OpenResourceFork *) Tcl_GetHashValue(nameHashPtr);
sl@0	2074	fileRef = resourceRef->fileRef;
sl@0	2075
sl@0	2076	if ( resourceRef->flags & TCL_RESOURCE_DONT_CLOSE ) {
sl@0	2077	if (resultPtr != NULL) {
sl@0	2078	Tcl_AppendStringsToObj(resultPtr,
sl@0	2079	"can't close \"", tokenPtr, "\" resource file",
sl@0	2080	(char *) NULL);
sl@0	2081	}
sl@0	2082	return -1;
sl@0	2083	}
sl@0	2084
sl@0	2085	Tcl_DeleteHashEntry(nameHashPtr);
sl@0	2086	ckfree((char *) resourceRef);
sl@0	2087
sl@0	2088
sl@0	2089	/*
sl@0	2090	* Now remove the resource from the resourceForkList object
sl@0	2091	*/
sl@0	2092
sl@0	2093	Tcl_ListObjGetElements(NULL, resourceForkList, &listLen, &elemPtrs);
sl@0	2094
sl@0	2095
sl@0	2096	index = -1;
sl@0	2097	length = strlen(tokenPtr);
sl@0	2098
sl@0	2099	for (i = 0; i < listLen; i++) {
sl@0	2100	match = 0;
sl@0	2101	bytes = Tcl_GetStringFromObj(elemPtrs[i], &elemLen);
sl@0	2102	if (length == elemLen) {
sl@0	2103	match = (memcmp(bytes, tokenPtr,
sl@0	2104	(size_t) length) == 0);
sl@0	2105	}
sl@0	2106	if (match) {
sl@0	2107	index = i;
sl@0	2108	break;
sl@0	2109	}
sl@0	2110	}
sl@0	2111	if (!match) {
sl@0	2112	panic("the resource Fork List is out of synch!");
sl@0	2113	}
sl@0	2114
sl@0	2115	Tcl_ListObjReplace(NULL, resourceForkList, index, 1, 0, NULL);
sl@0	2116
sl@0	2117	resourceHashPtr = Tcl_FindHashEntry(&resourceTable, (char *) fileRef);
sl@0	2118
sl@0	2119	if (resourceHashPtr == NULL) {
sl@0	2120	panic("Resource & Name tables are out of synch in resource command.");
sl@0	2121	}
sl@0	2122	ckfree(Tcl_GetHashValue(resourceHashPtr));
sl@0	2123	Tcl_DeleteHashEntry(resourceHashPtr);
sl@0	2124
sl@0	2125	return fileRef;
sl@0	2126
sl@0	2127	}
sl@0	2128
sl@0	2129
sl@0	2130	/*
sl@0	2131	*----------------------------------------------------------------------
sl@0	2132	*
sl@0	2133	* BuildResourceForkList --
sl@0	2134	*
sl@0	2135	* Traverses the list of open resource forks, and builds the
sl@0	2136	* list of resources forks. Also creates a resource token for any that
sl@0	2137	* are opened but not registered with our resource system.
sl@0	2138	* This is based on code from Apple DTS.
sl@0	2139	*
sl@0	2140	* Results:
sl@0	2141	* None.
sl@0	2142	*
sl@0	2143	* Side effects:
sl@0	2144	* The list of resource forks is updated.
sl@0	2145	* The resource name table may be augmented.
sl@0	2146	*
sl@0	2147	*----------------------------------------------------------------------
sl@0	2148	*/
sl@0	2149
sl@0	2150	void
sl@0	2151	BuildResourceForkList()
sl@0	2152	{
sl@0	2153	Handle currentMapHandle, mSysMapHandle;
sl@0	2154	Ptr tempPtr;
sl@0	2155	FCBPBRec fileRec;
sl@0	2156	char fileName[256];
sl@0	2157	char appName[62];
sl@0	2158	Tcl_Obj *nameObj;
sl@0	2159	OSErr err;
sl@0	2160	ProcessSerialNumber psn;
sl@0	2161	ProcessInfoRec info;
sl@0	2162	FSSpec fileSpec;
sl@0	2163
sl@0	2164	/*
sl@0	2165	* Get the application name, so we can substitute
sl@0	2166	* the token "application" for the application's resource.
sl@0	2167	*/
sl@0	2168
sl@0	2169	GetCurrentProcess(&psn);
sl@0	2170	info.processInfoLength = sizeof(ProcessInfoRec);
sl@0	2171	info.processName = (StringPtr) &appName;
sl@0	2172	info.processAppSpec = &fileSpec;
sl@0	2173	GetProcessInformation(&psn, &info);
sl@0	2174	p2cstr((StringPtr) appName);
sl@0	2175
sl@0	2176
sl@0	2177	fileRec.ioCompletion = NULL;
sl@0	2178	fileRec.ioVRefNum = 0;
sl@0	2179	fileRec.ioFCBIndx = 0;
sl@0	2180	fileRec.ioNamePtr = (StringPtr) &fileName;
sl@0	2181
sl@0	2182
sl@0	2183	currentMapHandle = LMGetTopMapHndl();
sl@0	2184	mSysMapHandle = LMGetSysMapHndl();
sl@0	2185
sl@0	2186	while (1) {
sl@0	2187	/*
sl@0	2188	* Now do the ones opened after the application.
sl@0	2189	*/
sl@0	2190
sl@0	2191	nameObj = Tcl_NewObj();
sl@0	2192
sl@0	2193	tempPtr = *currentMapHandle;
sl@0	2194
sl@0	2195	fileRec.ioRefNum = ((short ) (tempPtr + 20));
sl@0	2196	err = PBGetFCBInfo(&fileRec, false);
sl@0	2197
sl@0	2198	if (err != noErr) {
sl@0	2199	/*
sl@0	2200	* The ROM resource map does not correspond to an opened file...
sl@0	2201	*/
sl@0	2202	Tcl_SetStringObj(nameObj, "ROM Map", -1);
sl@0	2203	} else {
sl@0	2204	p2cstr((StringPtr) fileName);
sl@0	2205	if (strcmp(fileName,appName) == 0) {
sl@0	2206	Tcl_SetStringObj(nameObj, "application", -1);
sl@0	2207	} else {
sl@0	2208	Tcl_SetStringObj(nameObj, fileName, -1);
sl@0	2209	}
sl@0	2210	c2pstr(fileName);
sl@0	2211	}
sl@0	2212
sl@0	2213	TclMacRegisterResourceFork(fileRec.ioRefNum, nameObj,
sl@0	2214	TCL_RESOURCE_DONT_CLOSE \| TCL_RESOURCE_INSERT_TAIL);
sl@0	2215
sl@0	2216	if (currentMapHandle == mSysMapHandle) {
sl@0	2217	break;
sl@0	2218	}
sl@0	2219
sl@0	2220	currentMapHandle = ((Handle ) (tempPtr + 16));
sl@0	2221	}
sl@0	2222	}

author	sl@SLION-WIN7.fritz.box
	Fri, 15 Jun 2012 03:10:57 +0200
changeset 0	bde4ae8d615e
permissions	-rw-r--r--