11 # Information about the current enumeration
12 my $flags; # Is enumeration a bitmask?
13 my $option_underscore_name; # Overriden underscore variant of the enum name
14 # for example to fix the cases we don't get the
15 # mixed-case -> underscorized transform right.
16 my $option_lowercase_name; # DEPRECATED. A lower case name to use as part
17 # of the *_get_type() function, instead of the
18 # one that we guess. For instance, when an enum
19 # uses abnormal capitalization and we can not
20 # guess where to put the underscores.
21 my $seenbitshift; # Have we seen bitshift operators?
22 my $seenprivate; # Have we seen a private option?
23 my $enum_prefix; # Prefix for this enumeration
24 my $enumname; # Name for this enumeration
25 my $enumshort; # $enumname without prefix
26 my $enumname_prefix; # prefix of $enumname
27 my $enumindex = 0; # Global enum counter
28 my $firstenum = 1; # Is this the first enumeration per file?
29 my @entries; # [ $name, $val ] for each entry
30 my $sandbox = Safe->new; # sandbox for safe evaluation of expressions
32 my $output; # Filename to write result into
38 for $opt (split /\s*,\s*/, $opts) {
41 my ($key,$val) = $opt =~ /(\w+)(?:=(.+))?/;
42 defined $val or $val = 1;
43 push @opts, $key, $val;
49 my $file_name = shift;
50 my $looking_for_name = 0;
53 # read lines until we have no open comments
54 while (m@/\*([^*]|\*(?!/))*$@) {
56 defined ($new = <$file>) || die "Unmatched comment in $ARGV";
59 # strip comments w/o options
70 if ($looking_for_name) {
77 # Handle include files
78 if (/^\#include\s*<([^>]*)>/ ) {
80 open NEWFILE, $file or die "Cannot open include file $file: $!\n";
82 if (parse_entries (\*NEWFILE, $NEWFILE)) {
89 if (/^\s*\}\s*(\w+)/) {
97 $looking_for_name = 1;
104 \s*\w+\s*\(.*\)\s* # macro with multiple args
106 (?:[^,/]|/(?!\*))* # anything but a comma or comment
113 my ($name, $value, $options) = ($1,$2,$3);
115 if (!defined $flags && defined $value && $value =~ /<</) {
119 next if $seenprivate;
121 if (defined $options) {
122 my %options = parse_trigraph($options);
123 if (!defined $options{skip}) {
124 push @entries, [ $name, $value, $options{nick} ];
127 push @entries, [ $name, $value ];
129 } elsif (m@^\s*\#@) {
130 # ignore preprocessor directives
132 /\*< (([^*]|\*(?!/))*) >\s*\*/
135 my ($options) = ($1);
137 if (defined $options) {
138 my %options = parse_trigraph($options);
139 if (defined $options{private}) {
142 elsif (defined $options{public}) {
147 print STDERR "$0: $file_name:$.: Failed to parse `$_'\n";
155 print "glib-mkenums version glib-@GLIB_VERSION@\n";
156 print "glib-mkenums comes with ABSOLUTELY NO WARRANTY.\n";
157 print "You may redistribute copies of glib-mkenums under the terms of\n";
158 print "the GNU General Public License which can be found in the\n";
159 print "GLib source package. Sources, examples and contact\n";
160 print "information are available at http://www.gtk.org\n";
165 print " glib-mkenums [OPTION...] [FILES...]\n\n";
166 print "Help Options:\n";
167 print " -h, --help Show this help message\n\n";
168 print "Utility Options:\n";
169 print " --identifier-prefix <text> Identifier prefix\n";
170 print " --symbol-prefix <text> Symbol prefix\n";
171 print " --fhead <text> Output file header\n";
172 print " --fprod <text> Per input file production\n";
173 print " --ftail <text> Output file trailer\n";
174 print " --eprod <text> Per enum text (produced prior to value iterations)\n";
175 print " --vhead <text> Value header, produced before iterating over enum values\n";
176 print " --vprod <text> Value text, produced for each enum value\n";
177 print " --vtail <text> Value tail, produced after iterating over enum values\n";
178 print " --comments <text> Comment structure\n";
179 print " --template file Template file\n";
180 print " --output file Output file\n";
181 print " -v, --version Print version informations\n\n";
182 print "Production text substitutions:\n";
183 print " \@EnumName\@ PrefixTheXEnum\n";
184 print " \@enum_name\@ prefix_the_xenum\n";
185 print " \@ENUMNAME\@ PREFIX_THE_XENUM\n";
186 print " \@ENUMSHORT\@ THE_XENUM\n";
187 print " \@ENUMPREFIX\@ PREFIX\n";
188 print " \@VALUENAME\@ PREFIX_THE_XVALUE\n";
189 print " \@valuenick\@ the-xvalue\n";
190 print " \@valuenum\@ the integer value (limited support, Since: 2.26)\n";
191 print " \@type\@ either enum or flags\n";
192 print " \@Type\@ either Enum or Flags\n";
193 print " \@TYPE\@ either ENUM or FLAGS\n";
194 print " \@filename\@ name of current input file\n";
195 print " \@basename\@ base name of the current input file (Since: 2.22)\n";
199 # production variables:
200 my $idprefix = ""; # "G", "Gtk", etc
201 my $symprefix = ""; # "g", "gtk", etc, if not just lc($idprefix)
202 my $fhead = ""; # output file header
203 my $fprod = ""; # per input file production
204 my $ftail = ""; # output file trailer
205 my $eprod = ""; # per enum text (produced prior to value itarations)
206 my $vhead = ""; # value header, produced before iterating over enum values
207 my $vprod = ""; # value text, produced for each enum value
208 my $vtail = ""; # value tail, produced after iterating over enum values
209 my $comment_tmpl = ""; # comment template
211 sub read_template_file {
213 my %tmpl = ('file-header', $fhead,
214 'file-production', $fprod,
216 'enumeration-production', $eprod,
217 'value-header', $vhead,
218 'value-production', $vprod,
219 'value-tail', $vtail,
220 'comment', $comment_tmpl);
222 open (FILE, $file) || die "Can't open $file: $!\n";
224 if (/^\/\*\*\*\s+(BEGIN|END)\s+([\w-]+)\s+\*\*\*\//) {
225 if (($in eq 'junk') && ($1 eq 'BEGIN') && (exists($tmpl{$2}))) {
229 elsif (($in eq $2) && ($1 eq 'END') && (exists($tmpl{$2}))) {
233 die "Malformed template file $file\n";
236 if (!($in eq 'junk')) {
241 if (!($in eq 'junk')) {
242 die "Malformed template file $file\n";
244 $fhead = $tmpl{'file-header'};
245 $fprod = $tmpl{'file-production'};
246 $ftail = $tmpl{'file-tail'};
247 $eprod = $tmpl{'enumeration-production'};
248 $vhead = $tmpl{'value-header'};
249 $vprod = $tmpl{'value-production'};
250 $vtail = $tmpl{'value-tail'};
251 $comment_tmpl = $tmpl{'comment'};
253 # default to C-style comments
254 $comment_tmpl = "/* \@comment\@ */" if $comment_tmpl eq "";
257 if (!defined $ARGV[0]) {
260 while ($_=$ARGV[0],/^-/) {
263 if (/^--template$/) { read_template_file (shift); }
264 elsif (/^--identifier-prefix$/) { $idprefix = shift }
265 elsif (/^--symbol-prefix$/) { $symprefix = shift }
266 elsif (/^--fhead$/) { $fhead = $fhead . shift }
267 elsif (/^--fprod$/) { $fprod = $fprod . shift }
268 elsif (/^--ftail$/) { $ftail = $ftail . shift }
269 elsif (/^--eprod$/) { $eprod = $eprod . shift }
270 elsif (/^--vhead$/) { $vhead = $vhead . shift }
271 elsif (/^--vprod$/) { $vprod = $vprod . shift }
272 elsif (/^--vtail$/) { $vtail = $vtail . shift }
273 elsif (/^--comments$/) { $comment_tmpl = shift }
274 elsif (/^--output$/) { $output = shift }
275 elsif (/^--help$/ || /^-h$/ || /^-\?$/) { usage; }
276 elsif (/^--version$/ || /^-v$/) { version; }
278 last if not defined($ARGV[0]);
281 if (defined ($output)) {
282 my($out_fn, $out_dir, $out_suffix) = fileparse($output, qr{\.\w+$});
283 if ($out_dir eq '') { $out_dir = cwd(); }
285 $out_suffix =~ s/^\./_/; # .foo -> _foo
287 $OUTPUT = File::Temp->new("$out_fn$out_suffix\_XXXXXX", DIR => $out_dir, UNLINK => 0);
288 select $OUTPUT; # Make all print calls from here on go to OUTPUT
291 # put auto-generation comment
293 my $comment = $comment_tmpl;
294 $comment =~ s/\@comment\@/Generated data (by glib-mkenums)/;
295 print "\n" . $comment . "\n\n";
298 if (length($fhead)) {
300 my $base = basename ($ARGV[0]);
302 $prod =~ s/\@filename\@/$ARGV[0]/g;
303 $prod =~ s/\@basename\@/$base/g;
304 $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
305 $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
315 close (ARGV); # reset line numbering
316 $firstenum = 1; # Flag to print filename at next enum
319 # read lines until we have no open comments
320 while (m@/\*([^*]|\*(?!/))*$@) {
322 defined ($new = <>) || die "Unmatched comment in $ARGV";
325 # strip comments w/o options
330 # ignore forward declarations
331 next if /^\s*typedef\s+enum.*;/;
333 if (m@^\s*typedef\s+enum\s*
341 my %options = parse_trigraph ($2);
342 next if defined $options{skip};
343 $enum_prefix = $options{prefix};
344 $flags = $options{flags};
345 $option_lowercase_name = $options{lowercase_name};
346 $option_underscore_name = $options{underscore_name};
348 $enum_prefix = undef;
350 $option_lowercase_name = undef;
351 $option_underscore_name = undef;
353 if (defined $option_lowercase_name) {
354 if (defined $option_underscore_name) {
355 print STDERR "$0: $ARGV:$.: lowercase_name overriden with underscore_name\n";
356 $option_lowercase_name = undef;
358 print STDERR "$0: $ARGV:$.: lowercase_name is deprecated, use underscore_name\n";
361 # Didn't have trailing '{' look on next lines
362 if (!defined $1 && !defined $4) {
365 die "Hit end of file while parsing enum in $ARGV";
377 # Now parse the entries
378 parse_entries (\*ARGV, $ARGV);
380 # figure out if this was a flags or enums enumeration
381 if (!defined $flags) {
382 $flags = $seenbitshift;
385 # Autogenerate a prefix
386 if (!defined $enum_prefix) {
389 if (!defined $nick) {
391 if (defined $enum_prefix) {
392 my $tmp = ~ ($name ^ $enum_prefix);
393 ($tmp) = $tmp =~ /(^\xff*)/;
394 $enum_prefix = $enum_prefix & $tmp;
396 $enum_prefix = $name;
400 if (!defined $enum_prefix) {
403 # Trim so that it ends in an underscore
404 $enum_prefix =~ s/_[^_]*$/_/;
407 # canonicalize user defined prefixes
408 $enum_prefix = uc($enum_prefix);
409 $enum_prefix =~ s/-/_/g;
410 $enum_prefix =~ s/(.*)([^_])$/$1$2_/;
413 for $entry (@entries) {
414 my ($name,$num,$nick) = @{$entry};
415 if (!defined $nick) {
416 ($nick = $name) =~ s/^$enum_prefix//;
419 @{$entry} = ($name, $num, $nick);
424 # Spit out the output
425 if (defined $option_underscore_name) {
426 $enumlong = uc $option_underscore_name;
427 $enumsym = lc $option_underscore_name;
428 $enumshort = $enumlong;
429 $enumshort =~ s/^[A-Z][A-Z0-9]*_//;
431 $enumname_prefix = $enumlong;
432 $enumname_prefix =~ s/_$enumshort$//;
433 } elsif (!$symprefix && !$idprefix) {
434 # enumname is e.g. GMatchType
435 $enspace = $enumname;
436 $enspace =~ s/^([A-Z][a-z]*).*$/$1/;
438 $enumshort = $enumname;
439 $enumshort =~ s/^[A-Z][a-z]*//;
440 $enumshort =~ s/([^A-Z])([A-Z])/$1_$2/g;
441 $enumshort =~ s/([A-Z][A-Z])([A-Z][0-9a-z])/$1_$2/g;
442 $enumshort = uc($enumshort);
444 $enumname_prefix = $enumname;
445 $enumname_prefix =~ s/^([A-Z][a-z]*).*$/$1/;
446 $enumname_prefix = uc($enumname_prefix);
448 $enumlong = uc($enspace) . "_" . $enumshort;
449 $enumsym = lc($enspace) . "_" . lc($enumshort);
451 if (defined($option_lowercase_name)) {
452 $enumsym = $option_lowercase_name;
455 $enumshort = $enumname;
457 $enumshort =~ s/^${idprefix}//;
459 $enumshort =~ s/^[A-Z][a-z]*//;
461 $enumshort =~ s/([^A-Z])([A-Z])/$1_$2/g;
462 $enumshort =~ s/([A-Z][A-Z])([A-Z][0-9a-z])/$1_$2/g;
463 $enumshort = uc($enumshort);
465 $enumname_prefix = $symprefix && uc($symprefix) || uc($idprefix);
467 $enumlong = $enumname_prefix . "_" . $enumshort;
468 $enumsym = lc($enumlong);
474 if (length($fprod)) {
476 my $base = basename ($ARGV);
478 $prod =~ s/\@filename\@/$ARGV/g;
479 $prod =~ s/\@basename\@/$base/g;
480 $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
481 $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
488 if (length($eprod)) {
491 $prod =~ s/\@enum_name\@/$enumsym/g;
492 $prod =~ s/\@EnumName\@/$enumname/g;
493 $prod =~ s/\@ENUMSHORT\@/$enumshort/g;
494 $prod =~ s/\@ENUMNAME\@/$enumlong/g;
495 $prod =~ s/\@ENUMPREFIX\@/$enumname_prefix/g;
496 if ($flags) { $prod =~ s/\@type\@/flags/g; } else { $prod =~ s/\@type\@/enum/g; }
497 if ($flags) { $prod =~ s/\@Type\@/Flags/g; } else { $prod =~ s/\@Type\@/Enum/g; }
498 if ($flags) { $prod =~ s/\@TYPE\@/FLAGS/g; } else { $prod =~ s/\@TYPE\@/ENUM/g; }
499 $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
500 $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
506 if (length($vhead)) {
509 $prod =~ s/\@enum_name\@/$enumsym/g;
510 $prod =~ s/\@EnumName\@/$enumname/g;
511 $prod =~ s/\@ENUMSHORT\@/$enumshort/g;
512 $prod =~ s/\@ENUMNAME\@/$enumlong/g;
513 $prod =~ s/\@ENUMPREFIX\@/$enumname_prefix/g;
514 if ($flags) { $prod =~ s/\@type\@/flags/g; } else { $prod =~ s/\@type\@/enum/g; }
515 if ($flags) { $prod =~ s/\@Type\@/Flags/g; } else { $prod =~ s/\@Type\@/Enum/g; }
516 if ($flags) { $prod =~ s/\@TYPE\@/FLAGS/g; } else { $prod =~ s/\@TYPE\@/ENUM/g; }
517 $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
518 $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
524 if (length($vprod)) {
528 $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
529 $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
531 my ($name,$num,$nick) = @{$_};
532 my $tmp_prod = $prod;
534 if ($prod =~ /\@valuenum\@/) {
535 # only attempt to eval the value if it is requested
536 # this prevents us from throwing errors otherwise
538 # use sandboxed perl evaluation as a reasonable
539 # approximation to C constant folding
540 $num = $sandbox->reval ($num);
542 # make sure it parsed to an integer
543 if (!defined $num or $num !~ /^-?\d+$/) {
544 die "Unable to parse enum value '$num'";
550 $tmp_prod =~ s/\@valuenum\@/$num/g;
551 $next_num = $num + 1;
554 $tmp_prod =~ s/\@VALUENAME\@/$name/g;
555 $tmp_prod =~ s/\@valuenick\@/$nick/g;
556 if ($flags) { $tmp_prod =~ s/\@type\@/flags/g; } else { $tmp_prod =~ s/\@type\@/enum/g; }
557 if ($flags) { $tmp_prod =~ s/\@Type\@/Flags/g; } else { $tmp_prod =~ s/\@Type\@/Enum/g; }
558 if ($flags) { $tmp_prod =~ s/\@TYPE\@/FLAGS/g; } else { $tmp_prod =~ s/\@TYPE\@/ENUM/g; }
565 if (length($vtail)) {
568 $prod =~ s/\@enum_name\@/$enumsym/g;
569 $prod =~ s/\@EnumName\@/$enumname/g;
570 $prod =~ s/\@ENUMSHORT\@/$enumshort/g;
571 $prod =~ s/\@ENUMNAME\@/$enumlong/g;
572 $prod =~ s/\@ENUMPREFIX\@/$enumname_prefix/g;
573 if ($flags) { $prod =~ s/\@type\@/flags/g; } else { $prod =~ s/\@type\@/enum/g; }
574 if ($flags) { $prod =~ s/\@Type\@/Flags/g; } else { $prod =~ s/\@Type\@/Enum/g; }
575 if ($flags) { $prod =~ s/\@TYPE\@/FLAGS/g; } else { $prod =~ s/\@TYPE\@/ENUM/g; }
576 $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
577 $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
585 if (length($ftail)) {
587 my $base = basename ($ARGV);
589 $prod =~ s/\@filename\@/$ARGV/g;
590 $prod =~ s/\@basename\@/$base/g;
591 $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
592 $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
598 # put auto-generation comment
600 my $comment = $comment_tmpl;
601 $comment =~ s/\@comment\@/Generated data ends here/;
602 print "\n" . $comment . "\n\n";
605 if (defined ($output)) {
607 my $tmpfilename = $OUTPUT->filename;
609 || warn "Closing output file $tmpfilename failed: $!";
610 move ($tmpfilename, $output)
611 || die "Could not rename $tmpfilename to $output: $!";