[glibmm/gmmproc-refactor] Added more stuff.

From: Krzesimir Nowak <krnowak src gnome org>
To: commits-list gnome org
Cc:
Subject: [glibmm/gmmproc-refactor] Added more stuff.
Date: Thu, 3 Feb 2011 22:04:19 +0000 (UTC)
commit f9e2b4e1ea76bf31f611150a959c8e6f8bf52d6f
Author: Krzesimir Nowak <qdlacz gmail com>
Date:   Wed Feb 2 20:39:41 2011 +0100

    Added more stuff.
    
    Added an Api class as an interface for lookup for API. Some other
    minor fixes.

 tools/pm/Base/Api.pm      |  307 +++++++++++++++++++++++++++++
 tools/pm/Base/Entity.pm   |   11 +
 tools/pm/Defs/Property.pm |    1 +
 tools/pm/Defs/Signal.pm   |    1 +
 tools/pm/Enum.pm          |   22 ++-
 tools/pm/Function.pm      |  473 ++++++++++++++++++++++++---------------------
 tools/pm/FunctionBase.pm  |   65 ++++++-
 tools/pm/WrapParser.pm    |   10 +
 tools/pm/test.pl          |    1 +
 9 files changed, 663 insertions(+), 228 deletions(-)
---
diff --git a/tools/pm/Base/Api.pm b/tools/pm/Base/Api.pm
new file mode 100644
index 0000000..ebd2d68
--- /dev/null
+++ b/tools/pm/Base/Api.pm
@@ -0,0 +1,307 @@
+# gmmproc - Base::Api module
+#
+# Copyright 2011 glibmm development team
+#
+# 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 Base::Api;
+
+use strict;
+use warnings;
+
+# class Base::Api
+# {
+#   function array get_methods ();
+#   property array get_properties ();
+#   function array get_signals ();
+#
+#   enum lookup_enum(c_type)
+#   object lookup_object(c_name)
+#   function lookup_method(c_name)
+#   function lookup_function(c_name)
+#   property lookup_property(object, c_name)
+#   function lookup_signal(object, c_name)
+# }
+
+my $g_o = 'outputter';
+my $g_b = 'backend';
+
+sub new ($$$)
+{
+  my $type = shift;
+  my $main_backend_module = shift;
+  my $outputter = shift;
+  my $class = (ref ($type) or $type or "Base::Api");
+  my $backend = undef;
+
+  eval ("require $main_backend_module::Backend; \$backend = $main_backend_module::Backend->new ();") or die;
+  $outputter->set_backend ($backend->get_outputter_backend ());
+
+  my $self =
+  {
+    $g_b => $backend,
+    $g_o => $outputter
+  };
+
+  bless ($self, $class);
+  return $self;
+}
+
+sub get_enums ($)
+{
+  my $self = shift;
+  my $backend = $self->{$g_b};
+
+  if (defined ($backend))
+  {
+    return $backend->get_enums ();
+  }
+  # TODO: error!
+  return [];
+}
+
+sub get_methods ($)
+{
+  my $self = shift;
+  my $backend = $self->{$g_b};
+
+  if (defined ($backend))
+  {
+    return $backend->get_methods ();
+  }
+  # TODO: error!
+  return [];
+}
+
+sub get_signals ($)
+{
+  my $self = shift;
+  my $backend = $self->{$g_b};
+
+  if (defined ($backend))
+  {
+    return $backend->get_signals ();
+  }
+  # TODO: error!
+  return [];
+}
+
+sub get_properties ($)
+{
+  my $self = shift;
+  my $backend = $self->{$g_b};
+
+  if (defined ($backend))
+  {
+    return $backend->get_properties ();
+  }
+  # TODO: error!
+  return [];
+}
+
+sub get_objects ($)
+{
+  my $self = shift;
+  my $backend = $self->{$g_b};
+
+  if (defined ($backend))
+  {
+    return $backend->get_objects ();
+  }
+  # TODO: error!
+  return [];
+}
+
+sub get_functions ($)
+{
+  my $self = shift;
+  my $backend = $self->{$g_b};
+
+  if (defined ($backend))
+  {
+    return $backend->get_functions ();
+  }
+  # TODO: error!
+  return [];
+}
+
+sub get_marked ($)
+{
+  my $self = shift;
+  my $backend = $self->{$g_b};
+
+  if (defined ($backend))
+  {
+    return $backend->get_marked ();
+  }
+  # TODO: error!
+  return [];
+}
+
+# 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 ($)
+{
+  my $self = shift;
+  my $backend = $self->{$g_b};
+  my $unwrapped = [];
+
+  if (defined ($backend))
+  {
+    push (@{$unwrapped}, $backend->get_unwrapped_methods ());
+    push (@{$unwrapped}, $backend->get_unwrapped_signals ());
+    push (@{$unwrapped}, $backend->get_unwrapped_properties ());
+    push (@{$unwrapped}, $backend->get_unwrapped_objects ());
+    push (@{$unwrapped}, $backend->get_unwrapped_enums ());
+    push (@{$unwrapped}, $backend->get_unwrapped_functions ());
+    return $unwrapped;
+  }
+  # TODO: error!
+  return [];
+}
+
+##########################
+
+sub lookup_enum($$$)
+{
+  my $self = shift;
+  my $c_name = shift;
+  my $mark = (shift == 1 ? 1 : 0);
+  my $backend = $self->{$g_b};
+
+  if (defined ($backend))
+  {
+    my $enum = $backend->lookup_enum ($c_name);
+
+    if (defined ($enum) and $mark == 1)
+    {
+      $enum->set_marked (1);
+    }
+    return $enum;
+  }
+  # TODO: error!
+  return undef;
+}
+
+sub lookup_object($$$)
+{
+  my $self = shift;
+  my $c_name = shift;
+  my $mark = (shift == 1 ? 1 : 0);
+  my $backend = $self->{$g_b};
+
+  if (defined ($backend))
+  {
+    my $obj = $backend->lookup_object ($c_name);
+
+    if (defined ($obj) and $mark == 1)
+    {
+      $obj->set_marked (1);
+    }
+    return $obj;
+  }
+  # TODO: error!
+  return undef;
+}
+
+# $objProperty lookup_property($name, $parent_object_name)
+sub lookup_property($$$$)
+{
+  my $self = shift;
+  my $object = shift;
+  my $name = shift;
+  my $mark = (shift == 1 ? 1 : 0);
+  my $backend = $self->{$g_b};
+
+  if (defined ($backend))
+  {
+    my $property = $backend->lookup_property ($object, string_canonical ($name));
+
+    if (defined ($property) and $mark == 1)
+    {
+      $property->set_marked (1);
+    }
+    return $property;
+  }
+  # TODO: error!
+  return undef;
+}
+
+sub lookup_method($$$)
+{
+  my $self = shift;
+  my $c_name = shift;
+  my $mark = (shift == 1 ? 1 : 0);
+  my $backend = $self->{$g_b};
+
+  if (defined ($backend))
+  {
+    my $method = $backend->lookup_method (string_canonical ($c_name));
+
+    if (defined ($method) and $mark == 1)
+    {
+      $method->set_marked (1);
+    }
+    return $method;
+  }
+  # TODO: error!
+  return undef;
+}
+
+sub lookup_function($$$)
+{
+  my $self = shift;
+  my $c_name = shift;
+  my $mark = (shift == 1 ? 1 : 0);
+  my $backend = $self->{$g_b};
+
+  if (defined ($backend))
+  {
+    my $function = $backend->lookup_function (string_canonical ($c_name));
+
+    if (defined ($function) and $mark == 1)
+    {
+      $function->set_marked (1);
+    }
+    return $function;
+  }
+  # TODO: error!
+  return undef;
+}
+
+sub lookup_signal($$$$)
+{
+  my $self = shift;
+  my $object = shift;
+  my $name = shift;
+  my $mark = (shift == 1 ? 1 : 0);
+  my $backend = $self->{$g_b};
+
+  if (defined ($backend))
+  {
+    my $signal = $backend->lookup_signal ($object, string_canonical ($name));
+
+    if (defined ($signal) and $mark == 1)
+    {
+      $signal->set_marked (1);
+    }
+    return $signal;
+  }
+  # TODO: error!
+  return undef;
+}
+
+1; #indicate proper module load.
diff --git a/tools/pm/Base/Entity.pm b/tools/pm/Base/Entity.pm
index 8d52dea..fdcedbb 100644
--- a/tools/pm/Base/Entity.pm
+++ b/tools/pm/Base/Entity.pm
@@ -24,6 +24,17 @@ use warnings;
 
 # class Base::Entity
 # {
+# public:
+#   bool is_marked ();
+#   void set_marked (bool);
+#
+#   string get_c_name ();
+#   void set_c_name (string);
+#
+#   string get_entity ();
+#   void set_entity ();
+#
+# private:
 #   bool   marked;
 #   string entity;
 #   string c_name
diff --git a/tools/pm/Defs/Property.pm b/tools/pm/Defs/Property.pm
index 45654b5..7852640 100644
--- a/tools/pm/Defs/Property.pm
+++ b/tools/pm/Defs/Property.pm
@@ -81,6 +81,7 @@ sub parse ($$)
   }
 
   $self->set_name ($name);
+  $self->set_c_name ($name);
   $self->set_class ($class);
   $self->set_type ($type);
   $self->set_readable ($readable);
diff --git a/tools/pm/Defs/Signal.pm b/tools/pm/Defs/Signal.pm
index 7f8fbab..8c4aa6b 100644
--- a/tools/pm/Defs/Signal.pm
+++ b/tools/pm/Defs/Signal.pm
@@ -120,6 +120,7 @@ sub parse ($$)
   }
 
   $self->set_entity ($entity);
+  $self->set_c_name ($name);
   $self->set_name ($name);
   $self->set_class ($class);
   $self->set_ret_type ($ret_type);
diff --git a/tools/pm/Enum.pm b/tools/pm/Enum.pm
index 71eea45..7046ea4 100644
--- a/tools/pm/Enum.pm
+++ b/tools/pm/Enum.pm
@@ -2,6 +2,7 @@ package Enum;
 
 use strict;
 use warnings;
+use base qw (Entity);
 
 # class Enum
 #    {
@@ -117,21 +118,22 @@ sub split_enum_tokens($)
 # end of private functions.
 #
 
+my $g_f = 'flags';
+my $g_t = 'type';
+my $g_e_n = 'elem_names';
+my $g_e_v = 'elem_values';
+
 sub new ($$)
 {
   my $type = shift;
   my $token = shift;
   my $class = ref ($type) or $type or "Enum";
-  my $self =
-  {
-    $g_i_p => $include_paths_a_r,
-    $g_e => {},
-    $g_o => {},
-    $g_m => {},
-    $g_s => {},
-    $g_p => {},
-    $g_a_r_f => {}
-  };
+  my $self = $class->SUPER->new ();
+
+  $self->{$g_f} = 0;
+  $self->{$g_t} = '';
+  $self->{$g_e_n} = [];
+  $self->{$g_e_v} = [];
 
   return bless ($self, $class);
   my ($def) = @_;
diff --git a/tools/pm/Function.pm b/tools/pm/Function.pm
index 60d4d41..98d4cdb 100644
--- a/tools/pm/Function.pm
+++ b/tools/pm/Function.pm
@@ -5,228 +5,95 @@ use warnings;
 use Util;
 use base qw (FunctionBase);
 
-##################################################
-### 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 ($)
-{
-  my $type = shift;
-  my $class = ref ($type) or $type or "Function";
-  my $self = $class->SUPER->new ();
-
-  $self->{}
-}
-
-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;
-}
+my $gi_p_t = 'internal_param_types';
+my $gi_p_n = 'internal_param_names';
+my $gi_p_d_v = 'internal_param_default_values';
 
 # parses C++ parameter lists.
 # forms a list of types, names, and initial values
 #  (we don't currently use values)
-sub parse_param($$)
+sub parse_params($$)
 {
-  my ($self, $line) = @_;
-
-
-  my $type = "";
-  my $name = "";
-  my $value = "";
+  my $line = shift;
+  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};
+  my $param_types = [];
+  my $param_names = [];
+  my $param_default_values = [];
+  my $params_h_r =
+  {
+    $gi_p_t = $param_types,
+    $gi_p_n = $param_names,
+    $gi_p_d_v = $param_default_values
+  };
 
   # clean up space and handle empty case
-  $line = Util::string_trim($line);
-  $line =~ s/\s+/ /g; # Compress whitespace.
-  return if ($line =~ /^$/);
+  $line = Util::string_simplify ($line);
+  return $params_h_r if (not $line);
 
   # parse through argument list
   my @str = ();
   my $par = 0;
-  foreach (split(/(const )|([,=&*()])|(<[^,]*>)|(\s+)/, $line)) #special characters OR <something> OR whitespace.
+  for my $part (split(/(const )|([,=&*()])|(<[^,]*>)|(\s+)/, $line)) #special characters OR <something> OR whitespace.
   {
-    next if ( !defined($_) or $_ eq "" );
+    next if (not defined ($part) or not $part);
       
-    if ( $_ eq "(" ) #Detect the opening bracket.
+    if ($part eq '(') #Detect the opening bracket.
     {
-       push(@str, $_);
-       $par++; #Increment the number of parameters.
+       push (@str, $part);
+       ++$par; #Increment the number of parameters.
        next;
     }
-    elsif ( $_ eq ")" )
+    elsif ($part eq ')')
     {
-       push(@str, $_);
-       $par--; #Decrement the number of parameters.
+       push (@str, $part);
+       --$par; #Decrement the number of parameters.
        next;
     }
-    elsif ( $par || /^(const )|(<[^,]*>)|([*&])|(\s+)/ ) #TODO: What's happening here?
+    # const std::vector<std::string>& (or const std::vector<int>*))
+    elsif ($par or $part =~ /^(const )|(<[^,]*>)|([*&])|(\s+)/)
     {
-      push(@str, $_); #This looks like part of the type, so we store it.
+      push (@str, $part); #This looks like part of the type, so we store it.
       next;
     }
-    elsif ( $_ eq "=" ) #Default value
+    elsif ($part eq '=') #Default value
     {
-      $type = join("", @str); #The type is everything before the = character.
+      $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:
+    elsif ($part 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 ",".
+        $value = join ('', @str); # If there's a default value, then it's the part before the next ",".
       }
       else
       {
-        $type = join("", @str);
+        $type = join ('', @str);
       }
 
-      if ($name eq "")
+      unless ($name)
       {
-        $name = sprintf("p%s", $#$param_types + 2)
+        $name = sprintf ('p%s', @{$param_types} + 1)
       }
 
-      $type = Util::string_trim($type);
+      $type = Util::string_trim ($type);
 
-      push(@$param_types, $type);
-      push(@$param_names, $name);
-      push(@$param_default_values, $value);
+      push (@{$param_types}, $type);
+      push (@{$param_names}, $name);
+      push (@{$param_default_values}, $value);
       
       #Clear variables, ready for the next parameter.
       @str = ();
-      $type= "";
-      $value = "";
+      $type= '';
+      $value = '';
       $has_value = 0;
-      $name = "";
-
+      $name = '';
       $id = 0;
 
       next;
@@ -238,9 +105,9 @@ sub parse_param($$)
       next;
     }
 
-    $id++;
-    $name = $_ if ($id == 2);
-    push(@str, $_) if ($id == 1);
+    ++$id;
+    $name = $part if ($id == 2);
+    push (@str, $part) if ($id == 1);
 
     if ($id > 2)
     {
@@ -254,91 +121,265 @@ sub parse_param($$)
   # handle last argument  (There's no , at the end.)
   if ($has_value)
   {
-    $value = join("", @str);
+    $value = join ('', @str);
   }
   else
   {
-    $type = join("", @str);
+    $type = join ('', @str);
   }
 
-  if ($name eq "")
+  unless ($name)
   {
-    $name = sprintf("p%s", $#$param_types + 2)
+    $name = sprintf ('p%s', @{$param_types} + 1)
   }
 
-  $type = Util::string_trim($type);
+  $type = Util::string_trim ($type);
+
+  push (@{$param_types}, $type);
+  push (@{$param_names}, $name);
+  push (@{$param_default_values}, $value);
+
+  return $params_h_r;
+}
+
+
+##################################################
+### Function
+# Commonly used algorithm for parsing a function declaration into
+# its component pieces
+#
+#  class Function : FunctionBase
+#    {
+#       string ret_type;
+#       bool ret_type_needs_ref;
+#       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
+#    }
+
+my $g_r_t_n_r = 'ret_type_needs_ref';
+my $g_c = 'const';
+my $g_s = 'static';
+my $g_p_d_v = 'param_default_values';
+my $g_i_m = 'in_module';
+my $g_s_w = 'signal_when'; # TODO: check if this is needed.
+my $g_cl = 'class'; # TODO: check if this is needed.
+my $g_e_t = 'entity_type' # TODO: check if this is needed. If so, move to new base class.
 
-  push(@$param_types, $type);
-  push(@$param_names, $name);
-  push(@$param_default_values, $value);
+sub new ($)
+{
+  my $type = shift;
+  my $class = ref ($type) or $type or "Function";
+  my $self = $class->SUPER->new ();
+
+  $self->{$g_r_t_n_r} = 0;
+  $self->{$g_c} = 0;
+  $self->{$g_s} = 0;
+  $self->{$g_p_d_v} = [];
+  $self->{$g_i_m} = '';
+  $self->{$g_s_w} = '';
+  $self->{$g_cl} = '';
+  $self->{$g_e_t} = 'method';
+
+  bless ($self, $class);
+  return $self;
 }
 
+#sub new_empty()
+#{
+#  my $self = {};
+#  bless $self;
+
+#  return $self;
+#}
+
+# bool parse ($self, $declaration)
+sub parse ($$)
+{
+  #Parse a function/method declaration.
+  #e.g. guint gtk_something_set_thing(guint a, const gchar* something)
+
+  my $self = shift;
+  my $line = shift;
+
+  $line Util::string_simplify ($line);
+
+  my $ret_type = '';
+  my $name = '';
+  my $params = '';
+  my $static = 0;
+  my $const = 0;
+
+  # static method
+  if ($line =~ /^static\s+([^()]+)\s+(\S+)\s*\((.*)\)\s*$/)
+  {
+    $ret_type = $1;
+    $name = $2;
+    $params = $3;
+    $static = 1;
+  }
+  # function, method or const method
+  elsif ($line =~ /^([^()]+)\s+(\S+)\s*\((.*)\)\s*(const)*$/)
+  {
+    $ret_type = $1;
+    $name = $2;
+    $params = $3;
+    $const = ((defined ($4) and $4 eq 'const') ? 1 : 0);
+  }
+  # constructor
+  elsif ($line =~ /^(\S+)\s*\((.*)\)\s*/)
+  {
+    $name = $1;
+    $params = $2;
+  }
+  else
+  {
+    return 0;
+  }
+
+  my $params_h_r = parse_params ($params);
+
+  unless (keys (%{$params_h_r}))
+  {
+    return 0;
+  }
+
+  $self->set_ret_type ($ret_type);
+  $self->set_name ($name);
+  $self->set_c_name ($name);
+  $self->set_param_types ($params_h_r->{$gi_p_t});
+  $self->set_param_names ($params_h_r->{$gi_p_n});
+  $self->{$g_p_d_v} = $params_h_r->{$gi_p_d_v};
+  $self->{$g_s} = $static;
+  $self->{$g_c} = $const;
+
+  return 1;
+}
+
+
+## $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;
+#}
+
 # add_parameter_autoname($, $type, $name)
 # Adds e.g "sometype somename"
-sub add_parameter_autoname($$)
+sub add_parameter_autoname ($$)
 {
-  my ($self, $type) = @_;
+  my $self = shift;
+  my $type = shift;
 
-  add_parameter($self, $type, "");
+  $self->add_parameter ($type, '');
 }
 
 # add_parameter($, $type, $name)
 # Adds e.g GtkSomething* p1"
 sub add_parameter($$$)
 {
-  my ($self, $type, $name) = @_;
-  $type = Util::string_unquote($type);
+  my $self = shift;
+  my $type = shift;
+  my $name = shift;
+
+  $type = Util::string_unquote ($type);
+  #const-char -> const char
   $type =~ s/-/ /g;
 
-  my $param_names = $$self{param_names};
+  my $param_names = $self->get_param_names ();
 
-  if ($name eq "")
+  unless ($name)
   {
-    $name = sprintf("p%s", $#$param_names + 2);
+    $name = sprintf ('p%s', @{$param_names} + 1);
   }
 
-  push(@$param_names, $name);
-
-  my $param_types = $$self{param_types};
+  push (@{$param_names}, $name);
 
-  push(@$param_types, $type);
+  my $param_types = $self->get_param_types ();
 
-  return $self;
+  push(@{$param_types}, $type);
 }
 
 # $string get_refdoc_comment()
 # Generate a readable prototype for signals.
 sub get_refdoc_comment($)
 {
-  my ($self) = @_;
-
-  my $str = "  /**\n";
+  my $self = shift;
+  my $str .= "  /**\n   * \ par Prototype:\n";
 
-  $str .= "   * \ par Prototype:\n";
-  $str .= "   * <tt>$$self{rettype} on_my_\%$$self{name}(";
+  $str .= join ('', '   * <tt>', $self->get_ret_type (), ' on_my_', $self->get_name (), '(');
 
-  my $param_names = $$self{param_names};
-  my $param_types = $$self{param_types};
-  my $num_params  = scalar(@$param_types);
+  my $param_names = $self->get_param_names ();
+  my $param_types = $self->get_param_types ();
+  my $num_params  = @{$param_types};
 
   # List the parameters:
-  for(my $i = 0; $i < $num_params; ++$i)
+  for (my $i = 0; $i < @{$param_types}; ++$i)
   {
-    $str .= $$param_types[$i] . ' ' . $$param_names[$i];
-    $str .= ", " if($i < $num_params - 1);
+    $str .= $param_types->[$i] . ' ' . $param_names->[$i];
+    $str .= ", " if ($i < $num_params - 1);
   }
 
-  $str .= ")</tt>\n";
-  $str .= "   */";
+  $str .= ")</tt>\n   */";
 
   return $str;
 }
 
 sub get_is_const($)
 {
-  my ($self) = @_;
+  my $self = shift;
 
-  return $$self{const};
+  return $self->{$g_c};
 }
 
 1; # indicate proper module load.
diff --git a/tools/pm/FunctionBase.pm b/tools/pm/FunctionBase.pm
index f594645..bd7c353 100644
--- a/tools/pm/FunctionBase.pm
+++ b/tools/pm/FunctionBase.pm
@@ -13,10 +13,16 @@ use Util;
 #    {
 #       string array param_types;
 #       string array param_names;
+#       string       ret_type;
+#       string       name;
+#       string       c_name;
 #    }
 
 my $g_p_t = 'param_types';
 my $g_p_n = 'param_names';
+my $g_r_t = 'ret_type';
+my $g_n = 'name';
+my $g_c_n = 'c_name'
 
 sub new ($)
 {
@@ -24,8 +30,11 @@ sub new ($)
   my $class = ref ($type) or $type or "FunctionBase";
   my $self =
   {
-    $g_p_t => [];
-    $g_p_n => [];
+    $g_p_t => [],
+    $g_p_n => [],
+    $g_r_t => '',
+    $g_n => '',
+    $g_c_n => ''
   };
 
   bless ($self, $class);
@@ -62,6 +71,58 @@ sub set_param_names ($$)
   $self->{$g_p_n} = shift;
 }
 
+sub get_param_count ($)
+{
+  my $self = shift;
+
+  return scalar (@{$self->{$g_p_t}});
+}
+
+sub get_ret_type ($)
+{
+  my $self = shift;
+
+  return $self->{$g_r_t};
+}
+
+sub set_ret_type ($$)
+{
+  my $self = shift;
+  my $ret_type = shift;
+
+  $self->{$g_r_t} = $ret_type;
+}
+
+sub get_name ($)
+{
+  my $self = shift;
+
+  return $self->{$g_n};
+}
+
+sub set_name ($$)
+{
+  my $self = shift;
+  my $name = shift;
+
+  $self->{$g_n} = $name;
+}
+
+sub get_c_name ($)
+{
+  my $self = shift;
+
+  return $self->{$g_c_n};
+}
+
+sub set_c_name ($$)
+{
+  my $self = shift;
+  my $c_name = shift;
+
+  $self->{$g_c_n} = $c_name;
+}
+
 # $string args_types_only($)
 # comma-delimited argument types.
 sub args_types_only($)
diff --git a/tools/pm/WrapParser.pm b/tools/pm/WrapParser.pm
index 262b7c2..f7b4226 100644
--- a/tools/pm/WrapParser.pm
+++ b/tools/pm/WrapParser.pm
@@ -41,6 +41,16 @@ our @EXPORT_OK;
 
 ############################################################################
 
+#TODO: write a function in main guessing backend main module based on given definitions filename - gtk.defs will give Defs, gtk.gir will give Gir
+#TODO: on construction of Base::Api a module name should be passed. it will be used to create a backend for it.
+#TODO: require $guessed_main_module::Backend;
+#TODO: on construction take Base::Api as parameter.
+#TODO: Base::Api will give an outputter to use.
+#TODO: Outputter should be split into two classes - common part and backend part.
+#TODO: When setting backend for Base::Api it should also get backend for outputter.
+#TODO: Backend should have methods like used in Base::API and a method returning an outputter backend.
+
+
 my @tokens = ();
 
 # $objWrapParser new($objOutputter)
diff --git a/tools/pm/test.pl b/tools/pm/test.pl
index cfef16e..fcd0c8d 100755
--- a/tools/pm/test.pl
+++ b/tools/pm/test.pl
@@ -10,6 +10,7 @@ require Base::Enum;
 require Base::Function;
 require Base::Object;
 require Base::Property;
+require Base::Api;
 
 require Defs::Common;
 require Defs::Enum;
[Date Prev][Date Next] [Thread Prev][Thread Next] [Thread Index] [Date Index] [Author Index]