gtk2/gtk/makeenums.pl

216 lines
4.3 KiB
Perl
Raw Normal View History

#!/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*<([^>]*)>/ ) {
1998-09-20 02:35:59 +00:00
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 =~ /<</) {
$seenbitshift = 1;
}
if (defined $options) {
my %options = parse_options($options);
if (!defined $options{skip}) {
push @entries, [ $name, $options{nick} ];
}
} else {
push @entries, [ $name ];
}
} else {
print STDERR "Can't understand: $_\n";
}
}
return 0;
}
my $gen_arrays = 0;
my $gen_defs = 0;
# Parse arguments
if (@ARGV) {
if ($ARGV[0] eq "arrays") {
shift @ARGV;
$gen_arrays = 1;
} elsif ($ARGV[0] eq "defs") {
shift @ARGV;
$gen_defs = 1;
} else {
$gen_defs = 1;
}
}
if ($gen_defs) {
print ";; generated by makeenums.pl ; -*- scheme -*-\n\n";
} else {
print "/* Generated by makeenums.pl */\n\n";
}
ENUMERATION:
while (<>) {
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) {
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
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";
} else {
($valuename = $enumname) =~ s/([A-Z][a-z])/_$1/g;
$valuename =~ s/([a-z])([A-Z])/$1_$2/g;
$valuename = lc($valuename);
print "static GtkEnumValue $ {valuename}_values[] = {\n";
for (@entries) {
my ($name,$nick) = @{$_};
print qq( { $name, "$name", "$nick" },\n);
}
print " { 0, NULL, NULL }\n";
print "};\n";
}
}
}