# This is a shell archive.  Remove anything before this line,
# then unpack it by saving it in a file and typing "sh file".
#
# Wrapped by tralfaz!ove on Wed Jan 13 10:52:52 PST 1988
# Contents:  Makefile ansi.c comed.c craytool.c editwin.c epanel.c macro.c
#	send.c tpanel.c craytool.h fkeys.h .craymacros
 
echo x - Makefile
sed 's/^@//' > "Makefile" <<'@//E*O*F Makefile//'
CFLAGS = -O		# -pg for profiling
LIBS =	-lsuntool -lsunwindow -lpixrect -lm

OBJ = 	craytool.o comed.o macro.o editwin.o tpanel.o epanel.o ansi.o send.o

@.SUFFIXES : 
@.SUFFIXES : .o .c

craytool : $(OBJ)
	cc $(CFLAGS) -o craytool $(OBJ) $(LIBS)

$(OBJ) : fkeys.h craytool.h

@.c.o :
	cc $(CFLAGS) -c $*.c

@//E*O*F Makefile//
chmod u=rw,g=r,o=r Makefile
 
echo x - ansi.c
sed 's/^@//' > "ansi.c" <<'@//E*O*F ansi.c//'
/* Stuff to make a canvas window take ansi sequences */

#include "craytool.h"

#define R	ansi_win->row
#define C	ansi_win->col

Pixwin	*pw ;

char	blanks[NCOLS+1] ;
char	linebuf[NCOLS+1] ;
int	reverse_flag ;		/* if set, change video on next setcursor */
int	reverse ;		/* actual flag */
struct timeval belltime = { 0, 100000 } ;



/* macros for writing text fast */

#define XX(c)	(char_width*(c) + char_width/4)
#define YY(r)	(char_height*(r) + (char_height*3)/4)

/* Put a character at (r,c) in a canvas window */
#define scribec(r, c, ch) \
	if ( reverse ) pw_char(pw, XX(c), YY(r), PIX_NOT(PIX_SRC), NULL, ch); \
	else pw_char(pw, XX(c), YY(r), PIX_SRC, NULL, ch) ;


/* Put a character at (r,c) in a canvas window in reverse video */
#define rev_scribec(r, c, ch) \
	pw_char(pw, XX(c), YY(r), PIX_NOT(PIX_DST), NULL, ch);

/* Put a string at (r,c) in a canvas windwo */
#define scribes(r, c, s) \
	if ( reverse ) pw_text(pw, XX(c), YY(r), PIX_NOT(PIX_SRC), NULL, s) ;\
	else pw_text(pw, XX(c), YY(r), PIX_SRC, NULL, s) ;




/* WIN_ANSI
 *
 * Limited ansi support routine for a canvas subwindow.  Send a string
 * of characters to the screen at the current location.  Output to the
 * the screen is optimized by batching the vector.
 */
#define ESC_BUFSIZE	20

win_ansi(ansi_win,s)
struct Ansi_win *ansi_win ;
char	*s ;
{
int	i, j, r, c ;
char	ch ;
static char	escbuf[ESC_BUFSIZE] ;
static int	count, counting ;

/* on first call, initialize */
if ( blanks[0] != ' ' ) {
	for (i=0;i<NCOLS;i++) blanks[i] = ' ' ;
	blanks[NCOLS] = NULL ;
	pw = canvas_pixwin(ansi_win->canvas) ;
}


/* batching on here ....*/
pw_batch_on(pw) ;

for (; NULL != *s; s++ ) {
	ch = *s ;

	/* check for ordinary character first to reduce overhead */
	if ( !counting && ch > '\033' ) {
		overtype_char(ansi_win,ch) ;
		continue ;
	}

	/* parse the escape sequences */
	if ( ch == '\033' || counting ) {

		if ( ch == '\033' ) {		/* start of escape */
			count = 0 ;
			counting = 1 ;
		}
		else if ( count==0 && ch!='[' ) { /* only ESC [ allowed */
			count = 0 ;
			counting = 0 ;
		}
		else if ( count >= ESC_BUFSIZE ) {
			count = 0 ;
			counting = 0 ;
		}
		else {		/* doing escape sequence */
			escbuf[count] = ch ;
			count++ ;

			/* look for a recognised escape terminator */
			switch (ch) {
			
			case 'H' : case 'f' :	/* set cursor */
				escbuf[count] = NULL ;
				if (2==sscanf(escbuf,"[%d;%dH",&r,&c)){
					r-- ; c-- ;
				}
				else if (1==sscanf(escbuf,"[;%dH",&c)){
					r = 0 ; c-- ;
				}
				else if (1==sscanf(escbuf,"[%d;H",&r)){
					r-- ; c = 0 ;
				}
				else {
					r = 0; c = 0 ;
				}
				count = 0 ; counting = 0 ;
				setcursor(ansi_win,r,c) ;
				break ;

			case 'K' :	/* eeol */
				count = 0 ; counting = 0 ;
				eeol(ansi_win) ;
				break ;

			case 'J' :	/* eeop */
				count = 0 ; counting = 0 ;
				eeop(ansi_win) ;
				break ;

			case 'm' :	/* reverse video */
				reverse_flag =
					(1 == sscanf(escbuf,"[%dm",&r) && r) ;
				count = 0 ; counting = 0 ;
				break ;

			/* unsupported but valid terminators */
			case '@' : case 'A' : case 'B' : case 'C' : case 'D' :
			case 'E' : case 'L' : case 'M' : case 'P' :
				count = 0 ; counting = 0 ;
				break ;
			}
		}
	}

	else {		/* other control chars: \b, \t, etc */
		switch (ch) {

		case '\b' :
			backspace(ansi_win) ;
			break ;
		case '\014' :	/* ^L clear the screen */
			setcursor(ansi_win,0,0) ;
			eeop(ansi_win) ;
			break ;
		case '\t' :
			tab(ansi_win) ;
			break ;
		case '\n' :
			newline(ansi_win) ;
			break ;
		case '\015' :
			break ;
		case '\007' :
			win_bell(window_get(ansi_win->canvas,WIN_FD), belltime,
				canvas_pixwin(ansi_win->canvas)) ;
			break ;
		default :
			overtype_char(ansi_win,ch) ;
		}
	}
}

/* batching off here ... */
pw_batch_off(pw) ;
}



/* A bunch of ansi editing functions.  These routines update the ansi_win->image
 * buffer of the window as well as maintaining (and displaying) the cursor
 * location.
 */
eeol(ansi_win)
struct Ansi_win *ansi_win ;
{
	reverse = reverse_flag ;
	memcpy( &ansi_win->image[C + R*NCOLS], blanks, NCOLS - C) ;
	memcpy( linebuf, blanks, NCOLS - C) ;
	linebuf[NCOLS-C] = NULL ;
	scribes(R, C, linebuf) ;
	setcursor(ansi_win,R,C) ;
}

eeop(ansi_win)
struct Ansi_win *ansi_win ;
{
int	i ;

	reverse = reverse_flag ;
	eeol(ansi_win) ;
	for ( i = R+1; i < NROWS; i++ ) {
		memcpy( &ansi_win->image[i*NCOLS], blanks, NCOLS ) ;
		scribes(i, 0, blanks) ;
	}
	setcursor(ansi_win,R,C) ;	/* cursor stays put, redisplay */
}

setcursor(ansi_win,r,c)
struct Ansi_win *ansi_win ;
int	r, c ;
{
char	ch ;

	r = min( r, NROWS-1 ) ;
	c = min( c, NCOLS-1 ) ;
	r = max( r, 0 ) ;
	c = max( c, 0 ) ;

	ch = ansi_win->image[ C + R*NCOLS ] ;	/* char at old cursor */
	scribec(R, C, ch) ;			/* restore char */
	reverse = reverse_flag ;
	R = r ;
	C = c ;
	ch = ansi_win->image[ C + R*NCOLS ] ;	/* char at new cursor */
	rev_scribec(R, C, ch) ;			/* draw new cursor */
}

newline(ansi_win)
struct Ansi_win *ansi_win ;
{
int	i ;

	/* clear screen if at bottom (scrolling is slow) */
	if ( R == NROWS-1 ) {
		setcursor(ansi_win, 0, 0) ;
		eeop(ansi_win) ;
	}
	else setcursor(ansi_win, R+1, 0) ;
}

tab(ansi_win)
struct Ansi_win *ansi_win ;
{
int	newcol ;

	newcol = min( 1+(C|7), NCOLS-1 ) ;
	if ( C != newcol ) setcursor(ansi_win, R, newcol) ;
}

backspace(ansi_win)
struct Ansi_win *ansi_win ;
{
	if ( C ) setcursor(ansi_win, R, C-1) ;
}

overtype_char(ansi_win,ch)
struct Ansi_win *ansi_win ;
char	ch ;
{
int	i ;
char	*s ;

	reverse = reverse_flag ;
	ansi_win->image[ C + R*NCOLS ] = ch ;
	scribec(R, C, ch) ;
	if ( C < NCOLS-1 ) setcursor(ansi_win, R, C+1) ;
	else setcursor(ansi_win, R, C) ;
}

insert_char(ansi_win,ch)
struct Ansi_win *ansi_win ;
char	ch ;
{
int	i ;
char	*s ;

	reverse = reverse_flag ;
	for ( i=NCOLS-2; i>=C; i--) {
		s = &ansi_win->image[i + R*NCOLS] ;
		*(s+1) = *s ;
		scribec(R, i+1, *s) ;
	}
	ansi_win->image[ C + R*NCOLS ] = ch ;
	scribec(R, C, ch) ;
	if ( C < NCOLS-1 ) setcursor(ansi_win, R, C+1) ;
	else setcursor(ansi_win, R, C) ;
}

@//E*O*F ansi.c//
chmod u=rw,g=r,o=r ansi.c
 
echo x - comed.c
sed 's/^@//' > "comed.c" <<'@//E*O*F comed.c//'
/* COMED.C
 *
 * Command line editor (emacs based) and macro processing facilities
 * for craytool.  This stuff maintains a list (ring) of past input lines,
 * allows them to be invoked with up/down cursor keys, and edited with
 * emacs sequences and function keys.  Macros in the style of prep are
 * also supported.  The telnet process must have the echo turned off
 * when this stuff is active.
 */
 
#include "craytool.h"
#include "netdb.h"

#define RINGSIZE	20
#define DEF_BUFSIZE	100
#define NEXT(i)		( i+1 >= RINGSIZE ? 0          : i+1 )
#define PREV(i)		( i-1 < 0         ? RINGSIZE-1 : i-1 )
#define META		0x80

/* def of Ring struct.  Note: entries are to be malloced */
struct Ring {
	int	size ;			/* number of entries (RINGSIZE) */
	int	add ;			/* add next entry here */
	int	active ;		/* entry currently being edited */
	char	*entry[RINGSIZE] ;
} lr ;

char	*line ;			/* current line */
int	index = 0 ;		/* current cursor location */
int	allocation = DEF_BUFSIZE ;	/* current size of "line" buffer */
int	characters ;		/* length of string in buffer */
char	c_previous ;		/* last command character ACCEPTED */
char	buf[DEF_BUFSIZE] ;	/* scratch buffer */

char	*mac_proc(), *strtok(), *getenv() ;


/* TTY_INIT
 *
 * Initialize tty window and comed stuff.  The tools are initially
 * turned off so that the password will not be echoed.
 */
tty_init()
{
int	i ;
unsigned int inet_addr ;
FILE	*macfile ;
char	*ptr, macfile_name[DEF_BUFSIZE] ;

	create_tty_control_panel(frame) ;
	ttysw = window_create(frame, TTY,
		WIN_BELOW,			tpanel,
		TTY_ARGV,			tty_argv,
		TTY_QUIT_ON_CHILD_DEATH,	TRUE,
		WIN_ROWS,			NROWS+5,
		WIN_COLUMNS,			NCOLS,
		0);
	comed_flag = FALSE ;
	notify_interpose_event_func(ttysw, tty_interposer, NOTIFY_SAFE) ;

	/* ring initialization */
	lr.size = RINGSIZE ;
	lr.add = 0 ;
	lr.active = 0 ;
	for ( i=0; i<lr.size; i++ ) {
		lr.entry[i] = malloc( DEF_BUFSIZE ) ;
		lr.entry[i][0] = NULL ;
	}
	line = malloc( DEF_BUFSIZE ) ;
	*line = NULL ;

	/* set up initial macros */
	/* macro to invoke the editor */
	gethostname(buf,DEF_BUFSIZE) ;
	inet_addr = *(unsigned int*)(gethostbyname(buf)->h_addr) ;
	sprintf(buf, ":ue uemacs %d.%d.%d.%d ;",
		(inet_addr & 0xFF000000) >> 24,
		(inet_addr & 0x00FF0000) >> 16,
		(inet_addr & 0x0000FF00) >> 8,
		(inet_addr & 0x000000FF)	) ;
	mac_proc(buf) ;

	/* read in the standard macro file */
	sprintf(macfile_name, "%s/.craymacros", getenv("HOME")) ;
	if ( NULL != ( macfile = fopen( macfile_name, "r" ) ) ) {
		while ( fgets(buf, DEF_BUFSIZE, macfile) ) {
			buf[strlen(buf)-1] = NULL ;	/* remove newline */
			ptr = mac_proc(buf) ;
			if ( ptr ) free(ptr) ;		/* should be null */
		}
		fclose( macfile ) ;
	}
}



/* TTY Interposer
 *
 * Control passes here when a signal is received from the console while
 * in the tty window.  Handles the editing of the buffer, updates the
 * screen (with ansi sequences), and passes completed lines to the ring
 * and macro processor.
 */
Notify_value tty_interposer(frame, event, arg, type)
Frame	frame ;
Event	*event ;
Notify_arg arg ;
Notify_event_type type ;
{
int		tc ;
char		ch ;
static int	c ;

	/* bypass routine altogether if disabled by the flag */
	if ( !comed_flag ) {
		/* don't let the user kill telnet accidentally with EOF */
		if ( 0x7F & (int)event_id(event) == CTRL(d) )
			return( NOTIFY_DONE ) ;
		else
			return( notify_next_event_func(frame,event,arg,type) ) ;
	}

	/* pass unsupported events to the base handler */
	if ( !event_is_ascii(event) && !event_is_key_right(event) )
		return( notify_next_event_func(frame,event,arg,type) ) ;

	/* map sequences and character keys to control keys */
	tc = map_key(event) ;
	if ( tc ) {	/* got one */
		c_previous = c ;
		c = tc ;
	}
	else return( NOTIFY_DONE ) ;


	switch ( c ) {
		
	case CTRL(a) :
		tty_bol() ; break ;
		
	case CTRL(e) :	/* if "bare", send immediately */
		if ( characters ) tty_eol() ;
		else {
			ch = 0x7F & c ;
			ttysw_input(ttysw, &ch, 1) ;
		}
		break ;

	case CTRL(f) :
		tty_forward() ; break ;
		
	case CTRL(b) :
		tty_backward() ; break ;
		
	case CTRL(d) :
		tty_del() ; break ;
		
	case CTRL(k) :
		tty_kill() ; break ;

	case CTRL(h) : case 127 :
		tty_backspace() ; break ;
		
	case CTRL(n) :
		tty_next() ; break ;
		
	case CTRL(p) :
		tty_previous() ; break ;
		
	case CTRL(m) : case CTRL(j) :
		tty_enter() ; break ;

	case META | 'f' : case META | 'F' :
		tty_forword() ; break ;
		
	case META | 'b' : case META | 'B' :
		tty_backword() ; break ;
		
	default :
		/* if unused ctrl chars are typed, clear line and send char */
		if ( c == CTRL(i) ) c = ' ' ;	/* tab kludge */
		if ( c < 32 ) {
			tty_bol() ;
			tty_kill() ;
			ch = 0x7F & c ;
			ttysw_input(ttysw, &ch, 1) ;
		}
		else {	/* otherwise insert it */
			ch = 0x7F & c ;
			tty_insert_char(ch) ;
		}
	}
	
	return( NOTIFY_DONE ) ;
}



/* MAP_KEY
 *
 * Maps function keys and character sequences to a control integer.
 * ESC c is mapped to		META | (int)c.
 * ESC [ {ABCD} is mapped to	an emacs cursor control key
 * If in the middle of a potential sequence, returns null.
 * Handles wierd sun tty fkey sequences.
 */
int	map_key(event)
Event	*event ;
{
static int	c, lastc ;
static int	cursor_flag ;		/* last two were ESC [ */
static int	esc_flag ;		/* last was ESC */
static char	buf[80], buf_index = 0 ;/* esc sequence buffer */
int		fkey ;

	esc_flag = ( c == ESC ) ;
	lastc = c ;

	if ( cursor_flag ) {
		cursor_flag = FALSE ;		/* assume a terminator */
		lastc = NULL ;
		c = 0x7F & (int)event_id(event) ;

		switch ( c ) {
		case 'A' : c = CTRL(p) ;	/* up, ^P */
			break ;
		case 'B' : c = CTRL(n) ;	/* down, ^N */
			break ;
		case 'C' : c = CTRL(f) ;	/* forward, ^F */
			break ;
		case 'D' : c = CTRL(b) ;	/* backward, ^B */
			break ;
		case 'z' :			/* sun tty fkey terminator */
			if ( sscanf(buf, "%d", &fkey) ) {
				switch ( fkey ) {
				case 214 :
					c = CTRL(a) ; break ;	/* bol */
				case 216 :
					c = CTRL(e) ; break ;	/* eol */
				case 220 :
					c = META | 'b' ; break ;/* next word */
				case 222 :
					c = META | 'f' ; break ;/* prev word */
				default :
					c = NULL ;
				}
			}
			else c = NULL ;
			break ;
				
		default :  			/* add to buf */
			buf[buf_index++] = c ;
			buf[buf_index] = NULL ;
			cursor_flag = TRUE ;	/* keep looking */
			c = NULL ;
		}
	}

	else if ( esc_flag ) {
		c = 0x7F & (int)event_id(event) ;
		if ( c == '[' ) {
			cursor_flag = TRUE ;
			buf_index = 0 ;
			*buf = NULL ;
			return(NULL) ;
		}
		lastc = NULL ;
		c |= META ;
	}
	else {
		c = 0x7F & (int)event_id(event) ;
		if ( c == ESC ) return(NULL) ;
	}
	
	return(c) ;
}



/* INSERT_CHAR
 *
 * Insert a character at the current cursor location.
 */
tty_insert_char(c)
char	c ;
{
int	i ;

	/* make the buffer bigger if necessary */
	if ( characters > DEF_BUFSIZE-2 ) {
		allocation += DEF_BUFSIZE ;
		line = realloc( line, allocation ) ;
	}

	/* update the buffer */
	for ( i=characters; i>index; i-- ) line[i] = line[i-1] ;
	line[index++] = c ;
	line[++characters] = NULL ;
	
	/* update the display */
	ttysw_output(ttysw, "\033[@", 3) ;	/* insert blank */
	ttysw_output(ttysw, &c, 1) ;
}


/* BOL
 *
 * Move the cursor to the beginning of the line.
 */
tty_bol()
{
	if ( index ) {
		sprintf(buf, "\033[%dD", index) ;
		ttysw_output(ttysw, buf, strlen(buf)) ;
		index = 0 ;
	}
}


/* EOL
 *
 * Move the cursor to the end of the line.
 */
tty_eol()
{
int	move = characters - index ;	/* distance to move cursor */

	if ( index != characters ) {
		index = characters ;
		sprintf(buf, "\033[%dC", move) ;
		ttysw_output(ttysw, buf, strlen(buf)) ;
	}
}


/* FORWARD
 *
 * Move the cursor right 1 character
 */
tty_forward()
{
	if ( index < characters ) {
		index++ ;
		ttysw_output(ttysw, "\033[C", 3) ;
	}
}


/* BACKWARD
 *
 * Move the cursor left 1 character
 */
tty_backward()
{
	if ( index > 0 ) {
		index-- ;
		ttysw_output(ttysw, "\033[D", 3) ;
	}
}


/* NEXT WORD
 *
 * Move the cursor right 1 word.
 */
tty_forword()
{
int	i ;

	for ( i = index; i < characters; i++ )	/* to 1st non-alpha */
		if ( ! isalnum(line[i]) ) break ;
	for ( ; i < characters; i++ )		/* to 1st alpha */
		if ( isalnum(line[i]) ) break ;
	if ( i > index ) {
		sprintf(buf, "\033[%dC", i - index) ;
		ttysw_output(ttysw, buf, strlen(buf)) ;
		index = i ;
	}
}


/* PREV WORD
 *
 * Move the cursor left 1 word.
 */
tty_backword()
{
int	i ;

	for ( i = index; i > 0; i--)		/* to 1st non-alpha */
		if ( ! isalnum(line[i]) ) break ;
	for ( ; i > 0; i--)			/* to 1st alpha */
		if ( isalnum(line[i]) ) break ;
	for ( ; i > 0; i--)			/* to next non-alpha */
		if ( ! isalnum(line[i]) ) break ;
	if ( i != index && !isalnum(line[i]) ) i++ ;	/* 1st char of word */

	if ( i < index ) {
		sprintf(buf, "\033[%dD", index - i) ;
		ttysw_output(ttysw, buf, strlen(buf)) ;
		index = i ;
	}
}


/* DEL
 *
 * Delete the current character.
 */
tty_del()
{
	if ( index < characters ) {
		strcpy( &line[index], &line[index+1] ) ;
		line[--characters] = NULL ;
		ttysw_output(ttysw, "\033[P", 3) ;
	}
}


/* KILL
 *
 * Erase from current char to eol.
 */
tty_kill()
{
	if ( index < characters ) {
		strcpy( &line[index], &line[index+1] ) ;
		characters = index ;
		line[characters] = NULL ;
		ttysw_output(ttysw, "\033[K", 3) ;
	}
}


/* BACKSPACE
 *
 * Erase character at index-1.
 */
tty_backspace()
{
	if ( index > 0 ) {
		strcpy( &line[index-1], &line[index] ) ;
		index-- ;
		line[--characters] = NULL ;
		ttysw_output(ttysw, "\010\033[P", 4) ;
	}
}


/* ENTER
 *
 * Process the completed string.
 */
tty_enter()
{
char	*text, *part, *pntr ;

	/* update the screen */
	ttysw_output(ttysw, "\015\n", 2) ;

	/* move the line to the ring if
	 *	1) it is not a macro definition
	 *	2) it was not just popped from the ring
	 *	3) it isn't very short.
	 */
	if ( !defining_macro && NULL == def_check(line) &&
	     c_previous != CTRL(n) && c_previous != CTRL(p) &&
	     strlen(line) > 3 ) {
		lr.entry[lr.add] =
			realloc( lr.entry[lr.add], allocation ) ;
		strcpy( lr.entry[lr.add], line ) ;
		lr.add = NEXT(lr.add) ;
		lr.active = lr.add ;
		lr.entry[lr.add][0] = NULL ;
	}
	
	/* expand any macros in the line, or define macro if this is a def */
	text = mac_proc(line) ;
	
	/* send the expanded text to the telnet process, being careful not
	 * to swamp it.
	 */
	if ( text ) {
		pntr = text ;
		while ( NULL != ( part = strtok(pntr, "\n") ) ) {
			pntr = NULL ;
			if (strlen(part) > DEF_BUFSIZE) part[DEF_BUFSIZE] = NULL ;
			ttysw_input(ttysw, part, strlen(part)) ;
			ttysw_input(ttysw, "\n", 1) ;
		}
		/* send blank lines & newlines as a newline */
		if ( pntr == text ) ttysw_input(ttysw, "\n", 1) ;
		free(text) ;
	}

	/* reset the line buffer */
	line = realloc(line, DEF_BUFSIZE) ;
	allocation = DEF_BUFSIZE ;
	line[0] = NULL ;
	index = 0 ;
	characters = 0 ;
}


/* PREVIOUS
 *
 * Pop the previous line from the ring into the active state.
 */
tty_previous()
{
int	i ;

	for ( i=0; i<lr.size; i++ ) {
		lr.active = PREV(lr.active) ;
		if ( lr.entry[lr.active][0] != NULL ) break ;
	}

	if ( i == lr.size ) return ;	/* no entries */

	/* kill current line */
	tty_bol() ;
	tty_kill() ;
	
	/* copy new line to the buffer */
	characters = strlen( lr.entry[lr.active] ) ;
	allocation = characters + DEF_BUFSIZE ;
	line = realloc( line, allocation ) ;
	strcpy( line, lr.entry[lr.active] ) ;
	index = characters ;
	
	/* update the screen */
	ttysw_output(ttysw, line, characters) ;
}


/* NEXT
 *
 * Like previous but goes in the other direction.
 */
tty_next()
{
int	i ;

	for ( i=0; i<lr.size; i++ ) {
		lr.active = NEXT(lr.active) ;
		if ( lr.entry[lr.active][0] != NULL ) break ;
	}

	if ( i == lr.size ) return ;	/* no entries */

	/* kill current line */
	tty_bol() ;
	tty_kill() ;
	
	/* copy new line to the buffer */
	characters = strlen( lr.entry[lr.active] ) ;
	allocation = characters + DEF_BUFSIZE ;
	line = realloc( line, allocation ) ;
	strcpy( line, lr.entry[lr.active] ) ;
	index = characters ;
	
	/* update the screen */
	ttysw_output(ttysw, line, characters) ;
}


/* ERR_MSG
 *
 * Display an error message on the tty window.
 */
err_msg(s)
char	*s ;
{
	ttysw_output(ttysw, s, strlen(s)) ;
	ttysw_output(ttysw, "\015\n", 2) ;
}

@//E*O*F comed.c//
chmod u=rw,g=r,o=r comed.c
 
echo x - craytool.c
sed 's/^@//' > "craytool.c" <<'@//E*O*F craytool.c//'
/* Craytool.c   tty/ canvas pop-up/ tcp/ display oriented version
 *
 * Written by P.R.Ove 7/87
 *
 * Copyright 1897 (C) Regents of the University of Illinois
 *
 *    Tool for cray emacs support over a communications line.  This tool
 * provides a normal tty subwindow in which telnet is run, connected to
 * the cray.  When the editor is invoked, it sends a signal to the tool
 * so that it may start up the tcp emacs "server".  The editor (on the cray)
 * then attempts to contact the server.  When the connection is made,
 * a canvas window (with partial ansi support) is invoked and the tcp
 * i/o is attached to it.
 *
 * A canvas window is used for the editor because:
 *   1) Sunview is brain-damaged and allows only 1 tty subwindow/process,
 *      and insists on loading another process in the window.
 *   2) Textsw's provide many features not needed, and not all that are.
 *      They also keep an edit log, which may overflow.  In general the
 *      features are designed for editing files locally.
 *   3) Only a display is required, and the canvas is most easily controlled.
 *   4) What is really needed is a vt100 emulator that takes a stream and
 *      directs a simple display window.  This is missing in sunview and
 *      is provided for here in a limited form.
 *
 * Planned improvements:
 *   1) vms style command editor for the tty window....Done
 *   2) pop-up graphics support....maybe
 *
 * 7/87 and counting...
 *
 * Thanks to Steve Dorner and Bob Sault for help in getting all of this
 * stuff to work.
 */


#define MAIN	1
#include "craytool.h"


/* MAIN
 *
 * Set up the TTY window telnet process, and set up the emacs display
 * pop-up "server".
 */
main(argc,argv)
int argc ;
char **argv ;
{
int	i ;

	/* check to see if called correctly */
	if ( argc < 3 ) {
		fprintf(stderr,"Usage: %s telnet cray [switches]\n",argv[0]) ;
		exit(1) ;
	}

	/* initialization */
	flush_char = 128 ;

	/* create a control panel and a tty window in the frame */
	frame = window_create(NULL, FRAME, 
		FRAME_ARGS,	argc, argv,
		WIN_ERROR_MSG,	"Cannot create frame", 
		FRAME_LABEL,
			"NCSA Cray/Sun Distributed Emacs Tool    P.R.Ove 1987",
		FRAME_SUBWINDOWS_ADJUSTABLE,	FALSE,
		0);

	/* run "telnet" login process in tty window */
	tty_argv[0] = argv[1] ;		/* telnet */
	tty_argv[1] = argv[2] ;		/* host */
	tty_argv[2] = NULL ;
	tty_init() ;
	window_fit(frame) ;

	define_popup() ;
		
	notify_interpose_destroy_func(frame, exodus) ;

	window_main_loop(frame);
}


/* EXODUS
 *
 * Go out of business.
 */
Notify_value exodus(client, status)
Notify_client	client ;
Destroy_status	status ;
{
	close(comm) ;
	return(notify_next_destroy_func(client,status)) ;
}
@//E*O*F craytool.c//
chmod u=rw,g=r,o=r craytool.c
 
echo x - editwin.c
sed 's/^@//' > "editwin.c" <<'@//E*O*F editwin.c//'
/* Editor display pop-up and support routines */

#include "craytool.h"
#include "fkeys.h"

#define COMM_BUFSIZ	3000

/* internet socket stuff */
#include <netinet/in.h>
#include <netdb.h>
#include <sys/socket.h>
int			sd ;	/* socket descriptor */
struct sockaddr_in	sin ;	/* local internet socket info */
struct sockaddr_in	from ;	/* alien internet socket info */
struct itimerval poll_timer ;	/* timer for connection polling */

/* window stuff */
struct Ansi_win edit_win ;
Notify_value	poll_socket(), comm_input() ;


/* DEFINE_POPUP
 *
 * Define the canvas & control panel, to be invoked later.  Also define
 * the tcp emacs server, so that it can be polled for a connection.
 */
int define_popup()
{
int	i ;

	edit_win.image = malloc( NROWS*NCOLS ) ;
	for (i=0;i<NROWS*NCOLS;i++) edit_win.image[i] = ' ' ;

	/* pop-up window for the editor */
	edit_win.frame = window_create(frame, FRAME, 0) ;
	edit_win.canvas = window_create(edit_win.frame, CANVAS,
		WIN_EVENT_PROC,		editor_kbd,
		WIN_ROWS,		NROWS,
		WIN_COLUMNS,		NCOLS,
		WIN_X,			0,
		WIN_CONSUME_KBD_EVENT,	WIN_TOP_KEYS,
		WIN_CONSUME_KBD_EVENT,	WIN_RIGHT_KEYS,
		WIN_CONSUME_KBD_EVENT,	WIN_LEFT_KEYS,
		WIN_CONSUME_KBD_EVENT,	WIN_ASCII_EVENTS,
		WIN_CONSUME_PICK_EVENT,	LOC_STILL,
		WIN_IGNORE_PICK_EVENT,	LOC_MOVE,
		CANVAS_FAST_MONO,	TRUE,
		0) ;
	create_editor_control_panel(&edit_win) ;	/* the control panel */
	window_fit(edit_win.frame) ;

	/* text stuff */
	edit_win.font = pw_pfsysopen() ;		/* get default font */
	char_width = (int)window_get(edit_win.canvas, WIN_COLUMN_WIDTH) ;
	char_height = (int)window_get(edit_win.canvas, WIN_ROW_HEIGHT) ;

	/* define the server socket, non-blocking so we can poll */
	sd = socket(AF_INET, SOCK_STREAM, 0) ;
	sin.sin_family = AF_INET ;
	sin.sin_addr.s_addr = INADDR_ANY ;
	sin.sin_port = MYPORT ;
	if ( bind(sd, (char *)&sin, sizeof(sin)) < 0 ) {
		close(sd) ;
		perror("bind") ;
		return(-1) ;
	}
	listen(sd,1) ;
	fcntl(sd, F_SETFL, fcntl(sd,F_GETFL) | O_NDELAY ) ;

	/* set a timer so that we poll for a connection (~ every second) */
	poll_timer.it_interval.tv_usec = 0 ;
	poll_timer.it_interval.tv_sec = 1 ;
	poll_timer.it_value.tv_usec = 0 ;
	poll_timer.it_value.tv_sec = 1 ;
	notify_set_itimer_func(frame, poll_socket,
		ITIMER_REAL, &poll_timer, ITIMER_NULL) ;
		
	return(NULL) ;
}


/* POLL_SOCKET
 *
 * See if a connection is being attempted.  If so, activate the editor
 * window and get to it.
 */
Notify_value poll_socket(client, which)
Notify_client	client ;
int		which ;
{
int	len = sizeof(from) ;

	/* get connection */
	if ( (comm = accept(sd, &from, &len)) < 0 )
		return(NOTIFY_DONE) ;	 /* no contact */

	activate_editor() ;

	return(NOTIFY_DONE) ;
}


/* ACTIVATE_EDITOR
 *
 * Define i/o and start her up.
 */
activate_editor()
{
	/* turn off polling */
	notify_set_itimer_func(frame, poll_socket,
		ITIMER_REAL, ITIMER_NULL, ITIMER_NULL) ;

	notify_set_input_func(edit_win.frame, comm_input, comm) ;
	window_set(edit_win.frame, WIN_SHOW, TRUE, 0) ;
}


/* DEACTIVATE_EDITOR
 */
deactivate_editor()
{
	window_set(edit_win.frame, WIN_SHOW, FALSE, 0) ;
	notify_set_input_func(edit_win.frame, NOTIFY_FUNC_NULL, comm) ;
	close(comm) ;

	/* restart polling */
	notify_set_itimer_func(frame, poll_socket,
		ITIMER_REAL, &poll_timer, ITIMER_NULL) ;
}



/* EDITOR_KBD
 *
 * Notifier calls this routine when a kbd event is detected in the editor
 * window.
 */

void editor_kbd(canvas, event)
Canvas	canvas ;
Event	*event ;
{
char	buf[80] ;			/* scratch buffer */
char	c ;
int	code ;
static int esc_flag ;			/* last was esc */
static int cursor_flag ;		/* last two were ESC [ */
static int ctrlx_flag ;			/* last was ctrlx */

	code = (int)event_id(event) ;
	c = 0x7F & code ;

/* cray-emacs translation: */
	/* unsupported event */
	if ( !( event_is_ascii(event) ||
		event_is_button(event) ||
		event_is_key_top(event) ||
		event_is_key_right(event) ||
		code == LOC_STILL ))
		return ;

	/* ignore up fkey events */
	if ( !event_is_button(event) && event_is_up(event) ) return ;

	/* mouse keys */
	if ( event_is_button(event) || event_id(event)==LOC_STILL ) {
		switch ( code ) {

		/* mouse still for 1/5 second, set cursor here */
		case LOC_STILL :
			sprintf(buf, "\\400\\%03o\\%03o",
				min(NROWS-1,event_y(event)/char_height),
				min(NCOLS-1,event_x(event)/char_width) ) ;
			sends(buf,1) ;
			break ;

		/* left: mark on down, wipeout on up */
		case MS_LEFT :
			sprintf(buf, "\\400\\%03o\\%03o",
				min(NROWS-1,event_y(event)/char_height),
				min(NCOLS-1,event_x(event)/char_width) ) ;
			sends(buf,0) ;
			if ( event_is_down(event) ) {
				sendc(ESC,0) ;		/* mark */
				sendc(' ',1) ;
			}
			else	sendc(CTRL(w),1) ;	/* wipeout ^W */
			break ;
			
		/* middle: just put mark at mouse pointer */
		case MS_MIDDLE :
			if ( event_is_up(event) ) break ; 
			sprintf(buf, "\\400\\%03o\\%03o",
				min(NROWS-1,event_y(event)/char_height),
				min(NCOLS-1,event_x(event)/char_width) ) ;
			sends(buf,0) ;
			sendc(ESC,0) ;		/* mark */
			sendc(' ',1) ;
			break ;
			
		/* right: yank at mouse position */
		case MS_RIGHT :
			if ( event_is_up(event) ) break ; 
			sprintf(buf, "\\400\\%03o\\%03o",
				min(NROWS-1,event_y(event)/char_height),
				min(NCOLS-1,event_x(event)/char_width) ) ;
			sends(buf,0) ;
			sendc(CTRL(y),1) ;	/* yank ^Y */
			break ;
		}
		return ;
	}

	/* right function keys */
	if ( event_is_key_right(event) ) {
		if ( event_shift_is_down(event) )
			sends(rightkey[code-KEY_RIGHT(1)].shifted,1) ;
		else if ( event_ctrl_is_down(event) )
			sends(rightkey[code-KEY_RIGHT(1)].control,1) ;
		else	sends(rightkey[code-KEY_RIGHT(1)].normal,1) ;
		return ;
	}	


	/* top function keys */
	if ( event_is_key_top(event) ) {
		if ( event_shift_is_down(event) )
			sends(topkey[code-KEY_TOP(1)].shifted,1) ;
		else if ( event_ctrl_is_down(event) )
			sends(topkey[code-KEY_TOP(1)].control,1) ;
		else	sends(topkey[code-KEY_TOP(1)].normal,1) ;
		return ;
	}	


	/* normal keys.  If previous was ESC, send as ESC c and flush.
	 * Also kludge past the sun cursor keys
	 */
	if ( event_is_ascii(event) ) {
		
		if ( cursor_flag ) {	/* already got ESC [ */
			cursor_flag = FALSE ;
			switch (c) {
			case 'A' : sendc(CTRL(p),1) ;	/* up, ^P */
				break ;
			case 'B' : sendc(CTRL(n),1) ;	/* down, ^N */
				break ;
			case 'C' : sendc(CTRL(f),1) ;	/* forward, ^F */
				break ;
			case 'D' : sendc(CTRL(b),1) ;	/* backward, ^B */
				break ;
			default : sendc(ESC,0) ;
				sendc('[',0) ;
				sendc(c,0) ;
			}
		}
		else if ( esc_flag ) {	/* last one was meta prefix */
			esc_flag = FALSE ;
			switch (c) {
			case '[' :
				cursor_flag = TRUE ;
				break ;
			case ESC :
				sendc(c,1) ;
				break ;
			default :
				sendc(ESC,0) ;
				sendc(c,1) ;
			}
		}
		else if ( ctrlx_flag ) {	/* last was ctrlx */
			ctrlx_flag = FALSE ;
			switch (c) {
			case CTRL(x) :
				sendc(c,1) ;
				break ;
			default :
				sendc(CTRL(x),0) ;
				sendc(c,1) ;
			}
		}
		else {

			switch (c) {
			case ESC :		/* escape */
				esc_flag = TRUE ;
				break ;
			case CTRL(x) :
				ctrlx_flag = TRUE ;
				break ;
			case LF : case CR :
				sendc(c,1) ;	/* send it and flush */
				break ;
			default :
				c &= 0x7F ;
				if ( c == '\\' ) sendc(c,0) ; /* extra one */
				if ( immediate || isctrl(c) || 
				     ( cmode && 0 != strchr("#}",c) ) )
					sendc(c,1) ;
				else {
					sendc(c,0) ;
					if (inserting)
						insert_char(&edit_win,c) ;
					else overtype_char(&edit_win,c) ;
				}
			}
		}
		return ;
	}
}



/* COMM_INPUT
 *
 * Take input from the tcp cray connection and send to the display.
 * To speed up the display, we batch around it.
 */
#define MODE_BUFSIZ	10

Notify_value comm_input(client, fd)
Notify_client client;
int fd;
{
char	c ;
int	i, count ;
static int slash_flag ;		/* prev char was 1st in "escape" sequence */
char	modebuf[MODE_BUFSIZ] ;	/* mode change command buffer */
char	buf[COMM_BUFSIZ+1], *buf_pntr ;


pw_batch_on( canvas_pixwin(edit_win.canvas) ) ; /* batching on */

/* read until no more input pending on the socket (MUST NOT BLOCK) */
count = read(fd, buf, COMM_BUFSIZ) ;


for (buf_pntr = buf; buf_pntr < &buf[count]; ) {
	c = *buf_pntr++ ;

/* cray-emacs translation: */
	/* A few codes are defined to allow the editor to control some
	 * local mode flags.  These take the form "\(mode)", where
	 * mode is in caps to set and lower case to reset.  \ is also
	 * sent from the editor as \\.
	 */
	if ( slash_flag ) {	/* finish escape sequence */
		slash_flag = FALSE ;
                switch (c) {
		case '(' :	/* mode set/reset */
			modebuf[0] = c ;
			for ( i=1; i<MODE_BUFSIZ-1; i++) {
				modebuf[i] = *buf_pntr++ ;
				if ( modebuf[i] == ')' ) break ;
			}
			modebuf[i+1] = NULL ;
			if ( 0==strcmp( "(I)", modebuf ) )
				immediate = TRUE ;
			else if ( 0==strcmp( "(i)", modebuf ) )
				immediate = FALSE ;
			else if ( 0==strcmp( "(OVER)", modebuf ) )
				inserting = FALSE ;
			else if ( 0==strcmp( "(over)", modebuf ) )
				inserting = TRUE ;
			else if ( 0==strcmp( "(CMODE)", modebuf ) )
				cmode = TRUE ;
			else if ( 0==strcmp( "(cmode)", modebuf ) )
				cmode = FALSE ;
			break ;
		case 'E' : case 'e' :	/* \e is escape, hcc brain damage */
			win_output(&edit_win,'\033') ;
			break ;
		default :		/* should only be \, but... */
			win_output(&edit_win,'\\') ;
		}
	}
	else {
		switch (c) {
		case CTRL(d) :		/* terminate editing session */
			deactivate_editor() ;
			break ;
		case '\\' :		/* start of escape sequence */
			slash_flag = TRUE ;
			break ;
		default :
			win_output(&edit_win,c) ;
		}
	}

} /* end of for loop: processed all characters recieved */

pw_batch_off( canvas_pixwin(edit_win.canvas) ) ;	/* batching off */
return(NOTIFY_DONE) ;
}




/* WIN_OUTPUT
 *
 * Line buffered output to the screen (for speed).  CTSS eol char
 * is 31 (decimal).
 */
win_output(ansi_win,c)
struct Ansi_win *ansi_win ;
char	c ;
{
static char	buf[COMM_BUFSIZ+1] ;
static int	index=0 ;

	if ( c == CRAY_EOL ) {	/* eol char ? */
		buf[index] = NULL ;
		win_ansi(ansi_win,buf) ;
		index = 0 ;
	}
	else {
		buf[index++] = c ;
		if ( index >= COMM_BUFSIZ-1 ) {
			buf[index] = NULL ;
			win_ansi(ansi_win,buf) ;
			index = 0 ;
		}
	}
}

@//E*O*F editwin.c//
chmod u=rw,g=r,o=r editwin.c
 
echo x - epanel.c
sed 's/^@//' > "epanel.c" <<'@//E*O*F epanel.c//'
/* Control panel event stuff for the editor window of craytool */

#include "craytool.h"

Panel_item	insert_item, quickexit_item ;



/* INSERT_EVENT
 *
 * A button on the panel.  Toggle insert mode (must be editing).  The
 * editor will send back codes to make sure the local state is correct.
 */
void insert_event( item, event )
Panel_item	item ;
Event		*event ;
{
	if ( inserting ) sends("\030MOVER\015",1) ; /* add mode OVER */
	else sends("\030\015OVER\015",1) ;	/* del mode OVER */
}


/* QUICKEXIT_EVENT
 *
 * A button on the panel.  If editing, exit the editor, saving all files.
 */
void quickexit_event( item, event )
Panel_item	item ;
Event		*event ;
{
	sendc(ESC,0) ;
	sendc('Z',1) ;		/* ESC Z exit sequence */
}



/* Create the control panel */
create_editor_control_panel(ansi_win)
struct Ansi_win *ansi_win ;
{
	epanel = window_create(ansi_win->frame, PANEL,
		WIN_BELOW,	ansi_win->canvas,
		WIN_X,		0,
		WIN_ROWS,	1,
		0) ;
	insert_item = panel_create_item(epanel, PANEL_BUTTON,
		PANEL_LABEL_IMAGE, panel_button_image(epanel,"INS TOGGLE",0,0),
		PANEL_NOTIFY_PROC,	insert_event,
		0 ) ;
	quickexit_item = panel_create_item(epanel, PANEL_BUTTON,
		PANEL_LABEL_IMAGE, panel_button_image(epanel,"SAVE & EXIT",0,0),
		PANEL_NOTIFY_PROC,	quickexit_event,
		0 ) ;
	window_fit_height(epanel) ;
}
@//E*O*F epanel.c//
chmod u=rw,g=r,o=r epanel.c
 
echo x - macro.c
sed 's/^@//' > "macro.c" <<'@//E*O*F macro.c//'
/* MACRO.c
 *
 *   The routines in this file support the macro processing facilities
 * of PREP.  The style is similar to that of c #define macros, except
 * that : is used instead of #define and ; terminates the macro.  
 *   Recursive definitions are permitted, but will cause an abort
 * (and possibly a memory allocation error) on expansion.  For each
 * line submitted to expand_macros, a count of is kept for each
 * stored macro indicating how many times it has been expanded in
 * the current line.  When this exceeds MAX_CALLS, the program 
 * assumes a macro definition is recursive and stops.  Macros
 * are expanded starting with the one with the longest name, so that
 * if the definitions
 *
 * : >=		.ge. ;
 * : >		.gt. ;
 *
 * are in effect, >= will be changed to .ge. rather than .gt.=.  This
 * is only a potential problem when macro names are not fully
 * alphanumeric, since "arg" will not be flagged if "r" is defined.
 *   If a definition contains no text ( : name ; ) then name is
 * removed from the list if present.  This can be used for undefining
 * macro defs.
 *
 * 11/4/86 P.R.OVE
 *
 * Copyright P.R.OVE
 *   This routine was modified and used with NCSA Cray/Sun distributed
 * MicroEMACS with the permission of the author.
 */
 
#include "craytool.h"
 
#define	MAX_MACROS	1000
#define MAX_CALLS	100	/* if exceeded, assume recursive */
#define MAX_TOKENS	20
#define START_CHAR	(Char)(128)
#define FILL_CHAR	(Char)(129)
#define MAX_CHAR	129	/* max ascii char allowed in search text */

/* NOTE: START_CHAR & FILL_CHAR are used to overwrite a "found" macro in
 * text to be expanded (to prevent the macro or parts of it from being
 * caught twice).  Since this text will be searched for other macros, the
 * marker characters must be in a BM skip table.  Therefore the
 * minimum value for MAX_CHAR is max( FILL_CHAR, START_CHAR ).
 */
 
/* macro structure */
struct Macro {
	Char	*name ;		/* macro name */
	Char	*text ;		/* text with parm codes */
	Short	namelength ;	/* macro name length */
	Short	parmcount ;	/* number of parms */
	Short	purity ;	/* TRUE if expand(text)=text */
	Short	callcount ;	/* recursion check counter */
	Short	alpha ;		/* 1 if an edge char is alphanumeric */
	Short	*skip1, *skip2 ; /* Boyer-Moore search tables */
} macro[MAX_MACROS], *macrop ;
 
int	defined_macros = 0 ;	/* number of defined macros */
Char	errline[80] ;		/* error message buffer */

/* function types */
Char	*expand_macros(), *mac_expand(), *find_mac() ;
Char	*search(), *strmatch(), *def_check(), *string_copy() ;
Char	*strtokp(), *mac_proc(), *mat_del(), *line_end() ;
int	define_macro() ;



/* MAC_PROC, interface to the macro processor.
 *
 *   This routine defines and expands macros.  The definition phase
 * is invoked when a leading : is found in the record.  Text is
 * then taken until the terminating ; is found.  Text following the
 * ; is ignored.  Multiline macros are permitted.  Failure to have a
 * terminating ; will cause serious problems eventually.
 *   A NULL pointer is returned if a macro has been defined or is in
 * the process of being defined.  If the definition is incomplete, global
 * variable "defining_macro" will remain set (to prevent records from
 * being added to the ring.  Otherwise a pointer to the buffer with the
 * expanded text is returned (even if no macros have been expanded).
 * The buffer is temporary and should be eliminated by the caller.
 */
Char	*mac_proc(line)
Char	*line ;		/* line containing the definition */
{
static int	j ;	/* static so routine can be re-entered */
static Char	*def ;
int	i, n, size ;
Char	*text ;
 
/* expand macro if not a definition */
if ( !defining_macro && NULL == def_check(line) ) {
	text = (Char*)malloc( strlen(line) ) ;
	strcpy( text, line ) ;
	if ( defined_macros != 0 ) {
		for ( i=0; i<defined_macros; i++ ) macro[i].callcount = 0 ;
		text = expand_macros( text, &n ) ;
	}
	return( text ) ;
}
 
/* macro definition */
if ( NULL != (text = def_check(line)) ) {	/* new definition */
	defining_macro = TRUE ;
	j = 1 ;
	def = (Char*)malloc( strlen(text)+10 ) ;
	strcpy( def, text ) ;
}
else {						/* continuing a definition */
	size = strlen(def) + strlen(line) + 10 ;
	def = (Char*)realloc( def, size ) ;
	strcat( def, line ) ;
}

for (;; j++ ) {
 
	switch ( def[j] ) {
 
	case ';':	def[j+1] = NULL ;
			define_macro( def ) ;
			free( def ) ;
			defining_macro = FALSE ;
			return(NULL) ;
			
	case NULL :	def[j] = '\n' ;
			def[j+1] = NULL ;
			return(NULL) ;
	}
}
}
 

/* DEF_CHECK
 *
 * Checks to see if a string is a macro definition.  If so, a pointer
 * to the ':' is returned.  If not, a NULL pointer is returned.
 */
Char	*def_check(line)
Char	*line ;
{
int	i ;
	 
	for ( i=0; line[i] != NULL; i++ ) {
		if ( line[i] == ':' )
			return( &line[i] ) ;
		else if ( line[i] == BLANK || line[i] == TAB )
			continue ;
		else break ;
	}
	return((Char*)NULL) ;
}
 
 

/*  DEFINE_MACRO
 *
 * Process the macro definition in the argument string.
 * A macro has the form:
 *
 * : name( parm1, parm2, ... )	text with parms ;
 *
 * In a definition the delimeter must follow the name
 * without whitespace.  In the source code this requirement is
 * relaxed.  Alphanumeric macros must be not be next to an alpha or 
 * number character or they will not be recognized.
 *
 * This routine puts the macro string into a more easily handled
 * structure, replacing parms in the text with n, where n is a
 * binary value (128 to 128+MAX_TOKENS).
 *
 * The macros are entered in order of their name length, so that
 * the macro expander will expand those with long names first.
 *
 * If no text is present the macro is removed from the list.
 */
 
int	define_macro(string)
Char	*string ;
{
struct	Macro spare_macro ;
Char	*pntr, *pntr1, *name, *parms[MAX_TOKENS],
	*parm, *text,
	*open_parens, *close_parens ;
int	i, j, l ;
 
	if ( defined_macros >= MAX_MACROS ) {
		sprintf(errline,"DEFINE_MACRO: too many macros: %s",string);
		err_msg( errline ) ;
		return(-1) ;
	}
 
/* get the name */
	name = strtokp( string, ":; \n\t(" ) ;	/* pointer to the name */
	if ( name == NULL ) return(-1) ;	/* nothing there */
	macrop = &macro[defined_macros] ;
	defined_macros++ ;
	macrop->namelength = strlen(name) ;
	macrop->name = (Char*)malloc( macrop->namelength ) ;
	string_copy( macrop->name, name ) ;
	macrop->alpha = isalnum( *macrop->name ) ||
			isalnum( *(macrop->name + macrop->namelength - 1) ) ;
 
/* set up the Boyer-Moore skip tables */
	if ( macrop->namelength > 1 ) makeskip( macrop ) ;
	else {
		macrop->skip1 = NULL ;
		macrop->skip2 = NULL ;
	}
	
/* get the parameters */
	for ( i=0; i<MAX_TOKENS; i++ ) parms[i] = NULL ;
	open_parens = strmatch(string,name) + macrop->namelength ;
	if ( NULL == line_end( open_parens ) ) {
		sprintf( errline, "DEFINE_MACRO: unterminated: %s", string ) ;
		err_msg( errline ) ;
		return(-1) ;
	}
 
	/* get the text storage here to avoid memory allocation tangles */
	text = open_parens ;
	macrop->text = (Char*)malloc( strlen(text) ) ;
 
	if ( strchr( "([{\'\"", *open_parens ) ) {
		if ( NULL == ( close_parens = mat_del( open_parens ) ) ) {
			sprintf(errline,"DEFINE_MACRO: missing delimeter: %s",
				string ) ;
			err_msg( errline ) ;
			return(-1) ;
		}
		text = close_parens + 1 ;
		i = (int)(close_parens - open_parens) - 1 ;
		pntr = open_parens + 1 ;
		*close_parens = NULL ;
		for ( i=0, pntr1 = pntr; i<MAX_TOKENS; i++, pntr1 = NULL ) {
			if ( NULL == ( parm = strtokp( pntr1, ", \t" ) ) )
				break ;
			parms[i] = (Char*)malloc( strlen(parm) ) ;
			string_copy( parms[i], parm ) ;
		}
	}
 
	
/* get the text, plugging in binary codes for parameters */
 
	/* remove leading whitespace */
	if ( NULL == (text=line_end( text )) ) {
		sprintf( errline, "DEFINE_MACRO: unterminated: %s", string ) ;
		err_msg( errline ) ;
		return(-1) ;
	}
 
	/* remove the trailing ';' but NOT whitespace */
	for ( i=strlen(text)-1; i>=0; i-- ) {
		if ( text[i] == ';' ) { text[i] = NULL ; break ; }
	}
 
	/* if the text is snow white at this stage, delete the entry
	 * and any other entries with the same name, then return.
	 */
	if ( NULL == line_end(text) ) {
		for ( i=defined_macros-2; i>=0; i-- ) {
			if ( NULL == strcmp( macrop->name, macro[i].name ) ) {
				mac_del(i) ;
				macrop = &macro[defined_macros-1] ;
			}
		}
		mac_del(defined_macros-1) ;
		return(-1) ;
	}
 
	string_copy( macrop->text, text ) ;
	text = macrop->text ;

	for ( i=0; i<MAX_TOKENS && NULL != (parm = parms[i]); i++ ) {
 
		/* replace parm by code, if not next to an alpha or number */
		l = strlen(parm) ;
		for ( pntr=text; NULL != (pntr1=strmatch(pntr,parm));
		pntr=pntr1+1 ) {
			if ( !( isalnum(*(pntr1-1)) && isalnum(*pntr1) ) &&
			     !( isalnum(*(pntr1+l-1)) && isalnum(*(pntr1+l)))) {
			     	*pntr1 = 128 + i ;
				string_copy( pntr1 + 1, pntr1 + strlen(parm) ) ;
			}
		}
	}
 
/* count parms and free up temporary storage */
	macrop->parmcount = 0 ;
	for ( i=0; i<MAX_TOKENS && NULL != parms[i]; i++ ) {
		free( parms[i] ) ;
		macrop->parmcount++ ;
	}
 
/* Recalculate purity information */
	for ( i=0; i<defined_macros; i++ ) macro[i].purity = FALSE ;
 
/*	j = defined_macros - 1 ;
	macro[j].purity = TRUE ;
	for ( i=0; i<j; i++ ) {
		if ( macro[i].parmcount || 
		     find_mac( macro[i].text, END(macro[i].text), j )  )
			macro[i].purity = FALSE ;
		if ( !macro[j].purity ||
		     macro[j].parmcount || 
		     find_mac( macro[j].text, END(macro[j].text), i )  )
			macro[j].purity = FALSE ;
	}
*/
 
/* rearrange the macro table so it is sorted by name length */
	for ( i=0; i<defined_macros-1; i++ ) {
		if ( macrop->namelength < macro[i].namelength ) {
			mac_copy( &spare_macro, macrop ) ;
			for ( j=defined_macros-1; j>i; j-- )
				mac_copy( &macro[j], &macro[j-1] ) ;
			mac_copy( &macro[i], &spare_macro ) ;
			break ;
		}
		/* replace if name already exists */
		if ( macrop->namelength == macro[i].namelength &&
		     NULL == strcmp( macrop->name, macro[i].name ) ) {
			mac_swap( &macro[i], macrop ) ;
			mac_del( defined_macros - 1 ) ;
			break ;
		}
	}
 
/* return the index of the new macro */
	return(i) ;
}
 
 
 
/* MAC_COPY
 *
 * Copy macro p2 into p1 (just changing pointers)
 */
mac_copy( p1, p2 )
struct Macro *p1, *p2 ;
{
	p1->name = p2->name ;
	p1->namelength = p2->namelength ;
	p1->text = p2->text ;
	p1->parmcount = p2->parmcount ;
	p1->purity = p2->purity ;
	p1->callcount = p2->callcount ;
	p1->alpha = p2 ->alpha ;
	p1->skip1 = p2->skip1 ;
	p1->skip2 = p2->skip2 ;
}
 
 
 
/* MAC_SWAP
 *
 * Exchange macro contents.
 */
mac_swap( p1, p2 )
struct Macro *p1, *p2 ;
{
struct Macro mac ;
 
	mac_copy( &mac, p1 ) ;
	mac_copy( p1, p2 ) ;
	mac_copy( p2, &mac ) ;
}
 
 
 
/* MAC_DEL
 *
 * Remove a macro, specified by index, and shift the table.
 */
 
/* the skip parameters may be null if the name is short */
#define FREE(s)		if ( NULL != s ) free(s)
 
mac_del( i )
int	i ;
{
int	j ;
 
	if ( i >= defined_macros ) return ;	/* index not defined */
 
	FREE( macro[i].name ) ;
	FREE( macro[i].text ) ;
	FREE( (Char *)macro[i].skip1 ) ;
	FREE( (Char *)macro[i].skip2 ) ;
	for ( j=i; j<defined_macros-1; j++ )
		mac_copy( &macro[j], &macro[j+1] ) ;
 
	defined_macros-- ;
}
 
 
/* EXPAND_MACROS
 *
 * Expand the macros in the argument string, 1 ply deep.  Returns a
 * pointer to the expanded string, which is likely to be huge.  The
 * memory should be freed as soon as possible.  The macros are expanded
 * starting with the one with the highest index.  Recursive macro
 * definitions will be flagged, but may cause a termination due to
 * allocation failure before doing so.  Caution must be exercised
 * to avoid accidental recursive definitions involving
 * more than one macro:
 *	: h	i+x ;
 *	: i(y)	func(y) ;
 *	: func	h ;
 * This will generate the successive strings (from a = func(x)):
 *	a = h(x)
 *	a = i+x(x)
 *	a = func()+x(x)
 *	a = h()+x(x) .... and so on.  Beware.
 * This routine is meant to be called recursively.  The argument
 * string is deallocated.  If it is known in advance that the macro
 * text contains no further macros (the purity parameter), a call
 * to expand_macros is not done.  This parameter is set if expand_
 * macros returns with the original text.
 */
 
Char	*expand_macros(text,np)
Char	*text ;
int	*np ;		/* returns the number of macros found */
{
Char	*found, *start, *stop, *result ;
Char	*new_text ;
int	m, length ;
int	macros = 0 ;
 
 
for ( m=defined_macros-1; m>=0; m-- ) {
start = text ;
 
/* find and expand (completely) all macros of index m */
do {
	length = strlen(text) ;
	stop = text + length - 1 ;
	found = find_mac( start, stop, m ) ;
	if ( found != NULL ) {
		new_text = mac_expand( found, m ) ;
		if ( !macro[m].purity ) {
			new_text = expand_macros(new_text,np);
			if ( *np == 0 ) macro[m].purity = TRUE ;
		}
		macros++ ;

/* At this stage we have the original text with a macro overwritten with
 * characters 128 and 129, the completely expanded macro in "new_text",
 * and the location (in text) where it should be inserted in "found".
 */
		/* find out how much memory we will need and allocate */
		result = (Char*)malloc( length + strlen(new_text) ) ;

		/* splice in the expanded macro */
		strcpy( result, text ) ;
		start = &result[ (int)(found-text) ] ;	/* for next search */
		*start = NULL ;
		strcat( result, new_text ) ;
		for ( found++; *found == FILL_CHAR; found++ ) ;
		strcat( result, found ) ;
		free(new_text) ;
		free(text) ;		/* result now holds it */
		text = result ;
	}
 
} while ( found != NULL ) ;
 
}
		
*np = macros ;
return(text) ;
}
 
 
 
/* FIND_MAC
 *
 * Find a macro in a string.  The args are the macro index and pointers
 * to the start and stop locations of the string to be searched.
 *   This routine returns a pointer to the 1st character of the macro
 * name in the text.  If the name is quoted or otherwise not valid it
 * is ignored.  A null pointer is returned if no macro is found.
 */
 
/* macros to check for being next to an alpha */
#define ALPHA_BEFORE(s)	( (s!=start) && (isalnum(*(s-1)) && isalnum(*( s ))) )
#define ALPHA_AFTER(s)	(               isalnum(*( s )) && isalnum(*(s+1))  )
#define NEXT_TO_ALPHA(s,l)	( ALPHA_AFTER(s+l-1) || ALPHA_BEFORE(s) )
 
Char *find_mac( start, stop, i )
Char	*start, *stop ;
int	i ;
{
Char	*candidate, *first ;
int	l ;
 
	first = start ;
	l = macro[i].namelength ;
	quoted( start, start, 1 ) ;	/* reset quote routine */
 
 
	while (1) {
		if ( l == 1 )
			candidate = (Char*)strchr( first, macro[i].name[0] ) ;
		else
			candidate = search( first, stop, &macro[i] ) ;
 
		if ( candidate != NULL ) {
			if ( (macro[i].alpha && NEXT_TO_ALPHA(candidate,l)) ||
			     quoted( candidate, start, 0 )   ) {
				first = candidate + 1 ;
				continue ;
			}
		}
 
		return( candidate ) ;
	}
}
 
 
 
 
/* MAC_EXPAND
 *
 *    Expand a single macro in a text string.  The old string is retained
 * with the macro ( name[...] ) replaced with characters START_CHAR (at
 * the head) and FILL_CHAR (the body).  This keeps the size of the 
 * original text the same and any pointers to it valid.
 * This routine returns a pointer to the expanded text, which could then 
 * be spliced back in (but which is in practice searched for nested macros
 * first). Name points to the macro in the string and index is the macro
 * index.
 *    If a macro seems recursive, it's purity parameter is set so that
 * it will not be expanded further.
 */

Char	*mac_expand( name, index )
Char	*name ;
int	index ;
{
Char	*pntr, *new_text, *parms[MAX_TOKENS],
	*open_parens, *close_parens, *rest_of_text, c ;
int	i, j, size ;
 
	macrop = &macro[index] ;
	if ( macrop->callcount++ > MAX_CALLS ) {
		sprintf( errline,
		"MAC_EXPAND: possible recursion involving: \'%s\'",
			macrop->name ) ;
		err_msg( errline ) ;
		macrop->purity = TRUE ;
	}
	
/* get the parameters if there are any for this macro */
	for ( i=0; i<MAX_TOKENS; i++ ) parms[i] = NULL ;
	rest_of_text = &name[ macrop->namelength ] ;
	if ( macrop->parmcount != 0 ) {
		open_parens = &rest_of_text[ strspn( rest_of_text, " \t" ) ] ;
		if ( (NULL != strchr( "([{\'\"", *open_parens )) &&
		     (NULL != *open_parens )) {
			if (NULL == (close_parens=mat_del(open_parens)) ) {
				sprintf(errline,"MAC_EXPAND: missing delimeter") ;
				err_msg(errline) ;
				close_parens = open_parens + 1 ;
				*close_parens = ')' ;
				*(close_parens+1) = NULL ;
			}
			pntr = open_parens + 1 ;
			c = *close_parens ;		/* save *close_parens */
			*close_parens = NULL ;		/* make parm block a string */
			i = tokenize( pntr, parms ) ;	/* break out the parms */
			*close_parens = (Char)c ; 	/* restore text */
			rest_of_text = close_parens + 1 ;
		}
	}
 
	
/* find out how much memory we will need, then allocate */
	size = strlen(macrop->text) ;
	for ( i=0; NULL != (c=macrop->text[i]); i++ ) {
		if ( c > 127 && parms[c-128] != NULL )
			size += strlen(parms[c-128]) ;
	}
	new_text = (Char*)malloc( size ) ;
	*new_text = NULL ;
 
/* expand the macro */
	for ( i=0, j=0; NULL != (c=macrop->text[i]); i++, j++ ) {
		if ( c > 127 ) {
			if ( parms[c-128] != NULL ) {
				strcat( new_text, parms[c-128] ) ;
				j += strlen( parms[c-128] ) - 1 ;
			}
			else j-- ;
		}
		else {		/* keep null terminated */
			new_text[j] = c ;
			new_text[j+1] = NULL ;
		}
	}
	
/* replace the macro in the original text with markers */
	*name = START_CHAR ;
	for ( pntr=name+1; pntr<rest_of_text; pntr++ ) *pntr = FILL_CHAR ;
 
/* free up temporary storage and return pointer to new allocation */
	for ( i=0; i<MAX_TOKENS && NULL != parms[i]; i++ ) free( parms[i] ) ;
	return( new_text ) ;
}
 
 
 
/* QUOTED
 *
 * Return TRUE if the pointer is quoted in the string (pntr marks
 * a position in the string).  The quote character is the apostrophe.
 * If pntr is not in the string the result will be meaningless.  This
 * routine keeps a static index and quote flag, so it doesn't have
 * to keep starting back at the beginning.  To reset it, call with
 * reset = 1.  To start the search at the old index, call with reset
 * set to 0.  The routine is also reset if pntr is less than the index from
 * the previous call.
 *    Since macros can be on multiple lines, the quote flag
 * is reset on newline.
 */
 
int	quoted( pntr, string, reset )
Char	*pntr, *string ;
{
static int	i, quote ;
 
	if ( reset || &string[i] > pntr ) {
		i = 0 ;
		quote = FALSE ;
	}
	else {
		for ( ; NULL != string[i] && &string[i] < pntr; i++ ) {
			switch ( string[i] ) {
				case '\'':	quote = !quote ; break ;
				case '\n':	quote = FALSE ;
			}
		}
	}
		
	return( quote ) ;
}
 
 
 
 
/* Guts of the Boyer-Moore algorithm, using already defined skip tables.
 * Returns a pointer to the location where the text is found, else a
 * NULL pointer.
 */
 
Char *search( start, stop, macrop )
Char			*start, *stop ;		/* 1st and last in buffer */
struct Macro		*macrop ;
 
{
register Char 	*k,		/* indexes text */
		*j ;		/* indexes pattern */
register int	skip ;		/* skip distance */
Char		*patend ;	/* pointer to last char in pattern */
 
patend = macrop->name + macrop->namelength - 1 ;
 
	k = start ;
	skip = macrop->namelength - 1 ;
	while ( skip <= (stop-k) ) {
 
		for ( j=patend, k=k+skip; *j == *k; --j, --k )
			if ( j == macrop->name ) return(k) ;
 
		skip = max( macrop->skip1[ *(Char *)k ],
			    macrop->skip2[ j - macrop->name ]      ) ;
	}
 
	/* reaching here ==> search failed */
	return(NULL) ;
}
 
 
 
 
/* Generate the skip tables for Boyer-Moore string search algorithm.
 * Skip1 is the skip depending on the character which failed to match
 * the pattern (name), and skip2 is the skip depending on how far we
 * got into the name.
 */
 
makeskip( macrop )
struct Macro *macrop ;
{
Char	*name, *p ;
Short	*skip1, *skip2 ;
int	namelength ;
int	*backtrack ;	/* backtracking table for t when building skip2 */
int	c ;		/* general purpose constant */
int	j, k, t, tp ;	/* indices into skip's and backtrack */
 
	
	name = macrop->name ;
	namelength = macrop->namelength ;
 
	/* allocate space for the skip strings */ 
	p = (Char*)malloc( sizeof(int) * (MAX_CHAR + 1) ) ;
	skip1 = (Short *)p ;
	p = (Char*)malloc( sizeof(int) * namelength ) ;
	skip2 = (Short *)p ;
	
	macrop->skip1 = skip1 ;
	macrop->skip2 = skip2 ;
	
	/* allocate temporary space for the backtracking table */
	p = (Char*)malloc( sizeof(int) * namelength ) ;
	backtrack = (int *)p ;
	
	for (c=0; c<=MAX_CHAR; ++c) skip1[c] = namelength ;
 
	for (k=0; k<namelength; k++) {
		skip1[name[k]] = namelength - k - 1 ;
		skip2[k] = 2 * namelength - k - 1 ;
	}
 
	for (j=namelength - 1,t=namelength; j >= 0; --j,--t) {
		backtrack[j] = t ;
		while (t<namelength && name[j] != name[t]) {
			skip2[t] = min(skip2[t], namelength - j - 1) ;
			t = backtrack[t] ;
		}
	}
 
	for (k=0; k<=t; ++k) skip2[k] = min(skip2[k],namelength+t-k) ;
	tp=backtrack[t] ;
 
	while( tp < namelength ) {
		while( t < namelength ) {
			skip2[t] = min( skip2[t], tp-t+namelength ) ;
			++t ;
		}
		tp = backtrack[tp] ;
	}
 
	free(backtrack) ;
}
 
 
 
/* MAC_QUERY
 *
 * Determine if a given string a defined macro.  Returns the index of
 * the macro, or -1 on failure.  The list is assumed sorted by length.
 */
int	mac_query( s )
Char	*s ;
{
int	index, i, l ;
 
	l = strlen( s ) ;
 
	/* Find first macro with length l (need not be efficient here) */
	for ( index=0; index<defined_macros; index++ ) {
		if ( macro[index].namelength==l ) break ;
		if ( macro[index].namelength>l || index==defined_macros-1 )
			return(-1) ;
	}
 
	/* Look for a match */
	for ( i=index; macro[i].namelength==l && i<defined_macros; i++ ) {
		if ( NULL == strcmp( s, macro[i].name ) ) return(i) ;
	}
 
	return(-1) ;
}
 
 
 
 
/* STRING_COPY
 *
 * Copy a string, in reverse order if necessary.  Slow but safe.
 */
Char	*string_copy(d, s)
Char	*d, *s ;
{
Char	*save = d ;
int	i, length = strlen(s) ;

	if ( d > s && d <= s+length )
		for ( i=length; i>=0; i-- ) d[i] = s[i] ;
	else
		while ( *d++ = *s++ ) ;

	return(save) ;
}

 
 
/* Function MAT_DEL
 *
 * Given pointer to a delimeter this routine finds its
 * partner and returns a pointer to it.  On failure a
 * NULL pointer is returned.  The supported delimeters
 * are:
 *
 *   '  "  ( )  [ ]  { }  < >
 *
 * ' and " are supported only in the forward direction
 * and no nesting is detected.
 * In all cases the search is limited to the current
 * line (bounded by NULLs).
 *
 * P. R. OVE  11/9/85
 */
 
 
Char *mat_del( pntr )
Char	*pntr ;
 
{
int	nest_count = 0, i, direction ;
Char	target ;
 
if ( pntr == NULL ) return( NULL ) ;
 
/* get the target character and direction of search */
	switch( *pntr ) {
 
		case '(' :	{ target = ')' ;
				  direction = 1 ;
				  break ;          }
 
		case ')' :	{ target = '(' ;
				  direction = -1 ;
				  break ;          }
 
		case '[' :	{ target = ']' ;
				  direction = 1 ;
				  break ;          }
 
		case ']' :	{ target = '[' ;
				  direction = -1 ;
				  break ;          }
 
		case '{' :	{ target = '}' ;
				  direction = 1 ;
				  break ;          }
 
		case '}' :	{ target = '{' ;
				  direction = -1 ;
				  break ;          }
 
		case '<' :	{ target = '>' ;
				  direction = 1 ;
				  break ;          }
 
		case '>' :	{ target = '<' ;
				  direction = -1 ;
				  break ;          }
 
		case '\'':	{ target = '\'' ;
				  direction = 1 ;
				  break ;          }
 
		case '\"':	{ target = '\"' ;
				  direction = 1 ;
				  break ;          }
 
		default:	  return( NULL ) ;
				
	}
 
/* find the match */
	for ( i = direction; pntr[i] != NULL; i += direction ) {
		
		if ( pntr[i] == target ) {
 
			if ( nest_count == 0 ) {
				break ;	}
			else {
				nest_count-- ;
				continue ; }
                }
		
		if ( pntr[i] == pntr[0] ) nest_count++ ;
	}
 
	if ( pntr[i] == NULL ) return( NULL ) ;
	return( &pntr[i] ) ;
}

 
 
/* STRMATCH:  find the first occurrence of string2 in string1, return pointer
 * to the first character of the match.  Returns NULL pointer if no match.
 * This routine is fairly slow and should not be used where speed is
 * critical.
 */
#define NULL	0
 
Char	*strmatch( string1, string2 )
Char	*string1, *string2 ;
{
Char	*pntr1, *pntr2 ;
 
 	for ( pntr1 = string1, pntr2 = string2 ; *pntr1 != NULL; pntr1++ ) {
		if ( *pntr1 == *pntr2 ) {
			pntr2++ ;
			if ( *pntr2 == NULL ) return( pntr1 - strlen(string2) + 1 ) ;
		}
		else pntr2 = string2 ;
	}
 
	/* failure if control reaches this point */
	return( NULL ) ;
}
 
 
 
 
/* Tokenize
 *
 * Break out arguments from a string.  Pntr is the argument string
 * and tokens is an array of pointers which will be assigned memory and have
 * the arguments returned.  The function returns the number of arguments
 * found.  Pairwise characters are monitored to ensure that expressions
 * are sexually balanced.  Unused parm pointers are returned NULL.
 * MAX_TOKENS determines the dimension of the array of pointers.
 * Commas are the only delimiters allowed to distinquish tokens.
 */
 
int	tokenize( pntr, tokens )
Char	*pntr, *tokens[] ;
{
int	square = 0, curl = 0, parens = 0, apost = 1, quote = 1 ;
int	i, j, quit ;
Char	*text, *txt ;
 
/* clear the pointers and make a copy of the string */
for ( i=0; i<MAX_TOKENS; i++ ) tokens[i] = NULL ;
text = (Char*)malloc( strlen(pntr) ) ;
strcpy( text, pntr ) ;
 
for ( i=0, j=0, quit=FALSE, txt=text; quit==FALSE; j++ ) {
 
	switch( text[j] ) {
 
	case '['  :	square += 1 ;	break ;
	case ']'  :	square -= 1 ;	break ;
	case '{'  :	curl   += 1 ;	break ;
	case '}'  :	curl   -= 1 ;	break ;
	case '('  :	parens += 1 ;	break ;
	case ')'  :	parens -= 1 ;	break ;
	case '\'' :	apost = -apost;	break ;
	case '\"' :	quote = -quote;	break ;
	case NULL :	
			tokens[i] = (Char*)malloc( strlen(txt) );
			strcpy( tokens[i], txt ) ;
			quit = TRUE ;
			break ;
	case ','  :	if (!square && !curl && !parens &&(apost==1)&&(quote==1)){
				text[j] = NULL ;
				tokens[i] = (Char*)malloc( strlen(txt) ) ;
				strcpy( tokens[i], txt ) ;
				i += 1 ;
				txt = &text[j+1] ;
			}
	}
}
 
free( text ) ;
return( i+1 ) ;
}
 
 
 
/* function STRTOKP
 
   Like Strtok, except that the original string is preserved (strtok
   puts null in there to terminate the substrings).  This routine
   uses mallocs to allow storage for the token.  The memory is
   reallocated for each new string.  Use just like strtok:
   
   Successively returns the tokens in string1, using the delimeters
   defined by string2.  If string1 is NULL (a NULL pointer) the 
   routine returns the next token in the string from the previous call.
   Otherwise the first token is returned.  A NULL pointer is returned
   on failure (no more tokens in the current string).
*/
 
Char *strtokp( string1, string2 )
Char	*string1, *string2 ;
{
static Char	*spntr, *tpntr, *token ;
static int	called = NULL ;		/* called=NULL ==> initialize */
 
/* initialize on first call */
	if ( called == NULL ) {
		called = 1 ;
		token = (Char*)malloc( strlen(string1) ) ;
	}
 
/* if string1 is not NULL reset the routine */
	if ( string1 != NULL ) {
		spntr = string1 ;
		token = (Char*)realloc( token, strlen(string1) ) ;
	}
	if ( *spntr == NULL ) return( NULL ) ;	/* end of original string */
 
/* skip	initial delimeter characters */
	for (; *spntr != NULL; spntr++ )
		if ( NULL == strchr(string2, *spntr) ) break ;
 
/* copy characters to token until the next delimeter */
	tpntr = &token[0] ;
	for (; *spntr != NULL; spntr++ ) {
		if ( NULL != strchr( string2, *spntr ) ) break ;
		*tpntr = *spntr ;
		tpntr++ ;
	}
	*tpntr = NULL ;
 
/* return result to caller */
	if ( token[0] == NULL ) return( NULL ) ;
	return( &token[0] ) ;
}
 
 
 
 
/* strupr: convert a string to upper case.
 */
 
Char	*strupr( string )
Char	*string ;
{
int	i ;
 
	for ( i=0; i<strlen( string ); i++ )
		if ( string[i] > 96 && string[i] < 123 ) string[i] -= 32 ;
 
	return( string ) ;
}



/* Function LINE_END
 *
 * Return a NULL pointer if the string contains only
 * blanks and tabs or if it is a NULL string.  Else
 * return a pointer to the first offending character.
 */
Char	*line_end( string ) 
Char 	*string ;
{
	for (; *string != NULL; string++ )
		if ( (*string != BLANK) && (*string != TAB) ) return(string) ;
 
	return( NULL ) ;
}

@//E*O*F macro.c//
chmod u=rw,g=r,o=r macro.c
 
echo x - send.c
sed 's/^@//' > "send.c" <<'@//E*O*F send.c//'
/* SEND
 *
 * These routines support sending characters to the cray.  This time we
 * are using tcp/ip directly so it should be really simple.
 */

#include "craytool.h"


/* SENDS
 *
 * Send a string to comm.
 */
void sends(string,flush)
char	*string ;
int	flush ;
{
	time_buffer(string, strlen(string)) ;
	if (flush) time_buffer(&flush_char, 1) ;
}


/* SENDC
 *
 * Send a char to comm.
 */
void sendc(c,flush)
char	c ;
int	flush ;
{
	time_buffer(&c,1) ;
	if ( flush ) time_buffer(&flush_char,1) ;
}


/* TIME_BUFFER
 *
 * This additional buffering is a kludge made necessary by the fact
 * the the cray tends to lose characters in its input stream when they
 * follow a newline too closely.  This buffer is flushed only by the
 * interval timer routine.  Should the buffer fill it is reallocated
 * (we can make it pretty big, sunview progs are huge anyway).  When the
 * timer routine finds text in the buffer with a trailing newline the
 * buffer is flushed.  When filtering the flushing routine only sends
 * a single flush_char, regardless of how many have been stockpiled.
 * The timer should be set to ~ 1/5 second.  On flushing care must
 * be taken not to give the cray too many characters without a flush
 * character (if filtering).
 *
 * With tpc/ip we don't lose characters, but still it is nice to buffer
 * them in time.
 */
#define OUT_BUFSIZ	256	/* timed output buffer size */
#define OUT_TIMEOUT	200000	/* 1/5 second timeout */

time_buffer(s,count)
char	*s ;
int	count ;
{
static int	out_bufsiz ;
static int	index ;
int		i ;
Notify_value	time_flush() ;
struct itimerval out_timer ;

	/* initial entry, allocate buffer */
	if ( outbuf == NULL ) {
		outbuf = malloc(OUT_BUFSIZ) ;
		out_bufsiz = OUT_BUFSIZ ;
	}

	/* reset the timer on each string received */
	out_timer.it_interval.tv_usec = 0 ;
	out_timer.it_interval.tv_sec = 0 ;
	out_timer.it_value.tv_usec = OUT_TIMEOUT ;
	out_timer.it_value.tv_sec = 0 ;
	notify_set_itimer_func(frame, time_flush,
		ITIMER_REAL, &out_timer, ITIMER_NULL) ;

	if ( *outbuf == NULL ) index = 0 ;

	for ( i=0; i<count; i++ ) {
		if ( index >= out_bufsiz - 2 ) {
			outbuf = realloc(outbuf, out_bufsiz + OUT_BUFSIZ) ;
			outbuf == NULL ;
			out_bufsiz += OUT_BUFSIZ ;
		}
		outbuf[index++] = s[i] ;
	}
	outbuf[index] = NULL ;
}


/* TIME_FLUSH
 *
 * Control reaches here when the interval is up.  Flushes the output
 * buffer if anything is there.  Delays the flush until a flush character
 * is recieved.  In this TCP version the flush character should be a
 * meta character (not normally used) and should never be sent (it is
 * not line buffered).
 */

Notify_value time_flush(client, which)
Notify_client	client ;
int		which ;
{
int	count, i, send_count ;
int	last_flush_char ;

	/* count chars, and find last flush char */
	for ( last_flush_char = 0, count = 0; outbuf[count] != NULL; count++ )
		if ( outbuf[count] == flush_char ) last_flush_char = count ;
	
	/* if no flush char, don't do anything */
	if ( last_flush_char == 0 ) return(NOTIFY_DONE) ;
	
	/* squeeze flush_chars out of the buffer */
	for ( i=0, count=0; i<last_flush_char; i++ )
		if ( outbuf[i] != flush_char ) outbuf[count++] = outbuf[i] ;

	write(comm, outbuf, count) ;
	*outbuf = NULL ;

	return(NOTIFY_DONE) ;
}


@//E*O*F send.c//
chmod u=rw,g=r,o=r send.c
 
echo x - tpanel.c
sed 's/^@//' > "tpanel.c" <<'@//E*O*F tpanel.c//'
/* Control panel event stuff for the tty window of craytool */

#include "craytool.h"

Panel_item	comed_item, exit_item ;
Panel_item	suffixa_item, suffixb_item, suffixc_item,
	 	suffixd_item, suffixe_item ;


/* EXIT_EVENT
 *
 * Terminates the telnet process and shuts down everything.
 */
void exit_event( item, event )
Panel_item	item ;
Event		*event ;
{
char	c = CTRL(d) ;

	ttysw_input(ttysw, &c, 1) ;
}


/* COMED_EVENT
 *
 * Enables/Disables the comed/macro stuff.  This can't be active on startup
 * or the password will be echoed.  It should be invoked by a button.
 */
void comed_event( item, event )
Panel_item	item ;
Event		*event ;
{
char	c = TELNET_ECHO ;

	comed_flag = !comed_flag ;
	if ( comed_flag )
		panel_set(comed_item, PANEL_LABEL_IMAGE,
			panel_button_image(tpanel, "SUSPEND COMMAND EDITOR",0,0),
			0 ) ;
	else
		panel_set(comed_item, PANEL_LABEL_IMAGE,
			panel_button_image(tpanel, "INVOKE COMMAND EDITOR ",0,0),
			0 ) ;
	ttysw_input(ttysw, &c, 1) ;
	ttysw_input(ttysw, "\n", 1) ;
}



/* SUFFIX SWITCHING EVENT FUNCTIONS
 *
 * Switches to the requested suffix.
 */
void suffixa_event(){ ttysw_input(ttysw, "\005a\n", 3) ; }
void suffixb_event(){ ttysw_input(ttysw, "\005b\n", 3) ; }
void suffixc_event(){ ttysw_input(ttysw, "\005c\n", 3) ; }
void suffixd_event(){ ttysw_input(ttysw, "\005d\n", 3) ; }
void suffixe_event(){ ttysw_input(ttysw, "\005e\n", 3) ; }



/* Create the control panel */
create_tty_control_panel(frame)
Frame	frame ;
{
	tpanel = window_create(frame, PANEL,
		WIN_X,		0,
		WIN_ROWS,	1,
		0) ;
	exit_item = panel_create_item(tpanel, PANEL_BUTTON,
		PANEL_LABEL_IMAGE,	panel_button_image(tpanel,
					"EXIT",0,0),
		PANEL_NOTIFY_PROC,	exit_event,
		0 ) ;
	comed_item = panel_create_item(tpanel, PANEL_BUTTON,
		PANEL_LABEL_IMAGE,	panel_button_image(tpanel,
					"INVOKE COMMAND EDITOR ",0,0),
		PANEL_NOTIFY_PROC,	comed_event,
		0 ) ;
	suffixa_item = panel_create_item(tpanel, PANEL_BUTTON,
		PANEL_LABEL_IMAGE,	panel_button_image(tpanel,"A",0,0),
		PANEL_NOTIFY_PROC,	suffixa_event,
		0 ) ;
	suffixb_item = panel_create_item(tpanel, PANEL_BUTTON,
		PANEL_LABEL_IMAGE,	panel_button_image(tpanel,"B",0,0),
		PANEL_NOTIFY_PROC,	suffixb_event,
		0 ) ;
	suffixc_item = panel_create_item(tpanel, PANEL_BUTTON,
		PANEL_LABEL_IMAGE,	panel_button_image(tpanel,"C",0,0),
		PANEL_NOTIFY_PROC,	suffixc_event,
		0 ) ;
	suffixd_item = panel_create_item(tpanel, PANEL_BUTTON,
		PANEL_LABEL_IMAGE,	panel_button_image(tpanel,"D",0,0),
		PANEL_NOTIFY_PROC,	suffixd_event,
		0 ) ;
	suffixe_item = panel_create_item(tpanel, PANEL_BUTTON,
		PANEL_LABEL_IMAGE,	panel_button_image(tpanel,"E",0,0),
		PANEL_NOTIFY_PROC,	suffixe_event,
		0 ) ;
	window_fit_height(tpanel) ;
}
@//E*O*F tpanel.c//
chmod u=rw,g=r,o=r tpanel.c
 
echo x - craytool.h
sed 's/^@//' > "craytool.h" <<'@//E*O*F craytool.h//'
/* include file for program craytool */
#ifdef MAIN
#define	EXTERN
#else
#define EXTERN	extern
#endif


#include <stdio.h>
#include <suntool/sunview.h>
#include <suntool/canvas.h>
#include <suntool/tty.h>
#include <suntool/panel.h>

#include <malloc.h>
#include <ctype.h>
#include <fcntl.h>
#include <sys/wait.h>

#define NROWS	34	/* must match cray emacs definition */
#define NCOLS	80

#define CTRL(c)		(char)('c'>96 ? 'c'-96 : 'c'-64)
#define isctrl(c)	( c==(c&0x1F) || c==0x7F )
#define Char		unsigned char
#define Short		unsigned short
#define MYPORT	10000	/* inet port number */
#define BLANK		' '
#define TAB		'\t'
#define	NOT		!
#define ESC		'\033'
#define LF		'\n'
#define CR		'\015'
#define CRAY_EOL	'\037'
#define TELNET_ECHO	CTRL(p)
#define TELNET_ATTN	CTRL(])
#define ITIMER_NULL	((struct itimerval *)0)

#define	STDIN	0
#define	STDOUT	1
#define	STDERR	2

EXTERN Frame		frame;
EXTERN Pixfont		*font ;
EXTERN Tty		ttysw ;
EXTERN Notify_value	exodus(), tty_interposer() ;

EXTERN Panel		epanel ;	/* editor window panel */
EXTERN Panel		tpanel ;	/* tty window panel */

/* ansi canvas definition */
struct Ansi_win {
	Frame	frame ;
	Canvas	canvas ;
	Pixfont *font ;
	int	row, col ;	/* cursor location */
	char	*image ;	/* buffer containing screen image */
} ;

EXTERN void		sends(), sendc(), sendspure(), sendcpure() ;
EXTERN void		editor_kbd(), shell_kbd() ;

EXTERN int	comm ;			/* socket descriptor */
EXTERN int	char_width, char_height ; /* char size in pixels (for mouse) */
EXTERN char	*outbuf ;		/* timed output buffer */
EXTERN char	flush_char ;		/* char to force a flush */
EXTERN FILE	*scratch ;		/* debug output file */
EXTERN char	*tty_argv[3] ;		/* args to invoke telnet */

/* flags */
EXTERN int	inserting ;		/* 1 if in insert mode */
EXTERN int	cmode ;			/* 1 if cmode */
EXTERN int	immediate ;		/* 1 to flush on every char */
EXTERN int	defining_macro ;	/* 1 if def in progresss */
EXTERN int	comed_flag ;		/* 1 to activate ced tools */
@//E*O*F craytool.h//
chmod u=rw,g=r,o=r craytool.h
 
echo x - fkeys.h
sed 's/^@//' > "fkeys.h" <<'@//E*O*F fkeys.h//'
/* function key defs */

struct Key	{
	char	*normal ;
	char	*shifted ;
	char	*control ;
} ;


/* right keypad (sun3)

normal (movement)
	r1    r2    r3		pgup        top         rev isearch
	r4    r5    r6		pgdn        bottom      isearch
	r7    up    r9		home        up          end
	left  r11   right	left        set mark	right
	r13   down  r15		prev word   down        next word   

shifted (kbd macro & buffers)
	r1    r2    r3		exec macro  learn       end learn
	r4    r5    r6		next buf    list bufs   name buf
	r7    up    r9		select buf              kill buf
	left  r11   right	            named command
	r13   down  r15		del p word              del n word

controlled (window commands)
	r1    r2    r3		next pgup   prev        del current
	r4    r5    r6		next pgdn   next        del others
	r7    up    r9		resize                  redraw
	left  r11   right	            split
	r13   down  r15		grow                    shrink
*/


struct Key rightkey[] =  {
	{"\\541",	"\\501",	"\\401"},
	{"\\542",	"\\502",	"\\402"},
	{"\\543",	"\\503",	"\\403"},
	{"\\544",	"\\504",	"\\404"},
	{"\\545",	"\\505",	"\\405"},
	{"\\546",	"\\506",	"\\406"},
	{"\\547",	"\\507",	"\\407"},
	{"\\550",	"\\510",	"\\410"},
	{"\\551",	"\\511",	"\\411"},
	{"\\552",	"\\512",	"\\412"},
	{"\\553",	"\\513",	"\\413"},
	{"\\554",	"\\514",	"\\414"},
	{"\\555",	"\\515",	"\\415"},
	{"\\556",	"\\516",	"\\416"},
	{"\\557",	"\\517",	"\\417"}
} ;
		

/* top function keys

normal: (files)
f1	f2	f3	f4	f5	f6	f7	f8	f9
find	read	insert	view	save	write	rename  copy r	arg

shifted: (misc)
f1	f2	f3	f4	f5	f6	f7	f8	f9
replace q repl. insert	upper	lower	admode	dlmode	adgmode	dlgmode

control: free codes to be redefined.

All codes are unique (special keys), except F9 which sends ^U (arg).
*/

struct Key topkey[] = {
	{"\\461",	"\\441",	"\\421"},
	{"\\462",	"\\442",	"\\422"},
	{"\\463",	"\\443",	"\\423"},
	{"\\464",	"\\444",	"\\424"},
	{"\\465",	"\\445",	"\\425"},
	{"\\466",	"\\446",	"\\426"},
	{"\\467",	"\\447",	"\\427"},
	{"\\470",	"\\450",	"\\430"},
	{"\\025",	"\\451",	"\\431"}
} ;
@//E*O*F fkeys.h//
chmod u=rw,g=r,o=r fkeys.h
 
echo x - .craymacros
sed 's/^@//' > ".craymacros" <<'@//E*O*F .craymacros//'
Default macro definitions.  Don't forget the terminating ';'.  The general
format is 
": macroname(arg1, arg2, ... argn)	text of macro with arguments ;"

: ls		files ;
: rm		destroy ;
: mls		mass list ;
: @		cosmos ;
: tralfaz	128.174.20.49 ;

Example of a macro with arguments (args separated by commas).  To expand
this macro, type CFT [arg], with your choice of delimeters.
: CFT(x)	cft i=x.f, l=x.l, b=x.o ;
@//E*O*F .craymacros//
chmod u=rw,g=r,o=r .craymacros
 
exit 0