package TkConvo; use Milkbone::Convo; use Tk::Browser; use Tk::BrowseEdit; use Milkbone; use strict; use warnings; my $mw = hook("tk_getmain"); my %convos; register_hook("create_convo", sub { my $buddy = $ARGS{-user}; my $convo; return if(exists $convos{$buddy}); $convos{$buddy} = 1; print " is new"; print %convos; $convo = $mw->MBConvo; $convo->init($mw, hook("protocol_get_realname", -user => $buddy) || $buddy); $convos{$buddy} = $convo; register_hook("msg_in_$buddy", sub { if(!$convos{$ARGS{-user}}) { hook("create_convo", -user => hook("protocol_get_realname", -user => $ARGS{-user})); } $convos{$ARGS{-user}}->on_receive(@ARGS{-from, -msg, -away}); hook("flash_window", -wnd => $convo); }); register_hook("protocol_typing_status_changed_$buddy", sub { $ARGS{-self}->typing_status($ARGS{-status}); }, {-self => $convo}); register_hook("msg_sent_$buddy", sub { $ARGS{-self}->msg_sent(@ARGS{-msg, -away}); }, {-self => $convo}); register_hook("buddy_in_$buddy", sub { $ARGS{-self}->on_buddy_in(); }, {-self => $convo}); register_hook("buddy_out_$buddy", sub { $ARGS{-self}->on_buddy_out(); }, {-self => $convo}); $convo->focus; $convo->{bottom}->focus; $convo->withdraw if hook("protocol_away_status") != 0; $convo->update; hook("flash_window", -wnd => $convo) unless $ARGS{-fabricated}; }); register_hook("remove_convo", sub { deregister_hook("msg_in_$ARGS{-user}"); deregister_hook("buddy_in_$ARGS{-user}"); deregister_hook("buddy_out_$ARGS{-user}"); $convos{$ARGS{-user}}->destroy; delete $convos{$ARGS{-user}}; }); register_hook("msg_in", sub { hook("create_convo", -user => hook("protocol_get_realname", -user => $ARGS{-user})); }); register_hook("get_convo", sub { return $convos{$ARGS{-user}}; }); register_hook("protocol_go_away", sub { $_->withdraw for values(%convos); }); register_hook("protocol_return", sub { $_->deiconify && $_->focus for values(%convos); }); register_hook("goodbye", sub { my $goodbye = join(' ', option("Goodbye")); hook("protocol_send_im", -dest => $_, -msg => $goodbye, -away => 0) for(keys(%convos)); }); register_hook("buddy_in", sub { hook("buddy_in_$ARGS{-buddy}", -group => $ARGS{-group}) if $convos{$ARGS{-buddy}}; }); register_hook("buddy_out", sub { hook("buddy_out_$ARGS{-buddy}", -group => $ARGS{-group}) if $convos{$ARGS{-buddy}}; }); 1;