source: git/doc/pl2doc.pl @ 522906

jengelh-datetimespielwiese
Last change on this file since 522906 was 522906, checked in by Bernhard R. Link <brlink@…>, 11 years ago
tag more examples Add a way to tag all examples from a .lib file included. Use this new feature to tag some libs needed external programs, special features or significant memory usage in order to be able to build documentation on more machines. Make DOC2TEX_EXAMPLE_EXCLUSIONS a make variable, so that this setting can also be overridden at make invocation time.
  • Property mode set to 100755
File size: 12.9 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 explicitely
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.