milkbone57 22 years ago
parent
commit
0a3ccc81e6
  1. 314
      plugins/Tk-Convo/Milkbone/Convo.pm
  2. 68
      plugins/Tk-Convo/Milkbone/ConvoTL.pm
  3. 91
      plugins/Tk-Convo/Tk-Convo.pl

314
plugins/Tk-Convo/Milkbone/Convo.pm

@ -6,242 +6,226 @@ use Milkbone; @@ -6,242 +6,226 @@ use Milkbone;
our $VERSION = '1.0';
use Tk(Ev);
use base qw(Tk::Toplevel);
use Tk qw(Ev);
use Tk::widgets qw(Frame);
use base qw(Tk::Frame);
use strict;
use warnings;
use Tk::BrowseEdit;
Construct Tk::Widget 'MBConvo';
sub ClassInit
{
my ($class, $mw) = @_;
$class->SUPER::ClassInit($mw);
my ($class, $mw) = @_;
$class->SUPER::ClassInit($mw);
}
sub Populate
{
my ($self, $args) = @_;
$self->SUPER::Populate($args);
my ($self, $args) = @_;
$self->SUPER::Populate($args);
$self->ConfigSpecs('DEFAULT' => ['SELF']);
$self->ConfigSpecs('DEFAULT' => ['SELF']);
}
sub on_send
{
my $self = shift;
my $msg = $self->{bottom}->to_html('0.0', 'end');
$msg =~ s/\n*$//;
$msg =~ s/\r\n?//g;
$msg =~ s/\n/<br>/g;
return if($msg eq "");
$msg =~ s/&amp;/&/g;
$msg =~ s/&quot;/\"/g;
$msg =~ s/%ignore%//gi;
$self->{bottom}->delete('0.0', 'end');
# $self->{bottom}->ResetUndo;
hook("protocol_send_im", -dest => $self->{buddy}, -msg => $msg, -away => 0);
$self->{typing_status} = 0;
$self->{text_entered} = 0;
$self->{typing_empty} = 0;
hook("protocol_set_typing_status", -user => $self->{buddy}, -status => 0);
my $self = shift;
my $msg = $self->{bottom}->to_html('0.0', 'end');
$msg =~ s/\n*$//;
$msg =~ s/\r\n?//g;
$msg =~ s/\n/<br>/g;
return if($msg eq "");
$msg =~ s/&amp;/&/g;
$msg =~ s/&quot;/\"/g;
$msg =~ s/%ignore%//gi;
$self->{bottom}->delete('0.0', 'end');
# $self->{bottom}->ResetUndo;
hook("protocol_send_im", -dest => $self->{buddy}, -msg => $msg, -away => 0);
$self->{typing_status} = 0;
$self->{text_entered} = 0;
$self->{typing_empty} = 0;
hook("protocol_set_typing_status", -user => $self->{buddy}, -status => 0);
}
sub msg_sent
{
my ($self, $msg, $away) = @_;
my $nl = $self->{empty} ? "" : "\n";
$self->{top}->insert('end', $nl . data("me"), 'self');
$self->{top}->insert('end', $self->make_timestamp, 'self_stamp');
$self->{top}->insert('end', ": ", 'self');
$self->{top}->insertHTML('end', $msg);
$self->{top}->yview($self->{top}->index('end'));
$self->{empty} = 0;
my ($self, $msg, $away) = @_;
my $nl = $self->{empty} ? "" : "\n";
$self->{top}->insert('end', $nl . data("me"), 'self');
$self->{top}->insert('end', $self->make_timestamp, 'self_stamp');
$self->{top}->insert('end', ": ", 'self');
$self->{top}->insertHTML('end', $msg);
$self->{top}->yview($self->{top}->index('end'));
$self->{empty} = 0;
}
sub on_receive
{
my ($self) = @_;
my $nl = $self->{empty} ? "" : "\n";
$self->{top}->insert('end', "${nl}$ARGS{-user}", 'buddy');
$self->{top}->insert('end', $self->make_timestamp, 'buddy_stamp');
$self->{top}->insert('end', ": ", 'buddy');
$self->{top}->insertHTML('end', "$ARGS{-msg}");
$self->{top}->yview($self->{top}->index('end'));
$self->{empty} = 0;
$self->typing_status(0);
my ($self) = @_;
my $nl = $self->{empty} ? "" : "\n";
$self->{top}->insert('end', "${nl}$ARGS{-user}", 'buddy');
$self->{top}->insert('end', $self->make_timestamp, 'buddy_stamp');
$self->{top}->insert('end', ": ", 'buddy');
$self->{top}->insertHTML('end', "$ARGS{-msg}");
$self->{top}->yview($self->{top}->index('end'));
$self->{empty} = 0;
$self->typing_status(0);
}
sub on_destroy
{
my ($self) = @_;
hook("remove_convo", -user => shift->{buddy});
$self->{rep_id}->cancel;
hook("protocol_set_typing_status", -user => $self->{buddy}, -status => 0);
my ($self) = @_;
hook("remove_convo", -user => shift->{buddy});
$self->{rep_id}->cancel;
hook("protocol_set_typing_status", -user => $self->{buddy}, -status => 0);
}
sub on_prof
{
hook("get_profile", -user => shift->{buddy});
hook("get_profile", -user => shift->{buddy});
}
sub on_buddy_in
{
my ($self) = @_;
my ($self) = @_;
$self->{top}->insert('end', "\n" . $self->{buddy} . " has signed in.", "buddy") if $self->{out};
$self->{out} = 0 if(defined($self->{out}) and $self->{out} == 1);
$self->{top}->yview($self->{top}->index('end'));
$self->{top}->insert('end', "\n" . $self->{buddy} . " has signed in.", "buddy") if $self->{out};
$self->{out} = 0 if(defined($self->{out}) and $self->{out} == 1);
$self->{top}->yview($self->{top}->index('end'));
}
sub on_buddy_out
{
my ($self) = @_;
my ($self) = @_;
$self->{top}->insert('end', "\n" . $self->{buddy} . " has signed out.", "buddy");
$self->{out} = 1;
$self->{top}->yview($self->{top}->index('end'));
$self->{top}->insert('end', "\n" . $self->{buddy} . " has signed out.", "buddy");
$self->{out} = 1;
$self->{top}->yview($self->{top}->index('end'));
}
sub make_timestamp
{
my ($self) = @_;
my ($self) = @_;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
$sec = sprintf("%02d", $sec);
my $pm = ($hour > 12) ? 'PM' : 'AM';
$hour = $hour % 12;
$year += 1900;
$year %= 100;
$sec = sprintf("%02d", $sec);
my $pm = ($hour > 12) ? 'PM' : 'AM';
$hour = $hour % 12;
$year += 1900;
$year %= 100;
return " (" . $mon . "/" . $mday . "/" . $year . " " . $hour . ":" . $min . ":" . $sec . " " . $pm . ") ";
return " (" . $mon . "/" . $mday . "/" . $year . " " . $hour . ":" . $min . ":" . $sec . " " . $pm . ") ";
}
sub toggle_stamps
{
my ($self) = @_;
$self->{hide_stamps} = !$self->{hide_stamps};
my ($self) = @_;
$self->{hide_stamps} = !$self->{hide_stamps};
$self->{top}->tagConfigure('self_stamp', -elide => $self->{hide_stamps});
$self->{top}->tagConfigure('buddy_stamp', -elide => $self->{hide_stamps});
$self->{top}->tagConfigure('self_stamp', -elide => $self->{hide_stamps});
$self->{top}->tagConfigure('buddy_stamp', -elide => $self->{hide_stamps});
}
sub typing_status
{
my ($self, $status) = @_;
my ($self, $status) = @_;
my @msgs = ("", $self->{buddy} . " has typed text.", $self->{buddy} . " is typing...");
$self->{typing}->configure(-text => $msgs[$status]);
my @msgs = ("", $self->{buddy} . " has typed text.", $self->{buddy} . " is typing...");
$self->{typing}->configure(-text => $msgs[$status]);
}
sub on_key
{
my ($self) = @_;
if($self->{typing_status} == 0)
{
hook("protocol_set_typing_status", -user => $self->{buddy}, -status => 2);
$self->{typing_status} = 2;
}
$self->{last_typed} = time;
my ($self) = @_;
if($self->{typing_status} == 0)
{
hook("protocol_set_typing_status", -user => $self->{buddy}, -status => 2);
$self->{typing_status} = 2;
}
$self->{last_typed} = time;
}
sub update_status
{
my ($self) = @_;
if($self->{bottom}->get('0.0', 'end') =~ /^\s*$/ && $self->{typing_status})
{
hook("protocol_set_typing_status", -user => $self->{buddy}, -status => 0);
$self->{typing_status} = 0;
return;
}
if((time - $self->{last_typed}) >= 5 && $self->{typing_status} == 2)
{
hook("protocol_set_typing_status", -user => $self->{buddy}, -status => 1);
$self->{typing_status} = 1;
}
my ($self) = @_;
if($self->{bottom}->get('0.0', 'end') =~ /^\s*$/ && $self->{typing_status})
{
hook("protocol_set_typing_status", -user => $self->{buddy}, -status => 0);
$self->{typing_status} = 0;
return;
}
if((time - $self->{last_typed}) >= 5 && $self->{typing_status} == 2)
{
hook("protocol_set_typing_status", -user => $self->{buddy}, -status => 1);
$self->{typing_status} = 1;
}
}
sub init
{
my ($self, $mw, $buddy) = @_;
$self->withdraw();
$self->title("$buddy - Conversation");
$self->update;
# WIDGET CREATION BEGIN
$self->{menu} = $self->Menu;
$self->{menu_file} = $self->{menu}->cascade(-label => "File", -tearoff => 0);
$self->{menu_file}->command(-label => "Close", -command => [$self, "destroy"]);
$self->configure(-menu => $self->{menu});
$self->{frame} = $self->Frame(-borderwidth => 0)->pack(-expand => 1, -fill => 'both');
$self->{off} = 0;
$self->{hide_stamps} = 1;
$self->{top} = $self->{frame}->Scrolled("Browser",
-height => 6, -font => "times 12", -scrollbars => 'oe', -wrap => 'word', -takefocus => 0)->
pack(-side => 'top', -expand => 1, -fill => 'both', -padx => 5);
$self->{bottom} = $self->{frame}->Scrolled("BrowseEdit",
-height => 6, -font => "times 12", -scrollbars => 'oe', -wrap => 'word',
-spacing1 => 0, -spacing2 => 0, -spacing3 => 0)->
pack(-expand => 1, -fill => 'both', -padx => 5);
$self->{typing} = $self->{frame}->Label->pack(-anchor => 'w');
$self->{frame}->Button(-text => "Send", -command => [$self, "on_send"])->
pack(-pady => 3, -side => 'right', -anchor => 'center');
$self->{frame}->Button(-text => "Get Profile", -command => [$self, "on_prof"])->
pack(-pady => 3, -side => 'left', -anchor => 'center');
# WIDGET CREATION END
$self->{top}->tagConfigure('self', -foreground => 'red', -font => 'times 12 bold');
$self->{top}->tagConfigure('buddy', -foreground => 'blue', -font => 'times 12 bold');
$self->{top}->tagConfigure('self_stamp', -foreground => 'red', -elide => 1, -font => 'times 9 bold');
$self->{top}->tagConfigure('buddy_stamp', -foreground => 'blue', -elide => 1, -font => 'times 9 bold');
$self->{bottom}->bind("<Return>", [$self, "on_send"]);
$self->{bottom}->bind("<Control-Return>", [sub { $self->{bottom}->insert('insert', "\r\n")}, $self]);
$self->{bottom}->bind("<Escape>", [$self, "destroy"]);
$self->{bottom}->bind("<KeyPress>", [$self, "on_key"]);
$self->bind("<F2>", [$self, "toggle_stamps"]);
hook("tk_bindwheel", -window => $self->{bottom});
hook("tk_bindwheel", -window => $self->{top});
# $self->bind('<Configure>', [sub {
# my ($width, $height) = @_;
# set_option('ConvoHeight', $height);
# set_option('ConvoWidth', $width);
# }, Ev('w'), Ev('h')]);
$self->{me} = data("me");
$self->{buddy} = $buddy;
$self->{empty} = 1;
$self->{last_typed} = time;
$self->{typing_status} = 0;
$self->update;
$self->geometry("480x320");
$self->deiconify;
hook("tk_seticon", -wnd => $self);
$self->OnDestroy([$self, "on_destroy"]);
$self->{bottom}->focus;
$self->{rep_id} = $self->repeat(1000, [$self, "update_status"]);
my ($self, $mw, $buddy) = @_;
$self->update;
# WIDGET CREATION BEGIN
$self->{off} = 0;
$self->{hide_stamps} = 1;
$self->{top} = $self->Scrolled("Browser",
-height => 6, -font => "times 12", -scrollbars => 'oe', -wrap => 'word', -takefocus => 0)->
pack(-side => 'top', -expand => 1, -fill => 'both', -padx => 5);
$self->{bottom} = $self->Scrolled("BrowseEdit",
-height => 6, -font => "times 12", -scrollbars => 'oe', -wrap => 'word',
-spacing1 => 0, -spacing2 => 0, -spacing3 => 0)->
pack(-expand => 1, -fill => 'both', -padx => 5);
$self->{typing} = $self->Label->pack(-anchor => 'w');
$self->Button(-text => "Send", -command => [$self, "on_send"])->
pack(-pady => 3, -side => 'right', -anchor => 'center');
$self->Button(-text => "Get Profile", -command => [$self, "on_prof"])->
pack(-pady => 3, -side => 'left', -anchor => 'center');
# WIDGET CREATION END
$self->{top}->tagConfigure('self', -foreground => 'red', -font => 'times 12 bold');
$self->{top}->tagConfigure('buddy', -foreground => 'blue', -font => 'times 12 bold');
$self->{top}->tagConfigure('self_stamp', -foreground => 'red', -elide => 1, -font => 'times 9 bold');
$self->{top}->tagConfigure('buddy_stamp', -foreground => 'blue', -elide => 1, -font => 'times 9 bold');
$self->{bottom}->bind("<Return>", [$self, "on_send"]);
$self->{bottom}->bind("<Control-Return>", [sub { $self->{bottom}->insert('insert', "\r\n")}, $self]);
$self->{bottom}->bind("<KeyPress>", [$self, "on_key"]);
$self->bind("<F2>", [$self, "toggle_stamps"]);
hook("tk_bindwheel", -window => $self->{bottom});
hook("tk_bindwheel", -window => $self->{top});
# $self->bind('<Configure>', [sub {
# my ($width, $height) = @_;
# set_option('ConvoHeight', $height);
# set_option('ConvoWidth', $width);
# }, Ev('w'), Ev('h')]);
$self->{me} = data("me");
$self->{buddy} = $buddy;
$self->{empty} = 1;
$self->{last_typed} = time;
$self->{typing_status} = 0;
$self->{bottom}->focus;
$self->{rep_id} = $self->repeat(1000, [$self, "update_status"]);
}
1;

68
plugins/Tk-Convo/Milkbone/ConvoTL.pm

@ -0,0 +1,68 @@ @@ -0,0 +1,68 @@
# milkbone - conversation window
package Milkbone::ConvoTL;
use Milkbone;
use Milkbone::Convo;
our $VERSION = '1.0';
use Tk(Ev);
use base qw(Tk::Toplevel);
use strict;
use warnings;
Construct Tk::Widget 'MBConvoTL';
sub ClassInit
{
my ($class, $mw) = @_;
$class->SUPER::ClassInit($mw);
}
sub Populate
{
my ($self, $args) = @_;
$self->SUPER::Populate($args);
$self->ConfigSpecs('DEFAULT' => ['SELF']);
}
sub on_destroy
{
my ($self) = @_;
hook("remove_convo", -user => shift->{buddy});
hook("protocol_set_typing_status", -user => $self->{buddy}, -status => 0);
}
sub init
{
my ($self, $mw, $buddy) = @_;
$self->{buddy} = $buddy;
$self->withdraw();
$self->title("$buddy - Conversation");
$self->update;
# WIDGET CREATION BEGIN
$self->{menu} = $self->Menu;
$self->{menu_file} = $self->{menu}->cascade(-label => "File", -tearoff => 0);
$self->{menu_file}->command(-label => "Close", -command => [$self, "destroy"]);
$self->configure(-menu => $self->{menu});
$self->{convo} = $self->MBConvo->pack(-expand => 1, -fill => 'both');
$self->bind("<Escape>", [$self, "destroy"]);
$self->{convo}->init($mw, $buddy);
$self->update;
$self->geometry("480x320");
$self->deiconify;
hook("tk_seticon", -wnd => $self);
$self->OnDestroy([$self, "on_destroy"]);
}
1;

91
plugins/Tk-Convo/Tk-Convo.pl

@ -1,6 +1,6 @@ @@ -1,6 +1,6 @@
package TkConvo;
use Milkbone::Convo;
use Milkbone::ConvoTL;
use Tk::Browser;
use Tk::BrowseEdit;
use Milkbone;
@ -12,87 +12,86 @@ my $mw = hook("tk_getmain"); @@ -12,87 +12,86 @@ my $mw = hook("tk_getmain");
my %convos;
register_hook("create_convo", sub {
my $buddy = $ARGS{-user};
my $convo;
my $buddy = $ARGS{-user};
my $convo;
return if(exists $convos{$buddy});
$convos{$buddy} = 1;
return if(exists $convos{$buddy});
$convos{$buddy} = 1;
$convo = $mw->MBConvo;
$convo->init($mw, hook("protocol_get_realname", -user => $buddy) || $buddy);
$convo = $mw->MBConvoTL;
$convo->init($mw, $buddy);
$convos{$buddy} = $convo;
$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("msg_in_$buddy", sub {
if(!$convos{$ARGS{-user}})
{
hook("create_convo", -user => hook("protocol_get_realname", -user => $ARGS{-user}));
}
$convos{$ARGS{-user}}->{convo}->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("protocol_typing_status_changed_$buddy", sub {
$ARGS{-self}->{convo}->typing_status($ARGS{-status});
}, {-self => $convo});
register_hook("msg_sent_$buddy", sub {
$ARGS{-self}->msg_sent(@ARGS{-msg, -away});
}, {-self => $convo});
register_hook("protocol_send_im", sub {
$ARGS{-self}->{convo}->msg_sent(@ARGS{-msg, -away});
}, {-self => $convo});
register_hook("buddy_in_$buddy", sub {
$ARGS{-self}->on_buddy_in();
}, {-self => $convo});
register_hook("buddy_in_$buddy", sub {
$ARGS{-self}->{convo}->on_buddy_in();
}, {-self => $convo});
register_hook("buddy_out_$buddy", sub {
$ARGS{-self}->on_buddy_out();
}, {-self => $convo});
register_hook("buddy_out_$buddy", sub {
$ARGS{-self}->{convo}->on_buddy_out();
}, {-self => $convo});
$convo->focus;
$convo->{bottom}->focus;
$convo->focus;
$convo->withdraw if hook("protocol_away_status") != 0;
$convo->update;
hook("flash_window", -wnd => $convo) unless $ARGS{-fabricated};
$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}");
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}};
$convos{$ARGS{-user}}->destroy;
delete $convos{$ARGS{-user}};
});
register_hook("msg_in", sub {
hook("create_convo", -user => hook("protocol_get_realname", -user => $ARGS{-user}));
hook("create_convo", -user => hook("protocol_get_realname", -user => $ARGS{-user}));
});
register_hook("get_convo", sub {
return $convos{$ARGS{-user}};
return $convos{$ARGS{-user}};
});
register_hook("protocol_go_away", sub {
$_->withdraw for values(%convos);
$_->withdraw for values(%convos);
});
register_hook("protocol_return", sub {
$_->deiconify && $_->focus for values(%convos);
$_->deiconify && $_->focus for values(%convos);
});
register_hook("goodbye", sub {
my $goodbye = join(' ', option("Goodbye"));
my $goodbye = join(' ', option("Goodbye"));
hook("protocol_send_im", -dest => $_, -msg => $goodbye, -away => 0) for(keys(%convos));
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}};
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}};
hook("buddy_out_$ARGS{-buddy}", -group => $ARGS{-group}) if $convos{$ARGS{-buddy}};
});
1;

Loading…
Cancel
Save