#!/usr/local/bin/perl

# $Id: belt,v 1.21 2002/08/13 11:39:42 max Exp $

# Copyright (c) 1999, 2000, 2001, 2002
#      Max Zomborszki. All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.

use Pod::Text;
use Tk;
use Tk::Balloon;
use Getopt::Long;

$| = 1;

# ==========================================================================
#  Installation
# ==========================================================================

# $iconloc is the location where belts own icons are
# installed. $iconpath is the path to search for icons. These two are
# used to construct a @iconsearchpath which is used to find all icons
# (yes, that means that you do not really have to place belts own
# icons in $iconloc but can place them anywhere in $iconpath, but no,
# don't do it!) $iconloc is really only still here for compatibility
# reasons. You might (and should) just as well only use --iconpath

my $iconloc = '/usr/local/belt/icons/';
my $iconpath = '/misc/graphics/icons/reduced/48x48/';

# ==========================================================================
#  Variables
# ==========================================================================

my $main = MainWindow->new();
my $Xname = $main->Class;
my $verbose = 0;
my @STARTARGS = @ARGV;
my $debug = 0;

my $apid;
my $auid;

# ==========================================================================
#  Options
# ==========================================================================

# Priority of options within parenthesis. Higher number = higher priority.

# (1) DEFAULTS values (Priority: widgetDefault/20)

$main->optionAdd("$Xname*autopost"              => "false",
		 "widgetDefault");
$main->optionAdd("$Xname*autopostdelay"         => "300",
		 "widgetDefault");
$main->optionAdd("$Xname*autounpost"            => "false",
		 "widgetDefault");
$main->optionAdd("$Xname*autounpostdelay"       => "1500",
		 "widgetDefault");
$main->optionAdd("$Xname*overrideredirect"      => "true",
		 "widgetDefault");
$main->optionAdd("$Xname*unpost"                => "false",
		 "widgetDefault");
$main->optionAdd("$Xname*bhactive"              => "true",
		 "widgetDefault");
$main->optionAdd("$Xname*bhdelay"               => 1500,
		 "widgetDefault");
$main->optionAdd("$Xname*bhmaindelay"           => 5000,
		 "widgetDefault");
$main->optionAdd("$Xname*bhbackground"          => "yellow",
		 "widgetDefault");
$main->optionAdd("$Xname*bhfont"                => "fixed",
		 "widgetDefault");
$main->optionAdd("$Xname*maxicons"               => 8,
		 "widgetDefault");
$main->optionAdd("$Xname*dynamic"                => "true",
		 "widgetDefault");
$main->optionAdd("$Xname*ontop"                  => "true",
		 "widgetDefault");
$main->optionAdd("$Xname*placement"              => "+0-0",
		 "widgetDefault");
$main->optionAdd("$Xname*direction"              => "right",
		 "widgetDefault");
$main->optionAdd("$Xname*icondirectory"          => $iconloc,
		 "widgetDefault");
$main->optionAdd("$Xname*iconpath"               => $iconpath,
		 "widgetDefault");
$main->optionAdd("$Xname*iconsize"               => 48,
		 "widgetDefault");
$main->optionAdd("$Xname*configdirectory"        => "~/.beltconf/",
		 "widgetDefault");
$main->optionAdd("$Xname*menufile"               => "menu.conf",
		 "widgetDefault");
$main->optionAdd("$Xname*configfile"             => "resources",
		 "widgetDefault");

# (2) XDEFAULTS (Priority: userDefault/60)
#     Read by the system.

# (4) Command-line-options (Priority: interactive/80)
GetOptions(
           "extracticons" => \&extracticons,
           "version" => sub { print ' Belt $Revision: 1.21 $ ' . "\n"; exit; },
	   "help" => \&help,
	   "verbose!" => \$verbose,
	   "placement=s" => \&setoption,
	   "overrideredirect=s" => \&setoption,
	   "autopost=s" => \&setoption,
	   "autopostdelay=i" => \&setoption,
	   "autounpost=s" => \&setoption,
	   "autounpostdelay=i" => \&setoption,
	   "unpost=s" => \&setoption,
	   "bhactive=s" => \&setoption,
	   "bhdelay=i" => \&setoption,
	   "bhmaindelay=i" => \&setoption,
	   "bhbackground=s" => \&setoption,
	   "bhfont=s" => \&setoption,
	   "maxicons=i" => \&setoption,
	   "dynamic=s" => \&setoption,
	   "ontop=s" => \&setoption,
	   "direction=s" => \&setoption,
	   "icondirectory=s" => \&setoption,
	   "iconpath=s" => \&setoption,
	   "iconsize=i" => \&setoption,
	   "configdirectory=s" => \&setoption,
	   "configfile=s" => \&setoption,
	   "menufile=s" => \&setoption,
	   "debug" => \$debug,
           );

# (3) ~/.beltconf/resources  (Priority: 70)
#     Yes, this is point three but done after point four. Still it 
#     is the priority that decides if a commandline option overrides
#     this or not.
my $tmpdir = $main->optionGet("configdirectory", "$Xname");
my $tmpfile = $main->optionGet("configfile", "$Xname");
$tmpdir = &correctpath($tmpdir);
if (-f $tmpdir . $tmpfile) {
    $main->optionReadfile($tmpdir . $tmpfile, 70);
}

# ==========================================================================
#  Options Finalizing
# ==========================================================================

my $orrd = ($main->optionGet("overrideredirect", "$Xname") =~ /^true$/i) ? 1 : 0;
my $unpost = ($main->optionGet("unpost", "$Xname") =~ /^true$/i) ? 1 : 0;
my $bhactive = ($main->optionGet("bhactive", "$Xname") =~ /^true$/i) ? 1 : 0;
my $autopost = ($main->optionGet("autopost", "$Xname") =~ /^true$/i) ? 1 : 0;
my $autopostdelay = $main->optionGet("autopostdelay", "$Xname");
my $autounpost = ($main->optionGet("autounpost", "$Xname") =~ /^true$/i) ? 1 : 0;
my $autounpostdelay = $main->optionGet("autounpostdelay", "$Xname");
my $bhdelay = $main->optionGet("bhdelay", "$Xname");
my $bhmaindelay = $main->optionGet("bhmaindelay", "$Xname");
my $bhbg = $main->optionGet("bhbackground", "$Xname");
my $bhfont = $main->optionGet("bhfont", "$Xname");
my $maxicons = $main->optionGet("maxicons", "$Xname");
my $dynamic = ($main->optionGet("dynamic", "$Xname") =~ /^true$/i) ? 1 : 0;
my $ontop = ($main->optionGet("ontop", "$Xname") =~ /^true$/i) ? 1 : 0;
my $placement = $main->optionGet("placement", "$Xname");
my $direction = $main->optionGet("direction", "$Xname");
my $icondir = $main->optionGet("icondirectory", "$Xname");
my $iconpath = $main->optionGet("iconpath", "$Xname");
my $size = $main->optionGet("iconsize", "$Xname");
my $confdir = $main->optionGet("configdirectory", "$Xname");
my $conffile = $main->optionGet("configfile", "$Xname");
my $menufile = $main->optionGet("menufile", "$Xname");
$confdir = &correctpath($confdir);

# Construct iconsearchpath from icondir and iconpath
my @iconsearchpath = &splitandfixpath("$icondir:$iconpath");

die "autopostdelay cannot be less than zero\n" if ($autopostdelay < 0);
die "autounpostdelay cannot be less than zero\n" if ($autounpostdelay < 0);
die "bhdelay cannot be less than one\n" if ($bhdelay < 1);
die "bhmaindelay cannot be less than one\n" if ($bhmaindelay < 1);
die "maxicons cannot be less than one\n" if ($maxicons < 1);
die "placement can only be a placement specification\n" 
    if ($placement !~ /^[\-\+][0-9]+[\-\+][0-9]+$/);
die "size cannot be less than one\n" if ($size < 1);

if ($verbose or $debug) {
    print "-------------------------------------------------\n";
    print "autopost              $autopost\n";
    print "autopostdelay         $autopostdelay\n";
    print "autounpost            $autounpost\n";
    print "autounpostdelay       $autounpostdelay\n";
    print "Application Name      $Xname\n";
    print "overrideredirect      $orrd\n";
    print "unpost                $unpost\n";
    print "bhactive              $bhactive\n";
    print "bhdelay               $bhdelay\n";
    print "bhmaindelay           $bhmaindelay\n";
    print "bhbg                  $bhbg\n";
    print "bhfont                $bhfont\n";
    print "maxicons              $maxicons\n";
    print "dynamic               $dynamic\n";
    print "ontop                 $ontop\n";
    print "placement             $placement\n";
    print "direction             $direction\n";
    print "size                  $size\n";
    print "confdir               $confdir\n";
    print "menufile              $menufile\n";
    print "icondir               $icondir\n";
    print "iconpath              $iconpath\n";
    print "iconsearchpath        (searched in order)\n";
    foreach my $e (@iconsearchpath) {
	print "                      $e\n";
    }
    print "-------------------------------------------------\n";
}

# ==========================================================================
#  Variables
# ==========================================================================

my (%imgs, $open, $close, $scrfwd, $scrbck, $pckdir, $first, $last);

# ==========================================================================
#  Setting up the GUI
# ==========================================================================

$main->geometry($placement);
$main->overrideredirect($orrd);
$main->appname("Belt");

my $bh = $main->Balloon(-initwait => $bhdelay,
			-state => "balloon",
			-balloonposition => "mouse",
			-background => $bhbg,
			-font => $bhfont,
			);

foreach (qw/DH DS LH LS RH RS UH US noicon/) {
    my $file = &findicon($_ . '.gif');
    die "Couldn't find $_.gif " if (! -f $file);
    $imgs{$_} = $main->Photo(-file => $file);
}

if ($direction eq 'left') {
    $close = $imgs{'RS'};
    $open = $imgs{'LS'};
    $scrfwd = $imgs{'LH'};
    $scrbck = $imgs{'RH'};
    $pckdir = 'right';
} elsif ($direction eq 'up') {
    $close = $imgs{'DS'};
    $open = $imgs{'US'};
    $scrfwd = $imgs{'UH'};
    $scrbck = $imgs{'DH'};
    $pckdir = 'bottom';
} elsif ($direction eq 'down') {
    $close = $imgs{'US'};
    $open = $imgs{'DS'};
    $scrfwd = $imgs{'DH'};
    $scrbck = $imgs{'UH'};
    $pckdir = 'top';
} else {
    $close = $imgs{'LS'};
    $open = $imgs{'RS'};
    $scrfwd = $imgs{'RH'};
    $scrbck = $imgs{'LH'};
    $pckdir = 'left';
}

my $b = $main->Button(-image => $open,
		      -command => \&post,
		      )->pack(-side => $pckdir);
$bh->attach($b,
	    -initwait => $bhmaindelay,
	    -balloonmsg => "Ctrl-Right-DoubleClick to exit\nCtrl-Middle-DoubleClick to restart");

$b->bind("<Control-Double-Button-3>", sub{ &destroyimages(); destroy $main; });
$b->bind("<Control-Double-Button-2>", sub{ &destroyimages(); destroy $main; exec $0, @STARTARGS; });
$main->bind("<Enter>", sub{ $main->raise(); }) if ($ontop);

if ($autopost) {
    $b->bind("<Enter>", sub { &postafter() });
    $b->bind("<Leave>", sub { &postcancel(); &unpostcancel() });
}

if ($autounpost) {
    $main->bind("<Leave>", sub { &unpostafter() });
    $main->bind("<Enter>", sub { &unpostcancel() });
}

my $frm = $main->Frame(-relief => 'flat',
		       -borderwidth => '0',
		       );
my $bck = $frm->Button(-image => $scrbck,
		       -command => \&scrollbackward,
		       );
my $f = $frm->Frame(-relief => 'flat',
		    -borderwidth => '0',
		    );
my $fwd = $frm->Button(-image => $scrfwd,
		       -command => \&scrollforward,
		       );
my $cl =  $frm->Button(-image => $close,
		       -command => \&unpost,
		       );
my @list;


if (-f $confdir . $menufile) {
    if (open (MENUCONF, $confdir . $menufile )) {
	while (<MENUCONF>) {
	    chomp;
	    next if (/^\#/);
	    my ($text, $icon, $program) =
		(split /\|/, $_,7)[2,5,6];
	    if ($program ne "" ) {
		my $im;
		# Fix the path of the icon if necessary.
		$icon = &findicon($icon);
		if (-f $icon) {
		    $im = $main->Photo(-file => $icon,
				       -height => $size,
				       -width => $size,
				       );
		    $imgs{$im} = $im;
		} else {
		    $im = $imgs{'noicon'};
		}

		my $c = $f->Button(-command => 
				   sub{ &unpost() if ($unpost);
					system($program . ' &'); },
				   -relief => 'groove',
				   -image => $im,
				   );
		$c->bind("<Button-3>", sub{ &unpost(); system($program . ' &'); });
		$bh->attach($c, -balloonmsg => $text) if ($bhactive);

		push @list, $c;
	    }
	}
	close (MENUCONF);
    }
}

if ($dynamic && $ENV{"WMMENUPATH"}) {
    my @menupath = split /\:/, $ENV{"WMMENUPATH"};
    my $confpath;
    foreach $confpath (@menupath) {
        if (open (MENUCONF, $confpath . "/menu.conf")) {
	    while (<MENUCONF>) {
                chomp;
		next if (/^\#/);
		my ($text, $icon, $program) =
		    (split /\|/, $_,7)[2,5,6];

                if ($program ne "" ) {
		    my $im;
		    # Fix the path of the icon if necessary.
		    $icon = &findicon($icon);
		    if (-f $icon) {
			$im = $main->Photo(-file => $icon,
					   -height => $size,
					   -width => $size,
					   );
			$imgs{$im} = $im;
		    } else {
			$im = $imgs{'noicon'};
		    }

		    my $c = $f->Button(-command => 
				       sub{ &unpost() if ($unpost);
					    system($program . ' &'); },
				       -relief => 'groove',
				       -image => $im,
				       );
		    $bh->attach($c, -balloonmsg => $text) if ($bhactive);

		    push @list, $c;
                }
            }
            close (MENUCONF);
        }
    }
}

$bck->pack(-side => $pckdir,
	   ) if ((scalar @list) > $maxicons);
$f->pack(-side => $pckdir,
	 -fill => 'both');
$fwd->pack(-side => $pckdir,
	   ) if ((scalar @list) > $maxicons);
$cl->pack(-side => $pckdir,
	  );

if ((scalar @list) > $maxicons) {
    my $i;
    $first = 0;
    $last = $maxicons - 1;
    for ($i = 0; $i < $maxicons; $i++) {
	$list[$i]->pack(-side => $pckdir);
    }
} else {
    my $button;
    foreach $button (@list) {
	$button->pack(-side => $pckdir);
    }
}

MainLoop;

# ==========================================================================
#  Subroutines
# ==========================================================================

sub destroyimages {
    foreach (keys %imgs) {
	$imgs{$_}->destroy();
    }
}

sub unpost {
    &unpostcancel();
    $frm->packForget();
    $b->configure(-command => \&post);
    $b->configure(-image => $open);
}

sub post {
    &postcancel();
    $frm->pack(-side => $pckdir);
    $b->configure(-command => \&unpost);
    $b->configure(-image => $close);
}

sub postafter {
    return if defined $apid;
    $apid = $b->after($autopostdelay, sub{ &post() });
    print "After POST: $apid\n" if ($debug);
}

sub unpostafter {
    return if defined $auid;
    $auid = $main->after($autounpostdelay, sub{ &unpost });
    print "After UNPOST: $auid\n" if ($debug);
}

sub postcancel {
    return unless defined $apid;
    $b->afterCancel($apid);
    print "Cancelled POST: $apid\n" if ($debug);
    $apid = undef;
}

sub unpostcancel {
    return unless defined $auid;
    $main->afterCancel($auid);
    print "Cancelled UNPOST: $auid\n" if ($debug);
    $auid = undef;
}

sub scrollforward {
    if ($last < $#list) {
	$list[$first]->packForget();
	$first++;
	$last++;
	$list[$last]->pack(-side => $pckdir);
    }
}

sub scrollbackward {
    if ($first > 0) {
	$list[$last]->packForget();
	$last--;
	$first--;
	$list[$first]->pack(-side => $pckdir,
			    -before => $list[$first+1]);
    }
}

sub expandtilde {
    my $path = shift;

    # Expand tilde for this user.
    $path =~ s/^~\//$ENV{'HOME'}\//;
    
    # Expand tilde for other users
    if($path =~ /^~([^\/]*)/) {
	my $user = $1;
	my $realpath = (getpwnam($user))[7];
	if (defined $realpath) {
	    $path =~ s/^~([^\/]*)/$realpath/;
	} else {
	    die "No such user '" . $user . "' when expanding '" . $path . "'\n";
	}
    }

    return $path;
}

sub correctpath {
    my $dir = shift @_;

    $dir = &expandtilde($dir);

    # Add a trailing slash
    $dir =~ s/([^\/])$/$1\//;
    
    return $dir;
}

sub splitandfixpath {
    my $p = shift;
    my @rp = ();

    foreach my $e (split ":", $p) {
	next if $e =~ /^\s*$/;
	$e = &correctpath($e);
	push @rp, $e unless grep {$_ eq $e} @rp;
    }

    return @rp;
}

sub findicon {
    my $i = shift || return undef;

    # Leading slash indicates absolute path, nothing to do.
    if ($i =~ m/^\//) {
	print STDERR "FINDICON: Absolute path for $i. Aborting.\n" if ($debug);
	return $i;
    }

    # Leading tilde indicates that we should expand it.
    if ($i =~ m/^~/) {
	print STDERR "FINDICON: Leading tilde for $i. Expanding.\n" if ($debug);
	return &expandtilde($i);
    }

    foreach my $p (@iconsearchpath) {
	my $correctpath = $p . $i;
	print STDERR "FINDICON: Searching for $correctpath.\n" if ($debug);
	if (-f $correctpath) {
	    print "FINDICON: Found $correctpath.\n\n" if ($debug);
	    return $correctpath;
	}
    }

    print STDERR "FINDICON: Didn't find anything for $i.\n\n" if ($debug);
    return undef;
}

sub setoption {
    my ($name, $val) = @_;
    print STDERR "SETOPTION: Setting $Xname*$name to $val\n" if ($debug);
    $main->optionAdd($Xname . '*' . $name => $val, 'interactive');
}

sub extracticons {
    my $s;
    my %h;
    
    $s  = "\x47\x49\x46\x38\x39\x61\x30\x00\x10\x00\x80\x00\x00\x00\x00\x00";
    $s .= "\xc0\xc0\xc0\x21\xf9\x04\x01\x00\x00\x01\x00\x2c\x00\x00\x00\x00";
    $s .= "\x30\x00\x10\x00\x00\x02\x29\x8c\x8f\xa9\xcb\xed\x0f\xa3\x9c\xb4";
    $s .= "\xda\x7b\x81\xde\xbc\x63\xa9\x35\xe1\x07\x02\xcb\x48\x96\x09\x9a";
    $s .= "\xaa\x06\xdb\xaa\x70\x5c\x9a\x74\x76\xe7\xfa\xce\xf7\x7e\x52\x00";
    $s .= "\x00\x3b";
    $h{'DH.gif'} = $s;
    $s  = "\x47\x49\x46\x38\x39\x61\x30\x00\x10\x00\x80\x00\x00\x00\x00\x00";
    $s .= "\xc0\xc0\xc0\x21\xf9\x04\x01\x00\x00\x01\x00\x2c\x00\x00\x00\x00";
    $s .= "\x30\x00\x10\x00\x00\x02\x27\x8c\x8f\xa9\xcb\xed\x0f\xa3\x9c\xb4";
    $s .= "\xda\x7b\x81\xde\xbc\x63\xd9\x85\xda\x37\x89\x1c\x49\x99\x00\x5a";
    $s .= "\x89\xac\xe5\xbd\xf0\x28\x67\xf5\x8d\xe7\xfa\xce\x27\x05\x00\x3b";
    $h{'DS.gif'} = $s;
    $s  = "\x47\x49\x46\x38\x39\x61\x10\x00\x30\x00\x80\x00\x00\x00\x00\x00";
    $s .= "\xc0\xc0\xc0\x21\xf9\x04\x01\x00\x00\x01\x00\x2c\x00\x00\x00\x00";
    $s .= "\x10\x00\x30\x00\x00\x02\x35\x8c\x8f\xa9\xcb\xed\x0f\xa3\x9c\xb4";
    $s .= "\xda\x8b\xb3\x96\x80\x77\x08\x84\x60\xf7\x35\x62\x50\x2e\x27\x6a";
    $s .= "\xa6\x29\xb2\x1a\x2f\xec\x3a\xeb\x9c\x9c\x78\x4e\x46\xe1\xae\x88";
    $s .= "\x3d\x80\x9b\xa2\xf1\x88\x4c\x2a\x97\xcc\x62\x01\x00\x3b";
    $h{'LH.gif'} = $s;
    $s  = "\x47\x49\x46\x38\x39\x61\x10\x00\x30\x00\x80\x00\x00\x00\x00\x00";
    $s .= "\xc0\xc0\xc0\x21\xf9\x04\x01\x00\x00\x01\x00\x2c\x00\x00\x00\x00";
    $s .= "\x10\x00\x30\x00\x00\x02\x30\x8c\x8f\xa9\xcb\xed\x0f\xa3\x9c\xb4";
    $s .= "\xda\x8b\xb3\x96\x80\x77\x08\x84\x60\xf8\x35\xa4\x68\x9e\xa5\xa2";
    $s .= "\xa2\x6c\xbb\x26\xb0\xd3\x3e\xea\xe8\xd2\xb9\x3e\xc5\xdb\x0f\x0c";
    $s .= "\x0a\x87\xc4\xa2\x71\x58\x00\x00\x3b";
    $h{'LS.gif'} = $s;
    $s  = "\x47\x49\x46\x38\x39\x61\x10\x00\x30\x00\x80\x00\x00\x00\x00\x00";
    $s .= "\xc0\xc0\xc0\x21\xf9\x04\x01\x00\x00\x01\x00\x2c\x00\x00\x00\x00";
    $s .= "\x10\x00\x30\x00\x00\x02\x36\x8c\x8f\xa9\xcb\xed\x0f\xa3\x9c\xb4";
    $s .= "\xda\x8b\xb3\x5e\x60\x82\x1e\x7d\xe0\xd3\x7d\x10\x68\x3a\x63\xca";
    $s .= "\x8c\x01\xab\xb8\xaf\x7c\xb8\x70\xb2\xd2\x08\xaa\xef\xf3\x79\x6b";
    $s .= "\xf5\x62\x9b\xa2\xf1\x88\x4c\x2a\x97\xcc\x26\xa3\x00\x00\x3b";
    $h{'RH.gif'} = $s;
    $s  = "\x47\x49\x46\x38\x39\x61\x10\x00\x30\x00\x80\x00\x00\x00\x00\x00";
    $s .= "\xc0\xc0\xc0\x21\xf9\x04\x01\x00\x00\x01\x00\x2c\x00\x00\x00\x00";
    $s .= "\x10\x00\x30\x00\x00\x02\x31\x8c\x8f\xa9\xcb\xed\x0f\xa3\x9c\xb4";
    $s .= "\xda\x8b\xb3\x5e\x60\x82\x1e\x7d\xe0\x23\x8e\x4d\x69\x72\xa8\x83";
    $s .= "\x7e\x67\x9b\x1e\xf0\x5b\xb2\xb5\xed\x92\xb9\x2e\xc5\xdb\x0f\x0c";
    $s .= "\x0a\x87\xc4\xa2\xf1\x68\x28\x00\x00\x3b";
    $h{'RS.gif'} = $s;
    $s  = "\x47\x49\x46\x38\x39\x61\x30\x00\x10\x00\x80\x00\x00\x00\x00\x00";
    $s .= "\xc0\xc0\xc0\x21\xf9\x04\x01\x00\x00\x01\x00\x2c\x00\x00\x00\x00";
    $s .= "\x30\x00\x10\x00\x00\x02\x2d\x8c\x8f\xa9\xcb\xed\x0f\xa3\x9c\xb4";
    $s .= "\xda\x8b\x15\xc8\xfc\x80\xdf\x65\x20\x18\x56\x64\x70\x96\x50\x8a";
    $s .= "\x6e\xea\xc3\x1a\xf1\xeb\xb9\xcb\xfc\x7e\xfa\xce\xdb\xf4\x0f\x0c";
    $s .= "\x0a\x87\x9c\x02\x00\x3b";
    $h{'UH.gif'} = $s;
    $s  = "\x47\x49\x46\x38\x39\x61\x30\x00\x10\x00\x80\x00\x00\x00\x00\x00";
    $s .= "\xc0\xc0\xc0\x21\xf9\x04\x01\x00\x00\x01\x00\x2c\x00\x00\x00\x00";
    $s .= "\x30\x00\x10\x00\x00\x02\x28\x8c\x8f\xa9\xcb\xed\x0f\xa3\x9c\xb4";
    $s .= "\xda\x8b\x15\xc8\xfc\x80\xdf\x65\xdf\x18\x5a\xe3\x59\x4e\xe7\x9a";
    $s .= "\x42\xeb\xdb\x36\xef\x1c\x6b\x33\x5d\xe7\xfa\xce\xf7\x56\x01\x00";
    $s .= "\x3b";
    $h{'US.gif'} = $s;
    $s  = "\x47\x49\x46\x38\x39\x61\x30\x00\x30\x00\x80\xff\x00\x00\x00\x00";
    $s .= "\xc0\xc0\xc0\x21\xf9\x04\x01\x00\x00\x01\x00\x2c\x00\x00\x00\x00";
    $s .= "\x30\x00\x30\x00\x00\x02\x9c\x8c\x8f\xa9\xcb\xed\x0f\xa3\x74\xa0";
    $s .= "\x5a\x3b\xb3\xba\xfc\xea\xdc\x85\xde\xf7\x88\x66\x45\x36\xe7\x9a";
    $s .= "\x6e\x26\xf2\xb6\x87\xc8\x84\xb2\x41\xd7\xb6\x9c\xeb\xdc\xbd\x53";
    $s .= "\x75\x6e\x33\x0c\x65\x48\x04\x21\x93\x91\x20\xb3\xe4\x7c\x2e\x62";
    $s .= "\x52\x5f\xb4\x5a\xec\x61\x61\xda\x6d\x76\xe9\xfd\xfe\xc2\x89\x2e";
    $s .= "\xd9\x7c\x06\x93\xc5\xa8\x75\x59\xed\xbe\xba\xe7\xf4\x94\x3c\x3d";
    $s .= "\xae\xdf\xc3\x7b\x6f\x7f\xfb\x87\x15\x58\x47\x58\xa8\x37\x83\xd3";
    $s .= "\x56\x96\x08\x90\x85\x83\x08\xf5\xd8\xf8\xb8\x38\x19\xd0\x68\x89";
    $s .= "\x39\x69\xa9\x72\xe9\x99\xb9\xe1\x09\x83\x88\x29\x4a\x91\x68\xca";
    $s .= "\x29\x49\xca\x7a\xa9\x3a\x05\x69\xb4\xe8\x9a\xd9\x06\x6a\x88\x9b";
    $s .= "\xdb\x52\x00\x00\x3b";
    $h{'noicon.gif'} = $s;
 
    foreach (keys %h) {
	print "Extracting " . $_ . "... ";
	open (F, '>' . $_) or die "Cannot write to " . $_ . "\n";
	binmode F;
	print F $h{$_};
	close F;
	print "done\n";
    }
    print "All icons have been extracted. They should now be moved to the\n";
    print "correct directory, probably " . $iconloc . ".\n";
   
    exit;
}

# ==========================================================================
#  Help
# ==========================================================================

sub help {
    pod2text($0);
	
    exit;
}

__END__

=head1 NAME

belt - Configurable buttonmenu for X

=head1 SYNOPSIS

belt [ options ]

=head1 DESCRIPTION

Belt is a configurable "belt" that pops out a row of buttons for easy
access to programs. It is inspired by the Macintosh version.

=head1 USAGE

The belt is retracted as default. By clicking on the belt button the
belt pops out revealing buttons. The user can then click on the
buttons on the belt to start the desired programs. Depending upon how
it is configured the belt may hide back after starting the program
using a left-click. Right-clicking always retracts the belt after
starting the program.

=head1 OPTIONS

You don not have to type out the entire name of the option, as long as
it is unique. A boolean value is either the string I<true> or
I<false>.

=over

=item --overrideredirect boolean

Should the overrideredirect directive be used for the main window.

=item --unpost boolean

Should the belt retract when a program is started from the buttons.

=item --autopost boolean

Should the belt extract the when mouse cursor is over the extract
button. The time the mouse cursor has to be over the button is
specified by the --autopostdelay option.

=item --autopostdelay integer

Specifies the delay from the mouse cursor enter the button area to the
belt is extracted. If the cursor leaves the button within this time
the belt is not extracted.

=item --autounpost boolean

Should the belt retract the when mouse cursor leaves the belt. The
time the mouse cursor has to be out of the belt area is specified by
the --autounpostdelay option.

=item --autounpostdelay integer

Specifies the delay from the mouse cursor leaves the button area to
the belt is retracted. If the cursor enters the area again within this
time the belt is not retracted.

=item --bhactive boolean

Sets whether the balloonhelp is active or not. The balloonhelp
shows the associated name for each button if active.

=item --bhdelay milliseconds

Sets the time in milliseconds before a balloonhelp popup is
displayed for a button.

=item --bhmaindelay milliseconds

Sets the time in milliseconds before a balloonhelp popup is
displayed for the mainbutton.

=item --bhbackground color

Sets the background color for the balloonhelp popups.

=item --bhfont fontname

Sets the font for the balloonhelp popups.

=item --maxicons integer

Sets the maximum number of icons allowed on the belt. If the number
of icons exceed this amount, arrows will appear to allow scrolling.

=item --dynamic boolean

Sets whether the program is affected by the WMMENUPATH environment
variable when searching for program definitions.

=item --ontop boolean

Sets whether the belt should be on top, ie. if it should be raised as
soon as it gets focus.

=item --placement placement

The placement of the belt. Should be one of the corners and not a
size specification, just a placement specification (ie. +0-0).

=item --direction string

Which direction should the belt extend. The string can be I<right>,
I<left>, I<up> or I<down>. The belt does not extend outside the 
screen which can lead to unintuitive packing order for the buttons if
placement and directions does not match.

=item --icondirectory directory

The directory where the icons used by belt is located. This is I<not>
neccessarily the locations of the programicons. They can be located
here but also in one of the directories specified by the --iconpath
switch or by setting an absolute path in the F<menu.conf> file. The
directory specified in by this switch is searched before any
directories in the --iconpath path.

=item --iconpath path

A path to search for the icons used by belt.

=item --iconsize size

The size of the icons. All icons (except for the arrows) are expected
to be square. This is a limit of the largest icon. The icons can be
of different sizes, but the same size is preferred. Icons larger than
iconsize will be cropped.

=item --configdirectory directory

The location of the userconfiguration files. The directory name should
have a trailing slash. The directory name is subject to a primitive
form of tilde expansion.

=item --configfile filename

The filename of the configurationfile you wish to use if you do not 
want to use the default one.

=item --menufile filename

The filename of the local menu configuration file to be used. This
can be used if you want multiple instances of belt. Filename should
be relative to the directory specified by configdirectory.

=item --extracticons

Extracts the special (arrow)icons to the current directory. They
should be moved to the directory where the special icons are to be
stored.

=item --verbose

Show the configuration and add errormessages.

=item --help

Show this help.

=back

=head1 X RESOURCES

These are the X resources that affect the appearance of belt and the
default values.

=over

=item 

Belt*autopost:         false

=item 

Belt*autopostdelay:    300

=item 

Belt*autounpost:       false

=item 

Belt*autounpostdelay:  1500

=item 

Belt*unpost:           false

=item 

Belt*bhactive:         true

=item 

Belt*bhdelay:          1500

=item 

Belt*bhmaindelay:      5000

=item 

Belt*bhbackground:     yellow

=item 

Belt*bhfont:           fixed

=item 

Belt*maxicons:         8

=item 

Belt*dynamic:          true

=item 

Belt*ontop:            true

=item 

Belt*placement:        +0-0

=item 

Belt*direction:        right

=item 

Belt*icondirectory:    /usr/local/belt/icons/

=item 

Belt*iconpath:         /misc/graphics/icons/reduced/48x48

=item 

Belt*iconsize:         48

=item 

Belt*configdirectory:  ~/.beltconf/

=item 

Belt*configfile:       F<resources>

=item 

Belt*menufile:         F<menu.conf>

=back

They correspond directly to a command line option.


=head1 THE CONFIG FILES

There are primarily two types of files. Program settings is generally
xresources and thus can lie in F<.Xdefaults>/F<.Xresources> or in the
resources file in the users configuration directory.

Button definitions follow the dynamic-menu style as in use at the
Unix system at E.KTH.SE. The files should be called F<menu.conf> and
reside in a directory found in the WMMENUPATH or in the users configuration 
directory for local settings. The name of the local button 
definitions file can be overridden by the menufile directive.

The format of the F<menu.conf>-file is:

  module|cat|text|miniicon|applicationclass|icon|executable

Where I<module> is the name of the module, I<cat> is one of the predefined
the category, I<text> is the label in the final menu, I<miniicon> is a 
small icon for use in the window decoration, I<applicationclass> is the 
X Window System class for the application, I<icon> is the path and icon 
associated with the application and I<executable> is the path, file and 
switches needed to run the program. Only I<text>, I<icon> and 
I<executable> is used by belt. For example the line:

  ||XtermWide|||/usr/local/graphics/xterm.xpm|/bin/X11/xterm -132

is sufficient for use with belt. One should however specify all fields
if applicable.

Icons can either be specified with a full path or a relative path. If
the path is relative first the icons is searched for in the
icondirectory and then in the directories specified by iconpath.

If the first character on the line is a # the line is considered to be
a comment.

=head1 CONFIGURATION

The programs default settings has the lowest priority. The default settings
can be overridden by xresources in the X resource database (ie F<.Xdefaults> or
F<.Xresources>). These can in turn be overridden by resources specified in the
sers configuration file, usually F<~/.beltconf/resources>.
Command line options always override any previous settings.

=head1 MULTIPLE INSTANCES

It is possible to start several instances of belt. You should probably 
have different placement specifiers and/or direction specifiers. Also
it might be a good idea to have different menufiles for the different 
instances as well as using the dynamic directive to turn off dynamic
buttons from all instances but one.

=head1 SMALLER/LARGER ICONS

By default the icons should be 48x48, as indicated by iconsize. The 
only exception are the special arrowicons F<[UDRL][SH].gif> which are
just one third as wide (default is 48x16). You can create your own
icons and use them instead. The problem is that when you use the 
dynamic menu you cannot change icons for those entries. You can only
change icons for icons for the local button definitions. Suppose 
that you have some icons that are 24x24 and the local button definition
file is called F<smallmenu.conf> and resides in your configuration directory.
Also you have made some small versions of the special icons with size
24x8 for the arrows and 24x24 for F<noicon.gif>. Then you can start belt
with the command:

  belt --iconsize=24 --menufile=smallmenu.conf 
       --iconpath=/home/staff/max/belt/SmallIcons/:/misc/icons/small

=head1 EXITING

To quit the application you can double-click on the button which posts the 
button bar using the right mouse button while holding down the Control key.
Yes, it is a bit awkward but that combo you should not press by mistake.

=head1 RESTARTING

If you have edited the configuration files and wish to restart belt 
double-click on the button which posts the button bar using the middle
button while holding down the Control key. This effectively destroys 
the old button bar and exec a new one with the same arguments as the
original one was started with.

=head1 FILES

=over

=item F<DS.gif>

Solid arrow pointing down (48x16).

=item F<US.gif>       

Solid arrow pointing up (48x16).

=item F<RS.gif>       

Solid arrow pointing right (16x48).

=item F<LS.gif>       

Solid arrow pointing left (16x48).

=item F<DH.gif>       

Hollow arrow pointing down (48x16).   

=item F<UH.gif>       

Hollow arrow pointing up (48x16).

=item F<RH.gif>       

Hollow arrow pointing right (16x48).

=item F<LH.gif>       

Hollow arrow pointing left (16x48).

=item F<noicon.gif>   

Icon used when no icon is found.

=item F<menu.conf>    

Default name for local configuration file.

=item F<resources>    

Name for local resource settings file, overriding X resources.

=item F<.Xdefaults> or F<.Xresources>

where the normal X resources are stored

=back

=head1 AUTHOR

This software is Copyright 1999, 2000, 2001, 2002 by Max
Zomborszki. Full licence can be found at the top of the code.

=head1 ACKNOWLEDGMENTS

Larry Wall for creating Perl and everyone making great modules for Perl.

=head1 SEE ALSO

Perl(1), X(1X)

=head1 KNOWN PROBLEMS

Lots of bugs. The autopost/autounpost features have not been tested
extensively and initial versions had obvious problems.

=head1 BUGS

Send bug reports to max@e.kth.se

=cut