source: git/doc/pl2doc.pl @ 0cf861

spielwiese
Last change on this file since 0cf861 was 0cf861, checked in by Olaf Bachmann <obachman@…>, 23 years ago
* some updates git-svn-id: file:///usr/local/Singular/svn/trunk@4851 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100755
File size: 12.5 KB
Line 
1#!/usr/local/bin/perl
2# $Id: pl2doc.pl,v 1.17 2000-12-08 15:51:24 obachman Exp $
3###################################################################
4#  Computer Algebra System SINGULAR
5#
6#  pl2doc.pl: utility to generate doc file out of pl for singular library
7#
8####
9$Usage = <<EOT;
10Usage: 
11$0 [-o out_file -db db_file -no_ex -no_fun -doc] library_perl_file.doc
12Convert library_perl_file.pl to library_perl_file.doc
13EOT
14
15###################################################################
16# parse command line options
17#
18while (@ARGV && $ARGV[0] =~ /^-/) 
19{
20  $_ = shift(@ARGV);
21  if (/^-o$/)    { $out_file = shift(@ARGV); next;}
22  if (/^-db$/) { $db_file = shift(@ARGV); next;}
23  if (/^-no_fun$/)    { $no_fun = 1;next;}
24  if (/^-doc$/)       { $doc = 1; next;}
25  if (/^-h(elp)?$/)   { print $Usage; exit;}
26 
27  die "Error: Unknown option: $_:$Usage\n";
28}
29
30
31###################################################################
32# Execute perl file
33#
34$pl_file = pop(@ARGV);
35die "Error: No perl file specified: $Usage\n" unless $pl_file;
36die "Error: Can't find perl file $pl_file: $Usage\n" unless -r $pl_file;
37require $pl_file;
38$lib = $library;
39$lib =~ s|.*/(.*)$|$1|;
40$lib =~ s|(.*)\.lib$|$1|;
41
42###################################################################
43# print  summary
44#
45unless ($out_file)
46{
47  ($out_file = $pl_file) =~ s/(.*)\..*$/$1/;
48  $out_file .= "_noFun" if ($no_fun);
49  $out_file .= ".doc";
50}
51open(LDOC, ">$out_file") || die"Error: can't open $out_file for writing: $!\n";
52print_doc_header(\*LDOC) if $doc;
53print LDOC "\@c ---content LibInfo---\n";
54print LDOC "\@c library version: $version\n";
55print LDOC "\@c library file: $library\n";
56print LDOC "\@cindex $lib.lib\n";
57print LDOC "\@cindex ${lib}_lib\n";
58undef @procs; # will be again defined by OutLibInfo
59$parsing = "info-string of lib $lib:";
60$ref = OutLibInfo(\*LDOC, $info, ! $no_fun);
61OutRef(\*LDOC, $ref) if $ref;
62print LDOC "\@c ---end content LibInfo---\n";
63
64###################################################################
65# print  summary
66#
67# print subsubsections for help of procs
68unless ($no_fun)
69{
70  if ($db_file && -e $db_file && ! -z $db_file)
71  {
72    my $return;
73    unless ($return = do $db_file)
74    {
75      die "couldn't parse $db_file: $@" if $@;
76      die "couldn't do $db_file: $!"    unless defined $return;
77      die "couldn't run $db_file"       unless $return;
78    } 
79  }
80
81  # print help and example of each function
82  for ($i = 0; $i <= $#procs; $i++)
83  {
84    # print node and section heading
85    print LDOC "\n\@c ------------------- " . $procs[$i]." -------------\n";
86    print LDOC "\@node " . $procs[$i].",";
87    print LDOC " ".$procs[$i+1] if ($i < $#procs);
88    print LDOC ",";
89    print LDOC " ".$procs[$i-1] if ($i > 0);
90    print LDOC ", " . $lib ."_lib\n";
91    print LDOC "\@subsubsection " . $procs[$i] . "\n";
92    print LDOC "\@cindex ". $procs[$i] . "\n";
93    if ($db_file && 
94        (!defined($CHECKSUMS{$procs[$i]}) ||
95         $CHECKSUMS{$procs[$i]} != $chksum{$procs[$i]}))
96    {
97      $CHECKSUMS{$procs[$i]} = $chksum{$procs[$i]};
98      $CHECKSUMS_CHANGED = 1;
99    }
100    print LDOC "\@c ---content $procs[$i]---\n";
101    print LDOC "Procedure from library \@code{$lib.lib} (\@pxref{${lib}_lib}).\n\n";
102    if ($help{$procs[$i]} =~ /^\@/)
103    {
104      print LDOC $help{$procs[$i]};
105      $ref = '';
106    }
107    else
108    {
109      print LDOC "\@table \@asis\n";
110      $table_is_open = 1;
111      # print help
112      $parsing = "help-string of $lib:$procs[$i]:";
113      $ref = OutInfo(\*LDOC, $help{$procs[$i]});
114      print LDOC "\@end table\n";
115    }
116    # print example
117    if ($example{$procs[$i]} && 
118        ($ex = &CleanUpExample($lib, $example{$procs[$i]})))
119    {
120      print LDOC "\@strong{Example:}\n";
121      print LDOC "\@smallexample\n\@c example\n";
122      print LDOC $ex;
123      print LDOC "\n\@c example\n\@end smallexample\n";
124    }
125    OutRef(\*LDOC, $ref) if $ref;
126    print LDOC "\@c ---end content $procs[$i]---\n";
127  }
128  # save checksums
129  if ($CHECKSUMS_CHANGED)
130  {
131    open(CD, ">$db_file") || die "Can't open '$db_file' for writing: $!";
132    print CD "%CHECKSUMS = (\n";
133    for $key (keys %CHECKSUMS)
134    {
135      print CD "q{$key}, $CHECKSUMS{$key},\n";
136    }
137    print CD ");\n";
138    close(CD);
139  }
140}
141
142#
143# und Tschuess
144#
145if ($doc)
146{
147 print LDOC <<EOT;
148\@c ----------------------------------------------------------
149\@node Index, , Singular libraries, Top
150\@chapter Index
151\@printindex cp
152
153\@bye
154EOT
155}
156 
157close(LDOC);
158if ($error)
159{
160  print STDERR "ERROR: $error\n";
161  exit(1);
162}
163exit(0);
164
165###########################################################################
166#
167# parse and print-out libinfo
168#
169sub OutLibInfo
170{
171  my ($FH, $info, $l_fun) = @_;
172  if ($info =~ /^\@/)
173  {
174    print $FH $info;
175    return;
176  }
177  print $FH "\@table \@asis\n";
178  $table_is_open = 1;
179 
180  my ($ref) = OutInfo($FH, $info, $l_fun);
181
182  print $FH "\@end table\n" if $table_is_open;
183  $table_is_open = 0;
184  return $ref;
185}
186
187sub OutInfo
188{
189  my ($FH, $info, $l_fun) = @_;
190  if ($info =~ /^\@/)
191  {
192    print $FH $info;
193    return;
194  }
195  $info =~ s/^\s*//;
196  $info =~ s/\s*$//;
197  $info .= "\n";
198
199  my ($item, $text, $line, $ref);
200  while ($info =~ m/(.*\n)/g)
201  {
202    $line = $1;
203    if ($1 =~ /^([A-Z][A-Z0-9 ]+?):(.*\n)/)
204    {
205      $ref .= OutInfoItem($FH, $item, $text, $l_fun) if $item && $text;
206      $item = $1;
207      $text = $2;
208    }
209    else
210    {
211      $text .= $line;
212    }
213  }
214  $ref .= OutInfoItem($FH, $item, $text, $l_fun) if $item && $text;
215  return $ref;
216}
217
218sub FormatInfoText
219{
220  my $length = shift;
221  my ($pline, $line, $text, $ptext, $special);
222  my ($in_format, $in_example, $in_texinfo);
223
224  $length = 0 unless $length;
225  $_ .= "\n";
226  $ptext = $_;
227  while ($ptext =~ /(.*)\n/g)
228  {
229    $pline = $line;
230    $line = $1;
231    # check whether we are in protected env
232    if ($in_format || $in_example || $in_texinfo)
233    {
234      # end protected env?
235      if ($line =~ /^\s*\@end (format|example|texinfo)\s*$/)
236      {
237        if ($in_format && $1 eq 'format')
238        {
239          $in_format = 0;
240          $text .= "$line\n";
241        }
242        elsif ($in_example && $1 eq 'example')
243        {
244          $in_example = 0;
245          $text .= "\@end smallexample\n";
246        }
247        elsif ($in_texinfo && $1 eq 'texinfo')
248        {
249          $in_texinfo = 0;
250          $text .= "\n";
251        }
252        else
253        {
254          $error = "While parsing $parsing: \@end $1 found without matching \@$1" unless $error;
255        }
256        next;
257      }
258      else
259      {
260        $text .= "$line\n";
261        next;
262      }
263    }
264    # look for @example, @format, @texinfo
265    if ($line =~ /^\s*\@(example|format|texinfo)\s*$/)
266    {
267      $special = 1;
268      if ($1 eq 'example')
269      {
270        $text .= "\@smallexample\n";
271        $in_example = 1;
272      }
273      elsif ($1 eq 'format')
274      {
275        $text .= "$line\n";
276        $in_format = 1;
277      }
278      else
279      {
280        $text .= "\n";
281        $in_texinfo = 1;
282      }
283      next;
284    }
285    my $ref = 'ref';
286    if ($line =~ /([^\@]|^)\@(code|math|xref|pxref|$ref){(.*?)}/)
287    {
288      my $l = $line;
289      $l =~ s/^\s*//;
290      $l =~ s/\s$//;
291      while ($l =~ /([^\@]|^)\@(code|math|xref|pxref|$ref){(.*?)}/)
292      {
293        $text .= CleanAscii($`.$1);
294        $text .= "\@$2\{$3\}";
295        $l = $';
296      }
297      $special = 1;
298      $text .= CleanAscii($l) . "\n";
299      next;
300    }
301    # break line if
302    $text .= '@*' 
303      if ($line =~ /\w/ 
304          && $pline =~ /\w/      # line and prev line are not empty
305          && $line !~ /^\s*\@\*/ # line does not start with @*
306          && $pline !~ /\@\*\s*/ # prev line does not end with @*
307          && length($pline) + $length < 60 # prev line is shorter than 60 chars
308          && ! $special);        # prev line was not special line
309    $line =~ s/^\s*//;
310    $line =~ s/\s$//;
311    $special = 0;
312    $text .= CleanAscii($line) . "\n";
313  }
314  $_ = $text;
315  s/^\s*//;
316  s/\s*$//;
317  $_ .= "\n";
318  if ($in_format || $in_texinfo || $in_example)
319  {
320    $error = "While parsing $parsing: no matching \@end " .
321      ($in_format ? "format" : ($in_texinfo ? "texinfo" : "example" )) .
322        " found"
323          unless $error;
324  }
325}
326
327sub CleanAscii
328{
329  my $a = shift;
330  $a =~ s/(\@([^\*]|$))/\@$1/g; # escape @ signs, except @*, @{, @}
331  $a =~ s/{/\@{/g; # escape {}
332  $a =~ s/}/\@}/g;
333  $a =~ s/\t/ /g;
334  $a =~ s/ +/ /g;         
335  return $a;
336}
337
338sub OutInfoItem
339{
340  my ($FH, $item, $text, $l_fun) = @_;
341  local $parsing  = $parsing . uc($item);
342
343  $item = lc $item;
344  $item = ucfirst $item;
345
346  if ($item =~ /see also/i)
347  {
348    # return references
349    return $text;
350  }
351  elsif ($item =~ m/example/i)
352  {
353    # forget about example, since it comes explicitely
354    return '';
355  }
356  elsif ($item =~ m/procedure/i)
357  {
358    if ($l_fun && $table_is_open)
359    {
360      print $FH "\@end table\n\n";
361      $table_is_open = 0;
362    }
363    $text =~ s/^\s*//;
364    $text =~ s/\s*$//;
365    $text =~ s/.*$// if ($text=~/parameters.*brackets.*are.*optional.*$/);
366    $text .= "\n";
367   
368    my ($proc, $pargs, $pinfo, $line);
369    if ($l_fun)
370    {
371      print $FH "\@strong{$item:}\n\@menu\n";
372    }
373    else
374    {
375      print $FH "\@item \@strong{$item:}\n\@table \@asis\n";
376    }
377    while ($text =~ /(.*\n)/g)
378    {
379      $line = $1;
380      if ($1 =~ /^\s*(\w+)\((.*?)\)/)
381      {
382        OutProcInfo($FH, $proc, $procargs, $pinfo, $l_fun) if $proc && $pinfo;
383        $proc = $1;
384        $procargs = $2;
385        $pinfo = $';
386      }
387      else
388      {
389        $pinfo .= $line; 
390      }
391    }
392    OutProcInfo($FH, $proc, $procargs, $pinfo, $l_fun) if $proc && $pinfo;
393    print $FH ($l_fun ? "\@end menu\n" : "\@end table\n");
394    return '';
395  }
396  elsif ($item =~ m/keywords/i || m/keyphrases/i)
397  {
398    # index entries
399    return OutKeywords($FH, $text);
400  }
401 
402  if (! $table_is_open)
403  {
404    print $FH "\@table \@asis\n";
405    $table_is_open = 1;
406  }
407  print $FH '@item @strong{'. "$item:}\n";
408  # prepare text:
409  local $_ = $text;
410  if (($item =~ m/^library/i)  && m/\s*(\w*)\.lib/)
411  {
412    print $FH "$1.lib\n";
413    $text = $';
414    if ($text =~ /\w/)
415    {
416      print $FH '@item @strong{Purpose:'."}\n";
417      if ($text !~ /[a-z]/)
418      {
419        print $FH lc $text;
420      }
421      else
422      {
423        print $FH $text;
424      }
425    }
426  }
427  else
428  {
429    # just print the text
430    FormatInfoText(length($item) + 1);
431    print $FH "$_\n";
432  }
433  return '';
434}
435
436sub OutProcInfo
437{
438  my($FH, $proc, $procargs, $pinfo, $l_fun) = @_;
439  local $_ = $pinfo;
440  s/^[;\s]*//;
441  s/\n/ /g;
442  FormatInfoText();
443  if ($l_fun)
444  {
445    print $FH "* ${proc}:: $_";
446    push @procs, $proc;
447  }
448  else
449  {
450    print $FH "\@item \@code{$proc($procargs)}  ";
451    print $FH "\n\@cindex $proc\n$_";
452  }
453}
454
455sub OutRef
456{
457  my ($FH, $refs) = @_;
458  $refs =~ s/^\s*//;
459  $refs =~ s/\s*$//;
460  $refs =~ s/\n/,/g;
461  my @refs = split (/[,;\.]+/, $refs);
462  my $ref;
463  print $FH "\@c ref\n";
464  $ref = shift @refs;
465  print $FH "\@ref{$ref}";
466  for $ref (@refs)
467  {
468    $ref =~ s/^\s*//;
469    $ref =~ s/\s*$//;
470    print $FH ", \@ref{$ref}"  if ($ref =~ /\w/);
471  }
472  print $FH "\n\@c ref\n\n";
473
474}
475
476sub OutKeywords
477{
478  my ($FH, $kws) = @_;
479  for $kw (split (/;/, $kws))
480  {
481    $kw =~ s/^\s*(.*?)\s*$/$1/;
482    print $FH "\@cindex $kw\n";
483  }
484}
485
486sub CleanUpExample
487{
488  local($lib, $example) = @_;
489 
490  # find portion in {}
491  $example =~ s/^[^{]*{(.*)}[^}]*$/$1/s;
492
493  if ($example =~ /EXAMPLE: \(not executed\)/)
494  {
495    # erase first three lines
496    $example =~ s/^.*\n.*\n.*\n/\n/;
497    # erase enclosing " " in every line
498    $example =~ s/\n\s*"/\n/g;
499    $example =~  s/";\n/\n/g;
500  }
501  # erase EXAMPLE, echo and pause statements
502  $example =~ s/"EXAMPLE.*"[^;]*;//g;
503  $example .= "\n";
504  my ($mexample, $line);
505  while ($example =~ m/(.*)\n/g)
506  {
507    $line = $1;
508    $line =~ s|echo[^;]*;||g if $line !~ m|(.*)//(.*)echo[^;]*;|;
509    $line =~ s|pause\(.*?\)[^;]*;||g if $line !~ m|(.*)//(.*)pause\(.*?\)[^;]*;|;
510    $mexample .= "$line\n";
511  }
512  $example = $mexample;
513  $example = undef unless $example =~ /\w/;
514  # prepend LIB command
515  $example = "LIB \"$lib.lib\";\n".$example 
516    if ($example && $lib ne "standard");
517  # erase empty lines
518  $example =~ s/^\s*\n//g;
519  # erase spaces from beginning of lines
520  $example =~ s/\n\s*/\n/g;
521  $example =~ s/\s*$//g;
522  return $example;
523}
524
525sub print_doc_header
526{
527  my $fh = shift;
528  ($hlp_file = $out_file) =~ s/doc$/hlp/;
529  print $fh <<EOT;
530\\input texinfo   \@c -*-texinfo-*-
531\@c %**start of header
532\@setfilename $hlp_file
533\@settitle Formatted manual of $lib.lib
534\@paragraphindent 0
535\@c %**end of header
536
537\@ifinfo
538This file documents contains the formatted documentation of $library
539\@end ifinfo
540
541\@titlepage
542\@title Formatted manual of $library
543\@end titlepage
544
545\@node Top, , , (dir)
546
547\@ifnottex
548This file contains the formatted documentation of $library
549\@end ifnottex
550
551\@menu
552* Singular libraries::
553* Index::
554\@end menu
555
556\@node Singular libraries, Index,,Top
557\@comment node-name,next, previous, up
558\@chapter Singular libraries
559
560\@menu
561* ${lib}_lib:: 
562\@end menu
563 
564\@node ${lib}_lib,,,Singular libraries
565\@section ${lib}_lib
566
567\@example
568-------BEGIN OF PART WHICH IS INCLUDED IN MANUAL-----
569\@end example
570
571
572EOT
573}
Note: See TracBrowser for help on using the repository browser.