mirror of
https://gitlab.gnome.org/GNOME/glib.git
synced 2024-12-26 15:36:14 +01:00
924f1bc528
Commit 789e260638 tried to add support for -?, but there is a typo
and instead -h was added when already present instead of -? for one
of the cases.
It works without this corrections, because all unrecognized options
trigger usage showing as well, but this is more correct.
This was bug 556706 originally.
512 lines
15 KiB
Plaintext
Executable File
512 lines
15 KiB
Plaintext
Executable File
#!@PERL_PATH@ -w
|
|
|
|
use File::Basename;
|
|
|
|
# glib-mkenums.pl
|
|
# Information about the current enumeration
|
|
my $flags; # Is enumeration a bitmask?
|
|
my $option_underscore_name; # Overriden underscore variant of the enum name
|
|
# for example to fix the cases we don't get the
|
|
# mixed-case -> underscorized transform right.
|
|
my $option_lowercase_name; # DEPRECATED. 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 $enumname_prefix; # prefix of $enumname
|
|
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*\w+\s*\(.*\)\s* # macro with multiple args
|
|
| # OR
|
|
(?:[^,/]|/(?!\*))* # anything but a comma or comment
|
|
))?,?\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 "glib-mkenums version glib-@GLIB_VERSION@\n";
|
|
print "glib-mkenums comes with ABSOLUTELY NO WARRANTY.\n";
|
|
print "You may redistribute copies of glib-mkenums under the terms of\n";
|
|
print "the GNU General Public License which can be found in the\n";
|
|
print "GLib source package. Sources, examples and contact\n";
|
|
print "information are available at http://www.gtk.org\n";
|
|
exit 0;
|
|
}
|
|
sub usage {
|
|
print "Usage:\n";
|
|
print " glib-mkenums [OPTION...] [FILES...]\n\n";
|
|
print "Help Options:\n";
|
|
print " -h, --help Show this help message\n\n";
|
|
print "Utility Options:\n";
|
|
print " --fhead <text> Output file header\n";
|
|
print " --fprod <text> Per input file production\n";
|
|
print " --ftail <text> Output file trailer\n";
|
|
print " --eprod <text> Per enum text (produced prior to value itarations)\n";
|
|
print " --vhead <text> Value header, produced before iterating over enum values\n";
|
|
print " --vprod <text> Value text, produced for each enum value\n";
|
|
print " --vtail <text> Value tail, produced after iterating over enum values\n";
|
|
print " --comments <text> Comment structure\n";
|
|
print " --template file Template file\n";
|
|
print " -v, --version Print version informations\n\n";
|
|
print "Production text substitutions:\n";
|
|
print " \@EnumName\@ PrefixTheXEnum\n";
|
|
print " \@enum_name\@ prefix_the_xenum\n";
|
|
print " \@ENUMNAME\@ PREFIX_THE_XENUM\n";
|
|
print " \@ENUMSHORT\@ THE_XENUM\n";
|
|
print " \@ENUMPREFIX\@ PREFIX\n";
|
|
print " \@VALUENAME\@ PREFIX_THE_XVALUE\n";
|
|
print " \@valuenick\@ the-xvalue\n";
|
|
print " \@type\@ either enum or flags\n";
|
|
print " \@Type\@ either Enum or Flags\n";
|
|
print " \@TYPE\@ either ENUM or FLAGS\n";
|
|
print " \@filename\@ name of current input file\n";
|
|
print " \@basename\@ base name of the current input file (Since: 2.22)\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; }
|
|
last if not defined($ARGV[0]);
|
|
}
|
|
|
|
# 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;
|
|
my $base = basename ($ARGV[0]);
|
|
|
|
$prod =~ s/\@filename\@/$ARGV[0]/g;
|
|
$prod =~ s/\@basename\@/$base/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;
|
|
chomp ($prod);
|
|
|
|
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*\*/)?
|
|
\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};
|
|
$option_underscore_name = $options{underscore_name};
|
|
} else {
|
|
$enum_prefix = undef;
|
|
$flags = undef;
|
|
$option_lowercase_name = undef;
|
|
$option_underscore_name = undef;
|
|
}
|
|
if (defined $option_lowercase_name) {
|
|
if (defined $option_underscore_name) {
|
|
print STDERR "$0: $ARGV:$.: lowercase_name overriden with underscore_name\n";
|
|
$option_lowercase_name = undef;
|
|
} else {
|
|
print STDERR "$0: $ARGV:$.: lowercase_name is deprecated, use underscore_name\n";
|
|
}
|
|
}
|
|
# Didn't have trailing '{' look on next lines
|
|
if (!defined $1 && !defined $4) {
|
|
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
|
|
if (defined $option_underscore_name) {
|
|
$enumlong = uc $option_underscore_name;
|
|
$enumsym = lc $option_underscore_name;
|
|
$enumshort = $enumlong;
|
|
$enumshort =~ s/^[A-Z][A-Z0-9]*_//;
|
|
|
|
$enumname_prefix = $enumlong;
|
|
$enumname_prefix =~ s/$enumshort$//;
|
|
} else {
|
|
# 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);
|
|
|
|
$enumname_prefix = $enumname;
|
|
$enumname_prefix =~ s/^([A-Z][a-z]*).*$/$1/;
|
|
$enumname_prefix = uc($enumname_prefix);
|
|
|
|
$enumlong = uc($enspace) . "_" . $enumshort;
|
|
$enumsym = lc($enspace) . "_" . lc($enumshort);
|
|
|
|
if (defined($option_lowercase_name)) {
|
|
$enumsym = $option_lowercase_name;
|
|
}
|
|
}
|
|
|
|
if ($firstenum) {
|
|
$firstenum = 0;
|
|
|
|
if (length($fprod)) {
|
|
my $prod = $fprod;
|
|
my $base = basename ($ARGV);
|
|
|
|
$prod =~ s/\@filename\@/$ARGV/g;
|
|
$prod =~ s/\@basename\@/$base/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;
|
|
chomp ($prod);
|
|
|
|
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;
|
|
$prod =~ s/\@ENUMPREFIX\@/$enumname_prefix/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;
|
|
chomp ($prod);
|
|
|
|
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;
|
|
$prod =~ s/\@ENUMPREFIX\@/$enumname_prefix/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;
|
|
chomp ($prod);
|
|
|
|
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 = $prod;
|
|
|
|
$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; }
|
|
chomp ($tmp_prod);
|
|
|
|
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;
|
|
$prod =~ s/\@ENUMPREFIX\@/$enumname_prefix/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;
|
|
chomp ($prod);
|
|
|
|
print "$prod\n";
|
|
}
|
|
}
|
|
}
|
|
|
|
if (length($ftail)) {
|
|
my $prod = $ftail;
|
|
my $base = basename ($ARGV);
|
|
|
|
$prod =~ s/\@filename\@/$ARGV/g;
|
|
$prod =~ s/\@basename\@/$base/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;
|
|
chomp ($prod);
|
|
|
|
print "$prod\n";
|
|
}
|
|
|
|
# put auto-generation comment
|
|
{
|
|
my $comment = $comment_tmpl;
|
|
$comment =~ s/\@comment\@/Generated data ends here/;
|
|
print "\n" . $comment . "\n\n";
|
|
}
|