reduce-algebra
/
reduce-historical
espejo de git://github.com/reduce-algebra/reduce-historical


			
							123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621
							
#
# This pre-pre-processor subroutine handles $ signs in the left column
#  of the Examples environment. latex2html scans very early for math
#  delimiters like $, even before special handler subroutines are called.
# Similarly, one occurence of % needs to be handled.
#

sub pre_pre_process {
    local($contents) = "";

    local($body);
    local($rest);

    ## some special cases

    # handle percent sign 
    s/\\begin\{Command\}\[percent\]\{%\}/\\begin{Command}[percent]{\\%}/;

    # $m > n$ in CHOOSE
    s/\$m > n\$/m > n/;

    # $\pi/2$ in TAN
    s/\$\\pi\/2\$/PI\/2/g;

    ## END of special cases

    ## Handle Bigexample environment (insert verbatim env)
    while (/\\begin\{Bigexample\}(.+?)\\end\{Bigexample\}/s) {
	$contents .= $`;
	$body = "\\begin{Bigexample}\n\\begin{verbatim}\n" . $& . "\\end{verbatim}\n\\end{Bigexample}\n" ;
	$_ = $';

	$contents .= $body;
    }

    $_ = $contents . $_;

    ## Handle Examples environment
    while (/\\begin\{Examples\}(.+?)\\end\{Examples\}/s) {
	$contents .= $`;
	$body = $&;
	$_ = $';

	# special case $ or \$ just at end of column
	$body =~ s/(^|[^\\])\$(\s*)(&|\\\\)/$1\\\$$2$3/sg;
	$contents .= $body;
    }

    $_ = $contents . $_;
}


sub post_post_process {
    s/<TITLE>No Title<\/TITLE>/<TITLE>REDUCE Reference Manual.<\/TITLE>/;
    s/<BODY/<BODY BGCOLOR="#ffffff"/;

}


&ignore_commands(<<_IGNORED_COMMANDS_)
documentclass # [] # {} # []
NeedsTeXFormat#{}#[]
NEWdescription#{}
NEWfeature#{}
quad
textcompwordmark
null
_IGNORED_COMMANDS_

&process_commands_in_tex(<<__RAW_ARG_CMDS_);
textcircled # {}
textvisiblespace
textparagraph
__RAW_ARG_CMDS_


#%ignore = ('TEX',1,%ignore);
%ignore = ('INFO',1,%ignore);

#sub do_env_INFO {}
sub do_env_TEX {}

sub do_cmd_REDUCE {
    join("","REDUCE",shift);
}

sub do_cmd_IFTEX {
    local($_) = @_;
    local($texpart) = &missing_braces unless (
	  (s/$next_pair_pr_rx/$texpart = $2;''/eo)
	||(s/$next_pair_rx/$texpart = $2;''/eo));
    local($nontexpart) = &missing_braces unless (
	  (s/$next_pair_pr_rx/$nontexpart = $2;''/eo)
	||(s/$next_pair_rx/$nontexpart = $2;''/eo));
    $nontexpart . $_;
}

sub do_cmd_name {
#    local($_) = @_;
#    local($rest) = $_;
#    $rest =~ s/$next_pair_pr_rx//o;
#    join('',"<tt>",$&,"</tt>",$rest);
    &styled_text_chunk('TT','','font','','', '', @_);
}

sub do_cmd_nameindex {
    local($_) = @_;
    local($br_id,$name);
    $name = &missing_braces unless (
	(s/$next_pair_pr_rx/($br_id, $name) = ($1, $2);''/eo)
	||(s/$next_pair_rx/($br_id, $name) = ($1, $2);''/eo));
    &anchor_label($name,$CURRENT_FILE,'');
    join('',"<TT>" . &make_index_entry($br_id,$str) . "</TT>",$_);
}

#sub do_cmd_hyperref {
#    local($_) = @_;
#    local($rest) = $_;
#    $rest =~ s/$next_pair_pr_rx//o;
#    join('',"<tt>",$&,"</tt>",$rest);
#}


sub do_cmd_nameref {
    local($_) = @_;
    &process_ref($cross_ref_mark,$cross_ref_mark,1);
}

sub do_cmd_key {
    local($_) = @_;
    local($rest) = $_;
    $rest =~ s/$next_pair_pr_rx//o;
    join('',"<KBD>",$&,"</KBD>",$rest);
}

sub do_cmd_arg {
    local($_) = @_;
    local($rest) = $_;
    $rest =~ s/$next_pair_pr_rx//o;
    join('',"<i>",$&,"</i>",$rest);
}

#sub do_cmd_key {
#    local($_) = @_;
#    local($rest) = $_;
#    $rest =~ s/$next_pair_pr_rx//o;
#    join('',"<i>",$&,"</i>",$rest);
#}


sub do_cmd_repeated {
    '<SUP>+</SUP>';
}	


sub do_cmd_optional {
    '<SUP>*</SUP>';
}	


sub do_cmd_meta {
    local($_) = @_;
    local($rest) = $_;
    $rest =~ s/$next_pair_pr_rx//o;
    join('',"<i>",$&,"</i>",$rest);
}

sub do_env_Syntax {
    local($_) = @_;
#    print STDERR "\nEntering Syntax with body: $_\n";
    s/(^|[^\\]) /$1~/g;
    s/$tex2html_deferred_rx\\par$tex2html_deferred_rx2//go; # get rid of empty input lines
    s/$tex2html_envs_rx\\\(/(/go; s/\\\(/(/go; 
    s/\\\)$tex2html_envs_rx/)/go; s/\\\)/)/go;
#    print STDERR "\nSyntax: after translating \\(\\): $_\n";
    $_ = &translate_commands(&translate_environments($_));
#    print STDERR "\nExiting Syntax with body: $_\n";
    "<P>\n<FONT SIZE=\"+1\">\n&nbsp;&nbsp;&nbsp;&nbsp;$_\n</FONT><P>";
}


sub do_newitemEnv {
    local($type,$_) = @_;
    local($optional_ref_key) = &get_next_optional_argument;
    local($br_id,$name);
    $name = &missing_braces unless (
	(s/$next_pair_pr_rx/($br_id, $name) = ($1, $2);''/eo)
	||(s/$next_pair_rx/($br_id, $name) = ($1, $2);''/eo));
    $name =~ s/\\_/_/g;
    $name =~ s/$dol_mark/\$/go;
    local($nameu) = $name;
    $nameu = "\U$name\E" unless $name =~ /^<.+>$/;
    
    &make_index_entry($br_id,$name);
#    &make_index_entry($br_id,"$type!$name");

    local($ref_key) = ($optional_ref_key || $name);

    $_ = &translate_commands(&translate_environments($_));

    local($header) = <<XXX;
<TABLE COLS=2 WIDTH=100%>
  <TR>
    <TD ALIGN=LEFT NOWRAP><FONT SIZE="+2"><B>$nameu</B></FONT></TD>
    <TD ALIGN=RIGHT NOWRAP><FONT SIZE="+2"><B>$type</B></FONT></TD>
  </TR>
</TABLE>

XXX

    return &anchor_label("\L$ref_key\Q",$CURRENT_FILE,$header . $_);
}


sub do_env_Command {
    &do_newitemEnv("Command",@_);
}

sub do_env_Operator {
    &do_newitemEnv("Operator",@_);
}

sub do_env_Function {
    &do_newitemEnv("Function",@_);
}

sub do_env_Switch {
    &do_newitemEnv("Switch",@_);
}

sub do_env_Variable {
    &do_newitemEnv("Variable",@_);
}

sub do_env_Declaration {
    &do_newitemEnv("Declaration",@_);
}

sub do_env_Package {
    &do_newitemEnv("Concept",@_);
}

sub do_env_Concept {
    &do_newitemEnv("Concept",@_);
}

sub do_env_Constant {
    &do_newitemEnv("Constant",@_);
}

sub do_env_Type {
    &do_newitemEnv("Type",@_);
}

sub do_env_info {
    &do_newitemEnv("info",@_);
}

sub do_env_Introduction {
    &do_newitemEnv("Introduction",@_);
}

sub do_env_Bigexample {
    local($_) = @_;
    join('',"<H3>Example</H3>\n",&translate_commands(&translate_environments($_)));
}


sub do_env_Comments {
    local($_) = @_;
    join('',"<H3>Comments</H3>\n",$_);
}


sub do_env_Related {
    join('',"<H3>Related Information</H3>\n",&do_env_description);
}


$match_rfrac = "<!-- START rfrac#(\\d+) -->(.+)<!-- END rfrac#\\1 -->";
$match_rfrac_cell = "<(TD|TD VALIGN=.+)>(.+?)</TD>";
$match_rfrac_row_upper = "<TR ALIGN=CENTER>\n\\s+$match_rfrac_cell<!-- UPPER rfrac#\\1 -->\n\\s+</TR>";
$match_rfrac_row_middle = "<TR ALIGN=CENTER>\n\\s+$match_rfrac_cell<!-- MIDDLE rfrac#\\1 -->\n\\s+</TR>";
$match_rfrac_row_lower = "<TR ALIGN=CENTER>\n\\s+$match_rfrac_cell<!-- LOWER rfrac#\\1 -->\n\\s+</TR>";
$match_rfrac_body = "<!-- START rfrac#(\\d+) -->\n<TABLE VALIGN=MIDDLE>\n\\s+$match_rfrac_row_upper\n\\s+$match_rfrac_row_middle\n\\s+$match_rfrac_row_lower\n</TABLE>\n<!-- END rfrac#\\1 -->";

sub condense_rfracs {
    local($cell) = @_;

    return $cell unless ($cell =~ /$match_rfrac/so);

    local(@lines) = split(/<P>/,$cell);

    foreach (@lines) {
	$_ = &condense_line_with_rfrac($_);
    }

    $cell = join("<P>",@lines);
    return $cell;
}


sub extract_rfrac_parts {
    local($body) = @_;

#    print STDERR "\nExtracting parts from: $body\n";
    $body =~ /$match_rfrac_body/so;
    my($num,$bar,$den) = ($3,$5,$7);
#    print STDERR "\nParts:\nNum: $num\nBar: $bar\nDen: $den\n";
    $num = &condense_line_with_rfrac($num);
    $den = &condense_line_with_rfrac($den);

#    print STDERR "\nCondensed parts:\nNum: $num\nBar: $bar\nDen: $den\n";

    return($num,$bar,$den);    
}


sub condense_line_with_rfrac {
    local($cell) = @_;

    return ("$cell<!-- WIDTH=" . &count_width($cell) . " -->")
	unless ($cell =~ /$match_rfrac/so);

#    print STDERR "\ncell with standalone rfrac's: $cell\n";

    my $restcell = $cell;
    my(@upperparts,@middleparts,@lowerparts);
    my $totalwidth = 0;

    while ($restcell =~ s/$match_rfrac/$2/so) {
	my $before_rfrac = $`;
	my $after_rfrac = $';
	my $rfrac_proper = $&;

        if ($before_rfrac) {
	    push @upperparts,"&nbsp;";
	    push @middleparts,$before_rfrac;
	    push @lowerparts,"&nbsp;";
	    $totalwidth += &count_width($before_rfrac);
	}

	my($num,$bar,$den) = &extract_rfrac_parts($rfrac_proper);
	my($numwidth,$denwidth,$width) = (0,0,0);
	$num =~ s/<!-- WIDTH=(\d+) -->$/$numwidth=$1;''/e;
	$den =~ s/<!-- WIDTH=(\d+) -->$/$denwidth=$1;''/e;
	if ($numwidth && $denwidth) {
	    # recalculate width
	    $width = 2 + ($numwidth > $denwidth ? $numwidth : $denwidth);
#	    print STDERR "\nSetting bar width to 2+max($numwidth,$denwidth) = $width\n";
	    $bar = "-" x (2*$width);
	}
	push @upperparts,$num;
	push @middleparts,$bar;
	push @lowerparts,$den;
	$totalwidth += length($bar)/2;

	$restcell = $after_rfrac;
    }

    if ($restcell ) {
	push @upperparts,"&nbsp;";
	push @middleparts,$restcell;
	push @lowerparts,"&nbsp;";
	$totalwidth += &count_width($restcell);
    }

    # now put the bits together
    my $i;
    $cell = "<TABLE VALIGN=MIDDLE>\n  <TR ALIGN=CENTER>\n";
    for ($i = 0; $i <= $#upperparts; $i++) {
	$cell .= "    <TD>$upperparts[$i]</TD>\n";
    }
    $cell .= "  </TR>\n  <TR ALIGN=CENTER>\n";
    for ($i = 0; $i <= $#middleparts; $i++) {
	$cell .= "    <TD>$middleparts[$i]</TD>\n";
    }
    $cell .= "  </TR>\n  <TR ALIGN=CENTER>\n";
    for ($i = 0; $i <= $#lowerparts; $i++) {
	$cell .= "    <TD>$lowerparts[$i]</TD>\n";
    }
    $cell .= "  </TR>\n</TABLE><!-- WIDTH=$totalwidth -->\n";

#    print STDERR "\ncell with replaced rfrac's: $cell\n";
    return $cell;
}


sub do_env_Examples {
    local($_) = @_;
    local($colspec) = "ll";
#    print STDERR "\nEntering do_env_Examples\n";
    s/\\\\\s*\[([^]]+)\]/\\\\/g;  # TKM - get rid of [N.n pc] on end of rows...
    s/\\newline\s*\[([^]]+)\]/\\newline/g;
    s/\n\s*\n/\n/g;	# Remove empty lines (otherwise will have paragraphs!)
    local($i,@colspec,$char,$cols,$cell,$htmlcolspec,$frames,$rules);
    local(@rows,@cols,$border);
    local($colspan,$cellcount);

    $border = ""; $frame = "";
    ($htmlcolspec,$frames,$rules,$cols,@colspec) =
	&translate_colspec($colspec, 'TD');

    $frames .= "t" if ( s/^\s*\\hline// );
    $frames .= "b" if ( s/\\hline\s*$// );
    $rules .= "r" if ( /\\[ch]line/ );

    if ( $frames || $rules ) {
	$border = " BORDER";
	$rule = " RULES=NONE";
	$frame = " FRAME=$frameoptions{$frames}" if ($frames);
	$rule = " RULES=GROUPS" if ($rules);
    };

    @rows = split(/\\\\/);
    $#rows-- if ( $rows[$#rows] =~ /^\s*$/ );
    local($return) = "<H3>Examples</H3>\n<TABLE COLS=$cols$border$frame$rule$_[1]>\n";
    $return .= "$htmlcolspec\n";
    $return .= "<TBODY>\n" if ( $rules =~ /r/ );
    foreach (@rows) {
#        print STDERR "\nNext row: >>$_<<\n";
        next if /^\s*$/;
	if ( s/^(\s*\\hline\s*)+//g ) {
	    $return .= "</TBODY><TBODY>\n";
	};
        $return .= "<TR>";
        ($leftcol,$rightcol) = split(/$html_specials{'&'}/o);
        $leftcolspec = $colspec[0];
	# handle left column
        $colspan = 0;
        $leftcol =~ s/;SPMquot;/&#34;/g;
        $leftcol =~ s/~/&#126;/g;
#        $leftcol =~ s/\{/&#123;/g;
#        $leftcol =~ s/\}/&#125;/g;
	# May modify $leftcolspec
#	print STDERR "\nleftcol before translate: $leftcol\n";
	$leftcell = &translate_commands(&translate_environments($leftcol));
#        print STDERR "\nleftcell after translate: $leftcell\n";
	if ( $colspan ) {
	    for ( $cellcount = 0; $colspan > 0; $colspan-- ) {
	        $colspec[$i++] =~ s/<TD/$cellcount++;"<TD"/ge;
	    }
	    $i--;
	    $leftcolspec =~ s/>$content_mark/ COLSPAN=$cellcount$&/;
	};
        $leftcolspec =~ s/$content_mark/<TT>$leftcell<\/TT>/;
	$return .= $leftcolspec;

        next if $colspan > 1;
	# handle right column
        $rightcolspec = $colspec[1];
        $colspan = 0;
#	print STDERR "\nrightcol before translate: $rightcol\n";

	$rightcell = "\&nbsp;"x4 . '<TT>----&gt;</TT>' . "\&nbsp;"x4 .
                       &translate_commands(&translate_environments($rightcol)) if $rightcol;
#        print STDERR "\nrightcell after translate: $rightcell\n";
        while ($rightcell =~ /\^$any_next_pair_pr_rx/o) {
#	    print STDERR "\nrightcell with superscript: $rightcell\n";
            $rightcell =~ s/\^$any_next_pair_pr_rx/<SUP>$2<\/SUP>/go;
#	    print STDERR "result is: $rightcell\n";
	}

        # try to handle rfrac's
        $rightcell = &condense_rfracs($rightcell);
            
	if ( $colspan ) {
	    for ( $cellcount = 0; $colspan > 0; $colspan-- ) {
	        $colspec[$i++] =~ s/<TD/$cellcount++;"<TD"/ge;
	    }
	    $i--;
	    $rightcolspec =~ s/>$content_mark/ COLSPAN=$cellcount$&/;
	};
        $rightcolspec =~ s/$content_mark/$rightcell/;
	$return .= $rightcolspec;

	$return .= "</TR>\n";
    };
    $return .= "</TBODY>\n" if ( $rules =~ /r/ );
    $return .= "</TABLE>\n";
#    print STDERR "\nExamples returns: $return\n";
    $return;
}


$rfrac_counter = 0;

sub do_cmd_rfrac {
    local($_) = @_;
    local($num,$den);
    local($num) = &missing_braces unless (
	  (s/$next_pair_pr_rx/$num = $2;''/eo)
	||(s/$next_pair_rx/$num = $2;''/eo));
    local($den) = &missing_braces unless (
	  (s/$next_pair_pr_rx/$den = $2;''/eo)
	||(s/$next_pair_rx/$den = $2;''/eo));
#    print STDERR "\nEntering rfrac with args: $num,$den\n";
    local($numwidth,$denwidth) = (&count_width($num),&count_width($den));
    local($width) = 2 + ($numwidth > $denwidth ? $numwidth : $denwidth);
    local($bar) = "-" x (2*$width);
    $rfrac_counter++;
    $_ = <<RFRAC . $_;

<!-- START rfrac#$rfrac_counter -->
<TABLE VALIGN=MIDDLE>
  <TR ALIGN=CENTER>
    <TD>$num</TD><!-- UPPER rfrac#$rfrac_counter -->
  </TR>
  <TR ALIGN=CENTER>
    <TD VALIGN=BASELINE>$bar</TD><!-- MIDDLE rfrac#$rfrac_counter -->
  </TR>
  <TR ALIGN=CENTER>
    <TD>$den</TD><!-- LOWER rfrac#$rfrac_counter -->
  </TR>
</TABLE>
<!-- END rfrac#$rfrac_counter -->
RFRAC
#    print STDERR "\nExiting rfrac with args: $_\n";
    $_;
}


sub count_width {
    local($_) = @_;
    s/&\w+;/ /g;
    s/--/ /g;
    s/<TD>(.+?)<\/TD>/$1/;
    s/<TT>(.+?)<\/TT>/$1/;
    s/\^$any_next_pair_pr_rx/$2/g;
    s/<SUP>(.+?)<\/SUP>/$1/;
    length;
}

sub do_cmd_explanationi {
    local($_) = @_;
    local($text) = &missing_braces unless (
	  (s/$next_pair_pr_rx/$text = $2;''/eo)
	||(s/$next_pair_rx/$text = $2;''/eo));
    local($dmy1,$dmy2,$dmy3,$dmy4);
    $colspan = 2;
    local($celltag) = "TD";
    ($dmy1,$dmy2,$dmy3,$dmy4,$leftcolspec) = &translate_colspec("p{0.95\textwidth}", $celltag);
    "<I>$text</I>";    
}


sub do_cmd_explanation {
    &do_cmd_explanationi;
}


sub do_cmd_explanationo {
    &styled_text_chunk('EM','em','font','variant','','', @_);
}


sub do_env_multilineinput {
    local($_) = @_;
    s/$tex2html_deferred_rx\\par$tex2html_deferred_rx2/\n<P>\n<P>\n/go;
#    s/\n/\n<P>\n/mg;
#    s/ /&nbsp;/mg;
    $leftcolspec =~ s/<TD VALIGN=BASELINE /<TD VALIGN=BOTTOM /;
    "<PRE>\n$_\n</PRE>";
}


sub do_env_multilineoutput {
    local($_) = @_;
    s/$next_pair_rx//o;
#    print STDERR "Body of multilineoutput:\n$_\n";
    s/$tex2html_deferred_rx\\par$tex2html_deferred_rx2/\n<P>\n<P>\n/go;
#    print STDERR "Body of multilineoutput(2):\n$_\n";
#    s/\n/\n<P>\n/mg;
#    s/ /&nbsp;/mg;
    s/-/--/g;
#    print STDERR "Body of multilineoutput(3):\n$_\n";
    "<PRE>\n" . &translate_commands($_) . "\n</PRE>";
}


##
## correct crazy handling of itemlabels
##

sub do_env_itemize {
    local($_) = @_;
    $itemize_level++;
    #RRM - catch nested lists
    &protect_useritems(*_);
    $_ = &translate_environments($_);
#    if (/^\s*$item_description_rx/) {
    local($bullet)='&nbsp;';
    SWITCH: {
        if ($itemize_level==1) {
            $bullet .= "*";
            last SWITCH; }
        if ($itemize_level==2) {
            $bullet .= "-";
            last SWITCH; }
        if ($itemize_level==3) {
            $bullet .= "*";
            last SWITCH; }
    }
    $itemize_level--;

    if (/\s*$item_description_rx/) {
        # Contains user defined optional labels
        &do_env_description($_, " COMPACT", $bullet)
    } else { &list_helper($_,'UL'); }
}


1;