#!/usr/bin/perl -w # This script snarfs the enums from header files and writes them out into # a .defs file (mate.defs, for example). From there, the sister script # maketypes.awk converts the defs into a *typebuiltins.h, as well as # *typebuiltins_vals.c, *typebuiltins_ids.c and *typebuiltins_evals.c. # 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 =~ /<</) { $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 const GEnumValue $ {valuename}_values[] = {\n"; for (@entries) { my ($name,$nick) = @{$_}; print qq( { $name, "$name", "$nick" },\n); } print " { 0, NULL, NULL }\n"; print "};\n"; } } }