vfontedpr.c revision 7c478bd95313f5f23a4c958a745db2134aa03244
1/*
2 * Copyright (c) 1980 Regents of the University of California.
3 * All rights reserved.  The Berkeley software License Agreement
4 * specifies the terms and conditions for redistribution.
5 */
6
7#pragma ident	"%Z%%M%	%I%	%E% SMI"
8
9#include <ctype.h>
10#include <stdio.h>
11#include <sys/types.h>
12#include <sys/stat.h>
13#include <locale.h>
14#include <euc.h>
15#include <stdlib.h>
16
17#define boolean int
18#define TRUE 1
19#define FALSE 0
20#define NIL 0
21#define STANDARD 0
22#define ALTERNATE 1
23
24/*
25 * Vfontedpr.
26 *
27 * Dave Presotto 1/12/81 (adapted from an earlier version by Bill Joy)
28 *
29 */
30
31#define STRLEN 10		/* length of strings introducing things */
32#define PNAMELEN 40		/* length of a function/procedure name */
33#define PSMAX 20		/* size of procedure name stacking */
34
35/* regular expression routines */
36
37char	*expmatch();		/* match a string to an expression */
38char	*STRNCMP();		/* a different kind of strncmp */
39char	*convexp();		/* convert expression to internal form */
40
41char	*tgetstr();		/* extract a string-valued capability */
42boolean	isproc();
43char	*ctime();
44char	*strchr();
45
46/*
47 *	The state variables
48 */
49
50boolean	incomm;			/* in a comment of the primary type */
51boolean	instr;			/* in a string constant */
52boolean	inchr;			/* in a string constant */
53boolean	nokeyw = FALSE;		/* no keywords being flagged */
54boolean	doindex = FALSE;	/* form an index */
55boolean twocol = FALSE;		/* in two-column mode */
56boolean	filter = FALSE;		/* act as a filter (like eqn) */
57boolean	pass = FALSE;		/* when acting as a filter, pass indicates
58				 * whether we are currently processing
59				 * input.
60				 */
61boolean	prccont;		/* continue last procedure */
62int	comtype;		/* type of comment */
63int	margin;
64int	psptr;			/* the stack index of the current procedure */
65char	pstack[PSMAX][PNAMELEN+1];	/* the procedure name stack */
66int	plstack[PSMAX];		/* the procedure nesting level stack */
67int	blklevel;		/* current nesting level */
68int	prclevel;		/* nesting level at which procedure definitions
69				   may be found, -1 if none currently valid
70				   (meaningful only if l_prclevel is true) */
71char	*defsfile = "/usr/lib/vgrindefs";	/* name of language definitions file */
72char	pname[BUFSIZ+1];
73
74/*
75 *	The language specific globals
76 */
77
78char	*language = "c";	/* the language indicator */
79char	*l_keywds[BUFSIZ/2];	/* keyword table address */
80char	*l_prcbeg;		/* regular expr for procedure begin */
81char	*l_combeg;		/* string introducing a comment */
82char	*l_comend;		/* string ending a comment */
83char	*l_acmbeg;		/* string introducing a comment */
84char	*l_acmend;		/* string ending a comment */
85char	*l_blkbeg;		/* string begining of a block */
86char	*l_blkend;		/* string ending a block */
87char	*l_strbeg;		/* delimiter for string constant */
88char	*l_strend;		/* delimiter for string constant */
89char	*l_chrbeg;		/* delimiter for character constant */
90char	*l_chrend;		/* delimiter for character constant */
91char	*l_prcenable;		/* re indicating that procedure definitions
92				   can be found in the next lexical level --
93				   kludge for lisp-like languages that use
94				   something like
95					   (defun (proc ...)
96					  	(proc ...)
97					   )
98				   to define procedures */
99char	l_escape;		/* character used to  escape characters */
100boolean	l_toplex;		/* procedures only defined at top lex level */
101boolean l_prclevel;		/* procedure definitions valid only within
102				   the nesting level indicated by the px
103				   (l_prcenable) capability */
104
105/*
106 *  for the benefit of die-hards who aren't convinced that tabs
107 *  occur every eight columns
108 */
109short tabsize = 8;
110
111/*
112 *  global variables also used by expmatch
113 */
114boolean	_escaped;		/* if last character was an escape */
115char	*Start;			/* start of the current string */
116boolean	l_onecase;		/* upper and lower case are equivalent */
117char	*l_idchars;		/* characters legal in identifiers in addition
118				   to letters and digits (default "_") */
119
120/*
121 * The code below emits troff macros and directives that consume part of the
122 * troff macro and register space.  See tmac.vgrind for an enumeration of
123 * these macros and registers.
124 */
125
126main(argc, argv)
127    int argc;
128    char *argv[];
129{
130    FILE *in;
131    char *fname;
132    struct stat stbuf;
133    char buf[BUFSIZ];
134    char idbuf[256];	/* enough for all 8 bit chars */
135    char strings[2 * BUFSIZ];
136    char defs[2 * BUFSIZ];
137    int needbp = 0;
138    int i;
139    char *cp;
140
141	(void) setlocale(LC_ALL, "");
142#if !defined(TEXT_DOMAIN)
143#define	TEXT_DOMAIN	"SYS_TEST"
144#endif
145	(void) textdomain(TEXT_DOMAIN);
146
147    /*
148     * Dump the name by which we were invoked.
149     */
150    argc--, argv++;
151
152    /*
153     * Process arguments.  For the sake of compatibility with older versions
154     * of the program, the syntax accepted below is very idiosyncratic.  Some
155     * options require space between the option and its argument; others
156     * disallow it.  No options may be bundled together.
157     *
158     * Actually, there is one incompatibility.  Files and options formerly
159     * could be arbitrarily intermixed, but this is no longer allowed.  (This
160     * possiblity was never documented.)
161     */
162    while (argc > 0 && *argv[0] == '-') {
163	switch (*(cp = argv[0] + 1)) {
164
165	case '\0':				/* - */
166	    /* Take input from stdin. */
167	    /*
168	     * This option implies the end of the flag arguments.  Leave the
169	     * "-" in place for the file processing code to see.
170	     */
171	    goto flagsdone;
172
173	case '2':				/* -2 */
174	    /* Enter two column mode. */
175	    twocol = 1;
176	    printf("'nr =2 1\n");
177	    break;
178
179	case 'd':				/* -d <defs-file> */
180	    /* Specify the language description file. */
181	    defsfile = argv[1];
182	    argc--, argv++;
183	    break;
184
185	case 'f':				/* -f */
186	    /* Act as a filter like eqn. */
187	    filter = 1;
188	    /*
189	     * Slide remaining arguments down one position and postpend "-",
190	     * to force reading from stdin.
191	     */
192	    for (i = 0; i < argc - 1; i++)
193		argv[i] = argv[i + 1];
194	    argv[argc - 1] = "-";
195	    continue;
196
197	case 'h':				/* -h [header] */
198	    /* Specify header string. */
199	    if (argc == 1) {
200		printf("'ds =H\n");
201		break;
202	    }
203	    printf("'ds =H %s\n", argv[1]);
204	    argc--, argv++;
205	    break;
206
207	case 'l':				/* -l<language> */
208	    /* Specify the language. */
209	    language = cp + 1;
210	    break;
211
212	case 'n':				/* -n */
213	    /* Indicate no keywords. */
214	    nokeyw = 1;
215	    break;
216
217	case 's':				/* -s<size> */
218	    /* Specify the font size. */
219	    i = 0;
220	    cp++;
221	    while (*cp)
222		i = i * 10 + (*cp++ - '0');
223	    printf("'nr vP %d\n", i);
224	    break;
225
226	case 't':				/* -t */
227	    /* Specify a nondefault tab size. */
228	    tabsize = 4;
229	    break;
230
231	case 'x':				/* -x */
232	    /* Build an index. */
233	    doindex = 1;
234	    /* This option implies "-n" as well; turn it on. */
235	    argv[0] = "-n";
236	    continue;
237	}
238
239	/* Advance to next argument. */
240	argc--, argv++;
241    }
242
243flagsdone:
244
245    /*
246     * Get the language definition from the defs file.
247     */
248    i = tgetent (defs, language, defsfile);
249    if (i == 0) {
250	fprintf (stderr, gettext("no entry for language %s\n"), language);
251	exit (0);
252    } else  if (i < 0) {
253	fprintf (stderr,  gettext("cannot find vgrindefs file %s\n"), defsfile);
254	exit (0);
255    }
256    cp = strings;
257    if (tgetstr ("kw", &cp) == NIL)
258	nokeyw = TRUE;
259    else  {
260	char **cpp;
261
262	cpp = l_keywds;
263	cp = strings;
264	while (*cp) {
265	    while (*cp == ' ' || *cp =='\t')
266		*cp++ = NULL;
267	    if (*cp)
268		*cpp++ = cp;
269	    while (*cp != ' ' && *cp  != '\t' && *cp)
270		cp++;
271	}
272	*cpp = NIL;
273    }
274    cp = buf;
275    l_prcbeg = convexp (tgetstr ("pb", &cp));
276    cp = buf;
277    l_combeg = convexp (tgetstr ("cb", &cp));
278    cp = buf;
279    l_comend = convexp (tgetstr ("ce", &cp));
280    cp = buf;
281    l_acmbeg = convexp (tgetstr ("ab", &cp));
282    cp = buf;
283    l_acmend = convexp (tgetstr ("ae", &cp));
284    cp = buf;
285    l_strbeg = convexp (tgetstr ("sb", &cp));
286    cp = buf;
287    l_strend = convexp (tgetstr ("se", &cp));
288    cp = buf;
289    l_blkbeg = convexp (tgetstr ("bb", &cp));
290    cp = buf;
291    l_blkend = convexp (tgetstr ("be", &cp));
292    cp = buf;
293    l_chrbeg = convexp (tgetstr ("lb", &cp));
294    cp = buf;
295    l_chrend = convexp (tgetstr ("le", &cp));
296    cp = buf;
297    l_prcenable = convexp (tgetstr ("px", &cp));
298    cp = idbuf;
299    l_idchars = tgetstr ("id", &cp);
300    /* Set default, for compatibility with old version */
301    if (l_idchars == NIL)
302	l_idchars = "_";
303    l_escape = '\\';
304    l_onecase = tgetflag ("oc");
305    l_toplex = tgetflag ("tl");
306    l_prclevel = tgetflag ("pl");
307
308    /*
309     * Emit a call to the initialization macro.  If not in filter mode, emit a
310     * call to the vS macro, so that tmac.vgrind can uniformly assume that all
311     * program input is bracketed with vS-vE pairs.
312     */
313    printf("'vI\n");
314    if (!filter)
315	printf("'vS\n");
316
317    if (doindex) {
318	/*
319	 * XXX:	Hard-wired spacing information.  This should probably turn
320	 *	into the emission of a macro invocation, so that tmac.vgrind
321	 *	can make up its own mind about what spacing is appropriate.
322	 */
323	if (twocol)
324	    printf("'ta 2.5i 2.75i 4.0iR\n'in .25i\n");
325	else
326	    printf("'ta 4i 4.25i 5.5iR\n'in .5i\n");
327    }
328
329    while (argc > 0) {
330	if (strcmp(argv[0], "-") == 0) {
331	    /* Embed an instance of the original stdin. */
332	    in = fdopen(fileno(stdin), "r");
333	    fname = "";
334	} else {
335	    /* Open the file for input. */
336	    if ((in = fopen(argv[0], "r")) == NULL) {
337		perror(argv[0]);
338		exit(1);
339	    }
340	    fname = argv[0];
341	}
342	argc--, argv++;
343
344	/*
345	 * Reinitialize for the current file.
346	 */
347	incomm = FALSE;
348	instr = FALSE;
349	inchr = FALSE;
350	_escaped = FALSE;
351	blklevel = 0;
352	prclevel = -1;
353	for (psptr=0; psptr<PSMAX; psptr++) {
354	    pstack[psptr][0] = NULL;
355	    plstack[psptr] = 0;
356	}
357	psptr = -1;
358	printf("'-F\n");
359	if (!filter) {
360	    char *cp;
361
362	    printf(".ds =F %s\n", fname);
363	    if (needbp) {
364		needbp = 0;
365		printf(".()\n");
366		printf(".bp\n");
367	    }
368	    fstat(fileno(in), &stbuf);
369	    cp = ctime(&stbuf.st_mtime);
370	    cp[16] = '\0';
371	    cp[24] = '\0';
372	    printf(".ds =M %s %s\n", cp+4, cp+20);
373	    printf("'wh 0 vH\n");
374	    printf("'wh -1i vF\n");
375	}
376	if (needbp && filter) {
377	    needbp = 0;
378	    printf(".()\n");
379	    printf(".bp\n");
380	}
381
382	/*
383	 *	MAIN LOOP!!!
384	 */
385	while (fgets(buf, sizeof buf, in) != NULL) {
386	    if (buf[0] == '\f') {
387		printf(".bp\n");
388	    }
389	    if (buf[0] == '.') {
390		printf("%s", buf);
391		if (!strncmp (buf+1, "vS", 2))
392		    pass = TRUE;
393		if (!strncmp (buf+1, "vE", 2))
394		    pass = FALSE;
395		continue;
396	    }
397	    prccont = FALSE;
398	    if (!filter || pass)
399		putScp(buf);
400	    else
401		printf("%s", buf);
402	    if (prccont && (psptr >= 0))
403		printf("'FC %s\n", pstack[psptr]);
404#ifdef DEBUG
405	    printf ("com %o str %o chr %o ptr %d\n", incomm, instr, inchr, psptr);
406#endif
407	    margin = 0;
408	}
409
410	needbp = 1;
411	(void) fclose(in);
412    }
413
414    /* Close off the vS-vE pair. */
415    if (!filter)
416	printf("'vE\n");
417
418    exit(0);
419    /* NOTREACHED */
420}
421
422#define isidchr(c) (isalnum(c) || ((c) != NIL && strchr(l_idchars, (c)) != NIL))
423
424putScp(os)
425    char *os;
426{
427    register char *s = os;		/* pointer to unmatched string */
428    char dummy[BUFSIZ];			/* dummy to be used by expmatch */
429    char *comptr;			/* end of a comment delimiter */
430    char *acmptr;			/* end of a comment delimiter */
431    char *strptr;			/* end of a string delimiter */
432    char *chrptr;			/* end of a character const delimiter */
433    char *blksptr;			/* end of a lexical block start */
434    char *blkeptr;			/* end of a lexical block end */
435
436    Start = os;			/* remember the start for expmatch */
437    _escaped = FALSE;
438    if (nokeyw || incomm || instr)
439	goto skip;
440    if (isproc(s)) {
441	printf("'FN %s\n", pname);
442	if (psptr < PSMAX-1) {
443	    ++psptr;
444	    strncpy (pstack[psptr], pname, PNAMELEN);
445	    pstack[psptr][PNAMELEN] = NULL;
446	    plstack[psptr] = blklevel;
447	}
448    }
449    /*
450     * if l_prclevel is set, check to see whether this lexical level
451     * is one immediately below which procedure definitions are allowed.
452     */
453    if (l_prclevel && !incomm && !instr && !inchr) {
454	if (expmatch (s, l_prcenable, dummy) != NIL)
455	    prclevel = blklevel + 1;
456    }
457skip:
458    do {
459	/* check for string, comment, blockstart, etc */
460	if (!incomm && !instr && !inchr) {
461
462	    blkeptr = expmatch (s, l_blkend, dummy);
463	    blksptr = expmatch (s, l_blkbeg, dummy);
464	    comptr = expmatch (s, l_combeg, dummy);
465	    acmptr = expmatch (s, l_acmbeg, dummy);
466	    strptr = expmatch (s, l_strbeg, dummy);
467	    chrptr = expmatch (s, l_chrbeg, dummy);
468
469	    /* start of a comment? */
470	    if (comptr != NIL)
471		if ((comptr < strptr || strptr == NIL)
472		  && (comptr < acmptr || acmptr == NIL)
473		  && (comptr < chrptr || chrptr == NIL)
474		  && (comptr < blksptr || blksptr == NIL)
475		  && (comptr < blkeptr || blkeptr == NIL)) {
476		    putKcp (s, comptr-1, FALSE);
477		    s = comptr;
478		    incomm = TRUE;
479		    comtype = STANDARD;
480		    if (s != os)
481			printf ("\\c");
482		    printf ("\\c\n'+C\n");
483		    continue;
484		}
485
486	    /* start of a comment? */
487	    if (acmptr != NIL)
488		if ((acmptr < strptr || strptr == NIL)
489		  && (acmptr < chrptr || chrptr == NIL)
490		  && (acmptr < blksptr || blksptr == NIL)
491		  && (acmptr < blkeptr || blkeptr == NIL)) {
492		    putKcp (s, acmptr-1, FALSE);
493		    s = acmptr;
494		    incomm = TRUE;
495		    comtype = ALTERNATE;
496		    if (s != os)
497			printf ("\\c");
498		    printf ("\\c\n'+C\n");
499		    continue;
500		}
501
502	    /* start of a string? */
503	    if (strptr != NIL)
504		if ((strptr < chrptr || chrptr == NIL)
505		  && (strptr < blksptr || blksptr == NIL)
506		  && (strptr < blkeptr || blkeptr == NIL)) {
507		    putKcp (s, strptr-1, FALSE);
508		    s = strptr;
509		    instr = TRUE;
510		    continue;
511		}
512
513	    /* start of a character string? */
514	    if (chrptr != NIL)
515		if ((chrptr < blksptr || blksptr == NIL)
516		  && (chrptr < blkeptr || blkeptr == NIL)) {
517		    putKcp (s, chrptr-1, FALSE);
518		    s = chrptr;
519		    inchr = TRUE;
520		    continue;
521		}
522
523	    /* end of a lexical block */
524	    if (blkeptr != NIL) {
525		if (blkeptr < blksptr || blksptr == NIL) {
526		    /* reset prclevel if necessary */
527		    if (l_prclevel && prclevel == blklevel)
528			prclevel = -1;
529		    putKcp (s, blkeptr - 1, FALSE);
530		    s = blkeptr;
531		    blklevel--;
532		    if (psptr >= 0 && plstack[psptr] >= blklevel) {
533
534			/* end of current procedure */
535			if (s != os)
536			    printf ("\\c");
537			printf ("\\c\n'-F\n");
538			blklevel = plstack[psptr];
539
540			/* see if we should print the last proc name */
541			if (--psptr >= 0)
542			    prccont = TRUE;
543			else
544			    psptr = -1;
545		    }
546		    continue;
547		}
548	    }
549
550	    /* start of a lexical block */
551	    if (blksptr != NIL) {
552		putKcp (s, blksptr - 1, FALSE);
553		s = blksptr;
554		blklevel++;
555		continue;
556	    }
557
558	/* check for end of comment */
559	} else if (incomm) {
560	    comptr = expmatch (s, l_comend, dummy);
561	    acmptr = expmatch (s, l_acmend, dummy);
562	    if (((comtype == STANDARD) && (comptr != NIL)) ||
563	        ((comtype == ALTERNATE) && (acmptr != NIL))) {
564		if (comtype == STANDARD) {
565		    putKcp (s, comptr-1, TRUE);
566		    s = comptr;
567		} else {
568		    putKcp (s, acmptr-1, TRUE);
569		    s = acmptr;
570		}
571		incomm = FALSE;
572		printf("\\c\n'-C\n");
573		continue;
574	    } else {
575		putKcp (s, s + strlen(s) -1, TRUE);
576		s = s + strlen(s);
577		continue;
578	    }
579
580	/* check for end of string */
581	} else if (instr) {
582	    if ((strptr = expmatch (s, l_strend, dummy)) != NIL) {
583		putKcp (s, strptr-1, TRUE);
584		s = strptr;
585		instr = FALSE;
586		continue;
587	    } else {
588		putKcp (s, s+strlen(s)-1, TRUE);
589		s = s + strlen(s);
590		continue;
591	    }
592
593	/* check for end of character string */
594	} else if (inchr) {
595	    if ((chrptr = expmatch (s, l_chrend, dummy)) != NIL) {
596		putKcp (s, chrptr-1, TRUE);
597		s = chrptr;
598		inchr = FALSE;
599		continue;
600	    } else {
601		putKcp (s, s+strlen(s)-1, TRUE);
602		s = s + strlen(s);
603		continue;
604	    }
605	}
606
607	/* print out the line */
608	putKcp (s, s + strlen(s) -1, FALSE);
609	s = s + strlen(s);
610    } while (*s);
611}
612
613putKcp (start, end, force)
614    char	*start;		/* start of string to write */
615    char	*end;		/* end of string to write */
616    boolean	force;		/* true if we should force nokeyw */
617{
618    int i;
619    int xfld = 0;
620
621    while (start <= end) {
622	if (doindex) {
623	    if (*start == ' ' || *start == '\t') {
624		if (xfld == 0)
625		    printf("");
626		printf("\t");
627		xfld = 1;
628		while (*start == ' ' || *start == '\t')
629		    start++;
630		continue;
631	    }
632	}
633
634	/* take care of nice tab stops */
635	if (*start == '\t') {
636	    while (*start == '\t')
637		start++;
638	    i = tabs(Start, start) - margin / tabsize;
639	    printf ("\\h'|%dn'",
640		    i * (tabsize == 4 ? 5 : 10) + 1 - margin % tabsize);
641	    continue;
642	}
643
644	if (!nokeyw && !force)
645	    if (  (*start == '#'   ||  isidchr(*start))
646	       && (start == Start || !isidchr(start[-1]))
647	       ) {
648		i = iskw(start);
649		if (i > 0) {
650		    printf("\\*(+K");
651		    do
652			putcp(*start++);
653		    while (--i > 0);
654		    printf("\\*(-K");
655		    continue;
656		}
657	    }
658
659	putcp (*start++);
660    }
661}
662
663
664tabs(s, os)
665    char *s, *os;
666{
667
668    return (width(s, os) / tabsize);
669}
670
671width(s, os)
672	register char *s, *os;
673{
674	register int i = 0;
675	unsigned char c;
676	int n;
677
678	while (s < os) {
679		if (*s == '\t') {
680			i = (i + tabsize) &~ (tabsize-1);
681			s++;
682			continue;
683		}
684		c = *(unsigned char *)s;
685		if (c < ' ')
686			i += 2, s++;
687		else if (c >= 0200) {
688			if ((n = mblen(s, MB_CUR_MAX)) > 0) {
689				i += csetcol(csetno(c));
690				s += n;
691			} else
692				s++;
693		} else
694			i++, s++;
695	}
696	return (i);
697}
698
699putcp(c)
700	register int c;
701{
702
703	switch(c) {
704
705	case 0:
706		break;
707
708	case '\f':
709		break;
710
711	case '{':
712		printf("\\*(+K{\\*(-K");
713		break;
714
715	case '}':
716		printf("\\*(+K}\\*(-K");
717		break;
718
719	case '\\':
720		printf("\\e");
721		break;
722
723	case '_':
724		printf("\\*_");
725		break;
726
727	case '-':
728		printf("\\*-");
729		break;
730
731		/*
732		 * The following two cases deal with the accent characters.
733		 * If they're part of a comment, we assume that they're part
734		 * of running text and hand them to troff as regular quote
735		 * characters.  Otherwise, we assume they're being used as
736		 * special characters (e.g., string delimiters) and arrange
737		 * for troff to render them as accents.  This is an imperfect
738		 * heuristic that produces slightly better appearance than the
739		 * former behavior of unconditionally rendering the characters
740		 * as accents.  (See bug 1040343.)
741		 */
742
743	case '`':
744		if (incomm)
745			printf("`");
746		else
747			printf("\\`");
748		break;
749
750	case '\'':
751		if (incomm)
752			printf("'");
753		else
754			printf("\\'");
755		break;
756
757	case '.':
758		printf("\\&.");
759		break;
760
761		/*
762		 * The following two cases contain special hacking
763		 * to make C-style comments line up.  The tests aren't
764		 * really adequate; they lead to grotesqueries such
765		 * as italicized multiplication and division operators.
766		 * However, the obvious test (!incomm) doesn't work,
767		 * because incomm isn't set until after we've put out
768		 * the comment-begin characters.  The real problem is
769		 * that expmatch() doesn't give us enough information.
770		 */
771
772	case '*':
773		if (instr || inchr)
774			printf("*");
775		else
776			printf("\\f2*\\fP");
777		break;
778
779	case '/':
780		if (instr || inchr)
781			printf("/");
782		else
783			printf("\\f2\\h'\\w' 'u-\\w'/'u'/\\fP");
784		break;
785
786	default:
787		if (c < 040)
788			putchar('^'), c |= '@';
789	case '\t':
790	case '\n':
791		putchar(c);
792	}
793}
794
795/*
796 *	look for a process beginning on this line
797 */
798boolean
799isproc(s)
800    char *s;
801{
802    pname[0] = NULL;
803    if (l_prclevel ? (prclevel == blklevel) : (!l_toplex || blklevel == 0))
804	if (expmatch (s, l_prcbeg, pname) != NIL) {
805	    return (TRUE);
806	}
807    return (FALSE);
808}
809
810
811/*
812 * iskw - check to see if the next word is a keyword
813 *	Return its length if it is or 0 if it isn't.
814 */
815
816iskw(s)
817	register char *s;
818{
819	register char **ss = l_keywds;
820	register int i = 1;
821	register char *cp = s;
822
823	/* Get token length. */
824	while (++cp, isidchr(*cp))
825		i++;
826
827	while (cp = *ss++) {
828		if (!STRNCMP(s,cp,i) && !isidchr(cp[i]))
829			return (i);
830	}
831	return (0);
832}
833