[glibmm/gmmproc-refactor] Update general Gmmproc workings.
- From: Krzesimir Nowak <krnowak src gnome org>
- To: commits-list gnome org
- Cc:
- Subject: [glibmm/gmmproc-refactor] Update general Gmmproc workings.
- Date: Sat, 7 Apr 2012 14:36:00 +0000 (UTC)
commit 297a5f96a15a3b582f4dff578778a8beb3424cc8
Author: Krzesimir Nowak <qdlacz gmail com>
Date: Sat Apr 7 16:26:18 2012 +0200
Update general Gmmproc workings.
tools/pm/Common/CFunctionInfo.pm | 54 +
tools/pm/Common/CallableInfo.pm | 159 ++
tools/pm/Common/Constants.pm | 37 +
tools/pm/Common/ConversionsStore.pm | 387 +++
tools/pm/Common/CxxFunctionInfo.pm | 100 +
tools/pm/Common/Gmmproc.pm | 336 +++
tools/pm/Common/Scanner.pm | 967 ++++++++
tools/pm/Common/SectionManager.pm | 221 ++-
tools/pm/Common/Sections.pm | 79 +
tools/pm/Common/Sections/Conditional.pm | 23 +-
tools/pm/Common/Sections/Entries.pm | 4 +-
tools/pm/Common/Sections/Section.pm | 21 +-
tools/pm/Common/Shared.pm | 677 ++++++
tools/pm/Common/SignalInfo.pm | 242 ++
tools/pm/Common/TokensStore.pm | 112 +
tools/pm/Common/TypeInfoStore.pm | 356 +++
tools/pm/Common/Util.pm | 5 +-
tools/pm/Common/Variables.pm | 44 +
tools/pm/Common/WrapParser.pm | 3935 +++++++++++++++++++------------
19 files changed, 6130 insertions(+), 1629 deletions(-)
---
diff --git a/tools/pm/Common/CFunctionInfo.pm b/tools/pm/Common/CFunctionInfo.pm
new file mode 100644
index 0000000..7781966
--- /dev/null
+++ b/tools/pm/Common/CFunctionInfo.pm
@@ -0,0 +1,54 @@
+# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# gmmproc - Common::CFunctionInfo module
+#
+# Copyright 2012 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 Common::CFunctionInfo;
+
+use strict;
+use warnings;
+
+use parent qw (Common::CallableInfo);
+
+sub _get_name_from_gir ($$)
+{
+ my (undef, $gir_function) = @_;
+
+ return $gir_function->get_a_c_identifier;
+}
+
+sub new_from_gir ($$)
+{
+ my ($type, $gir_function) = @_;
+ my $class = (ref $type or $type or 'Common::CFunctionInfo');
+ my $self = $class->SUPER::new ($gir_function);
+ my $throws = $gir_function->get_a_throws;
+
+ $self->{'throws'} = $throws;
+
+ return bless $self, $class;
+}
+
+sub get_throws ($)
+{
+ my ($self) = @_;
+
+ return $self->{'throws'};
+}
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/CallableInfo.pm b/tools/pm/Common/CallableInfo.pm
new file mode 100644
index 0000000..373bc11
--- /dev/null
+++ b/tools/pm/Common/CallableInfo.pm
@@ -0,0 +1,159 @@
+# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# gmmproc - Common::CallableInfo module
+#
+# Copyright 2012 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 Common::CallableInfo;
+
+use strict;
+use warnings;
+
+sub _parse_typed ($)
+{
+ my ($gir_typed) = @_;
+
+ if ($gir_typed->get_g_type_count > 0)
+ {
+ my $gir_type = $gir_typed->get_g_type_by_index (0);
+
+ return $gir_type->get_a_c_type;
+ }
+ elsif ($gir_typed->get_g_array_count > 0)
+ {
+ my $gir_array = $gir_typed->get_g_array_by_index (0);
+
+ return $gir_array->get_a_c_type;
+ }
+ elsif ($gir_typed->get_g_varargs_count > 0)
+ {
+ return '...';
+ }
+ else die;
+}
+
+sub _parse_parameters ($)
+{
+ my ($gir_function) = @_;
+ my $param_types = [];
+ my $param_names = [];
+ my $param_transfers = [];
+
+ if ($gir_function->get_g_parameters_count > 0)
+ {
+ my $gir_parameters = $gir_function->get_g_parameters_by_index (0);
+ my $gir_parameters_count = $gir_parameters->get_g_parameter_count;
+
+ for (my $iter = 0; $iter < $gir_parameters_count; ++$iter)
+ {
+ my $gir_parameter = $gir_parameters->get_g_parameter_by_index ($iter);
+ my $name = $gir_parameter->get_a_name;
+ my $transfer = Common::ConversionsStore::transfer_from_string $gir_parameter->get_a_transfer_ownership;
+ my $type = _parse_parameter $gir_parameter;
+
+# TODO: error.
+ die unless ($type);
+ push @{$param_types}, $type;
+ push @{$param_names}, $name;
+ push @{$param_transfers}, $transfer;
+ }
+ }
+ return ($param_types, $param_names, $param_transfers);
+}
+
+sub _parse_parameter ($$)
+{
+ my ($self, $gir_parameter) = @_;
+
+ return $self->_parse_typed ($gir_parameter);
+}
+
+sub _parse_return_value ($$)
+{
+ my ($self, $gir_return_value) = @_;
+
+ return $self->_parse_typed ($gir_return_value);
+}
+
+sub new_from_gir ($$)
+{
+ my ($type, $gir_callable) = @_;
+ my $class = (ref $type or $type or 'Common::CallableInfo');
+ # Bless now, so we can use virtual methods.
+ my $self = bless $class, $type;
+ my $gir_return = $gir_callable->get_g_return_value_by_index (0);
+ my $ret = $self->_parse_return_value ($gir_return);
+ my $ret_transfer = Common::ConversionsStore::transfer_from_string $gir_return->get_a_transfer_ownership;
+ my $name = $self->_get_name_from_gir ($gir_callable)
+ my ($param_types, $param_names, $param_transfers) = $self->_parse_parameters ($gir_callable);
+
+ my $self =
+ {
+ 'ret' => $ret,
+ 'ret_transfer' => $ret_transfer,
+ 'name' => $name,
+ 'param_types' => $param_types,
+ 'param_names' => $param_names,
+ 'param_transfers' => $param_transfers,
+ };
+
+ return $self;
+}
+
+sub get_return_type ($)
+{
+ my ($self) = @_;
+
+ return $self->{'ret'};
+}
+
+sub get_return_transfer ($)
+{
+ my ($self) = @_;
+
+ return $self->{'ret_transfer'};
+}
+
+sub get_name ($)
+{
+ my ($self) = @_;
+
+ return $self->{'name'};
+}
+
+sub get_param_types ($)
+{
+ my ($self) = @_;
+
+ return $self->{'param_types'};
+}
+
+sub get_param_names ($)
+{
+ my ($self) = @_;
+
+ return $self->{'param_names'};
+}
+
+sub get_param_transfers ($)
+{
+ my ($self) = @_;
+
+ return $self->{'param_transfers'};
+}
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/Constants.pm b/tools/pm/Common/Constants.pm
new file mode 100644
index 0000000..214fcd9
--- /dev/null
+++ b/tools/pm/Common/Constants.pm
@@ -0,0 +1,37 @@
+# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# gmmproc - Common::Constants module
+#
+# Copyright 2012 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 Common::Constants;
+
+use strict;
+use warnings;
+
+use constant
+{
+ 'INVALID' => 0,
+ 'FILE' => 1,
+ 'NAMESPACE' => 2,
+ 'CLASS' => 3,
+ 'FIRST_CLASS' => 4,
+ 'FIRST_NAMESPACE' => 5,
+ 'LAST' => 6
+};
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/ConversionsStore.pm b/tools/pm/Common/ConversionsStore.pm
new file mode 100644
index 0000000..94a13e1
--- /dev/null
+++ b/tools/pm/Common/ConversionsStore.pm
@@ -0,0 +1,387 @@
+# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# gmmproc - Common::Conversions module
+#
+# Copyright 2012 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 Common::ConversionsStore;
+
+use strict;
+use warnings;
+use feature ':5.10';
+use constant
+{
+ 'TRANSFER_INVALID' => -1, # do not use
+ 'TRANSFER_NONE' => 0,
+ 'TRANSFER_CONTAINER' => 1,
+ 'TRANSFER_FULL' => 2,
+ 'TRANSFER_LAST' => 3 # do not use
+};
+
+sub transfer_from_string ($)
+{
+ my ($string) = @_;
+
+ if ($string eq 'none')
+ {
+ return TRANSFER_NONE;
+ }
+ if ($string eq 'container')
+ {
+ return TRANSFER_CONTAINER;
+ }
+ if ($string eq 'full')
+ {
+ return TRANSFER_FULL;
+ }
+ return TRANSFER_INVALID;
+}
+
+sub transfer_to_string ($)
+{
+ my ($transfer) = @_;
+
+ given ($transfer)
+ {
+ when (TRANSFER_NONE)
+ {
+ return 'none';
+ }
+ when (TRANSFER_CONTAINER)
+ {
+ return 'container';
+ }
+ when (TRANSFER_FULL)
+ {
+ return 'full';
+ }
+ default
+ {
+ return 'invalid';
+ }
+ }
+}
+
+sub _new_generic ($$$)
+{
+ my ($type, $global_store, $generated) = @_;
+ my $class = (ref $type or $type or 'Common::ConversionsStore');
+ my $self =
+ {
+ 'our' => {},
+ 'generated' => $generated,
+ 'other' => $global_store
+ };
+
+ return bless $self, $class;
+}
+
+sub _get_our ($)
+{
+ my ($self) = @_;
+
+ return $self->{'our'};
+}
+
+sub _get_other ($)
+{
+ my ($self) = @_;
+
+ return $self->{'other'};
+}
+
+sub _get_generated ($)
+{
+ my ($self) = @_;
+
+ return $self->{'generated'};
+}
+
+sub _add_generic ($$$$$$$)
+{
+ my ($self, $from, $to, $transfer_none, $transfer_container, $transfer_full, $conversions) = @_;
+ unless (exists $conversions->{$from})
+ {
+ $conversions->{$from} = {};
+ }
+
+ my $from_conversions = $conversions->{$from};
+
+ unless (exists $from_conversions->{$to})
+ {
+ $from_conversions->{$to} = [$transfer_none, $transfer_container, $transfer_full];
+ }
+# TODO: what should be done with duplicates?
+}
+
+sub new_local ($$)
+{
+ my ($type, $global_store) = @_;
+
+ return _new_generic ($type, $global_store, undef);
+}
+
+sub new_global ($$$)
+{
+ my ($type, $mm_module, $include_paths) = @_;
+ my $self = _new_generic ($type, undef, {});
+
+ $self->{'mm_module'} = $mm_module;
+ $self->{'include_paths'} = $include_paths;
+
+ return $self;
+}
+
+sub add_new ($$$$$$)
+{
+ my ($self, $from, $to, $transfer_none, $transfer_container, $transfer_full) = @_;
+ my $conversions = $self->_get_our;
+
+ $self->_add_generic ($from, $to, $transfer_none, $transfer_container, $transfer_full, $conversions);
+}
+
+sub add_new_generated ($$$$$$)
+{
+ my ($self, $from, $to, $transfer_none, $transfer_container, $transfer_full) = @_;
+ my $conversions = $self->_get_generated;
+
+# TODO: exception - not usable from local instance.
+ die unless defined $conversions;
+
+ $self->_add_generic ($from, $to, $transfer_none, $transfer_container, $transfer_full, $conversions);
+}
+
+sub get_conversion ($$$$$)
+{
+ my ($self, $from, $to, $transfer, $name) = @_;
+ my $conversion = undef;
+
+ if ($transfer > TRANSFER_INVALID and $transfer < TRANSFER_LAST)
+ {
+ my @conversions_table = ($self->_get_our, $self->_get_generated);
+
+ foreach my $conversions (@conversions_table)
+ {
+ if (defined $conversions and exists $conversions->{$from})
+ {
+ my $from_conversions = $conversions->{$from};
+
+ if (exists $from_conversions->{$to})
+ {
+ my $template = undef;
+
+ do
+ {
+ $template = $from_conversions->{$to}[$transfer];
+ --$transfer;
+ }
+ while (not defined $template and $transfer != TRANSFER_INVALID);
+
+ if (defined $template)
+ {
+ $template =~ s/##ARG##/$name/g;
+
+ $conversion = $template;
+ last;
+ }
+ }
+ }
+ }
+ }
+
+ unless (defined $conversion)
+ {
+ my $other = $self->_get_other;
+
+ if (defined $other)
+ {
+ $conversion = $other->get_conversion ($from, $to, $transfer, $name);
+ }
+ }
+
+ return $conversion;
+}
+
+sub add_from_file ($$)
+{
+ my ($self, $basename) = @_;
+ my $mm_module = $self->_get_mm_module;
+
+ # Do not even try to look for file that is going to be generated
+ # at the end. Yeah, we make such basename reserved.
+ if ($basename ne join '_', 'conversions', $mm_module, 'generated')
+ {
+ my $include_paths = $self->_get_include_paths;
+ my $read_files = $self->_get_read_files;
+
+ foreach my $path (@{$include_paths})
+ {
+ my $inc_filename = File::Spec->catfile ($path, $basename);
+
+ if (-f $inc_filename and -r $inc_filename)
+ {
+ unless (exists $read_files->{$inc_filename})
+ {
+ my $fd = IO::File->new ($inc_filename, 'r');
+
+ $read_files->{$inc_filename} = undef;
+ unless (defined $fd)
+ {
+# TODO: throw an error
+ print STDERR 'Could not open file `' . $inc_filename . '\' for reading.' . "\n";
+ exit 1;
+ }
+
+ my @lines = $fd->getlines;
+ my $c_to_cpp = $self->_get_c_to_cpp (1);
+ my $cpp_to_c = $self->_get_cpp_to_c (1);
+ my $line_num = 0;
+ my $from = undef;
+ my $to = undef;
+ my $transfers = [undef, undef, undef];
+ my $expect_brace = 0;
+
+ $fd->close;
+ foreach my $line (@lines)
+ {
+ ++$line_num;
+ $line =~ s/\s*#.*//;
+ $line = Common::Util::string_trim ($line);
+ next unless $line;
+ if ($expect_brace)
+ {
+ unless ($line =~ '^\s*\{\s*$')
+ {
+# TODO: parsing error - expected opening brace only in line.
+ die;
+ }
+ $expect_brace = 0;
+ }
+ elsif (defined $from and defined $to)
+ {
+ if ($line =~ /\s*(\w)+\s*:\s*(.*)$/)
+ {
+ my $transfer_str = $1;
+ my $transfer = $2;
+ my $index = transfer_from_string $transfer_str;
+
+# TODO: parsing error - wrong transfer name.
+ die if ($index == TRANSFER_INVALID);
+ if (defined $transfers->[$index])
+ {
+# TODO: parsing error - that transfer is already defined.
+ die;
+ }
+
+ $transfers->[$index] = $transfer;
+ }
+ elsif ($line =~ /^\s*\}\s*$/)
+ {
+ my $added = 0;
+
+ foreach my $transfer_type (TRANSFER_NONE .. TRANSFER_FULL)
+ {
+ if (defined $transfers->[$transfer_type])
+ {
+ $added = 1;
+ $self->add_new ($from,
+ $to,
+ @{$transfers});
+ last;
+ }
+ }
+# TODO: parsing error - no transfer specified.
+ die unless $added;
+ }
+ }
+ elsif ($line =~ /^(.+?)\s*=>\s*(.+):$/)
+ {
+ $from = $1;
+ $to = $2;
+ $expect_brace = 1;
+ }
+ elsif ($line =~ /^include\s+(\S+)^/)
+ {
+ my $inc_basename = $1;
+
+ $self->add_from_file ($inc_basename);
+ }
+ else
+ {
+ print STDERR $inc_filename . ':' . $line_num . ' - could not parse the line.' . "\n";
+ }
+ }
+ }
+ last;
+ }
+ }
+ }
+}
+
+sub write_to_file ($)
+{
+ my ($self) = @_;
+ my $conversions = $self->_get_generated;
+
+# TODO: error - not usable from local instance.
+ die unless defined $conversions;
+
+ my $include_paths = $self->_get_include_paths;
+ my $mm_module = $self->_get_mm_module;
+
+ unless (@{$include_paths})
+ {
+# TODO: internal error.
+ die;
+ }
+
+ my $filename = File::Spec->catfile ($include_paths->[0], join '_', 'conversions', $mm_module, 'generated');
+ my $fd = IO::File->new ($filename, 'w');
+
+ unless (defined $fd)
+ {
+# TODO: error.
+ die;
+ }
+
+ foreach my $from (sort keys %{$conversions})
+ {
+ my $to_convs = $conversions->{$from};
+
+ foreach my $to (sort keys %{$to_convs})
+ {
+ my $transfers = $to_convs->{$to};
+
+ $fd->print (join '', $from, ' => ', $to, ':', "\n", '{', "\n");
+
+ foreach my $transfer_type (TRANSFER_NONE .. TRANSFER_FULL)
+ {
+ my $transfer = $transfers->[$transfer_type];
+
+ if (defined $transfer)
+ {
+ $fd->print (join '', ' ', (transfer_to_string $transfer_type), ': ', $transfer, "\n");
+ }
+ }
+
+ $fd->print (join '', '}', "\n\n");
+ }
+ }
+ $fd->close;
+}
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/CxxFunctionInfo.pm b/tools/pm/Common/CxxFunctionInfo.pm
new file mode 100644
index 0000000..8c34c44
--- /dev/null
+++ b/tools/pm/Common/CxxFunctionInfo.pm
@@ -0,0 +1,100 @@
+# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# gmmproc - Common::CxxFunctionInfo module
+#
+# Copyright 2012 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 Common::CxxFunctionInfo;
+
+use strict;
+use warnings;
+
+use Common::Shared;
+
+sub new_from_string ($$)
+{
+ my ($type, $string) = @_;
+ my $class = (ref $type or $type or 'Common::CxxFunctionInfo');
+ my $cxx_parts = Common::Shared::parse_function_declaration $string;
+ my $params = Common::Shared::parse_params $cxx_parts->[3];
+ my $param_types = [];
+ my $param_names = [];
+
+ foreach my $desc (@{$params})
+ {
+ push @{$param_types}, $desc->{'type'};
+ push @{$param_names}, $desc->{'name'};
+ }
+
+ $params = undef;
+
+ my $self =
+ {
+ 'static' => ($cxx_parts->[0] =~ /\bstatic\b/),
+ 'ret' => $cxx_parts->[1],
+ 'name' => $cxx_parts->[2],
+ 'param_types' => $param_types,
+ 'param_names' => $param_names,
+ 'const' => ($cxx_parts->[4] =~ /\bconst\b/)
+ };
+
+ return bless $self, $class;
+}
+
+sub get_static ($)
+{
+ my ($self) = @_;
+
+ return $self->{'static'};
+}
+
+sub get_return_type ($)
+{
+ my ($self) = @_;
+
+ return $self->{'ret'};
+}
+
+sub get_name ($)
+{
+ my ($self) = @_;
+
+ return $self->{'name'};
+}
+
+sub get_param_types ($)
+{
+ my ($self) = @_;
+
+ return $self->{'param_types'};
+}
+
+sub get_param_names ($)
+{
+ my ($self) = @_;
+
+ return $self->{'param_names'};
+}
+
+sub get_const ($)
+{
+ my ($self) = @_;
+
+ return $self->{'const'};
+}
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/Gmmproc.pm b/tools/pm/Common/Gmmproc.pm
new file mode 100644
index 0000000..88991e0
--- /dev/null
+++ b/tools/pm/Common/Gmmproc.pm
@@ -0,0 +1,336 @@
+# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# gmmproc - Common::Gmmproc module
+#
+# Copyright 2012 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 Common::Gmmproc;
+
+use strict;
+use warnings;
+
+use IO::File;
+
+use Common::Sections;
+use Common::SectionManager;
+use Common::TokensStore;
+use Common::TypeInfoStore;
+use Common::WrapParser;
+use Common::Variables;
+
+use Gir::Repositories;
+
+sub _tokenize_contents_ ($)
+{
+ my ($contents) = @_;
+ # Break the file into tokens. Token is:
+ # - any group of #, A to z, 0 to 9, _
+ # - /**
+ # - /*!
+ # - /*
+ # - */
+ # - ///
+ # - //!
+ # - //
+ # - any char proceeded by \
+ # - symbols ;{}"`'():
+ # - newline
+ my @tokens = split(/([#A-Za-z0-9_]+)|(\/\*[*!]?)|(\*\/)|(\/\/[\/!]?)|(\\.)|([:;{}"'`()])|(\n)/,
+ $contents);
+# my @tokens = split(/([#A-Za-z0-9_]+)|(\/\**)|(\/\*!)|(\/\*)|(\*\/)|(\/\/\/)|(\/\/!)|(\/\/)|(\\.)|([:;{}"'`()])|(\n)/,
+# $contents);
+
+ return \ tokens;
+}
+
+sub _prepare ($)
+{
+ my ($self) = @_;
+ my $conversions_store = $self->get_conversions_store;
+ my $type_info_store = $self->get_type_info_store;
+
+ $conversions_store->add_from_file ('conversions');
+ $type_info_store->add_from_file ('mappings');
+}
+
+sub _read_all_bases ($)
+{
+ my ($self) = @_;
+ my $source_dir = $self->get_source_dir;
+ my $bases = $self->get_bases;
+
+ # parallelize
+ foreach my $base (sort keys %{$bases})
+ {
+ my $tokens_store = $bases->{$base};
+ my $source = File::Spec->catfile ($source_dir, $base);
+ my $hg = $source . '.hg';
+ my $ccg = $source . '.ccg';
+ my $fd = IO::File->new ($hg, 'r');
+
+ unless (defined $fd)
+ {
+ print 'Could not open file `' . $hg . '\' for reading.' . "\n";
+ exit 1;
+ }
+
+ $tokens_store->set_hg_tokens (_tokenize_contents_ (join '', $fd->getlines));
+ $fd->close;
+
+ # Source file is optional.
+ $fd = IO::File->new ($ccg, 'r');
+ if (defined $fd)
+ {
+ my $str = join '',
+ '_INSERT_SECTION(SECTION_CCG_BEGIN)',
+ "\n",
+ $fd->getlines,
+ "\n",
+ '_INSERT_SECTION(SECTION_CCG_END)',
+ "\n";
+ $tokens_store->set_ccg_tokens (_tokenize_contents_ ($str));
+ $fd->close;
+ }
+ }
+}
+
+sub _scan_all_bases ($)
+{
+ my ($self) = @_;
+ my $bases = $self->get_bases;
+ my @bases_keys = sort keys %{$bases};
+
+ # parallelize
+ foreach my $base (@bases_keys)
+ {
+ my $tokens_store = $bases->{$base};
+ my $tokens_hg = $tokens_store->get_hg_tokens;
+ my $tokens_ccg = $tokens_store->get_ccg_tokens;
+ my $scanner = Common::Scanner->new ($tokens_hg, $tokens_ccg);
+
+ $scanner->scan;
+ $tokens_store->set_pairs ($scanner->get_pairs);
+ $tokens_store->set_conversions ($scanner->get_conversions);
+ }
+
+ my $type_info_store = $self->get_type_info_store;
+ my $conversions_store = $self->get_conversions_store;
+
+ foreach my $base (@bases_keys)
+ {
+ my $tokens_store = $bases->{$base};
+ my $pairs = $tokens_store->get_pairs;
+
+ foreach my $pair (@{$pairs})
+ {
+ my $c_stuff = $pair->[0];
+ my $cpp_stuff = $pair->[1];
+
+ $type_info_store->add_new ($c_stuff, $cpp_stuff);
+ }
+
+ my $conversions = $tokens_store->get_conversions;
+
+ foreach my $conversion (@{$conversions})
+ {
+ $conversions_store->add_new_generated (@{$conversion});
+ }
+ }
+}
+
+sub _parse_all_bases ($)
+{
+ my ($self) = @_;
+ my $bases = $self->get_bases;
+ my $type_info_store = $self->get_type_info_store;
+ my $section_managers = $self->get_section_managers;
+ my $repositories = $self->get_repositories;
+ my $conversions_store = $self->get_conversions_store;
+ my $mm_module = $self->get_mm_module;
+
+ # parallelize
+ foreach my $base (@{$bases})
+ {
+ my $tokens_store = $bases->{$base};
+ my $tokens_hg = $tokens_store->get_hg_tokens;
+ my $tokens_ccg = $tokens_store->get_ccg_tokens;
+ my $wrap_parser = Common::WrapParser->new ($tokens_hg,
+ $tokens_ccg,
+ $type_info_store,
+ $repositories,
+ $conversions_store,
+ $mm_module);
+
+ $wrap_parser->parse;
+ $tokens_store->set_section_manager ($wrap_parser->get_section_manager);
+ }
+}
+
+sub _generate_all_bases ($)
+{
+ my ($self) = @_;
+ my $bases = $self->get_bases;
+ my $destination_dir = $self->get_destination_dir;
+
+ # parallelize
+ foreach my $base (sort keys %{$bases})
+ {
+ my $tokens_store = $bases->{$base};
+ my $section_manager = $tokens_store->get_section_manager;
+ my $h_file = File::Spec->catfile ($destination_dir, $base . '.h');
+ my $cc_file = File::Spec->catfile ($destination_dir, $base . '.cc');
+ my $p_h_file = File::Spec->catfile ($destination_dir, 'private', $base . '_p.h');
+
+ $section_manager->write_main_section_to_file (Common::Sections::H, $h_file);
+ $section_manager->write_main_section_to_file (Common::Sections::CC, $cc_file);
+ $section_manager->write_main_section_to_file (Common::Sections::P_H, $p_h_file);
+ }
+}
+
+sub _finish ($)
+{
+ my ($self) = @_;
+ my $conversions_store = $self->get_conversions_store;
+ my $type_info_store = $self->get_type_info_store;
+
+ $conversions_store->write_to_file ('conversions');
+ $type_info_store->write_to_file ('mappings');
+}
+
+sub new ($$$$)
+{
+ my ($type, $repositories, $mm_module, $include_paths) = @_;
+ my $class = (ref $type or $type or 'Common::Gmmproc');
+ my $self =
+ {
+ 'repositories' => $repositories,
+ 'bases' => {},
+ 'source_dir' => '.',
+ 'destination_dir' => '.',
+ 'type_info_store' => Common::TypeInfoStore->new ($mm_module, $include_paths),
+ 'conversions_store' => Common::ConversionsStore->new_global ($mm_module, $include_paths),
+ 'mm_module' => $mm_module,
+ 'include_paths' => $include_paths
+ };
+
+ return bless $self, $class;
+}
+
+sub set_source_dir ($$)
+{
+ my ($self, $source_dir) = @_;
+
+ $self->{'source_dir'} = $source_dir;
+}
+
+sub get_source_dir ($)
+{
+ my ($self) = @_;
+
+ return $self->{'source_dir'};
+}
+
+sub set_destination_dir ($$)
+{
+ my ($self, $destination_dir) = @_;
+
+ $self->{'destination_dir'} = $destination_dir;
+}
+
+sub get_destination_dir ($)
+{
+ my ($self) = @_;
+
+ return $self->{'destination_dir'};
+}
+
+sub set_include_paths ($$)
+{
+ my ($self, $includes) = @_;
+
+ $self->{'includes'} = $includes;
+}
+
+sub get_include_paths ($)
+{
+ my ($self) = @_;
+
+ return $self->{'includes'};
+}
+
+sub add_base ($$)
+{
+ my ($self, $base) = @_;
+ my $bases = $self->get_bases;
+
+ if (exists $bases->{$base})
+ {
+ print STDERR 'Base `' . $base . ' was already added.' . "\n";
+ return;
+ }
+
+ $bases->{$base} = Common::TokensStore->new;
+}
+
+sub get_bases ($)
+{
+ my ($self) = @_;
+
+ return $self->{'bases'};
+}
+
+sub get_repositories ($)
+{
+ my ($self) = @_;
+
+ return $self->{'repositories'};
+}
+
+sub get_type_info_store ($)
+{
+ my ($self) = @_;
+
+ return $self->{'type_info_store'};
+}
+
+sub get_conversions_store ($)
+{
+ my ($self) = @_;
+
+ return $self->{'conversions_store'};
+}
+
+sub get_mm_module ($)
+{
+ my ($self) = @_;
+
+ return $self->{'mm_module'};
+}
+
+sub parse_and_generate ($)
+{
+ my ($self) = @_;
+
+ $self->_prepare;
+ $self->_read_all_bases;
+ $self->_scan_all_bases;
+ $self->_parse_all_bases;
+ $self->_generate_all_bases;
+ $self->_finish;
+}
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/Scanner.pm b/tools/pm/Common/Scanner.pm
new file mode 100644
index 0000000..aa14cd8
--- /dev/null
+++ b/tools/pm/Common/Scanner.pm
@@ -0,0 +1,967 @@
+# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# gmmproc - Common::Scanner module
+#
+# Copyright 2012 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 Common::Scanner;
+
+use strict;
+use warnings;
+
+use Common::Shared;
+use constant
+{
+ 'STAGE_HG' => 0,
+ 'STAGE_CCG' => 1,
+ 'STAGE_INVALID' => 2
+};
+
+sub _get_stages ($)
+{
+ my ($self) = @_;
+
+ return $self->{'stages'};
+}
+
+sub _set_tokens ($$)
+{
+ my ($self, $tokens) = @_;
+
+ $self->{'tokens'} = $tokens;
+}
+
+sub _get_tokens ($)
+{
+ my ($self) = @_;
+
+ return $self->{'tokens'};
+}
+
+sub _get_namespaces ($)
+{
+ my ($self) = @_;
+
+ return $self->{'namespaces'};
+}
+
+sub _get_classes ($)
+{
+ my ($self) = @_;
+
+ return $self->{'classes'};
+}
+
+sub _inc_level ($)
+{
+ my ($self) = @_;
+
+ ++$self->{'level'};
+}
+
+sub _dec_level ($)
+{
+ my ($self) = @_;
+
+ --$self->{'level'};
+}
+
+sub _get_level ($)
+{
+ my ($self) = @_;
+
+ return $self->{'level'};
+}
+
+sub _get_class_levels ($)
+{
+ my ($self) = @_;
+
+ return $self->{'class_levels'};
+}
+
+sub _get_namespace_levels ($)
+{
+ my ($self) = @_;
+
+ return $self->{'namespace_levels'};
+}
+
+sub _get_handlers ($)
+{
+ my ($self) = @_;
+
+ return $self->{'handlers'};
+}
+
+sub _switch_to_stage ($$)
+{
+ my ($self, $stage) = @_;
+ my $stages = $self->_get_stages;
+
+ if (exists $stages->{$stage})
+ {
+ $self->_set_tokens ($stages->{$stage});
+ }
+ else
+ {
+# TODO: throw an internal error
+ print STDERR 'Internal error in Scanner - unknown stage: ' . $stage . "\n";
+ exit 1;
+ }
+}
+
+sub _extract_token ($)
+{
+ my ($self) = @_;
+ my $tokens = $self->_get_tokens;
+ my $results = Common::Shared::extract_token $tokens;
+
+ return $results->[0];
+}
+
+sub _on_string_with_end ($$)
+{
+ my ($self, $end) = @_;
+ my $tokens = $self->_get_tokens;
+
+ while (@{$tokens})
+ {
+ my $token = $self->extract_token;
+
+ if ($token eq $end)
+ {
+ last;
+ }
+ }
+}
+
+sub _extract_bracketed_text ($)
+{
+ my ($self) = @_;
+ my $tokens = $self->_get_tokens;
+ my $result = Common::Shared::extract_bracketed_text $tokens;
+
+ if (defined $result)
+ {
+ my $string = $result->[0];
+ my $add_to_line = $result->[1];
+
+ return $string;
+ }
+}
+
+sub _make_full_type ($$)
+{
+ my ($self, $cpp_type) = @_;
+ my $namespaces = $self->_get_namespaces;
+ my $classes = $self->_get_classes;
+
+ if (defined $cpp_type)
+ {
+ return join '::', reverse @{$namespaces}, reverse @{$classes}, $cpp_type;
+ }
+ else
+ {
+ return join '::', reverse @{$namespaces}, reverse @{$classes};
+ }
+}
+
+sub _append ($$$)
+{
+ my ($self, $c_stuff, $cpp_stuff) = @_;
+ my $pairs = $self->get_pairs;
+
+ push @{$pairs}, [$c_stuff, $cpp_stuff];
+}
+
+sub _get_params ($)
+{
+ my ($self) = @_;
+ my @args = Common::Shared::string_split_commas $self->extract_bracketed_text;
+
+ if (@args < 2)
+ {
+ return undef;
+ }
+
+ return [$args[0], $args[1]];
+}
+
+sub _on_wrap_func_generic ($$)
+{
+ my ($self, $args) = @_;
+ my $cpp_function = Common::Shared::parse_function_declaration ($args->[0])->[2];
+ my $c_function = $args->[1];
+
+ $self->_append ($c_function, $self->_make_full_type ($cpp_function));
+}
+
+sub _on_wrap_enum_generic ($$)
+{
+ my ($self, $args) = @_;
+ my $cpp_enum = $args->[0];
+ my $c_enum = $args->[1];
+
+ $self->_append ($c_enum, $self->_make_full_type ($cpp_enum));
+}
+
+sub _on_wrap_class_generic ($$)
+{
+ my ($self, $args) = @_;
+ my $classes = $self->_get_classes;
+ my $cpp_class = $args->[0];
+ my $c_class = $args->[1];
+
+ if (@{$classes} > 0 and $classes->[-1] eq $cpp_class)
+ {
+ $self->_append ($c_class, $self->_make_full_type (undef));
+ }
+}
+
+sub _on_convert_enum ($$)
+{
+ my ($self, $args) = @_;
+ my $cpp_enum = $args->[0];
+ my $c_enum = $args->[1];
+ my $full_cpp_enum = $self->_make_full_type ($cpp_enum);
+ my $sub_types = Common::Shared::split_cpp_type_to_sub_types $full_cpp_enum;
+
+ foreach my $sub_type (@{$sub_types})
+ {
+ $self->push_conv($c_enum, $sub_type, 'static_cast< ' . $sub_type . ' >(##ARG##)', undef, undef);
+ $self->push_conv($sub_type, $c_enum, 'static_cast< ' . $c_enum . ' >(##ARG##)', undef, undef);
+ }
+}
+
+sub _generate_containers ($$$)
+{
+ my ($self, $c_class, $all_types) = @_;
+ my $arg = '##ARG##';
+ my @list_sub_types = ('Glib::ListHandle', 'ListHandle');
+ my @slist_sub_types = ('Glib::SListHandle', 'SListHandle');
+ my @array_sub_types = ('Glib::ArrayHandle', 'ArrayHandle');
+ my @vector_sub_types = ('std::vector', 'vector');
+ my @ownerships = ('Glib::OWNERSHIP_NONE', 'Glib::OWNERSHIP_SHALLOW', 'Glib::OWNERSHIP_DEEP');
+ my $handle_to_c = '(' . $arg . ').data()';
+ my @c_array_types = ($c_class . '**', 'const ' . $c_class . '**', $c_class . '* const*', 'const ' . $c_class . '* const*');
+
+ foreach my $list_sub_type (@list_sub_types)
+ {
+ my @list_member_types = map { $list_sub_type . '< ' . $_ . ' >'} @{$all_types};
+
+ push @list_member_types, (map { $_ . '&' } @list_member_types);
+
+ my @const_list_member_types = map { 'const ' . $_ } @list_member_types;
+ my $glist = 'GList*';
+ my $const_glist = 'const ' . $glist;
+ my $cc_handle_to_c = 'const_cast< ' . $glist . ' >(' . $handle_to_c . ')';
+
+ foreach my $list_type (@list_member_types)
+ {
+ my @to_cxx = map { $list_type . '(' . $arg . ', ' . $_ . ')' } @ownerships;
+ my @to_cxx_cc = map { $list_type . '(const_cast< ' . $glist . ' >(' . $arg . '), ' . $_ . ')' } @ownerships;
+
+ $self->push_conv ($list_type, $glist, $handle_to_c, undef, undef);
+ $self->push_conv ($list_type, $const_glist, $handle_to_c, undef, undef);
+ $self->push_conv ($glist, $list_type, @to_cxx[0 .. 2]);
+ $self->push_conv ($const_glist, $list_type, @to_cxx_cc[0 .. 2]);
+ }
+ foreach my $list_type (@const_list_member_types)
+ {
+ my @to_cxx = map { $list_type . '(' . $arg . ', ' . $_ . ')' } @ownerships;
+
+ $self->push_conv ($list_type, $glist, $cc_handle_to_c, undef, undef);
+ $self->push_conv ($list_type, $const_glist, $handle_to_c, undef, undef);
+ $self->push_conv ($glist, $list_type, @to_cxx[0 .. 2]);
+ $self->push_conv ($const_glist, $list_type, @to_cxx[0 .. 2]);
+ }
+ }
+ foreach my $slist_sub_type (@slist_sub_types)
+ {
+ my @slist_member_types = map { $slist_sub_type . '< ' . $_ . ' >' } ${all_types};
+
+ push @slist_member_types, (map { $_ . '&' } @slist_member_types);
+
+ my @const_slist_member_types = map { 'const ' . $_ } @slist_member_types;
+ my $gslist = 'GSList*';
+ my $const_gslist = 'const ' . $gslist;
+ my $cc_handle_to_c = 'const_cast< ' . $gslist . ' >(' . $handle_to_c . ')';
+
+ foreach my $slist_type (@slist_member_types)
+ {
+ my @to_cxx = map { $slist_type . '(' . $arg . ', ' . $_ . ')' } @ownerships;
+ my @to_cxx_cc = map { $slist_type . '(const_cast< ' . $gslist . ' >(' . $arg . '), ' . $_ . ')' } @ownerships;
+
+ $self->push_conv ($slist_type, $gslist, $handle_to_c, undef, undef);
+ $self->push_conv ($slist_type, $const_gslist, $handle_to_c, undef, undef);
+ $self->push_conv ($gslist, $slist_type, @to_cxx[0 .. 2]);
+ $self->push_conv ($const_gslist, $slist_type, @to_cxx_cc[0 .. 2]);
+ }
+ foreach my $slist_type (@const_slist_member_types)
+ {
+ my @to_cxx = map { $slist_type . '(' . $arg . ', ' . $_ . ')' } @ownerships;
+
+ $self->push_conv ($slist_type, $gslist, $cc_handle_to_c, undef, undef);
+ $self->push_conv ($slist_type, $const_gslist, $handle_to_c, undef, undef);
+ $self->push_conv ($gslist, $slist_type, @to_cxx[0 .. 2]);
+ $self->push_conv ($const_gslist, $slist_type, @to_cxx[0 .. 2]);
+ }
+ }
+ foreach my $array_sub_type (@array_sub_types)
+ {
+ my @array_member_types = map { $array_sub_type . '< ' . $_ . ' >' } @{$all_types};
+
+ push @array_member_types, (map { $_ . '&' } @array_member_types);
+ push @array_member_types, (map { 'const ' . $_ } @array_member_types);
+ foreach my $array_type (@array_member_types)
+ {
+ my @to_cxx_cc = map { $array_type . '(const_cast< const ' . $array_type . '::CType* >(' . $arg . '), ' . $_ . ')' } @ownerships;
+
+ foreach my $c_array_type (@c_array_types)
+ {
+ my $cc_handle_to_c = 'const_cast< ' . $c_array_type . ' >(' . $handle_to_c . ')';
+
+ $self->push_conv ($array_type, $c_array_type, $cc_handle_to_c, undef, undef);
+ $self->push_conv ($c_array_type, $array_type, @to_cxx_cc[0 .. 2]);
+ }
+ }
+ }
+ foreach my $member_type (@{$all_types})
+ {
+ my @array_to_vectors = map { 'Glib::ArrayHandler< ' . $member_type . ' >::array_to_vector(const_cast< const Glib::ArrayHandler< ' . $member_type . ' >::CType* >(' . $arg . '), ' . $_ . ')' } @ownerships;
+ my $vector_to_array = 'Glib::ArrayHandler< ' . $member_type . ' >::vector_to_array(' . $arg . ').data()';
+ my @glist_to_vectors = map { 'Glib::ListHandler< ' . $member_type . ' >::list_to_vector(const_cast< GList* >(##ARG##), ' . $_ . ')' } @ownerships;
+ my $vector_to_glist = 'Glib::ListHandler< ' . $member_type . ' >::vector_to_list(' . $arg . ').data()';
+ my @gslist_to_vectors = map { 'Glib::SListHandler< ' . $member_type . ' >::slist_to_vector(const_cast< GSList* >(##ARG##), ' . $_ . ')' } @ownerships;
+ my $vector_to_gslist = 'Glib::SListHandler< ' . $member_type . ' >::vector_to_slist(' . $arg . ').data()';
+
+ foreach my $vector_sub_type (@vector_sub_types)
+ {
+ my $full_vector_type = $vector_sub_type . '< ' . $member_type . ' >';
+ my @full_vector_types = ($full_vector_type, $full_vector_type . '&');
+
+ push @full_vector_types, (map { 'const ' . $_ } @full_vector_types);
+ foreach my $vector_type (@full_vector_types)
+ {
+ foreach my $c_array_type (@c_array_types)
+ {
+ my $cc_vector_to_array = 'const_cast< ' . $c_array_type . ' >(' . $vector_to_array . ')';
+
+ $self->push_conv ($vector_type, $c_array_type, $cc_vector_to_array, undef, undef);
+ $self->push_conv ($c_array_type, $vector_type, @array_to_vectors[0 .. 2]);
+ }
+ foreach my $c_glist_type ('GList*', 'const GList*')
+ {
+ my $cc_vector_to_glist = 'const_cast< ' . $c_glist_type . ' >(' . $vector_to_glist . ')';
+
+ $self->push_conv ($vector_type, $c_glist_type, $cc_vector_to_glist, undef, undef);
+ $self->push_conv ($c_glist_type, $vector_type, @glist_to_vectors[0 .. 2]);
+ }
+ foreach my $c_gslist_type ('GSList*', 'const GSList*')
+ {
+ my $cc_vector_to_gslist = 'const_cast< ' . $c_gslist_type . ' >(' . $vector_to_gslist . ')';
+
+ $self->push_conv ($vector_type, $c_gslist_type, $cc_vector_to_gslist, undef, undef);
+ $self->push_conv ($c_gslist_type, $vector_type, @gslist_to_vectors[0 .. 2]);
+ }
+ }
+ }
+ }
+}
+
+sub _on_convert_class ($$)
+{
+ my ($self, $args) = @_;
+ my $c_class = $args->[1];
+ my $full_cpp_class = $self->_make_full_type (undef);
+ my $sub_types = Common::Shared::split_cpp_type_to_sub_types $full_cpp_class;
+ my $c_class_ptr = $c_class . '*';
+ my $const_c_class_ptr = 'const ' . $c_class_ptr;
+ my $arg = '##ARG##';
+ my $glib_unwrap = 'Glib::unwrap(' . $arg . ')';
+ my $cc_glib_unwrap = 'const_cast< ' . $c_class_ptr . ' >(' . $glib_unwrap . ')';
+ my $glib_unwrap_copy = 'Glib::unwrap_copy(' . $arg . ')';
+ my $cc_glib_unwrap_copy = 'const_cast< ' . $c_class_ptr . ' >(' . $glib_unwrap_copy . ')';
+ my $glib_unwrap_ref = 'Glib::unwrap(&' . $arg . ')';
+ my $cc_glib_unwrap_ref = 'const_cast< ' . $c_class_ptr . ' >(' . $glib_unwrap_ref . ')';
+ my $glib_unwrap_ref_copy = 'Glib::unwrap_copy(&' . $arg . ')';
+ my $cc_glib_unwrap_ref_copy = 'const_cast< ' . $c_class_ptr . ' >(' . $glib_unwrap_ref_copy . ')';
+ my $glib_wrap = 'Glib::wrap(' . $arg . ', false)';
+ my $glib_wrap_cc = 'Glib::wrap(const_cast< ' . $c_class_ptr . ' >(' . $arg . ', false))';
+ my $glib_wrap_copy = 'Glib::wrap(' . $arg . ', true)';
+ my $glib_wrap_copy_cc = 'Glib::wrap(const_cast< ' . $c_class_ptr . ' >(' . $arg . ', true))';
+ my $glib_wrap_ref = '*Glib::wrap(' . $arg . ', false)';
+ my $glib_wrap_ref_cc = '*Glib::wrap(const_cast< ' . $c_class_ptr . ' >(' . $arg . ', false)';
+ my $glib_wrap_ref_copy = '*Glib::wrap(' . $arg . ', true)';
+ my $glib_wrap_ref_copy_cc = '*Glib::wrap(const_cast< ' . $c_class_ptr . ' >(' . $arg . ', true)';
+
+ foreach my $sub_type (@{$sub_types})
+ {
+ my $const_sub_type = 'const ' . $sub_type;
+
+ foreach my $non_const_cxx_sub_type ($sub_type, $sub_type . '&')
+ {
+ foreach my $c_class_type ($c_class_ptr, $const_c_class_ptr)
+ {
+ $self->push_conv ($non_const_cxx_sub_type, $c_class_type, $glib_unwrap_ref, undef, $glib_unwrap_ref_copy);
+ }
+ $self->push_conv ($c_class_ptr, $non_const_cxx_sub_type, $glib_wrap_ref, undef, $glib_wrap_ref_copy);
+ $self->push_conv ($const_c_class_ptr, $non_const_cxx_sub_type, $glib_wrap_ref_cc, undef, $glib_wrap_ref_copy_cc);
+ }
+ foreach my $const_cxx_sub_type ($const_sub_type, $const_sub_type . '&')
+ {
+ foreach my $c_class_type ($c_class_ptr, $const_c_class_ptr)
+ {
+ $self->push_conv ($c_class_type, $const_cxx_sub_type, $glib_wrap_ref, undef, $glib_wrap_ref_copy);
+ }
+ $self->push_conv ($const_cxx_sub_type, $c_class_ptr, $cc_glib_unwrap_ref, undef, $cc_glib_unwrap_ref_copy);
+ $self->push_conv ($const_cxx_sub_type, $const_c_class_ptr, $glib_unwrap_ref, undef, $glib_unwrap_ref_copy);
+ }
+
+ my $sub_type_ptr = $sub_type . '*';
+ my $const_sub_type_ptr = $const_sub_type . '*';
+
+ foreach my $c_class_type ($c_class_ptr, $const_c_class_ptr)
+ {
+ $self->push_conf($sub_type_ptr, $c_class_type, $glib_unwrap, undef, $glib_unwrap_copy);
+ }
+ $self->push_conv($c_class_ptr, $sub_type_ptr, $glib_wrap, undef, $glib_wrap_copy);
+ $self->push_conv($const_c_class_ptr, $sub_type_ptr, $glib_wrap_cc, undef, $glib_wrap_copy_cc);
+
+ foreach my $c_class_type ($c_class_ptr, $const_c_class_ptr)
+ {
+ $self->push_conv ($c_class_type, $const_sub_type_ptr, $glib_wrap, undef, $glib_wrap_copy);
+ }
+ $self->push_conv ($const_sub_type_ptr, $c_class_ptr, $cc_glib_unwrap, undef, $cc_glib_unwrap_copy);
+ $self->push_conv ($const_sub_type_ptr, $const_c_class_ptr, $glib_unwrap, undef, $glib_unwrap_copy);
+ }
+
+ my $gen_flags = Common::Shared::GEN_NORMAL | Common::Shared::GEN_REF | Common::Shared::GEN_PTR | Common::Shared::GEN_CONST;
+ my $gen_types = Common::Shared::gen_cpp_types ([$full_cpp_class], $gen_flags);
+
+ $self->_generate_containers ($c_class, $gen_types);
+}
+
+sub _on_convert_reffed_class ($$)
+{
+ my ($self, $args) = @_;
+ my $c_class = $args->[1];
+ my $full_cpp_class = $self->_make_full_type (undef);
+ my $sub_types = Common::Shared::split_cpp_type_to_sub_types $full_cpp_class;
+ my $glib_ref_ptr_type = 'Glib::RefPtr';
+ my $ref_sub_types = Common::Shared::split_cpp_type_to_sub_types $glib_ref_ptr_type;
+ my $c_class_ptr = $c_class . '*';
+ my $const_c_class_ptr = 'const ' . $c_class_ptr;
+ my $arg = '##ARG##';
+ my $glib_unwrap = 'Glib::unwrap(' . $arg . ')';
+ my $cc_glib_unwrap = 'const_cast< ' . $c_class_ptr . ' >(' . $glib_unwrap . ')';
+ my $glib_unwrap_copy = 'Glib::unwrap_copy(' . $arg . ')';
+ my $cc_glib_unwrap_copy = 'const_cast< ' . $c_class_ptr . ' >(' . $glib_unwrap_copy . ')';
+ my $glib_wrap = 'Glib::wrap(' . $arg . ', false)';
+ my $glib_wrap_cc = 'Glib::wrap(const_cast< ' . $c_class_ptr . ' >(' . $arg . ', false))';
+ my $glib_wrap_copy = 'Glib::wrap(' . $arg . ', true)';
+ my $glib_wrap_copy_cc = 'Glib::wrap(const_cast< ' . $c_class_ptr . ' >(' . $arg . ', true))';
+
+ foreach my $sub_type (@{$sub_types})
+ {
+ foreach my $ref_sub_type (@{$ref_sub_types})
+ {
+ my $refptr_type = $ref_sub_type . '< ' . $sub_type . ' >';
+ my $refptr_const_type = $ref_sub_type . '< const ' . $sub_type . ' >';
+ my $const_refptr_type = 'const ' . $ref_sub_type . '< ' . $sub_type . ' >';
+ my $const_refptr_const_type = 'const ' . $ref_sub_type . '< const ' . $sub_type . ' >';
+
+ foreach my $xxx_refptr_type ($refptr_type, $const_refptr_type, $refptr_type . '&', $const_refptr_type . '&')
+ {
+ $self->push_conv ($xxx_refptr_type, $c_class_ptr, $glib_unwrap, undef, $glib_unwrap_copy);
+ $self->push_conv ($xxx_refptr_type, $const_c_class_ptr, $glib_unwrap, undef, $glib_unwrap_copy);
+ $self->push_conv ($c_class_ptr, $xxx_refptr_type, $glib_wrap, undef, $glib_wrap_copy);
+ $self->push_conv ($const_c_class_ptr, $xxx_refptr_type, $glib_wrap_cc, undef, $glib_wrap_copy_cc);
+ }
+ foreach my $xxx_refptr_const_type ($refptr_const_type, $const_refptr_const_type, $refptr_const_type . '&', $const_refptr_const_type . '&')
+ {
+ $self->push_conv ($xxx_refptr_const_type, $c_class_ptr, $cc_glib_unwrap, undef, $cc_glib_unwrap_copy);
+ $self->push_conv ($xxx_refptr_const_type, $const_c_class_ptr, $glib_unwrap, undef, $glib_unwrap_copy);
+ $self->push_conv ($c_class_ptr, $xxx_refptr_const_type, $glib_wrap, undef, $glib_wrap_copy);
+ $self->push_conv ($const_c_class_ptr, $xxx_refptr_const_type, $glib_wrap, undef, $glib_wrap_copy);
+ }
+ }
+ }
+
+ my $gen_flags = Common::Shared::GEN_NORMAL | Common::Shared::GEN_REF | Common::Shared::GEN_CONST;
+ my $gen_types = Common::Shared::gen_cpp_types ([$glib_ref_ptr_type, $full_cpp_class], $gen_flags);
+
+ $self->_generate_containers ($c_class, $gen_types);
+}
+
+###
+###
+###
+
+sub _on_open_brace ($)
+{
+ my ($self) = @_;
+
+ $self->_inc_level;
+}
+
+sub _on_close_brace ($)
+{
+ my ($self) = @_;
+ my $level = $self->_get_level;
+ my $classes = $self->_get_classes;
+ my $class_levels = $self->_get_class_levels;
+ my $namespaces = $self->_get_namespaces;
+ my $namespace_levels = $self->_get_namespace_levels;
+
+ if (@{$class_levels} and $class_levels->[-1] == $level)
+ {
+ pop @{$classes};
+ pop @{$class_levels};
+ }
+ elsif (@{$namespace_levels} and $namespace_levels->[-1] == $level)
+ {
+ pop @{$namespaces};
+ pop @{$namespace_levels};
+ }
+ $self->_dec_level;
+}
+
+sub _on_string_literal ($)
+{
+ my ($self) = @_;
+
+ $self->_on_string_with_end ('"');
+}
+
+sub _on_comment_cpp ($)
+{
+ my ($self) = @_;
+
+ $self->_on_string_with_end ("\n");
+}
+
+sub _on_comment_c ($)
+{
+ my ($self) = @_;
+
+ $self->_on_string_with_end ('*/');
+}
+
+sub _on_comment_doxygen ($)
+{
+ my ($self) = @_;
+
+ $self->_on_string_with_end ('*/');
+}
+
+sub _on_m4_section ($)
+{
+ my ($self) = @_;
+
+ $self->_on_string_with_end ('#m4end');
+}
+
+sub _on_m4_line ($)
+{
+ my ($self) = @_;
+
+ $self->_on_string_with_end ("\n");
+}
+
+sub _on_wrap_method ($)
+{
+ my ($self) = @_;
+ my $args = $self->_get_params;
+
+ if (defined $args)
+ {
+ $self->_on_wrap_func_generic ($args);
+ }
+}
+
+sub _on_wrap_ctor ($)
+{
+ my ($self) = @_;
+ my $args = $self->_get_params;
+
+ if (defined $args)
+ {
+ $self->_on_wrap_func_generic ($args);
+ }
+}
+
+sub _on_wrap_enum ($)
+{
+ my ($self) = @_;
+ my $args = $self->_get_params;
+
+ if (defined $args)
+ {
+ $self->_on_wrap_enum_generic ($args);
+ $self->_on_convert_enum ($args);
+ }
+}
+
+sub _on_wrap_gerror ($)
+{
+ my ($self) = @_;
+ my $args = $self->_get_params;
+
+ if (defined $args)
+ {
+ $self->_on_wrap_enum_generic ($args);
+ $self->_on_convert_enum ($args);
+ }
+}
+
+sub _on_class_generic ($)
+{
+ my ($self) = @_;
+ my $args = $self->_get_params;
+
+ if (defined $args)
+ {
+ $self->_on_wrap_class_generic ($args);
+ # no conversion generation possible - it have to be provided manually.
+ }
+}
+
+sub _on_class_g_object ($)
+{
+ my ($self) = @_;
+ my $args = $self->_get_params;
+
+ if (defined $args)
+ {
+ $self->_on_wrap_class_generic ($args);
+ $self->_on_convert_reffed_class ($args);
+ }
+}
+
+sub _on_class_gtk_object ($)
+{
+ my ($self) = @_;
+ my $args = $self->_get_params;
+
+ if (defined $args)
+ {
+ $self->_on_wrap_class_generic ($args);
+ $self->_on_convert_class ($args); # Glib::wrap and Glib::unwrap
+ }
+}
+
+sub _on_class_boxed_type ($)
+{
+ my ($self) = @_;
+ my $args = $self->_get_params;
+
+ if (defined $args)
+ {
+ $self->_on_wrap_class_generic ($args);
+ $self->_on_convert_class ($args); # Glib::wrap and Glib::unwrap
+ }
+}
+
+sub _on_class_boxed_type_static ($)
+{
+ my ($self) = @_;
+ my $args = $self->_get_params;
+
+ if (defined $args)
+ {
+ $self->_on_wrap_class_generic ($args);
+ $self->_on_convert_class ($args); # Glib::wrap and Glib::unwrap
+ }
+}
+
+sub _on_class_interface ($)
+{
+ my ($self) = @_;
+ my $args = $self->_get_params;
+
+ if (defined $args)
+ {
+ $self->_on_wrap_class_generic ($args);
+# TODO: which convert? reffed or not? probably both. probably manual.
+ }
+}
+
+sub _on_class_opaque_copyable ($)
+{
+ my ($self) = @_;
+ my $args = $self->_get_params;
+
+ if (defined $args)
+ {
+ $self->_on_wrap_class_generic ($args);
+ $self->_on_convert_class ($args); # Glib::wrap and Glib::unwrap
+ }
+}
+
+sub _on_class_opaque_refcounted ($)
+{
+ my ($self) = @_;
+ my $args = $self->_get_params;
+
+ if (defined $args)
+ {
+ $self->_on_wrap_class_generic ($args);
+ $self->_on_convert_reffed_class ($args);
+ }
+}
+
+sub _on_namespace ($)
+{
+ my ($self) = @_;
+ my $tokens = $self->_get_tokens;
+ my $name = '';
+ my $in_s_comment = 0;
+ my $in_m_comment = 0;
+
+ # we need to peek ahead to figure out what type of namespace
+ # declaration this is.
+ foreach my $token (@{$tokens})
+ {
+ next if (not defined $token or $token eq '');
+
+ if ($in_s_comment)
+ {
+ if ($token eq "\n")
+ {
+ $in_s_comment = 0;
+ }
+ }
+ elsif ($in_m_comment)
+ {
+ if ($token eq '*/')
+ {
+ $in_m_comment = 0;
+ }
+ }
+ elsif ($token =~ m'^//[/!]?$')
+ {
+ $in_s_comment = 1;
+ }
+ elsif ($token =~ m'^/*[*!]?$')
+ {
+ $in_m_comment = 1;
+ }
+ elsif ($token eq '{')
+ {
+ my $namespaces = $self->_get_namespaces;
+ my $namespace_levels = $self->_get_namespace_levels;
+
+ $name = Util::string_trim ($name);
+ push @{$namespaces}, $name;
+ push @{$namespace_levels}, $self->_get_level + 1;
+ return;
+ }
+ elsif ($token eq ';')
+ {
+ return;
+ }
+ elsif ($token !~ /\s/)
+ {
+ $name = $token;
+ }
+ }
+}
+
+sub _on_class ($)
+{
+ my ($self) = @_;
+ my $tokens = $self->_get_tokens;
+ my $name = '';
+ my $done = 0;
+ my $in_s_comment = 0;
+ my $in_m_comment = 0;
+ my $colon_met = 0;
+
+ # we need to peek ahead to figure out what type of class
+ # declaration this is.
+ foreach my $token (@{$tokens})
+ {
+ next if (not defined $token or $token eq '');
+
+ if ($in_s_comment)
+ {
+ if ($token eq "\n")
+ {
+ $in_s_comment = 0;
+ }
+ }
+ elsif ($in_m_comment)
+ {
+ if ($token eq '*/')
+ {
+ $in_m_comment = 0;
+ }
+ }
+ elsif ($token eq '//' or $token eq '///' or $token eq '//!')
+ {
+ $in_s_comment = 1;
+ }
+ elsif ($token eq '/*' or $token eq '/**' or $token eq '/*!')
+ {
+ $in_m_comment = 1;
+ }
+ elsif ($token eq '{')
+ {
+ my $classes = $self->_get_classes;
+ my $class_levels = $self->_get_class_levels;
+
+ $name =~ s/\s+//g;
+ push @{$classes}, $name;
+ push @{$class_levels}, $self->_get_level + 1;
+ return;
+ }
+ elsif ($token eq ';')
+ {
+ return;
+ }
+ elsif ($token eq ':')
+ {
+ $colon_met = 1;
+ }
+ elsif ($token !~ /\s/)
+ {
+ unless ($colon_met)
+ {
+ $name .= $token;
+ }
+ }
+ }
+}
+
+sub new ($$$)
+{
+ my ($type, $tokens_hg, $tokens_ccg) = @_;
+ my $class = (ref $type or $type or 'Common::Scanner');
+ my @tokens_hg_copy = (@{$tokens_hg});
+ my @tokens_ccg_copy = (@{$tokens_ccg});
+ my $self =
+ {
+ 'tokens' => undef,
+ 'pairs' => [],
+ 'conversions' => [],
+ 'stages' =>
+ {
+ STAGE_HG () => \ tokens_hg_copy,
+ STAGE_CCG () => \ tokens_ccg_copy,
+ STAGE_INVALID () => []
+ },
+ 'namespace_levels' => [],
+ 'namespaces' => [],
+ 'class_levels' => [],
+ 'classes' => [],
+ 'level' => 0
+ };
+
+ $self = bless $self, $class;
+
+ $self->{'handlers'} =
+ {
+ '{' => [$self, \&_on_open_brace],
+ '}' => [$self, \&_on_close_brace],
+ '"' => [$self, \&_on_string_literal],
+ '//' => [$self, \&_on_comment_cpp],
+ '///' => [$self, \&_on_comment_cpp],
+ '//!' => [$self, \&_on_comment_cpp],
+ '/*' => [$self, \&_on_comment_c],
+ '/**' => [$self, \&_on_comment_doxygen],
+ '/*!' => [$self, \&_on_comment_doxygen],
+ '#m4begin' => [$self, \&_on_m4_section],
+ '#m4' => [$self, \&_on_m4_line],
+ '_WRAP_METHOD' => [$self, \&_on_wrap_method],
+ '_WRAP_CTOR' => [$self, \&_on_wrap_ctor],
+ '_WRAP_ENUM' => [$self, \&_on_wrap_enum],
+ '_WRAP_GERROR' => [$self, \&_on_wrap_gerror],
+ '_CLASS_GENERIC' => [$self, \&_on_class_generic],
+ '_CLASS_GOBJECT' => [$self, \&_on_class_g_object],
+ '_CLASS_GTKOBJECT' => [$self, \&_on_class_gtk_object],
+ '_CLASS_BOXEDTYPE' => [$self, \&_on_class_boxed_type],
+ '_CLASS_BOXEDTYPE_STATIC' => [$self, \&_on_class_boxed_type_static],
+ '_CLASS_INTERFACE' => [$self, \&_on_class_interface],
+ '_CLASS_OPAQUE_COPYABLE' => [$self, \&_on_class_opaque_copyable],
+ '_CLASS_OPAQUE_REFCOUNTED' => [$self, \&_on_class_opaque_refcounted],
+ 'namespace' => [$self, \&_on_namespace],
+ 'class' => [$self, \&_on_class]
+ };
+
+ return $self;
+}
+
+sub scan ($)
+{
+ my ($self) = @_;
+ my $handlers = $self->_get_handlers;
+ my @stages = (STAGE_HG, STAGE_CCG);
+
+ for my $stage (@stages)
+ {
+ $self->_switch_to_stage ($stage);
+
+ my $tokens = $self->_get_tokens;
+
+ while (@{$tokens})
+ {
+ my $token = $self->_extract_token;
+
+ if (exists $handlers->{$token})
+ {
+ my $pair = $handlers->{$token};
+ my $object = $pair->[0];
+ my $handler = $pair->[1];
+
+ if (defined $object)
+ {
+ $object->$handler;
+ }
+ else
+ {
+ &{$handler};
+ }
+ }
+ }
+ }
+}
+
+sub get_pairs ($)
+{
+ my ($self) = @_;
+
+ return $self->{'pairs'};
+}
+
+sub get_conversions ($)
+{
+ my ($self) = @_;
+
+ return $self->{'conversions'};
+}
+
+sub push_conv ($$$$$$)
+{
+ my ($self, $from, $to, $none, $shallow, $full) = @_;
+ my $conversions = $self->get_conversions;
+
+ push @{$conversions}, [$from, $to, $none, $shallow, $full];
+}
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/SectionManager.pm b/tools/pm/Common/SectionManager.pm
index 0cd7616..940ec8d 100644
--- a/tools/pm/Common/SectionManager.pm
+++ b/tools/pm/Common/SectionManager.pm
@@ -29,11 +29,7 @@ use Common::Sections::Section;
use Common::Sections::Conditional;
use constant
{
- 'SECTION_H' => 'SECTION_MAIN_H',
- 'SECTION_CC' => 'SECTION_MAIN_CC',
- 'SECTION_P_H' => 'SECTION_MAIN_P_H',
- 'SECTION_DEV_NULL' => 'SECTION_MAIN_DEV_NULL',
- 'VARIABLE_UNKNOWN' => 'NO_SUCH_VARIABLE_FOR_NOW'
+ 'VARIABLE_UNKNOWN' => 'NO_SUCH_VARIABLE_FOR_NOW',
};
sub _get_section ($$)
@@ -62,9 +58,9 @@ sub _get_conditional ($$)
return $conditionals->{$conditional_name};
}
-sub _append_stuff_to_entries ($$$$)
+sub _append_stuff_to_entries ($$$$$)
{
- my ($self, $type, $stuff, $entries) = @_;
+ my ($self, $type, $stuff, $entries, $is_linked) = @_;
given ($type)
{
@@ -76,12 +72,20 @@ sub _append_stuff_to_entries ($$$$)
{
my $section = $self->_get_section ($stuff);
+ if (defined $is_linked)
+ {
+ $section->set_linked ($is_linked);
+ }
$entries->append_section ($section);
}
when (Common::Sections::Entries::CONDITIONAL ())
{
my $conditional = $self->_get_conditional ($stuff);
+ if (defined $is_linked)
+ {
+ $conditional->set_linked ($is_linked);
+ }
$entries->append_conditional ($conditional);
}
default
@@ -92,45 +96,95 @@ sub _append_stuff_to_entries ($$$$)
}
}
-sub _append_stuff_to_section ($$$$)
+sub _get_entries_and_linking_from_section ($$)
{
- my ($self, $type, $stuff, $section_name) = @_;
+ my ($self, $section_name) = @_;
my $section = $self->_get_section ($section_name);
- my $entries = $section->get_entries;
- $self->append_stuff_to_entries ($type, $stuff, $entries);
+ return ($section->get_entries, $section->is_linked);
}
-sub _append_stuff_to_conditional ($$$$$)
+sub _get_entries_and_linking_from_conditional ($$$)
{
- my ($self, $type, $stuff, $conditional_name, $bool) = @_;
+ my ($self, $conditional_name, $bool) = @_;
+ my $conditional = $self->_get_conditional ($conditional_name);
if ($bool)
{
- $bool = Common::Sections::Entries::TRUE ();
+ $bool = Common::Sections::Conditional::TRUE ();
}
else
{
- $bool = Common::Sections::Entries::FALSE ();
+ $bool = Common::Sections::Conditional::FALSE ();
}
- my $conditional = $self->_get_conditional ($conditional_name);
- my $entries = $conditional->get_entries ($bool);
+ return ($conditional->get_entries ($bool), $conditional->is_linked);
+}
+
+sub _append_stuff_to_section ($$$$)
+{
+ my ($self, $type, $stuff, $section_name) = @_;
+ my ($entries, $is_linked) = $self->_get_entries_and_linking_from_section ($section_name);
+
+ $self->_append_stuff_to_entries ($type, $stuff, $entries, $is_linked);
+}
+
+sub _append_stuff_to_conditional ($$$$$)
+{
+ my ($self, $type, $stuff, $conditional_name, $bool) = @_;
+ my ($entries, $is_linked) = $self->_get_entries_and_linking_from_conditional ($conditional_name, $bool);
+
+ $self->_append_stuff_to_entries ($type, $stuff, $entries, $is_linked);
+}
+
+sub _get_entries_stack ($)
+{
+ my ($self) = @_;
+
+ return $self->{'entries_stack'};
+}
+
+sub _push_entry ($$$)
+{
+ my ($self, $entry, $is_linked) = @_;
+ my $entries_stack = $self->_get_entries_stack;
+
+ push @{$entries_stack}, [$entry, $is_linked];
+}
- $self->append_stuff_to_entries ($type, $stuff, $entries);
+sub _append_generic ($$$)
+{
+ my ($self, $stuff, $stuff_type) = @_;
+ my $entries_stack = $self->_get_entries_stack;
+ my $entry = $entries_stack->[-1];
+
+ $self->_append_stuff_to_entries ($stuff_type, $stuff, $entry->[0], $entry->[1]);
+}
+
+sub _get_variables ($)
+{
+ my ($self) = @_;
+
+ return $self->{'variables'};
}
sub new ($)
{
my ($type) = @_;
- my $class = (ref ($type) or $type or 'Common::SectionManager');
- my $main_h_section = Common::Sections::Section->new (SECTION_H);
- my $main_cc_section = Common::Sections::Section->new (SECTION_CC);
- my $main_p_h_section = Common::Sections::Section->new (SECTION_P_H);
- my $main_dev_null_section = Common::Sections::Section->new (SECTION_DEV_NULL);
+ my $class = (ref $type or $type or 'Common::SectionManager');
+ my $main_h_section = Common::Sections::Section->new (Common::Sections::H);
+ my $main_cc_section = Common::Sections::Section->new (Common::Sections::CC);
+ my $main_p_h_section = Common::Sections::Section->new (Common::Sections::P_H);
+ my $main_dev_null_section = Common::Sections::Section->new (Common::Sections::DEV_NULL);
+
+ $main_h_section->set_linked (Common::Sections::H);
+ $main_cc_section->set_linked (Common::Sections::CC);
+ $main_p_h_section->set_linked (Common::Sections::P_H);
+ $main_dev_null_section->set_linked (Common::Sections::DEV_NULL);
+
my $self =
{
- 'toplevel_sections' =>
+ 'main_sections' =>
{
$main_h_section->get_name => $main_h_section,
$main_cc_section->get_name => $main_cc_section,
@@ -145,16 +199,21 @@ sub new ($)
$main_dev_null_section->get_name => $main_dev_null_section
},
'conditionals' => {},
- 'variables' => {}
+ 'variables' => {},
+ 'entries_stack' => []
};
- return bless $self, $class;
+ $self = bless $self, $class;
+
+ $self->push_section ($main_dev_null_section->get_name);
+
+ return $self;
}
sub get_variable ($$)
{
my ($self, $name) = @_;
- my $variables = $self->{'variables'};
+ my $variables = $self->_get_variables;
unless (exists $variables->{$name})
{
@@ -167,7 +226,7 @@ sub get_variable ($$)
sub set_variable ($$$)
{
my ($self, $name, $value) = @_;
- my $variables = $self->{'variables'};
+ my $variables = $self->_get_variables;
if ($value)
{
@@ -179,52 +238,46 @@ sub set_variable ($$$)
}
}
-##
-## string, section name
-##
sub append_string_to_section ($$$)
{
- shift->_append_stuff_to_section (Common::Sections::Entries::STRING (), shift, shift);
+ my ($self, $string, $target_section_name) = @_;
+
+ $self->_append_stuff_to_section (Common::Sections::Entries::STRING (), $string, $target_section_name);
}
-##
-## section name, section name
-##
sub append_section_to_section ($$$)
{
- shift->_append_stuff_to_section (Common::Sections::Entries::SECTION (), shift, shift);
+ my ($self, $section_name, $target_section_name) = @_;
+
+ $self->_append_stuff_to_section (Common::Sections::Entries::SECTION (), $section_name, $target_section_name);
}
-##
-## conditional name, section name
-##
sub append_conditional_to_section ($$$)
{
- shift->_append_stuff_to_section (Common::Sections::Entries::CONDITIONAL (), shift, shift);
+ my ($self, $conditional_name, $target_section_name) = @_;
+
+ $self->_append_stuff_to_section (Common::Sections::Entries::CONDITIONAL (), $conditional_name, $target_section_name);
}
-##
-## string, conditional name, bool value
-##
sub append_string_to_conditional ($$$$)
{
- shift->_append_stuff_to_conditional (Common::Sections::Entries::STRING (), shift, shift, shift);
+ my ($self, $string, $target_conditional_name, $bool) = @_;
+
+ $self->_append_stuff_to_conditional (Common::Sections::Entries::STRING (), $string, $target_conditional_name, $bool);
}
-##
-## section name, conditional name, bool value
-##
sub append_section_to_conditional ($$$$)
{
- shift->_append_stuff_to_conditional (Common::Sections::Entries::SECTION (), shift, shift, shift);
+ my ($self, $section_name, $target_conditional_name, $bool) = @_;
+
+ $self->_append_stuff_to_conditional (Common::Sections::Entries::SECTION (), $section_name, $target_conditional_name, $bool);
}
-##
-## conditional name, conditional name, bool value
-##
sub append_conditional_to_conditional ($$$$)
{
- shift->_append_stuff_to_conditional (Common::Sections::Entries::CONDITIONAL (), shift, shift, shift);
+ my ($self, $conditional_name, $target_conditional_name, $bool) = @_;
+
+ $self->_append_stuff_to_conditional (Common::Sections::Entries::CONDITIONAL (), $conditional_name, $target_conditional_name, $bool);
}
sub set_variable_for_conditional ($$$)
@@ -302,4 +355,68 @@ sub write_main_section_to_file ($$$)
$fd->close;
}
+sub is_section_linked_to_main_section ($$)
+{
+ my ($self, $section_name) = @_;
+ my $section = $self->_get_section ($section_name);
+
+ return $section->is_linked;
+}
+
+sub is_conditional_linked_to_main_section ($$)
+{
+ my ($self, $conditional_name) = @_;
+ my $conditional = $self->_get_conditional ($conditional_name);
+
+ return $conditional->is_linked;
+}
+
+sub push_section ($$)
+{
+ my ($self, $section_name) = @_;
+ my ($entries, $is_linked) = $self->_get_entries_and_linking_from_section ($section_name);
+
+ $self->_push_entry ($entries, $is_linked);
+}
+
+sub push_conditional ($$$)
+{
+ my ($self, $conditional_name, $bool) = @_;
+ my ($entries, $is_linked) = $self->_get_entries_and_linking_from_conditional ($conditional_name, $bool);
+
+ $self->_push_entry ($entries, $is_linked);
+}
+
+sub pop_entry ($)
+{
+ my ($self) = @_;
+ my $entries_stack = $self->_get_entries_stack;
+
+ if (@{$entries_stack} > 1)
+ {
+ pop @{$entries_stack};
+ }
+}
+
+sub append_string ($$)
+{
+ my ($self, $string) = @_;
+
+ $self->_append_generic (Common::Sections::Entries::STRING (), $string);
+}
+
+sub append_section ($$)
+{
+ my ($self, $section) = @_;
+
+ $self->_append_generic (Common::Sections::Entries::SECTION (), $section);
+}
+
+sub append_conditional ($$)
+{
+ my ($self, $conditional) = @_;
+
+ $self->_append_generic (Common::Sections::Entries::CONDITIONAL (), $conditional);
+}
+
1; # indicate proper module load.
diff --git a/tools/pm/Common/Sections.pm b/tools/pm/Common/Sections.pm
new file mode 100644
index 0000000..3f08914
--- /dev/null
+++ b/tools/pm/Common/Sections.pm
@@ -0,0 +1,79 @@
+# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# gmmproc - Common::Sections module
+#
+# Copyright 2012 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 Common::Sections;
+
+use strict;
+use warnings;
+
+use Common::Constants;
+
+use Common::Sections::Section;
+use Common::Sections::Conditional;
+use Common::Sections::Entries;
+
+use constant
+{
+ 'H' => ['SECTION_H', Common::Constants::FILE ()], # main header section
+ 'CC' => ['SECTION_CC', Common::Constants::FILE ()], # main implementation section
+ 'P_H' => ['SECTION_P_H', Common::Constants::FILE ()], # main private header section
+ 'DEV_NULL' => ['SECTION_DEV_NULL', Common::Constants::FILE ()], # everything put into this section goes to /dev/null
+ 'H_CONTENTS' => ['SECTION_H_CONTENTS', Common::Constants::FILE ()],
+ 'CC_CONTENTS' => ['SECTION_CC_CONTENTS', Common::Constants::FILE ()],
+ 'P_H_CONTENTS' => ['SECTION_P_H_CONTENTS', Common::Constants::FILE ()],
+ 'CC_UNNAMED_NAMESPACE' => ['SECTION_UNNAMED_NAMESPACE', Common::Constants::FILE ()], # blablabla
+ 'H_BEGIN' => ['SECTION_HEADER_BEGIN', Common::Constants::FILE ()], # SECTION_HEADER_FIRST
+ 'HEADER1' => ['SECTION_HEADER1', Common::Constants::FILE ()], # TODO: check if needed, use better name, H_FOO
+ 'HEADER2' => ['SECTION_HEADER2', Common::Constants::FILE ()], # TODO: check if needed, use better name, H_FOO
+ 'HEADER3' => ['SECTION_HEADER3', Common::Constants::FILE ()], # TODO: check if needed, use better name, H_FOO
+ 'CC_PRE_INCLUDES' => ['SECTION_CC_PRE_INCLUDES', Common::Constants::FILE ()],
+ 'CC_INCLUDES' => ['SECTION_CC_INCLUDES', Common::Constants::FILE ()],
+ 'CC_CUSTOM' => ['SECTION_CC_CUSTOM', Common::Constants::FILE ()], # TODO: check if needed, SECTION_SRC_CUSTOM
+ 'CC_GENERATED' => ['SECTION_CC_GENERATED', Common::Constants::FILE ()], # TODO: check if needed, SECTION_CC_GENERATED
+ 'CC_END' => ['SECTION_CC_END', Common::Constants::FILE ()],
+ 'CC_NAMESPACE' => ['SECTION_CC_NAMESPACE', Common::Constants::NAMESPACE ()],
+ 'CLASS1' => ['SECTION_CLASS1', Common::Constants::CLASS ()], # TODO: check if needed, use better name, CC_FOO
+ 'CLASS2' => ['SECTION_CLASS2', Common::Constants::CLASS ()], # TODO: check if needed, use better name, CC_FOO
+ 'P_CC_IMPLEMENTS_INTERFACES' => ['SECTION_P_CC_IMPLEMENTS_INTERFACES', Common::Constants::CLASS ()],
+ 'H_VFUNCS' => ['SECTION_H_VFUNCS', Common::Constants::CLASS ()],
+ 'H_VFUNCS_CPP_WRAPPER' => ['SECTION_H_VFUNCS_CPP_WRAPPER', Common::Constants::CLASS ()], # TODO: probably not needed.
+ 'H_DEFAULT_SIGNAL_HANDLERS' => ['SECTION_H_DEFAULT_SIGNAL_HANDLERS', Common::Constants::CLASS ()],
+ 'CC_DEFAULT_SIGNAL_HANDLERS' => ['SECTION_CC_DEFAULT_SIGNAL_HANDLERS', Common::Constants::CLASS ()],
+ 'CC_VFUNCS' => ['SECTION_CC_VFUNCS', Common::Constants::CLASS ()],
+ 'CC_VFUNCS_CPP_WRAPPER' => ['SECTION_CC_VFUNCS_CPP_WRAPPER', Common::Constants::CLASS ()], # TODO: probably not needed
+ 'P_H_DEFAULT_SIGNAL_HANDLERS' => ['SECTION_P_H_DEFAULT_SIGNAL_HANDLERS', Common::Constants::CLASS ()],
+ 'P_H_VFUNCS' => ['SECTION_P_H_VFUNCS', Common::Constants::CLASS ()],
+ 'P_CC_DEFAULT_SIGNAL_HANDLERS' => ['SECTION_P_CC_DEFAULT_SIGNAL_HANDLERS', Common::Constants::CLASS ()],
+ 'P_CC_VFUNCS' => ['SECTION_P_CC_VFUNCS', Common::Constants::CLASS ()],
+ 'P_CC_INIT_DEFAULT_SIGNAL_HANDLERS' => ['SECTION_P_CC_INIT_DEFAULT_SIGNAL_HANDLERS', Common::Constants::CLASS ()],
+ 'P_CC_INIT_VFUNCS' => ['SECTION_P_CC_INIT_VFUNCS', Common::Constants::CLASS ()],
+ 'P_CC_NAMESPACE' => ['SECTION_P_CC_NAMESPACE', Common::Constants::CLASS ()],
+ 'H_BEFORE_FIRST_NAMESPACE' => ['SECTION_BEFORE_FIRST_NAMESPACE', Common::Constants::FIRST_NAMESPACE ()],
+ 'H_BEFORE_FIRST_CLASS' => ['SECTION_BEFORE_FIRST_CLASS', Common::Constants::FIRST_CLASS ()],
+ 'H_AFTER_FIRST_CLASS' => ['SECTION_AFTER_FIRST_CLASS', Common::Constants::FIRST_CLASS ()],
+ 'H_AFTER_FIRST_NAMESPACE' => ['SECTION_AFTER_FIRST_NAMESPACE', Common::Constants::FIRST_NAMESPACE ()],
+ 'H_SIGNAL_PROXIES' => ['SECTION_H_SIGNAL_PROXIES', Common::Constants::CLASS ()],
+ 'CC_SIGNAL_PROXIES' => ['SECTION_CC_SIGNAL_PROXIES', Common::Constants::CLASS ()],
+ 'H_PROPERTY_PROXIES' => ['SECTION_H_PROPERTY_PROXIES', Common::Constants::CLASS ()],
+ 'CC_PROPERTY_PROXIES' => ['SECTION_CC_PROPERTY_PROXIES', Common::Constants::CLASS ()],
+ 'CC_INITIALIZE_EXTRA' => ['SECTION_CC_INITIALIZE_EXTRA', Common::Constants::CLASS ()] # TODO: check if needed.
+};
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/Sections/Conditional.pm b/tools/pm/Common/Sections/Conditional.pm
index 694d699..e7b4ea5 100644
--- a/tools/pm/Common/Sections/Conditional.pm
+++ b/tools/pm/Common/Sections/Conditional.pm
@@ -33,13 +33,14 @@ use constant
sub new ($$$)
{
my ($type, $name, $bool_variable_name) = @_;
- my $class = (ref ($type) or $type or 'Common::Sections::Conditional');
+ my $class = (ref $type or $type or 'Common::Sections::Conditional');
my $self =
{
'name' => $name,
'false_entries' => Common::Sections::Entries->new,
'true_entries' => Common::Sections::Entries->new,
- 'bool_variable_name' => $bool_variable_name
+ 'bool_variable_name' => $bool_variable_name,
+ 'linked' => undef
};
return bless $self, $class;
@@ -82,7 +83,7 @@ sub get_entries ($$)
}
default
{
- # TODO: throw an error.
+# TODO: throw an error.
print STDERR 'Unknown value for conditional, use Common::Sections::Conditional::{TRUE,FALSE}' . "\n";
exit 1;
}
@@ -97,4 +98,18 @@ sub clear ($)
$self->{'true_entries'} = Common::Sections::Entries->new;
}
-1; #indicate proper module load.
+sub is_linked ($)
+{
+ my ($self) = @_;
+
+ return $self->{'linked'};
+}
+
+sub set_linked ($$)
+{
+ my ($self, $main_section) = @_;
+
+ $self->{'linked'} = $main_section;
+}
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/Sections/Entries.pm b/tools/pm/Common/Sections/Entries.pm
index b9250b0..31aa06a 100644
--- a/tools/pm/Common/Sections/Entries.pm
+++ b/tools/pm/Common/Sections/Entries.pm
@@ -32,7 +32,7 @@ use constant
sub new ($)
{
my ($type) = @_;
- my $class = (ref ($type) or $type or 'Common::Sections::Entries');
+ my $class = (ref $type or $type or 'Common::Sections::Entries');
my $self = [];
return bless $self, $class;
@@ -67,4 +67,4 @@ sub get_copy ($)
return \ copy;
}
-1; #indicate proper module load.
+1; # indicate proper module load.
diff --git a/tools/pm/Common/Sections/Section.pm b/tools/pm/Common/Sections/Section.pm
index 7409c34..0bf36ce 100644
--- a/tools/pm/Common/Sections/Section.pm
+++ b/tools/pm/Common/Sections/Section.pm
@@ -28,11 +28,12 @@ use Common::Sections::Entries;
sub new ($$)
{
my ($type, $name) = @_;
- my $class = (ref ($type) or $type or 'Common::Sections::Section');
+ my $class = (ref $type or $type or 'Common::Sections::Section');
my $self =
{
'name' => $name,
- 'entries' => Common::Sections::Entries->new
+ 'entries' => Common::Sections::Entries->new,
+ 'linked' => undef
};
return bless $self, $class;
@@ -59,4 +60,18 @@ sub clear ($)
$self->{'entries'} = Common::Sections::Entries->new;
}
-1; #indicate proper module load.
+sub is_linked ($)
+{
+ my ($self) = @_;
+
+ return $self->{'linked'};
+}
+
+sub set_linked ($$)
+{
+ my ($self, $main_section) = @_;
+
+ $self->{'linked'} = $main_section;
+}
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/Shared.pm b/tools/pm/Common/Shared.pm
new file mode 100644
index 0000000..0048dae
--- /dev/null
+++ b/tools/pm/Common/Shared.pm
@@ -0,0 +1,677 @@
+# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# gmmproc - Common::Shared module
+#
+# Copyright 2012 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 Common::Shared;
+
+use strict;
+use warnings;
+use feature ':5.10';
+
+use constant
+{
+ 'GEN_NONE' => 0,
+ 'GEN_NORMAL' => (1 >> 0),
+ 'GEN_REF' => (1 >> 1),
+ 'GEN_PTR' => (1 >> 2),
+ 'GEN_CONST' => (1 >> 3)
+};
+
+use Common::Util;
+
+sub extract_token ($)
+{
+ my ($tokens) = @_;
+ my $line_change = 0;
+
+ while (@{$tokens})
+ {
+ my $token = shift @{$tokens};
+
+ # skip empty tokens
+ next if (not defined $token or $token eq '');
+
+ if ($token =~ /\n/)
+ {
+ ++$line_change;
+ }
+
+ return [$token, $line_change];
+ }
+
+ return ['', $line_change];
+}
+
+sub extract_bracketed_text ($)
+{
+ my ($tokens) = @_;
+ my $level = 1;
+ my $str = '';
+ my $line_change = 0;
+
+ # Move to the first "(":
+ while (@{$tokens})
+ {
+ my $result = extract_token $tokens;
+ my $token = $result->[0];
+ my $add_to_line = $result->[1];
+
+ $line_change += $add_to_line;
+ last if ($token eq '(');
+ }
+
+ # Concatenate until the corresponding ")":
+ while (@{$tokens})
+ {
+ my $result = extract_token $tokens;
+ my $token = $result->[0];
+ my $add_to_line = $result->[1];
+
+ $line_change += $add_to_line;
+ ++$level if ($token eq '(');
+ --$level if ($token eq ')');
+
+ return [$str, $line_change] unless $level;
+ $str .= $token;
+ }
+
+ return undef;
+}
+
+sub string_split_commas ($)
+{
+ my ($in) = @_;
+ my @out = ();
+ my $level = 0;
+ my $str = '';
+ my @tokens = split(/([,()"'\\])/, $in);
+ my $sq = 0;
+ my $dq = 0;
+ my $escape = 0;
+
+ while (@tokens)
+ {
+ my $token = shift @tokens;
+
+ next if ($token eq '');
+
+ if ($escape)
+ {
+ # do nothing
+ }
+ if ($sq)
+ {
+ if ($token eq '\'')
+ {
+ $sq = 0;
+ }
+ }
+ elsif ($dq)
+ {
+ if ($token eq '"')
+ {
+ $dq = 0;
+ }
+ }
+ elsif ($token eq '\\')
+ {
+ $escape = 1;
+ }
+ elsif ($token eq '\'')
+ {
+ $sq = 1;
+ }
+ elsif ($token eq '"')
+ {
+ $dq = 1;
+ }
+ elsif ($token eq '(')
+ {
+ ++$level;
+ }
+ elsif ($token eq ')')
+ {
+ --$level;
+ }
+ elsif ($token eq ',' and not $level)
+ {
+ push @out, $str;
+ $str = '';
+ next;
+ }
+
+ $str .= $token;
+ }
+
+ push @out, $str;
+ return @out;
+}
+
+sub string_split_func_params ($)
+{
+ my ($in) = @_;
+ my @out = ();
+ my $level = 0;
+ my $str = '';
+ my @tokens = split(/([,()"'\\<>])/, $in);
+ my $sq = 0;
+ my $dq = 0;
+ my $escape = 0;
+ my @close_stack = ();
+ my %closes = ('(' => ')', '<' => '>');
+
+ while (@tokens)
+ {
+ my $token = shift @tokens;
+
+ next if ($token eq '');
+
+ if ($sq)
+ {
+ if ($escape)
+ {
+ $escape = 0;
+ }
+ elsif ($token eq '\'')
+ {
+ $sq = 0;
+ }
+ elsif ($token eq '\\')
+ {
+ $escape = 1;
+ }
+ }
+ elsif ($dq)
+ {
+ if ($escape)
+ {
+ $escape = 0;
+ }
+ elsif ($token eq '"')
+ {
+ $dq = 0;
+ }
+ elsif ($token eq '\\')
+ {
+ $escape = 1;
+ }
+ }
+ elsif ($token eq '\'')
+ {
+ $sq = 1;
+ }
+ elsif ($token eq '"')
+ {
+ $dq = 1;
+ }
+ elsif ($token eq '(' or $token eq '<')
+ {
+ ++$level;
+ push @close_stack, $closes{$token};
+ }
+ elsif ($token eq ')' or $token eq '>')
+ {
+ my $expected = pop @close_stack;
+
+ if ($expected eq $token)
+ {
+ --$level;
+ }
+ else
+ {
+ return [];
+ }
+ }
+ elsif ($token eq ',' and not $level)
+ {
+ push @out, $str;
+ $str = '';
+ next;
+ }
+
+ $str .= $token;
+ }
+
+ push @out, $str;
+ return \ out;
+}
+
+# - split params with something similar to string_split_commas
+# - split every part with `='
+# - second part, if defined, is default value
+# - from first part take last word - it is parameter name
+# - the rest should be a parameter type.
+sub parse_params ($)
+{
+ my ($line) = @_;
+
+ $line =~ s/^\s*\(\s*//;
+ $line =~ s/\s*\)\s*$//;
+
+ my $parts = string_split_func_params ($line);
+ my @params = ();
+
+ foreach my $part (@{$parts})
+ {
+ my @subparts = split ('=', $part);
+ my $value = undef;
+ my $rest = Common::Util::string_trim $subparts[0];
+ my $name = undef;
+ my $type = undef;
+
+ if (@subparts > 1)
+ {
+ $value = join '', $subparts[1 .. @subparts - 1];
+ }
+ if ($rest =~ /^(.+\W)(\w+)$/)
+ {
+ $type = $1;
+ $name = $2;
+
+ while ($type =~ /\s+[&*]+/)
+ {
+ $type =~ s/\s+([*&]+)/$1 /g;
+ }
+ $type = Common::Util::string_simplify $type;
+ }
+ else
+ {
+ return [];
+ }
+ push @params, {'type' => $type, 'name' => $name, 'value' => $value};
+ }
+ return \ params;
+}
+
+# - start scanning string from its end.
+# - string from end of string to last closing paren should be saved as $after
+# - string from last closing paren to its opening counterpart should be stored as $params
+# - string from opening parent to whitespace should be saved as $name (beware of operator foo!)
+# - string at the beginning could be `static', if so then store it in $before, otherwise $before is empty
+# - rest of it should be a return type.
+sub parse_function_declaration ($)
+{
+ my ($line) = @_;
+ my $before = '';
+
+ $line = Common::Util::string_simplify ($line);
+
+ my @tokens = split /([\s(),"'\\])/, $line;
+
+ # get before
+ while (@tokens)
+ {
+ my $token = shift @tokens;
+
+ next unless ($token);
+
+ $token = Common::Util::string_trim ($token);
+
+ next unless ($token);
+
+ if ($token eq 'static')
+ {
+ $before = $token;
+ }
+ else
+ {
+ unshift @tokens, $token;
+ }
+ last;
+ }
+
+ @tokens = reverse @tokens;
+
+ #get after
+ my @after_parts = ();
+
+ while (@tokens)
+ {
+ my $token = shift @tokens;
+
+ next unless ($token);
+ last if ($token eq ')');
+ push @after_parts, $token;
+ }
+
+ my $after = '';
+
+ if (@after_parts)
+ {
+ $after = Common::Util::string_trim (join '', reverse @after_parts);
+ }
+ @after_parts = undef;
+
+ #get params
+ my @params_parts = (')');
+ my $level = 1;
+ my $maybe_dq_change = 0;
+ my $dq = 0;
+ my $maybe_sq_change = 0;
+ my $sq = 0;
+
+ while (@tokens)
+ {
+ my $token = shift @tokens;
+
+ next unless ($token);
+ push @params_parts, $token;
+ if ($maybe_dq_change)
+ {
+ $maybe_dq_change = 0;
+ if ($token ne '\\')
+ {
+ $dq = 0;
+ unshift @tokens, $token;
+ }
+ }
+ elsif ($dq)
+ {
+ if ($token eq '"')
+ {
+ $maybe_dq_change = 1;
+ }
+ }
+ elsif ($maybe_sq_change)
+ {
+ $maybe_sq_change = 0;
+ if ($token ne '\\')
+ {
+ $sq = 0;
+ unshift @tokens, $token;
+ }
+ }
+ elsif ($sq)
+ {
+ if ($token eq '\'')
+ {
+ $maybe_sq_change = 1;
+ }
+ }
+ elsif ($token eq '"')
+ {
+ $dq = 1;
+ }
+ elsif ($token eq '\'')
+ {
+ $sq = 1;
+ }
+ elsif ($token eq ')')
+ {
+ ++$level;
+ }
+ elsif ($token eq '(')
+ {
+ --$level;
+ unless ($level)
+ {
+ last;
+ }
+ }
+ }
+
+ # TODO: this is probably not what we want for string default values.
+ # TODO continued: not sure if we should care about that.
+ # TODO continued: if string parameter's default value holds several consecutive whitespaces
+ # TODO continued: then those ones are going to be changed into single space.
+ my $params = Common::Util::string_trim (join '', reverse @params_parts);
+
+ @params_parts = undef;
+ # get rid of whitespaces
+ while (@tokens)
+ {
+ my $token = shift @tokens;
+
+ next unless ($token);
+
+ $token = Common::Util::string_trim ($token);
+
+ next unless ($token);
+
+ unshift @tokens, $token;
+ last;
+ }
+
+ my @name_parts = ();
+ my $try_operator = 0;
+
+# TODO: this part needs testing
+ while (@tokens)
+ {
+ my $token = shift @tokens;
+
+ next unless ($token);
+
+ my $trimmed_token = Common::Util::string_trim ($token);
+
+ if ($try_operator)
+ {
+ if ($trimmed_token)
+ {
+ if ($trimmed_token eq 'operator')
+ {
+ push @name_parts, $trimmed_token . ' ';
+ }
+ else
+ {
+ unshift @tokens, $token . ' ';
+ }
+ last;
+ }
+ }
+ elsif ($trimmed_token)
+ {
+ push @name_parts, $trimmed_token;
+ }
+ else
+ {
+ $try_operator = 1;
+ }
+ }
+
+ my $name = Common::Util::string_simplify (join '', reverse @name_parts);
+ my $ret_type = Common::Util::string_simplify (join '', reverse @tokens);
+
+ @name_parts = undef;
+ return [$before, $ret_type, $name, $params, $after];
+}
+
+sub split_cpp_type_to_sub_types ($)
+{
+ my ($cpp_type) = @_;
+ my @cpp_parts = split '::', $cpp_type;
+ my @cpp_sub_types = ();
+
+ for (my $iter = 0; $iter < @cpp_parts; ++$iter)
+ {
+ my $cpp_sub_type = join '::', @cpp_parts[$iter .. $#cpp_parts];
+
+ push @cpp_sub_types, $cpp_sub_type;
+ }
+
+ return \ cpp_sub_types;
+}
+
+# prototype needed, because it is recursively called.
+sub gen_cpp_types ($$);
+
+sub gen_cpp_types ($$)
+{
+ my ($all_cpp_types, $flags) = @_;
+
+ if (@{$all_cpp_types} > 0 and $flags != GEN_NONE)
+ {
+ my $outermost_type = $all_cpp_types->[0];
+ my $sub_types = split_cpp_type_to_sub_types ($outermost_type);
+ my @gen_types = ();
+
+ if (@{$all_cpp_types} > 1)
+ {
+ my @further_types = @{$all_cpp_types}[1 .. $#{$all_cpp_types}];
+ my $child_sub_types = gen_cpp_types (\ further_types, $flags);
+
+ @further_types = ();
+ foreach my $sub_type (@{$sub_types})
+ {
+ push @gen_types, map { $sub_type . '< ' . $_ . ' >'} @{$child_sub_types};
+ }
+ }
+ else
+ {
+ push @gen_types, @{$sub_types};
+ }
+
+ my @ret_types = ();
+
+ if ($flags & GEN_NORMAL == GEN_NORMAL)
+ {
+ push @ret_types, @gen_types;
+ }
+ if ($flags & GEN_REF == GEN_REF)
+ {
+ push @ret_types, map { $_ . '&' } @gen_types;
+ }
+ if ($flags & GEN_PTR == GEN_PTR)
+ {
+ push @ret_types, map { $_ . '*' } @gen_types;
+ }
+ if ($flags & GEN_CONST == GEN_CONST)
+ {
+ push @ret_types, map { 'const ' . $_ } @ret_types;
+ }
+ return \ ret_types;
+ }
+ return [];
+}
+
+sub get_args ($$)
+{
+ my ($args, $descs) = @_;
+ my %better_descs = ();
+
+ while (my ($desc, $ref) = each %{$descs})
+ {
+ my $ref_type = undef;
+
+ if ($desc =~ /^(o?)([abs])\([\w-]+\)$/)
+ {
+ my $obsolete = (defined $1);
+ my $type = $2;
+ my $param = $3;
+
+ $better_descs{$param} = {'type' => $type, 'ref' => $ref, 'obsolete' => $obsolete};
+ $ref_type = (($type eq 'a') ? 'ARRAY' : 'SCALAR');
+ }
+ else
+ {
+# TODO: programming error - throw an exception.
+ die;
+ }
+ if (defined $ref and (ref $ref) ne $ref_type)
+ {
+# TODO: programming error - throw an exception
+ die;
+ }
+
+ }
+
+ my $errors = [];
+ my $warnings = [];
+
+ foreach my $arg (@{$args})
+ {
+ my ($param, $possible_value) = split /[\s]+/, $arg, 2;
+
+ unless ($param =~ /^[\w-]+$/)
+ {
+ push @{$errors}, [$param, 'Should contain only alphanumeric characters, underlines and dashes.'];
+ next;
+ }
+ unless (exists $better_descs{$param})
+ {
+ push @{$errors}, [$param, 'Unknown parameter.'];
+ next;
+ }
+
+ my $desc = $better_descs{$param};
+ my $type = $desc->{'type'};
+
+ if ($desc->{'obsolete'})
+ {
+ push @{$warnings}, [$param, 'Obsolete parameter.'];
+ }
+
+ if (defined $desc->{'value'} and $type ne 'a')
+ {
+ push @{$errors}, [$param, 'Given twice.'];
+ next;
+ }
+
+ my $ref = $desc->{'ref'};
+
+ given ($type)
+ {
+ when ('a')
+ {
+ unless (defined $possible_value)
+ {
+ push @{$errors}, [$param, 'Expected value, got nothing.'];
+ next;
+ }
+ push @{$ref}, $possible_value;
+ }
+ when ('b')
+ {
+ if (defined $possible_value)
+ {
+ push @{$errors}, [$param, join '', 'No value expected, got `', $possible_value, '\'.'];
+ next;
+ }
+ ${$ref} = 1;
+ }
+ when ('s')
+ {
+ unless (defined $possible_value)
+ {
+ push @{$errors}, [$param, 'Expected value, got nothing.'];
+ next;
+ }
+ ${$ref} = $possible_value;
+ }
+ }
+ }
+
+ my $results = undef;
+
+ unless (@{$errors})
+ {
+ $errors = undef;
+ }
+ unless (@{$warnings})
+ {
+ $warnings = undef;
+ }
+ if (defined $errors or defined $warnings)
+ {
+ $results = [$errors, $warnings];
+ }
+ return $results;
+}
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/SignalInfo.pm b/tools/pm/Common/SignalInfo.pm
new file mode 100644
index 0000000..b0624fb
--- /dev/null
+++ b/tools/pm/Common/SignalInfo.pm
@@ -0,0 +1,242 @@
+# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# gmmproc - Common::SignalInfo module
+#
+# Copyright 2012 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 Common::SignalInfo;
+
+use strict;
+use warnings;
+
+use parent qw (Common::CallableInfo);
+
+sub _guess_typed ($$)
+{
+ my ($gir_typed, $wrap_parser) = @_;
+ my $name = '';
+
+ if ($gir_typed->get_g_type_count > 0)
+ {
+ my $gir_type = $gir_typed->get_g_type_by_index (0);
+
+ $name = $gir_type->get_a_name;
+ }
+ elsif ($gir_typed->get_g_array_count > 0)
+ {
+ return _guess_typed $gir_typed->get_g_array_by_index(0);
+ }
+
+ if ($name eq 'utf8' or $name eq 'filename')
+ {
+ return 'gchar*';
+ }
+ else
+ {
+ my $namespace = undef;
+ my $stuff = undef;
+
+ if ($name =~ /^(\w)\.(\w)$/)
+ {
+ $namespace = $1;
+ $stuff = $2;
+ }
+ elsif ($name =~ /^[A-Z]/)
+ {
+ $namespace = $wrap_parser->get_module;
+ $stuff = $name;
+ }
+ else # probably something like gint or gboolean
+ {
+ return $name;
+ }
+
+ my $repositories = $wrap_parser->get_repositories;
+ my $gir_repository = $repositories->get_repository ($namespace);
+ my $gir_namespace = $gir_repository->get_g_namespace_by_name ($namespace);
+ my @gir_symbol_prefixes = split ',', $gir_namespace->get_a_c_symbol_prefixes;
+ my @gir_namespace_methods =
+ (
+ \&Gir::Api::Namespace::get_g_class_by_name,
+ \&Gir::Api::Namespace::get_g_interface_by_name,
+ \&Gir::Api::Namespace::get_g_glib_boxed_by_name,
+ \&Gir::Api::Namespace::get_g_record_by_name,
+ \&Gir::Api::Namespace::get_g_enumeration_by_name,
+ \&Gir::Api::Namespace::get_g_bitfield_by_name,
+ \&Gir::Api::Namespace::get_g_union_by_name
+ );
+
+ foreach my $symbol_prefix (@gir_symbol_prefixes)
+ {
+ my $maybe_c_name = $symbol_prefix . $stuff;
+
+ foreach my $method (@gir_namespace_methods)
+ {
+ my $gir_stuff = $gir_namespace->$method ($maybe_c_name);
+
+ if ($gir_stuff)
+ {
+ # Meh, glib:boxed is special
+ if ($gir_stuff->isa ('Gir::Api::GlibBoxed'))
+ {
+ return $gir_stuff->get_a_glib_type_name;
+ }
+ else
+ {
+ return $gir_stuff->get_a_c_type;
+ }
+ }
+ }
+ }
+# Argh, probably our guess at C name was just wrong.
+# Taking longer route at guessing the C type.
+ @gir_namespace_methods =
+ (
+ [
+ \&Gir::Api::Namespace::get_g_class_count,
+ \&Gir::Api::Namespace::get_g_class_by_index
+ ],
+ [
+ \&Gir::Api::Namespace::get_g_interface_count,
+ \&Gir::Api::Namespace::get_g_interface_by_index
+ ],
+ [
+ \&Gir::Api::Namespace::get_g_glib_boxed_count,
+ \&Gir::Api::Namespace::get_g_glib_boxed_by_index
+ ],
+ [
+ \&Gir::Api::Namespace::get_g_record_count,
+ \&Gir::Api::Namespace::get_g_record_by_index
+ ],
+ [
+ \&Gir::Api::Namespace::get_g_enumeration_count,
+ \&Gir::Api::Namespace::get_g_enumeration_by_index
+ ],
+ [
+ \&Gir::Api::Namespace::get_g_bitfield_count,
+ \&Gir::Api::Namespace::get_g_bitfield_by_index
+ ],
+ [
+ \&Gir::Api::Namespace::get_g_union_count,
+ \&Gir::Api::Namespace::get_g_union_by_index
+ ]
+ );
+
+ foreach my $method_pair (@gir_namespace_methods)
+ {
+ my $count_method = $method_pair->[0];
+ my $index_method = $method_pair->[1];
+ my $count = $gir_namespace->$count_method;
+
+ for (my $iter = 0; $iter < $count; ++$iter)
+ {
+ my $gir_stuff = $gir_namespace->$index_method ($iter);
+
+ if ($gir_stuff)
+ {
+ # Meh, glib:boxed is special
+ if ($gir_stuff->isa('Gir::Api::GlibBoxed'))
+ {
+ my $gir_name = $gir_stuff->get_a_glib_name;
+
+ if ($gir_name eq $stuff)
+ {
+ return $gir_stuff->get_a_glib_type_name;
+ }
+ }
+ else
+ {
+ my $gir_name = $gir_stuff->get_a_name;
+
+ if ($gir_name eq $stuff)
+ {
+ return $gir_stuff->get_a_c_type;
+ }
+ }
+ }
+ }
+ }
+ # Huh, got nothing?
+ die;
+ }
+}
+
+sub _guess_parameter ($$)
+{
+ my ($gir_parameter, $wrap_parser) = @_;
+ my $c_type = _guess_typed $gir_parameter, $wrap_parser;
+ my $gir_direction = $gir_parameter->get_a_direction;
+
+ # out parameters in C have to be pointers.
+ unless ((index $gir_direction, 'out') < 0)
+ {
+ $c_type .= '*';
+ }
+
+ return $c_type;
+}
+
+sub _get_wrap_parser ($)
+{
+ my ($self) = @_;
+
+ return $self->{'wrap_parser'};
+}
+
+sub _get_name_from_gir ($$)
+{
+ my (undef, $gir_signal) = @_;
+
+ return $gir_signal->get_a_name;
+}
+
+sub _parse_parameter ($$)
+{
+ my ($self, $gir_parameter) = @_;
+ my $type = $self->SUPER::_parse_parameter ($gir_parameter);
+
+ unless ($type)
+ {
+ $type = _guess_parameter $gir_parameter, $self->_get_wrap_parser;
+ }
+
+ return $type;
+}
+
+sub _parse_return_value ($$)
+{
+ my ($self, $gir_return_value) = @_;
+ my $type = $self->SUPER::_parse_return_value ($gir_return_value);
+
+ unless ($type)
+ {
+ $type = _guess_typed $gir_return_value, $self->_get_wrap_parser;
+ }
+
+ return $type;
+}
+
+sub new_from_gir ($$$)
+{
+ my ($type, $gir_function, $wrap_parser) = @_;
+ my $class = (ref $type or $type or 'Common::SignalInfo');
+ my $self = $class->SUPER::new ($gir_function);
+
+ return bless $self, $class;
+}
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/TokensStore.pm b/tools/pm/Common/TokensStore.pm
new file mode 100644
index 0000000..8772e67
--- /dev/null
+++ b/tools/pm/Common/TokensStore.pm
@@ -0,0 +1,112 @@
+# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# gmmproc - Common::TokensStore module
+#
+# Copyright 2012 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 Common::TokensStore;
+
+use strict;
+use warnings;
+
+sub new ($)
+{
+ my ($type) = @_;
+ my $class = (ref $type or $type or 'Common::TokensStore');
+ my $self =
+ {
+ 'pairs' => [],
+ 'conversions' => [],
+ 'section_manager' => undef,
+ 'tokens_hg' => undef,
+ 'tokens_ccg' => undef
+ };
+
+ return bless $self, $class;
+}
+
+sub set_pairs ($$)
+{
+ my ($self, $pairs) = @_;
+
+ $self->{'pairs'} = $pairs;
+}
+
+sub get_pairs ($)
+{
+ my ($self) = @_;
+
+ return $self->{'pairs'};
+}
+
+sub set_conversions ($$)
+{
+ my ($self, $conversions) = @_;
+
+ $self->{'conversions'} = $conversions;
+}
+
+sub get_conversions ($)
+{
+ my ($self) = @_;
+
+ return $self->{'conversions'};
+}
+
+sub set_section_manager ($$)
+{
+ my ($self, $section_manager) = @_;
+
+ $self->{'section_manager'} = $section_manager;
+}
+
+sub get_section_manager ($)
+{
+ my ($self) = @_;
+
+ return $self->{'section_manager'};
+}
+
+sub set_hg_tokens ($$)
+{
+ my ($self, $tokens_hg) = @_;
+
+ $self->{'tokens_hg'} = $tokens_hg;
+}
+
+sub get_hg_tokens ($)
+{
+ my ($self) = @_;
+
+ return $self->{'tokens_hg'};
+}
+
+sub set_ccg_tokens ($$)
+{
+ my ($self, $tokens_ccg) = @_;
+
+ $self->{'tokens_ccg'} = $tokens_ccg;
+}
+
+sub get_ccg_tokens ($)
+{
+ my ($self) = @_;
+
+ return $self->{'tokens_ccg'};
+}
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/TypeInfoStore.pm b/tools/pm/Common/TypeInfoStore.pm
new file mode 100644
index 0000000..f18edb1
--- /dev/null
+++ b/tools/pm/Common/TypeInfoStore.pm
@@ -0,0 +1,356 @@
+# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# gmmproc - Common::TypeInfoStore module
+#
+# Copyright 2012 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 Common::TypeInfoStore;
+
+use strict;
+use warnings;
+
+use IO::File;
+
+use Common::Util;
+
+sub _add_new_to ($$$$$)
+{
+ my ($self, $c_stuff, $cpp_stuff, $c_to_cpp, $cpp_to_c) = @_;
+
+ if (exists $c_to_cpp->{$c_stuff})
+ {
+ my $old_stuff = $c_to_cpp->{$c_stuff};
+ my $ref_type = ref $old_stuff;
+
+ if ($ref_type eq 'ARRAY')
+ {
+ my $found = 0;
+
+ foreach my $stuff (@{$old_stuff})
+ {
+ if ($stuff eq $cpp_stuff)
+ {
+ $found = 1;
+ last;
+ }
+ }
+ unless ($found)
+ {
+ push @{$old_stuff}, $cpp_stuff;
+ }
+ }
+ elsif ($ref_type eq '')
+ {
+ if ($old_stuff ne $cpp_stuff)
+ {
+ $c_to_cpp->{$c_stuff} = [$old_stuff, $cpp_stuff];
+ }
+ }
+ else
+ {
+# TODO: throw internal error;
+ print STDERR 'Internal error - C->C++ type info should be array or string' . "\n";
+ exit 1;
+ }
+ }
+ else
+ {
+ $c_to_cpp->{$c_stuff} = $cpp_stuff;
+ }
+
+ my $cpp_sub_types = Common::Shared::split_cpp_types_to_sub_types $cpp_stuff;
+
+ foreach my $cpp_sub_stuff (@{$cpp_sub_types})
+ {
+ if (exists $cpp_to_c->{$cpp_sub_stuff})
+ {
+ my $old_stuff = $cpp_to_c->{$cpp_sub_stuff};
+ my $ref_type = ref $old_stuff;
+
+ if ($ref_type eq 'ARRAY')
+ {
+ my $found = 0;
+
+ foreach my $stuff (@{$old_stuff})
+ {
+ if ($stuff eq $c_stuff)
+ {
+ $found = 1;
+ last;
+ }
+ }
+ unless ($found)
+ {
+ push @{$old_stuff}, $c_stuff;
+ }
+ }
+ elsif ($ref_type eq '')
+ {
+ if ($old_stuff ne $c_stuff)
+ {
+ $cpp_to_c->{$cpp_sub_stuff} = [$old_stuff, $c_stuff];
+ }
+ }
+ else
+ {
+# TODO: throw internal error;
+ print STDERR 'Internal error - C++->C type info should be array or string' . "\n";
+ exit 1;
+ }
+ }
+ else
+ {
+ $cpp_to_c->{$cpp_sub_stuff} = $c_stuff;
+ }
+ }
+}
+
+sub _get_unambiguous_pairs ($)
+{
+ my ($self) = @_;
+ my $c_to_cpp = $self->{'c_to_cpp'};
+ my @pairs = ();
+
+ foreach my $c_stuff (sort keys %{$c_to_cpp})
+ {
+ my $cpp_stuff = $c_to_cpp->{$c_stuff};
+ my $ref_type = ref $cpp_stuff;
+
+ if ($ref_type eq '')
+ {
+ push @pairs, [$c_stuff, $cpp_stuff];
+ }
+ }
+
+ return \ pairs;
+}
+
+sub _get_stuff_from ($$$)
+{
+ my ($self, $stuff, $mapping_name) = @_;
+ my $mapping = $self->{$mapping_name};
+
+ if (exists $mapping->{$stuff})
+ {
+ return $mapping->{$stuff};
+ }
+ else
+ {
+ my $from_files = $self->{'from_files'};
+
+ $mapping = $from_files->{$mapping_name};
+ if (exists $mapping->{$stuff})
+ {
+ return $mapping->{$stuff};
+ }
+ }
+
+ return undef;
+}
+
+sub _get_mm_module ($)
+{
+ my ($self) = @_;
+
+ return $self->{'mm_module'};
+}
+
+sub _get_include_paths ($)
+{
+ my ($self) = @_;
+
+ return $self->{'include_paths'};
+}
+
+sub _get_read_files ($)
+{
+ my ($self) = @_;
+
+ return $self->get_read_files;
+}
+
+sub _get_c_to_cpp ($$)
+{
+ my ($self, $from_files) = @_;
+
+ if ($from_files)
+ {
+ return $self->{'from_files'}{'c_to_cpp'};
+ }
+ return $self->{'c_to_cpp'};
+}
+
+sub _get_cpp_to_c ($$)
+{
+ my ($self, $from_files) = @_;
+
+ if ($from_files)
+ {
+ return $self->{'from_files'}{'cpp_to_c'};
+ }
+ return $self->{'cpp_to_c'};
+}
+
+sub new ($$$)
+{
+ my ($type, $mm_module, $include_paths) = @_;
+ my $class = (ref $type or $type or 'Common::TypeInfoStore');
+ my $self =
+ {
+ 'c_to_cpp' => {},
+ 'cpp_to_c' => {},
+ 'from_files' =>
+ {
+ 'c_to_cpp' => {},
+ 'cpp_to_c' => {}
+ },
+ 'mm_module' => $mm_module,
+ 'include_paths' => $include_paths,
+ 'read_files' => {}
+ };
+
+ return bless $self, $class;
+}
+
+sub add_new ($$$)
+{
+ my ($self, $c_stuff, $cpp_stuff) = @_;
+ my $c_to_cpp = $self->_get_c_to_cpp (0);
+ my $cpp_to_c = $self->_get_cpp_to_c (0);
+
+ $self->_add_new_to ($c_stuff, $cpp_stuff, $c_to_cpp, $cpp_to_c);
+}
+
+sub c_to_cpp ($$)
+{
+ my ($self, $c_stuff) = @_;
+
+ return $self->_get_stuff_from ($c_stuff, 'c_to_cpp');
+}
+
+sub cpp_to_c ($$)
+{
+ my ($self, $cpp_stuff) = @_;
+
+ return $self->_get_stuff_from ($cpp_stuff, 'cpp_to_c');
+}
+
+sub add_from_file ($$)
+{
+ my ($self, $basename) = @_;
+ my $mm_module = $self->_get_mm_module;
+
+ # Do not even try to look for file that is going to be generated
+ # at the end. Yeah, we make such basename reserved.
+ if ($basename ne join '_', 'mappings', $mm_module, 'generated')
+ {
+ my $include_paths = $self->_get_include_paths;
+ my $read_files = $self->_get_read_files;
+
+ foreach my $path (@{$include_paths})
+ {
+ my $inc_filename = File::Spec->catfile ($path, $basename);
+
+ if (-f $inc_filename and -r $inc_filename)
+ {
+ unless (exists $read_files->{$inc_filename})
+ {
+ my $fd = IO::File->new ($inc_filename, 'r');
+
+ $read_files->{$inc_filename} = undef;
+ unless (defined $fd)
+ {
+# TODO: throw an error
+ print STDERR 'Could not open file `' . $inc_filename . '\' for reading.' . "\n";
+ exit 1;
+ }
+
+ my @lines = $fd->getlines;
+ my $c_to_cpp = $self->_get_c_to_cpp (1);
+ my $cpp_to_c = $self->_get_cpp_to_c (1);
+ my $line_num = 0;
+
+ $fd->close;
+ foreach my $line (@lines)
+ {
+ ++$line_num;
+ $line =~ s/\s*#.*//;
+ $line = Common::Util::string_trim ($line);
+ if ($line eq '')
+ {
+ next;
+ }
+ if ($line =~ /^(\S+)\s*<=>\s*(\S+)$/ or $line =~ /^(\S+)\s*,\s*(\S+)$/)
+ {
+ my $c_stuff = $1;
+ my $cpp_stuff = $2;
+
+ $self->_add_new_to ($c_stuff, $cpp_stuff, $c_to_cpp, $cpp_to_c);
+ }
+ elsif ($line =~ /^include\s+(\S+)^/)
+ {
+ my $inc_basename = $1;
+
+ $self->add_from_file ($inc_basename);
+ }
+ else
+ {
+ print STDERR $inc_filename . ':' . $line_num . ' - could not parse the line.' . "\n";
+ }
+ }
+ }
+ last;
+ }
+ }
+ }
+}
+
+sub write_to_file ($)
+{
+ my ($self) = @_;
+ my $include_paths = $self->_get_include_paths;
+ my $mm_module = $self->_get_mm_module;
+
+ unless (@{$include_paths})
+ {
+# TODO: internal error.
+ die;
+ }
+
+ my $filename = File::Spec->catfile ($include_paths->[0], join '_', 'mappings', $mm_module, 'generated');
+ my $fd = IO::File->new ($filename, 'w');
+
+ unless (defined $fd)
+ {
+ print STDERR 'Could not open file `' . $filename . '\' for writing.' . "\n";
+ exit 1;
+ }
+
+ my $c_cpp_pairs = $self->_get_unambiguous_pairs;
+
+ foreach my $pair (@{$c_cpp_pairs})
+ {
+ my $c_stuff = $pair->[0];
+ my $cpp_stuff = $pair->[1];
+
+ $fd->print (join '', $c_stuff, ' <=> ', $cpp_stuff, "\n");
+ }
+
+ $fd->close;
+}
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/Util.pm b/tools/pm/Common/Util.pm
index bb03e40..e491452 100644
--- a/tools/pm/Common/Util.pm
+++ b/tools/pm/Common/Util.pm
@@ -21,12 +21,11 @@
# Functions in this module are exported so there is no need to
# request them by module name.
#
-package Util;
+package Common::Util;
use strict;
use warnings;
-
#$ string_unquote($string)
# Removes leading and trailing quotes.
sub string_unquote($)
@@ -57,7 +56,7 @@ sub string_simplify ($)
$str =~ s/^\s+//;
$str =~ s/\s+$//;
- $str =~ s/\s+/ /;
+ $str =~ s/\s+/ /g;
return $str;
}
diff --git a/tools/pm/Common/Variables.pm b/tools/pm/Common/Variables.pm
new file mode 100644
index 0000000..dfb046b
--- /dev/null
+++ b/tools/pm/Common/Variables.pm
@@ -0,0 +1,44 @@
+# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# gmmproc - Common::Variables module
+#
+# Copyright 2012 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 Common::Variables;
+
+use strict;
+use warnings;
+
+use Common::Constants;
+
+use constant
+{
+ 'PROTECTED_GCLASS' => ['PROTECTED_GCLASS_BOOL_VARIABLE', Common::Constants::CLASS],
+ 'DYNAMIC_GTYPE_REGISTRATION' => ['DYNAMIC_GTYPE_REGISTRATION_BOOL_VARIABLE', Common::Constants::CLASS],
+ 'STRUCT_NOT_HIDDEN' => ['STRUCT_NOT_HIDDEN_BOOL_VARIABLE', Common::Constants::CLASS],
+ 'NO_WRAP_FUNCTION' => ['NO_WRAP_FUNCTION_BOOL_VARIABLE', Common::Constants::CLASS],
+ 'DO_NOT_DERIVE_GTYPE' => ['DO_NOT_DERIVE_GTYPE_BOOL_VARIABLE', Common::Constants::CLASS],
+ 'CUSTOM_WRAP_NEW' => ['CUSTOM_WRAP_NEW_BOOL_VARIABLE', Common::Constants::CLASS],
+ 'CUSTOM_CTOR_CAST' => ['CUSTOM_CTOR_CAST_BOOL_VARIABLE', Common::Constants::CLASS],
+ 'DERIVES_INITIALLY_UNOWNED' => ['DERIVES_INITIALLY_UNOWNED_BOOL_VARIABLE', Common::Constants::CLASS],
+ 'CUSTOM_DTOR' => ['CUSTOM_DTOR_BOOL_VARIABLE', Common::Constants::CLASS],
+ 'CUSTOM_DEFAULT_CTOR' => ['CUSTOM_DEFAULT_CTOR_BOOL_VARIABLE', Common::Constants::CLASS],
+ 'CUSTOM_STRUCT_PROTOTYPE' => ['CUSTOM_STRUCT_PROTOTYPE_BOOL_VARIABLE', Common::Constants::CLASS],
+ 'IS_INTERFACE' => ['IS_INTERFACE_BOOL_VARIABLE', Common::Constants::CLASS]
+};
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/WrapParser.pm b/tools/pm/Common/WrapParser.pm
index 4693023..0aca2a7 100644
--- a/tools/pm/Common/WrapParser.pm
+++ b/tools/pm/Common/WrapParser.pm
@@ -1,7 +1,7 @@
# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
# gmmproc - Common::WrapParser module
#
-# Copyright 2011 glibmm development team
+# Copyright 2011, 2012 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
@@ -27,1074 +27,786 @@ use IO::File;
use Common::Util;
use Common::SectionManager;
-use Common::Output::Shared;
-use Common::Output::Gobject;
+use Common::Shared;
+use Common::Output;
+use Common::ConversionsStore;
use constant
{
'STAGE_HG' => 0,
'STAGE_CCG' => 1,
- 'STAGE_INVALID' => 2
+ 'STAGE_INVALID' => 2,
+ 'GIR_RECORD' => 0,
+ 'GIR_CLASS' => 1,
+ 'GIR_ANY' => 2
};
-############################################################################
+###
+### NOT SURE ABOUT THE CODE BELOW
+###
-sub nl
+# TODO: check if we can avoid using it.
+# Look back for a Doxygen comment. If there is one,
+# remove it from the output and return it as a string.
+sub extract_preceding_documentation ($)
{
- return (shift or '') . "\n";
-}
+ my ($self) = @_;
+ my $outputter = $$self{objOutputter};
+ my $out = \ {$$outputter{out}};
-# public
-sub new ($$$)
-{
- my ($type, $repositories, $gir_namespace) = @_;
- my $class = (ref ($type) or $type or 'Common::WrapParser');
- my $self =
- {
- # TODO: check if all those fields are really needed.
- 'filename' => '(none)',
- 'line_num' => 0,
- 'level' => 0,
- 'class' => '',
- 'c_class' => '',
- 'in_class' => 0,
- 'first_namespace' => 1,
- 'namespace' => [],
- 'in_namespace' => [],
- 'defsdir' => ".",
- 'module' => $gir_namespace,
- 'type' => "GTKOBJECT", # or "BOXEDTYPE", or "GOBJECT" - wrapped differently.
- 'already_read' => {},
- 'repositories' => $repositories,
- 'tokens_hg' => [],
- 'tokens_ccg' => [],
- 'tokens_null' => [],
- 'tokens' => [],
- 'parsing_stage' => STAGE_INVALID,
- 'main_section' => Common::SectionManager::SECTION_DEV_NULL,
- 'section_manager' => Common::SectionManager->new,
- 'stage_section_pairs' =>
- {
- STAGE_HG() => [Common::SectionManager::SECTION_H, 'tokens_hg'],
- STAGE_CCG() => [Common::SectionManager::SECTION_CC, 'tokens_ccg'],
- STAGE_INVALID() => [Common::SectionManager::SECTION_DEV_NULL, 'tokens_null']
- },
- 'source_dir' => undef,
- 'destination_dir' => undef,
- 'base' => undef
- };
+ my $comment = '';
- $self = bless ($self, $class);
- $self->{'handlers'} =
+ if ($#$out >= 2)
{
- '{' => [$self, \&on_open_brace],
- '}' => [$self, \&on_close_brace],
- '`' => [$self, \&on_backtick], # probably won't be needed anymore
- '\'' => [$self, \&on_apostrophe], # probably won't be needed anymore
- '"' => [$self, \&on_string_literal],
- '//' => [$self, \&on_comment_cpp],
- '/*' => [$self, \&on_comment_c],
- '/**' => [$self, \&on_comment_doxygen],
- '#m4begin' => [$self, \&on_m4_section], # probably won't be needed anymore
- '#m4' => [$self, \&on_m4_line], # probably won't be needed anymore
- '_DEFS' => [$self, \&on_defs], # probably won't be needed anymore
- '_IGNORE' => [$self, \&on_ignore],
- '_IGNORE_SIGNAL' => [$self, \&on_ignore_signal],
- '_WRAP_METHOD' => [$self, \&on_wrap_method],
- '_WRAP_METHOD_DOCS_ONLY' => [$self, \&on_wrap_method_docs_only],
- '_WRAP_CORBA_METHOD'=> [$self, \&on_wrap_corba_method],
- '_WRAP_SIGNAL' => [$self, \&on_wrap_signal],
- '_WRAP_PROPERTY' => [$self, \&on_wrap_property],
- '_WRAP_VFUNC' => [$self, \&on_wrap_vfunc],
- '_WRAP_CTOR' => [$self, \&on_wrap_ctor],
- '_WRAP_CREATE' => [$self, \&on_wrap_create],
- '_WRAP_ENUM' => [$self, \&on_wrap_enum],
- '_WRAP_GERROR' => [$self, \&on_wrap_gerror],
- '_IMPLEMENTS_INTERFACE' => [$self, \&on_implements_interface],
- # TODO: these should be handled by different handlers.
- '_CLASS_GENERIC' => [$self, \&on_class_generic],
- '_CLASS_GOBJECT' => [$self, \&on_class_gobject],
- '_CLASS_GTKOBJECT' => [$self, \&on_class],
- '_CLASS_BOXEDTYPE' => [$self, \&on_class],
- '_CLASS_BOXEDTYPE_STATIC' => [$self, \&on_class],
- '_CLASS_INTERFACE' => [$self, \&on_class],
- '_CLASS_OPAQUE_COPYABLE' => [$self, \&on_class],
- '_CLASS_OPAQUE_REFCOUNTED' => [$self, \&on_class],
- 'namespace' => [$self, \&on_namespace],
- '_INSERT_SECTION' => [$self, \&on_insert_section]
- };
+ # steal the last three tokens
+ my @back = splice(@$out, -3);
+ local $_ = join('', @back);
+ # Check for /*[*!] ... */ or //[/!] comments. The closing */ _must_
+ # be the last token of the previous line. Apart from this restriction,
+ # anything else should work, including multi-line comments.
+ if (m#\A/\s*\*(?:\*`|`!)(.+)'\*/\s*\z#s or m#\A\s*//`[/!](.+)'\s*\z#s)
+ {
+ $comment = '`' . $1;
+ $comment =~ s/\s*$/'/;
+ }
+ else
+ {
+ # restore stolen tokens
+ push(@$out, @back);
+ }
+ }
- return bless ($self, $class);
+ return $comment;
}
-# public
-sub set_source_dir ($$)
+# TODO: probably implement this. I am not sure.
+# void _on_wrap_corba_method()
+sub _on_wrap_corba_method ($)
{
- my ($self, $source_dir) = @_;
+ my ($self) = @_;
- $self->{'source_dir'} = $source_dir;
-}
+ $self->extract_bracketed_text;
+ # my $objOutputter = $$self{objOutputter};
-# public
-sub set_destination_dir ($$)
-{
- my ($self, $destination_dir) = @_;
+ # return unless ($self->check_for_eof());
+
+ # my $filename = $$self{filename};
+ # my $line_num = $$self{line_num};
+
+ # my $str = $self->extract_bracketed_text();
+ # my @args = string_split_commas($str);
+
+ # my $entity_type = "method";
- $self->{'destination_dir'} = $destination_dir;
+ # if (!$$self{in_class})
+ # {
+ # print STDERR "$filename:$line_num:_WRAP macro encountered outside class\n";
+ # return;
+ # }
+
+ # my $objCppfunc;
+
+ # # handle first argument
+ # my $argCppMethodDecl = $args[0];
+ # if ($argCppMethodDecl !~ m/\S/s)
+ # {
+ # print STDERR "$filename:$line_num:_WRAP_CORBA_METHOD: missing prototype\n";
+ # return;
+ # }
+
+ # # Parse the method decaration and build an object that holds the details:
+ # $objCppfunc = &Function::new($argCppMethodDecl, $self);
+ # $objOutputter->output_wrap_corba_method($filename, $line_num, $objCppfunc);
}
-# public
-sub set_base ($$)
+###
+### NOT SURE ABOUT THE CODE ABOVE
+###
+
+sub _handle_get_args_results ($$)
{
- my ($self, $base) = @_;
+ my ($self, $results) = @_;
+
+ if (defined $results)
+ {
+ my $errors = $results->[0];
+ my $warnings = $results->[1];
+ my $fatal = 0;
+
+ if (defined $errors)
+ {
+ foreach my $error (@{$errors})
+ {
+ my $param = $error->[0];
+ my $message = $error->[1];
+
+ $self->fixed_error_non_fatal (join ':', $param, $message);
+ }
+ $fatal = 1;
+ }
+ if (defined $warnings)
+ {
+ foreach my $warning (@{$warnings})
+ {
+ my $param = $warning->[0];
+ my $message = $warning->[1];
+
+ $self->fixed_warning (join ':', $param, $message);
+ }
+ }
- $self->{'base'} = $base;
+ if ($fatal)
+ {
+# TODO: throw an exception or something.
+ exit 1;
+ }
+ }
}
-# public
-sub get_namespaces ($)
+sub _extract_token ($)
{
my ($self) = @_;
+ my $tokens = $self->get_tokens;
+ my $results = Common::Shared::extract_token $tokens;
+ my $token = $results->[0];
+ my $add_lines = $results->[1];
- return $self->{'namespace'};
+ $self->inc_line_num ($add_lines);
+ return $token;
}
-# public
-sub get_section_manager ($)
+sub _peek_token ($)
{
my ($self) = @_;
+ my $tokens = $self->get_tokens;
- return $self->{'section_manager'};
+ while (@{$tokens})
+ {
+ my $token = $tokens->[0];
+
+ # skip empty tokens
+ if (not defined $token or $token eq '')
+ {
+ shift @{$tokens};
+ }
+ else
+ {
+ return $token;
+ }
+ }
+
+ return '';
}
-# public
-sub get_main_section ($)
+sub _extract_bracketed_text ($)
{
my ($self) = @_;
+ my $tokens = $self->get_tokens;
+ my $result = Common::Shared::extract_bracketed_text $tokens;
- return $self->{'main_section'};
+ if (defined $result)
+ {
+ my $string = $result->[0];
+ my $add_lines = $result->[1];
+
+ $self->inc_line_num ($add_lines);
+ return $string;
+ }
+
+ $self->fixed_error ('Hit eof when extracting bracketed text.');
}
-sub switch_to_stage ($$)
+sub _extract_members ($$)
{
- my ($self, $stage) = @_;
- my $pairs = $self->{'stage_section_pairs'};
+ my ($object, $substs) = @_;
+ my $member_count = $object->get_g_member_count;
+ my @all_members = ();
- if (exists $pairs->{$stage})
- {
- $self->{'parsing_stage'} = $stage;
- $self->{'main_section'} = $pairs->{$stage}[0];
- $self->{'tokens'} = $self->{$pairs->{$stage}[1]};
- }
- else
+ for (my $iter = 0; $iter < $member_count; ++$iter)
{
- # TODO: internal error.
+ my $member = $object->get_g_member_by_index ($iter);
+ my $name = uc $member->get_a_name;
+ my $value = $member->get_a_value;
+
+ foreach my $pair (@{$substs})
+ {
+ $name =~ s#$pair->[0]#$pair->[1]#;
+ $value =~ s#$pair->[0]#$pair->[1]#;
+ }
+ push @all_members, [$name, $value];
}
+
+ return \ all_members;
}
-# public
-sub parse ($)
+sub _on_string_with_delimiters ($$$$)
{
- my ($self) = @_;
+ my ($self, $start, $end, $what) = @_;
+ my $tokens = $self->get_tokens;
+ my $section_manager = $self->get_section_manager;
+ my $main_section = $self->get_main_section;
+ my @out = ($start);
+
+ while (@{$tokens})
+ {
+ my $token = $self->_extract_token;
- $self->read_file;
- $self->parse_and_build_output;
+ push @out, $token;
+ if ($token eq $end)
+ {
+ $section_manager->append_string_to_section ((join '', @out), $main_section);
+ return;
+ }
+ }
+ $self->fixed_error ('Hit eof while in ' . $what . '.');
}
-# void parse_and_build_output()
-sub parse_and_build_output ($)
+sub _on_ending_brace ($)
{
my ($self) = @_;
- my $handlers = $self->{'handlers'};
- my $section_manager = $self->{'section_manager'};
- my @stages = (STAGE_HG, STAGE_CCG);
+ my $tokens = $self->get_tokens;
+ my $section_manager = $self->get_section_manager;
+ my $main_section = $self->get_main_section;
+ my @strings = ();
+ my $slc = 0;
+ my $mlc = 0;
- for my $stage (@stages)
+ while (@{$tokens})
{
- $self->switch_to_stage ($stage);
-
- my $tokens = $self->{'tokens'};
+ my $token = $self->_extract_token;
- while (@{$tokens})
+ push @strings, $token;
+ if ($slc)
{
- my $token = $self->extract_token;
-
- if (exists $handlers->{$token})
+ if ($token eq "\n")
{
- my $pair = $handlers->{$token};
- my $object = $pair->[0];
- my $handler = $pair->[1];
-
- if (defined $object)
- {
- $object->$handler;
- }
- else
- {
- &{$handler};
- }
+ last;
}
- else
+ }
+ elsif ($mlc)
+ {
+ if ($token eq "*/")
{
- my $main_section = $self->{'main_section'};
- # no handler found - just paste the token to main section
- $section_manager->append_string_to_section ($token, $main_section);
+ last;
}
}
+ elsif ($token eq '//')
+ {
+ # usual case: } // namespace Foo
+ $slc = 1;
+ }
+ elsif ($token eq '/*')
+ {
+ # usual case: } /* namespace Foo */
+ $mlc = 1;
+ }
+ elsif ($token eq "\n")
+ {
+ last;
+ }
+ elsif ($token =~ /^\s+$/)
+ {
+ # got nonwhitespace, non plain comment token
+ # removing it from strings and putting it back to tokens, so it will be processed later.
+ pop @strings;
+ unshift @{$tokens}, $token;
+ last;
+ }
}
-
- my $destination_dir = $self->{'destination_dir'};
- my $base = $self->{'base'};
- my $h_file = File::Spec->catfile ($destination_dir, $base . '.h');
- my $cc_file = File::Spec->catfile ($destination_dir, $base . '.cc');
- my $p_h_file = File::Spec->catfile ($destination_dir, 'private', $base . '_p.h');
-
- $section_manager->write_main_section_to_file (Common::SectionManager::SECTION_H, $h_file);
- $section_manager->write_main_section_to_file (Common::SectionManager::SECTION_CC, $cc_file);
- $section_manager->write_main_section_to_file (Common::SectionManager::SECTION_P_H, $p_h_file);
+ $section_manager->append_string_to_section ((join '', @strings, "\n"), $main_section);
}
-sub error_with_loc ($$$)
+sub _get_gir_stack ($)
{
- my ($self, $line_num, $message) = @_;
+ my ($self) = @_;
- print STDERR $self->{'filename'} . ':' . $line_num . ' - ERROR: ' . $message . "\n";
- exit 1;
+ return $self->{'gir_stack'};
}
-sub error ($$)
+sub _push_gir_generic ($$$)
{
- my ($self, $message) = @_;
+ my ($self, $gir_stuff, $gir_type) = @_;
+ my $gir_stack = $self->_get_gir_stack;
- $self->error_with_loc ($self->{'line_num'}, $message);
+ push @{$gir_stack}, [$gir_type, $gir_stuff];
}
-sub warning_with_loc ($$$)
+sub _push_gir_record ($$)
{
- my ($self, $line_num, $message) = @_;
+ my ($self, $gir_record) = @_;
- print STDERR $self->{'filename'} . ':' . $line_num . ' - WARNING: ' . $message;
+ $self->_push_gir_generic ($gir_record, GIR_RECORD);
}
-sub warning ($$)
+sub _push_gir_class ($$)
{
- my ($self, $message) = @_;
+ my ($self, $gir_class) = @_;
- $self->warning_with_loc ($self->{'line_num'}, $message);
+ $self->_push_gir_generic ($gir_class, GIR_CLASS);
}
-######################################################################
-##### 1.1 parser subroutines
-
-########################################
-### returns the next token, ignoring some stuff.
-# $string extract_token()
-sub extract_token ($)
+sub _get_gir_generic ($$)
{
- my ($self) = @_;
- my $tokens = $self->{'tokens'};
+ my ($self, $gir_type) = @_;
+ my $gir_stack = $self->_get_gir_stack;
- while (@{$tokens})
+ if (@{$gir_stack})
{
- my $token = shift @{$tokens};
-
- # skip empty tokens
- next if (not defined ($token) or $token eq '');
+ my $gir_desc = $gir_stack->[-1];
- if ($token =~ /\n/)
+ if ($gir_desc->[0] == $gir_type or $gir_type == GIR_ANY)
{
- ++$self->{'line_num'};
+ return $gir_desc->[1];
}
-
- return $token;
}
- return '';
+ return undef;
}
-### Returns the next token, but does not remove it from the queue, so that
-# extract_token will return it again.
-# $string peek_token()
-sub peek_token ($)
+sub _get_gir_record ($)
{
my ($self) = @_;
- my $tokens = $self->{'tokens'};
- while (@{$tokens})
- {
- my $token = $tokens->[0];
+ return $self->_get_gir_generic (GIR_RECORD);
+}
- # skip empty tokens
- if (not defined $token or $token eq '')
- {
- shift @{$tokens};
- }
- else
- {
- return $token;
- }
- }
+sub _get_gir_class ($)
+{
+ my ($self) = @_;
- return '';
+ return $self->_get_gir_generic (GIR_CLASS);
}
-sub on_string_with_delimiters ($$$$)
+sub _get_gir_entity ($)
{
- my ($self, $start, $end, $what) = @_;
- my $tokens = $self->{'tokens'};
- my $section_manager = $self->{'section_manager'};
- my $main_section = $self->{'main_section'};
- my @out = ($start);
- my $line_num = $self->{'line_num'};
-
- while (@{$tokens})
- {
- my $token = $self->extract_token;
+ my ($self) = @_;
- push @out, $token;
- if ($token eq $end)
- {
- $section_manager->append_string_to_section (join ('', @out), $main_section);
- return;
- }
- }
- $self->error_with_loc ($line_num, 'Hit eof while in ' . $what . '.');
+ return $self->_get_gir_generic (GIR_ANY);
}
-########################################
-### we pass strings literally with quote substitution
-# void on_string_literal()
-sub on_string_literal ($)
+sub _pop_gir_entity ($)
{
my ($self) = @_;
+ my $gir_stack = $self->_get_gir_stack;
- $self->on_string_with_delimiters ('"', '"', 'string');
+ pop @{$gir_stack};
}
-
-########################################
-### we pass comments literally
-# void on_comment_cpp()
-sub on_comment_cpp ($)
+sub _get_c_stack ($)
{
my ($self) = @_;
- $self->on_string_with_delimiters ('//', "\n", 'C++ comment');
+ return $self->{'c_stack'};
}
+sub _push_c_class ($$)
+{
+ my ($self, $c_class) = @_;
+ my $c_stack = $self->_get_c_stack;
+
+ push @{$c_stack}, $c_class;
+}
-########################################
-### we pass C comments literally
-# void on_comment_c()
-sub on_comment_c ($)
+sub _pop_c_class ($)
{
my ($self) = @_;
+ my $c_stack = $self->_get_c_stack;
- $self->on_string_with_delimiters ('/*', '*/', 'C comment');
+ pop @{$c_stack};
}
-sub on_comment_doxygen ($)
+# TODO: public
+sub get_c_class ($)
{
my ($self) = @_;
- my $tokens = $self->{'tokens'};
- my @out = ('/**');
- my $line_num = $self->{'line_num'};
+ my $c_stack = $self->_get_c_stack;
- while (@{$tokens})
+ if (@{$c_stack})
{
- my $token = $self->extract_token;
-
- if ($token eq '*/')
- {
- push @out, '*';
- # Find next non-whitespace token, but remember whitespace so that we
- # can print it if the next real token is not _WRAP_SIGNAL
- my @whitespace = ();
- my $next_token = $self->peek_token;
- while ($next_token !~ /\S/)
- {
- push @whitespace, $self->extract_token;
- $next_token = $self->peek_token;
- }
-
- # If the next token is a signal, do not close this comment, to merge
- # this doxygen comment with the one from the signal.
- if ($next_token eq '_WRAP_SIGNAL')
- {
- # Extract token and process
- $self->extract_token();
- # Tell wrap_signal to merge automatically generated comment with
- # already existing comment. This is why we do not close the comment
- # here.
- return $self->on_wrap_signal_after_comment(\ out);
- }
- else
- {
- # Something other than signal follows, so close comment normally
- # and append whitespace we ignored so far.
- push @out, '/', @whitespace;
- return join '', @out;
- }
-
- last;
- }
-
- push @out, $token;
+ return $c_stack->[-1];
}
- $self->error_with_loc ($line_num, 'Hit eof while in doxygen comment.');
+ return undef;
}
-#TODO: get rid of it?
-########################################
-### handle #m4begin ... #m4end
-# we don't substitute ` or ' in #m4begin
-# void on_m4_section()
-sub on_m4_section($)
+sub _get_prop_name ($$$$)
{
- my ($self) = @_;
- my $tokens = $self->{'tokens'};
- my $line_num = $self->{'line_num'};
+ my ($self, $gir_class, $c_param_name, $cxx_param_name) = @_;
+ my $c_prop_name = $c_param_name;
- $self->warning ('#m4begin and #m4end are deprecated.');
+ $c_prop_name =~ s/_/-/g;
- while (@{$tokens})
+ my $gir_property = $gir_class->get_g_property_by_name ($c_prop_name);
+
+ unless (defined $gir_property)
{
- return if ($self->extract_token eq '#m4end');
+ my $cxx_prop_name = $cxx_param_name;
+
+ $cxx_prop_name =~ s/_/-/g;
+ $gir_property = $gir_class->get_g_property_by_name ($cxx_prop_name);
+
+ unless (defined $gir_property)
+ {
+# TODO: error in proper, fixed line.
+ die;
+ }
}
- $self->error_with_loc ($line_num, 'Hit eof when looking for #m4end.');
+ return $gir_property->get_a_name;
}
-# TODO: get rid of it?
-########################################
-### handle #m4 ... /n
-# we don't substitute ` or ' in #m4
-# void on_m4_line()
-sub on_m4_line ($)
+###
+### HANDLERS BELOW
+###
+
+sub _on_open_brace ($)
{
my ($self) = @_;
- my $tokens = $self->{'tokens'};
- my $line_num = $self->{'line_num'};
-
- $self->warning ('#m4 is deprecated.');
-
- while (@{$tokens})
- {
- return if ($self->extract_token eq "\n");
- }
+ my $section_manager = $self->get_section_manager;
+ my $main_section = $self->get_main_section;
- $self->error_with_loc ($line_num, 'Hit eof when looking for newline');
+ $self->inc_level;
+ $section_manager->append_string_to_section ('{', $main_section);
}
-########################################
-# m4 needs to know when we entered a namespace
-# void on_namespace()
-sub on_namespace ($)
+sub _on_close_brace ($)
{
my ($self) = @_;
- my $tokens = $self->{'tokens'};
- my $section_manager = $self->{'section_manager'};
- my $main_section = $self->{'main_section'};
- my $name = '';
- my $done = 0;
- my $in_s_comment = 0;
- my $in_m_comment = 0;
- my $line_num = $self->{'line_num'};
+ my $section_manager = $self->get_section_manager;
+ my $main_section = $self->get_main_section;
+ my $namespace_levels = $self->get_namespace_levels;
+ my $namespaces = $self->get_namespaces;
+ my $level = $self->get_level;
+ my $class_levels = $self->get_class_levels;
+ my $classes = $self->get_classes;
- # we need to peek ahead to figure out what type of namespace
- # declaration this is.
- foreach my $token (@{$tokens})
+ $section_manager->append_string_to_section ('}', $main_section);
+
+ # check if we are closing the class brace
+ if (@{$class_levels} and $class_levels->[-1] == $level)
{
- next if (not defined $token or $token eq '');
+ pop @{$class_levels};
+ pop @{$classes};
- if ($in_s_comment)
- {
- if ($token eq "\n")
- {
- $in_s_comment = 0;
- }
- }
- elsif ($in_m_comment)
- {
- if ($token eq '*/')
- {
- $in_m_comment = 0;
- }
- }
- elsif ($token eq '//')
- {
- $in_s_comment = 1;
- }
- elsif ($token eq '/*' or $token eq '/**')
- {
- $in_m_comment = 1;
- }
- elsif ($token eq '{')
+ unless (@{$classes})
{
- $name = Util::string_trim ($name);
+ my $section = Common::Output::Shared::get_section $self, Common::Sections::H_AFTER_FIRST_CLASS;
- if ($self->{'first_namespace'})
- {
- $self->{'first_namespace'} = 0;
- $section_manager->append_section_to_section ('SECTION_BEFORE_FIRST_NAMESPACE', $main_section);
- }
-
-# this is probably not needed - m4 needed that to know what namespaces
-# were opened, so it could close them and reopen in order
-# $objOutputter->append("_NAMESPACE($arg)");
- unshift @{$self->{'namespace'}}, $name;
- unshift @{$self->{'in_namespace'}}, $self->{'level'} + 1;
- $done = 1;
- }
- elsif ($token eq ';')
- {
- $done = 1;
- }
- elsif ($token !~ /\s/)
- {
- if ($name ne '')
- {
- $self->error ('Unexpected `' . $token . '\' after namespace name.');
- }
- $name = $token;
+ $self->_on_ending_brace;
+ $section_manager->append_section_to_section ($section, $main_section);
}
+ $self->_pop_gir_entity;
+ }
+ # check if we are closing the namespace brace
+ elsif (@{$namespace_levels} and $namespace_levels->[-1] == $level)
+ {
+ pop @{$namespaces};
+ pop @{$namespace_levels};
- if ($done)
+ unless (@{$namespaces})
{
- $section_manager->append_string_to_section ('namespace', $main_section);
- return;
+ my $section = Common::Output::Shared::get_section $self, Common::Sections::H_AFTER_FIRST_NAMESPACE;
+
+ $self->_on_ending_brace;
+ $section_manager->append_section_to_section ($section, $main_section);
}
}
- $self->error_with_loc ($line_num, 'Hit eof while processing `namespace\'.');
-}
+ $self->dec_level;
+}
-# TODO: implement it.
-########################################
-### we don't want to report every petty function as unwrapped
-# void on_ignore($)
-sub on_ignore($)
+sub _on_string_literal ($)
{
my ($self) = @_;
- $self->warning ('_IGNORE is not yet implemented.');
- $self->extract_bracketed_text;
-# my @args = split(/\s+|,/,$str);
-# foreach (@args)
-# {
-# next if ($_ eq "");
-# GtkDefs::lookup_function($_); #Pretend that we've used it.
-# }
+ $self->_on_string_with_delimiters ('"', '"', 'string');
}
-# TODO: implement it.
-sub on_ignore_signal($)
+sub _on_comment_cpp ($)
{
my ($self) = @_;
- $self->warning ('_IGNORE_SIGNAL is not yet implemented.');
- $self->extract_bracketed_text;
-# $str = Util::string_trim($str);
-# $str = Util::string_unquote($str);
-# my @args = split(/\s+|,/,$str);
-# foreach (@args)
-# {
-# next if ($_ eq "");
-# GtkDefs::lookup_signal($$self{c_class}, $_); #Pretend that we've used it.
-# }
+ $self->_on_string_with_delimiters ('//', "\n", 'C++ comment');
}
-# TODO: make it a common handler of _CLASS macros. And actually implement it.
-########################################
-### we have certain macros we need to insert at end of statements
-# void on_class($, $strClassCommand)
-#sub on_class($$)
-sub on_class ($)
+# TODO: look at _on_comment_doxygen - something similar has to
+# TODO continued: be done here.
+sub _on_comment_doxygen_single ($)
{
-# my ($self, $class_command) = @_;
my ($self) = @_;
- $self->warning ('on_class is not implemented.');
- $self->extract_bracketed_text;
-
- # my $objOutputter = $$self{objOutputter};
-
- # $$self{in_class} = $$self{level};
-
- # #Remember the type of wrapper required, so that we can append the correct _END_CLASS_* macro later.
- # {
- # my $str = $class_command;
- # $str =~ s/^_CLASS_//;
- # $$self{type} = $str;
- # }
-
- # my ($class, $c_class) = split(',',$str);
- # $class = Util::string_trim($class);
- # $c_class = Util::string_trim($c_class);
-
- # $$self{class} = $class;
- # $$self{c_class} = $c_class;
-
- # my @back;
- # push(@back, $class_command);
- # push(@back, "($str)");
-
- # TODO: do we really need it?
- # When we hit _CLASS, we walk backwards through the output to find "class"
- # my $token;
- # while ( scalar(@{$$objOutputter{out}}))
- # {
- # $token = pop @{$$objOutputter{out}};
- # unshift(@back, $token);
- # if ($token eq "class")
- # {
- # $objOutputter->append("_CLASS_START()");
-
- # my $strBack = join("", @back);
-
- # $objOutputter->append($strBack);
- # return;
- # }
- # }
-
-# $self->error($class_command . 'outside of class.');
-# exit 1;
+ $self->_on_string_with_delimiters ('///', "\n", 'Doxygen single line comment');
}
-# order to read the defs file
-# void on_defs()
-sub on_defs ($)
+sub _on_comment_c ($)
{
my ($self) = @_;
- $self->warning ('_DEFS macro is deprecated.');
- $self->extract_bracketed_text;
+ $self->_on_string_with_delimiters ('/*', '*/', 'C comment');
}
-# void on_open_brace()
-sub on_open_brace($)
+# TODO: use the commented code.
+sub _on_comment_doxygen ($)
{
my ($self) = @_;
- my $section_manager = $self->{'section_manager'};
- my $main_section = $self->{'main_section'};
- ++$self->{'level'};
- $section_manager->append_string_to_section ('{', $main_section);
+ $self->_on_string_with_delimiters ('/**', '*/', 'Doxygen multiline comment');
+
+# my $tokens = $self->get_tokens;
+# my @out = ('/**');
+#
+# while (@{$tokens})
+# {
+# my $token = $self->_extract_token;
+#
+# if ($token eq '*/')
+# {
+# push @out, '*';
+# # Find next non-whitespace token, but remember whitespace so that we
+# # can print it if the next real token is not _WRAP_SIGNAL
+# my @whitespace = ();
+# my $next_token = $self->_peek_token;
+# while ($next_token !~ /\S/)
+# {
+# push @whitespace, $self->_extract_token;
+# $next_token = $self->_peek_token;
+# }
+#
+# # If the next token is a signal, do not close this comment, to merge
+# # this doxygen comment with the one from the signal.
+# if ($next_token eq '_WRAP_SIGNAL')
+# {
+# # Extract token and process
+# $self->_extract_token;
+# # Tell wrap_signal to merge automatically generated comment with
+# # already existing comment. This is why we do not close the comment
+# # here.
+# return $self->_on_wrap_signal_after_comment(\ out);
+# }
+# else
+# {
+# # Something other than signal follows, so close comment normally
+# # and append whitespace we ignored so far.
+# push @out, '/', @whitespace;
+# return join '', @out;
+# }
+#
+# last;
+# }
+#
+# push @out, $token;
+# }
+# $self->fixed_error ('Hit eof while in doxygen comment.');
}
-# void on_close_brace($)
-sub on_close_brace($)
+# TODO: We have to just ignore #m4{begin,end}, and check for
+# TODO continued: _CONVERSION macros inside.
+sub _on_m4_section ($)
{
my ($self) = @_;
- my $section_manager = $self->{'section_manager'};
- my $main_section = $self->{'main_section'};
-
- if ($self->{'in_class'} and $self->{'in_class'} == $self->{'level'})
- {
- $self->on_end_class();
- }
+ my $tokens = $self->get_tokens;
- $section_manager->append_string_to_section ('}', $main_section);
+ $self->fixed_warning ('Deprecated.');
- if (@{$self->{'in_namespace'}} and $self->{'in_namespace'}[0] == $self->{'level'})
+ while (@{$tokens})
{
- $self->on_end_namespace();
+ return if ($self->_extract_token eq '#m4end');
}
- --$self->{'level'};
+ $self->fixed_error ('Hit eof when looking for #m4end.');
}
-
-# TODO: check if we really need it. That was probably only for m4. We can do it in simpler way.
-########################################
-### denote the end of a class
-# void on_end_class($)
-sub on_end_class ($)
+# TODO: We have to just ignore #m4, and check for _CONVERSION
+# TODO continued: macros inside.
+sub _on_m4_line ($)
{
my ($self) = @_;
- # my $objOutputter = $$self{objOutputter};
+ my $tokens = $self->get_tokens;
- # # Examine $$self{type}, which was set in on_class()
- # # And append the _END_CLASS_* macro, which will, in turn, output the m4 code.
- # {
- # my $str = $$self{type};
- # $objOutputter->append("`'_END_CLASS_$str()\n");
- # }
+ $self->fixed_warning ('Deprecated.');
+
+ while (@{$tokens})
+ {
+ return if ($self->_extract_token eq "\n");
+ }
- # $$self{class} = "";
- # $$self{c_class} = "";
- # $$self{in_class} = 0;
+ $self->fixed_error ('Hit eof when looking for newline');
}
-########################################
-###
-# void on_end_namespace($)
-sub on_end_namespace ($)
+sub _on_defs ($)
{
my ($self) = @_;
- my $namespaces = $self->{'namespace'};
-# my $objOutputter = $$self{objOutputter};
-# $objOutputter->append("`'_END_NAMESPACE()");
- shift @{$namespaces};
- shift @{$self->{'in_namespace'}};
-
- unless (@{$namespaces})
- {
- my $section_manager = $self->{'section_manager'};
- my $main_section = $self->{'main_section'};
- my $tokens = $self->{'tokens'};
- my @strs = ();
+ $self->fixed_warning ('Deprecated.');
+ $self->extract_bracketed_text;
+}
- # TODO: make it multiline comments aware?
- while (@{$tokens})
- {
- my $token = $self->extract_token;
+# TODO: implement it.
+sub _on_ignore ($)
+{
+ my ($self) = @_;
- push @strs, $token;
- last if ($token eq "\n");
- }
- $section_manager->append_string_to_section (join ('', @strs), $main_section);
- $section_manager->append_section_to_section ('SECTION_AFTER_FIRST_NAMESPACE', $main_section);
- }
+ $self->fixed_warning ('Not yet implemented.');
+ $self->extract_bracketed_text;
+# my @args = split(/\s+|,/,$str);
+# foreach (@args)
+# {
+# next if ($_ eq "");
+# GtkDefs::lookup_function($_); #Pretend that we've used it.
+# }
}
+# TODO: implement it.
+sub _on_ignore_signal ($)
+{
+ my ($self) = @_;
-######################################################################
-##### some utility subroutines
+ $self->fixed_warning ('Not yet implemented.');
+ $self->extract_bracketed_text;
+# $str = Common::Util::string_trim($str);
+# $str = Common::Util::string_unquote($str);
+# my @args = split(/\s+|,/,$str);
+# foreach (@args)
+# {
+# next if ($_ eq "");
+# GtkDefs::lookup_signal($$self{c_class}, $_); #Pretend that we've used it.
+# }
+}
-########################################
-### takes (\S+) from the tokens (smart)
-# $string extract_bracketed_text()
-sub extract_bracketed_text ($)
+sub _on_wrap_method ($)
{
my ($self) = @_;
- my $tokens = $self->{'tokens'};
- my $level = 1;
- my $str = '';
- my $line_num = $self->{'line_num'};
+ my @args = Common::Shared::string_split_commas $self->extract_bracketed_text;
- # Move to the first "(":
- while (@{$tokens})
+ if (@args < 2)
{
- my $token = $self->extract_token;
-
- last if ($token eq '(');
+ $self->fixed_error ('Too few parameters.');
}
- # Concatenate until the corresponding ")":
- while (@{$tokens})
+ my $cxx_method_decl = shift @args;
+ my $c_function_name = shift @args;
+ my $deprecated = 0;
+ my $refreturn = 0;
+ my $constversion = 0;
+ my $errthrow = 0;
+ my $ifdef = undef;
+ my $setup =
{
- my $token = $self->extract_token;
- ++$level if ($token eq '(');
- --$level if ($token eq ')');
+ 'b(deprecated)' => \$deprecated,
+# TODO: probably obsolete, maybe inform that some annotation
+# TODO continued: could be added to C sources.
+ 'ob(refreturn)' => \$refreturn,
+ 'b(constversion)' => \$constversion,
+ 'ob(errthrow)' => \$errthrow,
+ 's(ifdef)' => \$ifdef
+ };
+
+ $self->_handle_get_args_results (Common::Shared::get_args \ args, $setup);
+
+ my $cxx_function = Common::CxxFunctionInfo->new_from_string ($cxx_method_decl);
+ my $gir_entity = $self->_get_gir_entity;
- return $str unless $level;
- $str .= $token;
+ unless (defined $gir_entity)
+ {
+ $self->fixed_error ('Macro outside class.');
}
- $self->error_with_loc ($line_num, 'Hit eof when extracting bracketed text.');
-}
+# TODO: Check if we have any function outside C class wrapped
+# TODO continued: in C++ class. If not then getting the
+# TODO continued: namespace is not needed.
+ my $repositories = $self->get_repositories;
+ my $module = $self->get_module;
+ my $repository = $repositories->get_repository ($module);
-# TODO: Handle case when some string is passed?
-########################################
-### breaks up a string by commas (smart)
-# @strings string_split_commas($string)
-sub string_split_commas ($)
-{
- my ($in) = @_;
- my @out = ();
- my $level = 0;
- my $str = '';
- my @tokens = split(/([,()]"')/, $in);
- my $sq = 0;
- my $dq = 0;
+ unless (defined $repository)
+ {
+ $self->fixed_error ('No such repository: ' . $module);
+ }
+
+ my $gir_namespace = $repository->get_g_namespace_by_name ($module);
- while (@tokens)
+ unless (defined $gir_namespace)
{
- my $token = shift @tokens;
+ $self->fixed_error ('No such namespace: ' . $module);
+ }
+
+ my $gir_func = $gir_entity->get_g_method_by_name ($c_function_name);
- next if ($token eq '');
+ unless (defined $gir_func)
+ {
+ $gir_func = $gir_entity->get_g_function_by_name ($c_function_name);
- if ($sq)
+ unless (defined $gir_func)
{
- if ($token eq '\'')
+# TODO: Check if we have any function outside C class wrapped
+# TODO continued: in C++ class.
+ $gir_func = $gir_namespace->get_g_function_by_name ($c_function_name);
+
+ unless (defined $gir_func)
{
- $sq = 0;
+ $self->fixed_error ('No such method: ' . $c_function_name);
}
- }
- elsif ($dq)
- {
- if ($token eq '"')
+ else
{
- $dq = 0;
+ $self->fixed_warning ('Found a function, but it is outside class.');
}
}
- elsif ($token eq '\'')
- {
- $sq = 1;
- }
- elsif ($token eq '"')
- {
- $dq = 1;
- }
- elsif ($token eq '(')
- {
- ++$level;
- }
- elsif ($token eq ')')
- {
- --$level;
- }
- elsif ($token eq ',' and not $level)
- {
- push @out, $str;
- $str = '';
- next;
- }
-
- $str .= $token;
}
- push @out, $str;
- return @out;
-}
-
-sub tokenize_contents ($$)
-{
- my ($self, $contents) = @_;
- # Break the file into tokens. Token is:
- # - any group of #, A to z, 0 to 9, _
- # - /**
- # - /*
- # - *.
- # - //
- # - any char proceeded by \
- # - symbols ;{}"`'()
- # - newline
- my @tokens = split(/([#A-Za-z0-9_]+)|(\/\*\*)|(\/\*)|(\*\/)|(\/\/)|(\\.)|([;{}"'`()])|(\n)/,
- $contents);
-
- return \ tokens;
-}
-
-########################################
-### reads in the preprocessor files
-# we insert line and file directives for later stages
-# void read_file()
-sub read_file ($)
-{
- my ($self) = @_;
- my $source_dir = $self->{'source_dir'};
- my $base = $self->{'base'};
- my $source = File::Spec->catfile ($source_dir, $base);
- my $hg = $source . '.hg';
- my $ccg = $source . '.ccg';
- my $fd = IO::File->new ($hg, 'r');
+ my $c_function = Common::CFunctionInfo->new_from_gir ($gir_func);
+ my $ret_transfer = $c_function->get_return_transfer;
+ my $throws = $c_function->get_throws;
- unless (defined $fd)
+# TODO: remove the ifs below after possible bugs in
+# TODO continued: wrappers/annotations are fixed.
+ if ($ret_transfer == Common::ConversionsStore::TRANSFER_FULL and $refreturn)
{
- print 'Could not open file `' . $hg . '\' for reading.' . "\n";
- exit 1;
+ $self->fixed_warning ('refreturn given but annotation says that transfer is already full - which is wrong? (refreturn is ignored anyway.)');
}
-
- $self->{'tokens_hg'} = $self->tokenize_contents (join '', $fd->getlines);
- $fd->close;
-
- # Source file is optional.
- $fd = IO::File->new ($ccg, 'r');
- if (defined $fd)
+ elsif ($ret_transfer == Common::ConversionsStore::TRANSFER_NONE and not $refreturn)
{
- my $str = join ('',
- '_INSERT_SECTION(SECTION_CCG_BEGIN)',
- "\n",
- $fd->getlines,
- "\n",
- '_INSERT_SECTION(SECTION_CCG_END)',
- "\n");
- $self->{'tokens_ccg'} = $self->tokenize_contents ($str);
- $fd->close;
+ $self->fixed_warning ('There is no refreturn, but annotation says that transfer is none - which is wrong? (refreturn would be ignored anyway.)');
}
-}
-
-######################################################################
-##### 2.1 subroutines for _WRAP
-
-########################################
-
-# $bool check_for_eof()
-sub check_for_eof ($)
-{
- my ($self) = @_;
- my $tokens = $self->{'tokens'};
-
- unless (@{$tokens})
+ if (not $throws and $errthrow)
{
- $self->error ('Hit eof in _WRAP.');
+ $self->fixed_warning ('errthrow given but annotation says that no error here is thrown - which is wrong? (errthrow is ignored anyway.)');
}
- return 1;
+ elsif ($throws and not $errthrow)
+ {
+ $self->fixed_warning ('There is no errthrow but annotation says that an error can be thrown here - which is wrong? (errthrow would be ignored anyway.)');
+ }
+
+ Common::Output::Method::output ($self,
+ $cxx_function->get_static,
+ $cxx_function->get_return_type,
+ $cxx_function->get_name,
+ $cxx_function->get_param_types,
+ $cxx_function->get_param_names,
+ $cxx_function->get_const,
+ $constversion,
+ $deprecated,
+ $ifdef,
+ $c_function->get_return_type,
+ $ret_transfer,
+ $c_function->get_name,
+ $c_function->get_param_types,
+ $c_function->get_param_transfers,
+ $throws);
}
-# TODO: check if we can avoid using it.
-# Look back for a Doxygen comment. If there is one,
-# remove it from the output and return it as a string.
-sub extract_preceding_documentation ($)
+# TODO: implement it.
+sub _on_wrap_method_docs_only ($)
{
my ($self) = @_;
- my $outputter = $$self{objOutputter};
- my $out = \ {$$outputter{out}};
- my $comment = '';
+ $self->extract_bracketed_text;
+ $self->fixed_warning ('Not yet implemented.');
+ # my $objOutputter = $$self{objOutputter};
- if ($#$out >= 2)
- {
- # steal the last three tokens
- my @back = splice(@$out, -3);
- local $_ = join('', @back);
+ # return unless ($self->check_for_eof());
- # Check for /*[*!] ... */ or //[/!] comments. The closing */ _must_
- # be the last token of the previous line. Apart from this restriction,
- # anything else should work, including multi-line comments.
-
- if (m#\A/\s*\*(?:\*`|`!)(.+)'\*/\s*\z#s or m#\A\s*//`[/!](.+)'\s*\z#s)
- {
- $comment = '`' . $1;
- $comment =~ s/\s*$/'/;
- }
- else
- {
- # restore stolen tokens
- push(@$out, @back);
- }
- }
-
- return $comment;
-}
-
-# TODO: implement it.
-# void on_wrap_method()
-sub on_wrap_method($)
-{
- my ($self) = @_;
-
- $self->extract_bracketed_text;
- # my $objOutputter = $$self{objOutputter};
-
- # return unless ($self->check_for_eof());
-
- # my $filename = $$self{filename};
- # my $line_num = $$self{line_num};
-
- # my $commentblock = $self->extract_preceding_documentation();
- # my $str = $self->extract_bracketed_text();
- # my @args = string_split_commas($str);
-
- # my $entity_type = "method";
-
- # unless ($$self{in_class})
- # {
- # print STDERR "$filename:$line_num:_WRAP macro encountered outside class\n";
- # return;
- # }
-
- # my $objCfunc;
- # my $objCppfunc;
-
- # # handle first argument
- # my $argCppMethodDecl = $args[0];
- # if ($argCppMethodDecl !~ m/\S/s)
- # {
- # print STDERR "$filename:$line_num:_WRAP_METHOD: missing prototype\n";
- # return;
- # }
-
- # #Parse the method decaration and build an object that holds the details:
- # $objCppfunc = &Function::new($argCppMethodDecl, $self);
-
- # # handle second argument:
-
- # my $argCFunctionName = $args[1];
- # $argCFunctionName = Util::string_trim($argCFunctionName);
-
- # #Get the c function's details:
-
- # # Checks that it's not empty and that it contains no whitespace.
- # if ($argCFunctionName =~ m/^\S+$/s)
- # {
- # #c-name. e.g. gtk_clist_set_column_title
- # $objCfunc = GtkDefs::lookup_function($argCFunctionName);
-
- # if(!$objCfunc) #If the lookup failed:
- # {
- # $objOutputter->output_wrap_failed($argCFunctionName, "method defs lookup failed (1)");
- # return;
- # }
- # }
-
- # # Extra stuff needed?
- # $$objCfunc{rettype_needs_ref} = 0;
- # $$objCfunc{throw_any_errors} = 0;
- # $$objCfunc{constversion} = 0;
- # $$objCfunc{deprecated} = "";
- # my $deprecation_docs = "";
- # my $ifdef;
- # while($#args >= 2) # If the optional ref/err/deprecated arguments are there.
- # {
- # my $argRef = Util::string_trim(pop @args);
- # #print "debug arg=$argRef\n";
- # if($argRef eq "refreturn")
- # {
- # $$objCfunc{rettype_needs_ref} = 1;
- # }
- # elsif($argRef eq "errthrow")
- # {
- # $$objCfunc{throw_any_errors} = 1;
- # }
- # elsif($argRef eq "constversion")
- # {
- # $$objCfunc{constversion} = 1;
- # }
- # elsif($argRef =~ /^deprecated(.*)/) #If deprecated is at the start.
- # {
- # $$objCfunc{deprecated} = "deprecated";
-
- # if($1 ne "")
- # {
- # $deprecation_docs = Util::string_unquote(Util::string_trim($1));
- # }
- # }
- # elsif($argRef =~ /^ifdef(.*)/) #If ifdef is at the start.
- # {
- # $ifdef = $1;
- # }
- # }
-
- # if ($commentblock ne '')
- # {
- # $commentblock = ' /**' . $commentblock . "\n */\n";
- # }
- # else
- # {
- # $commentblock = DocsParser::lookup_documentation($argCFunctionName, $deprecation_docs);
- # }
-
- # $objOutputter->output_wrap_meth($filename, $line_num, $objCppfunc, $objCfunc, $argCppMethodDecl, $commentblock, $ifdef);
-}
-
-# TODO: implement it.
-# void on_wrap_method_docs_only()
-sub on_wrap_method_docs_only($)
-{
- my ($self) = @_;
-
- $self->extract_bracketed_text;
- # my $objOutputter = $$self{objOutputter};
-
- # return unless ($self->check_for_eof());
-
- # my $filename = $$self{filename};
- # my $line_num = $$self{line_num};
+ # my $filename = $$self{filename};
+ # my $line_num = $$self{line_num};
# my $str = $self->extract_bracketed_text();
# my @args = string_split_commas($str);
@@ -1111,7 +823,7 @@ sub on_wrap_method_docs_only($)
# # handle first argument
# my $argCFunctionName = $args[0];
- # $argCFunctionName = Util::string_trim($argCFunctionName);
+ # $argCFunctionName = Common::Util::string_trim($argCFunctionName);
# # Get the C function's details:
@@ -1132,7 +844,7 @@ sub on_wrap_method_docs_only($)
# $$objCfunc{throw_any_errors} = 0;
# while($#args >= 1) # If the optional ref/err arguments are there.
# {
- # my $argRef = Util::string_trim(pop @args);
+ # my $argRef = Common::Util::string_trim(pop @args);
# if($argRef eq "errthrow")
# {
# $$objCfunc{throw_any_errors} = 1;
@@ -1145,966 +857,2059 @@ sub on_wrap_method_docs_only($)
# $objOutputter->output_wrap_meth_docs_only($filename, $line_num, $commentblock);
}
-# TODO: implement it.
-sub on_wrap_ctor($)
+# TODO: Split the common part from it and make two methods
+# TODO continued: with merging doxycomment and without it.
+# TODO: Implement it actually.
+sub _on_wrap_signal ($)
{
my ($self) = @_;
+ my @args = Common::Shared::string_split_commas $self->extract_bracketed_text;
- $self->extract_bracketed_text;
- # my $objOutputter = $$self{objOutputter};
+ if (@args < 2)
+ {
+ $self->fixed_error ('Too few parameters.');
+ }
- # if( !($self->check_for_eof()) )
- # {
- # return;
- # }
+ my $cxx_method_decl = shift @args;
+ my $c_signal_str = shift @args;
+ my $deprecated = 0;
+ my $refreturn = 0;
+ my $ifdef = undef;
+ my $dhs_disabled = 0;
+ my $custom_c_callback = 0;
+ my $custom_signal_handler = 0;
+ my $setup =
+ {
+ 'b(deprecated)' => \$deprecated,
+# TODO: probably obsolete, maybe inform that some annotation
+# TODO continued: could be added to C sources.
+ 'ob(refreturn)' => \$refreturn,
+ 's(ifdef)' => \$ifdef,
+ 'b(no_default_handler)' => \$dhs_disabled,
+ 'b(custom_c_callback)' => \$custom_c_callback,
+ 'b(custom_signal_handler)' => \$custom_signal_handler
+ };
- # my $filename = $$self{filename};
- # my $line_num = $$self{line_num};
+ $self->_handle_get_args_results (Common::Shared::get_args \ args, $setup);
- # my $str = $self->extract_bracketed_text();
- # my @args = string_split_commas($str);
+ if ($c_signal_str =~ /_/ or $c_signal_str !~ /$".*"^/)
+ {
+ $self->fixed_warning ('Second parameter should be like C string (in double quotes) with dashes instead of underlines - e.g. "activate-link".');
+ }
- # my $entity_type = "method";
+ $c_signal_str =~ s/_/-/g;
+ $c_signal_str =~ s/"//g;
- # if (!$$self{in_class})
- # {
- # print STDERR "$filename:$line_num:_WRAP_CTOR macro encountered outside class\n";
- # return;
- # }
+ my $c_signal_name = $c_signal_str;
- # my $objCfunc;
- # my $objCppfunc;
+ $c_signal_name =~ s/-/_/g;
- # # handle first argument
- # my $argCppMethodDecl = $args[0];
- # if ($argCppMethodDecl !~ m/\S/s)
- # {
- # print STDERR "$filename:$line_num:_WRAP_CTOR: missing prototype\n";
- # return;
- # }
+ my $cxx_function = Common::CxxFunctionInfo->new_from_string ($cxx_method_decl);
+ my $gir_class = $self->_get_gir_class;
+
+ unless (defined $gir_class)
+ {
+ $self->fixed_error ('Macro outside class.');
+ }
- # #Parse the method decaration and build an object that holds the details:
- # $objCppfunc = &Function::new_ctor($argCppMethodDecl, $self);
+ my $gir_signal = $gir_class->get_g_glib_signal_by_name ($c_signal_str);
- # # handle second argument:
+ unless (defined $gir_signal)
+ {
+ $self->fixed_error ('No such signal: ' . $c_signal_str);
+ }
- # my $argCFunctionName = $args[1];
- # $argCFunctionName = Util::string_trim($argCFunctionName);
+ my $c_signal = Common::SignalInfo->new_from_gir ($gir_signal);
+ my $ret_transfer = $c_signal->get_return_transfer;
- # #Get the C function's details:
- # if ($argCFunctionName =~ m/^\S+$/s)
- # {
- # $objCfunc = GtkDefs::lookup_function($argCFunctionName); #c-name. e.g. gtk_clist_set_column_title
- # if(!$objCfunc) #If the lookup failed:
- # {
- # $objOutputter->output_wrap_failed($argCFunctionName, "ctor defs lookup failed (2)");
- # return;
- # }
- # }
+# TODO: remove the ifs below after possible bugs in
+# TODO continued: wrappers/annotations are fixed.
+ if ($ret_transfer == Common::ConversionsStore::TRANSFER_FULL and $refreturn)
+ {
+ $self->fixed_warning ('refreturn given but annotation says that transfer is already full - which is wrong? (refreturn is ignored anyway.)');
+ }
+ elsif ($ret_transfer == Common::ConversionsStore::TRANSFER_NONE and not $refreturn)
+ {
+ $self->fixed_warning ('There is no refreturn, but annotation says that transfer is none - which is wrong? (refreturn would be ignored anyway.)');
+ }
- # $objOutputter->output_wrap_ctor($filename, $line_num, $objCppfunc, $objCfunc, $argCppMethodDecl);
+# TODO: Add custom_signal_handler.
+ Common::Output::Signal::output $self,
+ $ifdef,
+ $c_signal->get_return_type,
+ $ret_transfer,
+ $c_signal_name,
+ $c_signal->get_name,
+ $c_signal->get_param_types,
+ $c_signal->get_param_names,
+ $c_signal->get_param_transfers,
+ $cxx_function->get_return_type,
+ $cxx_function->get_name,
+ $cxx_function->get_param_types,
+ $cxx_function->get_param_names,
+ $custom_c_callback,
+ !$dhs_disabled;
}
-# TODO: implement it.
-sub on_implements_interface ($)
+sub _on_wrap_property ($)
{
my ($self) = @_;
+ my @args = Common::Shared::string_split_commas $self->extract_bracketed_text;
- $self->extract_bracketed_text;
- # if( !($self->check_for_eof()) )
- # {
- # return;
- # }
+ if (@args < 2)
+ {
+ $self->fixed_error ('Too few parameters.');
+ }
- # my $filename = $$self{filename};
- # my $line_num = $$self{line_num};
+ my $prop_c_name = shift @args;
+ my $prop_cpp_type = shift @args;
- # my $str = $self->extract_bracketed_text();
- # my @args = string_split_commas($str);
+ # Catch useless parameters.
+ $self->_handle_get_args_results (Common::Shared::get_args \ args, {});
- # # handle first argument
- # my $interface = $args[0];
+ if ($prop_c_name =~ /_/ or $prop_c_name !~ /$".*"^/)
+ {
+ $self->fixed_warning ('First parameter should be like C string (in double quotes) with dashes instead of underlines - e.g. "g-name-owner".');
+ }
- # # Extra stuff needed?
- # my $ifdef;
- # while($#args >= 1) # If the optional ref/err/deprecated arguments are there.
- # {
- # my $argRef = Util::string_trim(pop @args);
- # if($argRef =~ /^ifdef(.*)/) #If ifdef is at the start.
- # {
- # $ifdef = $1;
- # }
- # }
- # my $objOutputter = $$self{objOutputter};
- # $objOutputter->output_implements_interface($interface, $ifdef);
-}
+ $prop_c_name =~ s/_/-/g;
+ $prop_c_name =~ s/"//g;
-# TODO: implement it.
-sub on_wrap_create($)
-{
- my ($self) = @_;
+ my $prop_cpp_name = $prop_c_name;
- $self->extract_bracketed_text;
+ $prop_c_name =~ s/-/_/g;
- # if( !($self->check_for_eof()) )
- # {
- # return;
- # }
+ my $gir_class = $self->_get_gir_class;
- # my $str = $self->extract_bracketed_text();
+ unless ($gir_class)
+ {
+ $self->fixed_error ('Outside Glib::Object subclass.');
+ }
- # my $objOutputter = $$self{objOutputter};
- # $objOutputter->output_wrap_create($str, $self);
+ my $gir_property = $gir_class->get_g_property_by_name ($prop_c_name);
+
+ unless ($gir_property)
+ {
+ $self->fixed_error ('No such property in gir: "' . $prop_c_name . '".');
+ }
+
+ my $construct_only = $gir_property->get_a_construct_only;
+ my $readable = $gir_property->get_a_readable;
+ my $writable = $gir_property->get_a_writable;
+# TODO: probably not needed.
+ my $transfer = $gir_property->get_a_transfer_ownership;
+ my $read_only = 0;
+ my $write_only = 0;
+
+ if ($construct_only and not $readable)
+ {
+ $self->fixed_error ('Tried to wrap write-only and construct-only property');
+ }
+
+ Common::Output::Property::output $self,
+ $construct_only,
+ $readable,
+ $writable,
+ $prop_cpp_type,
+ $prop_cpp_name,
+ $prop_c_name;
}
-# TODO: split the common part from it and make two methods with merging doxycomment and without it. Implement it actually.
-sub on_wrap_signal($)
+sub _on_wrap_vfunc ($)
{
my ($self) = @_;
+ my @args = Common::Shared::string_split_commas $self->extract_bracketed_text;
- $self->extract_bracketed_text;
- # my ($self, $merge_doxycomment_with_previous) = @_;
+ if (@args < 2)
+ {
+ $self->fixed_error ('Too few parameters.');
+ }
- # if( !($self->check_for_eof()) )
- # {
- # return;
- # }
+ my $cxx_method_decl = shift @args;
+ my $c_vfunc_name = shift @args;
- # my $str = $self->extract_bracketed_text();
- # my @args = string_split_commas($str);
+ if ($c_vfunc_name !~ /^\w+$/)
+ {
+ $self->fixed_warning ('Second parameter should be like a name of C vfunc. No dashes, no double quotes.');
+ }
+
+ $c_vfunc_name =~ s/-/_/g;
+ $c_vfunc_name =~ s/"//g;
+
+ my $deprecated = 0;
+ my $refreturn = 0;
+ my $errthrow = 0;
+ my $ifdef = undef;
+ my $custom_vfunc = 0;
+ my $custom_vfunc_callback = 0;
+ my $setup =
+ {
+ 'b(deprecated)' => \$deprecated,
+# TODO: probably obsolete, maybe inform that some annotation
+# TODO continued: could be added to C sources.
+ 'ob(refreturn)' => \$refreturn,
+ 'ob(refreturn_ctype)' => undef,
+ 'ob(errthrow)' => $errthrow,
+ 's(ifdef)' => \$ifdef,
+ 'b(custom_vfunc)' => \$custom_vfunc,
+ 'b(custom_vfunc_callback)' => \$custom_vfunc_callback
+ };
- # #Get the arguments:
- # my $argCppDecl = $args[0];
- # my $argCName = $args[1];
- # $argCName = Util::string_trim($argCName);
- # $argCName = Util::string_unquote($argCName);
+ $self->_handle_get_args_results (Common::Shared::get_args \ args, $setup);
- # my $bCustomDefaultHandler = 0;
- # my $bNoDefaultHandler = 0;
- # my $bCustomCCallback = 0;
- # my $bRefreturn = 0;
- # my $ifdef;
+ my $cxx_function = Common::CxxFunctionInfo->new_from_string ($cxx_method_decl);
+ my $gir_class = $self->_get_gir_class;
- # while($#args >= 2) # If optional arguments are there.
- # {
- # my $argRef = Util::string_trim(pop @args);
- # if($argRef eq "custom_default_handler")
- # {
- # $bCustomDefaultHandler = 1;
- # }
+ unless (defined $gir_class)
+ {
+ $self->fixed_error ('Macro outside Glib::Object subclass.');
+ }
- # if($argRef eq "no_default_handler")
- # {
- # $bNoDefaultHandler = 1;
- # }
+ my $gir_vfunc = $gir_class->get_g_virtual_method_by_name ($c_vfunc_name);
- # if($argRef eq "custom_c_callback")
- # {
- # $bCustomCCallback = 1;
- # }
+ unless (defined $gir_vfunc)
+ {
+ $self->fixed_error ('No such virtual method: ' . $c_vfunc_name);
+ }
- # if($argRef eq "refreturn")
- # {
- # $bRefreturn = 1;
- # }
+ my $c_vfunc = Common::CFunctionInfo->new_from_gir ($gir_vfunc);
+ my $ret_transfer = $c_vfunc->get_return_transfer;
+ my $throws = $c_vfunc->get_throws;
- # elsif($argRef =~ /^ifdef(.*)/) #If ifdef is at the start.
- # {
- # $ifdef = $1;
- # }
- # }
+# TODO: remove the ifs below after possible bugs in
+# TODO continued: wrappers/annotations are fixed.
+ if ($ret_transfer == Common::ConversionsStore::TRANSFER_FULL and $refreturn)
+ {
+ $self->fixed_warning ('refreturn given but annotation says that transfer is already full - which is wrong? (refreturn is ignored anyway.)');
+ }
+ elsif ($ret_transfer == Common::ConversionsStore::TRANSFER_NONE and not $refreturn)
+ {
+ $self->fixed_warning ('There is no refreturn, but annotation says that transfer is none - which is wrong? (refreturn would be ignored anyway.)');
+ }
+ if (not $throws and $errthrow)
+ {
+ $self->fixed_warning ('errthrow given but annotation says that no error here is thrown - which is wrong? (errthrow is ignored anyway.)');
+ }
+ elsif ($throws and not $errthrow)
+ {
+ $self->fixed_warning ('There is no errthrow but annotation says that an error can be thrown here - which is wrong? (errthrow would be ignored anyway.)');
+ }
- # $self->output_wrap_signal($argCppDecl, $argCName, $$self{filename}, $$self{line_num},
- # $bCustomDefaultHandler, $bNoDefaultHandler, $bCustomCCallback,
- # $bRefreturn, $ifdef, $merge_doxycomment_with_previous);
+ Common::Output::VFunc::output $self,
+ $ifdef,
+ $c_vfunc->get_return_type,
+ $ret_transfer,
+ $c_vfunc->get_name,
+ $c_vfunc->get_param_types,
+ $c_vfunc->get_param_names,
+ $c_vfunc->get_param_transfers,
+ $cxx_function->get_return_type,
+ $cxx_function->get_name,
+ $cxx_function->get_param_types,
+ $cxx_function->get_param_names,
+ $cxx_function->get_const,
+ $custom_vfunc,
+ $custom_vfunc_callback,
+ $throws;
}
-# TODO: implement it.
-# void on_wrap_vfunc()
-sub on_wrap_vfunc($)
+sub _on_wrap_ctor ($)
{
my ($self) = @_;
+ my @args = Common::Shared::string_split_commas $self->extract_bracketed_text;
- $self->extract_bracketed_text;
+ if (@args < 2)
+ {
+ $self->fixed_error ('Too few parameters.');
+ }
- # if( !($self->check_for_eof()) )
- # {
- # return;
- # }
+ my $cxx_method_decl = shift @args;
+ my $c_constructor_name = shift @args;
- # my $str = $self->extract_bracketed_text();
- # my @args = string_split_commas($str);
+ # Catch useless parameters.
+ $self->_handle_get_args_results (Common::Shared::get_args \ args, {});
- # #Get the arguments:
- # my $argCppDecl = $args[0];
- # my $argCName = $args[1];
- # $argCName = Util::string_trim($argCName);
- # $argCName = Util::string_unquote($argCName);
+ my $cxx_function = Common::CxxFunctionInfo->new_from_string ($cxx_method_decl);
+ my $gir_class = $self->_get_gir_class;
- # my $refreturn = 0;
- # my $refreturn_ctype = 0;
- # my $custom_vfunc = 0;
- # my $custom_vfunc_callback = 0;
- # my $ifdef = "";
+ unless (defined $gir_class)
+ {
+ $self->fixed_error ('Macro outside Glib::Object subclass.');
+ }
- # while($#args >= 2) # If optional arguments are there.
- # {
- # my $argRef = Util::string_trim(pop @args);
+ my $gir_constructor = $gir_class->get_g_constructor_by_name ($c_constructor_name);
- # # Extra ref needed?
- # if($argRef eq "refreturn")
- # {
- # $refreturn = 1;
- # }
- # elsif($argRef eq "refreturn_ctype")
- # {
- # $refreturn_ctype = 1;
- # }
- # elsif($argRef eq "custom_vfunc")
- # {
- # $custom_vfunc = 1;
- # }
- # elsif($argRef eq "custom_vfunc_callback")
- # {
- # $custom_vfunc_callback = 1;
- # }
- # elsif($argRef =~ /^ifdef(.*)/) #If ifdef is at the start.
- # {
- # $ifdef = $1;
- # }
- # }
+ unless (defined $gir_constructor)
+ {
+ $self->fixed_error ('No such constructor: ' . $c_constructor_name);
+ }
+
+ my $c_constructor = Common::CFunctionInfo->new_from_gir ($gir_constructor);
+ my $c_param_names = $c_constructor->get_param_names;
+ my $cxx_param_names = $cxx_function->get_param_names;
+ my @c_prop_names = ();
+
+ die if scalar(@{$c_param_names}) != scalar(@{$cxx_param_names});
+ if (@{$c_param_names})
+ {
+ @c_prop_names = map { $self->get_prop_name ($gir_class, $c_param_names->[$_], $cxx_param_names->[$_]) } 0 .. @{$c_param_names};
+ }
- # $self->output_wrap_vfunc($argCppDecl, $argCName, $$self{filename}, $$self{line_num},
- # $refreturn, $refreturn_ctype, $custom_vfunc,
- # $custom_vfunc_callback, $ifdef);
+ Common::Output::Ctor::wrap_ctor $self,
+ $c_constructor->get_param_types,
+ $c_constructor->get_param_transfers,
+ \ c_prop_names,
+ $cxx_function->get_param_types,
+ $cxx_function->get_param_names;
}
-sub extract_members ($$)
+sub _on_wrap_create ($)
{
- my ($object, $substs) = @_;
- my $member_count = $object->get_g_member_count;
- my @all_members = ();
+ my ($self) = @_;
+ my $params = Common::Shared::parse_params $self->extract_bracketed_text;
+ my $types = [];
+ my $names = [];
- for (my $iter = 0; $iter < $member_count; ++$iter)
+ foreach my $param (@{$params})
{
- my $member = $object->get_g_member_by_index ($iter);
- my $name = uc $member->get_a_name;
- my $value = $member->get_a_value;
-
- foreach my $pair (@{$substs})
- {
- $name =~ s#$pair->[0]#$pair->[1]#;
- $value =~ s#$pair->[0]#$pair->[1]#;
- }
- push @all_members, [$name, $value];
+ push @{$types}, $param->{'type'};
+ push @{$names}, $param->{'name'};
}
- return \ all_members;
-}
-
-#TODO: implement beautifying if I am really bored.
-sub convert_members_to_strings($)
-{
- my ($members) = @_;
- my @strings = ();
-
- foreach my $pair (@{$members})
- {
- my $name = $pair->[0];
- my $value = $pair->[1];
-
- push @strings, ' ' . $name . ' = ' . $value;
- }
- return \ strings;
+ Common::Output::Ctor::wrap_create $self, $types, $names;
}
-sub on_wrap_enum($)
+sub _on_wrap_enum ($)
{
my ($self) = @_;
- my $repositories = $self->{'repositories'};
- my $module = $self->{'module'};
+ my $repositories = $self->get_repositories;
+ my $module = $self->get_module;
my $repository = $repositories->get_repository ($module);
my $namespace = $repository->get_g_namespace_by_name ($module);
+ my @args = Common::Shared::string_split_commas ($self->extract_bracketed_text);
- return unless $self->check_for_eof;
-
- # get the arguments
- my @args = string_split_commas ($self->extract_bracketed_text);
- my $cpp_type = Util::string_trim(shift @args);
- my $c_enum = Util::string_trim(shift @args);
- my $flags = 0;
- my $enum = $namespace->get_g_enumeration_by_name ($c_enum);
-
- unless (defined $enum)
+ if (@args < 2)
{
- $enum = $namespace->get_g_bitfield_by_name ($c_enum);
- $flags = 1;
- unless (defined $enum)
- {
- $self->error ('No enum or flags `' . $c_enum . '\' found.');
- }
+ $self->fixed_error ('Too few parameters.');
}
+ my $cpp_type = Common::Util::string_trim(shift @args);
+ my $c_type = Common::Util::string_trim(shift @args);
+ my @sed = ();
+ my $setup =
+ {
+ 'ob(NO_GTYPE)' => undef,
+ 'a(sed)' => \ sed,
+ 'os(get_type_func)' => undef,
+ };
+
+ $self->_handle_get_args_results (Common::Shared::get_args \ args, $setup);
+
my @substs = ();
- if (@args)
+ for my $subst (@sed)
{
- foreach my $arg (@args)
+ if ($subst =~ /^\s*s#([^#]+)#([^#]*)#\s*$/)
{
- if ($arg eq 'NO_GTYPE')
- {
- $self->warning ('NO_GTYPE parameter is deprecated.');
- }
- elsif ($arg =~ /^\s*s#([^#]+)#([^#]*)#\s*$/)
- {
- push @substs, [$1, $2];
- }
- elsif (/^\s*get_type_func=.*$/)
- {
- $self->warning ('get-type-func parameter is deprecated.');
- }
- else
- {
- $self->warning ('Unknown parameter passed to _WRAP_GERROR: `' . $arg . '\'.');
- }
+ push @substs, $subst;
+ }
+ else
+ {
+ $self->fixed_warning ('sed:Badly formed value - delimiters have to be hashes (#).');
}
}
+ my $flags = 0;
+ my $enum = $namespace->get_g_enumeration_by_name ($c_type);
+
unless (defined $enum)
{
- $self->error ('No enum `' . $c_enum . '\' found.');
+ $enum = $namespace->get_g_bitfield_by_name ($c_type);
+ $flags = 1;
+ unless (defined $enum)
+ {
+ $self->fixed_error ('No such enumeration or bitfield: `' . $c_type . '\'.');
+ }
}
my $gir_gtype = $enum->get_a_glib_get_type;
- my $members = extract_members ($enum, \ substs);
- my $string_members = convert_members_to_strings ($members);
- my $code_string = nl ('enum ' . $cpp_type) .
- nl ('{') .
- nl (join (nl (','), $string_members)) .
- nl ('};') .
- nl ();
-
- if ($flags)
- {
- $code_string .= nl ('inline ' . $cpp_type . ' operator|(' . $cpp_type . ' lhs, ' . $cpp_type . ' rhs)') .
- nl (' { return static_cast<' . $cpp_type . '>(static_cast<unsigned>(lhs) | static_cast<unsigned>(rhs)); }') .
- nl () .
- nl ('inline ' . $cpp_type . ' operator&(' . $cpp_type . ' lhs, ' . $cpp_type . ' rhs)') .
- nl (' { return static_cast<' . $cpp_type . '>(static_cast<unsigned>(lhs) & static_cast<unsigned>(rhs)); }') .
- nl () .
- nl ('inline ' . $cpp_type . ' operator^(' . $cpp_type . ' lhs, ' . $cpp_type . ' rhs)') .
- nl ('{ return static_cast<' . $cpp_type . '>(static_cast<unsigned>(lhs) ^ static_cast<unsigned>(rhs)); }') .
- nl () .
- nl ('inline ' . $cpp_type . ' operator~(' . $cpp_type . ' flags)') .
- nl (' { return static_cast<' . $cpp_type . '>(~static_cast<unsigned>(flags)); }') .
- nl () .
- nl ('inline ' . $cpp_type . '& operator|=(' . $cpp_type . '& lhs, ' . $cpp_type . ' rhs)') .
- nl (' { return (lhs = static_cast<' . $cpp_type . '>(static_cast<unsigned>(lhs) | static_cast<unsigned>(rhs))); }') .
- nl () .
- nl ('inline ' . $cpp_type . '& operator&=(' . $cpp_type . '& lhs, ' . $cpp_type . ' rhs)') .
- nl (' { return (lhs = static_cast<' . $cpp_type . '>(static_cast<unsigned>(lhs) & static_cast<unsigned>(rhs))); }') .
- nl () .
- nl ('inline ' . $cpp_type . '& operator^=(' . $cpp_type . '& lhs, ' . $cpp_type . ' rhs)') .
- nl (' { return (lhs = static_cast<' . $cpp_type . '>(static_cast<unsigned>(lhs) ^ static_cast<unsigned>(rhs))); }') .
- nl ();
+ my $members = _extract_members $enum, \ substs;
- }
+ Common::Output::Enum::output ($self, $cpp_type, $members, $flags, $gir_gtype);
+}
- my $namespaces = $self->{'namespace'};
- my $error_namespaces = $self->join_namespaces;
- my $full_cpp_type = join ('::', $error_namespaces, $cpp_type);
+sub _on_wrap_gerror ($)
+{
+ my ($self) = @_;
+ my $repositories = $self->get_repositories;
+ my $module = $self->get_module;
+ my $repository = $repositories->get_repository ($module);
+ my $namespace = $repository->get_g_namespace_by_name ($module);
+ my @args = Common::Shared::string_split_commas ($self->extract_bracketed_text);
- if (defined $gir_gtype)
+ if (@args < 2)
{
- my $close = 1;
-
- if (@{$namespaces} == 1 and $namespaces->[0] eq 'Glib')
- {
- $close = 0;
- }
-
- if ($close)
- {
- $code_string .= Common::Output::Shared::close_namespaces $self->get_namespaces;
- }
+ $self->fixed_error ('Too few parameters.');
+ }
- my $value_base = 'Glib::Value_';
+ my $cpp_type = Common::Util::string_trim (shift @args);
+ my $c_type = Common::Util::string_trim (shift @args);
+ my $enum = $namespace->get_g_enumeration_by_name ($c_type);
- if ($flags)
- {
- $value_base .= 'Flags';
- }
- else
- {
- $value_base .= 'Enum';
- }
- $code_string .= nl (Common::Output::Shared::doxy_skip_begin) .
- nl ('namespace Glib') .
- nl ('{') .
- nl () .
- nl ('template <>') .
- nl ('class Value< ' . $full_cpp_type . ' > : public ' . $value_base . '< ' . $full_cpp_type . '> ') .
- nl ('{') .
- nl ('public:') .
- nl (' static GType value_type() G_GNUC_CONST;') .
- nl ('};') .
- nl () .
- nl ('} // namespace Glib') .
- nl (Common::Output::Shared::doxy_skip_end) .
- nl ();
+ if (@args)
+ {
+ my $arg = $args[0];
- if ($close)
+ if ($arg ne 'NO_GTYPE' and $arg !~ /^\s*s#[^#]+#[^#]*#\s*$/ and $arg !~ /^\s*get_type_func=.*$/)
{
- $code_string .= Common::Output::Shared::open_namespaces $self->get_namespaces;
+ $self->fixed_warning ('Domain parameter is deprecated.');
+ shift @args;
}
}
- my $section_manager = $self->{'section_manager'};
-
- $section_manager->append_string_to_section ($code_string, Common::SectionManager::SECTION_H);
-
- if (defined $gir_gtype)
+ my @sed = ();
+ my $setup =
{
- $code_string = nl ('// static') .
- nl ('GType Glib::Value< ' . $full_cpp_type . ' >::value_type()') .
- nl ('{') .
- nl (' return ' . $gir_gtype . '();') .
- nl ('}') .
- nl ();
- $section_manager->append_string_to_section ($code_string, 'SECTION_CCG_END');
- }
-}
-
-sub on_wrap_gerror ($)
-{
- my ($self) = @_;
- my $repositories = $self->{'repositories'};
- my $module = $self->{'module'};
- my $repository = $repositories->get_repository ($module);
- my $namespace = $repository->get_g_namespace_by_name ($module);
+ 'ob(NO_GTYPE)' => undef,
+ 'a(sed)' => \ sed,
+ 'os(get_type_func)' => undef,
+ };
- return unless $self->check_for_eof;
+ $self->_handle_get_args_results (Common::Shared::get_args \ args, $setup);
- # get the arguments
- my @args = string_split_commas ($self->extract_bracketed_text);
- my $cpp_type = Util::string_trim(shift @args);
- my $c_enum = Util::string_trim(shift @args);
- my $enum = $namespace->get_g_enumeration_by_name ($c_enum);
my @substs = ();
- if (@args)
+ for my $subst (@sed)
{
- my $first_iteration = 1;
-
- foreach my $arg (@args)
+ if ($subst =~ /^\s*s#([^#]+)#([^#]*)#\s*$/)
{
- if ($arg eq 'NO_GTYPE')
- {
- $self->warning ('NO_GTYPE parameter is deprecated.');
- }
- elsif ($arg =~ /^\s*s#([^#]+)#([^#]*)#\s*$/)
- {
- push @substs, [$1, $2];
- }
- elsif (/^\s*get_type_func=.*$/)
- {
- $self->warning ('get-type-func parameter is deprecated.');
- }
- elsif ($first_iteration)
- {
- $self->warning ('Domain parameter is deprecated.');
- }
- else
- {
- $self->warning ('Unknown parameter passed to _WRAP_GERROR: `' . $arg . '\'.');
- }
- $first_iteration = 0;
+ push @substs, $subst;
+ }
+ else
+ {
+ $self->fixed_warning ('sed:Badly formed value - delimiters have to be hashes (#).');
}
}
unless (defined $enum)
{
- $self->error ('No enum `' . $c_enum . '\' found.');
+ $self->fixed_error ('No such enumeration: `' . $c_type . '\'.');
}
my $gir_gtype = $enum->get_a_glib_get_type;
my $gir_domain = $enum->get_a_glib_error_domain;
- my $members = extract_members ($enum, \ substs);
- my $string_members = convert_members_to_strings ($members);
- my $code_string = nl ('class ' . $cpp_type . ' : public Glib:error') .
- nl ('{') .
- nl ('public:') .
- nl (' enum Code') .
- nl (' {') .
- nl (join nl (','), @{$string_members}) .
- nl (' };') .
- nl () .
- nl (' ' . $cpp_type . '(Code error_code, const Glib::ustring& error_message);') .
- nl (' explicit ' . $cpp_type . '(GError* gobject);') .
- nl (' Code code() const;') .
- nl () .
- nl (Common::Output::Shared::doxy_skip_begin) .
- nl ('private:') .
- nl () .
- nl (' static void throw_func(GError* gobject);') .
- nl () .
- nl (' friend void wrap_init(); // uses throw_func()') .
- nl (Common::Output::Shared::doxy_skip_end) .
- nl ('};') .
- nl ();
-
- my $error_namespaces = $self->join_namespaces;
- my $full_cpp_type = join ('::', $error_namespaces, $cpp_type);
-
- if (defined $gir_gtype)
- {
- my $namespaces = $self->{'namespace'};
- my $close = 1;
- if (@{$namespaces} == 1 and $namespaces->[0] eq 'Glib')
- {
- $close = 0;
- }
-
- if ($close)
- {
- $code_string .= Common::Output::Shared::close_namespaces $self->get_namespaces;
- }
-
- $code_string .= nl (Common::Output::Shared::doxy_skip_begin) .
- nl ('namespace Glib') .
- nl ('{') .
- nl () .
- nl ('template <>') .
- nl ('class Value< ' . $full_cpp_type . '::Code > : public Glib::Value_Enum< ' . $full_cpp_type . '::Code >') .
- nl ('{') .
- nl ('public:') .
- nl (' static GType value_type() G_GNUC_CONST;') .
- nl ('};') .
- nl () .
- nl ('} // namespace Glib') .
- nl (Common::Output::Shared::doxy_skip_end) .
- nl ();
-
- if ($close)
- {
- $code_string .= Common::Output::Shared::open_namespaces $self->get_namespaces;
- }
- }
-
- my $section_manager = $self->{'section_manager'};
-
- $section_manager->append_string_to_section ($code_string, Common::SectionManager::SECTION_H);
- $code_string = nl ($full_cpp_type . '::' . $cpp_type . '(' . $full_cpp_type . '::Code error_code, const Glib::ustring& error_message)') .
- nl (':') .
- nl (' Glib::Error(g_quark_from_static_string ("' . $gir_domain . '"), error_code, error_message)') .
- nl ('{}') .
- nl () .
- nl ($full_cpp_type . '::' . $cpp_type . '(GError* gobject)') .
- nl (':') .
- nl (' Glib::Error(gobject)') .
- nl ('{}') .
- nl () .
- nl ($full_cpp_type . '::Code ' . $full_cpp_type . '::code() const') .
- nl ('{') .
- nl (' return static_cast<Code>(Glib::Error::code());') .
- nl ('}') .
- nl () .
- nl ('// static') .
- nl ('void ' . $full_cpp_type . '::throw_func(GError* gobject)') .
- nl ('{') .
- nl (' throw ' . $full_cpp_type . '(gobject);') .
- nl ('}') .
- nl ();
-
- if (defined $gir_gtype)
- {
- $code_string .= nl ('// static') .
- nl ('GType Glib::Value< ' . $full_cpp_type . '::Code >::value_type()') .
- nl ('{') .
- nl (' return ' . $gir_gtype . '();') .
- nl ('}') .
- nl ();
- }
-
- $section_manager->append_string_to_section ($code_string, 'SECTION_CCG_END');
-}
-
-# TODO: implement it.
-sub on_wrap_property($)
-{
- my ($self) = @_;
-
- $self->extract_bracketed_text;
- # my $objOutputter = $$self{objOutputter};
-
- # return unless ($self->check_for_eof());
-
- # my $str = $self->extract_bracketed_text();
- # my @args = string_split_commas($str);
+ my $members = _extract_members $enum, \ substs;
- # #Get the arguments:
- # my $argPropertyName = $args[0];
- # $argPropertyName = Util::string_trim($argPropertyName);
- # $argPropertyName = Util::string_unquote($argPropertyName);
-
- # #Convert the property name to a canonical form, as it is inside gobject.
- # #Otherwise, gobject might not recognise the name,
- # #and we will not recognise the property name when we get notification that the value changes.
- # $argPropertyName =~ tr/_/-/;
-
- # my $argCppType = $args[1];
- # $argCppType = Util::string_trim($argCppType);
- # $argCppType = Util::string_unquote($argCppType);
-
- # my $filename = $$self{filename};
- # my $line_num = $$self{line_num};
-
- # $objOutputter->output_wrap_property($filename, $line_num, $argPropertyName, $argCppType, $$self{c_class});
+ Common::Output::GError::output $self, $cpp_type, $members, $gir_domain, $gir_gtype;
}
-# TODO: either remove it or make use of it in every _WRAP macro specific for class.
-sub output_wrap_check($$$$$$)
+sub _on_implements_interface ($)
{
- my ($self, $CppDecl, $signal_name, $filename, $line_num, $macro_name) = @_;
-
- #Some checks:
+ my ($self) = @_;
+ my @args = Common::Shared::string_split_commas $self->extract_bracketed_text;
- unless ($self->{'in_class'})
- {
- $self->error ($macro_name . 'macro encountered outside class');
- }
- if ($CppDecl !~ m/\S/s)
+ if (@args < 2)
{
- $self->error ($macro_name . ': missing prototype');
+ $self->fixed_error ('Too few parameters.');
}
- return 0;
-}
-
-# TODO: we probably won't need this.
-# void output_wrap($CppDecl, $signal_name, $filename, $line_num, $bCustomDefaultHandler, $bNoDefaultHandler, $bCustomCCallback, $bRefreturn)
-# sub output_wrap_signal($$$$$$$$$)
-# {
-# my ($self, $CppDecl, $signal_name, $filename, $line_num, $bCustomDefaultHandler, $bNoDefaultHandler, $bCustomCCallback, $bRefreturn, $ifdef, $merge_doxycomment_with_previous) = @_;
-
-# #Some checks:
-# return if ($self->output_wrap_check($CppDecl, $signal_name,
-# $filename, $line_num, "_WRAP_SIGNAL"));
-# # handle first argument
-
-# #Parse the method declaration and build an object that holds the details:
-# my $objCppSignal = &Function::new($CppDecl, $self);
-# $$objCppSignal{class} = $$self{class}; #Remember the class name for use in Outputter::output_wrap_signal().
-
-# # handle second argument:
-# my $objCSignal = undef;
-
-# my $objOutputter = $$self{objOutputter};
-
-# #Get the c function's details:
-# if ($signal_name ne '')
-# {
-# $objCSignal = GtkDefs::lookup_signal($$self{c_class}, $signal_name);
-
-# # Check for failed lookup.
-# if($objCSignal eq 0)
-# {
-# print STDERR "$signal_name\n";
-# $objOutputter->output_wrap_failed($signal_name,
-# " signal defs lookup failed");
-# return;
-# }
-# }
-
-# $objOutputter->output_wrap_sig_decl($filename, $line_num, $objCSignal, $objCppSignal, $signal_name, $bCustomCCallback, $ifdef, $merge_doxycomment_with_previous);
-
-# if($bNoDefaultHandler eq 0)
-# {
-# $objOutputter->output_wrap_default_signal_handler_h($filename, $line_num, $objCppSignal, $objCSignal, $ifdef);
-
-# my $bImplement = 1;
-# if($bCustomDefaultHandler) { $bImplement = 0; }
-# $objOutputter->output_wrap_default_signal_handler_cc($filename, $line_num, $objCppSignal, $objCSignal, $bImplement, $bCustomCCallback, $bRefreturn, $ifdef);
-# }
-# }
-
-# TODO: we probably won't need this.
-# void output_wrap($CppDecl, $vfunc_name, $filename, $line_num, $refreturn, $refreturn_ctype,
-# $custom_vfunc, $custom_vfunc_callback, $ifdef)
-# sub output_wrap_vfunc($$$$$$$$)
-# {
-# my ($self, $CppDecl, $vfunc_name, $filename, $line_num, $refreturn, $refreturn_ctype,
-# $custom_vfunc, $custom_vfunc_callback, $ifdef) = @_;
-
-# #Some checks:
-# return if ($self->output_wrap_check($CppDecl, $vfunc_name, $filename, $line_num, '_WRAP_VFUNC'));
-
-# # handle first argument
-
-# #Parse the method declaration and build an object that holds the details:
-# my $objCppVfunc = &Function::new($CppDecl, $self);
-
-
-# # handle second argument:
-# my $objCVfunc = undef;
-
-# my $objOutputter = $$self{objOutputter};
-
-# #Get the c function's details:
-# if ($vfunc_name =~ m/^\S+$/s) # if it's not empty and contains no whitespace
-# {
-# $objCVfunc = GtkDefs::lookup_signal($$self{c_class},$vfunc_name);
-# if(!$objCVfunc) #If the lookup failed:
-# {
-# $objOutputter->output_wrap_failed($vfunc_name, " vfunc defs lookup failed");
-# return;
-# }
-# }
-
-# # Write out the appropriate macros.
-# # These macros are defined in vfunc.m4:
-
-# $$objCppVfunc{rettype_needs_ref} = $refreturn;
-# $$objCppVfunc{name} .= "_vfunc"; #All vfuncs should have the "_vfunc" suffix, and a separate easily-named invoker method.
-
-# $$objCVfunc{rettype_needs_ref} = $refreturn_ctype;
-
-# $objOutputter->output_wrap_vfunc_h($filename, $line_num, $objCppVfunc, $objCVfunc, $ifdef);
-# $objOutputter->output_wrap_vfunc_cc($filename, $line_num, $objCppVfunc, $objCVfunc,
-# $custom_vfunc, $custom_vfunc_callback, $ifdef);
-# }
-
-# TODO: what it is for? Remove it.
-# give some sort of weights to sorting attibutes
-# sub byattrib()
-# {
-# my %attrib_value = (
-# "virtual_impl" ,1,
-# "virtual_decl" ,2,
-# # "sig_impl" ,3,
-# "sig_decl" ,4,
-# "meth" ,5
-# );
+ my $interface = shift @args;
+ my $ifdef = undef;
+ my $setup =
+ {
+ 's(ifdef)' => \$ifdef
+ };
-# # $a and $b are hidden parameters to a sorting function
-# return $attrib_value{$b} <=> $attrib_value{$a};
-# }
+ $self->_handle_get_args_results (Common::Shared::get_args \ args, $setup);
+ Common::Output::GObject::implements_interface $self, $interface, $ifdef;
+}
-# TODO: probably implement this. I am not sure.
-# void on_wrap_corba_method()
-sub on_wrap_corba_method($)
+sub _on_class_generic ($)
{
my ($self) = @_;
+ my @args = Common::Shared::string_split_commas $self->extract_bracketed_text;
- $self->extract_bracketed_text;
- # my $objOutputter = $$self{objOutputter};
-
- # return unless ($self->check_for_eof());
-
- # my $filename = $$self{filename};
- # my $line_num = $$self{line_num};
-
- # my $str = $self->extract_bracketed_text();
- # my @args = string_split_commas($str);
-
- # my $entity_type = "method";
-
- # if (!$$self{in_class})
- # {
- # print STDERR "$filename:$line_num:_WRAP macro encountered outside class\n";
- # return;
- # }
-
- # my $objCppfunc;
+ if (@args < 2)
+ {
+ $self->fixed_error ('Too few parameters.');
+ }
- # # handle first argument
- # my $argCppMethodDecl = $args[0];
- # if ($argCppMethodDecl !~ m/\S/s)
- # {
- # print STDERR "$filename:$line_num:_WRAP_CORBA_METHOD: missing prototype\n";
- # return;
- # }
+ my $cpp_type = shift @args;
+ my $c_type = shift @args;
- # # Parse the method decaration and build an object that holds the details:
- # $objCppfunc = &Function::new($argCppMethodDecl, $self);
- # $objOutputter->output_wrap_corba_method($filename, $line_num, $objCppfunc);
-}
+ # Catch useless parameters.
+ $self->_handle_get_args_results (Common::Shared::get_args \ args, {});
-sub on_insert_section ($)
-{
- my ($self) = @_;
- my $section_manager = $self->{'section_manager'};
- my $main_section = $self->{'main_section'};
- my $str = Util::string_trim $self->extract_bracketed_text;
+ my $repositories = $self->get_repositories;
+ my $module = $self->get_module;
+ my $repository = $repositories->get_repository ($module);
- $section_manager->append_section_to_section ($str, $main_section);
-}
+ unless (defined $repository)
+ {
+ $self->fixed_error ('No such repository: ' . $module);
+ }
-sub on_class_generic ($)
-{
- my ($self) = @_;
- my @args = string_split_commas $self->extract_bracketed_text;
+ my $namespace = $repository->get_g_namespace_by_name ($module);
- if (@args < 2)
+ unless (defined $namespace)
{
- $self->error ('Too few parameters for _CLASS_GENERIC');
+ $self->fixed_error ('No such namespace: ' . $module);
}
- elsif (@args > 2)
+
+ my $gir_record = $namespace->get_g_record_by_name ($c_type);
+
+ unless (defined $gir_record)
{
- $self->warning ('Superfluous parameters in _CLASS_GENERIC will be ignored.');
+ $self->fixed_error ('No such record: ' . $c_type);
+# TODO: should we check also other things? like Union or Glib::Boxed?
}
- my ($cpp_type, $c_type) = @args;
- my $code_string = nl ('public:') .
- nl (Common::Output::Shared::doxy_skip_begin) .
- nl (' typedef ' . $cpp_type . ' CppObjectType;') .
- nl (' typedef ' . $c_type . ' BaseObjectType;') .
- nl (Common::Output::Shared::doxy_skip_end) .
- nl () .
- nl ('private:') .
- nl ();
- my $section_manager = $self->{'section_manager'};
- my $main_section = $self->{'main_section'};
+ $self->push_gir_record ($gir_record);
- $section_manager->append_string_to_section ($code_string, $main_section);
+ Common::Output::Generic::output ($self, $c_type, $cpp_type);
}
-sub on_class_gobject ($)
+sub _on_class_g_object ($)
{
my ($self) = @_;
- my $section_manager = $self->{'section_manager'};
- my $main_section = $self->{'main_section'};
- my $line_num = $self->{'line_num'};
- my @args = string_split_commas $self->extract_bracketed_text;
+ my @args = Common::Shared::string_split_commas $self->extract_bracketed_text;
if (@args > 2)
{
- $self->warning_with_loc ($line_num, 'Last ' . @args - 2 . ' parameters are deprecated.');
+ $self->fixed_warning ('Last ' . @args - 2 . ' parameters are deprecated.');
}
- my $repositories = $self->{'repositories'};
- my $module = $self->{'module'};
+ my $repositories = $self->get_repositories;
+ my $module = $self->get_module;
my $repository = $repositories->get_repository ($module);
unless (defined $repository)
{
- $self->error_with_loc ($line_num, 'No such repository: ' . $module);
+ $self->fixed_error ('No such repository: ' . $module);
}
my $namespace = $repository->get_g_namespace_by_name ($module);
unless (defined $namespace)
{
- $self->error_with_loc ($line_num, 'No such namespace: ' . $module);
+ $self->fixed_error ('No such namespace: ' . $module);
}
- my $gir_prefix = $namespace->get_a_c_identifier_prefixes;
- my ($cpp_type, $c_type) = @_;
+ my $cpp_type = shift @args;
+ my $c_type = shift @args;
my $gir_class = $namespace->get_g_class_by_name ($c_type);
unless (defined $gir_class)
{
- $self->error_with_loc ($line_num, 'No such class: ' . $c_type);
+ $self->fixed_error ('No such class: ' . $c_type);
}
my $get_type_func = $gir_class->get_a_glib_get_type;
unless (defined $get_type_func)
{
- $self->error_with_loc ($line_num, 'Class `' . $c_type . '\' has no get-type function.');
+ $self->fixed_error ('Class `' . $c_type . '\' has no get type function.');
}
my $gir_parent = $gir_class->get_a_parent;
unless (defined $gir_parent)
{
- $self->error_with_loc ($line_num, 'Class `' . $c_type . '\' has no parent (you are not wrapping GObject, are you?).');
+ $self->fixed_error ('Class `' . $c_type . '\' has no parent. (you are not wrapping GObject, are you?)');
}
my $gir_type_struct = $gir_class->get_a_glib_type_struct;
unless (defined $gir_type_struct)
{
- $self->error_with_loc ($line_num, 'Class `' . $c_type . '\' has no Class struct.');
+ $self->fixed_error ('Class `' . $c_type . '\' has no Class struct.');
+ }
+
+ my @gir_prefixes = $namespace->get_a_c_identifier_prefixes;
+ my $c_class_type = undef;
+
+ foreach my $gir_prefix (@gir_prefixes)
+ {
+ my $temp_type = $gir_prefix . $gir_type_struct;
+
+ if (defined $namespace->get_g_record_by_name ($temp_type))
+ {
+ $c_class_type = $temp_type;
+ last;
+ }
+ }
+
+ unless (defined $c_class_type)
+ {
+ $self->fixed_error ('Could not find any type struct (' . $gir_type_struct . ').');
}
- my $c_type_class = $gir_prefix . $gir_type_struct;
- my $c_type_parent;
- my $c_type_parent_class;
+ my $c_parent_type = undef;
+ my $c_parent_class_type = undef;
# if parent is for example Gtk.Widget
if ($gir_parent =~ /^([^.]+)\.(.*)/)
{
my $gir_parent_module = $1;
- my $gir_parent_name = $2;
- my $parent_repository = $repositories=>get_repository ($gir_parent_module);
+ my $gir_parent_type = $2;
+ my $parent_repository = $repositories->get_repository ($gir_parent_module);
unless (defined $parent_repository)
{
- $self->error ('No such repository for parent: `' . $gir_parent_module . '\'.');
+ $self->fixed_error ('No such repository for parent: `' . $gir_parent_module . '\'.');
}
my $parent_namespace = $parent_repository->get_g_namespace_by_name ($gir_parent_module);
unless (defined $parent_namespace)
{
- $self->error ('No such namespace for parent: `' . $gir_parent_module . '\'.');
+ $self->fixed_error ('No such namespace for parent: `' . $gir_parent_module . '\'.');
}
- my $gir_parent_c_prefix = $parent_namespace->get_a_c_identifier_prefixes;
+ my @gir_parent_prefixes = split ',', $parent_namespace->get_a_c_identifier_prefixes;
+ my $gir_parent_class = undef;
+
+ foreach my $gir_parent_prefix (@gir_parent_prefixes)
+ {
+ my $temp_parent_type = $gir_parent_prefix . $gir_parent_type;
- $c_type_parent = $gir_parent_c_prefix . $gir_parent_name;
+ $gir_parent_class = $parent_namespace->get_g_class_by_name ($temp_parent_type);
- my $gir_parent_class = $parent_namespace->get_g_class_by_name ($c_type_parent);
+ if (defined $gir_parent_class)
+ {
+ $c_parent_type = $temp_parent_type;
+ last;
+ }
+ }
- unless (defined $gir_parent_class)
+ unless (defined $c_parent_type)
{
- $self->error_with_loc ($line_num, 'No such parent class in namespace: `' . $c_type_parent . '\.');
+ $self->fixed_error ('No such parent class in namespace: `' . $c_parent_type . '\.');
}
my $gir_parent_type_struct = $gir_parent_class->get_a_glib_type_struct;
unless (defined $gir_parent_type_struct)
{
- $self->error_with_loc ($line_num, 'Parent of `' . $c_type . '\', `' . $c_type_parent . '\' has not Class struct.');
+ $self->fixed_error ('Parent of `' . $c_type . '\', `' . $c_parent_type . '\' has not Class struct.');
+ }
+
+ for my $gir_parent_prefix (@gir_parent_prefixes)
+ {
+ my $temp_parent_class_type = $gir_parent_prefix . $gir_parent_type_struct;
+ my $gir_parent_class_struct = $namespace->get_g_record_by_name ($temp_parent_class_type);
+
+ if (defined $gir_parent_class_struct)
+ {
+ $c_parent_class_type = $temp_parent_class_type;
+ }
}
- $c_type_parent_class = $gir_parent_c_prefix . $gir_parent_type_struct;
+ unless (defined $c_parent_class_type)
+ {
+ $self->fixed_error ('Could not find type struct (' . $gir_parent_type_struct . ').');
+ }
}
else
{
- $c_type_parent = $gir_prefix . $gir_parent;
+ my $gir_parent_class = undef;
+
+ foreach my $gir_prefix (@gir_prefixes)
+ {
+ my $temp_parent_type = $gir_prefix . $gir_parent;
+
+ $gir_parent_class = $namespace->get_g_class_by_name ($temp_parent_type);
- my $gir_parent_class = $namespace->get_g_class_by_name ($c_type_parent);
+ if (defined $gir_parent_class)
+ {
+ $c_parent_type = $temp_parent_type;
+ last;
+ }
+ }
- unless (defined $gir_parent_class)
+ unless (defined $c_parent_type)
{
- $self->error_with_loc ($line_num, 'No such parent class in namespace: `' . $c_type_parent . '\.');
+ $self->fixed_error ('No such parent class in namespace: `' . $gir_parent . '\.');
}
my $gir_parent_type_struct = $gir_parent_class->get_a_glib_type_struct;
unless (defined $gir_parent_type_struct)
{
- $self->error_with_loc ($line_num, 'Parent of `' . $c_type . '\', `' . $c_type_parent . '\' has not Class struct.');
+ $self->fixed_error ('Parent of `' . $c_type . '\', `' . $c_parent_type . '\' has not Class struct.');
+ }
+
+ for my $gir_prefix (@gir_prefixes)
+ {
+ my $temp_parent_class_type = $gir_prefix . $gir_parent_type_struct;
+ my $gir_parent_class_struct = $namespace->get_g_record_by_name ($temp_parent_class_type);
+
+ if (defined $gir_parent_class_struct)
+ {
+ $c_parent_class_type = $temp_parent_class_type;
+ }
+ }
+
+ unless (defined $c_parent_class_type)
+ {
+ $self->fixed_error ('Could not find type struct (' . $gir_parent_type_struct . ').');
}
+ }
+
+ my $type_info_store = $self->get_type_info_store;
+ my $cpp_parent_type = $type_info_store->c_to_cpp ($c_parent_type);
+
+ $self->push_gir_class ($gir_class);
+ $self->push_c_class ($c_type);
+
+ Common::Output::GObject::output $self,
+ $c_type,
+ $c_class_type,
+ $c_parent_type,
+ $c_parent_class_type,
+ $get_type_func,
+ $cpp_type,
+ $cpp_parent_type;
+}
+
+# TODO: set current gir_class.
+sub _on_class_gtk_object ($)
+{
+
+}
+
+sub _on_class_boxed_type ($)
+{
+ my ($self) = @_;
+ my @args = Common::Shared::string_split_commas $self->extract_bracketed_text;
- $c_type_parent_class = $gir_prefix . $gir_parent_type_struct;
+ if (@args > 5)
+ {
+ $self->fixed_warning ('Last ' . @args - 5 . ' parameters are deprecated.');
}
- # TODO: write C <-> C++ name store.
- my $c_cpp_converter = $self->get_c_cpp_converter;
- my $cpp_type_parent = $c_cpp_converter->from_c_to_cpp ($c_type_parent);
+ my $repositories = $self->get_repositories;
+ my $module = $self->get_module;
+ my $repository = $repositories->get_repository ($module);
+
+ unless (defined $repository)
+ {
+ $self->fixed_error ('No such repository: ' . $module);
+ }
+
+ my $namespace = $repository->get_g_namespace_by_name ($module);
+
+ unless (defined $namespace)
+ {
+ $self->fixed_error ('No such namespace: ' . $module);
+ }
+
+ my ($cpp_type, $c_type, $new_func, $copy_func, $free_func) = @args;
+ my $gir_record = $namespace->get_g_record_by_name ($c_type);
+
+ unless (defined $gir_record)
+ {
+ $self->fixed_error ('No such record: ' . $c_type);
+ }
+
+ my $get_type_func = $gir_record->get_a_glib_get_type;
+
+ unless (defined $get_type_func)
+ {
+ $self->fixed_error ('Record `' . $c_type . '\' has no get type function.');
+ }
+
+# TODO: Check if we can support generating constructors with
+# TODO continued: several parameters also.
+ if (not defined $new_func or $new_func eq 'GUESS')
+ {
+ my $constructor_count = $gir_record->get_g_constructor_count;
+
+ $new_func = undef;
+ for (my $iter = 0; $iter < $constructor_count; ++$iter)
+ {
+ my $constructor = $gir_record->get_g_constructor_by_index ($iter);
+
+ unless ($constructor->get_g_parameters_count)
+ {
+ $new_func = $constructor->get_a_c_identifier;
+ last;
+ }
+ }
+ }
+
+ my @gir_prefixes = split ',', $namespace->get_a_c_symbol_prefixes;
+ my $record_prefix = $gir_record->get_a_c_symbol_prefix;
+
+ if (not defined $copy_func or $copy_func eq 'GUESS')
+ {
+ my $found_any = 0;
+
+ $copy_func = undef;
+ for my $prefix (@gir_prefixes)
+ {
+ for my $ctor_suffix ('copy', 'ref')
+ {
+ my $copy_ctor_name = join '_', $prefix, $record_prefix, $ctor_suffix;
+ my $copy_ctor = $gir_record->get_g_method_by_name ($copy_ctor_name);
+
+ if (defined $copy_ctor)
+ {
+ $found_any = 1;
+ unless ($copy_ctor->get_g_parameters_count)
+ {
+ $copy_func = $copy_ctor_name;
+ }
+ }
+ }
+ }
+
+ unless (defined $copy_func)
+ {
+ if ($found_any)
+ {
+ $self->fixed_error ('Found a copy/ref function, but its prototype was not the expected one. Please specify its name explicitly. Note that NONE is not allowed.');
+ }
+ else
+ {
+ $self->fixed_error ('Could not find any copy/ref function. Please specify its name explicitly. Note that NONE is not allowed.');
+ }
+ }
+ }
+ elsif ($copy_func ne 'NONE')
+ {
+ my $copy_ctor = $gir_record->get_g_method_by_name ($copy_func);
+
+ unless (defined $copy_ctor)
+ {
+ $self->fixed_error ('Could not find such copy/ref function in Gir file: `' . $copy_func . '\'.');
+ }
+ }
+ else
+ {
+ $self->fixed_error ('Copy/ref function can not be NONE.');
+ }
+
+ if (not defined $free_func or $free_func eq 'GUESS')
+ {
+ my $found_any = 0;
+
+ $free_func = undef;
+ for my $prefix (@gir_prefixes)
+ {
+ for my $dtor_suffix ('free', 'unref')
+ {
+ my $dtor_name = join '_', $prefix, $record_prefix, $dtor_suffix;
+ my $dtor = $gir_record->get_g_method_by_name ($dtor_name);
+
+ if (defined $dtor)
+ {
+ $found_any = 1;
+ unless ($dtor->get_g_parameters_count)
+ {
+ $free_func = $dtor_name;
+ }
+ }
+ }
+ }
+
+ unless (defined $free_func)
+ {
+ if ($found_any)
+ {
+ $self->fixed_error ('Found a free/unref function, but its prototype was not the expected one. Please specify its name explicitly. Note that NONE is not allowed.');
+ }
+ else
+ {
+ $self->fixed_error ('Could not find any free/unref function. Please specify its name explicitly. Note that NONE is not allowed.');
+ }
+ }
+ }
+ elsif ($free_func ne 'NONE')
+ {
+ my $dtor = $gir_record->get_g_method_by_name ($free_func);
+
+ unless (defined $dtor)
+ {
+ $self->fixed_error ('Could not find such free/unref in Gir file: `' . $free_func . '\'.');
+ }
+ }
+ else
+ {
+ $self->fixed_error ('Free/unref function can not be NONE.');
+ }
+
+ $self->push_gir_record ($gir_record);
+
+ Common::Output::BoxedType::output $self,
+ $c_type,
+ $cpp_type,
+ $get_type_func,
+ $new_func,
+ $copy_func,
+ $free_func;
+}
+
+sub _on_class_boxed_type_static ($)
+{
+ my ($self) = @_;
+ my @args = Common::Shared::string_split_commas $self->extract_bracketed_text;
+
+ if (@args > 2)
+ {
+ $self->fixed_warning ('Last ' . @args - 2 . ' parameters are useless.');
+ }
+
+ my $repositories = $self->get_repositories;
+ my $module = $self->get_module;
+ my $repository = $repositories->get_repository ($module);
+
+ unless (defined $repository)
+ {
+ $self->fixed_error ('No such repository: ' . $module);
+ }
+
+ my $namespace = $repository->get_g_namespace_by_name ($module);
+
+ unless (defined $namespace)
+ {
+ $self->fixed_error ('No such namespace: ' . $module);
+ }
+
+ my ($cpp_type, $c_type) = @args;
+ my $gir_record = $namespace->get_g_record_by_name ($c_type);
+
+ unless (defined $gir_record)
+ {
+ $self->fixed_error ('No such record: ' . $c_type);
+ }
+
+ my $get_type_func = $gir_record->get_a_glib_get_type;
+
+ unless (defined $get_type_func)
+ {
+ $self->fixed_error ('Record `' . $c_type . '\' has no get type function.');
+ }
+
+ $self->push_gir_record ($gir_record);
+
+ Common::Output::BoxedTypeStatic::output $self,
+ $c_type,
+ $cpp_type,
+ $get_type_func;
+}
+
+sub _on_class_interface ($)
+{
+ my ($self) = @_;
+ my @args = Common::Shared::string_split_commas $self->extract_bracketed_text;
+
+ if (@args > 2)
+ {
+ $self->fixed_warning ('Last ' . @args - 2 . ' parameters are deprecated.');
+ }
+
+ my $repositories = $self->get_repositories;
+ my $module = $self->get_module;
+ my $repository = $repositories->get_repository ($module);
+
+ unless (defined $repository)
+ {
+ $self->fixed_error ('No such repository: ' . $module);
+ }
+
+ my $namespace = $repository->get_g_namespace_by_name ($module);
+
+ unless (defined $namespace)
+ {
+ $self->fixed_error ('No such namespace: ' . $module);
+ }
+
+ my ($cpp_name, $c_name) = @args;
+ my $gir_class = $namespace->get_g_class_by_name ($c_name);
+
+ unless (defined $gir_class)
+ {
+ $self->fixed_error ('No such class: ' . $c_name);
+ }
+
+ my $get_type_func = $gir_class->get_a_glib_get_type;
+
+ unless (defined $get_type_func)
+ {
+ $self->fixed_error ('Class `' . $c_name . '\' has no get type function.');
+ }
+
+ my $prerequisite_count = $gir_class->get_g_prerequisite_count;
+ my $gir_parent = undef;
+
+ for (my $iter = 0; $iter < $prerequisite_count; ++$iter)
+ {
+ my $prerequisite = $gir_class->get_g_prerequisite_by_index ($iter);
+
+ if (defined $prerequisite)
+ {
+ my $prereq_name = $prerequisite->get_a_name;
+
+ if ($prereq_name ne "GObject.Object")
+ {
+ $gir_parent = $prereq_name;
+ }
+ }
+ }
+
+ unless (defined $gir_parent)
+ {
+ $gir_parent = 'GObject.Object';
+ }
+
+ my $gir_type_struct = $gir_class->get_a_glib_type_struct;
+
+ unless (defined $gir_type_struct)
+ {
+ $self->fixed_error ('Class `' . $c_name . '\' has no Iface struct.');
+ }
+
+ my @gir_prefixes = $namespace->get_a_c_identifier_prefixes;
+ my $c_class_name = undef;
+
+ foreach my $gir_prefix (@gir_prefixes)
+ {
+ my $temp_name = $gir_prefix . $gir_type_struct;
+
+ if (defined $namespace->get_g_record_by_name ($temp_name))
+ {
+ $c_class_name = $temp_name;
+ last;
+ }
+ }
+
+ unless (defined $c_class_name)
+ {
+ $self->fixed_error ('Could not find any type struct (' . $gir_type_struct . ').');
+ }
+
+ my $c_parent_name = undef;
+
+ # if parent is for example Gtk.Widget
+ if ($gir_parent =~ /^([^.]+)\.(.*)/)
+ {
+ my $gir_parent_module = $1;
+ my $gir_parent_name = $2;
+ my $parent_repository = $repositories=>get_repository ($gir_parent_module);
+
+ unless (defined $parent_repository)
+ {
+ $self->fixed_error ('No such repository for parent: `' . $gir_parent_module . '\'.');
+ }
+
+ my $parent_namespace = $parent_repository->get_g_namespace_by_name ($gir_parent_module);
+
+ unless (defined $parent_namespace)
+ {
+ $self->fixed_error ('No such namespace for parent: `' . $gir_parent_module . '\'.');
+ }
+
+ my @gir_parent_prefixes = $parent_namespace->get_a_c_identifier_prefixes;
+
+ foreach my $gir_parent_prefix (@gir_parent_prefixes)
+ {
+ my $temp_parent_name = $gir_parent_prefix . $gir_parent_name;
+ my $gir_parent_class = $parent_namespace->get_g_class_by_name ($temp_parent_name);
+
+ if (defined $gir_parent_class)
+ {
+ $c_parent_name = $temp_parent_name;
+ last;
+ }
+ }
+
+ unless (defined $c_parent_name)
+ {
+ $self->fixed_error ('No such parent class in namespace: `' . $c_parent_name . '\.');
+ }
+ }
+ else
+ {
+ for my $gir_prefix (@gir_prefixes)
+ {
+ my $temp_parent_name = $gir_prefix . $gir_parent;
+ my $gir_parent_class = $namespace->get_g_class_by_name ($temp_parent_name);
+
+ if (defined $gir_parent_class)
+ {
+ $c_parent_name = $temp_parent_name;
+ last;
+ }
+ }
+
+ unless (defined $c_parent_name)
+ {
+ $self->fixed_error ('No such parent class in namespace: `' . $c_parent_name . '\.');
+ }
+ }
+
+ my $type_info_store = $self->get_type_info_store;
+ my $cpp_parent_name = $type_info_store->c_to_cpp ($c_parent_name);
+
+ $self->push_gir_class ($gir_class);
+
+ Common::Output::Interface::output $self,
+ $c_name,
+ $c_class_name,
+ $c_parent_name,
+ $cpp_name,
+ $cpp_parent_name,
+ $get_type_func;
+}
+
+# TODO: some of the code here duplicates the code in next
+# TODO continued: method.
+sub _on_class_opaque_copyable ($)
+{
+ my ($self) = @_;
+ my @args = Common::Shared::string_split_commas $self->extract_bracketed_text;
+
+ if (@args > 5)
+ {
+ $self->fixed_warning ('Last ' . @args - 2 . ' parameters are useless.');
+ }
+
+ my $repositories = $self->get_repositories;
+ my $module = $self->get_module;
+ my $repository = $repositories->get_repository ($module);
+
+ unless (defined $repository)
+ {
+ $self->fixed_error ('No such repository: ' . $module);
+ }
+
+ my $namespace = $repository->get_g_namespace_by_name ($module);
+
+ unless (defined $namespace)
+ {
+ $self->fixed_error ('No such namespace: ' . $module);
+ }
+
+ my ($cpp_type, $c_type, $new_func, $copy_func, $free_func) = @args;
+ my $gir_record = $namespace->get_g_record_by_name ($c_type);
+
+ unless (defined $gir_record)
+ {
+ $self->fixed_error ('No such record: ' . $c_type);
+ }
+
+# TODO: Check if we can support generating constructors with
+# TODO continued: several parameters also.
+ if (not defined $new_func or $new_func eq 'GUESS')
+ {
+ my $constructor_count = $gir_record->get_g_constructor_count;
+
+ $new_func = undef;
+ for (my $iter = 0; $iter < $constructor_count; ++$iter)
+ {
+ my $constructor = $gir_record->get_g_constructor_by_index ($iter);
+
+ unless ($constructor->get_g_parameters_count)
+ {
+ $new_func = $constructor->get_a_c_identifier;
+ last;
+ }
+ }
+ }
+
+ my @gir_prefixes = split ',', $namespace->get_a_c_symbol_prefixes;
+ my $record_prefix = $gir_record->get_a_c_symbol_prefix;
+
+ if (not defined $copy_func or $copy_func eq 'GUESS')
+ {
+ my $found_any = 0;
+
+ $copy_func = undef;
+ for my $prefix (@gir_prefixes)
+ {
+ for my $ctor_suffix ('copy', 'ref')
+ {
+ my $copy_ctor_name = join '_', $prefix, $record_prefix, $ctor_suffix;
+ my $copy_ctor = $gir_record->get_g_method_by_name ($copy_ctor_name);
+
+ if (defined $copy_ctor)
+ {
+ $found_any = 1;
+ unless ($copy_ctor->get_g_parameters_count)
+ {
+ $copy_func = $copy_ctor_name;
+ }
+ }
+ }
+ }
+
+ unless (defined $copy_func)
+ {
+ if ($found_any)
+ {
+ $self->fixed_error ('Found a copy/ref function, but its prototype was not the expected one. Please specify its name explicitly. Note that NONE is not allowed.');
+ }
+ else
+ {
+ $self->fixed_error ('Could not find any copy/ref function. Please specify its name explicitly. Note that NONE is not allowed.');
+ }
+ }
+ }
+ elsif ($copy_func ne 'NONE')
+ {
+ my $copy_ctor = $gir_record->get_g_method_by_name ($copy_func);
+
+ unless (defined $copy_ctor)
+ {
+ $self->fixed_error ('Could not find such copy/ref function in Gir file: `' . $copy_func . '\'.');
+ }
+ }
+ else
+ {
+ $self->fixed_error ('Copy/ref function can not be NONE.');
+ }
+
+ if (not defined $free_func or $free_func eq 'GUESS')
+ {
+ my $found_any = 0;
+
+ $free_func = undef;
+ for my $prefix (@gir_prefixes)
+ {
+ for my $dtor_suffix ('free', 'unref')
+ {
+ my $dtor_name = join '_', $prefix, $record_prefix, $dtor_suffix;
+ my $dtor = $gir_record->get_g_method_by_name ($dtor_name);
+
+ if (defined $dtor)
+ {
+ $found_any = 1;
+ unless ($dtor->get_g_parameters_count)
+ {
+ $free_func = $dtor_name;
+ }
+ }
+ }
+ }
+
+ unless (defined $free_func)
+ {
+ if ($found_any)
+ {
+ $self->fixed_error ('Found a free/unref function, but its prototype was not the expected one. Please specify its name explicitly. Note that NONE is not allowed.');
+ }
+ else
+ {
+ $self->fixed_error ('Could not find any free/unref function. Please specify its name explicitly. Note that NONE is not allowed.');
+ }
+ }
+ }
+ elsif ($free_func ne 'NONE')
+ {
+ my $dtor = $gir_record->get_g_method_by_name ($free_func);
+
+ unless (defined $dtor)
+ {
+ $self->fixed_error ('Could not find such free/unref in Gir file: `' . $free_func . '\'.');
+ }
+ }
+ else
+ {
+ $self->fixed_error ('Free/unref function can not be NONE.');
+ }
+
+ $self->push_gir_record ($gir_record);
+
+ Common::Output::OpaqueCopyable::output $self,
+ $c_type,
+ $cpp_type,
+ $new_func,
+ $copy_func,
+ $free_func;
+}
+
+# TODO: some of the code below duplicates the code in method
+# TODO continued: above.
+sub _on_class_opaque_refcounted ($)
+{
+ my ($self) = @_;
+ my @args = Common::Shared::string_split_commas $self->extract_bracketed_text;
+
+ if (@args > 5)
+ {
+ $self->fixed_warning ('Last ' . @args - 2 . ' parameters are useless.');
+ }
+
+ my $repositories = $self->get_repositories;
+ my $module = $self->get_module;
+ my $repository = $repositories->get_repository ($module);
+
+ unless (defined $repository)
+ {
+ $self->fixed_error ('No such repository: ' . $module);
+ }
+
+ my $namespace = $repository->get_g_namespace_by_name ($module);
+
+ unless (defined $namespace)
+ {
+ $self->fixed_error ('No such namespace: ' . $module);
+ }
+
+ my ($cpp_type, $c_type, $new_func, $copy_func, $free_func) = @args;
+ my $gir_record = $namespace->get_g_record_by_name ($c_type);
+
+ unless (defined $gir_record)
+ {
+ $self->fixed_error ('No such record: ' . $c_type);
+ }
+
+# TODO: Check if we can support generating constructors with
+# TODO continued: with several parameters also.
+ if (not defined $new_func or $new_func eq 'GUESS')
+ {
+ my $constructor_count = $gir_record->get_g_constructor_count;
+
+ $new_func = undef;
+ for (my $iter = 0; $iter < $constructor_count; ++$iter)
+ {
+ my $constructor = $gir_record->get_g_constructor_by_index ($iter);
+
+ unless ($constructor->get_g_parameters_count)
+ {
+ $new_func = $constructor->get_a_c_identifier;
+ last;
+ }
+ }
+ }
+
+ my @gir_prefixes = split ',', $namespace->get_a_c_symbol_prefixes;
+ my $record_prefix = $gir_record->get_a_c_symbol_prefix;
+
+ if (not defined $copy_func or $copy_func eq 'GUESS')
+ {
+ my $found_any = 0;
+
+ $copy_func = undef;
+ for my $prefix (@gir_prefixes)
+ {
+ for my $ctor_suffix ('ref', 'copy')
+ {
+ my $copy_ctor_name = join '_', $prefix, $record_prefix, $ctor_suffix;
+ my $copy_ctor = $gir_record->get_g_method_by_name ($copy_ctor_name);
+
+ if (defined $copy_ctor)
+ {
+ $found_any = 1;
+ unless ($copy_ctor->get_g_parameters_count)
+ {
+ $copy_func = $copy_ctor_name;
+ }
+ }
+ }
+ }
+
+ unless (defined $copy_func)
+ {
+ if ($found_any)
+ {
+ $self->fixed_error ('Found a copy/ref function, but its prototype was not the expected one. Please specify its name explicitly. Note that NONE is not allowed.');
+ }
+ else
+ {
+ $self->fixed_error ('Could not find any copy/ref function. Please specify its name explicitly. Note that NONE is not allowed.');
+ }
+ }
+ }
+ elsif ($copy_func ne 'NONE')
+ {
+ my $copy_ctor = $gir_record->get_g_method_by_name ($copy_func);
+
+ unless (defined $copy_ctor)
+ {
+ $self->fixed_error ('Could not find such copy/ref function in Gir file: `' . $copy_func . '\'.');
+ }
+ }
+ else
+ {
+ $self->fixed_error ('Copy/ref function can not be NONE.');
+ }
+
+ if (not defined $free_func or $free_func eq 'GUESS')
+ {
+ my $found_any = 0;
+
+ $free_func = undef;
+ for my $prefix (@gir_prefixes)
+ {
+ for my $dtor_suffix ('unref', 'free')
+ {
+ my $dtor_name = join '_', $prefix, $record_prefix, $dtor_suffix;
+ my $dtor = $gir_record->get_g_method_by_name ($dtor_name);
+
+ if (defined $dtor)
+ {
+ $found_any = 1;
+ unless ($dtor->get_g_parameters_count)
+ {
+ $free_func = $dtor_name;
+ }
+ }
+ }
+ }
+
+ unless (defined $free_func)
+ {
+ if ($found_any)
+ {
+ $self->fixed_error ('Found a free/unref function, but its prototype was not the expected one. Please specify its name explicitly. Note that NONE is not allowed.');
+ }
+ else
+ {
+ $self->fixed_error ('Could not find any free/unref function. Please specify its name explicitly. Note that NONE is not allowed.');
+ }
+ }
+ }
+ elsif ($free_func ne 'NONE')
+ {
+ my $dtor = $gir_record->get_g_method_by_name ($free_func);
+
+ unless (defined $dtor)
+ {
+ $self->fixed_error ('Could not find such free/unref in Gir file: `' . $free_func . '\'.');
+ }
+ }
+ else
+ {
+ $self->fixed_error ('Free/unref function can not be NONE.');
+ }
+
+ $self->push_gir_record ($gir_record);
+
+ Common::Output::OpaqueRefcounted::output $self,
+ $c_type,
+ $cpp_type,
+ $new_func,
+ $copy_func,
+ $free_func;
+}
+
+sub _on_namespace_keyword ($)
+{
+ my ($self) = @_;
+ my $tokens = $self->get_tokens;
+ my $section_manager = $self->get_section_manager;
+ my $main_section = $self->get_main_section;
+ my $name = '';
+ my $done = 0;
+ my $in_s_comment = 0;
+ my $in_m_comment = 0;
+
+ # we need to peek ahead to figure out what type of namespace
+ # declaration this is.
+ foreach my $token (@{$tokens})
+ {
+ next if (not defined $token or $token eq '');
+
+ if ($in_s_comment)
+ {
+ if ($token eq "\n")
+ {
+ $in_s_comment = 0;
+ }
+ }
+ elsif ($in_m_comment)
+ {
+ if ($token eq '*/')
+ {
+ $in_m_comment = 0;
+ }
+ }
+ elsif ($token eq '//')
+ {
+ $in_s_comment = 1;
+ }
+ elsif ($token eq '/*' or $token eq '/**')
+ {
+ $in_m_comment = 1;
+ }
+ elsif ($token eq '{')
+ {
+ my $level = $self->get_level;
+ my $namespaces = $self->get_namespaces;
+ my $namespace_levels = $self->get_namespace_levels;
+
+ $name = Common::Util::string_trim ($name);
+
+ unless (@{$namespaces})
+ {
+ $self->generate_first_namespace_number;
+
+ my $section = Common::Output::Shared::get_section $self, Common::Sections::H_BEFORE_FIRST_NAMESPACE;
+
+ $section_manager->append_section_to_section ($section, $main_section);
+ }
+
+ push @{$namespaces}, $name;
+ push @{$namespace_levels}, $level + 1;
+ $done = 1;
+ }
+ elsif ($token eq ';')
+ {
+ $done = 1;
+ }
+ elsif ($token !~ /\s/)
+ {
+ if ($name ne '')
+ {
+ $self->fixed_error ('Unexpected `' . $token . '\' after namespace name.');
+ }
+ $name = $token;
+ }
+
+ if ($done)
+ {
+ $section_manager->append_string_to_section ('namespace', $main_section);
+ return;
+ }
+ }
+ $self->fixed_error ('Hit eof while processing `namespace\'.');
+}
+
+sub _on_insert_section ($)
+{
+ my ($self) = @_;
+ my $section_manager = $self->get_section_manager;
+ my $main_section = $self->get_main_section;
+ my $str = Common::Util::string_trim $self->extract_bracketed_text;
+
+ $section_manager->append_section_to_section ($str, $main_section);
+}
+
+sub _on_class_keyword ($)
+{
+ my ($self) = @_;
+ my $tokens = $self->get_tokens;
+ my $section_manager = $self->get_section_manager;
+ my $main_section = $self->get_main_section;
+ my $name = '';
+ my $done = 0;
+ my $in_s_comment = 0;
+ my $in_m_comment = 0;
+ my $colon_met = 0;
+
+ # we need to peek ahead to figure out what type of class
+ # declaration this is.
+ foreach my $token (@{$tokens})
+ {
+ next if (not defined $token or $token eq '');
+
+ if ($in_s_comment)
+ {
+ if ($token eq "\n")
+ {
+ $in_s_comment = 0;
+ }
+ }
+ elsif ($in_m_comment)
+ {
+ if ($token eq '*/')
+ {
+ $in_m_comment = 0;
+ }
+ }
+ elsif ($token eq '//' or $token eq '///' or $token eq '//!')
+ {
+ $in_s_comment = 1;
+ }
+ elsif ($token eq '/*' or $token eq '/**' or $token eq '/*!')
+ {
+ $in_m_comment = 1;
+ }
+ elsif ($token eq '{')
+ {
+ my $level = $self->get_level;
+ my $classes = $self->get_classes;
+ my $class_levels = $self->get_class_levels;
+
+ $name =~ s/\s+//g;
+
+ unless (@{$classes})
+ {
+ $self->generate_first_class_number;
+
+ my $section = Common::Output::Shared::get_section $self, Common::Sections::H_BEFORE_FIRST_CLASS;
+
+ $section_manager->append_section_to_section ($section, $main_section);
+ }
+
+ push @{$classes}, $name;
+ push @{$class_levels}, $level + 1;
+ $done = 1;
+ }
+ elsif ($token eq ';')
+ {
+ $done = 1;
+ }
+ elsif ($token eq ':')
+ {
+ $colon_met = 1;
+ }
+ elsif ($token !~ /\s/)
+ {
+ unless ($colon_met)
+ {
+ $name .= $token;
+ }
+ }
+
+ if ($done)
+ {
+ $section_manager->append_string_to_section ('class', $main_section);
+ return;
+ }
+ }
+ $self->fixed_error ('Hit eof while processing `class\'.');
+}
+
+sub _on_module ($)
+{
+ my ($self) = @_;
+ my $str = Common::Util::string_trim $self->extract_bracketed_text;
+
+ $self->{'module'} = $str;
+}
+
+###
+### HANDLERS ABOVE
+###
+
+sub _switch_to_stage ($$)
+{
+ my ($self, $stage) = @_;
+ my $pairs = $self->get_stage_section_pairs;
+
+ if (exists $pairs->{$stage})
+ {
+ $self->set_parsing_stage ($stage);
+ $self->set_main_section ($pairs->{$stage}[0][0]);
+ $self->set_tokens ($self->{$pairs->{$stage}[1]});
+ }
+ else
+ {
+# TODO: internal error.
+ }
+}
+
+# public
+sub new ($$$$$$)
+{
+ my ($type, $tokens_hg, $tokens_ccg, $type_info_store, $repositories, $conversions_store, $mm_module) = @_;
+ my $class = (ref $type or $type or 'Common::WrapParser');
+ my $self =
+ {
+# TODO: check if all those fields are really needed.
+ 'line_num' => 0,
+ 'fixed_line_num' => 0,
+ 'level' => 0,
+ 'classes' => [],
+ 'class_levels' => [],
+ 'first_namespace' => '',
+ 'first_class' => '',
+ 'namespaces' => [],
+ 'namespace_levels' => [],
+ 'module' => '',
+ 'repositories' => $repositories,
+ 'tokens_hg' => [ {$tokens_hg}],
+ 'tokens_ccg' => [ {$tokens_ccg}],
+ 'tokens_null' => [],
+ 'tokens' => [],
+ 'parsing_stage' => STAGE_INVALID,
+ 'main_section' => Common::Sections::DEV_NULL->[0],
+ 'section_manager' => Common::SectionManager->new,
+ 'stage_section_pairs' =>
+ {
+ STAGE_HG() => [Common::Sections::H, 'tokens_hg'],
+ STAGE_CCG() => [Common::Sections::CC, 'tokens_ccg'],
+ STAGE_INVALID() => [Common::Sections::DEV_NULL, 'tokens_null']
+ },
+ 'type_info_store' => $type_info_store,
+ 'counter' => 0,
+ 'conversions_store' => Common::ConversionsStore->new_local ($conversions_store),
+ 'gir_stack' => [],
+ 'c_stack' => [],
+ 'mm_module' => $mm_module
+ };
+
+ $self = bless $self, $class;
+ $self->{'handlers'} =
+ {
+ '{' => [$self, \&_on_open_brace],
+ '}' => [$self, \&_on_close_brace],
+# '`' => [$self, \&_on_backtick], # probably won't be needed anymore
+# '\'' => [$self, \&_on_apostrophe], # probably won't be needed anymore
+ '"' => [$self, \&_on_string_literal],
+ '//' => [$self, \&_on_comment_cpp],
+ '///' => [$self, \&_on_comment_doxygen_single],
+ '//!' => [$self, \&_on_comment_doxygen_single],
+ '/*' => [$self, \&_on_comment_c],
+ '/**' => [$self, \&_on_comment_doxygen],
+ '/*!' => [$self, \&_on_comment_doxygen],
+ '#m4begin' => [$self, \&_on_m4_section], # probably won't be needed anymore
+ '#m4' => [$self, \&_on_m4_line], # probably won't be needed anymore
+ '_DEFS' => [$self, \&_on_defs], # probably won't be needed anymore
+ '_IGNORE' => [$self, \&_on_ignore],
+ '_IGNORE_SIGNAL' => [$self, \&_on_ignore_signal],
+ '_WRAP_METHOD' => [$self, \&_on_wrap_method],
+ '_WRAP_METHOD_DOCS_ONLY' => [$self, \&_on_wrap_method_docs_only],
+# '_WRAP_CORBA_METHOD'=> [$self, \&_on_wrap_corba_method],
+ '_WRAP_SIGNAL' => [$self, \&_on_wrap_signal],
+ '_WRAP_PROPERTY' => [$self, \&_on_wrap_property],
+ '_WRAP_VFUNC' => [$self, \&_on_wrap_vfunc],
+ '_WRAP_CTOR' => [$self, \&_on_wrap_ctor],
+ '_WRAP_CREATE' => [$self, \&_on_wrap_create],
+ '_WRAP_ENUM' => [$self, \&_on_wrap_enum],
+ '_WRAP_GERROR' => [$self, \&_on_wrap_gerror],
+ '_IMPLEMENTS_INTERFACE' => [$self, \&_on_implements_interface],
+ '_CLASS_GENERIC' => [$self, \&_on_class_generic],
+ '_CLASS_GOBJECT' => [$self, \&_on_class_g_object],
+ '_CLASS_GTKOBJECT' => [$self, \&_on_class_gtk_object],
+ '_CLASS_BOXEDTYPE' => [$self, \&_on_class_boxed_type],
+ '_CLASS_BOXEDTYPE_STATIC' => [$self, \&_on_class_boxed_type_static],
+ '_CLASS_INTERFACE' => [$self, \&_on_class_interface],
+ '_CLASS_OPAQUE_COPYABLE' => [$self, \&_on_class_opaque_copyable],
+ '_CLASS_OPAQUE_REFCOUNTED' => [$self, \&_on_class_opaque_refcounted],
+ 'namespace' => [$self, \&_on_namespace_keyword],
+ '_INSERT_SECTION' => [$self, \&_on_insert_section],
+ 'class' => [$self, \&_on_class_keyword],
+ '_MODULE' => [$self, \&_on_module],
+ };
+
+ return $self;
+}
+
+sub get_number ($)
+{
+ my ($self) = @_;
+ my $c = 'counter';
+ my $number = $self->{$c};
+
+ ++$self->{$c};
+ return $number;
+}
+
+sub get_conversions_store ($)
+{
+ my ($self) = @_;
+
+ return $self->{'conversions_store'};
+}
+
+sub generate_first_class_number ($)
+{
+ my ($self) = @_;
+
+ $self->{'first_class_number'} = $self->get_number;
+}
+
+sub get_first_class_number ($)
+{
+ my ($self) = @_;
+
+ return $self->{'first_class_number'};
+}
+
+sub generate_first_namespace_number ($)
+{
+ my ($self) = @_;
+
+ $self->{'first_namespace_number'} = $self->get_number;
+}
+
+sub get_first_namespace_number ($)
+{
+ my ($self) = @_;
+
+ $self->{'first_namespace_number'};
+}
+
+# public
+sub get_namespaces ($)
+{
+ my ($self) = @_;
+
+ return $self->{'namespaces'};
+}
+
+sub get_namespace_levels ($)
+{
+ my ($self) = @_;
+
+ return $self->{'namespace_levels'};
+}
+
+sub get_classes ($)
+{
+ my ($self) = @_;
+
+ return $self->{'classes'};
+}
+
+sub get_class_levels ($)
+{
+ my ($self) = @_;
+
+ return $self->{'class_levels'};
+}
+
+# public
+sub get_section_manager ($)
+{
+ my ($self) = @_;
+
+ return $self->{'section_manager'};
+}
+
+# public
+sub get_main_section ($)
+{
+ my ($self) = @_;
+
+ return $self->{'main_section'};
+}
+
+sub set_main_section ($$)
+{
+ my ($self, $main_section) = @_;
+
+ $self->{'main_section'} = $main_section;
+}
+
+sub set_parsing_stage ($$)
+{
+ my ($self, $parsing_stage) = @_;
+
+ $self->{'parsing_stage'} = $parsing_stage;
+}
+
+sub set_tokens ($$)
+{
+ my ($self, $tokens) = @_;
+
+ $self->{'tokens'} = $tokens;
+}
+
+sub get_tokens ($)
+{
+ my ($self) = @_;
+
+ return $self->{'tokens'};
+}
+
+sub get_line_num ($)
+{
+ my ($self) = @_;
+
+ return $self->{'line_num'};
+}
+
+sub inc_line_num ($$)
+{
+ my ($self, $inc) = @_;
+
+ $self->{'line_num'} += $inc;
+}
+
+sub _set_fixed_line_num ($)
+{
+ my ($self) = @_;
+
+ $self->{'fixed_line_num'} = $self->get_line_num;
+}
+
+sub _get_fixed_line_num ($)
+{
+ my ($self) = @_;
+
+ return $self->{'fixed_line_num'};
+}
+
+sub get_current_macro ($)
+{
+ my ($self) = @_;
+
+ return $self->{'current_macro'};
+}
+
+sub _set_current_macro ($$)
+{
+ my ($self, $macro) = @_;
+
+ $self->{'current_macro'} = $macro;
+}
+
+sub get_level ($)
+{
+ my ($self) = @_;
+
+ return $self->{'level'};
+}
+
+sub dec_level ($)
+{
+ my ($self) = @_;
+
+ --$self->{'level'};
+}
+
+sub inc_level ($)
+{
+ my ($self) = @_;
+
+ ++$self->{'level'};
+}
+
+sub get_module ($)
+{
+ my ($self) = @_;
+
+ return $self->{'module'};
+}
+
+sub get_mm_module ($)
+{
+ my ($self) = @_;
+
+ return $self->{'mm_module'};
+}
+
+sub parse ($)
+{
+ my ($self) = @_;
+ my $handlers = $self->{'handlers'};
+ my $section_manager = $self->get_section_manager;
+ my @stages = (STAGE_HG, STAGE_CCG);
+
+ for my $stage (@stages)
+ {
+ $self->_switch_to_stage ($stage);
+
+ my $tokens = $self->get_tokens;
+
+ while (@{$tokens})
+ {
+ my $token = $self->_extract_token;
+
+ if (exists $handlers->{$token})
+ {
+ my $pair = $handlers->{$token};
+ my $object = $pair->[0];
+ my $handler = $pair->[1];
+
+ $self->_set_current_macro ($token);
+ $self->_set_fixed_line_num;
+
+ if (defined $object)
+ {
+ $object->$handler;
+ }
+ else
+ {
+ &{$handler};
+ }
+ }
+ else
+ {
+ my $main_section = $self->get_main_section;
+ # no handler found - just paste the token to main section
+ $section_manager->append_string_to_section ($token, $main_section);
+# TODO: remove it later.
+ if ($token =~ /^[A-Z_]+$/)
+ {
+ print STDERR $token . ": Possible not implemented token!\n";
+ }
+ }
+ }
+ }
+}
+
+# TODO: warning and error functions should not print messages
+# TODO continued: immediately - they should just put messages
+# TODO continued: into an array and that would be printed by
+# TODO continued: Gmmproc.
+
+sub _print_with_loc ($$$$$)
+{
+ my ($self, $line_num, $type, $message, $fatal) = @_;
+ my $full_message = join '', (join ':', $self->{'filename'}, $self->get_current_macro, $line_num, $type, $message), "\n";
+
+ print STDERR $full_message;
+
+ if ($fatal)
+ {
+# TODO: throw an exception or something.
+ exit 1;
+ }
+}
+
+sub error_with_loc ($$$)
+{
+ my ($self, $line_num, $message) = @_;
+ my $type = 'ERROR';
+ my $fatal = 1;
+
+ $self->_print_with_loc ($line_num, $type, $message, $fatal);
+}
+
+sub error ($$)
+{
+ my ($self, $message) = @_;
+
+ $self->error_with_loc ($self->get_line_num, $message);
+}
+
+sub fixed_error ($$)
+{
+ my ($self, $message) = @_;
+ my $line_num = $self->_get_fixed_line_num;
+
+ $self->error_with_loc ($line_num, $message);
+}
+
+sub fixed_error_non_fatal ($$)
+{
+ my ($self, $message) = @_;
+ my $line_num = $self->_get_fixed_line_num;
+ my $type = 'ERROR';
+ my $fatal = 0;
+
+ $self->_print_with_loc ($line_num, $type, $message, $fatal);
+}
+
+sub warning_with_loc ($$$)
+{
+ my ($self, $line_num, $message) = @_;
+ my $type = 'WARNING';
+ my $fatal = 0;
+
+ $self->_print_with_loc ($line_num, $type, $message, $fatal);
+}
+
+sub warning ($$)
+{
+ my ($self, $message) = @_;
+
+ $self->warning_with_loc ($self->get_line_num, $message);
+}
+
+sub fixed_warning ($$)
+{
+ my ($self, $message) = @_;
+ my $line_num = $self->_get_fixed_line_num;
- Common::Output::Gobject::output ($self,
- $c_type,
- $c_type_class,
- $c_type_parent,
- $c_type_parent_class,
- $get_type_func,
- $cpp_type,
- $cpp_type_parent);
+ $self->warning_with_loc ($line_num, $message);
}
1; # indicate proper module load.
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]
