# 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 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 # # set: It's always nice to be able to update the data stored in a data # structure. So, here's a method to let you do that. We emit the # 'row-changed' signal to notify all who care that we've updated # something. # sub set { my $self = shift; my $treeiter = shift; # create (col, value) pairs to update. my %vals = @_; # Convert the Gtk2::TreeIter to a more useable array reference. # Note that the model's stamp must be passed in as an argument. # This is so we can avoid trying to extract the guts of an iter # that we did not create in the first place. my $iter = $treeiter->to_arrayref($self->{stamp}); my $record = $iter->[2]; while (my ($col, $val) = each %vals) { if ($col == CUSTOM_LIST_COL_NAME) { $record->{name} = $val; } elsif ($col == CUSTOM_LIST_COL_YEAR_BORN) { $record->{year_born} = $val; } elsif ($col == CUSTOM_LIST_COL_RECORD) { warn "Can't update the value of the Record column!"; } else { warn "Invalid column used in set method!"; } } $self->row_changed ($self->get_path ($treeiter), $treeiter); } # # get_iter_from_name: Sometimes, you have a bit of information that # uniquely identifies a record in your TreeModel, # but it doesn't convert easily to a TreePath, # so it's hard to get a TreeIter out of it. This # is an example of how to make a TreeModel that # can get iterators without having to find the path # first. # sub get_iter_from_name { my $self = shift; my $name = shift; my ($record, $n); for (0..scalar (@{$self->{rows}})) { if ($self->{rows}[$_]->{name} eq $name) { $record = $self->{rows}[$_]; $n = $_; last; } } return Gtk2::TreeIter->new_from_arrayref([$self->{stamp}, $n, $record, undef]); } # # 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->set (editable => TRUE); $renderer->signal_connect (edited => sub { my ($cell, $pathstring, $newtext, $model) = @_; my $path = Gtk2::TreePath->new_from_string ($pathstring); my $iter = $model->get_iter ($path); $model->set ($iter, &CustomList::CUSTOM_LIST_COL_NAME, $newtext); }, $customlist); $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 $view = create_view_and_model(); my $scrollwin = Gtk2::ScrolledWindow->new; $scrollwin->add ($view); $window->add ($scrollwin); $window->show_all; Gtk2->main; exit 0; } ############################################################################ ############################################################################ ############################################################################