source: trunk/third/glib2/gobject/glib-mkenums.in @ 20721

Revision 20721, 13.8 KB checked in by ghudson, 20 years ago (diff)
This commit was generated by cvs2svn to compensate for changes in r20720, which included commits to RCS files with non-trunk default branches.
  • Property svn:executable set to *
Line 
1#!@PERL_PATH@ -w
2
3# glib-mkenums.pl
4# Information about the current enumeration
5my $flags;                      # Is enumeration a bitmask?
6my $option_lowercase_name;                      # A lower case name to use as part of the *_get_type() function, instead of the one that we guess.
7                        # For instance, when an enum uses abnormal capitalization and we can not guess where to put the underscores.
8my $seenbitshift;               # Have we seen bitshift operators?
9my $enum_prefix;                # Prefix for this enumeration
10my $enumname;                   # Name for this enumeration
11my $enumshort;                  # $enumname without prefix
12my $enumindex = 0;              # Global enum counter
13my $firstenum = 1;              # Is this the first enumeration per file?
14my @entries;                    # [ $name, $val ] for each entry
15
16sub parse_trigraph {
17    my $opts = shift;
18    my @opts;
19
20    for $opt (split /\s*,\s*/, $opts) {
21        $opt =~ s/^\s*//;
22        $opt =~ s/\s*$//;
23        my ($key,$val) = $opt =~ /(\w+)(?:=(.+))?/;
24        defined $val or $val = 1;
25        push @opts, $key, $val;
26    }
27    @opts;
28}
29sub parse_entries {
30    my $file = shift;
31    my $file_name = shift;
32    my $looking_for_name = 0;
33   
34    while (<$file>) {
35        # read lines until we have no open comments
36        while (m@/\*([^*]|\*(?!/))*$@) {
37            my $new;
38            defined ($new = <$file>) || die "Unmatched comment in $ARGV";
39            $_ .= $new;
40        }
41        # strip comments w/o options
42        s@/\*(?!<)
43            ([^*]+|\*(?!/))*
44           \*/@@gx;
45       
46        # strip newlines
47        s@\n@ @;
48       
49        # skip empty lines
50        next if m@^\s*$@;
51       
52        if ($looking_for_name) {
53            if (/^\s*(\w+)/) {
54                $enumname = $1;
55                return 1;
56            }
57        }
58       
59        # Handle include files
60        if (/^\#include\s*<([^>]*)>/ ) {
61            my $file= "../$1";
62            open NEWFILE, $file or die "Cannot open include file $file: $!\n";
63           
64            if (parse_entries (\*NEWFILE, $NEWFILE)) {
65                return 1;
66            } else {
67                next;
68            }
69        }
70       
71        if (/^\s*\}\s*(\w+)/) {
72            $enumname = $1;
73            $enumindex++;
74            return 1;
75        }
76       
77        if (/^\s*\}/) {
78            $enumindex++;
79            $looking_for_name = 1;
80            next;
81        }
82
83        if (m@^\s*
84              (\w+)\s*                   # name
85              (?:=(                      # value
86                   \s*\w+\s*\(.*\)\s*       # macro with multiple args
87                   |                        # OR
88                   (?:[^,/]|/(?!\*))*       # anything but a comma or comment
89                  ))?,?\s*
90              (?:/\*<                    # options
91                (([^*]|\*(?!/))*)
92               >\s*\*/)?,?
93              \s*$
94             @x) {
95            my ($name, $value, $options) = ($1,$2,$3);
96
97            if (!defined $flags && defined $value && $value =~ /<</) {
98                $seenbitshift = 1;
99            }
100
101            if (defined $options) {
102                my %options = parse_trigraph($options);
103                if (!defined $options{skip}) {
104                    push @entries, [ $name, $options{nick} ];
105                }
106            } else {
107                push @entries, [ $name ];
108            }
109        } elsif (m@^\s*\#@) {
110            # ignore preprocessor directives
111        } else {
112            print STDERR "$0: $file_name:$.: Failed to parse `$_'\n";
113        }
114    }
115
116    return 0;
117}
118
119sub version {
120    print STDERR "glib-mkenums version glib-@GLIB_VERSION@\n";
121    print STDERR "glib-mkenums comes with ABSOLUTELY NO WARRANTY.\n";
122    print STDERR "You may redistribute copies of glib-mkenums under the terms of\n";
123    print STDERR "the GNU General Public License which can be found in the\n";
124    print STDERR "GLib source package. Sources, examples and contact\n";
125    print STDERR "information are available at http://www.gtk.org\n";
126    exit 0;
127}
128sub usage {
129    print STDERR "Usage: glib-mkenums [options] [files...]\n";
130    print STDERR "  --fhead <text>             output file header\n";
131    print STDERR "  --fprod <text>             per input file production\n";
132    print STDERR "  --ftail <text>             output file trailer\n";
133    print STDERR "  --eprod <text>             per enum text (produced prior to value itarations)\n";
134    print STDERR "  --vhead <text>             value header, produced before iterating over enum values\n";
135    print STDERR "  --vprod <text>             value text, produced for each enum value\n";
136    print STDERR "  --vtail <text>             value tail, produced after iterating over enum values\n";
137    print STDERR "  --comments <text>          comment structure\n";
138    print STDERR "  --template file            template file\n";
139    print STDERR "  -h, --help                 show this help message\n";
140    print STDERR "  -v, --version              print version informations\n";
141    print STDERR "Production text substitutions:\n";
142    print STDERR "  \@EnumName\@                 PrefixTheXEnum\n";
143    print STDERR "  \@enum_name\@                prefix_the_xenum\n";
144    print STDERR "  \@ENUMNAME\@                 PREFIX_THE_XENUM\n";
145    print STDERR "  \@ENUMSHORT\@                THE_XENUM\n";
146    print STDERR "  \@VALUENAME\@                PREFIX_THE_XVALUE\n";
147    print STDERR "  \@valuenick\@                the-xvalue\n";
148    print STDERR "  \@type\@                     either enum or flags\n";
149    print STDERR "  \@Type\@                     either Enum or Flags\n";
150    print STDERR "  \@TYPE\@                     either ENUM or FLAGS\n";
151    print STDERR "  \@filename\@                 name of current input file\n";
152    exit 0;
153}
154
155# production variables:
156my $fhead = "";   # output file header
157my $fprod = "";   # per input file production
158my $ftail = "";   # output file trailer
159my $eprod = "";   # per enum text (produced prior to value itarations)
160my $vhead = "";   # value header, produced before iterating over enum values
161my $vprod = "";   # value text, produced for each enum value
162my $vtail = "";   # value tail, produced after iterating over enum values
163# other options
164my $comment_tmpl = "/* \@comment\@ */";
165
166sub read_template_file {
167  my ($file) = @_;
168  my %tmpl = ('file-header', $fhead,
169              'file-production', $fprod,
170              'file-tail', $ftail,
171              'enumeration-production', $eprod,
172              'value-header', $vhead,
173              'value-production', $vprod,
174              'value-tail', $vtail,
175              'comment', $comment_tmpl);
176  my $in = 'junk';
177  open (FILE, $file) || die "Can't open $file: $!\n";
178  while (<FILE>) {
179    if (/^\/\*\*\*\s+(BEGIN|END)\s+([\w-]+)\s+\*\*\*\//) {
180      if (($in eq 'junk') && ($1 eq 'BEGIN') && (exists($tmpl{$2}))) {
181        $in = $2;
182        next;
183      }
184      elsif (($in eq $2) && ($1 eq 'END') && (exists($tmpl{$2}))) {
185        $in = 'junk';
186        next;
187      }
188      else {
189          die "Malformed template file $file\n";
190      }
191    }
192    if (!($in eq 'junk')) {
193        $tmpl{$in} .= $_;
194    }
195  }
196  close (FILE);
197  if (!($in eq 'junk')) {
198      die "Malformed template file $file\n";
199  }
200  $fhead = $tmpl{'file-header'};
201  $fprod = $tmpl{'file-production'};
202  $ftail = $tmpl{'file-tail'};
203  $eprod = $tmpl{'enumeration-production'};
204  $vhead = $tmpl{'value-header'};
205  $vprod = $tmpl{'value-production'};
206  $vtail = $tmpl{'value-tail'};
207  $comment_tmpl = $tmpl{'comment'};
208}
209
210if (!defined $ARGV[0]) {
211    usage;
212}
213while ($_ = $ARGV[0], /^-/) {
214    shift;
215    last if /^--$/;
216    if (/^--template$/)              { read_template_file (shift); }
217    elsif (/^--fhead$/)              { $fhead = $fhead . shift }
218    elsif (/^--fprod$/)              { $fprod = $fprod . shift }
219    elsif (/^--ftail$/)              { $ftail = $ftail . shift }
220    elsif (/^--eprod$/)              { $eprod = $eprod . shift }
221    elsif (/^--vhead$/)              { $vhead = $vhead . shift }
222    elsif (/^--vprod$/)              { $vprod = $vprod . shift }
223    elsif (/^--vtail$/)              { $vtail = $vtail . shift }
224    elsif (/^--comments$/)           { $comment_tmpl = shift }
225    elsif (/^--help$/ || /^-h$/)     { usage; }
226    elsif (/^--version$/ || /^-v$/)  { version; }
227    else { usage; }
228}
229
230# put auto-generation comment
231{
232    my $comment = $comment_tmpl;
233    $comment =~ s/\@comment\@/Generated data (by glib-mkenums)/;
234    print "\n" . $comment . "\n\n";
235}
236
237if (length($fhead)) {
238    my $prod = $fhead;
239
240    $prod =~ s/\@filename\@/$ARGV[0]/g;
241    $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
242    $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
243               
244    print "$prod\n";
245}
246
247while (<>) {
248    if (eof) {
249        close (ARGV);           # reset line numbering
250        $firstenum = 1;         # Flag to print filename at next enum
251    }
252
253    # read lines until we have no open comments
254    while (m@/\*([^*]|\*(?!/))*$@) {
255        my $new;
256        defined ($new = <>) || die "Unmatched comment in $ARGV";
257        $_ .= $new;
258    }
259    # strip comments w/o options
260    s@/\*(?!<)
261       ([^*]+|\*(?!/))*
262       \*/@@gx;
263       
264    if (m@^\s*typedef\s+enum\s*
265           ({)?\s*
266           (?:/\*<
267             (([^*]|\*(?!/))*)
268            >\s*\*/)?
269         @x) {
270        if (defined $2) {
271            my %options = parse_trigraph ($2);
272            next if defined $options{skip};
273            $enum_prefix = $options{prefix};
274            $flags = $options{flags};
275      $option_lowercase_name = $options{lowercase_name};
276        } else {
277            $enum_prefix = undef;
278            $flags = undef;
279      $option_lowercase_name = undef;
280        }
281        # Didn't have trailing '{' look on next lines
282        if (!defined $1) {
283            while (<>) {
284                if (s/^\s*\{//) {
285                    last;
286                }
287            }
288        }
289
290        $seenbitshift = 0;
291        @entries = ();
292
293        # Now parse the entries
294        parse_entries (\*ARGV, $ARGV);
295
296        # figure out if this was a flags or enums enumeration
297        if (!defined $flags) {
298            $flags = $seenbitshift;
299        }
300
301        # Autogenerate a prefix
302        if (!defined $enum_prefix) {
303            for (@entries) {
304                my $nick = $_->[1];
305                if (!defined $nick) {
306                    my $name = $_->[0];
307                    if (defined $enum_prefix) {
308                        my $tmp = ~ ($name ^ $enum_prefix);
309                        ($tmp) = $tmp =~ /(^\xff*)/;
310                        $enum_prefix = $enum_prefix & $tmp;
311                    } else {
312                        $enum_prefix = $name;
313                    }
314                }
315            }
316            if (!defined $enum_prefix) {
317                $enum_prefix = "";
318            } else {
319                # Trim so that it ends in an underscore
320                $enum_prefix =~ s/_[^_]*$/_/;
321            }
322        } else {
323            # canonicalize user defined prefixes
324            $enum_prefix = uc($enum_prefix);
325            $enum_prefix =~ s/-/_/g;
326            $enum_prefix =~ s/(.*)([^_])$/$1$2_/;
327        }
328       
329        for $entry (@entries) {
330            my ($name,$nick) = @{$entry};
331            if (!defined $nick) {
332                ($nick = $name) =~ s/^$enum_prefix//;
333                $nick =~ tr/_/-/;
334                $nick = lc($nick);
335                @{$entry} = ($name, $nick);
336            }
337        }
338       
339
340        # Spit out the output
341       
342        # enumname is e.g. GMatchType
343        $enspace = $enumname;
344        $enspace =~ s/^([A-Z][a-z]*).*$/$1/;
345       
346        $enumshort = $enumname;
347        $enumshort =~ s/^[A-Z][a-z]*//;
348        $enumshort =~ s/([^A-Z])([A-Z])/$1_$2/g;
349        $enumshort =~ s/([A-Z][A-Z])([A-Z][0-9a-z])/$1_$2/g;
350        $enumshort = uc($enumshort);
351
352        $enumlong = uc($enspace) . "_" . $enumshort;
353        $enumsym = lc($enspace) . "_" . lc($enumshort);
354
355  #The options might override the lower case name if it could not be generated correctly:
356  if (defined($option_lowercase_name)) {
357      $enumsym = $option_lowercase_name;
358  }
359
360        if ($firstenum) {
361            $firstenum = 0;
362           
363            if (length($fprod)) {
364                my $prod = $fprod;
365
366                $prod =~ s/\@filename\@/$ARGV/g;
367                $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
368                $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
369               
370                print "$prod\n";
371            }
372        }
373       
374        if (length($eprod)) {
375            my $prod = $eprod;
376
377            $prod =~ s/\@enum_name\@/$enumsym/g;
378            $prod =~ s/\@EnumName\@/$enumname/g;
379            $prod =~ s/\@ENUMSHORT\@/$enumshort/g;
380            $prod =~ s/\@ENUMNAME\@/$enumlong/g;
381            if ($flags) { $prod =~ s/\@type\@/flags/g; } else { $prod =~ s/\@type\@/enum/g; }
382            if ($flags) { $prod =~ s/\@Type\@/Flags/g; } else { $prod =~ s/\@Type\@/Enum/g; }
383            if ($flags) { $prod =~ s/\@TYPE\@/FLAGS/g; } else { $prod =~ s/\@TYPE\@/ENUM/g; }
384            $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
385            $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
386
387            print "$prod\n";
388        }
389
390        if (length($vhead)) {
391            my $prod = $vhead;
392
393            $prod =~ s/\@enum_name\@/$enumsym/g;
394            $prod =~ s/\@EnumName\@/$enumname/g;
395            $prod =~ s/\@ENUMSHORT\@/$enumshort/g;
396            $prod =~ s/\@ENUMNAME\@/$enumlong/g;
397            if ($flags) { $prod =~ s/\@type\@/flags/g; } else { $prod =~ s/\@type\@/enum/g; }
398            if ($flags) { $prod =~ s/\@Type\@/Flags/g; } else { $prod =~ s/\@Type\@/Enum/g; }
399            if ($flags) { $prod =~ s/\@TYPE\@/FLAGS/g; } else { $prod =~ s/\@TYPE\@/ENUM/g; }
400            $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
401            $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
402           
403            print "$prod\n";
404        }
405
406        if (length($vprod)) {
407            my $prod = $vprod;
408           
409            $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
410            $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
411            for (@entries) {
412                my ($name,$nick) = @{$_};
413                my $tmp_prod = $prod;
414
415                $tmp_prod =~ s/\@VALUENAME\@/$name/g;
416                $tmp_prod =~ s/\@valuenick\@/$nick/g;
417                if ($flags) { $tmp_prod =~ s/\@type\@/flags/g; } else { $tmp_prod =~ s/\@type\@/enum/g; }
418                if ($flags) { $tmp_prod =~ s/\@Type\@/Flags/g; } else { $tmp_prod =~ s/\@Type\@/Enum/g; }
419                if ($flags) { $tmp_prod =~ s/\@TYPE\@/FLAGS/g; } else { $tmp_prod =~ s/\@TYPE\@/ENUM/g; }
420
421                print "$tmp_prod\n";
422            }
423        }
424
425        if (length($vtail)) {
426            my $prod = $vtail;
427
428            $prod =~ s/\@enum_name\@/$enumsym/g;
429            $prod =~ s/\@EnumName\@/$enumname/g;
430            $prod =~ s/\@ENUMSHORT\@/$enumshort/g;
431            $prod =~ s/\@ENUMNAME\@/$enumlong/g;
432            if ($flags) { $prod =~ s/\@type\@/flags/g; } else { $prod =~ s/\@type\@/enum/g; }
433            if ($flags) { $prod =~ s/\@Type\@/Flags/g; } else { $prod =~ s/\@Type\@/Enum/g; }
434            if ($flags) { $prod =~ s/\@TYPE\@/FLAGS/g; } else { $prod =~ s/\@TYPE\@/ENUM/g; }
435            $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
436            $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
437           
438            print "$prod\n";
439        }
440    }
441}
442
443if (length($ftail)) {
444    my $prod = $ftail;
445
446    $prod =~ s/\@filename\@/$ARGV/g;
447    $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
448    $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
449               
450    print "$prod\n";
451}
452
453# put auto-generation comment
454{
455    my $comment = $comment_tmpl;
456    $comment =~ s/\@comment\@/Generated data ends here/;
457    print "\n" . $comment . "\n\n";
458}
Note: See TracBrowser for help on using the repository browser.