Question about Gtk2-1.042/examples/customlist.pl

[Niel Das <idas watson wustl edu>]

I am having some trouble in understanding the customlist.pl script found 
in the Gtk2-1.042 /examples directory.  This is the example of creating 
a custom GtkTreeModel with Gtk2-Perl.  

I was trying to see how to set up some initial properties about the data 
format for a newly created object TreeModel.

I would like to describe column types and number of columns without 
using hardcoded constants, but from passed arguments to the 
functions/subroutines.

Ideally, I was wondering if it is possible to create a CustomList object 
like this:

my $customlist = CustomList->new($n_columns_scalar, $arrayref_column_types);

From looking at the perldoc on Glib::Object::Subclass, it seemed to me 
that this is possible via defining a new constructor in the CustomList 
package.

So I began by simply adding a simple new constructor just above the 
INIT_INSTANCE function, as follows:

sub new {
   my $class = shift;
   my $self = {};
   bless($self, $class);
   $self->INIT_INSTANCE();
   print "Hello there from new!\n";
   return $self;
}


However, now the program fails when it reaches the


$self->row_inserted($path, $self->get_iter($path));


line in the append_record subroutine.  It gives me the following error:


$ perl5.8.3 customlist.pl
Hello there from new!
Gtk-CRITICAL **: file gtktreemodel.c: line 684 
(gtk_tree_model_get_iter): assertion `GTK_IS_TREE_MODEL (tree_model)' 
failed at customlist.pl line 366.
variable not allowed to be undef where GtkTreeIter is wanted at 
customlist.pl line 366.

However, the program works fine, when the added "new" constructor is 
removed.  I was wondering if I am implementing my new constructor wrong, 
or if I should be explcitly mentioning some class that I should be 
inheriting from, or if I completely misunderstood the concept about how 
to add initial properties for a CustomTreeModel in Gtk2-Perl?

Also, I was wondering if there are any additional resources are 
available to refer to about implementing custom GtkTreeModels with 
Gtk2-Perl besides the customrender.pl and customlist.pl examples, and 
the GTK+ 2.0 Tree View Tutorial (http://scentric.net/tutorial/)?

Thanks again to all help in advance.

Cheers,

Niel

Attached below is what I edited in customlist.pl

======================================================

# ported from Tim-Phillip Mueller's Tree View tutorial,
# http://scentric.net/tutorial/sec-custom-models.html
#

package CustomList;

use Glib qw(TRUE FALSE);
use Gtk2;
use Carp;
use Data::Dumper;
use strict;
use warnings;

# maybe bad style, but makes life a lot easier
use base Exporter::;

our @EXPORT = qw/
   CUSTOM_LIST_COL_RECORD
   CUSTOM_LIST_COL_NAME
   CUSTOM_LIST_COL_YEAR_BORN
   CUSTOM_LIST_N_COLUMNS
/;

# The data columns that we export via the tree model interface

use constant {
   CUSTOM_LIST_COL_RECORD    => 0,
   CUSTOM_LIST_COL_NAME      => 1,
   CUSTOM_LIST_COL_YEAR_BORN => 2,
   CUSTOM_LIST_N_COLUMNS     => 3,
};

#
#  here we register our new type and its interfaces with the type system.
#  If you want to implement additional interfaces like GtkTreeSortable,
#  you will need to do it here.
#

use Glib::Object::Subclass
   Glib::Object::,
   interfaces => [ Gtk2::TreeModel:: ],
   ;

# This method of implementation does not work -- Niel comment
#use Glib::Object::Subclass (Glib::Object::);
#Gtk2::TreeModel->add_interface(__PACKAGE__);

####################################################################
#
#  Experiment -- just wanted to see what a "new" would do...
#

sub new {
   my $class = shift;
   my $self = {};
   bless($self, $class);
   $self->INIT_INSTANCE();
   print "Hello there from new!\n";
   return $self;
}

####################################################################

#
# this is called everytime a new custom list object
# instance is created (we do that in custom_list_new).
# Initialise the list structure's fields here.
#

sub INIT_INSTANCE {
   my $self = shift;
   $self->{n_columns} = CUSTOM_LIST_N_COLUMNS;
   $self->{column_types} = [
       'Glib::Scalar',    # CUSTOM_LIST_COL_RECORD
       'Glib::String',    # CUSTOM_LIST_COL_NAME
       'Glib::Uint',    # CUSTOM_LIST_COL_YEAR_BORN
   ];
   $self->{rows}     = [];

   # Random int to check whether an iter belongs to our model
   $self->{stamp} = sprintf '%d', rand (1<<31);
}


#
#  this is called just before a custom list is
#  destroyed. Free dynamically allocated memory here.
#

sub FINALIZE_INSTANCE {
   my $self = shift;

   # free all records and free all memory used by the list
   #warning IMPLEMENT
}


#
# tells the rest of the world whether our tree model has any special
# characteristics. In our case, we have a list model (instead of a tree).
# Note that unlike the C version of this custom model, our iters do NOT
# persist.
#

#sub GET_FLAGS { [qw/list-only iters-persist/] }
sub GET_FLAGS { [qw/list-only/] }


#
# tells the rest of the world how many data
# columns we export via the tree model interface
#

sub GET_N_COLUMNS { shift->{n_columns}; }


#
# tells the rest of the world which type of
# data an exported model column contains
#

sub GET_COLUMN_TYPE {
   my ($self, $index) = @_;
   # and invalid index will send undef back to the calling XS layer,
   # which will croak.
   return $self->{column_types}[$index];
}


#
# converts a tree path (physical position) into a
# tree iter structure (the content of the iter
# fields will only be used internally by our model).
# We simply store a pointer to our CustomRecord
# structure that represents that row in the tree iter.
#

sub GET_ITER {
   my ($self, $path) = @_;

   die "no path" unless $path;

   my @indices = $path->get_indices;
   my $depth   = $path->get_depth;

   # we do not allow children
   # depth 1 = top level; a list only has top level nodes and no children
   die "depth != 1" unless $depth == 1;

   my $n = $indices[0]; # the n-th top level row

   return undef if $n >= @{$self->{rows}} || $n < 0;

   my $record = $self->{rows}[$n];

   die "no record" unless $record;
   die "bad record" unless $record->{pos} == $n;

   # We simply store a pointer to our custom record in the iter
   return [ $self->{stamp}, $n, $record, undef ];
}


#
#  custom_list_get_path: converts a tree iter into a tree path (ie. the
#                        physical position of that row in the list).
#

sub GET_PATH {
   my ($self, $iter) = @_;
   die "no iter" unless $iter;

   my $record = $iter->[2];

   my $path = Gtk2::TreePath->new;
   $path->append_index ($record->{pos});
   return $path;
}


#
# custom_list_get_value: Returns a row's exported data columns
#                        (_get_value is what gtk_tree_model_get uses)
#

sub GET_VALUE {
   my ($self, $iter, $column) = @_;

   die "bad iter" unless $iter;

   return undef unless $column < @{$self->{column_types}};

   my $record = $iter->[2];

   return undef unless $record;

   die "bad iter" if $record->{pos} >= @{$self->{rows}};

   if ($column == CUSTOM_LIST_COL_RECORD) {
       return $record;
   } elsif ($column == CUSTOM_LIST_COL_NAME) {
       return $record->{name};
   } elsif ($column == CUSTOM_LIST_COL_YEAR_BORN) {
       return $record->{year_born};
   }
}


#
# iter_next: Takes an iter structure and sets it to point to the next row.
#

sub ITER_NEXT {
   my ($self, $iter) = @_;

   return undef
       unless $iter && $iter->[2];

   my $record = $iter->[2];

   # Is this the last record in the list?
   return undef
       if $record->{pos} >= @{ $self->{rows} };

   my $nextrecord = $self->{rows}[$record->{pos} + 1];

   return undef unless $nextrecord;
   die "invalid record" unless $nextrecord->{pos} == ($record->{pos} + 1);

   return [ $self->{stamp}, $nextrecord->{pos}, $nextrecord, undef ];
}


#
# iter_children: Returns TRUE or FALSE depending on whether the row
#                specified by 'parent' has any children.  If it has
#                children, then 'iter' is set to point to the first
#                child.  Special case: if 'parent' is undef, then the
#                first top-level row should be returned if it exists.
#

sub ITER_CHILDREN {
   my ($self, $parent) = @_;

###    return undef unless $parent and $parent->[1];

   # this is a list, nodes have no children
   return undef if $parent;

   # parent == NULL is a special case; we need to return the first 
top-level row

    # No rows => no first row
   return undef unless @{ $self->{rows} };

   # Set iter to first item in list
   return [ $self->{stamp}, 0, $self->{rows}[0] ];
}


#
# iter_has_child: Returns TRUE or FALSE depending on whether
#                 the row specified by 'iter' has any children.
#                 We only have a list and thus no children.
#

sub ITER_HAS_CHILD { FALSE }

#
# iter_n_children: Returns the number of children the row specified by
#                  'iter' has. This is usually 0, as we only have a list
#                  and thus do not have any children to any rows.
#                  A special case is when 'iter' is undef, in which case
#                  we need to return the number of top-level nodes, ie.
#                  the number of rows in our list.
#

sub ITER_N_CHILDREN {
   my ($self, $iter) = @_;

   # special case: if iter == NULL, return number of top-level rows
   return scalar @{$self->{rows}}
       if ! $iter;

   return 0; # otherwise, this is easy again for a list
}


#
# iter_nth_child: If the row specified by 'parent' has any children,
#                 set 'iter' to the n-th child and return TRUE if it
#                 exists, otherwise FALSE.  A special case is when
#                 'parent' is NULL, in which case we need to set 'iter'
#                 to the n-th row if it exists.
#

sub ITER_NTH_CHILD {
   my ($self, $parent, $n) = @_;

   # a list has only top-level rows
   return undef if $parent;

   # special case: if parent == NULL, set iter to n-th top-level row

   return undef if $n >= @{$self->{rows}};

   my $record = $self->{rows}[$n];

   die "no record" unless $record;
   die "bad record" unless $record->{pos} == $n;

   return [ $self->{stamp}, $n, $record ];
}


#
# iter_parent: Point 'iter' to the parent node of 'child'.  As we have a
#              a list and thus no children and no parents of children,
#              we can just return FALSE.
#

sub ITER_PARENT { FALSE }

#
# ref_node and unref_node get called as the model manages the lifetimes
# of nodes in the model.  you normally don't need to do anything for these,
# but may want to if you plan to implement data caching.
#
#sub REF_NODE { warn "REF_NODE @_\n"; }
#sub UNREF_NODE { warn "UNREF_NODE @_\n"; }

#
# new:  This is what you use in your own code to create a
#       new custom list tree model for you to use.
#

# we inherit new from Glib::Object::Subclass


#
# append_record:  Empty lists are boring. This function can be used in your
#                 own code to add rows to the list.  Note how we emit the
#                 "row-inserted" signal after we have appended the row
#                 so the tree view and other interested objects know about
#                 the new row.
#

sub append_record {
   my ($self, $name, $year_born) = @_;

   croak "usage: \$list->append_record (NAME, YEAR_BORN)"
         unless $name;

   my $newrecord = {
       name => $name,
#        name_collate_key => g_utf8_collate_key(name,-1), # for fast 
sorting, used later
       year_born => $year_born,
   };

   push @{ $self->{rows} }, $newrecord;
   $newrecord->{pos} = @{$self->{rows}} - 1;

   # inform the tree view and other interested objects
   # (e.g. tree row references) that we have inserted
   # a new row, and where it was inserted

   my $path = Gtk2::TreePath->new;
   $path->append_index ($newrecord->{pos});
   $self->row_inserted ($path, $self->get_iter ($path));
}

############################################################################
############################################################################
############################################################################

package main;

no strict 'subs';
use Glib qw(TRUE FALSE);
use Gtk2 -init;

import CustomList;

sub fill_model {
   my $customlist = shift;

   my @firstnames = qw(Joe Jane William Hannibal Timothy Gargamel);
   my @surnames   = qw(Grokowich Twitch Borheimer Bork);

   foreach my $sname (@surnames) {
       foreach my $fname (@firstnames) {
           $customlist->append_record ("$fname $sname",
                                       1900 + rand (103.0));
       }
   }
}

sub create_view_and_model {
 my $customlist = CustomList->new;
 fill_model ($customlist);

 my $view = Gtk2::TreeView->new ($customlist);

 my $renderer = Gtk2::CellRendererText->new;
 my $col = Gtk2::TreeViewColumn->new;

 $col->pack_start ($renderer, TRUE);
 $col->add_attribute ($renderer, text => 
&CustomList::CUSTOM_LIST_COL_NAME);
 $col->set_title ("Name");
 $view->append_column ($col);

 $renderer = Gtk2::CellRendererText->new;
 $col = Gtk2::TreeViewColumn->new;
 $col->pack_start ($renderer, TRUE);
 $col->add_attribute ($renderer, text => 
&CustomList::CUSTOM_LIST_COL_YEAR_BORN);
 $col->set_title ("Year Born");
 $view->append_column ($col);

 return $view;
}

{
 my $window = Gtk2::Window->new;
 $window->set_default_size (200, 400);
 $window->signal_connect (delete_event => sub {Gtk2->main_quit; 0});

 my $scrollwin = Gtk2::ScrolledWindow->new;

 my $view = create_view_and_model();

 $scrollwin->add ($view);
 $window->add ($scrollwin);

 $window->show_all;

 Gtk2->main;

 exit 0;
}


############################################################################
############################################################################
############################################################################


======================================================