Some cleanup:

. correct a typo in regexp.c,
. implement a new "nc" (non-comment) feature to describe exceptions from
  the comment detection; there were problems in Perl with the $# operator
  that could not be solved by any other means,
. prevent blocklevel from becoming negative (due to earlier misdetected
  sequences), this is probably a workaround for the problem described
  in PR # bin/1785,
. update the Perl description to use the "nc" feature,
. update the man page for the "nc" and the undocumented "ab"/"ae"
  features.

4 files changed, 33 insertions, 3 deletions

diff --git a/usr.bin/vgrind/regexp.c b/usr.bin/vgrind/regexp.c
index 2022edb..472b6d4 100644
--- a/usr.bin/vgrind/regexp.c
+++ b/usr.bin/vgrind/regexp.c
@@ -263,7 +263,7 @@ expconv()
 	    OCNT(cs) = ccre - cs;		/* offset to next symbol */
 	    break;
 
-	/* reurn from a recursion */
+	/* return from a recursion */
 	case ')':
 	    if (acs != NIL) {
 		do {
diff --git a/usr.bin/vgrind/vfontedpr.c b/usr.bin/vgrind/vfontedpr.c
index 3be249b..bd153a8 100644
--- a/usr.bin/vgrind/vfontedpr.c
+++ b/usr.bin/vgrind/vfontedpr.c
@@ -117,6 +117,7 @@ char	*l_combeg;		/* string introducing a comment */
 char	*l_comend;		/* string ending a comment */
 char	 l_escape;		/* character used to  escape characters */
 char	*l_keywds[BUFSIZ/2];	/* keyword table address */
+char	*l_nocom;		/* regexp for non-comments */
 char	*l_prcbeg;		/* regular expr for procedure begin */
 char    *l_strbeg;		/* delimiter for string constant */
 char    *l_strend;		/* delimiter for string constant */
@@ -274,6 +275,8 @@ main(argc, argv)
 	l_chrbeg = convexp(cp);
 	cgetustr(defs, "le", &cp);
 	l_chrend = convexp(cp);
+	cgetustr(defs, "nc", &cp);
+	l_nocom = convexp(cp);
 	l_escape = '\\';
 	l_onecase = (cgetcap(defs, "oc", ':') != NULL);
 	l_toplex = (cgetcap(defs, "tl", ':') != NULL);
@@ -358,6 +361,7 @@ putScp(os)
     char *chrptr;			/* end of a character const delimiter */
     char *blksptr;			/* end of a lexical block start */
     char *blkeptr;			/* end of a lexical block end */
+    char *nocomptr;			/* end of a non-comment delimiter */
 
     _start = os;			/* remember the start for expmatch */
     _escaped = FALSE;
@@ -385,6 +389,17 @@ skip:
 	    acmptr = expmatch (s, l_acmbeg, dummy);
 	    strptr = expmatch (s, l_strbeg, dummy);
 	    chrptr = expmatch (s, l_chrbeg, dummy);
+	    nocomptr = expmatch (s, l_nocom, dummy);
+
+	    /* start of non-comment? */
+	    if (nocomptr != NIL)
+		if ((nocomptr <= comptr || comptr == NIL)
+		  && (nocomptr <= acmptr || acmptr == NIL)) {
+		    /* continue after non-comment */
+		    putKcp (s, nocomptr-1, FALSE);
+		    s = nocomptr;
+		    continue;
+		}
 
 	    /* start of a comment? */
 	    if (comptr != NIL)
@@ -445,7 +460,8 @@ skip:
 		if (blkeptr < blksptr || blksptr == NIL) {
 		    putKcp (s, blkeptr - 1, FALSE);
 		    s = blkeptr;
-		    blklevel--;
+		    if (blklevel > 0 /* sanity */)
+			    blklevel--;
 		    if (psptr >= 0 && plstack[psptr] >= blklevel) {
 
 			/* end of current procedure */
@@ -619,6 +635,9 @@ putcp(c)
 	case '\f':
 		break;
 
+	case '\r':
+		break;
+
 	case '{':
 		ps("\\*(+K{\\*(-K");
 		break;
diff --git a/usr.bin/vgrind/vgrindefs.5 b/usr.bin/vgrind/vgrindefs.5
index 4ac7522..c2060a2 100644
--- a/usr.bin/vgrind/vgrindefs.5
+++ b/usr.bin/vgrind/vgrindefs.5
@@ -54,6 +54,8 @@ The following table names and describes each field.
 .Pp
 .Bl -column Namexxx Tpexxx
 .Sy Name	Type	Description
+.It "ab	str	regular expression for the start of an alternate comment"
+.It "ae	str	regular expression for the end of an alternate comment"
 .It "pb	str	regular expression for start of a procedure"
 .It "bb	str	regular expression for start of a lexical block"
 .It "be	str	regular expression for the end of a lexical block"
@@ -63,11 +65,20 @@ The following table names and describes each field.
 .It "se	str	regular expression for the end of a string"
 .It "lb	str	regular expression for the start of a character constant"
 .It "le	str	regular expression for the end of a character constant"
+.It "nc	str	regular expression for a non-comment (see below)"
 .It "tl	bool	present means procedures are only defined at the top lexical level"
 .It "oc	bool	present means upper and lower case are equivalent"
 .It "kw	str	a list of keywords separated by spaces"
 .El
 .Pp
+Non-comments are required to describe a certain context where a
+sequence that would normally start a comment loses its special
+meaning.  A typical example for this can be found in Perl, where
+comments are normally starting with
+.Ql # ,
+while the string
+.Ql $#
+is an operator on an array.
 .Sh EXAMPLES
 The following entry, which describes the C language, is 
 typical of a language entry.
diff --git a/usr.bin/vgrind/vgrindefs.src b/usr.bin/vgrind/vgrindefs.src
index becf773..a5e12ee 100644
--- a/usr.bin/vgrind/vgrindefs.src
+++ b/usr.bin/vgrind/vgrindefs.src
@@ -150,7 +150,7 @@ C++|c++:\
 #   &packagename'function;
 #
 Perl|perl|pl:\
-	:pb=sub\d\p\d:bb={:be=}:cb=#:ce=$:tl:\
+	:pb=sub\d\p\d:bb={:be=}:cb=#:ce=$:nc=\$#:tl:\
 	:ab=&:ae=(;|\d|,):\
 	:sb=":se=(\e"|$):lb=':le=(\e'|$):\
 	:kw=do if unless while until else elsif for foreach continue\