[comp.sources.misc] v07i050: CRISP release 1.9 part 29/32

allbery@uunet.UU.NET (Brandon S. Allbery - comp.sources.misc) (06/22/89)

Posting-number: Volume 7, Issue 50
Submitted-by: fox@marlow.UUCP (Paul Fox)
Archive-name: crisp1.9/part30



#!/bin/sh
# this is part 9 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file ./regexp.c continued
#
CurArch=9
if test ! -r s2_seq_.tmp
then echo "Please unpack part 1 first!"
     exit 1; fi
( read Scheck
  if test "$Scheck" != $CurArch
  then echo "Please unpack part $Scheck next!"
       exit 1;
  else exit 0; fi
) < s2_seq_.tmp || exit 1
echo "x - Continuing file ./regexp.c"
sed 's/^X//' << 'SHAR_EOF' >> ./regexp.c
X	  case '<': case '^':
X			re_code[end_of_code] = BOL;	break;
X	  case '>': case '$':
X			re_code[end_of_code] = EOL;	break;
X	  case '.':
X	  		if (re_syntax == BRIEF_SYNTAX)
X				goto DEFAULT;
X	  		re_code[end_of_code] = QUESTION;	
X			break;
X	  case '?':
X	  		if (re_syntax == UNIX_SYNTAX)
X				goto DEFAULT;
X	  		re_code[end_of_code] = QUESTION;	
X			break;
X	  case '*':	re_code[end_of_code] = STAR;	break;
X	  case '[': {
X			register int class;
X			register int classend;
X			char	bitmap[BITMAP_SIZE];
X			int	i;
X			int	not = 0;
X# define	SET(x)	bitmap[x >> 3] |= bittab[x & 7]
X# define	ISSET(ptr, bit) (ptr[bit >> 3] & bittab[bit & 7])
X
X			for (i = 0; i < BITMAP_SIZE; i++)
X				bitmap[i] = 0;
X
X			re_code[end_of_code] = CLASS;
X			pat_ptr++;
X		 	if (*pat_ptr == '^' || *pat_ptr == '~') {
X				not = 1;
X			       	pat_ptr++;
X				}
X		       if (*pat_ptr == ']' || *pat_ptr == '-') {
X				SET(*pat_ptr);
X				pat_ptr++;
X				}
X		       while (*pat_ptr && *pat_ptr != ']') {
X			       if (*pat_ptr == '-') {
X				       pat_ptr++;
X				       if (*pat_ptr == ']' || *pat_ptr == 0) {
X						SET('-');
X						continue;
X						}
X				       class = (pat_ptr[-2] & 0xff)+1;
X				       classend = *pat_ptr & 0xff;
X				       if (class > classend+1) {
X						ewprintf("Invalid [] range.");
X						return FALSE;
X						}
X				       for (; class <= classend; class++)
X						SET(class);
X					pat_ptr++;
X					}
X				else if (*pat_ptr == '\\') {
X					int	ch;
X					pat_ptr++;
X					ch = *pat_ptr == 'n' ? '\n' :
X					     *pat_ptr == 'f' ? '\f' : 
X					     *pat_ptr == 't' ? '\t' : 
X					     *pat_ptr;
X					SET(ch);
X					pat_ptr++;
X					}
X				else {
X					SET(*pat_ptr);
X					pat_ptr++;
X					}
X		       }
X		       if (*pat_ptr++ != ']') {
X				ewprintf("Unmatched [ ]");
X				return FALSE;
X				}
X			for (i = 0; i < BITMAP_SIZE; i++)
X				re_code[end_of_code + 3 + i] =
X					not ? ~bitmap[i] : bitmap[i];
X			end_of_code += 3 + i;
X			return TRUE;
X	       }
X	  case '\\':
X		if (*++pat_ptr == 'c') {
X			re_code[end_of_code] = SETPOS;
X			break;
X			}
X		len = strcspn(pat_ptr + 1, magic_str) + 1;
X		goto do_normal;
X	  DEFAULT:
X	  default:
X		if (magic)
X			len = strcspn(pat_ptr, magic_str);
X		else
X			len = strlen(pat_ptr);
Xdo_normal:
X		if (or_just_done && len > 1)
X			len = 1;
X		else if (len <= 0)
X			len = strlen(pat_ptr);
X		else if (len > 1 && (pat_ptr[len] == '@' || 
X		     pat_ptr[len] == '+' || pat_ptr[len] == '|'))
X			len--;
X		/*----------------------------------------
X		/*   Check to see if we need to expand code[]
X		/*----------------------------------------*/
X		if (end_of_code + len >= re_code_size - REGEXP_INCR) {
X			char *new_code = chk_alloc(re_code_size + REGEXP_INCR);
X			memcpy(new_code, re_code, re_code_size);
X			re_code_size += REGEXP_INCR;
X			re_code = new_code;
X			}
X		re_code[end_of_code] = STRING;
X		re_code[end_of_code+3] = len;
X		strncpy(&re_code[end_of_code+4], pat_ptr, len);
X		incr = len;
X		size = len + 4;
X		break;
X	  }
X	pat_ptr += incr;
X	if (*pat_ptr == '}' || *pat_ptr == NULL)
X		LPUT16(&re_code[end_of_code], 0);
X	else
X		LPUT16(&re_code[end_of_code], size);
X	end_of_code += size;
X	return TRUE;
X}
Xshift_up(index)
X{
X	register	char	*dst = &re_code[end_of_code - 1] + 3;
X	register	char	*src = dst - 3;
X	register	char	*ptr = &re_code[index];
X
X	while (src >= ptr)
X		*dst-- = *src--;
X	end_of_code += 3;
X}
Xstatic	char	*start_of_line;
XREGEXP	*regexp;
Xchar	*end_ptr;
Xtypedef struct regstate {
X	int	loop_count;
X	char	*lptr;
X	int	size;
X	} rsp;
X
Xint
Xregexec(prog, string, size)
XREGEXP *prog;
Xchar *string;
X{	int	incr = 1;
X	register int	loop_count;
X	register char	*lptr;
X	extern int offset;
X	extern int fwd;
X	char	*prog_string = prog->program;
X
X	if (*prog_string == BOL) {
X		if (fwd && offset)
X			return FALSE;
X		if (!fwd)
X			offset = 0;
X		}
X	lptr = string + offset;
X	start_of_line = string;
X	size -= offset;
X	regexp = prog;
X	prog->setpos = NULL;
X
X	if (fwd) {
X		loop_count = size + 1;
X		if (*prog_string == STRING) {
X# if 1
X			char ch4 = prog_string[4];
X			loop_count -= prog_string[3] - 1;
X			if (case_flag && size) {
X				int orig_loop_count = loop_count;
X				while (--loop_count > 0) {
X					if (*lptr++ == ch4) {
X						if (strncmp(lptr-1, &prog_string[4], prog_string[3]) == 0) {
X							if (*(prog_string + LGET16(prog_string)) == FINISH) {
X								prog->start = lptr-1;
X								prog->end = lptr + prog_string[3] - 1;
X								return 1;
X								}
X							lptr--;
X							break;
X							}
X						}
X					}
X				loop_count++;
X				size -= orig_loop_count - loop_count;
X				}
X				if (loop_count <= 0)
X					return 0;
X# else
X			loop_count -= prog_string[3] - 1;
X			if (case_flag && size)
X				while (loop_count > 0) {
X					if (*lptr == prog_string[4])
X						break;
X					loop_count--;
X					lptr++;
X					size--;
X					}
X# endif
X			}
X		}
X	else {
X		loop_count = lptr - string + 1;
X		incr = -1;
X		}
X	if (*prog_string == BOL)
X		loop_count = 1;
X		
X	while (loop_count-- > 0) {
X		if (regmatch(prog_string, lptr, size, (rsp *) NULL)) {
X			prog->start = lptr;
X			prog->end = end_ptr;
X			return 1;
X			}
X		lptr += incr;
X		size -= incr;
X		}
X	return 0;
X}
Xregmatch(prog, lptr, size, regstate)
Xregister char	*prog;
Xregister char	*lptr;
Xrsp *regstate;
X{	int	i;
X	char	*prog_start = prog;
X
X# define	RETURN return
Xloop_again:
X	for ( ; ; prog += LGET16(prog)) {
X		switch (*prog) {
X		  case STRING:
X			i = prog[3];
X			if (size < i)
X				RETURN(FALSE);
X			if (prog[4] != *lptr ||
X				strncmp(lptr, prog+4, i) != 0) {
X				if (!case_flag) {
X					if (case_match(lptr, prog+4, i) == FALSE)
X						RETURN(FALSE);
X					}
X				else
X					RETURN(FALSE);
X				}
X			size -= i;
X			lptr += i;
X			break;
X		  case CLASS: {
X		  	char *bitmap = prog + 3;
X			if (size <= 0)
X				RETURN(FALSE);
X			if (ISSET(bitmap, *lptr)) {
X				size--;
X				lptr++;
X				break;
X				}
X			if (!case_flag && isalpha(*lptr)) {
X				char	ch = isupper(*lptr) ? *lptr + 0x20 : *lptr;
X				char	ch1 = ch - 0x20;
X				if (!ISSET(bitmap, ch) && !ISSET(bitmap, ch1))
X					RETURN(FALSE);
X				}
X			else 
X				RETURN(FALSE);
X			size--;
X			lptr++;
X			break;
X			}
X		  case FINISH:	
X				end_ptr = lptr;	
X				RETURN(TRUE);
X		  case LOOP:		
X				if (regstate && --regstate->loop_count > 0) {
X					prog = prog_start;
X					goto loop_again;
X					}
X				break;
X		  case END:		break;
X		  case BOL:
X			if (lptr != start_of_line)
X				RETURN(FALSE);
X			break;
X		  case EOL:
X			if (size) {
X				if (*lptr != '\n')
X					RETURN(FALSE);
X				lptr++, size--;
X				}
X			break;
X		  case QUESTION:
X			if (size <= 0)
X				RETURN(FALSE);
X			size--;
X			lptr++;
X			break;
X		  case OR:
X			do {
X				if (regmatch(prog + 3, lptr, size, (rsp *) NULL))
X					RETURN(TRUE);
X				prog += LGET16(prog);
X				}
X			while (*prog == OR);
X			RETURN(regmatch(prog, lptr, size, (rsp *) NULL));
X		  case STAR: {
X		  	char *eptr;
X			if (magic > 0) { /* 1.3 */
X				for (i = size; i >= 0; i--)
X					if (regmatch(prog + 3, lptr + i, size - i, (rsp *) NULL))
X						break;
X				}
X			else {
X				for (i = size, eptr = lptr; i >= 0; eptr++, i--)
X					if (regmatch(prog + 3, eptr, i, (rsp *) NULL))
X						break;
X				}
X			if (i < 0)
X				RETURN(FALSE);
X			RETURN(TRUE);
X			}
X		  case ONE_OR_MORE:
X		  case ZERO_OR_MORE: {
X			char *eptr = prog + LGET16(prog);
X			char *latest_end_ptr = NULL;
X			rsp rs;
X			
X			end_ptr = lptr;
X			i = *prog == ZERO_OR_MORE ? 1 : 2;
X			for ( ; i < size+2; i++) {
X				int success;
X				rs.loop_count = i-1;
X				success = regmatch(i == 1 ? eptr : prog + 3, 
X					lptr, size, &rs);
X				if (!success) {
X					if (rs.loop_count)
X						break;
X					}
X				if (!success && i >= size + 3)
X					break;
X				if (success) {
X					latest_end_ptr = end_ptr;
X					if (end_ptr >= lptr + size)
X						break;
X					if (magic > 0)	/* 1.3 */
X						break;
X					}
X				}
X# ifdef	DEBUG_REGEXP
Xif (dflag) {char buf[128]; sprintf(buf, 
X"@(%d): Given up after %d iterations - %ssuccessful.\n", 
Xmatch_level, i, latest_end_ptr ? "" : "un");trace_log(buf);}
X# endif
X			if (*prog == ZERO_OR_MORE && i == 1 && latest_end_ptr == NULL)
X				break;
X			if (latest_end_ptr == NULL)
X				RETURN(FALSE);
X# ifdef DEBUG_REGEXP
X	print_match(lptr, latest_end_ptr);
X# endif
X			end_ptr = latest_end_ptr;
X			RETURN(TRUE);
X			}
X		  case OPEN: case OPEN+1: case OPEN+2: case OPEN+3: case OPEN+4:
X		  case OPEN+5: case OPEN+6: case OPEN+7: case OPEN+8: case OPEN+9:
X			regexp->startp[*prog - OPEN] = lptr;
X			break;
X		  case CLOSE: case CLOSE+1: case CLOSE+2: case CLOSE+3: case CLOSE+4:
X		  case CLOSE+5: case CLOSE+6: case CLOSE+7: case CLOSE+8: case CLOSE+9:
X			regexp->endp[*prog - CLOSE] = lptr;
X			break;
X		  case SETPOS:
X			regexp->setpos = lptr;
X			break;
X		  }
X		}
X}
Xcase_match(str1, str2, len)
Xregister char *str1;
Xregister char *str2;
Xregister int len;
X{	register int ch1, ch2;
X	while (len-- > 0) {
X		ch1 = *str1++;
X		ch2 = *str2++;
X		if (isupper(ch1))
X			ch1 += 0x20;
X		if (isupper(ch2))
X			ch2 += 0x20;
X		if (ch1 != ch2)
X			return FALSE;
X		}
X	return TRUE;
X}
Xre_print(re)
Xchar	*re;
X{	char	*start = re;
X	char	buf[128];
X	char	buf1[128];
X	char	buf2[20];
X	char	*p;
X	int	i;
X
X	trace_log("\n");
X	while (1) {
X		p = buf1;
X		switch (*re) {
X		  case FINISH:	
X		  case ZERO_OR_MORE:
X		  case ONE_OR_MORE:
X		  case STAR:	
X		  case QUESTION:
X		  case BOL:	
X		  case EOL:	
X		  case END:
X		  case OR:
X		  case LOOP:
X		  case SETPOS:
X				p = re_opcodes[*re];
X				break;
X		  case CLASS:		
X					sprintf(buf1, "CLASS     %s",
X						reg_print_bitmap(re+3));
X					break;
X		  case STRING:		
X				sprintf(buf1, "STRING  len=%d str='%.*s'",
X					re[3], re[3], re+4);
X				break;
X		  case OPEN:   case OPEN+1: case OPEN+2: case OPEN+3: 
X		  case OPEN+4: case OPEN+5: case OPEN+6: case OPEN+7: 
X		  case OPEN+8: case OPEN+9:
X				sprintf(buf2, "OPEN-%d", *re - OPEN);
X				p = buf2;
X				break;
X		  case CLOSE:   case CLOSE+1: case CLOSE+2: case CLOSE+3: 
X		  case CLOSE+4: case CLOSE+5: case CLOSE+6: case CLOSE+7: 
X		  case CLOSE+8: case CLOSE+9:
X				sprintf(buf2, "CLOSE-%d", *re - CLOSE);
X				p = buf2;
X				break;
X		  default:
X				sprintf(buf1, "** DONT KNOW = 0x%02x", *re);
X				break;
X		  }
X		if (*re == FINISH)
X			sprintf(buf, "[%02d] --> --/-- %s\n", 
X			re-start, p);
X		else
X			sprintf(buf, "[%02d] --> %02d/%02d %s\n", 
X				re-start, LGET16(re), 
X				(re - start) + LGET16(re), p);
X		trace_log(buf);
X		if (*re == FINISH)
X			break;
X		if (*re == OR || *re == END || *re == ZERO_OR_MORE || *re == ONE_OR_MORE)
X			i = 3;
X		else
X			i = LGET16(re);
X		if (i == 0)
X			i = 3;
X		re += i;
X		}
X}
Xstatic char	*
Xreg_print_bitmap(bitmap)
Xchar	*bitmap;
X{
X	int	i;
X	int	not = 0;
X	int	last_set = -1;
X	static	char	buf[128];
X	char	*cp = buf;
X
X	*cp++ = '[';
X	if (ISSET(bitmap, 0)) {
X		*cp++ = '~';
X		not = 1;
X		}
X	for (i = 0; i < 256; i++) {
X		int	set = ISSET(bitmap, i);
X		if (not)
X			set = !set;
X		if (set) {
X			if (last_set == -1) {
X				if (i == '\t')
X					*cp++ = '\\', *cp++ = 't';
X				else if (i == '\n')
X					*cp++ = '\\', *cp++ = 'n';
X				else
X					*cp++ = (char) i;
X				last_set = i;
X				}
X			continue;
X			}
X		if (last_set != -1) {
X			if (i > last_set+1) {
X				*cp++ = '-';
X				*cp++ = (char) i;
X				}
X			last_set = -1;
X			}
X		}
X	*cp++ = ']';
X	*cp = NULL;
X	return buf;
X}
X# if defined(DEBUG_REGEXP)
Xprint_match(start, end)
Xchar	*start;
Xchar	*end;
X{
X	extern int dflag;
X	if (dflag & DB_REGEXP) {
X		int	i, j;
X		char	*cp;
X		trace_log("Matched: '");
X		for (cp = start_of_line; *cp; cp++)
X			if (*cp == '\n')
X				trace_log("\\n");
X			else
X				trace_log("%c", *cp);
X		trace_log("'\n          ");
X		for (i = start - start_of_line; i > 0; i--)
X			trace_log(" ");
X		trace_log("^");
X		if (j = end - start) {
X			for (i = j - 2; i > 0; i--)
X				trace_log("-");
X			trace_log("^");
X			}
X		trace_log("\n");
X		}
X}
X# endif
SHAR_EOF
echo "File ./regexp.c is complete"
chmod 0444 ./regexp.c || echo "restore of ./regexp.c fails"
mkdir . >/dev/null 2>&1
echo "x - extracting ./region.c (Text)"
sed 's/^X//' << 'SHAR_EOF' > ./region.c &&
X/**************************************************************
X *
X *	CRISP - Custom Reduced Instruction Set Programmers Editor
X *
X *	(C) Paul Fox, 1989
X *	43, Jerome Close	      Tel: +44 6284 4222
X *	    Marlow
X *	     Bucks.
X *		England SL7 1TX
X *
X *
X *    Please See COPYRIGHT notice.
X *
X **************************************************************/
X
X# include	"list.h"
X
X
XSCCSID("@(#) region.c 1.9, (C) 1989, P. Fox");
X
Xextern	int	start_line, start_col;
Xextern	int	end_line, end_col;
Xextern	int	mark_type;
Xint	doing_transfer = FALSE;
Xint	saved_col;
X/*
X * This structure holds the starting position
X * (as a line/offset pair) and the number of characters in a
X * region of a buffer. This makes passing the specification
X * of a region around a little bit easier.
X */
Xtypedef struct  {
X	int	r_line;
X	int	r_col;			/* Origin LINE offset.          */
X	int	r_doffset;
X	RSIZE   r_size;                 /* Length in characters.        */
X	int	r_type;			/* Mark type.			*/
X}       REGION;
X
XREGION region;
X/*
X * Kill the region. Ask "getregion"
X * to figure out the bounds of the region.
X * Move "." to the start, and kill the characters.
X */
Xdel_block()
X{
X
X	if (rdonly() || check_mark())
X		return 0;
X
X	if (getregion(TRUE) != TRUE)
X		return 0;
X	delregion();
X	infof("Block deleted.");
X	return 0;
X}
X
Xcheck_mark()
X{
X	if (!doing_transfer && curbp->b_anchor == NULL) {
X		errorf("No marked block.");
X		return TRUE;
X		}
X	return FALSE;
X}
Xdelregion()
X{
X	if (region.r_size) {
X		u_dot();
X		*cur_col = current_col(region.r_col);
X		*cur_line = region.r_line;
X		ldelete(region.r_size);
X		if (region.r_type == MK_LINE)
X			*cur_col = saved_col;
X		}
X	raise_anchor();
X	return TRUE;
X}
Xtransfer()
X{	extern	BUFFER	*scrbp;
X	extern	BUFFER	*scrap_bp;
X	BUFFER	*saved_bp = curbp;
X	BUFFER	*bp;
X	BUFFER	*numberb();
X
X	accumulator = 0;
X	if ((bp = numberb(argv[1].l_int)) == NULL)
X		return 0;
X
X	scrbp = curbp;
X	curbp = bp;
X
X	start_line = argv[2].l_int;
X	start_col = argv[3].l_int;
X	end_line = argv[4].l_int + 1;
X	end_col = argv[5].l_int;
X
X	doing_transfer = TRUE;
X	copy();
X	accumulator = 1;
X	scrbp = scrap_bp;
X	curbp = saved_bp;
X	doing_transfer = FALSE;
X	return 0;
X}
Xinq_mksize()
X{
X	if (getregion(FALSE) != TRUE)
X		accumulator = 0;
X	else
X		accumulator = region.r_size;
X	return 0;
X}
Xpaste()
X{	char	*cp;
X	int	n;
X	int	inserted = FALSE;
X	int	col = *cur_col;
X
X	if (rdonly())
X		return 0;
X	lchange(WFEDIT);
X
X	k_seek();
X	u_dot();
X	if ((region.r_type = k_type()) == MK_LINE)
X		*cur_col = 1;
X
X	win_modify(WFEDIT);
X	while ((n = k_read(&cp)) >= 0) {
X		if (inserted)
X			lnewline();
X		else
X			inserted = TRUE;
X		if (n)
X			llinsert(cp, n, FALSE);
X		}
X	win_modify(WFEDIT);
X	if (region.r_type == MK_LINE)
X		*cur_col = col;
X
X	if (inserted)
X		infof("Scrap inserted.");
X	else 
X		infof("No scrap to insert.");
X	return 0;
X}
X
X/*
X * Copy all of the characters in the
X * region to the kill buffer. Don't move dot
X * at all. This is a bit like a kill region followed
X * by a yank.
X */
Xcopy()
X{
X	if (check_mark())
X		return 0;
X	if (copyregion((FILE *) NULL) == 0)
X		return 0;
X	if (!doing_transfer) {
X		raise_anchor();
X		infof("Block copied to scrap.");
X		}
X	return 0;
X}
Xcut()
X{
X	if (rdonly() || check_mark())
X		return 0;
X
X	if (copyregion((FILE *) NULL) == 0)
X		return 0;
X	if (delregion())
X		infof("Block deleted to scrap.");
X	else
X		infof("No marked block.");
X	return 0;
X}
Xcopyregion(fp)
XFILE	*fp;
X{
X	register LINE   *lp;
X	register int	line;
X	RSIZE	size;
X	int	r;
X	register int	mo;
X
X	if (getregion(TRUE) != TRUE || region.r_size == 0)
X		return 0;
X
X	line = region.r_line;
X	mo = region.r_col;
X
X	if (fp == NULL)
X		k_seek();
X	for (size = region.r_size; size > 0; line++) {
X		lp = vm_lock_line(line);
X		r = llength(lp) - mo;
X		if (size < r)
X			r = size;
X		if (fp)
X			fwrite(lp->l_text + mo, (int) r, 1, fp);
X		else
X			k_write(lp->l_text + mo, (int) r);
X		size -= r;
X		if (size > 0) {
X			if (fp)
X				fwrite("\n", 1, 1, fp);
X			else
X				k_newline();
X			size--;
X			}
X		mo = 0;
X		vm_unlock(line);
X		}
X	k_end();
X	return 1;
X}
X
Xgetregion(delete)
X{
X	register RSIZE	size = 0;
X	register LINE	*lp;
X	int	current_line;
X
X	saved_col = *cur_col;
X	if (check_mark())
X		return FALSE;
X	if (doing_transfer)
X		mark_type = MK_NORMAL;
X	else
X		get_marked_areas(hooked ? curwp : (WINDOW *) NULL);
X
X	region.r_type = mark_type;
X	current_line = *cur_line;
X	*cur_line = start_line;
X	start_col = current_offset(start_col, FALSE);
X	if (end_line == curbp->b_numlines)
X		end_col = 0;
X	else {
X		*cur_line = end_line;
X		end_col = current_offset(end_col, FALSE);
X		*cur_line = current_line;
X		}
X
X	if (delete && !doing_transfer) {
X		u_scrap();
X		k_delete(region.r_type);
X		}
X	region.r_line = start_line;
X	region.r_col = start_col;
X	region.r_doffset = end_col;
X	size -= start_col;
X	
X	while (start_line < end_line) {
X		lp = linep(start_line++);
X		size += llength(lp) + 1;
X		}
X
X	if (region.r_type == MK_LINE) {
X		lp = linep(start_line);
X		end_col = llength(lp)+1;
X		}
X	size += end_col;
X	region.r_size = size;
X
X	if (region.r_type != MK_LINE && end_line != curbp->b_numlines)
X		region.r_size++;
X	return TRUE;
X}
SHAR_EOF
chmod 0444 ./region.c || echo "restore of ./region.c fails"
mkdir . >/dev/null 2>&1
echo "x - extracting ./register.c (Text)"
sed 's/^X//' << 'SHAR_EOF' > ./register.c &&
X/**************************************************************
X *
X *	CRISP - Custom Reduced Instruction Set Programmers Editor
X *
X *	(C) Paul Fox, 1989
X *	43, Jerome Close	      Tel: +44 6284 4222
X *	    Marlow
X *	     Bucks.
X *		England SL7 1TX
X *
X *
X *    Please See COPYRIGHT notice.
X *
X **************************************************************/
X# include	"list.h"
X# include	"clk.h"
X
XSCCSID("@(#) register.c 1.8, (C) 1989, P. Fox");
X# define	MAX_REGISTER	(REG_MAX + 1)
X
XHead_p	reg[MAX_REGISTER];
Xvoid	trigger();
Xstatic	rchk();
Xlong	interval = 0;
Xlong	time_last_key_pressed = 0;
Xstatic void remove_macro();
X
Xvoid
Xinit_register()
X{	int	i;
X	for (i = 0; i < MAX_REGISTER; i++)
X		reg[i] = ll_init();
X}
X
Xcall_registered_macro()
X{
X	int	i = rchk();
X
X	if (i >= 0)
X		trigger(i);
X
X	return 0;
X}
Xregister_macro()
X{	int	i = rchk();
X	int	local = argv[3].l_flags == F_NULL ? FALSE : argv[3].l_int;
X	char	*str;
X
X	if (i < 0)
X		return 0;
X	str = strdup(argv[2].l_str);
X	if (local && i == REG_TYPED)
X		ll_append(curbp->b_register, str);
X	else
X		ll_append(reg[i], str);
X	return 0;
X}
Xunregister_macro()
X{	int	i = rchk();
X	int	local = argv[3].l_flags == F_NULL ? FALSE : argv[3].l_int;
X	char	*str = get_str(2);
X
X	if (i < 0)
X		return 0;
X
X	accumulator = 0;
X	if (local != 1)
X		remove_macro(reg[i], str);
X	remove_macro(curbp->b_register, str);
X	return 0;
X}
Xstatic void
Xremove_macro(lp, str)
XHead_p	lp;
Xchar	*str;
X{	register List_p llp;
X
X	for (llp = ll_first(lp); llp; llp = ll_next(llp)) {
X		char *cp = (char *) ll_elem(llp);
X		if (strcmp(cp, str) == 0) {
X			accumulator = 1;
X			chk_free(cp);
X			ll_delete(llp);
X			break;
X			}
X		}
X
X}
Xstatic
Xrchk()
X{	int	i = argv[1].l_int;
X	extern char *command_name;
X
X	if (i < 0 || i >= MAX_REGISTER) {
X		errorf("%s: invalid parameters.", command_name);
X		return -1;
X		}
X	return i;
X}
Xvoid
Xtrigger(type)
X{	extern int msg_level;
X	int	saved_msg_level = msg_level;
X	List_p	llp, blp = NULL;
X	if (type < 0)
X		return;
X
X	if (type == REG_TYPED)
X		blp = ll_first(curbp->b_register);
X	llp = ll_first(reg[type]);
X
X	if (llp == NULL && blp == NULL)
X		return;
X
X	msg_level = 1;
X	accumulator = 0;
X	trace_trigger(type);
X	for ( ; blp; blp = ll_next(blp))
X		str_exec((char *) ll_elem(blp));
X	for ( ; llp; llp = ll_next(llp))
X		str_exec((char *) ll_elem(llp));
X	msg_level = saved_msg_level;
X	if (type == REG_CTRLC && accumulator)
X		check_exit();
X}
Xreg_idle()
X{	extern int p_level;
X	extern int reading_char;
X	extern	u_int16	ttcol, ttrow;
X	extern int prompting;
X	u_int16	old_col = ttcol;
X	u_int16	old_row = ttrow;
X
X	if (p_level < 2 && reading_char && !prompting) {
X		trigger(REG_IDLE);
X		update();
X		ttmove(old_row, old_col);
X		ttflush();
X		}		
X	if (interval)
X		clk_timeout(reg_idle, 0, interval SECONDS);
X}
Xinq_idefault()
X{
X	accumulator = interval;
X	return 0;
X}
Xinq_itime()
X{
X	extern long time();
X	long l = time((long *) 0);
X
X	accumulator = l - time_last_key_pressed;
X	return 0;
X}
SHAR_EOF
chmod 0444 ./register.c || echo "restore of ./register.c fails"
mkdir . >/dev/null 2>&1
echo "x - extracting ./search.c (Text)"
sed 's/^X//' << 'SHAR_EOF' > ./search.c &&
X/**************************************************************
X *
X *	CRISP - Custom Reduced Instruction Set Programmers Editor
X *
X *	(C) Paul Fox, 1989
X *	43, Jerome Close	      Tel: +44 6284 4222
X *	    Marlow
X *	     Bucks.
X *		England SL7 1TX
X *
X *
X *    Please See COPYRIGHT notice.
X *
X **************************************************************/
X# include	"list.h"
X
XSCCSID("@(#) search.c 1.16, (C) P. Fox");
X
Xint	fwd;
Xint	offset;
Xint	magic = TRUE;		/* If FALSE, special characters in R.E. */
X				/* treated as normal.			*/
Xint	pnf_msg = TRUE;		/* FALSE when we dont want the 'Pattern */
X				/* not found.' message printed.		*/
Xint	case_flag = TRUE;
XREGEXP	*prog;
Xextern char *re_code;		/* From regexp.c so we can save the compiled */
Xextern int re_code_size;	/* re when we go prompting the user.	*/
Xstatic	int	print_msg = TRUE;/*Set to FALSE when we do a translate  */
X				/* to avoid forwsrch() printing search  */
X				/* succeeded message.			*/
Xstruct re_state {
X	int	saved_magic;
X	int	saved_case;
X	int	bmatch;
X	int	line;
X	int	last_line;
X	int	search_col;
X	}	re_state;
X
Xquote_regexp()
X{	register char *cp = get_str(1);
X	char	buf[BUFSIZ];
X	char	*bp = buf;
X	char	*rech = "+@[]<>^$*?{}|";
X
X	while (*cp) {
X		if (*cp == '\\') {
X			*bp++ = *cp++;
X			*bp++ = *cp++;
X			continue;
X			}
X		if (strchr(rech, *cp))
X			*bp++ = '\\';
X		*bp++ = *cp++;
X		}
X	*bp = NULL;
X	str_acc_assign(buf, bp - buf);
X}
Xsearch_list()
X{	struct re_state	rs;
X	char	*cp = get_str(2);
X	int	atom_no = 0;
X	int	i;
X	LIST	*lp = argv[3].l_list;
X	LIST	*next_atom();
X
X	accumulator = -1;
X	argv[6].l_flags = F_NULL;
X	if (search_start(&rs, TRUE, cp, 4, 5, 6) == FALSE)
X		return;
X	if (argv[1].l_flags != F_NULL)
X		atom_no = argv[1].l_int;
X
X	for (i = atom_no; i-- > 0 && lp; )
X		lp = next_atom(lp);
X
X	for ( ; lp; lp = next_atom(lp), atom_no++) {
X		if (*lp != F_STR && *lp != F_LIT)
X			continue;
X		cp = (char *) LGET32(lp);
X		if (regexec(prog, cp, strlen(cp))) {
X			accumulator = atom_no;
X			return;
X			}
X		}
X}
Xsearch(dir)
X{	struct re_state	rs;
X	char	buf[BUFSIZ];
X	char	*cp = get_arg1(dir ? "Search for: " : "Search back: ", buf, sizeof buf);
X
X	if (cp == NULL)
X		return;
X	if (*cp == NULL) {
X		infof("No pattern specified.");
X		accumulator = -1;
X		return;
X		}
X	if (search_start(&rs, dir, cp, 2, 3, 4) == FALSE) {
X		accumulator = -1;
X		return;
X		}
X	infof("Searching...");
X	(void) forwsrch(&rs);
X}
Xsrch_case()
X{
X	case_flag = argv[1].l_flags == F_NULL ? !case_flag : argv[1].l_int;
X	infof("Case sensitivity %s.", case_flag ? "on" : "off");
X	return 0;
X}
Xsrch_string()
X{
X	accumulator = search_string(get_str(1), get_str(2),
X		(int) (argv[5].l_flags == F_NULL ? case_flag : argv[5].l_int),
X		(int) (argv[4].l_flags == F_NULL ? magic : argv[4].l_int)
X		);
X	if (accumulator && argv[3].l_flags != F_NULL)
X			argv[3].l_sym->s_int = prog->end - prog->start;
X}
Xsearch_string(str1, str2, casef, magicf)
Xchar	*str1, *str2;
X{	int	saved_case = case_flag;
X	int	saved_magic = magic;
X	int	len2 = strlen(str2);
X	int	ret = 0;
X
X	case_flag = casef;
X	magic = magicf;
X
X	if ((prog = regcomp(str1)) == NULL) {
X		case_flag = saved_case;
X		magic = saved_magic;
X		return 0;
X		}
X	fwd = TRUE;
X	offset = 0;
X	if (len2 && regexec(prog, str2, len2)) {
X		if (prog->setpos)
X			prog->start = prog->setpos;
X		ret = prog->start - str2 + 1;
X		}
X	magic = saved_magic;
X	case_flag = saved_case;
X	return ret;
X}
X
Xtranslate()
X{	char	rep_buf[80];
X	int	global = argv[3].l_int;
X	int	prompt = argv[3].l_flags == F_NULL;
X	int	ntranslations = 0;
X	int	print_tmsg = FALSE;
X	int	found_one = FALSE;
X	int	num_lines_inserted = 0;
X	int	tmagic;
X	char	*cp;
X	int	s;
X	int	abort;
X	char	ch_buf[2];
X	int	ch;
X	int	size;
X	char	patbuf[256];
X	char	*pat;
X	int	perc = FALSE;
X	int	first_time = TRUE;
X	struct re_state rs;
X	char	*saved_code;
X	int	saved_re_code_size;
X	int	saved_col;
X	
X	if ((pat = get_arg1("Pattern: ", patbuf, sizeof patbuf)) == NULL)
X		return;
X	if (*pat == NULL) {
X		errorf("No previous translate pattern.");
X		return;
X		}
X
X	if (argv[2].l_flags == F_NULL)
X		ereply("Replacement: ", rep_buf, sizeof rep_buf);
X	else
X		strcpy(rep_buf, get_str(2));
X
X	save_position();
X	infof("Searching...");
X	if (search_start(&rs, TRUE, pat, 4, 5, 6) == FALSE)
X		return;
X	pnf_msg = FALSE;
X	saved_col = rs.search_col;
X	while (1) {
X		LINE *lp = linep(*cur_line);
X		print_msg = FALSE;
X		if (saved_col >= llength(lp)) {
X			saved_col = 0;
X			(*cur_line)++;
X			}
X		rs.search_col = saved_col;
X		if (!first_time) {
X			rs.line = *cur_line;
X			rs.last_line += num_lines_inserted;
X			}
X		first_time = FALSE;
X		tmagic = magic;
X		s = forwsrch(&rs);
X		saved_col = rs.search_col;
X		magic = tmagic;
X		print_msg = TRUE;
X		if (s)
X			break;
X		ch = 'Y';
X		found_one = TRUE;
X		size = prog->end - prog->start;
X		if (prompt) {
X			REGEXP saved_regexp;
X			argv[1].l_flags = F_NULL;
X			drop_anchor();
X			argv[1].l_int = size - 1;
X			argv[1].l_flags = F_INT;
X			if (size)
X				next_char();
X			win_modify(WFEDIT);
X			update();
X			saved_code = re_code;
X			saved_re_code_size = re_code_size;
X			re_code = NULL;
X			saved_regexp = *prog;
X			do {
X				if ((abort = ereply("Change [Yes|No|Global]? ", 
X				   ch_buf, 1)) == ABORT)
X					break;
X				ch = ch_buf[0];
X				if (ch > 'a')
X					ch -= 0x20;
X				}
X			while (ch != 'G' && ch != 'Y' && ch != 'N');
X			*prog = saved_regexp;
X			if (re_code)
X				chk_free(re_code);
X			re_code = saved_code;
X			prog->program = re_code;
X			re_code_size = saved_re_code_size;
X			if (ch == 'G') {
X				print_tmsg = TRUE;
X				global = TRUE;
X				prompt = FALSE;
X				perc = TRUE;
X				}
X			argv[1].l_int = size - 1;
X			argv[1].l_flags = F_INT;
X			if (size)
X				prev_char();
X			raise_anchor();
X			if (abort == ABORT)
X				break;
X			}
X		if (perc)
X			percentage((long) *cur_line, (long) curbp->b_numlines, "Global", "translate");
X		if (global || ch == 'Y') {
X			char	rep_str[256];
X			char	*rp = rep_str;
X			int	len;
X			for (cp = rep_buf; *cp; ) {
X				int	group;
X				char	*cp1;
X				if (*cp != '\\') {
X					*rp++ = *cp++;
X					continue;
X					}
X				if (!isdigit(cp[1])) {
X					if (*++cp)
X						*rp++ = *cp++;
X					continue;
X					}
X				group = cp[1] - '0';
X/*				if (group == 0)
X					group = 10;
X				else
X					group--;*/
X				cp += 2;
X				if ((cp1 = prog->startp[group]) == NULL) {
X					errorf("No such group in pattern.");
X					found_one = FALSE;
X					goto end_of_function;
X					}
X				while (cp1 < prog->endp[group])
X					*rp++ = *cp1++;
X				}
X			*rp = NULL;
X			len = strlen(rep_str);
X			ldelete((RSIZE) (size));
X			num_lines_inserted = linsert(rep_str, len);
X			saved_col += len;
X			if (*pat == '<' || *pat == '^')
X				saved_col++;
X			if (prompt && second_passed())
X				update();
X			ntranslations++;
X			}
X		else
X			saved_col++;
X		if (global == FALSE && prompt == FALSE)
X			break;
X		}
Xend_of_function:
X	accumulator = ntranslations;
X	argv[1].l_flags = F_NULL;
X	if (abort) {
X		argv[1].l_flags = F_INT;
X		argv[1].l_int = 0;
X		}
X	restore_position();
X	if (print_tmsg || prompt) {
X		update();
X		if (found_one)
X			infof("Translation complete; %d occurrence%s changed.",
X				ntranslations, ntranslations == 1 ? "" : "s");
X		else
X			infof("Pattern not found.");
X		}
X	pnf_msg = TRUE;
X	return;
X}
Xsearch_start(re_state, dir, pat, re, _case, block)
Xstruct re_state *re_state;
Xchar *pat;
X{
X	fwd = dir;
X	re_state->bmatch = FALSE;
X	re_state->line = *cur_line;
X	re_state->saved_case = case_flag;
X	re_state->last_line = curbp->b_numlines;
X	re_state->saved_magic = magic;
X	magic = TRUE;
X
X	if (argv[re].l_flags == F_INT)
X		magic = argv[re].l_int;
X	if (argv[_case].l_flags == F_INT)
X		case_flag = argv[_case].l_int;
X
X	if ((prog = regcomp(pat)) == NULL) {
X		magic = re_state->saved_magic;
X		return FALSE;
X		}
X	/*----------------------------------------
X	/*   If block is TRUE, then we only search
X	/*   within marked block.
X	/*----------------------------------------*/
X	if (argv[block].l_flags == F_INT && argv[block].l_int && get_marked_areas((WINDOW *) NULL)) {
X		extern int start_line, end_line, start_col;
X		re_state->line = start_line;
X		re_state->last_line = end_line + 1;
X		re_state->search_col = current_offset(start_col, FALSE);
X		}
X	else
X		re_state->search_col = current_offset(*cur_col, FALSE);
X
X	if (!fwd) {
X		switch (magic) {
X	  	  case -3: case 3:
X			re_state->bmatch = TRUE; break;
X	  	  case -2: case 2:
X			re_state->bmatch = !fwd; break;
X	  	  case -1: case 0: case 1:
X			re_state->bmatch = FALSE; break;
X	  	  }
X		if (pat[0] == '$' || pat[0] == '>') {
X			re_state->line++;
X			re_state->search_col = -1;
X			}
X		}
X
X	return TRUE;
X
X}
Xforwsrch(re_state)
Xstruct re_state *re_state;
X{	register LINE   *clp;
X	int	success = FALSE;
X	int	length;
X	int	incr, col;
X	int	orig_col;
X	
X	accumulator = 0;
X	if (fwd) {
X		incr = 1;
X		col = 0;
X		}
X	else {
X		incr = -1;
X		col = -1;
X		}
X	clp = vm_lock_line(re_state->line);
X	while (re_state->line >= 1 && re_state->line < re_state->last_line) {
X		length = llength(clp);
X		if (re_state->search_col < 0)
X			re_state->search_col = length;
X		if (re_state->bmatch) {
X			if (length > re_state->search_col)
X				length = re_state->search_col;
X			}
X		offset = re_state->search_col;
X		success = regexec(prog, ltext(clp), length);
X		vm_unlock(re_state->line);
X		if (success)
X			break;
X		clp = fwd ? lforw(clp) : lback(clp);
X		re_state->line += incr;
X		re_state->search_col = col;
X		}
X	case_flag = re_state->saved_case;
X	magic = re_state->saved_magic;
X	if (success != 1) {
X		if (pnf_msg)
X			infof("Pattern not found.");
X		return 1;
X		}
X	trace_log("Search succeeded\n");
X
X	u_dot();
X	win_modify(WFMOVE);
X	*cur_line = re_state->line;
X	if (prog->setpos)
X		prog->start = prog->setpos;
X	orig_col = re_state->search_col;
X	re_state->search_col = prog->start - (char *) ltext(clp);
X	*cur_col = current_col(re_state->search_col);
X	accumulator = prog->end - prog->start + 1;
X	
X	win_modify(WFMOVE);
X	if (print_msg)
X		infof("Search completed.");
X	return 0;
X}
Xvoid
Xregerror(msg)
Xchar	*msg;
X{
X	errorf("%s", msg);
X}
SHAR_EOF
chmod 0444 ./search.c || echo "restore of ./search.c fails"
mkdir . >/dev/null 2>&1
echo "x - extracting ./spawn.c (Text)"
sed 's/^X//' << 'SHAR_EOF' > ./spawn.c &&
X/**************************************************************
X *
X *	CRISP - Custom Reduced Instruction Set Programmers Editor
X *
X *	(C) Paul Fox, 1989
X *	43, Jerome Close	      Tel: +44 6284 4222
X *	    Marlow
X *	     Bucks.
X *		England SL7 1TX
X *
X *
X *    Please See COPYRIGHT notice.
X *
X **************************************************************/
X# include	"list.h"
X#include        <signal.h>
X
XSCCSID("@(#) spawn.c 1.12, (C) 1989 P. Fox");
Xchar    *shname = NULL;                 /* Saved shell name             */
Xint	background = FALSE;
X
Xtypedef	struct PROC {
X	int	p_pid;		/* Process ID */
X	char	*p_macro;	/* Completion macro to call. */
X	} PROC;
XHead_p	hd_procs;
Xint	child_sig = FALSE;	/* Set to TRUE when SIGCLD goes off. */
X
Xvoid
Xproc_add(pid, macro)
Xchar	*macro;
X{	char	*strdup();
X	void	child_handler();
X	
X	PROC *pp = (PROC *) chk_alloc(sizeof (PROC));
X	pp->p_pid = pid;
X	pp->p_macro = macro ? strdup(macro) : NULL;
X	if (hd_procs == NULL) {
X		hd_procs = ll_init();
X# if	defined(SIGCLD)
X		signal(SIGCLD, child_handler);
X# endif
X# if	defined(SIGPIPE)
X		signal(SIGPIPE, child_handler);
X# endif
X# if	defined(BSD)
X		siginterrupt(SIGCLD, TRUE);
X# endif
X		}
X	ll_append(hd_procs, pp);
X}
Xvoid
Xchild_handler()
X{
X	child_sig = TRUE;
X}
Xvoid
Xproc_wait(pid)
X{	int	dead_proc;
X	PROC	*pp;
X	List_p	lp;
X	int	status;
X	char	*cp, *cp1;
X	
X	while (1) {
X		while (1) {
X			dead_proc = wait(&status);
X# if	defined(SIGCLD)
X       			signal(SIGCLD, child_handler);
X# endif
X			if (dead_proc < 0 && pid < 0) {
X				child_sig = FALSE;
X				return;
X				}
X			if (dead_proc >= 0)
X				break;
X			}
X		for (lp = ll_first(hd_procs); lp; lp = ll_next(lp)) {
X			pp = (PROC *) ll_elem(lp);
X			if (pp->p_pid == dead_proc) {
X				if (pp->p_macro) {
X					char *tmpstr = chk_alloc(strlen(pp->p_macro) + 16);
X					cp = tmpstr;
X					for (cp1 = pp->p_macro; *cp1 && !isspace(*cp1); )
X						*cp++ = *cp1++;
X					*cp++ = ' ';
X					sprintf(cp, " %d ", status);
X					cp += strlen(cp);
X					strcpy(cp, cp1);
X					str_exec(tmpstr);
X					chk_free(tmpstr);
X					}
X				chk_free(pp);
X				ll_delete(lp);
X				break;
X				}
X			}
X		if (pid < 0 || pid == dead_proc)
X			break;
X		}
X	child_sig = FALSE;
X	if (!background)
X		update();
X}
Xchar *
Xget_shell()
X{	char	*ggetenv();
X	if (shname == NULL) {
X		shname = ggetenv("SHELL");
X		if (shname == NULL)
X			shname = ggetenv("shell");
X		if (shname == NULL)
X			shname = "/bin/csh";     
X		}
X	return shname;
X}
Xdo_shell()
X{
X	char	*command = get_str(1);
X	extern char     *strrchr();
X	register void    (*oisig)();
X	register void   (*oqsig)();
X	int	pid;
X	int	status;
X	int	repaint = argv[2].l_flags != F_INT || argv[2].l_int == 0;
X	char	*macro_name = get_str(3);
X
X	get_shell();
X
X	ttcolor(FG(col_table.c_normal));
X	ttmove(nrow-1, 0);
X	if (repaint) {
X		tteeol();
X		ttclose();
X		tttidy();
X		}
X	oisig = signal(SIGINT,  SIG_IGN);
X	oqsig = signal(SIGQUIT,  SIG_IGN);
X	background = TRUE;
X# if defined(VMS)
X	system(argv[1].l_flags != F_NULL ? command : (char *) NULL);
X# else
X	if ((pid = fork()) == 0) {
X		register char *name = strrchr(shname, '/');
X		if (name)
X			name++;
X		else
X			name = "sh";
X# if	defined(SIGCLD)
X		(void) signal(SIGCLD,  SIG_DFL);
X# endif
X		(void) signal(SIGINT,  SIG_DFL);
X		if (argv[1].l_flags != F_NULL) 
X			execl(shname, name, "-c", command, (char *) NULL);
X		else
X			execl(shname, name, "-i", (char *) NULL);
X		printf("Couldn't exec(%s, %s, %s, %s)\n", shname, name, command ? "-c" : "-i", command ? command : "(char *) NULL");
X		exit(1);
X		}
X	proc_add(pid, *macro_name ? macro_name : (char *) NULL);
X	if (*macro_name == NULL)
X		proc_wait(pid);
X# endif
X	signal(SIGINT,  oisig);
X	signal(SIGQUIT,  oqsig);
X	background = FALSE;
X	if (repaint) {
X		ttopen();
X		sgarbf = TRUE;
X		}
X	accumulator = status;
X	return 0;
X}
SHAR_EOF
chmod 0444 ./spawn.c || echo "restore of ./spawn.c fails"
mkdir . >/dev/null 2>&1
echo "x - extracting ./symbol.c (Text)"
sed 's/^X//' << 'SHAR_EOF' > ./symbol.c &&
X/**************************************************************
X *
X *	CRISP - Custom Reduced Instruction Set Programmers Editor
X *
X *	(C) Paul Fox, 1989
X *	43, Jerome Close	      Tel: +44 6284 4222
X *	    Marlow
X *	     Bucks.
X *		England SL7 1TX
X *
X *
X *    Please See COPYRIGHT notice.
X *
X **************************************************************/
X# include	"list.h"
X
XSCCSID("@(#) symbol.c 1.8, (C) P. Fox");
X
X# define	MIN_STRLEN	26
Xchar		*min_string = "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
XSPTREE		*gsym_tbl;
XSPTREE		*lsym_tbl[MAX_NESTING];
Xint	nest_level = 0;
Xchar	*saccumulator;
Xint	sacc_len = 0;
Xstatic int list_len;
X
Xsym_init()
X{	register int i;
X
X	gsym_tbl = spinit();
X	for (i = 0; i < MAX_NESTING; i++)
X		lsym_tbl[i] = spinit();
X}
Xdo_extern()
X{
X	return 0;
X}
Xmake_local_variable()
X{
X	return move_symbols(curbp->b_syms);
X}
Xdo_global()
X{
X	return move_symbols(gsym_tbl);
X}
Xmove_symbols(sym_tbl)
XSPTREE	*sym_tbl;
X{	register LIST	*lp = argv[1].l_list;
X	register SPBLK	*spb;
X	u_int16	type;
X	SYMBOL *sp;
X
X	for (; *lp != F_HALT; lp += sizeof_atoms[*lp]) {
X		char	*str;
X		if (*lp == F_INT) {
X			type = (u_int16) LGET32(lp);
X			lp += sizeof_atoms[F_INT];
X			}
X		else
X			type = 0;
X		if (*lp != F_STR)
X			continue;
X		str = (char *) LGET32(lp);
X		if ((spb = splookup(str, lsym_tbl[nest_level])) == NULL) {
X			if (splookup(str, sym_tbl) == NULL) {
X				spb = (SPBLK *) chk_alloc( sizeof (SPBLK) +
X						sizeof (SYMBOL) );
X				sp = (SYMBOL *) (spb + 1);
X
X				strcpy(sp->s_name, str);
X				sp->s_type = type;
X				switch (type) {
X				  case F_INT:
X					sp->s_int = 0;
X					break;
X				  case F_STR:
X					sp->s_str = r_init("");
X					break;
X				  case F_LIST:
X					sp->s_list = NULL;
X					break;
X				  default:
X 					panic("default");
X				  }
X				spb->key = sp->s_name;
X				spb->data = (char *) sp;
X				spenq(spb, sym_tbl);
X				}
X			continue;
X			}
X		spdeq(spb, lsym_tbl[nest_level]);
X		spenq(spb, sym_tbl);
X		}
X	return 0;
X}
Xdeclare(flag)
X{	SYMBOL	*sp;
X	SPBLK	*spb;
X	register LIST *lp;
X
X	for (lp = argv[1].l_list; *lp != F_HALT &&
X		(*lp == F_STR || *lp == F_ID); lp += sizeof_atoms[*lp]) {
X		extern BUILTIN builtin[];
X		char	*str;
X		if (*lp == F_ID)
X			str = builtin[LGET16(lp)].name;
X		else
X			str = (char *) LGET32(lp);
X		if (spb = splookup(str, gsym_tbl)) {
X			sp = (SYMBOL *) spb->data;
X			if (sp->s_type) {
X				if (flag == F_POLY)
X					sp->s_flag = SF_POLY;
X				continue;
X				}
X			}
X		else {
X			if (spb = splookup(str, lsym_tbl[nest_level])) {
X				sp = (SYMBOL *) spb->data;
X				if (sp->s_type == F_STR || sp->s_type == F_LIST)
X					r_dec(sp->s_str);
X				}
X			else {
X				spb = (SPBLK *) chk_alloc( sizeof (SPBLK) +
X						sizeof (SYMBOL) );
X				sp = (SYMBOL *) (spb + 1);
X				spb->key = sp->s_name;
X				spb->data = (char *) sp;
X				strcpy(sp->s_name, str);
X				spenq(spb, lsym_tbl[nest_level]);
X				}
X			}
X		if (flag == F_POLY) {
X			sp->s_flag = SF_POLY;
X			sp->s_type = F_INT;
X			}
X		else
X			sp->s_type = flag;
X		if (sp->s_type == F_INT)
X			sp->s_int = 0;
X		else if (sp->s_type == F_STR)
X			sp->s_str = r_init("");
X		else
X			sp->s_list = NULL;
X		}
X
X	if (*lp != F_HALT) {
X		ewprintf("illegal variable name");
X		return -1;
X		}
X	return 0;
X}
Xdelete_buffer_symbols(bp)
Xregister BUFFER *bp;
X{
X	delete_symbols(bp->b_syms);
X	chk_free(bp->b_syms);
X}
Xvoid
Xdelete_local_symbols()
X{	extern int doing_return;
X
X	delete_symbols(lsym_tbl[nest_level]);
X	nest_level--;
X	doing_return = FALSE;
X}
Xdelete_symbols(sym_tbl)
XSPTREE	*sym_tbl;
X{	register SYMBOL *sp;
X
X	while (!spempty(sym_tbl)) {
X		SPBLK *sp1 = sphead(sym_tbl);
X		spdeq(sp1, sym_tbl);
X		sp = (SYMBOL *) sp1->data;
X		if (sp->s_type == F_STR)
X			r_dec(sp->s_str);
X		else if (sp->s_type == F_LIST && sp->s_list)
X			chk_free(sp->s_list);
X		chk_free(sp1);
X		}
X}
XSYMBOL *
Xlookup(name)
Xchar	*name;
X{	extern SYMBOL *sym_lookup();
X	SYMBOL *sp = sym_lookup(name);
X	if (sp)
X		return sp;
X	ewprintf("Undefined symbol: %s", name);
X	return NULL;
X}
XSYMBOL *
Xsym_lookup(name)
Xchar	*name;
X{	register int	i;
X	int	loop_cnt = 0;
X	MACRO	*mptr;
X	extern MACRO *lookup_macro();
X	SPBLK	*spb;
X
X	for (loop_cnt = 0; loop_cnt++ < 2; ) {
X		if (nest_level >= 0 && lsym_tbl[nest_level]) {
X			if (spb = splookup(name, lsym_tbl[nest_level]))
X				return (SYMBOL *) spb->data;
X			}
X
X		if (spb = splookup(name, gsym_tbl))
X			return (SYMBOL *) spb->data;
X
X		for (i = nest_level - 1; i > 0; i--)
X			if (lsym_tbl[i] && (spb = splookup(name, lsym_tbl[i])))
X				return (SYMBOL *) spb->data;
X
X		/*----------------------------------------
X		/*   See if symbol exists in buffer symbol
X		/*   table.
X		/*----------------------------------------*/
X		if ((spb = splookup(name, curbp->b_syms)) != NULL)
X			return (SYMBOL *) spb->data;
X
X		mptr = lookup_macro(name);
X		if (mptr && mptr->m_flags & M_AUTOLOAD)
X			ld_macro((char *) mptr->m_list);
X		}
X
X	return NULL;
X}
Xstrl_acc_assign(str)
Xchar	*str;
X{
X	str_acc_assign(str, strlen(str));
X}
Xstr_acc_assign(str, len)
Xchar	*str;
X{
X	if (sacc_len < len+1) {
X		if (sacc_len)
X			chk_free(saccumulator);
X		sacc_len = (len + 1) | 0x7f;
X		saccumulator = chk_alloc(sacc_len);
X		}
X	if (len)
X		memcpy(saccumulator, str, len);
X	saccumulator[len] = NULL;
X	acc_type = F_STR;
X}
XLIST *
Xcopy_list(list)
XLIST *list;
X{	LIST	*new_list;
X	LIST	*lp;
X	extern LIST *next_atom();
X
X	list_len = length_of_list(list);
X
X	if (list_len == 0)
X		return NULL;
X
X	new_list = (LIST *) chk_alloc(list_len+1);
X	memcpy(new_list, list, list_len);
X	new_list[list_len] = F_HALT;
X	for (lp = new_list; lp; lp = next_atom(lp)) {
X		r_str	*rp;
X		if (*lp != F_RSTR)
X			continue;
X		rp = (r_str *) LGET32(lp);
X		r_inc(rp);
X		}
X	return new_list;
X}
Xvoid
Xlist_assign(symbol, list)
XSYMBOL	*symbol;
XLIST	*list;
X{
X	if (symbol->s_list)
X		chk_free(symbol->s_list);
X	symbol->s_list = copy_list(list);
X	str_acc_assign(list, length_of_list(symbol->s_list));
X	acc_type = F_LIST;
X}
Xlength_of_list(list)
XLIST	*list;
X{	register LIST *lp = list;
X
X	if (lp == NULL)
X		return 0;
X	while (*lp != F_HALT) {
X		if (*lp == F_LIST) {
X			u_int16	i = LGET16(lp);
X			if (i == 0)
X				i = sizeof_atoms[F_LIST];
X			lp += i;
X			continue;
X			}
X		lp += sizeof_atoms[*lp];
X		}
X	return lp - list + 1;
X}
Xvoid
Xstr_assign(symbol, str)
XSYMBOL	*symbol;
Xchar	*str;
X{
X	r_dec(symbol->s_str);
X	symbol->s_str = r_init(str);
X}
Xvoid
Xstr_rassign(symbol, rp)
XSYMBOL	*symbol;
Xr_str	*rp;
X{
X	if (symbol->s_str != rp) {
X		r_dec(symbol->s_str);
X		symbol->s_str = r_inc(rp);
X		}
X}
Xlist_acc(lp, len)
XLIST	*lp;
X{
X	if (lp == NULL) {
X		if (sacc_len)
X			chk_free(saccumulator);
X		sacc_len = 0;
X		saccumulator = NULL;
X		}
X	else
X		str_acc_assign(lp, len);
X	acc_type = F_LIST;
X}
Xvoid
Xint_assign(sym, value)
XSYMBOL *sym;
Xlong	value;
X{
X	trace_ilog("  %s := ", sym->s_name);
X	trace_log("%d\n", value);
X	sym->s_int = value;
X}
SHAR_EOF
chmod 0444 ./symbol.c || echo "restore of ./symbol.c fails"
mkdir . >/dev/null 2>&1
echo "x - extracting ./system.c (Text)"
sed 's/^X//' << 'SHAR_EOF' > ./system.c &&
X/* Routines which are machine independent but are useful for */
X/* making the rest of the code portable, especially to VMS. */
Xsys_read(fd, buf, size)
Xchar *buf;
X{	int	n;
X	int	osize = size;
X	do {
X		n = read(fd, buf, size);
X		size -= n;
X		buf += n;
X		}
X	while (n > 0);
X	return osize - size;
X}
X# if	!defined(VMS)
X/* VMS version in vms.c */
Xsys_write(fd, buf, size)
Xchar *buf;
X{
X	return write(fd, buf, size);
X}
X# endif
SHAR_EOF
chmod 0444 ./system.c || echo "restore of ./system.c fails"
mkdir . >/dev/null 2>&1
echo "x - extracting ./termcap.c (Text)"
sed 's/^X//' << 'SHAR_EOF' > ./termcap.c &&
X/**************************************************************
X *
X *	CRISP - Custom Reduced Instruction Set Programmers Editor
X *
X *	(C) Paul Fox, 1989
X *	43, Jerome Close	      Tel: +44 6284 4222
X *	    Marlow
X *	     Bucks.
X *		England SL7 1TX
X *
X *
X *    Please See COPYRIGHT notice.
X *
X **************************************************************/
X# include	"list.h"
X
XSCCSID("@(#) termcap.c 1.8, (C) 1989, P. Fox");
X# define	TBUFSIZ		2048
X# define	MAX_ENTRIES	256
X
Xchar	*tgetstr();
Xstatic int	compile_termcap();
Xextern char	*ggetenv();
Xstatic	char	*ubuf;		/* User's termcap buffer.		*/
Xstatic struct tc {
X	int	name;
X	char	*entry;
X	}	*tc;
Xstatic	int	ent_count = 0;
X
Xtgetent(bp, name)
Xchar	*bp;
Xchar	*name;
X{	char	buf[64];
X	char	*p;
X	char	*cp;
X
X	ubuf = bp;
X	tc = (struct tc *) chk_alloc(MAX_ENTRIES * sizeof (struct tc));
X	if (tgetent1(bp, name, TRUE) == 0)
X		return 0;
X	p = buf;
X	if ((cp = tgetstr("tc", &p)) == NULL)
X		return 1;
X	tgetent1(ubuf + strlen(ubuf), cp, FALSE);
X
X	return 1;
X}
Xtgetent1(bp, name, first_time)
Xchar	*bp;
Xchar	*name;
X{	int	fd;
X	char	buf[TBUFSIZ];
X	register char *cp;
X	register char	*bp1 = &buf[TBUFSIZ];
X	int	cnt = -1;
X	char	*filename = ggetenv("TERMCAP");
X	char	*term = ggetenv("TERM");
X	extern char *termcap_dir;
X
X	if (filename == NULL || !first_time)
X		filename = termcap_dir;
X	else if (filename[0] != '/' && filename[0] != '[') {
X		if (strcmp(term, name) == 0) {
X			strncpy(bp, filename, TBUFSIZ);
X			compile_termcap();
X			return 1;
X			}
X		filename = termcap_dir;
X		}
X	if ((fd = open(filename, O_RDONLY)) < 0)
X		return -1;
X	while (1) {
X		cp = bp;
X		while (1) {
X			if (--cnt <= 0) {
X				if ((cnt = read(fd, buf, TBUFSIZ)) <= 0) {
X					close(fd);
X					fd = -1;
X					break;
X					}
X				bp1 = buf;
X				}
X			if ((*cp++ = *bp1++) == '\n') {
X				cp--;
X				if (cp == bp)
X					break;
X				if (cp > bp && cp[-1] != '\\')
X					break;
X				cp--;
X				continue;
X				}
X			}
X		*cp = NULL;
X		if (tnamchk(bp, name)) {
X			if (fd > 0)
X				close(fd);
X			return 1;
X			}
X		if (fd < 0)
X			return 0;
X		}
X
X	
X}
Xtnamchk(bp, name)
Xregister char	*bp;
Xchar	*name;
X{	register char	*cp;
X
X	while (1) {
X		for (cp = name; *bp == *cp; )
X			bp++, cp++;
X		if (*cp == NULL && (*bp == '|' || *bp == ':'))
X			break;
X		while (*bp && *bp != '|' && *bp != ':')
X			bp++;
X		if (*bp != '|')
X			return 0;
X		bp++;
X		}
X	compile_termcap();
X	return 1;
X}
Xvoid
Xclose_termcap()
X{
X	chk_free((char *) tc);
X}
Xstatic 
Xcompile_termcap()
X{	register char *cp;
X
X	for (cp = ubuf; *cp && ent_count < MAX_ENTRIES; ) {
X		while (*cp != ':' && *cp)
X			cp++;
X		if (*cp) {
X			tc[ent_count].entry = ++cp;
X			tc[ent_count++].name = (*cp << 8) | cp[1];
X			}
X		}
X
X	return 1;
X}
Xtgetnum(id)
Xregister char	*id;
X{	register char	*bp = ubuf;
X
X	while (*bp) {
X		while (*bp != ':' && *bp)
X			bp++;
X		if (*bp && bp[1] == id[0] && bp[2] == id[1] && bp[3] == '#')
X			return atoi(bp+4);
X		bp++;
X		}
X	return 0;
X}
Xtgetflag(id)
Xregister char	*id;
X{	register char	*bp = ubuf;
X
X	while (*bp) {
X		while (*bp != ':' && *bp)
X			bp++;
X		if (*bp && bp[1] == id[0] && bp[2] == id[1])
X			return 1;
X		bp++;
X		}
X	return 0;
X}
Xchar *
Xtgetstr(id, area)
Xchar	*id;
Xchar	**area;
X{	register int	ltc = (*id << 8) | (id[1] & 0xff);
X	register int	i = ent_count;
X	register char	*dp = *area;
X	char	*init_area = *area;
X	struct tc *tcp = tc;
X	int	n;
X	char	*tcopy_string();
X	char	*cp;
X
X	for (; i-- > 0; tcp++) {
X		if (tcp->name != ltc)
X			continue;
X# if 0
X		if (tcp->entry[2] == '&') {
X			register char *bp = tcp->entry+3;
X			n = XDIGIT(*bp);
X			bp++;
X			n = n * 16 + XDIGIT(*bp);
X			*dp++ = (char) n;
X			*dp++ = NULL;
X			*area = dp;
X			return init_area;
X			}
X# endif
X		if (tcp->entry[2] == '=') {
X			/*------------------------------
X			 *   Remove delays at beginning of string.
X			 *------------------------------*/
X			for (cp = tcp->entry + 3; isdigit(*cp); )
X				cp++;
X			*area = tcopy_string(dp, cp, ':');
X			return init_area;
X			}
X		}
X	return NULL;
X}
Xtputs(cp, affcnt, outc)
Xchar	*cp;
Xint	affcnt;
Xint	(*outc)();
X{
X	while (*cp)
X		(*outc)(*cp++);
X	return 0;
X}
Xchar *
Xtgoto(str, col, row)
Xregister char	*str;
X{	static char buf[32];
X	register char	*cp = buf;
X	int	arg[2];
X	register int	*argp = arg;
X	int	t;
X
X	arg[0] = row;
X	arg[1] = col;
X
X	while (*str) {
X		if (*str != '%') {
X			*cp++ = *str++;
X			continue;
X			}
X		str++;
X		switch (*str++) {
X			case '+':
X				*argp += *str++;
X				/* Fall into ... */
X			case '.':	/* Code change thanks to john@hcrvax.uucp */
X				*cp++ = (char) *argp++;
X				break;
X			case '2':	
X				sprintf(cp, "%02d", *argp++);
X				cp += 2;
X				break;
X			case '3':	
X				sprintf(cp, "%03d", *argp++);
X				cp += 3;
X				break;
X			case 'B':
X				*argp = (16 * (*argp / 10)) + (*argp % 10);
X				break;
X			case 'D':
X				*argp = (*argp - 2 * (*argp % 16));
X				break;
X			case 'd':	
X				sprintf(cp, "%d", *argp++);
X				cp += strlen(cp);
X				break;
X			case '>':	
X				if (*argp > *str)
X					*argp += str[1];
X				str += 2;
X				break;
X			case 'i':	arg[0]++, arg[1]++;
X					break;
X			case 'n':
X				arg[0] ^= 0140;
X				arg[1] ^= 0140;
X				break;
X			case 'r':	t = arg[0];
X					arg[0] = arg[1];
X					arg[1] = t;
X					break;
X			case '%':	*cp++ = '%';
X					break;
X			default:
X					*cp++ = *str;
X			}
X		}
X	*cp = NULL;
X	return buf;
X
X}
SHAR_EOF
chmod 0444 ./termcap.c || echo "restore of ./termcap.c fails"
mkdir . >/dev/null 2>&1
echo "x - extracting ./tty.c (Text)"
sed 's/^X//' << 'SHAR_EOF' > ./tty.c &&
X/**************************************************************
X *
X *	CRISP - Custom Reduced Instruction Set Programmers Editor
X *
X *	(C) Paul Fox, 1989
X *	43, Jerome Close	      Tel: +44 6284 4222
X *	    Marlow
X *	     Bucks.
X *		England SL7 1TX
X *
X *
X *    Please See COPYRIGHT notice.
X *
X **************************************************************/
X
X#include        "list.h"
X# include	<sys/signal.h>
X
XSCCSID("@(#) tty.c 1.14, (C) 1989, P. Fox");
Xvoid	ttwindow();
Xvoid	ttresize();
Xvoid	ttputpad();
Xvoid	putpad();
Xvoid	flush_col_cache();
Xvoid	set_attr();
X
X
X#define BEL     0x07                    /* BEL character.               */
X#define LF      0x0A                    /* Line feed.                   */
X
Xextern  int     tttop;
Xextern  int     ttbot;
X
Xint     tceeol;                 /* Costs are set later */
Xint     tcinsl;
Xint     tcdell;
X
Xstatic  int     insdel;         /* Do we have both insert & delete line? */
X
Xchar    *tgetstr();
Xchar    *tgoto();
X
X#define TCAPSLEN 2048
X
Xchar tcapbuf[TCAPSLEN];
Xtypedef struct colors {
X	char	*fg[16];
SHAR_EOF
echo "End of part 9"
echo "File ./tty.c is continued in part 10"
echo "10" > s2_seq_.tmp
exit 0
-- 
=====================			Reuters Ltd PLC, 
Tel: +44 628 891313 x. 212		 Westthorpe House,
UUCP:     fox%marlow.uucp@idec.stc.co.uk  Little Marlow,
					   Bucks, England SL7 3RQ