[comp.sources.sun] v01i024: Tooltool - a suntools user interface builder, Part 05/13

mcgrew@dartagnan.rutgers.edu (Charles Mcgrew) (06/07/89)

Submitted-by: Chuck Musciano <chuck@trantor.harris-atd.com>
Posting-number: Volume 1, Issue 24
Archive-name: tooltool2.1c/part05

#! /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 5 (of 13)."
# Contents:  expr.c func.c lex.c
# Wrapped by chuck@melmac on Thu Jun  1 10:39:31 1989
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'expr.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'expr.c'\"
else
echo shar: Extracting \"'expr.c'\" \(14434 characters\)
sed "s/^X//" >'expr.c' <<'END_OF_FILE'
X/************************************************************************/
X/*	Copyright 1988 by Chuck Musciano and Harris Corporation		*/
X/*									*/
X/*	Permission to use, copy, modify, and distribute this software	*/
X/*	and its documentation for any purpose and without fee is	*/
X/*	hereby granted, provided that the above copyright notice	*/
X/*	appear in all copies and that both that copyright notice and	*/
X/*	this permission notice appear in supporting documentation, and	*/
X/*	that the name of Chuck Musciano and Harris Corporation not be	*/
X/*	used in advertising or publicity pertaining to distribution	*/
X/*	of the software without specific, written prior permission.	*/
X/*	Chuck Musciano and Harris Corporation make no representations	*/
X/*	about the suitability of this software for any purpose.  It is	*/
X/*	provided "as is" without express or implied warranty.		*/
X/*									*/
X/*	The sale of any product based wholely or in part upon the 	*/
X/*	technology provided by tooltool is strictly forbidden without	*/
X/*	specific, prior written permission from Harris Corporation.	*/
X/*	Tooltool technology includes, but is not limited to, the source	*/
X/*	code, executable binary files, specification language, and	*/
X/*	sample specification files.					*/
X/************************************************************************/
X
X#include	<stdio.h>
X#include	<ctype.h>
X#include	<math.h>
X
X#include	"tooltool.h"
X
X/************************************************************************/
XPRIVATE	v_ptr	do_compare(op, l, r)
X
Xregister	int	op;
Xregister	v_ptr	l;
Xregister	v_ptr	r;
X
X{	register	char	*p, *q;
X
X	if (is_number(l) && is_number(r))
X	   switch (op) {
X	      case E_EQUAL         : return(tt_int_result(l->number == r->number));
X	      case E_GREATER       : return(tt_int_result(l->number > r->number));
X	      case E_GREATER_EQUAL : return(tt_int_result(l->number >= r->number));
X	      case E_LESS          : return(tt_int_result(l->number < r->number));
X	      case E_LESS_EQUAL    : return(tt_int_result(l->number <= r->number));
X	      case E_NOT_EQUAL     : return(tt_int_result(l->number != r->number));
X	      }
X	else {
X	   p = tt_string_of(l);
X	   q = tt_string_of(r);
X	   switch (op) {
X	      case E_EQUAL         : return(tt_int_result(strcmp(p, q) == 0));
X	      case E_GREATER       : return(tt_int_result(strcmp(p, q) > 0));
X	      case E_GREATER_EQUAL : return(tt_int_result(strcmp(p, q) >= 0));
X	      case E_LESS          : return(tt_int_result(strcmp(p, q) < 0));
X	      case E_LESS_EQUAL    : return(tt_int_result(strcmp(p, q) <= 0));
X	      case E_NOT_EQUAL     : return(tt_int_result(strcmp(p, q) != 0));
X	      }
X	   }
X}
X
X/************************************************************************/
XPRIVATE	v_ptr	do_array_ref(a, i)
X
Xregister	v_ptr	a;
Xregister	v_ptr	i;
X
X{	register	v_ptr	v;
X	register	char	*s;
X	register	int	cmp;
X
X	s = tt_string_of(i);
X	if (is_array(a)) {
X	   for (v = a->value; v; )
X	      if ((cmp = tt_dict_compare(s, v->index)) == 0)
X	         break;
X	      else if (cmp < 0)
X	         v = v->left;
X	      else
X	         v = v->right;
X	   if (v)
X	      return(v);
X	   }
X	else {
X	   a->kind = V_ARRAY;
X	   a->value = NULL;
X	   }
X	v = (v_ptr) safe_malloc(sizeof(v_data));
X	v->kind = V_NOTHING;
X	v->number = 0.0;
X	v->str = "";
X	v->value = NULL;
X	v->left = NULL;
X	v->right = NULL;
X	tt_insert_array(&(a->value), strsave(s), v);
X	return(v);
X}
X
X/************************************************************************/
XPRIVATE	v_ptr	dup_array(v)
X
Xregister	v_ptr	v;
X
X{	register	v_ptr	new;
X
X	if (v == NULL)
X	   return(NULL);
X	new = (v_ptr) safe_malloc(sizeof(v_data));
X	new->kind = v->kind;
X	new->number = v->number;
X	new->left = dup_array(v->left);
X	new->right = dup_array(v->right);
X	new->index = strsave(v->index);
X	if (is_array(new))
X	   new->value = dup_array(v->value);
X	else
X	   new->str = is_number(new)? NULL : strsave(v->str);
X	return(new);
X}
X
X/************************************************************************/
XPRIVATE	char	*concatenate(v, separator)
X
Xregister	v_ptr	v;
Xchar		separator;
X
X{	register	char	*l, *m, *r, *p;
X	char	buf[2];
X
X	if (v == NULL)
X	   return("");
X	buf[0] = separator;
X	buf[1] = '\0';
X	l = concatenate(v->left, separator);
X	m = tt_string_of(v);
X	r = concatenate(v->right, separator);
X	p = tt_emalloc(strlen(l) + strlen(m) + strlen(r) + 3);
X	strcpy(p, l);
X	if (*m) {
X	   if (*p)
X	      strcat(p, buf);
X	   strcat(p, m);
X	   }
X	if (*r) {
X	   if (*p)
X	      strcat(p, buf);
X	   strcat(p, r);
X	   }
X	return(p);
X}
X
X/************************************************************************/
XPRIVATE	free_array(v)
X
Xv_ptr	v;
X
X{
X	if (v) {
X	   if (is_array(v))
X	      safe_free(v->value);
X	   safe_free(v->index);
X	   free_array(v->left);
X	   free_array(v->right);
X	   safe_free(v);
X	   }
X}
X
X/************************************************************************/
XPRIVATE	do_assign(l, r)
X
Xregister	v_ptr	l;
Xregister	v_ptr	r;
X
X{
X	if (is_array(l))
X	   free_array(l->value);
X	l->kind = (r->kind & V_TYPES) | (l->kind & V_SPECIAL);
X	if (is_gadget(l))
X	   switch (l->gadget->kind) {
X	      case GADGET_CHOICE :
X	      case GADGET_SLIDER : panel_set(l->gadget->panel_item, PANEL_VALUE, (int) r->number, 0);
X	      			   break;
X	      case GADGET_TEXT   : panel_set(l->gadget->panel_item, PANEL_VALUE, tt_string_of(r), 0);
X	      			   break;
X/*	      case GADGET_LABEL  : panel_set(l->gadget->panel_item, PANEL_LABEL_STRING, tt_string_of(r), 0);
X	      			   break;*/
X	      default		 : abend("cannot assign a value to a button or menu");
X	      }
X	if (is_array(l))
X	   l->value = dup_array(r->value);
X	else if (is_number(l))
X	   l->number = r->number;
X	else {
X	   l->str = strsave(r->str);
X	   l->number = r->number;
X	   }
X	if (is_interval(l))
X	   tt_set_timer((int) l->number, ((int) (l->number * 1000000.0)) % 1000000);
X}
X
X/************************************************************************/
XEXPORT	v_ptr	tt_int_result(i)
X
Xint	i;
X
X{	char	buf[20];
X	register	v_ptr	v;
X
X	v = (v_ptr) tt_emalloc(sizeof(v_data));
X	v->str = NULL;
X	v->kind = V_NUMBER;
X	v->number = i;
X	v->left = NULL;
X	v->right = NULL;
X	return(v);
X}
X
X/************************************************************************/
XEXPORT	v_ptr	tt_double_result(r)
X
Xdouble	r;
X
X{	char	buf[20];
X	register	v_ptr	v;
X
X	v = (v_ptr) tt_emalloc(sizeof(v_data));
X	v->str = NULL;
X	v->kind = V_NUMBER;
X	v->number = r;
X	v->left = NULL;
X	v->right = NULL;
X	return(v);
X}
X
X/************************************************************************/
XEXPORT	v_ptr	tt_string_result(s)
X
Xchar	*s;
X
X{	char	buf[20];
X	double	atof();
X	register	v_ptr	v;
X
X	v = (v_ptr) tt_emalloc(sizeof(v_data));
X	if (tt_is_temp(s))
X	   v->str = s;
X	else
X	   v->str = estrsave(s);
X	v->kind = V_NOTHING;
X	v->number = tt_is_number(s)? atof(s) : 0.0;
X	v->left = NULL;
X	v->right = NULL;
X	return(v);
X}
X
X/************************************************************************/
XEXPORT	char	*tt_string_of(v)
X
Xregister	v_ptr	v;
X
X{	register	char	*p;
X	char	buf[20], *delimiters;
X
X	if (is_array(v)) {
X	   if (is_array(tt_delimiters->value) || (delimiters = tt_string_of(tt_delimiters->value)) == NULL)
X	      delimiters = " ";
X	   return(concatenate(v->value, *delimiters));
X	   }
X	else if (is_number(v)) {
X	   sprintf(buf, "%1.12g", v->number);
X	   return(estrsave(buf));
X	   }
X	else
X	   return(v->str);
X}
X
X/************************************************************************/
XEXPORT	v_ptr	tt_insert_array(array, index, value)
X
Xregister	v_ptr	*array;
Xregister	char	*index;
Xregister	v_ptr	value;
X
X{	int	cmp;
X
X	while (*array)
X	   if ((cmp = tt_dict_compare(index, (*array)->index)) == 0)
X	      abend("%s should not exist in array", index);
X	   else if (cmp < 0)
X	      array = &((*array)->left);
X	   else
X	      array = &((*array)->right);
X	*array = value;
X	value->index = index;
X}
X
X/************************************************************************/
XEXPORT	e_ptr	tt_make_expr(op, arg1, arg2, arg3)
X
Xint	op;
Xe_ptr	arg1, arg2, arg3;
X
X{	e_ptr	e;
X
X	e = (e_ptr) safe_malloc(sizeof(e_data));
X	switch (e->op = op) {
X	   case E_QUESTION      : 
X	   			  e->extra = arg3;
X	   case E_AND           :
X	   case E_ARRAY_REF     :
X	   case E_ASSIGN_AND    :
X	   case E_ASSIGN_DIVIDE :
X	   case E_ASSIGN_MINUS  :
X	   case E_ASSIGN_MODULO :
X	   case E_ASSIGN_OR     :
X	   case E_ASSIGN_PLUS   :
X	   case E_ASSIGN_TIMES  :
X	   case E_ASSIGN_XOR    :
X	   case E_ASSIGNMENT    :
X	   case E_COMMA         :
X	   case E_DIVIDE        :
X	   case E_EQUAL         :
X	   case E_GREATER       :
X	   case E_GREATER_EQUAL :
X	   case E_LEFT_SHIFT    :
X	   case E_LESS          :
X	   case E_LESS_EQUAL    :
X	   case E_LOGICAL_AND   :
X	   case E_LOGICAL_NOT   :
X	   case E_LOGICAL_OR    :
X	   case E_MINUS         :
X	   case E_MODULO        :
X	   case E_NOT_EQUAL     :
X	   case E_OR            :
X	   case E_PLUS          :
X	   case E_RIGHT_SHIFT   :
X	   case E_TIMES         :
X	   case E_XOR           : 
X	   			  e->right = arg2;
X	   case E_COMPLEMENT    :
X	   case E_PAREN         :
X	   case E_POSTDECREMENT :
X	   case E_POSTINCREMENT :
X	   case E_PREDECREMENT  :
X	   case E_PREINCREMENT  :
X	   case E_UMINUS        :
X	   			  e->left = arg1;
X	   			  break;
X	   case E_FUNC_ID       : e->func = (f_ptr) arg1;
X	   			  e->left = arg2;
X	   			  break;
X	   case E_STRING        : e->string = (char *) arg1;
X	   			  break;
X	   case E_NUMBER	: e->value = *((double *) arg1);
X	   			  break;
X	   case E_SYMBOL        : e->symbol = (s_ptr) arg1;
X	   			  break;
X	   }
X	return(e);
X}
X
X/************************************************************************/
XEXPORT	v_ptr	tt_eval(e)
X
Xregister	e_ptr	e;
X
X{	double	r;
X	int	i;
X	v_ptr	v, w;
X	char	*p, *q, *s;
X
X	if (e == NULL)
X	   return(NULL);
X	switch (e->op) {
X	   case E_AND           : return(tt_int_result(((int) tt_eval(e->left)->number) & ((int) tt_eval(e->right)->number)));
X	   case E_ARRAY_REF     : return(do_array_ref(tt_eval(e->left), tt_eval(e->right)));
X	   case E_ASSIGN_AND    : v = tt_eval(e->left);
X	   			  do_assign(v, tt_int_result(((int) v->number) & ((int) tt_eval(e->right)->number)));
X	   			  return(v);
X	   case E_ASSIGN_DIVIDE : v = tt_eval(e->left);
X	   			  if ((r = tt_eval(e->right)->number) == 0.0)
X	   			     abend("division by zero");
X	   			  else {
X	   			     do_assign(v, tt_double_result(v->number / r));
X	   			     return(v);
X	   			     }
X	   case E_ASSIGN_MINUS  : v = tt_eval(e->left);
X	   			  do_assign(v, tt_double_result(v->number - tt_eval(e->right)->number));
X	   			  return(v);
X	   case E_ASSIGN_MODULO : v = tt_eval(e->left);
X	   			  do_assign(v, tt_int_result(((int) v->number) % ((int) tt_eval(e->right)->number)));
X	   			  return(v);
X	   case E_ASSIGN_OR     : v = tt_eval(e->left);
X	   			  do_assign(v, tt_int_result(((int) v->number) | ((int) tt_eval(e->right)->number)));
X	   			  return(v);
X	   case E_ASSIGN_PLUS   : v = tt_eval(e->left);
X	   			  do_assign(v, tt_double_result(v->number + tt_eval(e->right)->number));
X	   			  return(v);
X	   case E_ASSIGN_TIMES  : v = tt_eval(e->left);
X	   			  do_assign(v, tt_double_result(v->number * tt_eval(e->right)->number));
X	   			  return(v);
X	   case E_ASSIGN_XOR    : v = tt_eval(e->left);
X	   			  do_assign(v, tt_int_result(((int) v->number) ^ ((int) tt_eval(e->right)->number)));
X	   			  return(v);
X	   case E_ASSIGNMENT    : do_assign(tt_eval(e->left), v = tt_eval(e->right));
X	   			  return(v);
X	   case E_COMMA         : p = tt_string_of(tt_eval(e->left));
X	   			  q = tt_string_of(tt_eval(e->right));
X	   			  s = tt_emalloc(strlen(p) + strlen(q) + 1);
X	   			  strcpy(s, p);
X	   			  strcat(s, q);
X	   			  return(tt_string_result(s));
X	   case E_COMPLEMENT    : return(tt_int_result(~((int) tt_eval(e->left)->number)));
X	   case E_DIVIDE        : if ((r = tt_eval(e->right)->number) == 0.0)
X	   			     abend("division by zero");
X	   			  else
X	   			     return(tt_double_result(tt_eval(e->left)->number / r));
X	   case E_EQUAL         :
X	   case E_GREATER       :
X	   case E_GREATER_EQUAL :
X	   case E_LESS          :
X	   case E_LESS_EQUAL    :
X	   case E_NOT_EQUAL     : return(do_compare(e->op, tt_eval(e->left), tt_eval(e->right)));
X	   case E_FUNC_ID       : return(e->func(e->left));
X	   case E_LEFT_SHIFT    : return(tt_int_result(((int) tt_eval(e->left)->number) << ((int) tt_eval(e->right)->number)));
X	   case E_LOGICAL_AND   : return(tt_int_result(((int) tt_eval(e->left)->number) && ((int) tt_eval(e->right)->number)));
X	   case E_LOGICAL_NOT   : return(tt_int_result(!((int) tt_eval(e->left)->number)));
X	   case E_LOGICAL_OR    : return(tt_int_result(((int) tt_eval(e->left)->number) || ((int) tt_eval(e->right)->number)));
X	   case E_MINUS         : return(tt_double_result(tt_eval(e->left)->number - tt_eval(e->right)->number));
X	   case E_MODULO        : if ((i = ((int) tt_eval(e->right)->number)) == 0)
X	   			     abend("modulus by zero");
X	   			  else
X	   			     return(tt_int_result(((int) tt_eval(e->left)->number) % i));
X	   case E_NUMBER	: return(tt_double_result(e->value));
X	   case E_OR            : return(tt_int_result(((int) tt_eval(e->left)->number) | ((int) tt_eval(e->right)->number)));
X	   case E_PAREN         : return(tt_eval(e->left));
X	   case E_PLUS          : return(tt_double_result(tt_eval(e->left)->number + tt_eval(e->right)->number));
X	   case E_POSTDECREMENT : v = tt_eval(e->left);
X	   			  do_assign(v, tt_double_result((r = v->number) - 1.0));
X	   			  return(tt_double_result(r));
X	   case E_POSTINCREMENT : v = tt_eval(e->left);
X	   			  do_assign(v, tt_double_result((r = v->number) + 1.0));
X	   			  return(tt_double_result(r));
X	   case E_PREDECREMENT  : v = tt_eval(e->left);
X	   			  do_assign(v, tt_double_result(v->number - 1.0));
X	   			  return(v);
X	   case E_PREINCREMENT  : v = tt_eval(e->left);
X	   			  do_assign(v, tt_double_result(v->number + 1.0));
X	   			  return(v);
X	   case E_QUESTION      : return(((int) tt_eval(e->left)->number)? tt_eval(e->right) : tt_eval(e->extra));
X	   case E_RIGHT_SHIFT   : return(tt_int_result(((int) tt_eval(e->left)->number) >> ((int) tt_eval(e->right)->number)));
X	   case E_STRING        : return(tt_string_result(e->string));
X	   case E_SYMBOL        : return(tt_get_value(e->symbol));
X	   case E_TIMES         : return(tt_double_result(tt_eval(e->left)->number * tt_eval(e->right)->number));
X	   case E_UMINUS        : return(tt_double_result(-tt_eval(e->left)->number));
X	   case E_XOR           : return(tt_int_result(((int) tt_eval(e->left)->number) ^ ((int) tt_eval(e->right)->number)));
X	   }
X}
END_OF_FILE
if test 14434 -ne `wc -c <'expr.c'`; then
    echo shar: \"'expr.c'\" unpacked with wrong size!
fi
# end of 'expr.c'
fi
if test -f 'func.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'func.c'\"
else
echo shar: Extracting \"'func.c'\" \(13815 characters\)
sed "s/^X//" >'func.c' <<'END_OF_FILE'
X/************************************************************************/
X/*	Copyright 1988 by Chuck Musciano and Harris Corporation		*/
X/*									*/
X/*	Permission to use, copy, modify, and distribute this software	*/
X/*	and its documentation for any purpose and without fee is	*/
X/*	hereby granted, provided that the above copyright notice	*/
X/*	appear in all copies and that both that copyright notice and	*/
X/*	this permission notice appear in supporting documentation, and	*/
X/*	that the name of Chuck Musciano and Harris Corporation not be	*/
X/*	used in advertising or publicity pertaining to distribution	*/
X/*	of the software without specific, written prior permission.	*/
X/*	Chuck Musciano and Harris Corporation make no representations	*/
X/*	about the suitability of this software for any purpose.  It is	*/
X/*	provided "as is" without express or implied warranty.		*/
X/*									*/
X/*	The sale of any product based wholely or in part upon the 	*/
X/*	technology provided by tooltool is strictly forbidden without	*/
X/*	specific, prior written permission from Harris Corporation.	*/
X/*	Tooltool technology includes, but is not limited to, the source	*/
X/*	code, executable binary files, specification language, and	*/
X/*	sample specification files.					*/
X/************************************************************************/
X
X#include	<stdio.h>
X#include	<ctype.h>
X#include	<pwd.h>
X#include	<grp.h>
X
X#include	<sys/types.h>
X#include	<sys/stat.h>
X#include	<sys/file.h>
X
X#include	"tooltool.h"
X
XPUBLIC	char	*getenv(), *rindex();
X
XPRIVATE	v_ptr	do_cardinality(),
X		do_cd(),
X		do_executable(),
X		do_exists(),
X		do_format(),
X		do_getenv(),
X		do_group(),
X		do_head(),
X		do_index(),
X		do_is_open(),
X		do_length(),
X		do_output_of(),
X		do_pwd(),
X		do_readable(),
X		do_root(),
X		do_selection(),
X		do_stat(),
X		do_substr(),
X		do_suffix(),
X		do_system(),
X		do_tail(),
X		do_tokenize(),
X		do_user(),
X		do_verify(),
X		do_writable();
X
XPRIVATE	struct	{char	*name;
X		 f_ptr	func;
X		} func[] = {{"cardinality", do_cardinality},
X			    {"cd",          do_cd},
X			    {"executable",  do_executable},
X			    {"exists",      do_exists},
X			    {"format",      do_format},
X			    {"getenv",      do_getenv},
X			    {"group",       do_group},
X			    {"head",        do_head},
X			    {"index",       do_index},
X			    {"is_open",     do_is_open},
X			    {"length",      do_length},
X			    {"output_of",   do_output_of},
X			    {"pwd",         do_pwd},
X			    {"readable",    do_readable},
X			    {"root",        do_root},
X			    {"selection",   do_selection},
X			    {"stat",        do_stat},
X			    {"substr",      do_substr},
X			    {"suffix",      do_suffix},
X			    {"system",      do_system},
X			    {"tail",        do_tail},
X			    {"tokenize",    do_tokenize},
X			    {"user",        do_user},
X			    {"verify",      do_verify},
X			    {"writable",    do_writable},
X			    {NULL,          NULL}};
X
X/************************************************************************/
XEXPORT	f_ptr	tt_is_function(s)
X
Xchar	*s;
X
X{	int	i;
X
X	for (i = 0; func[i].name; i++)
X	   if (strcmp(func[i].name, s) == 0)
X	      return(func[i].func);
X	return(NULL);
X}
X
X/************************************************************************/
XPRIVATE	char	*fix_ctime(time)
X
Xint	*time;
X
X{	char	*p;
X
X	p = ctime(time);
X	p[24] = '\0';
X	return(p);
X}
X
X/************************************************************************/
XPRIVATE	e_ptr	get_parm(e, n)
X
Xe_ptr	e;
Xint	n;
X
X{	e_ptr	e1;
X	int	i, depth;
X
X	if (e == NULL)
X	   return(NULL);
X	for (e1 = e, depth = 1; e1->op == E_COMMA; e1 = e1->left)
X	   depth++;
X	if (n > depth)
X	   return(NULL);
X	else if (depth == 1)
X	   return(e);
X	else {
X	   for (i = depth - n; i; i--)
X	      e = e->left;
X	   return((n == 1)? e : e->right);
X	   }
X}
X
X/************************************************************************/
XPRIVATE	int	child_count(v)
X
Xv_ptr	v;
X
X{
X	return(v? child_count(v->left) + child_count(v->right) + 1 : 0);
X}
X
X/************************************************************************/
XPRIVATE	v_ptr	do_cardinality(e)
X
Xe_ptr	e;
X
X{	v_ptr	v;
X
X	v = tt_eval(e);
X	if (is_array(v))
X	   return(tt_int_result(child_count(v->value)));
X	else
X	   return(tt_int_result(0));
X}
X
X/************************************************************************/
XPRIVATE	v_ptr	do_cd(e)
X
Xe_ptr	e;
X
X{
X	return(tt_int_result(chdir(tt_string_of(tt_eval(e)))? 0 : 1));
X}
X
X/************************************************************************/
XPRIVATE	v_ptr	do_executable(e)
X
Xe_ptr	e;
X
X{	struct	stat	buf;
X	int	result;
X	char	*p;
X
X	if (stat(p = tt_string_of(tt_eval(e)), &buf) == 0 && access(p, X_OK) == 0)
X	   result = 1;
X	else
X	   result = 0;
X	return(tt_int_result(result));
X}
X
X/************************************************************************/
XPRIVATE	v_ptr	do_exists(e)
X
Xe_ptr	e;
X
X{	struct	stat	buf;
X
X	return(tt_int_result((stat(tt_string_of(tt_eval(e)), &buf) == -1)? 0 : 1));
X}
X
X/************************************************************************/
XPRIVATE	v_ptr	do_format(e)
X
Xe_ptr	e;
X
X{	char	fmt[1024], result[1024], *p, *q, *r, *format;
X	int	parm;
X	e_ptr	e1;
X
X	format = tt_string_of(tt_eval(get_parm(e, 1)));
X	for (parm = 1, q = result, p = fmt; *format; format++) {
X	   *p++ = *format;
X	   if (*format == '%') {
X	      for (format++; index("0123456789.-+ #", *format); )
X	         *p++ = *format++;
X	      *p++ = *format;
X	      *p = '\0';
X	      if (index("eEfgG", *format)) { /* print as a double */
X	         if ((e1 = get_parm(e, ++parm)) == NULL)
X	            abend("too few parameters supplied to 'format'");
X	         sprintf(q, fmt, tt_eval(e1)->number);
X	         }
X	      else if (index("cdloxXu", *format)) { /* print as integer */
X	         if ((e1 = get_parm(e, ++parm)) == NULL)
X	            abend("too few parameters supplied to 'format'");
X	         sprintf(q, fmt, (int) tt_eval(e1)->number);
X	         }
X	      else if (*format == 's') { /* a string */
X	         if ((e1 = get_parm(e, ++parm)) == NULL)
X	            abend("too few parameters supplied to 'format'");
X	         sprintf(q, fmt, tt_string_of(tt_eval(e1)));
X	         }
X	      else if (*format == '%')
X	         sprintf(q, fmt);
X	      else
X	         abend("invalid format character passed to 'format': %c", *format);
X	      q += strlen(q);
X	      p = fmt;
X	      }
X	   }
X	*p = '\0';
X	sprintf(q, fmt);
X	return(tt_string_result(result));
X}
X
X/************************************************************************/
XPRIVATE	v_ptr	do_getenv(e)
X
Xe_ptr	e;
X
X{	register	char	*p;
X
X	p = getenv(tt_string_of(tt_eval(e)));
X	return(tt_string_result(p? p : ""));
X}
X
X/************************************************************************/
XPRIVATE	v_ptr	do_group()
X
X{	register	struct	group	*gp;
X	register	int	gid;
X
X	if (gp = getgrgid(gid = getgid()))
X	   return(tt_string_result(gp->gr_name));
X	else
X	   return(tt_int_result(gid));
X}
X
X/************************************************************************/
XPRIVATE	v_ptr	do_head(e)
X
Xe_ptr	e;
X
X{	char	*p, *s;
X
X	p = tt_string_of(tt_eval(e));
X	if (s = rindex(p, '/'))
X	   *s = '\0';
X	return(tt_string_result(p));
X}
X
X/************************************************************************/
XPRIVATE	v_ptr	do_index(e)
X
X{	char	*source, *target;
X	int	i;
X
X	source = tt_string_of(tt_eval(get_parm(e, 1)));
X	target = tt_string_of(tt_eval(get_parm(e, 2)));
X	if (source == NULL || target == NULL)
X	   abend("too few parameters supplied to 'index'");
X	for (i = 1; *source; source++, i++) {
X	   for ( ; *source && *source != *target; source++, i++)
X	      ;
X	   if (strncmp(source, target, strlen(target)) == 0)
X	      return(tt_int_result(i));
X	   }
X	return(tt_int_result(0));
X}
X
X/************************************************************************/
XPRIVATE	v_ptr	do_is_open()
X
X{
X	return(tt_int_result(window_get(tt_base_window->frame, FRAME_CLOSED)? 0 : 1));
X}
X
X/************************************************************************/
XPRIVATE	v_ptr	do_length(e)
X
Xe_ptr	e;
X
X{
X	return(tt_int_result(strlen(tt_string_of(tt_eval(e)))));
X}
X
X/************************************************************************/
XPRIVATE	v_ptr	do_output_of(e)
X
Xe_ptr	e;
X
X{	FILE	*f;
X	char	*buf, *p;
X	int	amt, size;
X
X	if ((f = popen(tt_string_of(tt_eval(e)), "r")) == NULL)
X	   return(tt_int_result(-1));
X	for (buf = p = tt_emalloc(65536), size = 65536; size > 0 && (amt = fread(p, sizeof(char), 1024, f)); p += amt, size -= amt)
X	   ;
X	*p = '\0';
X	pclose(f);
X	return(tt_string_result(buf));
X}
X
X/************************************************************************/
XPRIVATE	v_ptr	do_pwd()
X
X{	char	buf[1024];
X
X	getwd(buf);
X	return(tt_string_result(buf));
X}
X
X/************************************************************************/
XPRIVATE	v_ptr	do_readable(e)
X
Xe_ptr	e;
X
X{	struct	stat	buf;
X	int	result;
X	char	*p;
X
X	if (stat(p = tt_string_of(tt_eval(e)), &buf) == 0 && access(p, R_OK) == 0)
X	   result = 1;
X	else
X	   result = 0;
X	return(tt_int_result(result));
X}
X
X/************************************************************************/
XPRIVATE	v_ptr	do_root(e)
X
Xe_ptr	e;
X
X{	char	*s, *p, *q;
X
X	p = tt_string_of(tt_eval(e));
X	s = rindex(p, '/');
X	q = rindex(p, '.');
X	if (s) {
X	   if (q > s)
X	      *q = '\0';
X	   }
X	else if (q)
X	   *q = '\0';
X	return(tt_string_result(p));
X}
X
X/************************************************************************/
XPRIVATE	v_ptr	do_selection(e)
X
Xe_ptr	e;
X
X{
X	return(tt_string_result(tt_get_selection((int) tt_eval(e)->number)));
X}
X
X/************************************************************************/
XPRIVATE	v_ptr	do_stat(e)
X
Xe_ptr	e;
X
X{	register	v_ptr	v;
X	struct	stat	buf;
X	register	struct	passwd	*pp;
X	register	struct	group	*gp;
X
X	v = (v_ptr) tt_emalloc(sizeof(v_data));
X	v->kind = V_ARRAY;
X	v->index = NULL;
X	v->value = NULL;
X	v->left = NULL;
X	v->right = NULL;
X	if (stat(tt_string_of(tt_eval(e)), &buf) == 0) {
X	   tt_insert_array(&(v->value), estrsave("mode"), tt_int_result(buf.st_mode));
X	   if (pp = getpwuid(buf.st_uid))
X	      tt_insert_array(&(v->value), estrsave("uid"), tt_string_result(pp->pw_name));
X	   else
X	      tt_insert_array(&(v->value), estrsave("uid"), tt_int_result(buf.st_uid));
X	   if (gp = getgrgid(buf.st_gid))
X	      tt_insert_array(&(v->value), estrsave("gid"), tt_string_result(gp->gr_name));
X	   else
X	      tt_insert_array(&(v->value), estrsave("gid"), tt_int_result(buf.st_gid));
X	   tt_insert_array(&(v->value), estrsave("size"), tt_int_result(buf.st_size));
X	   tt_insert_array(&(v->value), estrsave("atime"), tt_string_result(fix_ctime(&(buf.st_atime))));
X	   tt_insert_array(&(v->value), estrsave("mtime"), tt_string_result(fix_ctime(&(buf.st_mtime))));
X	   tt_insert_array(&(v->value), estrsave("ctime"), tt_string_result(fix_ctime(&(buf.st_ctime))));
X	   }
X	return(v);
X}
X
X/************************************************************************/
XPRIVATE	v_ptr	do_substr(e)
X
Xe_ptr	e;
X
X{	e_ptr	string, start, length;
X	char	*s;
X	int	st, l;
X
X	string = get_parm(e, 1);
X	start = get_parm(e, 2);
X	length = get_parm(e, 3);
X	if (get_parm(e, 4))
X	   abend("too many arguments passed to 'substr'");
X	s = estrsave(tt_string_of(tt_eval(string)));
X	if ((st = start? tt_eval(start)->number - 1 : 0) < 0)
X	   abend("negative starting position passed to 'substr': %d", st);
X	if ((l = length? tt_eval(length)->number : 0x7fffffff) < 0)
X	   abend("negative length passed to 'substr': %d", l);
X	if (st > strlen(s))
X	   *s = '\0';
X	else
X	   s += st;
X	if (l <= strlen(s))
X	   *(s + l) = '\0';
X	return(tt_string_result(s));
X}
X
X/************************************************************************/
XPRIVATE	v_ptr	do_suffix(e)
X
Xe_ptr	e;
X
X{	char	*s, *p, *q;
X
X	p = tt_string_of(tt_eval(e));
X	s = rindex(p, '/');
X	q = rindex(p, '.');
X	if (s)
X	   p = (q > s)? q + 1 : "";
X	else
X	   p = q? q + 1 : "";
X	return(tt_string_result(p));
X}
X
X/************************************************************************/
XPRIVATE	v_ptr	do_system(e)
X
Xe_ptr	e;
X
X{
X	return(tt_int_result(system(tt_string_of(tt_eval(e)))));
X}
X
X/************************************************************************/
XPRIVATE	v_ptr	do_tail(e)
X
Xe_ptr	e;
X
X{	char	*p, *s;
X
X	p = tt_string_of(tt_eval(e));
X	if (s = rindex(p, '/'))
X	   p = s + 1;
X	return(tt_string_result(p));
X}
X
X/************************************************************************/
XPRIVATE	v_ptr	do_tokenize(e)
X
Xe_ptr	e;
X
X{	register	char	**tokens, *line;
X	register	int	i, max_count;
X	register	v_ptr	v;
X	char	buf[20];
X	int	count;
X
X	line = tt_string_of(tt_eval(e));
X	tokens = (char **) tt_emalloc((max_count = strlen(line) / 2 + 2) * sizeof(char *));
X	tokenize(line, &count, tokens, max_count);
X	v = (v_ptr) tt_emalloc(sizeof(v_data));
X	v->kind = V_ARRAY;
X	v->index = NULL;
X	v->value = NULL;
X	v->left = NULL;
X	v->right = NULL;
X	for (i = 0; i < count; i++) {
X	   sprintf(buf, "%d", i);
X	   tt_insert_array(&(v->value), estrsave(buf), tt_string_result(tokens[i]));
X	   }
X	return(v);
X}
X
X/************************************************************************/
XPRIVATE	v_ptr	do_user()
X
X{	register	struct	passwd	*pp;
X	register	int	uid;
X
X	if (pp = getpwuid(uid = getuid()))
X	   return(tt_string_result(pp->pw_name));
X	else
X	   return(tt_int_result(uid));
X}
X
X/************************************************************************/
XPRIVATE	v_ptr	do_verify(e)
X
X{	char	*source, *valid;
X
X	source = tt_string_of(tt_eval(get_parm(e, 1)));
X	valid = tt_string_of(tt_eval(get_parm(e, 2)));
X	if (source == NULL || valid == NULL)
X	   abend("too few parameters supplied to 'verify'");
X	for ( ; *source; source++)
X	   if (index(valid, *source) == NULL)
X	      return(tt_int_result(0));
X	return(tt_int_result(1));
X}
X
X/************************************************************************/
XPRIVATE	v_ptr	do_writable(e)
X
Xe_ptr	e;
X
X{	struct	stat	buf;
X	int	result;
X	char	*p;
X
X	if (stat(p = tt_string_of(tt_eval(e)), &buf) == 0 && access(p, W_OK) == 0)
X	   result = 1;
X	else
X	   result = 0;
X	return(tt_int_result(result));
X}
END_OF_FILE
if test 13815 -ne `wc -c <'func.c'`; then
    echo shar: \"'func.c'\" unpacked with wrong size!
fi
# end of 'func.c'
fi
if test -f 'lex.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'lex.c'\"
else
echo shar: Extracting \"'lex.c'\" \(13060 characters\)
sed "s/^X//" >'lex.c' <<'END_OF_FILE'
X/************************************************************************/
X/*	Copyright 1988 by Chuck Musciano and Harris Corporation		*/
X/*									*/
X/*	Permission to use, copy, modify, and distribute this software	*/
X/*	and its documentation for any purpose and without fee is	*/
X/*	hereby granted, provided that the above copyright notice	*/
X/*	appear in all copies and that both that copyright notice and	*/
X/*	this permission notice appear in supporting documentation, and	*/
X/*	that the name of Chuck Musciano and Harris Corporation not be	*/
X/*	used in advertising or publicity pertaining to distribution	*/
X/*	of the software without specific, written prior permission.	*/
X/*	Chuck Musciano and Harris Corporation make no representations	*/
X/*	about the suitability of this software for any purpose.  It is	*/
X/*	provided "as is" without express or implied warranty.		*/
X/*									*/
X/*	The sale of any product based wholely or in part upon the 	*/
X/*	technology provided by tooltool is strictly forbidden without	*/
X/*	specific, prior written permission from Harris Corporation.	*/
X/*	Tooltool technology includes, but is not limited to, the source	*/
X/*	code, executable binary files, specification language, and	*/
X/*	sample specification files.					*/
X/************************************************************************/
X
X#define		RETURN(x)		return(last_token = (x))
X
X#define		FIRST_KEYWORD		ACTION
X#define		LAST_KEYWORD		WIDTH
X#define		NUM_KEYWORDS		(LAST_KEYWORD - FIRST_KEYWORD + 1)
X
X#define		CPP			"/lib/cpp"
X
XPRIVATE	FILE	*f;
XPRIVATE	int	last_token = -1;
XPRIVATE	char	buf[1024];
X
XPRIVATE	struct	{char	*name;
X		 int	value;
X		} token[] = {{"action",		ACTION},
X			     {"align",		ALIGN},
X			     {"application",	APPLICATION},
X			     {"at",		AT},
X			     {"base",		BASE},
X			     {"beep",		BEEP},
X			     {"bottom",		BOTTOM},
X			     {"break",		BREAK},
X			     {"button",		BUTTON},
X			     {"by",		BY},
X			     {"center",		CENTER},
X			     {"characters",	CHARACTERS},
X			     {"choice",		CHOICE},
X			     {"close",		CLOSE},
X			     {"completion",	COMPLETION},
X			     {"continue",	CONTINUE},
X			     {"control",	CONTROL},
X			     {"current",	CURRENT},
X			     {"cycle",		CYCLE},
X			     {"dialog",		DIALOG},
X			     {"disable",	DISABLE},
X			     {"display",	DISPLAY},
X			     {"else",		ELSE},
X			     {"end_button",	END_BUTTON},
X			     {"end_choice",	END_CHOICE},
X			     {"end_dialog",	END_DIALOG},
X			     {"end_gadgets",	END_GADGETS},
X			     {"end_key",	END_KEY},
X			     {"end_keys",	END_KEYS},
X			     {"end_label",	END_LABEL},
X			     {"end_menu",	END_MENU},
X			     {"end_mouse",	END_MOUSE},
X			     {"end_slider",	END_SLIDER},
X			     {"end_text",	END_TEXT},
X			     {"exit",		EXIT},
X			     {"font",		FONT},
X			     {"for",		FOR},
X			     {"function_keys",	FUNCTION_KEYS},
X			     {"gadgets",	GADGETS},
X			     {"horizontal",	HORIZONTAL},
X			     {"icon",		ICON},
X			     {"if",		IF},
X			     {"ignore",		IGNORE},
X			     {"initial",	INITIAL},
X			     {"initialize",	INITIALIZE},
X			     {"key",		KEY},
X			     {"keys",		KEYS},
X			     {"label",		LABEL},
X			     {"left",		LEFT},
X			     {"mark",		MARK},
X			     {"maximum",	MAXIMUM},
X			     {"menu",		MENU},
X			     {"meta",		META},
X			     {"middle",		MIDDLE},
X			     {"minimum",	MINIMUM},
X			     {"mouse",		MOUSE},
X			     {"nomark",		NOMARK},
X			     {"normal",		NORMAL},
X			     {"normal_keys",	NORMAL_KEYS},
X			     {"nothing",	NOTHING},
X			     {"off",		OFF},
X			     {"on",		ON},
X			     {"open",		OPEN},
X			     {"pixels",		PIXELS},
X			     {"popup",		POPUP},
X			     {"proportional",	PROPORTIONAL},
X			     {"ragged",		RAGGED},
X			     {"range",		RANGE},
X			     {"remove",		REMOVE},
X			     {"retain",		RETAIN},
X			     {"right",		RIGHT},
X			     {"send",		SEND},
X			     {"shift",		SHIFT},
X			     {"size",		SIZE},
X			     {"slider",		SLIDER},
X			     {"text",		TEXT},
X			     {"timer",		TIMER},
X			     {"top",		TOP},
X			     {"trigger",	TRIGGER},
X			     {"ttymenu",	TTYMENU},
X			     {"value",		VALUE},
X			     {"vertical",	VERTICAL},
X			     {"while",		WHILE},
X			     {"width",		WIDTH}};
X
XPRIVATE	struct	{char	first;
X		 char	next;
X		 int	name;
X		} punc[] = {{'&',  '\0', LOGICAL_AND},
X			    {'&',  '&',  AND},
X			    {'&',  '=',  ASSIGN_AND},
X			    {':',  '\0', COLON},
X			    {',',  '\0', COMMA},
X			    {'~',  '\0', COMPLEMENT},
X			    {'=',  '\0', ASSIGNMENT},
X			    {'=',  '=',  EQUAL},
X			    {'>',  '\0', GREATER},
X			    {'>',  '=',  GREATER_EQUAL},
X			    {'>',  '>',  RIGHT_SHIFT},
X			    {'{',  '\0', LBRACE},
X			    {'[',  '\0', LBRACK},
X			    {'<',  '\0', LESS},
X			    {'<',  '=',  LESS_EQUAL},
X			    {'<',  '<',  LEFT_SHIFT},
X			    {'!',  '\0', LOGICAL_NOT},
X			    {'!',  '=',  NOT_EQUAL},
X			    {'|',  '\0', OR},
X			    {'|',  '|',  LOGICAL_OR},
X			    {'|',  '=',  ASSIGN_OR},
X			    {'(',  '\0', LPAREN},
X			    {'-',  '\0', MINUS},
X			    {'-',  '-',  DECREMENT},
X			    {'-',  '=',  ASSIGN_MINUS},
X			    {'%',  '\0', MODULO},
X			    {'%',  '=',  ASSIGN_MODULO},
X			    {'+',  '\0', PLUS},
X			    {'+',  '+',  INCREMENT},
X			    {'+',  '=',  ASSIGN_PLUS},
X			    {'?',  '\0', QUESTION},
X			    {'}',  '\0', RBRACE},
X			    {']',  '\0', RBRACK},
X			    {')',  '\0', RPAREN},
X			    {';',  '\0', SEMICOLON},
X			    {'*',  '\0', TIMES},
X			    {'*',  '=',  ASSIGN_TIMES},
X			    {'^',  '\0', XOR},
X			    {'^',  '=',  ASSIGN_XOR},
X			    {'\0', '\0', -1}};
X
XPRIVATE	char	getch()
X
X{	register	char	c;
X	static		int	first = TRUE;
X
X	if (first) {
X	   first = FALSE;
X	   if ((f = popen(CPP, "r")) == NULL)
X	      abend("could not invoke %s", CPP);
X	   }
X	if (ungetc != -1)
X	   c = ungetc, ungetc = -1;
X	else {
X	   c = getc(f);
X	   if (c == '\n')
X	      line_count++;
X	   }
X	return(c);
X}
X
XPRIVATE	fix_escapes(buf)
X
Xchar	*buf;
X
X{	char	*q;
X	int	i;
X
X	for (q = buf; *buf; buf++, q++)
X	   if (*buf == '\\')
X	      switch (*++buf) {
X	         case 'b' : *q = '\010'; /* ^h */
X	            	    break;
X	         case 'e' : *q = '\033'; /* esc */
X	          	    break;
X	         case 'f' : *q = '\014'; /* ^l */
X	            	    break;
X	         case 'n' : *q = '\012'; /* ^j */
X	            	    break;
X	         case 'r' : *q = '\015'; /* ^m */
X	            	    break;
X	         case 't' : *q = '\011'; /* ^i */
X	            	    break;
X	         case '0' : 
X	         case '1' : 
X	         case '2' : 
X	         case '3' : 
X	         case '4' : 
X	         case '5' : 
X	         case '6' : 
X	         case '7' : *q = *buf++ - '0';
X	            	    for (i = 0; i < 2 && *buf >= '0' && *buf <= '7'; i++)
X	            	       *q = (*q << 3) + *buf++ - '0';
X	            	    buf--;
X	            	    break;
X	         default  : *q = *buf;
X	            	    break;
X	         }
X	   else if (*buf == '^' && *(buf + 1) >= '@' && *(buf + 1) <= '_')
X	      *q = *++buf & 0x1f;
X	   else
X	      *q = *buf;
X	*q = '\0';
X}
X
XPRIVATE	int	is_keyword(s)
X
Xchar	*s;
X
X{	register	int	cmp, high, low, pos;
X
X	for (low = 0, high = NUM_KEYWORDS - 1; low <= high; )
X	   if ((cmp = strcmp(s, token[pos = (high - low) / 2 + low].name)) == 0)
X	      return(token[pos].value);
X	   else if (cmp < 0)
X	      high = pos - 1;
X	   else
X	      low = pos + 1;
X	return(NULL);
X}
X
XPRIVATE	int	yylex()
X
X{	register	char	c, c1, *p;
X	register	int	i, j, val;
X	char			*index();
X	double			atof();
X
X	c = getch();
X	while (isspace(c))
X	   c = getch();
X	if (isalpha(c)) {
X	   p = buf;
X	   *p++ = c;
X	   while (isalnum(c = getch()) || c == '_')
X	      *p++ = c;
X	   ungetc = c;
X	   *p = '\0';
X	   for (p = buf; *p; p++)
X	      if (isupper(*p))
X	         *p = tolower(*p);
X	   if (i = is_keyword(buf))
X	      RETURN(i);
X	   if ((i = strlen(buf)) == 2) { /* possible two character function key name */
X	      if (buf[0] == 'l' && buf[1] >= '2' && buf[1] <= '9') /* l2 - l9 */
X	         RETURN(yylval.ival = L2 + buf[1] - '2');
X	      else if (buf[0] == 'f' && buf[1] >= '1' && buf[1] <= '9') /* f1 - f9 */
X	         RETURN(yylval.ival = F1 + buf[1] - '1');
X	      else if (buf[0] == 'r' && buf[1] >= '1' && buf[1] <= '9') /* r1 - r9 */
X	         RETURN(yylval.ival = R1 + buf[1] - '1');
X	      }
X	   else if (i == 3) { /* possible three character function key name */
X	      if (buf[0] == 'l' && buf[1] == '1' && buf[2] == '0')
X	         RETURN(yylval.ival = L10);
X	      else if (buf[0] == 'r' && buf[1] == '1' && buf[2] >= '0' && buf[2] <= '5') /* r10 - r15 */
X	         RETURN(yylval.ival = R10 + buf[2] - '0');
X	      }
X	   fix_escapes(buf);
X	   yylval.cpval = strsave(buf);
X	   RETURN(ID);
X	   }
X	else if (c == '"') {
X	   for (p = buf; TRUE; p++)
X	      if ((*p = getch()) == '"')
X	         break;
X	      else if (*p == '\\')
X	         *++p = getch();
X	      else if (*p == '\n' || *p == '\r') {
X	         yyerror("Newline in string not allowed");
X	         break;
X	         }
X	   *p = '\0';
X	   fix_escapes(buf);
X	   yylval.cpval = strsave(buf);
X	   RETURN(STRING);
X	   }
X	else if (c == '\'') {
X	   p = buf;
X	   for (p = buf; TRUE; p++)
X	      if ((*p = getch()) == '\'')
X	         break;
X	      else if (*p == '\\')
X	         *++p = getch();
X	      else if (*p == '\n' || *p == '\r') {
X	         yyerror("Newline in string not allowed");
X	         break;
X	         }
X	   *p = '\0';
X	   fix_escapes(buf);
X	   yylval.cpval = strsave(buf);
X	   RETURN(ICON_STRING);
X	   }
X	else if (isdigit(c)) {
X	   if (c == '0') {
X	      if ((c = getch()) == 'x') /* hex number */
X	         for (val = 0; isxdigit(c = getch()); )
X	            if (isdigit(c))
X	               val = val * 16 + c - '0';
X	            else
X	               val = val * 16 + c - (isupper(c)? 'A' : 'a');
X	      else if (isdigit(c)) /* octal */
X	         for (val = c - '0'; (c = getch()) >= '0' && c <= '7'; )
X	            val = val * 8 + c - '0';
X	      else if (c == '.') {
X	         ungetc = c;
X	         c = '0';
X	         goto do_real; /* with God as my witness, I'll never do this again, I swear */
X	         }
X	      else
X	         val = 0;
X	      ungetc = c;
X	      yylval.ival = val;
X	      RETURN(INTEGER);
X	      }
X	   else {
Xdo_real:      p = buf;
X	      *p++ = c;
X	      val = INTEGER;
X	      while (isdigit(c = getch()))
X	         *p++ = c;
X	      if (c == '.')
X	         for (*p++ = c, val = REAL; isdigit(c = getch()); )
X	            *p++ = c;
X	      if (c == 'e' || c == 'E') {
X	         *p++ = c;
X	         if ((c = getch()) == '-' || c == '+')
X	            *p++ = c;
X	         else
X	            ungetc = c;
X	         for (val = REAL; isdigit(c = getch()); )
X	            *p++ = c;
X	         }
X	      *p = '\0';
X	      ungetc = c;
X	      if (val == INTEGER)
X	         yylval.ival = atoi(buf);
X	      else
X	         yylval.rval = atof(buf);
X	      RETURN(val);
X	      }
X	   }
X	else if (c == '/') {
X	   if ((c = getch()) == '*') {
X	      while (1) {
X	         while ((c = getch()) != '*')
X	            ;
X	         if ((c = getch()) == '/')
X	            break;
X	         }
X	      }
X	   else if (c == '=')
X	      RETURN(ASSIGN_DIVIDE);
X	   else {
X	      ungetc = c;
X	      RETURN(DIVIDE);
X	      }
X	   }
X	else if (c == '#') {
X	   if (yylex() == INTEGER) {
X	      line_count = yylval.ival - 1; /* getch will bump by 1 when \n is read */
X	      if (yylex() == STRING) {
X	         if (*yylval.cpval)
X	            tt_curr_file = yylval.cpval;
X	         while (getch() != '\n')
X	            ;
X	         RETURN(yylex());
X	         }
X	      }
X	   yyerror("Invalid cpp control sequence in source file");
X	   }
X	else if (c == EOF) {
X	   pclose(f);
X	   RETURN(EOF);
X	   }
X	else {
X	   for (i = 0; punc[i].first; i++)
X	      if (c == punc[i].first) {
X	         for (c1 = getch(), j = 1; punc[i + j].first == c; j++)
X	            if (c1 == punc[i + j].next)
X	               RETURN(punc[i + j].name);
X	         ungetc = c1;
X	         RETURN(punc[i].name);
X	         }
X	   yyerror("Invalid character in source file: %c (0x%02x)", c, c);
X	   }
X	RETURN(yylex());
X}
X
X/************************************************************************/
XPRIVATE	print_last_token()
X
X{	int	i;
X
X	fprintf(stderr, " at or near \"");
X	if (last_token == INTEGER || last_token == REAL || last_token == STRING || last_token == ICON_STRING || last_token == ID)
X	   fprintf(stderr, buf);
X	else if (last_token >= L2 && last_token <= L10)
X	   fprintf(stderr, "L%d", last_token - L2 + 2);
X	else if (last_token >= F1 && last_token <= F9)
X	   fprintf(stderr, "F%d", last_token - F1 + 1);
X	else if (last_token >= R1 && last_token <= R15)
X	   fprintf(stderr, "R%d", last_token - R1 + 1);
X	else if (last_token >= AND && last_token <= XOR) {
X	   for (i = 0; punc[i].first; i++)
X	      if (punc[i].name == last_token) {
X	         fprintf(stderr, "%c", punc[i].first);
X	         if (punc[i].next)
X	            fprintf(stderr, "%c", punc[i].next);
X	         break;
X	         }
X	   if (punc[i].first == '\0')
X	      fprintf(stderr, "!!Geez!  Some punctuation, I don't know!!");
X	   }
X	else if (last_token >= FIRST_KEYWORD && last_token <= LAST_KEYWORD)
X	   fprintf(stderr, token[last_token - FIRST_KEYWORD].name);
X	else if (last_token == EOF)
X	   fprintf(stderr, "End Of File");
X	else
X	   fprintf(stderr, "!!Geez!  Some keyword, I don't know!!");
X	fprintf(stderr, "\"");
X}
END_OF_FILE
if test 13060 -ne `wc -c <'lex.c'`; then
    echo shar: \"'lex.c'\" unpacked with wrong size!
fi
# end of 'lex.c'
fi
echo shar: End of archive 5 \(of 13\).
cp /dev/null ark5isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 ; do
    if test ! -f ark${I}isdone ; then
	MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 13 archives.
    rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
    echo You still need to unpack the following archives:
    echo "        " ${MISSING}
fi
##  End of shell archive.
exit 0

Chuck Musciano			ARPA  : chuck@trantor.harris-atd.com
Harris Corporation 		Usenet: ...!uunet!x102a!trantor!chuck
PO Box 37, MS 3A/1912		AT&T  : (407) 727-6131
Melbourne, FL 32902		FAX   : (407) 727-{5118,5227,4004}