mirror of
https://github.com/tildearrow/furnace.git
synced 2024-11-16 09:45:06 +00:00
298 lines
9 KiB
Perl
Executable file
298 lines
9 KiB
Perl
Executable file
#!/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= <O>;
|
|
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)): $@";
|
|
}
|