Subversion Repositories or1k

/*

 * 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.1.1.1 2002-01-16 10:25:35 markom Exp $

 */

#define TCL_TEST

#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, char **argv));

static int              WriteTextResource _ANSI_ARGS_((ClientData dummy,

                            Tcl_Interp *interp, int argc, 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. */

    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. */

    char **argv)                        /* Argument strings. */

{

    char *errNum = "wrong # args: ";

    char *errBad = "bad argument: ";

    char *errStr;

    char *fileName = NULL, *rsrcName = NULL;

    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;

}

int

TclMacChmod(

    char *path,

    int mode)

{

    HParamBlockRec hpb;

    OSErr err;

    c2pstr(path);

    hpb.fileParam.ioNamePtr = (unsigned char *) path;

    hpb.fileParam.ioVRefNum = 0;

    hpb.fileParam.ioDirID = 0;

    if (mode & 0200) {

        err = PBHRstFLockSync(&hpb);

    } else {

        err = PBHSetFLockSync(&hpb);

    }

    p2cstr((unsigned char *) path);

    if (err != noErr) {

        errno = TclMacOSErrorToPosixError(err);

        return -1;

    }

    return 0;

}