# 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.