Gtk2-1.24993/examples/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 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;
}


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