Stream I/O routines for TCL
Peter da Silva
peter at ficc.uu.net
Thu Apr 12 05:52:35 AEST 1990
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 at 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 at 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 at ficc.uu.net>.
/ \ 'U`
\_.--._/
v
More information about the Alt.sources
mailing list