Home | History | Annotate | Download | only in gobject 
      1 #!@PERL_PATH@ -w
      2 
      3 # glib-mkenums.pl 
      4 # Information about the current enumeration
      5 my $flags;			# Is enumeration a bitmask?
      6 my $option_underscore_name;	# Overriden underscore variant of the enum name
      7 				# for example to fix the cases we don't get the
      8 				# mixed-case -> underscorized transform right.
      9 my $option_lowercase_name;	# DEPRECATED.  A lower case name to use as part
     10 				# of the *_get_type() function, instead of the
     11 				# one that we guess. For instance, when an enum
     12 				# uses abnormal capitalization and we can not
     13 				# guess where to put the underscores.
     14 my $seenbitshift;		# Have we seen bitshift operators?
     15 my $enum_prefix;		# Prefix for this enumeration
     16 my $enumname;			# Name for this enumeration
     17 my $enumshort;			# $enumname without prefix
     18 my $enumname_prefix;		# prefix of $enumname
     19 my $enumindex = 0;		# Global enum counter
     20 my $firstenum = 1;		# Is this the first enumeration per file?
     21 my @entries;			# [ $name, $val ] for each entry
     22 
     23 sub parse_trigraph {
     24     my $opts = shift;
     25     my @opts;
     26 
     27     for $opt (split /\s*,\s*/, $opts) {
     28 	$opt =~ s/^\s*//;
     29 	$opt =~ s/\s*$//;
     30         my ($key,$val) = $opt =~ /(\w+)(?:=(.+))?/;
     31 	defined $val or $val = 1;
     32 	push @opts, $key, $val;
     33     }
     34     @opts;
     35 }
     36 sub parse_entries {
     37     my $file = shift;
     38     my $file_name = shift;
     39     my $looking_for_name = 0;
     40     
     41     while (<$file>) {
     42 	# read lines until we have no open comments
     43 	while (m@/\*([^*]|\*(?!/))*$@) {
     44 	    my $new;
     45 	    defined ($new = <$file>) || die "Unmatched comment in $ARGV";
     46 	    $_ .= $new;
     47 	}
     48 	# strip comments w/o options
     49 	s@/\*(?!<)
     50 	    ([^*]+|\*(?!/))*
     51 	   \*/@@gx;
     52 	
     53 	# strip newlines
     54 	s@\n@ @;
     55 	
     56 	# skip empty lines
     57 	next if m@^\s*$@;
     58 	
     59 	if ($looking_for_name) {
     60 	    if (/^\s*(\w+)/) {
     61 		$enumname = $1;
     62 		return 1;
     63 	    }
     64 	}
     65 	
     66 	# Handle include files
     67 	if (/^\#include\s*<([^>]*)>/ ) {
     68             my $file= "../$1";
     69 	    open NEWFILE, $file or die "Cannot open include file $file: $!\n";
     70 	    
     71 	    if (parse_entries (\*NEWFILE, $NEWFILE)) {
     72 		return 1;
     73 	    } else {
     74 		next;
     75 	    }
     76 	}
     77 	
     78 	if (/^\s*\}\s*(\w+)/) {
     79 	    $enumname = $1;
     80 	    $enumindex++;
     81 	    return 1;
     82 	}
     83 	
     84 	if (/^\s*\}/) {
     85 	    $enumindex++;
     86 	    $looking_for_name = 1;
     87 	    next;
     88 	}
     89 
     90         if (m@^\s*
     91               (\w+)\s*                   # name
     92               (?:=(                      # value
     93 		   \s*\w+\s*\(.*\)\s*       # macro with multiple args
     94 		   |                        # OR
     95                    (?:[^,/]|/(?!\*))*       # anything but a comma or comment
     96                   ))?,?\s*
     97               (?:/\*<                    # options
     98                 (([^*]|\*(?!/))*)
     99                >\s*\*/)?,?
    100               \s*$
    101              @x) {
    102             my ($name, $value, $options) = ($1,$2,$3);
    103 
    104 	    if (!defined $flags && defined $value && $value =~ /<</) {
    105 		$seenbitshift = 1;
    106 	    }
    107 
    108 	    if (defined $options) {
    109 		my %options = parse_trigraph($options);
    110 		if (!defined $options{skip}) {
    111 		    push @entries, [ $name, $options{nick} ];
    112 		}
    113 	    } else {
    114 		push @entries, [ $name ];
    115 	    }
    116 	} elsif (m@^\s*\#@) {
    117 	    # ignore preprocessor directives
    118 	} else {
    119 	    print STDERR "$0: $file_name:$.: Failed to parse `$_'\n";
    120 	}
    121     }
    122 
    123     return 0;
    124 }
    125 
    126 sub version {
    127     print "glib-mkenums version glib-@GLIB_VERSION@\n";
    128     print "glib-mkenums comes with ABSOLUTELY NO WARRANTY.\n";
    129     print "You may redistribute copies of glib-mkenums under the terms of\n";
    130     print "the GNU General Public License which can be found in the\n";
    131     print "GLib source package. Sources, examples and contact\n";
    132     print "information are available at http://www.gtk.org\n";
    133     exit 0;
    134 }
    135 sub usage {
    136     print "Usage:\n";
    137     print "  glib-mkenums [OPTION...] [FILES...]\n\n";
    138     print "Help Options:\n";
    139     print "  -h, --help            Show this help message\n\n";
    140     print "Utility Options:\n";
    141     print "  --fhead <text>        Output file header\n";
    142     print "  --fprod <text>        Per input file production\n";
    143     print "  --ftail <text>        Output file trailer\n";
    144     print "  --eprod <text>        Per enum text (produced prior to value itarations)\n";
    145     print "  --vhead <text>        Value header, produced before iterating over enum values\n";
    146     print "  --vprod <text>        Value text, produced for each enum value\n";
    147     print "  --vtail <text>        Value tail, produced after iterating over enum values\n";
    148     print "  --comments <text>     Comment structure\n";
    149     print "  --template file       Template file\n";
    150     print "  -v, --version         Print version informations\n\n";
    151     print "Production text substitutions:\n";
    152     print "  \@EnumName\@            PrefixTheXEnum\n";
    153     print "  \@enum_name\@           prefix_the_xenum\n";
    154     print "  \@ENUMNAME\@            PREFIX_THE_XENUM\n";
    155     print "  \@ENUMSHORT\@           THE_XENUM\n";
    156     print "  \@ENUMPREFIX\@          PREFIX\n";
    157     print "  \@VALUENAME\@           PREFIX_THE_XVALUE\n";
    158     print "  \@valuenick\@           the-xvalue\n";
    159     print "  \@type\@                either enum or flags\n";
    160     print "  \@Type\@                either Enum or Flags\n";
    161     print "  \@TYPE\@                either ENUM or FLAGS\n";
    162     print "  \@filename\@            name of current input file\n";
    163     exit 0;
    164 }
    165 
    166 # production variables:
    167 my $fhead = "";   # output file header
    168 my $fprod = "";   # per input file production
    169 my $ftail = "";   # output file trailer
    170 my $eprod = "";   # per enum text (produced prior to value itarations)
    171 my $vhead = "";   # value header, produced before iterating over enum values
    172 my $vprod = "";   # value text, produced for each enum value
    173 my $vtail = "";   # value tail, produced after iterating over enum values
    174 # other options
    175 my $comment_tmpl = "/* \@comment\@ */";
    176 
    177 sub read_template_file {
    178   my ($file) = @_;
    179   my %tmpl = ('file-header', $fhead, 
    180 	      'file-production', $fprod, 
    181 	      'file-tail', $ftail, 
    182 	      'enumeration-production', $eprod,
    183 	      'value-header', $vhead,
    184 	      'value-production', $vprod,
    185 	      'value-tail', $vtail,
    186 	      'comment', $comment_tmpl);
    187   my $in = 'junk';
    188   open (FILE, $file) || die "Can't open $file: $!\n";
    189   while (<FILE>) {
    190     if (/^\/\*\*\*\s+(BEGIN|END)\s+([\w-]+)\s+\*\*\*\//) {
    191       if (($in eq 'junk') && ($1 eq 'BEGIN') && (exists($tmpl{$2}))) {
    192 	$in = $2;
    193 	next;
    194       }
    195       elsif (($in eq $2) && ($1 eq 'END') && (exists($tmpl{$2}))) {
    196 	$in = 'junk';
    197 	next;
    198       } else {
    199 	  die "Malformed template file $file\n";
    200       }
    201     }
    202     if (!($in eq 'junk')) {
    203 	$tmpl{$in} .= $_;
    204     }
    205   }
    206   close (FILE);
    207   if (!($in eq 'junk')) {
    208       die "Malformed template file $file\n";
    209   }
    210   $fhead = $tmpl{'file-header'};
    211   $fprod = $tmpl{'file-production'};
    212   $ftail = $tmpl{'file-tail'};
    213   $eprod = $tmpl{'enumeration-production'};
    214   $vhead = $tmpl{'value-header'};
    215   $vprod = $tmpl{'value-production'};
    216   $vtail = $tmpl{'value-tail'};
    217   $comment_tmpl = $tmpl{'comment'};
    218 }
    219 
    220 if (!defined $ARGV[0]) {
    221     usage;
    222 }
    223 while ($_=$ARGV[0],/^-/) {
    224     shift;
    225     last if /^--$/;
    226     if (/^--template$/)                      { read_template_file (shift); }
    227     elsif (/^--fhead$/)                      { $fhead = $fhead . shift }
    228     elsif (/^--fprod$/)                      { $fprod = $fprod . shift }
    229     elsif (/^--ftail$/)                      { $ftail = $ftail . shift }
    230     elsif (/^--eprod$/)                      { $eprod = $eprod . shift }
    231     elsif (/^--vhead$/)                      { $vhead = $vhead . shift }
    232     elsif (/^--vprod$/)                      { $vprod = $vprod . shift }
    233     elsif (/^--vtail$/)                      { $vtail = $vtail . shift }
    234     elsif (/^--comments$/)                   { $comment_tmpl = shift }
    235     elsif (/^--help$/ || /^-h$/ || /^-h$/)   { usage; }
    236     elsif (/^--version$/ || /^-v$/)          { version; }
    237     else { usage; }
    238     last if not defined($ARGV[0]);
    239 }
    240 
    241 # put auto-generation comment
    242 {
    243     my $comment = $comment_tmpl;
    244     $comment =~ s/\@comment\@/Generated data (by glib-mkenums)/;
    245     print "\n" . $comment . "\n\n";
    246 }
    247 
    248 if (length($fhead)) {
    249     my $prod = $fhead;
    250 
    251     $prod =~ s/\@filename\@/$ARGV[0]/g;
    252     $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
    253     $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
    254     chomp ($prod);
    255 		
    256     print "$prod\n";
    257 }
    258 
    259 while (<>) {
    260     if (eof) {
    261 	close (ARGV);		# reset line numbering
    262 	$firstenum = 1;		# Flag to print filename at next enum
    263     }
    264 
    265     # read lines until we have no open comments
    266     while (m@/\*([^*]|\*(?!/))*$@) {
    267 	my $new;
    268 	defined ($new = <>) || die "Unmatched comment in $ARGV";
    269 	$_ .= $new;
    270     }
    271     # strip comments w/o options
    272     s@/\*(?!<)
    273        ([^*]+|\*(?!/))*
    274        \*/@@gx;
    275 	
    276     if (m@^\s*typedef\s+enum\s*
    277            ({)?\s*
    278            (?:/\*<
    279              (([^*]|\*(?!/))*)
    280             >\s*\*/)?
    281            \s*({)?
    282          @x) {
    283 	if (defined $2) {
    284 	    my %options = parse_trigraph ($2);
    285 	    next if defined $options{skip};
    286 	    $enum_prefix = $options{prefix};
    287 	    $flags = $options{flags};
    288 	    $option_lowercase_name = $options{lowercase_name};
    289 	    $option_underscore_name = $options{underscore_name};
    290 	} else {
    291 	    $enum_prefix = undef;
    292 	    $flags = undef;
    293 	    $option_lowercase_name = undef;
    294 	    $option_underscore_name = undef;
    295 	}
    296 	if (defined $option_lowercase_name) {
    297 	    if (defined $option_underscore_name) {
    298 		print STDERR "$0: $ARGV:$.: lowercase_name overriden with underscore_name\n";
    299 		$option_lowercase_name = undef;
    300 	    } else {
    301 		print STDERR "$0: $ARGV:$.: lowercase_name is deprecated, use underscore_name\n";
    302 	    }
    303 	}
    304 	# Didn't have trailing '{' look on next lines
    305 	if (!defined $1 && !defined $4) {
    306 	    while (<>) {
    307 		if (s/^\s*\{//) {
    308 		    last;
    309 		}
    310 	    }
    311 	}
    312 
    313 	$seenbitshift = 0;
    314 	@entries = ();
    315 
    316 	# Now parse the entries
    317 	parse_entries (\*ARGV, $ARGV);
    318 
    319 	# figure out if this was a flags or enums enumeration
    320 	if (!defined $flags) {
    321 	    $flags = $seenbitshift;
    322 	}
    323 
    324 	# Autogenerate a prefix
    325 	if (!defined $enum_prefix) {
    326 	    for (@entries) {
    327 		my $nick = $_->[1];
    328 		if (!defined $nick) {
    329 		    my $name = $_->[0];
    330 		    if (defined $enum_prefix) {
    331 			my $tmp = ~ ($name ^ $enum_prefix);
    332 			($tmp) = $tmp =~ /(^\xff*)/;
    333 			$enum_prefix = $enum_prefix & $tmp;
    334 		    } else {
    335 			$enum_prefix = $name;
    336 		    }
    337 		}
    338 	    }
    339 	    if (!defined $enum_prefix) {
    340 		$enum_prefix = "";
    341 	    } else {
    342 		# Trim so that it ends in an underscore
    343 		$enum_prefix =~ s/_[^_]*$/_/;
    344 	    }
    345 	} else {
    346 	    # canonicalize user defined prefixes
    347 	    $enum_prefix = uc($enum_prefix);
    348 	    $enum_prefix =~ s/-/_/g;
    349 	    $enum_prefix =~ s/(.*)([^_])$/$1$2_/;
    350 	}
    351 	
    352 	for $entry (@entries) {
    353 	    my ($name,$nick) = @{$entry};
    354             if (!defined $nick) {
    355  	        ($nick = $name) =~ s/^$enum_prefix//;
    356 	        $nick =~ tr/_/-/;
    357 	        $nick = lc($nick);
    358 	        @{$entry} = ($name, $nick);
    359             }
    360 	}
    361 	
    362 
    363 	# Spit out the output
    364 	if (defined $option_underscore_name) {
    365 	    $enumlong = uc $option_underscore_name;
    366 	    $enumsym = lc $option_underscore_name;
    367 	    $enumshort = $enumlong;
    368 	    $enumshort =~ s/^[A-Z][A-Z0-9]*_//;
    369 
    370 	    $enumname_prefix = $enumlong;
    371 	    $enumname_prefix =~ s/$enumshort$//;
    372 	} else {
    373 	    # enumname is e.g. GMatchType
    374 	    $enspace = $enumname;
    375 	    $enspace =~ s/^([A-Z][a-z]*).*$/$1/;
    376 
    377 	    $enumshort = $enumname;
    378 	    $enumshort =~ s/^[A-Z][a-z]*//;
    379 	    $enumshort =~ s/([^A-Z])([A-Z])/$1_$2/g;
    380 	    $enumshort =~ s/([A-Z][A-Z])([A-Z][0-9a-z])/$1_$2/g;
    381 	    $enumshort = uc($enumshort);
    382 
    383 	    $enumname_prefix = $enumname;
    384 	    $enumname_prefix =~ s/^([A-Z][a-z]*).*$/$1/;
    385 	    $enumname_prefix = uc($enumname_prefix);
    386 
    387 	    $enumlong = uc($enspace) . "_" . $enumshort;
    388 	    $enumsym = lc($enspace) . "_" . lc($enumshort);
    389 
    390 	    if (defined($option_lowercase_name)) {
    391 		$enumsym = $option_lowercase_name;
    392 	    }
    393 	}
    394 
    395 	if ($firstenum) {
    396 	    $firstenum = 0;
    397 	    
    398 	    if (length($fprod)) {
    399 		my $prod = $fprod;
    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 	        chomp ($prod);
    405 		
    406 		print "$prod\n";
    407 	    }
    408 	}
    409 	
    410 	if (length($eprod)) {
    411 	    my $prod = $eprod;
    412 
    413 	    $prod =~ s/\@enum_name\@/$enumsym/g;
    414 	    $prod =~ s/\@EnumName\@/$enumname/g;
    415 	    $prod =~ s/\@ENUMSHORT\@/$enumshort/g;
    416 	    $prod =~ s/\@ENUMNAME\@/$enumlong/g;
    417 	    $prod =~ s/\@ENUMPREFIX\@/$enumname_prefix/g;
    418 	    if ($flags) { $prod =~ s/\@type\@/flags/g; } else { $prod =~ s/\@type\@/enum/g; }
    419 	    if ($flags) { $prod =~ s/\@Type\@/Flags/g; } else { $prod =~ s/\@Type\@/Enum/g; }
    420 	    if ($flags) { $prod =~ s/\@TYPE\@/FLAGS/g; } else { $prod =~ s/\@TYPE\@/ENUM/g; }
    421 	    $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
    422 	    $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
    423             chomp ($prod);
    424 
    425 	    print "$prod\n";
    426 	}
    427 
    428 	if (length($vhead)) {
    429 	    my $prod = $vhead;
    430 
    431 	    $prod =~ s/\@enum_name\@/$enumsym/g;
    432             $prod =~ s/\@EnumName\@/$enumname/g;
    433             $prod =~ s/\@ENUMSHORT\@/$enumshort/g;
    434             $prod =~ s/\@ENUMNAME\@/$enumlong/g;
    435 	    $prod =~ s/\@ENUMPREFIX\@/$enumname_prefix/g;
    436 	    if ($flags) { $prod =~ s/\@type\@/flags/g; } else { $prod =~ s/\@type\@/enum/g; }
    437 	    if ($flags) { $prod =~ s/\@Type\@/Flags/g; } else { $prod =~ s/\@Type\@/Enum/g; }
    438 	    if ($flags) { $prod =~ s/\@TYPE\@/FLAGS/g; } else { $prod =~ s/\@TYPE\@/ENUM/g; }
    439             $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
    440             $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
    441             chomp ($prod);
    442 	    
    443             print "$prod\n";
    444 	}
    445 
    446 	if (length($vprod)) {
    447 	    my $prod = $vprod;
    448 	    
    449 	    $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
    450 	    $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
    451 	    for (@entries) {
    452 		my ($name,$nick) = @{$_};
    453 		my $tmp_prod = $prod;
    454 
    455 		$tmp_prod =~ s/\@VALUENAME\@/$name/g;
    456 		$tmp_prod =~ s/\@valuenick\@/$nick/g;
    457 		if ($flags) { $tmp_prod =~ s/\@type\@/flags/g; } else { $tmp_prod =~ s/\@type\@/enum/g; }
    458 		if ($flags) { $tmp_prod =~ s/\@Type\@/Flags/g; } else { $tmp_prod =~ s/\@Type\@/Enum/g; }
    459 		if ($flags) { $tmp_prod =~ s/\@TYPE\@/FLAGS/g; } else { $tmp_prod =~ s/\@TYPE\@/ENUM/g; }
    460 		chomp ($tmp_prod);
    461 
    462 		print "$tmp_prod\n";
    463 	    }
    464 	}
    465 
    466 	if (length($vtail)) {
    467 	    my $prod = $vtail;
    468 
    469 	    $prod =~ s/\@enum_name\@/$enumsym/g;
    470             $prod =~ s/\@EnumName\@/$enumname/g;
    471             $prod =~ s/\@ENUMSHORT\@/$enumshort/g;
    472             $prod =~ s/\@ENUMNAME\@/$enumlong/g;
    473 	    $prod =~ s/\@ENUMPREFIX\@/$enumname_prefix/g;
    474 	    if ($flags) { $prod =~ s/\@type\@/flags/g; } else { $prod =~ s/\@type\@/enum/g; }
    475 	    if ($flags) { $prod =~ s/\@Type\@/Flags/g; } else { $prod =~ s/\@Type\@/Enum/g; }
    476 	    if ($flags) { $prod =~ s/\@TYPE\@/FLAGS/g; } else { $prod =~ s/\@TYPE\@/ENUM/g; }
    477             $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
    478             $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
    479             chomp ($prod);
    480 	    
    481             print "$prod\n";
    482 	}
    483     }
    484 }
    485 
    486 if (length($ftail)) {
    487     my $prod = $ftail;
    488 
    489     $prod =~ s/\@filename\@/$ARGV/g;
    490     $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
    491     $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
    492     chomp ($prod);
    493 		
    494     print "$prod\n";
    495 }
    496 
    497 # put auto-generation comment
    498 {
    499     my $comment = $comment_tmpl;
    500     $comment =~ s/\@comment\@/Generated data ends here/;
    501     print "\n" . $comment . "\n\n";
    502 }
    503