#!/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;