From: peter@ficc.uu.net (Peter da Silva)
Newsgroups: alt.sources
Subject: TCL for System V (part 02/06)
Summary: Tool Command Language for System V and Xenix/286.
Message-ID: <ND22UTBxds13@ficc.uu.net>
Date: 7 Mar 90 11:26:30 GMT
Sender: peter@ficc.uu.net (Peter da Silva)
Organization: Xenix Support, FICC
Lines: 2102
Posted: Wed Mar  7 12:26:30 1990


Archive-name: tcl/Part02

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of archive 2 (of 6)."
# Contents:  list.h stream.c tclExpr.c tclGlob.c tclInt.h
# Wrapped by peter@ficc.uu.net on Wed Mar  7 05:16:04 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'list.h' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'list.h'\"
else
echo shar: Extracting \"'list.h'\" \(8831 characters\)
sed "s/^X//" >'list.h' <<'END_OF_FILE'
X/*
X * list.h --
X *
X * Structures, macros, and routines exported by the List module.
X *
X * Copyright (C) 1985, 1988 Regents of the University of California
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.  The University of California
X * makes no representations about the suitability of this
X * software for any purpose.  It is provided "as is" without
X * express or implied warranty.
X *
X * rcsid "$Header: /sprite/src/lib/include/RCS/list.h,v 1.3 89/06/23 11:29:49 rab Exp $ SPRITE (Berkeley)"
X */
X
X#ifndef _LIST
X#define _LIST
X
X#ifndef _SPRITE
X#include "sprite.h"
X#endif
X
X/*
X * This module defines the list abstraction, which enables one to link
X * together arbitrary data structures.  Lists are doubly-linked and
X * circular.  A list contains a header followed by its real members, if
X * any.  (An empty list therefore consists of a single element, the
X * header,  whose nextPtr and prevPtr fields point to itself).  To refer
X * to a list as a whole, the user keeps a pointer to the header; that
X * header is initialized by a call to List_Init(), which creates an empty
X * list given a pointer to a List_Links structure (described below).
X * 
X * The links are contained in a two-element structure called List_Links.
X * A list joins List_Links records (that is, each List_Links structure
X * points to other List_Links structures), but if the List_Links is the
X * first field within a larger structure, then the larger structures are
X * effectively linked together as follows:
X * 
X *	      header
X *	  (List_Links)		   first elt.		    second elt.
X *	-----------------	-----------------	----------------- 
X * ..->	|    nextPtr	| ---->	|  List_Links	| ---->	|  List_Links	|----..
X *	| - - - - - - -	|	|		|	|		| 
X * ..--	|    prevPtr	| <----	|		| <----	|		|<---..
X *	-----------------	- ---  ---  ---	-	- ---  ---  ---	-
X *				|    rest of	|	|    rest of	| 
X *				|   structure	|	|   structure	| 
X *				|		|	|		|
X *				|      ...	|	|      ...	| 
X *				-----------------	----------------- 
X * 
X * It is possible to link structures through List_Links fields that are
X * not at the beginning of the larger structure, but it is then necessary
X * to perform pointer arithmetic to find the beginning of the larger
X * structure, given a pointer to some point within it.
X * 
X * A typical structure might be something like:
X * 
X *      typedef struct {
X *                  List_Links links;
X *                  char ch;
X *                  integer flags;
X *      } EditChar;
X *  
X * Before an element is inserted in a list for the first time, it must
X * be initialized by calling the macro List_InitElement().
X */
X 
X
X/*
X * data structure for lists
X */
X
Xtypedef struct List_Links {
X    struct List_Links *prevPtr;
X    struct List_Links *nextPtr;
X} List_Links;
X
X/*
X * procedures
X */
X
Xvoid	List_Init();    /* initialize a header to a list */
Xvoid    List_Insert();  /* insert an element into a list */
Xvoid    List_ListInsert();  /* insert a list into a list */
Xvoid 	List_Remove();  /* remove an element from a list */
Xvoid 	List_Move();    /* move an element elsewhere in a list */
X 
X/*
X * ----------------------------------------------------------------------------
X *
X * List_InitElement --
X *
X *      Initialize a list element.  Must be called before an element is first
X *	inserted into a list.
X *
X * ----------------------------------------------------------------------------
X */
X#define List_InitElement(elementPtr) \
X    (elementPtr)->prevPtr = (List_Links *) NIL; \
X    (elementPtr)->nextPtr = (List_Links *) NIL;
X    
X/*
X * Macros for stepping through or selecting parts of lists
X */
X
X/*
X * ----------------------------------------------------------------------------
X *
X * LIST_FORALL --
X *
X *      Macro to loop through a list and perform an operation on each member.
X *
X *      Usage: LIST_FORALL(headerPtr, itemPtr) {
X *                 / * 
X *                   * operation on itemPtr, which points to successive members
X *                   * of the list
X *                   * 
X *                   * It may be appropriate to first assign
X *                   *          foobarPtr = (Foobar *) itemPtr;
X *                   * to refer to the entire Foobar structure.
X *                   * /
X *             }
X *
X *      Note: itemPtr must be a List_Links pointer variable, and headerPtr
X *      must evaluate to a pointer to a List_Links structure.
X *
X * ----------------------------------------------------------------------------
X */
X
X#define LIST_FORALL(headerPtr, itemPtr) \
X        for (itemPtr = List_First(headerPtr); \
X             !List_IsAtEnd((headerPtr),itemPtr); \
X             itemPtr = List_Next(itemPtr))
X
X/*
X * ----------------------------------------------------------------------------
X *
X * List_IsEmpty --
X *
X *      Macro: Boolean value, TRUE if the given list does not contain any
X *      members.
X *
X *      Usage: if (List_IsEmpty(headerPtr)) ...
X *
X * ----------------------------------------------------------------------------
X */
X
X#define List_IsEmpty(headerPtr) \
X        ((headerPtr) == (headerPtr)->nextPtr)
X
X/*
X * ----------------------------------------------------------------------------
X *
X * List_IsAtEnd --
X *
X *      Macro: Boolean value, TRUE if itemPtr is after the end of headerPtr
X *      (i.e., itemPtr is the header of the list).
X *
X *      Usage: if (List_IsAtEnd(headerPtr, itemPtr)) ...
X *
X * ----------------------------------------------------------------------------
X */
X
X
X#define List_IsAtEnd(headerPtr, itemPtr) \
X        ((itemPtr) == (headerPtr))
X
X 
X/*
X * ----------------------------------------------------------------------------
X *
X * List_First --
X *
X *      Macro to return the first member in a list, which is the header if
X *      the list is empty.
X *
X *      Usage: firstPtr = List_First(headerPtr);
X *
X * ----------------------------------------------------------------------------
X */
X
X#define List_First(headerPtr) ((headerPtr)->nextPtr)
X
X/*
X * ----------------------------------------------------------------------------
X *
X * List_Last --
X *
X *      Macro to return the last member in a list, which is the header if
X *      the list is empty.
X *
X *      Usage: lastPtr = List_Last(headerPtr);
X *
X * ----------------------------------------------------------------------------
X */
X
X#define List_Last(headerPtr) ((headerPtr)->prevPtr)
X
X/*
X * ----------------------------------------------------------------------------
X *
X * List_Prev --
X *
X *      Macro to return the member preceding the given member in its list.
X *      If the given list member is the first element in the list, List_Prev
X *      returns the list header.
X *
X *      Usage: prevPtr = List_Prev(itemPtr);
X *
X * ----------------------------------------------------------------------------
X */
X
X#define List_Prev(itemPtr) ((itemPtr)->prevPtr)
X
X/*
X * ----------------------------------------------------------------------------
X *
X * List_Next --
X *
X *      Macro to return the member following the given member in its list.
X *      If the given list member is the last element in the list, List_Next
X *      returns the list header.
X *
X *      Usage: nextPtr = List_Next(itemPtr);
X *
X * ----------------------------------------------------------------------------
X */
X
X#define List_Next(itemPtr) ((itemPtr)->nextPtr)
X
X 
X/*
X * ----------------------------------------------------------------------------
X *      The List_Insert procedure takes two arguments.  The first argument
X *      is a pointer to the structure to be inserted into a list, and
X *      the second argument is a pointer to the list member after which
X *      the new element is to be inserted.  Macros are used to determine
X *      which existing member will precede the new one.
X *
X *      The List_Move procedure takes a destination argument with the same
X *      semantics as List_Insert.
X *
X *      The following macros define where to insert the new element
X *      in the list:
X *
X *      LIST_AFTER(itemPtr)     --      insert after itemPtr
X *      LIST_BEFORE(itemPtr)    --      insert before itemPtr
X *      LIST_ATFRONT(headerPtr) --      insert at front of list
X *      LIST_ATREAR(headerPtr)  --      insert at end of list
X *
X *      For example, 
X *
X *              List_Insert(itemPtr, LIST_AFTER(otherPtr));
X *
X *      will insert itemPtr following otherPtr in the list containing otherPtr.
X * ----------------------------------------------------------------------------
X */
X
X#define LIST_AFTER(itemPtr) ((List_Links *) itemPtr)
X
X#define LIST_BEFORE(itemPtr) (((List_Links *) itemPtr)->prevPtr)
X
X#define LIST_ATFRONT(headerPtr) ((List_Links *) headerPtr)
X
X#define LIST_ATREAR(headerPtr) (((List_Links *) headerPtr)->prevPtr)
X
X#endif /* _LIST */
END_OF_FILE
if test 8831 -ne `wc -c <'list.h'`; then
    echo shar: \"'list.h'\" unpacked with wrong size!
fi
# end of 'list.h'
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'\" \(6686 characters\)
sed "s/^X//" >'stream.c' <<'END_OF_FILE'
X/* stream commands for tcl */
X#include <stdio.h>
X#include <tcl.h>
X
X#define STATIC
X
Xint streamOpen(),
X    streamClose(),
X    streamGets(),
X    streamPuts(),
X    streamEof(),
X    streamName(),
X    streamErr(),
X    streamTell(),
X    streamSeek();
X
Xstatic struct subcmd {
X	int (*func)();
X	char *name;
X	int min;
X	int max;
X	char *args;
X} commands[] = {
X	{ streamOpen, "open", 2, 2, "name mode" },
X	{ streamClose, "close", 0, 0, "" },
X	{ streamGets, "gets", 0, 0, "" },
X	{ streamPuts, "puts", 1, 1, "line" },
X	{ streamEof, "eof", 0, 0, "" },
X	{ streamErr, "error", 0, 0, "" },
X	{ streamName, "name", 0, 0, "" },
X	{ streamTell, "tell", 0, 0, "" },
X	{ streamSeek, "seek", 1, 2, "offset [whence]" },
X};
X
Xstatic struct stream {
X	struct stream *next;
X	char *name;
X	char *filename;
X	char *error;
X	FILE *fp;
X} *streams = NULL;
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 stream *get_stream(name)
Xchar *name;
X{
X	struct stream *s;
X
X	for(s = streams; s; s = s->next)
X		if(strcmp(name, s->name) == 0)
X			break;
X	return s;
X}
X
XSTATIC struct stream *add_stream(name, filename, fp)
Xchar *name;
Xchar *filename;
XFILE *fp;
X{
X	struct stream *s;
X
X	s = (struct stream *)ckalloc(sizeof(struct stream)
X		+ strlen(name) + 1
X		+ (filename ? (strlen(filename)+1) : 0) );
X
X	s->name = (char *)&s[1];
X	strcpy(s->name, name);
X	if(filename) {
X		s->filename = s->name + strlen(name) + 1;
X		strcpy(s->filename, filename);
X	} else
X		s->filename = NULL;
X	s->fp = fp;
X	s->error = NULL;
X	s->next = streams;
X	streams = s;
X}
X
XSTATIC del_stream(name)
Xchar *name;
X{
X	struct stream *p, *q;
X
X	p = streams;
X	q = NULL;
X	while(p) {
X		if(strcmp(p->name, name) == 0) {
X			if(q)
X				q->next = p->next;
X			else
X				streams = p->next;
X			if(p->error) ckfree(p->error);
X			ckfree(p);
X			return 1;
X		}
X		q = p;
X		p = p->next;
X	}
X	return 0;
X}
X
XSTATIC cmdStream(cmdname, interp, argc, argv)
Xchar *cmdname;
XTcl_Interp *interp;
Xint argc;
Xchar **argv;
X{
X	struct subcmd *cmdv = commands;
X	int cmdc = sizeof commands / sizeof *commands;
X
X	char *handle, *action;
X
X	char *err;
X	char *name;
X	char *args;
X
X	err = "wrong # args in";
X	action = "stream";
X	name = "command";
X	args = "args...";
X
X	if(argc < 3)
X		goto error;
X
X	argv++; --argc;
X	handle = *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, handle, argc, argv);
X			return result;
X		}
X		cmdv++;
X		cmdc--;
X	}
X	err = "unknown subcommand";
Xerror:
X	sprintf(interp->result, "%s %s:  should be \"%.50s handle %s %s\"",
X		err, action, cmdname, name, args);
X	return TCL_ERROR;
X}
X
Xstream_init(interp)
XTcl_Interp *interp;
X{
X	Tcl_CreateCommand(interp, "stream",
X		cmdStream, (ClientData) "stream", NULL);
X	add_stream("stdin", (char *)NULL, stdin);
X	add_stream("stdout", (char *)NULL, stdout);
X	add_stream("stderr", (char *)NULL, stderr);
X}
X
XSTATIC int streamOpen(interp, handle, argc, argv)
XTcl_Interp *interp;
Xchar *handle;
Xint argc;
Xchar **argv;
X{
X	FILE *fp;
X
X	if(!(fp = fopen(argv[0], argv[1]))) {
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	add_stream(handle, argv[0], fp);
X	return TCL_OK;
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, handle, argc, argv)
XTcl_Interp *interp;
Xchar *handle;
Xint argc;
Xchar **argv;
X{
X	struct stream *s = get_stream(handle);
X
X	if(!s) {
X		not_open(interp, handle);
X		return TCL_ERROR;
X	}
X
X	fclose(s->fp);
X	del_stream(handle);
X	return TCL_OK;
X}
X
XSTATIC int streamGets(interp, handle, argc, argv)
XTcl_Interp *interp;
Xchar *handle;
Xint argc;
Xchar **argv;
X{
X	struct stream *s = get_stream(handle);
X	char *buffer = ckalloc(BUFSIZ);
X	char *ptr, *strchr();
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		ptr = strchr(buffer, '\n');
X		if(ptr) 
X			*ptr = 0;
X		Tcl_Return(interp, buffer, TCL_VOLATILE);
X	}
X	else
X	{
X		Tcl_Return(interp, (char *)NULL, TCL_STATIC);
X	}
X	ckfree(buffer);
X	return TCL_OK;
X}
X
XSTATIC int streamPuts(interp, handle, argc, argv)
XTcl_Interp *interp;
Xchar *handle;
Xint argc;
Xchar **argv;
X{
X	struct stream *s = get_stream(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, handle, argc, argv)
XTcl_Interp *interp;
Xchar *handle;
Xint argc;
Xchar **argv;
X{
X	struct stream *s = get_stream(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, handle, argc, argv)
XTcl_Interp *interp;
Xchar *handle;
Xint argc;
Xchar **argv;
X{
X	struct stream *s = get_stream(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, handle, argc, argv)
XTcl_Interp *interp;
Xchar *handle;
Xint argc;
Xchar **argv;
X{
X	struct stream *s = get_stream(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, handle, argc, argv)
XTcl_Interp *interp;
Xchar *handle;
Xint argc;
Xchar **argv;
X{
X	struct stream *s = get_stream(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, handle, argc, argv)
XTcl_Interp *interp;
Xchar *handle;
Xint argc;
Xchar **argv;
X{
X	struct stream *s = get_stream(handle);
X	int whence;
X	long offset, fseek();
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	offset = fseek(s->fp, offset, whence);
X	sprintf(interp->result, "%ld", offset);
X	if(offset == -1) save_err(s);
X
X	return TCL_OK;
X}
END_OF_FILE
if test 6686 -ne `wc -c <'stream.c'`; then
    echo shar: \"'stream.c'\" unpacked with wrong size!
fi
# end of 'stream.c'
fi
if test -f 'tclExpr.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'tclExpr.c'\"
else
echo shar: Extracting \"'tclExpr.c'\" \(16599 characters\)
sed "s/^X//" >'tclExpr.c' <<'END_OF_FILE'
X/* 
X * tclExpr.c --
X *
X *	This file contains the code to evaluate expressions for
X *	Tcl.
X *
X * Copyright 1987 Regents of the University of California
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.  The University of California
X * makes no representations about the suitability of this
X * software for any purpose.  It is provided "as is" without
X * express or implied warranty.
X */
X
X#ifndef lint
Xstatic char rcsid[] = "$Header: /sprite/src/lib/tcl/RCS/tclExpr.c,v 1.11 90/01/27 14:44:32 ouster Exp $ SPRITE (Berkeley)";
X#endif /* not lint */
X
X#include <stdio.h>
X#include <ctype.h>
X#include "tcl.h"
X#include "tclInt.h"
X
X/*
X * The data structure below describes the state of parsing an expression.
X * It's passed among the routines in this module.
X */
X
Xtypedef struct {
X    Tcl_Interp *interp;		/* Intepreter to use for command execution
X				 * and variable lookup. */
X    char *originalExpr;		/* The entire expression, as originally
X				 * passed to Tcl_Expr. */
X    char *expr;			/* Position to the next character to be
X				 * scanned from the expression string. */
X    int token;			/* Type of the last token to be parsed from
X				 * expr.  See below for definitions.
X				 * Corresponds to the characters just
X				 * before expr. */
X    int number;			/* If token is NUMBER, gives value of
X				 * the number. */
X} ExprInfo;
X
X/*
X * The token types are defined below.  In addition, there is a table
X * associating a precedence with each operator.  The order of types
X * is important.  Consult the code before changing it.
X */
X
X#define NUMBER		0
X#define OPEN_PAREN	1
X#define CLOSE_PAREN	2
X#define END		3
X#define UNKNOWN		4
X
X/*
X * Binary operators:
X */
X
X#define MULT		8
X#define DIVIDE		9
X#define MOD		10
X#define PLUS		11
X#define MINUS		12
X#define LEFT_SHIFT	13
X#define RIGHT_SHIFT	14
X#define LESS		15
X#define GREATER		16
X#define LEQ		17
X#define GEQ		18
X#define EQUAL		19
X#define NEQ		20
X#define BIT_AND		21
X#define BIT_XOR		22
X#define BIT_OR		23
X#define AND		24
X#define OR		25
X
X/*
X * Unary operators:
X */
X
X#define	UNARY_MINUS	26
X#define NOT		27
X#define BIT_NOT		28
X
X/*
X * Precedence table.  The values for non-operator token types are ignored.
X */
X
Xint precTable[] = {
X    0, 0, 0, 0, 0, 0, 0, 0,
X    10, 10, 10,				/* MULT, DIVIDE, MOD */
X    9, 9,				/* PLUS, MINUS */
X    8, 8,				/* LEFT_SHIFT, RIGHT_SHIFT */
X    7, 7, 7, 7,				/* LESS, GREATER, LEQ, GEQ */
X    6, 6,				/* EQUAL, NEQ */
X    5,					/* BIT_AND */
X    4,					/* BIT_XOR */
X    3,					/* BIT_OR */
X    2,					/* AND */
X    1,					/* OR */
X    11, 11, 11				/* UNARY_MINUS, NOT, BIT_NOT */
X};
X 
X/*
X *----------------------------------------------------------------------
X *
X * ExprGetNum --
X *
X *	Parse off a number from a string.
X *
X * Results:
X *	The return value is the integer value corresponding to the
X *	leading digits of string.  If termPtr isn't NULL, *termPtr
X *	is filled in with the address of the character after the
X *	last one that is part of the number.
X *
X * Side effects:
X *	None.
X *
X *----------------------------------------------------------------------
X */
X
Xint
XExprGetNum(string, termPtr)
X    register char *string;		/* ASCII representation of number.
X					 * If leading digit is "0" then read
X					 * in base 8;  if "0x", then read in
X					 * base 16. */
X    register char **termPtr;		/* If non-NULL, fill in with address
X					 * of terminating character. */
X{
X    int result, sign;
X    register char c;
X
X    c = *string;
X    result = 0;
X    if (c == '-') {
X	sign = -1;
X	string++; c = *string;
X    } else {
X	sign = 1;
X    }
X    if (c == '0') {
X	string++; c = *string;
X	if (c == 'x') {
X	    while (1) {
X		string++; c = *string;
X		if ((c >= '0') && (c <= '9')) {
X		    result = (result << 4) + (c - '0');
X		} else if ((c >= 'a') && (c <= 'f')) {
X		    result = (result << 4) + 10 + (c - 'a');
X		} else if ((c >= 'A') && (c <= 'F')) {
X		    result = (result << 4) + 10 + (c - 'A');
X		} else {
X		    break;
X		}
X	    }
X	} else {
X	    while ((c >= '0') && (c <= '7')) {
X		result = (result << 3) + (c - '0');
X		string++;  c = *string;
X	    }
X	}
X    } else {
X	while ((c >= '0') && (c <= '9')) {
X	    result = (result*10) + (c - '0');
X	    string++;  c = *string;
X	}
X    }
X    if (termPtr != NULL) {
X	*termPtr = string;
X    }
X    return result*sign;
X}
X 
X/*
X *----------------------------------------------------------------------
X *
X * ExprLex --
X *
X *	Lexical analyzer for expression parser.
X *
X * Results:
X *	TCL_OK is returned unless an error occurred while doing lexical
X *	analysis or executing an embedded command.  In that case a
X *	standard Tcl error is returned, using interp->result to hold
X *	an error message.  In the event of a successful return, the token
X *	and (possibly) number fields in infoPtr are updated to refer to
X *	the next symbol in the expression string, and the expr field is
X *	advanced.
X *
X * Side effects:
X *	None.
X *
X *----------------------------------------------------------------------
X */
X
Xint
XExprLex(interp, infoPtr)
X    Tcl_Interp *interp;			/* Interpreter to use for error
X					 * reporting. */
X    register ExprInfo *infoPtr;		/* Describes the state of the parse. */
X{
X    register char *p, c;
X    char *var, *term;
X    int result;
X
X    /*
X     * The next token is either:
X     * (a)	a variable name (indicated by a $ sign plus a variable
X     *		name in the standard Tcl fashion);  lookup the value
X     *		of the variable and return its numeric equivalent as a
X     *		number.
X     * (b)	an embedded command (anything between '[' and ']').
X     *		Execute the command and convert its result to a number.
X     * (c)	a series of decimal digits.  Convert it to a number.
X     * (d)	space:  skip it.
X     * (d)	an operator.  See what kind it is.
X     */
X
X    p = infoPtr->expr;
X    c = *p;
X    while (isspace(c)) {
X	p++;  c = *p;
X    }
X    infoPtr->expr = p+1;
X    if (!isascii(c)) {
X	infoPtr->token = UNKNOWN;
X	return TCL_OK;
X    }
X    switch (c) {
X	case '0':
X	case '1':
X	case '2':
X	case '3':
X	case '4':
X	case '5':
X	case '6':
X	case '7':
X	case '8':
X	case '9':
X	    infoPtr->token = NUMBER;
X	    infoPtr->number = ExprGetNum(p, &infoPtr->expr);
X	    return TCL_OK;
X
X	case '$':
X	    infoPtr->token = NUMBER;
X	    var = Tcl_ParseVar(infoPtr->interp, p, &infoPtr->expr);
X	    if (var == '\0') {
X		return TCL_ERROR;
X	    }
X	    if (((Interp *) infoPtr->interp)->noEval) {
X		infoPtr->number = 0;
X		return TCL_OK;
X	    }
X	    infoPtr->number = ExprGetNum(var, &term);
X	    if ((term == var) || (*term != 0)) {
X		c = *infoPtr->expr;
X		*infoPtr->expr = 0;
X		Tcl_Return(interp, (char *) NULL, TCL_STATIC);
X		sprintf(interp->result,
X			"variable \"%.50s\" contained non-numeric value \"%.50s\"",
X			p, var);
X		*infoPtr->expr = c;
X		return TCL_ERROR;
X	    }
X	    return TCL_OK;
X
X	case '[':
X	    infoPtr->token = NUMBER;
X	    result = Tcl_Eval(infoPtr->interp, p+1, TCL_BRACKET_TERM,
X		    &infoPtr->expr);
X	    if (result != TCL_OK) {
X		return result;
X	    }
X	    infoPtr->expr++;
X	    if (((Interp *) infoPtr->interp)->noEval) {
X		infoPtr->number = 0;
X		Tcl_Return(interp, (char *) NULL, TCL_STATIC);
X		return TCL_OK;
X	    }
X	    infoPtr->number = ExprGetNum(interp->result, &term);
X	    if ((term == interp->result) || (*term != 0)) {
X		char string[200];
X		infoPtr->expr[-1];
X		infoPtr->expr[-1] = 0;
X		sprintf(string, "command \"%.50s\" returned non-numeric result \"%.50s\"",
X			p+1, interp->result);
X		infoPtr->expr[-1] = c;
X		Tcl_Return(interp, string, TCL_VOLATILE);
X		return TCL_ERROR;
X	    }
X	    Tcl_Return(interp, (char *) NULL, TCL_STATIC);
X	    return TCL_OK;
X
X	case '(':
X	    infoPtr->token = OPEN_PAREN;
X	    return TCL_OK;
X
X	case ')':
X	    infoPtr->token = CLOSE_PAREN;
X	    return TCL_OK;
X
X	case '*':
X	    infoPtr->token = MULT;
X	    return TCL_OK;
X
X	case '/':
X	    infoPtr->token = DIVIDE;
X	    return TCL_OK;
X
X	case '%':
X	    infoPtr->token = MOD;
X	    return TCL_OK;
X
X	case '+':
X	    infoPtr->token = PLUS;
X	    return TCL_OK;
X
X	case '-':
X	    infoPtr->token = MINUS;
X	    return TCL_OK;
X
X	case '<':
X	    switch (p[1]) {
X		case '<':
X		    infoPtr->expr = p+2;
X		    infoPtr->token = LEFT_SHIFT;
X		    break;
X		case '=':
X		    infoPtr->expr = p+2;
X		    infoPtr->token = LEQ;
X		    break;
X		default:
X		    infoPtr->token = LESS;
X		    break;
X	    }
X	    return TCL_OK;
X
X	case '>':
X	    switch (p[1]) {
X		case '>':
X		    infoPtr->expr = p+2;
X		    infoPtr->token = RIGHT_SHIFT;
X		    break;
X		case '=':
X		    infoPtr->expr = p+2;
X		    infoPtr->token = GEQ;
X		    break;
X		default:
X		    infoPtr->token = GREATER;
X		    break;
X	    }
X	    return TCL_OK;
X
X	case '=':
X	    if (p[1] == '=') {
X		infoPtr->expr = p+2;
X		infoPtr->token = EQUAL;
X	    } else {
X		infoPtr->token = UNKNOWN;
X	    }
X	    return TCL_OK;
X
X	case '!':
X	    if (p[1] == '=') {
X		infoPtr->expr = p+2;
X		infoPtr->token = NEQ;
X	    } else {
X		infoPtr->token = NOT;
X	    }
X	    return TCL_OK;
X
X	case '&':
X	    if (p[1] == '&') {
X		infoPtr->expr = p+2;
X		infoPtr->token = AND;
X	    } else {
X		infoPtr->token = BIT_AND;
X	    }
X	    return TCL_OK;
X
X	case '^':
X	    infoPtr->token = BIT_XOR;
X	    return TCL_OK;
X
X	case '|':
X	    if (p[1] == '|') {
X		infoPtr->expr = p+2;
X		infoPtr->token = OR;
X	    } else {
X		infoPtr->token = BIT_OR;
X	    }
X	    return TCL_OK;
X
X	case '~':
X	    infoPtr->token = BIT_NOT;
X	    return TCL_OK;
X
X	case 0:
X	    infoPtr->token = END;
X	    infoPtr->expr = p;
X	    return TCL_OK;
X
X	default:
X	    infoPtr->expr = p+1;
X	    infoPtr->token = UNKNOWN;
X	    return TCL_OK;
X    }
X}
X 
X/*
X *----------------------------------------------------------------------
X *
X * ExprGetValue --
X *
X *	Parse a "value" from the remainder of the expression in infoPtr.
X *
X * Results:
X *	Normally TCL_OK is returned.  The value of the parsed number is
X *	returned in infoPtr->number.  If an error occurred, then
X *	interp->result contains an error message and TCL_ERROR is returned.
X *
X * Side effects:
X *	Information gets parsed from the remaining expression, and the
X *	expr and token fields in infoPtr get updated.  Information is
X *	parsed until either the end of the expression is reached (null
X *	character or close paren), an error occurs, or a binary operator
X *	is encountered with precedence <= prec.  In any of these cases,
X *	infoPtr->token will be left pointing to the token AFTER the
X *	expression.
X *
X *----------------------------------------------------------------------
X */
X
Xint
XExprGetValue(interp, infoPtr, prec)
X    Tcl_Interp *interp;			/* Interpreter to use for error
X					 * reporting. */
X    register ExprInfo *infoPtr;		/* Describes the state of the parse
X					 * just before the value (i.e. ExprLex
X					 * will be called to get first token
X					 * of value). */
X    int prec;				/* Treat any un-parenthesized operator
X					 * with precedence <= this as the end
X					 * of the expression. */
X{
X    Interp *iPtr = (Interp *) interp;
X    int result, operator, operand;
X    int gotOp;				/* Non-zero means already lexed the
X					 * operator (while picking up value
X					 * for unary operator).  Don't lex
X					 * again. */
X
X    /*
X     * There are two phases to this procedure.  First, pick off an initial
X     * value.  Then, parse (binary operator, value) pairs until done.
X     */
X
X    gotOp = 0;
X    result = ExprLex(interp, infoPtr);
X    if (result != TCL_OK) {
X	return result;
X    }
X    if (infoPtr->token == OPEN_PAREN) {
X
X	/*
X	 * Parenthesized sub-expression.
X	 */
X
X	result = ExprGetValue(interp, infoPtr, -1);
X	if (result != TCL_OK) {
X	    return result;
X	}
X	if (infoPtr->token != CLOSE_PAREN) {
X	    Tcl_Return(interp, (char *) NULL, TCL_STATIC);
X	    sprintf(interp->result,
X		    "unmatched parentheses in expression \"%.50s\"",
X		    infoPtr->originalExpr);
X	    return TCL_ERROR;
X	}
X    } else {
X	if (infoPtr->token == MINUS) {
X	    infoPtr->token = UNARY_MINUS;
X	}
X	if (infoPtr->token >= UNARY_MINUS) {
X
X	    /*
X	     * Process unary operators.
X	     */
X
X	    operator = infoPtr->token;
X	    result = ExprGetValue(interp, infoPtr, precTable[infoPtr->token]);
X	    if (result != TCL_OK) {
X		return result;
X	    }
X	    switch (operator) {
X		case UNARY_MINUS:
X		    infoPtr->number = -infoPtr->number;
X		    break;
X		case NOT:
X		    infoPtr->number = !infoPtr->number;
X		    break;
X		case BIT_NOT:
X		    infoPtr->number = ~infoPtr->number;
X		    break;
X	    }
X	    gotOp = 1;
X	} else if (infoPtr->token != NUMBER) {
X	    goto syntaxError;
X	}
X    }
X
X    /*
X     * Got the first operand.  Now fetch (operator, operand) pairs.
X     */
X
X    if (!gotOp) {
X	result = ExprLex(interp, infoPtr);
X	if (result != TCL_OK) {
X	    return result;
X	}
X    }
X    while (1) {
X	operand = infoPtr->number;
X	operator = infoPtr->token;
X	if ((operator < MULT) || (operator >= UNARY_MINUS)) {
X	    if ((operator == END) || (operator == CLOSE_PAREN)) {
X		return TCL_OK;
X	    } else {
X		goto syntaxError;
X	    }
X	}
X	if (precTable[operator] <= prec) {
X	    return TCL_OK;
X	}
X
X	/*
X	 * If we're doing an AND or OR and the first operand already
X	 * determines the result, don't execute anything in the
X	 * second operand:  just parse.
X	 */
X
X	if (((operator == AND) && !operand)
X		|| ((operator == OR) && operand)) {
X	    iPtr->noEval++;
X	    result = ExprGetValue(interp, infoPtr, precTable[operator]);
X	    iPtr->noEval--;
X	} else {
X	    result = ExprGetValue(interp, infoPtr, precTable[operator]);
X	}
X	if (result != TCL_OK) {
X	    return result;
X	}
X	if ((infoPtr->token < MULT) && (infoPtr->token != NUMBER)
X		&& (infoPtr->token != END)
X		&& (infoPtr->token != CLOSE_PAREN)) {
X	    goto syntaxError;
X	}
X	switch (operator) {
X	    case MULT:
X		infoPtr->number = operand * infoPtr->number;
X		break;
X	    case DIVIDE:
X		if (infoPtr->number == 0) {
X		    Tcl_Return(interp, "divide by zero", TCL_STATIC);
X		    return TCL_ERROR;
X	        }
X		infoPtr->number = operand / infoPtr->number;
X		break;
X	    case MOD:
X		if (infoPtr->number == 0) {
X		    Tcl_Return(interp, "divide by zero", TCL_STATIC);
X		    return TCL_ERROR;
X	        }
X		infoPtr->number = operand % infoPtr->number;
X		break;
X	    case PLUS:
X		infoPtr->number = operand + infoPtr->number;
X		break;
X	    case MINUS:
X		infoPtr->number = operand - infoPtr->number;
X		break;
X	    case LEFT_SHIFT:
X		infoPtr->number = operand << infoPtr->number;
X		break;
X	    case RIGHT_SHIFT:
X		infoPtr->number = operand >> infoPtr->number;
X		break;
X	    case LESS:
X		infoPtr->number = operand < infoPtr->number;
X		break;
X	    case GREATER:
X		infoPtr->number = operand > infoPtr->number;
X		break;
X	    case LEQ:
X		infoPtr->number = operand <= infoPtr->number;
X		break;
X	    case GEQ:
X		infoPtr->number = operand >= infoPtr->number;
X		break;
X	    case EQUAL:
X		infoPtr->number = operand == infoPtr->number;
X		break;
X	    case NEQ:
X		infoPtr->number = operand != infoPtr->number;
X		break;
X	    case BIT_AND:
X		infoPtr->number = operand & infoPtr->number;
X		break;
X	    case BIT_XOR:
X		infoPtr->number = operand ^ infoPtr->number;
X		break;
X	    case BIT_OR:
X		infoPtr->number = operand | infoPtr->number;
X		break;
X	    case AND:
X		infoPtr->number = operand && infoPtr->number;
X		break;
X	    case OR:
X		infoPtr->number = operand || infoPtr->number;
X		break;
X	}
X    }
X
X    syntaxError:
X    Tcl_Return(interp, (char *) NULL, TCL_STATIC);
X    sprintf(interp->result, "syntax error in expression \"%.50s\"",
X	    infoPtr->originalExpr);
X    return TCL_ERROR;
X}
X 
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_Expr --
X *
X *	Parse and evaluate an expression.
X *
X * Results:
X *	The return value is TCL_OK if the expression was correctly parsed;
X *	if there was a syntax error or some other error during parsing,
X *	then another Tcl return value is returned and Tcl_Result points
X *	to an error message.  If all went well, *valuePtr is filled in
X *	with the result corresponding to the expression string.
X *
X * Side effects:
X *	None.
X *
X *----------------------------------------------------------------------
X */
X
Xint
XTcl_Expr(interp, string, valuePtr)
X    Tcl_Interp *interp;		/* Intepreter to use for variables etc. */
X    char *string;		/* Expression to evaluate. */
X    int *valuePtr;		/* Where to store result of evaluation. */
X{
X    ExprInfo info;
X    int result;
X
X    info.interp = interp;
X    info.originalExpr = string;
X    info.expr = string;
X    result = ExprGetValue(interp, &info, -1);
X    if (result != TCL_OK) {
X	return result;
X    }
X    if (info.token != END) {
X	Tcl_Return(interp, (char *) NULL, TCL_STATIC);
X	sprintf(interp->result, "syntax error in expression \"%.50s\"", string);
X	return TCL_ERROR;
X    }
X    *valuePtr = info.number;
X    return TCL_OK;
X}
END_OF_FILE
if test 16599 -ne `wc -c <'tclExpr.c'`; then
    echo shar: \"'tclExpr.c'\" unpacked with wrong size!
fi
# end of 'tclExpr.c'
fi
if test -f 'tclGlob.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'tclGlob.c'\"
else
echo shar: Extracting \"'tclGlob.c'\" \(11713 characters\)
sed "s/^X//" >'tclGlob.c' <<'END_OF_FILE'
X/* TclGlob.c -
X *
X *     	This file contains routines to glob filenames.  It calls
X *	glob routines from GNU.
X *
X */
X
X#ifndef lint
Xstatic char rcsid[] = "$Header: /sprite/src/lib/tcl/RCS/tclGlob.c,v 1.2 89/06/12 17:00:39 shirriff Exp $ SPRITE (Berkeley)";
X#endif /* not lint */
X
X#include <string.h>
X#include <list.h>
X#include <pwd.h>
X#include <tcl.h>
X
X/*
X * Library imports.
X */
X
Xextern int errno;
Xextern char *sys_errlist[];
Xextern char *ckalloc(), *sprintf(), *getlogin();
Xextern char **glob_filename();
X
X/*
X * Structure to hold a list of strings.
X */
Xtypedef struct {
X    List_Links links;
X    char *str;
X} stringList;
X
X/*
X * Free the linked list.  This macro requires stringElt to be defined.
X */
X#define FREE(list) \
X	while (!List_IsEmpty((list))) { \
X	    stringElt=(stringList *)List_First((list)); \
X	    List_Remove((List_Links *)stringElt); \
X	    if (stringElt->str != NULL) { \
X		ckfree(stringElt->str); \
X	    } \
X	    ckfree((char *)stringElt); \
X	} \
X	ckfree((char *)(list))
X 
X/*
X * ----------------------------------------------------------------------------
X *
X * BraceExpand --
X *
X *      Expands a filename containing {} braces.
X *	If inBrace==0, this routine matches expression E, where
X *		E = string
X *	    or	E = [E]{E,...,E}[E]
X *	otherwise this routine matches a similar expression E1, where
X *		E1 = string (stopping at comma or closing brace)
X *	    or	E1 = [E1]{E,...,E}[E1]
X *	That is, commas and closing braces will stop the parsing. 
X *	
X * Results:
X *	
X *	The position of the next character in the input is returned.
X *	This position will point to '\0', or possibly ',' if inBrace is true.
X *      The resulting list of strings is returned in strList.
X *	In case of an error, NULL will be returned and the error
X *	message will be returned in the list of strings.
X *
X * Side effects:
X *      Allocates memory for the list of strings.
X *
X * ----------------------------------------------------------------------------
X */
Xstatic char*
XBraceExpand(str,inBrace,strList)
X    char *str;			/* String to expand. */
X    int inBrace;		/* True if inside a brace. */
X    List_Links **strList;	/* List of strings. */
X{
X    List_Links *headerPtr;	/* Header of string list. */
X    stringList *stringElt;	/* Element of string list. */
X    List_Links *leftHdr;	/* Left part of expanded name. */
X    List_Links *rightHdr;	/* Right part of expanded name. */
X    char *strPtr;		/* Pointer into the string. */
X    char *next;			/* Next position in string. */
X    int len;			/* String length. */
X    List_Links *leftPtr;	/* Pointer to left string element. */
X    char *left;			/* Left string. */
X    int leftLen;		/* Length of left string. */
X    List_Links *rightPtr;	/* Pointer to right string element. */
X    char *right;		/* Right string. */
X
X    headerPtr = (List_Links *)ckalloc(sizeof(List_Links));
X    List_Init(headerPtr);
X	
X    if (inBrace) {
X	strPtr = strpbrk(str,"{,}");
X    } else {
X	strPtr = strchr(str,'{');
X    }
X    if (strPtr==NULL || *strPtr=='}' || *strPtr==',') {
X	/*
X	 * Return a single element.
X	 */
X	if (strPtr==NULL) {
X	    len = strlen(str);
X	    strPtr = str+len;
X	}
X	else {
X	    len = strPtr-str;
X	}
X	stringElt = (stringList *)ckalloc(sizeof(stringList));
X	List_InitElement((List_Links *)stringElt);
X	stringElt->str = (char *)ckalloc((unsigned)len+1);
X	(void) strncpy(stringElt->str,str,len);
X	stringElt->str[len] = '\0';
X	List_Insert((List_Links *)stringElt,
X		LIST_ATFRONT(headerPtr));
X	*strList = headerPtr;
X	return strPtr;
X    }
X
X    len = strPtr-str;
X    leftHdr = (List_Links *)ckalloc(sizeof(List_Links));
X    List_Init(leftHdr);
X
X    /*
X     * The idea is to grab a unit (string or thing in braces) from
X     * the left, and put this in leftHdr.  Then recursively expand
X     * the remainder, and put this in rightHdr.  Finally merge the
X     * two lists
X     */
X
X    if (*str=='{') {
X	next = strPtr;
X	while (1) {
X	    /*
X	     * Expand the part in the braces.
X	     */
X	    next = BraceExpand(++next,1,&rightHdr);
X	    if (next==NULL) {
X		/*
X		 * Error in BraceExpand.
X		 */
X		*strList = rightHdr;
X		return NULL;
X	    } else if (*next=='\0') {
X		/*
X		 * Unexpected end of string.
X		 */
X		FREE(leftHdr);
X		FREE(rightHdr);
X		stringElt = (stringList *)ckalloc(sizeof(stringList));
X		List_InitElement((List_Links *)stringElt);
X		stringElt->str = "Missing }.";
X		List_Insert((List_Links *)stringElt,
X			LIST_ATREAR(headerPtr));
X		*strList = headerPtr;
X		return NULL;
X	    }
X	    else {
X		/*
X		 * Add the new list obtained from BraceExpand to the list.
X		 */
X		List_ListInsert(rightHdr, LIST_ATREAR(leftHdr));
X		ckfree((char *)rightHdr);
X		if (*next=='}') {
X		    strPtr = next+1;
X		    break;
X		}
X	    }
X	}
X    } else {
X	/*
X	 * leftHdr is the part before the braces.
X	 */
X	stringElt = (stringList *)ckalloc(sizeof(stringList));
X	List_InitElement((List_Links *)stringElt);
X	stringElt->str = (char *)ckalloc((unsigned)len+1);
X	(void) strncpy(stringElt->str,str,len);
X	stringElt->str[len] = '\0';
X	List_Insert((List_Links *)stringElt,
X		LIST_ATFRONT(leftHdr));
X    }
X
X    /*
X     * Now expand the rest of the pattern and put this in rightHdr.
X     */
X
X    if (*strPtr=='\0' || (*strPtr==',' && inBrace)) {
X	/*
X	 * We can leave early.
X	 */
X	*strList = leftHdr;
X	ckfree((char *)headerPtr);
X	return strPtr;
X    }
X    next = BraceExpand(strPtr,inBrace,&rightHdr);
X    if (next==NULL) {
X	ckfree((char *)leftHdr);
X	ckfree((char *)headerPtr);
X	*strList = rightHdr;
X	return NULL;
X    }
X
X    /*
X     * Merge the left and right lists of strings.
X     */
X
X    LIST_FORALL(leftHdr,leftPtr) {
X	left = ((stringList *)leftPtr)->str;
X	leftLen = strlen(left);
X	LIST_FORALL(rightHdr,rightPtr) {
X	    right = ((stringList *)rightPtr)->str;
X	    stringElt = (stringList *)ckalloc(sizeof(stringList));
X	    List_InitElement((List_Links *)stringElt);
X	    stringElt->str = (char *)ckalloc((unsigned)strlen(left)+
X		    strlen(right)+1);
X	    (void)strcpy(stringElt->str,left);
X	    (void)strcpy(stringElt->str+leftLen,right);
X	    List_Insert((List_Links *)stringElt,
X		    LIST_ATREAR(headerPtr));
X	}
X    }
X    FREE(leftHdr);
X    FREE(rightHdr);
X    *strList = headerPtr;
X    return next;
X}
X
X 
X
X#define VALID "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\
X0123456789-"
X
X/*
X * ----------------------------------------------------------------------------
X *
X * Tilde --
X *
X *      Expands a string starting with a tilde.
X *	It is assumed that the pattern starts with a tilde.
X *	It is also assumed that we may temporarily modify pattern.
X *	
X * Results:
X *	
X *	If successful, TCL_OK is returned, and result points to the string
X *	containing the expanded filenames.
X *	Otherwise, TCL_ERROR is returned, and interp contains the error.
X *
X * Side effects:
X *      Allocates the result string if successful.
X *
X * ----------------------------------------------------------------------------
X */
Xstatic int
XTilde(pattern,interp,result)
X    char *pattern;		/* Pattern to expand. */
X    Tcl_Interp *interp;         /* Current interpreter. */
X    char **result;		/* Result of expansion. */
X{
X    int len;			/* Length of tilde name. */
X    struct passwd *pwPtr;	/* Password file entry. */
X    char *strPtr;		/* String pointer. */
X    int ret;
X
X    pattern++;
X
X    len = strspn(pattern,VALID);
X    if (len==0) {
X	/*
X	 * Get home directory.
X	 */
X	 strPtr = (char *)getlogin();
X	 if (strPtr==NULL) {
X	     interp->result = "no home directory";
X	     return TCL_ERROR;
X	 }
X    }
X    else {
X	 strPtr = (char *)ckalloc((unsigned)len+1);
X	 strncpy(strPtr,pattern,len);
X	 strPtr[len] = '\0';
X    }
X    pwPtr = getpwnam(strPtr);
X    if (pwPtr==NULL) {
X	 sprintf(interp->result,"Unknown user: %s.",strPtr);
X	 ret = TCL_ERROR;
X    }
X    else {
X	*result = (char *)ckalloc((unsigned)strlen(pattern+len)+
X		strlen(pwPtr->pw_dir)+1);
X	(void) strcpy(*result,pwPtr->pw_dir);
X	(void) strcpy(*result+strlen(pwPtr->pw_dir),pattern+len);
X	ret = TCL_OK;
X    }
X    if (len>0) {
X	ckfree(strPtr);
X    }
X    return ret;
X}
X 
X/*
X * ----------------------------------------------------------------------------
X *
X * Tcl_Glob --
X *
X *      Expands a pattern in a directory using csh rules.
X *	
X * Results:
X *	A standard Tcl result.
X *
X * Side effects:
X *      See the user documentation.
X *
X * ----------------------------------------------------------------------------
X */
X
Xint
XTcl_Glob(interp, argc, argv)
X    Tcl_Interp *interp;                 /* Current interpreter. */
X    int argc;
X    char *argv[];
X{
X    List_Links *stringHdr;	/* Element of string list. */
X    stringList *stringElt;	/* Element of string list. */
X    List_Links *resultList;	/* Results of expansion. */
X    List_Links *linkPtr;	/* Pointer to linked list element. */
X    int length = 0;		/* Length of result. */
X    char *strPtr;		/* String pointer. */
X    char *str2Ptr;		/* String pointer. */
X    char **fileList;		/* List of globbed filenames */
X    char **fileList1;		/* List of globbed filenames */
X    int i;
X
X    resultList = (List_Links *) ckalloc(sizeof(List_Links));
X    List_Init(resultList);
X
X    for (i=1;i<argc;i++) {
X	/*
X	 * Expand the braces in each argument and add to resultList.
X	 */
X	if (!strcmp(argv[i],"{") || !strcmp(argv[i],"{}")) {
X	    /*
X	     * Patterns "{" and "{}" are special cases.
X	     */
X	    stringElt = (stringList *)ckalloc(sizeof(stringList));
X	    List_InitElement((List_Links *)stringElt);
X	    stringElt->str = (char *)ckalloc((unsigned)strlen(argv[i])+1);
X	    (void)strcpy(stringElt->str,argv[i]);
X	    List_Insert((List_Links *)stringElt,
X		    LIST_ATREAR(resultList));
X	} else if (BraceExpand(argv[i],0,&stringHdr)==NULL) {
X	    strcpy(interp->result,
X		    ((stringList *)List_First(stringHdr))->str);
X	    FREE(resultList);
X	    FREE(stringHdr);
X	    return TCL_ERROR;
X	} else {
X	    List_ListInsert(stringHdr,LIST_ATREAR(resultList));
X	    ckfree((char *)stringHdr);
X	}
X    }
X
X    stringHdr = (List_Links *)ckalloc(sizeof(List_Links));
X    List_Init(stringHdr);
X
X    LIST_FORALL(resultList,linkPtr) {
X	strPtr = ((stringList *)linkPtr)->str;
X	if (*strPtr == '~') {
X	    /*
X	     * Expand tildes.
X	     */
X	    if (Tilde(strPtr,interp,&str2Ptr) != TCL_OK) {
X		FREE(resultList);
X		FREE(stringHdr);
X		return TCL_ERROR;
X	    } else {
X		ckfree(strPtr);
X		((stringList *)linkPtr)->str = str2Ptr;
X		strPtr = str2Ptr;
X	    }
X	}
X	if (glob_pattern_p(strPtr)) {
X	fileList = (char **)glob_filename(strPtr);
X	    if ((int)fileList==-1) {
X		strcpy(interp->result,sys_errlist[errno]);
X		FREE(resultList);
X		FREE(stringHdr);
X		return TCL_ERROR;
X	    } else {
X		for (fileList1=fileList; *fileList1!='\0'; fileList1++) {
X		    length += strlen(*fileList1)+1;
X		    stringElt = (stringList *)ckalloc(sizeof(stringList));
X		    List_InitElement((List_Links *)stringElt);
X		    stringElt->str =
X			    (char *)ckalloc((unsigned)strlen(*fileList1)+1);
X		    strcpy(stringElt->str,*fileList1);
X		    List_Insert((List_Links *)stringElt,
X			    LIST_ATREAR(stringHdr));
X		    ckfree(*fileList1);
X		}
X		ckfree((char *)fileList);
X	    }
X	} else {
X	    length += strlen(strPtr)+1;
X	    stringElt = (stringList *)ckalloc(sizeof(stringList));
X	    List_InitElement((List_Links *)stringElt);
X	    stringElt->str = strPtr;
X	    ((stringList *)linkPtr)->str = NULL;
X	    List_Insert((List_Links *)stringElt,LIST_ATREAR(stringHdr));
X	}
X    }
X    FREE(resultList);
X
X    if (List_IsEmpty(stringHdr)) {
X	FREE(stringHdr);
X	sprintf(interp->result,"%.50s couldn't find file that matches pattern",
X		argv[0]);
X	return TCL_ERROR;
X    }
X
X    strPtr = (char *)ckalloc((unsigned) length);
X    interp->result = strPtr;
X    interp->dynamic = 1;
X    LIST_FORALL(stringHdr,linkPtr) {
X	strcpy(strPtr,((stringList *)linkPtr)->str);
X	strPtr += strlen(strPtr)+1;
X	strPtr[-1] = ' ';
X    }
X    strPtr[-1] = '\0';
X    FREE(stringHdr);
X    return TCL_OK;
X}
END_OF_FILE
if test 11713 -ne `wc -c <'tclGlob.c'`; then
    echo shar: \"'tclGlob.c'\" unpacked with wrong size!
fi
# end of 'tclGlob.c'
fi
if test -f 'tclInt.h' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'tclInt.h'\"
else
echo shar: Extracting \"'tclInt.h'\" \(9136 characters\)
sed "s/^X//" >'tclInt.h' <<'END_OF_FILE'
X/*
X * tclInt.h --
X *
X *	Declarations of things used internally by the Tcl interpreter.
X *
X * Copyright 1987 Regents of the University of California
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.  The University of California
X * makes no representations about the suitability of this
X * software for any purpose.  It is provided "as is" without
X * express or implied warranty.
X *
X * $Header: /sprite/src/lib/tcl/RCS/tclInt.h,v 1.19 90/01/27 14:40:46 ouster Exp $ SPRITE (Berkeley)
X */
X
X#ifndef _TCLINT
X#define _TCLINT
X
X#ifndef _TCL
X#include "tcl.h"
X#endif
X
X/*
X * The structure below defines one Tcl command, by associating a procedure
X * with a textual string.
X */
X
Xtypedef struct Command {
X    int (*proc)();		/* Procedure to process command. */
X    ClientData clientData;	/* Arbitrary value to pass to proc. */
X    void (*deleteProc)();	/* Procedure to invoke when deleting
X				 * command. */
X    struct Command *nextPtr;	/* Pointer to next command in list, or NULL
X				 * for end of list. */
X    char name[4];		/* Name of command.  The actual size of this
X				 * portion is as large as is necessary to
X				 * hold the characters.  This must be the
X				 * last subfield of the record. */
X} Command;
X
X#define CMD_SIZE(nameLength) ((unsigned) sizeof(Command) + nameLength - 3)
X
X/*
X * The structure below defines a variable, which associates a string name
X * with a string value.  To cut down on the number of malloc's and free's
X * (particularly for procedure parameters), space for both the variable's
X * name and initial value is allocated at the end of the structure (in
X * "storage").  If the variable's value changes later, a new dynamic
X * string is allocated, if there is insufficient space in the current
X * storage area.
X */
X
Xtypedef struct Var {
X    char *value;		/* Current value of variable (either points
X				 * to static space after name, or to dynamic
X				 * space if VAR_DYNAMIC is set). */
X    int valueLength;		/* Number of bytes of storage at the place
X				 * referred to by value, not including space
X				 * for NULL terminator. */
X    int flags;			/* Miscellaneous flags:  see below. */
X    struct Var *globalPtr;	/* If VAR_GLOBAL is set, this points to the
X				 * global variable corresponding to name. */
X    struct Var *nextPtr;	/* Next variable in list, or NULL for end
X				 * of list. */
X    char name[4];		/* Storage space for variable's name (and
X				 * initial value).  The name is at the
X				 * beginning, and is null-terminated.
X				 * May contain more than 4 bytes (see
X				 * VAR_SIZE macro below). */
X} Var;
X
X#define VAR_SIZE(nameLength, valueLength) \
X	((unsigned) sizeof(Var) + nameLength + valueLength - 2)
X
X/*
X * Variable flags:
X *
X * VAR_DYNAMIC:		1 means the storage space for the value was
X *			dynamically allocated, and must eventually be
X *			freed.
X * VAR_GLOBAL:		Used only in local variables.  Means that this
X *			is really a global variable.
X */
X
X#define VAR_DYNAMIC	1
X#define VAR_GLOBAL	2
X
X/*
X * The structure below defines a command procedure, which consists of
X * a collection of Tcl commands plus information about arguments and
X * variables.
X */
X
Xtypedef struct Proc {
X    struct Interp *iPtr;	/* Interpreter for which this command
X				 * is defined. */
X    char *command;		/* Command that constitutes the body of
X				 * the procedure (dynamically allocated). */
X    Var *argPtr;		/* Pointer to first in list of variables
X				 * giving names to the procedure's arguments.
X				 * The order of the variables is the same
X				 * as the order of the arguments.  The "value"
X				 * fields of the variables are the default
X				 * values. */
X} Proc;
X
X/*
X * The structure below defines a trace.  This is used to allow Tcl
X * clients to find out whenever a command is about to be executed.
X */
X
Xtypedef struct Trace {
X    int level;			/* Only trace commands at nesting level
X				 * less than or equal to this. */
X    void (*proc)();		/* Procedure to call to trace command. */
X    ClientData clientData;	/* Arbitrary value to pass to proc. */
X    struct Trace *nextPtr;	/* Next in list of traces for this interp. */
X} Trace;
X
X/*
X * The stucture below defines an interpreter callback, which is
X * a procedure to invoke just before an interpreter is deleted.
X */
X
Xtypedef struct InterpCallback {
X    void (*proc)();		/* Procedure to call. */
X    ClientData clientData;	/* Value to pass to procedure. */
X    struct InterpCallback *nextPtr;
X				/* Next in list of callbacks for this
X				 * interpreter (or NULL for end of
X				 * list). */
X} InterpCallback;
X
X/*
X * The structure below defines a frame, which is a procedure invocation.
X * These structures exist only while procedures are being executed, and
X * provide a sort of call stack.
X */
X
Xtypedef struct CallFrame {
X    Var *varPtr;		/* First in list of all local variables
X				 * and arguments for this procedure
X				 * invocation. */
X    int level;			/* Level of this procedure, for "uplevel"
X				 * purposes (i.e. corresponds to nesting of
X				 * callerVarPtr's, not callerPtr's).  1 means
X				 * outer-most procedure, 0 means top-level. */
X    int argc;			/* This and argv below describe name and
X				 * arguments for this procedure invocation. */
X    char **argv;		/* Array of arguments. */
X    struct CallFrame *callerPtr;
X				/* Frame of procedure that invoked this one
X				 * (NULL if level == 1). */
X    struct CallFrame *callerVarPtr;
X				/* Frame used by caller for accessing local
X				 * variables (same as callerPtr unless an
X				 * "uplevel" command was active in the
X				 * caller).  This field is used in the
X				 * implementation of "uplevel". */
X} CallFrame;
X
X/*
X * This structure defines an interpreter, which is a collection of commands
X * plus other state information related to interpreting commands, such as
X * variable storage.  The lists of commands and variables are sorted by usage:
X * each time a command or variable is used it is pulled to the front of its
X * list.
X */
X
Xtypedef struct Interp {
X
X    /*
X     * Note:  the first two fields must match exactly the first
X     * fields in a Tcl_Interp struct (see tcl.h).  If you change
X     * one, be sure to change the other.
X     */
X
X    char *result;		/* Points to result returned by last
X				 * command. */
X    int dynamic;		/* Non-zero means result is dynamically-
X				 * allocated and must be freed by Tcl_Eval
X				 * before executing the next command. */
X    int errorLine;		/* When TCL_ERROR is returned, this gives
X				 * the line number within the command where
X				 * the error occurred (1 means first line). */
X    Command *commandPtr;	/* First command in list containing all
X				 * commands defined for this table. */
X    Var *globalPtr;		/* First in list of all global variables for
X				 * this command table. */
X    Var *localPtr;		/* First in list of all local variables and
X				 * arguments for the Tcl procedure that is
X				 * currently being executed.  If no procedure
X				 * is being executed, or if it has no vars or
X				 * args, this will be NULL. */
X    int numLevels;		/* Keeps track of how many nested calls to
X				 * Tcl_Eval are in progress for this
X				 * interpreter.  It's used to delay deletion
X				 * of the table until all Tcl_Eval invocations
X				 * are completed. */
X    CallFrame *framePtr;	/* If a procedure is being executed, this
X				 * points to the call frame for the current
X				 * procedure (most recently-called).  NULL
X				 * means no procedure is active. */
X    CallFrame *varFramePtr;	/* Points to the call frame whose variables
X				 * are currently in use (same as framePtr
X				 * unless an "uplevel" command is being
X				 * executed).  NULL means no procedure is
X				 * active or "uplevel 0" is being exec'ed. */
X    int cmdCount;		/* Total number of times a command procedure
X				 * has been called for this interpreter. */
X    int errInProgress;		/* Non-zero means an error unwind is already
X				 * in progress.  Zero means Tcl_Eval has
X				 * been invoked since the last error
X				 * occurred. */
X    int noEval;			/* Non-zero means no commands should actually
X				 * be executed:  just parse only.  Used in
X				 * expressions when the result is already
X				 * determined. */
X    int flags;			/* Various flag bits.  See below. */
X    Trace *tracePtr;		/* List of traces for this interpreter. */
X    InterpCallback *callbackPtr;/* List of callbacks to invoke when
X				 * interpreter is deleted. */
X    char resultSpace[TCL_RESULT_SIZE];
X				/* Static space for storing small results. */
X} Interp;
X
X/*
X * Flag bits for Interp structures:
X *
X * DELETED:		Non-zero means the interpreter has been deleted:
X *			don't process any more commands for it, and destroy
X *			the structure as soon as all nested invocations of
X *			Tcl_Eval are done.
X */
X
X#define DELETED 1
X
X/*
X * Procedures shared among Tcl modules but not used by the outside
X * world:
X */
X
Xextern void		TclCopyAndCollapse();
Xextern void		TclDeleteVars();
Xextern Command *	TclFindCmd();
Xextern int		TclFindElement();
Xextern Proc *		TclFindProc();
Xextern Proc *		TclIsProc();
X
X#endif /* _TCLINT */
END_OF_FILE
if test 9136 -ne `wc -c <'tclInt.h'`; then
    echo shar: \"'tclInt.h'\" unpacked with wrong size!
fi
# end of 'tclInt.h'
fi
echo shar: End of archive 2 \(of 6\).
cp /dev/null ark2isdone
MISSING=""
for I in 1 2 3 4 5 6 ; do
    if test ! -f ark${I}isdone ; then
	MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 6 archives.
    rm -f ark[1-9]isdone
else
    echo You still need to unpack the following archives:
    echo "        " ${MISSING}
fi
##  End of shell archive.
exit 0
-- 
 _--_|\  `-_-' Peter da Silva. +1 713 274 5180. <peter@ficc.uu.net>.
/      \  'U`
\_.--._/ "I've about decided that the net is not the place to do the right
      v   thing. It might violate a charter somewhere ..." -- Spenser Aden


