/* 

  * 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;

 }