[glibmm/gmmproc-refactor] Add _PUSH_NAMED_CONV and _POP_NAMED_CONV macros.

[Krzesimir Nowak <krnowak src gnome org>]

commit bc5e19c5bfd37df520e2dd6635e37b98e7290b18
Author: Krzesimir Nowak <qdlacz gmail com>
Date:   Thu Jun 14 04:23:16 2012 +0200

    Add _PUSH_NAMED_CONV and _POP_NAMED_CONV macros.
    
    These macros are for defining temporary file-or-pop scoped
    conversions.

 tools/pm/Common/TypeInfo/Local.pm |  196 +++++++++++++++++++++++++++++++++++-
 tools/pm/Common/WrapParser.pm     |   77 +++++++++++++++
 2 files changed, 267 insertions(+), 6 deletions(-)
---
diff --git a/tools/pm/Common/TypeInfo/Local.pm b/tools/pm/Common/TypeInfo/Local.pm
index 5156be1..10a3ca5 100644
--- a/tools/pm/Common/TypeInfo/Local.pm
+++ b/tools/pm/Common/TypeInfo/Local.pm
@@ -30,6 +30,13 @@ sub _get_conversions ($)
   return $self->{'conversions'};
 }
 
+sub _get_named_conversions ($)
+{
+  my ($self) = @_;
+
+  return $self->{'named_conversions'};
+}
+
 sub _get_global ($)
 {
   my ($self) = @_;
@@ -37,6 +44,52 @@ sub _get_global ($)
   return $self->{'global'};
 }
 
+#named_conversions =>
+#{
+#  'names' => {$name => $from}, # this is for lookup whether name exists and for deletion.
+#  'conversions' =>
+#  {
+#    $from =>
+#    {
+#      'names' => {$name => $to}, # if this hash has only one element we are free to delete whole from part
+#      'to' =>
+#      {
+#        $to =>
+#        {
+#          'names_indices' => {$name => $index_in_names_stack}, # to quickly find $name's index in 'names_stack' so we can quickly remove it (without traversing whole stack).
+#          'names_stack' => [$name1, $name2], # order matters! index -1 (last) is top of the stack. if this array has only one element then we are free to delete whole to part. Otherwise we just remove a name from the 'names_stack', 'transfers' and 'names_indices'.
+#          'transfers' =>
+#          {
+#            $name1 => [$transfer_none, $transfer_container, $transfer_full],
+#            $name2 => [$transfer_none, $transfer_container, $transfer_full]
+#          }
+#        }
+#      }
+#    }
+#  }
+#}
+
+sub _get_named_conversion ($$$$$)
+{
+  my ($self, $from, $to, $transfer, $subst) = @_;
+  my $named_conversions = $self->_get_named_conversions ();
+  my $from_conversions = $named_conversions->{'conversions'};
+
+  if (exists ($from_conversions->{$from}))
+  {
+    my $to_conversions = $from_conversions->{$from}{'to'};
+
+    if (exists ($to_conversions->{$to}))
+    {
+      my $to_section = $to_conversions->{$to};
+      my $name = $to_section->{'names_stack'}[-1];
+
+      return $to_section->{'transfers'}{$name}[$transfer];
+    }
+  }
+  return undef;
+}
+
 sub new ($$)
 {
   my ($type, $global) = @_;
@@ -44,6 +97,11 @@ sub new ($$)
   my $self =
   {
     'conversions' => {},
+    'named_conversions' =>
+    {
+      'names' => {},
+      'conversions' => {}
+    },
     'global' => $global
   };
 
@@ -58,18 +116,144 @@ sub add_conversion ($$$$$$)
   Common::TypeInfo::Common::add_specific_conversion $conversions, $from, $to, $transfer_none, $transfer_container, $transfer_full;
 }
 
+sub named_conversion_exists ($$)
+{
+  my ($self, $name) = @_;
+  my $named_conversions = $self->_get_named_conversions ();
+  my $names = $named_conversions->{'names'};
+
+  return exists ($names->{$name});
+}
+
+sub push_named_conversion ($$$$$$$)
+{
+  my ($self, $name, $from, $to, $transfer_none, $transfer_container, $transfer_full) = @_;
+
+  die if $self->named_conversion_exists ($name);
+
+  my $named_conversions = $self->_get_named_conversions ();
+  my $toplevel_conversions = $named_conversions->{'conversions'};
+
+  $named_conversions->{'names'}{$name} = $from;
+
+  if (exists ($toplevel_conversions->{$from}))
+  {
+    my $from_section = $toplevel_conversions->{$from};
+    my $to_conversions = $toplevel_conversions->{'to'};
+
+    $from_section->{'names'}{$name} = $to;
+
+    if (exists ($to_conversions->{$to}))
+    {
+      my $to_section = $to_conversions->{$to};
+      my $names_stack = $to_section->{'names_stack'};
+
+      $to_section->{'names_indices'}{$name} = scalar (@{$names_stack});
+      push (@{$names_stack}, $name);
+      $to_section->{'transfers'}{$name} = [$transfer_none, $transfer_container, $transfer_full];
+    }
+    else
+    {
+      $to_conversions->{$to} =
+      {
+        'names_indices' => {$name => 0},
+        'names_stack' => [$name],
+        'transfers' =>
+        {
+          $name => [$transfer_none, $transfer_container, $transfer_full]
+        }
+      };
+    }
+  }
+  else
+  {
+    $toplevel_conversions->{$from} =
+    {
+      'names' => {$name => $to},
+      'to' =>
+      {
+        $to =>
+        {
+          'names_indices' => {$name => 0},
+          'names_stack' => [$name],
+          'transfers' =>
+          {
+            $name => [$transfer_none, $transfer_container, $transfer_full]
+          }
+        }
+      }
+    };
+  }
+}
+
+sub pop_named_conversion ($$)
+{
+  my ($self, $name) = @_;
+
+  die unless ($self->named_conversion_exists ($name));
+
+  my $named_conversions = $self->_get_named_conversions ();
+  my $toplevel_names = $named_conversions->{'names'};
+
+  if (scalar (keys (%{$toplevel_names})) > 1)
+  {
+    my $from = delete ($toplevel_names->{$name});
+    my $from_conversions = $named_conversions->{'conversions'};
+    my $from_section = $from_conversions->{$from};
+    my $from_names = $from_section->{'names'};
+
+    if (scalar (keys (%{$from_names})) > 1)
+    {
+      my $to = delete ($from_names->{$name});
+      my $to_conversions = $from_section->{'to'};
+      my $to_section = $to_conversions->{$to};
+      my $to_names_stack = $to_section->{'names_stack'};
+
+      if (scalar (@{$to_names_stack}) > 1)
+      {
+        my $index = delete ($to_section->{'names_indices'}{$name});
+
+        splice (@{$to_names_stack}, $index, 1);
+        delete ($to_section->{'transfers'}{$name});
+      }
+      else
+      {
+        delete $to_conversions->{$to};
+      }
+    }
+    else
+    {
+      delete $from_conversions->{$from};
+    }
+  }
+  else
+  {
+    $named_conversions =
+    {
+      'names' => {},
+      'conversions' => {}
+    };
+  }
+}
+
 sub get_conversion ($$$$$)
 {
   my ($self, $from, $to, $transfer, $subst) = @_;
-  my $conversions = $self->_get_conversions;
-  my $conversion = Common::TypeInfo::Common::get_specific_conversion $conversions, $from, $to, $transfer, $subst;
+  my $conversion = $self->_get_named_conversion ($from, $to, $transfer, $subst);
 
-  unless (defined $conversion)
+  unless (defined ($conversion))
   {
-    my $global = $self->_get_global;
+    my $conversions = $self->_get_conversions;
+
+    $conversion = Common::TypeInfo::Common::get_specific_conversion $conversions, $from, $to, $transfer, $subst;
+
+    unless (defined $conversion)
+    {
+      my $global = $self->_get_global;
 
-    # this will throw an exception when nothing is found.
-    $conversion = $global->get_conversion ($from, $to, $transfer, $subst);
+      # this will throw an exception when nothing is found.
+      $conversion = $global->get_conversion ($from, $to, $transfer, $subst);
+    }
   }
 
   return $conversion;
diff --git a/tools/pm/Common/WrapParser.pm b/tools/pm/Common/WrapParser.pm
index becc86e..4e80a6b 100644
--- a/tools/pm/Common/WrapParser.pm
+++ b/tools/pm/Common/WrapParser.pm
@@ -2508,6 +2508,81 @@ sub _on_pinclude ($)
   Common::Output::Misc::p_include $self, $str;
 }
 
+sub _on_push_named_conv ($)
+{
+  my ($self) = @_;
+  my @args = Common::Shared::string_split_commas ($self->_extract_bracketed_text ());
+
+  if (@args < 6)
+  {
+    $self->fixed_error ('Expected 6 parameters - conversion name, from type, to type, conversion for transfer none, conversion for transfer container and conversion for transfer full');
+  }
+  if (@args > 6)
+  {
+    $self->fixed_warning ('Superfluous parameter will be ignored.');
+  }
+
+  my $conv_name = shift (@args);
+  my $type_info_local = $self->get_type_info_local ();
+
+  if ($type_info_local->named_conversion_exists ($conv_name))
+  {
+    $self->fixed_error ('Conversion `' . $conv_name . '\' already exists.');
+  }
+
+  my ($from_type, $to_type, $transfer_none, $transfer_container, $transfer_full) = @args;
+  my $any_conv_exists = 0;
+
+  foreach my $transfer ($transfer_none, $transfer_container, $transfer_full)
+  {
+    if ($transfer eq 'NONE')
+    {
+      $transfer = undef;
+    }
+    else
+    {
+      $any_conv_exists = 1;
+    }
+  }
+
+  unless ($any_conv_exists)
+  {
+    $self->fixed_error ('At least one conversion has to be not NONE.');
+  }
+
+  $type_info_local->push_named_conversion ($conv_name,
+                                           Common::Shared::_type_fixup ($from_type),
+                                           Common::Shared::_type_fixup ($to_type),
+                                           $transfer_none,
+                                           $transfer_container,
+                                           $transfer_full);
+}
+
+sub _on_pop_named_conv ($)
+{
+  my ($self) = @_;
+  my @args = Common::Shared::string_split_commas ($self->_extract_bracketed_text ());
+
+  if (@args < 1)
+  {
+    $self->fixed_error ('Expected one parameter being name of conversion to be popped.');
+  }
+  if (@args > 1)
+  {
+    $self->fixed_warning ('Superfluous parameters will be ignored.');
+  }
+
+  my $conv_name = shift (@args);
+  my $type_info_local = $self->get_type_info_local ();
+
+  unless ($type_info_local->named_conversion_exists ($conv_name))
+  {
+    $self->fixed_error ('Conversion `' . $conv_name . '\' does not exist.');
+  }
+
+  $type_info_local->pop_named_conversion ($conv_name);
+}
+
 sub _on_add_conversion ($)
 {
   my ($self) = @_;
@@ -2700,6 +2775,8 @@ sub new ($$$$$$)
     '_MODULE' => [$self, \&_on_module],
     '_CTOR_DEFAULT' => [$self, \&_on_ctor_default],
     '_PINCLUDE' => [$self, \&_on_pinclude],
+    '_PUSH_NAMED_CONV' => [$self, \&_on_push_named_conv],
+    '_POP_NAMED_CONV' => [$self, \&_on_pop_named_conv],
     '_ADD_CONVERSION' => [$self, \&_on_add_conversion]
   };