vgrind - zygaena/hammerhead

root / base / usr / src / cmd / vgrind
vgrind Plain Text 2822 lines 68.1 KB
#
# CDDL HEADER START
#
# The contents of this file are subject to the terms of the
# Common Development and Distribution License (the "License").
# You may not use this file except in compliance with the License.
#
# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
# or http://www.opensolaris.org/os/licensing.
# See the License for the specific language governing permissions
# and limitations under the License.
#
# When distributing Covered Code, include this CDDL HEADER in each
# file and include the License file at usr/src/OPENSOLARIS.LICENSE.
# If applicable, add the following below this CDDL HEADER, with the
# fields enclosed by brackets "[]" replaced with your own identifying
# information: Portions Copyright [yyyy] [name of copyright owner]
#
# CDDL HEADER END
#
#
# Copyright 2008 Sun Microsystems, Inc.  All rights reserved.
# Use is subject to license terms.
#
# Copyright (c) 2018, Joyent, Inc.

#
# These are the objects associated with the overall vgrind command.
#
VFONTEDPR=	vfontedpr
RETEST=		retest
MACROS=		tmac.vgrind
LANGDEFS=	vgrindefs
KSHPROG=	vgrind

#
# These macros captures objects that ultimately will be installed in
# (respectively) /usr/bin, /usr/lib, and /usr/share/lib.
#
# Note also that retest is used strictly as a test program and is never
# installed.  We omit it here, so that the NSE doesn't spend cycles
# on it when acquiring and reconciling.
#
PROG=		$(KSHPROG)
LIBPROG=	$(VFONTEDPR) $(LANGDEFS)
TMACPROG=	$(MACROS)

VFONTEDPROBJS=	vfontedpr.o vgrindefs.o regexp.o
RETESTOBJS=	retest.o regexp.o

RETESTSRC=	$(RETESTOBJS:%.o=%.c)

OBJS= $(VFONTEDPROBJS) $(RETESTOBJS)
SRCS= $(OBJS:%.o=%.c)

#
# We can get away simply with omitting TMACPROGS to protect
# tmac.vgrind, since it's the only entry in that macro.
#
CLOBBERFILES=	$(LIBPROG) $(RETEST)

include ../Makefile.cmd

CERRWARN += -Wno-implicit-function-declaration
CERRWARN += -Wno-parentheses
CERRWARN += -Wno-unused-variable
CERRWARN += -Wno-unused-function

# not linted
SMATCH=off

#
# Message catalog
#
POFILES= $(OBJS:%.o=%.po)
POFILE= vgrind.po
POFILE_KSH= vgrind_ksh.po

#
# Abbreviation for future use.
#
ROOTTMAC= $(ROOT)/usr/share/lib/tmac

#
# Override macro definitions from Makefile.cmd.  Necessary because
# we're building targets for multiple destinations.
#
ROOTLIBPROG= $(LIBPROG:%=$(ROOT)/usr/lib/%)
ROOTTMACPROG= $(TMACPROG:%=$(ROOTTMAC)/%)

#
# Conditional assignments pertinent to installation.
#
$(ROOTLIB)/$(LANGDEFS)	: FILEMODE= $(LIBFILEMODE)
$(ROOTTMACPROG)		: FILEMODE= 0644

#
# The standard set of rules doesn't know about installing into
# subdirectories of /usr/share/lib, so we have to roll our own.
#
$(ROOTTMAC)/%: %
	$(INS.file)

.KEEP_STATE:

#
# retest appears here only in source form; see comment above for PROG.
#
all:	$(PROG) $(LIBPROG) $(TMACPROG) $(RETESTSRC)

#
# message catalog
#
$(POFILE): $(POFILES) $(POFILE_KSH)
	rm -f $@
	cat $(POFILES) $(POFILE_KSH) > $@

$(VFONTEDPR): $(VFONTEDPROBJS)
	$(LINK.c) -o $@ $(VFONTEDPROBJS) $(LDLIBS)
	$(POST_PROCESS)

$(LANGDEFS):	$(LANGDEFS).src
	$(CP) $? $@

$(RETEST): $(RETESTOBJS)
	$(LINK.c) -o $@ $(RETESTOBJS) $(LDLIBS)
	$(POST_PROCESS)

#
# We add all as a dependent to make sure that the install pattern
# matching rules see everything they should.  (This is a safety net.)
#
# XXX:	ROOTTMAC shouldn't appear as a dependent; it's here as a
#	bandaid(TM) until /usr/lib/tmac becomes a symlink to
#	/usr/share/lib/tmac.
#
install: all $(ROOTTMAC) $(ROOTPROG) $(ROOTLIBPROG) $(ROOTTMACPROG)

# XXX: see above.
$(ROOTTMAC):
	$(INS.dir)

clean:
	$(RM) $(OBJS)

#
# Don't worry about linting retest.
#
lint:	SRCS = $(VFONTEDPROBJS:%.o=%.c)
lint: lint_SRCS

include ../Makefile.targ
Copyright (c) 1980 Regents of the University of California.  
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:

    1. Redistributions of source code must retain the above copyright
       notice, this list of conditions and the following disclaimer.
    2. Redistributions in binary form must reproduce the above
       copyright notice, this list of conditions and the following
       disclaimer in the documentation and/or other materials provided
       with the distribution.
    3. All advertising materials mentioning features or use of this
       software must display the following acknowledgement:
           This product includes software developed by the University
           of California, Berkeley and its contributors.
    4. Neither the name of the University nor the names of its
       contributors may be used to endorse or promote products derived
       from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
PORTIONS OF VGRIND COMMAND FUNCTIONALITY
/*
 * Copyright (c) 1980 Regents of the University of California.
 * All rights reserved.  The Berkeley software License Agreement
 * specifies the terms and conditions for redistribution.
 */

#include <ctype.h>

typedef int	boolean;
#define TRUE	1
#define FALSE	0
#define NIL	0

extern boolean	l_onecase;	/* true if upper and lower equivalent */
extern char	*l_idchars;	/* set of characters legal in identifiers
				   in addition to letters and digits */

extern char	*strchr();
static void	expconv(void);

#define isidchr(c)	\
		(isalnum(c) || ((c) != NIL && strchr(l_idchars, (c)) != NIL))
#define makelower(c)	(isupper((c)) ? tolower((c)) : (c))

/*  STRNCMP -	like strncmp except that we convert the
 *		first string to lower case before comparing
 *		if l_onecase is set.
 */

int
STRNCMP(char *s1, char *s2, int len)
{
	if (l_onecase) {
	    do
		if (*s2 - makelower(*s1))
			return (*s2 - makelower(*s1));
		else {
			s2++;
			s1++;
		}
	    while (--len);
	} else {
	    do
		if (*s2 - *s1)
			return (*s2 - *s1);
		else {
			s2++;
			s1++;
		}
	    while (--len);
	}
	return(0);
}

/*	The following routine converts an irregular expression to
 *	internal format.
 *
 *	Either meta symbols (\a \d or \p) or character strings or
 *	operations ( alternation or parenthesizing ) can be
 *	specified.  Each starts with a descriptor byte.  The descriptor
 *	byte has STR set for strings, META set for meta symbols
 *	and OPER set for operations.
 *	The descriptor byte can also have the OPT bit set if the object
 *	defined is optional.  Also ALT can be set to indicate an alternation.
 *
 *	For metasymbols the byte following the descriptor byte identities
 *	the meta symbol (containing an ascii 'a', 'd', 'p', '|', or '(').  For
 *	strings the byte after the descriptor is a character count for
 *	the string:
 *
 *		meta symbols := descriptor
 *				symbol
 *
 *		strings :=	descriptor
 *				character count
 *				the string
 *
 *		operations :=	descriptor
 *				symbol
 *				character count
 */

/*
 *  handy macros for accessing parts of match blocks
 */
#define MSYM(A) (*(A+1))	/* symbol in a meta symbol block */
#define MNEXT(A) (A+2)		/* character following a metasymbol block */

#define OSYM(A) (*(A+1))	/* symbol in an operation block */
#define OCNT(A) (*(A+2))	/* character count */
#define ONEXT(A) (A+3)		/* next character after the operation */
#define OPTR(A) (A+*(A+2))	/* place pointed to by the operator */

#define SCNT(A) (*(A+1))	/* byte count of a string */
#define SSTR(A) (A+2)		/* address of the string */
#define SNEXT(A) (A+2+*(A+1))	/* character following the string */

/*
 * bit flags in the descriptor
 */
#define OPT 1
#define STR 2
#define META 4
#define ALT 8
#define OPER 16

char *ure;		/* pointer current position in unconverted exp */
char *ccre;		/* pointer to current position in converted exp*/
char *malloc();

char *
convexp(char *re)
	/* re - unconverted irregular expression */
{
    char *cre;		/* pointer to converted regular expression */

    /* allocate room for the converted expression */
    if (re == NIL)
	return (NIL);
    if (*re == '\0')
	return (NIL);
    cre = malloc (4 * strlen(re) + 3);
    ccre = cre;
    ure = re;

    /* start the conversion with a \a */
    *cre = META | OPT;
    MSYM(cre) = 'a';
    ccre = MNEXT(cre);

    /* start the conversion (its recursive) */
    expconv ();
    *ccre = 0;
    return (cre);
}

static void
expconv(void)
{
    char *cs;		/* pointer to current symbol in converted exp */
    char c;		/* character being processed */
    char *acs;		/* pinter to last alternate */
    int temp;

    /* let the conversion begin */
    acs = NIL;
    cs = NIL;
    while (*ure != NIL) {
	switch (c = *ure++) {

	case '\\':
	    switch (c = *ure++) {

	    /* escaped characters are just characters */
	    default:
		if (cs == NIL || (*cs & STR) == 0) {
		    cs = ccre;
		    *cs = STR;
		    SCNT(cs) = 1;
		    ccre += 2;
		} else {
		    SCNT(cs)++;
		}
		*ccre++ = c;
		break;

	    /* normal(?) metacharacters */
	    case 'a':
	    case 'd':
	    case 'e':
	    case 'p':
		if (acs != NIL && acs != cs) {
		    do {
			temp = OCNT(acs);
			OCNT(acs) = ccre - acs;
			acs -= temp;
		    } while (temp != 0);
		    acs = NIL;
		}
		cs = ccre;
		*cs = META;
		MSYM(cs) = c;
		ccre = MNEXT(cs);
		break;
	    }
	    break;

	/* just put the symbol in */
	case '^':
	case '$':
	    if (acs != NIL && acs != cs) {
		do {
		    temp = OCNT(acs);
		    OCNT(acs) = ccre - acs;
		    acs -= temp;
		} while (temp != 0);
		acs = NIL;
	    }
	    cs = ccre;
	    *cs = META;
	    MSYM(cs) = c;
	    ccre = MNEXT(cs);
	    break;

	/* mark the last match sequence as optional */
	case '?':
	    if (cs)
		*cs = *cs | OPT;
	    break;

	/* recurse and define a subexpression */
	case '(':
	    if (acs != NIL && acs != cs) {
		do {
		    temp = OCNT(acs);
		    OCNT(acs) = ccre - acs;
		    acs -= temp;
		} while (temp != 0);
		acs = NIL;
	    }
	    cs = ccre;
	    *cs = OPER;
	    OSYM(cs) = '(';
	    ccre = ONEXT(cs);
	    expconv ();
	    OCNT(cs) = ccre - cs;		/* offset to next symbol */
	    break;

	/* return from a recursion */
	case ')':
	    if (acs != NIL) {
		do {
		    temp = OCNT(acs);
		    OCNT(acs) = ccre - acs;
		    acs -= temp;
		} while (temp != 0);
		acs = NIL;
	    }
	    cs = ccre;
	    *cs = META;
	    MSYM(cs) = c;
	    ccre = MNEXT(cs);
	    return;

	/* mark the last match sequence as having an alternate */
	/* the third byte will contain an offset to jump over the */
	/* alternate match in case the first did not fail */
	case '|':
	    if (acs != NIL && acs != cs)
		OCNT(ccre) = ccre - acs;	/* make a back pointer */
	    else
		OCNT(ccre) = 0;
	    *cs |= ALT;
	    cs = ccre;
	    *cs = OPER;
	    OSYM(cs) = '|';
	    ccre = ONEXT(cs);
	    acs = cs;	/* remember that the pointer is to be filles */
	    break;

	/* if its not a metasymbol just build a scharacter string */
	default:
	    if (cs == NIL || (*cs & STR) == 0) {
		cs = ccre;
		*cs = STR;
		SCNT(cs) = 1;
		ccre = SSTR(cs);
	    } else
		SCNT(cs)++;
	    *ccre++ = c;
	    break;
	}
    }
    if (acs != NIL) {
	do {
	    temp = OCNT(acs);
	    OCNT(acs) = ccre - acs;
	    acs -= temp;
	} while (temp != 0);
	acs = NIL;
    }
}
/* end of convertre */


/*
 *	The following routine recognises an irregular expresion
 *	with the following special characters:
 *
 *		\?	-	means last match was optional
 *		\a	-	matches any number of characters
 *		\d	-	matches any number of spaces and tabs
 *		\p	-	matches any number of alphanumeric
 *				characters. The
 *				characters matched will be copied into
 *				the area pointed to by 'name'.
 *		\|	-	alternation
 *		\( \)	-	grouping used mostly for alternation and
 *				optionality
 *
 *	The irregular expression must be translated to internal form
 *	prior to calling this routine
 *
 *	The value returned is the pointer to the first non \a
 *	character matched.
 */

extern boolean _escaped;	/* true if we are currently _escaped */
extern char *Start;		/* start of string */

char *
expmatch(char *s, char *re, char *mstring)
	/* s - string to check for a match in */
	/* re - a converted irregular expression */
	/* mstring - where to put whatever matches a \p */
{
    char *cs;		/* the current symbol */
    char *ptr, *s1;	/* temporary pointer */
    boolean matched;	/* a temporary boolean */

    /* initial conditions */
    if (re == NIL)
	return (NIL);
    cs = re;
    matched = FALSE;

    /* loop till expression string is exhausted (or at least pretty tired) */
    while (*cs) {
	switch (*cs & (OPER | STR | META)) {

	/* try to match a string */
	case STR:
	    matched = !STRNCMP (s, SSTR(cs), SCNT(cs));
	    if (matched) {

		/* hoorah it matches */
		s += SCNT(cs);
		cs = SNEXT(cs);
	    } else if (*cs & ALT) {

		/* alternation, skip to next expression */
		cs = SNEXT(cs);
	    } else if (*cs & OPT) {

		/* the match is optional */
		cs = SNEXT(cs);
		matched = 1;		/* indicate a successful match */
	    } else {

		/* no match, error return */
		return (NIL);
	    }
	    break;

	/* an operator, do something fancy */
	case OPER:
	    switch (OSYM(cs)) {

	    /* this is an alternation */
	    case '|':
		if (matched)

		    /* last thing in the alternation was a match, skip ahead */
		    cs = OPTR(cs);
		else

		    /* no match, keep trying */
		    cs = ONEXT(cs);
		break;

	    /* this is a grouping, recurse */
	    case '(':
		ptr = expmatch (s, ONEXT(cs), mstring);
		if (ptr != NIL) {

		    /* the subexpression matched */
		    matched = 1;
		    s = ptr;
		} else if (*cs & ALT) {

		    /* alternation, skip to next expression */
		    matched = 0;
		} else if (*cs & OPT) {

		    /* the match is optional */
		    matched = 1;	/* indicate a successful match */
		} else {

		    /* no match, error return */
		    return (NIL);
		}
		cs = OPTR(cs);
		break;
	    }
	    break;

	/* try to match a metasymbol */
	case META:
	    switch (MSYM(cs)) {

	    /* try to match anything and remember what was matched */
	    case 'p':
		/*
		 *  This is really the same as trying the match the
		 *  remaining parts of the expression to any subset
		 *  of the string.
		 */
		s1 = s;
		do {
		    ptr = expmatch (s1, MNEXT(cs), mstring);
		    if (ptr != NIL && s1 != s) {

			/* we have a match, remember the match */
			strncpy (mstring, s, s1 - s);
			mstring[s1 - s] = '\0';
			return (ptr);
		    } else if (ptr != NIL && (*cs & OPT)) {

			/* it was aoptional so no match is ok */
			return (ptr);
		    } else if (ptr != NIL) {

			/* not optional and we still matched */
			return (NIL);
		    }
		    if (!isidchr(*s1))
			return (NIL);
		    if (*s1 == '\\')
			_escaped = _escaped ? FALSE : TRUE;
		    else
			_escaped = FALSE;
		} while (*s1++);
		return (NIL);

	    /* try to match anything */
	    case 'a':
		/*
		 *  This is really the same as trying the match the
		 *  remaining parts of the expression to any subset
		 *  of the string.
		 */
		s1 = s;
		do {
		    ptr = expmatch (s1, MNEXT(cs), mstring);
		    if (ptr != NIL && s1 != s) {

			/* we have a match */
			return (ptr);
		    } else if (ptr != NIL && (*cs & OPT)) {

			/* it was aoptional so no match is ok */
			return (ptr);
		    } else if (ptr != NIL) {

			/* not optional and we still matched */
			return (NIL);
		    }
		    if (*s1 == '\\')
			_escaped = _escaped ? FALSE : TRUE;
		    else
			_escaped = FALSE;
		} while (*s1++);
		return (NIL);

	    /* fail if we are currently _escaped */
	    case 'e':
		if (_escaped)
		    return(NIL);
		cs = MNEXT(cs);
		break;

	    /* match any number of tabs and spaces */
	    case 'd':
		ptr = s;
		while (*s == ' ' || *s == '\t')
		    s++;
		if (s != ptr || s == Start) {

		    /* match, be happy */
		    matched = 1;
		    cs = MNEXT(cs);
		} else if (*s == '\n' || *s == '\0') {

		    /* match, be happy */
		    matched = 1;
		    cs = MNEXT(cs);
		} else if (*cs & ALT) {

		    /* try the next part */
		    matched = 0;
		    cs = MNEXT(cs);
		} else if (*cs & OPT) {

		    /* doesn't matter */
		    matched = 1;
		    cs = MNEXT(cs);
		} else

		    /* no match, error return */
		    return (NIL);
		break;

	    /* check for end of line */
	    case '$':
		if (*s == '\0' || *s == '\n') {

		    /* match, be happy */
		    s++;
		    matched = 1;
		    cs = MNEXT(cs);
		} else if (*cs & ALT) {

		    /* try the next part */
		    matched = 0;
		    cs = MNEXT(cs);
		} else if (*cs & OPT) {

		    /* doesn't matter */
		    matched = 1;
		    cs = MNEXT(cs);
		} else

		    /* no match, error return */
		    return (NIL);
		break;

	    /* check for start of line */
	    case '^':
		if (s == Start) {

		    /* match, be happy */
		    matched = 1;
		    cs = MNEXT(cs);
		} else if (*cs & ALT) {

		    /* try the next part */
		    matched = 0;
		    cs = MNEXT(cs);
		} else if (*cs & OPT) {

		    /* doesn't matter */
		    matched = 1;
		    cs = MNEXT(cs);
		} else

		    /* no match, error return */
		    return (NIL);
		break;

	    /* end of a subexpression, return success */
	    case ')':
		return (s);
	    }
	    break;
	}
    }
    return (s);
}
/*
 * Copyright (c) 1980 Regents of the University of California.
 * All rights reserved.  The Berkeley software License Agreement
 * specifies the terms and conditions for redistribution.
 */

#include <ctype.h>

int l_onecase = 0;

char	*l_idchars = "_";	/* characters legal in identifiers in addition
				   to alphanumerics */

char * Start;
char * _escaped;
char * convexp();
char * expmatch();
main()
{
    char reg[132];
    char *ireg;
    char str[132];
    char *match;
    char matstr[132];
    char c;

    while (1) {
	printf ("\nexpr: ");
	scanf ("%s", reg);
	ireg = convexp(reg);
	match = ireg;
	while(*match) {
	    switch (*match) {

	    case '\\':
	    case '(':
	    case ')':
	    case '|':
		printf ("%c", *match);
		break;

	    default:
		if (isalnum(*match))
		    printf("%c", *match);
		else
		    printf ("<%03o>", *match);
		break;
	    }
	    match++;
	}
	printf("\n");
	getchar();
	while(1) {
	    printf ("string: ");
	    match = str;
	    while ((c = getchar()) != '\n')
		*match++ = c;
	    *match = 0;
	    if (str[0] == '#')
		break;
	    matstr[0] = 0;
	    Start = str;
	    _escaped = 0;
	    match = expmatch (str, ireg, matstr);
	    if (match == 0)
		printf ("FAILED\n");
	    else
		printf ("match\nmatstr = %s\n", matstr);
	}

    }
}
.\" ident	"%Z%%M%	%I%	%E% SMI"
.\"
.\" CDDL HEADER START
.\"
.\" The contents of this file are subject to the terms of the
.\" Common Development and Distribution License, Version 1.0 only
.\" (the "License").  You may not use this file except in compliance
.\" with the License.
.\"
.\" You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
.\" or http://www.opensolaris.org/os/licensing.
.\" See the License for the specific language governing permissions
.\" and limitations under the License.
.\"
.\" When distributing Covered Code, include this CDDL HEADER in each
.\" file and include the License file at usr/src/OPENSOLARIS.LICENSE.
.\" If applicable, add the following below this CDDL HEADER, with the
.\" fields enclosed by brackets "[]" replaced with your own identifying
.\" information: Portions Copyright [yyyy] [name of copyright owner]
.\"
.\" CDDL HEADER END
.\"
.ig
	This version of tmac.vgrind is intended to interface more
	gracefully to other macro packages than the previous version.
	Rather than defining things irrevocably, with no way to alter
	the definitions, this version encapsulates definitions and
	changes in the operating environment into macros whose
	definitions can be overriden as needed.

	Guide to strings that vfontedpr generates code to define:
	=F	current file name
	=H	operand of vfontedpr's -h flag
	=M	time and date info for current file

	Guide to number registers that vfontedpr generates code to define:
	vP	point size (in points) to use for main text.  Pre-defined
		only if the -s option was supplied to vfontedpr.
		N.B.: does not affect headers or margin entries.

	Internal strings
	=f	ellipsis string for current function
 	=G	local copy of =F used to keep header and footer consistent
		with each other
	+K	string used to start keyword; value depends on whether
		or not a comment is active
	-K	string used to end keyword; value depends on whether
		or not a comment is active

	Internal number registers
	v	nonzero prevents cut marks (in theory, at least)
	vC	nonzero when in comment

	To do: convert hard-wired point sizes, etc. to parameterized values.

	XXX: vfontedpr has font 2 wired into it for comments; change to use
	tC and fC as below.

  ***	This version is also augmented with support for two column output.

	N.B.: I haven't thought at all about how to make this work in
	filter mode.  Things will have to be redefined, as I rely on adding
	hooks to the header and footer macros to flip from one column to
	the next.

	Additional register that vfontedpr defines:
	=2	if nonzero, generate two column output.

	Additional internal number registers.
	v2	corrent column number: 0 == left, 1 == right
	vH	saved vertical position of top of left column; calculated
		in vH when switching to left column and used in vF when
		switching to the right column.
	vO	page offset in effect for left column (the original offset).
        vR	page offset in effect for right column.
	vL	saved line length in effect at beginning of new page.
	vK	line length in effect for each column.
	vX	scratch register.
..
'\"----------------
.ig
    sI:	Initialize configurable strings
	XXX: need better name for this macro.
	This macro is called from the vI macro at initialization time.
	It must define the following:
	_	string	representation for underscore
	-	string	representation for minus
	/	string	representation for slash, shifted horizontally so
			that C-style comments will line up
	/*	string	representation for /*, shifted horizontally so
			that C-style comments will line up.

	tC	string	comment font in .ft form (e.g., `BI')
	fC	string	comment font in \f  form (e.g., `(BI')
	tK	string	keyword font in .ft form
	fK	string	keyword font in \f  form
	tP	string	program font in .ft form
	fP	string	program font in \f  form

	By redefining this macro, one can alter the appearance of vgrind's
	output.
..
.de sI
'ds _ \d\(mi\u
'ds - \(mi
'ds / \\h'\\w' 'u-\\w'/'u'/
'ds /* \\h'\\w' 'u-\\w'/'u'/*
'\"
'ds tC 2
'ds fC 2
'ds tK 3
'ds fK 3
'ds tP 1
'ds fP 1
'\"
.nr v 1
..
'\"----------------
.ig
    no:	no-op
	This macro does nothing.  It's defined as a place-holder to
'\"	immediately precede \} constructs, to make editing easier.
..
.de no
..
'\"----------------
.ig
    vI:	Initial definitions.
	This macro is called once only, before any .vS -- .vE program
	inclusions are processed (or before all input files, if they consist
	solely of program text).

   XXX:	We assume that 2-column mode imples landscape output.  Ideally, there
	should be a separate -T<device> entry for the landscape version of the
	output device, but that hasn't happened.  Instead, all there is is a
	"-L" flag to troff that does nothing more than rotate the resulting
	PostScript 90 degrees.  In particular, page lengths and widths are
	unaffected.  Thus, we hack altered values into place here.  This is
	pretty disgusting...
..
.de vI
'\"	Deal with page length and width -- see above.
'if \\n(=2 \{\
'       ll 9.5i
'       lt 9.5i
'       ev 2
'       ll 9.5i
'       lt 9.5i
'       ev
'       pl 8i
'no\}
'sI
'\"	If point size values haven't already been established, set them
'\"	to suitable default values.  The defaults are smaller for two column
'\"	mode.
'if \\n(vP=0 \{\
'       ie \\n(=2 \{\
'               nr vP 8
'       no\}
'       el \{\
'               nr vP 9
'       no\}
'no\}
'\"	Force comment state indicators into the correct
'\"	initial state.  Convert the comment start macro
'\"	to its final form.
'+C
'-C
'am +C
'ne 3
\\..
'ft \\*(tP
'lg 0
..
'\"----------------
.ig
    vS: Start program text
	This macro must be called at the start of a chunk of interpolated
	program text.  The version given here is a default version suitable
	for standalone use -- that is, not in conjunction with some other
	macro package.  It should be redefined as necessary to coexist
	gracefully with the macro package of your choice.  Of course, the
	redefined version should do the same things this version does.

	It may be necessary to move the emboldening commands to the vI
	macro, or remove them altogether.  If they remain here, they will
	probably have to be supplemented with copies of themselves that
	are protected with the transparent throughput indicator.
..
.de vS
'ss 23
'\" Set text point size and vertical spacing.
'\"     XXX: All point size stuff should be parameterized, not just the
'\"	primary text sizes.
'ps \\n(vPp
'nr vX \\n(vP+1
'vs \\n(vXp
'\" If in two column mode, reduce page offset to first column a bit
'\" and bump line length correspondingly.
'\"	XXX: Aargh!  More hard-wiring!
.if \\n(=2 \{\
'       po -0.4i
'       ll +0.4i
'       lt +0.4i
'       ev 2
'       ll +0.4i
'       lt +0.4i
'       ev
'no\}
'\"'bd B 3
'\"'bd S B 3
'nf		\" When not run standalone, the host macro package
'		\" may well do this for us.
'nr vC 0	\" We're not in a comment.
'nr v2 0                                \" start in left column
'nr vO \\n(.ou                          \" save page offset
'nr vL \\n(.lu                          \" save line length
'nr vR \\n(.ou+(\\n(.lu/2u)+(0.25i)u    \" get right column offset
'ie \\n(=2 'nr vK (\\n(.lu/2u)-(0.25i)u \" get column width
'el        'nr vK \\n(.lu
..
'\"----------------
.ig
    vE: End program text
	This macro closes the chunk of program text started by vS.  The
	same comments apply to it that do for vS.
..
.de vE
'ss 12
'ps
'vs
'\"'bd B
'\"'bd S
..
'\"----------------
.ig
    vH:	Header macro
	Only invoked when not in filter mode.

	N.B.: This macro hard-wires the inter-column gap to 0.25i.
..
'de vH
'v<     \" Put out the header itself.
'if \\n(=2 \{\
'\"     In two column mode: we've trapped because we've moved to a new
'\"     page.  Save position information for later use.  Squash down line
'\"     length.
'       nr v2 0 1       \" reset column counter
'       mk vH           \" save vertical position for later restoration
'       ll \\n(vKu
'.no\}
'v.     \" Put out the column header
..
'\"----------------
.ig
    v<:	Output page header
	Called from vH.
..
.de v<
'ev 2
'if t 'if !\nv 'tl '\-\-''\-\-'
'\" Emit page header (file name at right and left page margins).
'ft 1
'sp .35i
'tl '\s14\f3\\*(=F\fP\s0'\\*(=H'\f3\s14\\*(=F\fP\s0'
'\"'\" Emit the ellipsis string for the current function.
'\"'sp .25i
'\"'ft 1
'\"\f2\s12\h'\\n(.lu-\w'\\*(=f'u'\\*(=f\fP\s0\h'|0u'
'\".sp .05i
'ev
'\" Save current file name for use in footer.
'ds =G \\*(=F
..
'\"----------------
.ig
    v.:	Output function ellipsis string as part of column header.
	Called from vH.
..
.de v.
'ev 2
'sp .25i
'ft 1
\f2\s12\h'\\n(vKu-\w'\\*(=f'u'\\*(=f\fP\s0\h'|0u'
.sp .05i
'ev
'ns     \" Suppress additional spacing.
..
'\"----------------
.ig
    vF:	Footer macro
	Only invoked when not in filter mode.

	If in two column mode, handles switching between columns.

	N.B.: This macro hard-wires the inter-column gap to 0.25i.
..
.de vF
'ie \\n(=2 \{\
'\" in two column mode
'       ie \\n+(v2=1 \{\
'\"         Transition from left column to right.
'\"             Construct a vertical line running down the center of the
'\"             gutter.
'               ev 2
'               nr vX (\\n(vLu/2u-(0.125i))u    \" Horiz off to gutter center
\h'|\\n(vXu'\c
\L'|\\n(vHu'\c
\h'|0u'\c
'\"             Move back to top of column and bump page offset to move
'\"             into it.
.               sp |\\n(vHu
'               po \\n(vRu
'\"             Put out the current function ellipsis string.
'               ev
'               v.
'       no\}
'       el \{\
'\"         Transition from right column to left of next page: restore
'\"         saved values and then output the footer.
'               po \\n(vOu
'               ll \\n(vLu
'               v>
'       no\}
'no\}
'el     'v>
..
'\"----------------
.ig
    v>:	Output page footer
	Called from vF when in single column mode or when it hits the
	bottom of the left column.
..
'de v>
'ev 2
'sp .35i
'ie '\\*(=G'' 'tl '\f2\\*(=M''Page %\fP'
'el           'tl '\f2\\*(=M''Page % of \\*(=G\fP'
'bp
'ev
'ft \\*(tP
'if \\n(vC=1 'ft \\*(tC
..
'\"----------------
.ig
    ():	Inter-file macro
	Only invoked when not in filter mode.  Called between input files,
	to reset page numbering for each.
..
'de ()
'pn 1
..
'\"----------------
.ig
    +C:	Start comment
..
'de +C
'nr vC 1
'ft \\*(tC
'ds +K
'ds -K
..
'\"----------------
.ig
    -C: end comment
..
'de -C
'nr vC 0
'ft \\*(tP
'ds +K \\f\\*(fK
'ds -K \fP
..
'\"----------------
.ig
    FN:	function definition
	Issues marginal notation giving function's name.
	Issues the primary index entry for it.
	Sets the =f string to record a continuation entry for it
	(e.g., " ...func-name").
..
'de FN
\f2\s14\h'\\n(vKu-\w'\\$1'u'\\$1\fP\s0\h'|0u'\c
.if \\nx .tm \\$1 \\*(=F \\n%
'ds =f \&...\\$1
..
'\"----------------
.ig
    FC:	function continuation
	Issues index entry for where the function definition picks up again.
	Sets the =f string to record a continuation entry for it
	(e.g., " ...func-name").
..
'de FC
.if \\nx .tm \\$1 \\*(=F \\n%
'ds =f \&...\\$1
..
'\"----------------
.ig
    -F:	function end
	Removes definition of =f string so that the marginal entry for
	function continuation will no longer appear.
..
'de -F
'rm =f
..
'\"----------------
/*
 * Copyright (c) 1980 Regents of the University of California.
 * All rights reserved.  The Berkeley software License Agreement
 * specifies the terms and conditions for redistribution.
 */

#include <ctype.h>
#include <stdio.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <locale.h>
#include <euc.h>
#include <stdlib.h>

#define boolean int
#define TRUE 1
#define FALSE 0
#define NIL 0
#define STANDARD 0
#define ALTERNATE 1

/*
 * Vfontedpr.
 *
 * Dave Presotto 1/12/81 (adapted from an earlier version by Bill Joy)
 *
 */

#define STRLEN 10		/* length of strings introducing things */
#define PNAMELEN 40		/* length of a function/procedure name */
#define PSMAX 20		/* size of procedure name stacking */

/* regular expression routines */

char	*expmatch();		/* match a string to an expression */
char	*STRNCMP();		/* a different kind of strncmp */
char	*convexp();		/* convert expression to internal form */

char	*tgetstr();		/* extract a string-valued capability */
boolean	isproc();
char	*ctime();
char	*strchr();

/*
 *	The state variables
 */

boolean	incomm;			/* in a comment of the primary type */
boolean	instr;			/* in a string constant */
boolean	inchr;			/* in a string constant */
boolean	nokeyw = FALSE;		/* no keywords being flagged */
boolean	doindex = FALSE;	/* form an index */
boolean twocol = FALSE;		/* in two-column mode */
boolean	filter = FALSE;		/* act as a filter (like eqn) */
boolean	pass = FALSE;		/* when acting as a filter, pass indicates
				 * whether we are currently processing
				 * input.
				 */
boolean	prccont;		/* continue last procedure */
int	comtype;		/* type of comment */
int	margin;
int	psptr;			/* the stack index of the current procedure */
char	pstack[PSMAX][PNAMELEN+1];	/* the procedure name stack */
int	plstack[PSMAX];		/* the procedure nesting level stack */
int	blklevel;		/* current nesting level */
int	prclevel;		/* nesting level at which procedure definitions
				   may be found, -1 if none currently valid
				   (meaningful only if l_prclevel is true) */
char	*defsfile = "/usr/lib/vgrindefs";	/* name of language definitions file */
char	pname[BUFSIZ+1];

/*
 *	The language specific globals
 */

char	*language = "c";	/* the language indicator */
char	*l_keywds[BUFSIZ/2];	/* keyword table address */
char	*l_prcbeg;		/* regular expr for procedure begin */
char	*l_combeg;		/* string introducing a comment */
char	*l_comend;		/* string ending a comment */
char	*l_acmbeg;		/* string introducing a comment */
char	*l_acmend;		/* string ending a comment */
char	*l_blkbeg;		/* string begining of a block */
char	*l_blkend;		/* string ending a block */
char	*l_strbeg;		/* delimiter for string constant */
char	*l_strend;		/* delimiter for string constant */
char	*l_chrbeg;		/* delimiter for character constant */
char	*l_chrend;		/* delimiter for character constant */
char	*l_prcenable;		/* re indicating that procedure definitions
				   can be found in the next lexical level --
				   kludge for lisp-like languages that use
				   something like
					   (defun (proc ...)
					  	(proc ...)
					   )
				   to define procedures */
char	l_escape;		/* character used to  escape characters */
boolean	l_toplex;		/* procedures only defined at top lex level */
boolean l_prclevel;		/* procedure definitions valid only within
				   the nesting level indicated by the px
				   (l_prcenable) capability */

/*
 *  for the benefit of die-hards who aren't convinced that tabs
 *  occur every eight columns
 */
short tabsize = 8;

/*
 *  global variables also used by expmatch
 */
boolean	_escaped;		/* if last character was an escape */
char	*Start;			/* start of the current string */
boolean	l_onecase;		/* upper and lower case are equivalent */
char	*l_idchars;		/* characters legal in identifiers in addition
				   to letters and digits (default "_") */

static void putcp(int c);
static int width(char *s, char *os);
static int tabs(char *s, char *os);
static void putKcp(char *start, char *end, boolean force);
static void putScp(char *os);
static int iskw(char *s);

/*
 * The code below emits troff macros and directives that consume part of the
 * troff macro and register space.  See tmac.vgrind for an enumeration of
 * these macros and registers.
 */

int
main(int argc, char *argv[])
{
    FILE *in;
    char *fname;
    struct stat stbuf;
    char buf[BUFSIZ];
    char idbuf[256];	/* enough for all 8 bit chars */
    char strings[2 * BUFSIZ];
    char defs[2 * BUFSIZ];
    int needbp = 0;
    int i;
    char *cp;

	(void) setlocale(LC_ALL, "");
#if !defined(TEXT_DOMAIN)
#define	TEXT_DOMAIN	"SYS_TEST"
#endif
	(void) textdomain(TEXT_DOMAIN);

    /*
     * Dump the name by which we were invoked.
     */
    argc--, argv++;

    /*
     * Process arguments.  For the sake of compatibility with older versions
     * of the program, the syntax accepted below is very idiosyncratic.  Some
     * options require space between the option and its argument; others
     * disallow it.  No options may be bundled together.
     *
     * Actually, there is one incompatibility.  Files and options formerly
     * could be arbitrarily intermixed, but this is no longer allowed.  (This
     * possiblity was never documented.)
     */
    while (argc > 0 && *argv[0] == '-') {
	switch (*(cp = argv[0] + 1)) {

	case '\0':				/* - */
	    /* Take input from stdin. */
	    /*
	     * This option implies the end of the flag arguments.  Leave the
	     * "-" in place for the file processing code to see.
	     */
	    goto flagsdone;

	case '2':				/* -2 */
	    /* Enter two column mode. */
	    twocol = 1;
	    printf("'nr =2 1\n");
	    break;

	case 'd':				/* -d <defs-file> */
	    /* Specify the language description file. */
	    defsfile = argv[1];
	    argc--, argv++;
	    break;

	case 'f':				/* -f */
	    /* Act as a filter like eqn. */
	    filter = 1;
	    /*
	     * Slide remaining arguments down one position and postpend "-",
	     * to force reading from stdin.
	     */
	    for (i = 0; i < argc - 1; i++)
		argv[i] = argv[i + 1];
	    argv[argc - 1] = "-";
	    continue;

	case 'h':				/* -h [header] */
	    /* Specify header string. */
	    if (argc == 1) {
		printf("'ds =H\n");
		break;
	    }
	    printf("'ds =H %s\n", argv[1]);
	    argc--, argv++;
	    break;

	case 'l':				/* -l<language> */
	    /* Specify the language. */
	    language = cp + 1;
	    break;

	case 'n':				/* -n */
	    /* Indicate no keywords. */
	    nokeyw = 1;
	    break;

	case 's':				/* -s<size> */
	    /* Specify the font size. */
	    i = 0;
	    cp++;
	    while (*cp)
		i = i * 10 + (*cp++ - '0');
	    printf("'nr vP %d\n", i);
	    break;

	case 't':				/* -t */
	    /* Specify a nondefault tab size. */
	    tabsize = 4;
	    break;

	case 'x':				/* -x */
	    /* Build an index. */
	    doindex = 1;
	    /* This option implies "-n" as well; turn it on. */
	    argv[0] = "-n";
	    continue;
	}

	/* Advance to next argument. */
	argc--, argv++;
    }

flagsdone:

    /*
     * Get the language definition from the defs file.
     */
    i = tgetent (defs, language, defsfile);
    if (i == 0) {
	fprintf (stderr, gettext("no entry for language %s\n"), language);
	exit (0);
    } else  if (i < 0) {
	fprintf (stderr,  gettext("cannot find vgrindefs file %s\n"), defsfile);
	exit (0);
    }
    cp = strings;
    if (tgetstr ("kw", &cp) == NIL)
	nokeyw = TRUE;
    else  {
	char **cpp;

	cpp = l_keywds;
	cp = strings;
	while (*cp) {
	    while (*cp == ' ' || *cp =='\t')
		*cp++ = '\0';
	    if (*cp)
		*cpp++ = cp;
	    while (*cp != ' ' && *cp  != '\t' && *cp)
		cp++;
	}
	*cpp = NIL;
    }
    cp = buf;
    l_prcbeg = convexp (tgetstr ("pb", &cp));
    cp = buf;
    l_combeg = convexp (tgetstr ("cb", &cp));
    cp = buf;
    l_comend = convexp (tgetstr ("ce", &cp));
    cp = buf;
    l_acmbeg = convexp (tgetstr ("ab", &cp));
    cp = buf;
    l_acmend = convexp (tgetstr ("ae", &cp));
    cp = buf;
    l_strbeg = convexp (tgetstr ("sb", &cp));
    cp = buf;
    l_strend = convexp (tgetstr ("se", &cp));
    cp = buf;
    l_blkbeg = convexp (tgetstr ("bb", &cp));
    cp = buf;
    l_blkend = convexp (tgetstr ("be", &cp));
    cp = buf;
    l_chrbeg = convexp (tgetstr ("lb", &cp));
    cp = buf;
    l_chrend = convexp (tgetstr ("le", &cp));
    cp = buf;
    l_prcenable = convexp (tgetstr ("px", &cp));
    cp = idbuf;
    l_idchars = tgetstr ("id", &cp);
    /* Set default, for compatibility with old version */
    if (l_idchars == NIL)
	l_idchars = "_";
    l_escape = '\\';
    l_onecase = tgetflag ("oc");
    l_toplex = tgetflag ("tl");
    l_prclevel = tgetflag ("pl");

    /*
     * Emit a call to the initialization macro.  If not in filter mode, emit a
     * call to the vS macro, so that tmac.vgrind can uniformly assume that all
     * program input is bracketed with vS-vE pairs.
     */
    printf("'vI\n");
    if (!filter)
	printf("'vS\n");

    if (doindex) {
	/*
	 * XXX:	Hard-wired spacing information.  This should probably turn
	 *	into the emission of a macro invocation, so that tmac.vgrind
	 *	can make up its own mind about what spacing is appropriate.
	 */
	if (twocol)
	    printf("'ta 2.5i 2.75i 4.0iR\n'in .25i\n");
	else
	    printf("'ta 4i 4.25i 5.5iR\n'in .5i\n");
    }

    while (argc > 0) {
	if (strcmp(argv[0], "-") == 0) {
	    /* Embed an instance of the original stdin. */
	    in = fdopen(fileno(stdin), "r");
	    fname = "";
	} else {
	    /* Open the file for input. */
	    if ((in = fopen(argv[0], "r")) == NULL) {
		perror(argv[0]);
		exit(1);
	    }
	    fname = argv[0];
	}
	argc--, argv++;

	/*
	 * Reinitialize for the current file.
	 */
	incomm = FALSE;
	instr = FALSE;
	inchr = FALSE;
	_escaped = FALSE;
	blklevel = 0;
	prclevel = -1;
	for (psptr=0; psptr<PSMAX; psptr++) {
	    pstack[psptr][0] = '\0';
	    plstack[psptr] = 0;
	}
	psptr = -1;
	printf("'-F\n");
	if (!filter) {
	    char *cp;

	    printf(".ds =F %s\n", fname);
	    if (needbp) {
		needbp = 0;
		printf(".()\n");
		printf(".bp\n");
	    }
	    fstat(fileno(in), &stbuf);
	    cp = ctime(&stbuf.st_mtime);
	    cp[16] = '\0';
	    cp[24] = '\0';
	    printf(".ds =M %s %s\n", cp+4, cp+20);
	    printf("'wh 0 vH\n");
	    printf("'wh -1i vF\n");
	}
	if (needbp && filter) {
	    needbp = 0;
	    printf(".()\n");
	    printf(".bp\n");
	}

	/*
	 *	MAIN LOOP!!!
	 */
	while (fgets(buf, sizeof buf, in) != NULL) {
	    if (buf[0] == '\f') {
		printf(".bp\n");
	    }
	    if (buf[0] == '.') {
		printf("%s", buf);
		if (!strncmp (buf+1, "vS", 2))
		    pass = TRUE;
		if (!strncmp (buf+1, "vE", 2))
		    pass = FALSE;
		continue;
	    }
	    prccont = FALSE;
	    if (!filter || pass)
		putScp(buf);
	    else
		printf("%s", buf);
	    if (prccont && (psptr >= 0))
		printf("'FC %s\n", pstack[psptr]);
#ifdef DEBUG
	    printf ("com %o str %o chr %o ptr %d\n", incomm, instr, inchr, psptr);
#endif
	    margin = 0;
	}

	needbp = 1;
	(void) fclose(in);
    }

    /* Close off the vS-vE pair. */
    if (!filter)
	printf("'vE\n");

    return (0);
}

#define isidchr(c) (isalnum(c) || ((c) != NIL && strchr(l_idchars, (c)) != NIL))

static void
putScp(char *os)
{
    char *s = os;			/* pointer to unmatched string */
    char dummy[BUFSIZ];			/* dummy to be used by expmatch */
    char *comptr;			/* end of a comment delimiter */
    char *acmptr;			/* end of a comment delimiter */
    char *strptr;			/* end of a string delimiter */
    char *chrptr;			/* end of a character const delimiter */
    char *blksptr;			/* end of a lexical block start */
    char *blkeptr;			/* end of a lexical block end */

    Start = os;			/* remember the start for expmatch */
    _escaped = FALSE;
    if (nokeyw || incomm || instr)
	goto skip;
    if (isproc(s)) {
	printf("'FN %s\n", pname);
	if (psptr < PSMAX-1) {
	    ++psptr;
	    strncpy (pstack[psptr], pname, PNAMELEN);
	    pstack[psptr][PNAMELEN] = '\0';
	    plstack[psptr] = blklevel;
	}
    }
    /*
     * if l_prclevel is set, check to see whether this lexical level
     * is one immediately below which procedure definitions are allowed.
     */
    if (l_prclevel && !incomm && !instr && !inchr) {
	if (expmatch (s, l_prcenable, dummy) != NIL)
	    prclevel = blklevel + 1;
    }
skip:
    do {
	/* check for string, comment, blockstart, etc */
	if (!incomm && !instr && !inchr) {

	    blkeptr = expmatch (s, l_blkend, dummy);
	    blksptr = expmatch (s, l_blkbeg, dummy);
	    comptr = expmatch (s, l_combeg, dummy);
	    acmptr = expmatch (s, l_acmbeg, dummy);
	    strptr = expmatch (s, l_strbeg, dummy);
	    chrptr = expmatch (s, l_chrbeg, dummy);

	    /* start of a comment? */
	    if (comptr != NIL)
		if ((comptr < strptr || strptr == NIL)
		  && (comptr < acmptr || acmptr == NIL)
		  && (comptr < chrptr || chrptr == NIL)
		  && (comptr < blksptr || blksptr == NIL)
		  && (comptr < blkeptr || blkeptr == NIL)) {
		    putKcp (s, comptr-1, FALSE);
		    s = comptr;
		    incomm = TRUE;
		    comtype = STANDARD;
		    if (s != os)
			printf ("\\c");
		    printf ("\\c\n'+C\n");
		    continue;
		}

	    /* start of a comment? */
	    if (acmptr != NIL)
		if ((acmptr < strptr || strptr == NIL)
		  && (acmptr < chrptr || chrptr == NIL)
		  && (acmptr < blksptr || blksptr == NIL)
		  && (acmptr < blkeptr || blkeptr == NIL)) {
		    putKcp (s, acmptr-1, FALSE);
		    s = acmptr;
		    incomm = TRUE;
		    comtype = ALTERNATE;
		    if (s != os)
			printf ("\\c");
		    printf ("\\c\n'+C\n");
		    continue;
		}

	    /* start of a string? */
	    if (strptr != NIL)
		if ((strptr < chrptr || chrptr == NIL)
		  && (strptr < blksptr || blksptr == NIL)
		  && (strptr < blkeptr || blkeptr == NIL)) {
		    putKcp (s, strptr-1, FALSE);
		    s = strptr;
		    instr = TRUE;
		    continue;
		}

	    /* start of a character string? */
	    if (chrptr != NIL)
		if ((chrptr < blksptr || blksptr == NIL)
		  && (chrptr < blkeptr || blkeptr == NIL)) {
		    putKcp (s, chrptr-1, FALSE);
		    s = chrptr;
		    inchr = TRUE;
		    continue;
		}

	    /* end of a lexical block */
	    if (blkeptr != NIL) {
		if (blkeptr < blksptr || blksptr == NIL) {
		    /* reset prclevel if necessary */
		    if (l_prclevel && prclevel == blklevel)
			prclevel = -1;
		    putKcp (s, blkeptr - 1, FALSE);
		    s = blkeptr;
		    blklevel--;
		    if (psptr >= 0 && plstack[psptr] >= blklevel) {

			/* end of current procedure */
			if (s != os)
			    printf ("\\c");
			printf ("\\c\n'-F\n");
			blklevel = plstack[psptr];

			/* see if we should print the last proc name */
			if (--psptr >= 0)
			    prccont = TRUE;
			else
			    psptr = -1;
		    }
		    continue;
		}
	    }

	    /* start of a lexical block */
	    if (blksptr != NIL) {
		putKcp (s, blksptr - 1, FALSE);
		s = blksptr;
		blklevel++;
		continue;
	    }

	/* check for end of comment */
	} else if (incomm) {
	    comptr = expmatch (s, l_comend, dummy);
	    acmptr = expmatch (s, l_acmend, dummy);
	    if (((comtype == STANDARD) && (comptr != NIL)) ||
	        ((comtype == ALTERNATE) && (acmptr != NIL))) {
		if (comtype == STANDARD) {
		    putKcp (s, comptr-1, TRUE);
		    s = comptr;
		} else {
		    putKcp (s, acmptr-1, TRUE);
		    s = acmptr;
		}
		incomm = FALSE;
		printf("\\c\n'-C\n");
		continue;
	    } else {
		putKcp (s, s + strlen(s) -1, TRUE);
		s = s + strlen(s);
		continue;
	    }

	/* check for end of string */
	} else if (instr) {
	    if ((strptr = expmatch (s, l_strend, dummy)) != NIL) {
		putKcp (s, strptr-1, TRUE);
		s = strptr;
		instr = FALSE;
		continue;
	    } else {
		putKcp (s, s+strlen(s)-1, TRUE);
		s = s + strlen(s);
		continue;
	    }

	/* check for end of character string */
	} else if (inchr) {
	    if ((chrptr = expmatch (s, l_chrend, dummy)) != NIL) {
		putKcp (s, chrptr-1, TRUE);
		s = chrptr;
		inchr = FALSE;
		continue;
	    } else {
		putKcp (s, s+strlen(s)-1, TRUE);
		s = s + strlen(s);
		continue;
	    }
	}

	/* print out the line */
	putKcp (s, s + strlen(s) -1, FALSE);
	s = s + strlen(s);
    } while (*s);
}

static void
putKcp(char *start, char *end, boolean force)
	/* start - start of string to write */
	/* end - end of string to write */
	/* force - true if we should force nokeyw */
{
    int i;
    int xfld = 0;

    while (start <= end) {
	if (doindex) {
	    if (*start == ' ' || *start == '\t') {
		if (xfld == 0)
		    printf("");
		printf("\t");
		xfld = 1;
		while (*start == ' ' || *start == '\t')
		    start++;
		continue;
	    }
	}

	/* take care of nice tab stops */
	if (*start == '\t') {
	    while (*start == '\t')
		start++;
	    i = tabs(Start, start) - margin / tabsize;
	    printf ("\\h'|%dn'",
		    i * (tabsize == 4 ? 5 : 10) + 1 - margin % tabsize);
	    continue;
	}

	if (!nokeyw && !force)
	    if (  (*start == '#'   ||  isidchr(*start))
	       && (start == Start || !isidchr(start[-1]))
	       ) {
		i = iskw(start);
		if (i > 0) {
		    printf("\\*(+K");
		    do
			putcp(*start++);
		    while (--i > 0);
		    printf("\\*(-K");
		    continue;
		}
	    }

	putcp (*start++);
    }
}


static int
tabs(char *s, char *os)
{

    return (width(s, os) / tabsize);
}

static int
width(char *s, char *os)
{
	int i = 0;
	unsigned char c;
	int n;

	while (s < os) {
		if (*s == '\t') {
			i = (i + tabsize) &~ (tabsize-1);
			s++;
			continue;
		}
		c = *(unsigned char *)s;
		if (c < ' ')
			i += 2, s++;
		else if (c >= 0200) {
			if ((n = mblen(s, MB_CUR_MAX)) > 0) {
				i += csetcol(csetno(c));
				s += n;
			} else
				s++;
		} else
			i++, s++;
	}
	return (i);
}

static void
putcp(int c)
{

	switch(c) {

	case 0:
		break;

	case '\f':
		break;

	case '{':
		printf("\\*(+K{\\*(-K");
		break;

	case '}':
		printf("\\*(+K}\\*(-K");
		break;

	case '\\':
		printf("\\e");
		break;

	case '_':
		printf("\\*_");
		break;

	case '-':
		printf("\\*-");
		break;

		/*
		 * The following two cases deal with the accent characters.
		 * If they're part of a comment, we assume that they're part
		 * of running text and hand them to troff as regular quote
		 * characters.  Otherwise, we assume they're being used as
		 * special characters (e.g., string delimiters) and arrange
		 * for troff to render them as accents.  This is an imperfect
		 * heuristic that produces slightly better appearance than the
		 * former behavior of unconditionally rendering the characters
		 * as accents.  (See bug 1040343.)
		 */

	case '`':
		if (incomm)
			printf("`");
		else
			printf("\\`");
		break;

	case '\'':
		if (incomm)
			printf("'");
		else
			printf("\\'");
		break;

	case '.':
		printf("\\&.");
		break;

		/*
		 * The following two cases contain special hacking
		 * to make C-style comments line up.  The tests aren't
		 * really adequate; they lead to grotesqueries such
		 * as italicized multiplication and division operators.
		 * However, the obvious test (!incomm) doesn't work,
		 * because incomm isn't set until after we've put out
		 * the comment-begin characters.  The real problem is
		 * that expmatch() doesn't give us enough information.
		 */

	case '*':
		if (instr || inchr)
			printf("*");
		else
			printf("\\f2*\\fP");
		break;

	case '/':
		if (instr || inchr)
			printf("/");
		else
			printf("\\f2\\h'\\w' 'u-\\w'/'u'/\\fP");
		break;

	default:
		if (c < 040)
			putchar('^'), c |= '@';
		/* FALLTHROUGH */
	case '\t':
	case '\n':
		putchar(c);
	}
}

/*
 *	look for a process beginning on this line
 */
boolean
isproc(char *s)
{
    pname[0] = '\0';
    if (l_prclevel ? (prclevel == blklevel) : (!l_toplex || blklevel == 0))
	if (expmatch (s, l_prcbeg, pname) != NIL) {
	    return (TRUE);
	}
    return (FALSE);
}


/*
 * iskw - check to see if the next word is a keyword
 *	Return its length if it is or 0 if it isn't.
 */

static int
iskw(char *s)
{
	char **ss = l_keywds;
	int i = 1;
	char *cp = s;

	/* Get token length. */
	while (++cp, isidchr(*cp))
		i++;

	while (cp = *ss++) {
		if (!STRNCMP(s,cp,i) && !isidchr(cp[i]))
			return (i);
	}
	return (0);
}
#! /usr/bin/ksh
#
# vgrind
# Copyright (c) 1999-2000 by Sun Microsystems, Inc.
# All rights reserved.
#
# ident	"%Z%%M%	%I%	%E% SMI"
#
# Copyright (c) 1980 Regents of the University of California.
# All rights reserved.  The Berkeley software License Agreement
# specifies the terms and conditions for redistribution.
#
#       This is a rewrite in ksh of the command originally written in
#       csh whose last incarnation was:
#       vgrind.csh 1.16 96/10/14 SMI; from UCB 5.3 (Berkeley) 11/13/85
#


# Definitions the user can override

troff=${TROFF:-/usr/bin/troff}
vfontedpr=${VFONTEDPR:-/usr/lib/vfontedpr}
macros=${TMAC_VGRIND:-/usr/share/lib/tmac/tmac.vgrind}
lp=${LP:-/usr/bin/lp}

# Internal processing of options

dpost=/usr/lib/lp/postscript/dpost

args=""
dpostopts="-e 2"
files=""
lpopts=""
troffopts="-t"

filter=0
uselp=1
usedpost=1
stdoutisatty=0

pspec=0
tspec=0
twospec=0

printer=""

if [ -t 1 ] ; then
  stdoutisatty=1
fi

# Process command line options

while getopts ":2d:fh:l:no:P:s:tT:wWx" opt ; do
  case "$opt" in
    +*)
      /bin/printf "`/usr/bin/gettext TEXT_DOMAIN 'vgrind: bad option %s'`\n" "+$opt" >&2
      exit 1
      ;;
    "?")
      /bin/printf "`/usr/bin/gettext TEXT_DOMAIN 'vgrind: bad option %s'`\n" "-$OPTARG" >&2
      exit 1
      ;;
    2)
      dpostopts="$dpostopts -p l"
      usedpost=1
      args="$args -2"
      twospec=1
      ;;
    d)
      args="$args -d $OPTARG"
      if ! [ -r $OPTARG ] ; then
        /bin/printf "`/usr/bin/gettext TEXT_DOMAIN 'vgrind: -%s %s: file not readable'`\n" "$opt" "$OPTARG" >&2
        exit 1
      fi
      ;;
    f)
      filter=1
      args="$args -f"
      ;;
    h)
      args="$args -h '$OPTARG'"
      ;;
    l)
      args="$args -l$OPTARG"
      ;;
    n)
      args="$args -$opt"
      ;;
    o)
      troffopts="$troffopts -o$OPTARG"
      ;;
    P)
      uselp=1
      usedpost=1
      printer=$OPTARG
      pspec=1
      ;;
    s)
      args="$args -s$OPTARG"
      ;;
    T)
      troffopts="$troffopts -T$OPTARG"
      ;;
    t)
      uselp=0
      usedpost=0
      tspec=1
      ;;
    W)
      # Do nothing with this switch
      ;;
    w)
      args="$args -t"
      ;;
    x)
      args="$args -x"
      ;;
    *)
      troffopts="$troffopts -$opt"
      ;;
  esac

  if [ "$opt" = ":" ] ; then
    /bin/printf "`/usr/bin/gettext TEXT_DOMAIN 'vgrind: missing argument to option %s'` \n" "-$OPTARG" >&2
    exit 1
  fi
done

shift $((OPTIND - 1))

for x in "$@" ; do
  args="$args '$x'"
  files="$files '$x'"
done

shift $#

if [ $filter -eq 1 -a \( $twospec -eq 1 -o $pspec -eq 1 \) ] ; then
  /bin/printf "`/usr/bin/gettext TEXT_DOMAIN 'vgrind: option -f is incompatible with -2 and -P'`\n" >&2
  exit 1
fi

if [ $filter -eq 1 -a $tspec -eq 1 ] ; then
  /bin/printf "`/usr/bin/gettext TEXT_DOMAIN 'vgrind: option -f is incompatible with -t'`\n" >&2
  exit 1
fi

if [ $tspec -eq 1 -a \( $twospec -eq 1 -o $pspec -eq 1 \) ] ; then
  /bin/printf "`/usr/bin/gettext TEXT_DOMAIN 'vgrind: option -t is incompatible with -2 and -P'`\n" >&2
  exit 1
fi

# Do some reasoning about whether to print

if [ $uselp -eq 1 ] ; then
  # If we want to print

  if [ -z "$printer" ] ; then
    # If "-P" was not specified

    defaultprinter=`LC_ALL=C /usr/bin/lpstat -d | /bin/sed -e "s/no system default destination//" 2>/dev/null`

    if [ -n "$defaultprinter" ] ; then
      defaultprinter=`echo $defaultprinter | \
        /bin/sed -e "s/system default destination: //" 2>/dev/null`
    fi

    if [ $stdoutisatty -eq 1 ] ; then
      # If stdout is not re-directed

      if [ -z "$defaultprinter" ] ; then
        uselp=0
      else
        printer=$defaultprinter
      fi
    else
      # stdout is redirected - assume it is for further processing of
      # postscript output.

      uselp=0
    fi
  fi
fi

if [ $uselp -eq 1 ] ; then
  case $(/bin/basename $lp) in
   lp)
     lpopts="$lpopts -d$printer"
     ;;
   lpr)
     lpopts="$lpopts -P$printer"
     ;;
   *)
     /bin/printf "`/usr/bin/gettext TEXT_DOMAIN 'vgrind: unknown print program %s'`\n" $lp >&2
     exit 1
     ;;
  esac
fi

# Implementation note:  In the following, we use "eval" to execute the
# command in order to preserve spaces which may appear in the -h option
# argument (and possibly in file names).

if [ $filter -eq 1 ] ; then
  eval "$vfontedpr $args | /bin/cat $macros -"
else
  cmd="$vfontedpr $args"

  if [ -r index ] ; then
    # Removes any entries from the index that come from the files we are
    # processing.

    echo > nindex

    for i in "$files" ; do
      echo "? $i ?d" | /bin/sed -e "s:/:\\\/:g" -e "s:?:/:g" >> nindex
    done

    /bin/sed -f nindex index > xindex

    # Now process the input.
    # (! [$filter -eq 1])

    trap "rm -f xindex nindex; exit 1" INT QUIT

    cmd="$cmd | $troff -rx1 $troffopts -i $macros - 2>> xindex"

    if [ $usedpost -eq 1 ] ; then
      cmd="$cmd | $dpost $dpostopts"
    fi

    if [ $uselp -eq 1 ] ; then
      cmd="$cmd | $lp $lpopts"
    fi

    eval $cmd
    trap - INT QUIT
    /bin/sort -dfu +0 -2 xindex > index
    /bin/rm nindex xindex
  else
    # (! [ -r index ])

    cmd="$cmd | $troff -i $troffopts $macros -"

    if [ $usedpost -eq 1 ] ; then
      cmd="$cmd | $dpost $dpostopts"
    fi

    if [ $uselp -eq 1 ] ; then
        cmd="$cmd | $lp $lpopts"
    fi

    eval $cmd
  fi
fi
#
# Copyright 2005 Sun Microsystems, Inc.  All rights reserved.
# Use is subject to license terms.
#
# CDDL HEADER START
#
# The contents of this file are subject to the terms of the
# Common Development and Distribution License, Version 1.0 only
# (the "License").  You may not use this file except in compliance
# with the License.
#
# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
# or http://www.opensolaris.org/os/licensing.
# See the License for the specific language governing permissions
# and limitations under the License.
#
# When distributing Covered Code, include this CDDL HEADER in each
# file and include the License file at usr/src/OPENSOLARIS.LICENSE.
# If applicable, add the following below this CDDL HEADER, with the
# fields enclosed by brackets "[]" replaced with your own identifying
# information: Portions Copyright [yyyy] [name of copyright owner]
#
# CDDL HEADER END
#
#ident	"%Z%%M%	%I%	%E% SMI"
#
msgid  "vgrind: bad option %s"
msgstr
msgid  "vgrind: -%s %s: file not readable"
msgstr
msgid  "vgrind: option -f is incompatible with -2 and -P"
msgstr
msgid  "vgrind: option -f is incompatible with -t"
msgstr
msgid  "vgrind: option -t is incompatible with -2 and -P"
msgstr
msgid  "vgrind: unknown print program %s"
msgstr
msgid  "vgrind: missing argument to option %s"
msgstr
/*
 * Copyright (c) 1980 Regents of the University of California.
 * All rights reserved.  The Berkeley software License Agreement
 * specifies the terms and conditions for redistribution.
 */

#define	BUFSIZ	1024
#define MAXHOP	32	/* max number of tc= indirections */

#include <ctype.h>
#include <locale.h>
#include <string.h>
/*
 * grindcap - routines for dealing with the language definitions data base
 *	(code stolen almost totally from termcap)
 *
 * BUG:		Should use a "last" pointer in tbuf, so that searching
 *		for capabilities alphabetically would not be a n**2/2
 *		process when large numbers of capabilities are given.
 * Note:	If we add a last pointer now we will screw up the
 *		tc capability. We really should compile termcap.
 *
 * Essentially all the work here is scanning and decoding escapes
 * in string capabilities.  We don't use stdio because the editor
 * doesn't, and because living w/o it is not hard.
 */

static	char *tbuf;
static	char *filename;
static	int hopcount;	/* detect infinite loops in termcap, init 0 */
char	*tgetstr();
char	*getenv();

static char *tdecode(char *str, char **area);
static char *tskip(char *bp);
static int tnchktc(void);
static int tnamatch(char *np);

static char	*vgrind_msg;

/*
 * Get an entry for terminal name in buffer bp,
 * from the termcap file.  Parse is very rudimentary;
 * we just notice escaped newlines.
 */
int
tgetent(char *bp, char *name, char *file)
{
	char *cp;
	int c;
	int i = 0, cnt = 0;
	char ibuf[BUFSIZ];
	char *cp2;
	int tf;

	tbuf = bp;
	tf = 0;
	filename = file;
	tf = open(filename, 0);
	if (tf < 0)
		return (-1);
	for (;;) {
		cp = bp;
		for (;;) {
			if (i == cnt) {
				cnt = read(tf, ibuf, BUFSIZ);
				if (cnt <= 0) {
					close(tf);
					return (0);
				}
				i = 0;
			}
			c = ibuf[i++];
			if (c == '\n') {
				if (cp > bp && cp[-1] == '\\'){
					cp--;
					continue;
				}
				break;
			}
			if (cp >= bp+BUFSIZ) {
				vgrind_msg = gettext("Vgrind entry too long\n");
				write(2, vgrind_msg, strlen(vgrind_msg));
				break;
			} else
				*cp++ = c;
		}
		*cp = 0;

		/*
		 * The real work for the match.
		 */
		if (tnamatch(name)) {
			close(tf);
			return(tnchktc());
		}
	}
}

/*
 * tnchktc: check the last entry, see if it's tc=xxx. If so,
 * recursively find xxx and append that entry (minus the names)
 * to take the place of the tc=xxx entry. This allows termcap
 * entries to say "like an HP2621 but doesn't turn on the labels".
 * Note that this works because of the left to right scan.
 */
static int
tnchktc(void)
{
	char *p, *q;
	char tcname[16];	/* name of similar terminal */
	char tcbuf[BUFSIZ];
	char *holdtbuf = tbuf;
	int l;

	p = tbuf + strlen(tbuf) - 2;	/* before the last colon */
	while (*--p != ':')
		if (p<tbuf) {
			vgrind_msg = gettext("Bad vgrind entry\n");
			write(2, vgrind_msg, strlen(vgrind_msg));
			return (0);
		}
	p++;
	/* p now points to beginning of last field */
	if (p[0] != 't' || p[1] != 'c')
		return(1);
	strcpy(tcname,p+3);
	q = tcname;
	while (q && *q != ':')
		q++;
	*q = 0;
	if (++hopcount > MAXHOP) {
		vgrind_msg = gettext("Infinite tc= loop\n");
		write(2, vgrind_msg, strlen(vgrind_msg));
		return (0);
	}
	if (tgetent(tcbuf, tcname, filename) != 1)
		return(0);
	for (q=tcbuf; *q != ':'; q++)
		;
	l = p - holdtbuf + strlen(q);
	if (l > BUFSIZ) {
		vgrind_msg = gettext("Vgrind entry too long\n");
		write(2, vgrind_msg, strlen(vgrind_msg));
		q[BUFSIZ - (p-tbuf)] = 0;
	}
	strcpy(p, q+1);
	tbuf = holdtbuf;
	return(1);
}

/*
 * Tnamatch deals with name matching.  The first field of the termcap
 * entry is a sequence of names separated by |'s, so we compare
 * against each such name.  The normal : terminator after the last
 * name (before the first field) stops us.
 */
static int
tnamatch(char *np)
{
	char *Np, *Bp;

	Bp = tbuf;
	if (*Bp == '#')
		return(0);
	for (;;) {
		for (Np = np; *Np && *Bp == *Np; Bp++, Np++)
			continue;
		if (*Np == 0 && (*Bp == '|' || *Bp == ':' || *Bp == 0))
			return (1);
		while (*Bp && *Bp != ':' && *Bp != '|')
			Bp++;
		if (*Bp == 0 || *Bp == ':')
			return (0);
		Bp++;
	}
}

/*
 * Skip to the next field.  Notice that this is very dumb, not
 * knowing about \: escapes or any such.  If necessary, :'s can be put
 * into the termcap file in octal.
 */
static char *
tskip(char *bp)
{

	while (*bp && *bp != ':')
		bp++;
	if (*bp == ':')
		bp++;
	return (bp);
}

/*
 * Return the (numeric) option id.
 * Numeric options look like
 *	li#80
 * i.e. the option string is separated from the numeric value by
 * a # character.  If the option is not found we return -1.
 * Note that we handle octal numbers beginning with 0.
 */
static int
tgetnum(char *id)
{
	int i, base;
	char *bp = tbuf;

	for (;;) {
		bp = tskip(bp);
		if (*bp == 0)
			return (-1);
		if (*bp++ != id[0] || *bp == 0 || *bp++ != id[1])
			continue;
		if (*bp == '@')
			return(-1);
		if (*bp != '#')
			continue;
		bp++;
		base = 10;
		if (*bp == '0')
			base = 8;
		i = 0;
		while (isdigit(*bp))
			i *= base, i += *bp++ - '0';
		return (i);
	}
}

/*
 * Handle a flag option.
 * Flag options are given "naked", i.e. followed by a : or the end
 * of the buffer.  Return 1 if we find the option, or 0 if it is
 * not given.
 */
int
tgetflag(char *id)
{
	char *bp = tbuf;

	for (;;) {
		bp = tskip(bp);
		if (!*bp)
			return (0);
		if (*bp++ == id[0] && *bp != 0 && *bp++ == id[1]) {
			if (!*bp || *bp == ':')
				return (1);
			else if (*bp == '@')
				return(0);
		}
	}
}

/*
 * Get a string valued option.
 * These are given as
 *	cl=^Z
 * Much decoding is done on the strings, and the strings are
 * placed in area, which is a ref parameter which is updated.
 * No checking on area overflow.
 */
char *
tgetstr(char *id, char **area)
{
	char *bp = tbuf;

	for (;;) {
		bp = tskip(bp);
		if (!*bp)
			return (0);
		if (*bp++ != id[0] || *bp == 0 || *bp++ != id[1])
			continue;
		if (*bp == '@')
			return(0);
		if (*bp != '=')
			continue;
		bp++;
		return (tdecode(bp, area));
	}
}

/*
 * Tdecode does the grung work to decode the
 * string capability escapes.
 */
static char *
tdecode(char *str, char **area)
{
	char *cp;
	int c;
	int i;

	cp = *area;
	while (c = *str++) {
	    if (c == ':' && *(cp-1) != '\\')
		break;
	    *cp++ = c;
	}
	*cp++ = 0;
	str = *area;
	*area = cp;
	return (str);
}
#
# CDDL HEADER START
#
# The contents of this file are subject to the terms of the
# Common Development and Distribution License, Version 1.0 only
# (the "License").  You may not use this file except in compliance
# with the License.
#
# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
# or http://www.opensolaris.org/os/licensing.
# See the License for the specific language governing permissions
# and limitations under the License.
#
# When distributing Covered Code, include this CDDL HEADER in each
# file and include the License file at usr/src/OPENSOLARIS.LICENSE.
# If applicable, add the following below this CDDL HEADER, with the
# fields enclosed by brackets "[]" replaced with your own identifying
# information: Portions Copyright [yyyy] [name of copyright owner]
#
# CDDL HEADER END
#
# ident	"%Z%%M%	%I%	%E% SMI"
#
model|mod|m:\
	:pb=^\d(space\d\p\drep)|(\p\dis|inline|public\dbeginproc):\
	:bb=\dbeginproc|space|case\d:be=\dendproc|end\d|;:\
	:cb=\$:ce=\$|$:sb=":se=":lb=':le=\a|$:\
	:kw=abs and array beginproc boolean by case cdnl char copied dispose\
	div do dynamic else elsif end endproc entry external FALSE false\
	fi file for formal fortran global if iff ift\
	in integer include inline is lbnd\
	max min mod new NIL nil noresult not notin od of or procedure public\
	read readln readonly record recursive rem rep repeat res\
	result return set\
	space string subscript such then TRUE true type ubnd union until\
	varies while width:
pascal|pasc|p:\
	:pb=(^\d?procedure|function|program\d\p\d|\(|;|\:)|(=\d?record\d):\
	:bb=\dcase|begin\d:be=\dend|forward\d|;:\
	:cb={:ce=}:\
	:ab=\(*:ae=*\):\
	:sb=':se=':\
	:kw=and array assert begin case const div do downto else end file for\
	forward function goto if in label mod nil not of or packed procedure\
	program record repeat set then to type until var while with oct hex\
	external:
C|c:\
	:pb=^\d?*?\d?\p\d?\(\a?\)(\d|{):bb={:be=}:cb=/*:ce=*/:sb=":se=\e":lb=':\
	:le=\e':tl:\
	:kw=asm auto break case char continue default do double else enum\
	extern float for fortran goto if int long register return short\
	sizeof static struct switch typedef union unsigned void while #define\
	#else #endif #if #ifdef #ifndef #include #undef # define endif\
	ifdef ifndef include undef defined:
ISP|isp|i:\
	:cb=!:ce=!|$:oc:\
	:kw=and begin decode define end eql eqv geq gtr if leave leq lss mod\
	neq next not or otherwise repeat restart resume sr0 sr1 srd srr sl0 sl1\
	sld slr tst xor:
SH|sh:\
	:pb=(;|^)\d?\p\(\)(\d|{):\
	:ab=\$#:ae=(\d?|\a?):\
	:bb={:be=}:cb=#:ce=$:sb=":se=\e":lb=':\
	:le=\e':tl:\
	:kw=break case cd continue do done \
	elif else esac eval exec exit export \
	fi for if in then while until \
	read readonly set shift test trap umask wait:
CSH|csh:\
	:cb=#:ce=$:sb=":se=\e":lb=':\
	:ab=\$\a?#:ae=(\d?|\a?):\
	:le=\e':tl:\
	:kw=alias alloc break breaksw case cd chdir continue default\
	echo else end endif endsw exec exit foreach \
	glob goto history if logout nice nohup onintr repeat set\
	setenv shift source switch then time \
	while umask unalias unset wait while @ env \
	argv child home ignoreeof noclobber noglob \
	nomatch path prompt shell status verbose :
ldl|LDL:\
	:pb=^\p\::bb=\::be=;:cb=/*:ce=*/:sb=":se=\e":\
	:kw=constant functions grammar reswords tokens add1 addste\
	car cdr check colno cond cons copy defun divide empty enter\
	eq equal findattr firstchild ge getattr getfield gt hash label\
	lambda lastchild le leftsibling lookone lookup lt minus name ne\
	newnode nextcom nil null parent plus precnl prevcom prog progn\
	quote reglob return rightsibling self set setattr setfield setq\
	stjoin sub1 t times tnull tokno ttype:
Icon|icon|I:\
	:pb=^\d?procedure\d\p\d?\(\a?\):\
	:bb=(^\d?procedure\d\p\d?\(\a?\))|{:be=}|(^\d?end\d?$):\
	:cb=#:ce=$:\
	:sb=":se=\e":lb=':le=\e':tl:\
	:kw=break by case create default do dynamic else end every external\
	fail global if initial local next not of procedure record\
	repeat return static suspend then to until using while\
	&ascii &clock &cset &date &dateline &errout &fail &host &input\
	&lcase &level &main &null &output &pos &random &source &subject\
	&time &trace &ucase &version:
ratfor|rat|r:\
	:pb=(subroutine|function)\d\p\d?\(\a?\):\
	:bb=(subroutine|function)\d\p\d?\(\a?\):be=^\d?end:\
	:cb=#:ce=$:\
	:sb=":se=\e":lb=':le=\e':oc:\
	:kw=DRETURN DRIVER arith break case character default define do\
	else elsedef enddef filedes for function goto if ifdef ifelse\
	ifnotdef include incr integer linepointer next opeq pointer\
	real repeat return select string subroutine substr until:
modula2|mod2|m2:\
	:pb=(^\d?(procedure|function|module)\d\p\d|\(|;|\:):\
	:bb=\d(begin|case|for|if|loop|record|repeat|while|with)\d:\
	:be=\dend|;:\
	:cb={:ce=}:\
	:ab=\(*:ae=*\):\
	:sb=":se=":\
	:oc:\
	:kw=and array begin by case const\
	definition div do else elsif end exit export\
	for from if implementation import in\
	loop mod module not of or pointer procedure qualified\
	record repeat return set then to type\
	until var while with:
yacc|Yacc|y:\
	:cb=/*:ce=*/:sb=":se=\e":lb=':le=\e':tl:\
	:kw=%{ %} %% %union %token %type\
	#else #endif #if #ifdef #ifndef #include #undef # define else endif\
	if ifdef ifndef include undef:
C++|c++:\
	:pb=^\d?*?\d?\p\d?\(\a?\)(\d|{):bb={:be=}:cb=/*:ce=*/:ab=//:\
	:ae=$:sb=":se=\e":lb=':\
	:le=\e':tl:\
	:kw=asm auto break case char continue default do double else enum\
	extern float for fortran goto if int long register return short\
	sizeof static struct switch typedef union unsigned while void #define\
	#else #endif #if #ifdef #ifndef #include #undef # define endif\
	ifdef ifndef include undef defined\
	class const delete friend inline new operator overload private\
	protected public virtual:
fortran|FORTRAN|f77|fc|f:\
	:pb=(function|subroutine|program)\d\p\d?\(\a?\):\
	:bb=(function|subroutine|program)\d\p\d?\(\a?\):be=^\dend:\
	:cb=^c:\
	:ce=$:\
	:sb=':\
	:se=':\
	:oc:\
	:kw=call common complex continue dimension do double else elseif\
	end endif equivalence format function\
	goto if include integer \
	parameter precision real return stop subroutine:
#
# This entry makes use of new capabilities added to support the description
# of lisp-like languages (id, pl, and px).  The set of keywords given is a
# matter of taste.  It would be reasonable to add all the wired functions to
# the list.
MLisp|ml|Emacs Mock Lisp:\
	:cb=;:ce=$:lb=':le=\e':sb=":se=\e":bb=\(:be=\):\
	:id=_-$#@./,%&?!^*+~`|;<>'\::\
	:kw=defun if progn while:pl:px=\d\(defun:pb=^\d\(\p($|(\d\a$)):
#
# It's not obvious what constitutes a "procedure definition" in Russell.
# This entry doesn't even try...
russell|Russell:\
	:cb=\(*:ce=*\):kw=cand cor do od if fi else enum record prod union\
	extend export hide with constants let use in ni val var func type\
	field characters readonly:sb=":se=":lb=':le=':