Pileus Git - ~andy/gtk/blob - gtk/makeenums.pl

   1 #!/usr/bin/perl -w
   2
   3 # Information about the current enumeration
   4
   5 my $flags;                      # Is enumeration a bitmask
   6 my $seenbitshift;               # Have we seen bitshift operators?
   7 my $prefix;                     # Prefix for this enumeration
   8 my $enumname;                   # Name for this enumeration
   9 my $firstenum = 1;              # Is this the first enumeration in file?
  10 my @entries;                    # [ $name, $val ] for each entry
  11
  12 sub parse_options {
  13     my $opts = shift;
  14     my @opts;
  15
  16     for $opt (split /\s*,\s*/, $opts) {
  17         my ($key,$val) = $opt =~ /\s*(\w+)(?:=(\S+))?/;
  18         defined $val or $val = 1;
  19         push @opts, $key, $val;
  20     }
  21     @opts;
  22 }
  23 sub parse_entries {
  24     my $file = shift;
  25
  26     while (<$file>) {
  27         # Read lines until we have no open comments
  28         while (m@/\*
  29                ([^*]|\*(?!/))*$
  30                @x) {
  31             my $new;
  32             defined ($new = <$file>) || die "Unmatched comment";
  33             $_ .= $new;
  34         }
  35         # Now strip comments
  36         s@/\*(?!<)
  37             ([^*]+|\*(?!/))*
  38            \*/@@gx;
  39
  40         s@\n@ @;
  41
  42         next if m@^\s*$@;
  43
  44         # Handle include files
  45         if (/^\#include\s*<([^>]*)>/ ) {
  46             my $file= "../$1";
  47             open NEWFILE, $file or die "Cannot open include file $file: $!\n";
  48
  49             if (parse_entries (\*NEWFILE)) {
  50                 return 1;
  51             } else {
  52                 next;
  53             }
  54         }
  55
  56         if (/^\s*\}\s*(\w+)/) {
  57             $enumname = $1;
  58             return 1;
  59         }
  60
  61         if (m@^\s*
  62               (\w+)\s*                   # name
  63               (?:=(                      # value
  64                    (?:[^,/]|/(?!\*))*
  65                   ))?,?\s*
  66               (?:/\*<                    # options
  67                 (([^*]|\*(?!/))*)
  68                >\*/)?
  69               \s*$
  70              @x) {
  71             my ($name, $value, $options) = ($1,$2,$3);
  72
  73             if (!defined $flags && defined $value && $value =~ /<</) {
  74                 $seenbitshift = 1;
  75             }
  76             if (defined $options) {
  77                 my %options = parse_options($options);
  78                 if (!defined $options{skip}) {
  79                     push @entries, [ $name, $options{nick} ];
  80                 }
  81             } else {
  82                 push @entries, [ $name ];
  83             }
  84         } else {
  85             print STDERR "Can't understand: $_\n";
  86         }
  87     }
  88     return 0;
  89 }
  90
  91
  92 my $gen_arrays = 0;
  93 my $gen_defs = 0;
  94
  95 # Parse arguments
  96
  97 if (@ARGV) {
  98     if ($ARGV[0] eq "arrays") {
  99         shift @ARGV;
 100         $gen_arrays = 1;
 101     } elsif ($ARGV[0] eq "defs") {
 102         shift @ARGV;
 103         $gen_defs = 1;
 104     } else {
 105         $gen_defs = 1;
 106     }
 107
 108 }
 109
 110 if ($gen_defs) {
 111     print ";; generated by makeenums.pl  ; -*- scheme -*-\n\n";
 112 } else {
 113     print "/* Generated by makeenums.pl */\n\n";
 114 }
 115
 116 ENUMERATION:
 117 while (<>) {
 118     if (eof) {
 119         close (ARGV);           # reset line numbering
 120         $firstenum = 1;         # Flag to print filename at next enum
 121     }
 122
 123     if (m@^\s*typedef\s+enum\s*
 124            ({)?\s*
 125            (?:/\*<
 126              (([^*]|\*(?!/))*)
 127             >\*/)?
 128          @x) {
 129         if (defined $2) {
 130             my %options = parse_options($2);
 131             $prefix = $options{prefix};
 132             $flags = $options{flags};
 133         } else {
 134             $prefix = undef;
 135             $flags = undef;
 136         }
 137         # Didn't have trailing '{' look on next lines
 138         if (!defined $1) {
 139             while (<>) {
 140                 if (s/^\s*\{//) {
 141                     last;
 142                 }
 143             }
 144         }
 145
 146         $seenbitshift = 0;
 147         @entries = ();
 148
 149         # Now parse the entries
 150         parse_entries (\*ARGV);
 151
 152         # figure out if this was a flags or enums enumeration
 153
 154         if (!defined $flags) {
 155             $flags = $seenbitshift;
 156         }
 157
 158         # Autogenerate a prefix
 159
 160         if (!defined $prefix) {
 161             for (@entries) {
 162                 my $name = $_->[0];
 163                 if (defined $prefix) {
 164                     my $tmp = ~ ($name ^ $prefix);
 165                     ($tmp) = $tmp =~ /(^\xff*)/;
 166                     $prefix = $prefix & $tmp;
 167                 } else {
 168                     $prefix = $name;
 169                 }
 170             }
 171             # Trim so that it ends in an underscore
 172             $prefix =~ s/_[^_]*$/_/;
 173         }
 174
 175         for $entry (@entries) {
 176             my ($name,$nick) = @{$entry};
 177             if (!defined $nick) {
 178                 ($nick = $name) =~ s/^$prefix//;
 179                 $nick =~ tr/_/-/;
 180                 $nick = lc($nick);
 181                 @{$entry} = ($name, $nick);
 182             }
 183         }
 184
 185         # Spit out the output
 186
 187         if ($gen_defs) {
 188             if ($firstenum) {
 189                 print qq(\n; enumerations from "$ARGV"\n);
 190                 $firstenum = 0;
 191             }
 192
 193             print "\n(define-".($flags ? "flags" : "enum")." $enumname";
 194
 195             for (@entries) {
 196                 my ($name,$nick) = @{$_};
 197                 print "\n   ($nick $name)";
 198             }
 199             print ")\n";
 200
 201         } else {
 202             my $valuename = $enumname;
 203             $valuename =~ s/([^A-Z])([A-Z])/$1_$2/g;
 204             $valuename =~ s/([A-Z][A-Z])([A-Z][0-9a-z])/$1_$2/g;
 205             $valuename = lc($valuename);
 206
 207             print "static const GtkEnumValue _${valuename}_values[] = {\n";
 208             for (@entries) {
 209                 my ($name,$nick) = @{$_};
 210                 print qq(  { $name, "$name", "$nick" },\n);
 211             }
 212             print "  { 0, NULL, NULL }\n";
 213             print "};\n";
 214         }
 215     }
 216 }