With a perl custom treemodel and a perl connected rows-reordered signal,
there seems to be a gremlin in the way $model->rows_reordered reaches
the signal handler. The slightly nasty reordered.pl below for instance
prints
$VAR1 = [
0,
undef,
where I hoped for the instance object and a treepath in the first two
args. The diff below to examples examples/customlist.pl gives also
$VAR1 = [
1,
'rows',
I wonder if it might be something like
* xs/GtkTreeModel.xs (gtk2perl_tree_model_rows_reordered_marshal):
Call gtk_tree_model_iter_n_children before building the stack, in case
it's a Perl class and calls out to ITER_N_CHILDREN. This fixes
clobbering of instance and treepath args to a Perl rows-reordered
handler connected on a Perl model.
* t/GtkTreeModelIface.t: Exercise rows-reordered marshalling.
package MyModel;
use strict;
use warnings;
use Gtk2;
use Glib::Object::Subclass
Glib::Object::,
interfaces => [ Gtk2::TreeModel:: ];
use constant LEN => 2;
sub INIT_INSTANCE {
my ($self) = @_;
}
sub GET_FLAGS {
return [ 'list-only' ];
}
sub GET_N_COLUMNS {
return 1;
}
sub GET_COLUMN_TYPE {
return 'Glib::String';
}
sub GET_ITER {
my ($self, $path) = @_;
if ($path->get_depth != 1) { return undef; }
my ($index) = $path->get_indices;
if ($index >= LEN) { return undef; }
return [ 123, $index, undef, undef ];
}
sub GET_PATH {
my ($self, $iter) = @_;
return Gtk2::TreePath->new_from_indices ($iter->[1]);
}
sub ITER_N_CHILDREN {
print "ITER_N_CHILDREN\n";
return 2;
}
sub ITER_NTH_CHILD {
my ($self, $iter, $n) = @_;
if (defined $iter) { return undef; }
if ($n >= 2) { return undef; }
return [ 123, $n, undef, undef ];
}
sub ITER_HAS_CHILD {
my ($self, $iter) = @_;
if (defined $iter) {
return 0; # nothing under rows
} else {
return 1;
}
}
sub ITER_PARENT {
return undef;
}
use strict;
use warnings;
use Gtk2 '-init';
use Data::Dumper;
my $model = MyModel->new;
$model->signal_connect
(rows_reordered => sub {
print "reordered signal:\n";
print Dumper([EMAIL PROTECTED]);
});
$model->rows_reordered (Gtk2::TreePath->new_from_indices(99,88,77), undef, 1, 0);
exit 0;
--- customlist.pl 01 Aug 2004 12:44:05 +1000 1.2
+++ customlist.pl 07 Jul 2008 09:52:14 +1000
@@ -442,6 +442,14 @@
my $customlist = CustomList->new;
fill_model ($customlist);
+ use Data::Dumper;
+ $customlist->signal_connect (rows_reordered => sub {
+ print Dumper([EMAIL PROTECTED]);
+ },
+ 'my-userdata');
+ $customlist->rows_reordered (Gtk2::TreePath->new, undef,
+ 0 .. $customlist->iter_n_children(undef) - 1);
+
my $view = Gtk2::TreeView->new ($customlist);
my $renderer = Gtk2::CellRendererText->new;
--- GtkTreeModel.xs 07 Jul 2008 09:53:48 +1000 1.54
+++ GtkTreeModel.xs 07 Jul 2008 09:54:47 +1000
@@ -42,6 +42,13 @@
int n_children, i;
dGPERL_CLOSURE_MARSHAL_ARGS;
+ /* If model is a Perl object then gtk_tree_model_iter_n_children()
+ will call out to ITER_N_CHILDREN in the class, so do that before
+ trying to build the stack here. */
+ model = g_value_get_object (param_values);
+ iter = g_value_get_boxed (param_values+2);
+ n_children = gtk_tree_model_iter_n_children (model, iter);
+
GPERL_CLOSURE_MARSHAL_INIT (closure, marshal_data);
PERL_UNUSED_VAR (return_value);
@@ -55,18 +62,15 @@
/* instance */
GPERL_CLOSURE_MARSHAL_PUSH_INSTANCE (param_values);
- model = SvGtkTreeModel(instance);
/* treepath */
XPUSHs (sv_2mortal (gperl_sv_from_value (param_values+1)));
/* treeiter */
XPUSHs (sv_2mortal (gperl_sv_from_value (param_values+2)));
- iter = g_value_get_boxed (param_values+2);
/* gint * new_order */
new_order = g_value_get_pointer (param_values+3);
- n_children = gtk_tree_model_iter_n_children (model, iter);
av = newAV ();
av_extend (av, n_children-1);
for (i = 0; i < n_children; i++)
--- GtkTreeModelIface.t 23 May 2008 09:50:57 +1000 1.6
+++ GtkTreeModelIface.t 07 Jul 2008 10:02:57 +1000
@@ -346,7 +346,7 @@
package main;
-use Gtk2::TestHelper tests => 166, noinit => 1;
+use Gtk2::TestHelper tests => 174, noinit => 1;
use strict;
use warnings;
@@ -393,6 +393,24 @@
$model->ref_node ($iter);
$model->unref_node ($iter);
+{ my $signal_finished = 0;
+ my $len = @{$model->{data}};
+ my @array = (0 .. $len-1);
+ my $id = $model->signal_connect (rows_reordered => sub {
+ my ($s_model, $path, $iter, $aref) = @_;
+ is ($s_model, $model);
+ isa_ok ($path, "Gtk2::TreePath");
+ my @indices = $path->get_indices;
+ is_deeply ([EMAIL PROTECTED], []);
+ is ($iter, undef);
+ is_deeply ($aref, [EMAIL PROTECTED]);
+ $signal_finished = 1;
+ });
+ $model->rows_reordered (Gtk2::TreePath->new, undef, @array);
+ ok ($signal_finished, 'rows-reordered signal ran');
+ $model->signal_handler_disconnect ($id);
+}
+
my $sorter_two = sub {
my ($list, $a, $b, $data) = @_;
_______________________________________________
gtk-perl-list mailing list
[email protected]
http://mail.gnome.org/mailman/listinfo/gtk-perl-list
