gtkdoc-common.pl.in

   1 #!@PERL@ -w
   2 # -*- cperl -*-
   3 #
   4 # gtk-doc - GTK DocBook documentation generator.
   5 # Copyright (C) 2001  Damon Chaplin
   6 #
   7 # This program is free software; you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 2 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # This program is distributed in the hope that it will be useful,
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program; if not, write to the Free Software
  19 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  20 #
  21
  22 #
  23 # These are functions used by several of the gtk-doc Perl scripts.
  24 # We'll move more of the common routines here eventually, though they need to
  25 # stop using global variables first.
  26 #
  27
  28 1;
  29
  30
  31 #############################################################################
  32 # Function    : UpdateFileIfChanged
  33 # Description : Compares the old version of the file with the new version and
  34 #               if the file has changed it moves the new version into the old
  35 #               versions place. This is used so we only change files if
  36 #               needed, so we can do proper dependency tracking and we don't
  37 #               needlessly check files into version control systems that haven't
  38 #               changed.
  39 #               It returns 0 if the file hasn't changed, and 1 if it has.
  40 # Arguments   : $old_file - the pathname of the old file.
  41 #               $new_file - the pathname of the new version of the file.
  42 #               $make_backup - 1 if a backup of the old file should be kept.
  43 #                       It will have the .bak suffix added to the file name.
  44 #############################################################################
  45
  46 sub UpdateFileIfChanged {
  47     my ($old_file, $new_file, $make_backup) = @_;
  48
  49     #print "Comparing $old_file with $new_file...\n";
  50
  51     # If the old file doesn't exist we want this to default to 1.
  52     my $exit_code = 1;
  53
  54     if (-e $old_file) {
  55         `cmp -s "$old_file" "$new_file"`;
  56         $exit_code = $? >> 8;
  57         #print "   cmp exit code: $exit_code ($?)\n";
  58     }
  59
  60     if ($exit_code > 1) {
  61         die "Error running 'cmp $old_file $new_file'";
  62     }
  63
  64     if ($exit_code == 1) {
  65         #print "   files changed - replacing old version with new version.\n";
  66         if ($make_backup && -e $old_file) {
  67             rename ($old_file, "$old_file.bak")
  68                 || die "Can't move $old_file to $old_file.bak: $!";
  69         }
  70         rename ($new_file, $old_file)
  71             || die "Can't move $new_file to $old_file: $!";
  72
  73         return 1;
  74     } else {
  75         #print "   files the same - deleting new version.\n";
  76         unlink ("$new_file")
  77             || die "Can't delete file: $new_file: $!";
  78
  79         return 0;
  80     }
  81 }
  82
  83
  84 #############################################################################
  85 # Function    : ParseStructDeclaration
  86 # Description : This function takes a structure declaration and
  87 #               breaks it into individual type declarations.
  88 # Arguments   : $declaration - the declaration to parse
  89 #               $is_object - true if this is an object structure
  90 #               $output_function_params - true if full type is wanted for
  91 #                                         function pointer members
  92 #               $typefunc - function reference to apply to type
  93 #               $namefunc - function reference to apply to name
  94 #############################################################################
  95
  96 sub ParseStructDeclaration {
  97     my ($declaration, $is_object, $output_function_params, $typefunc, $namefunc) = @_;
  98
  99     # For forward struct declarations just return an empty array.
 100     if ($declaration =~ m/(?:struct|union)\s+\S+\s*;/msg) {
 101       return ();
 102     }
 103
 104     # Remove all private parts of the declaration
 105
 106     # For objects, assume private
 107     if ($is_object) {
 108         $declaration =~ s!((?:struct|union)\s+\w*\s*\{)
 109                           .*?
 110                           (?:/\*\s*<\s*public\s*>\s*\*/|(?=\}))!$1!msgx;
 111     }
 112
 113     # Remove private symbols
 114     # Assume end of declaration if line begins with '}'
 115     $declaration =~ s!\n?[ \t]*/\*\s*<\s*(private|protected)\s*>\s*\*/.*?(?:/\*\s*<\s*public\s*>\s*\*/|(?=^\}))!!msgx;
 116
 117     # Remove all other comments;
 118     $declaration =~ s@/\*([^*]+|\*(?!/))*\*/@ @g;
 119     $declaration =~ s@//.*@@g;
 120
 121     my @result = ();
 122
 123     if ($declaration =~ /^\s*$/) {
 124         return @result;
 125     }
 126
 127     # Prime match after "struct/union {" declaration
 128     if (!scalar($declaration =~ m/(?:struct|union)\s+\w*\s*\{/msg)) {
 129         die "Declaration '$declaration' does not begin with struct/union [NAME] {\n";
 130     }
 131
 132     #print "DEBUG: public fields in struct/union: $declaration\n";
 133
 134     # Treat lines in sequence, allowing singly nested anonymous structs
 135     # and unions.
 136     while ($declaration =~ m/\s*([^{;]+(\{[^\}]*\}[^{;]+)?);/msg) {
 137         my $line = $1;
 138
 139         last if $line =~ /^\s*\}\s*\w*\s*$/;
 140
 141         # FIXME: Just ignore nested structs and unions for now
 142         next if $line =~ /{/;
 143
 144         # ignore preprocessor directives
 145         while ($line =~ /^#.*?\n\s*(.*)/msg) {
 146             $line=$1;
 147         }
 148
 149         last if $line =~ /^\s*\}\s*\w*\s*$/;
 150
 151         # Try to match structure members which are functions
 152         if ($line =~ m/^
 153                  (const\s+|G_CONST_RETURN\s+|unsigned\s+|signed\s+|long\s+|short\s+)*(struct\s+|enum\s+)?  # mod1
 154                  (\w+)\s*                             # type
 155                  (\**(?:\s*restrict)?)\s*             # ptr1
 156                  (const\s+)?                          # mod2
 157                  (\**\s*)                             # ptr2
 158                  (const\s+)?                          # mod3
 159                  \(\s*\*\s*(\w+)\s*\)\s*              # name
 160                  \(([^)]*)\)\s*                       # func_params
 161                             $/x) {
 162
 163             my $mod1 = defined($1) ? $1 : "";
 164             if (defined($2)) { $mod1 .= $2; }
 165             my $type = $3;
 166             my $ptr1 = $4;
 167             my $mod2 = defined($5) ? $5 : "";
 168             my $ptr2 = $6;
 169             my $mod3 = defined($7) ? $7 : "";
 170             my $name = $8;
 171             my $func_params = $9;
 172             my $ptype = defined $typefunc ? $typefunc->($type, "<type>$type</type>") : $type;
 173             my $pname = defined $namefunc ? $namefunc->($name) : $name;
 174
 175             push @result, $name;
 176
 177             if ($output_function_params) {
 178               push @result, "$mod1$ptype$ptr1$mod2$ptr2$mod3 (*$pname) ($func_params)";
 179             } else {
 180               push @result, "$pname&#160;()";
 181             }
 182
 183
 184         # Try to match normal struct fields of comma-separated variables/
 185         } elsif ($line =~ m/^
 186             ((?:const\s+|volatile\s+|unsigned\s+|signed\s+|short\s+|long\s+)?)(struct\s+|enum\s+)? # mod1
 187             (\w+)\s*                            # type
 188             (\** \s* const\s+)?                 # mod2
 189             (.*)                                # variables
 190             $/x) {
 191
 192             my $mod1 = defined($1) ? $1 : "";
 193             if (defined($2)) { $mod1 .= $2; }
 194             my $type = $3;
 195             my $ptype = defined $typefunc ? $typefunc->($type, "<type>$type</type>") : $type;
 196             my $mod2 = defined($4) ? " " . $4 : "";
 197             my $list = $5;
 198
 199             #print "'$mod1' '$type' '$mod2' '$list' \n";
 200
 201             $mod1 =~ s/ /&#160;/g;
 202             $mod2 =~ s/ /&#160;/g;
 203
 204             my @names = split /,/, $list;
 205             for my $n (@names) {
 206                 # Each variable can have any number of '*' before the
 207                 # identifier, and be followed by any number of pairs of
 208                 # brackets or a bit field specifier.
 209                 # e.g. *foo, ***bar, *baz[12][23], foo : 25.
 210                 if ($n =~ m/^\s* (\**(?:\s*restrict\b)?) \s* (\w+) \s* (?: ((?:\[[^\]]*\]\s*)+) | (:\s*\d+)?) \s* $/x) {
 211                     my $ptrs = $1;
 212                     my $name = $2;
 213                     my $array = defined($3) ? $3 : "";
 214                     my $bits =  defined($4) ? " $4" : "";
 215
 216                     if ($ptrs && $ptrs !~ m/\*$/) { $ptrs .= " "; }
 217                     $array =~ s/ /&#160;/g;
 218                     $bits =~ s/ /&#160;/g;
 219
 220                     push @result, $name;
 221                     if (defined $namefunc) {
 222                         $name = $namefunc->($name);
 223                     }
 224                     push @result, "$mod1$ptype$mod2&#160;$ptrs$name$array$bits;";
 225
 226                     #print "***** Matched line: $mod1$ptype$mod2 $ptrs$name$array$bits\n";
 227                 } else {
 228                     print "WARNING: Couldn't parse struct field: $n\n";
 229                 }
 230             }
 231
 232         } else {
 233             print "WARNING: Cannot parse structure field: \"$line\"\n";
 234         }
 235     }
 236
 237     return @result;
 238 }
 239
 240
 241 #############################################################################
 242 # Function    : ParseEnumDeclaration
 243 # Description : This function takes a enumeration declaration and
 244 #               breaks it into individual enum member declarations.
 245 # Arguments   : $declaration - the declaration to parse
 246 #############################################################################
 247
 248 sub ParseEnumDeclaration {
 249     my ($declaration, $is_object) = @_;
 250
 251     # For forward enum declarations just return an empty array.
 252     if ($declaration =~ m/enum\s+\S+\s*;/msg) {
 253         return ();
 254     }
 255
 256     # Remove private symbols
 257     # Assume end of declaration if line begins with '}'
 258     $declaration =~ s!\n?[ \t]*/\*\s*<\s*(private|protected)\s*>\s*\*/.*?(?:/\*\s*<\s*public\s*>\s*\*/|(?=^\}))!!msgx;
 259
 260     # Remove comments
 261     $declaration =~ s@/\*([^*]+|\*(?!/))*\*/@ @g;
 262     $declaration =~ s@//.*$@@g;
 263
 264     my @result = ();
 265
 266     if ($declaration =~ /^\s*$/) {
 267         return @result;
 268     }
 269
 270     # Remove parenthesized expressions (in macros like GTK_BLAH = BLAH(1,3))
 271     # to avoid getting confused by commas they might contain. This
 272     # doesn't handle nested parentheses correctly.
 273
 274     $declaration =~ s/\([^)]+\)//g;
 275
 276     # Remove comma from comma - possible whitespace - closing brace sequence
 277     # since it is legal in GNU C and C99 to have a trailing comma but doesn't
 278     # result in an actual enum member
 279
 280     $declaration =~ s/,(\s*})/$1/g;
 281
 282     # Prime match after "typedef enum {" declaration
 283     if (!scalar($declaration =~ m/(typedef\s+)?enum\s*(\S+\s*)?\{/msg)) {
 284         die "Enum declaration '$declaration' does not begin with 'typedef enum {' or 'enum XXX {'\n";
 285     }
 286
 287     # Treat lines in sequence.
 288     while ($declaration =~ m/\s*([^,\}]+)([,\}])/msg) {
 289         my $line = $1;
 290         my $terminator = $2;
 291
 292         # ignore preprocessor directives
 293         while ($line =~ /^#.*?\n\s*(.*)/msg) {
 294             $line=$1;
 295         }
 296
 297         if ($line =~ m/^(\w+)\s*(=.*)?$/msg) {
 298             push @result, $1;
 299
 300         # Special case for GIOCondition, where the values are specified by
 301         # macros which expand to include the equal sign like '=1'.
 302         } elsif ($line =~ m/^(\w+)\s*GLIB_SYSDEF_POLL/msg) {
 303             push @result, $1;
 304
 305         # Special case include of <gdk/gdkcursors.h>, just ignore it
 306         } elsif ($line =~ m/^#include/) {
 307             last;
 308
 309         # Special case for #ifdef/#else/#endif, just ignore it
 310         } elsif ($line =~ m/^#(?:if|else|endif)/) {
 311             last;
 312
 313         } else {
 314             warn "Cannot parse enumeration member \"$line\"";
 315         }
 316
 317         last if $terminator eq '}';
 318     }
 319
 320     return @result;
 321 }
 322
 323
 324 #############################################################################
 325 # Function    : ParseFunctionDeclaration
 326 # Description : This function takes a function declaration and
 327 #               breaks it into individual parameter declarations.
 328 # Arguments   : $declaration - the declaration to parse
 329 #               $typefunc - function reference to apply to type
 330 #               $namefunc - function reference to apply to name
 331 #############################################################################
 332
 333 sub ParseFunctionDeclaration {
 334     my ($declaration, $typefunc, $namefunc) = @_;
 335
 336     my @result = ();
 337
 338     my ($param_num) = 0;
 339     while ($declaration ne "") {
 340         #print "$declaration";
 341
 342         if ($declaration =~ s/^[\s,]+//) {
 343             # skip whitespace and commas
 344             next;
 345
 346         } elsif ($declaration =~ s/^void\s*[,\n]//) {
 347             if ($param_num != 0) {
 348                 # FIXME: whats the problem here?
 349                 warn "void used as parameter in function $declaration";
 350             }
 351             push @result, "void";
 352             my $xref = "<type>void</type>";
 353             my $label = defined $namefunc ? $namefunc->($xref) : $xref;
 354             push @result, $label;
 355
 356         } elsif ($declaration =~ s/^...\s*[,\n]//) {
 357             push @result, "Varargs";
 358             my $label = defined $namefunc ? $namefunc->("...") : "...";
 359             push @result, $label;
 360
 361         # allow alphanumerics, '_', '[' & ']' in param names
 362         # Try to match a standard parameter
 363         #                               $1                                                                                                                                            $2                             $3                                                                                                $4       $5
 364         } elsif ($declaration =~ s/^\s*((?:(?:G_CONST_RETURN|G_GNUC_[A-Z_]+\s+|unsigned long|unsigned short|signed long|signed short|unsigned|signed|long|short|volatile|const)\s+)*)((?:struct\b|enum\b)?\s*\w+)\s*((?:(?:const\b|restrict\b|G_GNUC_[A-Z_]+\b)?\s*\*?\s*(?:const\b|restrict\b|G_GNUC_[A-Z_]+\b)?\s*)*)(\w+)?\s*((?:\[\S*\])*)\s*[,\n]//) {
 365             my $pre     = defined($1) ? $1 : "";
 366             my $type    = $2;
 367             my $ptr     = defined($3) ? $3 : "";
 368             my $name    = defined($4) ? $4 : "";
 369             my $array   = defined($5) ? $5 : "";
 370
 371             $pre  =~ s/\s+/ /g;
 372             $type =~ s/\s+/ /g;
 373             $ptr  =~ s/\s+/ /g;
 374             $ptr  =~ s/\s+$//;
 375             if ($ptr && $ptr !~ m/\*$/) { $ptr .= " "; }
 376
 377             #print "$symbol: '$pre' '$type' '$ptr' '$name' '$array'\n";
 378
 379             if (($name eq "") && $pre =~ m/^((un)?signed .*)\s?/ ) {
 380                 $name = $type;
 381                 $type = "$1";
 382                 $pre = "";
 383             }
 384
 385             if ($name eq "") {
 386                 $name = "Param" . ($param_num + 1);
 387             }
 388
 389             #print "$symbol: '$pre' '$type' '$ptr' '$name' '$array'\n";
 390
 391             push @result, $name;
 392             my $xref = defined $typefunc ? $typefunc->($type, "<type>$type</type>") : $type;
 393             my $label   = "$pre$xref $ptr$name$array";
 394             if (defined $namefunc) {
 395                 $label = $namefunc->($label)
 396             }
 397             push @result, $label;
 398
 399         # Try to match parameters which are functions
 400         #                            $1                                                                  $2          $3      $4                        $5              $6            $7             $8
 401         } elsif ($declaration =~ s/^(const\s+|G_CONST_RETURN\s+|G_GNUC_[A-Z_]+\s+|signed\s+|unsigned\s+)*(struct\s+)?(\w+)\s*(\**)\s*(?:restrict\b)?\s*(const\s+)?\(\s*(\*[\s\*]*)\s*(\w+)\s*\)\s*\(([^)]*)\)\s*[,\n]//) {
 402             my $mod1 = defined($1) ? $1 : "";
 403             if (defined($2)) { $mod1 .= $2; }
 404             my $type = $3;
 405             my $ptr1 = $4;
 406             my $mod2 = defined($5) ? $5 : "";
 407             my $func_ptr = $6;
 408             my $name = $7;
 409             my $func_params = defined($8) ? $8 : "";
 410
 411             #if (!defined($type)) { print "## no type\n"; };
 412             #if (!defined($ptr1)) { print "## no ptr1\n"; };
 413             #if (!defined($func_ptr)) { print "## no func_ptr\n"; };
 414             #if (!defined($name)) { print "## no name\n"; };
 415
 416             if ($ptr1 && $ptr1 !~ m/\*$/) { $ptr1 .= " "; }
 417             $func_ptr  =~ s/\s+//g;
 418
 419             push @result, $name;
 420             my $xref = defined $typefunc ? $typefunc->($type, "<type>$type</type>") : $type;
 421             #print "Type: [$mod1][$xref][$ptr1][$mod2] ([$func_ptr][$name]) ($func_params)\n";#
 422             my $label = "$mod1$xref$ptr1$mod2 ($func_ptr$name) ($func_params)";
 423             if (defined $namefunc) {
 424                 $label = $namefunc->($label)
 425             }
 426             push @result, $label;
 427         } else {
 428             warn "Can't parse args for function in \"$declaration\"";
 429             last;
 430         }
 431         $param_num++;
 432     }
 433
 434     return @result;
 435 }
 436
 437
 438 #############################################################################
 439 # Function    : ParseMacroDeclaration
 440 # Description : This function takes a macro declaration and
 441 #               breaks it into individual parameter declarations.
 442 # Arguments   : $declaration - the declaration to parse
 443 #               $namefunc - function reference to apply to name
 444 #############################################################################
 445
 446 sub ParseMacroDeclaration {
 447     my ($declaration, $namefunc) = @_;
 448
 449     my @result = ();
 450
 451     if ($declaration =~ m/^\s*#\s*define\s+\w+\(([^\)]*)\)/) {
 452         my $params = $1;
 453
 454         $params =~ s/\\\n//g;
 455         foreach $param (split (/,/, $params)) {
 456             $param =~ s/^\s+//;
 457             $param =~ s/\s*$//;
 458             if ($param =~ m/\S/) {
 459                 push @result, $param;
 460                 push @result, defined $namefunc ? $namefunc->($param) : $param;
 461             }
 462         }
 463     }
 464
 465     return @result;
 466 }
 467
 468
 469 #############################################################################
 470 # Function    : LogWarning
 471 # Description : Log a warning in gcc style format
 472 # Arguments   : $file - the file the error comes from
 473 #               $line - line number for the wrong entry
 474 #               $message - description of the issue
 475 #############################################################################
 476
 477 sub LogWarning {
 478     my ($file, $line, $message) = @_;
 479
 480     $file="unknown" if !defined($file);
 481     $line="0" if !defined($line);
 482
 483     print "$file:$line: warning: $message\n"
 484 }
 485
 486
 487 #############################################################################
 488 # Function    : CreateValidSGMLID
 489 # Description : Creates a valid SGML 'id' from the given string.
 490 #               According to http://www.w3.org/TR/html4/types.html#type-id
 491 #                 "ID and NAME tokens must begin with a letter ([A-Za-z]) and
 492 #                  may be followed by any number of letters, digits ([0-9]),
 493 #                  hyphens ("-"), underscores ("_"), colons (":"), and
 494 #                  periods (".")."
 495 #
 496 #               NOTE: When creating SGML IDS, we append ":CAPS" to all
 497 #                     all-caps identifiers to prevent name clashes (SGML ids are
 498 #                     case-insensitive). (It basically never is the case that
 499 #                     mixed-case identifiers would collide.)
 500 # Arguments   : $id - the string to be converted into a valid SGML id.
 501 #############################################################################
 502
 503 sub CreateValidSGMLID {
 504     my ($id) = $_[0];
 505
 506     # Special case, '_' would end up as '' so we use 'gettext-macro' instead.
 507     if ($id eq "_") { return "gettext-macro"; }
 508
 509     $id =~ s/[_ ]/-/g;
 510     $id =~ s/[,;]//g;
 511     $id =~ s/^-*//;
 512     $id =~ s/::/-/g;
 513     $id =~ s/:/--/g;
 514
 515     # Append ":CAPS" to all all-caps identifiers
 516     # FIXME: there are some inconsistencies here, we have sgml.index files
 517     # containing e.g. TRUE--CAPS
 518     if ($id !~ /[a-z]/ && $id !~ /-CAPS$/) { $id .= ":CAPS" };
 519
 520     return $id;
 521 }
 522