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