gtkdoc-common.pl.in

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