Subversion Repositories or1k_old

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