doc/make-func-list.pl

   1 #!/usr/bin/perl
   2 # Task: convert gnumeric's function documentation into a valid DocBook XML
   3 # fragment.
   4
   5 # Input format: as produced by "sstest --dump-func-defs=file", i.e.
   6 # a series of chunks documenting functions. The chunks consist of a number
   7 # of lines. Lines are either
   8 # - @KEYWORD=value
   9 # - @{parameter name}: text
  10 # - a continuation of the previous line
  11 # Chunks are separated by empty lines, but note that lines in a chunk may
  12 # be empty, so empty lines are not always chunk separators.
  13 # Chunks may contain multiple @KEYWORD=value lines for the same keyword.
  14 # The various keywords have their own enum value in GnmFuncHelpType in
  15 # src/func.h .
  16
  17 use strict;
  18 use warnings;
  19 use diagnostics;
  20 use open IO => ':utf8';
  21 binmode STDOUT, ':utf8';
  22
  23 #
  24 # Global state that we need to track
  25 #
  26
  27 # On the input side (parser state):
  28 my $curcat = undef;     # Current category
  29 my $curfunc = undef;    # Current function name
  30 my $curkeyword = undef; # Current input marker (keyword)
  31
  32 # On the output side:
  33 my @tagstack = ();      # Closing tags that still need to be output at some
  34                         # future point for proper balance.
  35
  36 #
  37 # Helper functions
  38 #
  39
  40 sub quote_stuff($) {
  41         # Escape/quote the characters which are special in XML: ampersand,
  42         # less than sign and greater than sign.
  43         my ($str) = @_;
  44
  45         # Let's do this one first...
  46         $str =~ s/\&/\&amp;/gu;
  47
  48         $str =~ s/</\&lt;/gu;
  49         $str =~ s/>/\&gt;/gu;
  50         return $str;
  51 }
  52
  53 sub markup_stuff($) {
  54         my ($str) = @_;
  55
  56         $str = &quote_stuff ($str);
  57         $str =~ s/\b$curfunc\b/<function>$curfunc<\/function>/gu;
  58         $str =~ s/\@\{([^}]*)\}/<parameter>$1<\/parameter>/gu;
  59         $str =~ s/\@(\w*)\b/<parameter>$1<\/parameter>/gu;
  60         return $str;
  61 }
  62
  63 sub close_including($) {
  64         my ($tag) = @_;
  65         while (1) {
  66                 my $element = pop @tagstack;
  67                 last unless defined $element;
  68                 print "  " x scalar(@tagstack), $element, "\n";
  69         }
  70 }
  71
  72 sub close_upto($) {
  73         my ($tag) = @_;
  74         while (1) {
  75                 my $element = pop @tagstack;
  76                 last unless defined $element;
  77                 if ($element eq $tag) {
  78                         push @tagstack, $element;
  79                         last;
  80                 }
  81                 print "  " x scalar(@tagstack), $element, "\n";
  82         }
  83 }
  84
  85 #
  86 # Functions to process specific keywords
  87 #
  88
  89 sub processnotimplemented($) {
  90         die("Sorry, no code has been implemented yet to handle the $curkeyword keyword"),
  91 }
  92
  93 sub process_category($) {
  94         my ($cat) = @_;
  95         chomp($cat);
  96
  97         my $ws = "  " x scalar(@tagstack);
  98
  99         if ((not defined $curcat) or ($curcat ne $cat)) {
 100                 # Start of a new category.
 101
 102                 # Finish up the old one (if there is one)
 103                 close_including('</sect1>');
 104
 105                 # And start on the new one
 106                 my $cat_id = "CATEGORY_" . $cat;
 107                 $cat_id =~ s/\s+/_/gg;
 108                 $cat_id =~ s/[^A-Za-z_]//gu;
 109                 print $ws, "<sect1 id=\"$cat_id\">\n";
 110                 print $ws, "  <title>", &quote_stuff ($cat), "</title>\n";
 111                 push @tagstack, ('</sect1>');
 112         }
 113 }
 114
 115 sub process_function($) {
 116         my ($func) = @_;
 117
 118         my $ws = "  " x scalar(@tagstack);
 119         print $ws, "<refentry id=\"gnumeric-function-$func\">\n";
 120         print $ws, "  <refmeta>\n";
 121         print $ws, "    <refentrytitle><function>$func</function></refentrytitle>\n";
 122         print $ws, "  </refmeta>\n";
 123         print $ws, "  <refnamediv>\n";
 124         print $ws, "    <refname><function>$func</function></refname>\n";
 125         push @tagstack, ('</refentry>');
 126 }
 127
 128 sub process_short_desc($) {
 129         my ($desc) = @_;
 130
 131         my $ws = "  " x scalar(@tagstack);
 132         print $ws, "  <refpurpose>\n";
 133         print $ws, "    ", &markup_stuff ($desc), "\n";
 134         print $ws, "  </refpurpose>\n";
 135         print $ws, "</refnamediv>\n";
 136 }
 137
 138 sub process_description($) {
 139         my ($text) = @_;
 140         my $ws = "  " x scalar(@tagstack);
 141         print $ws, "<refsect1>\n";
 142         print $ws, "  <title>Description</title>\n";
 143         my $haveparameters = 0;
 144         foreach my $l (split(/\n/, $text)) {
 145                 if (!$haveparameters && $l =~ m/^\@\{/) {
 146                         $haveparameters = 1;
 147                 }
 148                 print $ws,"    <para>", &markup_stuff($l), "</para>\n";
 149         }
 150         print $ws, "</refsect1>\n";
 151 }
 152
 153 sub process_argumentdescription($) {
 154         my ($text) = @_;
 155         my $ws = "  " x scalar(@tagstack);
 156         print $ws, "<refsect1>\n";
 157         print $ws, "  <title>Arguments</title>\n";
 158         my $haveparameters = 0;
 159         foreach my $l (split(/\n/, $text)) {
 160                 if (!$haveparameters && $l =~ m/^\@\{/) {
 161                         $haveparameters = 1;
 162                 }
 163                 print $ws,"    <para>", &markup_stuff($l), "</para>\n";
 164         }
 165         print $ws, "</refsect1>\n";
 166 }
 167
 168 sub process_note($) {
 169         my ($text) = @_;
 170         my $ws = "  " x scalar(@tagstack);
 171         print $ws, "<refsect1>\n";
 172         print $ws, "  <title>Note</title>\n";
 173         foreach my $l (split(/\n/, $text)) {
 174                 print $ws,"    <para>", &markup_stuff($l), "</para>\n";
 175         }
 176         print $ws, "</refsect1>\n";
 177 }
 178
 179 sub process_excel($) {
 180         my ($text) = @_;
 181         my $ws = "  " x scalar(@tagstack);
 182         print $ws, "<refsect1>\n";
 183         print $ws, "  <title>Microsoft Excel Compatibility</title>\n";
 184         foreach my $l (split(/\n/, $text)) {
 185                 print $ws,"    <para>", &markup_stuff($l), "</para>\n";
 186         }
 187         print $ws, "</refsect1>\n";
 188 }
 189
 190 sub process_odf($) {
 191         my ($text) = @_;
 192         my $ws = "  " x scalar(@tagstack);
 193         print $ws, "<refsect1>\n";
 194         print $ws, "  <title>OpenDocument Format (ODF) Compatibility</title>\n";
 195         foreach my $l (split(/\n/, $text)) {
 196                 print $ws,"    <para>", &markup_stuff($l), "</para>\n";
 197         }
 198         print $ws, "</refsect1>\n";
 199 }
 200
 201 sub process_syntax($) {
 202         my ($str) = @_;
 203         my $ws = "  " x scalar(@tagstack);
 204         $str = &markup_stuff ($str);
 205         $str =~ s/([\(\,])(\w*)/$1<parameter>$2<\/parameter>/gu;
 206         print $ws, "<refsynopsisdiv>\n";
 207         print $ws, "  <synopsis>$str</synopsis>\n";
 208         print $ws, "</refsynopsisdiv>\n";
 209 }
 210
 211 sub process_examples($) {
 212         my ($text) = @_;
 213         my $ws = "  " x scalar(@tagstack);
 214         print $ws, "<refsect1>\n";
 215         print $ws, "   <title>Examples</title>\n";
 216         print $ws, "   <para>", &markup_stuff ($text), "</para>\n";
 217         push @tagstack, ('</refsect1>');
 218 }
 219
 220 sub process_seealso($) {
 221         my ($text) = @_;
 222
 223         my $linktxt = $text;
 224         $linktxt =~ s/\s//gu;
 225         $linktxt =~ s/\.$//u;
 226         my @links = split (/,/, $linktxt);
 227
 228         my $ws = "  " x scalar(@tagstack);
 229         print $ws, "<refsect1>\n";
 230         print $ws, "  <title>See also</title>\n";
 231         my @a = ();
 232         print $ws, "  <para>\n";
 233         foreach my $link (@links) {
 234             push @a, $ws . "    <link linkend=\"gnumeric-function-$link\"><function>$link</function></link>";
 235         }
 236         if (scalar(@a) > 0) {
 237             print join (",\n", @a), ".\n";
 238         }
 239         print $ws, "  </para>\n";
 240         push @tagstack, ('</refsect1>');
 241 }
 242
 243 my %processor = (
 244         'CATEGORY'      => \&process_category,
 245         'FUNCTION'      => \&process_function,
 246         'SHORTDESC'     => \&process_short_desc,
 247         'SYNTAX'        => \&process_syntax,
 248         'ARGUMENTDESCRIPTION'   => \&process_argumentdescription,
 249         'DESCRIPTION'   => \&process_description,
 250         'SEEALSO'       => \&process_seealso,
 251         'NOTE'          => \&process_note,
 252         'EXCEL'         => \&process_excel,
 253         'ODF'           => \&process_odf,
 254 );
 255
 256 sub process_chunk(@) {
 257         my (@chunk) = @_;
 258         return unless scalar(@chunk) > 0;
 259
 260         # Trim off any trailing empty lines
 261         while (scalar(@chunk) > 0) {
 262                 last unless $chunk[$#chunk] =~ /^\s*$/;
 263                 pop @chunk;
 264         }
 265
 266         my $cat;
 267         my $in_description = 0;
 268
 269         $curkeyword = undef;
 270         my $lines = "";
 271         for my $i (0..$#chunk) {
 272                 my $chunk = $chunk[$i];
 273                 chomp $chunk;
 274
 275                 if ($chunk =~ m/^\@(\w+)=(.*)/) {
 276                         my ($key, $val) = (uc($1), $2);
 277
 278                         $cat = $val if ($key eq 'CATEGORY');
 279                         $curfunc = $val if ($key eq 'FUNCTION');
 280
 281                         if (defined($processor{$key})) {
 282                                 if (defined($curkeyword)) {
 283                                         # Process the previous tag for which
 284                                         # all lines have been gathered now.
 285                                         &{$processor{$curkeyword}}($lines);
 286                                 }
 287                                 $curkeyword = $key;
 288                                 $lines = $val;
 289                                 next;
 290                         } else {
 291                                 die("Unrecognised keyword: $key\n");
 292                         }
 293                 }
 294                 $lines .= "\n" . $chunk;
 295         }
 296         &{$processor{$curkeyword}}($lines);
 297
 298         $curcat = $cat;
 299
 300         close_upto('</sect1>'); # Closing tag of a category.
 301 }
 302
 303 sub main() {
 304         my $line;
 305         my @chunk = ();
 306         while ($line = <>) {
 307                 if ($line =~ m/^\@CATEGORY=/) {
 308                         # We're at the start of a new chunk of function
 309                         # documentation
 310                         process_chunk(@chunk);
 311                         print "\n";
 312                         @chunk = ($line);
 313                 } else {
 314                         push @chunk, $line;
 315                 }
 316         }
 317         process_chunk(@chunk);
 318         while (my $el = pop @tagstack) {
 319                 print "  " x scalar(@tagstack), $el, "\n";
 320         }
 321 }
 322
 323 main();
 324 exit(0);