/* 

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

}