From: espen Date: Sun, 29 Apr 2001 20:14:53 +0000 (+0000) Subject: Obsoleted by glib-mkenums X-Git-Tag: clg-0-90~420 X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/commitdiff_plain/24758b0bda1294528f4897c9ce780c675a4eea4c?hp=0df94f3b69547d79e9c5648924d965163c242d12 Obsoleted by glib-mkenums --- diff --git a/tools/makeenums.pl b/tools/makeenums.pl deleted file mode 100644 index 7f219dd..0000000 --- a/tools/makeenums.pl +++ /dev/null @@ -1,245 +0,0 @@ -#!/usr/bin/perl -w - -# Information about the current enumeration -# Modifed to generate output for clg - - -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 =~ /<) { - 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,$value,$nick) = @{$entry}; - - if (!defined $nick) { - ($nick = $name) =~ s/^$prefix//; - $nick =~ tr/_/-/; - $nick = lc($nick); - @{$entry} = ($name, $value, $nick); - } - } - - # Spit out the output - - if ($gen_defs) { - if ($firstenum) { - print qq(\n; enumerations from "$ARGV"\n); - $firstenum = 0; - } - - my $lispname = make_lispname ($enumname); - print "\n(deftype (".$lispname." \"".$enumname."\") ()\n '(". ($flags ? "flags" : "enum"); - - my $comment; - for (@entries) { - my ($name,$value,$nick) = @{$_}; - - $comment = 0; - if (defined $value) { - $value =~ s/0x/\#x/; - - print "\n"; - if ($flags && not ($value =~ s/1\s+<<\s+(\d+)/$1/)) { - print ";"; - $comment = 1; - } - - print " (:$nick $value)"; - } else { - print "\n :$nick"; - } - } - if ($comment) { - print "\n "; - } - print "))\n"; - - } else { - my $valuename = $enumname; - $valuename =~ s/([^A-Z])([A-Z])/$1_$2/g; - $valuename =~ s/([A-Z][A-Z])([A-Z][0-9a-z])/$1_$2/g; - $valuename = lc($valuename); - - print "static const GtkEnumValue _${valuename}_values[] = {\n"; - for (@entries) { - my ($name,$value,$nick) = @{$_}; - print qq( { $name, "$name", "$nick" },\n); - } - print " { 0, NULL, NULL }\n"; - print "};\n"; - } - } -}