mirror of
https://gitlab.gnome.org/GNOME/nautilus
synced 2024-08-25 10:45:41 +00:00
![Alexander Larsson](/assets/img/avatar_default.png)
2008-12-15 Alexander Larsson <alexl@redhat.com> * Makefile.am: * acconfig.h: * configure.in: * eel/ * libnautilus-private/Makefile.am: Import eel into nautilus. svn path=/trunk/; revision=14815
221 lines
4.6 KiB
Perl
Executable file
221 lines
4.6 KiB
Perl
Executable file
#!/usr/bin/perl -w
|
|
|
|
# This script snarfs the enums from header files and writes them out into
|
|
# a .defs file (gnome.defs, for example). From there, the sister script
|
|
# maketypes.awk converts the defs into a *typebuiltins.h, as well as
|
|
# *typebuiltins_vals.c, *typebuiltins_ids.c and *typebuiltins_evals.c.
|
|
|
|
# Information about the current enumeration
|
|
|
|
my $flags; # Is enumeration a bitmask
|
|
my $seenbitshift; # Have we seen bitshift operators?
|
|
my $prefix; # Prefix for this enumeration
|
|
my $enumname; # Name for this enumeration
|
|
my $firstenum = 1; # Is this the first enumeration in file?
|
|
my @entries; # [ $name, $val ] for each entry
|
|
|
|
sub parse_options {
|
|
my $opts = shift;
|
|
my @opts;
|
|
|
|
for $opt (split /\s*,\s*/, $opts) {
|
|
my ($key,$val) = $opt =~ /\s*(\w+)(?:=(\S+))?/;
|
|
defined $val or $val = 1;
|
|
push @opts, $key, $val;
|
|
}
|
|
@opts;
|
|
}
|
|
sub parse_entries {
|
|
my $file = shift;
|
|
|
|
while (<$file>) {
|
|
# Read lines until we have no open comments
|
|
while (m@/\*
|
|
([^*]|\*(?!/))*$
|
|
@x) {
|
|
my $new;
|
|
defined ($new = <$file>) || die "Unmatched comment";
|
|
$_ .= $new;
|
|
}
|
|
# Now strip comments
|
|
s@/\*(?!<)
|
|
([^*]+|\*(?!/))*
|
|
\*/@@gx;
|
|
|
|
s@\n@ @;
|
|
|
|
next if m@^\s*$@;
|
|
|
|
# Handle include files
|
|
if (/^\#include\s*<([^>]*)>/ ) {
|
|
my $file= "../$1";
|
|
open NEWFILE, $file or die "Cannot open include file $file: $!\n";
|
|
|
|
if (parse_entries (\*NEWFILE)) {
|
|
return 1;
|
|
} else {
|
|
next;
|
|
}
|
|
}
|
|
|
|
if (/^\s*\}\s*(\w+)/) {
|
|
$enumname = $1;
|
|
return 1;
|
|
}
|
|
|
|
if (m@^\s*
|
|
(\w+)\s* # name
|
|
(?:=( # value
|
|
(?:[^,/]|/(?!\*))*
|
|
))?,?\s*
|
|
(?:/\*< # options
|
|
(([^*]|\*(?!/))*)
|
|
>\*/)?
|
|
\s*$
|
|
@x) {
|
|
my ($name, $value, $options) = ($1,$2,$3);
|
|
|
|
if (!defined $flags && defined $value && $value =~ /<</) {
|
|
$seenbitshift = 1;
|
|
}
|
|
if (defined $options) {
|
|
my %options = parse_options($options);
|
|
if (!defined $options{skip}) {
|
|
push @entries, [ $name, $options{nick} ];
|
|
}
|
|
} else {
|
|
push @entries, [ $name ];
|
|
}
|
|
} else {
|
|
print STDERR "Can't understand: $_\n";
|
|
}
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
|
|
my $gen_arrays = 0;
|
|
my $gen_defs = 0;
|
|
|
|
# Parse arguments
|
|
|
|
if (@ARGV) {
|
|
if ($ARGV[0] eq "arrays") {
|
|
shift @ARGV;
|
|
$gen_arrays = 1;
|
|
} elsif ($ARGV[0] eq "defs") {
|
|
shift @ARGV;
|
|
$gen_defs = 1;
|
|
} else {
|
|
$gen_defs = 1;
|
|
}
|
|
|
|
}
|
|
|
|
if ($gen_defs) {
|
|
print ";; generated by makeenums.pl ; -*- scheme -*-\n\n";
|
|
} else {
|
|
print "/* Generated by makeenums.pl */\n\n";
|
|
}
|
|
|
|
ENUMERATION:
|
|
while (<>) {
|
|
if (eof) {
|
|
close (ARGV); # reset line numbering
|
|
$firstenum = 1; # Flag to print filename at next enum
|
|
}
|
|
|
|
if (m@^\s*typedef\s+enum\s*
|
|
({)?\s*
|
|
(?:/\*<
|
|
(([^*]|\*(?!/))*)
|
|
>\*/)?
|
|
@x) {
|
|
if (defined $2) {
|
|
my %options = parse_options($2);
|
|
$prefix = $options{prefix};
|
|
$flags = $options{flags};
|
|
} else {
|
|
$prefix = undef;
|
|
$flags = undef;
|
|
}
|
|
# Didn't have trailing '{' look on next lines
|
|
if (!defined $1) {
|
|
while (<>) {
|
|
if (s/^\s*\{//) {
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
|
|
$seenbitshift = 0;
|
|
@entries = ();
|
|
|
|
# Now parse the entries
|
|
parse_entries (\*ARGV);
|
|
|
|
# figure out if this was a flags or enums enumeration
|
|
|
|
if (!defined $flags) {
|
|
$flags = $seenbitshift;
|
|
}
|
|
|
|
# Autogenerate a prefix
|
|
|
|
if (!defined $prefix) {
|
|
for (@entries) {
|
|
my $name = $_->[0];
|
|
if (defined $prefix) {
|
|
my $tmp = ~ ($name ^ $prefix);
|
|
($tmp) = $tmp =~ /(^\xff*)/;
|
|
$prefix = $prefix & $tmp;
|
|
} else {
|
|
$prefix = $name;
|
|
}
|
|
}
|
|
# Trim so that it ends in an underscore
|
|
$prefix =~ s/_[^_]*$/_/;
|
|
}
|
|
|
|
for $entry (@entries) {
|
|
my ($name,$nick) = @{$entry};
|
|
if (!defined $nick) {
|
|
($nick = $name) =~ s/^$prefix//;
|
|
$nick =~ tr/_/-/;
|
|
$nick = lc($nick);
|
|
@{$entry} = ($name, $nick);
|
|
}
|
|
}
|
|
|
|
# Spit out the output
|
|
|
|
if ($gen_defs) {
|
|
if ($firstenum) {
|
|
print qq(\n; enumerations from "$ARGV"\n);
|
|
$firstenum = 0;
|
|
}
|
|
|
|
print "\n(define-".($flags ? "flags" : "enum")." $enumname";
|
|
|
|
for (@entries) {
|
|
my ($name,$nick) = @{$_};
|
|
print "\n ($nick $name)";
|
|
}
|
|
print ")\n";
|
|
|
|
} else {
|
|
($valuename = $enumname) =~ s/([A-Z][a-z])/_$1/g;
|
|
$valuename =~ s/([a-z])([A-Z])/$1_$2/g;
|
|
$valuename = lc($valuename);
|
|
|
|
print "static const GEnumValue $ {valuename}_values[] = {\n";
|
|
for (@entries) {
|
|
my ($name,$nick) = @{$_};
|
|
print qq( { $name, "$name", "$nick" },\n);
|
|
}
|
|
print " { 0, NULL, NULL }\n";
|
|
print "};\n";
|
|
}
|
|
}
|
|
}
|