4 # gtk-doc - GTK DocBook documentation generator.
5 # Copyright (C) 2001 Damon Chaplin
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.
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.
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.
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.
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
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 #############################################################################
46 sub UpdateFileIfChanged
{
47 my ($old_file, $new_file, $make_backup) = @_;
49 #@TRACE@("Comparing $old_file with $new_file...");
51 # If the old file doesn't exist we want this to default to 1.
55 `cmp -s "$old_file" "$new_file"`;
57 #@TRACE@(" cmp exit code: $exit_code ($?)";
61 die "Error running 'cmp $old_file $new_file'";
64 if ($exit_code == 1) {
65 #@TRACE@(" files changed - replacing old version with new version.");
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: $!";
70 rename ($new_file, $old_file)
71 || die "Can't move $new_file to $old_file: $!";
75 #@TRACE@(" files the same - deleting new version.");
77 || die "Can't delete file: $new_file: $!";
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 #############################################################################
96 sub ParseStructDeclaration
{
97 my ($declaration, $is_object, $output_function_params, $typefunc, $namefunc) = @_;
99 # For forward struct declarations just return an empty array.
100 if ($declaration =~ m/(?:struct|union)\s+\S+\s*;/msg) {
104 # Remove all private parts of the declaration
106 # For objects, assume private
108 $declaration =~ s
!((?
:struct
|union
)\s
+\w
*\s
*\
{)
110 (?
:/\*\s*<\s*public\s*>\s*\*/|(?
=\
}))!$1!msgx
;
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;
117 # Remove all other comments;
118 $declaration =~ s@
/\*([^*]+|\*(?!/))*\
*/@
@g;
119 $declaration =~ s@
//.*@
@g;
123 if ($declaration =~ /^\s*$/) {
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";
132 #@TRACE@("public fields in struct/union: $declaration");
134 # Treat lines in sequence, allowing singly nested anonymous structs
136 while ($declaration =~ m/\s*([^{;]+(\{[^\}]*\}[^{;]+)?);/msg) {
139 last if $line =~ /^\s*\}\s*\w*\s*$/;
141 # FIXME: Just ignore nested structs and unions for now
142 next if $line =~ /{/;
144 # ignore preprocessor directives
145 while ($line =~ /^#.*?\n\s*(.*)/msg) {
149 last if $line =~ /^\s*\}\s*\w*\s*$/;
151 # Try to match structure members which are functions
153 (const\s
+|G_CONST_RETURN\s
+|unsigned\s
+|signed\s
+|long\s
+|short\s
+)*(struct\s
+|enum\s
+)?
# mod1
155 (\
**(?
:\s
*restrict
)?
)\s
* # ptr1
159 \
(\s
*\
*\s
*(\w
+)\s
*\
)\s
* # name
160 \
(([^)]*)\
)\s
* # func_params
163 my $mod1 = defined($1) ?
$1 : "";
164 if (defined($2)) { $mod1 .= $2; }
167 my $mod2 = defined($5) ?
$5 : "";
169 my $mod3 = defined($7) ?
$7 : "";
171 my $func_params = $9;
172 my $ptype = defined $typefunc ?
$typefunc->($type, "<type>$type</type>") : $type;
173 my $pname = defined $namefunc ?
$namefunc->($name) : $name;
177 if ($output_function_params) {
178 push @result, "$mod1$ptype$ptr1$mod2$ptr2$mod3 (*$pname) ($func_params)";
180 push @result, "$pname ()";
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
188 (\
** \s
* const\s
+)?
# mod2
192 my $mod1 = defined($1) ?
$1 : "";
193 if (defined($2)) { $mod1 .= $2; }
195 my $ptype = defined $typefunc ?
$typefunc->($type, "<type>$type</type>") : $type;
196 my $mod2 = defined($4) ?
" " . $4 : "";
199 #@TRACE@("'$mod1' '$type' '$mod2' '$list'");
201 $mod1 =~ s/ / /g;
202 $mod2 =~ s/ / /g;
204 my @names = split /,/, $list;
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) {
213 my $array = defined($3) ?
$3 : "";
214 my $bits = defined($4) ?
" $4" : "";
216 if ($ptrs && $ptrs !~ m/\*$/) { $ptrs .= " "; }
217 $array =~ s/ / /g;
218 $bits =~ s/ / /g;
221 if (defined $namefunc) {
222 $name = $namefunc->($name);
224 push @result, "$mod1$ptype$mod2 $ptrs$name$array$bits;";
226 #@TRACE@("Matched line: $mod1$ptype$mod2 $ptrs$name$array$bits");
228 print "WARNING: Couldn't parse struct field: $n\n";
233 print "WARNING: Cannot parse structure field: \"$line\"\n";
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 #############################################################################
248 sub ParseEnumDeclaration
{
249 my ($declaration, $is_object) = @_;
251 # For forward enum declarations just return an empty array.
252 if ($declaration =~ m/enum\s+\S+\s*;/msg) {
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;
261 $declaration =~ s@
/\*([^*]+|\*(?!/))*\
*/@
@g;
262 $declaration =~ s@
//.*$@
@g;
266 if ($declaration =~ /^\s*$/) {
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.
274 $declaration =~ s/\([^)\n]+\)//g;
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
280 $declaration =~ s/,(\s*})/$1/g;
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";
287 # Treat lines in sequence.
288 while ($declaration =~ m/\s*([^,\}]+)([,\}])/msg) {
292 # ignore preprocessor directives
293 while ($line =~ /^#.*?\n\s*(.*)/msg) {
297 if ($line =~ m/^(\w+)\s*(=.*)?$/msg) {
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) {
305 # Special case include of <gdk/gdkcursors.h>, just ignore it
306 } elsif ($line =~ m/^#include/) {
309 # Special case for #ifdef/#else/#endif, just ignore it
310 } elsif ($line =~ m/^#(?:if|else|endif)/) {
314 warn "Cannot parse enumeration member \"$line\"";
317 last if $terminator eq '}';
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 #############################################################################
333 sub ParseFunctionDeclaration
{
334 my ($declaration, $typefunc, $namefunc) = @_;
339 while ($declaration ne "") {
340 #@TRACE@("$declaration");
342 if ($declaration =~ s/^[\s,]+//) {
343 # skip whitespace and commas
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";
351 push @result, "void";
352 my $xref = "<type>void</type>";
353 my $label = defined $namefunc ?
$namefunc->($xref) : $xref;
354 push @result, $label;
356 } elsif ($declaration =~ s/^...\s*[,\n]//) {
358 my $label = defined $namefunc ?
$namefunc->("...") : "...";
359 push @result, $label;
361 # allow alphanumerics, '_', '[' & ']' in param names
362 # Try to match a standard parameter
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 : "";
367 my $ptr = defined($3) ?
$3 : "";
368 my $name = defined($4) ?
$4 : "";
369 my $array = defined($5) ?
$5 : "";
375 if ($ptr && $ptr !~ m/\*$/) { $ptr .= " "; }
377 #@TRACE@("$symbol: '$pre' '$type' '$ptr' '$name' '$array'");
379 if (($name eq "") && $pre =~ m/^((un)?signed .*)\s?/ ) {
386 $name = "Param" . ($param_num + 1);
389 #@TRACE@("$symbol: '$pre' '$type' '$ptr' '$name' '$array'");
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)
397 push @result, $label;
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; }
406 my $mod2 = defined($5) ?
$5 : "";
409 my $func_params = defined($8) ?
$8 : "";
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"; };
416 if ($ptr1 && $ptr1 !~ m/\*$/) { $ptr1 .= " "; }
417 $func_ptr =~ s/\s+//g;
420 my $xref = defined $typefunc ?
$typefunc->($type, "<type>$type</type>") : $type;
421 #@TRACE@("Type: [$mod1][$xref][$ptr1][$mod2] ([$func_ptr][$name]) ($func_params)");
422 my $label = "$mod1$xref$ptr1$mod2 ($func_ptr$name) ($func_params)";
423 if (defined $namefunc) {
424 $label = $namefunc->($label)
426 push @result, $label;
428 warn "Can't parse args for function in \"$declaration\"";
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 #############################################################################
446 sub ParseMacroDeclaration
{
447 my ($declaration, $namefunc) = @_;
451 if ($declaration =~ m/^\s*#\s*define\s+\w+\(([^\)]*)\)/) {
454 $params =~ s/\\\n//g;
455 foreach $param (split (/,/, $params)) {
458 if ($param =~ m/\S/) {
459 push @result, $param;
460 push @result, defined $namefunc ?
$namefunc->($param) : $param;
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 #############################################################################
478 my ($file, $line, $message) = @_;
480 $file="unknown" if !defined($file);
481 $line="0" if !defined($line);
483 print "$file:$line: warning: $message\n"
489 if (defined($ENV{"GTKDOC_TRACE"})) {
490 my (undef, $file, $line) = caller;
493 print "$file:$line: trace: $message\n"
498 #############################################################################
499 # Function : CreateValidSGMLID
500 # Description : Creates a valid SGML 'id' from the given string.
501 # According to http://www.w3.org/TR/html4/types.html#type-id
502 # "ID and NAME tokens must begin with a letter ([A-Za-z]) and
503 # may be followed by any number of letters, digits ([0-9]),
504 # hyphens ("-"), underscores ("_"), colons (":"), and
507 # NOTE: When creating SGML IDS, we append ":CAPS" to all
508 # all-caps identifiers to prevent name clashes (SGML ids are
509 # case-insensitive). (It basically never is the case that
510 # mixed-case identifiers would collide.)
511 # Arguments : $id - the string to be converted into a valid SGML id.
512 #############################################################################
514 sub CreateValidSGMLID
{
517 # Special case, '_' would end up as '' so we use 'gettext-macro' instead.
518 if ($id eq "_") { return "gettext-macro"; }
526 # Append ":CAPS" to all all-caps identifiers
527 # FIXME: there are some inconsistencies here, we have sgml.index files
528 # containing e.g. TRUE--CAPS
529 if ($id !~ /[a-z]/ && $id !~ /-CAPS$/) { $id .= ":CAPS" };