tcl/mac/tclMacUnix.c

   1 /*
   2  * tclMacUnix.c --
   3  *
   4  *      This file contains routines to implement several features
   5  *      available to the Unix implementation, but that require
   6  *      extra work to do on a Macintosh.  These include routines
   7  *      Unix Tcl normally hands off to the Unix OS.
   8  *
   9  * Copyright (c) 1993-1994 Lockheed Missle & Space Company, AI Center
  10  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
  11  *
  12  * See the file "license.terms" for information on usage and redistribution
  13  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  14  *
  15  * RCS: @(#) $Id$
  16  */
  17
  18 #include <Files.h>
  19 #include <Strings.h>
  20 #include <TextUtils.h>
  21 #include <Finder.h>
  22 #include <FSpCompat.h>
  23 #include <Aliases.h>
  24 #include <Errors.h>
  25
  26 #include "tclInt.h"
  27 #include "tclMacInt.h"
  28
  29 /*
  30  * The following two Includes are from the More Files package
  31  */
  32 #include "FileCopy.h"
  33 #include "MoreFiles.h"
  34 #include "MoreFilesExtras.h"
  35
  36 /*
  37  * The following may not be defined in some versions of
  38  * MPW header files.
  39  */
  40 #ifndef kIsInvisible
  41 #define kIsInvisible 0x4000
  42 #endif
  43 #ifndef kIsAlias
  44 #define kIsAlias 0x8000
  45 #endif
  46
  47 /*
  48  * Missing error codes
  49  */
  50 #define usageErr                500
  51 #define noSourceErr             501
  52 #define isDirErr                502
  53
  54 \f
  55 /*
  56  *----------------------------------------------------------------------
  57  *
  58  * Tcl_EchoCmd --
  59  *
  60  *    Implements the TCL echo command:
  61  *        echo ?str ...?
  62  *
  63  * Results:
  64  *      Always returns TCL_OK.
  65  *
  66  * Side effects:
  67  *      None.
  68  *
  69  *----------------------------------------------------------------------
  70  */
  71
  72 int
  73 Tcl_EchoCmd(
  74     ClientData dummy,                   /* Not used. */
  75     Tcl_Interp *interp,                 /* Current interpreter. */
  76     int argc,                           /* Number of arguments. */
  77     CONST char **argv)                  /* Argument strings. */
  78 {
  79     Tcl_Channel chan;
  80     int mode, result, i;
  81
  82     chan = Tcl_GetChannel(interp, "stdout", &mode);
  83     if (chan == (Tcl_Channel) NULL) {
  84         return TCL_ERROR;
  85     }
  86     for (i = 1; i < argc; i++) {
  87         result = Tcl_WriteChars(chan, argv[i], -1);
  88         if (result < 0) {
  89             Tcl_AppendResult(interp, "echo: ", Tcl_GetChannelName(chan),
  90                     ": ", Tcl_PosixError(interp), (char *) NULL);
  91             return TCL_ERROR;
  92         }
  93         if (i < (argc - 1)) {
  94             Tcl_WriteChars(chan, " ", -1);
  95         }
  96     }
  97     Tcl_WriteChars(chan, "\n", -1);
  98     return TCL_OK;
  99 }
 100 \f
 101 /*
 102  *----------------------------------------------------------------------
 103  *
 104  * Tcl_LsObjCmd --
 105  *
 106  *      This procedure is invoked to process the "ls" Tcl command.
 107  *      See the user documentation for details on what it does.
 108  *
 109  * Results:
 110  *      A standard Tcl result.
 111  *
 112  * Side effects:
 113  *      See the user documentation.
 114  *
 115  *----------------------------------------------------------------------
 116  */
 117 int
 118 Tcl_LsObjCmd(
 119     ClientData dummy,                   /* Not used. */
 120     Tcl_Interp *interp,                 /* Current interpreter. */
 121     int objc,                           /* Number of arguments. */
 122     Tcl_Obj *CONST objv[])              /* Argument strings. */
 123 {
 124 #define STRING_LENGTH 80
 125 #define CR '\n'
 126     int i, j;
 127     int fieldLength, len = 0, maxLen = 0, perLine;
 128     OSErr err;
 129     CInfoPBRec paramBlock;
 130     HFileInfo *hpb = (HFileInfo *)&paramBlock;
 131     DirInfo *dpb = (DirInfo *)&paramBlock;
 132     char theFile[256];
 133     char theLine[STRING_LENGTH + 2];
 134     int fFlag = false, pFlag = false, aFlag = false, lFlag = false,
 135         cFlag = false, hFlag = false;
 136     char *argv;
 137     Tcl_Obj *newObjv[2], *resultObjPtr;
 138
 139     /*
 140      * Process command flags.  End if argument doesn't start
 141      * with a dash or is a dash by itself.  The remaining arguments
 142      * should be files.
 143      */
 144     for (i = 1; i < objc; i++) {
 145         argv = Tcl_GetString(objv[i]);
 146         if (argv[0] != '-') {
 147             break;
 148         }
 149
 150         if (!strcmp(argv, "-")) {
 151             i++;
 152             break;
 153         }
 154
 155         for (j = 1 ; argv[j] ; ++j) {
 156             switch(argv[j]) {
 157             case 'a':
 158             case 'A':
 159                 aFlag = true;
 160                 break;
 161             case '1':
 162                 cFlag = false;
 163                 break;
 164             case 'C':
 165                 cFlag = true;
 166                 break;
 167             case 'F':
 168                 fFlag = true;
 169                 break;
 170             case 'H':
 171                 hFlag = true;
 172                 break;
 173             case 'p':
 174                 pFlag = true;
 175                 break;
 176             case 'l':
 177                 pFlag = false;
 178                 lFlag = true;
 179                 break;
 180             default:
 181                 Tcl_AppendResult(interp, "error - unknown flag ",
 182                         "usage: ls -apCFHl1 ?files? ", NULL);
 183                 return TCL_ERROR;
 184             }
 185         }
 186     }
 187
 188     objv += i;
 189     objc -= i;
 190
 191     /*
 192      * No file specifications means we search for all files.
 193      * Glob will be doing most of the work.
 194      */
 195      if (!objc) {
 196         objc = 1;
 197         newObjv[0] = Tcl_NewStringObj("*", -1);
 198         newObjv[1] = NULL;
 199         objv = newObjv;
 200     }
 201
 202     if (Tcl_GlobObjCmd(NULL, interp, objc + 1, objv - 1) != TCL_OK) {
 203         Tcl_ResetResult(interp);
 204         return TCL_ERROR;
 205     }
 206
 207     resultObjPtr = Tcl_GetObjResult(interp);
 208     Tcl_IncrRefCount(resultObjPtr);
 209     if (Tcl_ListObjGetElements(interp, resultObjPtr, &objc, (Tcl_Obj ***)&objv) != TCL_OK) {
 210         Tcl_DecrRefCount(resultObjPtr);
 211         return TCL_ERROR;
 212     }
 213
 214     Tcl_ResetResult(interp);
 215
 216     /*
 217      * There are two major methods for listing files: the long
 218      * method and the normal method.
 219      */
 220     if (lFlag) {
 221         char    creator[5], type[5], time[16], date[16];
 222         char    lineTag;
 223         long    size;
 224         unsigned short flags;
 225         Tcl_Obj *objPtr;
 226         char *string;
 227         int length;
 228
 229         /*
 230          * Print the header for long listing.
 231          */
 232         if (hFlag) {
 233             sprintf(theLine, "T %7s %8s %8s %4s %4s %6s %s",
 234                     "Size", "ModTime", "ModDate",
 235                     "CRTR", "TYPE", "Flags", "Name");
 236             Tcl_AppendResult(interp, theLine, "\n", NULL);
 237             Tcl_AppendResult(interp,
 238                     "-------------------------------------------------------------\n",
 239                     NULL);
 240         }
 241
 242         for (i = 0; i < objc; i++) {
 243             strcpy(theFile, Tcl_GetString(objv[i]));
 244
 245             c2pstr(theFile);
 246             hpb->ioCompletion = NULL;
 247             hpb->ioVRefNum = 0;
 248             hpb->ioFDirIndex = 0;
 249             hpb->ioNamePtr = (StringPtr) theFile;
 250             hpb->ioDirID = 0L;
 251             err = PBGetCatInfoSync(&paramBlock);
 252             p2cstr((StringPtr) theFile);
 253
 254             if (hpb->ioFlAttrib & 16) {
 255                 /*
 256                  * For directories use zero as the size, use no Creator
 257                  * type, and use 'DIR ' as the file type.
 258                  */
 259                 if ((aFlag == false) && (dpb->ioDrUsrWds.frFlags & 0x1000)) {
 260                     continue;
 261                 }
 262                 lineTag = 'D';
 263                 size = 0;
 264                 IUTimeString(dpb->ioDrMdDat, false, (unsigned char *)time);
 265                 p2cstr((StringPtr)time);
 266                 IUDateString(dpb->ioDrMdDat, shortDate, (unsigned char *)date);
 267                 p2cstr((StringPtr)date);
 268                 strcpy(creator, "    ");
 269                 strcpy(type, "DIR ");
 270                 flags = dpb->ioDrUsrWds.frFlags;
 271                 if (fFlag || pFlag) {
 272                     strcat(theFile, ":");
 273                 }
 274             } else {
 275                 /*
 276                  * All information for files should be printed.  This
 277                  * includes size, modtime, moddate, creator type, file
 278                  * type, flags, anf file name.
 279                  */
 280                 if ((aFlag == false) &&
 281                         (hpb->ioFlFndrInfo.fdFlags & kIsInvisible)) {
 282                     continue;
 283                 }
 284                 lineTag = 'F';
 285                 size = hpb->ioFlLgLen + hpb->ioFlRLgLen;
 286                 IUTimeString(hpb->ioFlMdDat, false, (unsigned char *)time);
 287                 p2cstr((StringPtr)time);
 288                 IUDateString(hpb->ioFlMdDat, shortDate, (unsigned char *)date);
 289                 p2cstr((StringPtr)date);
 290                 strncpy(creator, (char *) &hpb->ioFlFndrInfo.fdCreator, 4);
 291                 creator[4] = 0;
 292                 strncpy(type, (char *) &hpb->ioFlFndrInfo.fdType, 4);
 293                 type[4] = 0;
 294                 flags = hpb->ioFlFndrInfo.fdFlags;
 295                 if (fFlag) {
 296                     if (hpb->ioFlFndrInfo.fdFlags & kIsAlias) {
 297                         strcat(theFile, "@");
 298                     } else if (hpb->ioFlFndrInfo.fdType == 'APPL') {
 299                         strcat(theFile, "*");
 300                     }
 301                 }
 302             }
 303
 304             sprintf(theLine, "%c %7ld %8s %8s %-4.4s %-4.4s 0x%4.4X %s",
 305                     lineTag, size, time, date, creator, type, flags, theFile);
 306
 307             Tcl_AppendResult(interp, theLine, "\n", NULL);
 308
 309         }
 310
 311         objPtr = Tcl_GetObjResult(interp);
 312         string = Tcl_GetStringFromObj(objPtr, &length);
 313         if ((length > 0) && (string[length - 1] == '\n')) {
 314             Tcl_SetObjLength(objPtr, length - 1);
 315         }
 316     } else {
 317         /*
 318          * Not in long format. We only print files names.  If the
 319          * -C flag is set we need to print in multiple coloumns.
 320          */
 321         int argCount, linePos;
 322         Boolean needNewLine = false;
 323
 324         /*
 325          * Fiend the field length: the length each string printed
 326          * to the terminal will be.
 327          */
 328         if (!cFlag) {
 329             perLine = 1;
 330             fieldLength = STRING_LENGTH;
 331         } else {
 332             for (i = 0; i < objc; i++) {
 333                 argv = Tcl_GetString(objv[i]);
 334                 len = strlen(argv);
 335                 if (len > maxLen) {
 336                     maxLen = len;
 337                 }
 338             }
 339             fieldLength = maxLen + 3;
 340             perLine = STRING_LENGTH / fieldLength;
 341         }
 342
 343         argCount = 0;
 344         linePos = 0;
 345         memset(theLine, ' ', STRING_LENGTH);
 346         while (argCount < objc) {
 347             strcpy(theFile, Tcl_GetString(objv[argCount]));
 348
 349             c2pstr(theFile);
 350             hpb->ioCompletion = NULL;
 351             hpb->ioVRefNum = 0;
 352             hpb->ioFDirIndex = 0;
 353             hpb->ioNamePtr = (StringPtr) theFile;
 354             hpb->ioDirID = 0L;
 355             err = PBGetCatInfoSync(&paramBlock);
 356             p2cstr((StringPtr) theFile);
 357
 358             if (hpb->ioFlAttrib & 16) {
 359                 /*
 360                  * Directory. If -a show hidden files.  If -f or -p
 361                  * denote that this is a directory.
 362                  */
 363                 if ((aFlag == false) && (dpb->ioDrUsrWds.frFlags & 0x1000)) {
 364                     argCount++;
 365                     continue;
 366                 }
 367                 if (fFlag || pFlag) {
 368                     strcat(theFile, ":");
 369                 }
 370             } else {
 371                 /*
 372                  * File: If -a show hidden files, if -f show links
 373                  * (aliases) and executables (APPLs).
 374                  */
 375                 if ((aFlag == false) &&
 376                         (hpb->ioFlFndrInfo.fdFlags & kIsInvisible)) {
 377                     argCount++;
 378                     continue;
 379                 }
 380                 if (fFlag) {
 381                     if (hpb->ioFlFndrInfo.fdFlags & kIsAlias) {
 382                         strcat(theFile, "@");
 383                     } else if (hpb->ioFlFndrInfo.fdType == 'APPL') {
 384                         strcat(theFile, "*");
 385                     }
 386                 }
 387             }
 388
 389             /*
 390              * Print the item, taking into account multi-
 391              * coloum output.
 392              */
 393             strncpy(theLine + (linePos * fieldLength), theFile,
 394                     strlen(theFile));
 395             linePos++;
 396
 397             if (linePos == perLine) {
 398                 theLine[STRING_LENGTH] = '\0';
 399                 if (needNewLine) {
 400                     Tcl_AppendResult(interp, "\n", theLine, NULL);
 401                 } else {
 402                     Tcl_AppendResult(interp, theLine, NULL);
 403                     needNewLine = true;
 404                 }
 405                 linePos = 0;
 406                 memset(theLine, ' ', STRING_LENGTH);
 407             }
 408
 409             argCount++;
 410         }
 411
 412         if (linePos != 0) {
 413             theLine[STRING_LENGTH] = '\0';
 414             if (needNewLine) {
 415                 Tcl_AppendResult(interp, "\n", theLine, NULL);
 416             } else {
 417                 Tcl_AppendResult(interp, theLine, NULL);
 418             }
 419         }
 420     }
 421
 422     Tcl_DecrRefCount(resultObjPtr);
 423
 424     return TCL_OK;
 425 }