chiark - git - mdw - clg/blob - tools/makeenums.pl

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