home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 8 / CDACTUAL8.iso / docs / linux.faq / linux-fa.sou / linux-fa / bfnnconv.pl next >
Encoding:
Perl Script  |  1996-03-06  |  9.0 KB  |  299 lines
  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','lout','info','html','post');
  25.  
  26. while ($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.  
  39. if (open(O,"$prefix.xrefdb")) {
  40.     @xrefdb= <O>;
  41.     close(O);
  42. } else {
  43.     warn "no $prefix.xrefdb ($!)";
  44. }
  45.  
  46. $section= -1;
  47. for $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.  
  62. open(U,">$prefix.xrefdb-new");
  63.  
  64. for $x (@outputs) { require("m-$x.pl"); }
  65.  
  66. &call('init');
  67.  
  68. while (<>) {
  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.  
  189. print ' 'x25,"\r";
  190. &call('finish');
  191. rename("$prefix.xrefdb-new","$prefix.xrefdb") || warn "rename xrefdb: $!";
  192. exit 0;
  193.  
  194.  
  195. sub 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.  
  257. sub 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.  
  274. sub recurse {
  275.     local (@outputs) = $coutput;
  276.     local ($holdover);
  277.     &text($_[0]);
  278. }
  279.  
  280.  
  281. sub 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.  
  288. sub 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.