498 lines
13 KiB
Perl
498 lines
13 KiB
Perl
package Function;
|
|
|
|
use strict;
|
|
use warnings;
|
|
use Util;
|
|
use FunctionBase;
|
|
|
|
# These flags indicate whether parameters are optional or output parameters.
|
|
use constant FLAG_PARAM_OPTIONAL => 1;
|
|
use constant FLAG_PARAM_OUTPUT => 2;
|
|
# These flags indicate how an empty string shall be translated to a C string:
|
|
# to a nullptr or to a pointer to an empty string.
|
|
use constant FLAG_PARAM_NULLPTR => 4;
|
|
use constant FLAG_PARAM_EMPTY_STRING => 8;
|
|
|
|
BEGIN {
|
|
use Exporter ();
|
|
our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
|
|
|
|
# set the version for version checking
|
|
$VERSION = 1.00;
|
|
@ISA = qw(FunctionBase);
|
|
@EXPORT = qw(&func1 &func2 &func4);
|
|
%EXPORT_TAGS = ( );
|
|
# your exported package globals go here,
|
|
# as well as any optionally exported functions
|
|
@EXPORT_OK = qw($Var1 %Hashit &func3 FLAG_PARAM_OPTIONAL FLAG_PARAM_OUTPUT
|
|
FLAG_PARAM_NULLPTR FLAG_PARAM_EMPTY_STRING);
|
|
}
|
|
our @EXPORT_OK;
|
|
|
|
##################################################
|
|
### Function
|
|
# Commonly used algorithm for parsing a function declaration into
|
|
# its component pieces
|
|
#
|
|
# class Function : FunctionBase
|
|
# {
|
|
# string rettype;
|
|
# bool const;
|
|
# bool static;
|
|
# string name; e.g. gtk_accelerator_valid
|
|
# string c_name;
|
|
# string array param_type;
|
|
# string array param_name;
|
|
# string array param_default_value;
|
|
# int array param_flags; (stores flags form params: 1 => optional, 2 => output)
|
|
# hash param_mappings; (maps C param names (if specified) to the C++ index)
|
|
# string array possible_args_list; (a list of space separated indexes)
|
|
# string in_module; e.g. Gtk
|
|
# string signal_when. e.g. first, last, or both.
|
|
# string class e.g. GtkButton ( == of-object. Useful for signal because their names are not unique.
|
|
# string entity_type. e.g. method or signal
|
|
# }
|
|
|
|
# Subroutine to get an array of string of indices representing the possible
|
|
# combination of arguments based on whether some parameters are optional.
|
|
sub possible_args_list($$);
|
|
|
|
sub new_empty()
|
|
{
|
|
my $self = {};
|
|
bless $self;
|
|
|
|
return $self;
|
|
}
|
|
|
|
# $objFunction new($function_declaration, $objWrapParser)
|
|
sub new($$)
|
|
{
|
|
#Parse a function/method declaration.
|
|
#e.g. guint gtk_something_set_thing(guint a, const gchar* something)
|
|
|
|
my ($line, $objWrapParser) = @_;
|
|
|
|
my $self = {};
|
|
bless $self;
|
|
|
|
#Initialize member data:
|
|
$$self{rettype} = "";
|
|
$$self{rettype_needs_ref} = 0; #Often the gtk function doesn't do an extra ref for the receiver.
|
|
$$self{const} = 0;
|
|
$$self{name} = "";
|
|
$$self{param_types} = [];
|
|
$$self{param_names} = [];
|
|
$$self{param_default_values} = [];
|
|
$$self{param_flags} = [];
|
|
$$self{param_mappings} = {};
|
|
$$self{possible_args_list} = [];
|
|
$$self{in_module} = "";
|
|
$$self{class} = "";
|
|
$$self{entity_type} = "method";
|
|
|
|
$line =~ s/^\s+//; # Remove leading whitespace.
|
|
$line =~ s/\s+/ /g; # Compress white space.
|
|
|
|
if ($line =~ /^static\s+([^()]+)\s+(\S+)\s*\((.*)\)\s*$/)
|
|
{
|
|
$$self{rettype} = $1;
|
|
$$self{name} = $2;
|
|
$$self{c_name} = $2;
|
|
$self->parse_param($3);
|
|
$$self{static} = 1;
|
|
}
|
|
elsif ($line =~ /^([^()]+)\s+(\S+)\s*\((.*)\)\s*(const)*$/)
|
|
{
|
|
$$self{rettype} = $1;
|
|
$$self{name} = $2;
|
|
$$self{c_name} = $2;
|
|
$self->parse_param($3);
|
|
$$self{const} = defined($4);
|
|
}
|
|
else
|
|
{
|
|
$objWrapParser->error("fail to parse $line\n");
|
|
}
|
|
|
|
# Store the list of possible argument combinations based on if arguments
|
|
# are optional.
|
|
my $possible_args_list = $$self{possible_args_list};
|
|
push(@$possible_args_list, $self->possible_args_list());
|
|
|
|
return $self;
|
|
}
|
|
|
|
|
|
# $objFunction new_ctor($function_declaration, $objWrapParser)
|
|
# Like new(), but the function_declaration doesn't need a return type.
|
|
sub new_ctor($$)
|
|
{
|
|
#Parse a function/method declaration.
|
|
#e.g. guint gtk_something_set_thing(guint a, const gchar* something)
|
|
|
|
my ($line, $objWrapParser) = @_;
|
|
|
|
my $self = {};
|
|
bless $self;
|
|
|
|
#Initialize member data:
|
|
$$self{rettype} = "";
|
|
$$self{rettype_needs_ref} = 0;
|
|
$$self{const} = 0;
|
|
$$self{name} = "";
|
|
$$self{param_types} = [];
|
|
$$self{param_names} = [];
|
|
$$self{param_default_values} = [];
|
|
$$self{param_flags} = [];
|
|
$$self{param_mappings} = {};
|
|
$$self{possible_args_list} = [];
|
|
$$self{in_module} = "";
|
|
$$self{class} = "";
|
|
$$self{entity_type} = "method";
|
|
|
|
$line =~ s/^\s+//; # Remove leading whitespace.
|
|
$line =~ s/\s+/ /g; # Compress white space.
|
|
|
|
if ($line =~ /^(\S+)\s*\((.*)\)\s*/)
|
|
{
|
|
$$self{name} = $1;
|
|
$$self{c_name} = $1;
|
|
$self->parse_param($2);
|
|
}
|
|
else
|
|
{
|
|
$objWrapParser->error("fail to parse $line\n");
|
|
}
|
|
|
|
# Store the list of possible argument combinations based on if arguments
|
|
# are optional.
|
|
my $possible_args_list = $$self{possible_args_list};
|
|
push(@$possible_args_list, $self->possible_args_list());
|
|
|
|
return $self;
|
|
}
|
|
|
|
# $num num_args()
|
|
sub num_args #($)
|
|
{
|
|
my ($self) = @_;
|
|
my $param_types = $$self{param_types};
|
|
return $#$param_types+1;
|
|
}
|
|
|
|
# parses C++ parameter lists.
|
|
# forms a list of types, names, and default values
|
|
sub parse_param($$)
|
|
{
|
|
my ($self, $line) = @_;
|
|
|
|
my $type = "";
|
|
my $name = "";
|
|
my $name_pos = -1;
|
|
my $value = "";
|
|
my $id = 0;
|
|
my $has_value = 0;
|
|
my $flags = 0;
|
|
my $curr_param = 0;
|
|
|
|
my $param_types = $$self{param_types};
|
|
my $param_names = $$self{param_names};
|
|
my $param_default_values = $$self{param_default_values};
|
|
my $param_flags = $$self{param_flags};
|
|
my $param_mappings = $$self{param_mappings};
|
|
|
|
# Mappings from a C name to this C++ param defaults to empty (no mapping).
|
|
my $mapping = "";
|
|
|
|
# clean up space and handle empty case
|
|
$line = string_trim($line);
|
|
$line =~ s/\s+/ /g; # Compress whitespace.
|
|
return if ($line =~ /^$/);
|
|
|
|
# Add a ',' at the end. No special treatment of the last parameter is necessary,
|
|
# if it's followed by a comma, like the other parameters.
|
|
$line .= ',' if (substr($line, -1) ne ',');
|
|
|
|
# Parse through the argument list.
|
|
#
|
|
# We must find commas (,) that separate parameters, and equal signs (=) that
|
|
# separate parameter names from optional default values.
|
|
# '&', '*' and '>' are delimiters in split() because they must be separated
|
|
# from the parameter name even if there is no space char between.
|
|
# Commas within "<.,.>" or "{.,.}" or "(.,.)" do not end a parameter.
|
|
# This parsing is not guaranteed to work well if there are several levels
|
|
# of (()) or {{}}. X<Y<Z>> works in the normal case where there is nothing
|
|
# but possibly spaces between the multiple ">>".
|
|
# Quoted strings are not detected. If a quoted string exists in a function
|
|
# prototype, it's probably as part of a default value, inside ("x") or {"y"}.
|
|
#
|
|
my @str = ();
|
|
foreach (split(/(\bconst\b|[,=&*>]|<.*?>|{.*?}|\(.*?\)|\s+)/, $line))
|
|
{
|
|
next if ( !defined($_) or $_ eq "" );
|
|
|
|
if ($_ =~ /^(?:const|[*&>]|<.*>|\(.*\)|\s+)$/)
|
|
{
|
|
# Any separator, except ',' or '=' or {.*}.
|
|
push(@str, $_);
|
|
next;
|
|
}
|
|
elsif ($_ =~ /^{(.*)}$/)
|
|
{
|
|
if (!$has_value)
|
|
{
|
|
# gmmproc options have been specified for the current parameter so
|
|
# process them.
|
|
|
|
# Get the options.
|
|
my $options = $1;
|
|
|
|
# Check if param should be optional or an output param.
|
|
$flags = FLAG_PARAM_OPTIONAL if($options =~ /\?/);
|
|
$flags |= FLAG_PARAM_OUTPUT if($options =~ />>/);
|
|
|
|
# Delete "NULL" from $options, so it won't be interpreted as a parameter name.
|
|
if ($options =~ s/(!?\bNULL\b)//)
|
|
{
|
|
$flags |= ($1 eq "!NULL") ? FLAG_PARAM_EMPTY_STRING : FLAG_PARAM_NULLPTR;
|
|
}
|
|
|
|
# Check if it should be mapped to a C param.
|
|
if ($options =~ /(\w+|\.)/)
|
|
{
|
|
$mapping = $1;
|
|
$mapping = $name if($mapping eq ".");
|
|
}
|
|
}
|
|
else
|
|
{
|
|
# {...} in a default value.
|
|
push(@str, $_);
|
|
}
|
|
next;
|
|
}
|
|
elsif ( $_ eq "=" ) #Default value
|
|
{
|
|
$str[$name_pos] = "" if ($name_pos >= 0);
|
|
# The type is everything before the = character, except the parameter name.
|
|
$type = join("", @str);
|
|
@str = (); #Wipe it so that it will only contain the default value, which comes next.
|
|
$has_value = 1;
|
|
next;
|
|
}
|
|
elsif ( $_ eq "," ) #The end of one parameter:
|
|
{
|
|
if ($has_value)
|
|
{
|
|
$value = join("", @str); # If there's a default value, then it's the part before the next ",".
|
|
}
|
|
else
|
|
{
|
|
$str[$name_pos] = "" if ($name_pos >= 0);
|
|
$type = join("", @str);
|
|
}
|
|
|
|
if ($name eq "")
|
|
{
|
|
$name = sprintf("p%s", $#$param_types + 2)
|
|
}
|
|
|
|
$type = string_trim($type);
|
|
|
|
push(@$param_types, $type);
|
|
push(@$param_names, $name);
|
|
push(@$param_default_values, $value);
|
|
push(@$param_flags, $flags);
|
|
|
|
# Map from the c_name to the C++ index (no map if no name given).
|
|
$$param_mappings{$mapping} = $curr_param if($mapping);
|
|
|
|
#Clear variables, ready for the next parameter.
|
|
@str = ();
|
|
$type= "";
|
|
$value = "";
|
|
$has_value = 0;
|
|
$name = "";
|
|
$name_pos = -1;
|
|
$flags = 0;
|
|
$curr_param++;
|
|
|
|
# Mappings from a C name to this C++ param defaults to empty (no mapping).
|
|
$mapping = "";
|
|
|
|
$id = 0;
|
|
next;
|
|
}
|
|
|
|
# Anything but a separator in split().
|
|
push(@str, $_);
|
|
|
|
if (!$has_value)
|
|
{
|
|
# The last identifier before ',', '=', or '{.*}' is the parameter name.
|
|
# E.g. int name, unsigned long int name = 42, const unsigned int& name.
|
|
# The name must be preceded by at least one other identifier (the type).
|
|
# 'const' is treated specially, as it can't by itself denote the type.
|
|
$id++;
|
|
if ($id >= 2)
|
|
{
|
|
$name = $_;
|
|
$name_pos = $#str;
|
|
}
|
|
}
|
|
} # end foreach
|
|
}
|
|
|
|
# add_parameter_autoname($, $type, $name)
|
|
# Adds e.g "sometype somename"
|
|
sub add_parameter_autoname($$)
|
|
{
|
|
my ($self, $type) = @_;
|
|
|
|
add_parameter($self, $type, "");
|
|
}
|
|
|
|
# add_parameter($, $type, $name)
|
|
# Adds e.g GtkSomething* p1"
|
|
sub add_parameter($$$)
|
|
{
|
|
my ($self, $type, $name) = @_;
|
|
$type = string_unquote($type);
|
|
$type =~ s/-/ /g;
|
|
|
|
my $param_names = $$self{param_names};
|
|
|
|
if ($name eq "")
|
|
{
|
|
$name = sprintf("p%s", $#$param_names + 2);
|
|
}
|
|
|
|
push(@$param_names, $name);
|
|
|
|
my $param_types = $$self{param_types};
|
|
push(@$param_types, $type);
|
|
|
|
return $self;
|
|
}
|
|
|
|
# $string get_refdoc_comment($existing_signal_docs, $signal_flags)
|
|
# Generate a readable prototype for signals and merge the prototype into the
|
|
# existing Doxygen comment block.
|
|
sub get_refdoc_comment($$$)
|
|
{
|
|
my ($self, $documentation, $signal_flags) = @_;
|
|
|
|
my $str = " /**\n";
|
|
|
|
$str .= " * \@par Slot Prototype:\n";
|
|
$str .= " * <tt>$$self{rettype} on_my_\%$$self{name}(";
|
|
|
|
my $param_names = $$self{param_names};
|
|
my $param_types = $$self{param_types};
|
|
my $num_params = scalar(@$param_types);
|
|
|
|
# List the parameters:
|
|
for(my $i = 0; $i < $num_params; ++$i)
|
|
{
|
|
$str .= $$param_types[$i] . ' ' . $$param_names[$i];
|
|
$str .= ", " if($i < $num_params - 1);
|
|
}
|
|
|
|
$str .= ")</tt>\n";
|
|
$str .= " *\n";
|
|
|
|
if ($signal_flags)
|
|
{
|
|
$str .= " * Flags: $signal_flags\n *\n";
|
|
}
|
|
|
|
if($documentation ne "")
|
|
{
|
|
# Remove the initial '/** ' from the existing docs and merge it.
|
|
$documentation =~ s/\/\*\*\s+/ \* /;
|
|
$str .= $documentation;
|
|
}
|
|
else
|
|
{
|
|
# Close the doc block if there's no existing docs.
|
|
$str .= " */\n";
|
|
}
|
|
|
|
# Return the merged documentation.
|
|
return $str;
|
|
}
|
|
|
|
sub get_is_const($)
|
|
{
|
|
my ($self) = @_;
|
|
|
|
return $$self{const};
|
|
}
|
|
|
|
# string array possible_args_list()
|
|
# Returns an array of string of space separated indexes representing the
|
|
# possible argument combinations based on whether parameters are optional.
|
|
sub possible_args_list($$)
|
|
{
|
|
my ($self, $start_index) = @_;
|
|
|
|
my $param_names = $$self{param_names};
|
|
my $param_types = $$self{param_types};
|
|
my $param_flags = $$self{param_flags};
|
|
|
|
my @result = ();
|
|
|
|
# Default starting index is 0 (The first call will have an undefined start
|
|
# index).
|
|
my $i = $start_index || 0;
|
|
|
|
if($i > $#$param_types)
|
|
{
|
|
# If index is past last arg, return an empty array inserting an empty
|
|
# string if this function has no parameters.
|
|
push(@result, "") if ($i == 0);
|
|
return @result;
|
|
}
|
|
elsif($i == $#$param_types)
|
|
{
|
|
# If it's the last arg just add its index:
|
|
push(@result, "$i");
|
|
# And if it's optional also add an empty string to represent that it is
|
|
# not added.
|
|
push(@result, "") if ($$param_flags[$i] & FLAG_PARAM_OPTIONAL);
|
|
return @result;
|
|
}
|
|
|
|
# Get the possible indices for remaining params without this one.
|
|
my @remaining = possible_args_list($self, $i + 1);
|
|
|
|
# Prepend this param's index to the remaining ones.
|
|
foreach my $possibility (@remaining)
|
|
{
|
|
if($possibility)
|
|
{
|
|
push(@result, "$i " . $possibility);
|
|
}
|
|
else
|
|
{
|
|
push(@result, "$i");
|
|
}
|
|
}
|
|
|
|
# If this parameter is optional, append the remaining possibilities without
|
|
# this param's type and name.
|
|
if($$param_flags[$i] & FLAG_PARAM_OPTIONAL)
|
|
{
|
|
foreach my $possibility (@remaining)
|
|
{
|
|
push(@result, $possibility);
|
|
}
|
|
}
|
|
|
|
return @result;
|
|
}
|
|
|
|
1; # indicate proper module load.
|
|
|