sl@0: /*
sl@0: * tclMacTest.c --
sl@0: *
sl@0: * Contains commands for platform specific tests for
sl@0: * the Macintosh platform.
sl@0: *
sl@0: * Copyright (c) 1996 Sun Microsystems, Inc.
sl@0: *
sl@0: * See the file "license.terms" for information on usage and redistribution
sl@0: * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0: *
sl@0: * RCS: @(#) $Id: tclMacTest.c,v 1.6 2002/10/09 11:54:42 das Exp $
sl@0: */
sl@0:
sl@0: #define TCL_TEST
sl@0: #define USE_COMPAT_CONST
sl@0: #include "tclInt.h"
sl@0: #include "tclMacInt.h"
sl@0: #include "tclMacPort.h"
sl@0: #include "Files.h"
sl@0: #include <Errors.h>
sl@0: #include <Resources.h>
sl@0: #include <Script.h>
sl@0: #include <Strings.h>
sl@0: #include <FSpCompat.h>
sl@0:
sl@0: /*
sl@0: * Forward declarations of procedures defined later in this file:
sl@0: */
sl@0:
sl@0: int TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
sl@0: static int DebuggerCmd _ANSI_ARGS_((ClientData dummy,
sl@0: Tcl_Interp *interp, int argc, CONST char **argv));
sl@0: static int WriteTextResource _ANSI_ARGS_((ClientData dummy,
sl@0: Tcl_Interp *interp, int argc, CONST char **argv));
sl@0:
sl@0:
sl@0: /*
sl@0: *----------------------------------------------------------------------
sl@0: *
sl@0: * TclplatformtestInit --
sl@0: *
sl@0: * Defines commands that test platform specific functionality for
sl@0: * Unix platforms.
sl@0: *
sl@0: * Results:
sl@0: * A standard Tcl result.
sl@0: *
sl@0: * Side effects:
sl@0: * Defines new commands.
sl@0: *
sl@0: *----------------------------------------------------------------------
sl@0: */
sl@0:
sl@0: int
sl@0: TclplatformtestInit(
sl@0: Tcl_Interp *interp) /* Interpreter to add commands to. */
sl@0: {
sl@0: /*
sl@0: * Add commands for platform specific tests on MacOS here.
sl@0: */
sl@0:
sl@0: Tcl_CreateCommand(interp, "debugger", DebuggerCmd,
sl@0: (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
sl@0: Tcl_CreateCommand(interp, "testWriteTextResource", WriteTextResource,
sl@0: (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
sl@0:
sl@0: return TCL_OK;
sl@0: }
sl@0:
sl@0: /*
sl@0: *----------------------------------------------------------------------
sl@0: *
sl@0: * DebuggerCmd --
sl@0: *
sl@0: * This procedure simply calls the low level debugger.
sl@0: *
sl@0: * Results:
sl@0: * A standard Tcl result.
sl@0: *
sl@0: * Side effects:
sl@0: * None.
sl@0: *
sl@0: *----------------------------------------------------------------------
sl@0: */
sl@0:
sl@0: static int
sl@0: DebuggerCmd(
sl@0: ClientData clientData, /* Not used. */
sl@0: Tcl_Interp *interp, /* Not used. */
sl@0: int argc, /* Not used. */
sl@0: CONST char **argv) /* Not used. */
sl@0: {
sl@0: Debugger();
sl@0: return TCL_OK;
sl@0: }
sl@0:
sl@0: /*
sl@0: *----------------------------------------------------------------------
sl@0: *
sl@0: * WriteTextResource --
sl@0: *
sl@0: * This procedure will write a text resource out to the
sl@0: * application or a given file. The format for this command is
sl@0: * textwriteresource
sl@0: *
sl@0: * Results:
sl@0: * A standard Tcl result.
sl@0: *
sl@0: * Side effects:
sl@0: * None.
sl@0: *
sl@0: *----------------------------------------------------------------------
sl@0: */
sl@0:
sl@0: static int
sl@0: WriteTextResource(
sl@0: ClientData clientData, /* Not used. */
sl@0: Tcl_Interp *interp, /* Current interpreter. */
sl@0: int argc, /* Number of arguments. */
sl@0: CONST char **argv) /* Argument strings. */
sl@0: {
sl@0: char *errNum = "wrong # args: ";
sl@0: char *errBad = "bad argument: ";
sl@0: char *errStr;
sl@0: CONST char *fileName = NULL, *rsrcName = NULL;
sl@0: CONST char *data = NULL;
sl@0: int rsrcID = -1, i, protectIt = 0;
sl@0: short fileRef = -1;
sl@0: OSErr err;
sl@0: Handle dataHandle;
sl@0: Str255 resourceName;
sl@0: FSSpec fileSpec;
sl@0:
sl@0: /*
sl@0: * Process the arguments.
sl@0: */
sl@0: for (i = 1 ; i < argc ; i++) {
sl@0: if (!strcmp(argv[i], "-rsrc")) {
sl@0: rsrcName = argv[i + 1];
sl@0: i++;
sl@0: } else if (!strcmp(argv[i], "-rsrcid")) {
sl@0: rsrcID = atoi(argv[i + 1]);
sl@0: i++;
sl@0: } else if (!strcmp(argv[i], "-file")) {
sl@0: fileName = argv[i + 1];
sl@0: i++;
sl@0: } else if (!strcmp(argv[i], "-protected")) {
sl@0: protectIt = 1;
sl@0: } else {
sl@0: data = argv[i];
sl@0: }
sl@0: }
sl@0:
sl@0: if ((rsrcName == NULL && rsrcID < 0) ||
sl@0: (fileName == NULL) || (data == NULL)) {
sl@0: errStr = errBad;
sl@0: goto sourceFmtErr;
sl@0: }
sl@0:
sl@0: /*
sl@0: * Open the resource file.
sl@0: */
sl@0: err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
sl@0: if (!(err == noErr || err == fnfErr)) {
sl@0: Tcl_AppendResult(interp, "couldn't validate file name", (char *) NULL);
sl@0: return TCL_ERROR;
sl@0: }
sl@0:
sl@0: if (err == fnfErr) {
sl@0: FSpCreateResFile(&fileSpec, 'WIsH', 'rsrc', smSystemScript);
sl@0: }
sl@0: fileRef = FSpOpenResFile(&fileSpec, fsRdWrPerm);
sl@0: if (fileRef == -1) {
sl@0: Tcl_AppendResult(interp, "couldn't open resource file", (char *) NULL);
sl@0: return TCL_ERROR;
sl@0: }
sl@0:
sl@0: UseResFile(fileRef);
sl@0:
sl@0: /*
sl@0: * Prepare data needed to create resource.
sl@0: */
sl@0: if (rsrcID < 0) {
sl@0: rsrcID = UniqueID('TEXT');
sl@0: }
sl@0:
sl@0: strcpy((char *) resourceName, rsrcName);
sl@0: c2pstr((char *) resourceName);
sl@0:
sl@0: dataHandle = NewHandle(strlen(data));
sl@0: HLock(dataHandle);
sl@0: strcpy(*dataHandle, data);
sl@0: HUnlock(dataHandle);
sl@0:
sl@0: /*
sl@0: * Add the resource to the file and close it.
sl@0: */
sl@0: AddResource(dataHandle, 'TEXT', rsrcID, resourceName);
sl@0:
sl@0: UpdateResFile(fileRef);
sl@0: if (protectIt) {
sl@0: SetResAttrs(Get1Resource('TEXT', rsrcID), resProtected);
sl@0: }
sl@0:
sl@0: CloseResFile(fileRef);
sl@0: return TCL_OK;
sl@0:
sl@0: sourceFmtErr:
sl@0: Tcl_AppendResult(interp, errStr, "error in \"", argv[0], "\"",
sl@0: (char *) NULL);
sl@0: return TCL_ERROR;
sl@0: }