Chris@42: #!/usr/bin/perl --
Chris@42: # Copyright (C) 1993-1995 Ian Jackson.
Chris@42: 
Chris@42: # This file is free software; you can redistribute it and/or modify
Chris@42: # it under the terms of the GNU General Public License as published by
Chris@42: # the Free Software Foundation; either version 2, or (at your option)
Chris@42: # any later version.
Chris@42: 
Chris@42: # It is distributed in the hope that it will be useful,
Chris@42: # but WITHOUT ANY WARRANTY; without even the implied warranty of
Chris@42: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Chris@42: # GNU General Public License for more details.
Chris@42: 
Chris@42: # You should have received a copy of the GNU General Public License
Chris@42: # along with GNU Emacs; see the file COPYING.  If not, write to
Chris@42: # the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Chris@42: # Boston, MA 02111-1307, USA.
Chris@42: 
Chris@42: # (Note: I do not consider works produced using these BFNN processing
Chris@42: # tools to be derivative works of the tools, so they are NOT covered
Chris@42: # by the GPL.  However, I would appreciate it if you credited me if
Chris@42: # appropriate in any documents you format using BFNN.)
Chris@42: 
Chris@42: @outputs=('ascii','info','html');
Chris@42: 
Chris@42: while ($ARGV[0] =~ m/^\-/) {
Chris@42:     $_= shift(@ARGV);
Chris@42:     if (m/^-only/) {
Chris@42:         @outputs= (shift(@ARGV));
Chris@42:     } else {
Chris@42:         warn "unknown option `$_' ignored";
Chris@42:     }
Chris@42: }
Chris@42: 
Chris@42: $prefix= $ARGV[0];
Chris@42: $prefix= 'stdin' unless length($prefix);
Chris@42: $prefix =~ s/\.bfnn$//;
Chris@42: 
Chris@42: if (open(O,"$prefix.xrefdb")) {
Chris@42:     @xrefdb= <O>;
Chris@42:     close(O);
Chris@42: } else {
Chris@42:     warn "no $prefix.xrefdb ($!)";
Chris@42: }
Chris@42: 
Chris@42: $section= -1;
Chris@42: for $thisxr (@xrefdb) {
Chris@42:     $_= $thisxr;
Chris@42:     chop;
Chris@42:     if (m/^Q (\w+) ((\d+)\.(\d+)) (.*)$/) {
Chris@42:         $qrefn{$1}= $2;
Chris@42:         $qreft{$1}= $5;
Chris@42:         $qn2ref{$3,$4}= $1;
Chris@42:         $maxsection= $3;
Chris@42:         $maxquestion[$3]= $4;
Chris@42:     } elsif (m/^S (\d+) /) {
Chris@42:         $maxsection= $1;
Chris@42:         $sn2title{$1}=$';
Chris@42:     }
Chris@42: }
Chris@42: 
Chris@42: open(U,">$prefix.xrefdb-new");
Chris@42: 
Chris@42: for $x (@outputs) { require("m-$x.pl"); }
Chris@42: 
Chris@42: &call('init');
Chris@42: 
Chris@42: while (<>) {
Chris@42:     chop;
Chris@42:     next if m/^\\comment\b/;
Chris@42:     if (!m/\S/) {
Chris@42:         &call('endpara');
Chris@42:         next;
Chris@42:     }
Chris@42:     if (s/^\\section +//) {
Chris@42:         $line= $_;
Chris@42:         $section++; $question=0;
Chris@42:         print U "S $section $line\n";
Chris@42:         $|=1; print "S$section",' 'x10,"\r"; $|=0;
Chris@42:         &call('endpara');
Chris@42:         &call('startmajorheading',"$section",
Chris@42:               "Section $section",
Chris@42:               $section<$maxsection ? "Section ".($section+1) : '',
Chris@42:               $section>1 ? 'Section '.($section-1) : 'Top');
Chris@42:         &text($line);
Chris@42:         &call('endmajorheading');
Chris@42:         if ($section) {
Chris@42:             &call('endpara');
Chris@42:             &call('startindex');
Chris@42:             for $thisxr (@xrefdb) {
Chris@42:                 $_= $thisxr;
Chris@42:                 chop;
Chris@42:                 if (m/^Q (\w+) (\d+)\.(\d+) (.*)$/) {
Chris@42:                     $ref= $1; $num1= $2; $num2= $3; $text= $4;
Chris@42:                     next unless $num1 == $section;
Chris@42:                     &call('startindexitem',$ref,"Q$num1.$num2","Question $num1.$num2");
Chris@42:                     &text($text);
Chris@42:                     &call('endindexitem');
Chris@42:                 }
Chris@42:             }
Chris@42:             &call('endindex');
Chris@42:         }
Chris@42:     } elsif (s/^\\question \d{2}[a-z]{3}((:\w+)?) +//) {
Chris@42:         $line= $_;
Chris@42:         $question++;
Chris@42:         $qrefstring= $1;
Chris@42:         $qrefstring= "q_${section}_$question" unless $qrefstring =~ s/^://;
Chris@42:         print U "Q $qrefstring $section.$question $line\n";
Chris@42:         $|=1; print "Q$section.$question",' 'x10,"\r"; $|=0;
Chris@42:         &call('endpara');
Chris@42:         &call('startminorheading',$qrefstring,
Chris@42:               "Question $section.$question",
Chris@42:               $question < $maxquestion[$section] ? "Question $section.".($question+1) :
Chris@42:               $section < $maxsection ? "Question ".($section+1).".1" : '',
Chris@42:               $question > 1 ? "Question $section.".($question-1) :
Chris@42:               $section > 1 ? "Question ".($section-1).'.'.($maxquestion[$section-1]) :
Chris@42:               'Top',
Chris@42:               "Section $section");
Chris@42:         &text("Question $section.$question.  $line");
Chris@42:         &call('endminorheading');
Chris@42:     } elsif (s/^\\only +//) {
Chris@42:         @saveoutputs= @outputs;
Chris@42:         @outputs=();
Chris@42:         for $x (split(/\s+/,$_)) {
Chris@42:             push(@outputs,$x) if grep($x eq $_, @saveoutputs);
Chris@42:         }
Chris@42:     } elsif (s/^\\endonly$//) {
Chris@42:         @outputs= @saveoutputs;
Chris@42:     } elsif (s/^\\copyto +//) {
Chris@42:         $fh= $';
Chris@42:         while(<>) {
Chris@42:             last if m/^\\endcopy$/;
Chris@42:             while (s/^([^\`]*)\`//) {
Chris@42:                 print $fh $1;
Chris@42:                 m/([^\\])\`/ || warn "`$_'";
Chris@42:                 $_= $';
Chris@42:                 $cmd= $`.$1;
Chris@42:                 $it= `$cmd`; chop $it;
Chris@42:                 print $fh $it;
Chris@42:             }
Chris@42:             print $fh $_;
Chris@42:         }
Chris@42:     } elsif (m/\\index$/) {
Chris@42:         &call('startindex');
Chris@42:         for $thisxr (@xrefdb) {
Chris@42:             $_= $thisxr;
Chris@42:             chop;
Chris@42:             if (m/^Q (\w+) (\d+\.\d+) (.*)$/) {
Chris@42:                 $ref= $1; $num= $2; $text= $3;
Chris@42:                 &call('startindexitem',$ref,"Q$num","Question $num");
Chris@42:                 &text($text);
Chris@42:                 &call('endindexitem');
Chris@42:             } elsif (m/^S (\d+) (.*)$/) {
Chris@42:                 $num= $1; $text= $2;
Chris@42:                 next unless $num;
Chris@42:                 &call('startindexmainitem',"s_$num",
Chris@42:                       "Section $num.","Section $num");
Chris@42:                 &text($text);
Chris@42:                 &call('endindexitem');
Chris@42:             } else {
Chris@42:                 warn $_;
Chris@42:             }
Chris@42:         }
Chris@42:         &call('endindex');
Chris@42:     } elsif (m/^\\call-(\w+) +(\w+)\s*(.*)$/) {
Chris@42:         $fn= $1.'_'.$2;
Chris@42:         eval { &$fn($3); };
Chris@42:         warn $@ if length($@);
Chris@42:     } elsif (m/^\\call +(\w+)\s*(.*)$/) {
Chris@42:         eval { &call($1,$2); };
Chris@42:         warn $@ if length($@);
Chris@42:     } elsif (s/^\\set +(\w+)\s*//) {
Chris@42:         $svalue= $'; $svari= $1;
Chris@42:         eval("\$user_$svari=\$svalue"); $@ && warn "setting $svalue failed: $@\n";
Chris@42:     } elsif (m/^\\verbatim$/) {
Chris@42:         &call('startverbatim');
Chris@42:         while (<>) {
Chris@42:             chop;
Chris@42:             last if m/^\\endverbatim$/;
Chris@42:             &call('verbatim',$_);
Chris@42:         }
Chris@42:         &call('endverbatim');
Chris@42:     } else {
Chris@42:         s/\.$/\. /;
Chris@42:         &text($_." ");
Chris@42:     }
Chris@42: }
Chris@42: 
Chris@42: print ' 'x25,"\r";
Chris@42: &call('finish');
Chris@42: rename("$prefix.xrefdb-new","$prefix.xrefdb") || warn "rename xrefdb: $!";
Chris@42: exit 0;
Chris@42: 
Chris@42: 
Chris@42: sub text {
Chris@42:     local($in,$rhs,$word,$refn,$reft,$fn,$style);
Chris@42:     $in= "$holdover$_[0]";
Chris@42:     $holdover= '';
Chris@42:     while ($in =~ m/\\/) {
Chris@42: #print STDERR ">$`##$'\n";
Chris@42:         $rhs=$';
Chris@42:         &call('text',$`);
Chris@42:         $_= $rhs;
Chris@42:         if (m/^\w+ $/) {
Chris@42:             $holdover= "\\$&";
Chris@42:             $in= '';
Chris@42:         } elsif (s/^fn\s+([^\s\\]*\w)//) {
Chris@42:             $in= $_;
Chris@42:             $word= $1;
Chris@42:             &call('courier');
Chris@42:             &call('text',$word);
Chris@42:             &call('endcourier');
Chris@42:         } elsif (s/^tab\s+(\d+)\s+//) {
Chris@42:             $in= $_; &call('tab',$1);
Chris@42:         } elsif (s/^nl\s+//) {
Chris@42:             $in= $_; &call('newline');
Chris@42:         } elsif (s/^qref\s+(\w+)//) {
Chris@42:             $refn= $qrefn{$1};
Chris@42:             $reft= $qreft{$1};
Chris@42:             if (!length($refn)) {
Chris@42:                 warn "unknown question `$1'";
Chris@42:             }
Chris@42:             $in= "$`\\pageref:$1:$refn:$reft\\endpageref.$_";
Chris@42:         } elsif (s/^pageref:(\w+):([^:\n]+)://) {
Chris@42:             $in= $_;
Chris@42:             &call('pageref',$1,$2);
Chris@42:         } elsif (s/^endpageref\.//) {
Chris@42:             $in= $_; &call('endpageref');
Chris@42:         } elsif (s/^(\w+)\{//) {
Chris@42:             $in= $_; $fn= $1;
Chris@42:             eval { &call("$fn"); };
Chris@42:             if (length($@)) { warn $@; $fn= 'x'; }
Chris@42:             push(@styles,$fn);
Chris@42:         } elsif (s/^\}//) {
Chris@42:             $in= $_;
Chris@42:             $fn= pop(@styles);
Chris@42:             if ($fn ne 'x') { &call("end$fn"); }
Chris@42:         } elsif (s/^\\//) {
Chris@42:             $in= $_;
Chris@42:             &call('text',"\\");
Chris@42:         } elsif (s,^(\w+)\s+([-A-Za-z0-9.\@:/]*\w),,) {
Chris@42: #print STDERR "**$&**$_\n";
Chris@42:             $in= $_;
Chris@42:             $style=$1; $word= $2;
Chris@42:             &call($style);
Chris@42:             &call('text',$word);
Chris@42:             &call("end$style");
Chris@42:         } else {
Chris@42:             warn "unknown control `\\$_'";
Chris@42:             $in= $_;
Chris@42:         }
Chris@42:     }
Chris@42:     &call('text',$in);
Chris@42: }
Chris@42: 
Chris@42: 
Chris@42: sub call {
Chris@42:     local ($fnbase, @callargs) = @_;
Chris@42:     local ($coutput);
Chris@42:     for $coutput (@outputs) {
Chris@42:         if ($fnbase eq 'text' && eval("\@${coutput}_cmds")) {
Chris@42: #print STDERR "special handling text (@callargs) for $coutput\n";
Chris@42:             $evstrg= "\$${coutput}_args[\$#${coutput}_args].=\"\@callargs\"";
Chris@42:             eval($evstrg);
Chris@42:             length($@) && warn "call adding for $coutput (($evstrg)): $@";
Chris@42:         } else {
Chris@42:             $fntc= $coutput.'_'.$fnbase; 
Chris@42:             &$fntc(@callargs);
Chris@42:         }
Chris@42:     }
Chris@42: }
Chris@42: 
Chris@42: 
Chris@42: sub recurse {
Chris@42:     local (@outputs) = $coutput;
Chris@42:     local ($holdover);
Chris@42:     &text($_[0]);
Chris@42: }
Chris@42: 
Chris@42: 
Chris@42: sub arg {
Chris@42: #print STDERR "arg($_[0]) from $coutput\n";
Chris@42:     $cmd= $_[0];
Chris@42:     eval("push(\@${coutput}_cmds,\$cmd); push(\@${coutput}_args,'')");
Chris@42:     length($@) && warn "arg setting up for $coutput: $@";
Chris@42: }
Chris@42: 
Chris@42: sub endarg {
Chris@42: #print STDERR "endarg($_[0]) from $coutput\n";
Chris@42:     $evstrg= "\$${coutput}_cmd= \$cmd= pop(\@${coutput}_cmds); ".
Chris@42:              "\$${coutput}_arg= \$arg= pop(\@${coutput}_args); ";
Chris@42:     eval($evstrg);
Chris@42:     length($@) && warn "endarg extracting for $coutput (($evstrg)): $@";
Chris@42: #print STDERR ">call $coutput $cmd $arg< (($evstrg))\n";
Chris@42:     $evstrg= "&${coutput}_do_${cmd}(\$arg)";
Chris@42:     eval($evstrg);
Chris@42:     length($@) && warn "endarg running ${coutput}_do_${cmd} (($evstrg)): $@";
Chris@42: }