1#!/usr/bin/perl --
2# Copyright (C) 1993-1995 Ian Jackson.
3
4# This file is free software; you can redistribute it and/or modify
5# it under the terms of the GNU General Public License as published by
6# the Free Software Foundation; either version 2, or (at your option)
7# any later version.
8
9# It is distributed in the hope that it will be useful,
10# but WITHOUT ANY WARRANTY; without even the implied warranty of
11# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12# GNU General Public License for more details.
13
14# You should have received a copy of the GNU General Public License
15# along with GNU Emacs; see the file COPYING.  If not, write to
16# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
17# Boston, MA 02111-1307, USA.
18
19# (Note: I do not consider works produced using these BFNN processing
20# tools to be derivative works of the tools, so they are NOT covered
21# by the GPL.  However, I would appreciate it if you credited me if
22# appropriate in any documents you format using BFNN.)
23
24@outputs=('ascii','info','html');
25
26while ($ARGV[0] =~ m/^\-/) {
27    $_= shift(@ARGV);
28    if (m/^-only/) {
29        @outputs= (shift(@ARGV));
30    } else {
31        warn "unknown option `$_' ignored";
32    }
33}
34
35$prefix= $ARGV[0];
36$prefix= 'stdin' unless length($prefix);
37$prefix =~ s/\.bfnn$//;
38
39if (open(O,"$prefix.xrefdb")) {
40    @xrefdb= <O>;
41    close(O);
42} else {
43    warn "no $prefix.xrefdb ($!)";
44}
45
46$section= -1;
47for $thisxr (@xrefdb) {
48    $_= $thisxr;
49    chop;
50    if (m/^Q (\w+) ((\d+)\.(\d+)) (.*)$/) {
51        $qrefn{$1}= $2;
52        $qreft{$1}= $5;
53        $qn2ref{$3,$4}= $1;
54        $maxsection= $3;
55        $maxquestion[$3]= $4;
56    } elsif (m/^S (\d+) /) {
57        $maxsection= $1;
58        $sn2title{$1}=$';
59    }
60}
61
62open(U,">$prefix.xrefdb-new");
63
64for $x (@outputs) { require("m-$x.pl"); }
65
66&call('init');
67
68while (<>) {
69    chop;
70    next if m/^\\comment\b/;
71    if (!m/\S/) {
72        &call('endpara');
73        next;
74    }
75    if (s/^\\section +//) {
76        $line= $_;
77        $section++; $question=0;
78        print U "S $section $line\n";
79        $|=1; print "S$section",' 'x10,"\r"; $|=0;
80        &call('endpara');
81        &call('startmajorheading',"$section",
82              "Section $section",
83              $section<$maxsection ? "Section ".($section+1) : '',
84              $section>1 ? 'Section '.($section-1) : 'Top');
85        &text($line);
86        &call('endmajorheading');
87        if ($section) {
88            &call('endpara');
89            &call('startindex');
90            for $thisxr (@xrefdb) {
91                $_= $thisxr;
92                chop;
93                if (m/^Q (\w+) (\d+)\.(\d+) (.*)$/) {
94                    $ref= $1; $num1= $2; $num2= $3; $text= $4;
95                    next unless $num1 == $section;
96                    &call('startindexitem',$ref,"Q$num1.$num2","Question $num1.$num2");
97                    &text($text);
98                    &call('endindexitem');
99                }
100            }
101            &call('endindex');
102        }
103    } elsif (s/^\\question \d{2}[a-z]{3}((:\w+)?) +//) {
104        $line= $_;
105        $question++;
106        $qrefstring= $1;
107        $qrefstring= "q_${section}_$question" unless $qrefstring =~ s/^://;
108        print U "Q $qrefstring $section.$question $line\n";
109        $|=1; print "Q$section.$question",' 'x10,"\r"; $|=0;
110        &call('endpara');
111        &call('startminorheading',$qrefstring,
112              "Question $section.$question",
113              $question < $maxquestion[$section] ? "Question $section.".($question+1) :
114              $section < $maxsection ? "Question ".($section+1).".1" : '',
115              $question > 1 ? "Question $section.".($question-1) :
116              $section > 1 ? "Question ".($section-1).'.'.($maxquestion[$section-1]) :
117              'Top',
118              "Section $section");
119        &text("Question $section.$question.  $line");
120        &call('endminorheading');
121    } elsif (s/^\\only +//) {
122        @saveoutputs= @outputs;
123        @outputs=();
124        for $x (split(/\s+/,$_)) {
125            push(@outputs,$x) if grep($x eq $_, @saveoutputs);
126        }
127    } elsif (s/^\\endonly$//) {
128        @outputs= @saveoutputs;
129    } elsif (s/^\\copyto +//) {
130        $fh= $';
131        while(<>) {
132            last if m/^\\endcopy$/;
133            while (s/^([^\`]*)\`//) {
134                print $fh $1;
135                m/([^\\])\`/ || warn "`$_'";
136                $_= $';
137                $cmd= $`.$1;
138                $it= `$cmd`; chop $it;
139                print $fh $it;
140            }
141            print $fh $_;
142        }
143    } elsif (m/\\index$/) {
144        &call('startindex');
145        for $thisxr (@xrefdb) {
146            $_= $thisxr;
147            chop;
148            if (m/^Q (\w+) (\d+\.\d+) (.*)$/) {
149                $ref= $1; $num= $2; $text= $3;
150                &call('startindexitem',$ref,"Q$num","Question $num");
151                &text($text);
152                &call('endindexitem');
153            } elsif (m/^S (\d+) (.*)$/) {
154                $num= $1; $text= $2;
155                next unless $num;
156                &call('startindexmainitem',"s_$num",
157                      "Section $num.","Section $num");
158                &text($text);
159                &call('endindexitem');
160            } else {
161                warn $_;
162            }
163        }
164        &call('endindex');
165    } elsif (m/^\\call-(\w+) +(\w+)\s*(.*)$/) {
166        $fn= $1.'_'.$2;
167        eval { &$fn($3); };
168        warn $@ if length($@);
169    } elsif (m/^\\call +(\w+)\s*(.*)$/) {
170        eval { &call($1,$2); };
171        warn $@ if length($@);
172    } elsif (s/^\\set +(\w+)\s*//) {
173        $svalue= $'; $svari= $1;
174        eval("\$user_$svari=\$svalue"); $@ && warn "setting $svalue failed: $@\n";
175    } elsif (m/^\\verbatim$/) {
176        &call('startverbatim');
177        while (<>) {
178            chop;
179            last if m/^\\endverbatim$/;
180            &call('verbatim',$_);
181        }
182        &call('endverbatim');
183    } else {
184        s/\.$/\. /;
185        &text($_." ");
186    }
187}
188
189print ' 'x25,"\r";
190&call('finish');
191rename("$prefix.xrefdb-new","$prefix.xrefdb") || warn "rename xrefdb: $!";
192exit 0;
193
194
195sub text {
196    local($in,$rhs,$word,$refn,$reft,$fn,$style);
197    $in= "$holdover$_[0]";
198    $holdover= '';
199    while ($in =~ m/\\/) {
200#print STDERR ">$`##$'\n";
201        $rhs=$';
202        &call('text',$`);
203        $_= $rhs;
204        if (m/^\w+ $/) {
205            $holdover= "\\$&";
206            $in= '';
207        } elsif (s/^fn\s+([^\s\\]*\w)//) {
208            $in= $_;
209            $word= $1;
210            &call('courier');
211            &call('text',$word);
212            &call('endcourier');
213        } elsif (s/^tab\s+(\d+)\s+//) {
214            $in= $_; &call('tab',$1);
215        } elsif (s/^nl\s+//) {
216            $in= $_; &call('newline');
217        } elsif (s/^qref\s+(\w+)//) {
218            $refn= $qrefn{$1};
219            $reft= $qreft{$1};
220            if (!length($refn)) {
221                warn "unknown question `$1'";
222            }
223            $in= "$`\\pageref:$1:$refn:$reft\\endpageref.$_";
224        } elsif (s/^pageref:(\w+):([^:\n]+)://) {
225            $in= $_;
226            &call('pageref',$1,$2);
227        } elsif (s/^endpageref\.//) {
228            $in= $_; &call('endpageref');
229        } elsif (s/^(\w+)\{//) {
230            $in= $_; $fn= $1;
231            eval { &call("$fn"); };
232            if (length($@)) { warn $@; $fn= 'x'; }
233            push(@styles,$fn);
234        } elsif (s/^\}//) {
235            $in= $_;
236            $fn= pop(@styles);
237            if ($fn ne 'x') { &call("end$fn"); }
238        } elsif (s/^\\//) {
239            $in= $_;
240            &call('text',"\\");
241        } elsif (s,^(\w+)\s+([-A-Za-z0-9.\@:/]*\w),,) {
242#print STDERR "**$&**$_\n";
243            $in= $_;
244            $style=$1; $word= $2;
245            &call($style);
246            &call('text',$word);
247            &call("end$style");
248        } else {
249            warn "unknown control `\\$_'";
250            $in= $_;
251        }
252    }
253    &call('text',$in);
254}
255
256
257sub call {
258    local ($fnbase, @callargs) = @_;
259    local ($coutput);
260    for $coutput (@outputs) {
261        if ($fnbase eq 'text' && eval("\@${coutput}_cmds")) {
262#print STDERR "special handling text (@callargs) for $coutput\n";
263            $evstrg= "\$${coutput}_args[\$#${coutput}_args].=\"\@callargs\"";
264            eval($evstrg);
265            length($@) && warn "call adding for $coutput (($evstrg)): $@";
266        } else {
267            $fntc= $coutput.'_'.$fnbase;
268            &$fntc(@callargs);
269        }
270    }
271}
272
273
274sub recurse {
275    local (@outputs) = $coutput;
276    local ($holdover);
277    &text($_[0]);
278}
279
280
281sub arg {
282#print STDERR "arg($_[0]) from $coutput\n";
283    $cmd= $_[0];
284    eval("push(\@${coutput}_cmds,\$cmd); push(\@${coutput}_args,'')");
285    length($@) && warn "arg setting up for $coutput: $@";
286}
287
288sub endarg {
289#print STDERR "endarg($_[0]) from $coutput\n";
290    $evstrg= "\$${coutput}_cmd= \$cmd= pop(\@${coutput}_cmds); ".
291             "\$${coutput}_arg= \$arg= pop(\@${coutput}_args); ";
292    eval($evstrg);
293    length($@) && warn "endarg extracting for $coutput (($evstrg)): $@";
294#print STDERR ">call $coutput $cmd $arg< (($evstrg))\n";
295    $evstrg= "&${coutput}_do_${cmd}(\$arg)";
296    eval($evstrg);
297    length($@) && warn "endarg running ${coutput}_do_${cmd} (($evstrg)): $@";
298}
299