###########################################################################
#
#             Script: cfilt.pl
#
#            Creator: alex@phred.org (Alex Wetmore)
#               Date: Sept 3, 1998
#
#     Basic Overview: A C color filter for C/C++ for use by Vile's perl
#                     mode.  Implements two functions, ColorC (does the
#                     coloring) and ClearColorC (removes coloring).
#
#  Comments/Concerns: Its not very fast.  Takes about 4 seconds to color
#                     a 90k C file on a P2-300.
#
###########################################################################

#
# Suggested bindings for your .vilerc
#
# store-procedure cfilt
# 	perl "require 'cfilt.pl'"
# 	perl ColorC
# ~endm
# bind-key cfilt +
# 
# store-procedure hi
# 	perl "require 'cfilt.pl'"
# 	perl ColorWords
# ~endm
# 
# store-procedure uncfilt
# 	perl "require 'cfilt.pl'"
# 	perl ClearColorC
# ~endm
# 
# store-procedure clear-all-colors
# 	uncfilt
# 	clear-visual-matches
# ~endm
# 
# bind-key clear-all-colors =
#
# This makes + turn on colors, = turn off all coloring (visual matching
# plus what is done by these functions) and :hi highlight regular
# expressions for you
# 

# to enable keyword coloring set this to 1
$fColorKeywords = 0;
if ($fColorKeywords) {
	# this list of keywords is taken from vile-cfilt.pl, written by 
	#            Creator: cavanaug@elwom4.ecn.purdue.edu (John P Cavanaugh)
	$rgKeywords= "void break register short enum extern int for if while struct "
	    . "static long continue switch case char unsigned double float "
	    . "return else default goto do pascal Boolean typedef volatile union "
	    . "auto sizeof size_t new delete class friend protected private "
	    . "public template try catch throw operator const mutable virtual "
	    . "asm inline this and and_eq bitand bitor compl not or or_eq xor "
	    . "xor_eq not_eq wchar_t bool true false static_cast dynamic_cast "
	    . "reinterpret_cast typeid using namespace inherited";
	# mangle the two lists into a portion of a regexp
	$rgKeywords =~ s/ /\\b\|\\b/g;
	# a list of C preprocessor words to highlight
	$rgCPPWords= "#ifdef #ifndef #if #endif #define #include #blah";
	$rgCPPWords =~ s/ /\|/g;
	$rgKeywords = "\\b" . $rgKeywords . "\\b|" . $rgCPPWords;
} else {
	$rgKeywords = "";
}

# regular expressions for the front and end of comment blocks
$rgCommentsPlus = "#if\\s*0|#if[def\\s]*BUGBUG";
$rgCommentsMinus = "#endif";

#
# the colors that we use for highlighting.  If your terminal doesn't support
# color then try the alternates below
#
@attrComments = ("color" => 8);
@attrStrings = ("color" => 14);
@attrKeywords = ("color" => 15);
@attrHighlight = ("color" => 11);

# monochrome alternates
#@attrComments = ("underline");
#@attrStrings = ("reverse");
#@attrKeywords = ("bold");
#@attrHighlight = ("bold");

#
# Remove all attributes on a buffer
#
sub ClearColorC {
    $Vile::current_buffer->set_region(1,'$');
    $Vile::current_buffer->attribute("normal");
}

#
# Colorize C code.  This colors strings, comments, and keywords defined 
# above.
#
sub ColorC {
    my $bufCurrent;                 # the current buffer
    my $fInCommentBlock = 0;        # are we in a comment block?
    my $fInCommentLine = 0;         # are we on a comment line?
    my $fInString = 0;              # are we in a string?
	my $cIfNesting = 0;				# nesting of comment ifdefs
    my @region;                     # the current region
    my $fQuote;                     # is the current region a quote?
    my @rgLines;                    # all of the lines in the current buffer
    my $iLine;                      # index of the current line in @rgLines
    my $cLines;                     # count of lines in @rgLines
    my $szLine;                     # $rgLines[$iLine]
    my $cLine;                      # length($szLine)
    my $cMatch;                     # length($&) (or 1 if the match is a quote)
    my $offset;                     # offset of the match into the line

    $bufCurrent = $Vile::current_buffer;

    # set the working flag
    Vile::working(1);

    # clear all attributes.  this also sets the region to include the 
    # entire file
    ClearColorC;

    # load the entire buffer into an array.  we do this to avoid setting
    # the region to each line that we want, and using <> operator to get
    # each line in turn
    @rgLines = <$Vile::current_buffer>;
    $cLines = scalar(@rgLines);

    # walk each line in turn
    for ($iLine = 0; $iLine < $cLines; $iLine++) {
        $szLine = $rgLines[$iLine];
        $fInCommentLine = 0;
        $cLine = length($szLine);

        @region = ($iLine + 1, 0, $iLine + 1, 0);

        # search for: ", /*, */, //, or a keyword
        while ($szLine =~ m!\\\\\"|[^\\]\"|//|/\*|\*/|\b#if[ndef]\b|\b#endif\b|$rgCommentsPlus|$rgCommentsMinus|$rgKeywords/!go) {
			my $fSetPos = 0;

            # find the offset to it
            $offset = pos($szLine);
            # quotes are a bit of a special case, so see if this is one
            if ($& eq "\\\\\"") {
                $fQuote = 1;
                $cMatch = 1;
	            pos($szLine) = pos($szLine) - 2;
				$fSetPos = 1;
			} elsif (substr($&, 1) eq "\"") {
                $fQuote = 1;
                $cMatch = 1;
	            pos($szLine) = pos($szLine) - 1;
				$fSetPos = 1;
            } else {
                $fQuote = 0;
                $cMatch = length $&;
            }

            # update our region to have everything up to and including the
            # string that our regexp found and set it
            $region[3] = $offset;
            $bufCurrent->set_region(@region);

            # colorize comments and strings
            if ($fInCommentLine || $fInCommentBlock || $cIfNesting > 0) {
                $bufCurrent->attribute(@attrComments);
            } elsif ($fInString) {
                $bufCurrent->attribute(("color" => $colorStrings));
            }

			if (!$fInString) {
	            # check for start of comment
	            if ($& eq "/*") {
	                $fInCommentBlock = 1;
	            } elsif ($& eq "//") {
	                $fInCommentLine = 1;
	                pos($szLine) = $cLine;
					$fSetPos = 1;
	            } elsif ($& =~ /$rgCommentsPlus/o) {
					$cIfNesting++;
				}
			}

            # do other checks
            if (!($fInCommentBlock || $fInCommentLine || $cIfNesting > 0)) {
                # check for start/end of string and for keywords
                if ($fQuote) { 
                    $fInString = !$fInString; 
                } elsif (!$fInString) {
                    $region[3] = $offset;
                    $region[1] = length($`);
                    $bufCurrent->set_region(@region);
                    $bufCurrent->attribute(("color" => $colorKeywords));
                }
            }

            # check for end of comments
			if (!$fInString) {
	            if ($& eq "*/") {
	                $fInCommentBlock = 0; 
	            } elsif ($& =~ /$rgCommentsMinus/o && $cIfNesting > 0) {
					$cIfNesting--;
				}
			}

			if (!$fSetPos) {
	            pos($szLine) = pos($szLine) - $cMatch + 1;
			}

            # our next region will start where this one left off
            $region[1] = $region[3] - $cMatch;
        }

        # if necessary colorize the rest of the line
        if ($fInCommentLine || $fInCommentBlock || $cIfNesting > 0 || $fInString) {
            $region[3] = $cLine;
            $bufCurrent->set_region(@region);
            if ($fInString) {
                $bufCurrent->attribute(("color" => $colorStrings));
            } else {
                $bufCurrent->attribute(@attrComments);
            }
        }   
    }

    # clear the working flag
    Vile::working(0);
}

#
# a function (based on code from the above function) which will color 
# a regular expression throughout the file.   this can be useful when
# reading through code and trying to figure out how one variable is
# used.
#
sub ColorWords {
	$szWord = Vile::mlreply("regexp to highlight: ");

    my $bufCurrent;                 # the current buffer
    my @region;                     # the current region
    my @rgLines;                    # all of the lines in the current buffer
    my $iLine = 0;                  # index of the current line in @rgLines
    my $cLines;                     # count of lines in @rgLines
    my $szLine;                     # $rgLines[$iLine]
    my $offset;                     # offset of the match into the line

    $bufCurrent = $Vile::current_buffer;

    # set the working flag
    Vile::working(1);

    # load the entire buffer into an array.  we do this to avoid setting
    # the region to each line that we want, and using <> operator to get
    # each line in turn
    $bufCurrent->set_region(1,'$');
    @rgLines = <$bufCurrent>;
    $cLines = scalar(@rgLines);

    # walk each line in turn
    for ($iLine = 0; $iLine < $cLines; $iLine++) {
        $szLine = $rgLines[$iLine];

        @region = ($iLine + 1, 0, $iLine + 1, 0);

        # search for our word
        while ($szLine =~ /$szWord/og) {
            # find the offset to it
            $offset = pos($szLine);

			# update the region to contain the word
            $region[3] = $offset;
            $region[1] = length($`);
            $bufCurrent->set_region(@region);
            $bufCurrent->attribute(("color" => $colorHighlight));
        }
    }

    # clear the working flag
    Vile::working(0);
}

1;