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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  20 #
  21
  22 #
  23 # These are functions used by several of the gtk-doc Perl scripts.
  24 # I'll move more of the common routines here eventually, though I need to
  25 # stop them from using global variables.
  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 CVS that haven't changed.
  38 #               It returns 0 if the file hasn't changed, and 1 if it has.
  39 # Arguments   : $old_file - the pathname of the old file.
  40 #               $new_file - the pathname of the new version of the file.
  41 #               $make_backup - 1 if a backup of the old file should be kept.
  42 #                       It will have the .bak suffix added to the file name.
  43 #############################################################################
  44
  45 sub UpdateFileIfChanged {
  46     my ($old_file, $new_file, $make_backup) = @_;
  47
  48 #    print "Comparing $old_file with $new_file...\n";
  49
  50     # If the old file doesn't exist we want this to default to 1.
  51     my $exit_code = 1;
  52
  53     if (-e $old_file) {
  54         `cmp -s $old_file $new_file`;
  55         $exit_code = $? >> 8;
  56 #       print "   cmp exit code: $exit_code ($?)\n";
  57     }
  58
  59     if ($exit_code > 1) {
  60         die "Error running 'cmp $old_file $new_file'";
  61     }
  62
  63     if ($exit_code == 1) {
  64 #       print "   files changed - replacing old version with new version.\n";
  65
  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
  71         rename ($new_file, $old_file)
  72             || die "Can't move $new_file to $old_file: $!";
  73
  74         return 1;
  75     } else {
  76 #       print "   files the same - deleting new version.\n";
  77
  78         unlink ("$new_file")
  79             || die "Can't delete file: $new_file: $!";
  80
  81         return 0;
  82     }
  83 }
  84
  85
  86 #############################################################################
  87 # Function    : ParseStructDeclaration
  88 # Description : This function takes a structure declaration and
  89 #               breaks it into individual type declarations.
  90 # Arguments   : $declaration - the declaration to parse
  91 #               $is_object - true if this is an object structure
  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\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\s+\w*\s*\{)
 109                           .*?
 110                           (?:/\*\s*<\s*public\s*>\s*\*/|(?=\}))!$1!msgx;
 111     }
 112
 113     # Assume end of declaration if line begins with '}'
 114     $declaration =~ s!\n?[ \t]*/\*\s*<\s*(private|protected)\s*>\s*\*/
 115                       .*?
 116                       (?:/\*\s*<\s*public\s*>\s*\*/|(?=^\}))!!msgx;
 117
 118     # Remove all other comments;
 119     $declaration =~ s@/\*([^*]+|\*(?!/))*\*/@ @g;
 120
 121     my @result = ();
 122
 123     if ($declaration =~ /^\s*$/) {
 124         return @result;
 125     }
 126
 127     # Prime match after "struct {" declaration
 128     if (!scalar($declaration =~ m/struct\s+\w*\s*\{/msg)) {
 129         die "Structure declaration '$declaration' does not begin with struct [NAME] {\n";
 130     }
 131
 132     # Treat lines in sequence, allowing singly nested anonymous structs
 133     # and unions.
 134     while ($declaration =~ m/\s*([^{;]+(\{[^\}]*\}[^{;]+)?);/msg) {
 135         my $line = $1;
 136
 137         last if $line =~ /^\s*\}\s*\w*\s*$/;
 138
 139         # FIXME: Just ignore nested structs and unions for now
 140         next if $line =~ /{/;
 141
 142         # ignore preprocessor directives
 143         while ($line =~ /^#.*?\n\s*(.*)/msg) {
 144             $line=$1;
 145         }
 146
 147         # FIXME: The regexes here are the same as in OutputFunction;
 148         #        this functionality should be separated out.
 149
 150         # Try to match structure members which are functions
 151         if ($line =~ m/^
 152                  (const\s+|G_CONST_RETURN\s+|unsigned\s+|signed\s+|long\s+|short\s+)*(struct\s+)?  # mod1
 153                  (\w+)\s*                             # type
 154                  (\**(?:\s*restrict)?)\s*             # ptr1
 155                  (const\s+)?                          # mod2
 156                  (\**\s*)                             # ptr2
 157                  (const\s+)?                          # mod3
 158                  \(\s*\*\s*(\w+)\s*\)\s*              # name
 159                  \(([^)]*)\)\s*                       # func_params
 160                             $/x) {
 161
 162             my $mod1 = defined($1) ? $1 : "";
 163             if (defined($2)) { $mod1 .= $2; }
 164             my $type = $3;
 165             my $ptr1 = $4;
 166             my $mod2 = defined($5) ? $5 : "";
 167             my $ptr2 = $6;
 168             my $mod3 = defined($7) ? $7 : "";
 169             my $name = $8;
 170             my $func_params = $9;
 171             my $ptype = defined $typefunc ? $typefunc->($type) : $type;
 172             my $pname = defined $namefunc ? $namefunc->($name) : $name;
 173
 174             push @result, $name;
 175
 176             if ($output_function_params) {
 177               push @result, "$mod1$ptype$ptr1$mod2$ptr2$mod3 (*$pname) ($func_params)";
 178             } else {
 179               push @result, "$pname&nbsp;()";
 180             }
 181
 182
 183         # Try to match normal struct fields of comma-separated variables/
 184         } elsif ($line =~ m/^
 185             ((?:const\s+|unsigned\s+|volatile\s+|signed\s+|short\s+|long\s+)*)(struct\s+)? # mod1
 186             (\w+)\s*                            # type
 187             (\** \s* const\s+)?                 # mod2
 188             (.*)                                # variables
 189             $/x) {
 190
 191             my $mod1 = defined($1) ? $1 : "";
 192             if (defined($2)) { $mod1 .= $2; }
 193             my $type = $3;
 194             my $ptype = defined $typefunc ? $typefunc->($type) : $type;
 195             my $mod2 = defined($4) ? " " . $4 : "";
 196             my $list = $5;
 197
 198             $mod1 =~ s/ /&nbsp;/g;
 199             $mod2 =~ s/ /&nbsp;/g;
 200
 201             my @names = split /,/, $list;
 202             for my $n (@names) {
 203                 # Each variable can have any number of '*' before the
 204                 # identifier, and be followed by any number of pairs of
 205                 # brackets or a bit field specifier.
 206                 # e.g. *foo, ***bar, *baz[12][23], foo : 25.
 207                 if ($n =~ m/^\s* (\**(?:\s*restrict\b)?) \s* (\w+) \s* (?: ((?:\[[^\]]*\]\s*)+) | (:\s*\d+)?) \s* $/x) {
 208                     my $ptrs = $1;
 209                     my $name = $2;
 210                     my $array = defined($3) ? $3 : "";
 211                     my $bits =  defined($4) ? " $4" : "";
 212
 213                     if ($ptrs && $ptrs !~ m/\*$/) { $ptrs .= " "; }
 214                     $array =~ s/ /&nbsp;/g;
 215                     $bits =~ s/ /&nbsp;/g;
 216
 217                     push @result, $name;
 218                     if (defined $namefunc) {
 219                         $name = $namefunc->($name);
 220                     }
 221                     push @result, "$mod1$ptype$mod2&nbsp;$ptrs$name$array$bits;";
 222
 223 #                   print "***** Matched line: $mod1$ptype$mod2 $ptrs$name$array$bits\n";
 224                 } else {
 225                     print "WARNING: Couldn't parse struct field: $n\n";
 226                 }
 227             }
 228
 229         } else {
 230             warn "Cannot parse structure field \"$line\"";
 231         }
 232     }
 233
 234     return @result;
 235 }
 236
 237
 238 #############################################################################
 239 # Function    : ParseEnumDeclaration
 240 # Description : This function takes a enumeration declaration and
 241 #               breaks it into individual enum member declarations.
 242 # Arguments   : $declaration - the declaration to parse
 243 #############################################################################
 244
 245 sub ParseEnumDeclaration {
 246     my ($declaration, $is_object) = @_;
 247
 248     # Remove comments;
 249     $declaration =~ s@/\*([^*]+|\*(?!/))*\*/@ @g;
 250
 251     my @result = ();
 252
 253     if ($declaration =~ /^\s*$/) {
 254         return @result;
 255     }
 256
 257     # Remove parenthesized expressions (in macros like GTK_BLAH = BLAH(1,3))
 258     # to avoid getting confused by commas they might contain. This
 259     # doesn't handle nested parentheses correctly.
 260
 261     $declaration =~ s/\([^)]+\)//g;
 262
 263     # Remove comma from comma - possible whitespace - closing brace sequence
 264     # since it is legal in GNU C and C99 to have a trailing comma but doesn't
 265     # result in an actual enum member
 266
 267     $declaration =~ s/,(\s*})/$1/g;
 268
 269     # Prime match after "typedef enum {" declaration
 270     if (!scalar($declaration =~ m/typedef\s+enum\s*(\S+\s*)?\{/msg)) {
 271         die "Enum declaration '$declaration' does not begin with typedef enum {\n";
 272     }
 273
 274     # Treat lines in sequence.
 275     while ($declaration =~ m/\s*([^,\}]+)([,\}])/msg) {
 276         my $line = $1;
 277         my $terminator = $2;
 278
 279         # ignore preprocessor directives
 280         while ($line =~ /^#.*?\n\s*(.*)/msg) {
 281             $line=$1;
 282         }
 283
 284         if ($line =~ m/^(\w+)\s*(=.*)?$/msg) {
 285             push @result, $1;
 286
 287         # Special case for GIOCondition, where the values are specified by
 288         # macros which expand to include the equal sign like '=1'.
 289         } elsif ($line =~ m/^(\w+)\s*GLIB_SYSDEF_POLL/msg) {
 290             push @result, $1;
 291
 292         # Special case include of <gdk/gdkcursors.h>, just ignore it
 293         } elsif ($line =~ m/^#include/) {
 294             last;
 295
 296         # Special case for #ifdef/#endif, just ignore it
 297         } elsif ($line =~ m/^#(?:if|endif)/) {
 298             last;
 299
 300         } else {
 301             warn "Cannot parse enumeration member \"$line\"";
 302         }
 303
 304         last if $terminator eq '}';
 305     }
 306
 307     return @result;
 308 }