glib/gobject/glib-mkenums.in
Emmanuele Bassi 9ba17d511e mkenums: Support public/private trigraph
It is possible, when using GTK-Doc, to mark sections of an enumeration
type as "private": the values are there, but they are not documented,
and GTK-Doc won't complain about missing symbols:

    typedef enum {
      /*< private >*/
      MY_FOO_PRIVATE,

      /*< public >*/
      MY_FOO_VALUE_A,
      MY_FOO_VALUE_B,

      /*< private >*/
      MY_FOO_VALUE_C,
      MY_FOO_VALUE_D
    } MyFooValue;

The glib-mkenums parser also allows skipping enumeration values, using a
slightly different syntax:

    typedef enum P
      MY_BAR_PRIVATE, /*< skip >*/
      MY_BAR_VALUE_A,
      MY_BAR_VALUE_B
    } MyBarValue;

The annotation must sit on the same line as the enumeration value.

Both GTK-Doc and glib-mkenum use the same trigraph syntax, but slightly
different keys. This makes combining them slightly redundant, but
feasible.

All would be well and good, except that glib-mkenum will generate a
warning for lines it does not understand — and that includes the GTK-Doc
annotation trigraph, which, when confronted with the MyFooValue
enumeration above, will result in a warning like:

    glib-mkenums: myfoo.h:2: Failed to parse `  /*< private >*/ '
    glib-mkenums: myfoo.h:5: Failed to parse `  /*< public >*/ '
    glib-mkenums: myfoo.h:9: Failed to parse `  /*< private >*/ '

Of course, we could make glib-mkenum ignore any trigraph comment on a
stand alone line, but it would probably be better to ensure that both
glib-mkenums and gtk-doc behave consistently with each other, and
especially with the maintainer's intent of hiding some values from the
user, and reserving them for internal use.

So we should ensure that glib-mkenums automatically skips all the
enumeration values after a "private" flag has been set, until it reaches
a "public" stanza.

https://bugzilla.gnome.org/show_bug.cgi?id=782162
2017-05-16 11:23:50 +01:00

613 lines
19 KiB
Plaintext
Executable File

#! @PERL_PATH@
use warnings;
use File::Basename;
use File::Copy "move";
use File::Temp;
use Cwd;
use Safe;
# glib-mkenums.pl
# Information about the current enumeration
my $flags; # Is enumeration a bitmask?
my $option_underscore_name; # Overriden underscore variant of the enum name
# for example to fix the cases we don't get the
# mixed-case -> underscorized transform right.
my $option_lowercase_name; # DEPRECATED. A lower case name to use as part
# of the *_get_type() function, instead of the
# one that we guess. For instance, when an enum
# uses abnormal capitalization and we can not
# guess where to put the underscores.
my $seenbitshift; # Have we seen bitshift operators?
my $seenprivate; # Have we seen a private option?
my $enum_prefix; # Prefix for this enumeration
my $enumname; # Name for this enumeration
my $enumshort; # $enumname without prefix
my $enumname_prefix; # prefix of $enumname
my $enumindex = 0; # Global enum counter
my $firstenum = 1; # Is this the first enumeration per file?
my @entries; # [ $name, $val ] for each entry
my $sandbox = Safe->new; # sandbox for safe evaluation of expressions
my $output; # Filename to write result into
sub parse_trigraph {
my $opts = shift;
my @opts;
for $opt (split /\s*,\s*/, $opts) {
$opt =~ s/^\s*//;
$opt =~ s/\s*$//;
my ($key,$val) = $opt =~ /(\w+)(?:=(.+))?/;
defined $val or $val = 1;
push @opts, $key, $val;
}
@opts;
}
sub parse_entries {
my $file = shift;
my $file_name = shift;
my $looking_for_name = 0;
while (<$file>) {
# read lines until we have no open comments
while (m@/\*([^*]|\*(?!/))*$@) {
my $new;
defined ($new = <$file>) || die "Unmatched comment in $ARGV";
$_ .= $new;
}
# strip comments w/o options
s@/\*(?!<)
([^*]+|\*(?!/))*
\*/@@gx;
# strip newlines
s@\n@ @;
# skip empty lines
next if m@^\s*$@;
if ($looking_for_name) {
if (/^\s*(\w+)/) {
$enumname = $1;
return 1;
}
}
# Handle include files
if (/^\#include\s*<([^>]*)>/ ) {
my $file= "../$1";
open NEWFILE, $file or die "Cannot open include file $file: $!\n";
if (parse_entries (\*NEWFILE, $NEWFILE)) {
return 1;
} else {
next;
}
}
if (/^\s*\}\s*(\w+)/) {
$enumname = $1;
$enumindex++;
return 1;
}
if (/^\s*\}/) {
$enumindex++;
$looking_for_name = 1;
next;
}
if (m@^\s*
(\w+)\s* # name
(?:=( # value
\s*\w+\s*\(.*\)\s* # macro with multiple args
| # OR
(?:[^,/]|/(?!\*))* # anything but a comma or comment
))?,?\s*
(?:/\*< # options
(([^*]|\*(?!/))*)
>\s*\*/)?,?
\s*$
@x) {
my ($name, $value, $options) = ($1,$2,$3);
if (!defined $flags && defined $value && $value =~ /<</) {
$seenbitshift = 1;
}
next if $seenprivate;
if (defined $options) {
my %options = parse_trigraph($options);
if (!defined $options{skip}) {
push @entries, [ $name, $value, $options{nick} ];
}
} else {
push @entries, [ $name, $value ];
}
} elsif (m@^\s*\#@) {
# ignore preprocessor directives
} elsif (m@^\s*
/\*< (([^*]|\*(?!/))*) >\s*\*/
\s*$
@x) {
my ($options) = ($1);
if (defined $options) {
my %options = parse_trigraph($options);
if (defined $options{private}) {
$seenprivate = 1;
}
elsif (defined $options{public}) {
$seenprivate = 0;
}
}
} else {
print STDERR "$0: $file_name:$.: Failed to parse `$_'\n";
}
}
return 0;
}
sub version {
print "glib-mkenums version glib-@GLIB_VERSION@\n";
print "glib-mkenums comes with ABSOLUTELY NO WARRANTY.\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 "GLib source package. Sources, examples and contact\n";
print "information are available at http://www.gtk.org\n";
exit 0;
}
sub usage {
print "Usage:\n";
print " glib-mkenums [OPTION...] [FILES...]\n\n";
print "Help Options:\n";
print " -h, --help Show this help message\n\n";
print "Utility Options:\n";
print " --identifier-prefix <text> Identifier prefix\n";
print " --symbol-prefix <text> Symbol prefix\n";
print " --fhead <text> Output file header\n";
print " --fprod <text> Per input file production\n";
print " --ftail <text> Output file trailer\n";
print " --eprod <text> Per enum text (produced prior to value iterations)\n";
print " --vhead <text> Value header, produced before iterating over enum values\n";
print " --vprod <text> Value text, produced for each enum value\n";
print " --vtail <text> Value tail, produced after iterating over enum values\n";
print " --comments <text> Comment structure\n";
print " --template file Template file\n";
print " --output file Output file\n";
print " -v, --version Print version informations\n\n";
print "Production text substitutions:\n";
print " \@EnumName\@ PrefixTheXEnum\n";
print " \@enum_name\@ prefix_the_xenum\n";
print " \@ENUMNAME\@ PREFIX_THE_XENUM\n";
print " \@ENUMSHORT\@ THE_XENUM\n";
print " \@ENUMPREFIX\@ PREFIX\n";
print " \@VALUENAME\@ PREFIX_THE_XVALUE\n";
print " \@valuenick\@ the-xvalue\n";
print " \@valuenum\@ the integer value (limited support, Since: 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 " \@filename\@ name of current input file\n";
print " \@basename\@ base name of the current input file (Since: 2.22)\n";
exit 0;
}
# production variables:
my $idprefix = ""; # "G", "Gtk", etc
my $symprefix = ""; # "g", "gtk", etc, if not just lc($idprefix)
my $fhead = ""; # output file header
my $fprod = ""; # per input file production
my $ftail = ""; # output file trailer
my $eprod = ""; # per enum text (produced prior to value itarations)
my $vhead = ""; # value header, produced before iterating over enum values
my $vprod = ""; # value text, produced for each enum value
my $vtail = ""; # value tail, produced after iterating over enum values
my $comment_tmpl = ""; # comment template
sub read_template_file {
my ($file) = @_;
my %tmpl = ('file-header', $fhead,
'file-production', $fprod,
'file-tail', $ftail,
'enumeration-production', $eprod,
'value-header', $vhead,
'value-production', $vprod,
'value-tail', $vtail,
'comment', $comment_tmpl);
my $in = 'junk';
open (FILE, $file) || die "Can't open $file: $!\n";
while (<FILE>) {
if (/^\/\*\*\*\s+(BEGIN|END)\s+([\w-]+)\s+\*\*\*\//) {
if (($in eq 'junk') && ($1 eq 'BEGIN') && (exists($tmpl{$2}))) {
$in = $2;
next;
}
elsif (($in eq $2) && ($1 eq 'END') && (exists($tmpl{$2}))) {
$in = 'junk';
next;
} else {
die "Malformed template file $file\n";
}
}
if (!($in eq 'junk')) {
$tmpl{$in} .= $_;
}
}
close (FILE);
if (!($in eq 'junk')) {
die "Malformed template file $file\n";
}
$fhead = $tmpl{'file-header'};
$fprod = $tmpl{'file-production'};
$ftail = $tmpl{'file-tail'};
$eprod = $tmpl{'enumeration-production'};
$vhead = $tmpl{'value-header'};
$vprod = $tmpl{'value-production'};
$vtail = $tmpl{'value-tail'};
$comment_tmpl = $tmpl{'comment'};
# default to C-style comments
$comment_tmpl = "/* \@comment\@ */" if $comment_tmpl eq "";
}
if (!defined $ARGV[0]) {
usage;
}
while ($_=$ARGV[0],/^-/) {
shift;
last if /^--$/;
if (/^--template$/) { read_template_file (shift); }
elsif (/^--identifier-prefix$/) { $idprefix = shift }
elsif (/^--symbol-prefix$/) { $symprefix = shift }
elsif (/^--fhead$/) { $fhead = $fhead . shift }
elsif (/^--fprod$/) { $fprod = $fprod . shift }
elsif (/^--ftail$/) { $ftail = $ftail . shift }
elsif (/^--eprod$/) { $eprod = $eprod . shift }
elsif (/^--vhead$/) { $vhead = $vhead . shift }
elsif (/^--vprod$/) { $vprod = $vprod . shift }
elsif (/^--vtail$/) { $vtail = $vtail . shift }
elsif (/^--comments$/) { $comment_tmpl = shift }
elsif (/^--output$/) { $output = shift }
elsif (/^--help$/ || /^-h$/ || /^-\?$/) { usage; }
elsif (/^--version$/ || /^-v$/) { version; }
else { usage; }
last if not defined($ARGV[0]);
}
if (defined ($output)) {
my($out_fn, $out_dir, $out_suffix) = fileparse($output, qr{\.\w+$});
if ($out_dir eq '') { $out_dir = cwd(); }
$out_suffix =~ s/^\./_/; # .foo -> _foo
$OUTPUT = File::Temp->new("$out_fn$out_suffix\_XXXXXX", DIR => $out_dir, UNLINK => 0);
select $OUTPUT; # Make all print calls from here on go to OUTPUT
}
# put auto-generation comment
{
my $comment = $comment_tmpl;
$comment =~ s/\@comment\@/Generated data (by glib-mkenums)/;
print "\n" . $comment . "\n\n";
}
if (length($fhead)) {
my $prod = $fhead;
my $base = basename ($ARGV[0]);
$prod =~ s/\@filename\@/$ARGV[0]/g;
$prod =~ s/\@basename\@/$base/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;
chomp ($prod);
print "$prod\n";
}
@ARGV = sort @ARGV;
while (<>) {
if (eof) {
close (ARGV); # reset line numbering
$firstenum = 1; # Flag to print filename at next enum
}
# read lines until we have no open comments
while (m@/\*([^*]|\*(?!/))*$@) {
my $new;
defined ($new = <>) || die "Unmatched comment in $ARGV";
$_ .= $new;
}
# strip comments w/o options
s@/\*(?!<)
([^*]+|\*(?!/))*
\*/@@gx;
# ignore forward declarations
next if /^\s*typedef\s+enum.*;/;
if (m@^\s*typedef\s+enum\s*
({)?\s*
(?:/\*<
(([^*]|\*(?!/))*)
>\s*\*/)?
\s*({)?
@x) {
if (defined $2) {
my %options = parse_trigraph ($2);
next if defined $options{skip};
$enum_prefix = $options{prefix};
$flags = $options{flags};
$option_lowercase_name = $options{lowercase_name};
$option_underscore_name = $options{underscore_name};
} else {
$enum_prefix = undef;
$flags = undef;
$option_lowercase_name = undef;
$option_underscore_name = undef;
}
if (defined $option_lowercase_name) {
if (defined $option_underscore_name) {
print STDERR "$0: $ARGV:$.: lowercase_name overriden with underscore_name\n";
$option_lowercase_name = undef;
} else {
print STDERR "$0: $ARGV:$.: lowercase_name is deprecated, use underscore_name\n";
}
}
# Didn't have trailing '{' look on next lines
if (!defined $1 && !defined $4) {
while (<>) {
if (eof) {
die "Hit end of file while parsing enum in $ARGV";
}
if (s/^\s*\{//) {
last;
}
}
}
$seenbitshift = 0;
$seenprivate = 0;
@entries = ();
# Now parse the entries
parse_entries (\*ARGV, $ARGV);
# figure out if this was a flags or enums enumeration
if (!defined $flags) {
$flags = $seenbitshift;
}
# Autogenerate a prefix
if (!defined $enum_prefix) {
for (@entries) {
my $nick = $_->[2];
if (!defined $nick) {
my $name = $_->[0];
if (defined $enum_prefix) {
my $tmp = ~ ($name ^ $enum_prefix);
($tmp) = $tmp =~ /(^\xff*)/;
$enum_prefix = $enum_prefix & $tmp;
} else {
$enum_prefix = $name;
}
}
}
if (!defined $enum_prefix) {
$enum_prefix = "";
} else {
# Trim so that it ends in an underscore
$enum_prefix =~ s/_[^_]*$/_/;
}
} else {
# canonicalize user defined prefixes
$enum_prefix = uc($enum_prefix);
$enum_prefix =~ s/-/_/g;
$enum_prefix =~ s/(.*)([^_])$/$1$2_/;
}
for $entry (@entries) {
my ($name,$num,$nick) = @{$entry};
if (!defined $nick) {
($nick = $name) =~ s/^$enum_prefix//;
$nick =~ tr/_/-/;
$nick = lc($nick);
@{$entry} = ($name, $num, $nick);
}
}
# Spit out the output
if (defined $option_underscore_name) {
$enumlong = uc $option_underscore_name;
$enumsym = lc $option_underscore_name;
$enumshort = $enumlong;
$enumshort =~ s/^[A-Z][A-Z0-9]*_//;
$enumname_prefix = $enumlong;
$enumname_prefix =~ s/_$enumshort$//;
} elsif (!$symprefix && !$idprefix) {
# enumname is e.g. GMatchType
$enspace = $enumname;
$enspace =~ s/^([A-Z][a-z]*).*$/$1/;
$enumshort = $enumname;
$enumshort =~ s/^[A-Z][a-z]*//;
$enumshort =~ s/([^A-Z])([A-Z])/$1_$2/g;
$enumshort =~ s/([A-Z][A-Z])([A-Z][0-9a-z])/$1_$2/g;
$enumshort = uc($enumshort);
$enumname_prefix = $enumname;
$enumname_prefix =~ s/^([A-Z][a-z]*).*$/$1/;
$enumname_prefix = uc($enumname_prefix);
$enumlong = uc($enspace) . "_" . $enumshort;
$enumsym = lc($enspace) . "_" . lc($enumshort);
if (defined($option_lowercase_name)) {
$enumsym = $option_lowercase_name;
}
} else {
$enumshort = $enumname;
if ($idprefix) {
$enumshort =~ s/^${idprefix}//;
} else {
$enumshort =~ s/^[A-Z][a-z]*//;
}
$enumshort =~ s/([^A-Z])([A-Z])/$1_$2/g;
$enumshort =~ s/([A-Z][A-Z])([A-Z][0-9a-z])/$1_$2/g;
$enumshort = uc($enumshort);
$enumname_prefix = $symprefix && uc($symprefix) || uc($idprefix);
$enumlong = $enumname_prefix . "_" . $enumshort;
$enumsym = lc($enumlong);
}
if ($firstenum) {
$firstenum = 0;
if (length($fprod)) {
my $prod = $fprod;
my $base = basename ($ARGV);
$prod =~ s/\@filename\@/$ARGV/g;
$prod =~ s/\@basename\@/$base/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;
chomp ($prod);
print "$prod\n";
}
}
if (length($eprod)) {
my $prod = $eprod;
$prod =~ s/\@enum_name\@/$enumsym/g;
$prod =~ s/\@EnumName\@/$enumname/g;
$prod =~ s/\@ENUMSHORT\@/$enumshort/g;
$prod =~ s/\@ENUMNAME\@/$enumlong/g;
$prod =~ s/\@ENUMPREFIX\@/$enumname_prefix/g;
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; }
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/\\f/\f/g; $prod =~ s/\\r/\r/g;
chomp ($prod);
print "$prod\n";
}
if (length($vhead)) {
my $prod = $vhead;
$prod =~ s/\@enum_name\@/$enumsym/g;
$prod =~ s/\@EnumName\@/$enumname/g;
$prod =~ s/\@ENUMSHORT\@/$enumshort/g;
$prod =~ s/\@ENUMNAME\@/$enumlong/g;
$prod =~ s/\@ENUMPREFIX\@/$enumname_prefix/g;
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; }
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/\\f/\f/g; $prod =~ s/\\r/\r/g;
chomp ($prod);
print "$prod\n";
}
if (length($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/\\f/\f/g; $prod =~ s/\\r/\r/g;
for (@entries) {
my ($name,$num,$nick) = @{$_};
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/\@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; }
chomp ($tmp_prod);
print "$tmp_prod\n";
}
}
if (length($vtail)) {
my $prod = $vtail;
$prod =~ s/\@enum_name\@/$enumsym/g;
$prod =~ s/\@EnumName\@/$enumname/g;
$prod =~ s/\@ENUMSHORT\@/$enumshort/g;
$prod =~ s/\@ENUMNAME\@/$enumlong/g;
$prod =~ s/\@ENUMPREFIX\@/$enumname_prefix/g;
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; }
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/\\f/\f/g; $prod =~ s/\\r/\r/g;
chomp ($prod);
print "$prod\n";
}
}
}
if (length($ftail)) {
my $prod = $ftail;
my $base = basename ($ARGV);
$prod =~ s/\@filename\@/$ARGV/g;
$prod =~ s/\@basename\@/$base/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;
chomp ($prod);
print "$prod\n";
}
# put auto-generation comment
{
my $comment = $comment_tmpl;
$comment =~ s/\@comment\@/Generated data ends here/;
print "\n" . $comment . "\n\n";
}
if (defined ($output)) {
select STDOUT;
my $tmpfilename = $OUTPUT->filename;
close ($OUTPUT)
|| warn "Closing output file $tmpfilename failed: $!";
move ($tmpfilename, $output)
|| die "Could not rename $tmpfilename to $output: $!";
}