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