Diff: glib-mkenums - glib-mkenums

	glib-mkenums	glib-mkenums

	#!/usr/bin/perl5 -w	#! /usr/bin/perl5


		use warnings;
	use File::Basename;	use File::Basename;

		use Safe;

	# glib-mkenums.pl	# glib-mkenums.pl
	# Information about the current enumeration	# Information about the current enumeration
	my $flags; # Is enumeration a bitmask?	my $flags; # Is enumeration a bitmask?
	my $option_underscore_name; # Overriden underscore variant of the enum n ame	my $option_underscore_name; # Overriden underscore variant of the enum n ame
	# for example to fix the cases we don't get the	# for example to fix the cases we don't get the
	# mixed-case -> underscorized transform righ t.	# mixed-case -> underscorized transform righ t.
	my $option_lowercase_name; # DEPRECATED. A lower case name to use as p art	my $option_lowercase_name; # DEPRECATED. A lower case name to use as p art
	# of the *_get_type() function, instead of t he	# of the *_get_type() function, instead of t he
	# one that we guess. For instance, when an e num	# one that we guess. For instance, when an e num
	# uses abnormal capitalization and we can no t	# uses abnormal capitalization and we can no t
	# guess where to put the underscores.	# guess where to put the underscores.
	my $seenbitshift; # Have we seen bitshift operators?	my $seenbitshift; # Have we seen bitshift operators?
	my $enum_prefix; # Prefix for this enumeration	my $enum_prefix; # Prefix for this enumeration
	my $enumname; # Name for this enumeration	my $enumname; # Name for this enumeration
	my $enumshort; # $enumname without prefix	my $enumshort; # $enumname without prefix
	my $enumname_prefix; # prefix of $enumname	my $enumname_prefix; # prefix of $enumname
	my $enumindex = 0; # Global enum counter	my $enumindex = 0; # Global enum counter
	my $firstenum = 1; # Is this the first enumeration per file?	my $firstenum = 1; # Is this the first enumeration per file?
	my @entries; # [ $name, $val ] for each entry	my @entries; # [ $name, $val ] for each entry

		my $sandbox = Safe->new; # sandbox for safe evaluation of expression s

	sub parse_trigraph {	sub parse_trigraph {
	my $opts = shift;	my $opts = shift;
	my @opts;	my @opts;

	for $opt (split /\s,\s/, $opts) {	for $opt (split /\s,\s/, $opts) {
	$opt =~ s/^\s*//;	$opt =~ s/^\s*//;
	$opt =~ s/\s*$//;	$opt =~ s/\s*$//;
	my ($key,$val) = $opt =~ /(\w+)(?:=(.+))?/;	my ($key,$val) = $opt =~ /(\w+)(?:=(.+))?/;
	defined $val or $val = 1;	defined $val or $val = 1;

	skipping to change at line 113	skipping to change at line 116
	@x) {	@x) {
	my ($name, $value, $options) = ($1,$2,$3);	my ($name, $value, $options) = ($1,$2,$3);

	if (!defined $flags && defined $value && $value =~ /<</) {	if (!defined $flags && defined $value && $value =~ /<</) {
	$seenbitshift = 1;	$seenbitshift = 1;
	}	}

	if (defined $options) {	if (defined $options) {
	my %options = parse_trigraph($options);	my %options = parse_trigraph($options);
	if (!defined $options{skip}) {	if (!defined $options{skip}) {

	push @entries, [ $name, $options{nick} ];	push @entries, [ $name, $value, $options{nick} ];
	}	}
	} else {	} else {

	push @entries, [ $name ];	push @entries, [ $name, $value ];
	}	}
	} elsif (m@^\s*\#@) {	} elsif (m@^\s*\#@) {
	# ignore preprocessor directives	# ignore preprocessor directives
	} else {	} else {
	print STDERR "$0: $file_name:$.: Failed to parse `$_'\n";	print STDERR "$0: $file_name:$.: Failed to parse `$_'\n";
	}	}
	}	}

	return 0;	return 0;
	}	}

	sub version {	sub version {

	print "glib-mkenums version glib-2.24.1\n";	print "glib-mkenums version glib-2.28.8\n";
	print "glib-mkenums comes with ABSOLUTELY NO WARRANTY.\n";	print "glib-mkenums comes with ABSOLUTELY NO WARRANTY.\n";
	print "You may redistribute copies of glib-mkenums under the terms of\n ";	print "You may redistribute copies of glib-mkenums under the terms of\n ";
	print "the GNU General Public License which can be found in the\n";	print "the GNU General Public License which can be found in the\n";
	print "GLib source package. Sources, examples and contact\n";	print "GLib source package. Sources, examples and contact\n";
	print "information are available at http://www.gtk.org\n";	print "information are available at http://www.gtk.org\n";
	exit 0;	exit 0;
	}	}
	sub usage {	sub usage {
	print "Usage:\n";	print "Usage:\n";
	print " glib-mkenums [OPTION...] [FILES...]\n\n";	print " glib-mkenums [OPTION...] [FILES...]\n\n";

	skipping to change at line 161	skipping to change at line 164
	print " --template file Template file\n";	print " --template file Template file\n";
	print " -v, --version Print version informations\n\n";	print " -v, --version Print version informations\n\n";
	print "Production text substitutions:\n";	print "Production text substitutions:\n";
	print " \@EnumName\@ PrefixTheXEnum\n";	print " \@EnumName\@ PrefixTheXEnum\n";
	print " \@enum_name\@ prefix_the_xenum\n";	print " \@enum_name\@ prefix_the_xenum\n";
	print " \@ENUMNAME\@ PREFIX_THE_XENUM\n";	print " \@ENUMNAME\@ PREFIX_THE_XENUM\n";
	print " \@ENUMSHORT\@ THE_XENUM\n";	print " \@ENUMSHORT\@ THE_XENUM\n";
	print " \@ENUMPREFIX\@ PREFIX\n";	print " \@ENUMPREFIX\@ PREFIX\n";
	print " \@VALUENAME\@ PREFIX_THE_XVALUE\n";	print " \@VALUENAME\@ PREFIX_THE_XVALUE\n";
	print " \@valuenick\@ the-xvalue\n";	print " \@valuenick\@ the-xvalue\n";

		print " \@valuenum\@ the integer value (limited support, Si nce: 2.26)\n";
	print " \@type\@ either enum or flags\n";	print " \@type\@ either enum or flags\n";
	print " \@Type\@ either Enum or Flags\n";	print " \@Type\@ either Enum or Flags\n";
	print " \@TYPE\@ either ENUM or FLAGS\n";	print " \@TYPE\@ either ENUM or FLAGS\n";
	print " \@filename\@ name of current input file\n";	print " \@filename\@ name of current input file\n";
	print " \@basename\@ base name of the current input file (S ince: 2.22)\n";	print " \@basename\@ base name of the current input file (S ince: 2.22)\n";
	exit 0;	exit 0;
	}	}

	# production variables:	# production variables:
	my $fhead = ""; # output file header	my $fhead = ""; # output file header
	my $fprod = ""; # per input file production	my $fprod = ""; # per input file production
	my $ftail = ""; # output file trailer	my $ftail = ""; # output file trailer
	my $eprod = ""; # per enum text (produced prior to value itarations)	my $eprod = ""; # per enum text (produced prior to value itarations)
	my $vhead = ""; # value header, produced before iterating over enum value s	my $vhead = ""; # value header, produced before iterating over enum value s
	my $vprod = ""; # value text, produced for each enum value	my $vprod = ""; # value text, produced for each enum value
	my $vtail = ""; # value tail, produced after iterating over enum values	my $vtail = ""; # value tail, produced after iterating over enum values

	# other options	my $comment_tmpl = ""; # comment template
	my $comment_tmpl = "/* \@comment\@ */";

	sub read_template_file {	sub read_template_file {
	my ($file) = @_;	my ($file) = @_;
	my %tmpl = ('file-header', $fhead,	my %tmpl = ('file-header', $fhead,
	'file-production', $fprod,	'file-production', $fprod,
	'file-tail', $ftail,	'file-tail', $ftail,
	'enumeration-production', $eprod,	'enumeration-production', $eprod,
	'value-header', $vhead,	'value-header', $vhead,
	'value-production', $vprod,	'value-production', $vprod,
	'value-tail', $vtail,	'value-tail', $vtail,

	skipping to change at line 221	skipping to change at line 224
	die "Malformed template file $file\n";	die "Malformed template file $file\n";
	}	}
	$fhead = $tmpl{'file-header'};	$fhead = $tmpl{'file-header'};
	$fprod = $tmpl{'file-production'};	$fprod = $tmpl{'file-production'};
	$ftail = $tmpl{'file-tail'};	$ftail = $tmpl{'file-tail'};
	$eprod = $tmpl{'enumeration-production'};	$eprod = $tmpl{'enumeration-production'};
	$vhead = $tmpl{'value-header'};	$vhead = $tmpl{'value-header'};
	$vprod = $tmpl{'value-production'};	$vprod = $tmpl{'value-production'};
	$vtail = $tmpl{'value-tail'};	$vtail = $tmpl{'value-tail'};
	$comment_tmpl = $tmpl{'comment'};	$comment_tmpl = $tmpl{'comment'};


		# default to C-style comments
		$comment_tmpl = "/* \@comment\@ */" if $comment_tmpl eq "";
	}	}

	if (!defined $ARGV[0]) {	if (!defined $ARGV[0]) {
	usage;	usage;
	}	}
	while ($_=$ARGV[0],/^-/) {	while ($_=$ARGV[0],/^-/) {
	shift;	shift;
	last if /^--$/;	last if /^--$/;
	if (/^--template$/) { read_template_file (shift); }	if (/^--template$/) { read_template_file (shift); }
	elsif (/^--fhead$/) { $fhead = $fhead . shift }	elsif (/^--fhead$/) { $fhead = $fhead . shift }

	skipping to change at line 332	skipping to change at line 338
	parse_entries (\*ARGV, $ARGV);	parse_entries (\*ARGV, $ARGV);

	# figure out if this was a flags or enums enumeration	# figure out if this was a flags or enums enumeration
	if (!defined $flags) {	if (!defined $flags) {
	$flags = $seenbitshift;	$flags = $seenbitshift;
	}	}

	# Autogenerate a prefix	# Autogenerate a prefix
	if (!defined $enum_prefix) {	if (!defined $enum_prefix) {
	for (@entries) {	for (@entries) {

	my $nick = $_->[1];	my $nick = $_->[2];
	if (!defined $nick) {	if (!defined $nick) {
	my $name = $_->[0];	my $name = $_->[0];
	if (defined $enum_prefix) {	if (defined $enum_prefix) {
	my $tmp = ~ ($name ^ $enum_prefix);	my $tmp = ~ ($name ^ $enum_prefix);
	($tmp) = $tmp =~ /(^\xff*)/;	($tmp) = $tmp =~ /(^\xff*)/;
	$enum_prefix = $enum_prefix & $tmp;	$enum_prefix = $enum_prefix & $tmp;
	} else {	} else {
	$enum_prefix = $name;	$enum_prefix = $name;
	}	}
	}	}

	skipping to change at line 358	skipping to change at line 364
	$enum_prefix =~ s/_[^_]*$/_/;	$enum_prefix =~ s/_[^_]*$/_/;
	}	}
	} else {	} else {
	# canonicalize user defined prefixes	# canonicalize user defined prefixes
	$enum_prefix = uc($enum_prefix);	$enum_prefix = uc($enum_prefix);
	$enum_prefix =~ s/-/_/g;	$enum_prefix =~ s/-/_/g;
	$enum_prefix =~ s/(.*)([^_])$/$1$2_/;	$enum_prefix =~ s/(.*)([^_])$/$1$2_/;
	}	}

	for $entry (@entries) {	for $entry (@entries) {

	my ($name,$nick) = @{$entry};	my ($name,$num,$nick) = @{$entry};
	if (!defined $nick) {	if (!defined $nick) {
	($nick = $name) =~ s/^$enum_prefix//;	($nick = $name) =~ s/^$enum_prefix//;
	$nick =~ tr/_/-/;	$nick =~ tr/_/-/;
	$nick = lc($nick);	$nick = lc($nick);

	@{$entry} = ($name, $nick);	@{$entry} = ($name, $num, $nick);
	}	}
	}	}

	# Spit out the output	# Spit out the output
	if (defined $option_underscore_name) {	if (defined $option_underscore_name) {
	$enumlong = uc $option_underscore_name;	$enumlong = uc $option_underscore_name;
	$enumsym = lc $option_underscore_name;	$enumsym = lc $option_underscore_name;
	$enumshort = $enumlong;	$enumshort = $enumlong;
	$enumshort =~ s/^[A-Z][A-Z0-9]*_//;	$enumshort =~ s/^[A-Z][A-Z0-9]*_//;


	skipping to change at line 454	skipping to change at line 460
	if ($flags) { $prod =~ s/\@TYPE\@/FLAGS/g; } else { $prod =~ s/\ @TYPE\@/ENUM/g; }	if ($flags) { $prod =~ s/\@TYPE\@/FLAGS/g; } else { $prod =~ s/\ @TYPE\@/ENUM/g; }
	$prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;	$prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
	$prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;	$prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
	chomp ($prod);	chomp ($prod);

	print "$prod\n";	print "$prod\n";
	}	}

	if (length($vprod)) {	if (length($vprod)) {
	my $prod = $vprod;	my $prod = $vprod;

		my $next_num = 0;

	$prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $ prod =~ s/\\n/\n/g;	$prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $ prod =~ s/\\n/\n/g;
	$prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;	$prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
	for (@entries) {	for (@entries) {

	my ($name,$nick) = @{$_};	my ($name,$num,$nick) = @{$_};
	my $tmp_prod = $prod;	my $tmp_prod = $prod;


		if ($prod =~ /\@valuenum\@/) {
		# only attempt to eval the value if it is requested
		# this prevents us from throwing errors otherwise
		if (defined $num) {
		# use sandboxed perl evaluation as a reasonable
		# approximation to C constant folding
		$num = $sandbox->reval ($num);

		# make sure it parsed to an integer
		if (!defined $num or $num !~ /^-?\d+$/) {
		die "Unable to parse enum value '$num'";
		}
		} else {
		$num = $next_num;
		}

		$tmp_prod =~ s/\@valuenum\@/$num/g;
		$next_num = $num + 1;
		}

	$tmp_prod =~ s/\@VALUENAME\@/$name/g;	$tmp_prod =~ s/\@VALUENAME\@/$name/g;
	$tmp_prod =~ s/\@valuenick\@/$nick/g;	$tmp_prod =~ s/\@valuenick\@/$nick/g;
	if ($flags) { $tmp_prod =~ s/\@type\@/flags/g; } else { $tmp _prod =~ s/\@type\@/enum/g; }	if ($flags) { $tmp_prod =~ s/\@type\@/flags/g; } else { $tmp _prod =~ s/\@type\@/enum/g; }
	if ($flags) { $tmp_prod =~ s/\@Type\@/Flags/g; } else { $tmp _prod =~ s/\@Type\@/Enum/g; }	if ($flags) { $tmp_prod =~ s/\@Type\@/Flags/g; } else { $tmp _prod =~ s/\@Type\@/Enum/g; }
	if ($flags) { $tmp_prod =~ s/\@TYPE\@/FLAGS/g; } else { $tmp _prod =~ s/\@TYPE\@/ENUM/g; }	if ($flags) { $tmp_prod =~ s/\@TYPE\@/FLAGS/g; } else { $tmp _prod =~ s/\@TYPE\@/ENUM/g; }
	chomp ($tmp_prod);	chomp ($tmp_prod);

	print "$tmp_prod\n";	print "$tmp_prod\n";
	}	}
	}	}

End of changes. 16 change blocks.
	10 lines changed or deleted	37 lines changed or added
This html diff was produced by rfcdiff 1.41. The latest version is available from http://tools.ietf.org/tools/rfcdiff/