os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/mac/tclMacUnix.c
changeset 0 bde4ae8d615e
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/mac/tclMacUnix.c	Fri Jun 15 03:10:57 2012 +0200
     1.3 @@ -0,0 +1,425 @@
     1.4 +/* 
     1.5 + * tclMacUnix.c --
     1.6 + *
     1.7 + *	This file contains routines to implement several features
     1.8 + *	available to the Unix implementation, but that require
     1.9 + *      extra work to do on a Macintosh.  These include routines
    1.10 + *      Unix Tcl normally hands off to the Unix OS.
    1.11 + *
    1.12 + * Copyright (c) 1993-1994 Lockheed Missle & Space Company, AI Center
    1.13 + * Copyright (c) 1994-1997 Sun Microsystems, Inc.
    1.14 + *
    1.15 + * See the file "license.terms" for information on usage and redistribution
    1.16 + * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    1.17 + *
    1.18 + * RCS: @(#) $Id: tclMacUnix.c,v 1.5 2002/10/09 11:54:45 das Exp $
    1.19 + */
    1.20 +
    1.21 +#include <Files.h>
    1.22 +#include <Strings.h>
    1.23 +#include <TextUtils.h>
    1.24 +#include <Finder.h>
    1.25 +#include <FSpCompat.h>
    1.26 +#include <Aliases.h>
    1.27 +#include <Errors.h>
    1.28 +
    1.29 +#include "tclInt.h"
    1.30 +#include "tclMacInt.h"
    1.31 +
    1.32 +/*
    1.33 + * The following two Includes are from the More Files package
    1.34 + */
    1.35 +#include "FileCopy.h"
    1.36 +#include "MoreFiles.h"
    1.37 +#include "MoreFilesExtras.h"
    1.38 +
    1.39 +/*
    1.40 + * The following may not be defined in some versions of
    1.41 + * MPW header files.
    1.42 + */
    1.43 +#ifndef kIsInvisible
    1.44 +#define kIsInvisible 0x4000
    1.45 +#endif
    1.46 +#ifndef kIsAlias
    1.47 +#define kIsAlias 0x8000
    1.48 +#endif
    1.49 +
    1.50 +/*
    1.51 + * Missing error codes
    1.52 + */
    1.53 +#define usageErr		500
    1.54 +#define noSourceErr		501
    1.55 +#define isDirErr		502
    1.56 +
    1.57 +
    1.58 +/*
    1.59 + *----------------------------------------------------------------------
    1.60 + *
    1.61 + * Tcl_EchoCmd --
    1.62 + *
    1.63 + *    Implements the TCL echo command:
    1.64 + *        echo ?str ...?
    1.65 + *
    1.66 + * Results:
    1.67 + *      Always returns TCL_OK.
    1.68 + *
    1.69 + * Side effects:
    1.70 + *	None.
    1.71 + *
    1.72 + *----------------------------------------------------------------------
    1.73 + */
    1.74 +
    1.75 +int
    1.76 +Tcl_EchoCmd(
    1.77 +    ClientData dummy,			/* Not used. */
    1.78 +    Tcl_Interp *interp,			/* Current interpreter. */
    1.79 +    int argc,				/* Number of arguments. */
    1.80 +    CONST char **argv)			/* Argument strings. */
    1.81 +{
    1.82 +    Tcl_Channel chan;
    1.83 +    int mode, result, i;
    1.84 +
    1.85 +    chan = Tcl_GetChannel(interp, "stdout", &mode);
    1.86 +    if (chan == (Tcl_Channel) NULL) {
    1.87 +        return TCL_ERROR;
    1.88 +    }
    1.89 +    for (i = 1; i < argc; i++) {
    1.90 +	result = Tcl_WriteChars(chan, argv[i], -1);
    1.91 +	if (result < 0) {
    1.92 +	    Tcl_AppendResult(interp, "echo: ", Tcl_GetChannelName(chan),
    1.93 +		    ": ", Tcl_PosixError(interp), (char *) NULL);
    1.94 +	    return TCL_ERROR;
    1.95 +	}
    1.96 +        if (i < (argc - 1)) {
    1.97 +	    Tcl_WriteChars(chan, " ", -1);
    1.98 +	}
    1.99 +    }
   1.100 +    Tcl_WriteChars(chan, "\n", -1);
   1.101 +    return TCL_OK;
   1.102 +}
   1.103 +
   1.104 +/*
   1.105 + *----------------------------------------------------------------------
   1.106 + *
   1.107 + * Tcl_LsObjCmd --
   1.108 + *
   1.109 + *	This procedure is invoked to process the "ls" Tcl command.
   1.110 + *	See the user documentation for details on what it does.
   1.111 + *
   1.112 + * Results:
   1.113 + *	A standard Tcl result.
   1.114 + *
   1.115 + * Side effects:
   1.116 + *	See the user documentation.
   1.117 + *
   1.118 + *----------------------------------------------------------------------
   1.119 + */
   1.120 +int
   1.121 +Tcl_LsObjCmd(
   1.122 +    ClientData dummy,			/* Not used. */
   1.123 +    Tcl_Interp *interp,			/* Current interpreter. */
   1.124 +    int objc,				/* Number of arguments. */
   1.125 +    Tcl_Obj *CONST objv[])		/* Argument strings. */
   1.126 +{
   1.127 +#define STRING_LENGTH 80
   1.128 +#define CR '\n'
   1.129 +    int i, j;
   1.130 +    int fieldLength, len = 0, maxLen = 0, perLine;
   1.131 +    OSErr err;
   1.132 +    CInfoPBRec paramBlock;
   1.133 +    HFileInfo *hpb = (HFileInfo *)&paramBlock;
   1.134 +    DirInfo *dpb = (DirInfo *)&paramBlock;
   1.135 +    char theFile[256];
   1.136 +    char theLine[STRING_LENGTH + 2];
   1.137 +    int fFlag = false, pFlag = false, aFlag = false, lFlag = false,
   1.138 +	cFlag = false, hFlag = false;
   1.139 +    char *argv;
   1.140 +    Tcl_Obj *newObjv[2], *resultObjPtr;
   1.141 +
   1.142 +    /*
   1.143 +     * Process command flags.  End if argument doesn't start
   1.144 +     * with a dash or is a dash by itself.  The remaining arguments
   1.145 +     * should be files.
   1.146 +     */
   1.147 +    for (i = 1; i < objc; i++) {
   1.148 +    	argv = Tcl_GetString(objv[i]);
   1.149 +	if (argv[0] != '-') {
   1.150 +	    break;
   1.151 +	}
   1.152 +		
   1.153 +	if (!strcmp(argv, "-")) {
   1.154 +	    i++;
   1.155 +	    break;
   1.156 +	}
   1.157 +		
   1.158 +	for (j = 1 ; argv[j] ; ++j) {
   1.159 +	    switch(argv[j]) {
   1.160 +	    case 'a':
   1.161 +	    case 'A':
   1.162 +		aFlag = true;
   1.163 +		break;
   1.164 +	    case '1':
   1.165 +		cFlag = false;
   1.166 +		break;
   1.167 +	    case 'C':
   1.168 +		cFlag = true;
   1.169 +		break;
   1.170 +	    case 'F':
   1.171 +		fFlag = true;
   1.172 +		break;
   1.173 +	    case 'H':
   1.174 +		hFlag = true;
   1.175 +		break;
   1.176 +	    case 'p':
   1.177 +		pFlag = true;
   1.178 +		break;
   1.179 +	    case 'l':
   1.180 +		pFlag = false;
   1.181 +		lFlag = true;
   1.182 +		break;
   1.183 +	    default:
   1.184 +		Tcl_AppendResult(interp, "error - unknown flag ",
   1.185 +			"usage: ls -apCFHl1 ?files? ", NULL);
   1.186 +		return TCL_ERROR;
   1.187 +	    }
   1.188 +	}
   1.189 +    }
   1.190 +
   1.191 +    objv += i;
   1.192 +    objc -= i;
   1.193 +
   1.194 +    /*
   1.195 +     * No file specifications means we search for all files.
   1.196 +     * Glob will be doing most of the work.
   1.197 +     */
   1.198 +     if (!objc) {
   1.199 +	objc = 1;
   1.200 +	newObjv[0] = Tcl_NewStringObj("*", -1);
   1.201 +	newObjv[1] = NULL;
   1.202 +	objv = newObjv;
   1.203 +    }
   1.204 +
   1.205 +    if (Tcl_GlobObjCmd(NULL, interp, objc + 1, objv - 1) != TCL_OK) {
   1.206 +    	Tcl_ResetResult(interp);
   1.207 +    	return TCL_ERROR;
   1.208 +    }
   1.209 +
   1.210 +    resultObjPtr = Tcl_GetObjResult(interp);
   1.211 +    Tcl_IncrRefCount(resultObjPtr);
   1.212 +    if (Tcl_ListObjGetElements(interp, resultObjPtr, &objc, (Tcl_Obj ***)&objv) != TCL_OK) {
   1.213 +    	Tcl_DecrRefCount(resultObjPtr);
   1.214 +    	return TCL_ERROR;
   1.215 +    }
   1.216 +
   1.217 +    Tcl_ResetResult(interp);
   1.218 +
   1.219 +    /*
   1.220 +     * There are two major methods for listing files: the long
   1.221 +     * method and the normal method.
   1.222 +     */
   1.223 +    if (lFlag) {
   1.224 +	char	creator[5], type[5], time[16], date[16];
   1.225 +	char	lineTag;
   1.226 +	long	size;
   1.227 +	unsigned short flags;
   1.228 +	Tcl_Obj *objPtr;
   1.229 +	char *string;
   1.230 +	int length;
   1.231 +
   1.232 +	/*
   1.233 +	 * Print the header for long listing.
   1.234 +	 */
   1.235 +	if (hFlag) {
   1.236 +	    sprintf(theLine, "T %7s %8s %8s %4s %4s %6s %s",
   1.237 +		    "Size", "ModTime", "ModDate",
   1.238 +		    "CRTR", "TYPE", "Flags", "Name");
   1.239 +	    Tcl_AppendResult(interp, theLine, "\n", NULL);
   1.240 +	    Tcl_AppendResult(interp,
   1.241 +		    "-------------------------------------------------------------\n",
   1.242 +		    NULL);
   1.243 +	}
   1.244 +		
   1.245 +	for (i = 0; i < objc; i++) {
   1.246 +	    strcpy(theFile, Tcl_GetString(objv[i]));
   1.247 +			
   1.248 +	    c2pstr(theFile);
   1.249 +	    hpb->ioCompletion = NULL;
   1.250 +	    hpb->ioVRefNum = 0;
   1.251 +	    hpb->ioFDirIndex = 0;
   1.252 +	    hpb->ioNamePtr = (StringPtr) theFile;
   1.253 +	    hpb->ioDirID = 0L;
   1.254 +	    err = PBGetCatInfoSync(&paramBlock);
   1.255 +	    p2cstr((StringPtr) theFile);
   1.256 +
   1.257 +	    if (hpb->ioFlAttrib & 16) {
   1.258 +		/*
   1.259 +		 * For directories use zero as the size, use no Creator
   1.260 +		 * type, and use 'DIR ' as the file type.
   1.261 +		 */
   1.262 +		if ((aFlag == false) && (dpb->ioDrUsrWds.frFlags & 0x1000)) {
   1.263 +		    continue;
   1.264 +		}
   1.265 +		lineTag = 'D';
   1.266 +		size = 0;
   1.267 +		IUTimeString(dpb->ioDrMdDat, false, (unsigned char *)time);
   1.268 +		p2cstr((StringPtr)time);
   1.269 +		IUDateString(dpb->ioDrMdDat, shortDate, (unsigned char *)date);
   1.270 +		p2cstr((StringPtr)date);
   1.271 +		strcpy(creator, "    ");
   1.272 +		strcpy(type, "DIR ");
   1.273 +		flags = dpb->ioDrUsrWds.frFlags;
   1.274 +		if (fFlag || pFlag) {
   1.275 +		    strcat(theFile, ":");
   1.276 +		}
   1.277 +	    } else {
   1.278 +		/*
   1.279 +		 * All information for files should be printed.  This
   1.280 +		 * includes size, modtime, moddate, creator type, file
   1.281 +		 * type, flags, anf file name.
   1.282 +		 */
   1.283 +		if ((aFlag == false) &&
   1.284 +			(hpb->ioFlFndrInfo.fdFlags & kIsInvisible)) {
   1.285 +		    continue;
   1.286 +		}
   1.287 +		lineTag = 'F';
   1.288 +		size = hpb->ioFlLgLen + hpb->ioFlRLgLen;
   1.289 +		IUTimeString(hpb->ioFlMdDat, false, (unsigned char *)time);
   1.290 +		p2cstr((StringPtr)time);
   1.291 +		IUDateString(hpb->ioFlMdDat, shortDate, (unsigned char *)date);
   1.292 +		p2cstr((StringPtr)date);
   1.293 +		strncpy(creator, (char *) &hpb->ioFlFndrInfo.fdCreator, 4);
   1.294 +		creator[4] = 0;
   1.295 +		strncpy(type, (char *) &hpb->ioFlFndrInfo.fdType, 4);
   1.296 +		type[4] = 0;
   1.297 +		flags = hpb->ioFlFndrInfo.fdFlags;
   1.298 +		if (fFlag) {
   1.299 +		    if (hpb->ioFlFndrInfo.fdFlags & kIsAlias) {
   1.300 +			strcat(theFile, "@");
   1.301 +		    } else if (hpb->ioFlFndrInfo.fdType == 'APPL') {
   1.302 +			strcat(theFile, "*");
   1.303 +		    }
   1.304 +		}
   1.305 +	    }
   1.306 +			
   1.307 +	    sprintf(theLine, "%c %7ld %8s %8s %-4.4s %-4.4s 0x%4.4X %s",
   1.308 +		    lineTag, size, time, date, creator, type, flags, theFile);
   1.309 +						 
   1.310 +	    Tcl_AppendResult(interp, theLine, "\n", NULL);
   1.311 +	    
   1.312 +	}
   1.313 +		
   1.314 +	objPtr = Tcl_GetObjResult(interp);
   1.315 +	string = Tcl_GetStringFromObj(objPtr, &length);
   1.316 +	if ((length > 0) && (string[length - 1] == '\n')) {
   1.317 +	    Tcl_SetObjLength(objPtr, length - 1);
   1.318 +	}
   1.319 +    } else {
   1.320 +	/*
   1.321 +	 * Not in long format. We only print files names.  If the
   1.322 +	 * -C flag is set we need to print in multiple coloumns.
   1.323 +	 */
   1.324 +	int argCount, linePos;
   1.325 +	Boolean needNewLine = false;
   1.326 +
   1.327 +	/*
   1.328 +	 * Fiend the field length: the length each string printed
   1.329 +	 * to the terminal will be.
   1.330 +	 */
   1.331 +	if (!cFlag) {
   1.332 +	    perLine = 1;
   1.333 +	    fieldLength = STRING_LENGTH;
   1.334 +	} else {
   1.335 +	    for (i = 0; i < objc; i++) {
   1.336 +	    	argv = Tcl_GetString(objv[i]);
   1.337 +		len = strlen(argv);
   1.338 +		if (len > maxLen) {
   1.339 +		    maxLen = len;
   1.340 +		}
   1.341 +	    }
   1.342 +	    fieldLength = maxLen + 3;
   1.343 +	    perLine = STRING_LENGTH / fieldLength;
   1.344 +	}
   1.345 +
   1.346 +	argCount = 0;
   1.347 +	linePos = 0;
   1.348 +	memset(theLine, ' ', STRING_LENGTH);
   1.349 +	while (argCount < objc) {
   1.350 +	    strcpy(theFile, Tcl_GetString(objv[argCount]));
   1.351 +			
   1.352 +	    c2pstr(theFile);
   1.353 +	    hpb->ioCompletion = NULL;
   1.354 +	    hpb->ioVRefNum = 0;
   1.355 +	    hpb->ioFDirIndex = 0;
   1.356 +	    hpb->ioNamePtr = (StringPtr) theFile;
   1.357 +	    hpb->ioDirID = 0L;
   1.358 +	    err = PBGetCatInfoSync(&paramBlock);
   1.359 +	    p2cstr((StringPtr) theFile);
   1.360 +
   1.361 +	    if (hpb->ioFlAttrib & 16) {
   1.362 +		/*
   1.363 +		 * Directory. If -a show hidden files.  If -f or -p
   1.364 +		 * denote that this is a directory.
   1.365 +		 */
   1.366 +		if ((aFlag == false) && (dpb->ioDrUsrWds.frFlags & 0x1000)) {
   1.367 +		    argCount++;
   1.368 +		    continue;
   1.369 +		}
   1.370 +		if (fFlag || pFlag) {
   1.371 +		    strcat(theFile, ":");
   1.372 +		}
   1.373 +	    } else {
   1.374 +		/*
   1.375 +		 * File: If -a show hidden files, if -f show links
   1.376 +		 * (aliases) and executables (APPLs).
   1.377 +		 */
   1.378 +		if ((aFlag == false) &&
   1.379 +			(hpb->ioFlFndrInfo.fdFlags & kIsInvisible)) {
   1.380 +		    argCount++;
   1.381 +		    continue;
   1.382 +		}
   1.383 +		if (fFlag) {
   1.384 +		    if (hpb->ioFlFndrInfo.fdFlags & kIsAlias) {
   1.385 +			strcat(theFile, "@");
   1.386 +		    } else if (hpb->ioFlFndrInfo.fdType == 'APPL') {
   1.387 +			strcat(theFile, "*");
   1.388 +		    }
   1.389 +		}
   1.390 +	    }
   1.391 +
   1.392 +	    /*
   1.393 +	     * Print the item, taking into account multi-
   1.394 +	     * coloum output.
   1.395 +	     */
   1.396 +	    strncpy(theLine + (linePos * fieldLength), theFile,
   1.397 +		    strlen(theFile));
   1.398 +	    linePos++;
   1.399 +			
   1.400 +	    if (linePos == perLine) {
   1.401 +		theLine[STRING_LENGTH] = '\0';
   1.402 +		if (needNewLine) {
   1.403 +		    Tcl_AppendResult(interp, "\n", theLine, NULL);
   1.404 +		} else {
   1.405 +		    Tcl_AppendResult(interp, theLine, NULL);
   1.406 +		    needNewLine = true;
   1.407 +		}
   1.408 +		linePos = 0;
   1.409 +		memset(theLine, ' ', STRING_LENGTH);
   1.410 +	    }
   1.411 +			
   1.412 +	    argCount++;
   1.413 +	}
   1.414 +		
   1.415 +	if (linePos != 0) {
   1.416 +	    theLine[STRING_LENGTH] = '\0';
   1.417 +	    if (needNewLine) {
   1.418 +		Tcl_AppendResult(interp, "\n", theLine, NULL);
   1.419 +	    } else {
   1.420 +		Tcl_AppendResult(interp, theLine, NULL);
   1.421 +	    }
   1.422 +	}
   1.423 +    }
   1.424 +
   1.425 +    Tcl_DecrRefCount(resultObjPtr);
   1.426 +    	
   1.427 +    return TCL_OK;
   1.428 +}