Initial revision

1 files changed, 2165 insertions, 0 deletions

diff --git a/mac/tclMacResource.c b/mac/tclMacResource.c
new file mode 100644
index 0000000..db06571
--- /dev/null
+++ b/mac/tclMacResource.c
@@ -0,0 +1,2165 @@
+/*
+ * tclMacResource.c --
+ *
+ *	This file contains several commands that manipulate or use
+ *	Macintosh resources.  Included are extensions to the "source"
+ *	command, the mac specific "beep" and "resource" commands, and
+ *	administration for open resource file references.
+ *
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclMacResource.c 1.35 97/11/24 15:03:58
+ */
+
+#include <Errors.h>
+#include <FSpCompat.h>
+#include <Processes.h>
+#include <Resources.h>
+#include <Sound.h>
+#include <Strings.h>
+#include <Traps.h>
+#include <LowMem.h>
+
+#include "FullPath.h"
+#include "tcl.h"
+#include "tclInt.h"
+#include "tclMac.h"
+#include "tclMacInt.h"
+#include "tclMacPort.h"
+
+/*
+ * This flag tells the RegisterResource function to insert the
+ * resource into the tail of the resource fork list.  Needed only
+ * Resource_Init.
+ */
+ 
+#define TCL_RESOURCE_INSERT_TAIL 1
+/*
+ * 2 is taken by TCL_RESOURCE_DONT_CLOSE
+ * which is the only public flag to TclMacRegisterResourceFork.
+ */
+ 
+#define TCL_RESOURCE_CHECK_IF_OPEN 4
+
+/*
+ * Pass this in the mode parameter of SetSoundVolume to determine
+ * which volume to set.
+ */
+
+enum WhichVolume {
+    SYS_BEEP_VOLUME,    /* This sets the volume for SysBeep calls */ 
+    DEFAULT_SND_VOLUME, /* This one for SndPlay calls */
+    RESET_VOLUME        /* And this undoes the last call to SetSoundVolume */
+};
+ 
+/*
+ * Hash table to track open resource files.
+ */
+
+typedef struct OpenResourceFork {
+    short fileRef;
+    int   flags;
+} OpenResourceFork;
+
+
+
+static Tcl_HashTable nameTable;		/* Id to process number mapping. */
+static Tcl_HashTable resourceTable;	/* Process number to id mapping. */
+static Tcl_Obj *resourceForkList;       /* Ordered list of resource forks */
+static int appResourceIndex;            /* This is the index of the application*
+					 * in the list of resource forks */
+static int newId = 0;			/* Id source. */
+static int initialized = 0;		/* 0 means static structures haven't 
+					 * been initialized yet. */
+static int osTypeInit = 0;		/* 0 means Tcl object of osType hasn't 
+					 * been initialized yet. */
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static void		DupOSTypeInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+			    Tcl_Obj *copyPtr));
+static void		ResourceInit _ANSI_ARGS_((void));
+static void             BuildResourceForkList _ANSI_ARGS_((void));
+static int		SetOSTypeFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr));
+static void		UpdateStringOfOSType _ANSI_ARGS_((Tcl_Obj *objPtr));
+static OpenResourceFork* GetRsrcRefFromObj _ANSI_ARGS_((Tcl_Obj *objPtr,
+		                int okayOnReadOnly, const char *operation,
+	                        Tcl_Obj *resultPtr));
+
+static void 		SetSoundVolume(int volume, enum WhichVolume mode);
+
+/*
+ * The structures below defines the Tcl object type defined in this file by
+ * means of procedures that can be invoked by generic object code.
+ */
+
+static Tcl_ObjType osType = {
+    "ostype",				/* name */
+    (Tcl_FreeInternalRepProc *) NULL,   /* freeIntRepProc */
+    DupOSTypeInternalRep,	        /* dupIntRepProc */
+    UpdateStringOfOSType,		/* updateStringProc */
+    SetOSTypeFromAny			/* setFromAnyProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ResourceObjCmd --
+ *
+ *	This procedure is invoked to process the "resource" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ResourceObjCmd(
+    ClientData clientData,		/* Not used. */
+    Tcl_Interp *interp,			/* Current interpreter. */
+    int objc,				/* Number of arguments. */
+    Tcl_Obj *CONST objv[])		/* Argument values. */
+{
+    Tcl_Obj *resultPtr, *objPtr;
+    int index, result;
+    long fileRef, rsrcId;
+    FSSpec fileSpec;
+    Tcl_DString buffer;
+    char *nativeName;
+    char *stringPtr;
+    char errbuf[16];
+    OpenResourceFork *resourceRef;
+    Handle resource = NULL;
+    OSErr err;
+    int count, i, limitSearch = false, length;
+    short id, saveRef, resInfo;
+    Str255 theName;
+    OSType rezType;
+    int gotInt, releaseIt = 0, force;
+    char *resourceId = NULL;	
+    long size;
+    char macPermision;
+    int mode;
+
+    static char *switches[] = {"close", "delete" ,"files", "list", 
+            "open", "read", "types", "write", (char *) NULL
+    };
+	        
+    enum {
+            RESOURCE_CLOSE, RESOURCE_DELETE, RESOURCE_FILES, RESOURCE_LIST, 
+            RESOURCE_OPEN, RESOURCE_READ, RESOURCE_TYPES, RESOURCE_WRITE
+    };
+              
+    static char *writeSwitches[] = {
+            "-id", "-name", "-file", "-force", (char *) NULL
+    };
+            
+    enum {
+            RESOURCE_WRITE_ID, RESOURCE_WRITE_NAME, 
+            RESOURCE_WRITE_FILE, RESOURCE_FORCE
+    };
+            
+    static char *deleteSwitches[] = {"-id", "-name", "-file", (char *) NULL};
+             
+    enum {RESOURCE_DELETE_ID, RESOURCE_DELETE_NAME, RESOURCE_DELETE_FILE};
+
+    resultPtr = Tcl_GetObjResult(interp);
+    
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+	return TCL_ERROR;
+    }
+
+    if (Tcl_GetIndexFromObj(interp, objv[1], switches, "option", 0, &index)
+	    != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (!initialized) {
+	ResourceInit();
+    }
+    result = TCL_OK;
+
+    switch (index) {
+	case RESOURCE_CLOSE:			
+	    if (objc != 3) {
+		Tcl_WrongNumArgs(interp, 2, objv, "resourceRef");
+		return TCL_ERROR;
+	    }
+	    stringPtr = Tcl_GetStringFromObj(objv[2], &length);
+	    fileRef = TclMacUnRegisterResourceFork(stringPtr, resultPtr);
+	    
+	    if (fileRef >= 0) {
+	        CloseResFile((short) fileRef);
+	        return TCL_OK;
+	    } else {
+	        return TCL_ERROR;
+	    }
+	case RESOURCE_DELETE:
+	    if (!((objc >= 3) && (objc <= 9) && ((objc % 2) == 1))) {
+		Tcl_WrongNumArgs(interp, 2, objv, 
+		    "?-id resourceId? ?-name resourceName? ?-file \
+resourceRef? resourceType");
+		return TCL_ERROR;
+	    }
+	    
+	    i = 2;
+	    fileRef = -1;
+	    gotInt = false;
+	    resourceId = NULL;
+	    limitSearch = false;
+
+	    while (i < (objc - 2)) {
+		if (Tcl_GetIndexFromObj(interp, objv[i], deleteSwitches,
+			"option", 0, &index) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+
+		switch (index) {
+		    case RESOURCE_DELETE_ID:		
+			if (Tcl_GetLongFromObj(interp, objv[i+1], &rsrcId)
+				!= TCL_OK) {
+			    return TCL_ERROR;
+			}
+			gotInt = true;
+			break;
+		    case RESOURCE_DELETE_NAME:		
+			resourceId = Tcl_GetStringFromObj(objv[i+1], &length);
+			if (length > 255) {
+			    Tcl_AppendStringsToObj(resultPtr,"-name argument ",
+			            "too long, must be < 255 characters",
+			            (char *) NULL);
+			    return TCL_ERROR;
+			}
+			strcpy((char *) theName, resourceId);
+			resourceId = (char *) theName;
+			c2pstr(resourceId);
+			break;
+		    case RESOURCE_DELETE_FILE:
+		        resourceRef = GetRsrcRefFromObj(objv[i+1], 0, 
+		                "delete from", resultPtr);
+		        if (resourceRef == NULL) {
+		            return TCL_ERROR;
+		        }	
+			limitSearch = true;
+			break;
+		}
+		i += 2;
+	    }
+	    
+	    if ((resourceId == NULL) && !gotInt) {
+		Tcl_AppendStringsToObj(resultPtr,"you must specify either ",
+		        "\"-id\" or \"-name\" or both ",
+		        "to \"resource delete\"",
+		        (char *) NULL);
+	        return TCL_ERROR;
+            }
+
+	    if (Tcl_GetOSTypeFromObj(interp, objv[i], &rezType) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+
+	    if (limitSearch) {
+		saveRef = CurResFile();
+		UseResFile((short) resourceRef->fileRef);
+	    }
+	    
+	    SetResLoad(false);
+	    
+	    if (gotInt == true) {
+	        if (limitSearch) {
+		    resource = Get1Resource(rezType, rsrcId);
+		} else {
+		    resource = GetResource(rezType, rsrcId);
+		}
+                err = ResError();
+            
+                if (err == resNotFound || resource == NULL) {
+	            Tcl_AppendStringsToObj(resultPtr, "resource not found",
+	                (char *) NULL);
+	            result = TCL_ERROR;
+	            goto deleteDone;               
+                } else if (err != noErr) {
+                    char buffer[16];
+                
+                    sprintf(buffer, "%12d", err);
+	            Tcl_AppendStringsToObj(resultPtr, "resource error #",
+	                    buffer, "occured while trying to find resource",
+	                    (char *) NULL);
+	            result = TCL_ERROR;
+	            goto deleteDone;               
+	        }
+	    } 
+	    
+	    if (resourceId != NULL) {
+	        Handle tmpResource;
+	        if (limitSearch) {
+	            tmpResource = Get1NamedResource(rezType,
+			    (StringPtr) resourceId);
+	        } else {
+	            tmpResource = GetNamedResource(rezType,
+			    (StringPtr) resourceId);
+	        }
+                err = ResError();
+            
+                if (err == resNotFound || tmpResource == NULL) {
+	            Tcl_AppendStringsToObj(resultPtr, "resource not found",
+	                (char *) NULL);
+	            result = TCL_ERROR;
+	            goto deleteDone;               
+                } else if (err != noErr) {
+                    char buffer[16];
+                
+                    sprintf(buffer, "%12d", err);
+	            Tcl_AppendStringsToObj(resultPtr, "resource error #",
+	                    buffer, "occured while trying to find resource",
+	                    (char *) NULL);
+	            result = TCL_ERROR;
+	            goto deleteDone;               
+	        }
+	        
+	        if (gotInt) { 
+	            if (resource != tmpResource) {
+	                Tcl_AppendStringsToObj(resultPtr,
+				"\"-id\" and \"-name\" ",
+	                        "values do not point to the same resource",
+	                        (char *) NULL);
+	                result = TCL_ERROR;
+	                goto deleteDone;
+	            }
+	        } else {
+	            resource = tmpResource;
+	        }
+	    }
+	        
+       	    resInfo = GetResAttrs(resource);
+	    
+	    if ((resInfo & resProtected) == resProtected) {
+	        Tcl_AppendStringsToObj(resultPtr, "resource ",
+	                "cannot be deleted: it is protected.",
+	                (char *) NULL);
+	        result = TCL_ERROR;
+	        goto deleteDone;               
+	    } else if ((resInfo & resSysHeap) == resSysHeap) {   
+	        Tcl_AppendStringsToObj(resultPtr, "resource",
+	                "cannot be deleted: it is in the system heap.",
+	                (char *) NULL);
+	        result = TCL_ERROR;
+	        goto deleteDone;               
+	    }
+	    
+	    /*
+	     * Find the resource file, if it was not specified,
+	     * so we can flush the changes now.  Perhaps this is
+	     * a little paranoid, but better safe than sorry.
+	     */
+	     
+	    RemoveResource(resource);
+	    
+	    if (!limitSearch) {
+	        UpdateResFile(HomeResFile(resource));
+	    } else {
+	        UpdateResFile(resourceRef->fileRef);
+	    }
+	    
+	    
+	    deleteDone:
+	    
+            SetResLoad(true);
+	    if (limitSearch) {
+                 UseResFile(saveRef);                        
+	    }
+	    return result;
+	    
+	case RESOURCE_FILES:
+	    if ((objc < 2) || (objc > 3)) {
+		Tcl_SetStringObj(resultPtr,
+		        "wrong # args: should be \"resource files \
+?resourceId?\"", -1);
+		return TCL_ERROR;
+	    }
+	    
+	    if (objc == 2) {
+	        stringPtr = Tcl_GetStringFromObj(resourceForkList, &length);
+	        Tcl_SetStringObj(resultPtr, stringPtr, length);
+	    } else {
+                FCBPBRec fileRec;
+                Handle pathHandle;
+                short pathLength;
+                Str255 fileName;
+	        
+	        if (strcmp(Tcl_GetStringFromObj(objv[2], NULL), "ROM Map")
+			    == 0) {
+	            Tcl_SetStringObj(resultPtr,"no file path for ROM Map", -1);
+	            return TCL_ERROR;
+	        }
+	        
+	        resourceRef = GetRsrcRefFromObj(objv[2], 1, "files", resultPtr);
+	        if (resourceRef == NULL) {
+	            return TCL_ERROR;
+	        }
+
+                fileRec.ioCompletion = NULL;
+                fileRec.ioFCBIndx = 0;
+                fileRec.ioNamePtr = fileName;
+                fileRec.ioVRefNum = 0;
+                fileRec.ioRefNum = resourceRef->fileRef;
+                err = PBGetFCBInfo(&fileRec, false);
+                if (err != noErr) {
+                    Tcl_SetStringObj(resultPtr,
+                            "could not get FCB for resource file", -1);
+                    return TCL_ERROR;
+                }
+                
+                err = GetFullPath(fileRec.ioFCBVRefNum, fileRec.ioFCBParID,
+                        fileRec.ioNamePtr, &pathLength, &pathHandle);
+                if ( err != noErr) {
+                    Tcl_SetStringObj(resultPtr,
+                            "could not get file path from token", -1);
+                    return TCL_ERROR;
+                }
+                
+                HLock(pathHandle);
+                Tcl_SetStringObj(resultPtr,*pathHandle,pathLength);
+                HUnlock(pathHandle);
+                DisposeHandle(pathHandle);
+            }                    	    
+	    return TCL_OK;
+	case RESOURCE_LIST:			
+	    if (!((objc == 3) || (objc == 4))) {
+		Tcl_WrongNumArgs(interp, 2, objv, "resourceType ?resourceRef?");
+		return TCL_ERROR;
+	    }
+	    if (Tcl_GetOSTypeFromObj(interp, objv[2], &rezType) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+
+	    if (objc == 4) {
+	        resourceRef = GetRsrcRefFromObj(objv[3], 1, 
+		                "list", resultPtr);
+		if (resourceRef == NULL) {
+		    return TCL_ERROR;
+		}	
+
+		saveRef = CurResFile();
+		UseResFile((short) resourceRef->fileRef);
+		limitSearch = true;
+	    }
+
+	    Tcl_ResetResult(interp);
+	    if (limitSearch) {
+		count = Count1Resources(rezType);
+	    } else {
+		count = CountResources(rezType);
+	    }
+	    SetResLoad(false);
+	    for (i = 1; i <= count; i++) {
+		if (limitSearch) {
+		    resource = Get1IndResource(rezType, i);
+		} else {
+		    resource = GetIndResource(rezType, i);
+		}
+		if (resource != NULL) {
+		    GetResInfo(resource, &id, (ResType *) &rezType, theName);
+		    if (theName[0] != 0) {
+			objPtr = Tcl_NewStringObj((char *) theName + 1,
+				theName[0]);
+		    } else {
+			objPtr = Tcl_NewIntObj(id);
+		    }
+		    ReleaseResource(resource);
+		    result = Tcl_ListObjAppendElement(interp, resultPtr,
+			    objPtr);
+		    if (result != TCL_OK) {
+			Tcl_DecrRefCount(objPtr);
+			break;
+		    }
+		}
+	    }
+	    SetResLoad(true);
+	
+	    if (limitSearch) {
+		UseResFile(saveRef);
+	    }
+	
+	    return TCL_OK;
+	case RESOURCE_OPEN:			
+	    if (!((objc == 3) || (objc == 4))) {
+		Tcl_WrongNumArgs(interp, 2, objv, "fileName ?permissions?");
+		return TCL_ERROR;
+	    }
+	    stringPtr = Tcl_GetStringFromObj(objv[2], &length);
+	    nativeName = Tcl_TranslateFileName(interp, stringPtr, &buffer);
+	    if (nativeName == NULL) {
+		return TCL_ERROR;
+	    }
+	    err = FSpLocationFromPath(strlen(nativeName), nativeName,
+		    &fileSpec) ;
+	    Tcl_DStringFree(&buffer);
+	    if (!((err == noErr) || (err == fnfErr))) {
+		Tcl_AppendStringsToObj(resultPtr,
+			"invalid path", (char *) NULL);
+		return TCL_ERROR;
+	    }
+
+	    /*
+	     * Get permissions for the file.  We really only understand
+	     * read-only and shared-read-write.  If no permissions are 
+	     * given we default to read only.
+	     */
+	    
+	    if (objc == 4) {
+		stringPtr = Tcl_GetStringFromObj(objv[3], &length);
+		mode = TclGetOpenMode(interp, stringPtr, &index);
+		if (mode == -1) {
+		    /* TODO: TclGetOpenMode doesn't work with Obj commands. */
+		    return TCL_ERROR;
+		}
+		switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
+		    case O_RDONLY:
+			macPermision = fsRdPerm;
+		    break;
+		    case O_WRONLY:
+		    case O_RDWR:
+			macPermision = fsRdWrShPerm;
+			break;
+		    default:
+			panic("Tcl_ResourceObjCmd: invalid mode value");
+		    break;
+		}
+	    } else {
+		macPermision = fsRdPerm;
+	    }
+	    
+	    /*
+	     * Don't load in any of the resources in the file, this could 
+	     * cause problems if you open a file that has CODE resources...
+	     */
+	     
+	    SetResLoad(false); 
+	    fileRef = (long) FSpOpenResFileCompat(&fileSpec, macPermision);
+	    SetResLoad(true);
+	    
+	    if (fileRef == -1) {
+	    	err = ResError();
+		if (((err == fnfErr) || (err == eofErr)) &&
+			(macPermision == fsRdWrShPerm)) {
+		    /*
+		     * No resource fork existed for this file.  Since we are
+		     * opening it for writing we will create the resource fork
+		     * now.
+		     */
+		     
+		    HCreateResFile(fileSpec.vRefNum, fileSpec.parID,
+			    fileSpec.name);
+		    fileRef = (long) FSpOpenResFileCompat(&fileSpec,
+			    macPermision);
+		    if (fileRef == -1) {
+			goto openError;
+		    }
+		} else if (err == fnfErr) {
+		    Tcl_AppendStringsToObj(resultPtr,
+			"file does not exist", (char *) NULL);
+		    return TCL_ERROR;
+		} else if (err == eofErr) {
+		    Tcl_AppendStringsToObj(resultPtr,
+			"file does not contain resource fork", (char *) NULL);
+		    return TCL_ERROR;
+		} else {
+		    openError:
+		    Tcl_AppendStringsToObj(resultPtr,
+			"error opening resource file", (char *) NULL);
+		    return TCL_ERROR;
+		}
+	    }
+	    	    
+            /*
+             * The FspOpenResFile function does not set the ResFileAttrs.
+             * Even if you open the file read only, the mapReadOnly
+             * attribute is not set.  This means we can't detect writes to a 
+             * read only resource fork until the write fails, which is bogus.  
+             * So set it here...
+             */
+            
+            if (macPermision == fsRdPerm) {
+                SetResFileAttrs(fileRef, mapReadOnly);
+            }
+            
+            Tcl_SetStringObj(resultPtr, "", 0);
+            if (TclMacRegisterResourceFork(fileRef, resultPtr, 
+                    TCL_RESOURCE_CHECK_IF_OPEN) != TCL_OK) {
+                CloseResFile(fileRef);
+		return TCL_ERROR;
+            }
+
+	    return TCL_OK;
+	case RESOURCE_READ:			
+	    if (!((objc == 4) || (objc == 5))) {
+		Tcl_WrongNumArgs(interp, 2, objv,
+			"resourceType resourceId ?resourceRef?");
+		return TCL_ERROR;
+	    }
+
+	    if (Tcl_GetOSTypeFromObj(interp, objv[2], &rezType) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    
+	    if (Tcl_GetLongFromObj((Tcl_Interp *) NULL, objv[3], &rsrcId)
+		    != TCL_OK) {
+		resourceId = Tcl_GetStringFromObj(objv[3], &length);
+            }
+
+	    if (objc == 5) {
+		stringPtr = Tcl_GetStringFromObj(objv[4], &length);
+	    } else {
+		stringPtr = NULL;
+	    }
+	
+	    resource = Tcl_MacFindResource(interp, rezType, resourceId,
+		rsrcId, stringPtr, &releaseIt);
+			    
+	    if (resource != NULL) {
+		size = GetResourceSizeOnDisk(resource);
+		Tcl_SetStringObj(resultPtr, *resource, size);
+
+		/*
+		 * Don't release the resource unless WE loaded it...
+		 */
+		 
+		if (releaseIt) {
+		    ReleaseResource(resource);
+		}
+		return TCL_OK;
+	    } else {
+		Tcl_AppendStringsToObj(resultPtr, "could not load resource",
+		    (char *) NULL);
+		return TCL_ERROR;
+	    }
+	case RESOURCE_TYPES:			
+	    if (!((objc == 2) || (objc == 3))) {
+		Tcl_WrongNumArgs(interp, 2, objv, "?resourceRef?");
+		return TCL_ERROR;
+	    }
+
+	    if (objc == 3) {
+	        resourceRef = GetRsrcRefFromObj(objv[2], 1, 
+		                "get types of", resultPtr);
+		if (resourceRef == NULL) {
+		    return TCL_ERROR;
+		}
+			
+		saveRef = CurResFile();
+		UseResFile((short) resourceRef->fileRef);
+		limitSearch = true;
+	    }
+
+	    if (limitSearch) {
+		count = Count1Types();
+	    } else {
+		count = CountTypes();
+	    }
+	    for (i = 1; i <= count; i++) {
+		if (limitSearch) {
+		    Get1IndType((ResType *) &rezType, i);
+		} else {
+		    GetIndType((ResType *) &rezType, i);
+		}
+		objPtr = Tcl_NewOSTypeObj(rezType);
+		result = Tcl_ListObjAppendElement(interp, resultPtr, objPtr);
+		if (result != TCL_OK) {
+		    Tcl_DecrRefCount(objPtr);
+		    break;
+		}
+	    }
+		
+	    if (limitSearch) {
+		UseResFile(saveRef);
+	    }
+		
+	    return result;
+	case RESOURCE_WRITE:			
+	    if ((objc < 4) || (objc > 11)) {
+		Tcl_WrongNumArgs(interp, 2, objv, 
+		"?-id resourceId? ?-name resourceName? ?-file resourceRef?\
+ ?-force? resourceType data");
+		return TCL_ERROR;
+	    }
+	    
+	    i = 2;
+	    gotInt = false;
+	    resourceId = NULL;
+	    limitSearch = false;
+	    force = 0;
+
+	    while (i < (objc - 2)) {
+		if (Tcl_GetIndexFromObj(interp, objv[i], writeSwitches,
+			"switch", 0, &index) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+
+		switch (index) {
+		    case RESOURCE_WRITE_ID:		
+			if (Tcl_GetLongFromObj(interp, objv[i+1], &rsrcId)
+				!= TCL_OK) {
+			    return TCL_ERROR;
+			}
+			gotInt = true;
+		        i += 2;
+			break;
+		    case RESOURCE_WRITE_NAME:		
+			resourceId = Tcl_GetStringFromObj(objv[i+1], &length);
+			strcpy((char *) theName, resourceId);
+			resourceId = (char *) theName;
+			c2pstr(resourceId);
+		        i += 2;
+			break;
+		    case RESOURCE_WRITE_FILE:		
+	                resourceRef = GetRsrcRefFromObj(objv[i+1], 0, 
+		                        "write to", resultPtr);
+                        if (resourceRef == NULL) {
+                            return TCL_ERROR;
+		        }	
+			limitSearch = true;
+		        i += 2;
+			break;
+		    case RESOURCE_FORCE:
+		        force = 1;
+		        i += 1;
+		        break;
+		}
+	    }
+	    if (Tcl_GetOSTypeFromObj(interp, objv[i], &rezType) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    stringPtr = Tcl_GetStringFromObj(objv[i+1], &length);
+
+	    if (gotInt == false) {
+		rsrcId = UniqueID(rezType);
+	    }
+	    if (resourceId == NULL) {
+		resourceId = (char *) "\p";
+	    }
+	    if (limitSearch) {
+		saveRef = CurResFile();
+		UseResFile((short) resourceRef->fileRef);
+	    }
+	    
+	    /*
+	     * If we are adding the resource by number, then we must make sure
+	     * there is not already a resource of that number.  We are not going
+	     * load it here, since we want to detect whether we loaded it or
+	     * not.  Remember that releasing some resources in particular menu
+	     * related ones, can be fatal.
+	     */
+	     
+	    if (gotInt == true) {
+	        SetResLoad(false);
+	        resource = Get1Resource(rezType,rsrcId);
+	        SetResLoad(true);
+	    }     
+	    	    
+	    if (resource == NULL) {
+	        /*
+	         * We get into this branch either if there was not already a
+	         * resource of this type & id, or the id was not specified.
+	         */
+	         
+	        resource = NewHandle(length);
+	        if (resource == NULL) {
+	            resource = NewHandleSys(length);
+	            if (resource == NULL) {
+	                panic("could not allocate memory to write resource");
+	            }
+	        }
+	        HLock(resource);
+	        memcpy(*resource, stringPtr, length);
+	        HUnlock(resource);
+	        AddResource(resource, rezType, (short) rsrcId,
+		    (StringPtr) resourceId);
+		releaseIt = 1;
+            } else {
+                /* 
+                 * We got here because there was a resource of this type 
+                 * & ID in the file. 
+                 */ 
+                
+                if (*resource == NULL) {
+                    releaseIt = 1;
+                } else {
+                    releaseIt = 0;
+                }
+               
+                if (!force) {
+                    /*
+                     *We only overwrite extant resources
+                     * when the -force flag has been set.
+                     */
+                     
+                    sprintf(errbuf,"%d", rsrcId);
+                  
+                    Tcl_AppendStringsToObj(resultPtr, "the resource ",
+                          errbuf, " already exists, use \"-force\"",
+                          " to overwrite it.", (char *) NULL);
+                    
+                    result = TCL_ERROR;
+                    goto writeDone;
+                } else if (GetResAttrs(resource) & resProtected) {
+                    /*  
+                     *  
+                     * Next, check to see if it is protected...
+                     */
+                 
+                    sprintf(errbuf,"%d", rsrcId);
+                    Tcl_AppendStringsToObj(resultPtr,
+			    "could not write resource id ",
+                            errbuf, " of type ",
+                            Tcl_GetStringFromObj(objv[i],&length),
+                            ", it was protected.",(char *) NULL);
+                    result = TCL_ERROR;
+                    goto writeDone;
+                } else {
+                    /*
+                     * Be careful, the resource might already be in memory
+                     * if something else loaded it.
+                     */
+                     
+                    if (*resource == 0) {
+                    	LoadResource(resource);
+                    	err = ResError();
+                    	if (err != noErr) {
+                            sprintf(errbuf,"%d", rsrcId);
+                            Tcl_AppendStringsToObj(resultPtr,
+				    "error loading resource ",
+                                    errbuf, " of type ",
+                                    Tcl_GetStringFromObj(objv[i],&length),
+                                    " to overwrite it", (char *) NULL);
+                            goto writeDone;
+                    	}
+                    }
+                     
+                    SetHandleSize(resource, length);
+                    if ( MemError() != noErr ) {
+                        panic("could not allocate memory to write resource");
+                    }
+
+                    HLock(resource);
+	            memcpy(*resource, stringPtr, length);
+	            HUnlock(resource);
+	           
+                    ChangedResource(resource);
+                
+                    /*
+                     * We also may have changed the name...
+                     */ 
+                 
+                    SetResInfo(resource, rsrcId, (StringPtr) resourceId);
+                }
+            }
+            
+	    err = ResError();
+	    if (err != noErr) {
+		Tcl_AppendStringsToObj(resultPtr,
+			"error adding resource to resource map",
+		        (char *) NULL);
+		result = TCL_ERROR;
+		goto writeDone;
+	    }
+	    
+	    WriteResource(resource);
+	    err = ResError();
+	    if (err != noErr) {
+		Tcl_AppendStringsToObj(resultPtr,
+			"error writing resource to disk",
+		        (char *) NULL);
+		result = TCL_ERROR;
+	    }
+	    
+	    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_GetIndexFromObject 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)  {
+	string = TclGetStringFromObj(objv[1], &length);
+	return Tcl_EvalFile(interp, string);
+    }
+    
+    /*
+     * The following code supports a few older forms of this command
+     * for backward compatability.
+     */
+    string = TclGetStringFromObj(objv[1], &length);
+    if (!strcmp(string, "-rsrc") || !strcmp(string, "-rsrcname")) {
+	rsrcName = TclGetStringFromObj(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 = TclGetStringFromObj(objv[3], &length);
+    }
+    return Tcl_MacEvalResource(interp, rsrcName, rsrcID, fileName);
+	
+    sourceFmtErr:
+    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), errStr, "should be \"",
+		Tcl_GetStringFromObj(objv[0], (int *) NULL),
+		" fileName\" or \"",
+		Tcl_GetStringFromObj(objv[0], (int *) NULL),
+		" -rsrc name ?fileName?\" or \"", 
+		Tcl_GetStringFromObj(objv[0], (int *) NULL),
+		" -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_GetStringFromObj(objv[0], (int *) NULL),
+		    " -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. */
+    char *resourceName,		/* Name of TEXT resource to source,
+				   NULL if number should be used. */
+    int resourceNumber,		/* Resource id of source. */
+    char *fileName)		/* Name of file to process.
+				   NULL if application resource. */
+{
+    Handle sourceText;
+    Str255 rezName;
+    char msg[200];
+    int result;
+    short saveRef, fileRef = -1;
+    char idStr[64];
+    FSSpec fileSpec;
+    Tcl_DString buffer;
+    char *nativeName;
+
+    saveRef = CurResFile();
+	
+    if (fileName != NULL) {
+	OSErr err;
+	
+	nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
+	if (nativeName == NULL) {
+	    return TCL_ERROR;
+	}
+	err = FSpLocationFromPath(strlen(nativeName), nativeName, &fileSpec);
+	Tcl_DStringFree(&buffer);
+	if (err != noErr) {
+	    Tcl_AppendResult(interp, "Error finding the file: \"", 
+		fileName, "\".", NULL);
+	    return TCL_ERROR;
+	}
+		
+	fileRef = FSpOpenResFileCompat(&fileSpec, fsRdPerm);
+	if (fileRef == -1) {
+	    Tcl_AppendResult(interp, "Error reading the file: \"", 
+		fileName, "\".", NULL);
+	    return TCL_ERROR;
+	}
+		
+	UseResFile(fileRef);
+    } else {
+	/*
+	 * The default behavior will search through all open resource files.
+	 * This may not be the behavior you desire.  If you want the behavior
+	 * of this call to *only* search the application resource fork, you
+	 * must call UseResFile at this point to set it to the application
+	 * file.  This means you must have already obtained the application's 
+	 * fileRef when the application started up.
+	 */
+    }
+	
+    /*
+     * Load the resource by name or ID
+     */
+    if (resourceName != NULL) {
+	strcpy((char *) rezName + 1, resourceName);
+	rezName[0] = strlen(resourceName);
+	sourceText = GetNamedResource('TEXT', rezName);
+    } 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:
+    sprintf(idStr, "ID=%d", resourceNumber);
+    Tcl_AppendResult(interp, "The resource \"",
+	    (resourceName != NULL ? resourceName : idStr),
+	    "\" could not be loaded from ",
+	    (fileName != NULL ? fileName : "application"),
+	    ".", NULL);
+
+    rezEvalCleanUp:
+    if (fileRef != -1) {
+	CloseResFile(fileRef);
+    }
+
+    UseResFile(saveRef);
+	
+    return result;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Tcl_MacConvertTextResource --
+ *
+ *	Converts a TEXT resource into a Tcl suitable string.
+ *
+ * Side Effects:
+ *	Mallocs the returned memory, converts '\r' to '\n', and appends a NULL.
+ *
+ * Results:
+ *      A new malloced string.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+char *
+Tcl_MacConvertTextResource(
+    Handle resource)		/* Handle to TEXT resource. */
+{
+    int i, size;
+    char *resultStr;
+
+    size = GetResourceSizeOnDisk(resource);
+    
+    resultStr = ckalloc(size + 1);
+    
+    for (i=0; i<size; i++) {
+	if ((*resource)[i] == '\r') {
+	    resultStr[i] = '\n';
+	} else {
+	    resultStr[i] = (*resource)[i];
+	}
+    }
+    
+    resultStr[size] = '\0';
+
+    return resultStr;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * Tcl_MacFindResource --
+ *
+ *	Higher level interface for loading resources.
+ *
+ * Side Effects:
+ *	Attempts to load a resource.
+ *
+ * Results:
+ *      A handle on success.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+Handle
+Tcl_MacFindResource(
+    Tcl_Interp *interp,		/* Interpreter in which to process file. */
+    long resourceType,		/* Type of resource to load. */
+    char *resourceName,		/* Name of resource to find,
+				 * NULL if number should be used. */
+    int resourceNumber,		/* Resource id of source. */
+    char *resFileRef,		/* Registered resource file reference,
+				 * NULL if searching all open resource files. */
+    int *releaseIt)	        /* Should we release this resource when done. */
+{
+    Tcl_HashEntry *nameHashPtr;
+    OpenResourceFork *resourceRef;
+    int limitSearch = false;
+    short saveRef;
+    Handle resource;
+
+    if (resFileRef != NULL) {
+	nameHashPtr = Tcl_FindHashEntry(&nameTable, resFileRef);
+	if (nameHashPtr == NULL) {
+	    Tcl_AppendResult(interp, "invalid resource file reference \"",
+			     resFileRef, "\"", (char *) NULL);
+	    return NULL;
+	}
+	resourceRef = (OpenResourceFork *) Tcl_GetHashValue(nameHashPtr);
+	saveRef = CurResFile();
+	UseResFile((short) resourceRef->fileRef);
+	limitSearch = true;
+    }
+
+    /* 
+     * Some system resources (for example system resources) should not 
+     * be released.  So we set autoload to false, and try to get the resource.
+     * If the Master Pointer of the returned handle is null, then resource was 
+     * not in memory, and it is safe to release it.  Otherwise, it is not.
+     */
+    
+    SetResLoad(false);
+	 
+    if (resourceName == NULL) {
+	if (limitSearch) {
+	    resource = Get1Resource(resourceType, resourceNumber);
+	} else {
+	    resource = GetResource(resourceType, resourceNumber);
+	}
+    } else {
+	c2pstr(resourceName);
+	if (limitSearch) {
+	    resource = Get1NamedResource(resourceType,
+		    (StringPtr) resourceName);
+	} else {
+	    resource = GetNamedResource(resourceType,
+		    (StringPtr) resourceName);
+	}
+	p2cstr((StringPtr) resourceName);
+    }
+    
+    if (*resource == NULL) {
+    	*releaseIt = 1;
+    	LoadResource(resource);
+    } else {
+    	*releaseIt = 0;
+    }
+    
+    SetResLoad(true);
+    	
+
+    if (limitSearch) {
+	UseResFile(saveRef);
+    }
+
+    return resource;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ResourceInit --
+ *
+ *	Initialize the structures used for resource management.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Read the code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ResourceInit()
+{
+
+    initialized = 1;
+    Tcl_InitHashTable(&nameTable, TCL_STRING_KEYS);
+    Tcl_InitHashTable(&resourceTable, TCL_ONE_WORD_KEYS);
+    resourceForkList = Tcl_NewObj();
+    Tcl_IncrRefCount(resourceForkList);
+
+    BuildResourceForkList();
+    
+}
+/***/
+
+/*Tcl_RegisterObjType(typePtr) */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NewOSTypeObj --
+ *
+ *	This procedure is used to create a new resource name type object.
+ *
+ * Results:
+ *	The newly created object is returned. This object will have a NULL
+ *	string representation. The returned object has ref count 0.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_NewOSTypeObj(
+    OSType newOSType)		/* Int used to initialize the new object. */
+{
+    register Tcl_Obj *objPtr;
+
+    if (!osTypeInit) {
+	osTypeInit = 1;
+	Tcl_RegisterObjType(&osType);
+    }
+
+    objPtr = Tcl_NewObj();
+    objPtr->bytes = NULL;
+    objPtr->internalRep.longValue = newOSType;
+    objPtr->typePtr = &osType;
+    return objPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetOSTypeObj --
+ *
+ *	Modify an object to be a resource type and to have the 
+ *	specified long value.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's old string rep, if any, is freed. Also, any old
+ *	internal rep is freed. 
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetOSTypeObj(
+    Tcl_Obj *objPtr,		/* Object whose internal rep to init. */
+    OSType newOSType)		/* Integer used to set object's value. */
+{
+    register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+
+    if (!osTypeInit) {
+	osTypeInit = 1;
+	Tcl_RegisterObjType(&osType);
+    }
+
+    Tcl_InvalidateStringRep(objPtr);
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+    
+    objPtr->internalRep.longValue = newOSType;
+    objPtr->typePtr = &osType;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetOSTypeFromObj --
+ *
+ *	Attempt to return an int from the Tcl object "objPtr". If the object
+ *	is not already an int, an attempt will be made to convert it to one.
+ *
+ * Results:
+ *	The return value is a standard Tcl object result. If an error occurs
+ *	during conversion, an error message is left in interp->objResult
+ *	unless "interp" is NULL.
+ *
+ * Side effects:
+ *	If the object is not already an int, the conversion will free
+ *	any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetOSTypeFromObj(
+    Tcl_Interp *interp, 	/* Used for error reporting if not NULL. */
+    Tcl_Obj *objPtr,		/* The object from which to get a int. */
+    OSType *osTypePtr)		/* Place to store resulting int. */
+{
+    register int result;
+    
+    if (!osTypeInit) {
+	osTypeInit = 1;
+	Tcl_RegisterObjType(&osType);
+    }
+
+    if (objPtr->typePtr == &osType) {
+	*osTypePtr = objPtr->internalRep.longValue;
+	return TCL_OK;
+    }
+
+    result = SetOSTypeFromAny(interp, objPtr);
+    if (result == TCL_OK) {
+	*osTypePtr = objPtr->internalRep.longValue;
+    }
+    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));
+    }
+}