1############################################################################## 2# 3# This program is free software; you can redistribute it and/or modify 4# it under the terms of the GNU General Public License as published by 5# the Free Software Foundation; either version 2 of the License, or 6# (at your option) any later version. 7# 8# This program is distributed in the hope that it will be useful, 9# but WITHOUT ANY WARRANTY; without even the implied warranty of 10# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11# GNU General Public License for more details. 12# 13# You should have received a copy of the GNU General Public License 14# along with this program; if not, write to the Free Software 15# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16# 17# Jabber 18# Copyright (C) 1998-1999 The Jabber Team http://jabber.org/ 19# 20############################################################################## 21 22package Tk::Roster; 23 24use vars qw($VERSION); 25$VERSION = '0.1'; 26 27use Tk; 28require Tk::Frame; 29 30use Carp; 31use strict; 32use base qw(Tk::Frame Jarl::Roster); 33Construct Tk::Widget 'Roster'; 34 35 36############################################################################## 37# 38# Populate - Create the Tk widget 39# 40############################################################################## 41sub Populate { 42 my ($self, $args) = @_; 43 my %args = %{$args}; 44 45 $self->{varsOnlineOnly} = 0; 46 47 $self->{varsRosterBackground} = 48 $self->ParseArg($args,"-rosterbackground","white"); 49 $self->{varsGroupBackground} = 50 $self->ParseArg($args,"-groupbackground","grey65"); 51 $self->{varsGroupForeground} = 52 $self->ParseArg($args,"-groupforeground","white"); 53 $self->{varsJIDBackground} = 54 $self->ParseArg($args,"-jidbackground","grey75"); 55 $self->{varsJIDForeground} = 56 $self->ParseArg($args,"-jidforeground","black"); 57 $self->{varsSelectBackground} = 58 $self->ParseArg($args,"-selectbackground","lightblue"); 59 $self->{varsResourceBackground} = 60 $self->ParseArg($args,"-resourcebackground","grey85"); 61 $self->{varsResourceForeground} = 62 $self->ParseArg($args,"-resourceforeground","black"); 63 $self->{varsBalloon} = 64 $self->ParseArg($args,"-balloon",undef); 65 $self->{varsFont} = 66 $self->ParseArg($args,"-font",""); 67 $self->{varsJIDLeftCommand} = 68 $self->ParseArg($args,"-jidleftcommand",""); 69 $self->{varsJIDRightCommand} = 70 $self->ParseArg($args,"-jidrightcommand",""); 71 $self->{varsUpdateMode} = 72 $self->ParseArg($args,"-updatemode","roster"); 73 $self->{varsWidth} = 74 $self->ParseArg($args,"-width",200); 75 76 $self->{frame} = 77 $self-> 78 Frame(%{$args} 79 )->pack(-side=>'top', 80 -padx=>0, 81 -pady=>0, 82 -fill=>'both', 83 -expand=>1); 84 85 my $scrolled = 86 $self->{frame}-> 87 Scrolled("Canvas", 88 -scrollbars=>"osoe", 89 -height=>10, 90 -width=>$self->{varsWidth}, 91 -borderwidth=>0, 92 -relief=>"flat", 93 -background=>$self->{varsRosterBackground}, 94 -takefocus=>0, 95 -highlightthickness=>0 96 )->pack(-side=>'top', 97 -fill=>'both', 98 -expand=>1, 99 -padx=>0, 100 -pady=>0); 101 102 $self->{canvas} = $scrolled->Subwidget("canvas"); 103 $scrolled->Subwidget("yscrollbar")->configure(-width=>10, 104 -borderwidth=>1, 105 -relief=>"flat", 106 -takefocus=>0, 107 -highlightthickness=>0 108 ); 109 $scrolled->Subwidget("xscrollbar")->configure(-width=>10, 110 -borderwidth=>1, 111 -relief=>"flat", 112 -takefocus=>0, 113 -highlightthickness=>0 114 ); 115 116 $self->{balloons} = {} if defined($self->{varsBalloon}); 117} 118 119 120############################################################################## 121# 122# ParseArg - Helper function to extract the specified argument from the 123# function call. 124# 125############################################################################## 126sub ParseArg { 127 my $self = shift; 128 my ($args,$arg,$default) = @_; 129 return (exists($args->{$arg}) ? delete($args->{$arg}) : $default); 130} 131 132 133############################################################################## 134# 135# Draw - Draw the roster. 136# 137############################################################################## 138sub Draw { 139 my $self = shift; 140 141 $self->{canvas}->createText(-1000,-1000, 142 -text=>"TestString", 143 ( 144 (ref($self->{varsFont}) eq "Tk::Font") ? 145 (-font=>$self->{varsFont}) : 146 ( 147 ($self->{varsFont} ne "") ? 148 (-font=>$self->{varsFont}) : 149 () 150 ) 151 ), 152 -tags=>[ "rostertest" ]); 153 154 my ($x1,$y1,$x2,$y2) = $self->{canvas}->bbox("rostertest"); 155 156 $self->{varsItem}->{Height} = $y2 - $y1 + 4; 157 $self->{varsItem}->{Height} = 16 if ($self->{varsItem}->{Height} < 16); 158 159 $self->{canvas}->delete("all"); 160 161 $self->{varsY} = 0; 162 163 foreach my $group ($self->GetGroups()) { 164 165 $self->DrawItem($self->CreateTag($group),"group",$group,0) 166 unless (($self->{varsOnlineOnly} == 1) && 167 ($self->ActiveGroup($group) == 0)); 168 169 if ($self->{groups}->{$group}->{'__roster__:status'} == 1) { 170 foreach my $jid (sort {uc($self->{jids}->{$a}->{name}) cmp uc($self->{jids}->{$b}->{name})} keys(%{$self->{groups}->{$group}})) { 171 next if ($jid eq '__roster__:status'); 172 next if (($self->{varsOnlineOnly} == 1) && !defined($self->Resource($jid))); 173 $self->DrawItem($self->CreateTag($group,$jid),"jid",$self->{jids}->{$jid}->{name},1); 174 if ($self->{groups}->{$group}->{$jid} == 1) { 175 foreach my $resource (sort {$self->{resources}->{$jid}->{$b}->{priority} <=> $self->{resources}->{$jid}->{$a}->{priority}} keys(%{$self->{resources}->{$jid}})) { 176 $self->DrawItem($self->CreateTag($group,$jid,$resource),"resource",$resource,2); 177 } 178 } 179 } 180 } 181 } 182 183 foreach my $jid (sort {uc($self->{jids}->{$a}->{name}) cmp uc($self->{jids}->{$b}->{name})} keys(%{$self->{groups}->{'__roster__:none'}})) { 184 next if ($jid eq '__roster__:status'); 185 next if (($self->{varsOnlineOnly} == 1) && !defined($self->Resource($jid))); 186 $self->DrawItem($self->CreateTag('__roster__:none',$jid),"jid",$self->{jids}->{$jid}->{name},0); 187 if ($self->{groups}->{'__roster__:none'}->{$jid} == 1) { 188 foreach my $resource (sort {$self->{jids}->{$jid}->{resources}->{$b}->{priority} <=> $self->{resources}->{$jid}->{$a}->{priority}} keys(%{$self->{resources}->{$jid}})) { 189 $self->DrawItem($self->CreateTag('__roster__:none',$jid,$resource),"resource",$resource,1); 190 } 191 } 192 } 193 194 (undef,undef,undef,$y2) = $self->{canvas}->bbox("all"); 195 196 (undef,undef,$x2,undef) = $self->{canvas}->bbox("text"); 197 198 $x2 = 10 unless ($x2 > 10); 199 $y2 = 10 unless ($y2 > 10); 200 201 $self->{canvas}-> 202 configure(-scrollregion=> 203 [ 0, 204 0, 205 ($x2+2), 206 $y2 207 ]); 208 209 $self->{varsBalloon}-> 210 attach($self->{canvas}, 211 -balloonposition => 'mouse', 212 -msg=>{ %{$self->{balloons}} }, 213 ) 214 if defined($self->{varsBalloon}); 215 216 if (defined($self->{varsSelectedTag}) && 217 ($self->{canvas}->gettags($self->{varsSelectedTag}) ne "")) { 218 $self->{canvas}->itemconfigure($self->{varsSelectedTag}, 219 -fill=>$self->{varsSelectBackground}); 220 } else { 221 $self->{varsSelectedJID} = undef; 222 $self->{varsSelectedTag} = undef; 223 } 224} 225 226 227############################################################################## 228# 229# DrawItem - Draw a single item entry. 230# 231############################################################################## 232sub DrawItem { 233 my $self = shift; 234 my ($tag,$type,$text,$indentLevel) = @_; 235 236 my %types; 237 $types{group}->{back} = $self->{varsGroupBackground}; 238 $types{group}->{fore} = $self->{varsGroupForeground}; 239 $types{jid}->{back} = $self->{varsJIDBackground}; 240 $types{jid}->{fore} = $self->{varsJIDForeground}; 241 $types{resource}->{back} = $self->{varsResourceBackground}; 242 $types{resource}->{fore} = $self->{varsResourceForeground}; 243 244 my ($group,$jid,$resource); 245 246 foreach my $splitTag (split(':::',$tag)) { 247 ($group) = ($splitTag =~ /^group-(.+)$/) if ($splitTag =~ /^group\-/); 248 ($jid) = ($splitTag =~ /^jid-(.+)$/) if ($splitTag =~ /^jid\-/); 249 ($resource) = ($splitTag =~ /^res-(.+)$/) if ($splitTag =~ /^res\-/); 250 } 251 252 $group = $self->UnescapeTag($group); 253 $jid = $self->UnescapeTag($jid); 254 $resource = $self->UnescapeTag($resource); 255 256 my $icon; 257 258 if ($type eq "group") { 259 if ($self->{groups}->{$group}->{'__roster__:status'} == 1) { 260 $icon = $main::GUI{Icons}->{Open}; 261 } else { 262 $icon = $main::GUI{Icons}->{Closed} 263 } 264 } 265 266 if ($type eq "resource") { 267 $icon = $main::GUI{Icons}->{Resource}; 268 } 269 270 if ($type eq "jid") { 271 272 my $resource = $self->Resource($jid); 273 274 if (defined($resource)) { 275 my $presence = 276 (($self->{resources}->{$jid}->{$resource}->{show} ne "") ? 277 $self->{resources}->{$jid}->{$resource}->{show} : 278 $self->{resources}->{$jid}->{$resource}->{type} 279 ); 280 281 $icon = &main::jarlRosterIF_PresenceIcon($self,$presence,$jid); 282 } else { 283 $icon = &main::jarlRosterIF_PresenceIcon($self,"unavailable",$jid); 284 } 285 } 286 287 $self->{canvas}-> 288 createRectangle(0,$self->{varsY}+1, 289 10000,$self->{varsY}+$self->{varsItem}->{Height}, 290 -fill=>$types{$type}->{back}, 291 -outline=>undef, 292 -tags=>[ 293 $tag, 294 (($type eq "jid") ? 295 ("jidback", "${tag}-back") : 296 () 297 ), 298 (($type eq "resource") ? 299 ("resback", "${tag}-back") : 300 () 301 ) 302 ]); 303 304 $self->{canvas}->createImage(($indentLevel*15)+5, 305 $self->{varsY}+(int($self->{varsItem}->{Height}/2)), 306 -image=>$icon, 307 -anchor=>"w", 308 -tags=>[ $tag ]); 309 310 $self->{canvas}->createText(($indentLevel*15)+($icon->width()+10), 311 $self->{varsY}+(int($self->{varsItem}->{Height}/2)), 312 -text=>$text, 313 ( 314 (ref($self->{varsFont}) eq "Tk::Font") ? 315 (-font=>$self->{varsFont}) : 316 ( 317 ($self->{varsFont} ne "") ? 318 (-font=>$self->{varsFont}) : 319 () 320 ) 321 ), 322 -fill=>$types{$type}->{fore}, 323 -anchor=>"w", 324 -tags=>[ $tag , "text" ]); 325 326 $self->{varsY} += $self->{varsItem}->{Height}; 327} 328 329 330############################################################################## 331# 332# RegisterGroup - overload function to handle adding in a new group. Sets up 333# the bindings for interfacing with the Roster groups. 334# 335############################################################################## 336sub RegisterGroup { 337 my $self = shift; 338 my ($group) = @_; 339 340 if ($self->{canvas}->bind("group-${group}") eq "") { 341 $self->{canvas}-> 342 bind("group-${group}", 343 "<Button-1>", 344 sub { 345 $self->{canvas}-> 346 itemconfigure("jidback", 347 -fill=>$self->{varsJIDBackground}); 348 $self->{canvas}-> 349 itemconfigure("resback", 350 -fill=>$self->{varsResourceBackground}); 351 $self->{varsSelectedJID} = undef; 352 $self->{varsSelectedTag} = undef; 353 } 354 ); 355 $self->{canvas}-> 356 bind("group-${group}", 357 "<Double-1>", 358 sub { 359 $self->Toggle($group); 360 } 361 ); 362 } 363} 364 365 366############################################################################## 367# 368# RegisterJID - overload to handle adding a new JID. Setups the canvas 369# bindings for interfacing with the Roster. 370# 371############################################################################## 372sub RegisterJID { 373 my $self = shift; 374 my ($group,$jid,$resource) = @_; 375 376 my $tag = $self->CreateTag($group,$jid,$resource); 377 378 if (defined($resource)) { 379 $self->RegisterBalloon($tag,\$self->{resources}->{$jid}->{$resource}->{balloon}); 380 } else { 381 $self->RegisterBalloon($tag,\$self->{jids}->{$jid}->{balloon}); 382 } 383 384 return unless ($self->{canvas}->bind($tag) eq ""); 385 386 my $fullJID = $jid; 387 $fullJID .= "/${resource}" unless ($resource eq ""); 388 389 $self->{canvas}-> 390 bind($tag, 391 "<Button-3>", 392 sub { 393 $self->{canvas}-> 394 itemconfigure("jidback", 395 -fill=>$self->{varsJIDBackground}); 396 $self->{canvas}-> 397 itemconfigure("resback", 398 -fill=>$self->{varsResourceBackground}); 399 $self->{canvas}-> 400 itemconfigure("${tag}-back", 401 -fill=>$self->{varsSelectBackground}); 402 $self->{varsSelectedJID} = $fullJID; 403 $self->{varsSelectedTag} = "${tag}-back"; 404 &{$self->{varsJIDRightCommand}}($group,$jid,$resource) 405 if ($self->{varsJIDRightCommand} ne ""); 406 } 407 ); 408 409 $self->{canvas}-> 410 bind($tag, 411 "<Button-1>", 412 sub { 413 $self->{canvas}-> 414 itemconfigure("jidback", 415 -fill=>$self->{varsJIDBackground}); 416 $self->{canvas}-> 417 itemconfigure("resback", 418 -fill=>$self->{varsResourceBackground}); 419 $self->{canvas}-> 420 itemconfigure("${tag}-back", 421 -fill=>$self->{varsSelectBackground}); 422 $self->{varsSelectedJID} = $fullJID; 423 $self->{varsSelectedTag} = "${tag}-back"; 424 } 425 ); 426 427 $self->{canvas}-> 428 bind($tag, 429 "<Double-1>", 430 sub { 431 &{$self->{varsJIDLeftCommand}}($jid,$resource) 432 if ($self->{varsJIDLeftCommand} ne ""); 433 } 434 ); 435} 436 437 438############################################################################## 439# 440# Clear - Clear the widget of all data 441# 442############################################################################## 443sub Clear { 444 my $self = shift; 445 446 $self->{canvas}->delete("all"); 447 $self->SUPER::Clear(); 448} 449 450 4511; 452