Re: GtkBindingSet etc

[Kevin Ryde <user42 zip com au>]

I got to this point (how to include added files in an "svn diff"?).  It
goes ok.  I think $bindingset->activate(keyval,modifiers,object) can do
the dispatch part of what I was pondering for object add-ons, but I'm
now not certain if the rc stuff actually leaves me any more configurable
than before ... the priority mechanism seems geared towards widgets.


/*
 * 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".  */

GtkBindingSet *
gtk2perl_binding_set_copy (GtkBindingSet *binding_set)
{
	/* no copying */
	return binding_set;
}
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 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

MODULE = Gtk2::BindingSet	PACKAGE = Gtk2::BindingSet	PREFIX = gtk_binding_set_

## Is/was gtk_binding_entry_clear() something subtly different from
## gtk_binding_entry_remove()?
##
## 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)
## 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

## See GtkObject.xs
## gboolean gtk_bindings_activate (GtkObject *object,
##                                 guint keyval,
##                                 GdkModifierType modifiers)

## See GtkObject.xs
## gboolean gtk_bindings_activate_event (GtkObject *object,
##                                       GdkEventKey *event)

gboolean
gtk_binding_set_activate (binding_set, keyval, modifiers, object)
     GtkBindingSet *binding_set
     guint keyval
     GdkModifierType modifiers
     GtkObject *object

## 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 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,
##                                    ...);

## ENHANCE-ME: 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

void
gtk_binding_entry_remove (binding_set, keyval, modifiers)
	GtkBindingSet *binding_set
	guint keyval
	GdkModifierType modifiers

#!/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,
  noinit => 1;  # don't think a display is needed ...
use Gtk2 '-init';

#-----------------------------------------------------------------------------
# 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;

Index: MANIFEST
===================================================================
--- MANIFEST	(revision 2104)
+++ MANIFEST	(working copy)
@@ -151,6 +151,7 @@
 t/GtkAspectFrame.t
 t/GtkAssistant.t
 t/GtkBin.t
+t/GtkBindings.t
 t/GtkBox.t
 t/GtkBuildable.t
 t/GtkBuildableIface.t
@@ -371,6 +372,7 @@
 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 2104)
+++ xs_files-2.0	(working copy)
@@ -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
Index: maps-2.0
===================================================================
--- maps-2.0	(revision 2104)
+++ maps-2.0	(working copy)
@@ -1,4 +1,4 @@
-# Copyright (C) 2003-2004 by the gtk2-perl team (see the file AUTHORS for the
+# 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
@@ -340,3 +340,5 @@
 
 # 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: gtk2perl.h
===================================================================
--- gtk2perl.h	(revision 2104)
+++ gtk2perl.h	(working copy)
@@ -1,6 +1,6 @@
 /*
  * 
- * Copyright (C) 2003-2004 by the gtk2-perl team (see the file AUTHORS for the
+ * 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
@@ -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 ())