root/tclTest.c

DEFINITIONS

1. cmdEcho
2. deleteProc
3. cmdCreate
4. cmdSleep
5. main

/* 
 * tcl.c --
 *
 *      Test driver for TCL.
 *
 * Copyright 1987 Regents of the University of California
 * All rights reserved.
 * Permission to use, copy, modify, and distribute this
 * software and its documentation for any purpose and without
 * fee is hereby granted, provided that the above copyright
 * notice appear in all copies.  The University of California
 * makes no representations about the suitability of this
 * software for any purpose.  It is provided "as is" without
 * express or implied warranty.
 */

#ifndef lint
static char rcsid[] = "$Header: /sprite/src/lib/tcl/tclTest/RCS/tclTest.c,v 1.6 90/02/09 08:34:14 ouster Exp $ SPRITE (Berkeley)";
#endif /* not lint */

#include <stdio.h>
#ifdef BSD
#include <sys/time.h>
#endif
#include "tcl.h"

Tcl_Interp *interp;

int
cmdEcho(clientData, interp, argc, argv)
    char *clientData;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    int i;

    for (i = 1; ; i++) {
        if (argv[i] == NULL) {
            if (i != argc) {
                echoError:
                sprintf(interp->result,
                    "argument list wasn't properly NULL-terminated in \"%s\" command",
                    argv[0]);
            }
            break;
        }
        if (i >= argc) {
            goto echoError;
        }
        fputs(argv[i], stdout);
        if (i < (argc-1)) {
            printf(" ");
        }
    }
    printf("\n");
    return TCL_OK;
}

void
deleteProc(clientData)
    char *clientData;
{
    printf("Deleting command with clientData \"%s\".\n", clientData);
}

int
cmdCreate(clientData, interp, argc, argv)
    ClientData clientData;              /* Not used. */
    Tcl_Interp *interp;
    int argc;
    int *argv;
{
    int count;
    if (argc != 2) {
        sprintf(interp->result, "wrong # args:  should be \"%.50s count\"",
                argv[0]);
        return TCL_ERROR;
    }
    count = atoi(argv[1]);
    for (; count > 0; count--) {
        Tcl_DeleteInterp(Tcl_CreateInterp());
    }
    return TCL_OK;
}

int
cmdSleep(clientData, interp, argc, argv)
    ClientData clientData;              /* Not used. */
    Tcl_Interp *interp;
    int argc;
    int *argv;
{
    int count;
    if (argc != 2) {
        sprintf(interp->result, "wrong # args:  should be \"%.50s seconds\"",
                argv[0]);
        return TCL_ERROR;
    }
    count = atoi(argv[1]);
    sleep(count);
    return TCL_OK;
}

main()
{
    char cmd[1000], *p;
    register char *p2;
    int c, i, result;

    interp = Tcl_CreateInterp();
    Tcl_CreateCommand(interp, "echo", cmdEcho, (ClientData) "echo",
            deleteProc);
    Tcl_CreateCommand(interp, "create", cmdCreate, (ClientData) "create",
            deleteProc);
    Tcl_CreateCommand(interp, "sleep", cmdSleep, (ClientData) "sleep",
            deleteProc);
    stream_init(interp);

    while (1) {
        clearerr(stdin);
        fputs("% ", stdout);
        fflush(stdout);
        p = cmd;
        while (1) {
            c = getchar();
            if (c == EOF) {
                if (p == cmd) {
                    exit(0);
                }
                goto gotCommand;
            }
            if (c == '\n') {
                register char *p2;
                int parens, brackets, numBytes;

                for (p2 = cmd, parens = 0, brackets = 0; p2 != p; p2++) {
                    switch (*p2) {
                        case '\\':
                            Tcl_Backslash(p2, &numBytes);
                            p2 += numBytes-1;
                            break;
                        case '{':
                            parens++;
                            break;
                        case '}':
                            parens--;
                            break;
                        case '[':
                            brackets++;
                            break;
                        case ']':
                            brackets--;
                            break;
                    }
                }
                if ((parens <= 0) && (brackets <= 0)) {
                    goto gotCommand;
                }
            }
            *p = c;
            p++;
        }
        gotCommand:
        *p = 0;

        result = Tcl_Eval(interp, cmd, 0, &p);
        if (result == TCL_OK) {
            if (*interp->result != 0) {
                printf("%s\n", interp->result);
            }
        } else {
            if (result == TCL_ERROR) {
                printf("Error");
            } else {
                printf("Error %d", result);
            }
            if (*interp->result != 0) {
                printf(": %s\n", interp->result);
            } else {
                printf("\n");
            }
        }
    }
}