archive
/
milkbone
1
0
Fork 0
Code Pull Requests Projects Releases Activity
Browse Source

""

master
milkbone57 22 years ago
parent
b02fec2fb2
commit
0a3ccc81e6
3 changed files with 263 additions and 212 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 316
      plugins/Tk-Convo/Milkbone/Convo.pm
  2. 68
      plugins/Tk-Convo/Milkbone/ConvoTL.pm
  3. 91
      plugins/Tk-Convo/Tk-Convo.pl

316
plugins/Tk-Convo/Milkbone/Convo.pm
Unescape View File

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

68
plugins/Tk-Convo/Milkbone/ConvoTL.pm
Unescape View File

@ -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
Unescape View File

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

Write Preview
Loading…
Cancel
Save