init
This commit is contained in:
327
squashfs-root/usr/lib/glibmm-2.4/proc/pm/Enum.pm
Normal file
327
squashfs-root/usr/lib/glibmm-2.4/proc/pm/Enum.pm
Normal file
@@ -0,0 +1,327 @@
|
||||
package Enum;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use DocsParser;
|
||||
|
||||
BEGIN {
|
||||
use Exporter ();
|
||||
our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
|
||||
|
||||
# set the version for version checking
|
||||
$VERSION = 1.00;
|
||||
@ISA = qw(Exporter);
|
||||
@EXPORT = ( );
|
||||
%EXPORT_TAGS = ( );
|
||||
# your exported package globals go here,
|
||||
# as well as any optionally exported functions
|
||||
@EXPORT_OK = ( );
|
||||
}
|
||||
our @EXPORT_OK;
|
||||
|
||||
# class Enum
|
||||
# {
|
||||
# bool flags;
|
||||
# string type;
|
||||
# string module;
|
||||
# string c_type;
|
||||
#
|
||||
# string array elem_names;
|
||||
# string array elem_values;
|
||||
# string c_prefix;
|
||||
#
|
||||
# bool mark;
|
||||
# }
|
||||
|
||||
#
|
||||
# private functions:
|
||||
#
|
||||
|
||||
sub split_enum_tokens($)
|
||||
{
|
||||
my ($token_string) = @_;
|
||||
my @tokens = ();
|
||||
# index of first opening double quotes between parens - beginning of a new
|
||||
# token.
|
||||
my $begin_token = 0;
|
||||
# index of last closing double quotes between parens - end of a token.
|
||||
my $end_token = 0;
|
||||
# whether we are inside double quotes.
|
||||
my $inside_dquotes = 0;
|
||||
# whether we are inside double and then single quotes (for situations like
|
||||
# "'"'").
|
||||
my $inside_squotes = 0;
|
||||
my $len = length($token_string);
|
||||
# whether we found opening paren and we are expecting an opening double
|
||||
# quotes.
|
||||
my $near_begin = 0;
|
||||
# count of double quotes pairs between parens.
|
||||
my $dq_count = 0;
|
||||
# whether previous char was a backslash - important only when being between
|
||||
# double quotes.
|
||||
my $backslash = 0;
|
||||
for (my $index = 0; $index < $len; $index++)
|
||||
{
|
||||
my $char = substr($token_string, $index, 1);
|
||||
if ($inside_dquotes)
|
||||
{
|
||||
# if prevous char was backslash, then current char is not important -
|
||||
# we are still inside double or double/single quotes anyway.
|
||||
if ($backslash)
|
||||
{
|
||||
$backslash = 0;
|
||||
}
|
||||
# if current char is backslash.
|
||||
elsif ($char eq '\\')
|
||||
{
|
||||
$backslash = 1;
|
||||
}
|
||||
# if current char is unescaped double quotes and we are not inside single
|
||||
# ones - means, we are going outside string. We mark this place as an end
|
||||
# of the token in case we find a closing paren after this.
|
||||
elsif ($char eq '"' and not $inside_squotes)
|
||||
{
|
||||
$inside_dquotes = 0;
|
||||
$end_token = $index;
|
||||
}
|
||||
# if current char is single quote then switch being inside single quotes
|
||||
# state.
|
||||
elsif ($char eq '\'')
|
||||
{
|
||||
$inside_squotes = not $inside_squotes;
|
||||
}
|
||||
}
|
||||
# current char is opening paren - this means we are near the beginning of
|
||||
# a token (first double quotes after this paren).
|
||||
elsif ($char eq '(')
|
||||
{
|
||||
$near_begin = 1;
|
||||
}
|
||||
# current char is closing paren - this means we reached end of a token at
|
||||
# last closing double quotes.
|
||||
elsif ($char eq ')')
|
||||
{
|
||||
my $token_len = $end_token + 1 - $begin_token;
|
||||
my $token = substr($token_string, $begin_token, $token_len);
|
||||
# there should be three pairs of double quotes.
|
||||
if ($dq_count == 3)
|
||||
{
|
||||
push(@tokens, $token);
|
||||
}
|
||||
else
|
||||
{
|
||||
print STDERR "Wrong value statement while parsing ($token)\n";
|
||||
}
|
||||
$dq_count = 0;
|
||||
}
|
||||
# current char is opening double quotes - this can be a beginning of
|
||||
# a token.
|
||||
elsif ($char eq '"')
|
||||
{
|
||||
if ($near_begin)
|
||||
{
|
||||
$begin_token = $index;
|
||||
$near_begin = 0;
|
||||
}
|
||||
$inside_dquotes = 1;
|
||||
$dq_count++;
|
||||
}
|
||||
}
|
||||
return @tokens;
|
||||
}
|
||||
|
||||
#
|
||||
# end of private functions.
|
||||
#
|
||||
|
||||
sub new
|
||||
{
|
||||
my ($def) = @_;
|
||||
my $self = {};
|
||||
bless $self;
|
||||
|
||||
$def =~ s/^\(//;
|
||||
$def =~ s/\)$//;
|
||||
|
||||
$$self{mark} = 0;
|
||||
$$self{flags} = 0;
|
||||
$$self{c_prefix} = "";
|
||||
|
||||
$$self{elem_names} = [];
|
||||
$$self{elem_values} = [];
|
||||
|
||||
# snarf down the fields
|
||||
|
||||
if($def =~ s/^define-(enum|flags)-extended (\S+)//)
|
||||
{
|
||||
$$self{type} = $2;
|
||||
$$self{flags} = 1 if($1 eq "flags");
|
||||
}
|
||||
|
||||
$$self{module} = $1 if($def =~ s/\(in-module "(\S+)"\)//);
|
||||
$$self{c_type} = $1 if($def =~ s/\(c-name "(\S+)"\)//);
|
||||
|
||||
# values are compound lisp statement
|
||||
if($def =~ s/\(values((?: '\("\S+" "\S+" "[^"]+"\))*) \)//)
|
||||
{
|
||||
$self->parse_values($1);
|
||||
}
|
||||
|
||||
if($def !~ /^\s*$/)
|
||||
{
|
||||
GtkDefs::error("Unhandled enum def ($def) in $$self{module}\::$$self{type}\n")
|
||||
}
|
||||
|
||||
# this should never happen
|
||||
warn if(scalar(@{$$self{elem_names}}) != scalar(@{$$self{elem_values}}));
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub parse_values($$)
|
||||
{
|
||||
my ($self, $value) = @_;
|
||||
|
||||
my $elem_names = [];
|
||||
my $elem_values = [];
|
||||
my $common_prefix = undef;
|
||||
# break up the value statements - it works with parens inside double quotes
|
||||
# and handles triples like '("dq-token", "MY_SCANNER_DQ_TOKEN", "'"'").
|
||||
foreach (split_enum_tokens($value))
|
||||
{
|
||||
if (/^"\S+" "(\S+)" "(.+)"$/)
|
||||
{
|
||||
my ($name, $value) = ($1, $2);
|
||||
|
||||
# detect whether there is module prefix common to all names, e.g. GTK_
|
||||
my $prefix = $1 if ($name =~ /^([^_]+_)/);
|
||||
|
||||
if (not defined($common_prefix))
|
||||
{
|
||||
$common_prefix = $prefix;
|
||||
}
|
||||
elsif ($prefix ne $common_prefix)
|
||||
{
|
||||
$common_prefix = "";
|
||||
}
|
||||
|
||||
push(@$elem_names, $name);
|
||||
push(@$elem_values, $value);
|
||||
}
|
||||
else
|
||||
{
|
||||
GtkDefs::error("Unknown value statement ($_) in $$self{c_type}\n");
|
||||
}
|
||||
}
|
||||
|
||||
if ($common_prefix)
|
||||
{
|
||||
# cut off the module prefix, e.g. GTK_
|
||||
s/^$common_prefix// foreach (@$elem_names);
|
||||
|
||||
# Save the common prefix.
|
||||
$$self{c_prefix} = $common_prefix;
|
||||
}
|
||||
|
||||
$$self{elem_names} = $elem_names;
|
||||
$$self{elem_values} = $elem_values;
|
||||
}
|
||||
|
||||
sub beautify_values($)
|
||||
{
|
||||
my ($self) = @_;
|
||||
|
||||
return if($$self{flags});
|
||||
|
||||
my $elem_names = $$self{elem_names};
|
||||
my $elem_values = $$self{elem_values};
|
||||
|
||||
my $num_elements = scalar(@$elem_values);
|
||||
return if($num_elements == 0);
|
||||
|
||||
my $first = $$elem_values[0];
|
||||
return if($first !~ /^-?[0-9]+$/);
|
||||
|
||||
my $prev = $first;
|
||||
|
||||
# Continuous? (Aliases to prior enum values are allowed.)
|
||||
foreach my $value (@$elem_values)
|
||||
{
|
||||
return if ($value =~ /[G-WY-Zg-wy-z_]/);
|
||||
return if(($value < $first) || ($value > $prev + 1));
|
||||
$prev = $value;
|
||||
}
|
||||
|
||||
# This point is reached only if the values are a continuous range.
|
||||
# 1) Let's kill all the superfluous values, for better readability.
|
||||
# 2) Substitute aliases to prior enum values.
|
||||
|
||||
my %aliases = ();
|
||||
|
||||
for(my $i = 0; $i < $num_elements; ++$i)
|
||||
{
|
||||
my $value = \$$elem_values[$i];
|
||||
my $alias = \$aliases{$$value};
|
||||
|
||||
if(defined($$alias))
|
||||
{
|
||||
$$value = $$alias;
|
||||
}
|
||||
else
|
||||
{
|
||||
$$alias = $$elem_names[$i];
|
||||
$$value = "" unless($first != 0 && $$value == $first);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub build_element_list($$$$)
|
||||
{
|
||||
my ($self, $ref_subst_in, $ref_subst_out, $indent) = @_;
|
||||
|
||||
my $elem_names = $$self{elem_names};
|
||||
my $elem_values = $$self{elem_values};
|
||||
|
||||
my $num_elements = scalar(@$elem_names);
|
||||
my $elements = "";
|
||||
|
||||
for(my $i = 0; $i < $num_elements; ++$i)
|
||||
{
|
||||
my $name = $$elem_names[$i];
|
||||
my $value = $$elem_values[$i];
|
||||
|
||||
for(my $ii = 0; $ii < scalar(@$ref_subst_in); ++$ii)
|
||||
{
|
||||
$name =~ s/$$ref_subst_in[$ii]/$$ref_subst_out[$ii]/;
|
||||
$value =~ s/$$ref_subst_in[$ii]/$$ref_subst_out[$ii]/;
|
||||
}
|
||||
|
||||
# Skip this element, if its name has been deleted.
|
||||
next if($name eq "");
|
||||
|
||||
$elements .= ",\n" if($elements ne "");
|
||||
$elements .= "${indent}${name}";
|
||||
$elements .= " = ${value}" if($value ne "");
|
||||
}
|
||||
|
||||
return $elements;
|
||||
}
|
||||
|
||||
sub dump($)
|
||||
{
|
||||
my ($self) = @_;
|
||||
|
||||
print "<enum module=\"$$self{module}\" type=\"$$self{type}\" flags=$$self{flags}>\n";
|
||||
|
||||
my $elem_names = $$self{elem_names};
|
||||
my $elem_values = $$self{elem_values};
|
||||
|
||||
for(my $i = 0; $i < scalar(@$elem_names); ++$i)
|
||||
{
|
||||
print " <element name=\"$$elem_names[$i]\" value=\"$$elem_values[$i]\"/>\n";
|
||||
}
|
||||
|
||||
print "</enum>\n\n";
|
||||
}
|
||||
|
||||
1; # indicate proper module load.
|
||||
Reference in New Issue
Block a user