mirror of
https://gitlab.gnome.org/GNOME/glib.git
synced 2024-12-26 15:36:14 +01:00
10bacd6058
2003-12-30 Murray Cumming <murrayc@usa.net>
* gobject/glib-mkenums.in: Added a lowercase_name option, to be used
next to the enum declaration, where the flag option is already used,
when it is not possible to guess where to put the underscores in the
_get_type() function name, for instance for GNOMEVFSURIHide.
457 lines
14 KiB
Plaintext
Executable File
457 lines
14 KiB
Plaintext
Executable File
#!@PERL_PATH@ -w
|
|
|
|
# glib-mkenums.pl
|
|
# Information about the current enumeration
|
|
my $flags; # Is enumeration a bitmask?
|
|
my $option_lowercase_name; # A lower case name to use as part of the *_get_type() function, instead of the one that we guess.
|
|
# For instance, when an enum uses abnormal capitalization and we can not guess where to put the underscores.
|
|
my $seenbitshift; # Have we seen bitshift operators?
|
|
my $enum_prefix; # Prefix for this enumeration
|
|
my $enumname; # Name for this enumeration
|
|
my $enumshort; # $enumname without prefix
|
|
my $enumindex = 0; # Global enum counter
|
|
my $firstenum = 1; # Is this the first enumeration per file?
|
|
my @entries; # [ $name, $val ] for each entry
|
|
|
|
sub parse_trigraph {
|
|
my $opts = shift;
|
|
my @opts;
|
|
|
|
for $opt (split /\s*,\s*/, $opts) {
|
|
$opt =~ s/^\s*//;
|
|
$opt =~ s/\s*$//;
|
|
my ($key,$val) = $opt =~ /(\w+)(?:=(.+))?/;
|
|
defined $val or $val = 1;
|
|
push @opts, $key, $val;
|
|
}
|
|
@opts;
|
|
}
|
|
sub parse_entries {
|
|
my $file = shift;
|
|
my $file_name = shift;
|
|
my $looking_for_name = 0;
|
|
|
|
while (<$file>) {
|
|
# read lines until we have no open comments
|
|
while (m@/\*([^*]|\*(?!/))*$@) {
|
|
my $new;
|
|
defined ($new = <$file>) || die "Unmatched comment in $ARGV";
|
|
$_ .= $new;
|
|
}
|
|
# strip comments w/o options
|
|
s@/\*(?!<)
|
|
([^*]+|\*(?!/))*
|
|
\*/@@gx;
|
|
|
|
# strip newlines
|
|
s@\n@ @;
|
|
|
|
# skip empty lines
|
|
next if m@^\s*$@;
|
|
|
|
if ($looking_for_name) {
|
|
if (/^\s*(\w+)/) {
|
|
$enumname = $1;
|
|
return 1;
|
|
}
|
|
}
|
|
|
|
# Handle include files
|
|
if (/^\#include\s*<([^>]*)>/ ) {
|
|
my $file= "../$1";
|
|
open NEWFILE, $file or die "Cannot open include file $file: $!\n";
|
|
|
|
if (parse_entries (\*NEWFILE, $NEWFILE)) {
|
|
return 1;
|
|
} else {
|
|
next;
|
|
}
|
|
}
|
|
|
|
if (/^\s*\}\s*(\w+)/) {
|
|
$enumname = $1;
|
|
$enumindex++;
|
|
return 1;
|
|
}
|
|
|
|
if (/^\s*\}/) {
|
|
$enumindex++;
|
|
$looking_for_name = 1;
|
|
next;
|
|
}
|
|
|
|
if (m@^\s*
|
|
(\w+)\s* # name
|
|
(?:=( # value
|
|
(?:[^,/]|/(?!\*))*
|
|
))?,?\s*
|
|
(?:/\*< # options
|
|
(([^*]|\*(?!/))*)
|
|
>\s*\*/)?,?
|
|
\s*$
|
|
@x) {
|
|
my ($name, $value, $options) = ($1,$2,$3);
|
|
|
|
if (!defined $flags && defined $value && $value =~ /<</) {
|
|
$seenbitshift = 1;
|
|
}
|
|
|
|
if (defined $options) {
|
|
my %options = parse_trigraph($options);
|
|
if (!defined $options{skip}) {
|
|
push @entries, [ $name, $options{nick} ];
|
|
}
|
|
} else {
|
|
push @entries, [ $name ];
|
|
}
|
|
} elsif (m@^\s*\#@) {
|
|
# ignore preprocessor directives
|
|
} else {
|
|
print STDERR "$0: $file_name:$.: Failed to parse `$_'\n";
|
|
}
|
|
}
|
|
|
|
return 0;
|
|
}
|
|
|
|
sub version {
|
|
print STDERR "glib-mkenums version glib-@GLIB_VERSION@\n";
|
|
print STDERR "glib-mkenums comes with ABSOLUTELY NO WARRANTY.\n";
|
|
print STDERR "You may redistribute copies of glib-mkenums under the terms of\n";
|
|
print STDERR "the GNU General Public License which can be found in the\n";
|
|
print STDERR "GLib source package. Sources, examples and contact\n";
|
|
print STDERR "information are available at http://www.gtk.org\n";
|
|
exit 0;
|
|
}
|
|
sub usage {
|
|
print STDERR "Usage: glib-mkenums [options] [files...]\n";
|
|
print STDERR " --fhead <text> output file header\n";
|
|
print STDERR " --fprod <text> per input file production\n";
|
|
print STDERR " --ftail <text> output file trailer\n";
|
|
print STDERR " --eprod <text> per enum text (produced prior to value itarations)\n";
|
|
print STDERR " --vhead <text> value header, produced before iterating over enum values\n";
|
|
print STDERR " --vprod <text> value text, produced for each enum value\n";
|
|
print STDERR " --vtail <text> value tail, produced after iterating over enum values\n";
|
|
print STDERR " --comments <text> comment structure\n";
|
|
print STDERR " --template file template file\n";
|
|
print STDERR " -h, --help show this help message\n";
|
|
print STDERR " -v, --version print version informations\n";
|
|
print STDERR "Production text substitutions:\n";
|
|
print STDERR " \@EnumName\@ PrefixTheXEnum\n";
|
|
print STDERR " \@enum_name\@ prefix_the_xenum\n";
|
|
print STDERR " \@ENUMNAME\@ PREFIX_THE_XENUM\n";
|
|
print STDERR " \@ENUMSHORT\@ THE_XENUM\n";
|
|
print STDERR " \@VALUENAME\@ PREFIX_THE_XVALUE\n";
|
|
print STDERR " \@valuenick\@ the-xvalue\n";
|
|
print STDERR " \@type\@ either enum or flags\n";
|
|
print STDERR " \@Type\@ either Enum or Flags\n";
|
|
print STDERR " \@TYPE\@ either ENUM or FLAGS\n";
|
|
print STDERR " \@filename\@ name of current input file\n";
|
|
exit 0;
|
|
}
|
|
|
|
# production variables:
|
|
my $fhead = ""; # output file header
|
|
my $fprod = ""; # per input file production
|
|
my $ftail = ""; # output file trailer
|
|
my $eprod = ""; # per enum text (produced prior to value itarations)
|
|
my $vhead = ""; # value header, produced before iterating over enum values
|
|
my $vprod = ""; # value text, produced for each enum value
|
|
my $vtail = ""; # value tail, produced after iterating over enum values
|
|
# other options
|
|
my $comment_tmpl = "/* \@comment\@ */";
|
|
|
|
sub read_template_file {
|
|
my ($file) = @_;
|
|
my %tmpl = ('file-header', $fhead,
|
|
'file-production', $fprod,
|
|
'file-tail', $ftail,
|
|
'enumeration-production', $eprod,
|
|
'value-header', $vhead,
|
|
'value-production', $vprod,
|
|
'value-tail', $vtail,
|
|
'comment', $comment_tmpl);
|
|
my $in = 'junk';
|
|
open (FILE, $file) || die "Can't open $file: $!\n";
|
|
while (<FILE>) {
|
|
if (/^\/\*\*\*\s+(BEGIN|END)\s+([\w-]+)\s+\*\*\*\//) {
|
|
if (($in eq 'junk') && ($1 eq 'BEGIN') && (exists($tmpl{$2}))) {
|
|
$in = $2;
|
|
next;
|
|
}
|
|
elsif (($in eq $2) && ($1 eq 'END') && (exists($tmpl{$2}))) {
|
|
$in = 'junk';
|
|
next;
|
|
}
|
|
else {
|
|
die "Malformed template file $file\n";
|
|
}
|
|
}
|
|
if (!($in eq 'junk')) {
|
|
$tmpl{$in} .= $_;
|
|
}
|
|
}
|
|
close (FILE);
|
|
if (!($in eq 'junk')) {
|
|
die "Malformed template file $file\n";
|
|
}
|
|
$fhead = $tmpl{'file-header'};
|
|
$fprod = $tmpl{'file-production'};
|
|
$ftail = $tmpl{'file-tail'};
|
|
$eprod = $tmpl{'enumeration-production'};
|
|
$vhead = $tmpl{'value-header'};
|
|
$vprod = $tmpl{'value-production'};
|
|
$vtail = $tmpl{'value-tail'};
|
|
$comment_tmpl = $tmpl{'comment'};
|
|
}
|
|
|
|
if (!defined $ARGV[0]) {
|
|
usage;
|
|
}
|
|
while ($_ = $ARGV[0], /^-/) {
|
|
shift;
|
|
last if /^--$/;
|
|
if (/^--template$/) { read_template_file (shift); }
|
|
elsif (/^--fhead$/) { $fhead = $fhead . shift }
|
|
elsif (/^--fprod$/) { $fprod = $fprod . shift }
|
|
elsif (/^--ftail$/) { $ftail = $ftail . shift }
|
|
elsif (/^--eprod$/) { $eprod = $eprod . shift }
|
|
elsif (/^--vhead$/) { $vhead = $vhead . shift }
|
|
elsif (/^--vprod$/) { $vprod = $vprod . shift }
|
|
elsif (/^--vtail$/) { $vtail = $vtail . shift }
|
|
elsif (/^--comments$/) { $comment_tmpl = shift }
|
|
elsif (/^--help$/ || /^-h$/) { usage; }
|
|
elsif (/^--version$/ || /^-v$/) { version; }
|
|
else { usage; }
|
|
}
|
|
|
|
# put auto-generation comment
|
|
{
|
|
my $comment = $comment_tmpl;
|
|
$comment =~ s/\@comment\@/Generated data (by glib-mkenums)/;
|
|
print "\n" . $comment . "\n\n";
|
|
}
|
|
|
|
if (length($fhead)) {
|
|
my $prod = $fhead;
|
|
|
|
$prod =~ s/\@filename\@/$ARGV[0]/g;
|
|
$prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
|
|
$prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
|
|
|
|
print "$prod\n";
|
|
}
|
|
|
|
while (<>) {
|
|
if (eof) {
|
|
close (ARGV); # reset line numbering
|
|
$firstenum = 1; # Flag to print filename at next enum
|
|
}
|
|
|
|
# read lines until we have no open comments
|
|
while (m@/\*([^*]|\*(?!/))*$@) {
|
|
my $new;
|
|
defined ($new = <>) || die "Unmatched comment in $ARGV";
|
|
$_ .= $new;
|
|
}
|
|
# strip comments w/o options
|
|
s@/\*(?!<)
|
|
([^*]+|\*(?!/))*
|
|
\*/@@gx;
|
|
|
|
if (m@^\s*typedef\s+enum\s*
|
|
({)?\s*
|
|
(?:/\*<
|
|
(([^*]|\*(?!/))*)
|
|
>\s*\*/)?
|
|
@x) {
|
|
if (defined $2) {
|
|
my %options = parse_trigraph ($2);
|
|
next if defined $options{skip};
|
|
$enum_prefix = $options{prefix};
|
|
$flags = $options{flags};
|
|
$option_lowercase_name = $options{lowercase_name};
|
|
} else {
|
|
$enum_prefix = undef;
|
|
$flags = undef;
|
|
$option_lowercase_name = 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, $ARGV);
|
|
|
|
# figure out if this was a flags or enums enumeration
|
|
if (!defined $flags) {
|
|
$flags = $seenbitshift;
|
|
}
|
|
|
|
# Autogenerate a prefix
|
|
if (!defined $enum_prefix) {
|
|
for (@entries) {
|
|
my $nick = $_->[1];
|
|
if (!defined $nick) {
|
|
my $name = $_->[0];
|
|
if (defined $enum_prefix) {
|
|
my $tmp = ~ ($name ^ $enum_prefix);
|
|
($tmp) = $tmp =~ /(^\xff*)/;
|
|
$enum_prefix = $enum_prefix & $tmp;
|
|
} else {
|
|
$enum_prefix = $name;
|
|
}
|
|
}
|
|
}
|
|
if (!defined $enum_prefix) {
|
|
$enum_prefix = "";
|
|
} else {
|
|
# Trim so that it ends in an underscore
|
|
$enum_prefix =~ s/_[^_]*$/_/;
|
|
}
|
|
} else {
|
|
# canonicalize user defined prefixes
|
|
$enum_prefix = uc($enum_prefix);
|
|
$enum_prefix =~ s/-/_/g;
|
|
$enum_prefix =~ s/(.*)([^_])$/$1$2_/;
|
|
}
|
|
|
|
for $entry (@entries) {
|
|
my ($name,$nick) = @{$entry};
|
|
if (!defined $nick) {
|
|
($nick = $name) =~ s/^$enum_prefix//;
|
|
$nick =~ tr/_/-/;
|
|
$nick = lc($nick);
|
|
@{$entry} = ($name, $nick);
|
|
}
|
|
}
|
|
|
|
|
|
# Spit out the output
|
|
|
|
# enumname is e.g. GMatchType
|
|
$enspace = $enumname;
|
|
$enspace =~ s/^([A-Z][a-z]*).*$/$1/;
|
|
|
|
$enumshort = $enumname;
|
|
$enumshort =~ s/^[A-Z][a-z]*//;
|
|
$enumshort =~ s/([^A-Z])([A-Z])/$1_$2/g;
|
|
$enumshort =~ s/([A-Z][A-Z])([A-Z][0-9a-z])/$1_$2/g;
|
|
$enumshort = uc($enumshort);
|
|
|
|
$enumlong = uc($enspace) . "_" . $enumshort;
|
|
$enumsym = lc($enspace) . "_" . lc($enumshort);
|
|
|
|
#The options might override the lower case name if it could not be generated correctly:
|
|
if (defined($option_lowercase_name)) {
|
|
$enumsym = $option_lowercase_name;
|
|
}
|
|
|
|
if ($firstenum) {
|
|
$firstenum = 0;
|
|
|
|
if (length($fprod)) {
|
|
my $prod = $fprod;
|
|
|
|
$prod =~ s/\@filename\@/$ARGV/g;
|
|
$prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
|
|
$prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
|
|
|
|
print "$prod\n";
|
|
}
|
|
}
|
|
|
|
if (length($eprod)) {
|
|
my $prod = $eprod;
|
|
|
|
$prod =~ s/\@enum_name\@/$enumsym/g;
|
|
$prod =~ s/\@EnumName\@/$enumname/g;
|
|
$prod =~ s/\@ENUMSHORT\@/$enumshort/g;
|
|
$prod =~ s/\@ENUMNAME\@/$enumlong/g;
|
|
if ($flags) { $prod =~ s/\@type\@/flags/g; } else { $prod =~ s/\@type\@/enum/g; }
|
|
if ($flags) { $prod =~ s/\@Type\@/Flags/g; } else { $prod =~ s/\@Type\@/Enum/g; }
|
|
if ($flags) { $prod =~ s/\@TYPE\@/FLAGS/g; } else { $prod =~ s/\@TYPE\@/ENUM/g; }
|
|
$prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
|
|
$prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
|
|
|
|
print "$prod\n";
|
|
}
|
|
|
|
if (length($vhead)) {
|
|
my $prod = $vhead;
|
|
|
|
$prod =~ s/\@enum_name\@/$enumsym/g;
|
|
$prod =~ s/\@EnumName\@/$enumname/g;
|
|
$prod =~ s/\@ENUMSHORT\@/$enumshort/g;
|
|
$prod =~ s/\@ENUMNAME\@/$enumlong/g;
|
|
if ($flags) { $prod =~ s/\@type\@/flags/g; } else { $prod =~ s/\@type\@/enum/g; }
|
|
if ($flags) { $prod =~ s/\@Type\@/Flags/g; } else { $prod =~ s/\@Type\@/Enum/g; }
|
|
if ($flags) { $prod =~ s/\@TYPE\@/FLAGS/g; } else { $prod =~ s/\@TYPE\@/ENUM/g; }
|
|
$prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
|
|
$prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
|
|
|
|
print "$prod\n";
|
|
}
|
|
|
|
if (length($vprod)) {
|
|
my $prod = $vprod;
|
|
|
|
$prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
|
|
$prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
|
|
for (@entries) {
|
|
my ($name,$nick) = @{$_};
|
|
my $tmp_prod = $vprod;
|
|
|
|
$tmp_prod =~ s/\@VALUENAME\@/$name/g;
|
|
$tmp_prod =~ s/\@valuenick\@/$nick/g;
|
|
if ($flags) { $tmp_prod =~ s/\@type\@/flags/g; } else { $tmp_prod =~ s/\@type\@/enum/g; }
|
|
if ($flags) { $tmp_prod =~ s/\@Type\@/Flags/g; } else { $tmp_prod =~ s/\@Type\@/Enum/g; }
|
|
if ($flags) { $tmp_prod =~ s/\@TYPE\@/FLAGS/g; } else { $tmp_prod =~ s/\@TYPE\@/ENUM/g; }
|
|
|
|
print "$tmp_prod\n";
|
|
}
|
|
}
|
|
|
|
if (length($vtail)) {
|
|
my $prod = $vtail;
|
|
|
|
$prod =~ s/\@enum_name\@/$enumsym/g;
|
|
$prod =~ s/\@EnumName\@/$enumname/g;
|
|
$prod =~ s/\@ENUMSHORT\@/$enumshort/g;
|
|
$prod =~ s/\@ENUMNAME\@/$enumlong/g;
|
|
if ($flags) { $prod =~ s/\@type\@/flags/g; } else { $prod =~ s/\@type\@/enum/g; }
|
|
if ($flags) { $prod =~ s/\@Type\@/Flags/g; } else { $prod =~ s/\@Type\@/Enum/g; }
|
|
if ($flags) { $prod =~ s/\@TYPE\@/FLAGS/g; } else { $prod =~ s/\@TYPE\@/ENUM/g; }
|
|
$prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
|
|
$prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
|
|
|
|
print "$prod\n";
|
|
}
|
|
}
|
|
}
|
|
|
|
if (length($ftail)) {
|
|
my $prod = $ftail;
|
|
|
|
$prod =~ s/\@filename\@/$ARGV/g;
|
|
$prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
|
|
$prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
|
|
|
|
print "$prod\n";
|
|
}
|
|
|
|
# put auto-generation comment
|
|
{
|
|
my $comment = $comment_tmpl;
|
|
$comment =~ s/\@comment\@/Generated data ends here/;
|
|
print "\n" . $comment . "\n\n";
|
|
}
|