peter@ficc.uu.net (Peter da Silva) (04/12/90)
Archive-name: tcl/streams The following routines implement a stream I/O library, allowing you to read and write text files easily from TCL. Because TCL assumes that malloc will abort on failure, these routines call "ckalloc". If you're on a BSD system, just #define ckalloc malloc. Otherwise you probably already have it in tcl.a. The Makefile is the complete System-V TCL Makefile, with the stream-IO routines added. main.c allows you to use "tcl" in scripts, with a similar calling syntax to AWK. cat.tcl is a TCL script that imitates "cat". #! /bin/sh # This is a shell archive. Remove anything before this line, then feed it # into a shell via "sh file" or similar. To overwrite existing files, # type "sh file -c". # The tool that generated this appeared in the comp.sources.unix newsgroup; # send mail to comp-sources-unix@uunet.uu.net if you want that tool. # If this archive is complete, you will see the following message at the end: # "End of shell archive." # Contents: stream.3 stream.5 stream.c stream.h handler.c handler.h # Makefile main.c cat.tcl # Wrapped by peter@ficc.uu.net on Wed Apr 11 14:44:58 1990 PATH=/bin:/usr/bin:/usr/ucb ; export PATH if test -f 'stream.3' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'stream.3'\" else echo shar: Extracting \"'stream.3'\" \(498 characters\) sed "s/^X//" >'stream.3' <<'END_OF_FILE' X.TH STREAM_INIT 3 X.SH NAME Xstream_init \- Initialise stream I/O commands for TCL X.SH SYNOPSIS X.B stream_init X( X.I interp X); X.SH DESCRIPTION X.PP X.B Stream Xis a set of commands that provide access from TCL to stdio routines. See X\fBstream\fR(5) for a description of these routines. To include them Xyou just need to call \fBstream_init\fR, passing it a pointer to your Xinterpreter. It will automatically be cleaned up and all the streams Xclosed when you delete the interpreter. X.SH SEE ALSO XSTREAM(5) END_OF_FILE if test 498 -ne `wc -c <'stream.3'`; then echo shar: \"'stream.3'\" unpacked with wrong size! fi # end of 'stream.3' fi if test -f 'stream.5' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'stream.5'\" else echo shar: Extracting \"'stream.5'\" \(2528 characters\) sed "s/^X//" >'stream.5' <<'END_OF_FILE' X.TH STREAM 5 X.SH NAME Xstream \- Stream I/O commands for TCL X.SH SYNOPSIS X.B set Xhandle [ X.B stream open X.I name mode X] X.br X.B stream close X.I handle X.br X.B stream gets X.I handle X[ X.I var X] X.br X.B stream puts X.I handle line X.br X.B stream eof X.I handle X.br X.B stream tell X.I handle X.br X.B stream seek X.I handle offset X[ X.I whence X] X.br X.B stream error X.I handle X.br X.B stream list X.SH DESCRIPTION X.PP X.B Stream Xis a set of commands that provide access from TCL to stdio routines. They Xuse a token called a "stream handle" to indicate what stream is beaing Xoperated on. The format of the handle is a string, "fileNNN". You create Xa handle with "open", and delete it with "close". X.PP XWhen stream starts up, streams 0, 1, and 2 are Xalready open, and correspond to "stdin", "stdout", and "stderr". X.SH COMMANDS X.IP "\fBstream open\fR name mode" XThis creates a new handle, referring to the named stream. XThe mode should Xbe the same as for fopen (r, w, w+, a, etc...), with the addition that a Xmode containing the letter 'p' opens a pipe and the name given Xis interpreted as a command. XAn error condition exists Xif the named file can not be opened, otherwise Xthe handle is returned to the user. X.IP "\fBstream close\fR handle" XThis closes the handle. It is an error for the handle not to exist on this Xor any of the remaining commands. X.IP "\fBstream gets\fR handle [var]" XThis reads a line from the file, returning it as the result. There is no Xtrailing newline, so you can't distinguish an empty line from eof... use X"stream handle eof" for this purpose, or pass a variable name. If called Xwith a variable Xit will put the resulting line in the named variable Xand the command will return the number of bytes read, 0 on Xeof, or -1 on error. X.IP "\fBstream puts\fR handle line" XThis writes a line to the file, plus a trailing newline. X.IP "\fBstream eof\fR handle" XThis returns 1 if EOF has bean read on this handle, otherwise 0. X.IP "\fBstream tell\fR handle" XThis returns the current offset of this handle, in decimal. X.IP "\fBstream error\fR handle" XIf there is currently an error condition on a handle, this returns Xthe approriate error text in perror-style format. X.IP "\fBstream seek\fR handle offset [whence]" XThis seeks to the named offset. Whence is 0, 1, or 2 (as in fseek), and Xdefaults to 0 if not specified. X.SH SEE ALSO XTCL(1), John Ousterhout. X.SH BUGS X.PP XThe semantics are not quite the same as the STDIO functions, because of Xthe single return value. X.PP XIt is not possible to read more or less than a whole line. END_OF_FILE if test 2528 -ne `wc -c <'stream.5'`; then echo shar: \"'stream.5'\" unpacked with wrong size! fi # end of 'stream.5' fi if test -f 'stream.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'stream.c'\" else echo shar: Extracting \"'stream.c'\" \(9339 characters\) sed "s/^X//" >'stream.c' <<'END_OF_FILE' X/* stream commands for tcl */ X#include <stdio.h> X#include <tcl.h> X#include <errno.h> X#include <ctype.h> X#include "handler.h" X#include "stream.h" X X#define STATIC X Xint streamOpen(), X streamClose(), X streamGets(), X streamPuts(), X streamEof(), X streamName(), X streamErr(), X streamTell(), X streamList(); X streamSeek(); X Xstatic struct subcmd commands[] = { X { streamOpen, "open", 2, 2, "name mode" }, X { streamClose, "close", 1, 1, "handle" }, X { streamGets, "gets", 1, 2, "handle [var]" }, X { streamPuts, "puts", 2, 2, "handle line" }, X { streamEof, "eof", 1, 1, "handle" }, X { streamErr, "error", 1, 1, "handle" }, X { streamName, "name", 1, 1, "handle" }, X { streamTell, "tell", 1, 1, "handle" }, X { streamList, "list", 0, 0, "" }, X { streamSeek, "seek", 2, 3, "handle offset [whence]" }, X}; X Xsave_err(s) Xstruct stream *s; X{ X char *strerror(); X extern int errno; X char *name; X X name = strerror(errno); X if(!name) X return; X X if(s->error) ckfree(s->error); X s->error = 0; X s->error = ckalloc(strlen(name)+1); X strcpy(s->error, name); X} X Xstatic struct { X char *name; X int len; X int type; X} types[] = { X { "file", 4, ST_FILE }, X { "pipe", 4, ST_PIPE } X}; Xint ntypes = sizeof types / sizeof *types; X XSTATIC int get_id(streams, name) Xstruct streams *streams; Xchar *name; X{ X int id; X int t; X X for(t = 0; t < ntypes; t++) X if(strncmp(name, types[t].name, types[t].len) == 0) X break; X if(t >= ntypes) X return -1; X name+=types[t].len; X if(!isdigit(*name)) X return -1; X id = atoi(name); X if(streams->s[id] && streams->s[id]->type == types[t].type) X return id; X return -1; X} X XSTATIC char *get_name(streams, id) Xstruct streams *streams; Xint id; X{ X static char name[32]; X int t; X X if(id < 0) X return 0; X X for(t = 0; t < ntypes; t++) X if(streams->s[id]->type == types[t].type) X break; X if(t >= ntypes) X return 0; X X sprintf(name, "%s%d", types[t].name, id); X X return name; X} X XSTATIC struct stream *get_stream(streams, name) Xstruct streams *streams; Xchar *name; X{ X int id; X struct stream *s; X X id = get_id(streams, name); X if(id >= 0) X return streams->s[id]; X else X return 0; X} X XSTATIC struct stream *add_stream(streams, filename, fp) Xstruct streams *streams; Xchar *filename; XFILE *fp; X{ X int id; X struct stream *s; X X for(id = 0; id < streams->n; id++) X if(!streams->s[id]) X break; X if(id >= MAXSTREAMS) { X extern int errno; X X errno = ENOMEM; X return 0; X } X if(id >= streams->n) X streams->n++; X X s = (struct stream *)ckalloc(sizeof(struct stream) X + (filename ? (strlen(filename)+1) : 0) ); X X if(filename) { X s->filename = (char *)(s+1); X strcpy(s->filename, filename); X } else X s->filename = NULL; X s->id = id; X s->fp = fp; X s->error = NULL; X streams->s[id] = s; X X return s; X} X XSTATIC del_stream(streams, id) Xstruct streams *streams; Xint id; X{ X struct stream *s; X X if(s = streams->s[id]) { X streams->s[id] = 0; X if(s->error) ckfree(s->error); X ckfree(s); X return 1; X } X return 0; X} X Xstream_term(stab) Xstruct cmd_table *stab; X{ X int id; X struct streams *streams = (struct streams *)stab->data; X X for(id = 0; id < streams->n; id++) X if(streams->s[id]) X del_stream(streams, id); X ckfree(streams); X ckfree(stab); X} X Xstream_init(interp) XTcl_Interp *interp; X{ X struct cmd_table *streamTable; X struct streams *streamHead; X X streamTable = (struct cmd_table *) ckalloc(sizeof *streamTable); X streamHead = (struct streams *) ckalloc(sizeof (struct streams)); X streamHead->n = 0; X X streamTable->name = "stream"; X streamTable->data = (ClientData) streamHead; X streamTable->cmdc = sizeof(commands) / sizeof(*commands); X streamTable->cmdv = commands; X X Tcl_CreateCommand(interp, "stream", X cmdHandler, (ClientData) streamTable, stream_term); X add_stream(streamTable->data, (char *)NULL, stdin); X add_stream(streamTable->data, (char *)NULL, stdout); X add_stream(streamTable->data, (char *)NULL, stderr); X} X XSTATIC int streamOpen(interp, streams, argc, argv) XTcl_Interp *interp; Xstruct streams *streams; Xint argc; Xchar **argv; X{ X FILE *fp; X struct stream *s; X int type; X char *ptr, *strchr(); X X if(ptr = strchr(argv[1], 'p')) { X do X ptr[0] = ptr[1]; X while(*ptr++); X fp = popen(argv[0], argv[1]); X type = ST_PIPE; X } else { X fp = fopen(argv[0], argv[1]); X type = ST_FILE; X } X X if(!fp) { X char *strerror(); X extern int errno; X char *s = strerror(errno); X if(s) X sprintf(interp->result, "%s: %s", argv[0], s); X else X Tcl_Return(interp, (char *)NULL, TCL_STATIC); X return TCL_ERROR; X } X X s = add_stream(streams, argv[0], fp); X s->type = type; X if(s) { X if(s->id < 0) X Tcl_Return(interp, (char *)NULL, TCL_STATIC); X else X Tcl_Return(interp, get_name(streams, s->id), TCL_VOLATILE); X return TCL_OK; X } else { X sprintf(interp->result, "%s: Too many open streams", argv[0]); X return TCL_ERROR; X } X} X XSTATIC not_open(interp, name) XTcl_Interp *interp; Xchar *name; X{ X sprintf(interp->result, X "%.50s is not an open stream", name); X} X XSTATIC int streamClose(interp, streams, argc, argv) XTcl_Interp *interp; Xstruct streams *streams; Xint argc; Xchar **argv; X{ X char *handle = (--argc, *argv++); X struct stream *s = get_stream(streams, handle); X X if(!s) { X not_open(interp, handle); X return TCL_ERROR; X } X X if(s->type==ST_PIPE) X pclose(s->fp); X else if(s->type==ST_FILE) X fclose(s->fp); X X del_stream(streams, s->id); X return TCL_OK; X} X XSTATIC int streamGets(interp, streams, argc, argv) XTcl_Interp *interp; Xstruct streams *streams; Xint argc; Xchar **argv; X{ X char *handle = (--argc, *argv++); X struct stream *s = get_stream(streams, handle); X char *buffer = ckalloc(BUFSIZ); X char *ptr, *strchr(); X int len; X X if(!s) { X not_open(interp, handle); X ckfree(buffer); X return TCL_ERROR; X } X X if(fgets(buffer, BUFSIZ, s->fp)) { X len = strlen(buffer); X ptr = strchr(buffer, '\n'); X if(ptr) X *ptr = 0; X if(argc==1) { X sprintf(interp->result, "%d", len); X Tcl_SetVar(interp, argv[0], buffer, 0); X } else X Tcl_Return(interp, buffer, TCL_VOLATILE); X } X else X { X if(argc==1) X Tcl_Return(interp, "0", TCL_STATIC); X else X Tcl_Return(interp, (char *)NULL, TCL_STATIC); X } X ckfree(buffer); X return TCL_OK; X} X XSTATIC int streamPuts(interp, streams, argc, argv) XTcl_Interp *interp; Xstruct streams *streams; Xint argc; Xchar **argv; X{ X char *handle = (--argc, *argv++); X struct stream *s = get_stream(streams, handle); X char buffer[BUFSIZ]; X X if(!s) { X not_open(interp, handle); X return TCL_ERROR; X } X X if(fputs(argv[0], s->fp) == EOF) save_err(s); X if(putc('\n', s->fp) == EOF) save_err(s); X X return TCL_OK; X} X XSTATIC int streamTell(interp, streams, argc, argv) XTcl_Interp *interp; Xstruct streams *streams; Xint argc; Xchar **argv; X{ X char *handle = (--argc, *argv++); X struct stream *s = get_stream(streams, handle); X long offset, ftell(); X X if(!s) { X not_open(interp, handle); X return TCL_ERROR; X } X X sprintf(interp->result, "%ld", offset = ftell(s->fp)); X if(offset == -1) save_err(s); X return TCL_OK; X} X XSTATIC int streamEof(interp, streams, argc, argv) XTcl_Interp *interp; Xstruct streams *streams; Xint argc; Xchar **argv; X{ X char *handle = (--argc, *argv++); X struct stream *s = get_stream(streams, handle); X X if(!s) { X not_open(interp, handle); X return TCL_ERROR; X } X X sprintf(interp->result, "%d", !!feof(s->fp)); X return TCL_OK; X} X XSTATIC int streamErr(interp, streams, argc, argv) XTcl_Interp *interp; Xstruct streams *streams; Xint argc; Xchar **argv; X{ X char *handle = (--argc, *argv++); X struct stream *s = get_stream(streams, handle); X X if(!s) { X not_open(interp, handle); X return TCL_ERROR; X } X X if(ferror(s->fp) && s->error) X Tcl_Return(interp, s->error, TCL_VOLATILE); X else X Tcl_Return(interp, (char *)NULL, TCL_STATIC); X X return TCL_OK; X} X XSTATIC int streamName(interp, streams, argc, argv) XTcl_Interp *interp; Xstruct streams *streams; Xint argc; Xchar **argv; X{ X char *handle = (--argc, *argv++); X struct stream *s = get_stream(streams, handle); X X if(!s) { X not_open(interp, handle); X return TCL_ERROR; X } X X if(s->filename) X Tcl_Return(interp, s->filename, TCL_VOLATILE); X else X Tcl_Return(interp, (char *)NULL, TCL_STATIC); X X return TCL_OK; X} X XSTATIC int streamSeek(interp, streams, argc, argv) XTcl_Interp *interp; Xstruct streams *streams; Xint argc; Xchar **argv; X{ X char *handle = (--argc, *argv++); X struct stream *s = get_stream(streams, handle); X int whence, ret, fseek(); X long offset, fftell(); X long strtol(); X char *endptr; X X if(!s) { X not_open(interp, handle); X return TCL_ERROR; X } X X if(argc > 1) whence = atoi(argv[1]); X else whence = 0; X X offset = strtol(argv[0], &endptr, 0); X X ret = fseek(s->fp, offset, whence); X if(ret==0) offset = ftell(s->fp); X else offset = -1; X sprintf(interp->result, "%ld", offset); X if(offset == -1) save_err(s); X X return TCL_OK; X} X XSTATIC int streamList(interp, streams, argc, argv) XTcl_Interp *interp; Xstruct streams *streams; Xint argc; Xchar **argv; X{ X char buffer[BUFSIZ]; X int id; X struct stream *s; X char *p; X X p = 0; X for(id = 0; id < streams->n; id++) { X if(s = streams->s[id]) { X if(!p) X p = buffer; X else X *p++ = ' '; X if(s->filename) { X char *strchr(); X if(strchr(s->filename, ' ') == NULL) X sprintf(p, "{%s %s}", X get_name(streams, id), X s->filename); X else X sprintf(p, "{%s {%s}}", X get_name(streams, id), X s->filename); X } else X sprintf(p, "%s", get_name(streams, id)); X p += strlen(p); X } X } X Tcl_Return(interp, buffer, TCL_VOLATILE); X return TCL_OK; X} END_OF_FILE if test 9339 -ne `wc -c <'stream.c'`; then echo shar: \"'stream.c'\" unpacked with wrong size! fi # end of 'stream.c' fi if test -f 'stream.h' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'stream.h'\" else echo shar: Extracting \"'stream.h'\" \(202 characters\) sed "s/^X//" >'stream.h' <<'END_OF_FILE' Xstruct stream { X int id; X int type; X char *filename; X char *error; X FILE *fp; X}; X#define MAXSTREAMS _NFILE X#define ST_FILE 0 X#define ST_PIPE 1 Xstruct streams { X int n; X struct stream *s[MAXSTREAMS]; X}; END_OF_FILE if test 202 -ne `wc -c <'stream.h'`; then echo shar: \"'stream.h'\" unpacked with wrong size! fi # end of 'stream.h' fi if test -f 'handler.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'handler.c'\" else echo shar: Extracting \"'handler.c'\" \(964 characters\) sed "s/^X//" >'handler.c' <<'END_OF_FILE' X/* handle standard commands with names for tcl */ X#include <stdio.h> X#include <tcl.h> X#include "handler.h" X XcmdHandler(tab, interp, argc, argv) Xstruct cmd_table *tab; XTcl_Interp *interp; Xint argc; Xchar **argv; X{ X struct subcmd *cmdv = tab->cmdv; X int cmdc = tab->cmdc; X X char *action; X X char *err; X char *name; X char *args; X X err = "wrong # args in"; X action = tab->name; X name = "command"; X args = "args..."; X X if(argc < 2) X goto error; X X argv++; --argc; X action = *argv++; --argc; X X while(cmdc > 0) { X if(strcmp(action, cmdv->name) == 0) { X int result; X X name = cmdv->name; X args = cmdv->args; X if(argc < cmdv->min X || (cmdv->max != -1 && argc > cmdv->max)) X goto error; X result = (*cmdv->func)(interp, tab->data, argc, argv); X return result; X } X cmdv++; X cmdc--; X } X err = "unknown subcommand"; Xerror: X sprintf(interp->result, "%.50s %.50s: should be \"%.50s %.50s %.50s\"", X err, action, tab->name, name, args); X return TCL_ERROR; X} END_OF_FILE if test 964 -ne `wc -c <'handler.c'`; then echo shar: \"'handler.c'\" unpacked with wrong size! fi # end of 'handler.c' fi if test -f 'handler.h' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'handler.h'\" else echo shar: Extracting \"'handler.h'\" \(192 characters\) sed "s/^X//" >'handler.h' <<'END_OF_FILE' Xstruct subcmd { X int (*func)(); X char *name; X int min; X int max; X char *args; X}; Xstruct cmd_table { X char *name; X ClientData data; X int cmdc; X struct subcmd *cmdv; X}; Xextern int cmdHandler(); END_OF_FILE if test 192 -ne `wc -c <'handler.h'`; then echo shar: \"'handler.h'\" unpacked with wrong size! fi # end of 'handler.h' fi if test -f 'Makefile' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'Makefile'\" else echo shar: Extracting \"'Makefile'\" \(1887 characters\) sed "s/^X//" >'Makefile' <<'END_OF_FILE' X# X# This Makefile is for use when distributing Tcl to the outside world. X# It is simplified so that it doesn't include any Sprite-specific stuff. X# XSHELL=/bin/sh X# XMEMCHECK= #-DMEMCHECK X X# X#System V X# X#LIBS = X#RANLIB=: X#VOID= -DVOID=void X#MODEL= X#LFLAGS= X#G=-g X X# X#System III Xenix X# XLIBS = -lx XRANLIB= ranlib XVOID= -DVOID=int XMODEL= -Ml XLFLAGS= -F 8000 XG= X X# X#BSD X# X#LIBS = X#RANLIB= ranlib X#VOID= -DVOID=void X#MODEL= X#LFLAGS= X#G=-g X X# X#HPUX X# X#LIBS = -lBSD X#RANLIB= ranlib X#VOID= -DVOID=void X#MODEL= X#G=-g X XCFLAGS = -I. -DTCL_VERSION=\"2.1\" ${VOID} ${MODEL} ${G} ${MEMCHECK} X XGLOB= X# GLOB=glob.o tclGlob.o X XOBJS = ${GLOB} tclBasic.o tclCmdAH.o tclCmdIZ.o tclExpr.o \ X tclProc.o tclUtil.o X XSTREAMHDRS= stream.h handler.h XSTREAMOBJS= stream.o handler.o X XLIBOBJS = panic.o strerror.o strtol.o strtoul.o l_init.o \ X l_insert.o l_l_insert.o l_remove.o ckalloc.o argv.o X XHDRS=list.h sprite.h stdlib.h string.h tcl.h tclInt.h ckalloc.h \ X $(STREAMHDRS) XCSRCS = glob.c tclBasic.c tclCmdAH.c tclCmdIZ.c tclExpr.c \ X tclGlob.c tclProc.c tclUtil.c XLIBSRCS= ${LIBOBJS:.o=.c} XSTREAMSRCS= ${STREAMOBJS:.o=.c} X Xtcl.a: ${OBJS} ${LIBOBJS} # ${STREAMOBJS} X rm -f tcl.a X ar cr tcl.a ${OBJS} ${LIBOBJS} # ${STREAMOBJS} X ${RANLIB} tcl.a X Xtcl: main.o tcl.a ${STREAMOBJS} X cc ${CFLAGS} ${LFLAGS} main.o ${STREAMOBJS} tcl.a ${LIBS} -o tcl X XtclTest: tclTest.o tcl.a ${STREAMOBJS} X cc ${CFLAGS} ${LFLAGS} tclTest.o ${STREAMOBJS} tcl.a ${LIBS} -o tclTest X Xclean: X rm -f ${OBJS} ${LIBOBJS} tcl.a tclTest.o ${STREAMOBJS} main.o X rm -f Part?? MANIFEST~ tclTest tcl X XALLSOURCE= tclTest.c $(HDRS) $(CSRCS) $(LIBSRCS) $(STREAMSRCS) main.c XALLFILES= Makefile README stream.5 $(ALLSOURCE) X Xtcl.shar: $(ALLFILES) X shar $(ALLFILES) > tcl.shar X XMANIFEST: $(ALLFILES) X sh -c 'if [ -r MANIFEST ] ;\ X then makekit -m ;\ X else makekit -oMANIFEST $(ALLFILES) ;\ X fi' X Xlint: $(ALLSOURCE) X lint -I. $(ALLSOURCE) > tcl.lint 2>&1 END_OF_FILE if test 1887 -ne `wc -c <'Makefile'`; then echo shar: \"'Makefile'\" unpacked with wrong size! fi # end of 'Makefile' fi if test -f 'main.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'main.c'\" else echo shar: Extracting \"'main.c'\" \(3812 characters\) sed "s/^X//" >'main.c' <<'END_OF_FILE' X/* X * Tcl command -- provide a Tcl CLI-command with awk-like command syntax X * X * Copyright 1990 Hackercorp X * Permission to use, copy, modify, and distribute this X * software and its documentation for any purpose and without X * fee is hereby granted, provided that the above copyright X * notice appear in all copies. Hackercorp makes no X * representations about the suitability of this software for X * any purpose. It is provided "as is" without express or X * implied warranty. X */ X X#include <stdio.h> X#include <stdlib.h> X#include <tcl.h> X Xvoid X print_result(fp, returnval, result_text) XFILE *fp; Xint returnval; Xchar *result_text; X{ X if (returnval == TCL_OK) X { X if (result_text && *result_text != 0) X { X fprintf(fp, "%s\n", result_text); X } X } X else X { X fprintf(stderr, "%s: %s\n", X (returnval == TCL_ERROR) ? "Error" : "Bad return code", X result_text); X } X} X Xint X cmdGetEnv(clientData, interp, argc, argv) XClientData clientData; /* Not used. */ XTcl_Interp *interp; Xint argc; Xint *argv; X{ X char *getenv(); X X if (argc != 2) X { X sprintf(interp->result, "wrong # args: should be \"%.50s name\"", X argv[0]); X return TCL_ERROR; X } X Tcl_Return(interp, getenv(argv[1]), TCL_STATIC); X return TCL_OK; X} X Xint X main(argc, argv) Xint argc; Xchar **argv; X{ X Tcl_Interp *interp; X int result; X X interp = Tcl_CreateInterp(); X Tcl_CreateCommand(interp, "getenv", cmdGetEnv, (ClientData) NULL, X (void (*)()) NULL); X stream_init(interp); X X /* X * if no arguments, give the user a Tcl command prompt X * X * if first arg is "-f", the following arg is a file name to do a X * "source" command on (to get Tcl to load the file) X * X * argv is set to be a list of arguments that follow the filename or an X * empty string if there are none X * X * if there arguments but there wasn't a -f, they are evaluated as a X * command by the tcl interpreter X */ X X if (argc == 1) X commandloop(interp, stdin, stdout, 1); X else if ((argc >= 3) && (strcmp(argv[1], "-f") == 0)) X { X FILE *fp; X X if (argc > 3) X { X char *args; X X args = Tcl_Merge(argc - 3, &argv[3]); X Tcl_SetVar(interp, "argv", args, 1); X ckfree(args); X } X X fp = fopen(argv[2], "r"); X if(!fp) { X perror(argv[2]); X } else { X commandloop(interp, fp, stdout, 0); X fclose(fp); X } X } X else X { X if (argc > 2) X { X char *args; X X args = Tcl_Merge(argc - 2, &argv[2]); X Tcl_SetVar(interp, "argv", args, 1); X ckfree(args); X } X X result = Tcl_Eval(interp, argv[1], 0, (char **)NULL); X print_result(stdout, result, interp->result); X } X X Tcl_DeleteInterp(interp); X exit(0); X} X Xcommandloop(interp, in, out, interactive) XTcl_Interp *interp; XFILE *in; XFILE *out; Xint interactive; X{ X char *cmd; X char *p; X register char *p2; X int c, i, result; X X cmd = (char *)ckalloc(32767); X while (1) X { X if (interactive) X { X clearerr(in); X fputs("% ", out); X fflush(out); X } X p = cmd; X while (1) X { X c = getc(in); X if (c == EOF) X { X if (p == cmd) X { X goto endOfFile; X } X goto gotCommand; X } X if (c == '\n') X { X register char *p2; X int parens, brackets, numBytes; X X parens = 0; X brackets = 0; X for (p2 = cmd; p2 < p; p2++) X { X switch (*p2) X { X case '\\': X Tcl_Backslash(p2, &numBytes); X p2 += numBytes - 1; X break; X case '{': X parens++; X break; X case '}': X parens--; X break; X case '[': X brackets++; X break; X case ']': X brackets--; X break; X } X } X if ((parens <= 0) && (brackets <= 0)) X { X goto gotCommand; X } X } X *p = c; X p++; X } XgotCommand: X *p = 0; X X result = Tcl_Eval(interp, cmd, 0, &p); X if (interactive) X print_result(out, result, interp->result); X } XendOfFile: X ckfree(cmd); X} END_OF_FILE if test 3812 -ne `wc -c <'main.c'`; then echo shar: \"'main.c'\" unpacked with wrong size! fi # end of 'main.c' fi if test -f 'cat.tcl' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'cat.tcl'\" else echo shar: Extracting \"'cat.tcl'\" \(124 characters\) sed "s/^X//" >'cat.tcl' <<'END_OF_FILE' Xproc cat args { X foreach file $args { X set f [stream open $file r] X for {} { [stream gets $f line] } {} { X echo $line X } X stream close $f X } X} END_OF_FILE if test 124 -ne `wc -c <'cat.tcl'`; then echo shar: \"'cat.tcl'\" unpacked with wrong size! fi # end of 'cat.tcl' fi echo shar: End of shell archive. exit 0 -- _--_|\ `-_-' Peter da Silva. +1 713 274 5180. <peter@ficc.uu.net>. / \ 'U` \_.--._/ v