/usr/share/perl5/Gtk2/Ex/Simple/TiedCommon.pm is in libgtk2-ex-simple-list-perl 0.50-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 | #
#
#
package Gtk2::Ex::Simple::TiedCommon;
our %column_types = (
'hidden' => {type=>'Glib::String', attr=>'hidden'},
'text' => {type=>'Glib::String', renderer=>'Gtk2::CellRendererText', attr=>'text'},
'markup' => {type=>'Glib::String', renderer=>'Gtk2::CellRendererText', attr=>'markup'},
'int' => {type=>'Glib::Int', renderer=>'Gtk2::CellRendererText', attr=>'text'},
'double' => {type=>'Glib::Double', renderer=>'Gtk2::CellRendererText', attr=>'text'},
'bool' => {type=>'Glib::Boolean', renderer=>'Gtk2::CellRendererToggle', attr=>'active'},
'scalar' => {type=>'Glib::Scalar', renderer=>'Gtk2::CellRendererText',
attr=> sub {
my ($tree_column, $cell, $model, $iter, $i) = @_;
my ($info) = $model->get ($iter, $i);
$cell->set (text => $info || '' );
} },
'pixbuf' => {type=>'Gtk2::Gdk::Pixbuf', renderer=>'Gtk2::CellRendererPixbuf', attr=>'pixbuf'},
);
# this is some cool shit
sub add_column_type
{
shift; # don't want/need classname
my $name = shift;
$column_types{$name} = { @_ };
}
package Gtk2::Ex::Simple::TiedRow;
use strict;
use Gtk2;
use Carp;
our $VERSION = '0.1';
=for nothing
TiedRow is the lowest-level tie, allowing you to treat a row as an array
of column data.
=cut
sub TIEARRAY {
my $class = shift;
my $model = shift;
my $iter = shift;
croak "usage tie (\@ary, 'class', model, iter)"
unless $model && UNIVERSAL::isa ($model, 'Gtk2::TreeModel');
return bless {
model => $model,
iter => $iter,
}, $class;
}
sub FETCH { # this, index
return $_[0]->{model}->get ($_[0]->{iter}, $_[1]);
}
sub STORE { # this, index, value
return $_[0]->{model}->set ($_[0]->{iter}, $_[1], $_[2])
if defined $_[2]; # allow 0, but not undef
}
sub FETCHSIZE { # this
return $_[0]{model}->get_n_columns;
}
sub EXISTS {
return( $_[1] < $_[0]{model}->get_n_columns );
}
sub EXTEND { } # can't change the length, ignore
sub CLEAR { } # can't change the length, ignore
sub new {
my ($class, $model, $iter) = @_;
my @a;
tie @a, __PACKAGE__, $model, $iter;
return \@a;
}
sub POP { croak "pop called on a TiedRow, but you can't change its size"; }
sub PUSH { croak "push called on a TiedRow, but you can't change its size"; }
sub SHIFT { croak "shift called on a TiedRow, but you can't change its size"; }
sub UNSHIFT { croak "unshift called on a TiedRow, but you can't change its size"; }
sub SPLICE { croak "splice called on a TiedRow, but you can't change its size"; }
#sub DELETE { croak "delete called on a TiedRow, but you can't change its size"; }
sub STORESIZE { carp "STORESIZE operation not supported"; }
1;
__END__
Copyright (C) 2004 by the gtk2-perl team (see the file AUTHORS for the
full list). See LICENSE for more information.
|