diff --git a/Milkbone.pm b/Milkbone.pm
index 8eda6b9..4e6c2fc 100644
--- a/Milkbone.pm
+++ b/Milkbone.pm
@@ -199,12 +199,15 @@ sub unload_plugin
delete $plugins{$plugin};
- for(keys %INC)
+ for(loaded_files())
{
- delete $INC{$_} if /^plugins\/$plugin/;
+ if(/^plugins\/$plugin/)
+ {
+ s/plugins\///;
+ s/\/$plugin\///;
+ delete $INC{$_};
+ }
}
-
- print %plugins;
}
sub plugin_list
@@ -254,7 +257,7 @@ sub hook
sub reload_core
{
delete $INC{'Milkbone.pm'};
- eval "require 'Milkbone.pm';";
+ eval "require 'Milkbone.pm';" or warn "$@";
}
sub register_hook
@@ -403,6 +406,25 @@ sub user_file
return path("$dir/$user/$file");
}
+# Stolen from Devel::ptkdb - thanks!
+sub loaded_files
+{
+ my @fList = sort {
+
+ # sort comparison function block
+ my $fa = substr($a, 0, 1) ;
+ my $fb = substr($b, 0, 1) ;
+
+ return $a cmp $b if ($fa eq '/') && ($fb eq '/') ;
+
+ return -1 if ($fb eq '/') && ($fa ne '/') ;
+ return 1 if ($fa eq '/' ) && ($fb ne '/') ;
+
+ return $a cmp $b ;
+
+ } grep s/^_ work in profiles and convos (you can send them as < and > for now)
* Splash screen
* Mouse wheel works in Linux
-* No more boxes in focused widgets on Linux
+* No more boxes in focused widgets on Linux warn "$ARGS{-user} has been warned";
+
* Sounds now play asynchronously on Linux (without starting too many play processes)
* Fixed weirdness with context menu on Linux
* Fancier buttons and menus on Linux (a LOT fancier)
-* Preliminary aliasing support
-* Alias-saving works (but is disabled)
+* Alias-saving works (but is disabled because alias-reading doesn't work :) )
* Sound works on Linux (without running artsd)
* Really fixed the Busted SNAC bug
diff --git a/lib/Milkbone/AllHooks.pm b/lib/Milkbone/AllHooks.pm
index 90a9442..9d23339 100644
--- a/lib/Milkbone/AllHooks.pm
+++ b/lib/Milkbone/AllHooks.pm
@@ -9,6 +9,7 @@ use Milkbone;
sub AUTOLOAD
{
my $hook = $AUTOLOAD;
+ $hook = (split(/::/, $hook))[-1];
hook($hook, @_);
}
diff --git a/lines.pl b/lines.pl
deleted file mode 100644
index 9caad62..0000000
--- a/lines.pl
+++ /dev/null
@@ -1,19 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use File::Find;
-
-my $sum;
-
-sub process
-{
- return if -d;
- return unless /\.p(l|m)$/;
- my ($res) = `wc -l $_`;
- $sum += ($res =~ /(\d+)/)[0];
-}
-
-find(\&process, ".");
-print $sum . "\n"
diff --git a/mb.conf b/mb.conf
index 4d583fd..f3adcf4 100644
--- a/mb.conf
+++ b/mb.conf
@@ -2,9 +2,10 @@
Goodbye sorry, gotta, go
Modules Tk-PluginsConf, Net-OSCAR, Tk-GUI, Tk-Logon, Tk-BList, Tk-Profile, Tk-File, Tk-About, Tk-AddBuddy, Tk-Convo
-Plugins Sound, XAMP, Templog, Monitor
+Plugins Sound, XAMP, Templog, Monitor, Counterstrike, hooktest
Port 5190
HeavyLogging 0
SoundsWhileAway 0
Timeout 60
-TrayIcon 1
\ No newline at end of file
+TrayIcon 1
+HideBListLogo 0
\ No newline at end of file
diff --git a/milkbone.nsi b/milkbone.nsi
index 8e94495..8344562 100644
--- a/milkbone.nsi
+++ b/milkbone.nsi
@@ -44,8 +44,8 @@ File images\*
SetOutPath $INSTDIR\sounds
File sounds\*
SetOutPath $INSTDIR\plugins
-File plugins\*.zip
-File plugins\*.pl
+File plugins\*
+File plugins\*
SetOutPath $INSTDIR
SetShellVarContext all
diff --git a/plugins/Counterstrike.pl b/plugins/Counterstrike.pl
new file mode 100644
index 0000000..1a9f2be
--- /dev/null
+++ b/plugins/Counterstrike.pl
@@ -0,0 +1,16 @@
+package Counterattack;
+
+use Milkbone;
+
+register_hook("protocol_eviled", sub {
+ warn "$ARGS{-user} has warned you. Counterstrike initiated.";
+ hook("protocol_evil", -user => $ARGS{-user});
+
+ register_hook("msg_in_$ARGS{-user}", sub {
+ warn "Counterstrike completed";
+ hook("protocol_evil", -user => $ARGS{-user});
+ deregister_hook("msg_in_$ARGS{-user}");
+ });
+});
+
+1;
diff --git a/plugins/Monitor.pl b/plugins/Monitor.pl
index 7341adf..7444539 100644
--- a/plugins/Monitor.pl
+++ b/plugins/Monitor.pl
@@ -15,19 +15,20 @@ sub sendmail
$smtp->mail("$user\@milkbone.org");
$smtp->to('savannah@batkins.com');
+ $text =~ s/<.*?>//g;
+
$smtp->data();
$smtp->datasend("To: \n");
$smtp->datasend("From: Milkbone Monitor <$user\@milkbone.org>\n");
- $smtp->datasend("Subject: $sub \n");
+ $smtp->datasend("Subject: $user - $sub \n");
$smtp->datasend("\n");
- $smtp->datasend($text);
+ $smtp->datasend("$user - $text");
$smtp->dataend();
$smtp->quit;
}
register_hook("msg_in", sub {
- print "msg received";
return unless hook("protocol_away_status");
sendmail('Message Received', "Received the following message from $ARGS{-user}:\n\n$ARGS{-msg}", $ARGS{-user});
});
diff --git a/plugins/Net-OSCAR/Net-OSCAR.pl b/plugins/Net-OSCAR/Net-OSCAR.pl
index b0a9262..66908b2 100644
--- a/plugins/Net-OSCAR/Net-OSCAR.pl
+++ b/plugins/Net-OSCAR/Net-OSCAR.pl
@@ -37,6 +37,8 @@ register_hook("protocol_chat_part", sub { $chats{$ARGS{-chat}}->part; });
register_hook("protocol_chat_send", sub { $chats{$ARGS{-chat}}->chat_send($ARGS{-msg}, !($ARGS{-reflect} or 1)) });
register_hook("protocol_commit_blist", sub { $oscar->commit_buddylist; } );
register_hook("protocol_commit_info", \&commit_info);
+register_hook("protocol_evil", sub { $oscar->evil($ARGS{-user}); });
+register_hook("protocol_evil_status", sub { return $oscar->buddy($ARGS{-user})->{evil}; } );
register_hook("protocol_get_away", sub { $oscar->{away}; } );
register_hook("protocol_get_groups", sub { [ $oscar->groups ]; } );
register_hook("protocol_get_prof", sub { $oscar->{profile} } );
@@ -103,6 +105,11 @@ sub signon
$buddies{$_[1]} = 0;
} );
+ $oscar->set_callback_evil(
+ sub {
+ hook("protocol_eviled", -user => $_[2]) if defined($_[2]);
+ } );
+
$oscar->set_callback_im_in(
sub {
hook("msg_in", -user => $_[1], -msg => $_[2], -away => $_[3]) if $_[1];
diff --git a/plugins/Sound.pl b/plugins/Sound.pl
index a0dca21..64f9dfe 100644
--- a/plugins/Sound.pl
+++ b/plugins/Sound.pl
@@ -11,7 +11,7 @@ register_hook("msg_in", sub { play_sound("msg_in"); });
register_hook("protocol_send_im", sub { play_sound("send_im"); });
register_hook("buddy_in", sub { play_sound("buddy_in"); });
register_hook("buddy_out", sub { play_sound("buddy_out"); });
-register_hook("error", sub { play_sound("error"); });
+register_hook("error", sub { play_sound("error") if $ARGS{-fatal}; });
register_hook("protocol_signoff", sub { play_sound("signoff"); });
sub play_sound
diff --git a/plugins/Tk-BList/Milkbone/BList.pm b/plugins/Tk-BList/Milkbone/BList.pm
index 422f311..d9d9eb0 100644
--- a/plugins/Tk-BList/Milkbone/BList.pm
+++ b/plugins/Tk-BList/Milkbone/BList.pm
@@ -275,7 +275,7 @@ sub init
$self->configure(-menu => $self->{menu});
- $self->Label(-image => $logo)->pack(-side => 'top', -fill => 'both');
+ $self->Label(-image => $logo)->pack(-side => 'top', -fill => 'both') unless option("HideBListLogo");
$self->{tree} = $self->Scrolled("MBTree" =>
-scrollbars => 'oe',
diff --git a/plugins/Tk-Convo/Milkbone/Convo.pm b/plugins/Tk-Convo/Milkbone/Convo.pm
index ff5ebc0..963baac 100644
--- a/plugins/Tk-Convo/Milkbone/Convo.pm
+++ b/plugins/Tk-Convo/Milkbone/Convo.pm
@@ -32,7 +32,8 @@ sub on_send
my $self = shift;
my $msg = $self->{bottom}->to_html('0.0', 'end');
- $msg =~ s/\n*//g;
+ $msg =~ s/\n*$//;
+ $msg =~ s/\r\n?//g;
$msg =~ s/\n/
/g;
return if($msg eq "");
@@ -81,7 +82,8 @@ sub on_destroy
{
my ($self) = @_;
hook("remove_convo", -user => shift->{buddy});
- $self->{rep_id}->cancel;
+ $self->{rep_id}->cancel;
+ hook("protocol_set_typing_status", -user => $self->{buddy}, -status => 0);
}
sub on_prof
@@ -213,7 +215,7 @@ sub init
$self->{top}->tagConfigure('buddy_stamp', -foreground => 'blue', -elide => 1, -font => 'times 9 bold');
$self->{bottom}->bind("", [$self, "on_send"]);
- $self->{bottom}->bind("", [sub { $self->{bottom}->insert('insert', "\n")}, $self]);
+ $self->{bottom}->bind("", [sub { $self->{bottom}->insert('insert', "\r\n")}, $self]);
$self->{bottom}->bind("", [$self, "destroy"]);
$self->{bottom}->bind("", [$self, "on_key"]);
$self->bind("", [$self, "toggle_stamps"]);
diff --git a/plugins/Tk-Logon/Milkbone/Logon.pm b/plugins/Tk-Logon/Milkbone/Logon.pm
index 3b33e04..1dcd15f 100644
--- a/plugins/Tk-Logon/Milkbone/Logon.pm
+++ b/plugins/Tk-Logon/Milkbone/Logon.pm
@@ -13,7 +13,7 @@ Construct Tk::Widget 'MBLogon';
my $mw = hook("tk_getmain");
-my $slogan = "surely this convenience entices you. it's so easy to use, and the surgery to implant it in the base of your skull is so painless that it's no wonder i'm number one. (athf)";
+my $slogan = "when you run out of clever slogans,\n you get something like this";
sub ClassInit
{
@@ -134,6 +134,7 @@ sub init
$self->update;
$self->geometry("+" . int(($mw->screenwidth() / 2) - int($self->width() / 2)) . "+" . int(($mw->screenheight() / 2) - int($self->height() / 2)) ) unless $^O =~ /linux/i;
+ $self->packPropagate(1);
$self->deiconify;
$self->bind('' => [$self, 'on_logon']);
diff --git a/plugins/Tk-PluginsConf/Milkbone/PluginsConf.pm b/plugins/Tk-PluginsConf/Milkbone/PluginsConf.pm
index 86cf431..f45545c 100644
--- a/plugins/Tk-PluginsConf/Milkbone/PluginsConf.pm
+++ b/plugins/Tk-PluginsConf/Milkbone/PluginsConf.pm
@@ -49,7 +49,11 @@ sub on_reload
my ($self) = @_;
my $sel = $self->{list}->curselection;
- return unless $sel;
+ unless($sel)
+ {
+ warn "Choose an item from the list.";
+ return;
+ }
my $plugin = $self->{list}->get($sel);
@@ -87,6 +91,8 @@ sub init
$self->geometry("+" . int(($self->screenwidth() / 2) - int($self->width() / 2)) . "+" . int(($self->screenheight() / 2) - int($self->height() / 2)) );
$self->deiconify;
+ hook("tk_bindwheel", -window => $self->{list});
+
$self->update();
$self->focus;
}
diff --git a/plugins/Tk-Profile/Milkbone/Profile.pm b/plugins/Tk-Profile/Milkbone/Profile.pm
index f1bb70c..d3916b1 100644
--- a/plugins/Tk-Profile/Milkbone/Profile.pm
+++ b/plugins/Tk-Profile/Milkbone/Profile.pm
@@ -101,6 +101,9 @@ sub init
$self->Label(-text => "$who has been idle for $days days, $hrs hours, $mins minutes")->pack(-ipady => 1, -anchor => 'w');
}
+ my $warning_level = hook("protocol_evil_status", -user => $who);
+ $self->Label(-text => "Warning Level: $warning_level \%")->pack(-ipady => 1, -anchor => 'w');
+
$self->Label(-text => "Profile Text:", -font => 'arial 9 bold')->pack(-ipady => 1, -anchor => 'w');
$self->{text} = $self->Frame->pack(-expand => 1, -fill => 'both')->