source: git/doc/pl2doc.pl @ 6ce030f

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