diff options
Diffstat (limited to 'mac/tclMacTest.c')
| -rw-r--r-- | mac/tclMacTest.c | 213 |
1 files changed, 0 insertions, 213 deletions
diff --git a/mac/tclMacTest.c b/mac/tclMacTest.c deleted file mode 100644 index 58154e3..0000000 --- a/mac/tclMacTest.c +++ /dev/null @@ -1,213 +0,0 @@ -/* - * 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. - * - * RCS: @(#) $Id: tclMacTest.c,v 1.6 2002/10/09 11:54:42 das Exp $ - */ - -#define TCL_TEST -#define USE_COMPAT_CONST -#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, CONST char **argv)); -static int WriteTextResource _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST 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. */ - CONST 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. */ - CONST char **argv) /* Argument strings. */ -{ - char *errNum = "wrong # args: "; - char *errBad = "bad argument: "; - char *errStr; - CONST char *fileName = NULL, *rsrcName = NULL; - CONST 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)); - 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; -} |