diff options
Diffstat (limited to 'mac/tclMacTest.c')
| -rw-r--r-- | mac/tclMacTest.c | 242 |
1 files changed, 242 insertions, 0 deletions
diff --git a/mac/tclMacTest.c b/mac/tclMacTest.c new file mode 100644 index 0000000..2452ca1 --- /dev/null +++ b/mac/tclMacTest.c @@ -0,0 +1,242 @@ +/* + * tclMacTest.c -- + * + * Contains commands for platform specific tests for + * the Macintosh platform. + * + * 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: @(#) tclMacTest.c 1.9 97/09/09 16:36:37 + */ + +#define TCL_TEST + +#include "tclInt.h" +#include "tclMacInt.h" +#include "tclMacPort.h" +#include "Files.h" +#include <Errors.h> +#include <Resources.h> +#include <Script.h> +#include <Strings.h> +#include <FSpCompat.h> + +/* + * Forward declarations of procedures defined later in this file: + */ + +int TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp)); +static int DebuggerCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int argc, char **argv)); +static int WriteTextResource _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int argc, char **argv)); + + +/* + *---------------------------------------------------------------------- + * + * TclplatformtestInit -- + * + * Defines commands that test platform specific functionality for + * Unix platforms. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * Defines new commands. + * + *---------------------------------------------------------------------- + */ + +int +TclplatformtestInit( + Tcl_Interp *interp) /* Interpreter to add commands to. */ +{ + /* + * Add commands for platform specific tests on MacOS here. + */ + + Tcl_CreateCommand(interp, "debugger", DebuggerCmd, + (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateCommand(interp, "testWriteTextResource", WriteTextResource, + (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * DebuggerCmd -- + * + * This procedure simply calls the low level debugger. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +DebuggerCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Not used. */ + int argc, /* Not used. */ + char **argv) /* Not used. */ +{ + Debugger(); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * WriteTextResource -- + * + * This procedure will write a text resource out to the + * application or a given file. The format for this command is + * textwriteresource + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +WriteTextResource( + ClientData clientData, /* 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; + char *data = NULL; + int rsrcID = -1, i, protectIt = 0; + short fileRef = -1; + OSErr err; + Handle dataHandle; + Str255 resourceName; + FSSpec fileSpec; + + /* + * Process the arguments. + */ + for (i = 1 ; i < argc ; i++) { + if (!strcmp(argv[i], "-rsrc")) { + rsrcName = argv[i + 1]; + i++; + } else if (!strcmp(argv[i], "-rsrcid")) { + rsrcID = atoi(argv[i + 1]); + i++; + } else if (!strcmp(argv[i], "-file")) { + fileName = argv[i + 1]; + i++; + } else if (!strcmp(argv[i], "-protected")) { + protectIt = 1; + } else { + data = argv[i]; + } + } + + if ((rsrcName == NULL && rsrcID < 0) || + (fileName == NULL) || (data == NULL)) { + errStr = errBad; + goto sourceFmtErr; + } + + /* + * Open the resource file. + */ + err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec); + if (!(err == noErr || err == fnfErr)) { + Tcl_AppendResult(interp, "couldn't validate file name", (char *) NULL); + return TCL_ERROR; + } + + if (err == fnfErr) { + FSpCreateResFile(&fileSpec, 'WIsH', 'rsrc', smSystemScript); + } + fileRef = FSpOpenResFile(&fileSpec, fsRdWrPerm); + if (fileRef == -1) { + Tcl_AppendResult(interp, "couldn't open resource file", (char *) NULL); + return TCL_ERROR; + } + + UseResFile(fileRef); + + /* + * Prepare data needed to create resource. + */ + if (rsrcID < 0) { + rsrcID = UniqueID('TEXT'); + } + + strcpy((char *) resourceName, rsrcName); + c2pstr((char *) resourceName); + + dataHandle = NewHandle(strlen(data) + 1); + HLock(dataHandle); + strcpy(*dataHandle, data); + HUnlock(dataHandle); + + /* + * Add the resource to the file and close it. + */ + AddResource(dataHandle, 'TEXT', rsrcID, resourceName); + + UpdateResFile(fileRef); + if (protectIt) { + SetResAttrs(Get1Resource('TEXT', rsrcID), resProtected); + } + + CloseResFile(fileRef); + return TCL_OK; + + sourceFmtErr: + Tcl_AppendResult(interp, errStr, "error in \"", argv[0], "\"", + (char *) NULL); + return TCL_ERROR; +} + +int +TclMacChmod( + char *path, + int mode) +{ + HParamBlockRec hpb; + OSErr err; + + c2pstr(path); + hpb.fileParam.ioNamePtr = (unsigned char *) path; + hpb.fileParam.ioVRefNum = 0; + hpb.fileParam.ioDirID = 0; + + if (mode & 0200) { + err = PBHRstFLockSync(&hpb); + } else { + err = PBHSetFLockSync(&hpb); + } + p2cstr((unsigned char *) path); + + if (err != noErr) { + errno = TclMacOSErrorToPosixError(err); + return -1; + } + + return 0; +} + |