### ----------------------------------------------------
### -- Gnome::GObject
### -- Licenses: Artistic-2.0
### -- Authors: Marcel Timmerman
### -- File: lib/Gnome/GObject/Object.rakumod
### ----------------------------------------------------
### -- Chunk 1 of 4
#TL:1:Gnome::GObject::Object:

use v6;
#-------------------------------------------------------------------------------
=begin pod

=head1 Gnome::GObject::Object

The base object type

=head1 Description

Gnome::GObject::Object is the fundamental type providing the common attributes and methods for all object types in GTK+, Pango and other libraries based on GObject. The GObject class provides methods for object construction and destruction, property access methods, and signal support.


=begin comment
Signals are described in detail L<here|https://developer.gnome.org/gobject/stable/signal.html>.

For a tutorial on implementing a new GObject class, see [How to define and
implement a new GObject][howto-gobject]. For a list of naming conventions for
GObjects and their methods, see the [GType conventions][gtype-conventions].
For the high-level concepts behind GObject, read [Instantiable classed types:
Objects][gtype-instantiable-classed].

=head2 Floating references

B<Gnome::GObject::InitiallyUnowned> is derived from B<Gnome::GObject::Object>. The only difference between the two is that the initial reference of a GInitiallyUnowned is flagged as a "floating" reference. This means that it is not specifically claimed to be "owned" by any code portion. The main motivation for providing floating references is C convenience. In particular, it allows code to be written as (in C):

  container = $create_container();
  container_add_child (container, create_child());

If C<container_add_child()> calls C<g_object_ref_sink()> on the passed-in child, no reference of the newly created child is leaked. Without floating references, C<container_add_child()> can only C<g_object_ref()> the new child, so to implement this code without reference leaks, it would have to be written as:

  Child *child;
  container = create_container();
  child = create_child();
  container_add_child (container, child);
  g_object_unref (child);

The floating reference can be converted into an ordinary reference by calling C<g_object_ref_sink()>. For already sunken objects (objects that don't have a floating reference anymore), C<g_object_ref_sink()> is equivalent to C<g_object_ref()> and returns a new reference.

Since floating references are useful almost exclusively for C convenience, language bindings that provide automated reference and memory ownership maintenance (such as smart pointers or garbage collection) should not expose floating references in their API.

Some object implementations may need to save an objects floating state across certain code portions (an example is B<Gnome::Gtk3::Menu>), to achieve this, the following sequence can be used:

  // save floating state
  gboolean was_floating = g_object_is_floating (object);
  g_object_ref_sink (object);
  // protected code portion

  ...

  // restore floating state
  if (was_floating)
    g_object_force_floating (object);
  else
    g_object_unref (object); // release previously acquired reference


=head2 See Also

I<GParamSpecObject>, C<g_param_spec_object()>

=end comment

=head1 Synopsis
=head2 Declaration

  unit class Gnome::GObject::Object;
  also is Gnome::N::TopLevelClassSupport;
  also does Gnome::GObject::Signal;

=head2 Uml Diagram

![](plantuml/Object.svg)


=begin comment
=head2 Example

This object is almost never used directly. Many classes inherit from this class. The below example shows how label text is set on a button using properties. This can be made much simpler by setting this label directly in the init of B<Gnome::Gtk3::Button>. The purpose of this example, however, is that there might be other properties which can only be set this way.

  use Gnome::GObject::Object:api<1>;
  use Gnome::GObject::Value:api<1>;
  use Gnome::GObject::Type:api<1>;
  use Gnome::Gtk3::Button:api<1>;

  my Gnome::GObject::Value $gv .= new(:init(G_TYPE_STRING));

  my Gnome::Gtk3::Button $b .= new;
  $gv.g-value-set-string('Open file');
  $b.g-object-set-property( 'label', $gv);
  $gv.clear-object;

=end comment
=end pod

#-------------------------------------------------------------------------------
use NativeCall;

use Gnome::N::X:api<1>;
use Gnome::N::NativeLib:api<1>;
use Gnome::N::N-GObject:api<1>;
use Gnome::N::TopLevelClassSupport:api<1>;
use Gnome::N::GlibToRakuTypes:api<1>;

use Gnome::Glib::MainLoop:api<1>;
use Gnome::Glib::MainContext:api<1>;

use Gnome::GObject::Signal:api<1>;
use Gnome::GObject::Type:api<1>;
use Gnome::GObject::Value:api<1>;
use Gnome::GObject::Closure:api<1>;
#use Gnome::GObject::Param:api<1>;

#-------------------------------------------------------------------------------
unit class Gnome::GObject::Object:auth<github:MARTIMM>:api<1>;
also is Gnome::N::TopLevelClassSupport;
also does Gnome::GObject::Signal;

#-------------------------------------------------------------------------------
my Hash $signal-types = {};
my Bool $signals-added = False;

#has Gnome::GObject::Signal $!g-signal;

#`{{ Moved to TopLevelClassSupport
# type is Gnome::Gtk3::Builder. Cannot load module because of circular dep.
# attribute is set by GtkBuilder via set-builder(). There might be more than one
my Array $builders = [];

# When a builder is set with a name set to ___Test_Builder__ it means that
# the Gnome::T module is used and the builder is created there.
my Bool $test-mode = False;
}}

# check on native library initialization. must be global to all of the
# TopLevelClassSupport classes. the
my Bool $gui-initialized = False;
my Bool $may-not-initialize-gui = False;

#-------------------------------------------------------------------------------
=begin pod
=head1 Methods
=head2 new

Create a Raku object using a B<Gnome::Gtk3::Builder>. The builder object will provide its object (self) to B<Gnome::GObject::Object> when the Builder is created. The Builder object is asked to search for id's defined in the GUI glade design.

  multi method new ( Str :$build-id! )

An example

  my Gnome::Gtk3::Builder $builder .= new(:filename<my-gui.glade>);
  my Gnome::Gtk3::Button $button .= new(:build-id<my-gui-button>);

=end pod

#TM:4:new():inheriting:*
#TM:4:new(:build-id):*
submethod BUILD ( *%options ) {

  # check GTK+ init except when GtkApplication / GApplication is used
  $may-not-initialize-gui = [or]
    $may-not-initialize-gui,
    $gui-initialized,
    # check for Application from Gio. that one inherits from Object.
    # Application from Gtk3 inherits from Gio, so this test is always ok.
    ?(self.^mro[0..*-3].gist ~~ m/'(Application) (Object)'/);

#note "go $?LINE";
  unless $may-not-initialize-gui {
#note "go $?LINE";
    if not $gui-initialized #`{{and !%options<skip-init>}} {
      # must setup gtk otherwise Raku will crash
      my $argc = int-ptr.new;
      $argc[0] = 1 + @*ARGS.elems;

      my $arg_arr = char-pptr.new;
      my Int $arg-count = 0;
      $arg_arr[$arg-count++] = $*PROGRAM.Str;
      for @*ARGS -> $arg {
        $arg_arr[$arg-count++] = $arg;
      }

      my $argv = char-ppptr.new;
      $argv[0] = $arg_arr;

      # call gtk_init_check
      _object_init_check( $argc, $argv);
      $gui-initialized = True;

      # now refill the ARGS list with left over commandline arguments
      @*ARGS = ();
      for ^$argc[0] -> $i {
        # skip first argument == programname
        next unless $i;
        @*ARGS.push: $argv[0][$i];
      }
    }
  }


  # add signal types
#  unless $signals-added {
#    $signals-added = self.add-signal-types(
#      $?CLASS.^name, :N-GParamSpec<notify>
#    );
#  }

  # test if native object is set by Gnome::N:TopLevelSupportClass
#note "Object valid: ", self.is-valid;
  if self.is-valid {
#`{{
    # If test mode is triggered by Gnome::T
note "Test mode: $test-mode";
    if $test-mode {
      my $no = self._get-native-object-no-reffing;
note "native object: ", $no.raku;
      my Gnome::GObject::Type $t .= new;

      # only when buildable then based on Widget -> widget path and gui-able
note "instance is GtkBuildable: ", $t.check-instance-is-a( $no, $t.from-name('GtkBuildable'));
      if $t.check-instance-is-a( $no, $t.from-name('GtkBuildable')) {

        # just pick first builder. this should be correct if Gnome::T
        # is started as early as possible
        my $builder = $builders[0];

        # create an id for use in builder to find the object
        my Str $widget-path = $t.name-from-instance($no);
        $widget-path ~= _path_to_string(_get_path($no));
note "widget path: $widget-path";

        # add object to builder
        $builder.expose-object( $widget-path, $no);

        note "set gobject build-id to: $widget-path" if $Gnome::N::x-debug;
      }
    }
}}
  }

  elsif %options<native-object>:exists { }

  #`{{
    note: thought about moving this test to Widget because the interface
    Buildable is hooked up there. This is not correct, because, after studying
    the Buider code, I saw that gtk_builder_expose_object() makes use of
    object_set_name() before inserting the object in a hash table.
    object_set_name() makes use of gtk_buildable_set_name() if the object
    inherits from Widget, otherwise it uses the g_object_set_data_full() to set
    the id onto the native object. This means that every object inheriting from
    here (=Object) can have an id set and thus retrieved here.
  }}
  elsif ? %options<build-id> {
    my N-GObject $native-object;
    note "gobject build-id: %options<build-id>" if $Gnome::N::x-debug;
    my Array $builders = self._get-builders;
    for @$builders -> $builder {

      #TODO this action does not increase object refcount, do it here.
      $native-object = $builder.get-object(%options<build-id>) // N-GObject;
      #TODO self.g_object_ref(); ?
      last if ?$native-object;
    }

    if ? $native-object {
      note "store native object: ", self.^name, ', ', $native-object
        if $Gnome::N::x-debug;

      self._set-native-object($native-object);
    }

    else {
      note "builder id '%options<build-id>' not found in any of the builders"
        if $Gnome::N::x-debug;

      die X::Gnome.new(
        :message(
          "Builder id '%options<build-id>' not found in any of the builders"
        )
      );
    }
  }
}

#-------------------------------------------------------------------------------
# no pod. user does not have to know about it.
method _fallback ( $native-sub --> Callable ) {

  my Callable $s;

  try { $s = &::("g_object_$native-sub"); };
  try { $s = &::("g_signal_$native-sub"); } unless ?$s;
  try { $s = &::("g_$native-sub"); } unless ?$s;
  try { $s = &::($native-sub); } if !$s and $native-sub ~~ m/^ 'g_' /;

  self._set-class-name-of-sub('GObject');

  $s
}

#-------------------------------------------------------------------------------
method _set-native-object ( $n-native-object ) {
  if ? $n-native-object {
    # when object is set, create signal object too
    #$!g-signal .= new(:g-object($n-native-object));
  }

  # now call the one from TopLevelClassSupport
  callsame
}

#-------------------------------------------------------------------------------
method native-object-ref ( $n-native-object --> N-GObject ) {
  _g_object_ref($n-native-object)
}

#-------------------------------------------------------------------------------
method native-object-unref ( $n-native-object ) {
#  _g_object_free($n-native-object)
  _g_object_unref($n-native-object)
}

#`{{ Moved to TopLevelClassSupport
#-------------------------------------------------------------------------------
# no pod. user does not have to know about it.
method _set-builder ( $builder ) {
  $builders.push($builder);

  # When a builder is set with a key _SET_TEST_BUILDER_ set to
  # ___Test_Builder__ it means that the Gnome::T module is used
  # and the builder is created there.
  $test-mode = True
    if $builder.get-data( '_SET_TEST_BUILDER_', Str) ~~ '___Test_Builder__';
}

#-------------------------------------------------------------------------------
# no pod. user does not have to know about it.
method _get-builders ( --> Array ) {
  $builders
}
}}

#-------------------------------------------------------------------------------
# no pod. user does not have to know about it.
method add-signal-types ( Str $module-name, *%signal-descriptions --> Bool ) {

  # must store signal names under the class name because I found the use of
  # the same signal name with different handler signatures in different classes.
  $signal-types{$module-name} //= {};

  note "\nTest signal names for $module-name" if $Gnome::N::x-debug;
  for %signal-descriptions.kv -> $signal-type, $signal-names {
    my @names = $signal-names ~~ List ?? @$signal-names !! ($signal-names,);
    for @names -> $signal-name {
      if $signal-type ~~ any(<w0 w1 w2 w3 w4 w5 w6 w7 w8 w9 signal event nativewidget>) {
        note "  $module-name, $signal-name --> $signal-type"
          if $Gnome::N::x-debug;
        $signal-types{$module-name}{$signal-name} = $signal-type;
      }

      # TODO cleanup deprecated and not supported
      elsif $signal-type eq 'deprecated' {
        note "  $signal-name is deprecated" if $Gnome::N::x-debug;
      }

      elsif $signal-type eq 'notsupported' {
        note "  $signal-name is not supported" if $Gnome::N::x-debug;
      }

      else {
        note "  $signal-name is not yet supported" if $Gnome::N::x-debug;
      }
    }
  }

  True
}

#-------------------------------------------------------------------------------
#TM:2:get-data:xt/Object.t
=begin pod
=head2 get-data

Gets a named field from the objects table of associations. See C<set-data()> for several examples.

Returns: the data if found, or C<undefined> if no such data exists.

  method get-data ( Str $key, $type, Str :$widget-class --> Any )

=item Str $key; name of the key for that association
=item $type; specification of the type of data to return. The recognized types are; int*, uint*, num*, Buf, (U)Int, Num, Str, Bool and N-GObject. the native int and uint type are taken as int64 and uint64 respectively. In the case of N-GObject the method will try to create a raku object. When it was undefined, this is not possible and it will return an undefined N-GObject. The N-GObject type can be helped by specifying the named argument C<widget-class>. This should be a name of a raku class like for instance B<Gnome::Gtk3::Label>. When the return value was undefined, the result object will always have the raku class type but the call to <.is-valid()> returns False. Note that Int, UInt, and Num is transformed to their 32 bit representations.
=item Str :$widget-class; Create object of this type.

=end pod

method get-data ( Str $key, Any $type, Str :$widget-class --> Any ) {

  my $data;
  my $odata = g_object_get_data( self._f('GObject'), $key);

  given $type.^name {
    when 'int8' {
      my CArray[int8] $d = nativecast( CArray[int8], $odata);
      $data = $d[0];
    }

    when /uint8 || byte/ {
      my CArray[byte] $d = nativecast( CArray[byte], $odata);
      $data = $d[0];
    }

    when 'int16' {
      my CArray[int16] $d = nativecast( CArray[int16], $odata);
      $data = $d[0];
    }

    when 'uint16' {
      my CArray[uint16] $d = nativecast( CArray[uint16], $odata);
      $data = $d[0];
    }

    when 'int32' {
      my CArray[int32] $d = nativecast( CArray[int32], $odata);
      $data = $d[0];
    }

    when 'uint32' {
      my CArray[uint32] $d = nativecast( CArray[uint32], $odata);
      $data = $d[0];
    }

    # int might be shorter but placed in longest possible, doesn't harm
    when /int '64'?/ {
      my CArray[int64] $d = nativecast( CArray[int64], $odata);
      $data = $d[0];
    }

    # int might be shorter but placed in longest possible, doesn't harm
    when /uint '64'?/ {
      my CArray[uint64] $d = nativecast( CArray[uint64], $odata);
      $data = $d[0];
    }

    when 'num32' {
      my CArray[num32] $d = nativecast( CArray[num32], $odata);
      $data = $d[0];
    }

    when 'num64' {
      my CArray[] $d = nativecast( CArray[], $odata);
      $data = $d[0];
    }

    when 'Pointer' {
      $data = $odata;
    }

    when 'Buf' {
      $data = nativecast( CArray[byte], $odata);
    }

    when 'UInt' {
      my CArray[int32] $d = nativecast( CArray[uint32], $odata);
      $data = $d[0];
    }

    when 'Int' {
      my CArray[int32] $d = nativecast( CArray[int32], $odata);
      $data = $d[0];
    }

    when 'Rat' {
      my CArray[num64] $d = nativecast( CArray[num64], $odata);
      $data = $d[0].Rat;
    }

    when 'Num' {
      my CArray[num32] $d = nativecast( CArray[num32], $odata);
      $data = $d[0];
    }

    when 'Str' {
      my CArray[Str] $d = nativecast( CArray[Str], $odata);
      $data = $d[0];
    }

    when 'Bool' {
      my CArray[gboolean] $d = nativecast( CArray[gboolean], $odata);
      $data = $d[0];
    }

    when 'N-GObject' {
      my CArray[N-GObject] $d = nativecast( CArray[N-GObject], $odata);
      if ?$widget-class {
        require ::($widget-class);
        my $class = ::($widget-class);
        $data = $class.new(:native-object($d[0]));
      }

      else {
        $data = $d[0].defined
          ?? self._wrap-native-type-from-no($d[0])
          !! N-GObject;
      }
    }

    default {
      die X::Gnome.new(:message("Type '$data.^name()' for key '$key' not supported"));
    }
  }

  $data
}

sub g_object_get_data ( N-GObject $object, Str $key --> Pointer )
  is native(&gobject-lib)
  { * }

#-------------------------------------------------------------------------------
#TM:2:get-properties:xt/Object.t
=begin pod
=head2 get-properties

Gets properties of an object.

In general, a copy is made of the property contents and the caller is responsible for freeing the memory in the appropriate manner for the type, for instance by calling C<g_free()> or C<g_object_unref()>.

The method is defined as;

  method get-properties ( $prop-name, $prop-value-type, … --> List )

=item Str $prop-name; name of a property to set.
=item $prop-value-type; The type of the property to receive. It can be any of Str, Int, UInt, Num, Bool, int*, uint*, num*. (U)Int is converted to (u)int32 and Num to num32.

See C<.set()> for an example.
=end pod

method get-properties ( *@properties --> List ) {

  my @parameter-list = ( Parameter.new(:type(N-GObject)), );    # object
  my @pl = ( );                                                 # arguments

  for @properties -> Str $key, $v-type {
    @parameter-list.push: Parameter.new(:type(Str));            # prop name
    @pl.push: $key;                                             # name arg

    # prop type of value
    given $v-type.^name {

      when 'int8' {
        @parameter-list.push: Parameter.new(:type(CArray[int8]));
        @pl.push: CArray[int8].new(0);
      }

      when /uint8 || byte/ {
        @parameter-list.push: Parameter.new(:type(CArray[byte]));
        @pl.push: CArray[byte].new(0);
      }

      when 'int16' {
        @parameter-list.push: Parameter.new(:type(CArray[int16]));
        @pl.push: CArray[int16].new(0);
      }

      when 'uint16' {
        @parameter-list.push: Parameter.new(:type(CArray[uint16]));
        @pl.push: CArray[uint16].new(0);
      }

      when 'int32' {
        @parameter-list.push: Parameter.new(:type(CArray[int32]));
        @pl.push: CArray[int32].new(0);
      }

      when 'uint32' {
        @parameter-list.push: Parameter.new(:type(CArray[uint32]));
        @pl.push: CArray[uint32].new(0);
      }

      when /int '64'?/ {
        @parameter-list.push: Parameter.new(:type(CArray[int64]));
        @pl.push: CArray[int64].new(0);
      }

      when /uint '64'?/ {
        @parameter-list.push: Parameter.new(:type(CArray[uint64]));
        @pl.push: CArray[uint64].new(0);
      }

      when 'num32' {
        @parameter-list.push: Parameter.new(:type(CArray[num32]));
        @pl.push: CArray[num32].new(0e0);
      }

      when 'num64' {
        @parameter-list.push: Parameter.new(:type(CArray[num64]));
        @pl.push: CArray[num64].new(0e0);
      }

      when 'Int' {
        @parameter-list.push: Parameter.new(:type(CArray[int32]));
        @pl.push: CArray[int32].new(0);
      }

      when 'UInt' {
        @parameter-list.push: Parameter.new(:type(CArray[uint32]));
        @pl.push: CArray[uint32].new(0);
      }

      when 'Num' {
        @parameter-list.push: Parameter.new(:type(CArray[num32]));
        @pl.push: CArray[num32].new(0e0);
      }

      when 'Str' {
        @parameter-list.push: Parameter.new(:type(CArray[Str]));
        @pl.push: CArray[Str].new('');
      }

      when /Bool || gboolean/ {
        @parameter-list.push: Parameter.new(:type(CArray[gboolean]));
        @pl.push: CArray[gboolean].new(0);
      }

#`{{
      when 'N-GObject' {
        @parameter-list.push: Parameter.new(:type(CArray[N-GObject]));
        @pl.push: CArray[N-GObject].new(N-GObject);
      }

      when / '::N-GClosure' $/ {
        @parameter-list.push: Parameter.new(:type(CArray[N-GClosure]));
        @pl.push: CArray[N-GClosure].new(N-GClosure);
      }
}}

      default {
        @parameter-list.push: Parameter.new(:type(CArray[$v-type]));
        @pl.push: CArray[$v-type].new($v-type);
      }

#`{{
      default {
        die X::Gnome.new(
          :message("Type '{$v-type.raku}' for key '$key' not supported")
        );
      }
}}
    }
  }

  # to finish the list with 0
  @parameter-list.push: Parameter.new(type => Pointer);

  # create signature
  my Signature $signature .= new(
    :params(|@parameter-list),
    :returns(int32)
  );

  # get a pointer to the sub, then cast it to a sub with the proper
  # signature. after that, the sub can be called, returning a value.
  state $ptr = cglobal( &gtk-lib, 'g_object_get', Pointer);
  my Callable $f = nativecast( $signature, $ptr);

  $f( self._get-native-object-no-reffing, |@pl, Nil);

  my @ret-values = ();
  for @pl -> $key, $v {
    @ret-values.push: $v[0];
  }

  @ret-values
}

#-------------------------------------------------------------------------------
=begin pod
=head2 get-property

Gets a property of an object. The value must have been initialized to the expected type of the property (or a type to which the expected type can be transformed).

In general, a copy is made of the property contents and the caller is responsible for freeing the memory by calling C<clear-object()>.

Next signature is used when no B<Gnome::GObject::Value> is available. The routine will create the Value using C<$gtype>.

  multi method get-property (
    Str $property_name, Int $gtype
    --> Gnome::GObject::Value
  )

The following is used when a Value object is available.

  multi method get-property (
    Str $property_name, N-GValue $value
    --> Gnome::GObject::Value
  )

=item Str $property_name; the name of the property to get.
=item Int $gtype; the type of the value, e.g. G_TYPE_INT.
=item N-GValue $value; The value is stored in a N-GValue object. It is used to get the type of the object.

The methods always return a B<Gnome::GObject::Value> with the result.

  my Gnome::Gtk3::Label $label .= new;
  my Gnome::GObject::Value $gv .= new(:init(G_TYPE_STRING));
  $label.g-object-get-property( 'label', $gv);
  $gv.g-value-set-string('my text label');

=end pod

multi method get-property(
  gchar-ptr $property_name, Int $gtype --> Gnome::GObject::Value
) {
  my Gnome::GObject::Value $v .= new(:init($gtype));
  my N-GValue $nv = $v._get-native-object-no-reffing;
  _g_object_get_property(
    self._get-native-object-no-reffing, $property_name, $nv
  );

  $v
}

multi method get-property(
  gchar-ptr $property_name, $value is copy --> Gnome::GObject::Value
) {
  $value .= _get-native-object-no-reffing unless $value ~~ N-GValue;

  my Gnome::GObject::Value $v .= new(:init($value.g-type));
  _g_object_get_property(
    self._get-native-object-no-reffing, $property_name, $value
  );
  $v._set-native-object($value);

  $v
}



proto sub g_object_get_property (
  N-GObject $object, gchar-ptr $property_name, |
) { * }

#TM:2:g_object_get-property(N-GObject,Prop,Int):xt/Object.t
multi sub g_object_get_property (
  $object, $property_name, Int $type
  --> Gnome::GObject::Value
) {
  my Gnome::GObject::Value $v .= new(:init($type));
  my N-GValue $nv = $v._get-native-object;
  _g_object_get_property( $object, $property_name, $nv);
#  $v._set-native-object($nv);

  $v
}

#TM:2:g_object_get_property(N-GObject,Str,N-GValue):xt/Object.t
multi sub g_object_get_property (
  $object, $property_name, N-GValue $nv
  --> Gnome::GObject::Value
) {
  my Gnome::GObject::Value $v .= new(:init($nv.g-type));
  _g_object_get_property( $object, $property_name, $nv);
  $v._set-native-object($nv);

  $v
}

#`{{
#TM:2:g_object_get_property(N-GObject,Str,Int):xt/Object.t
multi sub g_object_get_property (
  N-GObject $object, Str $property_name, Int $type
  --> Gnome::GObject::Value
) {
  my Gnome::GObject::Value $v .= new(:init($type));
  my N-GValue $nv = $v._get-native-object;
  _g_object_get_property( $object, $property_name, $nv);
  $v._set-native-object($nv);

  $v
}
}}

sub _g_object_get_property (
  N-GObject $object, gchar-ptr $property_name, N-GValue $gvalue is rw
) is native(&gobject-lib)
  is symbol('g_object_get_property')
  { * }

#-------------------------------------------------------------------------------
#TM:1:is-floating:
=begin pod
=head2 is-floating

Checks whether I<object> has a floating reference.

Returns: C<True> if I<object> has a floating reference

  method is-floating ( --> Bool )

=item Pointer $object; (type GObject.Object): a I<GObject>

=end pod
method is-floating ( --> Bool ) {
  g_object_is_floating(self._get-native-object-no-reffing).Bool
}

sub g_object_is_floating ( N-GObject $object --> gboolean )
  is native(&gobject-lib)
  { * }

#-------------------------------------------------------------------------------
#TM:1:ref-sink:
=begin pod
=head2 ref-sink

Increase the reference count of this native I<object>, and possibly remove the floating reference, if I<object> has a floating reference.

In other words, if the object is floating, then this call "assumes ownership" of the floating reference, converting it to a normal reference by clearing the floating flag while leaving the reference count unchanged.  If the object is not floating, then this call adds a new normal reference increasing the reference count by one.

The type of I<object> will be propagated to the return type under the same conditions as for C<g_object_ref()>.

Returns: N-GObject

  method ref-sink ( --> N-GObject )

=end pod

method ref-sink ( --> N-GObject ) {
  g_object_ref_sink(self._get-native-object-no-reffing)
}

sub g_object_ref_sink ( N-GObject $object --> N-GObject )
  is native(&gobject-lib)
  { * }

#-------------------------------------------------------------------------------
#TM:2:register-signal:
=begin pod
=head2 register-signal

Register a handler to process a signal or an event. There are several types of callbacks which can be handled by this regstration. They can be controlled by using a named argument with a special name.

  method register-signal (
    $handler-object, Str:D $handler-name,
    Str:D $signal-name, *%user-options
    --> Int
  )

=item $handler-object; The object wherein the handler is defined.
=item $handler-name; The name of the method.
=begin item
$signal-name; The name of the event to be handled. Each gtk object has its own series of signals.
=end item

=begin item
%user-options; Any other user data in whatever type provided as one or more named arguments. These arguments are provided to the user handler when an event for the handler is fired. The names starting with '_' are reserved to provide other info to the user.

The following reserved named arguments are available;
  =item C<:$_widget>; The instance which registered the signal.
  =item C<:$_handler-id>; The handler id which is returned from the registration
  =item C<:$_native-object>; The native object provided by the caller.
  =begin code
    method some-button-click-handler (
      …,
      Gnome::Gtk3::Button() :_native-object($button)
    ) {
      …
    }
  =end code
=end item

The method returns a handler id which can be used for example to disconnect the callback later.

=head3 Callback handlers

=begin item
Simple handlers; e.g. a click event handler has only named arguments and are optional.
=end item

=begin item
Complex handlers (only a bit) also have positional arguments and B<MUST> be typed because they are checked to create a signature for the call to a native subroutine. You can use the raku native types like C<int32> but several types are automatically converted to native types. The types such as gboolean, etc are defined in B<Gnome::N::GlibToRakuTypes>.
  =begin table
  Raku type | Native glib type | Native Raku type
  ===============================================
  Bool      | gboolean         | int32
  UInt      | guint            | uint32/uint64
  Int       | gint             | int32/int64
  Num       | gfloat           | num32
  Rat       | gdouble          | num64
  =end table
=end item

=begin item
Some handlers must return a value and is used by the calling process. You B<MUST> describe this too in the andlers API, otherwise the returned value is thrown away.
=end item

=begin item
Any user options are provided via named arguments from the call to C<register-signal()>.
=end item

=head3 Example 1

An example of a registration and the handlers signature to handle a button click event.

  # Handler class with callback methods
  class ButtonHandlers {
    method click-button (
      Gnome::Gtk3::Button() :_native-object($button),
      Int :$_handler_id, :$my-option ) {
      …
    }
  }

  $button.register-signal(
    ButtonHandlers.new, 'click-button', 'clicked', :my-option(…)
  );


=head3 Example 2

An example where a keyboard press is handled.

  # Handler class with callback methods
  class KeyboardHandlers {
    method keyboard-handler (
      N-GdkEvent $event,
      Int :$_handler_id, :$my-option
      Gnome::Gtk3::Window() :_native-object($bwindow),
      --> gboolean
    ) {
      …

    }
  }

  $window.register-signal(
    KeyboardHandlers.new, 'keyboard-handler',
    'key-press-event', :my-option(…)
  );


=end pod

method register-signal (
  $handler-object, Str:D $handler-name, Str:D $signal-name, *%user-options
  --> Int
) {

  my Int $handler-id = 0;

  # don't register if handler is not available
  my Method $sh = $handler-object.^lookup($handler-name) // Method;
  if ? $sh {
    if $Gnome::N::x-debug {
      note "\nregister $handler-object\.$handler-name\() for signal $signal-name, options are ", %user-options;
    }

    # search for signal name defined by this class as well as its parent classes
    my Str $signal-type;
    my Str $module-name;
    my @module-names = self.^name, |(map( {.^name}, self.^parents));
    for @module-names -> $mn {
      note "  search in class: $mn, $signal-name" if $Gnome::N