Fix building.

git-svn-id: svn://localhost/ardour2/trunk@2791 d708f5d6-7413-0410-9779-e7cbd77b26cf

libs/glibmm2/tools/pm/DocsParser.pm

@@ -0,0 +1,494 @@
+# gtkmm - DocsParser 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, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+#
+
+# Based on XML::Parser tutorial found at http://www.devshed.com/Server_Side/Perl/PerlXML/PerlXML1/page1.html
+# This module isn't properly Object Orientated because the XML Parser needs global callbacks.
+
+package DocsParser;
+use XML::Parser;
+use strict;
+use warnings;
+
+# use Util;
+use Function;
+use GtkDefs;
+use Object;
+
+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;
+
+#####################################
+
+use strict;
+use warnings;
+
+#####################################
+
+$DocsParser::CurrentFile = "";
+
+$DocsParser::refAppendTo = undef; # string reference to store the data into
+$DocsParser::currentParam = undef;
+
+$DocsParser::objCurrentFunction = undef; #Function
+%DocsParser::hasharrayFunctions = (); #Function elements
+#~ $DocsParser::bOverride = 0; #First we parse the C docs, then we parse the C++ override docs.
+
+$DocsParser::commentStart = "  /** ";
+$DocsParser::commentMiddleStart = "   * ";
+$DocsParser::commentEnd = "   */";
+
+sub read_defs($$$)
+{
+  my ($path, $filename, $filename_override) = @_;
+  
+  my $objParser = new XML::Parser(ErrorContext => 0);
+  $objParser->setHandlers(Start => \&parse_on_start, End => \&parse_on_end, Char => \&parse_on_cdata);
+  
+  # C documentation:
+  $DocsParser::CurrentFile = "$path/$filename";
+  if ( ! -r $DocsParser::CurrentFile)
+  {
+     print "DocsParser.pm: Warning: Can't read file \"" . $DocsParser::CurrentFile . "\".\n";
+     return;
+  }
+  # Parse
+  eval { $objParser->parsefile($DocsParser::CurrentFile) };
+  if( $@ )
+  {
+    $@ =~ s/at \/.*?$//s;
+    print "\nError in \"" . $DocsParser::CurrentFile . "\":$@\n";
+    return;
+  }
+
+  # C++ overide documentation:
+  $DocsParser::CurrentFile = "$path/$filename_override";
+  if ( ! -r $DocsParser::CurrentFile)
+  {
+     print "DocsParser.pm: Warning: Can't read file \"" . $DocsParser::CurrentFile . "\".\n";
+     return;
+  }
+  # Parse
+  eval { $objParser->parsefile($DocsParser::CurrentFile) };
+  if( $@ )
+  {
+    $@ =~ s/at \/.*?$//s;
+    print "\nError in \"" . $DocsParser::CurrentFile . "\":$@";
+    return;
+  }
+}
+
+sub parse_on_start($$%)
+{
+  my ($objParser, $tag, %attr) = @_;
+
+  $tag = lc($tag);
+
+  if($tag eq "function")
+  {
+    if(defined $DocsParser::objCurrentFunction)
+    {
+      $objParser->xpcroak("\nClose a function tag before you open another one.");
+    }
+    
+    my $functionName = $attr{name};
+
+    #Reuse existing Function, if it exists:
+    #(For instance, if this is the override parse)
+    $DocsParser::objCurrentFunction = $DocsParser::hasharrayFunctions{$functionName};
+    if(!$DocsParser::objCurrentFunction)
+    {
+      #Make a new one if necessary:
+      $DocsParser::objCurrentFunction = Function::new_empty();
+      # The idea is to change the policy a bit:
+      # If a function is redefined in a later parsing run only values which are redefined
+      # will be overwritten. For the name this is trivial. The description is simply rewritten.
+      # Same goes for the return description and the class mapping. Only exception is the
+      # parameter list. Everytime we enter a <parameters> tag the list is emptied again.
+      $$DocsParser::objCurrentFunction{name} = $functionName;
+      $$DocsParser::objCurrentFunction{description} = "";
+      $$DocsParser::objCurrentFunction{param_names} = [];
+      $$DocsParser::objCurrentFunction{param_descriptions} = ();
+      $$DocsParser::objCurrentFunction{return_description} = "";
+      $$DocsParser::objCurrentFunction{mapped_class} = "";
+      # We don't need this any more, the only reference to this field is commented
+      # $$DocsParser::objCurrentFunction{description_overridden} = $DocsParser::bOverride;
+    }
+  }
+  elsif($tag eq "parameters")
+  {
+    $$DocsParser::objCurrentFunction{param_names} = [];
+    $$DocsParser::objCurrentFunction{param_descriptions} = ();
+  }
+  elsif($tag eq "parameter")
+  {
+    $DocsParser::currentParam = $attr{name};
+    $$DocsParser::objCurrentFunction{param_descriptions}->{$DocsParser::currentParam} = "";
+  }
+  elsif($tag eq "description")
+  {
+    $$DocsParser::objCurrentFunction{description} = "";
+    # Set destination for parse_on_cdata().
+    $DocsParser::refAppendTo = \$$DocsParser::objCurrentFunction{description};
+  }
+  elsif($tag eq "parameter_description")
+  {
+    # Set destination for parse_on_cdata().
+    my $param_desc = \$$DocsParser::objCurrentFunction{param_descriptions};
+    $DocsParser::refAppendTo = \$$param_desc->{$DocsParser::currentParam};
+  }
+  elsif($tag eq "return")
+  {
+    $$DocsParser::objCurrentFunction{return_description} = "";
+    # Set destination for parse_on_cdata().
+    $DocsParser::refAppendTo = \$$DocsParser::objCurrentFunction{return_description};
+  }
+  elsif($tag eq "mapping")
+  {
+    $$DocsParser::objCurrentFunction{mapped_class} = $attr{class};
+  }
+  elsif($tag ne "root")
+  {
+    $objParser->xpcroak("\nUnknown tag \"$tag\".");
+  }
+}
+
+
+sub parse_on_end($$)
+{
+  my ($parser, $tag) = @_;
+
+  # Clear destination for parse_on_cdata().
+  $DocsParser::refAppendTo = undef;
+
+  $tag = lc($tag);
+
+  if($tag eq "function")
+  {
+    # Store the Function structure in the array:
+    my $functionName = $$DocsParser::objCurrentFunction{name};
+    $DocsParser::hasharrayFunctions{$functionName} = $DocsParser::objCurrentFunction;
+    $DocsParser::objCurrentFunction = undef;
+  }
+  elsif($tag eq "parameter")
+  {
+    # <parameter name="returns"> and <return> means the same.
+    if($DocsParser::currentParam eq "returns")
+    {
+      my $param_descriptions = \$$DocsParser::objCurrentFunction{param_descriptions};
+      my $return_description = \$$DocsParser::objCurrentFunction{return_description};
+      $$return_description = delete $$param_descriptions->{"returns"};
+    }
+    else
+    {
+      # Append to list of parameters.
+      push(@{$$DocsParser::objCurrentFunction{param_names}}, $DocsParser::currentParam);
+    }
+
+    $DocsParser::currentParam = undef;
+  }
+}
+
+
+sub parse_on_cdata($$)
+{
+  my ($parser, $data) = @_;
+
+  if(defined $DocsParser::refAppendTo)
+  {
+    # Dispatch $data to the current destination string.
+    $$DocsParser::refAppendTo .= $data;
+  }
+}
+
+
+# $strCommentBlock lookup_documentation($strFunctionName)
+sub lookup_documentation($$)
+{
+  my ($functionName, $deprecation_docs) = @_;
+
+  my $objFunction = $DocsParser::hasharrayFunctions{$functionName};
+  if(!$objFunction)
+  {
+    #print "DocsParser.pm: Warning: function not found: $functionName\n";
+    return ""
+  }
+
+  my $text = $$objFunction{description};
+
+  if(length($text) eq 0)
+  {
+    print "DocsParser.pm: Warning: No C docs for function: \"$functionName\"\n";
+  }
+
+
+  DocsParser::convert_docs_to_cpp($objFunction, \$text);
+
+  #Add note about deprecation if we have specified that in our _WRAP_METHOD() call:
+  if($deprecation_docs ne "")
+  {
+    $text .= "\n\@deprecated $deprecation_docs";
+  }
+
+  DocsParser::append_parameter_docs($objFunction, \$text);
+  DocsParser::append_return_docs($objFunction, \$text);
+
+
+  # Escape the space after "i.e." or "e.g." in the brief description.
+  $text =~ s/^([^.]*\b(?:i\.e\.|e\.g\.))\s/$1\\ /;
+
+  # Convert to Doxygen-style comment.
+  $text =~ s/\n/\n${DocsParser::commentMiddleStart}/g;
+  $text =  $DocsParser::commentStart . $text;
+  $text .= "\n${DocsParser::commentEnd}\n";
+
+  return $text;
+}
+
+
+sub append_parameter_docs($$)
+{
+  my ($obj_function, $text) = @_;
+
+  my @param_names = @{$$obj_function{param_names}};
+  my $param_descriptions = \$$obj_function{param_descriptions};
+
+  # Strip first parameter if this is a method.
+  my $defs_method = GtkDefs::lookup_method_dont_mark($$obj_function{name});
+  # the second alternative is for use with method-mappings meaning:
+  # this function is mapped into this Gtk::class
+  shift(@param_names) if(($defs_method && $$defs_method{class} ne "") ||
+                         ($$obj_function{mapped_class} ne ""));
+
+  foreach my $param (@param_names)
+  {
+    my $desc = $$param_descriptions->{$param};
+    
+    $param =~ s/([a-zA-Z0-9]*(_[a-zA-Z0-9]+)*)_?/$1/g;
+    DocsParser::convert_docs_to_cpp($obj_function, \$desc);
+    if(length($desc) > 0)
+    {
+      $desc  .= '.' unless($desc =~ /(?:^|\.)$/);
+      $$text .= "\n\@param ${param} \u${desc}";
+    }
+  }
+}
+
+
+sub append_return_docs($$)
+{
+  my ($obj_function, $text) = @_;
+
+  my $desc = $$obj_function{return_description};
+  DocsParser::convert_docs_to_cpp($obj_function, \$desc);
+
+  $desc  =~ s/\.$//;
+  $$text .= "\n\@return \u${desc}." unless($desc eq "");
+}
+
+
+sub convert_docs_to_cpp($$)
+{
+  my ($obj_function, $text) = @_;
+
+  # Chop off leading and trailing whitespace.
+  $$text =~ s/^\s+//;
+  $$text =~ s/\s+$//;
+# HagenM: this is the only reference to $$obj_function{description_overridden}
+# and it seems not to be in use.
+#  if(!$$obj_function{description_overridden})
+#  {
+    # Convert C documentation to C++.
+    DocsParser::convert_tags_to_doxygen($text);
+    DocsParser::substitute_identifiers($$obj_function{name}, $text);
+
+    $$text =~ s/\bX\s+Window\b/X&nbsp;\%Window/g;
+    $$text =~ s/\bWindow\s+manager/\%Window manager/g;
+#  }
+}
+
+
+sub convert_tags_to_doxygen($)
+{
+  my ($text) = @_;
+
+  for($$text)
+  {
+    # Replace format tags.
+    s"&lt;(/?)emphasis&gt;"<$1em>"g;
+    s"&lt;(/?)literal&gt;"<$1tt>"g;
+    s"&lt;(/?)function&gt;"<$1tt>"g;
+
+    # Some argument names are suffixed by "_" -- strip this.
+    # gtk-doc uses @thearg, but doxygen uses @a thearg.
+    s" ?\@([a-zA-Z0-9]*(_[a-zA-Z0-9]+)*)_?\b" \@a $1 "g;
+    s"^Note ?\d?: "\@note "mg;
+
+    s"&lt;/?programlisting&gt;""g;
+    s"&lt;informalexample&gt;"\@code"g;
+    s"&lt;/informalexample&gt;"\@endcode"g;
+    s"&lt;!&gt;""g;
+
+    # Remove all link tags.
+    s"&lt;/?u?link[^&]*&gt;""g;
+
+    # Remove all para tags (from tmpl sgml files).
+    s"&lt;/?para&gt;""g;
+
+    # Use our doxgen since/newin tags:
+    # TODO: Do this generically, regardless of the number:
+    s"Since: 2\.2"\@newin2p2"mg;
+    s"Since: 2\.4"\@newin2p4"mg;
+    s"Since: 2\.6"\@newin2p6"mg;
+    s"Since: 2\.8"\@newin2p8"mg;
+    s"Since: 2\.10"\@newin2p10"mg;
+    s"Since: 2\.12"\@newin2p12"mg;
+    s"Since: 2\.14"\@newin2p14"mg;
+    s"Since: 2\.16"\@newin2p16"mg;
+    s"Since: 2\.18"\@newin2p18"mg;
+
+    s"\b-&gt;\b"->"g;
+
+    # Doxygen is too dumb to handle &mdash;
+    s"&mdash;" \@htmlonly&mdash;\@endhtmlonly "g;
+
+    s"\%?FALSE\b"<tt>false</tt>"g;
+    s"\%?TRUE\b"<tt>true</tt>"g;
+    s"\%?NULL\b"<tt>0</tt>"g;
+
+    s"#?\bgboolean\b"<tt>bool</tt>"g;
+    s"#?\bg(int|short|long)\b"<tt>$1</tt>"g;
+    s"#?\bgu(int|short|long)\b"<tt>unsigned $1</tt>"g;
+
+    # For Gtk::TextIter.
+    s"(\\[rn])\b"<tt>\\$1</tt>"g;
+  }
+}
+
+
+sub substitute_identifiers($$)
+{
+  my ($doc_func, $text) = @_;
+
+  for($$text)
+  {
+    # TODO: handle more than one namespace
+
+    s/[#%]([A-Z][a-z]*)([A-Z][A-Za-z]+)\b/$1::$2/g; # type names
+
+    s/[#%]([A-Z])([A-Z]*)_([A-Z\d_]+)\b/$1\L$2\E::$3/g; # enum values
+
+    # Undo wrong substitutions.
+    s/\bHas::/HAS_/g;
+    s/\bNo::/NO_/g;
+
+    # Replace C function names with C++ counterparts.
+    s/\b([a-z]+_[a-z][a-z\d_]+) ?\(\)/&DocsParser::substitute_function($doc_func, $1)/eg;
+  }
+}
+
+
+sub substitute_function($$)
+{
+  my ($doc_func, $name) = @_;
+
+  if(my $defs_method = GtkDefs::lookup_method_dont_mark($name))
+  {
+    if(my $defs_object = DocsParser::lookup_object_of_method($$defs_method{class}, $name))
+    {
+      my $module = $$defs_object{module};
+      my $class  = $$defs_object{name};
+
+      DocsParser::build_method_name($doc_func, $module, $class, \$name);
+    }
+  }
+  else
+  {
+    # Not perfect, but better than nothing.
+    $name =~ s/^g_/Glib::/;
+  }
+
+  return $name . "()";
+}
+
+
+sub lookup_object_of_method($$)
+{
+  my ($object, $name) = @_;
+
+  if($object ne "")
+  {
+    # We already know the C object name, because $name is a non-static method.
+    return GtkDefs::lookup_object($object);
+  }
+
+  my @parts = split(/_/, $name);
+  pop(@parts);
+
+  # (gtk, foo, bar) -> (Gtk, Foo, Bar)
+  foreach(@parts) { $_ = (length > 2) ? ucfirst : uc; }
+
+  # Do a bit of try'n'error.
+  while(scalar(@parts) > 1)
+  {
+    my $try = join("", @parts);
+
+    if(my $defs_object = GtkDefs::lookup_object($try))
+      { return $defs_object; }
+
+    pop(@parts);
+  }
+
+  return undef;
+}
+
+
+sub build_method_name($$$$)
+{
+  my ($doc_func, $module, $class, $name) = @_;
+
+  my $prefix = $module . $class;
+
+  $prefix =~ s/([a-z])([A-Z])/$1_$2/g;
+  $prefix = lc($prefix) . '_';
+
+  if($$name =~ /^$prefix/)
+  {
+    my $scope = "";
+    $scope = "${module}::${class}::" unless($doc_func =~ /^$prefix/);
+
+    substr($$name, 0, length($prefix)) = $scope;
+  }
+}
+
+
+1; # indicate proper module load.

libs/glibmm2/tools/pm/Enum.pm

@@ -0,0 +1,246 @@
+package Enum;
+
+use strict;
+use warnings;
+
+BEGIN {
+     use Exporter   ();
+     our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
+
+     # set the version for version checking
+     $VERSION     = 1.00;
+     @ISA         = qw(Exporter);
+     @EXPORT      = ( );
+     %EXPORT_TAGS = ( );
+     # your exported package globals go here,
+     # as well as any optionally exported functions
+     @EXPORT_OK   = ( );
+     }
+our @EXPORT_OK;
+
+# class Enum
+#    {
+#       bool flags;
+#       string type;
+#       string module;
+#       string c_type;
+#
+#       string array elem_names;
+#       string array elem_values;
+#
+#       bool mark;
+#    }
+
+
+sub new
+{
+  my ($def) = @_;
+  my $self = {};
+  bless $self;
+
+  $def =~ s/^\(//;
+  $def =~ s/\)$//;
+
+  $$self{mark}  = 0;
+  $$self{flags} = 0;
+
+  $$self{elem_names}  = [];
+  $$self{elem_values} = [];
+
+  # snarf down the fields
+
+  if($def =~ s/^define-(enum|flags)-extended (\S+)//)
+  {
+    $$self{type} = $2;
+    $$self{flags} = 1 if($1 eq "flags");
+  }
+
+  $$self{module} = $1 if($def =~ s/\(in-module "(\S+)"\)//);
+  $$self{c_type} = $1 if($def =~ s/\(c-name "(\S+)"\)//);
+
+  # values are compound lisp statement
+  if($def =~ s/\(values((?: '\("\S+" "\S+" "[^"]+"\))*) \)//)
+  {
+    $self->parse_values($1);
+  }
+
+  if($def !~ /^\s*$/)
+  {
+    GtkDefs::error("Unhandled enum def ($def) in $$self{module}\::$$self{type}\n")
+  }
+
+  # this should never happen
+  warn if(scalar(@{$$self{elem_names}}) != scalar(@{$$self{elem_values}}));
+
+  return $self;
+}
+
+sub parse_values($$)
+{
+  my ($self, $value) = @_;
+
+  my $elem_names  = [];
+  my $elem_values = [];
+  my $common_prefix = undef;
+
+  # break up the value statements
+  foreach(split(/\s*'*[()]\s*/, $value))
+  {
+    next if($_ eq "");
+
+    if(/^"\S+" "(\S+)" "([^"]+)"$/)
+    {
+      my ($name, $value) = ($1, $2);
+
+      # detect whether there is module prefix common to all names, e.g. GTK_
+      my $prefix = $1 if ($name =~ /^([^_]+_)/);
+
+      if (not defined($common_prefix))
+      {
+        $common_prefix = $prefix;
+      }
+      elsif ($prefix ne $common_prefix)
+      {
+        $common_prefix = "";
+      }
+
+      push(@$elem_names, $name);
+      push(@$elem_values, $value);
+    }
+    else
+    {
+      GtkDefs::error("Unknown value statement ($_) in $$self{c_type}\n");
+    }
+  }
+
+  if ($common_prefix)
+  {
+    # cut off the module prefix, e.g. GTK_
+    s/^$common_prefix// foreach (@$elem_names);
+  }
+
+  $$self{elem_names}  = $elem_names;
+  $$self{elem_values} = $elem_values;
+}
+
+sub beautify_values($)
+{
+  my ($self) = @_;
+
+  return if($$self{flags});
+
+  my $elem_names  = $$self{elem_names};
+  my $elem_values = $$self{elem_values};
+
+  my $num_elements = scalar(@$elem_values);
+  return if($num_elements == 0);
+
+  my $first = $$elem_values[0];
+  return if($first !~ /^-?[0-9]+$/);
+
+  my $prev = $first;
+
+  # Continuous?  (Aliases to prior enum values are allowed.)
+  foreach my $value (@$elem_values)
+  {
+    return if(($value < $first) || ($value > $prev + 1));
+    $prev = $value;
+  }
+
+  # This point is reached only if the values are a continuous range.
+  # 1) Let's kill all the superfluous values, for better readability.
+  # 2) Substitute aliases to prior enum values.
+
+  my %aliases = ();
+
+  for(my $i = 0; $i < $num_elements; ++$i)
+  {
+    my $value = \$$elem_values[$i];
+    my $alias = \$aliases{$$value};
+
+    if(defined($$alias))
+    {
+      $$value = $$alias;
+    }
+    else
+    {
+      $$alias = $$elem_names[$i];
+      $$value = "" unless($first != 0 && $$value == $first);
+    }
+  }
+}
+
+sub build_element_list($$$$)
+{
+  my ($self, $ref_flags, $ref_no_gtype, $indent) = @_;
+
+  my @subst_in  = [];
+  my @subst_out = [];
+
+  # Build a list of custom substitutions, and recognize some flags too.
+
+  foreach(@$ref_flags)
+  {
+    if(/^\s*(NO_GTYPE)\s*$/)
+    {
+      $$ref_no_gtype = $1;
+    }
+    elsif(/^\s*(get_type_func=)(\s*)\s*$/)
+    {
+      my $part1 = $1;
+      my $part2 = $2;
+    }
+    elsif(/^\s*s#([^#]+)#([^#]*)#\s*$/)
+    {
+      push(@subst_in,  $1);
+      push(@subst_out, $2);
+    }
+    elsif($_ !~ /^\s*$/)
+    {
+      return undef;
+    }
+  }
+
+  my $elem_names  = $$self{elem_names};
+  my $elem_values = $$self{elem_values};
+
+  my $num_elements = scalar(@$elem_names);
+  my $elements = "";
+
+  for(my $i = 0; $i < $num_elements; ++$i)
+  {
+    my $name  = $$elem_names[$i];
+    my $value = $$elem_values[$i];
+
+    for(my $ii = 0; $ii < scalar(@subst_in); ++$ii)
+    {
+      $name  =~ s/${subst_in[$ii]}/${subst_out[$ii]}/;
+      $value =~ s/${subst_in[$ii]}/${subst_out[$ii]}/;
+    }
+
+    $elements .= "${indent}${name}";
+    $elements .= " = ${value}" if($value ne "");
+    $elements .= ",\n" if($i < $num_elements - 1);
+  }
+
+  return $elements;
+}
+
+sub dump($)
+{
+  my ($self) = @_;
+
+  print "<enum module=\"$$self{module}\" type=\"$$self{type}\" flags=$$self{flags}>\n";
+
+  my $elem_names  = $$self{elem_names};
+  my $elem_values = $$self{elem_values};
+
+  for(my $i = 0; $i < scalar(@$elem_names); ++$i)
+  {
+    print "  <element name=\"$$elem_names[$i]\"  value=\"$$elem_values[$i]\"/>\n";
+  }
+
+  print "</enum>\n\n";
+}
+
+1; # indicate proper module load.

libs/glibmm2/tools/pm/Function.pm

@@ -0,0 +1,351 @@
+package Function;
+
+use strict;
+use warnings;
+use Util;
+use FunctionBase;
+
+BEGIN {
+     use Exporter   ();
+     our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
+
+     # set the version for version checking
+     $VERSION     = 1.00;
+     @ISA         = qw(FunctionBase);
+     @EXPORT      = qw(&func1 &func2 &func4);
+     %EXPORT_TAGS = ( );
+     # your exported package globals go here,
+     # as well as any optionally exported functions
+     @EXPORT_OK   = qw($Var1 %Hashit &func3);
+     }
+our @EXPORT_OK;
+
+##################################################
+### Function
+# Commonly used algorithm for parsing a function declaration into
+# its component pieces
+#
+#  class Function : FunctionBase
+#    {
+#       string rettype;
+#       bool const;
+#       bool static;
+#       string name; e.g. gtk_accelerator_valid
+#       string c_name;
+#       string array param_type;
+#       string array param_name;
+#       string array param_default_value;
+#       string in_module; e.g. Gtk
+#       string signal_when. e.g. first, last, or both.
+#       string class e.g. GtkButton ( == of-object. Useful for signal because their names are not unique.
+#       string entity_type. e.g. method or signal
+#    }
+
+sub new_empty()
+{
+  my $self = {};
+  bless $self;
+
+  return $self;
+}
+
+# $objFunction new($function_declaration, $objWrapParser)
+sub new($$)
+{
+  #Parse a function/method declaration.
+  #e.g. guint gtk_something_set_thing(guint a, const gchar* something)
+
+  my ($line, $objWrapParser) = @_;
+
+  my $self = {};
+  bless $self;
+
+  #Initialize member data:
+  $$self{rettype} = "";
+  $$self{rettype_needs_ref} = 0; #Often the gtk function doesn't do an extra ref for the receiver.
+  $$self{const} = 0;
+  $$self{name} = "";
+  $$self{param_types} = [];
+  $$self{param_names} = [];
+  $$self{param_default_values} = [];
+  $$self{in_module} = "";
+  $$self{class} = "";
+  $$self{entity_type} = "method";
+
+  $line =~ s/^\s+//;  # Remove leading whitespace.
+  $line =~ s/\s+/ /g; # Compress white space.
+
+  if ($line =~ /^static\s+([^()]+)\s+(\S+)\s*\((.*)\)\s*$/)
+  {
+    $$self{rettype} = $1;
+    $$self{name} = $2;
+    $$self{c_name} = $2;
+    $self->parse_param($3);
+    $$self{static} = 1;
+  }
+  elsif ($line =~ /^([^()]+)\s+(\S+)\s*\((.*)\)\s*(const)*$/)
+  {
+    no warnings qw(uninitialized); # disable the uninitialize warning for $4
+    $$self{rettype} = $1;
+    $$self{name} = $2;
+    $$self{c_name} = $2;
+    $self->parse_param($3);
+    $$self{const} = ($4 eq "const");
+  }
+  else
+  {
+    $objWrapParser->error("fail to parse $line\n");
+  }
+
+  return $self;
+}
+
+
+# $objFunction new_ctor($function_declaration, $objWrapParser)
+# Like new(), but the function_declaration doesn't need a return type.
+sub new_ctor($$)
+{
+  #Parse a function/method declaration.
+  #e.g. guint gtk_something_set_thing(guint a, const gchar* something)
+
+  my ($line, $objWrapParser) = @_;
+
+  my $self = {};
+  bless $self;
+
+  #Initialize member data:
+  $$self{rettype} = "";
+  $$self{rettype_needs_ref} = 0;
+  $$self{const} = 0;
+  $$self{name} = "";
+  $$self{param_types} = [];
+  $$self{param_names} = [];
+  $$self{param_default_values} = [];
+  $$self{in_module} = "";
+  $$self{class} = "";
+  $$self{entity_type} = "method";
+
+  $line =~ s/^\s+//;  # Remove leading whitespace.
+  $line =~ s/\s+/ /g; # Compress white space.
+
+  if ($line =~ /^(\S+)\s*\((.*)\)\s*/)
+  {
+    $$self{name} = $1;
+    $$self{c_name} = $2;
+    $self->parse_param($2);
+  }
+  else
+  {
+    $objWrapParser->error("fail to parse $line\n");
+  }
+
+  return $self;
+}
+
+# $num num_args()
+sub num_args #($)
+{
+  my ($self) = @_;
+  my $param_types = $$self{param_types};
+  return $#$param_types+1;
+}
+
+# parses C++ parameter lists.
+# forms a list of types, names, and initial values
+#  (we don't currently use values)
+sub parse_param($$)
+{
+  my ($self, $line) = @_;
+
+
+  my $type = "";
+  my $name = "";
+  my $value = "";
+  my $id = 0;
+  my $has_value = 0;
+
+  my $param_types = $$self{param_types};
+  my $param_names = $$self{param_names};
+  my $param_default_values = $$self{param_default_values};
+
+  # clean up space and handle empty case
+  $line = string_trim($line);
+  $line =~ s/\s+/ /g; # Compress whitespace.
+  return if ($line =~ /^$/);
+
+  # parse through argument list
+  my @str = ();
+  my $par = 0;
+  foreach (split(/(const )|([,=&*()])|(<[^,]*>)|(\s+)/, $line)) #special characters OR <something> OR whitespace.
+  {
+    next if ( !defined($_) or $_ eq "" );
+      
+    if ( $_ eq "(" ) #Detect the opening bracket.
+    {
+       push(@str, $_);
+       $par++; #Increment the number of parameters.
+       next;
+    }
+    elsif ( $_ eq ")" )
+    {
+       push(@str, $_);
+       $par--; #Decrement the number of parameters.
+       next;
+    }
+    elsif ( $par || /^(const )|(<[^,]*>)|([*&])|(\s+)/ ) #TODO: What's happening here?
+    {
+      push(@str, $_); #This looks like part of the type, so we store it.
+      next;
+    }
+    elsif ( $_ eq "=" ) #Default value
+    {
+      $type = join("", @str); #The type is everything before the = character.
+      @str = (); #Wipe it so that it will only contain the default value, which comes next.
+      $has_value = 1;
+      next;
+    }
+    elsif ( $_ eq "," ) #The end of one parameter:
+    {
+      if ($has_value)
+      {
+        $value = join("", @str); # If there's a default value, then it's the part before the next ",".
+      }
+      else
+      {
+        $type = join("", @str);
+      }
+
+      if ($name eq "")
+      {
+        $name = sprintf("p%s", $#$param_types + 2)
+      }
+
+      $type = string_trim($type);
+
+      push(@$param_types, $type);
+      push(@$param_names, $name);
+      push(@$param_default_values, $value);
+      
+      #Clear variables, ready for the next parameter.
+      @str = ();
+      $type= "";
+      $value = "";
+      $has_value = 0;
+      $name = "";
+
+      $id = 0;
+
+      next;
+    }
+
+    if ($has_value)
+    {
+      push(@str, $_);
+      next;
+    }
+
+    $id++;
+    $name = $_ if ($id == 2);
+    push(@str, $_) if ($id == 1);
+
+    if ($id > 2)
+    {
+      print STDERR "Can't parse $line.\n";
+      print STDERR "  arg type so far: $type\n";
+      print STDERR "  arg name so far: $name\n";
+      print STDERR "  arg default value so far: $value\n";
+    }
+  }
+
+  # handle last argument  (There's no , at the end.)
+  if ($has_value)
+  {
+    $value = join("", @str);
+  }
+  else
+  {
+    $type = join("", @str);
+  }
+
+  if ($name eq "")
+  {
+    $name = sprintf("p%s", $#$param_types + 2)
+  }
+
+  $type = string_trim($type);
+
+  push(@$param_types, $type);
+  push(@$param_names, $name);
+  push(@$param_default_values, $value);
+}
+
+# add_parameter_autoname($, $type, $name)
+# Adds e.g "sometype somename"
+sub add_parameter_autoname($$)
+{
+  my ($self, $type) = @_;
+
+  add_parameter($self, $type, "");
+}
+
+# add_parameter($, $type, $name)
+# Adds e.g GtkSomething* p1"
+sub add_parameter($$$)
+{
+  my ($self, $type, $name) = @_;
+  $type = string_unquote($type);
+  $type =~ s/-/ /g;
+
+  my $param_names = $$self{param_names};
+
+  if ($name eq "")
+  {
+    $name = sprintf("p%s", $#$param_names + 2);
+  }
+
+  push(@$param_names, $name);
+
+  my $param_types = $$self{param_types};
+
+  push(@$param_types, $type);
+
+  return $self;
+}
+
+# $string get_refdoc_comment()
+# Generate a readable prototype for signals.
+sub get_refdoc_comment($)
+{
+  my ($self) = @_;
+
+  my $str = "  /**\n";
+
+  $str .= "   * \@par Prototype:\n";
+  $str .= "   * <tt>$$self{rettype} on_my_\%$$self{name}(";
+
+  my $param_names = $$self{param_names};
+  my $param_types = $$self{param_types};
+  my $num_params  = scalar(@$param_types);
+
+  # List the parameters:
+  for(my $i = 0; $i < $num_params; ++$i)
+  {
+    $str .= $$param_types[$i] . ' ' . $$param_names[$i];
+    $str .= ", " if($i < $num_params - 1);
+  }
+
+  $str .= ")</tt>\n";
+  $str .= "   */";
+
+  return $str;
+}
+
+sub get_is_const($)
+{
+  my ($self) = @_;
+
+  return $$self{const};
+}
+
+1; # indicate proper module load.
+

libs/glibmm2/tools/pm/FunctionBase.pm

@@ -0,0 +1,217 @@
+package FunctionBase;
+
+use strict;
+use warnings;
+use Util;
+
+BEGIN {
+     use Exporter   ();
+     our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
+
+     # set the version for version checking
+     $VERSION     = 1.00;
+     @ISA         = qw(Exporter);
+     @EXPORT      = qw(&func1 &func2 &func4);
+     %EXPORT_TAGS = ( );
+     # your exported package globals go here,
+     # as well as any optionally exported functions
+     @EXPORT_OK   = qw($Var1 %Hashit &func3);
+     }
+our @EXPORT_OK;
+
+##################################################
+### FunctionBase
+# Contains data and methods used by both Function (C++ declarations) and GtkDefs::Function (C defs descriptions)
+# Note that GtkDefs::Signal inherits from GtkDefs::Function so it get these methods too.
+#
+#  class Function : FunctionBase
+#    {
+#       string array param_types;
+#       string array param_names;
+#       string array param_documentation;
+#       string return_documention;
+#    }
+
+
+# $string args_types_only($)
+# comma-delimited argument types.
+sub args_types_only($)
+{
+  my ($self) = @_;
+
+  my $param_types = $$self{param_types};
+  return join(", ", @$param_types);
+}
+
+# $string args_names_only($)
+sub args_names_only($)
+{
+  my ($self) = @_;
+
+  my $param_names = $$self{param_names};
+  return join(", ", @$param_names);
+}
+
+# $string args_types_and_names($)
+sub args_types_and_names($)
+{
+  my ($self) = @_;
+
+  my $i;
+
+  my $param_names = $$self{param_names};
+  my $param_types = $$self{param_types};
+  my @out;
+
+  #debugging:
+  #if($#$param_types)
+  #{
+  #  return "NOARGS";
+  #}
+
+  for ($i = 0; $i < $#$param_types + 1; $i++)
+  {
+    my $str = sprintf("%s %s", $$param_types[$i], $$param_names[$i]);
+    push(@out, $str);
+  }
+
+  my $result =  join(", ", @out);
+  return $result;
+}
+
+# $string args_names_only_without_object($)
+sub args_names_only_without_object2($)
+{
+  my ($self) = @_;
+
+  my $param_names = $$self{param_names};
+
+  my $result = "";
+  my $bInclude = 0; #Ignore the first (object) arg.
+  foreach (@{$param_names})
+  {
+    # Add comma if there was an arg before this one:
+    if( $result ne "")
+    {
+      $result .= ", ";
+    }
+
+    # Append this arg if it's not the first one:
+    if($bInclude)
+    {
+      $result .= $_;
+    }
+
+    $bInclude = 1;
+  }
+
+  return $result;
+}
+
+# $string args_types_and_names_without_object($)
+sub args_types_and_names_without_object($)
+{
+  my ($self) = @_;
+
+  my $param_names = $$self{param_names};
+  my $param_types = $$self{param_types};
+  my $i = 0;
+  my @out;
+
+  for ($i = 1; $i < $#$param_types + 1; $i++) #Ignore the first arg.
+  {
+    my $str = sprintf("%s %s", $$param_types[$i], $$param_names[$i]);
+    push(@out, $str);
+  }
+
+  return join(", ", @out);
+}
+
+# $string args_names_only_without_object($)
+sub args_names_only_without_object($)
+{
+  my ($self) = @_;
+
+  my $param_names = $$self{param_names};
+
+  my $result = "";
+  my $bInclude = 0; #Ignore the first (object) arg.
+  foreach (@{$param_names})
+  {
+    # Add comma if there was an arg before this one:
+    if( $result ne "")
+    {
+      $result .= ", ";
+    }
+
+    # Append this arg if it's not the first one:
+    if($bInclude)
+    {
+      $result .= $_;
+    }
+
+    $bInclude = 1;
+  }
+
+  return $result;
+}
+
+sub dump($)
+{
+  my ($self) = @_;
+
+  my $param_types = $$self{param_types};
+  my $param_names = $$self{param_names};
+
+  print "<function>\n";
+  foreach (keys %$self)
+  {
+    print "  <$_ value=\"$$self{$_}\"/>\n" if (!ref $$self{$_} && $$self{$_} ne "");
+  }
+
+  if (scalar(@$param_types)>0)
+  {
+    print "  <parameters>\n";
+
+    for (my $i = 0; $i < scalar(@$param_types); $i++)
+    {
+      print "    \"$$param_types[$i]\" \"$$param_names[$i]\" \n";
+    }
+
+    print "  </parameters>\n";
+  }
+
+  print "</function>\n\n";
+}
+
+sub args_types_and_names_with_default_values($)
+{
+  my ($self) = @_;
+
+  my $i;
+
+  my $param_names = $$self{param_names};
+  my $param_types = $$self{param_types};
+  my $param_default_values = $$self{param_default_values};
+  my @out;
+  
+  for ($i = 0; $i < $#$param_types + 1; $i++)
+  {
+    my $str = sprintf("%s %s", $$param_types[$i], $$param_names[$i]);
+
+    if(defined($$param_default_values[$i]))
+    {
+      if($$param_default_values[$i] ne "")
+      {
+        $str .= " = " . $$param_default_values[$i];
+      }
+    }
+
+    push(@out, $str);
+  }
+
+  return join(", ", @out);
+}
+
+1; # indicate proper module load.
+

libs/glibmm2/tools/pm/GtkDefs.pm

@@ -0,0 +1,635 @@
+# gtkmm - GtkDefs 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, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+#
+package GtkDefs;
+use strict;
+use warnings;
+
+use Util;
+use Enum;
+use Object;
+use Property;
+use FunctionBase;
+
+#
+#  Public functions
+#    read_defs(path, file)
+#
+#    @ get_methods()
+#    @ get_signals()
+#    @ get_properties()
+#
+#    $ lookup_enum(c_type)
+#    $ lookup_object(c_name)
+#    $ lookup_method(c_name)
+#    $ lookup_function(c_name)
+#    $ lookup_property(object, c_name)
+#    $ lookup_signal(object, c_name)
+#
+
+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;
+
+#####################################
+
+use strict;
+use warnings;
+
+#####################################
+
+%GtkDefs::enums = (); #Enum
+%GtkDefs::objects = (); #Object
+%GtkDefs::methods = (); #GtkDefs::Function
+%GtkDefs::signals = (); #GtkDefs::Signal
+%GtkDefs::properties = (); #Property
+
+@GtkDefs::read = ();
+@GtkDefs::file = ();
+
+
+#####################################
+#prototype to get rid of warning
+sub read_defs($$;$);
+
+sub read_defs($$;$)
+{
+  my ($path, $filename, $restrict) = @_;
+  $restrict = "" if ($#_ < 2);
+
+  # check that the file is there.
+  if ( ! -r "$path/$filename")
+  {
+     print "Error: can't read defs file $filename\n";
+     return;
+  }
+
+  # break the tokens into lisp phrases up to three levels deep.
+  #   WARNING: reading the following perl statement may induce seizures,
+  #   please flush eyes with water immediately, and consult a mortician.
+  my @tokens = split(
+    m/(
+        \(
+        (?:
+            [^()]*
+            \(
+            (?:
+                [^()]*
+                \(
+                [^()]*
+                \)
+            )*
+            [^()]*
+            \)
+        )*
+        [^()]*
+        \)
+    )/x,
+    read_file($path, $filename));
+
+  # scan through top level tokens
+  while ($#tokens > -1)
+  {
+    my $token = shift @tokens;
+    next if ($token =~ /^\s*$/);
+
+    if ($token =~ /\(include (\S+)\)/)
+    {
+      read_defs($path,$1,$restrict);
+      next;
+    }
+    elsif ($token =~ /^\(define-flags-extended.*\)$/)
+    { on_enum($token); }
+    elsif ($token =~ /^\(define-enum-extended.*\)$/)
+    { on_enum($token); }
+    elsif ($token =~ /^\(define-flags.*\)$/)
+    { }
+    elsif ($token =~ /^\(define-enum.*\)$/)
+    { }
+    elsif ($token =~ /^\(define-object.*\)$/)
+    { on_object($token); }
+    elsif ($token =~ /^\(define-function.*\)$/)
+    { on_function($token); }
+    elsif ($token =~ /^\(define-method.*\)$/)
+    { on_method($token); }
+    elsif ($token =~ /^\(define-property.*\)$/)
+    { on_property($token); }
+    elsif ($token =~ /^\(define-signal.*\)$/)
+    { on_signal($token);  }
+    elsif ($token =~ /^\(define-vfunc.*\)$/)
+    { on_vfunc($token); }
+    else
+    {
+      if ( $token =~ /^\(define-(\S+) (\S+)/)
+      {
+        # FIXME need to figure out the line number.
+        print STDERR "Broken lisp definition for $1 $2.\n";
+      }
+      else
+      {
+        print "unknown token $token \n";
+      }
+    }
+  }
+}
+
+
+sub read_file($$)
+{
+  my ($path, $filename)=@_;
+  my @buf = ();
+
+  # don't read a file twice
+  foreach (@GtkDefs::read)
+  {
+    return "" if ($_ eq "$path/$filename");
+  }
+  push @GtkDefs::read, "$path/$filename";
+
+  # read file while stripping comments
+  open(FILE, "$path/$filename");
+  while (<FILE>)
+  {
+     s/^;.*$//;  # remove comments
+     chop;      # remove new lines
+     push(@buf, $_);
+  }
+  close(FILE);
+
+  $_ = join("", @buf);
+  s/\s+/ /g;
+  return $_;
+}
+
+
+sub on_enum($)
+{
+  my $thing = Enum::new(shift(@_));
+  $GtkDefs::enums{$$thing{c_type}} = $thing;
+}
+
+sub on_object($)
+{
+  my $thing = Object::new(shift(@_));
+  $GtkDefs::objects{$$thing{c_name}} = $thing;
+}
+
+sub on_function($)
+{
+  my $thing = GtkDefs::Function::new(shift(@_));
+  $GtkDefs::methods{$$thing{c_name}} = $thing;
+}
+
+sub on_method($)
+{
+  my $thing = GtkDefs::Function::new(shift(@_));
+  $GtkDefs::methods{$$thing{c_name}} = $thing if ($thing);
+}
+
+sub on_property($)
+{
+  my $thing = Property::new(shift(@_));
+  $GtkDefs::properties{"$$thing{class}::$$thing{name}"} = $thing;
+}
+
+sub on_signal($)
+{
+  my $thing = GtkDefs::Signal::new(shift(@_));
+  $GtkDefs::signals{"$$thing{class}::$$thing{name}"} = $thing;
+}
+
+sub on_vfunc($)
+{
+  my $thing = GtkDefs::Signal::new(shift(@_));
+  $GtkDefs::signals{"$$thing{class}::$$thing{name}"} = $thing;
+}
+
+##########################
+
+sub get_enums
+{
+  return sort {$$a{c_type} cmp $$b{c_type}} values %GtkDefs::enums;
+}
+sub get_methods
+{
+  return sort {$$a{c_name} cmp $$b{c_name}} values %GtkDefs::methods;
+}
+sub get_signals
+{
+  return sort {$$a{name} cmp $$b{name}} values %GtkDefs::signals;
+}
+sub get_properties
+{
+  return sort {$$a{name} cmp $$b{name}} values %GtkDefs::properties;
+}
+
+sub get_marked
+{
+  no warnings;
+  return grep {$$_{mark}==1} values %GtkDefs::methods; 
+}
+
+# This searches for items wrapped by this file and then tries to locate
+# other functions/signal/properties which may have been left unmarked.
+sub get_unwrapped
+{
+  # find methods which were used in for a _WRAP
+  my @targets;
+  push @targets,grep {$$_{entity_type} eq "method" && $$_{mark}==1} values %GtkDefs::methods;
+  push @targets,grep {$$_{mark}==1} values %GtkDefs::signals;
+  push @targets,grep {$$_{mark}==1} values %GtkDefs::properties;
+
+  # find the classes which used them.
+  my @classes = join(" ", unique(map { $$_{class} } @targets));
+
+  # find methods which are in those classes which didn't get marked.
+  my @unwrapped;
+  my $class;
+  foreach $class (@classes)
+  {
+    push @unwrapped, grep {$$_{class} eq $class && $$_{mark}==0} values %GtkDefs::methods;
+    push @unwrapped, grep {$$_{class} eq $class && $$_{mark}==0} values %GtkDefs::properties;
+    push @unwrapped, grep {$$_{class} eq $class && $$_{mark}==0} values %GtkDefs::signals;
+  }
+
+  return @unwrapped;
+}
+
+##########################
+
+sub lookup_enum($)
+{
+  no warnings;
+  my ($c_type) = @_;
+  my $obj = $GtkDefs::enums{$c_type};
+  return 0 if(!$obj);
+  $$obj{mark} = 1;
+  return $obj;
+}
+
+sub lookup_object($)
+{
+  no warnings;
+  return $GtkDefs::objects{$_[0]};
+}
+
+# $objProperty lookup_property($name, $parent_object_name)
+sub lookup_property($$)
+{
+  no warnings;
+  my ($parent_object_name, $name) = @_;
+  $name =~ s/-/_/g;
+  my $obj = $GtkDefs::properties{"${parent_object_name}::${name}"};
+  return 0 if ($obj eq "");
+  $$obj{mark} = 1;
+  return $obj;
+}
+
+sub lookup_method_dont_mark($)
+{
+  no warnings;
+  my ($c_name) = @_;
+  $c_name =~ s/-/_/g;
+
+  my $obj = $GtkDefs::methods{$c_name};
+  return 0 if ($obj eq "");
+
+  return $obj;
+}
+
+sub lookup_method($)
+{
+  my $obj = lookup_method_dont_mark($_);
+
+  $$obj{mark} = 1 if($obj);
+  return $obj;
+}
+
+sub lookup_function($)
+{
+  return lookup_method($_[0]);
+}
+
+sub lookup_signal($$)
+{
+  no warnings;
+  my ($parent_object_name, $name) = @_;
+
+  $name =~ s/-/_/g;
+  my $obj = $GtkDefs::signals{"${parent_object_name}::${name}"};
+  return 0 if ($obj eq "");
+  $$obj{mark} = 1;
+  return $obj;
+}
+
+sub error
+{
+  my $format = shift @_;
+  printf STDERR "GtkDefs.pm: $format\n", @_;
+}
+
+
+########################################################################
+package GtkDefs::Function;
+BEGIN { @GtkDefs::Function::ISA=qw(FunctionBase); }
+
+#  class Function : FunctionBase
+#
+#    {
+#       string name; e.g. gtk_accelerator_valid
+#       string c_name;
+#       string class e.g. GtkButton 
+#
+#       string rettype;
+#       string array param_types;
+#       string array param_names;
+#
+#       string entity_type. e.g. method or signal
+#
+#       bool varargs;
+#       bool mark;
+#
+#    }
+
+# "new" can't have prototype
+sub new
+{
+  my ($def) = @_;
+  my $whole = $def;
+  my $self = {};
+  bless $self;
+
+  $def =~ s/^\(//;
+  $def =~ s/\)$//;
+  $def =~ s/^\s*define-(\S+)\s+(\S+)\s*//;
+  $$self{entity_type} = $1;
+  $$self{name} = $2;
+  $$self{name} =~ s/-/_/g; # change - to _
+
+  # init variables
+  $$self{mark} = 0;
+  $$self{rettype} = "none";
+  $$self{param_types} = [];
+  $$self{param_names} = [];
+  $$self{class} = "";
+
+  # snarf down lisp fields
+  $$self{c_name} = $1     if ($def=~s/\(c-name "(\S+)"\)//);
+  $$self{class} = $1      if ($def=~s/\(of-object "(\S+)"\)//);
+
+  if ($def =~ s/\(return-type "(\S+)"\)//)
+  {
+    $$self{rettype} = $1;
+    $$self{rettype} =~ s/-/ /g; #e.g. replace const-gchar* with const gchar*. Otherwise it will be used in code.
+  }
+
+  $$self{varargs} = 1     if ($def=~s/\(varargs\s+#t\)//);
+  $$self{rettype} = "void"  if ($$self{rettype} eq "none");
+
+  # methods have a parameter not stated in the defs file
+  if ($$self{entity_type} eq "method")
+  {
+    push( @{$$self{param_types}}, "$$self{class}*" );
+    push( @{$$self{param_names}}, "self" );
+  }
+
+  # parameters are compound lisp statement
+  if ($def =~ s/\(parameters(( '\("\S+" "\S+"\))*) \)//)
+  {
+    $self->parse_param($1);
+  }
+
+  # is-constructor-of:
+  if ($def =~ s/\(is-constructor-of "(\S+)"\)//)
+  {
+    #Ignore them.
+  }
+  
+  # of-object
+  if ($def =~ s/\(of-object "(\S+)"\)//)
+  {
+    #Ignore them.
+  }
+
+  GtkDefs::error("Unhandled function parameter ($def) in $$self{c_name}\n")
+    if ($def !~ /^\s*$/);
+
+  return $self;
+}
+
+sub parse_param($$)
+{
+  my ($self, $param) = @_;
+
+  # break up the parameter statements
+  foreach (split(/\s*'*[()]\s*/, $param))
+  {
+    next if ($_ eq "");
+    if (/^"(\S+)" "(\S+)"$/)
+    {
+      my ($p1, $p2) = ($1,$2);
+      $p1 =~ s/-/ /;
+      push( @{$$self{param_types}}, $p1);
+      push( @{$$self{param_names}}, $p2);
+    }
+    else
+    {
+      GtkDefs::error("Unknown parameter statement ($_) in $$self{c_name}\n");
+    }
+  }
+}
+
+
+# $string get_return_type_for_methods().
+# Changes gchar* (not const-gchar*) to return-gchar* so that _CONVERT knows that it needs to be freed.
+sub get_return_type_for_methods($)
+{
+  my ($self) = @_;
+
+  my $rettype = $$self{rettype};
+  if($rettype eq "gchar*" || $rettype eq "char*")
+  {
+    $rettype = "return-" . $rettype;
+  }
+
+  return $rettype;
+}
+
+sub get_param_names
+{
+  my ($self) = @_;
+  return @$self{param_names};
+}
+
+######################################################################
+package GtkDefs::Signal;
+BEGIN { @GtkDefs::Signal::ISA=qw(GtkDefs::Function); }
+
+#  class Signal : Function
+#    {
+#       string name; e.g. gtk_accelerator_valid
+#       string class e.g. GtkButton ( == of-object.)
+#
+#       string rettype;
+#
+#       string when. e.g. first, last, or both.
+#       string entity_type. e.g. method or signal
+#    }
+
+# "new" can't have prototype
+sub new
+{
+  my ($def) = @_;
+
+  my $whole = $def;
+  my $self = {};
+  bless $self;
+
+  #Remove first and last braces:
+  $def =~ s/^\(//;
+  $def =~ s/\)$//;
+
+  $def =~ s/^\s*define-(\S+)\s+(\S+)\s*//;
+  $$self{entity_type} = $1;
+  $$self{name} = $2;
+  $$self{name} =~ s/-/_/g; #change - to _
+
+  # init variables
+  $$self{mark}=0;
+  $$self{rettype} = "none";
+  $$self{param_types} = [];
+  $$self{param_names} = [];
+  $$self{when} = "";
+  $$self{class} = "";
+
+  # snarf down lisp fields
+  if($def =~ s/\(of-object "(\S+)"\)//)
+  {
+    $$self{class} = $1;
+  }
+  else
+  {
+    GtkDefs::error("define-signal/define-vfunc without of-object (entity type: $$self{entity_type}): $whole");
+  }
+
+  if($def =~ s/\(return-type "(\S+)"\)//)
+  {
+    $$self{rettype} = $1;
+    $$self{rettype} =~ s/-/ /g; #e.g. replace const-gchar* with const gchar*. Otherwise it will be used in code.
+  }
+
+  if($def =~ s/\(when "(\S+)"\)//)
+  {
+    $$self{when} = $1;
+  }
+
+  if($$self{rettype} eq "none")
+  {
+    $$self{rettype} = "void"
+  }
+
+  # signals always have a parameter
+  push(@{$$self{param_types}}, "$$self{class}*");
+  push(@{$$self{param_names}}, "self");
+
+  # parameters are compound lisp statement
+  if ($def =~ s/\(parameters(( '\("\S+" "\S+"\))+) \)//)
+  {
+    $self->parse_param($1);
+  }
+
+  if ($def!~/^\s*$/)
+  {
+	  GtkDefs::error("Unhandled signal/vfunc def ($def) in $$self{class}::$$self{name}");
+  }
+
+  return $self;
+}
+
+# bool has_same_types($objFunction)
+# Compares return types and argument types
+sub has_same_types($$)
+{
+  my ($self, $objFuncOther) = @_;
+
+  #Compare return types:
+  if($self->types_are_equal($$self{rettype}, $$objFuncOther{rettype}) ne 1)
+  {
+    # printf("debug: different return types: %s, %s\n", $$self{rettype}, $$objFuncOther{rettype});
+    return 0; #Different types found.
+  }
+
+  #Compare arguement types:
+  my $i = 0;
+  my $param_types = $$self{param_types};
+  my $param_types_other = $$objFuncOther{param_types};
+  for ($i = 1; $i < $#$param_types + 1; $i++)
+  {
+    my $type_a = $$param_types[$i];
+    my $type_b = $$param_types_other[$i-1];
+
+    if($self->types_are_equal($type_a, $type_b) ne 1)
+    {
+      # printf("debug: different arg types: %s, %s\n", $type_a, $type_b);
+      return 0; #Different types found.
+    }
+  }
+
+  return 1; #They must all be the same for it to get this far.
+}
+
+# bool types_are_equal($a, $b)
+# Compares types, ignoring gint/int differences, etc.
+sub types_are_equal($$$)
+{
+  #TODO: Proper method of getting a normalized type name.
+
+  my ($self, $type_a, $type_b) = @_;
+
+  if($type_a ne $type_b)
+  {
+    #Try adding g to one of them:
+    if( ("g" . $type_a) ne $type_b )
+    {
+      #Try adding g to the other one:
+      if( $type_a ne ("g" . $type_b) )
+      {
+        #After all these checks it's still not equal:
+        return 0; #not equal.
+      }
+    }
+  }
+
+  # printf("DEBUG: types are equal: %s, %s\n", $$type_a, $$type_b);
+  return 1; #They must be the same for it to get this far.
+}
+
+1; # indicate proper module load.

libs/glibmm2/tools/pm/Makefile.am

@@ -0,0 +1,10 @@
+
+include $(top_srcdir)/tools/pm/Makefile_list_of_sources.am_fragment
+
+EXTRA_DIST = Makefile_list_of_sources.am_fragment $(files_tools_pm)
+
+# Install the .pm, files:
+
+tools_pm_includedir = $(libdir)/glibmm-2.4/proc/pm
+tools_pm_include_HEADERS = $(files_tools_pm)
+

libs/glibmm2/tools/pm/Makefile.in

@@ -0,0 +1,432 @@
+# Makefile.in generated by automake 1.10 from Makefile.am.
+# @configure_input@
+
+# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
+# 2003, 2004, 2005, 2006  Free Software Foundation, Inc.
+# This Makefile.in is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
+# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+# PARTICULAR PURPOSE.
+
+@SET_MAKE@
+
+VPATH = @srcdir@
+pkgdatadir = $(datadir)/@PACKAGE@
+pkglibdir = $(libdir)/@PACKAGE@
+pkgincludedir = $(includedir)/@PACKAGE@
+am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
+install_sh_DATA = $(install_sh) -c -m 644
+install_sh_PROGRAM = $(install_sh) -c
+install_sh_SCRIPT = $(install_sh) -c
+INSTALL_HEADER = $(INSTALL_DATA)
+transform = $(program_transform_name)
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+build_triplet = @build@
+host_triplet = @host@
+DIST_COMMON = $(srcdir)/Makefile.am $(srcdir)/Makefile.in \
+	$(tools_pm_include_HEADERS) \
+	$(top_srcdir)/tools/pm/Makefile_list_of_sources.am_fragment
+subdir = tools/pm
+ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
+am__aclocal_m4_deps = $(top_srcdir)/scripts/c_std.m4 \
+	$(top_srcdir)/scripts/cxx.m4 $(top_srcdir)/scripts/cxx_std.m4 \
+	$(top_srcdir)/scripts/docgen.m4 \
+	$(top_srcdir)/scripts/glibmm_check_perl.m4 \
+	$(top_srcdir)/scripts/macros.m4 \
+	$(top_srcdir)/scripts/reduced.m4 $(top_srcdir)/scripts/sun.m4 \
+	$(top_srcdir)/configure.in
+am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
+	$(ACLOCAL_M4)
+mkinstalldirs = $(install_sh) -d
+CONFIG_HEADER = $(top_builddir)/config.h \
+	$(top_builddir)/glib/glibmmconfig.h
+CONFIG_CLEAN_FILES =
+SOURCES =
+DIST_SOURCES =
+am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
+am__vpath_adj = case $$p in \
+    $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
+    *) f=$$p;; \
+  esac;
+am__strip_dir = `echo $$p | sed -e 's|^.*/||'`;
+am__installdirs = "$(DESTDIR)$(tools_pm_includedir)"
+tools_pm_includeHEADERS_INSTALL = $(INSTALL_HEADER)
+HEADERS = $(tools_pm_include_HEADERS)
+ETAGS = etags
+CTAGS = ctags
+DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
+ACLOCAL = @ACLOCAL@
+AMTAR = @AMTAR@
+AR = @AR@
+AS = @AS@
+AUTOCONF = @AUTOCONF@
+AUTOHEADER = @AUTOHEADER@
+AUTOMAKE = @AUTOMAKE@
+AWK = @AWK@
+CC = @CC@
+CCDEPMODE = @CCDEPMODE@
+CFLAGS = @CFLAGS@
+CPP = @CPP@
+CPPFLAGS = @CPPFLAGS@
+CXX = @CXX@
+CXXCPP = @CXXCPP@
+CXXDEPMODE = @CXXDEPMODE@
+CXXFLAGS = @CXXFLAGS@
+CYGPATH_W = @CYGPATH_W@
+DEFS = @DEFS@
+DEPDIR = @DEPDIR@
+DISABLE_DEPRECATED_API_CFLAGS = @DISABLE_DEPRECATED_API_CFLAGS@
+DISABLE_DEPRECATED_CFLAGS = @DISABLE_DEPRECATED_CFLAGS@
+DLLTOOL = @DLLTOOL@
+ECHO = @ECHO@
+ECHO_C = @ECHO_C@
+ECHO_N = @ECHO_N@
+ECHO_T = @ECHO_T@
+EGREP = @EGREP@
+EXEEXT = @EXEEXT@
+F77 = @F77@
+FFLAGS = @FFLAGS@
+GLIBMM_CFLAGS = @GLIBMM_CFLAGS@
+GLIBMM_LIBS = @GLIBMM_LIBS@
+GLIBMM_MAJOR_VERSION = @GLIBMM_MAJOR_VERSION@
+GLIBMM_MICRO_VERSION = @GLIBMM_MICRO_VERSION@
+GLIBMM_MINOR_VERSION = @GLIBMM_MINOR_VERSION@
+GLIBMM_RELEASE = @GLIBMM_RELEASE@
+GLIBMM_VERSION = @GLIBMM_VERSION@
+GREP = @GREP@
+GTHREAD_CFLAGS = @GTHREAD_CFLAGS@
+GTHREAD_LIBS = @GTHREAD_LIBS@
+GTKMMPROC_MERGECDOCS = @GTKMMPROC_MERGECDOCS@
+GTKMM_DOXYGEN_INPUT = @GTKMM_DOXYGEN_INPUT@
+INSTALL = @INSTALL@
+INSTALL_DATA = @INSTALL_DATA@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_SCRIPT = @INSTALL_SCRIPT@
+INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
+LDFLAGS = @LDFLAGS@
+LIBGLIBMM_SO_VERSION = @LIBGLIBMM_SO_VERSION@
+LIBOBJS = @LIBOBJS@
+LIBS = @LIBS@
+LIBTOOL = @LIBTOOL@
+LN_S = @LN_S@
+LTLIBOBJS = @LTLIBOBJS@
+M4 = @M4@
+MAINT = @MAINT@
+MAKEINFO = @MAKEINFO@
+MKDIR_P = @MKDIR_P@
+OBJDUMP = @OBJDUMP@
+OBJEXT = @OBJEXT@
+PACKAGE = @PACKAGE@
+PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
+PACKAGE_NAME = @PACKAGE_NAME@
+PACKAGE_STRING = @PACKAGE_STRING@
+PACKAGE_TARNAME = @PACKAGE_TARNAME@
+PACKAGE_VERSION = @PACKAGE_VERSION@
+PATH_SEPARATOR = @PATH_SEPARATOR@
+PERL_PATH = @PERL_PATH@
+PKG_CONFIG = @PKG_CONFIG@
+RANLIB = @RANLIB@
+SET_MAKE = @SET_MAKE@
+SHELL = @SHELL@
+STRIP = @STRIP@
+VERSION = @VERSION@
+abs_builddir = @abs_builddir@
+abs_srcdir = @abs_srcdir@
+abs_top_builddir = @abs_top_builddir@
+abs_top_srcdir = @abs_top_srcdir@
+ac_ct_CC = @ac_ct_CC@
+ac_ct_CXX = @ac_ct_CXX@
+ac_ct_F77 = @ac_ct_F77@
+am__include = @am__include@
+am__leading_dot = @am__leading_dot@
+am__quote = @am__quote@
+am__tar = @am__tar@
+am__untar = @am__untar@
+bindir = @bindir@
+build = @build@
+build_alias = @build_alias@
+build_cpu = @build_cpu@
+build_os = @build_os@
+build_vendor = @build_vendor@
+builddir = @builddir@
+datadir = @datadir@
+datarootdir = @datarootdir@
+docdir = @docdir@
+dvidir = @dvidir@
+exec_prefix = @exec_prefix@
+host = @host@
+host_alias = @host_alias@
+host_cpu = @host_cpu@
+host_os = @host_os@
+host_vendor = @host_vendor@
+htmldir = @htmldir@
+includedir = @includedir@
+infodir = @infodir@
+install_sh = @install_sh@
+libdir = @libdir@
+libexecdir = @libexecdir@
+localedir = @localedir@
+localstatedir = @localstatedir@
+mandir = @mandir@
+mkdir_p = @mkdir_p@
+oldincludedir = @oldincludedir@
+pdfdir = @pdfdir@
+prefix = @prefix@
+program_transform_name = @program_transform_name@
+psdir = @psdir@
+sbindir = @sbindir@
+sharedstatedir = @sharedstatedir@
+srcdir = @srcdir@
+sysconfdir = @sysconfdir@
+target_alias = @target_alias@
+top_builddir = @top_builddir@
+top_srcdir = @top_srcdir@
+files_tools_pm = DocsParser.pm GtkDefs.pm Enum.pm Function.pm FunctionBase.pm Object.pm Output.pm Property.pm Util.pm WrapParser.pm
+EXTRA_DIST = Makefile_list_of_sources.am_fragment $(files_tools_pm)
+
+# Install the .pm, files:
+tools_pm_includedir = $(libdir)/glibmm-2.4/proc/pm
+tools_pm_include_HEADERS = $(files_tools_pm)
+all: all-am
+
+.SUFFIXES:
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(top_srcdir)/tools/pm/Makefile_list_of_sources.am_fragment $(am__configure_deps)
+	@for dep in $?; do \
+	  case '$(am__configure_deps)' in \
+	    *$$dep*) \
+	      cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh \
+		&& exit 0; \
+	      exit 1;; \
+	  esac; \
+	done; \
+	echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu  tools/pm/Makefile'; \
+	cd $(top_srcdir) && \
+	  $(AUTOMAKE) --gnu  tools/pm/Makefile
+.PRECIOUS: Makefile
+Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
+	@case '$?' in \
+	  *config.status*) \
+	    cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
+	  *) \
+	    echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
+	    cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
+	esac;
+
+$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
+
+$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
+$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
+
+mostlyclean-libtool:
+	-rm -f *.lo
+
+clean-libtool:
+	-rm -rf .libs _libs
+install-tools_pm_includeHEADERS: $(tools_pm_include_HEADERS)
+	@$(NORMAL_INSTALL)
+	test -z "$(tools_pm_includedir)" || $(MKDIR_P) "$(DESTDIR)$(tools_pm_includedir)"
+	@list='$(tools_pm_include_HEADERS)'; for p in $$list; do \
+	  if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \
+	  f=$(am__strip_dir) \
+	  echo " $(tools_pm_includeHEADERS_INSTALL) '$$d$$p' '$(DESTDIR)$(tools_pm_includedir)/$$f'"; \
+	  $(tools_pm_includeHEADERS_INSTALL) "$$d$$p" "$(DESTDIR)$(tools_pm_includedir)/$$f"; \
+	done
+
+uninstall-tools_pm_includeHEADERS:
+	@$(NORMAL_UNINSTALL)
+	@list='$(tools_pm_include_HEADERS)'; for p in $$list; do \
+	  f=$(am__strip_dir) \
+	  echo " rm -f '$(DESTDIR)$(tools_pm_includedir)/$$f'"; \
+	  rm -f "$(DESTDIR)$(tools_pm_includedir)/$$f"; \
+	done
+
+ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
+	list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	mkid -fID $$unique
+tags: TAGS
+
+TAGS:  $(HEADERS) $(SOURCES)  $(TAGS_DEPENDENCIES) \
+		$(TAGS_FILES) $(LISP)
+	tags=; \
+	here=`pwd`; \
+	list='$(SOURCES) $(HEADERS)  $(LISP) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	if test -z "$(ETAGS_ARGS)$$tags$$unique"; then :; else \
+	  test -n "$$unique" || unique=$$empty_fix; \
+	  $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
+	    $$tags $$unique; \
+	fi
+ctags: CTAGS
+CTAGS:  $(HEADERS) $(SOURCES)  $(TAGS_DEPENDENCIES) \
+		$(TAGS_FILES) $(LISP)
+	tags=; \
+	here=`pwd`; \
+	list='$(SOURCES) $(HEADERS)  $(LISP) $(TAGS_FILES)'; \
+	unique=`for i in $$list; do \
+	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+	  done | \
+	  $(AWK) '    { files[$$0] = 1; } \
+	       END { for (i in files) print i; }'`; \
+	test -z "$(CTAGS_ARGS)$$tags$$unique" \
+	  || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
+	     $$tags $$unique
+
+GTAGS:
+	here=`$(am__cd) $(top_builddir) && pwd` \
+	  && cd $(top_srcdir) \
+	  && gtags -i $(GTAGS_ARGS) $$here
+
+distclean-tags:
+	-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
+
+distdir: $(DISTFILES)
+	@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
+	topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
+	list='$(DISTFILES)'; \
+	  dist_files=`for file in $$list; do echo $$file; done | \
+	  sed -e "s|^$$srcdirstrip/||;t" \
+	      -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
+	case $$dist_files in \
+	  */*) $(MKDIR_P) `echo "$$dist_files" | \
+			   sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
+			   sort -u` ;; \
+	esac; \
+	for file in $$dist_files; do \
+	  if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
+	  if test -d $$d/$$file; then \
+	    dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
+	    if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
+	      cp -pR $(srcdir)/$$file $(distdir)$$dir || exit 1; \
+	    fi; \
+	    cp -pR $$d/$$file $(distdir)$$dir || exit 1; \
+	  else \
+	    test -f $(distdir)/$$file \
+	    || cp -p $$d/$$file $(distdir)/$$file \
+	    || exit 1; \
+	  fi; \
+	done
+check-am: all-am
+check: check-am
+all-am: Makefile $(HEADERS)
+installdirs:
+	for dir in "$(DESTDIR)$(tools_pm_includedir)"; do \
+	  test -z "$$dir" || $(MKDIR_P) "$$dir"; \
+	done
+install: install-am
+install-exec: install-exec-am
+install-data: install-data-am
+uninstall: uninstall-am
+
+install-am: all-am
+	@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+
+installcheck: installcheck-am
+install-strip:
+	$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
+	  install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
+	  `test -z '$(STRIP)' || \
+	    echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install
+mostlyclean-generic:
+
+clean-generic:
+
+distclean-generic:
+	-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
+
+maintainer-clean-generic:
+	@echo "This command is intended for maintainers to use"
+	@echo "it deletes files that may require special tools to rebuild."
+clean: clean-am
+
+clean-am: clean-generic clean-libtool mostlyclean-am
+
+distclean: distclean-am
+	-rm -f Makefile
+distclean-am: clean-am distclean-generic distclean-tags
+
+dvi: dvi-am
+
+dvi-am:
+
+html: html-am
+
+info: info-am
+
+info-am:
+
+install-data-am: install-tools_pm_includeHEADERS
+
+install-dvi: install-dvi-am
+
+install-exec-am:
+
+install-html: install-html-am
+
+install-info: install-info-am
+
+install-man:
+
+install-pdf: install-pdf-am
+
+install-ps: install-ps-am
+
+installcheck-am:
+
+maintainer-clean: maintainer-clean-am
+	-rm -f Makefile
+maintainer-clean-am: distclean-am maintainer-clean-generic
+
+mostlyclean: mostlyclean-am
+
+mostlyclean-am: mostlyclean-generic mostlyclean-libtool
+
+pdf: pdf-am
+
+pdf-am:
+
+ps: ps-am
+
+ps-am:
+
+uninstall-am: uninstall-tools_pm_includeHEADERS
+
+.MAKE: install-am install-strip
+
+.PHONY: CTAGS GTAGS all all-am check check-am clean clean-generic \
+	clean-libtool ctags distclean distclean-generic \
+	distclean-libtool distclean-tags distdir dvi dvi-am html \
+	html-am info info-am install install-am install-data \
+	install-data-am install-dvi install-dvi-am install-exec \
+	install-exec-am install-html install-html-am install-info \
+	install-info-am install-man install-pdf install-pdf-am \
+	install-ps install-ps-am install-strip \
+	install-tools_pm_includeHEADERS installcheck installcheck-am \
+	installdirs maintainer-clean maintainer-clean-generic \
+	mostlyclean mostlyclean-generic mostlyclean-libtool pdf pdf-am \
+	ps ps-am tags uninstall uninstall-am \
+	uninstall-tools_pm_includeHEADERS
+
+# Tell versions [3.59,3.63) of GNU make to not export all variables.
+# Otherwise a system limit (for SysV at least) may be exceeded.
+.NOEXPORT:

libs/glibmm2/tools/pm/Makefile_list_of_sources.am_fragment

@@ -0,0 +1,2 @@
+files_tools_pm = DocsParser.pm GtkDefs.pm Enum.pm Function.pm FunctionBase.pm Object.pm Output.pm Property.pm Util.pm WrapParser.pm
+

libs/glibmm2/tools/pm/Object.pm

@@ -0,0 +1,72 @@
+package Object;
+
+use strict;
+use warnings;
+
+BEGIN {
+     use Exporter   ();
+     our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
+
+     # set the version for version checking
+     $VERSION     = 1.00;
+
+     @ISA         = qw(Exporter);
+     @EXPORT      = ( );
+     %EXPORT_TAGS = ( );
+
+     # your exported package globals go here,
+     # as well as any optionally exported functions
+     @EXPORT_OK   = ( );
+}
+our @EXPORT_OK;
+
+# class Object
+# {
+#   string name;
+#   string module;
+#   string parent;
+#   string c_name;
+#   string gtype_id;
+# }
+
+
+sub new
+{
+  my ($def) = @_;
+
+  my $self = {};
+  bless $self;
+
+  $def =~ s/^\(//;
+  $def =~ s/\)$//;
+
+  # snarf down the fields
+  $$self{name}     = $1 if($def =~ s/^define-object (\S+)//);
+  $$self{module}   = $1 if($def =~ s/\(in-module "(\S+)"\)//);
+  $$self{parent}   = $1 if($def =~ s/\(parent "(\S+)"\)//);
+  $$self{c_name}   = $1 if($def =~ s/\(c-name "(\S+)"\)//);
+  $$self{gtype_id} = $1 if($def =~ s/\(gtype-id "(\S+)"\)//);
+
+  if($def !~ /^\s*$/)
+  {
+    GtkDefs::error("Unhandled object def ($def) in $$self{module}\::$$self{name}\n")
+  }
+
+  return $self;
+}
+
+
+sub dump($)
+{
+  my ($self) = @_;
+
+  print "<object>\n";
+
+  foreach(keys %$self)
+    { print "  <$_ value=\"$$self{$_}\"/>\n"; }
+
+  print "</object>\n\n";
+}
+
+
+1; # indicate proper module load.

libs/glibmm2/tools/pm/Output.pm

@@ -0,0 +1,954 @@
+# Gtkmmproc Output 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, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+#
+package Output;
+use strict;
+BEGIN { @Namespace::ISA=qw(main); }
+
+# $objOutputter new()
+sub new
+{
+  my ($m4path, $macrodirs) = @_;
+  my $self = {};
+  bless $self;
+
+  $$self{out} = [];
+
+  $$self{source} = "";
+  $$self{tmpdir} = "/tmp";
+  $$self{destdir} = "";
+  $$self{objDefsParser} = undef; # It will be set in set_defsparser()
+
+  $$self{m4path} = $m4path;
+  $$self{m4args} = "-I";
+  $$self{m4args} .= join(" -I", @$macrodirs);
+
+  return $self;
+}
+
+sub set_defsparser($$)
+{
+  my ($self, $objDefsParser) = @_;
+
+  $$self{objDefsParser} = $objDefsParser; #Remember it so that we can use it in our output methods.
+}
+
+sub m4args_append($$)
+{
+  my ($self, $str) = @_;
+  $$self{m4args} .= $str;
+}
+
+sub append($$)
+{
+  my ($self, $str) = @_;
+
+  push(@{$$self{out}}, $str);
+}
+
+# void output_wrap_failed($cname, $error)
+# Puts a comment in the header about the error during code-generation.
+sub output_wrap_failed($$$)
+{
+  my ($self, $cname, $error) = @_;
+
+  my $str = sprintf("//gtkmmproc error: %s : %s", $cname, $error);
+  print STDERR "Output.pm: $cname : $error\n";
+  $self->append($str);
+}
+
+sub error
+{
+  my $format=shift @_;
+  printf STDERR "Output.pm: $format",@_;
+}
+
+sub ifdef($$)
+{
+	my ($self, $ifdef) = @_;
+	if ($ifdef)
+	{
+		$self->append("\n#ifdef $ifdef\n");
+	}
+}
+
+sub endif($$)
+{
+	my ($self, $ifdef) = @_;
+	if ($ifdef)
+	{
+		$self->append("\n#endif // $ifdef\n");
+	}
+}
+
+### Convert _WRAP to a virtual 
+# _VFUNC_H(signame,rettype,`<cppargs>')
+# _VFUNC_PH(gtkname,crettype,cargs and names)
+# void output_wrap_vfunc_h($filename, $line_num, $objCppfunc, $objCDefsFunc)
+sub output_wrap_vfunc_h($$$$$$)
+{
+  my ($self, $filename, $line_num, $objCppfunc, $objCDefsFunc, $ifdef) = @_;
+
+#Old code. We removed _VFUNC_H from the .m4 file
+#  my $str = sprintf("_VFUNC_H(%s,%s,\`%s\',%s)dnl\n",
+#    $$objCppfunc{name},
+#    $$objCppfunc{rettype},
+#    $objCppfunc->args_types_and_names(),
+#    $objCppfunc->get_is_const()
+#   );
+#  $self->append($str);
+
+  my $cppVfuncDecl = "virtual " . $$objCppfunc{rettype} . " " . $$objCppfunc{name} . "(" . $objCppfunc->args_types_and_names() . ")";
+  if($objCppfunc->get_is_const())
+  {
+    $cppVfuncDecl .= " const";
+  }
+
+  $self->append("#ifdef GLIBMM_VFUNCS_ENABLED\n");
+  $self->ifdef($ifdef);
+  $self->append("  $cppVfuncDecl;\n");
+  $self->endif($ifdef);
+  $self->append("#endif //GLIBMM_VFUNCS_ENABLED\n");
+
+  #The default callback, which will call *_vfunc, which will then call the base default callback.
+  #Declares the callback in the private *Class class and sets it in the class_init function.
+
+  my $str = sprintf("_VFUNC_PH(%s,%s,\`%s\',%s)dnl\n",
+    $$objCDefsFunc{name},
+    $$objCDefsFunc{rettype},
+    $objCDefsFunc->args_types_and_names(),
+    $ifdef
+   );
+  $self->append($str);
+}
+
+# _VFUNC_CC(signame,gtkname,rettype,crettype,`<cppargs>',`<cargs>')
+sub output_wrap_vfunc_cc($$$$$$$)
+{
+  my ($self, $filename, $line_num, $objCppfunc, $objDefsSignal, $ifdef) = @_;
+
+  my $cname = $$objDefsSignal{name};
+
+  # e.g. Gtk::Button::draw_indicator:
+
+  #Use a different macro for Interfaces, to generate an extra convenience method.
+
+  my $refreturn = "";
+  $refreturn = "refreturn" if($$objCppfunc{rettype_needs_ref});
+
+  my $str = sprintf("_VFUNC_CC(%s,%s,%s,%s,\`%s\',\`%s\',%s,%s,%s)dnl\n",
+    $$objCppfunc{name},
+    $cname,
+    $$objCppfunc{rettype},
+    $$objDefsSignal{rettype},
+    $objCppfunc->args_types_and_names(),
+    convert_args_cpp_to_c($objCppfunc, $objDefsSignal, 0, $line_num), #$objCppfunc->args_names_only(),
+    $objCppfunc->get_is_const(),
+    $refreturn,
+    $ifdef);
+
+  $self->append($str);
+
+  # e.g. Gtk::ButtonClass::draw_indicator():
+
+  my $refreturn_ctype = "";
+  $refreturn_ctype = "refreturn_ctype" if($$objDefsSignal{rettype_needs_ref});
+
+  my $str = sprintf("_VFUNC_PCC(%s,%s,%s,%s,\`%s\',\`%s\',\`%s\',%s,%s,%s)dnl\n",
+    $$objCppfunc{name},
+    $cname,
+    $$objCppfunc{rettype},
+    $$objDefsSignal{rettype},
+    $objDefsSignal->args_types_and_names(),
+    $objDefsSignal->args_names_only(),
+    convert_args_c_to_cpp($objDefsSignal, $objCppfunc, $line_num),
+    ${$objDefsSignal->get_param_names()}[0],
+    $refreturn_ctype,
+    $ifdef);
+
+  $self->append($str);
+}
+
+### Convert _WRAP to a virtual
+# _SIGNAL_H(signame,rettype, ifdef, `<cppargs>')
+# _SIGNAL_PH(gtkname,crettype, ifdef, cargs and names)
+# void output_wrap_default_signal_handler_h($filename, $line_num, $objCppfunc, $objCDefsFunc, $ifdef. @args)
+sub output_wrap_default_signal_handler_h($$$$$$$)
+{
+  my ($self, $filename, $line_num, $objCppfunc, $objCDefsFunc, $ifdef) = @_;
+
+  my $str = sprintf("_SIGNAL_H(%s,%s,\`%s\',%s)dnl\n",
+    $$objCppfunc{name},
+    $$objCppfunc{rettype},
+    $objCppfunc->args_types_and_names(),
+    $ifdef
+   );
+  $self->append($str);
+
+
+  #The default callback, which will call *_impl, which will then call the base default callback.
+  #Declares the callback in the private *Class class and sets it in the class_init function.
+
+  $str = sprintf("_SIGNAL_PH(%s,%s,\`%s\',%s)dnl\n",
+    $$objCDefsFunc{name},
+    $$objCDefsFunc{rettype},
+    $objCDefsFunc->args_types_and_names(),
+    $ifdef
+   );
+  $self->append($str);
+}
+
+# _SIGNAL_CC(signame, gtkname, rettype, crettype,`<cppargs>',`<cargs>')
+sub output_wrap_default_signal_handler_cc($$$$$$$$$)
+{
+  my ($self, $filename, $line_num, $objCppfunc, $objDefsSignal, $bImplement, $bCustomCCallback, $bRefreturn, $ifdef) = @_;
+  my $cname = $$objDefsSignal{name};
+  # $cname = $1 if ($args[3] =~ /"(.*)"/); #TODO: What's this about?
+
+  # e.g. Gtk::Button::on_clicked:
+  if($bImplement eq 1)
+  {
+    my $refreturn = "";
+    $refreturn = "refreturn" if($bRefreturn eq 1);
+  
+    my $str = sprintf("_SIGNAL_CC(%s,%s,%s,%s,\`%s\',\`%s\',%s,%s,%s)dnl\n",
+      $$objCppfunc{name},
+      $cname,
+      $$objCppfunc{rettype},
+      $$objDefsSignal{rettype},
+      $objCppfunc->args_types_and_names(),
+      convert_args_cpp_to_c($objCppfunc, $objDefsSignal, 0, $line_num), #$objCppfunc->args_names_only(),
+      $$objCppfunc{const},
+      $refreturn,
+      $ifdef);
+    $self->append($str);
+  }
+
+
+  # e.g. Gtk::ButtonClass::on_clicked():
+
+  #Callbacks always take the object instance as the first argument:
+#  my $arglist_names = "object";
+#  my $arglist_names_extra = $objDefsSignal->args_names_only();
+#  if ($arglist_names_extra)
+#  {
+#    $arglist_names .= ", ";
+#    $arglist_names .= $arglist_names_extra;
+#  }
+
+  if($bCustomCCallback ne 1)
+  {
+    my $str = sprintf("_SIGNAL_PCC(%s,%s,%s,%s,\`%s\',\`%s\',\`%s\',\`%s\',%s)dnl\n",
+      $$objCppfunc{name},
+      $cname,
+      $$objCppfunc{rettype},
+      $$objDefsSignal{rettype},
+      $objDefsSignal->args_types_and_names(),
+      $objDefsSignal->args_names_only(),
+      convert_args_c_to_cpp($objDefsSignal, $objCppfunc, $line_num),
+      ${$objDefsSignal->get_param_names()}[0],
+      $ifdef);
+    $self->append($str);
+  }
+}
+
+### Convert _WRAP to a method
+#  _METHOD(cppname,cname,cpprettype,crettype,arglist,cargs,const)
+#  void output_wrap_meth($filename, $line_num, $objCppFunc, $objCDefsFunc, $cppMethodDecl, $documentation, $ifdef)
+sub output_wrap_meth($$$$$$$)
+{
+  my ($self, $filename, $line_num, $objCppfunc, $objCDefsFunc, $cppMethodDecl, $documentation, $ifdef) = @_;
+  my $objDefsParser = $$self{objDefsParser};
+
+  # Allow the generated .h/.cc code to have an #ifndef around it, and add deprecation docs to the generated documentation.
+  my $deprecated = "";
+  if($$objCDefsFunc{deprecated})
+  {
+    $deprecated = "deprecated";
+  }
+
+  #Declaration:
+  if($deprecated ne "")
+  {
+    $self->append("\n_DEPRECATE_IFDEF_START");
+  }
+
+  # Doxygen documentation before the method declaration:
+  $self->output_wrap_meth_docs_only($filename, $line_num, $documentation);
+
+ $self->ifdef($ifdef);
+
+  if($$objCDefsFunc{throw_any_errors})
+  {
+     $self->append("#ifdef GLIBMM_EXCEPTIONS_ENABLED\n");
+  }
+
+  $self->append("  ${cppMethodDecl};");
+
+  if($$objCDefsFunc{throw_any_errors})
+  {
+     $self->append("\n#else\n");
+
+     # #Add an error argument, by searching for ) at the end and replacing it:
+     # my $declWithErrorArg = ${cppMethodDecl};
+     # $declWithErrorArg =~ s/\)$/, std::auto_ptr<Glib::Error>& error\)/g;
+
+     #Recreate the declaration, to remove the default values, which we can't have as well as an error parameter at the end: 
+     my $declWithErrorArg = $$objCppfunc{rettype} . " " . $$objCppfunc{name} . "(" . $objCppfunc->args_types_and_names() . ", std::auto_ptr<Glib::Error>& error)";
+
+     if($$objCppfunc{static})
+     {
+       $declWithErrorArg = "static " . $declWithErrorArg;
+     }
+
+     if($objCppfunc->get_is_const() eq 1)
+     {
+       if($$objCppfunc{static} ne 1) #It can't be const and static at the same time.
+       {
+         $declWithErrorArg = $declWithErrorArg . " const";
+       }
+     }
+
+     #remove any superfluous ,:
+     $declWithErrorArg =~ s/\(, /\(/g;
+
+     $self->append("  ${declWithErrorArg};");
+
+     $self->append("\n#endif //GLIBMM_EXCEPTIONS_ENABLED\n");
+  }
+  
+  $self->endif($ifdef);
+
+  
+  if($deprecated ne "")
+  {
+    $self->append("\n_DEPRECATE_IFDEF_END\n");
+  }
+
+  my $refneeded = "";
+  if($$objCDefsFunc{rettype_needs_ref})
+  {
+    $refneeded = "refreturn"
+  }
+
+  my $errthrow = "";
+  if($$objCDefsFunc{throw_any_errors})
+  {
+    $errthrow = "errthrow"
+  }
+
+  my $constversion = ""; #Whether it is just a const overload (so it can reuse code)
+  if($$objCDefsFunc{constversion})
+  {
+    $constversion = "constversion"
+  }
+
+  #Implementation:
+  my $str;
+  if ($$objCppfunc{static}) {
+    $str = sprintf("_STATIC_METHOD(%s,%s,%s,%s,\`%s\',\`%s\',%s,%s,%s,%s)dnl\n",
+      $$objCppfunc{name},
+      $$objCDefsFunc{c_name},
+      $$objCppfunc{rettype},
+      $objCDefsFunc->get_return_type_for_methods(),
+      $objCppfunc->args_types_and_names(),
+      convert_args_cpp_to_c($objCppfunc, $objCDefsFunc, 1, $line_num, $errthrow), #1 means it's static, so it has 'object'.
+      $refneeded,
+      $errthrow,
+      $deprecated,
+      $ifdef);
+  } else {
+    $str = sprintf("_METHOD(%s,%s,%s,%s,\`%s\',\`%s\',%s,%s,%s,%s,%s,\`%s\',%s)dnl\n",
+      $$objCppfunc{name},
+      $$objCDefsFunc{c_name},
+      $$objCppfunc{rettype},
+      $objCDefsFunc->get_return_type_for_methods(),
+      $objCppfunc->args_types_and_names(),
+      convert_args_cpp_to_c($objCppfunc, $objCDefsFunc, 0, $line_num, $errthrow),
+      $$objCppfunc{const},
+      $refneeded,
+      $errthrow,
+      $deprecated,
+      $constversion,
+      $objCppfunc->args_names_only(),
+      $ifdef
+      );
+  }
+  $self->append($str);
+}
+
+### Convert _WRAP to a method
+#  _METHOD(cppname,cname,cpprettype,crettype,arglist,cargs,const)
+#  void output_wrap_meth($filename, $line_num, $documentation)
+sub output_wrap_meth_docs_only($$$$)
+{
+  my ($self, $filename, $line_num, $documentation) = @_;
+  my $objDefsParser = $$self{objDefsParser};
+
+  # Doxygen documentation before the method declaration:
+  $self->append("\n${documentation}");
+}
+
+### Convert _WRAP_CTOR to a ctor
+#  _METHOD(cppname,cname,cpprettype,crettype,arglist,cargs,const)
+#  void output_wrap_ctor($filename, $line_num, $objCppFunc, $objCDefsFunc, $cppMethodDecl)
+sub output_wrap_ctor($$$$$)
+{
+  my ($self, $filename, $line_num, $objCppfunc, $objCDefsFunc, $cppMethodDecl) = @_;
+  my $objDefsParser = $$self{objDefsParser};
+
+  #Ctor Declaration:
+  #TODO: Add explicit.
+  $self->append("explicit " . $cppMethodDecl . ";");
+
+  #Implementation:
+  my $str = sprintf("_CTOR_IMPL(%s,%s,\`%s\',\`%s\')dnl\n",
+    $$objCppfunc{name},
+    $$objCDefsFunc{c_name},
+    $objCppfunc->args_types_and_names(),
+    get_ctor_properties($objCppfunc, $objCDefsFunc, $line_num)
+  );
+
+  $self->append($str);
+}
+
+sub output_wrap_create($$$)
+{
+  my ($self, $args_type_and_name_with_default_values, $objWrapParser) = @_;
+
+  #Re-use Function in a very hacky way, to separate the argument types_and_names.
+  my $fake_decl = "void fake_func(" . $args_type_and_name_with_default_values . ")";
+
+  my $objFunction = &Function::new($fake_decl, $objWrapParser);
+  my $args_names_only = $objFunction->args_names_only();
+  my $args_type_and_name_hpp = $objFunction->args_types_and_names_with_default_values();
+  my $args_type_and_name_cpp = $objFunction->args_types_and_names();
+
+  my $str = sprintf("_CREATE_METHOD(\`%s\',\`%s\',\`%s\')dnl\n",
+              $args_type_and_name_hpp, , $args_type_and_name_cpp, $args_names_only);
+
+  $self->append($str)
+}
+
+# void output_wrap_sig_decl($filename, $line_num, $objCSignal, $objCppfunc, $signal_name, $bCustomCCallback)
+# custom_signalproxy_name is "" when no type conversion is required - a normal templates SignalProxy will be used instead.
+sub output_wrap_sig_decl($$$$$$$$)
+{
+  my ($self, $filename, $line_num, $objCSignal, $objCppfunc, $signal_name, $bCustomCCallback, $ifdef, $merge_doxycomment_with_previous) = @_;
+
+# _SIGNAL_PROXY(c_signal_name, c_return_type, `<c_arg_types_and_names>',
+#               cpp_signal_name, cpp_return_type, `<cpp_arg_types>',`<c_args_to_cpp>',
+#               refdoc_comment)
+
+  my $doxycomment = $objCppfunc->get_refdoc_comment();
+
+  # If there was already a previous doxygen comment, we want to merge this
+  # one with the previous so it is one big comment. If it were two separate
+  # comments, doxygen would ignore the first one. If
+  # $merge_doxycomment_with_previous is nonzero, the first comment is
+  # already open but not yet closed.
+  if($merge_doxycomment_with_previous)
+  {
+    # Strip leading whitespace
+    $doxycomment =~ s/^\s+//;
+    # We don't have something to add, so just close the comment.
+    if($doxycomment eq "")
+    {
+      $doxycomment = "   */";
+    }
+    else
+    {
+      # Append the new comment, but remove the first three leading characters
+      # (which are /**) that mark the beginning of the comment.
+      $doxycomment = substr($doxycomment, 3);
+      $doxycomment =~ s/^\s+//;
+      $doxycomment = "   " . $doxycomment;
+    }
+  }
+
+  my $str = sprintf("_SIGNAL_PROXY(%s,%s,\`%s\',%s,%s,\`%s\',\`%s\',\`%s\',\`%s\',%s)dnl\n",
+    $signal_name,
+    $$objCSignal{rettype},
+    $objCSignal->args_types_and_names_without_object(),
+    $$objCppfunc{name},
+    $$objCppfunc{rettype},
+    $objCppfunc->args_types_only(),
+    convert_args_c_to_cpp($objCSignal, $objCppfunc, $line_num),
+    $bCustomCCallback, #When this is true, it will not write the *_callback implementation for you.
+    $doxycomment,
+    $ifdef
+  );
+
+  $self->append($str);
+}
+
+# void output_wrap_enum($filename, $line_num, $cpp_type, $c_type, $comment, @flags)
+sub output_wrap_enum($$$$$$$)
+{
+  my ($self, $filename, $line_num, $cpp_type, $c_type, $comment, @flags) = @_;
+
+  my $objEnum = GtkDefs::lookup_enum($c_type);
+  if(!$objEnum)
+  {
+    $self->output_wrap_failed($c_type, "enum defs lookup failed.");
+    return;
+  }
+
+  $objEnum->beautify_values();
+
+  my $no_gtype = "";
+  my $elements = $objEnum->build_element_list(\@flags, \$no_gtype, "  ");
+
+  if(!$elements)
+  {
+    $self->output_wrap_failed($c_type, "unknown _WRAP_ENUM() flag");
+    return;
+  }
+
+  my $value_suffix = "Enum";
+  $value_suffix = "Flags" if($$objEnum{flags});
+
+  my $str = sprintf("_ENUM(%s,%s,%s,\`%s\',\`%s\',\`%s\')dnl\n",
+    $cpp_type,
+    $c_type,
+    $value_suffix,
+    $elements,
+    $no_gtype,
+    $comment
+  );
+
+  $self->append($str);
+}
+
+# void output_wrap_gerror($filename, $line_num, $cpp_type, $c_enum, $domain, @flags)
+sub output_wrap_gerror($$$$$$$)
+{
+  my ($self, $filename, $line_num, $cpp_type, $c_enum, $domain, @flags) = @_;
+
+  my $objDefsParser = $$self{objDefsParser};
+
+  my $objEnum = GtkDefs::lookup_enum($c_enum);
+  if(!$objEnum)
+  {
+    $self->output_wrap_failed($c_enum, "enum defs lookup failed.");
+    return;
+  }
+
+  # Shouldn't happen, and if it does, I'd like to know that.
+  warn if($$objEnum{flags});
+
+  $objEnum->beautify_values();
+
+  # cut off the module prefix, e.g. GDK_
+  my $prefix = $domain;
+  $prefix =~ s/^[^_]+_//;
+
+  # Chop off the domain prefix, because we put the enum into the class.
+  unshift(@flags, "s#^${prefix}_##");
+
+  my $no_gtype = "";
+  my $elements = $objEnum->build_element_list(\@flags, \$no_gtype, "    ");
+
+  my $str = sprintf("_GERROR(%s,%s,%s,\`%s\',%s)dnl\n",
+    $cpp_type,
+    $c_enum,
+    $domain,
+    $elements,
+    $no_gtype
+  );
+
+  $self->append($str);
+}
+
+# _PROPERTY_PROXY(name, cpp_type)
+# void output_wrap_property($filename, $line_num, $name, $cpp_type)
+sub output_wrap_property($$$$$$)
+{
+  my ($self, $filename, $line_num, $name, $cpp_type, $c_class) = @_;
+
+  my $objDefsParser = $$self{objDefsParser};
+
+  my $objProperty = GtkDefs::lookup_property($c_class, $name);
+  if($objProperty eq 0) #If the lookup failed:
+  {
+    $self->output_wrap_failed($name, "property defs lookup failed.");
+  }
+  else
+  {
+    # We use a suffix to specify a particular Glib::PropertyProxy* class.
+    my $proxy_suffix = "";
+
+    # Read/Write:
+    if($objProperty->get_construct_only() eq 1)
+    {
+      # construct-only functions can be read, but not written.
+      $proxy_suffix = "_ReadOnly";
+    }
+    elsif($objProperty->get_readable() ne 1)
+    {
+      $proxy_suffix = "_WriteOnly";
+    }
+    elsif($objProperty->get_writable() ne 1)
+    {
+       $proxy_suffix = "_ReadOnly";
+    }
+
+    # Convert - to _ so we can use it in C++ method and variable names:
+    my $name_underscored = $name;
+    $name_underscored =~ s/-/_/g;
+
+    my $str = sprintf("_PROPERTY_PROXY(%s,%s,%s,%s,%s)dnl\n",
+      $name,
+      $name_underscored,
+      $cpp_type,
+      $proxy_suffix,
+      $objProperty->get_docs()
+    );
+    $self->append($str);
+    $self->append("\n");
+
+    # If the property is not already read-only, and the property can be read, then add a second const accessor for a read-only propertyproxy:
+    if( ($proxy_suffix ne "_ReadOnly") && ($objProperty->get_readable()) )
+    {
+      my $str = sprintf("_PROPERTY_PROXY(%s,%s,%s,%s,%s)dnl\n",
+        $name,
+        $name_underscored,
+        $cpp_type,
+        "_ReadOnly",
+        $objProperty->get_docs()
+      );
+      $self->append($str);
+    }
+
+    
+  }
+}
+
+# vpod output_temp_g1($filename, $section) e.g. output_temp_g1(button, gtk)
+sub output_temp_g1($$)
+{
+  my ($self, $section) = @_;
+
+  # Write out *.g1 temporary file
+  open(FILE, '>', "$$self{tmpdir}/gtkmmproc_$$.g1");  # $$ is the Process ID
+
+  print FILE "include(base.m4)dnl\n";
+
+  my $module = $section;
+  my $module_canonical = Util::string_canonical($module); #In case there is a / character in the module.
+  print FILE "_START($$self{source},$module,$module_canonical)dnl\n";
+  print FILE join("", @{$$self{out}});
+  print FILE "_END()\n";
+  close(FILE);
+}
+
+sub make_g2_from_g1($)
+{
+  my ($self) = @_;
+
+  # Execute m4 to get *.g2 file:
+  system("$$self{m4path} $$self{m4args} '$$self{tmpdir}/gtkmmproc_$$.g1' > '$$self{tmpdir}/gtkmmproc_$$.g2'");
+  return ($? >> 8);
+}
+
+# void write_sections_to_files()
+# This is where we snip the /tmp/gtkmmproc*.g2 file into sections (,h, .cc, _private.h)
+sub write_sections_to_files()
+{
+  my ($self) = @_;
+
+  my $fname_h  = "$$self{destdir}/$$self{source}.h";
+  my $fname_ph = "$$self{destdir}/private/$$self{source}_p.h";
+  my $fname_cc = "$$self{destdir}/$$self{source}.cc";
+
+  open(INPUT, '<', "$$self{tmpdir}/gtkmmproc_$$.g2"); # $$ is the process ID.
+
+  # open tempory file for each section
+  open(OUTPUT_H,  '>', "$fname_h.tmp");
+  open(OUTPUT_PH, '>', "$fname_ph.tmp");
+  open(OUTPUT_CC, '>', "$fname_cc.tmp");
+
+  my $oldfh = select(OUTPUT_H);
+  my $blank = 0;
+
+  while(<INPUT>)
+  {
+    # section switching
+    if(/^#S 0/) { select(OUTPUT_H);  next; }
+    if(/^#S 1/) { select(OUTPUT_PH); next; }
+    if(/^#S 2/) { select(OUTPUT_CC); next; }
+
+    # get rid of bogus blank lines
+    if(/^\s*$/) { ++$blank; } else { $blank = 0; }
+    next if($blank > 2);
+
+    print $_;
+  }
+
+  select($oldfh);
+  close(INPUT);
+  close(OUTPUT_H);
+  close(OUTPUT_PH);
+  close(OUTPUT_CC);
+
+  foreach($fname_h, $fname_ph, $fname_cc)
+  {
+    # overwrite the source file only if it has actually changed
+    system("cmp -s '$_.tmp' '$_' || cp '$_.tmp' '$_' ; rm -f '$_.tmp'");
+  }
+}
+
+
+sub remove_temp_files($)
+{
+  my ($self) = @_;
+
+  system("rm -f \"$$self{tmpdir}/gtkmmproc_$$.g1\"");
+  system("rm -f \"$$self{tmpdir}/gtkmmproc_$$.g2\"");
+}
+
+
+
+# procedure for generating CONVERT macros
+# $string convert_args_cpp_to_c($objCppfunc, $objCDefsFunc, $static, $wrap_line_number,$automatic_error)
+sub convert_args_cpp_to_c($$$$;$)
+{
+  my ($objCppfunc, $objCDefsFunc, $static, $wrap_line_number, $automatic_error) = @_;
+
+  $automatic_error = "" unless defined $automatic_error;
+
+  my $cpp_param_names = $$objCppfunc{param_names};
+  my $cpp_param_types = $$objCppfunc{param_types};
+  my $c_param_types = $$objCDefsFunc{param_types};
+
+  my @result;
+
+  my $num_c_args_expected = scalar(@{$c_param_types});
+  if( !($static) ) { $num_c_args_expected--; } #The cpp method will need an Object* paramater at the start.
+
+  my $num_cpp_args = scalar(@{$cpp_param_types});
+
+  # add implicit last error parameter;
+  if ( $automatic_error ne "" &&
+       $num_cpp_args == ($num_c_args_expected - 1) &&
+       ${$c_param_types}[-1] eq "GError**" )
+  {
+    $num_cpp_args++;
+    $cpp_param_names = [@{$cpp_param_names},"gerror"];
+    $cpp_param_types = [@{$cpp_param_types},"GError*&"];
+  }
+
+  if ( $num_cpp_args != $num_c_args_expected )
+  {
+    Output::error( "convert_args_cpp_to_c(): Incorrect number of arguments. (%d != %d)\n",
+             $num_cpp_args,
+             $num_c_args_expected );
+    $objCppfunc->dump();
+    $objCDefsFunc->dump();
+
+    return "";
+  }
+
+
+  # Loop through the cpp parameters:
+ my $i;
+ my $cpp_param_max = $num_cpp_args;
+ # if( !($static) ) { $cpp_param_max++; }
+
+ for ($i = 0; $i < $cpp_param_max; $i++)
+ {
+   #index of C parameter:
+   my $iCParam = $i;
+   if( !($static) ) { $iCParam++; }
+
+   my $cppParamType = $$cpp_param_types[$i];
+   $cppParamType =~ s/ &/&/g; #Remove space between type and &
+   $cppParamType =~ s/ \*/*/g; #Remove space between type and *
+
+   my $cppParamName = $$cpp_param_names[$i];
+   my $cParamType = $$c_param_types[$iCParam];
+
+   if ($cppParamType ne $cParamType) #If a type conversion is needed.
+   {
+
+
+     push(@result, sprintf("_CONVERT(%s,%s,%s,%s)",
+                  $cppParamType,
+                  $cParamType,
+                  $cppParamName,
+                  $wrap_line_number) );
+    }
+    else
+    {
+      push(@result, $cppParamName);
+    }
+  }
+
+  return join(", ", @result);
+}
+
+# procedure for generating CONVERT macros
+# Ignores the first C 'self' argument.
+# $string convert_args_c_to_cpp($objCDefsFunc, $objCppFunc, $wrap_line_number)
+sub convert_args_c_to_cpp($$$)
+{
+  my ($objCDefsFunc, $objCppfunc, $wrap_line_number) = @_;
+
+  my $cpp_param_types = $$objCppfunc{param_types};
+  my $c_param_types = $$objCDefsFunc{param_types};
+  my $c_param_names = $$objCDefsFunc{param_names};
+
+  my @result;
+
+  my $num_c_args = scalar(@{$c_param_types});
+
+  my $num_cpp_args = scalar(@{$cpp_param_types});
+
+  if ( ($num_cpp_args + 1) !=  $num_c_args )
+  {
+    Output::error( "convert_args_c_to_cpp(): Incorrect number of arguments. (%d != %d)\n",
+             $num_cpp_args + 1,
+             $num_c_args);
+    $objCppfunc->dump();
+    $objCDefsFunc->dump();
+
+    return "";
+  }
+
+
+  # Loop through the c parameters:
+ my $i;
+ my $c_param_max = $num_c_args;
+
+ for ($i = 1; $i < $c_param_max; $i++)
+ {
+   #index of C parameter:
+   my $iCppParam = $i - 1;
+
+   my $cppParamType = $$cpp_param_types[$iCppParam];
+   $cppParamType =~ s/ &/&/g; #Remove space between type and &.
+   $cppParamType =~ s/ \*/*/g; #Remove space between type and *
+
+   my $cParamName = $$c_param_names[$i];
+   my $cParamType = $$c_param_types[$i];
+
+   if ($cParamType ne $cppParamType) #If a type conversion is needed.
+   {
+     push(@result, sprintf("_CONVERT(%s,%s,%s,%s)\n",
+                  $cParamType,
+                  $cppParamType,
+                  $cParamName,
+                  $wrap_line_number) );
+    }
+    else
+    {
+      push(@result, $cParamName);
+    }
+  }
+
+  return join(", ",@result);
+}
+
+
+# generates the XXX in g_object_new(get_type(), XXX): A list of property names and values.
+# Uses the cpp arg name as the property name.
+# $string get_ctor_properties($objCppfunc, $objCDefsFunc, $wrap_line_number)
+sub get_ctor_properties($$$$)
+{
+ my ($objCppfunc, $objCDefsFunc, $wrap_line_number) = @_;
+
+  my $cpp_param_names = $$objCppfunc{param_names};
+  my $cpp_param_types = $$objCppfunc{param_types};
+  my $c_param_types = $$objCDefsFunc{param_types};
+
+  my @result;
+
+  my $num_args = scalar(@{$c_param_types});
+
+  my $num_cpp_args = scalar(@{$cpp_param_types});
+  if ( $num_cpp_args != $num_args )
+  {
+    Output::error("get_ctor_properties(): Incorrect number of arguments. (%d != %d)\n",
+             $num_cpp_args,
+             $num_args );
+    return "";
+  }
+
+
+  # Loop through the cpp parameters:
+ my $i = 0;
+
+ for ($i = 0; $i < $num_args; $i++)
+ {
+   my $cppParamType = $$cpp_param_types[$i];
+   $cppParamType =~ s/ &/&/g; #Remove space between type and &
+   $cppParamType =~ s/ \*/*/g; #Remove space between type and *
+
+   my $cppParamName = $$cpp_param_names[$i];
+   my $cParamType = $$c_param_types[$i];
+
+   # Property name:
+   push(@result, "\"" . $cppParamName . "\"");
+
+   # C property value:
+   if ($cppParamType ne $cParamType) #If a type conversion is needed.
+   {
+     push(@result, sprintf("_CONVERT(%s,%s,%s,%s)",
+                  $cppParamType,
+                  $cParamType,
+                  $cppParamName,
+                  $wrap_line_number) );
+    }
+    else
+    {
+      push(@result, $cppParamName);
+    }
+  }
+
+  return join(", ", @result);
+}
+
+### Convert _WRAP to a corba method
+# _CORBA_METHOD(retype, method_name,args, arg_names_only) - implemented in libbonobomm.
+#  void output_wrap_corba_method($filename, $line_num, $objCppFunc)
+sub output_wrap_corba_method($$$$)
+{
+  my ($self, $filename, $line_num, $objCppfunc) = @_;
+
+  my $str = sprintf("_CORBA_METHOD(%s,%s,\`%s\',\`%s\')dnl\n",
+      $$objCppfunc{rettype},
+      $$objCppfunc{name},
+      $objCppfunc->args_types_and_names(),
+      $objCppfunc->args_names_only()
+   );
+
+  $self->append($str);
+}
+
+sub output_implements_interface($$)
+{
+  my ($self, $interface, $ifdef) = @_;
+
+  my $str = sprintf("_IMPLEMENTS_INTERFACE_CC(%s, %s)dnl\n",
+  	$interface,
+  	$ifdef);
+
+  $self->append($str);
+}
+
+1; # indicate proper module load.

libs/glibmm2/tools/pm/Property.pm

@@ -0,0 +1,119 @@
+package Property;
+
+use strict;
+use warnings;
+
+BEGIN {
+     use Exporter   ();
+     our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
+
+     # set the version for version checking
+     $VERSION     = 1.00;
+     @ISA         = qw(Exporter);
+     @EXPORT      = qw(&func1 &func2 &func4);
+     %EXPORT_TAGS = ( );
+     # your exported package globals go here,
+     # as well as any optionally exported functions
+     @EXPORT_OK   = qw($Var1 %Hashit &func3);
+     }
+our @EXPORT_OK;
+
+# class Property
+#    {
+#       string name;
+#       string class;
+#       string type;
+#       bool readable;
+#       bool writable;
+#       bool construct_only;
+#       string docs;
+#    }
+
+
+sub new
+{
+  my ($def) = @_;
+  my $self = {};
+  bless $self;
+
+  $def=~s/^\(//;
+  $def=~s/\)$//;
+  # snarf down the fields
+  $$self{mark} = 0;
+  $$self{name} = $1                     if ($def =~ s/^define-property (\S+)//);
+  $$self{class} = $1                    if ($def =~ s/\(of-object "(\S+)"\)//);
+  $$self{type} = $1                     if ($def =~ s/\(prop-type "(\S+)"\)//);
+  $$self{readable} = ($1 eq "#t")       if ($def =~ s/\(readable (\S+)\)//);
+  $$self{writable} = ($1 eq "#t")       if ($def =~ s/\(writable (\S+)\)//);
+  $$self{construct_only} = ($1 eq "#t") if ($def =~ s/\(construct-only (\S+)\)//);
+  
+  # Property documentation:
+  my $propertydocs = $1                     if ($def =~ s/\(docs "([^"]*)"\)//);
+  # Add a full-stop if there is not one already:
+  if(defined($propertydocs))
+  {
+    my $docslen = length($propertydocs);
+    if($docslen)
+    {
+      if( !(substr($propertydocs, $docslen - 1, 1) eq ".") )
+      {
+        $propertydocs = $propertydocs . ".";
+      }
+    }
+  }
+  
+  $$self{docs} = $propertydocs;
+  
+
+  $$self{name} =~ s/-/_/g; # change - to _
+
+  GtkDefs::error("Unhandled property def ($def) in $$self{class}\::$$self{name}\n")
+    if ($def !~ /^\s*$/);
+
+  return $self;
+}
+
+sub dump($)
+{
+  my ($self) = @_;
+
+  print "<property>\n";
+
+  foreach (keys %$self)
+  { print "  <$_ value=\"$$self{$_}\"/>\n"; }
+
+  print "</property>\n\n";
+}
+
+sub get_construct_only($)
+{
+  my ($self) = @_;
+  return $$self{construct_only};
+}
+
+sub get_type($)
+{
+  my ($self) = @_;
+  return $$self{type};
+}
+
+sub get_readable($)
+{
+  my ($self) = @_;
+  return $$self{readable};
+}
+
+sub get_writable($)
+{
+  my ($self) = @_;
+  return $$self{writable};
+}
+
+sub get_docs($)
+{
+  my ($self) = @_;
+  return $$self{docs};
+}
+
+
+1; # indicate proper module load.

libs/glibmm2/tools/pm/Util.pm

@@ -0,0 +1,113 @@
+# gtkmm - Util 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, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+#
+#
+# This file holds basic functions used throughout gtkmmproc modules.
+# Functions in this module are exported so there is no need to 
+# request them by module name.
+#
+package Util;
+use strict;
+use warnings;
+
+BEGIN {
+     use Exporter   ();
+     our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
+
+     # set the version for version checking
+     $VERSION     = 1.00;
+     @ISA         = qw(Exporter);
+     @EXPORT      = qw(&string_unquote &string_trim &string_canonical
+                       &trace &unique);
+     %EXPORT_TAGS = ( );
+
+     # your exported package globals go here,
+     # as well as any optionally exported functions
+     #@EXPORT_OK   = qw($Var1 %Hashit &func3);
+     }
+our @EXPORT_OK;
+
+
+#$ string_unquote($string)
+# Removes leading and trailing quotes.
+sub string_unquote($)
+{
+    my ($str) = @_;
+    
+    $str =~ s/^['`"]// ;
+    $str =~ s/['`"]$// ;
+ 
+    return $str;
+}
+         
+# $ string_trim($string)
+# Removes leading and trailing white space.
+sub string_trim($)
+{
+  ($_) = @_;
+  s/^\s+//;
+  s/\s+$//;
+  return $_;
+}
+
+#  $ string_canonical($string)
+# Convert - to _.
+sub string_canonical($)
+{
+  ($_) = @_;
+  s/-/_/g ; # g means 'replace all'
+  s/\//_/g ; # g means 'replace all'
+  return $_;
+}
+
+#
+#  Back tracing utility.  
+#    Prints the call stack.
+#
+#  void trace()
+sub trace()
+{
+  my ($package, $filename, $line, $subroutine, $hasargs,
+   $wantarray, $evaltext, $is_require, $hints, $bitmask) = caller(1);
+
+  no warnings qw(uninitialized);
+
+  my $i = 2;
+  print "Trace on ${subroutine} called from ${filename}:${line}\n";
+  while (1)
+  {
+    ($package, $filename, $line, $subroutine) = caller($i);
+    $i++;
+    next if ($line eq "");
+    print "  From ${subroutine} call from ${filename}:${line}\n";
+  }
+}
+
+sub unique(@)
+{
+  my %hash;
+  foreach (@_)
+  {
+    $hash{$_}=1;
+  }
+
+  return keys %hash;
+}
+
+1; # indicate proper module load.
+