You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
104 lines
2.4 KiB
104 lines
2.4 KiB
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; |
|
|
|
print "IN CREATE_CONVO\n"; |
|
|
|
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 { |
|
print "message $ARGS{-msg} received \n\n"; |
|
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;
|
|
|