#!/usr/local/bin/perl
    eval 'exec perl -S $0 "$@"'
	if 0;
    eval 'exec perl -S $0 "$@"'
	if 0;
    eval 'exec perl -S $0 "$@"'
        if 0;

#
# A spiffier WinList written in perl using the Tk extension
#
# (c) 1997 Randy Ray, all rights reserved
#

use 5.003;

use strict;
use vars qw($TOP $frame %winlist $TITLE $CURRENT_FOCUS $MAX_NAME_LEN
            @last_ordering %OPTS %IMAGES);
use Carp;
use IO::File;

use Tk;
use X11::Fvwm::Tk;
use X11::Fvwm::Defaults 'TkFvwmError';

$TOP = new MainWindow;
my $mod = new X11::Fvwm::Tk $TOP,
                            INIT => 1,     # Go ahead and run initModule
                            CONFIG => 1,   # Go ahead and get config info
                            # The mask we will use: all the packets that we
                            # expect to care about
                            MASK => (M_ADD_WINDOW |
                                     M_DESTROY_WINDOW |
                                     M_ICONIFY |
                                     M_DEICONIFY |
                                     M_FOCUS_CHANGE |
                                     M_WINDOW_NAME |
                                     M_ICON_NAME |
                                     M_RES_CLASS |
                                     M_RES_NAME |
                                     M_CONFIGURE_WINDOW |
                                     M_ERROR);
&ReadFvwmOptions($mod, $TOP);

$frame = $TOP->Frame;

#
# What do we call ourselves?
#
$TITLE = $OPTS{Title} || 'PerlTkWL - WinList in pTk';
$TOP->title($TITLE);
$TOP->transient($TOP) if (defined $mod->{argv}->[0] and
                          $mod->{argv}->[0] eq 'Transient');
$TOP->geometry($OPTS{Geometry}) if (defined $OPTS{Geometry} and
                                    $OPTS{Geometry} =~ /^([+-]\d+){2}$/o);
$TOP->bind('<KeyPress-q>', sub { &ExitGracefully($mod) });

$CURRENT_FOCUS = undef;

#
# Maximum length for window names: greater than this, and the name is cut
# down to $MAX_NAME_LEN - 3, and "..." is added at the end.
#
$MAX_NAME_LEN = $OPTS{MaxNameLen} || 15;

&ReadWinList($mod) or croak "Could not get window list from fvwm\n";
&MakeInitialButtons($frame, $mod);
&RefreshWinList(1);

$frame->pack;

#
# Now define our event handlers. Where possible, use closures
#
# This one uses a generic handler from the Defaults package:
#
$mod->addHandler(M_ERROR, \&TkFvwmError);

$mod->addHandler(M_ICONIFY | M_DEICONIFY,
                 sub {
                     my ($self, $type, $id, $frameid, $ptr) = @_;

                     if ($type == M_ICONIFY)
                     {
                         # Set our internal track of the flags to include this
                         $winlist{$ptr}->{FLAGS} |= F_ICONIFIED;
                     }
                     else
                     {
                         # Clear out the flag in our interal flags
                         $winlist{$ptr}->{FLAGS} &= ~F_ICONIFIED;
                     }

                     if ($OPTS{Style} ne 'text')
                     {
                         $winlist{$ptr}->{iconLabel}->configure(-image =>
                                                                &updateIcon($ptr));
                     }
                     else
                     {
                         $winlist{$ptr}->{BUTTON}->configure(-text =>
                                                             &makeLabel($ptr));
                     }

                     &SetIconColors(($type == M_ICONIFY) ? 1 : 0, $ptr);
                     &RefreshWinList if ($OPTS{'sort'} =~ /icon/oi);

                     $ptr;
                 });

$mod->addHandler(M_DESTROY_WINDOW,
                 sub {
                     my ($self, $type, $id, $frameid, $ptr) = @_;

                     if (defined $winlist{$ptr}->{FRAME})
                     {
                         $winlist{$ptr}->{FRAME}->gridForget if
                             ($winlist{$ptr}->{PACKED});
                         $winlist{$ptr}->{FRAME}->destroy;
                     }
                     undef $winlist{$ptr};
                     delete $winlist{$ptr};
                     &RefreshWinList;

                     $ptr;
                 });

$mod->addHandler(M_ICON_NAME | M_WINDOW_NAME | M_RES_CLASS | M_RES_NAME,
                 sub {
                     my ($self, $type, $id, $frameid, $ptr, $name) = @_;

                     unless (exists $winlist{$ptr})
                     {
                         # this is part of a new window coming up
                         $winlist{$ptr} = {};
                     }

                     if ($type == M_ICON_NAME)
                     {
                         $winlist{$ptr}->{ICONNAME} = $name;
                     }
                     elsif ($type == M_WINDOW_NAME)
                     {
                         $winlist{$ptr}->{NAME} = $name;
                     }
                     elsif ($type == M_RES_CLASS)
                     {
                         $winlist{$ptr}->{RESCLASS} = $name;
                     }
                     else
                     {
                         $winlist{$ptr}->{RESNAME} = $name;
                     }

                     &MakeButton($ptr, $self, $frame);
                     &RefreshWinList;

                     $ptr;
                 });

$mod->addHandler(M_CONFIGURE_WINDOW,
                 sub {
                     my ($self, $type, $id, $frameid, $ptr, @args) = @_;

                     unless (exists $winlist{$ptr})
                     {
                         # this is part of a new window coming up
                         $winlist{$ptr} = {};
                     }

                     $winlist{$ptr}->{X_POS}  = $args[0];
                     $winlist{$ptr}->{Y_POS}  = $args[1];
                     $winlist{$ptr}->{WIDTH}  = $args[2];
                     $winlist{$ptr}->{HEIGHT} = $args[3];
                     $winlist{$ptr}->{DESK}   = $args[4];
                     $winlist{$ptr}->{FLAGS}  = $args[5];

                     &MakeButton($ptr, $self, $frame) && &RefreshWinList;

                     $ptr;
                 });

$mod->addHandler(M_FOCUS_CHANGE,
                 sub {
                     my ($self, $type, $id, $frameid, $ix) = @_;

                     if (defined $CURRENT_FOCUS)
                     {
                         my $id = $CURRENT_FOCUS;
                         undef $CURRENT_FOCUS;
                         last unless (defined $winlist{$id}->{FRAME});

                         &removeFocus($id);
                     }

                     return 1 unless (defined $winlist{$ix}->{FRAME});

                     $CURRENT_FOCUS = $ix;
                     &setFocus($ix);

                     $ix;
                 });

#
# Any signals we need to be wary of?
#
$SIG{PIPE} = sub { exit };

$mod->eventLoop; # Never returns

exit;

##############################################################################
#
#   Sub Name:       ReadFvwmOptions
#
#   Description:    Look at the module options from Fvwm for any that are
#                   relevant to this module.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $mod      in      ref       Object of class X11::Fvwm
#                   $top      in      ref       Tk top-level
#
#   Globals:        %OPTS
#
#   Returns:        Success:    1
#                   Failure:    0
#
##############################################################################
sub ReadFvwmOptions
{
    my $mod = shift;
    my $top = shift;

    # Without any arguments, this method will return a hash populated only
    # with keys that contain our app name as a substring. The -trimname
    # argument doesn't count-- getConfigInfo will pull it out early, and use
    # it as a direction to strip the "PerlTkWL" part of the name from each key.
    %OPTS = $mod->getConfigInfo(-trimname);

    # Just go down the list looking for things or setting defaults.
    $OPTS{fg}   = $OPTS{Foreground} || 'black';
    $OPTS{bg}   = $OPTS{Background} || 'white';
    $OPTS{afg}  = $OPTS{ActiveForeground} || $OPTS{bg};
    $OPTS{abg}  = $OPTS{ActiveBackground} || $OPTS{fg};
    $OPTS{ffg}  = $OPTS{FocusForeground} || $OPTS{fg};
    $OPTS{fbg}  = $OPTS{FocusBackground} || $OPTS{bg};
    $OPTS{ifg}  = $OPTS{IconForeground} || $OPTS{fg};
    $OPTS{ibg}  = $OPTS{IconBackground} || $OPTS{bg};

    $OPTS{iconfg} = $OPTS{IconForeground} || undef;
    $OPTS{iconbg} = $OPTS{IconBackground} || $OPTS{bg};

    $OPTS{UseSkipList} = (defined $OPTS{UseSkipList} and
                          $OPTS{UseSkipList} =~ /no|false|0/oi) ? 0 : 1;
    $OPTS{'sort'}  = lc $OPTS{SortStyle} || 'alpha';
    $OPTS{UseMiniIcons} = (defined $OPTS{UseMiniIcons} and
                           $OPTS{UseMiniIcons} =~ /yes|true|1/oi) ? 1 : 0;

    if (exists $OPTS{Action})
    {
        my @actions = ((ref($OPTS{Action}) eq 'ARRAY') ?
                       @{$OPTS{Action}} : ($OPTS{Action}));
        my (%actions, $event, $action);

        for (@actions)
        {
            ($event, $action) = split(/ /, $_, 2);
            next unless ($event =~ /^Click\d$/oi);
            $actions{ucfirst (lc $event)} = $action;
        }
        for (qw(Click1 Click2 Click3))
        {
            $actions{$_} = 'internal' unless (exists $actions{$_});
        }

        $OPTS{Action} = \%actions;
    }
    else
    {
        $OPTS{Action} = { Click1 => 'internal',
                          Click2 => 'internal',
                          Click3 => 'internal' };
    }

    #
    # Parlay some of these values into X options
    #
    $top->optionAdd('*foreground' => $OPTS{fg});
    $top->optionAdd('*background' => $OPTS{bg});
    $top->optionAdd('*Button.activeforeground' => $OPTS{afg});
    $top->optionAdd('*Button.activebackground' => $OPTS{abg});
    $top->optionAdd('*font' => $OPTS{Font});

    1;
}

##############################################################################
#
#   Sub Name:       ReadWinList
#
#   Description:    Read a current window list from fvwm
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $self     in      ref       Object of class X11::Fvwm
#
#
#   Globals:        %winlist
#                   @last_ordering
#
#   Returns:        Success:    1
#                   Failure:    0
#
##############################################################################
sub ReadWinList
{
    my $self = shift;

    my ($len, $packet, $type, @args);

    # Temporarily set the mask to only allow win-list-related packets
    my $old_mask = $self->mask(M_WINDOW_NAME | M_ICON_NAME |
                               M_RES_CLASS | M_RES_NAME |
                               M_CONFIGURE_WINDOW | M_END_WINDOWLIST);

    %winlist = ();
    @last_ordering = ();

    $self->sendInfo(0, "Send_WindowList");

    while (1)
    {
        ($len, $packet, $type) = $self->readPacket;
        last if ($type & M_END_WINDOWLIST);
        last if ($len < 0);

        @args = unpack($self->{packetTypes}->{$type}, $packet);
        unless (exists $winlist{$args[2]})
        {
            # Initialize the hashref first
            $winlist{$args[2]} = {};
        }

        if ($type & M_WINDOW_NAME)
        {
            #
            # $args[0]         Top-level Window ID from X
            # $args[1]         Top-level Fvwm frame Window ID
            # $args[2]         Ptr to internal fvmw database for this window
            # $args[3]         Window name
            #
            $args[3] =~ s/\0.*//o;
            $winlist{$args[2]}->{NAME}  = $args[3];
            $winlist{$args[2]}->{WINID} = $args[0];
        }
        elsif ($type & M_ICON_NAME)
        {
            #
            # $args[0]         Top-level Window ID from X
            # $args[1]         Top-level Fvwm frame Window ID
            # $args[2]         Ptr to internal fvmw database for this window
            # $args[3]         Icon name
            #
            $args[3] =~ s/\0.*//o;
            $winlist{$args[2]}->{ICONNAME} = $args[3];
        }
        elsif ($type & M_RES_CLASS)
        {
            #
            # $args[0]         Top-level Window ID from X
            # $args[1]         Top-level Fvwm frame Window ID
            # $args[2]         Ptr to internal fvmw database for this window
            # $args[3]         Resource class
            #
            $args[3] =~ s/\0.*//o;
            $winlist{$args[2]}->{RESCLASS} = $args[3];
        }
        elsif ($type & M_RES_NAME)
        {
            #
            # $args[0]         Top-level Window ID from X
            # $args[1]         Top-level Fvwm frame Window ID
            # $args[2]         Ptr to internal fvmw database for this window
            # $args[3]         Resource name
            #
            $args[3] =~ s/\0.*//o;
            $winlist{$args[2]}->{RESNAME} = $args[3];
        }
        elsif ($type & M_CONFIGURE_WINDOW)
        {
            #
            # $args[0]         Top-level Window ID from X
            # $args[1]         Top-level Fvwm frame Window ID
            # $args[2]         Ptr to internal fvwm database for this window
            # $args[3]         Window X position
            # $args[4]         Window Y position
            # $args[5]         Window width
            # $args[6]         Window height
            # $args[7]         Window desktop (not yet used)
            # $args[8]         Window flags
            #
            $winlist{$args[2]}->{X_POS}  = $args[3];
            $winlist{$args[2]}->{Y_POS}  = $args[4];
            $winlist{$args[2]}->{WIDTH}  = $args[5];
            $winlist{$args[2]}->{HEIGHT} = $args[6];
            $winlist{$args[2]}->{DESK}   = $args[7];
            $winlist{$args[2]}->{FLAGS}  = $args[8];
        }
    }

    #
    # All data has been sent by Fvwm, so restore the mask and exit.
    #
    $self->mask($old_mask);

    1;
}

##############################################################################
#
#   Sub Name:       MakeInitialButtons
#
#   Description:    Make the initial set of buttons, based on the current
#                   contents of %winlist
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $top      in      ref       Window under which to create
#                                                 the frames
#                   $mod      in      ref       Fvwm interface object
#
#   Globals:        %winlist
#
#   Returns:        Success:    1
#                   Failure:    0
#
##############################################################################
sub MakeInitialButtons
{
    my ($top, $mod) = @_;

    my ($ix, $label, $frame, $button, $x_off, $y_off);

    &loadImages($top, $mod) if ($OPTS{Style} ne 'text');

    for $ix (keys %winlist)
    {
        &MakeButton($ix, $mod, $top);
    }

    1;
}

##############################################################################
#
#   Sub Name:       RefreshWinList
#
#   Description:    Draw or refresh the window list frames/buttons.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $force    in      scalar    Force a refresh
#
#   Globals:        %winlist
#                   @last_ordering
#
#   Returns:        Success:    1
#                   Failure:    0
#
##############################################################################
sub RefreshWinList
{
    my $force = shift;

    my @current_ordering = &SortWinList;

    if (scalar @current_ordering == scalar @last_ordering)
    {
        my $diff = 0;
        for my $ix (scalar @current_ordering)
        {
            $diff++ if ((! defined $last_ordering[$ix] or
                         ! defined $current_ordering[$ix]) or
                        ("$current_ordering[$ix]" ne "$last_ordering[$ix]"));
        }
        return 1 unless ($diff || (defined $force and $force));
    }

    @last_ordering = @current_ordering;

    my $row = 0;
    my $height = 0;
    for (@current_ordering)
    {
        next unless defined $winlist{$_}->{FRAME};

        $winlist{$_}->{FRAME}->gridForget;
        $winlist{$_}->{FRAME}->grid(-column => 0, -row => $row,
                                    -sticky => 'ew');
        $winlist{$_}->{PACKED} = 1;
        $row++;
        $height += $winlist{$_}->{FRAME}->cget(-height);
    }

    $TOP->configure(-height => $height);

    1;
}

##############################################################################
#
#   Sub Name:       SortWinList
#
#   Description:    Sort the list of windows by the window name, returning a
#                   list of the %winlist keys in what will produce the correct
#                   ordering.
#
#   Arguments:      None.
#
#   Globals:        %winlist
#
#   Returns:        Success:    list
#                   Failure:    undef
#
##############################################################################
sub SortWinList
{
    my %sort_opts = map { $_, 1 } (split(/,/, $OPTS{'sort'}));
    my @list;

    if (defined $sort_opts{iconfirst} or defined $sort_opts{iconlast})
    {
        my (@icons, @other) = ();

        for (keys %winlist)
        {
            if ($winlist{$_}->{FLAGS} & F_ICONIFIED)
            {
                push(@icons, $_);
            }
            else
            {
                push(@other, $_);
            }
        }

        unless (defined $sort_opts{alpha})
        {
            @icons = sort { $a <=> $b } @icons;
            @other = sort { $a <=> $b } @other;
        }
        else
        {
            @icons = sort {
                (uc $winlist{$a}->{NAME}) cmp (uc $winlist{$b}->{NAME})
            } @icons;
            @other = sort {
                (uc $winlist{$a}->{NAME}) cmp (uc $winlist{$b}->{NAME})
            } @other;
        }
        if (defined $sort_opts{'reverse'})
        {
            @icons = reverse @icons;
            @other = reverse @other;
        }

        @list = (defined $sort_opts{iconfirst}) ?
            (@icons, @other) : (@other, @icons);
    }
    else
    {
        unless (defined $sort_opts{alpha})
        {
            @list = sort { $a <=> $b } keys %winlist;
        }
        else
        {
            @list = sort {
                (uc $winlist{$a}->{NAME}) cmp (uc $winlist{$b}->{NAME})
            } keys %winlist;
        }

        @list = reverse @list if (defined $sort_opts{'reverse'});
    }

    @list;
}

##############################################################################
#
#   Sub Name:       ButtonClick
#
#   Description:    Execute a button click on the specified list entry
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $b        in      scalar    Button that was clicked (1..3)
#                   $ix       in      scalar    List index of the widget hit
#                   $top      in      ref       Tk top-level ref
#                   $mod      in      ref       Fvwm API object
#
#   Globals:        %OPT
#
#   Returns:        Success:    1
#                   Failure:    0
#
##############################################################################
sub ButtonClick
{
    my ($b, $ix, $top, $mod) = @_;

    my %actions = %{$OPTS{Action}};

    my $action = $actions{"Click$b"};
    return 0 unless (defined $action);

    if ($action eq 'internal')
    {
        $action = ('Focus,Iconify -1,Focus', 'Iconify', 'Nop')[$b - 1];
    }

    if ($action =~ /^\&(.*)$/o)
    {
        no strict 'refs';

        &{"$1"}($b, $ix, $top, $mod);
    }
    else
    {
        $mod->sendInfo($winlist{$ix}->{WINID}, $action);
    }

    &ExitGracefully($mod) if (defined $mod->{argv}->[0] and
                              $mod->{argv}->[0] =~ /transient/oi);

    1;
}

##############################################################################
#
#   Sub Name:       MakeButton
#
#   Description:    Create a new button for the specified window. Called by
#                   MakeInitialButtons and whenever the event loop gets an
#                   indication of a new window.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $ix       in      scalar    Hash index for new window
#                   $mod      in      ref       The handle on Fvwm 
#                   $top      in      ref       The Tk object we are to derive
#                                                 the outer Frame from 
#
#   Globals:        %winlist
#                   $TITLE
#
#   Returns:        Success:    1
#                   Failure:    0 IMPORTANT! Returned unless all win data read
#
##############################################################################
sub MakeButton
{
    my ($ix, $mod, $top) = @_;

    #
    # To display the button, we must have received three packets: M_ICON_NAME,
    # M_WINDOW_NAME and M_CONFIGURE_WINDOW. The three fields below will not
    # exist until each of these three have been read and handled.
    #
    return 0 unless (exists $winlist{$ix}->{NAME} &&
                     exists $winlist{$ix}->{ICONNAME} &&
                     exists $winlist{$ix}->{X_POS});

    #
    # Also skip this application, in case they forgot to set it for skipping
    #
    return 0 if ($winlist{$ix}->{NAME} eq $TITLE);

    return 0 if ($OPTS{UseSkipList} &&
                 ($winlist{$ix}->{FLAGS} & F_WINDOWLISTSKIP));
    return 0 if ($winlist{$ix}->{FLAGS} & F_TRANSIENT);

    if ($OPTS{Style} ne 'graphic')
    {
        #
        # The well-known, comfortable style
        #
        if (exists $winlist{$ix}->{FRAME})
        {
            $winlist{$ix}->{BUTTON}->configure(-text => &makeLabel($ix));
            return 0;
        }

        my ($frame, $button);

        $frame = $top->Frame;
        &makeLabel($ix);
        $button = $frame->Button(-text => $winlist{$ix}->{LABEL},
                                 -highlightthickness => 0);
        $button->bind('<1>',
                      sub {
                          &ButtonClick(1, $ix, $top, $mod);
                      });
        $button->bind('<2>',
                      sub {
                          &ButtonClick(2, $ix, $top, $mod);
                      });
        $button->bind('<3>',
                      sub {
                          &ButtonClick(3, $ix, $top, $mod);
                      });
        $button->pack(-fill => 'x');
        $winlist{$ix}->{FRAME} = $frame;
        $winlist{$ix}->{BUTTON} = $button;
        $winlist{$ix}->{PACKED} = 0;
    }
    else
    {
        #
        # Create the graphics-abusive version
        #
        if (exists $winlist{$ix}->{FRAME})
        {
            $winlist{$ix}->{nameLabel}->configure(-text => &updateName($ix));
            $winlist{$ix}->{geomLabel}->configure(-text => &updateGeom($ix));
            $winlist{$ix}->{iconLabel}->configure(-image => &updateIcon($ix));
            $winlist{$ix}->{miniLabel}->configure(-image => &updateMini($ix))
                if ($OPTS{UseMiniIcons});
            return 0;
        }

        my ($frame, $nameLabel, $geomLabel, $iconLabel, $miniLabel);
        $frame = $top->Frame(-relief => 'raised', -borderwidth => 2);
        $nameLabel = $frame->Label(-anchor => 'w', -text => &updateName($ix));
        $geomLabel = $frame->Label(-anchor => 'e', -text => &updateGeom($ix));
        $iconLabel = $frame->Label(-image => &updateIcon($ix));
        for ($nameLabel, $geomLabel, $iconLabel)
        {
            $_->bind('<1>',
                      sub {
                          &ButtonClick(1, $ix, $top, $mod);
                      });
            $_->bind('<2>',
                      sub {
                          &ButtonClick(2, $ix, $top, $mod);
                      });
            $_->bind('<3>',
                      sub {
                          &ButtonClick(3, $ix, $top, $mod);
                      });
        }

        if ($OPTS{UseMiniIcons})
        {
            $miniLabel = $frame->Label(-image => &updateMini($ix));
            $winlist{$ix}->{miniLabel} = $miniLabel;
            $miniLabel->pack(-side => 'left', -fill => 'both');
            $miniLabel->bind('<Button-1>',
                             sub {
                                 &DeIconifyOrRaise($mod, $ix);
                             });
            $miniLabel->bind('<Button-2>', sub { &Iconify($mod, $ix) });
            $miniLabel->bind('<ButtonPress-3>', sub { 1 });
            $miniLabel->bind('<ButtonRelease-3>', sub { 1 });
        }
        $winlist{$ix}->{nameLabel} = $nameLabel;
        $nameLabel->pack(-side => 'left', -fill => 'both', -expand => 1);
        $winlist{$ix}->{iconLabel} = $iconLabel;
        $iconLabel->pack(-side => 'right', -fill => 'both');
        $winlist{$ix}->{geomLabel} = $geomLabel;
        $geomLabel->pack(-side => 'right', -fill => 'both', -expand => 1);
        $winlist{$ix}->{FRAME} = $frame;
        $winlist{$ix}->{PACKED} = 0;
    }

    &SetIconColors(1, $ix) if ($winlist{$ix}->{FLAGS} & F_ICONIFIED);

    1;
}

##############################################################################
#
#   Sub Name:       makeLabel
#
#   Description:    Create a label for the window/button in $ix.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $ix       in      scalar    Index into %winlist
#
#   Globals:        %winlist
#                   $MAX_NAME_LEN
#
#   Environment:    None.
#
#   Returns:        Success:    1
#                   Failure:    0
#
##############################################################################
sub makeLabel
{
    my $ix = shift;

    my ($x_off, $y_off);

    my $old_label = $winlist{$ix}->{LABEL} || '';

    my $label = ($winlist{$ix}->{FLAGS} & F_ICONIFIED) ?
        $winlist{$ix}->{ICONNAME} : $winlist{$ix}->{NAME};
    if (length($label) > $MAX_NAME_LEN)
    {
        $label = substr($label, 0, ($MAX_NAME_LEN - 3)) . '...';
    }
    $x_off = $winlist{$ix}->{X_POS};
    $x_off = "+$x_off" unless ($x_off < 0);
    $y_off = $winlist{$ix}->{Y_POS};
    $y_off = "+$y_off" unless ($y_off < 0);
    $label .= sprintf(" %dx%d$x_off$y_off",
                      $winlist{$ix}->{WIDTH}, $winlist{$ix}->{HEIGHT});
    $label = "($label)" if ($winlist{$ix}->{FLAGS} & F_ICONIFIED);

    $winlist{$ix}->{LABEL} = $label;

    $label;
}

#
# Re-make the text string used in the name label
#
sub updateName
{
    my $ix = shift;

    my $name = $winlist{$ix}->{NAME};

    if (length($name) > $MAX_NAME_LEN)
    {
        $name = substr($name, 0, ($MAX_NAME_LEN - 3)) . '...';
    }
    $winlist{$ix}->{nameLabelText} = $name;
}

#
# Re-figure the text string used in the geometry label
#
sub updateGeom
{
    my $ix = shift;

    my ($x_off, $y_off, $label);

    $x_off = $winlist{$ix}->{X_POS};
    $x_off = "+$x_off" unless ($x_off < 0);
    $y_off = $winlist{$ix}->{Y_POS};
    $y_off = "+$y_off" unless ($y_off < 0);
    $label = sprintf("%dx%d$x_off$y_off",
                     $winlist{$ix}->{WIDTH}, $winlist{$ix}->{HEIGHT});

    $winlist{$ix}->{geomLabelText} = $label;
}

#
# Return the cached image that corresponds to the the icon-state of window
# $ix. Not to be confused with the optional mini-icons, this is for noting
# windows that are (not) iconified.
#
sub updateIcon
{
    my $ix = shift;

    return ($winlist{$ix}->{FLAGS} & F_ICONIFIED) ? $IMAGES{_icon_ON} :
                                                    $IMAGES{_icon_OFF};
}

#
# Select a mini-icon to use (assuming that mini-icons are to be used) for
# the window. Look for matches by res-class, res-name and finally by name.
# The match by name is done as a regex substring match, but the others need
# to match explicitly (case-sensitive, since res name and res class are
# often the same save for one or two capital letters.
#
sub updateMini
{
    my $ix = shift;

    return '' unless ($OPTS{UseMiniIcons});

    my $resname = $winlist{$ix}->{RESNAME};
    my $resclass = $winlist{$ix}->{RESCLASS};
    my $name = $winlist{$ix}->{NAME};
    my ($resname_match, $resclass_match, $name_match);

    $resname_match  = (exists $IMAGES{$resname})  ? $IMAGES{$resname}  : undef;
    $resclass_match = (exists $IMAGES{$resclass}) ? $IMAGES{$resclass} : undef;
    # trickier
    $name_match = undef;
    for (keys %IMAGES)
    {
        next if /^_/o;
        if ($name =~ /$_/i)
        {
            $name_match = $IMAGES{$_};
            last;
        }
    }

    # This is the priority order: by name, by resource name, or by resource
    # class, with the blank used when no others match.
    return $name_match || $resname_match || $resclass_match ||
        $IMAGES{_no_mini_icon};
}

##############################################################################
#
#   Sub Name:       loadImages
#
#   Description:    Create a cache of images (bitmaps and pixmaps) that may
#                   potentially be needed by this application.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $top      in      ref       Tk top-level
#                   $mod      in      ref       Fvwm API hook
#
#   Globals:        %IMAGES
#                   %OPTS
#
#   Returns:        Success:    1
#                   Failure:    0
#
##############################################################################
sub loadImages
{
    my $top = shift;
    my $mod = shift;

    %IMAGES = ();

    my (@paths, %paths, @lines, $line, $name, $icon, @pairs);

    my $empty12 = <<END_OF_E12;
#define empty12_width 12
#define empty12_height 12
static unsigned char empty12_bits[] = {
  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
  };
END_OF_E12

    my $empty16 = <<END_OF_E16;
#define empty16_width 16
#define empty16_height 16
static unsigned char empty16_bits[] = {
  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, };
END_OF_E16

    my $iconified = <<END_ICONIFIED;
#define iconified_width 12
#define iconified_height 12
static char iconified_bits[] = {
 0x0e,0x07,0x9b,0x0d,0x91,0x08,0x9b,0x0d,0xfe,0x07,0x90,0x00,0x90,0x00,0xfe,
 0x07,0x9b,0x0d,0x91,0x08,0x9b,0x0d,0x0e,0x07};
END_ICONIFIED

    #
    # First take care of the two images for iconified/open windows
    #
    $IMAGES{_icon_ON}  = $top->Bitmap(-data => $iconified);
    $IMAGES{_icon_OFF} = $top->Bitmap(-data => $empty12);

    #
    # This is for using mini-icons, to fill the space on windows that don't
    # have a defined mini-icon
    #
    $IMAGES{_no_mini_icon} = $top->Bitmap(-data => $empty16);

    #
    # Now, we get the IconPath and PixmapPath variables, for our search
    # path(s). Then, we go through any and all lines stored in $OPTS{MiniIcon}
    # to see what icons we need to pre-load.
    #
    %paths = $mod->getConfigInfo('IconPath', 'PixmapPath');
    push(@paths,
         (split(/:/, $paths{IconPath}))) if (exists $paths{IconPath} and
                                             $paths{IconPath});
    push(@paths,
         (split(/:/, $paths{PixmapPath}))) if (exists $paths{PixmapPath} and
                                               $paths{PixmapPath});
    return 0 if ($#paths == -1);

    if (ref($OPTS{MiniIcon}) eq 'ARRAY')
    {
        @lines = @{$OPTS{MiniIcon}};
    }
    else
    {
        @lines = ($OPTS{MiniIcon});
    }

    for $line (@lines)
    {
        @pairs = split(/,/, $line);
        for (@pairs)
        {
            ($name, $icon) = split;

            next unless (defined($icon = &findIcon($icon, @paths)));
            $IMAGES{$name} = ($icon =~ /\.xpm/oi) ?
                $top->Pixmap(-file => $icon) :
                $top->Bitmap(-file => $icon);
        }
    }

    1;
}

#
# Locate the requested icon file in the list of paths. Return full path, or
# undef if it wasn't found
#
sub findIcon
{
    my ($name, @path) = @_;

    for (@path)
    {
        return "$_/$name" if (stat("$_/$name") && -f _ && -r _);
    }

    undef;
}

#
# Set the colors on the necessary widgets to reflect that the window indexed
# by $id is the current holder of the focus.
#
sub setFocus
{
    my $id = shift;

    if ($OPTS{Style} ne 'text')
    {
        for my $wid ($winlist{$id}->{miniLabel}, $winlist{$id}->{nameLabel},
                     $winlist{$id}->{geomLabel}, $winlist{$id}->{iconLabel},
                     $winlist{$id}->{FRAME})
        {
            $wid->configure(-foreground => $OPTS{ffg},
                            -background => $OPTS{fbg});
        }
    }
    else
    {
        $winlist{$id}->{BUTTON}->configure(-foreground => $OPTS{ffg},
                                           -background => $OPTS{fbg},
                                           -activeforeground => $OPTS{fbg},
                                           -activebackground => $OPTS{ffg});
    }

    1;
}

#
# Change colors back, so that a window that *had* the focus, but no longer 
# does, has the original colors.
#
sub removeFocus
{
    my $id = shift;

    if ($OPTS{Style} ne 'text')
    {
        for my $wid ($winlist{$id}->{miniLabel}, $winlist{$id}->{nameLabel},
                     $winlist{$id}->{geomLabel}, $winlist{$id}->{iconLabel},
                     $winlist{$id}->{FRAME})
        {
            $wid->configure(-foreground => $OPTS{fg},
                            -background => $OPTS{bg});
        }
    }
    else
    {
        $winlist{$id}->{BUTTON}->configure(-foreground => $OPTS{fg},
                                           -background => $OPTS{bg},
                                           -activeforeground => $OPTS{afg},
                                           -activebackground => $OPTS{abg});
    }

    &SetIconColors(1, $id) if ($winlist{$id}->{FLAGS} & F_ICONIFIED);

    1;
}

##############################################################################
#
#   Sub Name:       SetIconColors
#
#   Description:    Change the colors of the button as needed by a change in
#                   one button's iconic state.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $flag     in      scalar    1 if $id just iconified, or 0
#                   $id       in      scalar    winlist index
#
#   Globals:        %OPTS
#
#   Returns:        Success:    1
#                   Failure:    0
#
##############################################################################
sub SetIconColors
{
    my ($flag, $id) = @_;

    return 1 if ($OPTS{ifg} eq $OPTS{fg} and
                 $OPTS{ibg} eq $OPTS{bg});

    if ($flag)
    {
        if ($OPTS{Style} ne 'text')
        {
            for my $wid ($winlist{$id}->{miniLabel},
                         $winlist{$id}->{nameLabel},
                         $winlist{$id}->{geomLabel},
                         $winlist{$id}->{iconLabel},
                         $winlist{$id}->{FRAME})
            {
                $wid->configure(-foreground => $OPTS{ifg},
                                -background => $OPTS{ibg});
            }
        }
        else
        {
            $winlist{$id}->{BUTTON}->configure(-foreground => $OPTS{ifg},
                                               -background => $OPTS{ibg},
                                               -activeforeground =>
                                               $OPTS{ibg},
                                               -activebackground =>
                                               $OPTS{ifg});
        }
    }
    else
    {
        if ($OPTS{Style} ne 'text')
        {
            for my $wid ($winlist{$id}->{miniLabel},
                         $winlist{$id}->{nameLabel},
                         $winlist{$id}->{geomLabel},
                         $winlist{$id}->{iconLabel},
                         $winlist{$id}->{FRAME})
            {
                $wid->configure(-foreground => $OPTS{fg},
                                -background => $OPTS{bg});
            }
        }
        else
        {
            $winlist{$id}->{BUTTON}->configure(-foreground => $OPTS{fg},
                                               -background => $OPTS{bg},
                                               -activeforeground => $OPTS{afg},
                                               -activebackground => $OPTS{abg});
        }
    }
}

#
# Do a clean exit, as if we meant to
#
sub ExitGracefully
{
    my $mod = shift;

    my $top = $mod->{topLevel};
    $mod->invokeHandler('EXIT');
    $top->destroy;
    $mod->endModule;
}

__END__