Logo Search packages:      
Sourcecode: tcl8.0 version File versions  Download package

tclMacTest.c

/* 
 * 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.3 1998/11/10 06:49:51 jingham 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;
}


Generated by  Doxygen 1.6.0   Back to index