source: git/doc/pl2doc.pl

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