gobject/glib-mkenums.in

   1 #!@PERL_PATH@ -w
   2
   3 # glib-mkenums.pl
   4 # Information about the current enumeration
   5 my $flags;                      # Is enumeration a bitmask?
   6 my $seenbitshift;               # Have we seen bitshift operators?
   7 my $enum_prefix;                # Prefix for this enumeration
   8 my $enumname;                   # Name for this enumeration
   9 my $enumshort;                  # $enumname without prefix
  10 my $enumindex = 0;              # Global enum counter
  11 my $firstenum = 1;              # Is this the first enumeration per file?
  12 my @entries;                    # [ $name, $val ] for each entry
  13
  14 sub parse_trigraph {
  15     my $opts = shift;
  16     my @opts;
  17
  18     for $opt (split /\s*,\s*/, $opts) {
  19         $opt =~ s/^\s*//;
  20         $opt =~ s/\s*$//;
  21         my ($key,$val) = $opt =~ /(\w+)(?:=(.+))?/;
  22         defined $val or $val = 1;
  23         push @opts, $key, $val;
  24     }
  25     @opts;
  26 }
  27 sub parse_entries {
  28     my $file = shift;
  29     my $file_name = shift;
  30     my $looking_for_name = 0;
  31
  32     while (<$file>) {
  33
  34         # read lines until comment end is matched
  35         while (m@/\*([^*]|\*[^/*])*\**$@x) {
  36             my $new;
  37             defined ($new = <>) || die "Unmatched comment in $ARGV";
  38             $_ .= $new;
  39         }
  40         # strip comments w/o options
  41         s@/\*[^<]([^*]|\*[^/*])*\**\*/@@gx;
  42
  43         # strip newlines
  44         s/\n//;
  45
  46         # skip empty lines
  47         next if m@^\s*$@;
  48
  49 #       print STDERR "xxx $_\n";
  50
  51         if ($looking_for_name) {
  52             if (/^\s*(\w+)/) {
  53                 $enumname = $1;
  54                 return 1;
  55             }
  56         }
  57
  58         # Handle include files
  59         if (/^\#include\s*<([^>]*)>/ ) {
  60             my $file= "../$1";
  61             open NEWFILE, $file or die "Cannot open include file $file: $!\n";
  62
  63             # read lines until comment end is matched
  64             while (m@/\*([^*]|\*[^/*])*\**$@x) {
  65                 my $new;
  66                 defined ($new = <>) || die "Unmatched comment in $file_name";
  67                 $_ .= $new;
  68             }
  69             # strip comments w/o options
  70             s@/\*[^<]([^*]|\*[^/*])*\**\*/@@gx;
  71
  72             if (parse_entries (\*NEWFILE, $NEWFILE)) {
  73                 return 1;
  74             } else {
  75                 next;
  76             }
  77         }
  78
  79         if (/^\s*\}\s*(\w+)/) {
  80             $enumname = $1;
  81             $enumindex++;
  82             return 1;
  83         }
  84
  85         if (/^\s*\}/) {
  86             $enumindex++;
  87             $looking_for_name = 1;
  88             next;
  89         }
  90
  91         if (m@^\s*
  92               (\w+)\s*                   # name
  93               (?:=(                      # value
  94                    (?:[^,/]|/(?!\*))*
  95                   ))?,?\s*
  96               (?:/\*<                    # options
  97                 (([^*]|\*(?!/))*)
  98                >\s*\*/)?,?
  99               \s*$
 100              @x) {
 101             my ($name, $value, $options) = ($1,$2,$3);
 102
 103 #           print STDERR "xxx \"$name\" \"$value\" \"$otions\"\n";
 104
 105             if (!defined $flags && defined $value && $value =~ /<</) {
 106                 $seenbitshift = 1;
 107             }
 108
 109             if (defined $options) {
 110                 my %options = parse_trigraph($options);
 111                 if (!defined $options{skip}) {
 112                     push @entries, [ $name, $options{nick} ];
 113                 }
 114             } else {
 115                 push @entries, [ $name ];
 116             }
 117         } elsif (m@^\s*\#@) {
 118             # ignore preprocessor directives
 119         } else {
 120             print STDERR "$0: $file_name:$.: Failed to parse `$_'\n";
 121         }
 122     }
 123
 124     return 0;
 125 }
 126
 127 sub version {
 128     print STDERR "glib-mkenums version glib-2.0\n";   # FIXME: autogen version?
 129     print STDERR "glib-mkenums comes with ABSOLUTELY NO WARRANTY.\n";
 130     print STDERR "You may redistribute copies of glib-mkenums under the terms of\n";
 131     print STDERR "the GNU General Public License which can be found in the\n";
 132     print STDERR "GLib source package. Sources, examples and contact\n";
 133     print STDERR "information are available at http://www.gtk.org\n";
 134     exit 0;
 135 }
 136 sub usage {
 137     print STDERR "Usage: glib-mkenums [options] [files...]\n";
 138     print STDERR "  --fhead <text>             output file header\n";
 139     print STDERR "  --fprod <text>             per input file production\n";
 140     print STDERR "  --ftail <text>             output file trailer\n";
 141     print STDERR "  --eprod <text>             per enum text (produced prior to value itarations)\n";
 142     print STDERR "  --vhead <text>             value header, produced before iterating over enum values\n";
 143     print STDERR "  --vprod <text>             value text, produced for each enum value\n";
 144     print STDERR "  --vtail <text>             value tail, produced after iterating over enum values\n";
 145     print STDERR "  --comments <text>          comment structure\n";
 146     print STDERR "  -h, --help                 show this help message\n";
 147     print STDERR "  -v, --version              print version informations\n";
 148     print STDERR "Production text substitutions:\n";
 149     print STDERR "  \@EnumName\@                 PrefixTheXEnum\n";
 150     print STDERR "  \@enum_name\@                prefix_the_xenum\n";
 151     print STDERR "  \@ENUMNAME\@                 PREFIX_THE_XENUM\n";
 152     print STDERR "  \@ENUMSHORT\@                THE_XENUM\n";
 153     print STDERR "  \@VALUENAME\@                PREFIX_THE_XVALUE\n";
 154     print STDERR "  \@valuenick\@                the-xvalue\n";
 155     print STDERR "  \@type\@                     either enum or flags\n";
 156     print STDERR "  \@Type\@                     either Enum or Flags\n";
 157     print STDERR "  \@TYPE\@                     either ENUM or FLAGS\n";
 158     print STDERR "  \@filename\@                 name of current input file\n";
 159     exit 0;
 160 }
 161
 162 # production variables:
 163 my $fhead = "";   # output file header
 164 my $fprod = "";   # per input file production
 165 my $ftail = "";   # output file trailer
 166 my $eprod = "";   # per enum text (produced prior to value itarations)
 167 my $vhead = "";   # value header, produced before iterating over enum values
 168 my $vprod = "";   # value text, produced for each enum value
 169 my $vtail = "";   # value tail, produced after iterating over enum values
 170 # other options
 171 my $comment_tmpl = "/* \@comment\@ */";
 172
 173 if (!defined $ARGV[0]) {
 174     usage;
 175 }
 176 while ($_ = $ARGV[0], /^-/) {
 177     shift;
 178     last if /^--$/;
 179     if    (/^--fhead$/)              { $fhead = $fhead . shift }
 180     elsif (/^--fprod$/)              { $fprod = $fprod . shift }
 181     elsif (/^--ftail$/)              { $ftail = $ftail . shift }
 182     elsif (/^--eprod$/)              { $eprod = $eprod . shift }
 183     elsif (/^--vhead$/)              { $vhead = $vhead . shift }
 184     elsif (/^--vprod$/)              { $vprod = $vprod . shift }
 185     elsif (/^--vtail$/)              { $vtail = $vtail . shift }
 186     elsif (/^--comments$/)           { $comment_tmpl = shift }
 187     elsif (/^--help$/ || /^-h$/)     { usage; }
 188     elsif (/^--version$/ || /^-v$/)  { version; }
 189     else { usage; }
 190 }
 191
 192 # put auto-generation comment
 193 {
 194     my $comment = $comment_tmpl;
 195     $comment =~ s/\@comment\@/Generated data (by glib-mkenums)/;
 196     print "\n" . $comment . "\n\n";
 197 }
 198
 199 if (length($fhead)) {
 200     my $prod = $fhead;
 201
 202     $prod =~ s/\@filename\@/$ARGV/g;
 203     $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
 204     $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
 205
 206     print "$prod\n";
 207 }
 208
 209 while (<>) {
 210     if (eof) {
 211         close (ARGV);           # reset line numbering
 212         $firstenum = 1;         # Flag to print filename at next enum
 213     }
 214
 215     # read lines until comment end is matched
 216     while (m@/\*([^*]|\*[^/*])*\**$@x) {
 217         my $new;
 218         defined ($new = <>) || die "Unmatched comment in $ARGV";
 219         $_ .= $new;
 220     }
 221     # strip comments w/o options
 222     s@/\*[^<]([^*]|\*[^/*])*\**\*/@@gx;
 223
 224 #    print STDERR "xxx $_\n";
 225
 226     if (m@^\s*typedef\s+enum\s*
 227            ({)?\s*
 228            (?:/\*<
 229              (([^*]|\*(?!/))*)
 230             >\s*\*/)?
 231          @x) {
 232         if (defined $2) {
 233             my %options = parse_trigraph ($2);
 234             next if defined $options{skip};
 235             $enum_prefix = $options{prefix};
 236             $flags = $options{flags};
 237         } else {
 238             $enum_prefix = undef;
 239             $flags = undef;
 240         }
 241         # Didn't have trailing '{' look on next lines
 242         if (!defined $1) {
 243             while (<>) {
 244                 if (s/^\s*\{//) {
 245                     last;
 246                 }
 247             }
 248         }
 249
 250         $seenbitshift = 0;
 251         @entries = ();
 252
 253         # Now parse the entries
 254         parse_entries (\*ARGV, $ARGV);
 255
 256         # figure out if this was a flags or enums enumeration
 257         if (!defined $flags) {
 258             $flags = $seenbitshift;
 259         }
 260
 261         # Autogenerate a prefix
 262         if (!defined $enum_prefix) {
 263             for (@entries) {
 264                 my $nick = $_->[1];
 265                 if (!defined $nick) {
 266                     my $name = $_->[0];
 267                     if (defined $enum_prefix) {
 268                         my $tmp = ~ ($name ^ $enum_prefix);
 269                         ($tmp) = $tmp =~ /(^\xff*)/;
 270                         $enum_prefix = $enum_prefix & $tmp;
 271                     } else {
 272                         $enum_prefix = $name;
 273                     }
 274                 }
 275             }
 276             if (!defined $enum_prefix) {
 277                 $enum_prefix = "";
 278             } else {
 279                 # Trim so that it ends in an underscore
 280                 $enum_prefix =~ s/_[^_]*$/_/;
 281             }
 282         } else {
 283             # canonicalize user defined prefixes
 284             $enum_prefix = uc($enum_prefix);
 285             $enum_prefix =~ s/-/_/g;
 286             $enum_prefix =~ s/(.*)([^_])$/$1$2_/;
 287         }
 288
 289         for $entry (@entries) {
 290             my ($name,$nick) = @{$entry};
 291             if (!defined $nick) {
 292                 ($nick = $name) =~ s/^$enum_prefix//;
 293                 $nick =~ tr/_/-/;
 294                 $nick = lc($nick);
 295                 @{$entry} = ($name, $nick);
 296             }
 297         }
 298
 299
 300         # Spit out the output
 301
 302         # enumname is e.g. GMatchType
 303         $enspace = $enumname;
 304         $enspace =~ s/^([A-Z][a-z]*).*$/$1/;
 305
 306         $enumshort = $enumname;
 307         $enumshort =~ s/^[A-Z][a-z]*//;
 308         $enumshort =~ s/([^A-Z])([A-Z])/$1_$2/g;
 309         $enumshort =~ s/([A-Z][A-Z])([A-Z][0-9a-z])/$1_$2/g;
 310         $enumshort = uc($enumshort);
 311
 312         $enumlong = uc($enspace) . "_" . $enumshort;
 313         $enumsym = lc($enspace) . "_" . lc($enumshort);
 314
 315         if ($firstenum) {
 316             $firstenum = 0;
 317
 318             if (length($fprod)) {
 319                 my $prod = $fprod;
 320
 321                 $prod =~ s/\@filename\@/$ARGV/g;
 322                 $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
 323                 $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
 324
 325                 print "$prod\n";
 326             }
 327         }
 328
 329         if (length($eprod)) {
 330             my $prod = $eprod;
 331
 332             $prod =~ s/\@enum_name\@/$enumsym/g;
 333             $prod =~ s/\@EnumName\@/$enumname/g;
 334             $prod =~ s/\@ENUMSHORT\@/$enumshort/g;
 335             $prod =~ s/\@ENUMNAME\@/$enumlong/g;
 336             if ($flags) { $prod =~ s/\@type\@/flags/g; } else { $prod =~ s/\@type\@/enum/g; }
 337             if ($flags) { $prod =~ s/\@Type\@/Flags/g; } else { $prod =~ s/\@Type\@/Enum/g; }
 338             if ($flags) { $prod =~ s/\@TYPE\@/FLAGS/g; } else { $prod =~ s/\@TYPE\@/ENUM/g; }
 339             $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
 340             $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
 341
 342             print "$prod\n";
 343         }
 344
 345         if (length($vhead)) {
 346             my $prod = $vhead;
 347
 348             $prod =~ s/\@enum_name\@/$enumsym/g;
 349             $prod =~ s/\@EnumName\@/$enumname/g;
 350             $prod =~ s/\@ENUMSHORT\@/$enumshort/g;
 351             $prod =~ s/\@ENUMNAME\@/$enumlong/g;
 352             if ($flags) { $prod =~ s/\@type\@/flags/g; } else { $prod =~ s/\@type\@/enum/g; }
 353             if ($flags) { $prod =~ s/\@Type\@/Flags/g; } else { $prod =~ s/\@Type\@/Enum/g; }
 354             if ($flags) { $prod =~ s/\@TYPE\@/FLAGS/g; } else { $prod =~ s/\@TYPE\@/ENUM/g; }
 355             $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
 356             $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
 357
 358             print "$prod\n";
 359         }
 360
 361         if (length($vprod)) {
 362             my $prod = $vprod;
 363
 364             $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
 365             $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
 366             for (@entries) {
 367                 my ($name,$nick) = @{$_};
 368                 my $tmp_prod = $vprod;
 369
 370                 $tmp_prod =~ s/\@VALUENAME\@/$name/g;
 371                 $tmp_prod =~ s/\@valuenick\@/$nick/g;
 372                 if ($flags) { $tmp_prod =~ s/\@type\@/flags/g; } else { $tmp_prod =~ s/\@type\@/enum/g; }
 373                 if ($flags) { $tmp_prod =~ s/\@Type\@/Flags/g; } else { $tmp_prod =~ s/\@Type\@/Enum/g; }
 374                 if ($flags) { $tmp_prod =~ s/\@TYPE\@/FLAGS/g; } else { $tmp_prod =~ s/\@TYPE\@/ENUM/g; }
 375
 376                 print "$tmp_prod\n";
 377             }
 378         }
 379
 380         if (length($vtail)) {
 381             my $prod = $vtail;
 382
 383             $prod =~ s/\@enum_name\@/$enumsym/g;
 384             $prod =~ s/\@EnumName\@/$enumname/g;
 385             $prod =~ s/\@ENUMSHORT\@/$enumshort/g;
 386             $prod =~ s/\@ENUMNAME\@/$enumlong/g;
 387             if ($flags) { $prod =~ s/\@type\@/flags/g; } else { $prod =~ s/\@type\@/enum/g; }
 388             if ($flags) { $prod =~ s/\@Type\@/Flags/g; } else { $prod =~ s/\@Type\@/Enum/g; }
 389             if ($flags) { $prod =~ s/\@TYPE\@/FLAGS/g; } else { $prod =~ s/\@TYPE\@/ENUM/g; }
 390             $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
 391             $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
 392
 393             print "$prod\n";
 394         }
 395     }
 396 }
 397
 398 if (length($ftail)) {
 399     my $prod = $ftail;
 400
 401     $prod =~ s/\@filename\@/$ARGV/g;
 402     $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
 403     $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
 404
 405     print "$prod\n";
 406 }
 407
 408 # put auto-generation comment
 409 {
 410     my $comment = $comment_tmpl;
 411     $comment =~ s/\@comment\@/Generated data ends here/;
 412     print "\n" . $comment . "\n\n";
 413 }