check: port to python
[gtk-doc.git] / gtkdoc-scan.in
blob672545e11d62a2e2dc4f12bb68647a8867f67169
1 #!@PERL@ -w
2 # -*- cperl -*-
4 # gtk-doc - GTK DocBook documentation generator.
5 # Copyright (C) 1998  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.
23 #############################################################################
24 # Script      : gtkdoc-scan
25 # Description : Extracts declarations of functions, macros, enums, structs
26 #                and unions from header files.
28 #                It is called with a module name, an optional source directory,
29 #                an optional output directory, and the header files to scan.
31 #                It outputs all declarations found to a file named
32 #                '$MODULE-decl.txt', and the list of decarations to another
33 #                file '$MODULE-decl-list.txt'.
35 #                This second list file is typically copied to
36 #                '$MODULE-sections.txt' and organized into sections ready to
37 #                output the SGML pages.
38 #############################################################################
40 use strict;
41 use Getopt::Long;
42 use Cwd qw(realpath);
44 push @INC, '@PACKAGE_DATA_DIR@';
45 require "gtkdoc-common.pl";
47 # Options
49 # name of documentation module
50 my $MODULE;
51 my $OUTPUT_DIR;
52 my @SOURCE_DIRS;
53 my $IGNORE_HEADERS = "";
54 my $REBUILD_TYPES;
55 my $REBUILD_SECTIONS;
56 my $PRINT_VERSION;
57 my $PRINT_HELP;
58 # regexp matching cpp symbols which surround deprecated stuff
59 # e.g. 'GTK_ENABLE_BROKEN|GTK_DISABLE_DEPRECATED'
60 # these are detected if they are used as #if FOO, #ifndef FOO, or #ifdef FOO
61 my $DEPRECATED_GUARDS;
62 # regexp matching decorators that should be ignored
63 my $IGNORE_DECORATORS;
65 my @get_types = ();
67 # do not read files twice; checking it here permits to give both srcdir and
68 # builddir as --source-dir without fear of duplicities
69 my %seen_headers;
72 Run() unless caller; # Run program unless loaded as a module
75 sub Run {
76     my %optctl = (module => \$MODULE,
77                   'source-dir' => \@SOURCE_DIRS,
78                   'ignore-headers' => \$IGNORE_HEADERS,
79                   'output-dir' => \$OUTPUT_DIR,
80                   'rebuild-types' => \$REBUILD_TYPES,
81                   'rebuild-sections' => \$REBUILD_SECTIONS,
82                   'version' => \$PRINT_VERSION,
83                   'help' => \$PRINT_HELP,
84                   'deprecated-guards' => \$DEPRECATED_GUARDS,
85                   'ignore-decorators' => \$IGNORE_DECORATORS);
86     GetOptions(\%optctl, "module=s", "source-dir:s", "ignore-headers:s",
87                "output-dir:s", "rebuild-types", "rebuild-sections", "version",
88                "help", "deprecated-guards:s", "ignore-decorators:s");
90     if ($PRINT_VERSION) {
91         print "@VERSION@\n";
92         exit 0;
93     }
95     if (!$MODULE) {
96         $PRINT_HELP = 1;
97     }
99     if ($PRINT_HELP) {
100         print <<EOF;
101 gtkdoc-scan version @VERSION@ - scan header files for public symbols
103 --module=MODULE_NAME       Name of the doc module being parsed
104 --source-dir=DIRNAME       Directories containing the source files to scan
105 --ignore-headers=FILES     A space-separated list of header files/dirs not to
106                            scan
107 --output-dir=DIRNAME       The directory where the results are stored
108 --deprecated-guards=GUARDS A |-separated list of symbols used as deprecation
109                            guards
110 --ignore-decorators=DECS   A |-separated list of addition decorators in
111                            declarations that should be ignored
112 --rebuild-sections         Rebuild (overwrite) the MODULE-sections.txt file
113 --rebuild-types            Automatically recreate the MODULE.types file using
114                            all the *_get_type() functions found
115 --version                  Print the version of this program
116 --help                     Print this help
118         exit 0;
119     }
121     $DEPRECATED_GUARDS = $DEPRECATED_GUARDS ? $DEPRECATED_GUARDS : "does_not_match_any_cpp_symbols_at_all_nope";
123     $IGNORE_DECORATORS = $IGNORE_DECORATORS || "(?=no)match";
125     $OUTPUT_DIR = $OUTPUT_DIR ? $OUTPUT_DIR : ".";
127     if (!-d ${OUTPUT_DIR}) {
128         mkdir($OUTPUT_DIR, 0755) || die "Cannot create $OUTPUT_DIR: $!";
129     }
131     my $old_decl_list = "${OUTPUT_DIR}/$MODULE-decl-list.txt";
132     my $new_decl_list = "${OUTPUT_DIR}/$MODULE-decl-list.new";
133     my $old_decl = "${OUTPUT_DIR}/$MODULE-decl.txt";
134     my $new_decl = "${OUTPUT_DIR}/$MODULE-decl.new";
135     my $old_types = "${OUTPUT_DIR}/$MODULE.types";
136     my $new_types = "${OUTPUT_DIR}/$MODULE.types.new";
137     my $sections_file = "${OUTPUT_DIR}/$MODULE-sections.txt";
139     # If this is the very first run then we create the .types file automatically.
140     if (! -e $sections_file && ! -e $old_types) {
141         $REBUILD_TYPES = 1;
142     }
144     open (DECLLIST, ">$new_decl_list")
145         || die "Can't open $new_decl_list";
146     open (DECL, ">$new_decl")
147         || die "Can't open $new_decl";
148     if ($REBUILD_TYPES) {
149         open (TYPES, ">$new_types")
150             || die "Can't open $new_types";
151     }
153     my %section_list = ();
154     my $file;
156     # The header files to scan are passed in as command-line args.
157     for $file (@ARGV) {
158         &ScanHeader ($file, \%section_list);
159     }
161     for my $dir (@SOURCE_DIRS) {
162         &ScanHeaders ($dir, \%section_list);
163     }
165     ## FIXME: sort by key and output
166     #print DECLLIST $section_list;
167     my $section;
168     foreach $section (sort(keys %section_list)) {
169         print DECLLIST "$section_list{$section}";
170     }
172     close (DECLLIST);
173     close (DECL);
175     if ($REBUILD_TYPES) {
176         my $func;
178         foreach $func (sort(@get_types)) {
179            print TYPES "$func\n";
180         }
181         close (TYPES);
182         &UpdateFileIfChanged ($old_types, $new_types, 1);
184         # remove the file if empty
185         if (scalar (@get_types) == 0) {
186             unlink ("$new_types");
187         }
188     }
190     &UpdateFileIfChanged ($old_decl_list, $new_decl_list, 1);
191     &UpdateFileIfChanged ($old_decl, $new_decl, 1);
193     # If there is no MODULE-sections.txt file yet or we are asked to rebuild it,
194     # we copy the MODULE-decl-list.txt file into its place. The user can tweak it
195     # later if they want.
196     if ($REBUILD_SECTIONS || ! -e $sections_file) {
197       &UpdateFileIfChanged ($sections_file, $old_decl_list, 0);
198     }
200     # If there is no MODULE-overrides.txt file we create an empty one
201     # because EXTRA_DIST in gtk-doc.make requires it.
202     my $overrides_file = "${OUTPUT_DIR}/$MODULE-overrides.txt";
203     if (! -e $overrides_file) {
204       `touch $overrides_file`;
205     }
209 #############################################################################
210 # Function    : ScanHeaders
211 # Description : This scans a directory tree looking for header files.
213 # Arguments   : $source_dir - the directory to scan.
214 #               $section_list - a reference to the hashmap of sections.
215 #############################################################################
217 sub ScanHeaders {
218     my ($source_dir, $section_list) = @_;
219     @TRACE@("Scanning source directory: $source_dir");
221     # This array holds any subdirectories found.
222     my (@subdirs) = ();
224     opendir (SRCDIR, $source_dir)
225         || die "Can't open source directory $source_dir: $!";
226     my $file;
227     foreach $file (readdir (SRCDIR)) {
228         if ($file eq '.' || $file eq '..' || $file =~ /^\./) {
229             next;
230         } elsif (-d "$source_dir/$file") {
231             push (@subdirs, $file);
232         } elsif ($file =~ m/\.h$/) {
233             &ScanHeader ("$source_dir/$file", $section_list);
234         }
235     }
236     closedir (SRCDIR);
238     # Now recursively scan the subdirectories.
239     my $dir;
240     foreach $dir (@subdirs) {
241         next if ($IGNORE_HEADERS =~ m/(\s|^)\Q${dir}\E(\s|$)/);
242         &ScanHeaders ("$source_dir/$dir", $section_list);
243     }
247 #############################################################################
248 # Function    : ScanHeader
249 # Description : This scans a header file, looking for declarations of
250 #                functions, macros, typedefs, structs and unions, which it
251 #                outputs to the DECL file.
252 # Arguments   : $input_file - the header file to scan.
253 #               $section_list - a reference to the hashmap of sections.
254 # Returns     : it adds declarations to the appropriate list.
255 #############################################################################
257 sub ScanHeader {
258     my ($input_file, $section_list) = @_;
260     my $list = "";                  # Holds the resulting list of declarations.
261     my $title = "";                 # Holds the title of the section
262     my ($in_comment) = 0;                  # True if we are in a comment.
263     my ($in_declaration) = "";          # The type of declaration we are in, e.g.
264                                   #   'function' or 'macro'.
265     my ($skip_block) = 0;                  # True if we should skip a block.
266     my ($symbol);                  # The current symbol being declared.
267     my ($decl);                          # Holds the declaration of the current symbol.
268     my ($ret_type);                  # For functions and function typedefs this
269                                   #   holds the function's return type.
270     my ($pre_previous_line) = "";   # The pre-previous line read in - some Gnome
271                                   #   functions have the return type on one
272                                   #   line, the function name on the next,
273                                   #   and the rest of the declaration after.
274     my ($previous_line) = "";          # The previous line read in - some Gnome
275                                   #   functions have the return type on one line
276                                   #   and the rest of the declaration after.
277     my ($first_macro) = 1;          # Used to try to skip the standard #ifdef XXX
278                                   #   #define XXX at the start of headers.
279     my ($level);                          # Used to handle structs/unions which contain
280                                   #   nested structs or unions.
281     my @objects = ();                  # Holds declarations that look like GtkObject
282                                   #   subclasses, which we remove from the list.
283     my ($internal) = 0;             # Set to 1 for internal symbols, we need to
284                                     #   fully parse, but don't add them to docs
285     my %forward_decls = ();         # hashtable of forward declarations, we skip
286                                     #   them if we find the real declaration
287                                     #   later.
288     my %doc_comments = ();          # hastable of doc-comment we found. We can
289                                     # use that to put element to the right
290                                     # sction in the generated section-file
292     my $file_basename;
294     my $deprecated_conditional_nest = 0;
295     my $ignore_conditional_nest = 0;
297     my $deprecated = "";
298     my $doc_comment = "";
300     # Don't scan headers twice
301     my $canonical_input_file = realpath $input_file;
302     if (exists $seen_headers{$canonical_input_file}) {
303         @TRACE@("File already scanned: $input_file");
304         return;
305     }
306     $seen_headers{$canonical_input_file} = 1;
308     if ($input_file =~ m/^.*[\/\\](.*)\.h+$/) {
309         $file_basename = $1;
310     } else {
311         LogWarning(__FILE__,__LINE__,"Can't find basename of file $input_file");
312         $file_basename = $input_file;
313     }
315     # Check if the basename is in the list of headers to ignore.
316     if ($IGNORE_HEADERS =~ m/(\s|^)\Q${file_basename}\E\.h(\s|$)/) {
317         @TRACE@("File ignored: $input_file");
318         return;
319     }
320     # Check if the full name is in the list of headers to ignore.
321     if ($IGNORE_HEADERS =~ m/(\s|^)\Q${input_file}\E(\s|$)/) {
322         @TRACE@("File ignored: $input_file");
323         return;
324     }
326     if (! -f $input_file) {
327         LogWarning(__FILE__,__LINE__,"File doesn't exist: $input_file");
328         return;
329     }
331     @TRACE@("Scanning $input_file");
333     open(INPUT, $input_file)
334         || die "Can't open $input_file: $!";
335     while(<INPUT>) {
336         # If this is a private header, skip it.
337         if (m%^\s*/\*\s*<\s*private_header\s*>\s*\*/%) {
338             close(INPUT);
339             return;
340         }
342         # Skip to the end of the current comment.
343         if ($in_comment) {
344             @TRACE@("Comment: $_");
345             $doc_comment .= $_;
346             if (m%\*/%) {
347                 if ($doc_comment =~ m/\* ([a-zA-Z][a-zA-Z0-9_]+):/) {
348                   $doc_comments{lc($1)} = 1;
349                 }
350                 $in_comment = 0;
351                 $doc_comment = "";
352             }
353             next;
354         }
356         # Keep a count of #if, #ifdef, #ifndef nesting,
357         # and if we enter a deprecation-symbol-bracketed
358         # zone, take note.
359         if (m/^\s*#\s*if(?:n?def\b|\s+!?\s*defined\s*\()\s*(\w+)/) {
360             my $define_name = $1;
361             if ($deprecated_conditional_nest < 1 and $define_name =~ /$DEPRECATED_GUARDS/) {
362                  $deprecated_conditional_nest = 1;
363             } elsif ($deprecated_conditional_nest >= 1) {
364                  $deprecated_conditional_nest += 1;
365             }
366             if ($ignore_conditional_nest == 0 and $define_name =~ /__GTK_DOC_IGNORE__/) {
367                  $ignore_conditional_nest = 1;
368             } elsif ($ignore_conditional_nest > 0) {
369                  $ignore_conditional_nest += 1;
370             }
371         } elsif (m/^\s*#\sif/) {
372             if ($deprecated_conditional_nest >= 1) {
373                  $deprecated_conditional_nest += 1;
374             }
375             if ($ignore_conditional_nest > 0) {
376                  $ignore_conditional_nest += 1;
377             }
378         } elsif (m/^\s*#endif/) {
379             if ($deprecated_conditional_nest >= 1) {
380                 $deprecated_conditional_nest -= 1;
381             }
382             if ($ignore_conditional_nest > 0) {
383                 $ignore_conditional_nest -= 1;
384             }
385         }
387         # If we find a line containing _DEPRECATED, we hope that this is
388         # attribute based deprecation and also treat this as a deprecation
389         # guard, unless it's a macro definition.
390         if ($deprecated_conditional_nest == 0 and m/_DEPRECATED/) {
391             unless (m/^\s*#\s*(if*|define)/ or $in_declaration eq "enum") {
392                 @TRACE@("Found deprecation annotation (decl: '$in_declaration'): $_");
393                 $deprecated_conditional_nest += 0.1;
394             }
395         }
397         # set global that is used later when we do AddSymbolToList
398         if ($deprecated_conditional_nest > 0) {
399             $deprecated = "<DEPRECATED/>\n";
400         } else {
401             $deprecated = "";
402         }
404         if($ignore_conditional_nest) {
405             next;
406         }
408         if (!$in_declaration) {
409             # Skip top-level comments.
410             if (s%^\s*/\*%%) {
411                 if (m%\*/%) {
412                     @TRACE@("Found one-line comment: $_");
413                 } else {
414                     $in_comment = 1;
415                     $doc_comment = $_;
416                     @TRACE@("Found start of comment: $_");
417                 }
418                 next;
419             }
421             @TRACE@("0: $_");
423             # MACROS
425             if (m/^\s*#\s*define\s+(\w+)/) {
426                 $symbol = $1;
427                 $decl = $_;
428                 # We assume all macros which start with '_' are private.
429                 # We also try to skip the first macro if it looks like the
430                 # standard #ifndef HEADER_FILE #define HEADER_FILE etc.
431                 # And we only want TRUE & FALSE defined in GLib.
432                 if ($symbol !~ m/^_/
433                      && ($previous_line !~ m/#ifndef\s+$symbol/
434                          || $first_macro == 0)
435                      && (($symbol ne 'TRUE' && $symbol ne 'FALSE')
436                          || $MODULE eq 'glib')) {
437                     $in_declaration = "macro";
438                     @TRACE@("Macro: $symbol");
439                 } else {
440                     @TRACE@("skipping Macro: $symbol");
441                     $in_declaration = "macro";
442                     $internal = 1;
443                 }
444                 $first_macro = 0;
447             # TYPEDEF'D FUNCTIONS (i.e. user functions)
449             #                        $1                                $3            $4             $5
450             } elsif (m/^\s*typedef\s+((const\s+|G_CONST_RETURN\s+)?\w+)(\s+const)?\s*(\**)\s*\(\*\s*(\w+)\)\s*\(/) {
451                 my $p3 = defined($3) ? $3 : "";
452                 $ret_type = "$1$p3 $4";
453                 $symbol = $5;
454                 $decl = $';
455                 $in_declaration = "user_function";
456                 @TRACE@("user function (1): $symbol, Returns: $ret_type");
458             #                                                       $1                                $3            $4             $5
459             } elsif (($previous_line =~ m/^\s*typedef\s*/) && m/^\s*((const\s+|G_CONST_RETURN\s+)?\w+)(\s+const)?\s*(\**)\s*\(\*\s*(\w+)\)\s*\(/) {
460                 my $p3 = defined($3) ? $3 : "";
461                 $ret_type = "$1$p3 $4";
462                 $symbol = $5;
463                 $decl = $';
464                 $in_declaration = "user_function";
465                 @TRACE@("user function (2): $symbol, Returns: $ret_type");
467             #                                                       $1            $2
468             } elsif (($previous_line =~ m/^\s*typedef\s*/) && m/^\s*(\**)\s*\(\*\s*(\w+)\)\s*\(/) {
469                 $ret_type = $1;
470                 $symbol = $2;
471                 $decl = $';
472                 #                                     $1                                $3
473                 if ($previous_line =~ m/^\s*typedef\s*((const\s+|G_CONST_RETURN\s+)?\w+)(\s+const)?\s*/) {
474                     my $p3 = defined($3) ? $3 : "";
475                     $ret_type = "$1$p3 ".$ret_type;
476                     $in_declaration = "user_function";
477                     @TRACE@("user function (3): $symbol, Returns: $ret_type");
479                 }
480             # FUNCTION POINTER VARIABLES
481             #                                                                     $1                                $3            $4             $5
482             } elsif (m/^\s*(?:\b(?:extern|G_INLINE_FUNC|${IGNORE_DECORATORS})\s*)*((const\s+|G_CONST_RETURN\s+)?\w+)(\s+const)?\s*(\**)\s*\(\*\s*(\w+)\)\s*\(/o) {
483                 my $p3 = defined($3) ? $3 : "";
484                 $ret_type = "$1$p3 $4";
485                 $symbol = $5;
486                 $decl = $';
487                 $in_declaration = "user_function";
488                 @TRACE@("function pointer variable: $symbol, Returns: $ret_type");
490             # ENUMS
492             } elsif (s/^\s*enum\s+_?(\w+)\s+\{/enum $1 {/) {
493                 # We assume that 'enum _<enum_name> {' is really the
494                 # declaration of enum <enum_name>.
495                 $symbol = $1;
496                 @TRACE@("plain enum: $symbol");
497                 $decl = $_;
498                 $in_declaration = "enum";
500             } elsif (m/^\s*typedef\s+enum\s+_?(\w+)\s+\1\s*;/) {
501                 # We skip 'typedef enum <enum_name> _<enum_name>;' as the enum will
502                 # be declared elsewhere.
503                 @TRACE@("skipping enum typedef: $1");
505             } elsif (m/^\s*typedef\s+enum/) {
506                 $symbol = "";
507                 @TRACE@("typedef enum: -");
508                 $decl = $_;
509                 $in_declaration = "enum";
512             # STRUCTS AND UNIONS
514             } elsif (m/^\s*typedef\s+(struct|union)\s+_(\w+)\s+\2\s*;/) {
515                 # We've found a 'typedef struct _<name> <name>;'
516                 # This could be an opaque data structure, so we output an
517                 # empty declaration. If the structure is actually found that
518                 # will override this.
519                 my $structsym = uc $1;
520                 @TRACE@("$structsym typedef: $2");
521                 $forward_decls{$2} = "<$structsym>\n<NAME>$2</NAME>\n$deprecated</$structsym>\n"
523             } elsif (m/^\s*(?:struct|union)\s+_(\w+)\s*;/) {
524                 # Skip private structs/unions.
525                 @TRACE@("private struct/union");
527             } elsif (m/^\s*(struct|union)\s+(\w+)\s*;/) {
528                 # Do a similar thing for normal structs as for typedefs above.
529                 # But we output the declaration as well in this case, so we
530                 # can differentiate it from a typedef.
531                 my $structsym = uc $1;
532                 @TRACE@("$structsym: $2");
533                 $forward_decls{$2} = "<$structsym>\n<NAME>$2</NAME>\n$_$deprecated</$structsym>\n";
535             } elsif (m/^\s*typedef\s+(struct|union)\s*\w*\s*{/) {
536                 $symbol = "";
537                 $decl = $_;
538                 $level = 0;
539                 $in_declaration = $1;
540                 @TRACE@("typedef struct/union $1");
542             # OTHER TYPEDEFS
544             } elsif (m/^\s*typedef\s+(?:struct|union)\s+\w+[\s\*]+(\w+)\s*;/) {
545                 @TRACE@("Found struct/union(*) typedef $1: $_");
546                 if (&AddSymbolToList (\$list, $1)) {
547                     print DECL "<TYPEDEF>\n<NAME>$1</NAME>\n$deprecated$_</TYPEDEF>\n";
548                 }
550             } elsif (m/^\s*(G_GNUC_EXTENSION\s+)?typedef\s+(.+[\s\*])(\w+)(\s*\[[^\]]+\])*\s*;/) {
551                 if ($2 !~ m/^struct\s/ && $2 !~ m/^union\s/) {
552                     @TRACE@("Found typedef: $_");
553                     if (&AddSymbolToList (\$list, $3)) {
554                         print DECL "<TYPEDEF>\n<NAME>$3</NAME>\n$deprecated$_</TYPEDEF>\n";
555                     }
556                 }
557             } elsif (m/^\s*typedef\s+/) {
558                 @TRACE@("Skipping typedef: $_");
561             # VARIABLES (extern'ed variables)
563             } elsif (m/^\s*(extern|[A-Za-z_]+VAR|${IGNORE_DECORATORS})\s+((const\s+|signed\s+|unsigned\s+|long\s+|short\s+)*\w+)(\s+\*+|\*+|\s)\s*(const\s+)*([A-Za-z]\w*)\s*;/o) {
564                 $symbol = $6;
565                 s/^\s*([A-Za-z_]+VAR)\b/extern/;
566                 $decl = $_;
567                 @TRACE@("Possible extern var $symbol: $decl");
568                 if (&AddSymbolToList (\$list, $symbol)) {
569                     print DECL "<VARIABLE>\n<NAME>$symbol</NAME>\n$deprecated$decl</VARIABLE>\n";
570                 }
573             # VARIABLES
575             } elsif (m/^\s*((const\s+|signed\s+|unsigned\s+|long\s+|short\s+)*\w+)(\s+\*+|\*+|\s)\s*(const\s+)*([A-Za-z]\w*)\s*\=/) {
576                 $symbol = $5;
577                 $decl = $_;
578                 @TRACE@("Possible global var $symbol: $decl");
579                 if (&AddSymbolToList (\$list, $symbol)) {
580                     print DECL "<VARIABLE>\n<NAME>$symbol</NAME>\n$deprecated$decl</VARIABLE>\n";
581                 }
583             # G_DECLARE_*
585             } elsif (m/.*G_DECLARE_(FINAL_TYPE|DERIVABLE_TYPE|INTERFACE)\s*\(/) {
586                 $in_declaration = "g-declare";
587                 $symbol = "G_DECLARE_$1";
588                 $decl = $';
590             # FUNCTIONS
592             # We assume that functions which start with '_' are private, so
593             # we skip them.
594             #                                                                     $1                                                                                                    $2                                                          $3
595             } elsif (m/^\s*(?:\b(?:extern|G_INLINE_FUNC|${IGNORE_DECORATORS})\s*)*((?:const\s+|G_CONST_RETURN\s+|signed\s+|unsigned\s+|long\s+|short\s+|struct\s+|union\s+|enum\s+)*\w+)((?:\s+|\*)+(?:\s*(?:\*+|\bconst\b|\bG_CONST_RETURN\b))*)\s*(_[A-Za-z]\w*)\s*\(/o) {
596                 $ret_type = $1;
597                 if (defined ($2)) { $ret_type .= " $2"; }
598                 $symbol = $3;
599                 $decl = $';
600                 @TRACE@("internal Function: $symbol, Returns: [$1][$2]");
601                 $in_declaration = "function";
602                 $internal = 1;
603                 if (m/^\s*G_INLINE_FUNC/) {
604                     @TRACE@("skip block after inline function");
605                     # now we we need to skip a whole { } block
606                     $skip_block = 1;
607                 }
609             #                                                                     $1                                                                                                    $2                                                          $3
610             } elsif (m/^\s*(?:\b(?:extern|G_INLINE_FUNC|${IGNORE_DECORATORS})\s*)*((?:const\s+|G_CONST_RETURN\s+|signed\s+|unsigned\s+|long\s+|short\s+|struct\s+|union\s+|enum\s+)*\w+)((?:\s+|\*)+(?:\s*(?:\*+|\bconst\b|\bG_CONST_RETURN\b))*)\s*([A-Za-z]\w*)\s*\(/o) {
611                 $ret_type = $1;
612                 if (defined ($2)) { $ret_type .= " $2"; }
613                 $symbol = $3;
614                 $decl = $';
615                 @TRACE@("Function (1): $symbol, Returns: [$1][$2]");
616                 $in_declaration = "function";
617                 if (m/^\s*G_INLINE_FUNC/) {
618                     @TRACE@("skip block after inline function");
619                     # now we we need to skip a whole { } block
620                     $skip_block = 1;
621                 }
623             # Try to catch function declarations which have the return type on
624             # the previous line. But we don't want to catch complete functions
625             # which have been declared G_INLINE_FUNC, e.g. g_bit_nth_lsf in
626             # glib, or 'static inline' functions.
627             } elsif (m/^\s*([A-Za-z]\w*)\s*\(/) {
628                 $symbol = $1;
629                 $decl = $';
631                 if ($previous_line !~ m/^\s*G_INLINE_FUNC/) {
632                     if ($previous_line !~ m/^\s*static\s+/) {
633                         #                                                                     $1                                                                                                   $2
634                         if ($previous_line =~ m/^\s*(?:\b(?:extern|${IGNORE_DECORATORS})\s*)*((?:const\s+|G_CONST_RETURN\s+|signed\s+|unsigned\s+|long\s+|short\s+|struct\s+|union\s+|enum\s+)*\w+)((?:\s*(?:\*+|\bconst\b|\bG_CONST_RETURN\b))*)\s*$/o) {
635                             $ret_type = $1;
636                             if (defined ($2)) { $ret_type .= " $2"; }
637                             @TRACE@("Function  (2): $symbol, Returns: $ret_type");
638                             $in_declaration = "function";
639                         }
640                     } else {
641                         @TRACE@("skip block after inline function");
642                         # now we we need to skip a whole { } block
643                         $skip_block = 1;
644                         #                                                                                  $1                                                                                                    $2
645                         if ($previous_line =~ m/^\s*(?:\b(?:extern|static|inline|${IGNORE_DECORATORS})\s*)*((?:const\s+|G_CONST_RETURN\s+|signed\s+|unsigned\s+|long\s+|short\s+|struct\s+|union\s+|enum\s+)*\w+)((?:\s*(?:\*+|\bconst\b|\bG_CONST_RETURN\b))*)\s*$/o) {
646                             $ret_type = $1;
647                             if (defined ($2)) { $ret_type .= " $2"; }
648                             @TRACE@("Function  (3): $symbol, Returns: $ret_type");
649                             $in_declaration = "function";
650                         }
651                     }
652                 }
653                 else {
654                     if ($previous_line !~ m/^\s*static\s+/) {
655                         @TRACE@("skip block after inline function");
656                         # now we we need to skip a whole { } block
657                         $skip_block = 1;
658                         #                                                                                  $1                                                                                                    $2
659                         if ($previous_line =~ m/^\s*(?:\b(?:extern|G_INLINE_FUNC|${IGNORE_DECORATORS})\s*)*((?:const\s+|G_CONST_RETURN\s+|signed\s+|unsigned\s+|long\s+|short\s+|struct\s+|union\s+|enum\s+)*\w+)((?:\s*(?:\*+|\bconst\b|\bG_CONST_RETURN\b))*)\s*$/o) {
660                             $ret_type = $1;
661                             if (defined ($2)) { $ret_type .= " $2"; }
662                             @TRACE@("Function (4): $symbol, Returns: $ret_type");
663                             $in_declaration = "function";
664                         }
665                     }
666                 }
668             # Try to catch function declarations with the return type and name
669             # on the previous line(s), and the start of the parameters on this.
670             } elsif (m/^\s*\(/) {
671                 $decl = $';
672                 if ($previous_line =~ m/^\s*(?:\b(?:extern|G_INLINE_FUNC|${IGNORE_DECORATORS})\s*)*((?:const\s+|G_CONST_RETURN\s+|signed\s+|unsigned\s+|enum\s+)*\w+)(\s+\*+|\*+|\s)\s*([A-Za-z]\w*)\s*$/o) {
673                     $ret_type = "$1 $2";
674                     $symbol = $3;
675                     @TRACE@("Function (5): $symbol, Returns: $ret_type");
676                     $in_declaration = "function";
678                 } elsif ($previous_line =~ m/^\s*\w+\s*$/
679                          && $pre_previous_line =~ m/^\s*(?:\b(?:extern|G_INLINE_FUNC|${IGNORE_DECORATORS})\s*)*((?:const\s+|G_CONST_RETURN\s+|signed\s+|unsigned\s+|struct\s+|union\s+|enum\s+)*\w+(?:\**\s+\**(?:const|G_CONST_RETURN))?(?:\s+|\s*\*+))\s*$/o) {
680                     $ret_type = $1;
681                     $ret_type =~ s/\s*\n//;
682                     $in_declaration = "function";
684                     $symbol = $previous_line;
685                     $symbol =~ s/^\s+//;
686                     $symbol =~ s/\s*\n//;
687                     @TRACE@("Function (6): $symbol, Returns: $ret_type");
688                 }
690             #} elsif (m/^extern\s+/) {
691                 #print "DEBUG: Skipping extern: $_";
694             # STRUCTS
696             } elsif (m/^\s*struct\s+_?(\w+)\s*\*/) {
697                 # Skip 'struct _<struct_name> *', since it could be a
698                 # return type on its own line.
700             } elsif (m/^\s*struct\s+_?(\w+)/) {
701                 # We assume that 'struct _<struct_name>' is really the
702                 # declaration of struct <struct_name>.
703                 $symbol = $1;
704                 $decl = $_;
705                  # we will find the correct level as below we do $level += tr/{//;
706                 $level = 0;
707                 $in_declaration = "struct";
708                 @TRACE@("Struct(_): $symbol");
711             # UNIONS
713             } elsif (m/^\s*union\s+_(\w+)\s*\*/) {
714                     # Skip 'union _<union_name> *' (see above)
715             } elsif (m/^\s*union\s+_(\w+)/) {
716                 $symbol = $1;
717                 $decl = $_;
718                 $level = 0;
719                 $in_declaration = "union";
720                 @TRACE@("Union(_): $symbol");
721             }
723         } else {
724             @TRACE@("1: [$skip_block] $_");
725             # If we were already in the middle of a declaration, we simply add
726             # the current line onto the end of it.
727             if ($skip_block == 0) {
728                 $decl .= $_;
729             } else {
730                 # Remove all nested pairs of curly braces.
731                 while ($_ =~ s/{[^{]*}//g) { }
732                 # Then hope at most one remains in the line...
733                 if (m%(.*?){%) {
734                     if ($skip_block == 1) {
735                         $decl .= $1;
736                     }
737                     $skip_block += 1;
738                 } elsif (m%}%) {
739                     $skip_block -= 1;
740                     if ($skip_block == 1) {
741                         # this is a hack to detect the end of declaration
742                         $decl .= ";";
743                         $skip_block = 0;
744                         @TRACE@("2: ---");
745                     }
746                 } else {
747                     if ($skip_block == 1) {
748                         $decl .= $_;
749                     }
750                 }
751             }
752         }
754         #if ($in_declaration ne '') {
755         #    print "$in_declaration = $decl\n";
756         #}
758         if ($in_declaration eq "g-declare") {
759             if ($decl =~ s/\s*(\w+)\s*,\s*(\w+)\s*,\s*(\w+)\s*,\s*(\w+)\s*,\s*(\w+)\s*\).*$//) {
760                 my $ModuleObjName = $1;
761                 my $module_obj_name = $2;
762                 if ($REBUILD_TYPES) {
763                     push (@get_types, "${module_obj_name}_get_type");
764                 }
765                 $forward_decls{$ModuleObjName} = "<STRUCT>\n<NAME>$ModuleObjName</NAME>\n$deprecated</STRUCT>\n";
766                 if ($symbol =~ /^G_DECLARE_DERIVABLE/) {
767                     $forward_decls{"${ModuleObjName}Class"} = "<STRUCT>\n<NAME>${ModuleObjName}Class</NAME>\n$deprecated</STRUCT>\n";
768                 }
769                 if ($symbol =~ /^G_DECLARE_INTERFACE/) {
770                     $forward_decls{"${ModuleObjName}Interface"} = "<STRUCT>\n<NAME>${ModuleObjName}Interface</NAME>\n$deprecated</STRUCT>\n";
771                 }
772                 $in_declaration = "";
773             }
774         }
776         # Note that sometimes functions end in ') G_GNUC_PRINTF (2, 3);' or
777         # ') __attribute__ (...);'.
778         if ($in_declaration eq 'function') {
779             if ($decl =~ s/\)\s*(G_GNUC_.*|.*DEPRECATED.*|${IGNORE_DECORATORS}\s*|__attribute__\s*\(.*\)\s*)*;.*$//s) {
780                 if ($internal == 0) {
781                      $decl =~ s%/\*.*?\*/%%gs;        # remove comments.
782                      #$decl =~ s/^\s+//;                # remove leading whitespace.
783                      #$decl =~ s/\s+$//;                # remove trailing whitespace.
784                      $decl =~ s/\s*\n\s*/ /gs;        # consolidate whitespace at start
785                                                    # and end of lines.
786                      $ret_type =~ s%/\*.*?\*/%%g;        # remove comments in ret type.
787                      if (&AddSymbolToList (\$list, $symbol)) {
788                          print DECL "<FUNCTION>\n<NAME>$symbol</NAME>\n$deprecated<RETURNS>$ret_type</RETURNS>\n$decl\n</FUNCTION>\n";
789                          if ($REBUILD_TYPES) {
790                              # check if this looks like a get_type function and if so remember
791                              if (($symbol =~ m/_get_type$/) && ($ret_type =~ m/GType/) && ($decl =~ m/^(void|)$/)) {
792                                  @TRACE@("Adding get-type: [$ret_type] [$symbol] [$decl]\tfrom $input_file");
793                                  push (@get_types, $symbol);
794                              }
795                          }
796                      }
797                 } else {
798                      $internal = 0;
799                 }
800                 $deprecated_conditional_nest = int($deprecated_conditional_nest);
801                 $in_declaration = "";
802                 $skip_block = 0;
803             }
804         }
806         if ($in_declaration eq 'user_function') {
807             if ($decl =~ s/\).*$//) {
808                 if (&AddSymbolToList (\$list, $symbol)) {
809                     print DECL "<USER_FUNCTION>\n<NAME>$symbol</NAME>\n$deprecated<RETURNS>$ret_type</RETURNS>\n$decl</USER_FUNCTION>\n";
810                 }
811                 $deprecated_conditional_nest = int($deprecated_conditional_nest);
812                 $in_declaration = "";
813             }
814         }
816         if ($in_declaration eq 'macro') {
817             if ($decl !~ m/\\\s*$/) {
818                 if ($internal == 0) {
819                     if (&AddSymbolToList (\$list, $symbol)) {
820                         print DECL "<MACRO>\n<NAME>$symbol</NAME>\n$deprecated$decl</MACRO>\n";
821                     }
822                 } else {
823                     $internal = 0;
824                 }
825                 $deprecated_conditional_nest = int($deprecated_conditional_nest);
826                 $in_declaration = "";
827             }
828         }
830         if ($in_declaration eq 'enum') {
831             if ($decl =~ m/\}\s*(\w+)?;\s*$/) {
832                 if ($symbol eq "") {
833                     $symbol = $1;
834                 }
835                 if (&AddSymbolToList (\$list, $symbol)) {
836                     print DECL "<ENUM>\n<NAME>$symbol</NAME>\n$deprecated$decl</ENUM>\n";
837                 }
838                 $deprecated_conditional_nest = int($deprecated_conditional_nest);
839                 $in_declaration = "";
840             }
841         }
843         # We try to handle nested stucts/unions, but unmatched brackets in
844         # comments will cause problems.
845         if ($in_declaration eq 'struct' or $in_declaration eq 'union') {
846             if (($level <= 1) && ($decl =~ m/\n\}\s*(\w*);\s*$/)) {
847                 if ($symbol eq "") {
848                     $symbol = $1;
849                 }
851                 if ($symbol =~ m/^(\S+)(Class|Iface|Interface)\b/) {
852                     my $objectname = $1;
853                     @TRACE@("Found object: $1");
854                     $title = "<TITLE>$objectname</TITLE>\n";
855                     push (@objects, $objectname);
856                 }
857                 @TRACE@("Store struct: $symbol");
858                 if (&AddSymbolToList (\$list, $symbol)) {
859                     my $structsym = uc $in_declaration;
860                     print DECL "<$structsym>\n<NAME>$symbol</NAME>\n$deprecated$decl</$structsym>\n";
861                     if (defined($forward_decls{$symbol})) {
862                         undef($forward_decls{$symbol});
863                     }
864                 }
865                 $deprecated_conditional_nest = int($deprecated_conditional_nest);
866                 $in_declaration = "";
867             } else {
868                 # We use tr to count the brackets in the line, and adjust
869                 # $level accordingly.
870                 $level += tr/{//;
871                 $level -= tr/}//;
872                 @TRACE@("struct/union level : $level");
873             }
874         }
876         $pre_previous_line = $previous_line;
877         $previous_line = $_;
878     }
879     close(INPUT);
881     # print remaining forward declarations
882     foreach $symbol (sort(keys %forward_decls)) {
883         if (defined($forward_decls{$symbol})) {
884             &AddSymbolToList (\$list, $symbol);
885             print DECL $forward_decls{$symbol};
886         }
887     }
889     # add title
890     $list = "$title$list";
892     @TRACE@("Scanning $input_file done\n");
894     # Try to separate the standard macros and functions, placing them at the
895     # end of the current section, in a subsection named 'Standard'.
896     # do this in a loop to catch object, enums and flags
897     my ($class,$lclass,$prefix,$lprefix);
898     my ($standard_decl) = "";
899     do {
900         if ($list =~ m/^(\S+)_IS_(\S*)_CLASS\n/m) {
901             $prefix = $1;
902             $lprefix = lc($prefix);
903             $class = $2;
904             $lclass = lc($class);
905             @TRACE@("Found gobject type '${prefix}_$class' from is_class macro\n");
906         } elsif ($list =~ m/^(\S+)_IS_(\S*)\n/m) {
907             $prefix = $1;
908             $lprefix = lc($prefix);
909             $class = $2;
910             $lclass = lc($class);
911             @TRACE@("Found gobject type '${prefix}_$class' from is_ macro\n");
912         } elsif ($list =~ m/^(\S+?)_(\S*)_get_type\n/m) {
913             $lprefix = $1;
914             $prefix = uc($lprefix);
915             $lclass = $2;
916             $class = uc($lclass);
917             @TRACE@("Found gobject type '${prefix}_$class' from get_type function\n");
918         } else {
919           $class = $lclass = "";
920         }
922         if ($class ne "") {
923             my ($cclass) = $lclass;
924             $cclass =~ s/_//g;
925             my ($type) = $lprefix.$cclass;
927             if ($list =~ s/^${type}Private\n//im)               { $standard_decl .= $&; }
929             # We only leave XxYy* in the normal section if they have docs
930             if (! defined($doc_comments{$type})) {
931               @TRACE@("  Hide instance docs for $type");
932               if ($list =~ s/^${type}\n//im)                    { $standard_decl .= $&; }
933             }
934             if (! defined($doc_comments{$type."class"})) {
935               @TRACE@("  Hide class docs for $type");
936               if ($list =~ s/^${type}Class\n//im)               { $standard_decl .= $&; }
937             }
938             if (! defined($doc_comments{$type."interface"})) {
939               @TRACE@("  Hide iface docs for $type");
940               if ($list =~ s/^$type}Interface\n//im)            { $standard_decl .= $&; }
941             }
942             if (! defined($doc_comments{$type."iface"})) {
943               @TRACE@("  Hide iface docs for $type");
944               if ($list =~ s/${type}Iface\n//im)                { $standard_decl .= $&; }
945             }
947             while ($list =~ s/^\S+_IS_$class\n//m)              { $standard_decl .= $&; }
948             while ($list =~ s/^\S+_TYPE_$class\n//m)            { $standard_decl .= $&; }
949             while ($list =~ s/^\S+_${lclass}_get_type\n//m)     { $standard_decl .= $&; }
950             while ($list =~ s/^\S+_${class}_CLASS\n//m)         { $standard_decl .= $&; }
951             while ($list =~ s/^\S+_IS_${class}_CLASS\n//m)      { $standard_decl .= $&; }
952             while ($list =~ s/^\S+_${class}_GET_CLASS\n//m)     { $standard_decl .= $&; }
953             while ($list =~ s/^\S+_${class}_GET_IFACE\n//m)     { $standard_decl .= $&; }
954             while ($list =~ s/^\S+_${class}_GET_INTERFACE\n//m) { $standard_decl .= $&; }
956             # We do this one last, otherwise it tends to be caught by the IS_$class macro
957             while ($list =~ s/^\S+_$class\n//m)                 { $standard_decl .= $&; }
959             @TRACE@("Decl '".join(",",split("\n",$list))."'\n");
960             @TRACE@("Std  '".join(",",split("\n",$standard_decl))."'\n");
961         }
962     } while ($class ne "");
963     if ($standard_decl ne "") {
964       # sort the symbols
965       $standard_decl=join("\n",sort(split("\n",$standard_decl)))."\n";
966       $list .= "<SUBSECTION Standard>\n$standard_decl";
967     }
968     if ($list ne "") {
969         $$section_list{$file_basename} .= "<SECTION>\n<FILE>$file_basename</FILE>\n$list</SECTION>\n\n";
970     }
974 #############################################################################
975 # Function    : AddSymbolToList
976 # Description : This adds the symbol to the list of declarations, but only if
977 #                it is not already in the list.
978 # Arguments   : $list - reference to the list of symbols, one on each line.
979 #                $symbol - the symbol to add to the list.
980 #############################################################################
982 sub AddSymbolToList {
983     my ($list, $symbol) = @_;
985     if ($$list =~ m/\b\Q$symbol\E\b/) {
986          #print "Symbol $symbol already in list. skipping\n";
987          # we return 0 to skip outputting another entry to -decl.txt
988          # this is to avoid redeclarations (e.g. in conditional
989          # sections).
990         return 0;
991     }
992     $$list .= "$symbol\n";
993     return 1;