After searching fruitlessly on the Perl mailing lists for a free alternative to PerlTray (from the ActiveState PDK) I have banged together my own Rube Goldberg-esque contraption which works!
I am doing it the wrong way: one thread (main) to mind the Tk GUI and another (asynchronous) which minds the SysTray icon. They send one another (window) messages in a very crude fashion which happens to be OK and somehow works cross-thread.
This may make a Win32 artist cry and that's what makes it sweet.
Also I am disrespectfully meddling with the innards of Win32::GUI::NotifyIcon. Life's good.
Enjoy the code! (You need to supply a valid Win32 ICON file named icon.ico.)
-ulianov#!perl.exe
use strict;
use threads;
use threads::shared;
use Tk;
use POSIX ();
use File::Basename qw[dirname];
use File::Spec::Functions qw[ catfile rel2abs updir ];
use Win32::API;
use Win32::SysTray;
Win32::API->Import("user32", 'ShowWindow', 'II', 'I');
use constant SW_HIDE => 0;
use constant SW_RESTORE => 9;
sub win_op($$)
{
my $top = shift || return;
my $op = shift;
ShowWindow(hex($top->frame), $op);
}
Win32::API->Import("user32", 'MessageBox', 'NPPI', 'I');
use constant MB_OK => 0;
use constant MB_ICONSTOP => 16;
sub errorMessageBox($$)
{
my $title = shift;
my $msg = shift;
MessageBox(0, $msg, $title, MB_OK|MB_ICONSTOP);
}
sub Die
{
errorMessageBox('Sample SysTray', join('' => @_));
POSIX::_exit(1); # NOTREACHED
}
my $Tray : shared;
sub tray_hide()
{
return unless defined $Tray;
my ($handle, $id) = split /:/ => $Tray;
Win32::GUI::NotifyIcon::_Delete($handle, -id => $id); # HACK!!!
}
sub tray_thread($)
{
my $top = shift || return;
my $tray = new Win32::SysTray (
name => 'Sample SysTray',
icon => rel2abs(dirname($0)).'\icon.ico',
single => 1,
) or Die 'Win32::SysTray failed!';
$tray->setMenu (
"> &Show" => sub { win_op($top, SW_RESTORE); },
">-" => 0,
"> E&xit" => sub {
$tray->{Tray}->Remove();
POSIX::_exit(0); # CORE::exit makes Tk barf
},
);
my $t = $tray->{Tray};
$Tray = $t->{-handle}.':'.$t->{-id};
$tray->runApplication;
}
sub main()
{
my $mainw = MainWindow->new(-title=>'Sample SysTray');
async { tray_thread($mainw); }
$mainw->OnDestroy(sub {
tray_hide(); # else we have zombie Systray icon
POSIX::_exit(0); # should kill background threads
});
my $fr = $mainw->Frame->pack(-side => 'bottom', -fill => 'x');
$fr->Button(-text => "Exit",
-command => sub { exit(0); }
)->pack(-side => 'right');
$mainw->bind('<Unmap>', sub { win_op($mainw, SW_HIDE); } );
MainLoop();
}
main();
