Re: GtkBindingSet etc

[Torsten Schoenfeld <kaffeetisch gmx de>]

Kevin Ryde wrote:
> I got to this point on entry_add_signal.  It means you can populate
> bindings from program code.  See if the docs are as clear as mud.

Looks great to me.  Here's a patch that incorporates all your changes.  It also 
shuffles things around a bit.

A few small nits:

• Why call the set_name accessor just "name"?  The "set_" part might be 
redundant, but that's what it's called everywhere else.

• gtk_bindings_activate_event, gtk_binding_entry_skip, gtk_binding_entry_remove, 
and gtk_binding_entry_add_signal are untested.  I tried tackling 
gtk_bindings_activate_event but I couldn't get it to do anything.

I filed a bug about gtk_binding_entry_add_signall being deprecated: 
<http://bugzilla.gnome.org/show_bug.cgi?id=571196>.

> I don't want to much for field accessors, not initially.  So the only
> outstanding point would be whether add_path() should take
> GtkPathPriorityType enum strings, or integer values, or both.  I think a
> priority() field accessor would return an integer, so add_path() might
> want to accept an integer, whatever else it does or doesn't do.  (The
> point as before being that not all possible values are covered by the
> enum members ...)

I think I'd prefer the integer-only approach to handling GtkPathPriorityType: 
accept and return only integers, and provide constants akin to G_PRIORITY_*.
Index: gtk2perl.h
===================================================================
--- gtk2perl.h  (revision 2134)
+++ gtk2perl.h  (working copy)
@@ -1,7 +1,7 @@
 /*
  * 
- * Copyright (C) 2003-2004 by the gtk2-perl team (see the file AUTHORS for the
- * full list)
+ * Copyright (C) 2003-2004, 2009 by the gtk2-perl team (see the file AUTHORS
+ * for the full list)
  * 
  * This library is free software; you can redistribute it and/or modify it
  * under the terms of the GNU Library General Public License as published by
@@ -36,6 +36,12 @@
   GType gtk2perl_gdk_region_get_type (void) G_GNUC_CONST;
 #endif
 
+/* custom GType for GtkBindingSet */
+#ifndef GTK_TYPE_BINDING_SET
+# define GTK_TYPE_BINDING_SET (gtk2perl_binding_set_get_type ())
+  GType gtk2perl_binding_set_get_type (void) G_GNUC_CONST;
+#endif
+
 /* custom GType for PangoAttribute */
 #ifndef PANGO_TYPE_ATTRIBUTE
 # define PANGO_TYPE_ATTRIBUTE (gtk2perl_pango_attribute_get_type ())
Index: MANIFEST
===================================================================
--- MANIFEST    (revision 2134)
+++ MANIFEST    (working copy)
@@ -152,6 +152,7 @@ t/GtkArrow.t
 t/GtkAspectFrame.t
 t/GtkAssistant.t
 t/GtkBin.t
+t/GtkBindings.t
 t/GtkBox.t
 t/GtkBuildable.t
 t/GtkBuildableIface.t
@@ -373,6 +374,7 @@ xs/GtkArrow.xs
 xs/GtkAspectFrame.xs
 xs/GtkAssistant.xs
 xs/GtkBin.xs
+xs/GtkBindings.xs
 xs/GtkBox.xs
 xs/GtkBuildable.xs
 xs/GtkBuilder.xs
Index: xs_files-2.0
===================================================================
--- xs_files-2.0        (revision 2134)
+++ xs_files-2.0        (working copy)
@@ -51,6 +51,7 @@ xs/GtkAlignment.xs
 xs/GtkArrow.xs
 xs/GtkAspectFrame.xs
 xs/GtkBin.xs
+xs/GtkBindings.xs
 xs/GtkBox.xs
 xs/GtkButton.xs
 xs/GtkButtonBox.xs
Index: Makefile.PL
===================================================================
--- Makefile.PL (revision 2134)
+++ Makefile.PL (working copy)
@@ -33,7 +33,7 @@ use Cwd;
 our %build_reqs = (
        'perl-ExtUtils-Depends'   => '0.300',
        'perl-ExtUtils-PkgConfig' => '1.030',
-       'perl-Glib'               => '1.200', # FIXME: 1.212 for precompiled headers
+       'perl-Glib'               => '1.212', # FIXME: 1.220
        'perl-Pango'              => '1.210',
        'perl-Cairo'              => '1.000',
        'Gtk+'                    => '2.0.0',
@@ -286,7 +286,7 @@ WriteMakefile(
     $gtk2->get_makefile_vars,
 );
 
-=unstable
+#=unstable
 
 print <<__EOW__;
 WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING
@@ -294,12 +294,12 @@ WARNING WARNING WARNING WARNING WARNING 
    This is an unstable development release of Gtk2.  The API is not
    frozen and things are subject to change at any time.  Report any
    bugs to gtk-perl-list AT gnome DOT org as soon as possible.
-   Please use the 1.18x series for important work.
+   Please use the 1.20x series for important work.
 
 WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING
 __EOW__
 
-=cut
+#=cut
 
 =frozen
 
Index: xs/GtkBindings.xs
===================================================================
--- xs/GtkBindings.xs   (revision 0)
+++ xs/GtkBindings.xs   (revision 0)
@@ -0,0 +1,353 @@
+/*
+ * Copyright 2009 by the gtk2-perl team (see the file AUTHORS)
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Library General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version.
+ *
+ * This library 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
+ * Library General Public License for more details.
+ *
+ * You should have received a copy of the GNU Library General Public
+ * License along with this library; if not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include "gtk2perl.h"
+
+/* GtkBindingSet is struct treated here as a boxed type.  As of Gtk 2.12
+   there's no GType for it, so that's created here, with a #ifndef in
+   gtk2perl.h in case gtk gains it later.
+
+   Once created a GtkBindingSet is never destroyed, so no distinction
+   between "own" and "copy".  */
+
+static GtkBindingSet *
+gtk2perl_binding_set_copy (GtkBindingSet *binding_set)
+{
+       /* no copying */
+       return binding_set;
+}
+static void
+gtk2perl_binding_set_free (GtkBindingSet *binding_set)
+{
+       /* no freeing */
+}
+GType
+gtk2perl_binding_set_get_type (void)
+{
+       static GType binding_set_type = 0;
+       if (binding_set_type == 0)
+               binding_set_type = g_boxed_type_register_static
+                       ("Gtk2perlBindingSet",
+                        (GBoxedCopyFunc) gtk2perl_binding_set_copy,
+                        (GBoxedFreeFunc) gtk2perl_binding_set_free);
+       return binding_set_type;
+}
+
+MODULE = Gtk2::BindingSet      PACKAGE = Gtk2::BindingSet      PREFIX = gtk_binding_set_
+
+=for position DESCRIPTION
+
+=head1 DESCRIPTION
+
+A C<Gtk2::BindingSet> is basically a mapping from keys (ie. keyboard
+keystrokes) to named signals (action signals) which are to be invoked when
+the user presses such a key.
+
+Most of the time you can create binding sets just with RC files,
+including C<< Gtk2::Rc->parse_string >> etc from within a program,
+then the default C<Gtk2::Widget> handler for C<key_press_event> puts
+the key through the bindings for the class.  But you can create extra
+binding sets for special purposes, or invoke bindings for keys etc
+from unusual places.
+
+When creating bindings with C<Gtk2::Rc> bear in mind that as of Gtk
+2.12 the rc mechanism doesn't actually parse until someone is
+interested in the result, for example the C<Gtk2::Settings> for
+widgets.  This means binding sets in rc files or strings don't exist
+for C<< Gtk2::BindingSet->find >> to retrieve until at least one
+widget has been created (or similar).
+
+=cut
+
+## field accessor
+gchar *
+name (binding_set)
+       GtkBindingSet *binding_set
+    CODE:
+       RETVAL = binding_set->set_name;
+    OUTPUT:
+       RETVAL
+
+## This would return an integer, rather than a GtkPathPriorityType
+## enum string.  That's probably pretty reasonable, and certainly most
+## helpful if you're going to sort by priority, etc, but give it a
+## little thought just yet ...
+##
+## field accessor
+## gint
+## priority (binding_set)
+##     GtkBindingSet *binding_set
+##    CODE:
+##     RETVAL = binding_set->priority
+##    OUTPUT:
+##     RETVAL
+
+## GtkBindingSet* gtk_binding_set_new (const gchar *set_name)
+## set_name is copied, so doesnt need to live beyond the call
+GtkBindingSet_own* gtk_binding_set_new (class, set_name)
+       const gchar *set_name
+    C_ARGS:
+       set_name
+
+##GtkBindingSet* gtk_binding_set_by_class (gpointer object_class)
+GtkBindingSet_copy*
+gtk_binding_set_by_class (class, package_name)
+       const char *package_name
+    PREINIT:
+       GType type;
+       GtkObjectClass *oclass;
+    CODE:
+       /* ENHANCE-ME: do GtkObjectClass* through the typemap */
+       type = gperl_object_type_from_package (package_name);
+       if (! type)
+               croak ("package %s is not registered to a GType",
+                      package_name);
+       if (! g_type_is_a (type, GTK_TYPE_OBJECT))
+               croak ("'%s' is not an object subclass", package_name);
+       oclass = (GtkObjectClass*) g_type_class_ref (type);
+       RETVAL = gtk_binding_set_by_class (oclass);
+       g_type_class_unref (oclass);
+    OUTPUT:
+       RETVAL
+
+## GtkBindingSet* gtk_binding_set_find (const gchar *set_name)
+GtkBindingSet_ornull* gtk_binding_set_find (class, set_name)
+       const gchar *set_name
+    C_ARGS:
+       set_name
+
+gboolean
+gtk_binding_set_activate (binding_set, keyval, modifiers, object)
+     GtkBindingSet *binding_set
+     guint keyval
+     GdkModifierType modifiers
+     GtkObject *object
+
+## Could helpfully take priority values also as integers, since the enum values
+## don't cover the whole 0 to 15 range.
+void
+gtk_binding_set_add_path (binding_set, path_type, path_pattern, priority)
+     GtkBindingSet *binding_set
+     GtkPathType path_type
+     const gchar *path_pattern
+     GtkPathPriorityType priority
+
+
+
+MODULE = Gtk2::BindingSet      PACKAGE = Gtk2::BindingSet      PREFIX = gtk_binding_
+
+void
+gtk_binding_entry_skip (binding_set, keyval, modifiers)
+     GtkBindingSet *binding_set
+     guint keyval
+     GdkModifierType modifiers
+
+## Since gtk_binding_entry_clear() is deprecated, we leave it out.
+##
+## void
+## gtk_binding_entry_clear (binding_set, keyval, modifiers)
+##     GtkBindingSet *binding_set
+##     guint keyval
+##     GdkModifierType modifiers
+
+void
+gtk_binding_entry_remove (binding_set, keyval, modifiers)
+       GtkBindingSet *binding_set
+       guint keyval
+       GdkModifierType modifiers
+
+## entry_add_signal() is the programmatic way to add a binding set
+## entry with a keystroke and the signal to emit.
+##
+## The tricky bit is that the arguments to the signal must have types
+## decided at this point, ie. int, float, string, identifier, etc.
+## It's no good to look at the signal for what the argument types will
+## be, since it can be emitted on any class, even classes which don't
+## exist yet.
+##
+## The list style "_signall" version is best here, rather than the
+## varargs "_signal".  "_signall" is marked as "deprecated" which of
+## course is not a word but in this case means "useful feature taken
+## away".
+##
+## void gtk_binding_entry_add_signall (GtkBindingSet *binding_set,
+##                                     guint keyval,
+##                                     GdkModifierType modifiers,
+##                                     const gchar *signal_name,
+##                                     GSList *binding_args);
+##
+## void gtk_binding_entry_add_signal (GtkBindingSet *binding_set,
+##                                    guint keyval,
+##                                    GdkModifierType modifiers,
+##                                    const gchar *signal_name,
+##                                    guint n_args,
+##                                    ...);
+=for apidoc
+=for signature $binding_set->entry_add_signal (keyval, modifiers, signal_name, type, value, ...)
+=for arg type (string)
+=for arg value (scalar)
+=for arg ... (__hide__)
+Add an entry to $binding_set.  $keyval and $modifier are setup to
+invoke $signal_name, with signal parameters given by the $value
+arguments.  Each value is preceded by a type (a string), which must be
+one of
+
+    Glib::Long
+    Glib::Double
+    Glib::String
+    an enum type, ie. subtype of Glib::Enum
+    Glib::Flags, or a flags subtype
+
+For example,
+
+    $binding_set->entry_add_signal
+        (Gtk2->keyval_from_name('Return'),
+         [ 'control-mask' ],   # modifiers
+         'some-signal-name',
+         'Glib::Double', 1.5,
+         'Glib::String,  'hello');
+
+A parameter holds one of the three types Long, Double and String.
+When invoked they're coerced to the parameter types expected by the
+target object or widget.  Use Glib::Long for any integer argument,
+including chars and unichars by ordinal value.  Use Glib::Double for
+both single and double precision floats.
+
+Flags and enums are held as Longs in the BindingSet.  You can pass an
+enum type and string and C<entry_with_signal> will lookup and store
+accordingly.  For example
+
+    $binding_set->entry_add_signal
+        (Gtk2->keyval_from_name('Escape'), [],
+         'set-direction',
+         'Gtk2::Orientation', 'vertical');
+
+Likewise flags from an arrayref,
+
+    $binding_set->entry_add_signal
+        (Gtk2->keyval_from_name('d'), [],
+         'initiate-drag',
+         'Gtk2::Gdk::DragAction', ['move,'ask']);
+
+If you've got a Glib::Flags object, rather than just an arrayref, then
+you can just give Glib::Flags as the type and the value is taken from
+the object.  For example,
+
+    my $flags = Gtk2::DebugFlag->new (['tree', 'updates']);
+    $binding_set->entry_add_signal
+        (Gtk2->keyval_from_name('x'), ['control-mask'],
+         'change-debug',
+         'Glib::Flags', $flags);
+=cut
+void
+gtk_binding_entry_add_signal (binding_set, keyval, modifiers, signal_name, ...)
+       GtkBindingSet *binding_set
+       guint keyval
+       GdkModifierType modifiers
+       const gchar *signal_name
+    PREINIT:
+       const int first_argnum = 4;
+       int count, i;
+       GSList *binding_args = NULL;
+       GtkBindingArg *ap;
+    CODE:
+       count = (items - first_argnum);
+       if ((count % 2) != 0) {
+               croak ("entry_add_signal expects type,value pairs "
+                      "(odd number of arguments detected)");
+       }
+       count /= 2;
+       ap = g_new (GtkBindingArg, count);
+       for (i = 0; i < count; i += 2) {
+               SV *sv_type  = ST(i + first_argnum);
+               SV *sv_value = ST(i + first_argnum + 1);
+               GType gtype  = gperl_type_from_package(SvPV_nolen(sv_type));
+
+                /* gtype==G_TYPE_NONE for sv_type not registered will fall
+                 * through to the default
+                */
+               switch (G_TYPE_FUNDAMENTAL (gtype)) {
+               case G_TYPE_LONG:
+                       ap[i].d.long_data = SvIV(sv_value);
+                       break;
+               case G_TYPE_DOUBLE:
+                       ap[i].d.double_data = SvNV(sv_value);
+                       break;
+               case G_TYPE_STRING:
+                       /* GTK_TYPE_IDENTIFIER comes through here, but
+                        * believe that's only a hangover from gtk 1.2 and
+                        * needs no special attention.
+                        */
+                       /* gtk copies the string */
+                       ap[i].d.string_data = SvPV_nolen(sv_value);
+                       break;
+
+               /* helpers converting to the three basic types ... */
+               case G_TYPE_ENUM:
+                       /* coerce enum to long */
+                       ap[i].d.long_data = gperl_convert_enum(gtype,sv_value);
+                       gtype = G_TYPE_LONG;
+                       break;
+               case G_TYPE_FLAGS:
+                       /* coerce flags to long */
+                       ap[i].d.long_data = gperl_convert_flags(gtype,sv_value);
+                       gtype = G_TYPE_LONG;
+                       break;
+
+               default:
+                       g_slist_free (binding_args);
+                        g_free (ap);
+                       croak ("Unrecognised argument type '%s'",
+                               SvPV_nolen(sv_type));
+               }
+               ap[i].arg_type = gtype;
+               binding_args = g_slist_append (binding_args, &(ap[i]));
+       }
+       gtk_binding_entry_add_signall (binding_set, keyval, modifiers,
+                                      signal_name, binding_args);
+       g_slist_free (binding_args);
+       g_free (ap);
+
+
+
+MODULE = Gtk2::BindingSet      PACKAGE = Gtk2::Object  PREFIX = gtk_
+
+=for apidoc
+Although C<activate> and C<activate_event> are C<Gtk2::Object>
+methods, as of Gtk 2.12 they will only actually invoke signals on a
+C<Gtk2::Widget>.  On a C<Gtk2::Object> the return is always false (no
+binding activated).
+=cut
+gboolean
+gtk_bindings_activate (object, keyval, modifiers)
+       GtkObject *object
+       guint keyval
+       GdkModifierType modifiers
+
+gboolean
+gtk_bindings_activate_event (object, event)
+       GtkObject *object
+       GdkEvent *event
+PREINIT:
+       GdkEventType type;
+CODE:
+       type = event->type;
+       if (type != GDK_KEY_PRESS && type != GDK_KEY_RELEASE)
+               croak ("Event must be key-press or key-release");
+       RETVAL = gtk_bindings_activate_event (object, (GdkEventKey*) event);
+OUTPUT:
+       RETVAL
Index: maps-2.0
===================================================================
--- maps-2.0    (revision 2134)
+++ maps-2.0    (working copy)
@@ -1,5 +1,5 @@
-# Copyright (C) 2003-2004 by the gtk2-perl team (see the file AUTHORS for the
-# full list)
+# Copyright (C) 2003-2004, 2009 by the gtk2-perl team (see the file AUTHORS for
+# the full list)
 # 
 # This library is free software; you can redistribute it and/or modify it under
 # the terms of the GNU Library General Public License as published by the Free
@@ -340,3 +340,5 @@ GTK_TYPE_WRAP_MODE  GtkWrapMode     GEnum   Gtk
 
 # not really defined by GTK+, but we'll use it for ourselves.
 GDK_TYPE_REGION        GdkRegion       GBoxed  Gtk2::Gdk::Region
+
+GTK_TYPE_BINDING_SET   GtkBindingSet   GBoxed  Gtk2::BindingSet
Index: t/GtkBindings.t
===================================================================
--- t/GtkBindings.t     (revision 0)
+++ t/GtkBindings.t     (revision 0)
@@ -0,0 +1,138 @@
+#!/usr/bin/perl
+
+# Copyright 2009 by the gtk2-perl team (see the file AUTHORS)
+#
+# This library is free software; you can redistribute it and/or
+# modify it under the terms of the GNU Library General Public
+# License as published by the Free Software Foundation; either
+# version 2.1 of the License, or (at your option) any later version.
+#
+# This library 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
+# Library General Public License for more details.
+#
+# You should have received a copy of the GNU Library General Public
+# License along with this library; if not, see <http://www.gnu.org/licenses/>.
+
+package My::Object;
+use strict;
+use warnings;
+use Gtk2;
+use Glib::Object::Subclass
+  'Gtk2::Object',
+  signals => { mysig => { parameter_types => [],
+                          return_type => undef,
+                          flags => ['run-last','action'],
+                          class_closure => \&do_mysig },
+             };
+my $mysig_seen;
+sub do_mysig {
+  Test::More::diag ("mysig runs");
+  $mysig_seen = 1;
+}
+
+package My::Widget;
+use strict;
+use warnings;
+use Gtk2;
+use Glib::Object::Subclass
+  'Gtk2::Widget',
+  signals => { mywidgetsig => { parameter_types => [],
+                          return_type => undef,
+                          flags => ['run-last','action'],
+                          class_closure => \&do_mywidgetsig },
+             };
+my $mywidgetsig_seen;
+sub do_mywidgetsig {
+  Test::More::diag ("mywidgetsig runs");
+  $mywidgetsig_seen = 1;
+}
+
+package main;
+use strict;
+use warnings;
+use Gtk2::TestHelper tests => 11;
+
+#-----------------------------------------------------------------------------
+# new()
+
+my $mybindings = Gtk2::BindingSet->new('mybindings');
+ok ($mybindings, 'new()');
+
+#-----------------------------------------------------------------------------
+# name() field accessor
+
+is ($mybindings->name, 'mybindings',
+    'name() of mybindings');
+
+#-----------------------------------------------------------------------------
+# find()
+
+ok (Gtk2::BindingSet->find('mybindings'),
+    'find() mybindings');
+is (Gtk2::BindingSet->find('nosuchbindingset'), undef,
+    'find() not found');
+
+#-----------------------------------------------------------------------------
+# by_class()
+
+ok (Gtk2::BindingSet->by_class('Gtk2::Entry'),
+    'by_class() Gtk2::Entry');
+
+#-----------------------------------------------------------------------------
+# activate()
+
+# The rc mechanism doesn't actually parse anything or create any
+# GtkBindingSet's until one or more GtkSettings objects exist and are
+# interested in the rc values.  Create a dummy label widget to force that to
+# happen and thus ensure creation of the "some_bindings" set.
+#
+my $dummy_label = Gtk2::Label->new;
+
+Gtk2::Rc->parse_string (<<'HERE');
+binding "some_bindings" {
+  bind "Return" { "mysig" () }
+}
+HERE
+
+{
+  my $some_bindings = Gtk2::BindingSet->find('some_bindings');
+  ok ($some_bindings, 'find() of RC parsed bindings');
+
+  my $myobj = My::Object->new;
+  $mysig_seen = 0;
+  ok ($some_bindings->activate (Gtk2::Gdk->keyval_from_name('Return'),
+                                [],$myobj),
+      'activate() return true on myobj');
+  is ($mysig_seen, 1, 'activate() runs mysig on myobj');
+}
+
+#-----------------------------------------------------------------------------
+# add_path() and bindings_activate()
+
+Gtk2::Rc->parse_string (<<'HERE');
+binding "my_widget_bindings" {
+  bind "Return" { "mywidgetsig" () }
+}
+HERE
+
+# As of Gtk 2.12 $gtkobj->bindings_activate() only actually works on a
+# Gtk2::Widget, not a Gtk2::Object, hence My::Widget to exercise add_path()
+# instead of My::Object.
+{
+  my $my_widget_bindings = Gtk2::BindingSet->find('my_widget_bindings');
+  ok ($my_widget_bindings, 'find() of RC parsed bindings');
+
+  $my_widget_bindings->add_path ('widget-class', 'My__Widget', 'application');
+
+  my $mywidget = My::Widget->new;
+
+  $mywidgetsig_seen = 0;
+  ok ($mywidget->bindings_activate (Gtk2::Gdk->keyval_from_name('Return'), []),
+      'bindings_activate() return true on mywidget');
+  is ($mywidgetsig_seen, 1,
+      'bindings_activate() runs mywidgetsig on mywidget');
+}
+
+exit 0;