876 lines
22 KiB
C
876 lines
22 KiB
C
/*
|
||
* 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 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.6 96/10/08 14:33:54
|
||
*/
|
||
|
||
#include <FSpCompat.h>
|
||
#include <Resources.h>
|
||
#include <Sound.h>
|
||
#include <Strings.h>
|
||
|
||
#include "tcl.h"
|
||
#include "tclInt.h"
|
||
#include "tclMacInt.h"
|
||
|
||
/*
|
||
* Hash table to track open resource files.
|
||
*/
|
||
static Tcl_HashTable nameTable; /* Id to process number mapping. */
|
||
static Tcl_HashTable resourceTable; /* Process number to id mapping. */
|
||
static int newId = 0; /* Id source. */
|
||
static int initialized = 0; /* 0 means static structures haven't
|
||
* been initialized yet. */
|
||
/*
|
||
* Procedures defined for just this file.
|
||
*/
|
||
static void ResourceInit _ANSI_ARGS_((void));
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* Tcl_ResourceCmd --
|
||
*
|
||
* 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_ResourceCmd(
|
||
ClientData dummy, /* Not used. */
|
||
Tcl_Interp *interp, /* Current interpreter. */
|
||
int argc, /* Number of arguments. */
|
||
char **argv) /* Argument strings. */
|
||
{
|
||
int c, result;
|
||
size_t length;
|
||
long fileRef;
|
||
FSSpec fileSpec;
|
||
Tcl_DString buffer;
|
||
char *nativeName;
|
||
Tcl_HashEntry *resourceHashPtr;
|
||
Tcl_HashEntry *nameHashPtr;
|
||
Handle resource;
|
||
OSErr err;
|
||
|
||
if (argc < 2) {
|
||
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
|
||
" option ?arg ...?\"", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
c = argv[1][0];
|
||
length = strlen(argv[1]);
|
||
result = TCL_OK;
|
||
|
||
if (!initialized) {
|
||
ResourceInit();
|
||
}
|
||
|
||
if ((c == 'c') && (strncmp(argv[1], "close", length) == 0)) {
|
||
nameHashPtr = Tcl_FindHashEntry(&nameTable, argv[2]);
|
||
if (nameHashPtr == NULL) {
|
||
Tcl_AppendResult(interp, "invalid resource file reference \"",
|
||
argv[2], "\"", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
fileRef = (long) Tcl_GetHashValue(nameHashPtr);
|
||
if (fileRef == 0) {
|
||
Tcl_AppendResult(interp, "can't close system resource",
|
||
(char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
Tcl_DeleteHashEntry(nameHashPtr);
|
||
resourceHashPtr = Tcl_FindHashEntry(&resourceTable, (char *) fileRef);
|
||
if (resourceHashPtr == NULL) {
|
||
panic("how did this happen");
|
||
}
|
||
ckfree(Tcl_GetHashValue(resourceHashPtr));
|
||
Tcl_DeleteHashEntry(resourceHashPtr);
|
||
|
||
CloseResFile((short) fileRef);
|
||
return TCL_OK;
|
||
} else if ((c == 'g') && (strncmp(argv[1], "getSTR", length) == 0)) {
|
||
int rsrcId;
|
||
unsigned char size;
|
||
char *resourceName = NULL, *stringPtr, *resFileRef = NULL;
|
||
|
||
if (!((argc == 3) || (argc == 4))) {
|
||
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
|
||
" ", argv[1], " resourceId ?resourceRef?\"",
|
||
(char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
if (Tcl_GetInt(interp, argv[2], &rsrcId) != TCL_OK) {
|
||
Tcl_ResetResult(interp);
|
||
resourceName = argv[2];
|
||
}
|
||
|
||
if (argc == 4) {
|
||
resFileRef = argv[3];
|
||
}
|
||
|
||
resource = TclMacFindResource(interp, "STR ", resourceName,
|
||
rsrcId, resFileRef);
|
||
|
||
if (resource != NULL) {
|
||
size = (*resource)[0];
|
||
stringPtr = (char *) ckalloc(size + 1);
|
||
strncpy(stringPtr, (*resource) + 1, size);
|
||
stringPtr[size] = '\0';
|
||
Tcl_SetResult(interp, stringPtr, TCL_DYNAMIC);
|
||
ReleaseResource(resource);
|
||
return TCL_OK;
|
||
} else {
|
||
Tcl_AppendResult(interp, "could not load 'STR ' resource: \"",
|
||
argv[2], "\"", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
} else if ((c == 'g') && (strncmp(argv[1], "getSTR#", length) == 0)) {
|
||
int rsrcId, index, total, i;
|
||
char *resourceName = NULL, *stringPtr, *resFileRef = NULL;
|
||
char * ptr;
|
||
|
||
if (!((argc == 4) || (argc == 5))) {
|
||
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
|
||
" ", argv[1], " resourceId index ?resourceRef?\"",
|
||
(char *) NULL);
|
||
}
|
||
if (Tcl_GetInt(interp, argv[2], &rsrcId) != TCL_OK) {
|
||
Tcl_ResetResult(interp);
|
||
resourceName = argv[2];
|
||
}
|
||
if ((Tcl_GetInt(interp, argv[3], &index) != TCL_OK) || (index <= 0)) {
|
||
Tcl_AppendResult(interp, "invalid STR# index \"",
|
||
argv[3], "\"", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
if (argc == 5) {
|
||
resFileRef = argv[4];
|
||
}
|
||
|
||
resource = TclMacFindResource(interp, "STR#", resourceName, rsrcId,
|
||
resFileRef);
|
||
|
||
if (resource != NULL) {
|
||
total = * (short *) resource;
|
||
if (index > total) {
|
||
Tcl_ResetResult(interp);
|
||
return TCL_OK;
|
||
}
|
||
HLock(resource);
|
||
ptr = *resource + 2;
|
||
for (i = 1; i != index; i++) {
|
||
ptr += *ptr + 1;
|
||
}
|
||
stringPtr = (char *) ckalloc(*ptr + 1);
|
||
strncpy(stringPtr, ptr + 1, *ptr);
|
||
stringPtr[*ptr] = '\0';
|
||
Tcl_SetResult(interp, stringPtr, TCL_DYNAMIC);
|
||
HUnlock(resource);
|
||
ReleaseResource(resource);
|
||
return TCL_OK;
|
||
} else {
|
||
Tcl_AppendResult(interp, "could not load 'STR#' resource: \"",
|
||
argv[2], "\"", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
} else if ((c == 'g') && (strncmp(argv[1], "getTEXT", length) == 0)) {
|
||
int rsrcId;
|
||
char *resourceName = NULL, *stringPtr, *resFileRef = NULL;
|
||
|
||
if (!((argc == 3) || (argc == 4))) {
|
||
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
|
||
" ", argv[1], " resourceId ?resourceRef?\"",
|
||
(char *) NULL);
|
||
}
|
||
if (Tcl_GetInt(interp, argv[2], &rsrcId) != TCL_OK) {
|
||
Tcl_ResetResult(interp);
|
||
resourceName = argv[2];
|
||
}
|
||
|
||
if (argc == 4) {
|
||
resFileRef = argv[3];
|
||
}
|
||
|
||
resource = TclMacFindResource(interp, "TEXT", resourceName, rsrcId,
|
||
resFileRef);
|
||
|
||
if (resource != NULL) {
|
||
stringPtr = TclMacConvertTextResource(resource);
|
||
Tcl_SetResult(interp, stringPtr, TCL_DYNAMIC);
|
||
ReleaseResource(resource);
|
||
return TCL_OK;
|
||
} else {
|
||
Tcl_AppendResult(interp, "could not load 'TEXT' resource: \"",
|
||
argv[2], "\"", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
} else if ((c == 'l') && (strncmp(argv[1], "list", length) == 0)) {
|
||
int count, i, limitSearch = false;
|
||
short id, saveRef;
|
||
Str255 theName;
|
||
ResType rezType;
|
||
|
||
if (!((argc == 3) || (argc == 4))) {
|
||
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
|
||
" ", argv[1], " resourceType ?resourceRef?\"",
|
||
(char *) NULL);
|
||
}
|
||
if (strlen(argv[2]) != 4) {
|
||
Tcl_AppendResult(interp, "not a valid resourceType: \"",
|
||
argv[2], "\"", (char *) NULL);
|
||
}
|
||
rezType = *((long *) argv[2]);
|
||
|
||
if (argc == 4) {
|
||
nameHashPtr = Tcl_FindHashEntry(&nameTable, argv[3]);
|
||
if (nameHashPtr == NULL) {
|
||
Tcl_AppendResult(interp, "invalid resource file reference \"",
|
||
argv[3], "\"", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
fileRef = (long) Tcl_GetHashValue(nameHashPtr);
|
||
saveRef = CurResFile();
|
||
UseResFile((short) 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, &rezType, theName);
|
||
if (theName[0] != 0) {
|
||
theName[theName[0]+1] = '\0';
|
||
Tcl_AppendElement(interp, (char *) theName + 1);
|
||
} else {
|
||
sprintf((char *) theName, "%d", id);
|
||
Tcl_AppendElement(interp, (char *) theName);
|
||
}
|
||
ReleaseResource(resource);
|
||
}
|
||
}
|
||
SetResLoad(true);
|
||
|
||
if (limitSearch) {
|
||
UseResFile(saveRef);
|
||
}
|
||
|
||
return TCL_OK;
|
||
} else if ((c == 'o') && (strncmp(argv[1], "open", length) == 0)) {
|
||
int new;
|
||
char *resourceId;
|
||
|
||
if (argc != 3) {
|
||
Tcl_AppendResult(interp, "wrong # args: should be \"resource open fileName\"", NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
nativeName = Tcl_TranslateFileName(interp, argv[2], &buffer);
|
||
if (nativeName == NULL) {
|
||
return TCL_ERROR;
|
||
}
|
||
err = FSpLocationFromPath(strlen(nativeName), nativeName, &fileSpec) ;
|
||
Tcl_DStringFree(&buffer);
|
||
if ( err != noErr ) {
|
||
Tcl_AppendResult(interp, "path doesn't lead to a file", NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
fileRef = (long) FSpOpenResFileCompat(&fileSpec, fsRdPerm);
|
||
if (fileRef == -1) {
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
resourceHashPtr = Tcl_CreateHashEntry(&resourceTable,
|
||
(char *) fileRef, &new);
|
||
if (!new) {
|
||
resourceId = (char *) Tcl_GetHashValue(resourceHashPtr);
|
||
Tcl_AppendResult(interp, resourceId, NULL);
|
||
return TCL_OK;
|
||
}
|
||
|
||
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");
|
||
}
|
||
Tcl_SetHashValue(nameHashPtr, fileRef);
|
||
|
||
Tcl_AppendResult(interp, resourceId, NULL);
|
||
return TCL_OK;
|
||
} else if ((c == 't') && (strncmp(argv[1], "types", length) == 0)) {
|
||
int count, i, limitSearch = false;
|
||
short saveRef;
|
||
Str255 theName;
|
||
ResType rezType;
|
||
|
||
if (!((argc == 2) || (argc == 3))) {
|
||
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
|
||
" ", argv[1], " ?resourceRef?\"", (char *) NULL);
|
||
}
|
||
|
||
if (argc == 3) {
|
||
nameHashPtr = Tcl_FindHashEntry(&nameTable, argv[2]);
|
||
if (nameHashPtr == NULL) {
|
||
Tcl_AppendResult(interp, "invalid resource file reference \"",
|
||
argv[2], "\"", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
fileRef = (long) Tcl_GetHashValue(nameHashPtr);
|
||
saveRef = CurResFile();
|
||
UseResFile((short) fileRef);
|
||
limitSearch = true;
|
||
}
|
||
|
||
Tcl_ResetResult(interp);
|
||
if (limitSearch) {
|
||
count = Count1Types();
|
||
} else {
|
||
count = CountTypes();
|
||
}
|
||
for (i = 1; i <= count; i++) {
|
||
if (limitSearch) {
|
||
Get1IndType(&rezType, i);
|
||
} else {
|
||
GetIndType(&rezType, i);
|
||
}
|
||
sprintf((char *) theName, "%-4.4s", &rezType);
|
||
Tcl_AppendElement(interp, (char *) theName);
|
||
}
|
||
|
||
if (limitSearch) {
|
||
UseResFile(saveRef);
|
||
}
|
||
|
||
return TCL_OK;
|
||
} else {
|
||
Tcl_AppendResult(interp, "unknown option \"", argv[1],
|
||
"\": should be close, getSTR, getSTR#, getTEXT, ",
|
||
"list, open or types", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* Tcl_MacSourceCmd --
|
||
*
|
||
* 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_MacSourceCmd(
|
||
ClientData dummy, /* Not used. */
|
||
Tcl_Interp *interp, /* Current interpreter. */
|
||
int argc, /* Number of arguments. */
|
||
char **argv) /* Argument strings. */
|
||
{
|
||
char *errNum = "wrong # args: ";
|
||
char *errBad = "bad argument: ";
|
||
char *errStr;
|
||
char *fileName = NULL, *rsrcName = NULL;
|
||
int rsrcID = -1;
|
||
|
||
if (argc < 2 || argc > 4) {
|
||
errStr = errNum;
|
||
goto sourceFmtErr;
|
||
}
|
||
|
||
if (argc == 2) {
|
||
return Tcl_EvalFile(interp, argv[1]);
|
||
}
|
||
|
||
/*
|
||
* The following code supports a few older forms of this command
|
||
* for backward compatability.
|
||
*/
|
||
if (!strcmp(argv[1], "-rsrc") || !strcmp(argv[1], "-rsrcname")) {
|
||
rsrcName = argv[2];
|
||
} else if (!strcmp(argv[1], "-rsrcid")) {
|
||
if (Tcl_GetInt(interp, argv[2], &rsrcID) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
} else {
|
||
errStr = errBad;
|
||
goto sourceFmtErr;
|
||
}
|
||
|
||
if (argc == 4) {
|
||
fileName = argv[3];
|
||
}
|
||
|
||
return TclMacEvalResource(interp, rsrcName, rsrcID, fileName);
|
||
|
||
sourceFmtErr:
|
||
Tcl_AppendResult(interp, errStr, "should be \"", argv[0],
|
||
" fileName\" or \"", argv[0], " -rsrc name ?fileName?\" or \"",
|
||
argv[0], " -rsrcid id ?fileName?\"", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* Tcl_MacBeepCmd --
|
||
*
|
||
* This procedure makes the beep sound.
|
||
*
|
||
* Results:
|
||
* A standard Tcl result.
|
||
*
|
||
* Side effects:
|
||
* Makes a beep.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
int
|
||
Tcl_MacBeepCmd(
|
||
ClientData dummy, /* Not used. */
|
||
Tcl_Interp *interp, /* Current interpreter. */
|
||
int argc, /* Number of arguments. */
|
||
char **argv) /* Argument strings. */
|
||
{
|
||
Handle sound;
|
||
Str255 sndName;
|
||
int volume = -1;
|
||
char * sndArg = NULL;
|
||
long curVolume;
|
||
|
||
if (argc == 1) {
|
||
SysBeep(1);
|
||
return TCL_OK;
|
||
} else if (argc == 2) {
|
||
if (!strcmp(argv[1], "-list")) {
|
||
int count, i;
|
||
short id;
|
||
Str255 theName;
|
||
ResType rezType;
|
||
|
||
Tcl_ResetResult(interp);
|
||
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;
|
||
}
|
||
theName[theName[0]+1] = '\0';
|
||
Tcl_AppendElement(interp, (char *) theName + 1);
|
||
}
|
||
}
|
||
return TCL_OK;
|
||
} else {
|
||
sndArg = argv[1];
|
||
}
|
||
} else if (argc == 3) {
|
||
if (!strcmp(argv[1], "-volume")) {
|
||
volume = atoi(argv[2]);
|
||
} else {
|
||
goto beepUsage;
|
||
}
|
||
} else if (argc == 4) {
|
||
if (!strcmp(argv[1], "-volume")) {
|
||
volume = atoi(argv[2]);
|
||
sndArg = argv[3];
|
||
} else {
|
||
goto beepUsage;
|
||
}
|
||
} else {
|
||
goto beepUsage;
|
||
}
|
||
|
||
/*
|
||
* Set Volume
|
||
*/
|
||
if (volume >= 0) {
|
||
GetSysBeepVolume(&curVolume);
|
||
SetSysBeepVolume((short) volume);
|
||
}
|
||
|
||
/*
|
||
* Play the sound
|
||
*/
|
||
if (sndArg == NULL) {
|
||
SysBeep(1);
|
||
} else {
|
||
strcpy((char *) sndName + 1, sndArg);
|
||
sndName[0] = strlen(sndArg);
|
||
sound = GetNamedResource('snd ', sndName);
|
||
if (sound != NULL) {
|
||
#if (THINK_C == 7)
|
||
SndPlay(NULL, sound, false);
|
||
#else
|
||
SndPlay(NULL, (SndListHandle) sound, false);
|
||
#endif
|
||
return TCL_OK;
|
||
} else {
|
||
if (volume >= 0) {
|
||
SetSysBeepVolume(curVolume);
|
||
}
|
||
Tcl_ResetResult(interp);
|
||
Tcl_AppendResult(interp, " \"", sndArg,
|
||
"\" is not a valid sound. (Try ", argv[0],
|
||
" -list)", NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
}
|
||
|
||
/*
|
||
* Reset Volume
|
||
*/
|
||
if (volume >= 0) {
|
||
SetSysBeepVolume(curVolume);
|
||
}
|
||
return TCL_OK;
|
||
|
||
beepUsage:
|
||
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
|
||
" [-volume num] [-list | sndName]?\"", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
/*
|
||
*-----------------------------------------------------------------------------
|
||
*
|
||
* TclMacEvalResource --
|
||
*
|
||
* 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
|
||
TclMacEvalResource(
|
||
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;
|
||
|
||
sourceStr = TclMacConvertTextResource(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;
|
||
}
|
||
|
||
/*
|
||
*-----------------------------------------------------------------------------
|
||
*
|
||
* TclMacConvertTextResource --
|
||
*
|
||
* 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 *
|
||
TclMacConvertTextResource(
|
||
Handle resource) /* Handle to TEXT resource. */
|
||
{
|
||
int i, size;
|
||
char *resultStr;
|
||
|
||
size = SizeResource(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;
|
||
}
|
||
|
||
/*
|
||
*-----------------------------------------------------------------------------
|
||
*
|
||
* TclMacFindResource --
|
||
*
|
||
* Higher level interface for loading resources.
|
||
*
|
||
* Side Effects:
|
||
* Attempts to load a resource.
|
||
*
|
||
* Results:
|
||
* A handle on success.
|
||
*
|
||
*-----------------------------------------------------------------------------
|
||
*/
|
||
|
||
Handle
|
||
TclMacFindResource(
|
||
Tcl_Interp *interp, /* Interpreter in which to process file. */
|
||
char *resourceType, /* Type of resource to load. */
|
||
char *resourceName, /* Name of resource to source,
|
||
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. */
|
||
{
|
||
Tcl_HashEntry *nameHashPtr;
|
||
long fileRef;
|
||
ResType rezType;
|
||
int limitSearch = false;
|
||
short saveRef;
|
||
Handle resource;
|
||
|
||
if (strlen(resourceType) != 4) {
|
||
Tcl_AppendResult(interp, "not a valid resource type: \"",
|
||
resourceType, "\"", (char *) NULL);
|
||
return NULL;
|
||
}
|
||
rezType = *((long *) resourceType);
|
||
|
||
if (resFileRef != NULL) {
|
||
nameHashPtr = Tcl_FindHashEntry(&nameTable, resFileRef);
|
||
if (nameHashPtr == NULL) {
|
||
Tcl_AppendResult(interp, "invalid resource file reference \"",
|
||
resFileRef, "\"", (char *) NULL);
|
||
return NULL;
|
||
}
|
||
fileRef = (long) Tcl_GetHashValue(nameHashPtr);
|
||
saveRef = CurResFile();
|
||
UseResFile((short) fileRef);
|
||
limitSearch = true;
|
||
}
|
||
|
||
if (resourceName == NULL) {
|
||
if (limitSearch) {
|
||
resource = Get1Resource(rezType, resourceNumber);
|
||
} else {
|
||
resource = GetResource(rezType, resourceNumber);
|
||
}
|
||
} else {
|
||
c2pstr(resourceName);
|
||
if (limitSearch) {
|
||
resource = Get1NamedResource(rezType, (StringPtr) resourceName);
|
||
} else {
|
||
resource = GetNamedResource(rezType, (StringPtr) resourceName);
|
||
}
|
||
p2cstr((StringPtr) resourceName);
|
||
}
|
||
|
||
if (limitSearch) {
|
||
UseResFile(saveRef);
|
||
}
|
||
|
||
return resource;
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* ResourceInit --
|
||
*
|
||
* Initialize the structures used for resource management.
|
||
*
|
||
* Results:
|
||
* None.
|
||
*
|
||
* Side effects:
|
||
* Read the code.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
static void
|
||
ResourceInit()
|
||
{
|
||
Tcl_HashEntry *resourceHashPtr;
|
||
Tcl_HashEntry *nameHashPtr;
|
||
long fileRef;
|
||
char * resourceId;
|
||
int new;
|
||
|
||
initialized = 1;
|
||
Tcl_InitHashTable(&nameTable, TCL_STRING_KEYS);
|
||
Tcl_InitHashTable(&resourceTable, TCL_ONE_WORD_KEYS);
|
||
|
||
/*
|
||
* Place the application resource file into our cache.
|
||
*/
|
||
fileRef = CurResFile();
|
||
resourceHashPtr = Tcl_CreateHashEntry(&resourceTable, (char *) fileRef,
|
||
&new);
|
||
resourceId = (char *) ckalloc(strlen("application") + 1);
|
||
sprintf(resourceId, "application");
|
||
Tcl_SetHashValue(resourceHashPtr, resourceId);
|
||
|
||
nameHashPtr = Tcl_CreateHashEntry(&nameTable, resourceId, &new);
|
||
Tcl_SetHashValue(nameHashPtr, fileRef);
|
||
|
||
/*
|
||
* Place the system resource file into our cache.
|
||
*/
|
||
fileRef = 0;
|
||
resourceHashPtr = Tcl_CreateHashEntry(&resourceTable, (char *) fileRef,
|
||
&new);
|
||
resourceId = (char *) ckalloc(strlen("system") + 1);
|
||
sprintf(resourceId, "system");
|
||
Tcl_SetHashValue(resourceHashPtr, resourceId);
|
||
|
||
nameHashPtr = Tcl_CreateHashEntry(&nameTable, resourceId, &new);
|
||
Tcl_SetHashValue(nameHashPtr, fileRef);
|
||
}
|