661 lines
15 KiB
C
661 lines
15 KiB
C
/*
|
||
* tclMacUnix.c --
|
||
*
|
||
* This file contains routines to implement several features
|
||
* available to the Unix implementation, but that require
|
||
* extra work to do on a Macintosh. These include routines
|
||
* Unix Tcl normally hands off to the Unix OS.
|
||
*
|
||
* Copyright (c) 1993-1994 Lockheed Missle & Space Company, AI Center
|
||
* Copyright (c) 1994-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.
|
||
*
|
||
* SCCS: @(#) tclMacUnix.c 1.55 96/09/14 19:14:17
|
||
*/
|
||
|
||
#include <Files.h>
|
||
#include <Strings.h>
|
||
#include <TextUtils.h>
|
||
#include <Finder.h>
|
||
#include <FSpCompat.h>
|
||
#include <Aliases.h>
|
||
#include <Errors.h>
|
||
|
||
#include "tclInt.h"
|
||
#include "tclMacInt.h"
|
||
|
||
/*
|
||
* The following two Includes are from the More Files package
|
||
*/
|
||
#include "FileCopy.h"
|
||
#include "MoreFiles.h"
|
||
#include "MoreFilesExtras.h"
|
||
|
||
/*
|
||
* The following may not be defined in some versions of
|
||
* MPW header files.
|
||
*/
|
||
#ifndef kIsInvisible
|
||
#define kIsInvisible 0x4000
|
||
#endif
|
||
#ifndef kIsAlias
|
||
#define kIsAlias 0x8000
|
||
#endif
|
||
|
||
/*
|
||
* Missing error codes
|
||
*/
|
||
#define usageErr 500
|
||
#define noSourceErr 501
|
||
#define isDirErr 502
|
||
|
||
/*
|
||
* Static functions in this file.
|
||
*/
|
||
|
||
static int GlobArgs _ANSI_ARGS_((Tcl_Interp *interp,
|
||
int *argc, char ***argv));
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* GlobArgs --
|
||
*
|
||
* The following function was taken from Peter Keleher's Alpha
|
||
* Editor. *argc should only count the end arguments that should
|
||
* be globed. argv should be incremented to point to the first
|
||
* arg to be globed.
|
||
*
|
||
* Results:
|
||
* Returns 'true' if it worked & memory was allocated, else 'false'.
|
||
*
|
||
* Side effects:
|
||
* argv will be alloced, the call will need to release the memory
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
static int
|
||
GlobArgs(
|
||
Tcl_Interp *interp, /* Tcl interpreter. */
|
||
int *argc, /* Number of arguments. */
|
||
char ***argv) /* Argument strings. */
|
||
{
|
||
int res, len;
|
||
char *list;
|
||
|
||
/*
|
||
* Places the globbed args all into 'interp->result' as a list.
|
||
*/
|
||
res = Tcl_GlobCmd(NULL, interp, *argc + 1, *argv - 1);
|
||
if (res != TCL_OK) {
|
||
return false;
|
||
}
|
||
len = strlen(interp->result);
|
||
list = (char *) ckalloc(len + 1);
|
||
strcpy(list, interp->result);
|
||
Tcl_ResetResult(interp);
|
||
|
||
res = Tcl_SplitList(interp, list, argc, argv);
|
||
ckfree((char *) list);
|
||
if (res != TCL_OK) {
|
||
return false;
|
||
}
|
||
return true;
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* Tcl_CpCmd --
|
||
*
|
||
* This procedure is invoked to process the "cp" Tcl command.
|
||
* See the user documentation for the "file copy" command for
|
||
* details on what it does.
|
||
*
|
||
* Results:
|
||
* A standard Tcl result.
|
||
*
|
||
* Side effects:
|
||
* See the user documentation.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
int
|
||
Tcl_CpCmd(
|
||
ClientData dummy, /* Not used. */
|
||
Tcl_Interp *interp, /* Current interpreter. */
|
||
int argc, /* Number of arguments. */
|
||
char **argv) /* Argument strings. */
|
||
{
|
||
return TclFileCopyCmd(interp, argc-1, argv+1);
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* Tcl_EchoCmd --
|
||
*
|
||
* Implements the TCL echo command:
|
||
* echo ?str ...?
|
||
*
|
||
* Results:
|
||
* Always returns TCL_OK.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
int
|
||
Tcl_EchoCmd(
|
||
ClientData dummy, /* Not used. */
|
||
Tcl_Interp *interp, /* Current interpreter. */
|
||
int argc, /* Number of arguments. */
|
||
char **argv) /* Argument strings. */
|
||
{
|
||
Tcl_Channel chan;
|
||
int mode, result, i;
|
||
|
||
chan = Tcl_GetChannel(interp, "stdout", &mode);
|
||
if (chan == (Tcl_Channel) NULL) {
|
||
return TCL_ERROR;
|
||
}
|
||
for (i = 1; i < argc; i++) {
|
||
result = Tcl_Write(chan, argv[i], -1);
|
||
if (result < 0) {
|
||
Tcl_AppendResult(interp, "echo: ", Tcl_GetChannelName(chan),
|
||
": ", Tcl_PosixError(interp), (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
if (i < (argc - 1)) {
|
||
Tcl_Write(chan, " ", -1);
|
||
}
|
||
}
|
||
Tcl_Write(chan, "\n", -1);
|
||
return TCL_OK;
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* Tcl_LsCmd --
|
||
*
|
||
* This procedure is invoked to process the "ls" Tcl command.
|
||
* See the user documentation for details on what it does.
|
||
*
|
||
* Results:
|
||
* A standard Tcl result.
|
||
*
|
||
* Side effects:
|
||
* See the user documentation.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
int
|
||
Tcl_LsCmd(
|
||
ClientData dummy, /* Not used. */
|
||
Tcl_Interp *interp, /* Current interpreter. */
|
||
int argc, /* Number of arguments. */
|
||
char **argv) /* Argument strings. */
|
||
{
|
||
#define STRING_LENGTH 80
|
||
#define CR '\n'
|
||
int i, j;
|
||
int fieldLength, len = 0, maxLen = 0, perLine;
|
||
char **origArgv = argv;
|
||
OSErr err;
|
||
CInfoPBRec paramBlock;
|
||
HFileInfo *hpb = (HFileInfo *)¶mBlock;
|
||
DirInfo *dpb = (DirInfo *)¶mBlock;
|
||
char theFile[256];
|
||
char theLine[STRING_LENGTH + 2];
|
||
int fFlag = false, pFlag = false, aFlag = false, lFlag = false,
|
||
cFlag = false, hFlag = false;
|
||
|
||
/*
|
||
* Process command flags. End if argument doesn't start
|
||
* with a dash or is a dash by itself. The remaining arguments
|
||
* should be files.
|
||
*/
|
||
for (i = 1; i < argc; i++) {
|
||
if (argv[i][0] != '-') {
|
||
break;
|
||
}
|
||
|
||
if (!strcmp(argv[i], "-")) {
|
||
i++;
|
||
break;
|
||
}
|
||
|
||
for (j = 1 ; argv[i][j] ; ++j) {
|
||
switch(argv[i][j]) {
|
||
case 'a':
|
||
case 'A':
|
||
aFlag = true;
|
||
break;
|
||
case '1':
|
||
cFlag = false;
|
||
break;
|
||
case 'C':
|
||
cFlag = true;
|
||
break;
|
||
case 'F':
|
||
fFlag = true;
|
||
break;
|
||
case 'H':
|
||
hFlag = true;
|
||
break;
|
||
case 'p':
|
||
pFlag = true;
|
||
break;
|
||
case 'l':
|
||
pFlag = false;
|
||
lFlag = true;
|
||
break;
|
||
default:
|
||
Tcl_AppendResult(interp, "error - unknown flag ",
|
||
"usage: ls -apCFHl1 ?files? ", NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
}
|
||
}
|
||
|
||
argv += i;
|
||
argc -= i;
|
||
|
||
/*
|
||
* No file specifications means we search for all files.
|
||
* Glob will be doing most of the work.
|
||
*/
|
||
if (!argc) {
|
||
argc = 1;
|
||
argv = origArgv;
|
||
strcpy(argv[0], "*");
|
||
}
|
||
|
||
if (!GlobArgs(interp, &argc, &argv)) {
|
||
Tcl_ResetResult(interp);
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
/*
|
||
* There are two major methods for listing files: the long
|
||
* method and the normal method.
|
||
*/
|
||
if (lFlag) {
|
||
char creator[5], type[5], time[16], date[16];
|
||
char lineTag;
|
||
long size;
|
||
unsigned short flags;
|
||
|
||
/*
|
||
* Print the header for long listing.
|
||
*/
|
||
if (hFlag) {
|
||
sprintf(theLine, "T %7s %8s %8s %4s %4s %6s %s",
|
||
"Size", "ModTime", "ModDate",
|
||
"CRTR", "TYPE", "Flags", "Name");
|
||
Tcl_AppendResult(interp, theLine, "\n", NULL);
|
||
Tcl_AppendResult(interp,
|
||
"-------------------------------------------------------------\n",
|
||
NULL);
|
||
}
|
||
|
||
for (i = 0; i < argc; i++) {
|
||
strcpy(theFile, argv[i]);
|
||
|
||
c2pstr(theFile);
|
||
hpb->ioCompletion = NULL;
|
||
hpb->ioVRefNum = 0;
|
||
hpb->ioFDirIndex = 0;
|
||
hpb->ioNamePtr = (StringPtr) theFile;
|
||
hpb->ioDirID = 0L;
|
||
err = PBGetCatInfoSync(¶mBlock);
|
||
p2cstr((StringPtr) theFile);
|
||
|
||
if (hpb->ioFlAttrib & 16) {
|
||
/*
|
||
* For directories use zero as the size, use no Creator
|
||
* type, and use 'DIR ' as the file type.
|
||
*/
|
||
if ((aFlag == false) && (dpb->ioDrUsrWds.frFlags & 0x1000)) {
|
||
continue;
|
||
}
|
||
lineTag = 'D';
|
||
size = 0;
|
||
IUTimeString(dpb->ioDrMdDat, false, (unsigned char *)time);
|
||
p2cstr((StringPtr)time);
|
||
IUDateString(dpb->ioDrMdDat, shortDate, (unsigned char *)date);
|
||
p2cstr((StringPtr)date);
|
||
strcpy(creator, " ");
|
||
strcpy(type, "DIR ");
|
||
flags = dpb->ioDrUsrWds.frFlags;
|
||
if (fFlag || pFlag) {
|
||
strcat(theFile, ":");
|
||
}
|
||
} else {
|
||
/*
|
||
* All information for files should be printed. This
|
||
* includes size, modtime, moddate, creator type, file
|
||
* type, flags, anf file name.
|
||
*/
|
||
if ((aFlag == false) &&
|
||
(hpb->ioFlFndrInfo.fdFlags & kIsInvisible)) {
|
||
continue;
|
||
}
|
||
lineTag = 'F';
|
||
size = hpb->ioFlLgLen + hpb->ioFlRLgLen;
|
||
IUTimeString(hpb->ioFlMdDat, false, (unsigned char *)time);
|
||
p2cstr((StringPtr)time);
|
||
IUDateString(hpb->ioFlMdDat, shortDate, (unsigned char *)date);
|
||
p2cstr((StringPtr)date);
|
||
strncpy(creator, (char *) &hpb->ioFlFndrInfo.fdCreator, 4);
|
||
creator[4] = 0;
|
||
strncpy(type, (char *) &hpb->ioFlFndrInfo.fdType, 4);
|
||
type[4] = 0;
|
||
flags = hpb->ioFlFndrInfo.fdFlags;
|
||
if (fFlag) {
|
||
if (hpb->ioFlFndrInfo.fdFlags & kIsAlias) {
|
||
strcat(theFile, "@");
|
||
} else if (hpb->ioFlFndrInfo.fdType == 'APPL') {
|
||
strcat(theFile, "*");
|
||
}
|
||
}
|
||
}
|
||
|
||
sprintf(theLine, "%c %7ld %8s %8s %-4.4s %-4.4s 0x%4.4X %s",
|
||
lineTag, size, time, date, creator, type, flags, theFile);
|
||
|
||
Tcl_AppendResult(interp, theLine, "\n", NULL);
|
||
|
||
}
|
||
|
||
if ((interp->result != NULL) && (*(interp->result) != '\0')) {
|
||
int slen = strlen(interp->result);
|
||
if (interp->result[slen - 1] == '\n') {
|
||
interp->result[slen - 1] = '\0';
|
||
}
|
||
}
|
||
} else {
|
||
/*
|
||
* Not in long format. We only print files names. If the
|
||
* -C flag is set we need to print in multiple coloumns.
|
||
*/
|
||
int argCount, linePos;
|
||
Boolean needNewLine = false;
|
||
|
||
/*
|
||
* Fiend the field length: the length each string printed
|
||
* to the terminal will be.
|
||
*/
|
||
if (!cFlag) {
|
||
perLine = 1;
|
||
fieldLength = STRING_LENGTH;
|
||
} else {
|
||
for (i = 0; i < argc; i++) {
|
||
len = strlen(argv[i]);
|
||
if (len > maxLen) {
|
||
maxLen = len;
|
||
}
|
||
}
|
||
fieldLength = maxLen + 3;
|
||
perLine = STRING_LENGTH / fieldLength;
|
||
}
|
||
|
||
argCount = 0;
|
||
linePos = 0;
|
||
memset(theLine, ' ', STRING_LENGTH);
|
||
while (argCount < argc) {
|
||
strcpy(theFile, argv[argCount]);
|
||
|
||
c2pstr(theFile);
|
||
hpb->ioCompletion = NULL;
|
||
hpb->ioVRefNum = 0;
|
||
hpb->ioFDirIndex = 0;
|
||
hpb->ioNamePtr = (StringPtr) theFile;
|
||
hpb->ioDirID = 0L;
|
||
err = PBGetCatInfoSync(¶mBlock);
|
||
p2cstr((StringPtr) theFile);
|
||
|
||
if (hpb->ioFlAttrib & 16) {
|
||
/*
|
||
* Directory. If -a show hidden files. If -f or -p
|
||
* denote that this is a directory.
|
||
*/
|
||
if ((aFlag == false) && (dpb->ioDrUsrWds.frFlags & 0x1000)) {
|
||
argCount++;
|
||
continue;
|
||
}
|
||
if (fFlag || pFlag) {
|
||
strcat(theFile, ":");
|
||
}
|
||
} else {
|
||
/*
|
||
* File: If -a show hidden files, if -f show links
|
||
* (aliases) and executables (APPLs).
|
||
*/
|
||
if ((aFlag == false) &&
|
||
(hpb->ioFlFndrInfo.fdFlags & kIsInvisible)) {
|
||
argCount++;
|
||
continue;
|
||
}
|
||
if (fFlag) {
|
||
if (hpb->ioFlFndrInfo.fdFlags & kIsAlias) {
|
||
strcat(theFile, "@");
|
||
} else if (hpb->ioFlFndrInfo.fdType == 'APPL') {
|
||
strcat(theFile, "*");
|
||
}
|
||
}
|
||
}
|
||
|
||
/*
|
||
* Print the item, taking into account multi-
|
||
* coloum output.
|
||
*/
|
||
strncpy(theLine + (linePos * fieldLength), theFile,
|
||
strlen(theFile));
|
||
linePos++;
|
||
|
||
if (linePos == perLine) {
|
||
theLine[STRING_LENGTH] = '\0';
|
||
if (needNewLine) {
|
||
Tcl_AppendResult(interp, "\n", theLine, NULL);
|
||
} else {
|
||
Tcl_AppendResult(interp, theLine, NULL);
|
||
needNewLine = true;
|
||
}
|
||
linePos = 0;
|
||
memset(theLine, ' ', STRING_LENGTH);
|
||
}
|
||
|
||
argCount++;
|
||
}
|
||
|
||
if (linePos != 0) {
|
||
theLine[STRING_LENGTH] = '\0';
|
||
if (needNewLine) {
|
||
Tcl_AppendResult(interp, "\n", theLine, NULL);
|
||
} else {
|
||
Tcl_AppendResult(interp, theLine, NULL);
|
||
}
|
||
}
|
||
}
|
||
|
||
ckfree((char *) argv);
|
||
|
||
return TCL_OK;
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* Tcl_MkdirCmd --
|
||
*
|
||
* This procedure is invoked to process the "mkdir" Tcl command.
|
||
* See the user documentation for details on what it does.
|
||
*
|
||
* Results:
|
||
* A standard Tcl result.
|
||
*
|
||
* Side effects:
|
||
* See the user documentation.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
int
|
||
Tcl_MkdirCmd (
|
||
ClientData dummy, /* Not used. */
|
||
Tcl_Interp *interp, /* Current interpreter. */
|
||
int argc, /* Number of arguments. */
|
||
char **argv) /* Argument strings. */
|
||
{
|
||
if (argc < 2) {
|
||
Tcl_AppendResult(interp, "wrong # args: should be ", argv[0],
|
||
" path ?path ...?", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
if ((argc > 2) && (!strcmp(argv[1], "-path"))) {
|
||
argv++;
|
||
argc--;
|
||
}
|
||
|
||
return TclFileMakeDirsCmd(interp, argc-1, argv+1);
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* Tcl_MvCmd --
|
||
*
|
||
* This procedure is invoked to process the "cp" Tcl command.
|
||
* See the user documentation for details on what it does.
|
||
*
|
||
* Results:
|
||
* A standard Tcl result.
|
||
*
|
||
* Side effects:
|
||
* See the user documentation.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
int
|
||
Tcl_MvCmd(
|
||
ClientData dummy, /* Not used. */
|
||
Tcl_Interp *interp, /* Current interpreter. */
|
||
int argc, /* Number of arguments. */
|
||
char **argv) /* Argument strings. */
|
||
{
|
||
return TclFileRenameCmd(interp, argc-1, argv+1);
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* Tcl_RmCmd --
|
||
*
|
||
* This procedure is invoked to process the "rm" Tcl command.
|
||
* See the user documentation for details on what it does.
|
||
*
|
||
* Results:
|
||
* A standard Tcl result.
|
||
*
|
||
* Side effects:
|
||
* See the user documentation.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
int
|
||
Tcl_RmCmd(
|
||
ClientData dummy, /* Not used. */
|
||
Tcl_Interp *interp, /* Current interpreter. */
|
||
int argc, /* Number of arguments. */
|
||
char **argv) /* Argument strings. */
|
||
{
|
||
int newArgc, result;
|
||
char **newArgv;
|
||
char *list;
|
||
|
||
if (argc < 2) {
|
||
Tcl_AppendResult(interp, "wrong # args: ", argv[0],
|
||
" ?-force? path ?path ...?", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
if ((argc > 2) && (!strcmp(argv[1], "-nocomplain"))) {
|
||
argv++;
|
||
argc--;
|
||
}
|
||
|
||
if ((argc > 2) && (!strcmp(argv[1], "-force"))) {
|
||
result = Tcl_GlobCmd(NULL, interp, argc + 1, argv - 1);
|
||
if (result != TCL_OK) {
|
||
return result;
|
||
}
|
||
list = (char *) ckalloc(strlen(interp->result) + strlen("-force ") + 1);
|
||
strcpy(list, "-force ");
|
||
strcpy(list + strlen("-force "), interp->result);
|
||
Tcl_ResetResult(interp);
|
||
|
||
result = Tcl_SplitList(interp, list, &newArgc, &newArgv);
|
||
ckfree((char *) list);
|
||
if (result != TCL_OK) {
|
||
return result;
|
||
}
|
||
|
||
result = TclFileDeleteCmd(interp, newArgc, newArgv);
|
||
ckfree((char *) newArgv);
|
||
} else {
|
||
newArgc = argc-1;
|
||
newArgv = argv+1;
|
||
if (!GlobArgs(interp, &newArgc, &newArgv)) {
|
||
return TCL_OK;
|
||
}
|
||
result = TclFileDeleteCmd(interp, newArgc, newArgv);
|
||
ckfree((char *) newArgv);
|
||
}
|
||
|
||
return result;
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* Tcl_RmdirCmd --
|
||
*
|
||
* Implements the Tcl rmdir command:
|
||
*
|
||
* Results:
|
||
* Standard TCL results, may return the UNIX system error message.
|
||
*
|
||
* Side effects:
|
||
* See the user documentation.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
int
|
||
Tcl_RmdirCmd (dummy, interp, argc, argv)
|
||
ClientData dummy; /* Not used. */
|
||
Tcl_Interp *interp; /* Current interpreter. */
|
||
int argc; /* Number of arguments. */
|
||
char **argv; /* Argument strings. */
|
||
{
|
||
if (argc < 2) {
|
||
Tcl_AppendResult(interp, "wrong # args: ", argv[0],
|
||
" ?-force? path ?path ...?", (char *) NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
if ((argc > 2) && (!strcmp(argv[1], "-nocomplain"))) {
|
||
argv++;
|
||
argc--;
|
||
}
|
||
|
||
return TclFileDeleteCmd(interp, argc-1, argv+1);
|
||
}
|