| #!@PERL_PATH@ -w |
| |
| # 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 $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: glib-mkenums [options] [files...]\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 " -h, --help show this help message\n"; |
| print " -v, --version print version informations\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 " \@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"; |
| 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; |
| |
| $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; |
| 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]*_//; |
| } 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); |
| |
| $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; |
| |
| $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; |
| 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; |
| 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; |
| 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; |
| 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; |
| |
| $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; |
| 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"; |
| } |