OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [mac/] [tclMacUnix.c] - Blame information for rev 1774

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
/*
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-1996 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: tclMacUnix.c,v 1.1.1.1 2002-01-16 10:25:35 markom Exp $
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
/*
55
 * Static functions in this file.
56
 */
57
 
58
static int      GlobArgs _ANSI_ARGS_((Tcl_Interp *interp,
59
                    int *argc, char ***argv));
60
 
61
/*
62
 *----------------------------------------------------------------------
63
 *
64
 * GlobArgs --
65
 *
66
 *      The following function was taken from Peter Keleher's Alpha
67
 *      Editor.  *argc should only count the end arguments that should
68
 *      be globed.  argv should be incremented to point to the first
69
 *      arg to be globed.
70
 *
71
 * Results:
72
 *      Returns 'true' if it worked & memory was allocated, else 'false'.
73
 *
74
 * Side effects:
75
 *      argv will be alloced, the call will need to release the memory
76
 *
77
 *----------------------------------------------------------------------
78
 */
79
 
80
static int
81
GlobArgs(
82
    Tcl_Interp *interp,         /* Tcl interpreter. */
83
    int *argc,                  /* Number of arguments. */
84
    char ***argv)               /* Argument strings. */
85
{
86
    int res, len;
87
    char *list;
88
 
89
    /*
90
     * Places the globbed args all into 'interp->result' as a list.
91
     */
92
    res = Tcl_GlobCmd(NULL, interp, *argc + 1, *argv - 1);
93
    if (res != TCL_OK) {
94
        return false;
95
    }
96
    len = strlen(interp->result);
97
    list = (char *) ckalloc(len + 1);
98
    strcpy(list, interp->result);
99
    Tcl_ResetResult(interp);
100
 
101
    res = Tcl_SplitList(interp, list, argc, argv);
102
    ckfree((char *) list);
103
    if (res != TCL_OK) {
104
        return false;
105
    }
106
    return true;
107
}
108
 
109
/*
110
 *----------------------------------------------------------------------
111
 *
112
 * Tcl_EchoCmd --
113
 *
114
 *    Implements the TCL echo command:
115
 *        echo ?str ...?
116
 *
117
 * Results:
118
 *      Always returns TCL_OK.
119
 *
120
 * Side effects:
121
 *      None.
122
 *
123
 *----------------------------------------------------------------------
124
 */
125
 
126
int
127
Tcl_EchoCmd(
128
    ClientData dummy,                   /* Not used. */
129
    Tcl_Interp *interp,                 /* Current interpreter. */
130
    int argc,                           /* Number of arguments. */
131
    char **argv)                        /* Argument strings. */
132
{
133
    Tcl_Channel chan;
134
    int mode, result, i;
135
 
136
    chan = Tcl_GetChannel(interp, "stdout", &mode);
137
    if (chan == (Tcl_Channel) NULL) {
138
        return TCL_ERROR;
139
    }
140
    for (i = 1; i < argc; i++) {
141
        result = Tcl_Write(chan, argv[i], -1);
142
        if (result < 0) {
143
            Tcl_AppendResult(interp, "echo: ", Tcl_GetChannelName(chan),
144
                    ": ", Tcl_PosixError(interp), (char *) NULL);
145
            return TCL_ERROR;
146
        }
147
        if (i < (argc - 1)) {
148
            Tcl_Write(chan, " ", -1);
149
        }
150
    }
151
    Tcl_Write(chan, "\n", -1);
152
    return TCL_OK;
153
}
154
 
155
/*
156
 *----------------------------------------------------------------------
157
 *
158
 * Tcl_LsCmd --
159
 *
160
 *      This procedure is invoked to process the "ls" Tcl command.
161
 *      See the user documentation for details on what it does.
162
 *
163
 * Results:
164
 *      A standard Tcl result.
165
 *
166
 * Side effects:
167
 *      See the user documentation.
168
 *
169
 *----------------------------------------------------------------------
170
 */
171
int
172
Tcl_LsCmd(
173
    ClientData dummy,                   /* Not used. */
174
    Tcl_Interp *interp,                 /* Current interpreter. */
175
    int argc,                           /* Number of arguments. */
176
    char **argv)                        /* Argument strings. */
177
{
178
#define STRING_LENGTH 80
179
#define CR '\n'
180
    int i, j;
181
    int fieldLength, len = 0, maxLen = 0, perLine;
182
    char **origArgv = argv;
183
    OSErr err;
184
    CInfoPBRec paramBlock;
185
    HFileInfo *hpb = (HFileInfo *)&paramBlock;
186
    DirInfo *dpb = (DirInfo *)&paramBlock;
187
    char theFile[256];
188
    char theLine[STRING_LENGTH + 2];
189
    int fFlag = false, pFlag = false, aFlag = false, lFlag = false,
190
        cFlag = false, hFlag = false;
191
 
192
    /*
193
     * Process command flags.  End if argument doesn't start
194
     * with a dash or is a dash by itself.  The remaining arguments
195
     * should be files.
196
     */
197
    for (i = 1; i < argc; i++) {
198
        if (argv[i][0] != '-') {
199
            break;
200
        }
201
 
202
        if (!strcmp(argv[i], "-")) {
203
            i++;
204
            break;
205
        }
206
 
207
        for (j = 1 ; argv[i][j] ; ++j) {
208
            switch(argv[i][j]) {
209
            case 'a':
210
            case 'A':
211
                aFlag = true;
212
                break;
213
            case '1':
214
                cFlag = false;
215
                break;
216
            case 'C':
217
                cFlag = true;
218
                break;
219
            case 'F':
220
                fFlag = true;
221
                break;
222
            case 'H':
223
                hFlag = true;
224
                break;
225
            case 'p':
226
                pFlag = true;
227
                break;
228
            case 'l':
229
                pFlag = false;
230
                lFlag = true;
231
                break;
232
            default:
233
                Tcl_AppendResult(interp, "error - unknown flag ",
234
                        "usage: ls -apCFHl1 ?files? ", NULL);
235
                return TCL_ERROR;
236
            }
237
        }
238
    }
239
 
240
    argv += i;
241
    argc -= i;
242
 
243
    /*
244
     * No file specifications means we search for all files.
245
     * Glob will be doing most of the work.
246
     */
247
     if (!argc) {
248
        argc = 1;
249
        argv = origArgv;
250
        strcpy(argv[0], "*");
251
    }
252
 
253
    if (!GlobArgs(interp, &argc, &argv)) {
254
        Tcl_ResetResult(interp);
255
        return TCL_ERROR;
256
    }
257
 
258
    /*
259
     * There are two major methods for listing files: the long
260
     * method and the normal method.
261
     */
262
    if (lFlag) {
263
        char    creator[5], type[5], time[16], date[16];
264
        char    lineTag;
265
        long    size;
266
        unsigned short flags;
267
 
268
        /*
269
         * Print the header for long listing.
270
         */
271
        if (hFlag) {
272
            sprintf(theLine, "T %7s %8s %8s %4s %4s %6s %s",
273
                    "Size", "ModTime", "ModDate",
274
                    "CRTR", "TYPE", "Flags", "Name");
275
            Tcl_AppendResult(interp, theLine, "\n", NULL);
276
            Tcl_AppendResult(interp,
277
                    "-------------------------------------------------------------\n",
278
                    NULL);
279
        }
280
 
281
        for (i = 0; i < argc; i++) {
282
            strcpy(theFile, argv[i]);
283
 
284
            c2pstr(theFile);
285
            hpb->ioCompletion = NULL;
286
            hpb->ioVRefNum = 0;
287
            hpb->ioFDirIndex = 0;
288
            hpb->ioNamePtr = (StringPtr) theFile;
289
            hpb->ioDirID = 0L;
290
            err = PBGetCatInfoSync(&paramBlock);
291
            p2cstr((StringPtr) theFile);
292
 
293
            if (hpb->ioFlAttrib & 16) {
294
                /*
295
                 * For directories use zero as the size, use no Creator
296
                 * type, and use 'DIR ' as the file type.
297
                 */
298
                if ((aFlag == false) && (dpb->ioDrUsrWds.frFlags & 0x1000)) {
299
                    continue;
300
                }
301
                lineTag = 'D';
302
                size = 0;
303
                IUTimeString(dpb->ioDrMdDat, false, (unsigned char *)time);
304
                p2cstr((StringPtr)time);
305
                IUDateString(dpb->ioDrMdDat, shortDate, (unsigned char *)date);
306
                p2cstr((StringPtr)date);
307
                strcpy(creator, "    ");
308
                strcpy(type, "DIR ");
309
                flags = dpb->ioDrUsrWds.frFlags;
310
                if (fFlag || pFlag) {
311
                    strcat(theFile, ":");
312
                }
313
            } else {
314
                /*
315
                 * All information for files should be printed.  This
316
                 * includes size, modtime, moddate, creator type, file
317
                 * type, flags, anf file name.
318
                 */
319
                if ((aFlag == false) &&
320
                        (hpb->ioFlFndrInfo.fdFlags & kIsInvisible)) {
321
                    continue;
322
                }
323
                lineTag = 'F';
324
                size = hpb->ioFlLgLen + hpb->ioFlRLgLen;
325
                IUTimeString(hpb->ioFlMdDat, false, (unsigned char *)time);
326
                p2cstr((StringPtr)time);
327
                IUDateString(hpb->ioFlMdDat, shortDate, (unsigned char *)date);
328
                p2cstr((StringPtr)date);
329
                strncpy(creator, (char *) &hpb->ioFlFndrInfo.fdCreator, 4);
330
                creator[4] = 0;
331
                strncpy(type, (char *) &hpb->ioFlFndrInfo.fdType, 4);
332
                type[4] = 0;
333
                flags = hpb->ioFlFndrInfo.fdFlags;
334
                if (fFlag) {
335
                    if (hpb->ioFlFndrInfo.fdFlags & kIsAlias) {
336
                        strcat(theFile, "@");
337
                    } else if (hpb->ioFlFndrInfo.fdType == 'APPL') {
338
                        strcat(theFile, "*");
339
                    }
340
                }
341
            }
342
 
343
            sprintf(theLine, "%c %7ld %8s %8s %-4.4s %-4.4s 0x%4.4X %s",
344
                    lineTag, size, time, date, creator, type, flags, theFile);
345
 
346
            Tcl_AppendResult(interp, theLine, "\n", NULL);
347
 
348
        }
349
 
350
        if ((interp->result != NULL) && (*(interp->result) != '\0')) {
351
            int slen = strlen(interp->result);
352
            if (interp->result[slen - 1] == '\n') {
353
                interp->result[slen - 1] = '\0';
354
            }
355
        }
356
    } else {
357
        /*
358
         * Not in long format. We only print files names.  If the
359
         * -C flag is set we need to print in multiple coloumns.
360
         */
361
        int argCount, linePos;
362
        Boolean needNewLine = false;
363
 
364
        /*
365
         * Fiend the field length: the length each string printed
366
         * to the terminal will be.
367
         */
368
        if (!cFlag) {
369
            perLine = 1;
370
            fieldLength = STRING_LENGTH;
371
        } else {
372
            for (i = 0; i < argc; i++) {
373
                len = strlen(argv[i]);
374
                if (len > maxLen) {
375
                    maxLen = len;
376
                }
377
            }
378
            fieldLength = maxLen + 3;
379
            perLine = STRING_LENGTH / fieldLength;
380
        }
381
 
382
        argCount = 0;
383
        linePos = 0;
384
        memset(theLine, ' ', STRING_LENGTH);
385
        while (argCount < argc) {
386
            strcpy(theFile, argv[argCount]);
387
 
388
            c2pstr(theFile);
389
            hpb->ioCompletion = NULL;
390
            hpb->ioVRefNum = 0;
391
            hpb->ioFDirIndex = 0;
392
            hpb->ioNamePtr = (StringPtr) theFile;
393
            hpb->ioDirID = 0L;
394
            err = PBGetCatInfoSync(&paramBlock);
395
            p2cstr((StringPtr) theFile);
396
 
397
            if (hpb->ioFlAttrib & 16) {
398
                /*
399
                 * Directory. If -a show hidden files.  If -f or -p
400
                 * denote that this is a directory.
401
                 */
402
                if ((aFlag == false) && (dpb->ioDrUsrWds.frFlags & 0x1000)) {
403
                    argCount++;
404
                    continue;
405
                }
406
                if (fFlag || pFlag) {
407
                    strcat(theFile, ":");
408
                }
409
            } else {
410
                /*
411
                 * File: If -a show hidden files, if -f show links
412
                 * (aliases) and executables (APPLs).
413
                 */
414
                if ((aFlag == false) &&
415
                        (hpb->ioFlFndrInfo.fdFlags & kIsInvisible)) {
416
                    argCount++;
417
                    continue;
418
                }
419
                if (fFlag) {
420
                    if (hpb->ioFlFndrInfo.fdFlags & kIsAlias) {
421
                        strcat(theFile, "@");
422
                    } else if (hpb->ioFlFndrInfo.fdType == 'APPL') {
423
                        strcat(theFile, "*");
424
                    }
425
                }
426
            }
427
 
428
            /*
429
             * Print the item, taking into account multi-
430
             * coloum output.
431
             */
432
            strncpy(theLine + (linePos * fieldLength), theFile,
433
                    strlen(theFile));
434
            linePos++;
435
 
436
            if (linePos == perLine) {
437
                theLine[STRING_LENGTH] = '\0';
438
                if (needNewLine) {
439
                    Tcl_AppendResult(interp, "\n", theLine, NULL);
440
                } else {
441
                    Tcl_AppendResult(interp, theLine, NULL);
442
                    needNewLine = true;
443
                }
444
                linePos = 0;
445
                memset(theLine, ' ', STRING_LENGTH);
446
            }
447
 
448
            argCount++;
449
        }
450
 
451
        if (linePos != 0) {
452
            theLine[STRING_LENGTH] = '\0';
453
            if (needNewLine) {
454
                Tcl_AppendResult(interp, "\n", theLine, NULL);
455
            } else {
456
                Tcl_AppendResult(interp, theLine, NULL);
457
            }
458
        }
459
    }
460
 
461
    ckfree((char *) argv);
462
 
463
    return TCL_OK;
464
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.