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 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 #############################################################################
45 sub UpdateFileIfChanged
{
46 my ($old_file, $new_file, $make_backup) = @_;
48 # print "Comparing $old_file with $new_file...\n";
50 # If the old file doesn't exist we want this to default to 1.
54 `cmp -s "$old_file" "$new_file"`;
56 # print " cmp exit code: $exit_code ($?)\n";
60 die "Error running 'cmp $old_file $new_file'";
63 if ($exit_code == 1) {
64 # 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: $!";
71 rename ($new_file, $old_file)
72 || die "Can't move $new_file to $old_file: $!";
76 # print " files the same - deleting new version.\n";
79 || die "Can't delete file: $new_file: $!";
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 # $output_function_params - true if full type is wanted for
93 # function pointer members
94 # $typefunc - function reference to apply to type
95 # $namefunc - function reference to apply to name
96 #############################################################################
98 sub ParseStructDeclaration
{
99 my ($declaration, $is_object, $output_function_params, $typefunc, $namefunc) = @_;
101 # For forward struct declarations just return an empty array.
102 if ($declaration =~ m/(?:struct|union)\s+\S+\s*;/msg) {
106 # Remove all private parts of the declaration
108 # For objects, assume private
110 $declaration =~ s
!((?
:struct
|union
)\s
+\w
*\s
*\
{)
112 (?
:/\*\s*<\s*public\s*>\s*\*/|(?
=\
}))!$1!msgx
;
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@
/\*([^*]+|\*(?!/))*\
*/@
@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 #print "DEBUG: public fields in struct/union: $declaration\n";
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 #print "'$mod1' '$type' '$mod2' '$list' \n";
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 #print "***** Matched line: $mod1$ptype$mod2 $ptrs$name$array$bits\n";
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) {
257 $declaration =~ s@
/\*([^*]+|\*(?!/))*\
*/@
@g;
261 if ($declaration =~ /^\s*$/) {
265 # Remove parenthesized expressions (in macros like GTK_BLAH = BLAH(1,3))
266 # to avoid getting confused by commas they might contain. This
267 # doesn't handle nested parentheses correctly.
269 $declaration =~ s/\([^)]+\)//g;
271 # Remove comma from comma - possible whitespace - closing brace sequence
272 # since it is legal in GNU C and C99 to have a trailing comma but doesn't
273 # result in an actual enum member
275 $declaration =~ s/,(\s*})/$1/g;
277 # Prime match after "typedef enum {" declaration
278 if (!scalar($declaration =~ m/(typedef\s+)?enum\s*(\S+\s*)?\{/msg)) {
279 die "Enum declaration '$declaration' does not begin with 'typedef enum {' or 'enum XXX {'\n";
282 # Treat lines in sequence.
283 while ($declaration =~ m/\s*([^,\}]+)([,\}])/msg) {
287 # ignore preprocessor directives
288 while ($line =~ /^#.*?\n\s*(.*)/msg) {
292 if ($line =~ m/^(\w+)\s*(=.*)?$/msg) {
295 # Special case for GIOCondition, where the values are specified by
296 # macros which expand to include the equal sign like '=1'.
297 } elsif ($line =~ m/^(\w+)\s*GLIB_SYSDEF_POLL/msg) {
300 # Special case include of <gdk/gdkcursors.h>, just ignore it
301 } elsif ($line =~ m/^#include/) {
304 # Special case for #ifdef/#else/#endif, just ignore it
305 } elsif ($line =~ m/^#(?:if|else|endif)/) {
309 warn "Cannot parse enumeration member \"$line\"";
312 last if $terminator eq '}';
319 #############################################################################
320 # Function : LogWarning
321 # Description : Log a warning in gcc style format
322 # Arguments : $file - the file the error comes from
323 # $line - line number for the wrong entry
324 # $message - description of the issue
325 #############################################################################
328 my ($file, $line, $message) = @_;
330 $file="unknown" if !defined($file);
331 $line="0" if !defined($line);
333 print "$file:$line: warning: $message\n"
337 #############################################################################
338 # Function : CreateValidSGMLID
339 # Description : Creates a valid SGML 'id' from the given string.
340 # According to http://www.w3.org/TR/html4/types.html#type-id
341 # "ID and NAME tokens must begin with a letter ([A-Za-z]) and
342 # may be followed by any number of letters, digits ([0-9]),
343 # hyphens ("-"), underscores ("_"), colons (":"), and
346 # NOTE: When creating SGML IDS, we append ":CAPS" to all
347 # all-caps identifiers to prevent name clashes (SGML ids are
348 # case-insensitive). (It basically never is the case that
349 # mixed-case identifiers would collide.)
350 # Arguments : $id - the string to be converted into a valid SGML id.
351 #############################################################################
353 sub CreateValidSGMLID
{
356 # Special case, '_' would end up as '' so we use 'gettext-macro' instead.
357 if ($id eq "_") { return "gettext-macro"; }
365 # Append ":CAPS" to all all-caps identifiers
366 # FIXME: there are some inconsistencies here, we have sgml.index files
367 # containing e.g. TRUE--CAPS
368 if ($id !~ /[a-z]/ && $id !~ /-CAPS$/) { $id .= ":CAPS" };