# lgrind.perl by <Axel.Belinfante@cs.utwente.nl>
# a (currently partial) implementation of lgrind.sty
#
#     $Id: lgrind.perl,v 1.1 2001/03/17 23:29:03 RRM Exp $
#
# About lgrind:
#
#     lgrind - grind nice program listings using LaTeX
#
#     Lgrind  formats  program  sources  in  a  nice  style  using
#     (La)TeX(1).   Comments are placed in roman, keywords in bold
#     face, variables in italics, and strings in typewriter  font.
#     Source  file  line numbers appear in the right margin (every
#     10 lines).
#
#     Lgrind processes its input file(s) and writes the result  to
#     standard  output.   This output can be saved for later edit-
#     ting, inclusion in a larger document, etc.
#

package main;

# set to 1 to enable lots up debugging output
$debug = 0;
 
# our markers to indicate where tabs are.
# we insert these markers when we process a tab.
# we only process the markers in the macro for the complete line (L)
$lgrind_tab_start = '<tex2html_tab_mark';
$lgrind_tab_end = '>';

sub do_cmd_lgrindfile {
    local($outer) = @_;
    local($_);
    
    $outer =~ s/$next_pair_pr_rx//o;
    local($file) = $2;
    $file .= ".tex" unless $file =~ /\.tex$/;

    print "\n".'lgrindfile: '.$file."\n";

    foreach $dir ("$texfilepath", split(/:/,$ENV{'TEXINPUTS'})) { 
	if (-f ($_ = "$dir/$file")) {
	    #overread $_ with file contents
	    &slurp_input($_);
	    last;
	}
    }
    print "LgrindFileOrig: {\n$_\n}\n" if $debug;
    
    # handle (some of) the special characters that lgrind generates:
    # (for a few we defined commands do_cmd_..., see below)
    # first, we have translate underscores back to spaces,
    # but don't destroy the 'real' (escaped) underscores (\_)
    s/\\_/\001/g;
    s/_/ /g;
    s/\001/\\_/g;
    # now, protect quotes
    # (if we defined commands for them, we could process
    #  them depending on context, and try to map " to `` and ''
    #  (as the lgrind.sty does))
    s/\\'/'/g;
    s/\\"/"/g;
    # now, get rid of \! (it is used to insert minispaces)
    # (we probably also should remove \,)
    s/\\!//g;
    # now, protect lt and gt:
    s/\\</</g;
    s/\\>/>/g;
    # now, protect hyphens:
    s/\\-/-/g;
    # protext 'empty' lines
    s/\\L{\\LB{[ ]*}}/\\L{\\LB{\\\\}}/g;

    # now, pre_process file contents
    &pre_process;

    print "LgrindFileProc: {\n$_\n}\n" if $debug;
    
    $result = &translate_commands($_);

	# get rid of newline at start of output, to get the HTML comment
	# that is/will be produced by the File macro on the same line
	# as the <PRE><HR>
    $result =~ s/^\n//;
	
    join('','<PRE><HR>',$result,'<HR></PRE>',$outer);
}

# process the file/date information
sub do_cmd_File {
    local($outer) = @_;
    local($_);
    
    $outer =~ s/$next_pair_pr_rx//o;
    local($file) = $2;

    $outer =~ s/^,//o;
    $outer =~ s/$next_pair_pr_rx//o;
    local($time) = $2;

    $outer =~ s/^,//o;
    $outer =~ s/$next_pair_pr_rx//o;
    local($date) = $2;

    print "File: $file\n{\n$outer\n}\n" if $debug;

    join('', "<!--lgrindfile: $file $time $date-->",$outer);
}

# process a line (which contains recursive macro's for the line 'parts')
sub do_cmd_L {
    local($outer) = @_;
    local($_);
    
    $outer =~ s/$next_pair_pr_rx//o;
    local($line) = $2;

    # now, change || back to |
    # (for one reason or another '|' from the input gets duplicated)
    $line =~ s/\|\|/|/g;
    
    print "LineOrg : $line\n" if $debug;

    # now work on the tab marks.
    # we loop through the line looking for our tab markers (which contain
    # each a number: the tab position).
    # when found, then we compute the length of the line to the
    # left of the mark (not counting markup, and counting &bla; as 1 char)
    # we insert the 'right' number of spaces such that
    # (begin-of-line + added spaces == tab-position-number)
    # (Actually, we don't change the line, but build a copy of it)
    local($linecopy, $before, $special);
    while ($line =~ /$lgrind_tab_start(\d+)$lgrind_tab_end/ ) {
		$before = $`; $special = $&; $line = $'; $tab = $1;
    	print "LineTab: ($before)($special)($tab)($line)\n" if $debug;
		$linecopy .= $before;
		$linecopy .= &addblanks(&stripped_length($linecopy), $tab);
    }
    # add last part of the line
    $linecopy .= $line;

    print "LineCopy: $linecopy\n" if $debug;
    
    join('', $linecopy, $outer);
}

# return a string containing (l2 - l1) spaces
# (returns empty string if l2 <= l1)
sub addblanks {
	local($l1, $l2) = @_;
    local($_);
	local($result) = '';
	while ($l2 > $l1) {
		$result .= ' ';
		$l1++;
	}
    print "AddBlanks: ($l1, $l2) -> ($result)\n" if $debug;
	$result;
}

# get the length of the string without counting (HTML) formatting commands,
# and counting each [&;]bla; item as a single character.
# We need this line-up tab-stop positions.
sub stripped_length {
	local($line) = @_;
    local($_);
	local($result) = 0;
	$line =~ s/<[^>]+>//g;
	$line =~ s/[\&\;]SPM[^\;]+;/A/g;
	$result = length($line);
    print "simple_length: ($line) -> ($result)\n" if $debug;
    $result;
}

# process start of a line
sub do_cmd_LB {
    local($outer) = @_;
    local($_);
    
    $outer =~ s/$next_pair_pr_rx//o;
    local($start) = $2;
    print "LB: $start\n{\n$outer\n}\n" if $debug;

    join('', $start, $outer);
}

# process a keyword
sub do_cmd_K {
    local($outer) = @_;
    local($_);
    
    $outer =~ s/$next_pair_pr_rx//o;
    local($keyword) = $2;
    print "K: $keyword\n{\n$outer\n}\n" if $debug;

    join('',"<B>$keyword</B>", $outer);
}

# process a variable
sub do_cmd_V {
    local($outer) = @_;
    local($_);
    
    $outer =~ s/$next_pair_pr_rx//o;
    local($var) = $2;
    print "V: $id\n{\n$outer\n}\n" if $debug;

    join('',"$var", $outer);
}

# tab postition at given (argument) position
sub do_cmd_Tab {
    local($outer) = @_;
    local($_);
    
    $outer =~ s/$next_pair_pr_rx//o;
    local($tab) = $2;
    print "Tab: $tab\n" if $debug;

    join('',"$lgrind_tab_start$tab$lgrind_tab_end", $outer);
}

# start of comment
sub do_cmd_C {
    local($outer) = @_;
    local($_);
    
    $outer =~ s/$next_pair_pr_rx//o;
    local($ignored) = $2;
    print "C: $ignored\n" if $debug;

    join('',"<I>", $outer);
}

# end of comment
sub do_cmd_CE {
    local($outer) = @_;
    local($_);
    
    $outer =~ s/$next_pair_pr_rx//o;
    local($ignored) = $2;
    print "CE: $ignored\n" if $debug;

    join('',"</I>", $outer);
}

# start of string
sub do_cmd_S {
    local($outer) = @_;
    local($_);
    
    $outer =~ s/$next_pair_pr_rx//o;
    local($ignored) = $2;
    print "S: $ignored\n" if $debug;

    join('',"<code>", $outer);
}

# end of string
sub do_cmd_SE {
    local($outer) = @_;
    local($_);
    
    $outer =~ s/$next_pair_pr_rx//o;
    local($ignored) = $2;
    print "SE: $ignored\n" if $debug;

    join('',"</code>", $outer);
}

# special characters used by lgrind:
# (there are more than we define here!!! -- see lgrind.doc)
# literal slash
sub do_cmd_1 {
    local($outer) = @_;
    local($_);
    
    $outer =~ s/$next_pair_pr_rx//o;
    local($ignored) = $2;
    print "slash: $ignored\n" if $debug;

    join('',"/", $outer);
}
# literal backslash
sub do_cmd_2 {
    local($outer) = @_;
    local($_);
    
    $outer =~ s/$next_pair_pr_rx//o;
    local($ignored) = $2;
    print "backslash: $ignored\n" if $debug;
    
    $_ = "\\textbackslash";
    &pre_process;

    join('',&translate_commands($_), $outer);
}
# literal star
sub do_cmd_star {
    local($outer) = @_;
    local($_);
    
    $outer =~ s/$next_pair_pr_rx//o;
    local($ignored) = $2;
    print "star: $ignored\n" if $debug;

    join('',"*", $outer);
}

# we ignore the LGnuminterval command
# (which can be used to indicate that line numbers should appear in
#  the right margin. We don't generate line numbers)
    &ignore_commands( <<_IGNORED_CMDS_);
LGnuminterval
_IGNORED_CMDS_

1;