4 # gtk-doc - GTK DocBook documentation generator.
5 # Copyright (C) 2001 Damon Chaplin
6 # 2007-2016 Stefan Sauer
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.
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.
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.
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.
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
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 #############################################################################
47 sub UpdateFileIfChanged
{
48 my ($old_file, $new_file, $make_backup) = @_;
50 #@TRACE@("Comparing $old_file with $new_file...");
52 # If the old file doesn't exist we want this to default to 1.
56 `cmp -s "$old_file" "$new_file"`;
58 #@TRACE@(" cmp exit code: $exit_code ($?)");
62 die "Error running 'cmp $old_file $new_file'";
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: $!";
71 rename ($new_file, $old_file)
72 || die "Can't move $new_file to $old_file: $!";
76 #@TRACE@(" files the same - deleting new version.");
78 || die "Can't delete file: $new_file: $!";
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 #############################################################################
97 sub ParseStructDeclaration
{
98 my ($declaration, $is_object, $output_function_params, $typefunc, $namefunc) = @_;
100 # For forward struct declarations just return an empty array.
101 if ($declaration =~ m/(?:struct|union)\s+\S+\s*;/msg) {
105 # Remove all private parts of the declaration
107 # For objects, assume private
109 $declaration =~ s
!((?
:struct
|union
)\s
+\w
*\s
*\
{)
111 (?
:/\*\s*<\s*public\s*>\s*\*/|(?
=\
}))!$1!msgx
;
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;
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;
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;
129 if ($declaration =~ /^\s*$/) {
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";
138 #@TRACE@("public fields in struct/union: $declaration");
140 # Treat lines in sequence, allowing singly nested anonymous structs
142 while ($declaration =~ m/\s*([^{;]+(\{[^\}]*\}[^{;]+)?);/msg) {
145 last if $line =~ /^\s*\}\s*\w*\s*$/;
147 # FIXME: Just ignore nested structs and unions for now
148 next if $line =~ /{/;
150 # ignore preprocessor directives
151 while ($line =~ /^#.*?\n\s*(.*)/msg) {
155 last if $line =~ /^\s*\}\s*\w*\s*$/;
157 # Try to match structure members which are functions
159 (const\s
+|G_CONST_RETURN\s
+|unsigned\s
+|signed\s
+|long\s
+|short\s
+)*(struct\s
+|enum\s
+)?
# mod1
161 (\
**(?
:\s
*restrict
)?
)\s
* # ptr1
165 \
(\s
*\
*\s
*(\w
+)\s
*\
)\s
* # name
166 \
(([^)]*)\
)\s
* # func_params
169 my $mod1 = defined($1) ?
$1 : "";
170 if (defined($2)) { $mod1 .= $2; }
173 my $mod2 = defined($5) ?
$5 : "";
175 my $mod3 = defined($7) ?
$7 : "";
177 my $func_params = $9;
178 my $ptype = defined $typefunc ?
$typefunc->($type, "<type>$type</type>") : $type;
179 my $pname = defined $namefunc ?
$namefunc->($name) : $name;
183 if ($output_function_params) {
184 push @result, "$mod1$ptype$ptr1$mod2$ptr2$mod3 (*$pname) ($func_params)";
186 push @result, "$pname ()";
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
194 (\
** \s
* const\s
+)?
# mod2
198 my $mod1 = defined($1) ?
$1 : "";
199 if (defined($2)) { $mod1 .= $2; }
201 my $ptype = defined $typefunc ?
$typefunc->($type, "<type>$type</type>") : $type;
202 my $mod2 = defined($4) ?
" " . $4 : "";
205 #@TRACE@("'$mod1' '$type' '$mod2' '$list'");
207 $mod1 =~ s/ / /g;
208 $mod2 =~ s/ / /g;
210 my @names = split /,/, $list;
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) {
219 my $array = defined($3) ?
$3 : "";
220 my $bits = defined($4) ?
" $4" : "";
222 if ($ptrs && $ptrs !~ m/\*$/) { $ptrs .= " "; }
223 $array =~ s/ / /g;
224 $bits =~ s/ / /g;
227 if (defined $namefunc) {
228 $name = $namefunc->($name);
230 push @result, "$mod1$ptype$mod2 $ptrs$name$array$bits;";
232 #@TRACE@("Matched line: $mod1$ptype$mod2 $ptrs$name$array$bits");
234 print "WARNING: Couldn't parse struct field: $n\n";
239 print "WARNING: Cannot parse structure field: \"$line\"\n";
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 #############################################################################
254 sub ParseEnumDeclaration
{
255 my ($declaration, $is_object) = @_;
257 # For forward enum declarations just return an empty array.
258 if ($declaration =~ m/enum\s+\S+\s*;/msg) {
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;
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;
274 if ($declaration =~ /^\s*$/) {
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.
282 $declaration =~ s/\([^)\n]+\)//g;
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
288 $declaration =~ s/\'.\'//g;
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
294 $declaration =~ s/,(\s*})/$1/g;
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";
301 #@TRACE@("public fields in enum: $declaration");
303 # Treat lines in sequence.
304 while ($declaration =~ m/\s*([^,\}]+)([,\}])/msg) {
308 # ignore preprocessor directives
309 while ($line =~ /^#.*?\n\s*(.*)/msg) {
313 if ($line =~ m/^(\w+)\s*(=.*)?$/msg) {
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) {
321 # Special case include of <gdk/gdkcursors.h>, just ignore it
322 } elsif ($line =~ m/^#include/) {
325 # Special case for #ifdef/#else/#endif, just ignore it
326 } elsif ($line =~ m/^#(?:if|else|endif)/) {
330 warn "Cannot parse enumeration member \"$line\"";
333 last if $terminator eq '}';
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 #############################################################################
349 sub ParseFunctionDeclaration
{
350 my ($declaration, $typefunc, $namefunc) = @_;
355 while ($declaration ne "") {
356 #@TRACE@("[$declaration]");
358 if ($declaration =~ s/^[\s,]+//) {
359 # skip whitespace and commas
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";
367 push @result, "void";
368 my $xref = "<type>void</type>";
369 my $label = defined $namefunc ?
$namefunc->($xref) : $xref;
370 push @result, $label;
372 } elsif ($declaration =~ s/^\s*[_a-zA-Z0-9]*\.\.\.\s*[,\n]//) {
374 my $label = defined $namefunc ?
$namefunc->("...") : "...";
375 push @result, $label;
377 # allow alphanumerics, '_', '[' & ']' in param names
378 # Try to match a standard parameter
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 : "";
383 my $ptr = defined($3) ?
$3 : "";
384 my $name = defined($4) ?
$4 : "";
385 my $array = defined($5) ?
$5 : "";
391 if ($ptr && $ptr !~ m/\*$/) { $ptr .= " "; }
393 #@TRACE@("$symbol: '$pre' '$type' '$ptr' '$name' '$array'");
395 if (($name eq "") && $pre =~ m/^((un)?signed .*)\s?/ ) {
402 $name = "Param" . ($param_num + 1);
405 #@TRACE@("$symbol: '$pre' '$type' '$ptr' '$name' '$array'");
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)
413 push @result, $label;
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; }
422 my $mod2 = defined($5) ?
$5 : "";
425 my $func_params = defined($8) ?
$8 : "";
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"; };
432 if ($ptr1 && $ptr1 !~ m/\*$/) { $ptr1 .= " "; }
433 $func_ptr =~ s/\s+//g;
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)
442 push @result, $label;
444 warn "Can't parse args for function in \"$declaration\"";
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 #############################################################################
462 sub ParseMacroDeclaration
{
463 my ($declaration, $namefunc) = @_;
467 if ($declaration =~ m/^\s*#\s*define\s+\w+\(([^\)]*)\)/) {
470 $params =~ s/\\\n//g;
471 foreach $param (split (/,/, $params)) {
474 # Allow varargs variations
475 if ($param =~ m/^.*\.\.\.$/) {
478 if ($param =~ m/\S/) {
479 push @result, $param;
480 push @result, defined $namefunc ?
$namefunc->($param) : $param;
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 #############################################################################
498 my ($file, $line, $message) = @_;
500 $file="unknown" if !defined($file);
501 $line="0" if !defined($line);
503 print "$file:$line: warning: $message\n"
509 if (defined($ENV{"GTKDOC_TRACE"})) {
510 my (undef, $file, $line) = caller;
513 print "$file:$line: trace: $message\n"
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
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 #############################################################################
534 sub CreateValidSGMLID
{
537 # Special case, '_' would end up as '' so we use 'gettext-macro' instead.
538 if ($id eq "_") { return "gettext-macro"; }
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" };