#!/usr/bin/perl -w # Information about the current enumeration my $flags; # Is enumeration a bitmask my $seenbitshift; # Have we seen bitshift operators? my $prefix; # Prefix for this enumeration my $enumname; # Name for this enumeration my $firstenum = 1; # Is this the first enumeration in file? my @entries; # [ $name, $val ] for each entry sub parse_options { my $opts = shift; my @opts; for $opt (split /\s*,\s*/, $opts) { my ($key,$val) = $opt =~ /\s*(\w+)(?:=(\S+))?/; defined $val or $val = 1; push @opts, $key, $val; } @opts; } sub parse_entries { my $file = shift; while (<$file>) { # Read lines until we have no open comments while (m@/\* ([^*]|\*(?!/))*$ @x) { my $new; defined ($new = <$file>) || die "Unmatched comment"; $_ .= $new; } # Now strip comments s@/\*(?!<) ([^*]+|\*(?!/))* \*/@@gx; s@\n@ @; next if m@^\s*$@; # Handle include files if (/^\#include\s*<([^>]*)>/ ) { my $file= "../$1"; open NEWFILE, $file or die "Cannot open include file $file: $!\n"; if (parse_entries (\*NEWFILE)) { return 1; } else { next; } } if (/^\s*\}\s*(\w+)/) { $enumname = $1; return 1; } if (m@^\s* (\w+)\s* # name (?:=( # value (?:[^,/]|/(?!\*))* ))?,?\s* (?:/\*< # options (([^*]|\*(?!/))*) >\*/)? \s*$ @x) { my ($name, $value, $options) = ($1,$2,$3); if (!defined $flags && defined $value && $value =~ /<) { if (eof) { close (ARGV); # reset line numbering $firstenum = 1; # Flag to print filename at next enum } if (m@^\s*typedef\s+enum\s* ({)?\s* (?:/\*< (([^*]|\*(?!/))*) >\*/)? @x) { print "\n"; if (defined $2) { my %options = parse_options($2); $prefix = $options{prefix}; $flags = $options{flags}; } else { $prefix = undef; $flags = undef; } # Didn't have trailing '{' look on next lines if (!defined $1) { while (<>) { if (s/^\s*\{//) { last; } } } $seenbitshift = 0; @entries = (); # Now parse the entries parse_entries (\*ARGV); # figure out if this was a flags or enums enumeration if (!defined $flags) { $flags = $seenbitshift; } # Autogenerate a prefix if (!defined $prefix) { for (@entries) { my $name = $_->[0]; if (defined $prefix) { my $tmp = ~ ($name ^ $prefix); ($tmp) = $tmp =~ /(^\xff*)/; $prefix = $prefix & $tmp; } else { $prefix = $name; } } # Trim so that it ends in an underscore $prefix =~ s/_[^_]*$/_/; } for $entry (@entries) { my ($name,$nick) = @{$entry}; if (!defined $nick) { ($nick = $name) =~ s/^$prefix//; $nick =~ tr/_/-/; $nick = lc($nick); @{$entry} = ($name, $nick); } } # Spit out the output my $valuename = $enumname; $valuename =~ s/([^A-Z])([A-Z])/$1_$2/g; $valuename =~ s/([A-Z][A-Z])([A-Z][0-9a-z])/$1_$2/g; $valuename = lc($valuename); my $typemacro = $enumname; $typemacro =~ s/([^A-Z])([A-Z])/$1_$2/g; $typemacro =~ s/([A-Z][A-Z])([A-Z][0-9a-z])/$1_$2/g; $typemacro = uc($valuename); $typemacro =~ s/GDK_/GDK_TYPE_/g; if ($gen_defs) { if ($firstenum) { print qq(\n; enumerations from "$ARGV"\n); $firstenum = 0; } print "\n(define-".($flags ? "flags" : "enum")." $enumname"; for (@entries) { my ($name,$nick) = @{$_}; print "\n ($nick $name)"; } print ")\n"; } elsif ($gen_arrays) { print "static const GtkEnumValue _${valuename}_values[] = {\n"; for (@entries) { my ($name,$nick) = @{$_}; print qq( { $name, "$name", "$nick" },\n); } print " { 0, NULL, NULL }\n"; print "};\n"; } elsif ($gen_includes) { print "GType ${valuename}_get_type (void);\n"; print "#define ${typemacro} ${valuename}_get_type ()\n"; } elsif ($gen_cfile) { print (<