source: git/doc/pl2doc.pl @ 7aebcd

spielwiese
Last change on this file since 7aebcd was 499cae, checked in by Hans Schönemann <hannes@…>, 23 years ago
*hannes: again PROCEDURES git-svn-id: file:///usr/local/Singular/svn/trunk@5147 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100755
File size: 12.6 KB
Line 
1#!/usr/local/bin/perl
2# $Id: pl2doc.pl,v 1.20 2001-01-31 17:48:08 Singular 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      if ($CHECKSUMS{$key} == "sprintf")
136      {
137        print CD "q{$key}, \"sprintf\",\n";
138      }
139      else
140      {
141        print CD "q{$key}, $CHECKSUMS{$key},\n";
142      }
143    }
144    print CD ");\n";
145    close(CD);
146  }
147}
148
149#
150# und Tschuess
151#
152if ($doc)
153{
154 print LDOC <<EOT;
155\@c ----------------------------------------------------------
156\@node Index, , Singular libraries, Top
157\@chapter Index
158\@printindex cp
159
160\@bye
161EOT
162}
163 
164close(LDOC);
165if ($error)
166{
167  print STDERR "ERROR: $error\n";
168  exit(1);
169}
170exit(0);
171
172###########################################################################
173#
174# parse and print-out libinfo
175#
176sub OutLibInfo
177{
178  my ($FH, $info, $l_fun) = @_;
179  if ($info =~ /^\@/)
180  {
181    print $FH $info;
182    return;
183  }
184  print $FH "\@table \@asis\n";
185  $table_is_open = 1;
186 
187  my ($ref) = OutInfo($FH, $info, $l_fun);
188
189  print $FH "\@end table\n" if $table_is_open;
190  $table_is_open = 0;
191  return $ref;
192}
193
194sub OutInfo
195{
196  my ($FH, $info, $l_fun) = @_;
197  if ($info =~ /^\@/)
198  {
199    print $FH $info;
200    return;
201  }
202  $info =~ s/^\s*//;
203  $info =~ s/\s*$//;
204  $info .= "\n";
205
206  my ($item, $text, $line, $ref);
207  while ($info =~ m/(.*\n)/g)
208  {
209    $line = $1;
210    if ($1 =~ /^([A-Z][A-Z0-9 ]+?):(.*\n)/)
211    {
212      $ref .= OutInfoItem($FH, $item, $text, $l_fun) if $item && $text;
213      $item = $1;
214      $text = $2;
215    }
216    else
217    {
218      $text .= $line;
219    }
220  }
221  $ref .= OutInfoItem($FH, $item, $text, $l_fun) if $item && $text;
222  return $ref;
223}
224
225sub FormatInfoText
226{
227  my $length = shift;
228  my ($pline, $line, $text, $ptext, $special);
229  my ($in_format, $in_example, $in_texinfo);
230
231  $length = 0 unless $length;
232  $_ .= "\n";
233  $ptext = $_;
234  while ($ptext =~ /(.*)\n/g)
235  {
236    $pline = $line;
237    $line = $1;
238    # check whether we are in protected env
239    if ($in_format || $in_example || $in_texinfo)
240    {
241      # end protected env?
242      if ($line =~ /^\s*\@end (format|example|texinfo)\s*$/)
243      {
244        if ($in_format && $1 eq 'format')
245        {
246          $in_format = 0;
247          $text .= "$line\n";
248        }
249        elsif ($in_example && $1 eq 'example')
250        {
251          $in_example = 0;
252          $text .= "\@end smallexample\n";
253        }
254        elsif ($in_texinfo && $1 eq 'texinfo')
255        {
256          $in_texinfo = 0;
257          $text .= "\n";
258        }
259        else
260        {
261          $error = "While parsing $parsing: \@end $1 found without matching \@$1" unless $error;
262        }
263        next;
264      }
265      else
266      {
267        $text .= "$line\n";
268        next;
269      }
270    }
271    # look for @example, @format, @texinfo
272    if ($line =~ /^\s*\@(example|format|texinfo)\s*$/)
273    {
274      $special = 1;
275      if ($1 eq 'example')
276      {
277        $text .= "\@smallexample\n";
278        $in_example = 1;
279      }
280      elsif ($1 eq 'format')
281      {
282        $text .= "$line\n";
283        $in_format = 1;
284      }
285      else
286      {
287        $text .= "\n";
288        $in_texinfo = 1;
289      }
290      next;
291    }
292    my $ref = 'ref';
293    if ($line =~ /([^\@]|^)\@(code|math|xref|pxref|$ref){(.*?)}/)
294    {
295      my $l = $line;
296      $l =~ s/^\s*//;
297      $l =~ s/\s$//;
298      while ($l =~ /([^\@]|^)\@(code|math|xref|pxref|$ref){(.*?)}/)
299      {
300        $text .= CleanAscii($`.$1);
301        $text .= "\@$2\{$3\}";
302        $l = $';
303      }
304      $special = 1;
305      $text .= CleanAscii($l) . "\n";
306      next;
307    }
308    # break line if
309    $text .= '@*' 
310      if ($line =~ /\w/ 
311          && $pline =~ /\w/      # line and prev line are not empty
312          && $line !~ /^\s*\@\*/ # line does not start with @*
313          && $pline !~ /\@\*\s*/ # prev line does not end with @*
314          && length($pline) + $length < 60 # prev line is shorter than 60 chars
315          && ! $special);        # prev line was not special line
316    $line =~ s/^\s*//;
317    $line =~ s/\s$//;
318    $special = 0;
319    $text .= CleanAscii($line) . "\n";
320  }
321  $_ = $text;
322  s/^\s*//;
323  s/\s*$//;
324  $_ .= "\n";
325  if ($in_format || $in_texinfo || $in_example)
326  {
327    $error = "While parsing $parsing: no matching \@end " .
328      ($in_format ? "format" : ($in_texinfo ? "texinfo" : "example" )) .
329        " found"
330          unless $error;
331  }
332}
333
334sub CleanAscii
335{
336  my $a = shift;
337  $a =~ s/(\@([^\*]|$))/\@$1/g; # escape @ signs, except @*, @{, @}
338  $a =~ s/{/\@{/g; # escape {}
339  $a =~ s/}/\@}/g;
340  $a =~ s/\t/ /g;
341  $a =~ s/ +/ /g;         
342  return $a;
343}
344
345sub OutInfoItem
346{
347  my ($FH, $item, $text, $l_fun) = @_;
348  local $parsing  = $parsing . uc($item);
349
350  $item = lc $item;
351  $item = ucfirst $item;
352
353  if ($item =~ /see also/i)
354  {
355    # return references
356    return $text;
357  }
358  elsif ($item =~ m/example/i)
359  {
360    # forget about example, since it comes explicitely
361    return '';
362  }
363  elsif ($item =~ m/procedure/i)
364  {
365    if ($l_fun && $table_is_open)
366    {
367      print $FH "\@end table\n\n";
368      $table_is_open = 0;
369    }
370    $text =~ s/^\s*//;
371    $text =~ s/\s*$//;
372    $text =~ s/.*$// if ($text=~/parameters.*brackets.*are.*optional.*$/);
373    $text .= "\n";
374   
375    my ($proc, $pargs, $pinfo, $line);
376    if ($l_fun)
377    {
378      print $FH "\@strong{$item:}\n\@menu\n";
379    }
380    else
381    {
382      print $FH "\@item \@strong{$item:}\n\@table \@asis\n";
383    }
384    while ($text =~ /(.*\n)/g)
385    {
386      $line = $1;
387      if ($1 =~ /^\s*(\w+)\((.*?)\)/)
388      {
389        OutProcInfo($FH, $proc, $procargs, $pinfo, $l_fun) if $proc && $pinfo;
390        $proc = $1;
391        $procargs = $2;
392        $pinfo = $';
393      }
394      else
395      {
396        $pinfo .= $line; 
397      }
398    }
399    OutProcInfo($FH, $proc, $procargs, $pinfo, $l_fun) if $proc && $pinfo;
400    print $FH ($l_fun ? "\@end menu\n" : "\@end table\n");
401    return '';
402  }
403  elsif ($item =~ m/keywords/i || m/keyphrases/i)
404  {
405    # index entries
406    return OutKeywords($FH, $text);
407  }
408 
409  if (! $table_is_open)
410  {
411    print $FH "\@table \@asis\n";
412    $table_is_open = 1;
413  }
414  print $FH '@item @strong{'. "$item:}\n";
415  # prepare text:
416  local $_ = $text;
417  if (($item =~ m/^library/i)  && m/\s*(\w*)\.lib/)
418  {
419    print $FH "$1.lib\n";
420    $text = $';
421    if ($text =~ /\w/)
422    {
423      print $FH '@item @strong{Purpose:'."}\n";
424      if ($text !~ /[a-z]/)
425      {
426        print $FH lc $text;
427      }
428      else
429      {
430        print $FH $text;
431      }
432    }
433  }
434  else
435  {
436    # just print the text
437    FormatInfoText(length($item) + 1);
438    print $FH "$_\n";
439  }
440  return '';
441}
442
443sub OutProcInfo
444{
445  my($FH, $proc, $procargs, $pinfo, $l_fun) = @_;
446  local $_ = $pinfo;
447  s/^[;\s]*//;
448  s/\n/ /g;
449  FormatInfoText();
450  if ($l_fun)
451  {
452    print $FH "* ${proc}:: $_";
453    push @procs, $proc;
454  }
455  else
456  {
457    print $FH "\@item \@code{$proc($procargs)}  ";
458    print $FH "\n\@cindex $proc\n$_";
459  }
460}
461
462sub OutRef
463{
464  my ($FH, $refs) = @_;
465  $refs =~ s/^\s*//;
466  $refs =~ s/\s*$//;
467  $refs =~ s/\n/,/g;
468  my @refs = split (/[,;\.]+/, $refs);
469  my $ref;
470  print $FH "\@c ref\n";
471  $ref = shift @refs;
472  print $FH "\@ref{$ref}";
473  for $ref (@refs)
474  {
475    $ref =~ s/^\s*//;
476    $ref =~ s/\s*$//;
477    print $FH ", \@ref{$ref}"  if ($ref =~ /\w/);
478  }
479  print $FH "\n\@c ref\n\n";
480
481}
482
483sub OutKeywords
484{
485  my ($FH, $kws) = @_;
486  for $kw (split (/;/, $kws))
487  {
488    $kw =~ s/^\s*(.*?)\s*$/$1/;
489    print $FH "\@cindex $kw\n";
490  }
491}
492
493sub CleanUpExample
494{
495  local($lib, $example) = @_;
496 
497  # find portion in {}
498  $example =~ s/^[^{]*{(.*)}[^}]*$/$1/s;
499
500  if ($example =~ /EXAMPLE: \(not executed\)/)
501  {
502    # erase first three lines
503    $example =~ s/^.*\n.*\n.*\n/\n/;
504    # erase enclosing " " in every line
505    $example =~ s/\n\s*"/\n/g;
506    $example =~  s/";\n/\n/g;
507  }
508  # erase EXAMPLE, echo and pause statements
509  $example =~ s/"EXAMPLE.*"[^;]*;//g;
510  $example .= "\n";
511  my ($mexample, $line);
512  while ($example =~ m/(.*)\n/g)
513  {
514    $line = $1;
515    $line =~ s|echo[^;]*;||g if $line !~ m|(.*)//(.*)echo[^;]*;|;
516    $line =~ s|pause\(.*?\)[^;]*;||g if $line !~ m|(.*)//(.*)pause\(.*?\)[^;]*;|;
517    $mexample .= "$line\n";
518  }
519  $example = $mexample;
520  $example = undef unless $example =~ /\w/;
521  # prepend LIB command
522  $example = "LIB \"$lib.lib\";\n".$example 
523    if ($example && $lib ne "standard");
524  # erase empty lines
525  $example =~ s/^\s*\n//g;
526  # erase spaces from beginning of lines
527  $example =~ s/\n\s*/\n/g;
528  $example =~ s/\s*$//g;
529  return $example;
530}
531
532sub print_doc_header
533{
534  my $fh = shift;
535  ($hlp_file = $out_file) =~ s/doc$/hlp/;
536  print $fh <<EOT;
537\\input texinfo   \@c -*-texinfo-*-
538\@c %**start of header
539\@setfilename $hlp_file
540\@settitle Formatted manual of $lib.lib
541\@paragraphindent 0
542\@c %**end of header
543
544\@ifinfo
545This file documents contains the formatted documentation of $library
546\@end ifinfo
547
548\@titlepage
549\@title Formatted manual of $library
550\@end titlepage
551
552\@node Top, , , (dir)
553
554\@ifnottex
555This file contains the formatted documentation of $library
556\@end ifnottex
557
558\@menu
559* Singular libraries::
560* Index::
561\@end menu
562
563\@node Singular libraries, Index,,Top
564\@comment node-name,next, previous, up
565\@chapter Singular libraries
566
567\@menu
568* ${lib}_lib:: 
569\@end menu
570 
571\@node ${lib}_lib,,,Singular libraries
572\@section ${lib}_lib
573
574\@example
575-------BEGIN OF PART WHICH IS INCLUDED IN MANUAL-----
576\@end example
577
578
579EOT
580}
Note: See TracBrowser for help on using the repository browser.