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