The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w

#
# Copyright (C) 2003 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
# 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, write to the Free Software Foundation, Inc.,
# 59 Temple Place - Suite 330, Boston, MA  02111-1307  USA.
#
# $Id$
#

use strict;
use Data::Dumper;

use Gtk2 -init;
use Gtk2::SimpleList;

# add a new type of column that reverses the text that's in a scalar
Gtk2::SimpleList->add_column_type(
	'ralacs', 	# think about it for a second...
		type     => 'Glib::Scalar',      
		renderer => 'Gtk2::CellRendererText',   
		attr     => sub {
			my ($tree_column, $cell, $model, $iter, $i) = @_;
			my $info = $model->get ($iter, $i);
			$info = join('',reverse(split('', $info || '' )));
			$cell->set (text => $info);
		} 
	);

# add a new type of column that sums up an array reference
Gtk2::SimpleList->add_column_type(
	'sum_of_array',
		type     => 'Glib::Scalar',      
		renderer => 'Gtk2::CellRendererText',   
		attr     => sub {
			my ($tree_column, $cell, $model, $iter, $i) = @_;
			my $sum = 0;
			my $info = $model->get ($iter, $i);
			foreach (@$info)
			{
				$sum += $_;
			}
			$cell->set (text => $sum);
		} 
	);

my $win = Gtk2::Window->new;
$win->set_title ('Gtk2::SimpleList exapmle');
$win->set_border_width (6);
$win->set_default_size (700, 600);
$win->signal_connect (delete_event => sub { Gtk2->main_quit; });

my $hbox = Gtk2::HBox->new (0, 6);
$win->add ($hbox);

my $scwin = Gtk2::ScrolledWindow->new;
$hbox->pack_start ($scwin, 1, 1, 0);
$scwin->set_policy (qw/automatic automatic/);

# create a simple list widget with one of each column type
my $slist = Gtk2::SimpleList->new (
			'Text Field'    => 'text',
			'Int Field'     => 'int',
			'Double Field'  => 'double',
			'Bool Field'    => 'bool',
			'Scalar Field'  => 'scalar',
			'Pixbuf Field'  => 'pixbuf',
			'Ralacs Field'  => 'ralacs',
			'Sum of Array'  => 'sum_of_array',
			'Markup Field'  => 'markup',
	);
$scwin->add ($slist);

my $vbox = Gtk2::VBox->new (0, 6);
$hbox->pack_start($vbox, 0, 1, 0);

# now lets create some buttons to push, pop, shift, and unshift, ...
my $btn;
my $tooltips = Gtk2::Tooltips->new;
foreach (
		[ 'Push', 'Push a row onto the list' ],
		[ 'Pop', 'Pop a row off of the list' ],
		[ 'Unshift', 'Unshift a row onto the list' ],
		[ 'Shift', 'Shift a row off of the list' ],
		[ 'Splice 1', 'splice @data, 2, 2, (5 new items)' ],
		[ 'Splice 2', 'splice @data, 2, 0, (5 new items)' ],
		[ 'Splice 3', 'splice @data, 2, 2' ],
		[ 'Splice 4', 'splice @data, 2' ],
		[ 'Change 1', 'Change all of the columns of row 1 with an array ref assignment' ],
		[ 'Change 2', 'Change all of the columns of row 1 with array element assignments' ],
		[ 'Change 3', 'Change the first column of row 1 with a scalar assignment, most useful with single column lists' ],
		[ 'Delete', 'Delete the ~middle element from the list' ],
		[ 'Empty', 'Delete all rows from the list with an empty array assignement' ],
		[ 'Fill', 'Fill the list with data using an array assignment' ],
		[ 'Many', 'Push and Unshift several data element onto the list' ],
		[ 'Dump List', 'Dump list data to stdout' ],
		[ 'Dump Sel', 'Dump index of selected item(s)' ],
	)
{
	$btn = Gtk2::Button->new ($_->[0]);
	$btn->signal_connect (clicked => \&btn_clicked, $_->[0]);
	$tooltips->set_tip ($btn, $_->[1]);
	$vbox->pack_start($btn, 0, 1, 0);
}
$tooltips->enable;

# here's a little optionmenu to set the list's selection mode.
my $opt = Gtk2::OptionMenu->new;
my $menu = Gtk2::Menu->new;
foreach (qw/none single browse multiple/) {
	my $item = Gtk2::MenuItem->new ($_);
	$item->signal_connect (activate => sub {
			$slist->get_selection->set_mode ($_[1]);
			}, $_);
	$item->show;
	$menu->append ($item);
}
$opt->set_menu ($menu);
$opt->set_history (1);
$vbox->pack_start ($opt, 0, 0, 0);
$tooltips->set_tip ($opt, 'set the selection mode for the list');

# toggle the editable-ness of column 0
my $chk = Gtk2::CheckButton->new ('editable');
$chk->set_active (0);
$chk->signal_connect (toggled => sub {
		$slist->set_column_editable (0, $_[0]->get_active);
		});
$vbox->pack_start ($chk, 0, 0, 0);
$tooltips->set_tip ($chk, 'set whether column zero\'s text is editable');


# toggle the reorderable-ness of the view
$chk = Gtk2::CheckButton->new ('reorderable');
$chk->set_active (0);
$chk->signal_connect (toggled => sub {
		$slist->set_reorderable ($_[0]->get_active);
		});
$vbox->pack_start ($chk, 0, 0, 0);
$tooltips->set_tip ($chk, 'set whether the list is reorderable');

# toggle the reorderable-ness of the columns
$chk = Gtk2::CheckButton->new ('drag columns');
$chk->set_active (0);
$chk->signal_connect (toggled => sub {
		foreach my $column ($slist->get_columns) {
			$column->set_reorderable ($_[0]->get_active);
		}
		});
$vbox->pack_start ($chk, 0, 0, 0);
$tooltips->set_tip ($chk, 'set whether the list is reorderable');

# finally, a button to end it all
$btn = Gtk2::Button->new_from_stock ('gtk-quit');
$btn->signal_connect (clicked => sub  { Gtk2->main_quit; });
$vbox->pack_end($btn, 0, 1, 0);

$slist->signal_connect (row_activated => sub {
		my ($slist, $path, $column) = @_;
		my $row_ref = $slist->get_row_data_from_path ($path);
		print 'act '.Dumper ($row_ref);	
	});

# just for shorthand
my $dslist = $slist->{data};
my $op_count = 0;

my @pixbufs;
foreach (qw/gtk-ok gtk-cancel gtk-quit gtk-apply gtk-clear 
	    gtk-delete gtk-execute gtk-dnd/)
{
	push @pixbufs, $win->render_icon ($_, 'menu');
}
# so some will be blank
push @pixbufs, undef;

sub btn_clicked
{
	my ($button, $op) = @_;

	if( $op eq 'Push' )
	{
		push @$dslist, [ 'pushed',5, 5.5, 0, 'scalar pushed', 
			$pixbufs[rand($#pixbufs+1)], 'scalar pushed', 
			[5, 6, 7], '<span color="green">pushed</span>' ];
	}
	elsif( $op eq 'Pop' )
	{
		pop @$dslist;
	}
	elsif( $op eq 'Unshift' )
	{
		unshift @$dslist, [ 'unshifted', 6, 6.6, 1, 'scalar unshifted', 
			$pixbufs[rand($#pixbufs+1)], 'scalar unshifted',
			[6, 7, 8], '<span color="green">unshift</span>' ];
	}
	elsif( $op eq 'Shift' )
	{
		shift @$dslist;
	}
	elsif( $op eq 'Change 1' )
	{
		$dslist->[0] = [ 'changed1', 7, 7.7, 0, 'scalar changed1', 
			$pixbufs[rand($#pixbufs+1)], 'scalar changed1',
			[7, 8, 9], '<span color="green">changed1</span>' ];
	}
	elsif( $op eq 'Change 2' )
	{
		$dslist->[0][0] = 'changed2';
		$dslist->[0][1] = 8;
		$dslist->[0][2] = 8.8;
		$dslist->[0][3] = 1;
		$dslist->[0][4] = 'scalar changed2';
		$dslist->[0][5] = $pixbufs[rand($#pixbufs+1)];
		$dslist->[0][6] = 'scalar changed2';
		$dslist->[0][7] = [8, 9, 10];
		$dslist->[0][8] = '<span color="green">changed2</span>';
	}
	elsif( $op eq 'Change 3' )
	{
		# this is most useful if you've got a 1 column list
		$dslist->[0] = 'changed3';
	}
	elsif ($op eq 'Splice 1')
	{
		splice @$dslist, 2, 2, (1..5),
	}
	elsif ($op eq 'Splice 2')
	{
		splice @$dslist, 2, 0, (1..5)
	}
	elsif ($op eq 'Splice 3')
	{
		splice @$dslist, 2, 2;
	}
	elsif ($op eq 'Splice 4')
	{
		splice @$dslist, 2;
	}
	elsif( $op eq 'Delete' )
	{
		# delete the ~middle element
		delete $dslist->[$#$dslist/2];
	}
	elsif( $op eq 'Empty' )
	{
		# can't use shorthand on this b/c we're replacing the ref
		# in the simple list's data.
		@{$slist->{data}} = ();
	}
	elsif( $op eq 'Fill' )
	{
		# can't use shorthand on this b/c we're replacing the ref
		# in the simple list's data.

		@{$slist->{data}} = (
			[ 'one', 1, 1.1, 1, 'uno', undef, 'uno', 
				[1, 2, 3],
				'<span color="green">one</span>' ],
			[ 'two', 2, 2.2, 0, 'dos', undef, 'dos', 
				[2, 3, 4],
				'<span color="green">two</span>' ],
			[ 'three', 3, 3.3, 1, 'tres', undef, 'tres', 
				[3, 4, 5],
				'<span color="green">three</span>' ],
			[ 'four', 4, 4.4, 0, 'quatro', undef,  'quatro', 
				[4, 5, 6],
				'<span color="green">four</span>' ],
		);
	}
	elsif( $op eq 'Many' )
	{
		# can't use shorthand on this b/c we're replacing the ref
		# in the simple list's data.
		push @{$slist->{data}}, (
			[ 'one', 1, 1.1, 1, 'uno', undef, 'uno', 
				[1, 2, 3],
				'<span color="green">one</span>' ],
			[ 'two', 2, 2.2, 0, 'dos', undef, 'dos', 
				[2, 3, 4],
				'<span color="green">two</span>' ],
			[ 'three', 3, 3.3, 1, 'tres', undef, 'tres', 
				[3, 4, 5],
				'<span color="green">three</span>' ],
			[ 'four', 4, 4.4, 0, 'quatro', undef,  'quatro', 
				[4, 5, 6],
				'<span color="green">four</span>' ],
		);
		unshift @{$slist->{data}}, (
			[ 'one', 1, 1.1, 1, 'uno', undef, 'uno', 
				[1, 2, 3],
				'<span color="green">one</span>' ],
			[ 'two', 2, 2.2, 0, 'dos', undef, 'dos', 
				[2, 3, 4],
				'<span color="green">two</span>' ],
			[ 'three', 3, 3.3, 1, 'tres', undef, 'tres', 
				[3, 4, 5],
				'<span color="green">three</span>' ],
			[ 'four', 4, 4.4, 0, 'quatro', undef,  'quatro', 
				[4, 5, 6],
				'<span color="green">four</span>' ],
		);
	}
	elsif( $op eq 'Dump Sel' )
	{
		print "selected indices: "
		    . join(", ", $slist->get_selected_indices)
		    . "\n";
	}
	elsif( $op eq 'Dump List' )
	{
		print "\n\nList Data\n".Dumper($slist->{data})."\n\n";
	}

	1;
}

$win->show_all;
Gtk2->main;