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 sl@0: #include sl@0: #include sl@0: #include sl@0: #include 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: }