# gtkmm - WrapParser module
#
# Copyright 2001 Free Software Foundation
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#
package WrapParser;
use strict;
use warnings;
use open IO => ":utf8";
use Util;
use GtkDefs;
use Function;
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;
############################################################################
my @tokens = ();
# $objWrapParser new($objOutputter)
sub new($)
{
my ($objOutputter) = @_;
my $self = {};
bless $self;
#Initialize member data:
$$self{objOutputter} = $objOutputter;
$$self{filename} = "(none)";
$$self{line_num} = 0;
$$self{level} = 0;
$$self{class} = "";
$$self{c_class} = "";
$$self{in_class} = 0;
$$self{first_namespace} = 1;
$$self{namespace} = [];
$$self{in_namespace} = [];
$$self{defsdir} = ".";
$$self{module} = ""; #e.g. "gtkmm"
$$self{type} = "GTKOBJECT"; # or "BOXEDTYPE", or "GOBJECT" - wrapped differently.
return $self;
}
# void parse_and_build_output()
sub parse_and_build_output($)
{
my ($self) = @_;
my $objOutputter = $$self{objOutputter};
# Parse the tokens.
my $token;
while ( scalar(@tokens) )
{
$token = $self->extract_token();
my $bAppend = 1;
# we need to monitor the depth of braces
if ($token eq '{') { $self->on_open_brace(); }
if ($token eq '}') { $self->on_close_brace(); $bAppend = 0;}
# protect `' from the source file from m4
if ($token eq "`") { $objOutputter->append("`'__BT__`'"); next; }
if ($token eq "'") { $objOutputter->append("`'__FT__`'"); next; }
if ($token eq '"') { $objOutputter->append($self->on_string_literal()); next; }
if ($token eq '//') { $objOutputter->append($self->on_comment_cpp()); next; }
if ($token eq '/*') { $objOutputter->append($self->on_comment_c()); next; }
if ($token eq '/**') { $self->on_comment_doxygen(); next; }
# handle #m4begin ... #m4end
if ($token eq "#m4begin") { $objOutputter->append($self->on_m4_section()); next;}
# handle #m4 ... \n
if ($token eq "#m4") { $objOutputter->append($self->on_m4_line()); next;}
if ($token eq "_DEFS") { $self->on_defs(); next;} #Read the defs file.
if ($token eq "_IGNORE") { $self->on_ignore(); next;} #Ignore a function.
if ($token eq "_IGNORE_SIGNAL") { $self->on_ignore_signal(); next;} #Ignore a signal.
if ($token eq "_IGNORE_PROPERTY") { $self->on_ignore_property(); next;} #Ignore a property.
if ($token eq "_IGNORE_CHILD_PROPERTY") { $self->on_ignore_child_property(); next;} #Ignore a child property.
if ($token eq "_WRAP_METHOD") { $self->on_wrap_method(); next;}
if ($token eq "_WRAP_METHOD_DOCS_ONLY") { $self->on_wrap_method_docs_only(); next;}
if ($token eq "_WRAP_CORBA_METHOD") { $self->on_wrap_corba_method(); next;} #Used in libbonobo*mm.
if ($token eq "_WRAP_SIGNAL") { $self->on_wrap_signal(); next;}
if ($token eq "_WRAP_PROPERTY") { $self->on_wrap_property(); next;}
if ($token eq "_WRAP_CHILD_PROPERTY") { $self->on_wrap_child_property(); next;}
if ($token eq "_WRAP_VFUNC") { $self->on_wrap_vfunc(); next;}
if ($token eq "_WRAP_CTOR") { $self->on_wrap_ctor(); next;}
if ($token eq "_WRAP_CREATE") { $self->on_wrap_create(); next;}
if ($token eq "_WRAP_ENUM") { $self->on_wrap_enum(); next;}
if ($token eq "_WRAP_ENUM_DOCS_ONLY") { $self->on_wrap_enum_docs_only(); next;}
if ($token eq "_WRAP_GERROR") { $self->on_wrap_gerror(); next;}
if ($token eq "_IMPLEMENTS_INTERFACE") { $self->on_implements_interface(); next;}
if ($token =~ m/\A_CLASS_/s)
{
$self->on_class($token);
next;
# e.g.:
# _CLASS_GENERIC
# _CLASS_GOBJECT
# _CLASS_GTKOBJECT
# _CLASS_BOXEDTYPE
# _CLASS_BOXEDTYPE_STATIC
# _CLASS_INTERFACE
# _CLASS_OPAQUE_COPYABLE
# _CLASS_OPAQUE_REFCOUNTED
}
if ($token eq "namespace") { $self->on_namespace(); }
if ($token eq "_IS_DEPRECATED") { $$self{deprecated} = 1; }
# After all token manipulations
if($bAppend)
{
$objOutputter->append($token);
}
}
}
sub error($$)
{
my ($self, $format) = @_;
$format = "$$self{filename}:$$self{line_num}: $format";
printf STDERR $format,@_;
}
######################################################################
##### 1.1 parser subroutines
########################################
### returns the next token, ignoring some stuff.
# $string extract_token()
sub extract_token($)
{
my ($self) = @_;
while ( scalar(@tokens) )
{
$_ = shift @tokens;
# skip empty tokens
next if ( !defined($_) or $_ eq "" );
# eat line statements
if (m/^#l (\S+)\n/)
{
$$self{line_num} = $1;
next;
}
# eat file statements
if (m/^#f (\S+)\n/)
{
$$self{filename} = $1;
next;
}
return $_;
}
return "";
}
### Returns the next token, but does not remove it from the queue, so that
# extract_token will return it again.
# $string peek_token()
sub peek_token($)
{
my ($self) = @_;
while ( scalar(@tokens) )
{
$_ = $tokens[0];
# skip empty tokens
if(!defined($_) or $_ eq "")
{
shift @tokens;
}
# eat line statements
elsif ( /^#l (\S+)\n/)
{
$$self{line_num} = $1;
shift @tokens;
}
# eat file statements
elsif ( /^#f (\S+)\n/)
{
$$self{filename} = $1;
shift @tokens;
}
else
{
return $_;
}
}
return "";
}
# bool tokens_remaining()
sub tokens_remaining($)
{
my ($self) = @_;
return $#tokens >= 0;
}
########################################
### we pass strings literally with quote substitution
# void on_string_literal()
sub on_string_literal($)
{
my ($self) = @_;
my @out;
push (@out, '"');
while ( scalar(@tokens) )
{
$_ = $self->extract_token();
if ($_ eq "`") { push(@out, "`'__BT__`'"); next; }
if ($_ eq "'") { push(@out, "`'__FT__`'"); next; }
push (@out, $_);
return join("",@out) if ($_ eq '"');
}
my $line_num = $$self{line_num};
my $filename = $$self{filename};
print STDERR "$filename:$line_num: Hit eof while in string\n";
}
########################################
### we pass comments literally with quote substitution
# void on_comment_cpp()
sub on_comment_cpp($)
{
my ($self) = @_;
my @out;
push (@out,"//\`");
while ( scalar(@tokens) )
{
$_ = $self->extract_token();
if ($_ eq "`") { push(@out,"\'__BT__\`"); next; }
if ($_ eq "'") { push(@out,"\'__FT__\`"); next; }
if ($_ eq "\n")
{
push (@out,"\'\n");
return join("",@out)
}
if ($_ =~ /^_[A-Z]+$/) {$_="_$_";} # wipe out potential macros
push (@out,$_);
}
}
########################################
### we pass C comments literally with quote substitution
# void on_comment_c()
sub on_comment_c($)
{
my ($self) = @_;
my @out;
push (@out,"/*\`");
while ( scalar(@tokens) )
{
$_ = $self->extract_token();
if ($_ eq "`") { push(@out,"\'__BT__\`"); next; }
if ($_ eq "'") { push(@out,"\'__FT__\`"); next; }
if ($_ eq "*/")
{
push (@out,"\'*/");
return join("",@out)
}
push (@out,$_);
}
}
sub on_comment_doxygen($)
{
my ($self) = @_;
my $objOutputter = $$self{objOutputter};
my @out;
push (@out,"/**\`");
while ( scalar(@tokens) )
{
$_ = $self->extract_token();
if ($_ eq "`") { push(@out,"\'__BT__\`"); next; }
if ($_ eq "'") { push(@out,"\'__FT__\`"); next; }
if ($_ eq "*/")
{
push (@out,"\'*/");
$objOutputter->append(join("", @out));
# Extract all following whitespace tokens.
my @whitespace;
my $next_token = $self->peek_token();
while ($next_token !~ /\S/)
{
push(@whitespace, $self->extract_token());
$next_token = $self->peek_token();
}
# Do not extract the following non-whitespace token so that
# parse_and_build_output() will process it.
# Append whitespace.
# extract_preceding_documentation() expects to find a preceding
# doxygen comment, if any, as two array elements, one with the whole
# comment, the following (possibly empty) with the following
# whitespace.
$objOutputter->append(join("", @whitespace));
last;
}
push (@out,$_);
}
}
########################################
### handle #m4begin ... #m4end
# we don't substitute ` or ' in #m4begin
# void on_m4_section()
sub on_m4_section($)
{
my ($self) = @_;
my @value;
my $token;
while ( scalar(@tokens) )
{
$token = $self->extract_token();
return join("", @value) if ($token eq "#m4end");
push(@value, $token);
}
my $line_num = $$self{line_num};
my $filename = $$self{filename};
print STDERR "$filename:$line_num: Hit eof looking for #m4end\n";
next;
}
########################################
### handle #m4 ... /n
# we don't substitute ` or ' in #m4
# void on_m4_line()
sub on_m4_line ($)
{
my ($self) = @_;
my @value;
my $token;
while ( scalar(@tokens) )
{
$token = $self->extract_token();
push(@value,$token); # push first, so we don't eat the newline
return join("",@value) if ($token eq "\n");
}
}
########################################
# m4 needs to know when we entered a namespace
# void on_namespace()
sub on_namespace($)
{
my ($self) = @_;
my $objOutputter = $$self{objOutputter};
my $number = 0;
my $token;
my $arg;
# we need to peek ahead to figure out what type of namespace
# declaration this is.
while ( $number <= $#tokens )
{
$token = $tokens[$number];
$number++;
next if (!defined($token) or $token eq "");
# print "> $token\n";
if ($token eq '{')
{
$arg = string_trim($arg);
if ($$self{first_namespace})
{
$objOutputter->append("_SECTION(SECTION_HEADER2)\n");
$$self{first_namespace} = 0;
}
$objOutputter->append("_NAMESPACE($arg)");
unshift(@{$$self{namespace}}, $arg);
unshift(@{$$self{in_namespace}}, $$self{level}+1);
return;
}
next if ( $token =~ /^#[lf] \S+\n/);
return if ($token eq ';');
$arg .= $token; #concatenate
}
}
########################################
### we don't want to report every petty function as unwrapped
# void on_ignore($)
sub on_ignore($)
{
my ($self) = @_;
my $objOutputter = $$self{objOutputter};
my $str = $self->extract_bracketed_text();
my @args = split(/\s+|,/,$str);
foreach (@args)
{
next if ($_ eq "");
my $objCfunc = GtkDefs::lookup_function($_); #Pretend that we've used it.
if(!$objCfunc)
{
$objOutputter->output_wrap_failed($_, "ignored method defs lookup failed");
}
}
}
# void on_ignore_signal_or_property(\&lookup_function, $type)
sub on_ignore_signal_or_property($$$)
{
my ($self, $lookup_function, $type) = @_;
my $str = $self->extract_bracketed_text();
my @args = split(/\s+|,/,$str);
foreach (@args)
{
my $name = string_unquote($_);
next if ($name eq "");
my $objCentity = $lookup_function->($$self{c_class}, $name); #Pretend that we've used it.
if (!$objCentity)
{
$$self{objOutputter}->output_wrap_failed($name, "ignored $type defs lookup failed");
}
}
}
sub on_ignore_signal($)
{
my ($self) = @_;
$self->on_ignore_signal_or_property(\&GtkDefs::lookup_signal, "signal");
}
sub on_ignore_property($)
{
my ($self) = @_;
$self->on_ignore_signal_or_property(\&GtkDefs::lookup_property, "property");
}
sub on_ignore_child_property($)
{
my ($self) = @_;
$self->on_ignore_signal_or_property(\&GtkDefs::lookup_child_property, "child property");
}
########################################
### we have certain macros we need to insert at end of statements
# void on_class($, $strClassCommand)
sub on_class($$)
{
my ($self, $class_command) = @_;
my $objOutputter = $$self{objOutputter};
$$self{in_class} = $$self{level};
#Remember the type of wrapper required, so that we can append the correct _END_CLASS_* macro later.
{
my $str = $class_command;
$str =~ s/^_CLASS_//;
$$self{type} = $str;
}
my $str = $self->extract_bracketed_text();
my ($class, $c_class) = split(',',$str);
$class = string_trim($class);
$c_class = string_trim($c_class);
$$self{class} = $class;
$$self{c_class} = $c_class;
my @back;
push(@back, $class_command);
push(@back, "($str)");
# When we hit _CLASS, we walk backwards through the output to find "class"
my $token;
while ( scalar(@{$$objOutputter{out}}))
{
$token = pop @{$$objOutputter{out}};
unshift(@back, $token);
if ($token eq "class")
{
$objOutputter->append("_CLASS_START()");
my $strBack = join("", @back);
$objOutputter->append($strBack);
return;
}
}
$self->error("$class_command outside of class.\n");
exit(-1);
}
# remove surround spaces from the string
sub trim($)
{
my $string = shift;
$string =~ s/^\s+//;
$string =~ s/\s+$//;
return $string;
}
# order to read the defs file
# void on_defs()
sub on_defs($)
{
my ($self) = @_;
my $str = $self->extract_bracketed_text();
my ($module, $defsfile) = split(/,/, $str); #e.g. _DEFS(gtkmm,gtk), where gtkmm is the module name, and gtk is the defs file name.
$module = trim($module);
$defsfile = trim($defsfile);
# $$self{section} = $section; #Save it so that we can reuse it in read_defs_included.
$$self{module} = $module; #Use it later in call to output_temp_g1().
GtkDefs::read_defs("$$self{defsdir}", "$defsfile.defs");
#Read the documentation too, so that we can merge it into the generated C++ code:
my $docs_filename = $defsfile . "_docs.xml";
my $docs_filename_override = $defsfile . "_docs_override.xml";
DocsParser::read_defs("$$self{defsdir}", $docs_filename, $docs_filename_override);
}
# void on_open_brace()
sub on_open_brace($)
{
my ($self) = @_;
$$self{level}++;
}
# void on_close_brace($)
sub on_close_brace($)
{
my ($self) = @_;
my $objOutputter = $$self{objOutputter};
#push(@out, "($$self{level})");
$self->on_end_class()
if ($$self{in_class} && $$self{in_class} == $$self{level});
$objOutputter->append("}"); #We append it here instead of after we return, so that we can end the namespace after it.
$self->on_end_namespace()
if ( scalar(@{$$self{in_namespace}}) && (@{$$self{in_namespace}}[0] == $$self{level}) );
$$self{level}--;
}
########################################
### denote the end of a class
# void on_end_class($)
sub on_end_class($)
{
my ($self) = @_;
my $objOutputter = $$self{objOutputter};
# Examine $$self{type}, which was set in on_class()
# And append the _END_CLASS_* macro, which will, in turn, output the m4 code.
{
my $str = $$self{type};
$objOutputter->append("`'_END_CLASS_$str()\n");
}
$$self{class} = "";
$$self{c_class} = "";
$$self{in_class} = 0;
}
########################################
###
# void on_end_namespace($)
sub on_end_namespace($)
{
my ($self) = @_;
my $objOutputter = $$self{objOutputter};
$objOutputter->append("`'_END_NAMESPACE()");
shift( @{$$self{namespace}} );
shift( @{$$self{in_namespace}} );
}
######################################################################
##### some utility subroutines
########################################
### takes (\S+) from the tokens (smart)
# $string extract_bracketed_text()
sub extract_bracketed_text($)
{
my ($self) = @_;
my $level = 1;
my $in_quotes = 0;
my $str = "";
# Move to the first "(":
while ( scalar(@tokens) )
{
my $t = $self->extract_token();
last if ($t eq "(");
}
# TODO: Don't count "(" and ")" within double quotes.
# There may be .hg files with unpaired quotes that generate correct
# .h and .cc files. Don't want to break such code yet.
# See also TODO in string_split_commas().
# Concatenate until the corresponding ")":
while ( scalar(@tokens) )
{
my $t = $self->extract_token();
$in_quotes = !$in_quotes if ($t eq '"');
$level++ if ($t eq "(");
$level-- if ($t eq ")");
if (!$level)
{
$self->error("End of gmmproc directive within a quoted string.\n") if $in_quotes;
return $str;
}
$str .= $t;
}
return "";
}
########################################
### breaks up a string by commas (smart)
# @strings string_split_commas($string [, $ignore_quotes])
sub string_split_commas($;$)
{
my ($in, $ignore_quotes) = @_;
$ignore_quotes = 2 unless defined $ignore_quotes;
my @out;
my $level = 0;
my $in_quotes = 0;
my $str = "";
my @in = split(/([,"()<>{}])/, $in);
while (scalar(@in))
{
my $t = shift @in;
next if ($t eq "");
# TODO: Delete the test for scalar(@out) >= $ignore_quotes when we can stop accepting
# .hg files with unpaired quotes, such as _WRAP_PROPERTY("text_column, int).
# See also TODO in extract_bracketed_text().
$in_quotes = !$in_quotes if ($t eq '"' and scalar(@out) >= $ignore_quotes);
if (!$in_quotes)
{
$level++ if ($t eq "(" or $t eq "<" or $t eq "{");
# In the case of a '>' decrease the level if it is not in a {...} without
# a preceding '<', because then it is most likely indicating that
# a parameter in a method declaration is an output parameter (name{>>}).
$level-- if ($t eq ")" or $t eq "}" or ($t eq ">" && $str !~ /{[^<}]*$/));
# Don't split at comma, if inside a function, e.g. void f1(int x, int y)
# or std::map<Glib::ustring, float> f2(),
# or inside a quoted string, e.g. deprecated "Use f1(), f2() or f3() instead.".
if ($t eq "," && !$level)
{
push(@out, $str);
$str = "";
next;
}
}
$str .= $t;
}
push(@out, $str);
return @out;
}
########################################
### reads in the preprocessor files
# we insert line and file directives for later stages
# void read_file()
sub read_file($$$)
{
my ($self, $srcdir, $source) = @_;
my $lineno = 1;
my @in = ();
if ( ! -r "${srcdir}/${source}.hg")
{
print "Unable to find header file $srcdir/$source.hg\n";
exit(1);
}
# Read header file:
open(FILE, "${srcdir}/${source}.hg");
push(@in, "#f ${source}.hg\n");
while (<FILE>)
{
push(@in, "#l $lineno\n");
push(@in, $_);
++$lineno;
}
close(FILE);
push(@in, "\n", "_SECTION(SECTION_SRC_CUSTOM)\n");
# Source file is optional.
if ( -r "${srcdir}/${source}.ccg")
{
open(FILE, "${srcdir}/${source}.ccg");
$lineno = 1;
push(@in, "#f ${source}.ccg\n");
while (<FILE>)
{
push(@in, "#l $lineno\n");
push(@in, $_);
++$lineno;
}
close(FILE);
}
my $strIn = join("", @in);
# Break the file into tokens. Token is
# any group of #, A to z, 0 to 9, _
# /**
# /*
# *.
# //
# any char proceeded by \
# symbols ;{}"`'()<>
# newline
@tokens = split(/(\#[lf] \S+\n)|([#A-Za-z0-9_]+)|(\/\*\*)|(\/\*)|(\*\/)|(\/\/)|(\\.)|([;{}"'`()<>])|(\n)/,
$strIn);
}
sub class_prefix($)
{
my ($self) = @_;
my $str = $$self{class};
$str =~ s/([a-z])([A-Z])/$1_$2/g;
$str =~ tr/A-Z/a-z/;
return $str;
}
######################################################################
##### 2.1 subroutines for _WRAP
########################################
# $bool check_for_eof()
sub check_for_eof($)
{
my ($self) = @_;
my $filename = $$self{filename};
my $line_num = $$self{line_num};
unless (scalar(@tokens))
{
print STDERR "$filename:$line_num:hit eof in _WRAP\n";
return 0; #EOF
}
return 1; # No EOF
}
# Look back for a Doxygen comment. If there is one,
# remove it from the output and return it as a string.
sub extract_preceding_documentation ($)
{
my ($self) = @_;
my $outputter = $$self{objOutputter};
my $out = \@{$$outputter{out}};
my $comment = '';
if ($#$out >= 1)
{
# steal the last two tokens
my @back = splice(@$out, -2);
local $_ = join('', @back);
# Check for /*[*!] ... */ or //[/!] comments. The closing */ _must_
# be the last token of the previous line. Apart from this restriction,
# anything else should work, including multi-line comments.
if (m#\A/\s*\*(?:\*`|`!)(.+)'\*/\s*\z#s or m#\A\s*//`[/!](.+)'\s*\z#s)
{
$comment = '`' . $1;
$comment =~ s/\s*$/'/;
}
else
{
# restore stolen tokens
push(@$out, @back);
}
}
return $comment;
}
# void on_wrap_method()
sub on_wrap_method($)
{
my ($self) = @_;
my $objOutputter = $$self{objOutputter};
return unless ($self->check_for_eof());
my $filename = $$self{filename};
my $line_num = $$self{line_num};
my $commentblock = $self->extract_preceding_documentation();
my $str = $self->extract_bracketed_text();
my @args = string_split_commas($str);
my $entity_type = "method";
unless ($$self{in_class})
{
print STDERR "$filename:$line_num:_WRAP macro encountered outside class\n";
return;
}
my $objCfunc;
my $objCppfunc;
# handle first argument
my $argCppMethodDecl = $args[0];
if ($argCppMethodDecl !~ m/\S/s)
{
print STDERR "$filename:$line_num:_WRAP_METHOD: missing prototype\n";
return;
}
#Parse the method declaration and build an object that holds the details:
$objCppfunc = &Function::new($argCppMethodDecl, $self);
# handle second argument:
my $argCFunctionName = $args[1];
$argCFunctionName = string_trim($argCFunctionName);
#Get the c function's details:
# Checks that it's not empty and that it contains no whitespace.
if ($argCFunctionName =~ m/^\S+$/s)
{
#c-name. e.g. gtk_clist_set_column_title
if ($$objCppfunc{static}) {
$objCfunc = GtkDefs::lookup_method_set_weak_mark($argCFunctionName);
} else {
$objCfunc = GtkDefs::lookup_method($argCFunctionName);
}
if(!$objCfunc) #If the lookup failed:
{
$objOutputter->output_wrap_failed($argCFunctionName, "method defs lookup failed (1)");
return;
}
}
# Extra stuff needed?
$$objCfunc{rettype_needs_ref} = 0;
$$objCfunc{throw_any_errors} = 0;
$$objCfunc{constversion} = 0;
$$objCfunc{deprecated} = "";
my $errthrow_docs = "";
my $deprecation_docs = "";
my $newin = "";
my $ifdef;
while($#args >= 2) # If the optional ref/err/deprecated arguments are there.
{
my $argRef = string_trim(pop @args);
#print "debug arg=$argRef\n";
if($argRef eq "refreturn")
{
$$objCfunc{rettype_needs_ref} = 1;
}
elsif($argRef =~ /^errthrow(.*)/) #If errthrow is at the start.
{
$$objCfunc{throw_any_errors} = 1;
$errthrow_docs = ($1 ne "") ? string_unquote(string_trim($1)) : "Glib::Error";
}
elsif($argRef eq "constversion")
{
$$objCfunc{constversion} = 1;
}
elsif($argRef =~ /^deprecated(.*)/) #If deprecated is at the start.
{
$$objCfunc{deprecated} = "deprecated";
if($1 ne "")
{
$deprecation_docs = string_unquote(string_trim($1));
}
}
elsif($argRef =~ /^newin(.*)/) #If newin is at the start.
{
$newin = string_unquote(string_trim($1));
}
elsif($argRef =~ /^ifdef(.*)/) #If ifdef is at the start.
{
$ifdef = $1;
}
# The "slot_name" option tells gmmproc the name of the parameter
# that is a slot in the method if there is one.
elsif($argRef =~ /^slot_name\s+(\w+)/)
{
$$objCppfunc{slot_name} = $1;
}
# The "slot_callback" option tells gmmproc the name of the
# callback function that should be passed to the C function if the
# method has a slot.
elsif($argRef =~ /^slot_callback\s+(\w+)/)
{
$$objCppfunc{slot_callback} = $1;
}
# The "no_slot_copy" options tells gmmproc to pass the actual slot
# and not a copy of it to the C function in the data parameter.
if($argRef eq "no_slot_copy")
{
$$objCppfunc{no_slot_copy} = 1;
}
}
if ($commentblock ne '')
{
$commentblock = ' /**' . $commentblock . "\n */\n";
}
else
{
$commentblock = DocsParser::lookup_documentation($argCFunctionName,
$deprecation_docs, $newin, $objCppfunc, $errthrow_docs);
}
$objOutputter->output_wrap_meth($filename, $line_num, $objCppfunc, $objCfunc, $argCppMethodDecl, $commentblock, $ifdef);
}
# void on_wrap_method_docs_only()
sub on_wrap_method_docs_only($)
{
my ($self) = @_;
my $objOutputter = $$self{objOutputter};
return unless ($self->check_for_eof());
my $filename = $$self{filename};
my $line_num = $$self{line_num};
my $str = $self->extract_bracketed_text();
my @args = string_split_commas($str, 1);
my $entity_type = "method";
if (!$$self{in_class})
{
print STDERR "$filename:$line_num:_WRAP macro encountered outside class\n";
return;
}
my $objCfunc;
# handle first argument
my $argCFunctionName = $args[0];
$argCFunctionName = string_trim($argCFunctionName);
# Get the C function's details:
# Checks that it's not empty or contains whitespace
if ($argCFunctionName =~ m/^\S+$/s)
{
#c-name. e.g. gtk_clist_set_column_title
$objCfunc = GtkDefs::lookup_method_set_weak_mark($argCFunctionName);
if(!$objCfunc) #If the lookup failed:
{
$objOutputter->output_wrap_failed($argCFunctionName, "method defs lookup failed (1)");
return;
}
}
$$objCfunc{throw_any_errors} = 0;
my $errthrow_docs = "";
my $newin = "";
my $voidreturn = 0;
while($#args >= 1) # If the optional ref/err arguments are there.
{
my $argRef = string_trim(pop @args);
if($argRef =~ /^errthrow(.*)/) #If errthrow is at the start.
{
$$objCfunc{throw_any_errors} = 1;
$errthrow_docs = ($1 ne "") ? string_unquote(string_trim($1)) : "Glib::Error";
}
elsif($argRef =~ /^newin(.*)/) #If newin is at the start.
{
$newin = string_unquote(string_trim($1));
}
elsif($argRef eq "voidreturn")
{
$voidreturn = 1;
}
}
my $commentblock = "";
$commentblock = DocsParser::lookup_documentation($argCFunctionName, "", $newin,
undef, $errthrow_docs, $voidreturn);
$objOutputter->output_wrap_meth_docs_only($filename, $line_num, $commentblock);
}
sub on_wrap_ctor($)
{
my ($self) = @_;
my $objOutputter = $$self{objOutputter};
if( !($self->check_for_eof()) )
{
return;
}
my $filename = $$self{filename};
my $line_num = $$self{line_num};
my $str = $self->extract_bracketed_text();
my @args = string_split_commas($str);
my $entity_type = "method";
if (!$$self{in_class})
{
print STDERR "$filename:$line_num:_WRAP_CTOR macro encountered outside class\n";
return;
}
my $objCfunc;
my $objCppfunc;
# handle first argument
my $argCppMethodDecl = $args[0];
if ($argCppMethodDecl !~ m/\S/s)
{
print STDERR "$filename:$line_num:_WRAP_CTOR: missing prototype\n";
return;
}
#Parse the method decaration and build an object that holds the details:
$objCppfunc = &Function::new_ctor($argCppMethodDecl, $self);
# handle second argument:
my $argCFunctionName = $args[1];
$argCFunctionName = string_trim($argCFunctionName);
#Get the C function's details:
if ($argCFunctionName =~ m/^\S+$/s)
{
#c-name. e.g. gtk_button_new
$objCfunc = GtkDefs::lookup_method_set_weak_mark($argCFunctionName);
if(!$objCfunc) #If the lookup failed:
{
$objOutputter->output_wrap_failed($argCFunctionName, "ctor defs lookup failed (2)");
return;
}
}
# Handle options (presently only "errthrow" is recognized).
$$objCfunc{throw_any_errors} = 0;
while($#args >= 2)
{
my $argRef = string_trim(pop @args);
if($argRef eq "errthrow")
{
$$objCfunc{throw_any_errors} = 1;
}
else
{
print STDERR "$filename:$line_num:_WRAP_CTOR: Invalid option '$argRef'.\n";
return;
}
}
$objOutputter->output_wrap_ctor($filename, $line_num, $objCppfunc, $objCfunc, $argCppMethodDecl);
}
sub on_implements_interface($$)
{
my ($self) = @_;
if( !($self->check_for_eof()) )
{
return;
}
my $filename = $$self{filename};
my $line_num = $$self{line_num};
my $str = $self->extract_bracketed_text();
my @args = string_split_commas($str);
# handle first argument
my $interface = $args[0];
# Extra stuff needed?
my $ifdef;
while($#args >= 1) # If the optional ref/err/deprecated arguments are there.
{
my $argRef = string_trim(pop @args);
if($argRef =~ /^ifdef(.*)/) #If ifdef is at the start.
{
$ifdef = $1;
}
}
my $objOutputter = $$self{objOutputter};
$objOutputter->output_implements_interface($interface, $ifdef);
}
sub on_wrap_create($)
{
my ($self) = @_;
if( !($self->check_for_eof()) )
{
return;
}
my $str = $self->extract_bracketed_text();
my $objOutputter = $$self{objOutputter};
$objOutputter->output_wrap_create($str, $self);
}
sub on_wrap_signal($$)
{
my ($self) = @_;
if( !($self->check_for_eof()) )
{
return;
}
my $commentblock = $self->extract_preceding_documentation();
# Remove leading and trailing m4 quotes, if any.
# M4 quotes will be added around the whole comment, after $commentblock has
# possibly been merged with a second comment block.
$commentblock =~ s/^`//;
$commentblock =~ s/'$//;
my $str = $self->extract_bracketed_text();
my @args = string_split_commas($str);
#Get the arguments:
my $argCppDecl = $args[0];
my $argCName = $args[1];
$argCName = string_trim($argCName);
$argCName = string_unquote($argCName);
my $bCustomDefaultHandler = 0;
my $bNoDefaultHandler = 0;
my $bCustomCCallback = 0;
my $bRefreturn = 0;
my $ifdef = "";
my $argDeprecated = "";
my $deprecation_docs = "";
my $newin = "";
my $exceptionHandler = "";
my $detail_name = "";
my $bTwoSignalMethods = 0;
while($#args >= 2) # If optional arguments are there.
{
my $argRef = string_trim(pop @args);
if($argRef eq "custom_default_handler")
{
$bCustomDefaultHandler = 1;
}
elsif($argRef eq "no_default_handler")
{
$bNoDefaultHandler = 1;
}
elsif($argRef eq "custom_c_callback")
{
$bCustomCCallback = 1;
}
elsif($argRef eq "refreturn")
{
$bRefreturn = 1;
}
elsif($argRef =~ /^deprecated(.*)/) #If deprecated is at the start.
{
$argDeprecated = "deprecated";
if($1 ne "")
{
$deprecation_docs = string_unquote(string_trim($1));
}
}
elsif($argRef =~ /^newin(.*)/) #If newin is at the start.
{
$newin = string_unquote(string_trim($1));
}
elsif($argRef =~ /^ifdef(.*)/) #If ifdef is at the start.
{
$ifdef = $1;
}
elsif($argRef =~ /^exception_handler\s+(.*)/) #If exception_handler at the start.
{
$exceptionHandler = $1;
}
elsif($argRef =~ /^detail_name\s+(.+)/) #If detail_name at the start.
{
$detail_name = $1;
}
elsif($argRef eq "two_signal_methods")
{
$bTwoSignalMethods = 1;
}
else
{
$self->error("_WRAP_SIGNAL: Invalid option '$argRef'.\n");
}
}
$self->output_wrap_signal($argCppDecl, $argCName, $$self{filename}, $$self{line_num},
$bCustomDefaultHandler, $bNoDefaultHandler, $bCustomCCallback,
$bRefreturn, $ifdef, $commentblock, $argDeprecated, $deprecation_docs,
$newin, $exceptionHandler, $detail_name, $bTwoSignalMethods);
}
# void on_wrap_vfunc()
sub on_wrap_vfunc($)
{
my ($self) = @_;
if( !($self->check_for_eof()) )
{
return;
}
my $str = $self->extract_bracketed_text();
my @args = string_split_commas($str);
#Get the arguments:
my $argCppDecl = $args[0];
my $argCName = $args[1];
$argCName = string_trim($argCName);
$argCName = string_unquote($argCName);
my $refreturn = 0;
my $keep_return = 0;
my $refreturn_ctype = 0;
my $returnValue = "";
my $errReturnValue = "";
my $exceptionHandler = "";
my $custom_vfunc = 0;
my $custom_vfunc_callback = 0;
my $ifdef = "";
my $errthrow = 0;
my $slot_name = "";
my $slot_callback = "";
my $no_slot_copy = 0;
while($#args >= 2) # If optional arguments are there.
{
my $argRef = string_trim(pop @args);
# Extra ref needed?
if($argRef eq "refreturn")
{
$refreturn = 1;
}
# Must a copy of the return value be kept, because the caller does not
# get its own copy?
elsif($argRef eq "keep_return")
{
$keep_return = 1;
}
elsif($argRef eq "refreturn_ctype")
{
$refreturn_ctype = 1;
}
# Return value, if neither the underlying C class defines the vfunc
# nor the C++ vfunc is overridden in a user-defined subclass.
# (Default is the default value of the return type, e.g. false or 0.)
elsif($argRef =~ /^return_value\s+(.*)/)
{
$returnValue = $1;
}
# Return value, if the C++ vfunc throws an exception which is propagated
# to the C callback.
# (Default is the default value of the return type or, if return_value
# is specified, the return_value.)
elsif($argRef =~ /^err_return_value\s+(.*)/)
{
$errReturnValue = $1;
}
# If exception handler is not defined, then Glib::exception_handlers_invoke
# method will be used for exception handling.
elsif($argRef =~ /^exception_handler\s+(.*)/)
{
$exceptionHandler = $1;
}
elsif($argRef eq "custom_vfunc")
{
$custom_vfunc = 1;
}
elsif($argRef eq "custom_vfunc_callback")
{
$custom_vfunc_callback = 1;
}
elsif($argRef eq "errthrow")
{
$errthrow = 1;
}
elsif($argRef =~ /^ifdef(.*)/) #If ifdef is at the start.
{
$ifdef = $1;
}
# The "slot_name" option tells gmmproc the name of the parameter
# that is a slot in the virtual function if there is one.
elsif($argRef =~ /^slot_name\s+(\w+)/)
{
$slot_name = $1;
}
# The "slot_callback" option tells gmmproc the name of the
# callback function that should be passed to the C function if the
# virtual function has a slot.
elsif($argRef =~ /^slot_callback\s+(\w+)/)
{
$slot_callback = $1;
}
# The "no_slot_copy" options tells gmmproc to pass the actual slot
# and not a copy of it to the C function in the data parameter.
elsif($argRef eq "no_slot_copy")
{
$no_slot_copy = 1;
}
}
$errReturnValue = $returnValue if ($returnValue ne "" and $errReturnValue eq "");
$self->output_wrap_vfunc($argCppDecl, $argCName, $$self{filename}, $$self{line_num},
$refreturn, $keep_return, $refreturn_ctype, $custom_vfunc,
$custom_vfunc_callback, $ifdef, $errthrow,
$slot_name, $slot_callback, $no_slot_copy,
$returnValue, $errReturnValue, $exceptionHandler);
}
# Common part of _WRAP_ENUM(), _WRAP_ENUM_DOCS_ONLY() and _WRAP_GERROR().
sub on_wrap_any_enum($$)
{
my ($self, $is_gerror) = @_;
my $str = $self->extract_bracketed_text();
my @args = string_split_commas($str);
#Get the arguments:
my $cpp_type = string_trim(shift(@args));
my $c_type = string_trim(shift(@args));
my $domain = $is_gerror ? string_trim(shift(@args)) : "";
my @subst_in = [];
my @subst_out = [];
my $no_gtype = "";
my $argDeprecated = "";
my $deprecation_docs = "";
my $newin = "";
# Build a list of custom substitutions, and recognize some flags too.
foreach (@args)
{
my $arg = string_trim($_);
if ($arg eq "NO_GTYPE")
{
$no_gtype = "NO_GTYPE";
}
elsif ($arg =~ /^(get_type_func=)(\s*)$/)
{
my $part1 = $1;
my $part2 = $2;
}
elsif ($arg =~ /^s#([^#]+)#([^#]*)#$/)
{
push(@subst_in, $1);
push(@subst_out, $2);
}
elsif ($arg =~ /^deprecated(.*)/) #If deprecated is at the start.
{
$argDeprecated = "deprecated";
if ($1 ne "")
{
$deprecation_docs = string_unquote(string_trim($1));
}
}
elsif ($arg =~ /^newin(.*)/) #If newin is at the start.
{
$newin = string_unquote(string_trim($1));
}
}
return ($cpp_type, $c_type, $domain, \@subst_in, \@subst_out, $no_gtype,
$argDeprecated, $deprecation_docs, $newin);
}
sub on_wrap_enum($)
{
my ($self) = @_;
return unless ($self->check_for_eof());
my $comment = $self->extract_preceding_documentation();
# get the arguments
my ($cpp_type, $c_type, undef, $ref_subst_in, $ref_subst_out, $no_gtype,
$argDeprecated, $deprecation_docs, $newin) = $self->on_wrap_any_enum(0);
$$self{objOutputter}->output_wrap_enum(
$$self{filename}, $$self{line_num}, $cpp_type, $c_type,
$comment, $ref_subst_in, $ref_subst_out, $no_gtype,
$argDeprecated, $deprecation_docs, $newin);
}
sub on_wrap_enum_docs_only($)
{
my ($self) = @_;
return unless ($self->check_for_eof());
my $comment = $self->extract_preceding_documentation();
# get the arguments
my ($cpp_type, $c_type, undef, $ref_subst_in, $ref_subst_out, undef,
$argDeprecated, $deprecation_docs, $newin) = $self->on_wrap_any_enum(0);
# Get the module name so the enum docs can be included in the module's
# Doxygen enum group.
my $module_canonical = Util::string_canonical($$self{module});
$$self{objOutputter}->output_wrap_enum_docs_only(
$$self{filename}, $$self{line_num}, $module_canonical, $cpp_type, $c_type,
$comment, $ref_subst_in, $ref_subst_out, $deprecation_docs, $newin);
}
sub on_wrap_gerror($)
{
my ($self) = @_;
return unless ($self->check_for_eof());
# If _WRAP_GERROR is preceded by a doxygen comment, it will be applied
# to the generated exception class as a whole, and not to the enum Code
# inside the class.
my $class_docs = $self->extract_preceding_documentation();
# get the arguments
my ($cpp_type, $c_type, $domain, $ref_subst_in, $ref_subst_out, $no_gtype,
$argDeprecated, $deprecation_docs, $newin) = $self->on_wrap_any_enum(1);
$$self{objOutputter}->output_wrap_gerror(
$$self{filename}, $$self{line_num}, $cpp_type, $c_type, $domain,
$class_docs, $ref_subst_in, $ref_subst_out, $no_gtype,
$argDeprecated, $deprecation_docs, $newin);
}
sub on_wrap_any_property($)
{
my ($self) = @_;
my $str = $self->extract_bracketed_text();
my @args = string_split_commas($str);
#Get the arguments:
my $argPropertyName = $args[0];
$argPropertyName = string_trim($argPropertyName);
$argPropertyName = string_unquote($argPropertyName);
#Convert the property name to a canonical form, as it is inside gobject.
#Otherwise, gobject might not recognise the name,
#and we will not recognise the property name when we get notification that the value changes.
$argPropertyName =~ tr/_/-/;
my $argCppType = $args[1];
$argCppType = string_trim($argCppType);
$argCppType = string_unquote($argCppType);
my $filename = $$self{filename};
my $line_num = $$self{line_num};
#TODO: Reduce duplication with on_wrap_method():
my $argDeprecated = "";
my $deprecation_docs = "";
my $newin = "";
while($#args >= 2) # If the optional arguments are there.
{
my $argRef = string_trim(pop @args);
if($argRef =~ /^deprecated(.*)/) #If deprecated is at the start.
{
$argDeprecated = "deprecated";
if($1 ne "")
{
$deprecation_docs = string_unquote(string_trim($1));
}
}
elsif($argRef =~ /^newin(.*)/) #If newin is at the start.
{
$newin = string_unquote(string_trim($1));
}
}
return ($filename, $line_num, $argPropertyName, $argCppType,
$argDeprecated, $deprecation_docs, $newin);
}
sub on_wrap_property($)
{
my ($self) = @_;
my $objOutputter = $$self{objOutputter};
return unless ($self->check_for_eof());
my ($filename, $line_num, $argPropertyName, $argCppType, $argDeprecated,
$deprecation_docs, $newin) = $self->on_wrap_any_property();
$objOutputter->output_wrap_property($filename, $line_num, $argPropertyName,
$argCppType, $$self{c_class}, $$self{deprecated}, $argDeprecated, $deprecation_docs, $newin);
}
sub on_wrap_child_property($)
{
my ($self) = @_;
my $objOutputter = $$self{objOutputter};
return unless ($self->check_for_eof());
my ($filename, $line_num, $argPropertyName, $argCppType, $argDeprecated,
$deprecation_docs, $newin) = $self->on_wrap_any_property();
$objOutputter->output_wrap_child_property($filename, $line_num, $argPropertyName,
$argCppType, $$self{c_class}, $$self{deprecated}, $argDeprecated, $deprecation_docs, $newin);
}
sub output_wrap_check($$$$$$)
{
my ($self, $CppDecl, $signal_name, $filename, $line_num, $macro_name) = @_;
#Some checks:
unless ($$self{in_class})
{
print STDERR "$filename:$line_num: $macro_name macro encountered outside class\n";
return 1;
}
if ($CppDecl !~ m/\S/s)
{
print STDERR "$filename:$line_num:$macro_name: missing prototype\n";
return 1;
}
return '';
}
# void output_wrap($CppDecl, $signal_name, $filename, $line_num, $bCustomDefaultHandler,
# $bNoDefaultHandler, $bCustomCCallback, $bRefreturn, $ifdef,
# $commentblock, $deprecated, $deprecation_docs, $newin, $exceptionHandler,
# $detail_name, $bTwoSignalMethods)
sub output_wrap_signal($$$$$$$$$$$$$$$$$)
{
my ($self, $CppDecl, $signal_name, $filename, $line_num, $bCustomDefaultHandler,
$bNoDefaultHandler, $bCustomCCallback, $bRefreturn, $ifdef,
$commentblock, $deprecated, $deprecation_docs, $newin, $exceptionHandler,
$detail_name, $bTwoSignalMethods) = @_;
#Some checks:
return if ($self->output_wrap_check($CppDecl, $signal_name,
$filename, $line_num, "_WRAP_SIGNAL"));
# handle first argument
#Parse the method declaration and build an object that holds the details:
my $objCppSignal = &Function::new($CppDecl, $self);
$$objCppSignal{class} = $$self{class}; #Remember the class name for use in Outputter::output_wrap_signal().
# handle second argument:
my $objCSignal = undef;
my $objOutputter = $$self{objOutputter};
#Get the c function's details:
if ($signal_name ne '')
{
$objCSignal = GtkDefs::lookup_signal($$self{c_class}, $signal_name);
# Check for failed lookup.
if (!$objCSignal)
{
print STDERR "$signal_name\n";
$objOutputter->output_wrap_failed($signal_name,
" signal defs lookup failed");
return;
}
}
# Check detailed.
my $defs_detailed = $objCSignal->get_detailed();
if ($defs_detailed && !$detail_name)
{
print STDERR "Warning, $main::source: The $signal_name signal" .
" is marked 'detailed' in the .defs file, but not in _WRAP_SIGNAL.\n";
}
elsif (!$defs_detailed && $detail_name)
{
print STDERR "Warning, $main::source: The $signal_name signal" .
" is marked 'detailed' in _WRAP_SIGNAL, but not in the .defs file.\n";
}
Output::check_deprecation($$self{deprecated}, $objCSignal->get_deprecated(),
$deprecated, $signal_name, "signal", "SIGNAL");
$objOutputter->output_wrap_sig_decl($filename, $line_num, $objCSignal, $objCppSignal,
$signal_name, $bCustomCCallback, $ifdef, $commentblock,
$deprecated, $deprecation_docs, $newin, $exceptionHandler,
$detail_name, $bTwoSignalMethods);
if (!$bNoDefaultHandler)
{
$objOutputter->output_wrap_default_signal_handler_h($filename, $line_num,
$objCppSignal, $objCSignal, $ifdef, $deprecated, $exceptionHandler);
my $bImplement = 1;
if($bCustomDefaultHandler) { $bImplement = 0; }
$objOutputter->output_wrap_default_signal_handler_cc($filename, $line_num,
$objCppSignal, $objCSignal, $bImplement, $bCustomCCallback, $bRefreturn,
$ifdef, $deprecated, $exceptionHandler);
}
}
# void output_wrap_vfunc($CppDecl, $vfunc_name, $filename, $line_num,
# $refreturn, $keep_return, $refreturn_ctype,
# $custom_vfunc, $custom_vfunc_callback, $ifdef, $errthrow,
# $slot_name, $slot_callback, $no_slot_copy, $returnValue,
# $errReturnValue, $exceptionHandler)
sub output_wrap_vfunc($$$$$$$$$$$$$$$$$$)
{
my ($self, $CppDecl, $vfunc_name, $filename, $line_num, $refreturn, $keep_return, $refreturn_ctype,
$custom_vfunc, $custom_vfunc_callback, $ifdef, $errthrow,
$slot_name, $slot_callback, $no_slot_copy, $returnValue, $errReturnValue, $exceptionHandler) = @_;
#Some checks:
return if ($self->output_wrap_check($CppDecl, $vfunc_name, $filename, $line_num, '_WRAP_VFUNC'));
# handle first argument
#Parse the method declaration and build an object that holds the details:
my $objCppVfunc = &Function::new($CppDecl, $self);
# handle second argument:
my $objCVfunc = undef;
my $objOutputter = $$self{objOutputter};
#Get the c function's details:
if ($vfunc_name =~ m/^\S+$/s) # if it's not empty and contains no whitespace
{
$objCVfunc = GtkDefs::lookup_signal($$self{c_class},$vfunc_name);
if(!$objCVfunc) #If the lookup failed:
{
$objOutputter->output_wrap_failed($vfunc_name, " vfunc defs lookup failed");
return;
}
}
# Write out the appropriate macros.
# These macros are defined in vfunc.m4:
$$objCppVfunc{rettype_needs_ref} = $refreturn;
$$objCppVfunc{keep_return} = $keep_return;
$$objCppVfunc{return_value} = $returnValue;
$$objCppVfunc{err_return_value} = $errReturnValue;
$$objCppVfunc{exception_handler} = $exceptionHandler;
$$objCppVfunc{name} .= "_vfunc"; #All vfuncs should have the "_vfunc" suffix, and a separate easily-named invoker method.
# Store the slot information in the vfunc if specified.
$$objCppVfunc{slot_name} = $slot_name if ($slot_name);
$$objCppVfunc{slot_callback} = $slot_callback if ($slot_callback);
$$objCppVfunc{no_slot_copy} = $no_slot_copy if ($no_slot_copy);
$$objCVfunc{rettype_needs_ref} = $refreturn_ctype;
$$objCVfunc{throw_any_errors} = 1 if($errthrow);
$objOutputter->output_wrap_vfunc_h($filename, $line_num, $objCppVfunc, $objCVfunc, $ifdef);
$objOutputter->output_wrap_vfunc_cc($filename, $line_num, $objCppVfunc, $objCVfunc,
$custom_vfunc, $custom_vfunc_callback, $ifdef);
}
# give some sort of weights to sorting attibutes
sub byattrib()
{
my %attrib_value = (
"virtual_impl" ,1,
"virtual_decl" ,2,
# "sig_impl" ,3,
"sig_decl" ,4,
"meth" ,5
);
# $a and $b are hidden parameters to a sorting function
return $attrib_value{$b} <=> $attrib_value{$a};
}
# void on_wrap_corba_method()
sub on_wrap_corba_method($)
{
my ($self) = @_;
my $objOutputter = $$self{objOutputter};
return unless ($self->check_for_eof());
my $filename = $$self{filename};
my $line_num = $$self{line_num};
my $str = $self->extract_bracketed_text();
my @args = string_split_commas($str);
my $entity_type = "method";
if (!$$self{in_class})
{
print STDERR "$filename:$line_num:_WRAP macro encountered outside class\n";
return;
}
my $objCppfunc;
# handle first argument
my $argCppMethodDecl = $args[0];
if ($argCppMethodDecl !~ m/\S/s)
{
print STDERR "$filename:$line_num:_WRAP_CORBA_METHOD: missing prototype\n";
return;
}
# Parse the method decaration and build an object that holds the details:
$objCppfunc = &Function::new($argCppMethodDecl, $self);
$objOutputter->output_wrap_corba_method($filename, $line_num, $objCppfunc);
}
1; # return package loaded okay.