[perl-Glib-Object-Introspection] Add support for object class functions

[Torsten Schönfeld <tsch src gnome org>]

commit 5f35c3e5048dff27db4f0e469ff93282fc05d6b5
Author: Torsten Schönfeld <kaffeetisch gmx de>
Date:   Mon Oct 24 20:29:24 2016 +0200

    Add support for object class functions
    
    Like Gtk3::ContainerClass::find_child_property or
    Gtk3::WidgetClass::find_style_property.

 GObjectIntrospection.xs          |    2 +-
 bin/perli11ndoc                  |   13 ++++++++++-
 gperl-i11n-invoke-c.c            |    2 +-
 gperl-i11n-marshal-interface.c   |   44 ++++++++++++++++++++++++++++++++-----
 lib/Glib/Object/Introspection.pm |   36 +++++++++++++++++++-----------
 5 files changed, 75 insertions(+), 22 deletions(-)
---
diff --git a/GObjectIntrospection.xs b/GObjectIntrospection.xs
index 7351e9e..ef9b3e0 100644
--- a/GObjectIntrospection.xs
+++ b/GObjectIntrospection.xs
@@ -230,7 +230,7 @@ static void sv_to_interface (GIArgInfo * arg_info,
                              GPerlI11nInvocationInfo * invocation_info);
 
 static SV * instance_pointer_to_sv (GICallableInfo *info, gpointer pointer);
-static gpointer instance_sv_to_pointer (GICallableInfo *info, SV *sv);
+static gpointer instance_sv_to_pointer (GICallableInfo *info, SV *sv, GPerlI11nInvocationInfo *iinfo);
 
 static void sv_to_arg (SV * sv,
                        GIArgument * arg,
diff --git a/bin/perli11ndoc b/bin/perli11ndoc
old mode 100755
new mode 100644
index a9636d5..ea48476
--- a/bin/perli11ndoc
+++ b/bin/perli11ndoc
@@ -278,7 +278,7 @@ sub enumerate_namespace {
     [Enumerations => 'core:enumeration'],
     [Bitfields => 'core:bitfield'],
     [Callbacks => 'core:callback'],
-    [Records => 'core:record', \@record_sub_categories, sub { shift =~ /(?:Class|Private)$/ }],
+    [Records => 'core:record', \@record_sub_categories, sub { shift =~ /(?:Private)$/ }],
     [Constants => 'core:constant'],
     [Aliases => 'core:alias', undef, sub { shift =~ /_autoptr$/ }],
   );
@@ -583,6 +583,17 @@ sub format_function {
 sub format_method {
   my ($self, $element) = @_;
   my $synopsis_format = '[[OUT_LIST_ASSIGN]]$object->[[NAME]] ([[IN_LIST]])';
+
+  # Treat methods of class structs as functions.
+  {
+    my $parent = $element->parentNode;
+    if ($parent->nodeName eq 'record' &&
+        defined $self->find_attribute ($parent, 'glib:is-gtype-struct-for'))
+    {
+      $synopsis_format = '[[OUT_LIST_ASSIGN]][[FULL_NAME]] ($package, [[IN_LIST]])';
+    }
+  }
+
   return $self->format_callable ($element, 'METHOD', $synopsis_format);
 }
 
diff --git a/gperl-i11n-invoke-c.c b/gperl-i11n-invoke-c.c
index 11a8170..a6d7dac 100644
--- a/gperl-i11n-invoke-c.c
+++ b/gperl-i11n-invoke-c.c
@@ -46,7 +46,7 @@ invoke_c_code (GICallableInfo *info,
        _check_n_args (&iinfo);
 
        if (iinfo.is_method) {
-               instance = instance_sv_to_pointer (info, ST (0 + iinfo.stack_offset));
+               instance = instance_sv_to_pointer (info, ST (0 + iinfo.stack_offset), &iinfo.base);
                iinfo.arg_types_ffi[0] = &ffi_type_pointer;
                iinfo.args[0] = &instance;
        }
diff --git a/gperl-i11n-marshal-interface.c b/gperl-i11n-marshal-interface.c
index 93c1ce2..dc9be8c 100644
--- a/gperl-i11n-marshal-interface.c
+++ b/gperl-i11n-marshal-interface.c
@@ -4,7 +4,34 @@ void _store_enum (GIEnumInfo * info, gint value, GIArgument * arg);
 gint _retrieve_enum (GIEnumInfo * info, GIArgument * arg);
 
 static gpointer
-instance_sv_to_pointer (GICallableInfo *info, SV *sv)
+instance_sv_to_class_struct_pointer (SV *sv, GPerlI11nInvocationInfo *iinfo)
+{
+       gpointer pointer = NULL;
+       GType class_type = 0;
+       dwarn ("  -> gtype struct?\n");
+       if (gperl_sv_is_ref (sv)) { /* instance? */
+               const char *package = sv_reftype (SvRV (sv), TRUE);
+               class_type = gperl_type_from_package (package);
+       } else { /* package? */
+               class_type = gperl_type_from_package (SvPV_nolen (sv));
+       }
+       dwarn ("     class_type = %s (%lu), is_classed = %d\n",
+              g_type_name (class_type), class_type, G_TYPE_IS_CLASSED (class_type));
+       if (G_TYPE_IS_CLASSED (class_type)) {
+               pointer = g_type_class_peek (class_type);
+               if (!pointer) {
+                       /* If peek() produced NULL, the class has not been
+                        * instantiated yet and needs to be created. */
+                       pointer = g_type_class_ref (class_type);
+                       free_after_call (iinfo, (GFunc) g_type_class_unref, pointer);
+               }
+               dwarn ("     type class = %p\n", pointer);
+       }
+       return pointer;
+}
+
+static gpointer
+instance_sv_to_pointer (GICallableInfo *info, SV *sv, GPerlI11nInvocationInfo *iinfo)
 {
        // We do *not* own container.
        GIBaseInfo *container = g_base_info_get_container (info);
@@ -30,11 +57,16 @@ instance_sv_to_pointer (GICallableInfo *info, SV *sv)
            {
                GType type = get_gtype ((GIRegisteredTypeInfo *) container);
                if (!type || type == G_TYPE_NONE) {
-                       dwarn ("  -> untyped record\n");
-                       pointer = sv_to_struct (GI_TRANSFER_NOTHING,
-                                               container,
-                                               info_type,
-                                               sv);
+                       if (g_struct_info_is_gtype_struct (container)) {
+                               pointer = instance_sv_to_class_struct_pointer (sv, iinfo);
+                       }
+                       if (!pointer) {
+                               dwarn ("  -> untyped record\n");
+                               pointer = sv_to_struct (GI_TRANSFER_NOTHING,
+                                                       container,
+                                                       info_type,
+                                                       sv);
+                       }
                } else {
                        dwarn ("  -> boxed: type=%s (%"G_GSIZE_FORMAT")\n",
                               g_type_name (type), type);
diff --git a/lib/Glib/Object/Introspection.pm b/lib/Glib/Object/Introspection.pm
index d0415a4..2347277 100644
--- a/lib/Glib/Object/Introspection.pm
+++ b/lib/Glib/Object/Introspection.pm
@@ -474,19 +474,7 @@ other widgets it's usually friendliest to avoid circularities in the first
 place, either by using weak references in the userdata, or possibly locating a
 parent dynamically with C<< $widget->get_ancestor >>.
 
-=head2 Miscellaneous
-
-In C you can only return one value from a function, and it is a common practice
-to modify pointers passed in to simulate returning multiple values.  In Perl,
-you can return lists; any functions which modify arguments are changed to
-return them instead.
-
-Arguments and return values that have the types GList or GSList or which are C
-arrays of values will be converted to and from references to normal Perl
-arrays.  The same holds for GHashTable and references to normal Perl hashes.
-
-You don't need to specify string lengths.  You can always use C<substr> to pass
-different parts of a string.
+=head2 Exception handling
 
 Anything that uses GError in C will C<croak> on failure, setting $@ to a
 magical exception object, which is overloaded to print as the
@@ -517,6 +505,28 @@ Glib::Error exception objects, you don't have to rely on string matching
 on a possibly localized error message; you can match errors by explicit and
 predictable conditions.  See L<Glib::Error> for more information.
 
+=head2 Output arguments, lists, hashes
+
+In C you can only return one value from a function, and it is a common practice
+to modify pointers passed in to simulate returning multiple values.  In Perl,
+you can return lists; any functions which modify arguments are changed to
+return them instead.
+
+Arguments and return values that have the types GList or GSList or which are C
+arrays of values will be converted to and from references to normal Perl
+arrays.  The same holds for GHashTable and references to normal Perl hashes.
+
+=head2 Object class functions
+
+Object class functions like C<Gtk3::WidgetClass::find_style_propery> can be
+called either with a package name or with an instance of the package.  For
+example:
+
+  Gtk3::WidgetClass::find_style_property ('Gtk3::Button', 'image-spacing')
+
+  my $button = Gtk3::Button->new;
+  Gtk3::WidgetClass::find_style_property ($button, 'image-spacing')
+
 =head1 DESCRIPTION FOR LIBRARY BINDING AUTHORS
 
 =head2 C<< Glib::Object::Introspection->setup >>