ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Net-XMPP2/samples/devcl/DevCL/TreeView.pm
Revision: 1.1
Committed: Wed Jul 11 18:52:07 2007 UTC (19 years, 2 months ago) by elmex
Branch: MAIN
CVS Tags: HEAD
Log Message:
further improved devcl and added iq_xml

File Contents

# Content
1 package DevCL::TreeView;
2 use strict;
3 use Gtk2;
4 use POSIX qw/strftime/;
5
6 sub new {
7 my $this = shift;
8 my $class = ref($this) || $this;
9 my $self = { @_ };
10 bless $self, $class
11 }
12
13 sub init {
14 my ($self, @titles) = @_;
15
16 my $cols = scalar @titles;
17 my @cls;
18 for (1..$cols) { push @cls, 'Glib::String' }
19 push @cls, 'Glib::Scalar';
20 my $model = Gtk2::TreeStore->new (@cls);
21 $self->{model} = $model;
22 my $tv = $self->{tree} = Gtk2::TreeView->new ($model);
23
24 $tv->set_rules_hint (1);
25
26 for (1..$cols) {
27 my $txt = Gtk2::CellRendererText->new;
28 $txt->set (xalign => 0);
29
30 my $coffs =
31 $tv->insert_column_with_attributes (
32 -1, $titles[$_ - 1], $txt,
33 text => ($_ - 1)
34 );
35 my $col = $tv->get_column ($coffs - 1);
36 }
37
38 $tv->signal_connect (row_activated => sub {
39 my ($tv, $tp, $tc) = @_;
40 my $iter = $tv->get_model ()->get_iter ($tp);
41 my (@vals) = $tv->get_model ()->get ($iter);
42 my $us = pop @vals;
43 $self->{act_cb}->(@vals, @$us);
44 });
45
46 $tv
47 }
48
49 sub set_activate_cb {
50 my ($self, $cb) = @_;
51 $self->{act_cb} = $cb;
52 }
53
54 sub add_rec_path {
55 my ($self, $id, @cols) = @_;
56 my $fnd;
57 my $m = $self->{model};
58
59 if (defined $id) {
60 $m->foreach (sub {
61 my ($ts, $path, $iter) = @_;
62 my $clcnt = $m->get_n_columns;
63 my (@g) = $m->get ($iter);
64 if ($g[$clcnt - 1]->[0] eq $id) {
65 $fnd = $m->get_path ($iter)->to_string;
66 return 1;
67 }
68 0
69 });
70 }
71
72 $self->{id}++;
73
74 my $iter;
75 if (defined $fnd) {
76 $iter = $m->get_iter_from_string ($fnd);
77 }
78 my $chlditer = $m->append ($iter);
79 my $i = 0;
80 my $usrptr = pop @cols;
81 $m->set ($chlditer, map { ($i++, $_) } (@cols, [$self->{id}, $usrptr]));
82 my $path = $m->get_path ($chlditer);
83
84 $self->{id}
85 }
86
87 sub walk_step {
88 my ($self, $sub, $in_id, $field, $usr) = @_;
89 my ($id, $node_sub);
90 if (exists $sub->{$field}) {
91 ($id, $node_sub) = @{$sub->{$field}};
92 } else {
93 $id = $self->add_rec_path ($in_id, $field, $usr);
94 $node_sub = {};
95 $sub->{$field} = [$id, $node_sub];
96 }
97 ($id, $node_sub)
98 }
99
100
101
102 1