GNOME.org
 

perl-Gtk2 r2135 - in trunk: . t xs

Author: tsch
Date: Wed Feb 11 21:53:14 2009
New Revision: 2135
URL: http://svn.gnome.org/viewvc/perl-Gtk2?rev=2135&view=rev

Log:
Wrap the GtkBindings stuff.  Patch by Kevin Ryde.


Added:
   trunk/t/GtkBindings.t
   trunk/xs/GtkBindings.xs
Modified:
   trunk/ChangeLog
   trunk/Gtk2.pm
   trunk/MANIFEST
   trunk/constants-2.0
   trunk/gtk2perl.h
   trunk/maps-2.0
   trunk/xs_files-2.0

Modified: trunk/Gtk2.pm
==============================================================================
--- trunk/Gtk2.pm	(original)
+++ trunk/Gtk2.pm	Wed Feb 11 21:53:14 2009
@@ -342,6 +342,14 @@
 =item Tag: constants
 
   GTK_PRIORITY_RESIZE
+
+  GTK_PATH_PRIO_LOWEST
+  GTK_PATH_PRIO_GTK
+  GTK_PATH_PRIO_APPLICATION
+  GTK_PATH_PRIO_THEME
+  GTK_PATH_PRIO_RC
+  GTK_PATH_PRIO_HIGHEST
+
   GDK_PRIORITY_EVENTS
   GDK_PRIORITY_REDRAW
   GDK_CURRENT_TIME

Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST	(original)
+++ trunk/MANIFEST	Wed Feb 11 21:53:14 2009
@@ -152,6 +152,7 @@
 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/GtkAspectFrame.xs
 xs/GtkAssistant.xs
 xs/GtkBin.xs
+xs/GtkBindings.xs
 xs/GtkBox.xs
 xs/GtkBuildable.xs
 xs/GtkBuilder.xs

Modified: trunk/constants-2.0
==============================================================================
--- trunk/constants-2.0	(original)
+++ trunk/constants-2.0	Wed Feb 11 21:53:14 2009
@@ -3,3 +3,10 @@
 GDK_PRIORITY_REDRAW
 
 GTK_PRIORITY_RESIZE
+
+GTK_PATH_PRIO_LOWEST
+GTK_PATH_PRIO_GTK
+GTK_PATH_PRIO_APPLICATION
+GTK_PATH_PRIO_THEME
+GTK_PATH_PRIO_RC
+GTK_PATH_PRIO_HIGHEST

Modified: trunk/gtk2perl.h
==============================================================================
--- trunk/gtk2perl.h	(original)
+++ trunk/gtk2perl.h	Wed Feb 11 21:53:14 2009
@@ -1,6 +1,6 @@
 /*
  * 
- * Copyright (C) 2003-2004 by the gtk2-perl team (see the file AUTHORS for the
+ * Copyright (C) 2003-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
@@ -30,6 +30,12 @@
 
 #include "gtk2perl-versions.h"
 
+/* 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 GdkRegion */
 #ifndef GDK_TYPE_REGION
 # define GDK_TYPE_REGION (gtk2perl_gdk_region_get_type ())

Modified: trunk/maps-2.0
==============================================================================
--- trunk/maps-2.0	(original)
+++ trunk/maps-2.0	Wed Feb 11 21:53:14 2009
@@ -1,4 +1,4 @@
-# Copyright (C) 2003-2004 by the gtk2-perl team (see the file AUTHORS for the
+# Copyright (C) 2003-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
@@ -340,3 +340,7 @@
 
 # not really defined by GTK+, but we'll use it for ourselves.
 GDK_TYPE_REGION	GdkRegion	GBoxed	Gtk2::Gdk::Region
+
+# GTK_TYPE_BINDING_SET not defined as of Gtk 2.16, instead jigged up
+# ourselves in gtk2perl.h
+GTK_TYPE_BINDING_SET	GtkBindingSet	GBoxed	Gtk2::BindingSet

Added: trunk/t/GtkBindings.t
==============================================================================
--- (empty file)
+++ trunk/t/GtkBindings.t	Wed Feb 11 21:53:14 2009
@@ -0,0 +1,393 @@
+#!/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 => { param_types   => [],
+                          return_type   => undef,
+                          flags         => ['run-last','action'],
+                          class_closure => \&do_mysig },
+               mysig_with_long => { param_types   => [ 'Glib::Long' ],
+                                    return_type   => undef,
+                                    flags         => ['run-last','action'],
+                                    class_closure => \&do_mysig_with_long },
+               mysig_with_float => { param_types   => [ 'Glib::Double' ],
+                                     return_type   => undef,
+                                     flags         => ['run-last','action'],
+                                     class_closure => \&do_mysig_with_float },
+             };
+my $mysig_seen;
+sub do_mysig {
+  #Test::More::diag ("mysig runs");
+  $mysig_seen = 1;
+}
+my $mysig_with_long_value;
+sub do_mysig_with_long {
+  my ($self, $value) = @_;
+  #Test::More::diag ("mysig_with_long runs, value=$value");
+  $mysig_with_long_value = $value;
+}
+my $mysig_with_float_value;
+sub do_mysig_with_float {
+  my ($self, $value) = @_;
+  #Test::More::diag ("mysig_with_float runs, value=$value");
+  $mysig_with_float_value = $value;
+}
+
+package My::Widget;
+use strict;
+use warnings;
+use Gtk2;
+use Glib::Object::Subclass
+  'Gtk2::EventBox',
+  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;
+# Note: need '-init' to make Gtk2::Rc do its thing ...
+use Gtk2::TestHelper tests => 43;
+
+
+#-----------------------------------------------------------------------------
+# new()
+
+my $mybindings = Gtk2::BindingSet->new('mybindings');
+ok ($mybindings, 'new()');
+
+#-----------------------------------------------------------------------------
+# priority constants
+
+is (Gtk2::GTK_PATH_PRIO_LOWEST, 0);
+ok (Gtk2::GTK_PATH_PRIO_GTK);
+ok (Gtk2::GTK_PATH_PRIO_APPLICATION);
+ok (Gtk2::GTK_PATH_PRIO_THEME);
+ok (Gtk2::GTK_PATH_PRIO_RC);
+ok (Gtk2::GTK_PATH_PRIO_HIGHEST);
+
+#-----------------------------------------------------------------------------
+# set_name() field accessor
+
+is ($mybindings->set_name, 'mybindings',
+    'set_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 $object->bindings_activate() and bindings_activate_event()
+
+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 using 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 ('class', 'My__Widget',
+                                 Gtk2::GTK_PATH_PRIO_APPLICATION);
+
+  my $mywidget = My::Widget->new;
+  my $keyval = Gtk2::Gdk->keyval_from_name ('Return');
+  my $modifiers = [];
+
+  $mywidgetsig_seen = 0;
+  ok ($mywidget->bindings_activate ($keyval,$modifiers),
+      'bindings_activate() return true on mywidget');
+  is ($mywidgetsig_seen, 1,
+      'bindings_activate() runs mywidgetsig on mywidget');
+
+  # This diabolical bit of code is what it takes to synthesize a
+  # Gtk2::Gdk::Event::Key which gtk_bindings_activate_event() will dispatch.
+  # That func looks at the hardware_keycode and group, rather than the
+  # keyval in the event, so must generate those.  hardware_keycode values
+  # are basically arbitrary aren't they?  At any rate the strategy is to
+  # lookup what hardware code is Return in the display keymap and use that.
+  # gtk_bindings_activate_event() then ends up then going the other way,
+  # turning the hardware code into a keyval to lookup in the bindingset!
+  #
+  # The gtk_widget_get_display() docs say $mywidget won't have a display
+  # until it's the child of a toplevel.  Gtk 2.12 will give you back the
+  # default display before then, but probably better not to rely on that.
+  #
+  my $toplevel = Gtk2::Window->new;
+  $toplevel->add ($mywidget);
+  my $display = $mywidget->get_display;
+  my $keymap = Gtk2::Gdk::Keymap->get_for_display ($display);
+  my @keys = $keymap->get_entries_for_keyval ($keyval);
+  # diag "keys ", explain \ keys;
+
+  my $event = Gtk2::Gdk::Event->new ('key-press');
+  $event->window ($mywidget->window);
+  $event->keyval ($keyval);
+  $event->set_state ($modifiers);
+  $event->group($keys[0]->{'group'});
+  $event->hardware_keycode($keys[0]->{'keycode'});
+  $mywidget->bindings_activate_event ($event);
+
+  $mywidgetsig_seen = 0;
+  ok ($mywidget->bindings_activate_event ($event),
+      'bindings_activate() return true on mywidget');
+  is ($mywidgetsig_seen, 1,
+      'bindings_activate() runs mywidgetsig on mywidget');
+
+  $toplevel->destroy;
+}
+
+#-----------------------------------------------------------------------------
+# entry_add_signal()
+
+{
+  my $bindings = Gtk2::BindingSet->new ('entry_add_signal_test');
+  my $obj = My::Object->new;
+
+  {
+    my $keyval = Gtk2::Gdk->keyval_from_name('Return');
+    my $modifiers = [];
+    $bindings->entry_add_signal ($keyval, $modifiers, 'mysig');
+    $mysig_seen = 0;
+    ok ($bindings->activate ($keyval, $modifiers, $obj),
+        'entry_add_signal() activate on MyObject -- dispatch mysig');
+    is ($mysig_seen, 1,
+        'entry_add_signal() activate on MyObject -- ran mysig');
+  }
+
+  # object taking Glib::Long, pass as Glib::Long
+  #
+  {
+    my $keyval = Gtk2::Gdk->keyval_from_name('Escape');
+    my $modifiers = [];
+    my $arg = 12456;
+    $bindings->entry_add_signal ($keyval, $modifiers, 'mysig-with-long',
+                                 'Glib::Long', $arg);
+    $mysig_with_long_value = 0;
+    ok ($bindings->activate ($keyval, $modifiers, $obj),
+        'entry_add_signal() activate on MyObject -- dispatch mysig_with_long');
+    is ($mysig_with_long_value, $arg,
+        'entry_add_signal() activate on MyObject -- mysig_with_long value');
+  }
+
+  # object taking Glib::Float, pass as Glib::Double
+  #
+  {
+    my $keyval = Gtk2::Gdk->keyval_from_name('space');
+    my $modifiers = [ 'control-mask' ];
+    my $arg = 1.25;
+    $bindings->entry_add_signal ($keyval, $modifiers, 'mysig-with-float',
+                                 'Glib::Double', $arg);
+    $mysig_with_float_value = 0;
+    ok ($bindings->activate ($keyval, $modifiers, $obj),
+        'entry_add_signal() activate on MyObject -- dispatch mysig_with_float');
+    delta_ok ($mysig_with_float_value, $arg,
+              'entry_add_signal() activate on MyObject -- mysig_with_float value');
+  }
+
+  Glib::Type->register_flags ('My::Flags',
+                              ['value-one'   =>  8 ],
+                              ['value-two'   => 16 ],
+                              ['value-three' => 32 ]);
+
+  # object taking Glib::Long, give flags as arrayref
+  #
+  {
+    my $keyval = Gtk2::Gdk->keyval_from_name('Escape');
+    my $modifiers = [ 'control-mask' ];
+    my $flags = ['value-one', 'value-three'];
+    my $flags_num = 40;
+    $bindings->entry_add_signal ($keyval, $modifiers, 'mysig-with-long',
+                                 'My::Flags', $flags);
+    $mysig_with_long_value = -1;
+    ok ($bindings->activate ($keyval, $modifiers, $obj),
+        'entry_add_signal() activate on MyObject -- dispatch mysig_with_long');
+    is ($mysig_with_long_value, $flags_num,
+        'entry_add_signal() activate on MyObject -- mysig_with_long value');
+  }
+
+  # object taking Glib::Long, give flags as flags object
+  #
+  {
+    my $keyval = Gtk2::Gdk->keyval_from_name('Escape');
+    my $modifiers = [ 'control-mask' ];
+    my $flags = My::Flags->new (['value-one', 'value-two']);
+    my $flags_num = 24;
+    $bindings->entry_add_signal ($keyval, $modifiers, 'mysig-with-long',
+                                 'Glib::Flags', $flags);
+    $mysig_with_long_value = -1;
+    ok ($bindings->activate ($keyval, $modifiers, $obj),
+        'entry_add_signal() activate on MyObject -- dispatch mysig_with_long');
+    is ($mysig_with_long_value, $flags_num,
+        'entry_add_signal() activate on MyObject -- mysig_with_long value');
+  }
+
+  Glib::Type->register_flags ('My::Enum',
+                              [eeeek => 123 ]);
+
+  # object taking Glib::Long, give enum as string
+  #
+  {
+    my $keyval = Gtk2::Gdk->keyval_from_name('space');
+    my $modifiers = [];
+    $bindings->entry_add_signal ($keyval, $modifiers, 'mysig-with-long',
+                                 'My::Enum', 'eeeek');
+    $mysig_with_long_value = -1;
+    ok ($bindings->activate ($keyval, $modifiers, $obj),
+        'entry_add_signal() activate on MyObject -- dispatch mysig_with_long');
+    is ($mysig_with_long_value, 123,
+        'entry_add_signal() activate on MyObject -- mysig_with_long value');
+  }
+}
+
+#-----------------------------------------------------------------------------
+# entry_remove()
+
+{
+  my $bindings = Gtk2::BindingSet->new ('entry_remove_test');
+  my $obj = My::Object->new;
+
+  my $keyval = Gtk2::Gdk->keyval_from_name('Return');
+  my $modifiers = [];
+  $bindings->entry_add_signal ($keyval, $modifiers, 'mysig');
+
+  $mysig_seen = 0;
+  ok ($bindings->activate ($keyval, $modifiers, $obj),
+      'before entry_remove() activate on MyObject -- dispatch mysig');
+  is ($mysig_seen, 1,
+      'before entry_remove() activate on MyObject -- ran mysig');
+
+  $bindings->entry_remove ($keyval, $modifiers);
+
+  $mysig_seen = 0;
+  ok (! $bindings->activate ($keyval, $modifiers, $obj),
+      'after entry_remove() activate on MyObject -- no dispatch mysig');
+  is ($mysig_seen, 0,
+      'after entry_remove() activate on MyObject -- no run mysig');
+}
+
+
+#-----------------------------------------------------------------------------
+# entry_skip()
+
+# basic invocation on object doesn't dispatch
+{
+  my $skip_bindings = Gtk2::BindingSet->new ('entry_skip_test');
+  my $keyval = Gtk2::Gdk->keyval_from_name('Return');
+  my $modifiers = [];
+  $skip_bindings->entry_add_signal ($keyval, $modifiers, 'mysig');
+
+  my $obj = My::Object->new;
+
+  $mysig_seen = 0;
+  ok ($skip_bindings->activate ($keyval, $modifiers, $obj),
+      'before entry_skip() activate on MyObject -- dispatch mysig');
+  is ($mysig_seen, 1,
+      'before entry_skip() activate on MyObject -- ran mysig');
+
+  $skip_bindings->entry_skip ($keyval, $modifiers);
+
+  $mysig_seen = 0;
+  ok (! $skip_bindings->activate ($keyval, $modifiers, $obj),
+      'after entry_skip() activate on MyObject -- no dispatch mysig');
+  is ($mysig_seen, 0,
+      'after entry_skip() activate on MyObject -- no run mysig');
+
+
+  # When an entry_skip() binding shadows another binding the latter doesn't
+  # run.
+  #
+  # This more exercises gtk than it does the bindings, but it does make sure
+  # the shared code of ->entry_skip() and ->entry_remove() have the right
+  # func under the right name.
+  #
+  my $mywidget = My::Widget->new;
+
+  $mywidgetsig_seen = 0;
+  ok ($mywidget->bindings_activate (Gtk2::Gdk->keyval_from_name('Return'),[]),
+      'before entry_skip(), bindings_activate return true on mywidget');
+  is ($mywidgetsig_seen, 1,
+      'before entry_skip(), bindings_activate runs mywidgetsig on mywidget');
+
+  $skip_bindings->add_path ('widget-class', 'My__Widget',
+                            Gtk2::GTK_PATH_PRIO_HIGHEST);
+
+  $mywidgetsig_seen = 0;
+  ok (! $mywidget->bindings_activate(Gtk2::Gdk->keyval_from_name('Return'),[]),
+      'before entry_skip(), bindings_activate return true on mywidget');
+  is ($mywidgetsig_seen, 0,
+      'before entry_skip(), bindings_activate runs mywidgetsig on mywidget');
+}
+
+exit 0;

Added: trunk/xs/GtkBindings.xs
==============================================================================
--- (empty file)
+++ trunk/xs/GtkBindings.xs	Wed Feb 11 21:53:14 2009
@@ -0,0 +1,416 @@
+/*
+ * 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 a 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 ref counting and
+   no distinction between "own" and "copy".
+
+   ENHANCE-ME: Currently there's nothing to retrieve the contents of a
+   bindingset at the perl level.  The widget_path_pspecs and other pspecs
+   use a private PatternMatch struct so are inaccessible.  The linked list
+   of GtkBindingEntry and their contained GtkBindingSignal might be
+   extracted though, maybe in some form tolerably close to the kind of
+   entry_add_signal() calls that would build the set.  */
+
+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
+
+=for position DESCRIPTION
+
+=head1 DESCRIPTION
+
+A C<Gtk2::BindingSet> is basically a mapping from keyval+modifiers to
+a named action signal to invoke and with argument values for the
+signal.  Bindings are normally run by the C<Gtk2::Widget> default
+C<key-press-event> handler, but can also be activated explicitly.
+
+Binding sets can be populated from program code with
+C<entry_add_signal>, or created from an RC file or string (see
+L<Gtk2::Rc>).  If you use the RC note it doesn't parse and create
+anything until there's someone interested in the result, such as
+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).
+
+Currently there's no Perl-level access to the contents of a
+BindingSet, except for C<set_name>.
+
+=cut
+
+## Method name "set_name()" corresponds to the struct field name.  The name
+## might make you think it's a setter, like other set_foo() funcs, so the
+## couple of words of apidoc here try to make that clear it's a getter,
+## without labouring the point.
+=for apidoc
+Return the name of $binding_set.
+=cut
+gchar *
+set_name (binding_set)
+	GtkBindingSet *binding_set
+    CODE:
+	RETVAL = binding_set->set_name;
+    OUTPUT:
+	RETVAL
+
+## Note no field accessor for "priority", because as noted in the docs
+## it is unused nowadays, and in fact contains garbage.	 (The priority
+## from add_path() is buried in the private PatternSpec struct,
+## establishing an order among the matches, and different places using
+## the same GtkBindingSet can have different priorities ...)
+
+MODULE = Gtk2::BindingSet	PACKAGE = Gtk2::BindingSet	PREFIX = gtk_binding_set_
+
+## Is/was gtk_binding_entry_clear() something subtly different from
+## gtk_binding_entry_remove()?	The code for the two is different as
+## of Gtk circa 2.16.
+##
+## void
+## gtk_binding_entry_clear (binding_set, keyval, modifiers)
+##     GtkBindingSet *binding_set
+##     guint keyval
+##     GdkModifierType modifiers
+
+## GtkBindingSet* gtk_binding_set_new (const gchar *set_name)
+## GtkBindingSet* gtk_binding_set_find (const gchar *set_name)
+## GtkBindingSet* gtk_binding_set_by_class (gpointer object_class)
+##
+## gtk_binding_set_new() copies the given set_name, so the string need
+## not live beyond the call
+##
+## Only gtk_binding_set_find() needs the "ornull" return, new() and
+## by_class() are never NULL.
+##
+## In other wrappers normally new() would be an "_own", find() not,
+## and by_class() probably not, but as noted at the start of the file
+## there's no copying or freeing of GtkBindingSet so no such
+## distinction needed here.
+##
+=for apidoc Gtk2::BindingSet::new
+=for signature GtkBindingSet = Gtk2::BindingSet->new ($set_name)
+=for arg set_name (string)
+=for arg name (__hide__)
+=cut
+
+=for apidoc Gtk2::BindingSet::find
+=for signature GtkBindingSet_ornull Gtk2::BindingSet->find ($set_name)
+=for arg set_name (string)
+=for arg name (__hide__)
+=cut
+
+=for apidoc Gtk2::BindingSet::by_class
+=for signature GtkBindingSet = Gtk2::BindingSet->by_class ($package_name)
+=for arg package_name (string)
+=for arg name (__hide__)
+=cut
+
+=for apidoc new __hide__
+=for apidoc find __hide__
+=for apidoc by_class __hide__
+=cut
+GtkBindingSet_ornull* gtk_binding_set_new (class, name)
+	const gchar *name
+    ALIAS:
+	find = 1
+	by_class = 2
+    CODE:
+	switch (ix) {
+	case 0:
+		RETVAL = gtk_binding_set_new (name);
+		break;
+	case 1:
+		RETVAL = gtk_binding_set_find (name);
+		break;
+	default:
+	    {
+		GType type;
+		GtkObjectClass *oclass;
+		type = gperl_object_type_from_package (name);
+		if (! type)
+			croak ("package %s is not registered to a GType",
+			       name);
+		if (! g_type_is_a (type, GTK_TYPE_OBJECT))
+			croak ("'%s' is not an object subclass", name);
+		oclass = (GtkObjectClass*) g_type_class_ref (type);
+		RETVAL = gtk_binding_set_by_class (oclass);
+		g_type_class_unref (oclass);
+	    }
+	    break;
+	}
+    OUTPUT:
+	RETVAL
+
+gboolean
+gtk_binding_set_activate (binding_set, keyval, modifiers, object)
+     GtkBindingSet *binding_set
+     guint keyval
+     GdkModifierType modifiers
+     GtkObject *object
+
+=for apidoc
+The following constants are defined for standard priority levels,
+
+    Gtk2::GTK_PATH_PRIO_LOWEST
+    Gtk2::GTK_PATH_PRIO_GTK
+    Gtk2::GTK_PATH_PRIO_APPLICATION
+    Gtk2::GTK_PATH_PRIO_THEME
+    Gtk2::GTK_PATH_PRIO_RC
+    Gtk2::GTK_PATH_PRIO_HIGHEST
+
+LOWEST, which is 0, and HIGHEST, which is 15, are the limits of the
+allowed priorities.  The standard values are from the
+C<Gtk2::PathPriorityType> enum, but the parameter here is an integer,
+not an enum string, so you can give a value for instance a little
+above or below the pre-defined levels.
+=cut
+void
+gtk_binding_set_add_path (binding_set, path_type, path_pattern, priority)
+     GtkBindingSet *binding_set
+     GtkPathType path_type
+     const gchar *path_pattern
+     int priority
+
+MODULE = Gtk2::BindingSet	PACKAGE = Gtk2::BindingSet	PREFIX = gtk_binding_
+
+=for apidoc
+=for signature $binding_set->entry_add_signal ($keyval, $modifiers, $signal_name)
+=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 as a
+binding for $signal_name and with signal parameters given by $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 or 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
+## The list style "_signall" version is best here, rather than the
+## varargs "_signal".  "_signall" is marked as "deprecated" circa Gtk
+## 2.12.  Of course deprecated is not a word but in this case it means
+## "useful feature taken away".	 As of Gtk 2.16 _signal is in fact
+## implemented as a front end to _signall, though with some extra
+## coercions on the args, allowing for instance GValue containing
+## G_TYPE_INT to promote to G_TYPE_LONG.
+##
+## 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,
+##				      ...);
+##
+## There may be some scope for expanding the helper "type"s accepted.
+## For example 'Glib::Boolean' could take the usual perl true/false
+## and turn it into 0 or 1.  Or 'Glib::Unichar' could take a single
+## char string and store its ordinal.  Both can be done with
+## 'Glib::Long' and a "!!" boolizing or ord() lookup, so it's just
+## about what would be helpful and what would be useless bloat.	 The
+## Flags and Enum provided are quite helpful because it's not
+## particularly easy to extract the number.  A Unichar would probably
+## be bloat since there's no signals which take a char ordinal as a
+## parameter, is there?
+##
+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 if sv_type is not registered; it falls
+		 * through to the "default:" error
+		 */
+		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);
+
+## void gtk_binding_entry_remove (GtkBindingSet *binding_set,
+##				  guint keyval,
+##				  GdkModifierType modifiers);
+void
+gtk_binding_entry_skip (binding_set, keyval, modifiers)
+	GtkBindingSet *binding_set
+	guint keyval
+	GdkModifierType modifiers
+    ALIAS:
+	entry_remove = 1
+    CODE:
+	if (ix == 0)
+		gtk_binding_entry_skip (binding_set, keyval, modifiers);
+	else
+		gtk_binding_entry_remove (binding_set, keyval, modifiers);
+
+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

Modified: trunk/xs_files-2.0
==============================================================================
--- trunk/xs_files-2.0	(original)
+++ trunk/xs_files-2.0	Wed Feb 11 21:53:14 2009
@@ -51,6 +51,7 @@
 xs/GtkArrow.xs
 xs/GtkAspectFrame.xs
 xs/GtkBin.xs
+xs/GtkBindings.xs
 xs/GtkBox.xs
 xs/GtkButton.xs
 xs/GtkButtonBox.xs
[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]