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

File Contents

# User Rev Content
1 elmex 1.1 package DevCL::Browser;
2     use strict;
3     use Gtk2;
4     use POSIX qw/strftime/;
5     use Gtk2::SimpleList;
6 elmex 1.2 use DevCL::TreeView;
7 elmex 1.1
8     sub new {
9     my $this = shift;
10     my $class = ref($this) || $this;
11     my $self = { @_ };
12     bless $self, $class
13     }
14    
15     sub start {
16     my ($self) = @_;
17    
18 elmex 1.2 $self->{t} = {};
19    
20 elmex 1.1 my $w = Gtk2::Window->new ('toplevel');
21     $w->set_default_size (300, 400);
22     $w->signal_connect (destroy => $self->{on_destroy});
23    
24 elmex 1.2 my $t = $self->{tree} = DevCL::TreeView->new;
25     my $tv = $t->init ("JID/Node");
26    
27     $t->set_activate_cb (sub {
28     my ($title, $id, $us) = @_;
29     my ($jid, $node, $wid) = @$us;
30     if ($wid) {
31     $self->select_page ($wid);
32     } else {
33     $self->do_browse ($jid, $node);
34     }
35     });
36    
37 elmex 1.1 $w->add (my $hb = Gtk2::HPaned->new);
38     $hb->add1 (my $lsw = Gtk2::ScrolledWindow->new);
39 elmex 1.2 $lsw->add ($tv);
40 elmex 1.1 $lsw->set_policy (automatic => 'automatic');
41     $hb->add2 (my $vb = Gtk2::VBox->new);
42     $vb->pack_start (my $e = Gtk2::Entry->new, 0, 1, 0);
43     $e->signal_connect (activate => sub {
44     $self->do_browse ($e->get_text);
45     });
46     $vb->pack_start ($self->{view_title} = Gtk2::Label->new, 0, 1, 0);
47     $vb->pack_start (my $sw = $self->{view} = Gtk2::ScrolledWindow->new, 1, 1, 0);
48     $sw->set_policy ('automatic', 'automatic');
49     $sw->add ($self->{viewp} = Gtk2::Viewport->new);
50     $w->show_all;
51     }
52    
53     sub do_browse {
54     my ($self, $txt, $node) = @_;
55     $::DISCO->request_items (::get_con (), $txt, $node, sub {
56     my ($disco, $i, $e) = @_;
57     if ($e) {
58 elmex 1.2 $self->add_entry (
59     $txt, $node, "item_error",
60     Gtk2::Label->new ($e->string)
61     );
62 elmex 1.1 } else {
63     my $sl = Gtk2::SimpleList->new ('JID' => 'text', 'Name' => 'text', Node => 'text');
64     @{$sl->{data}} =
65     map {
66     [ $_->{jid}, $_->{name}, $_->{node} ]
67     } $i->items;
68    
69     $sl->signal_connect (row_activated => sub {
70     my ($sl, $path, $column) = @_;
71     my $row_ref = $sl->get_row_data_from_path ($path);
72     $self->do_browse ($row_ref->[0], $row_ref->[2] ne '' ? $row_ref->[2] : undef);
73     });
74 elmex 1.2 $self->add_entry ($i->jid, $i->node, 'items', $sl);
75     $self->select_page ($sl);
76 elmex 1.1 }
77     });
78     $::DISCO->request_info (::get_con (), $txt, undef, sub {
79     my ($disco, $i, $e) = @_;
80     if ($e) {
81 elmex 1.2 $self->add_entry (
82     $txt, $node, "info_error",
83     Gtk2::Label->new ($e->string)
84     );
85 elmex 1.1 } else {
86     my $vb = Gtk2::VBox->new;
87     $vb->pack_start (
88     my $sl1 = Gtk2::SimpleList->new (
89     Category => 'text', Type => 'text', Name => 'text'
90     ),
91     0, 1, 0
92     );
93     @{$sl1->{data}} =
94     map {
95     [ $_->{category}, $_->{type}, $_->{name} ]
96     } sort { $a->{category} cmp $b->{category} } $i->identities;
97     $vb->pack_start (
98     my $sl2 = Gtk2::SimpleList->new (Feature => 'text'),
99     0, 1, 0
100     );
101     @{$sl2->{data}} = sort keys %{$i->features || {}};
102 elmex 1.2 $self->add_entry ($i->jid, $i->node, 'info', $vb);
103 elmex 1.1 }
104     });
105     }
106    
107     sub select_page {
108 elmex 1.2 my ($self, $chld) = @_;
109 elmex 1.1 for ($self->{viewp}->get_children) {
110     $_->hide_all;
111     $self->{viewp}->remove ($_);
112     }
113 elmex 1.2 $self->{view_title}->set_text ("...");
114     $self->{viewp}->add ($chld);
115     $chld->show_all;
116 elmex 1.1 }
117    
118 elmex 1.2 sub add_entry {
119     my ($self, $jid, $node, $type, $chld) = @_;
120    
121     my $usr = [$jid, $node];
122    
123     $node = "/$node";
124    
125     my $t = $self->{tree};
126     my ($jid_id, $jid_sub) = $t->walk_step ($self->{t}, undef, $jid, $usr);
127     my ($node_id, $node_sub) = $t->walk_step ($jid_sub, $jid_id, $node, $usr);
128     my ($type_id, $type_sub) = $t->walk_step ($node_sub, $node_id, $type, $usr);
129    
130     $t->add_rec_path ($type_id, time, [@$usr, $chld]);
131 elmex 1.1 }
132     1