#!/usr/bin/perl -w

# $Id$

# 	FvwmTabs
#	Copyright (C) 2002-2006 Scott Smedley ss@aao.gov.au
#
#	This program is free software; you can redistribute it and/or modify
#	it under the terms of the GNU General Public License as published by
#	the Free Software Foundation; either version 2 of the License, or
#	(at your option) any later version.
#
#	This program is distributed in the hope that it will be useful,
#	but WITHOUT ANY WARRANTY; without even the implied warranty of
#	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#	GNU General Public License for more details.
#
#	You should have received a copy of the GNU General Public License
#	along with this program; if not, write to the Free Software
#	Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA


# see the FvwmTabs(1) man page for how to use this module.

BEGIN {
    use vars qw($prefix $datarootdir $datadir);
    $prefix = "/usr";
    $datarootdir = "${prefix}/share";
    $datadir = "${datarootdir}";
}

use strict;
use lib "${datadir}/fvwm/perllib";
use encoding ':locale';
use FVWM::Module::Tk;
use FVWM::Module::Toolkit qw(FileHandle IO::Select X11::Protocol>=0.52 Tk>=804.025 Tk::Balloon Tk::DragDrop Tk::DropSite Tk::LabFrame Tk::BrowseEntry Tk::PNG);

use vars qw($TOP $fvwm $xServer %tabWin @autoSwallow $repeatId $balloon %global);


$TOP = new MainWindow();
$TOP->withdraw();
$fvwm = new FVWM::Module::Tk($TOP,
							 Name => "FvwmTabs",
							 Mask => (M_STRING | M_ADD_WINDOW),
							 Debug => 0);

$fvwm->debug("Debug level is: " . $fvwm->{debug});
$fvwm->add_default_error_handler();
$fvwm->send("Read ConfigFvwmTabs");

sub ver ($)
{
	my ($v) = @_;
	$v =~ /^(\d+)\.(\d+)\.(\d+)$/;
	return $1 + ($2 + ($3 / 1000.0)) / 1000.0;
}

if (ver($fvwm->version()) < ver('2.5.11'))
{
	print(STDERR $fvwm->name() . " requires fvwm >= 2.5.11 - exiting.\n");
	exit;
}

my $configTracker = $fvwm->track('ModuleConfig',
	 DefaultConfig => {activeBG => 'MidnightBlue',
					   activeFG => 'yellow',
					   inactiveBG => 'royalblue',
					   inactiveFG => 'antiquewhite',
					   titleFG => 'black',
					   titleBG => 'antiquewhite',
					   activeRelief => 'sunken',
					   inactiveRelief => 'raised',
					   buttonYPadding => 3,
					   pollRate => 250,	# in milliseconds.
					   autoSwallowClass => '',
					   autoSwallowResource => '',
					   autoSwallowName => '',
					   fontSelector => 'gfontsel --print -f "%f"',
					   buttonFont => 'Helvetica -12 bold',
					   titleFont => 'Helvetica -12 bold',
					   menuFont => 'Helvetica -12',
					   balloonFont => 'Helvetica -12',
					   balloonWait => 350, # in milliseconds
					   balloonBG => '#C0C080',
					   balloonMsg => 'Tab %tabNo:\n%iconText\n%title',
					   autoResize => 'false',
					   stateFile => $ENV{FVWM_USERDIR} . '/.fvwmtabs.state',
					   fixedSizeTabs => 'false',
					   showTitlebar => 'true',
					   useTMTitlebar => 'true',
					   dragDropIcon => 'none',
					   bBuggyFocus => 'false',
					   enableSwallowDND => 'true',
					   swallowDNDTolerance => 10, # pixels
					   useIconsOnTabs => 'true',
					   killIcon => 'none',
					   addIcon => 'none',
					   releaseIcon => 'none',
					   menuIcon => 'none',
					   swallowIcon => 'none'});

my $pConfig = $configTracker->data;

sub setButtonAttr ($$$)
{
	my ($b, $attr, $val) = @_;

	eval { $b->configure(-lc($attr) => $pConfig->{$val}); };
	if ($@)
	{
		print(STDERR $fvwm->name() . ": invalid value \"" .
			$pConfig->{$val} . "\" for \"-" . lc($attr) . "\"\n");
		$pConfig->{$val} = $b->cget(-lc($attr));
	}
}

sub isTrue ($) { return ($_[0] =~ /true/i ? 1 : 0); }

$configTracker->observe("config line added", sub {
	# 1st arg is FVWM::Module::Tk hash
	# 2nd arg is FVWM::Tracker::ModuleConfig hash
	# 3rd arg is hash of config values
	# 4th arg is name of config value that has changed.
	my ($self, $h, $v, $p) = @_;
	$self->debug("Module Config event - \"$p\" changed, new val: \"$v->{$p}\"");

	foreach my $tId (keys(%tabWin))
	{
		if ($p =~ /^active(FG|BG|Relief)$/)
		{
			if (defined $tabWin{$tId}{currentTab})
			{
				setButtonAttr($tabWin{$tId}{tab}[$tabWin{$tId}{currentTab}]{button}, $1, $p);
				if ($1 ne 'Relief')
				{
					my $active = 'active' . ($1 eq 'BG' ? 'back' : 'fore') . 'ground';
					setButtonAttr($tabWin{$tId}{tab}[$tabWin{$tId}{currentTab}]{button}, $active, $p);
				}
			}
		}
		elsif ($p =~ /^inactive(FG|BG|Relief)$/)
		{
			# currentTab is always defined if $nTabs > 0
			if (defined $tabWin{$tId}{currentTab})
            {
				my $active = 'active' . ($1 eq 'BG' ? 'back' : 'fore') . 'ground';
				for (my $i = 0; $i < $tabWin{$tId}{nTabs}; $i++)
				{
					next if ($i == $tabWin{$tId}{currentTab});
					setButtonAttr($tabWin{$tId}{tab}[$i]{button}, $1, $p);
					if ($1 ne 'Relief')
					{
						setButtonAttr($tabWin{$tId}{tab}[$i]{button}, $active, $p);
					}
				}
			}
		}
		elsif ($p eq 'buttonYPadding')
		{
			# currentTab is always defined if $nTabs > 0
			if (defined $tabWin{$tId}{currentTab})
			{
				for (my $i = 0; $i < $tabWin{$tId}{nTabs}; $i++)
				{
					setButtonAttr($tabWin{$tId}{tab}[$i]{button}, 'pady', $p);
				}
			}
		}
		elsif ($p =~ /^title(FG|BG)$/)
		{
			$tabWin{$tId}{titleFrame}->configure(-lc($1) => $pConfig->{$p});
		}
		elsif ($p eq 'pollRate')
		{
			$TOP->afterCancel($repeatId);
			$repeatId = $TOP->repeat($pConfig->{pollRate}, \&callback);
			return;	# not a per-tabber option.
		}
		elsif ($p =~ /^(button|title|menu)Font$/)
		{
			setFont($tId, $1, $pConfig->{$p});
		}
		elsif ($p =~ /^autoSwallow(Class|Resource|Name)$/)
		{
			parseAutoSwallow($1);
			return;	# not a per-tabber option.
		}
		elsif ($p eq 'showTitlebar')
		{
			$tabWin{$tId}{showTitlebar} = isTrue($pConfig->{showTitlebar});
			showTitlebar($tId);
		}
		elsif ($p =~ /enableSwallowDND|autoResize/)
		{
			$tabWin{$tId}{$p} = isTrue($pConfig->{$p});
		}
		elsif ($p eq 'useTMTitlebar')
		{
			my $bOn = isTrue($pConfig->{useTMTitlebar});
			$tabWin{$tId}{useTMTitlebar} = $bOn;
			setupMainTitlebar($tId, $bOn);
		}
		elsif ($p =~ /^(fontSelector|fixedSizeTabs|balloonMsg|stateFile|bBuggyFocus|swallowDNDTolerance|swallowIcon)$/)
		{
			# handled implicitly.
			return;
		}
		elsif ($p =~ /^(balloon(Font|Wait|BG)|dragDropIcon|useIconsOnTabs|(kill|add|release|menu)Icon)$/)
		{
			print(STDERR $fvwm->name() . ": \"$p\" option will not take effect until FvwmTabs restarts.\n");
		}
		else
		{
			$self->showError("Unknown option: $p");
			return;
		}
	}
});

$pConfig->{global} = $fvwm->track("GlobalConfig")->data;

# ignoreWin() - called when we're contemplating swallowing a window.
sub ignoreWin ($)
{
	my ($winId) = @_;

	# handle situations in which we release window from tabber.
	# don't want to swallow it again straight away.
	if (defined $global{ignoreSwallow}{$winId})
	{
		my $ts = $global{ignoreSwallow}{$winId};
		# delete $global{ignoreSwallow}{$winId};
		# ignore window for 1 'window move' event or at least 1 second.
		# Wish we had millisecond-resolution time ...
		return ((time() - $ts) < 2);
	}
	return 0;
}

sub toPixels ($$)
{
	my ($tId, $tol) = @_;

	if ($tol =~ /(\d+)%/)
	{
		return ($1 / 100.0) * min($tabWin{$tId}{winFrame}->height(),
								  $tabWin{$tId}{winFrame}->width());
	}
	return $tol;
}

my $winTracker = $fvwm->track("WindowList", "!stack icons names winfo");
$winTracker->observe("window moved", sub {
	my ($fvwm, $tracker, $z, $winId, $old) = @_;

	return if (ignoreWin($winId));

	$fvwm->debug("swallow win move: $winId");

	my $p = $tracker->data($winId);
	return if (defined winIdToTId($winId)); # ignore tabbers moving.

	foreach my $tId (sort(keys(%tabWin)))
	{
		# window must overlap tabber by at least $tol pixels to be
		# swallowed.
		my $tol = toPixels($tId, $pConfig->{swallowDNDTolerance});

		my $t = $tracker->data($tabWin{$tId}{selfId});
		# At this point, $p is the window that moved & $t is the tabber we
		# are checking for an overlap with.
		next if (!$tabWin{$tId}{enableSwallowDND});
		next if ($p->{desk} != $t->{desk} ||
			$p->{X} > ($t->{X} + $t->{width} - $tol) ||
			($p->{X} + $p->{width}) < ($t->{X} + $tol) ||
			$p->{Y} > ($t->{Y} + $t->{height} - $tol) ||
			($p->{Y} + $p->{height}) < ($t->{Y} + $tol));

		# If OpaqueMoveSize is in use, we need to ensure the window
		# isn't swallowed already.
		return if (defined getTabNo($tId, $winId));

		# ok, we've got a match - this tabber should swallow the window.
		addTab($tId, $winId);
		return;
	}
});

$winTracker->observe("window icon updated", sub {
	my ($fvwm, $tracker, $pc, $winId, $old) = @_;

	return if (!isTrue($pConfig->{useIconsOnTabs}));

	my ($tId, $tabNo) = findWin($winId);
	return if (!defined $tId);

	my $p = $pc->{$winId};
	return if (!defined $p->{mini_icon_name});

	if (!defined $old->{mini_icon_name} ||
		$p->{mini_icon_name} ne $old->{mini_icon_name})
	{
		my $pButton = $tabWin{$tId}{tab}[$tabNo]{button};
		$pButton->configure(-image => createMiniIcon($p->{mini_icon_name}, $winId));
	}
});

sub autoSwallow (%)
{
	my (%args) = @_;

	$fvwm->debug("AutoSwallow: " . join(", ", map("$_=" . $args{$_},
												  sort(keys(%args)))));
	push(@autoSwallow, \%args);
}

sub parseAutoSwallow ($)
{
	my ($type) = @_;
	foreach (split(/,/, $pConfig->{'autoSwallow' . $type}))
	{
		if (!/^\s*(.+?)(\s+(\S+))?\s*$/i)
		{
			print(STDERR $fvwm->name() . ": unparseable autoSwallow$type.\n");
			next;
		}
		autoSwallow(lc($type) => $1, type => (!defined $3 ? 'any' : $3));
	}
}

foreach ('Class', 'Resource', 'Name')
{
	parseAutoSwallow($_);
}

$xServer = X11::Protocol->new($TOP->screen());
$xServer->event_handler('queue');

$xServer->error_handler(\&errorHandler);
sub errorHandler ($$)
{
	my($self, $data) = @_;
	print(STDERR $fvwm->name() . ': ' . $self->format_error_msg($data));
}

# Check for registered X events every $pollRate milliseconds.
$repeatId = $TOP->repeat($pConfig->{pollRate}, \&callback);

$balloon = $TOP->Balloon(-bg => $pConfig->{balloonBG},
						 -font => $pConfig->{balloonFont},
						 -initwait => $pConfig->{balloonWait});

sub showMenu ($$)
{
	my ($button, $tId) = @_;

	my $menu = $tabWin{$tId}{menu};

	$menu->delete(0, 'end');
	$menu->add('command',
			   -label => 'Release All',
			   -command => [\&releaseAll, undef, $tId, 0]);
	$menu->add('command',
			   -label => 'Release All (Iconify)',
			   -command => [\&releaseAll, undef, $tId, 1]);
	$menu->add('command',
			   -label => 'Add',
			   -command => [\&pickAndAddClick, undef, $tId, '']);
	$menu->add('command',
			   -label => 'Add Next',
			   -command => [\&swallowNext, $tId, '']);
	$menu->add('command',
			   -label => 'Multi Add',
			   -command => [\&pickAndAddClick, undef, $tId, 'multi']);
	$menu->add('command',
			   -label => 'Resize All To Current',
			   -command => [\&doResize, $tId]);
	if ($pConfig->{fontSelector} ne 'none')
	{
		my $fontMenu = $menu->Menu(-tearoff => 0, -font => $pConfig->{menuFont});
		$fontMenu->add('command',
					   -label => 'Button Font',
					   -command => [\&selectFont, $tId, 'button']);
		$fontMenu->add('command',
					   -label => 'Title Font',
					   -command => [\&selectFont, $tId, 'title']);
		$fontMenu->add('command',
					   -label => 'Menu Font',
					   -command => [\&selectFont, $tId, 'menu']);

		$menu->add('cascade', -label => 'Font', -menu => $fontMenu);
	}
	if (!defined $tabWin{$tId}{optionsMenu})
	{
		my $oMenu = $menu->Menu(-tearoff => 0, -font => $pConfig->{menuFont});
		$oMenu->add('checkbutton',
				   -label => 'Show Internal Titlebar',
				   -variable => \$tabWin{$tId}{showTitlebar},
				   -command => [\&showTitlebar, $tId]);
		$oMenu->add('checkbutton',
				   -label => 'Use Main Titlebar',
				   -variable => \$tabWin{$tId}{useTMTitlebar},
				   -command => [\&toggleMainTitlebar, $tId]);
		$oMenu->add('checkbutton',
				   -label => 'Auto Resize',
				   -variable => \$tabWin{$tId}{autoResize},
				   -command => [\&toggleAutoResize, $tId]);
		$oMenu->add('checkbutton',
				   -label => 'Swallow Overlapping (D&D)',
				   -variable => \$tabWin{$tId}{enableSwallowDND});
		$tabWin{$tId}{optionsMenu} = $oMenu;
	}
	$menu->add('cascade',
				-label => 'Options',
				-menu => $tabWin{$tId}{optionsMenu});
	$menu->add('command',
			   -label => 'Window Tabizer Dialog',
			   -command => [\&tabizeWindows, $tId]);
	$menu->add('separator');

	for (my $tabNo = 0; $tabNo < $tabWin{$tId}{nTabs}; $tabNo++)
	{
		$menu->add('command', -label => $tabWin{$tId}{tab}[$tabNo]{title},
							 -command => [\&showTab, $tId, $tabNo]);
	}
	$menu->add('separator') if ($tabWin{$tId}{nTabs} > 0);
	$menu->add('command', -label => 'About', -command => [\&about, $tId]);
	$menu->add('command', -label => 'Close', -command => [\&closeTabber, $tId]);
	$menu->Popup(-popanchor => 'ne', -popover => 'cursor');
}

sub createNewTabber
{
	my ($tId, $geom);
	foreach (@_)
	{
		$geom = $2, next if (/^--?g(eometry)?=(.*)/);
		$tId = $_;
	}

	if (!defined $tId)
	{
		for ($tId = 0; ; $tId++)
		{
			last if (!defined($tabWin{$tId}));
		}
	}
	elsif (exists $tabWin{$tId})
	{
		$fvwm->show_error("Tabber \"$tId\" already exists!");
		return;
	}
	elsif ($tId =~ /^(any|lastFocus)$/i)
	{
		$fvwm->show_error("Tabber name \"$tId\" is illegal!");
		return;
	}

	my $title = $fvwm->name() . " [$tId]";
	my $tl = $TOP->Toplevel(Name => $fvwm->name(),
							-class => $fvwm->name(),
							-title => $title);
	$tl->geometry($geom) if (defined $geom);
	$tl->iconname($title);
	$tl->focusmodel("active");
	my $topFrame = $tl->Frame();
	my $tabFrame = $topFrame->Frame();
	$tabFrame->pack(-side => 'top', -expand => 0, -fill => 'x');
	$topFrame->pack(-expand => 1, -fill => 'both', -anchor => 'nw');

	# titlebar
	my $wrapFrame = $topFrame->Frame();
	$wrapFrame->pack(-expand => 0, -fill => 'x');
	my $titleFrame = $wrapFrame->Label(-text => "No title",
									  -font => $pConfig->{titleFont},
									  -bg => $pConfig->{titleBG},
									  -fg => $pConfig->{titleFG});
	$tabWin{$tId}{showTitlebar} = isTrue($pConfig->{showTitlebar});
	$tabWin{$tId}{enableSwallowDND} = isTrue($pConfig->{enableSwallowDND});
	$tabWin{$tId}{useTMTitlebar} = isTrue($pConfig->{useTMTitlebar});
	$tabWin{$tId}{autoResize} = isTrue($pConfig->{autoResize});
	$tabWin{$tId}{titleFrame} = $titleFrame;
	$tabWin{$tId}{wrapFrame} = $wrapFrame;
	$tabWin{$tId}{nTabs} = 0;
	showTitlebar($tId);

	my $winFrame = $topFrame->Frame();
	$winFrame->pack(-expand => 1, -fill => 'both', -side => 'top');

	# ===
	my $af = $tabFrame->Frame()->pack(-side => 'right', -fill => 'y');
	my @po = qw/-side right -fill y/;
	my $bKill = $af->Button(-text => 'K',
							-image => createImage($pConfig->{killIcon}),
							-padx => 0,
							-borderwidth => 0,
							-relief => 'flat')->pack(@po);
	$bKill->Tk::bind('<ButtonRelease-1>', [\&closeTab, $tId, 'Close']);
	$bKill->Tk::bind('<ButtonRelease-2>', [\&killTab, $tId]);
	$bKill->Tk::bind('<ButtonRelease-3>', [\&closeTab, $tId, 'Destroy']);
	my $bAdd = $af->Button(-text => 'A',
						   -image => createImage($pConfig->{addIcon}),
						   -padx => 0,
						   -borderwidth => 0,
						   -relief => 'flat')->pack(@po);
	$bAdd->Tk::bind('<ButtonRelease-1>', [\&pickAndAddClick, $tId, '']);
	$bAdd->Tk::bind('<ButtonRelease-2>', [\&swallowNextClick, $tId]);
	$bAdd->Tk::bind('<ButtonRelease-3>', [\&pickAndAddClick, $tId, 'multi']);
	$tabWin{$tId}{addButton} = $bAdd;

	my $bRelease = $af->Button(-text => 'R',
							   -image => createImage($pConfig->{releaseIcon}),
							   -padx => 0,
							   -borderwidth => 0,
							   -relief => 'flat')->pack(@po);
	$bRelease->Tk::bind('<ButtonRelease-1>', [\&releaseCurrent, $tId]);
	$bRelease->Tk::bind('<ButtonRelease-2>', [\&releaseAll, $tId, 1]);
	$bRelease->Tk::bind('<ButtonRelease-3>', [\&releaseAll, $tId, 0]);

	my $bMenu = $af->Button(-text => 'M',
							-image => createImage($pConfig->{menuIcon}),
							-padx => 0,
							-borderwidth => 0,
							-relief => 'flat')->pack(@po);
	$bMenu->Tk::bind('<ButtonRelease-1>', [\&showMenu, $tId]);
	$bMenu->Tk::bind('<ButtonRelease-2>', [\&tabInfo, $tId]);

	$tabWin{$tId}{menu} = $tl->Menu(-tearoff => 0,
									-font => $pConfig->{menuFont});

	$tabWin{$tId}{toplevel} = $tl;
	$tabWin{$tId}{toplevelId} = hex($tabWin{$tId}{toplevel}->id());
	$tabWin{$tId}{tabFrame} = $tabFrame;
	$tabWin{$tId}{winFrame} = $winFrame;
	$tabWin{$tId}{currentTab} = undef;
	$tabWin{$tId}{lastId} = undef;
	$tabWin{$tId}{balloonMsg} = '?';
	$tabWin{$tId}{parent} = hex($winFrame->id);

	# ===
	$tabFrame->waitVisibility();
	# $tabFrame->packPropagate(0);
	# $tabFrame->configure(-height => 28, -width => $af->reqwidth());
	$tabFrame->configure(-width => $af->reqwidth());

	$winFrame->waitVisibility();
	my ($root, $parent, @kids) = $xServer->QueryTree($tabWin{$tId}{toplevelId});
	$tabWin{$tId}{selfId} = $parent;

	$tl->protocol('WM_DELETE_WINDOW', [\&closeTabber, $tId]);
	$tl->protocol('WM_TAKE_FOCUS', [\&takeFocus, $tId]);

	$xServer->ChangeWindowAttributes($tabWin{$tId}{parent},
		event_mask => $xServer->pack_event_mask('ResizeRedirect'));

	buggyFocusWorkaround($tId);
}

sub getWrapperWinId ($)
{
	my ($tId) = @_;
	return hex($tabWin{$tId}{toplevel}->frame());
}

sub buggyFocusWorkaround ($)
{
	my ($tId) = @_;

	if (exists $tabWin{$tId}{_wrapperWinId})
	{
		# don't want events on old window id anymore.
		$xServer->ChangeWindowAttributes($tabWin{$tId}{_wrapperWinId},
			event_mask => $xServer->pack_event_mask());
	}

	$tabWin{$tId}{_wrapperWinId} = getWrapperWinId($tId);
	# request events on new window id.
	$xServer->ChangeWindowAttributes($tabWin{$tId}{_wrapperWinId},
		event_mask => $xServer->pack_event_mask('EnterWindow'));
	$tabWin{$tId}{focusTimestamp} = 'CurrentTime';
}

sub takeFocus ($)
{
	my ($tId) = @_;

	$global{lastFocus} = $tId;
	my $winId;
	if ($tabWin{$tId}{toplevel}->state() eq 'iconic')
	{
		# TODO: who do we give the focus to?
		$winId = $tabWin{$tId}{toplevelId};
		return;
	}
	elsif (!defined $tabWin{$tId}{currentTab})
	{
		$winId = $tabWin{$tId}{toplevelId};
	}
	else
	{
		$winId = $tabWin{$tId}{tab}[$tabWin{$tId}{currentTab}]{winId};
	}

	my $ts = (isTrue($pConfig->{bBuggyFocus}) ?
			  'CurrentTime' :
			  $tabWin{$tId}{focusTimestamp});
	# "revert-to" (2nd) arg can be 'Parent', 'PointerRoot' or 'None'.
	$xServer->SetInputFocus($winId, 'Parent', $ts);
}

# Don't you just *love* Prince!?
sub letItGo ($$$$)
{
	my ($button, $tId, $tabNo, $bIconify) = @_;

	if ($fvwm->{debug} && $tabNo >= $tabWin{$tId}{nTabs})
	{
		$fvwm->debug("BUG: invalid tabNo.");
		return;
	}

	my $winId = $tabWin{$tId}{tab}[$tabNo]{winId};
	$global{ignoreSwallow}{$winId} = time();
	$xServer->ReparentWindow($winId, $xServer->root(), (0, 0));
	# position the window at the location we found it. (ie. before the
	# window was added to this tabber.)
	$xServer->ConfigureWindow($winId,
							  x => $tabWin{$tId}{tab}[$tabNo]{initialXPos},
							  y => $tabWin{$tId}{tab}[$tabNo]{initialYPos});
	$xServer->MapWindow($winId);
	XSync(); # wait for window to popup.

	# if the window we're releasing is a tabber, we need to recompute
	# the wrapper window id as it can change dynamically.
	my $otherTId = winIdToTId($winId);
	buggyFocusWorkaround($otherTId) if (defined $otherTId);

	$fvwm->send("Iconify", $winId) if ($bIconify);
	removeTab($tId, $tabNo, 'letgo');
}

sub letItGoClick ($$$$)
{
    my ($button, $tId, $winId, $bIconify) = @_;
	letItGo($button, $tId, getTabNo($tId, $winId), $bIconify);
}

# release all windows from <$tId> tabber.
sub releaseAll ($$$)
{
	my ($b, $tId, $bIconify) = @_;
	for (my $tabNo = $tabWin{$tId}{nTabs} - 1; $tabNo >= 0; $tabNo--)
	{
		letItGo(undef, $tId, $tabNo, $bIconify);
	}
	$tabWin{$tId}{tab} = undef;
	$tabWin{$tId}{nTabs} = 0;
	$tabWin{$tId}{currentTab} = undef;
}

sub releaseCurrent ($$)
{
	my ($b, $tId) = @_;

	return if (!defined $tabWin{$tId}{currentTab});
	letItGo($b, $tId, $tabWin{$tId}{currentTab}, 0);
}

sub closeTab ($$$)
{
	my ($b, $tId, $cmd) = @_;
	return if (!defined $tabWin{$tId}{currentTab});
	my $tabNo = $tabWin{$tId}{currentTab};
	# Ensure the window is mapped off-screen.
	$tabWin{$tId}{tab}[$tabNo]{initialXPos} = 2000;
	$tabWin{$tId}{tab}[$tabNo]{initialYPos} = 2000;
	my $winId = $tabWin{$tId}{tab}[$tabNo]{winId};
	releaseTab($tId, $tabNo, 0);
	# Give the window 1 second to be mapped, before closing it.
	$fvwm->send("Schedule 1000 WindowId $winId $cmd");
}

sub killTab ($$)
{
	my ($b, $tId) = @_;
	return if (!defined $tabWin{$tId}{currentTab});
	my $winId = $tabWin{$tId}{tab}[$tabWin{$tId}{currentTab}]{winId};
	$xServer->KillClient($winId);
}

sub XSync ()
{
	# atom() is cached by X11::Protocol so we need to issue
	# the actual X request.
	# $xServer->atom("WM_NAME");
	$xServer->req('InternAtom', "WM_NAME", 0);
}

sub closeTabber ($)
{
	my ($tId) = @_;

	$fvwm->debug("closeTabber($tId)");

	$xServer->ChangeWindowAttributes($tabWin{$tId}{parent},
		event_mask => $xServer->pack_event_mask());

	releaseAll(undef, $tId, 0);
	$tabWin{$tId}{toplevel}->withdraw();
	# We need to wait for the X server to do the reparenting before
	# we can destroy the window.
	XSync();

	# TODO: destroy() call intermittently causes problems.
	# $tabWin{$tId}{toplevel}->destroy();
	delete $tabWin{$tId};
}

sub winIdToTId ($)
{
	my ($winId) = @_;

	foreach my $tId (keys(%tabWin))
	{
		return $tId if ($winId == $tabWin{$tId}{selfId});
	}
	return undef;
}

# SendToModule commands arrive as M_STRING events.
$fvwm->add_handler(M_STRING, sub {
	my ($self, $event) = @_;

	$fvwm->debug("M_STRING: " . join(", ", map("$_ = " . $event->args->{$_}, keys(%{$event->args}))));

	# Older versions of Perl don't support 'xdigit'.
	# if ($event->args->{text} =~ /fn (\S+) (0x[[:xdigit:]]+)\s*(.*)/)
	if ($event->args->{text} =~ /fn (\S+) (0x[0-9a-fA-F]+)\s*(.*)/)
	{
		# fn <fnName> <winId> <optArgs>
		my $tId = winIdToTId(hex($2));
		print(STDERR $self->name() . ": focus not in tabber. ($2)\n"), return if (!defined $tId);
		no strict;
		&$1($tId, split(/\s+/, $3));
	}
	elsif ($event->args->{text} =~ /addme (\S+)(.*)?/)
	{
		my $bMulti = ($2 eq ' multi');
		my $tId = $1;
		$tId = winIdToTId(hex($tId)) if (!exists $tabWin{$tId});
		if (!defined $tId || !exists $tabWin{$tId})
		{
			print(STDERR $self->name() . ": Unknown Tabber \"$2\"\n");
			return;
		}
		addTab($tId, $event->args->{win_id});
		pickAndAdd($tId, 'multi') if ($bMulti);
	}
	else
	{
		# handle createNewTabber, saveState, enableDND & swallowNext.
		my @a = split(/\s+/, $event->args->{text});
		my $fn = shift(@a);
		if (!defined main->can($fn))
		{
			print(STDERR $self->name() . ": Unknown command: \"$fn(@a)\"\n");
			return;
		}
		no strict;
		&$fn(@a);
		$fvwm->debug("M_STRING: invoked command \"$fn\"");
	}
});

# showNext() - invoked from key binding.
sub showNext ($$)
{
	my ($tId, $inc) = @_;

	return if ($tabWin{$tId}{nTabs} <= 0);
	my $nextTabNo = ($tabWin{$tId}{currentTab} + $inc) % $tabWin{$tId}{nTabs};
	showTab($tId, $nextTabNo) if ($nextTabNo != $tabWin{$tId}{currentTab});
}

sub showLast ($)
{
	my ($tId) = @_;

	return if ($tabWin{$tId}{nTabs} <= 0 || !defined $tabWin{$tId}{lastId});
	my $tabNo = getTabNo($tId, $tabWin{$tId}{lastId});
	return if (!defined $tabNo);
	showTab($tId, $tabNo);
}

# releaseTab() - invoked from key binding.
sub releaseTab ($$$)
{
	my ($tId, $tabNo, $bIconify) = @_;
	$tabNo = $tabWin{$tId}{currentTab} if ($tabNo eq 'current');
	letItGo(undef, $tId, $tabNo, $bIconify);
}

sub emptiestTabber ()
{
	my $tId = undef;	# return undef if no tabbers running.
	my $n = 99;
	foreach (keys(%tabWin))
	{
		if ($tabWin{$_}{nTabs} < $n)
		{
			$tId = $_;
			$n = $tabWin{$_}{nTabs};
		}
	}
	return $tId;
}

sub whichTabber ($)
{
	my ($tId) = @_;

	if ($tId =~ /any/i)
	{
		# choose the emptiest tabber.
		return emptiestTabber();
	}
	elsif ($tId =~ /lastFocus/i)
	{
		return (defined $global{lastFocus} ?
			$global{lastFocus} :
			emptiestTabber());
	}
	return $tId;
}

# swallowCheck() - check if a window should be swallowed/tabized by a tabber.
sub swallowCheck ($$)
{
	my ($winId, $pArray) = @_;

	my $tId = $global{swallowNext};
	if (!defined $tId)
	{
		return if (ignoreWin($winId));
		my $s = chr(0);
		my $name = getProperty($winId, 'WM_NAME');
		return if (!defined $name);
		my ($resource, $class) = split(/$s/, getProperty($winId, 'WM_CLASS'));
		$resource = '' if (!defined $resource);
		$class = '' if (!defined $class);

		my $bFound = 0;
		foreach (@{$pArray})
		{
			if ((exists $_->{resource} && $resource =~ /$_->{resource}/) ||
				(exists $_->{class} && $class =~ /$_->{class}/) ||
				(exists $_->{name} && $name =~ /$_->{name}/))
			{
				$tId = $_->{type};
				$bFound = 1;
				last;
			}
		}
		return if (!$bFound);
	}
	elsif (exists $tabWin{$tId})
	{
		$tabWin{$tId}{addButton}->configure(-text => "A",
			-image => createImage($pConfig->{addIcon}));
	}
	$tId = whichTabber($tId);
	addTab($tId, $winId) if (defined $tId && exists $tabWin{$tId});
	delete $global{swallowNext};
}

sub swallowNext
{
	my ($tId, @fvwmCommand) = @_;
	$tId = $global{swallowNext} = whichTabber($tId);
	$fvwm->debug("Got swallowNext: $global{swallowNext}");
	$fvwm->debug("fvwmCommand is @fvwmCommand");
	if (exists $tabWin{$tId})
	{
		$tabWin{$tId}{addButton}->configure(-text => "",
			-image => createImage($pConfig->{swallowIcon}));
	}
	$fvwm->send("@fvwmCommand");
}

sub swallowNextClick ($$) { swallowNext($_[1], ''); }

$fvwm->add_handler(M_ADD_WINDOW, sub {
	my ($self, $event) = @_;

	$fvwm->debug("Add Window: " . join(", ", map("$_ = " . $event->args->{$_}, keys(%{$event->args}))));
	my $winId = $event->args->{win_id};

	swallowCheck($winId, \@autoSwallow);
});


# ON_EXIT handler is invoked just before this module terminates.
$fvwm->add_handler(ON_EXIT, sub {
	my ($self, $event) = @_;
	print($fvwm->name() . ": Got ON_EXIT event.\n");
	cleanup();
});

$SIG{PIPE} = sub {
	print($fvwm->name() . ": SIGPIPE!\n");
	cleanup();
	exit;
};

sub cleanup ()
{
	foreach (keys(%tabWin))
	{
		closeTabber($_);
	}
}

my $fds = IO::Select->new($xServer->connection->fh);

sub callback
{
	$xServer->flush();
 	$xServer->handle_input() if ($fds->can_read(0));

	while (my %e = $xServer->dequeue_event())
	{
		eventHandler(%e)
	}
}

sub eventHandler
{
	my (%event) = @_;

	$fvwm->debug("Got a $event{name} event: " . join(", ", map("$_ = $event{$_}", keys(%event))));


	if ($event{name} eq 'ResizeRequest')
	{
		my $tId;
		for (keys(%tabWin))
		{
			$tId = $_, last if ($tabWin{$_}{parent} == $event{window});
		}

		return if (!defined $tId);

		my $h = $tabWin{$tId}{winFrame}->height();
		# resize the $winFrame widget. Can't use $w->configure(-height ...)
		# cos we're requesting resize events on this widget.
		$xServer->ConfigureWindow($tabWin{$tId}{parent},
								  "height" => $h, #$event{height},
								  "width" => $event{width});

		if ($tabWin{$tId}{autoResize})
		{
			resizeAll($tId, $event{width}, $h); # $event{height}
		}
		else
		{
			# If the tabber is resized, resize the currently viewed app/tab
			# (if any) to fit into the new space.
			return if (!defined $tabWin{$tId}{currentTab});
			my $winId = $tabWin{$tId}{tab}[$tabWin{$tId}{currentTab}]{winId};

			$xServer->ConfigureWindow($winId,
									  "height" => $h, # $event{height},
									  "width" => $event{width});
		}
		XSync();
		return;
	}
	elsif ($event{name} eq 'EnterNotify')
	{
		my $tId;
		for (keys(%tabWin))
		{
			$tId = $_, last if (getWrapperWinId($_) == $event{event});
		}

		return if (!defined $tId);
		$tabWin{$tId}{focusTimestamp} = $event{time};
		$fvwm->debug("focusTimestamp set to $tabWin{$tId}{focusTimestamp}");
		takeFocus($tId);
		return;
	}

	my ($tId, $tabNo) = findWin($event{window});
	if (!defined $tId)
	{
		$fvwm->debug("Ignoring event for invalid/unknown window.");
		return;
	}

	if ($event{name} eq 'PropertyNotify')
	{
		my $prop = $xServer->atom_name($event{atom});
		return if ($prop ne 'WM_NAME' && $prop ne 'WM_ICON_NAME');
		my $val = getProperty($event{window}, $prop);
		return if (!defined $val);	# window no longer exists!
		if ($prop eq 'WM_NAME')
		{
			setTabTitle($tId, $tabNo, $val);
		}
		elsif ($prop eq 'WM_ICON_NAME')
		{
			setTabName($tId, $tabNo, $val);
		}
	}
	elsif ($event{name} eq 'DestroyNotify')
	{
		removeTab($tId, $tabNo, 'destroyed');
	}
	elsif ($event{name} eq 'MapNotify')
	{
		$xServer->SetInputFocus($event{window}, 'Parent', 'CurrentTime');
	}
	else
	{
		$fvwm->debug("Got a strange event: $event{name}");
	}
}

sub getXYPos ($)
{
	my ($winId) = @_;

	my ($na1, $na2, $x, $y) = $xServer->TranslateCoordinates($winId,
                                                             $xServer->root(),
                                                             0,
                                                             0);
	return ($x, $y);
}

sub createImage ($)
{
	my ($filename) = @_;

	if (defined $global{imageCache}{$filename})
	{
		return $global{imageCache}{$filename};
	}
	my $orig = $filename;
	if (substr($filename, 0, 1) ne '/')
	{
		my $bFound = 0;
		foreach (split(/:/, $pConfig->{global}->{ImagePath}))
		{
			my $tmp = "$_/$filename";
			$filename = $tmp, $bFound = 1, last if (-f $tmp);
		}
		return '' if (!$bFound);
	}
	print(STDERR $fvwm->name() . ": Creating icon from $filename\n");
	my $img = eval { $TOP->Photo(-file => $filename); };
	return '' if (!defined $img);
	$global{imageCache}{$orig} = $img;
	return $img;
}

sub createMiniIcon ($$)
{
	my ($iconName, $winId) = @_;

	return createImage($iconName) if ($iconName ne 'ewmh_mini_icon');

	my ($val, $type, $format, $bytes_after) =
		$xServer->GetProperty($winId,
							  $xServer->atom("_NET_WM_ICON"),
							  'AnyPropertyType',
							  0,
							  8192,
							  0);

	my $w = unpack("L", substr($val, 0, 4));
	my $h = unpack("L", substr($val, 4, 4));

	my $img = $TOP->Photo(-width => $w, -height => $h);
	my $index = 8;
	for my $y (0 .. $h - 1)
	{
		for my $x (0 .. $w - 1)
		{
			my $pixel = unpack("L", substr($val, $index, 4));
			$index += 4;

			my $alpha = ($pixel >> 24) & 0xff;
			next if ($alpha == 0);
			my $blue = $pixel & 0xff;
			my $green = ($pixel >> 8) & 0xff;
			my $red = ($pixel >> 16) & 0xff;

			my $color = sprintf("#%02x%02x%02x", $red, $green, $blue);
			$img->put($color, -to => ($x, $y, $x+1, $y+1));
		}
	}
	# TODO: image resizing quality is crap, but at least it works for now.
	my $img2 = $TOP->Photo();
	my ($xFactor, $yFactor) = ($w / 16, $h / 16);
	$img2->copy($img, -subsample => ($xFactor, $yFactor));
	return $img2;
}

my $dndIcon;
if ($pConfig->{dragDropIcon} ne 'none')
{
	$dndIcon = createImage($pConfig->{dragDropIcon});
	if ($dndIcon eq '')
	{
		print(STDERR $fvwm->name() . ": Couldn't create D&D icon from " .
			$pConfig->{dragDropIcon} . "\n");
	}
}

sub addTab ($$)
{
	my ($tId, $winId) = @_;

	if (defined $tabWin{$tId}{selfId} && $winId == $tabWin{$tId}{selfId})
	{
		# can't make tabber a child of itself
		$fvwm->send("Beep");
		$fvwm->show_error("Can't add self to tabber!");
		return;
	}

	# check if the window actually exists before we try to swallow it.
	if (!defined getProperty($winId, 'WM_NAME'))
	{
		print(STDERR $fvwm->name() . ": Window ($winId) doesn't exist.\n");
		return;
	}

	my $tabNo = $tabWin{$tId}{nTabs}++;
	$tabWin{$tId}{tab}[$tabNo]{winId} = $winId;

	# save position of window for later.
	($tabWin{$tId}{tab}[$tabNo]{initialXPos}, $tabWin{$tId}{tab}[$tabNo]{initialYPos}) = getXYPos($winId);

	# if the auto-resize option is specified & the new window to add is
	# smaller than the tabber, then we need to enlarge the new window. If
	# the new window is larger than the tabber, then the tabber will
	# expand appropriately (with all existing windows in the tabber) on
	# the resize event.
	if ($tabWin{$tId}{autoResize})
	{
		my %g = $xServer->GetGeometry($winId);
		my $h = $tabWin{$tId}{winFrame}->height();
		my $w = $tabWin{$tId}{winFrame}->width();
		if ($g{height} < $h || $g{width} < $w)
		{
			$xServer->ConfigureWindow($winId,
									  "height" => max($h, $g{height}),
									  "width" => max($w, $g{width}));
		}
	}

	$xServer->ReparentWindow($winId, $tabWin{$tId}{parent}, (0, 0));

	my $name = getProperty($winId, "WM_NAME");
	$tabWin{$tId}{tab}[$tabNo]{title} = $name;
	my $iconName = getProperty($winId, "WM_ICON_NAME");
	$iconName = $name if ($iconName eq '');

	# -borderwidth => 0 also gets rid of 2x2=4 pixels in height, but
	# will not be able to display relief of button.
	$tabWin{$tId}{tab}[$tabNo]{button} =
		$tabWin{$tId}{tabFrame}->Button(-text => $iconName,
										-padx => 2,
										-pady => $pConfig->{buttonYPadding},
										-width => 1,
										-anchor => 'w',
										-compound => 'left',
										-command => [\&showTabClick, $tId, $winId],
										-font => $pConfig->{buttonFont});
	my $pButton = $tabWin{$tId}{tab}[$tabNo]{button};

	if (defined $winTracker &&
		defined $winTracker->data($winId) &&
		isTrue($pConfig->{useIconsOnTabs}) &&
		defined $winTracker->data($winId)->{mini_icon_name})
	{
		my $icon = createMiniIcon($winTracker->data($winId)->{mini_icon_name}, $winId);
		$pButton->configure(-image => $icon);
	}

	# Raise the FvwmTabs window whenever a tab is selected.
	$pButton->Tk::bind('<ButtonPress-1>', sub { $fvwm->send("Current Raise"); });
	$pButton->pack(-side => 'left', -expand => 1, -fill => 'x');
	$pButton->Tk::bind('<ButtonRelease-2>', [\&letItGoClick, $tId, $winId, 0]);
	$pButton->Tk::bind('<ButtonRelease-3>', [\&letItGoClick, $tId, $winId, 1]);

	# drag-&-drop to reorder tabs.
	my $dd = $pButton->DragDrop(-event => '<Control-B2-Motion>',
								-sitetypes => [qw(Local)],
								-selection => $winId,
								-cursor => 'sb_h_double_arrow',
								-text => '*',
								-handlers => []);
	my $site =
	$pButton->DropSite(-droptypes => [qw(Local)],
					   -dropcommand => [\&reorderTabClick, [$tId, $winId]]);
	if ($pConfig->{dragDropIcon} ne 'none' && defined $dndIcon)
	{
		$dd->configure(-image => $dndIcon);
	}

	$balloon->attach($pButton,
					 -balloonmsg => \$tabWin{$tId}{balloonMsg},
					 -postcommand => [\&setBalloonMsg, $tId, $winId]);

	# Ensure we are notified of any attribute changes in the new window.
	# PropertyChange will tell us when WM_NAME or WM_ICON_NAME changes.
	# StructureNotify will tell us when a program running in a tab
	# terminates/is-destroyed.
	$xServer->ChangeWindowAttributes($winId,
			  event_mask => $xServer->pack_event_mask('PropertyChange',
			  										  'StructureNotify'));
	showTab($tId, $tabNo);
}

sub pickAndAdd ($$)
{
	my ($tId, $arg) = @_;
	$fvwm->send("Pick SendToModule " . $fvwm->name() . " addme $tId $arg");
}

# sub pickAndAddClick ($$$) { pickAndAdd(@_[1..$#_]); }
sub pickAndAddClick ($$$)
{
	my ($b, $tId, $arg) = @_;
	pickAndAdd($tId, $arg);
}

sub tabInfo ($$)
{
	my ($button, $tId) = @_;

	print("\nnTabs=$tabWin{$tId}{nTabs}\n");
	printf("parent=0x%x (%d)\n", $tabWin{$tId}{parent}, $tabWin{$tId}{parent});
	printf("self=0x%x (%d)\n", $tabWin{$tId}{selfId}, $tabWin{$tId}{selfId});
	for (my $tabNo = 0; $tabNo < $tabWin{$tId}{nTabs}; $tabNo++)
	{
		printf("Tab #$tabNo winId = 0x%x (%d)\n",
			   $tabWin{$tId}{tab}[$tabNo]{winId},
			   $tabWin{$tId}{tab}[$tabNo]{winId});
	}
	print("AutoSwallow:\n");
	foreach my $a (@autoSwallow)
	{
		print("\t" . join(", ", map("$_=" . $a->{$_}, sort(keys(%{$a})))) . "\n");
	}

	XSync();
}

sub getProperty ($$)
{
	my ($winId, $property) = @_;

	my @s = $xServer->robust_req('GetProperty',
								 $winId,
								 $xServer->atom($property),
								 'AnyPropertyType', 0, 200, 0);
	my $p = $s[0];
	return undef if ($p eq 'Window');
	# Remove font encoding details (if any).
	my ($startM, $endM) = (chr(27), chr(2));
	$p->[0] =~ s/$startM.*?$endM//g;
	return $p->[0];
}

# find which tabber/tab a window is in (if any).
sub findWin ($)
{
	my ($winId) = @_;

	foreach (keys(%tabWin))
	{
		my $tabNo = getTabNo($_, $winId);
		return ($_, $tabNo) if (defined $tabNo);
	}
	return undef;
}


# return the tabNo for the specified window ID or undef if the window is
# not part of the tabber.
# TODO: rename this function to "winIdToTabNo"?
sub getTabNo ($$)
{
	my ($tId, $winId) = @_;
	for (my $tabNo = 0; $tabNo < $tabWin{$tId}{nTabs}; $tabNo++)
	{
		return $tabNo if ($tabWin{$tId}{tab}[$tabNo]{winId} == $winId);
	}
	return undef;
}

# the window for <$tabNo> has been destroyed/letgo - cleanup appropriately.
sub removeTab ($$$)
{
	my ($tId, $tabNo, $state) = @_;

	$fvwm->debug("removeTab($tId, $tabNo, $state)");

	if ($state eq 'letgo')
	{
		# We are no longer interested in events for this window.
		$xServer->ChangeWindowAttributes($tabWin{$tId}{tab}[$tabNo]{winId},
			  event_mask => $xServer->pack_event_mask());
	}

	$balloon->detach($tabWin{$tId}{tab}[$tabNo]{button});
	$tabWin{$tId}{tab}[$tabNo]{button}->destroy();
	$tabWin{$tId}{tab}[$tabNo] = undef;

	for (my $t = $tabNo; $t < $tabWin{$tId}{nTabs} - 1; $t++)
	{
		$tabWin{$tId}{tab}[$t] = $tabWin{$tId}{tab}[$t + 1];
	}
	$tabWin{$tId}{nTabs}--;
	$tabWin{$tId}{tab}[$tabWin{$tId}{nTabs}] = undef;

	if ($tabWin{$tId}{currentTab} == $tabNo)
	{
		$tabWin{$tId}{currentTab} = undef;
		if ($tabWin{$tId}{nTabs} > 0)
		{
			showTab($tId, ($tabNo < $tabWin{$tId}{nTabs} ? $tabNo : $tabNo - 1))
		}
		else
		{
			$tabWin{$tId}{toplevel}->wm('grid', '', '', '', '');
			$tabWin{$tId}{titleFrame}->configure(-text => 'No title');
			$tabWin{$tId}{winFrame}->configure(-height => 1, -width => 0);
		}
	}
	else
	{
		$tabWin{$tId}{currentTab}-- if ($tabWin{$tId}{currentTab} > $tabNo);
		if ($tabWin{$tId}{nTabs} == 1)
		{
			# allow the selected tab button to expand as much as possible.
			$tabWin{$tId}{tab}[$tabWin{$tId}{currentTab}]{button}->pack(-expand => 1);
		}
	}
}

sub showTab ($$)
{
	my ($tId, $tabNo) = @_;

	$fvwm->send("Beep"), return if ($tabNo >= $tabWin{$tId}{nTabs});

	# Unmap the current tab.
	if (defined($tabWin{$tId}{currentTab}))
	{
		my $currentTab = $tabWin{$tId}{currentTab};
		return if ($tabNo == $currentTab);
		my $winId = $tabWin{$tId}{tab}[$currentTab]{winId};
		$xServer->UnmapWindow($winId);
		my $b = $tabWin{$tId}{tab}[$currentTab]{button};
		setButtonAttr($b, 'bg', 'inactiveBG');
		setButtonAttr($b, 'activebackground', 'inactiveBG');
		setButtonAttr($b, 'fg', 'inactiveFG');
		setButtonAttr($b, 'activeforeground', 'inactiveFG');
		$tabWin{$tId}{tab}[$currentTab]{button}->configure(
					-width => 1,
					-relief => $pConfig->{inactiveRelief});
		$tabWin{$tId}{tab}[$currentTab]{button}->pack(-expand => 1);
		$tabWin{$tId}{lastId} = $winId;
	}
	# Map the new tab.
	my $winId = $tabWin{$tId}{tab}[$tabNo]{winId};
	$xServer->MapWindow($winId);
	$tabWin{$tId}{currentTab} = $tabNo;
	my $bEq = isTrue($pConfig->{fixedSizeTabs});
	my $b = $tabWin{$tId}{tab}[$tabNo]{button};
	setButtonAttr($b, 'bg', 'activeBG');
	setButtonAttr($b, 'activebackground', 'activeBG');
	setButtonAttr($b, 'fg', 'activeFG');
	setButtonAttr($b, 'activeforeground', 'activeFG');
	$tabWin{$tId}{tab}[$tabNo]{button}->configure(
					-width => $bEq,
					-relief => $pConfig->{activeRelief});
	my $bExpand = ($bEq || ($tabWin{$tId}{nTabs} == 1));
	$tabWin{$tId}{tab}[$tabNo]{button}->pack(-expand => $bExpand);

	my %g = $xServer->GetGeometry($winId);
	$tabWin{$tId}{winFrame}->configure(-height => $g{height}, -width => $g{width});
	$tabWin{$tId}{toplevel}->geometry("");
	showTitle($tId, $tabNo, $g{width});
	setResizing ($tId, $winId);
	# If we're changing the active tab really quickly we have to handle/flush
	# all the X events in the queue - this prevents us from getting a
	# 'Protocol Error'.
	callback();
}

sub showTabClick ($$)
{
	my ($tId, $winId) = @_;
	showTab($tId, getTabNo($tId, $winId));
}

sub setMainTitlebar ($$)
{
	my ($tId, $titleStr) = @_;

	my $title = $fvwm->name() . " [$tId]";
	$title .= " : $titleStr" if ($titleStr ne '');
	$tabWin{$tId}{toplevel}->configure(-title => $title);
}

sub setupMainTitlebar ($$)
{
	my ($tId, $bOn) = @_;

	my $titleStr = '';
	if ($bOn && defined $tabWin{$tId}{currentTab})
	{
		$titleStr = $tabWin{$tId}{tab}[$tabWin{$tId}{currentTab}]{title};
	}
	setMainTitlebar($tId, $titleStr);
}

sub toggleMainTitlebar ($)
{
	setupMainTitlebar($_[0], $tabWin{$_[0]}{useTMTitlebar});
}

sub showTitle ($$$)
{
	my ($tId, $tabNo, $w) = @_;

	$fvwm->debug("BUG: showTitle()") if ($tabNo != $tabWin{$tId}{currentTab});
	# This is a nice feature - Wrap the title text across multiple lines.
	# The following command in an xterm window illustrates the usefulness:
	# echo "to be?\nor\nnot to be?" && sleep 3

	$w -= 30;

	my $titleStr = $tabWin{$tId}{tab}[$tabNo]{title};
	# make sure the title text does not exceed this length.
	$tabWin{$tId}{titleFrame}->configure(-text => $titleStr,
										 -wraplength => $w);

	setMainTitlebar($tId, $titleStr) if ($tabWin{$tId}{useTMTitlebar});
}

sub setTabTitle($$$)
{
	my ($tId, $tabNo, $titleStr) = @_;

	$titleStr =~ s/\n//g;
	$tabWin{$tId}{tab}[$tabNo]{title} = $titleStr;
	if ($tabNo == $tabWin{$tId}{currentTab})
	{
		# get the width of the title label in pixels.
		my $w = $tabWin{$tId}{titleFrame}->width();
		showTitle($tId, $tabNo, $w);
	}
}

sub showTitlebar ($)
{
	my ($tId) = @_;

	if ($tabWin{$tId}{showTitlebar})
	{
		$tabWin{$tId}{titleFrame}->pack(-expand => 0, -fill => 'x', -side => 'top');
	}
	else
	{
		$tabWin{$tId}{titleFrame}->pack('forget');
		$tabWin{$tId}{wrapFrame}->configure(-width => 0, -height => 1);
	}
}

sub setTabName ($$$)
{
	my ($tId, $tabNo, $name) = @_;

	$tabWin{$tId}{tab}[$tabNo]{button}->configure(-text => $name);
}

sub selectFont ($$)
{
	my ($tId, $type) = @_;
	my $cmd = $pConfig->{fontSelector};
	my $currentFont = $pConfig->{$type . 'Font'};
	$cmd =~ s/%f/$currentFont/g;
	$SIG{CHLD}= sub { wait; };
	my $pipe = new FileHandle();
	if (!$pipe->open("$cmd|"))
	{
		$fvwm->show_error("Select font: command $cmd failed.");
		return
	}

	sub fontCallback ($$$)
	{
		my ($pipe, $tId, $type) = @_;
		my $line = $pipe->getline();
		setFont($tId, $type, $line) if (defined($line));
		$pipe->close() if ($pipe->eof());
	}

	$TOP->fileevent($pipe, "readable" => [\&fontCallback, $pipe, $tId, $type]);
}

sub setFont ($$$)
{
	my ($tId, $type, $font) = @_;
	$fvwm->debug("new $type font is: $font");
	$pConfig->{$type . 'Font'} = $font;
	if ($type eq 'button')
	{
		for (my $tabNo = 0; $tabNo < $tabWin{$tId}{nTabs}; $tabNo++)
		{
			$tabWin{$tId}{tab}[$tabNo]{button}->configure(-font => $font);
		}
	}
	elsif ($type eq 'title')
	{
		$tabWin{$tId}{titleFrame}->configure(-font => $font);
	}
	elsif ($type eq 'menu')
	{
		$tabWin{$tId}{menu}->configure(-font => $font);
	}
}

sub about ($)
{
	my ($tId) = @_;

	my $info = $fvwm->name() . "\n\nby Scott Smedley\nss\@aao.gov.au";
	$fvwm->show_message($info, "About " . $fvwm->name());
}

sub setBalloonMsg ($$)
{
	my ($tId, $winId) = @_;

	my $tabNo = getTabNo($tId, $winId);

	my $msg = $pConfig->{balloonMsg};
	$msg =~ s/\\n/\n/g;
	$msg =~ s/%tabNo/$tabNo/gi;
	my $iconText = $tabWin{$tId}{tab}[$tabNo]{button}->cget(-text);
	$msg =~ s/%iconText/$iconText/gi;
	$msg =~ s/%title/$tabWin{$tId}{tab}[$tabNo]{title}/gi;
	$tabWin{$tId}{balloonMsg} = $msg;
}

sub reorderTab ($$$)
{
	my ($tId, $insertionPoint, $tabNo) = @_;

	return if ($insertionPoint == $tabNo || $insertionPoint == $tabNo + 1);

	my ($s, $e) = ($insertionPoint > $tabNo ?
				   ($tabNo, $insertionPoint) :
				   ($insertionPoint, $tabNo));

	for (my $i = $s; $i < $tabWin{$tId}{nTabs}; $i++)
	{
		$tabWin{$tId}{tab}[$i]{button}->pack('forget');
	}

	my $currentWinId = $tabWin{$tId}{tab}[$tabWin{$tId}{currentTab}]{winId};

	my $mover = $tabWin{$tId}{tab}[$tabNo];
	if ($insertionPoint > $tabNo)
	{
		for (my $i = $s; $i < $e - 1; $i++)
		{
			$tabWin{$tId}{tab}[$i] = $tabWin{$tId}{tab}[$i+1];
		}
		$tabWin{$tId}{tab}[$e-1] = $mover;
	}
	else
	{
		for (my $i = $e; $i > $s; $i--)
		{
			$tabWin{$tId}{tab}[$i] = $tabWin{$tId}{tab}[$i-1];
		}
		$tabWin{$tId}{tab}[$insertionPoint] = $mover;
	}
	$tabWin{$tId}{currentTab} = getTabNo($tId, $currentWinId);

	for (my $i = $s; $i < $tabWin{$tId}{nTabs}; $i++)
	{
		my $bExpand = 1;
		if ($i == $tabWin{$tId}{currentTab})
		{
			my $bEq = isTrue($pConfig->{fixedSizeTabs});
			$bExpand = (isTrue($pConfig->{fixedSizeTabs}) ||
						($tabWin{$tId}{nTabs} == 1) ? 1 : 0);
		}
		$tabWin{$tId}{tab}[$i]{button}->pack(-expand => $bExpand, -fill => 'x', -side => 'left');
	}
}

sub reorderTabClick ($$$)
{
	my ($pa, $winId, $notUsed) = @_;

	my ($tId, $insertionPoint) = @$pa;
	reorderTab($tId, getTabNo($tId, $insertionPoint), getTabNo($tId, $winId));
}

sub swapRight ($)
{
	my ($tId) = @_;

	return if ($tabWin{$tId}{nTabs} <= 0);
	if ($tabWin{$tId}{currentTab} == $tabWin{$tId}{nTabs} - 2)
	{
		reorderTab($tId, $tabWin{$tId}{currentTab}, $tabWin{$tId}{currentTab}+1);
	}
	else
	{
		my $inc = ($tabWin{$tId}{currentTab} == ($tabWin{$tId}{nTabs} - 1) ? 1 : 2);
		reorderTab($tId,
				   ($tabWin{$tId}{currentTab} + $inc) % $tabWin{$tId}{nTabs},
				   $tabWin{$tId}{currentTab});
	}
}

sub swapLeft ($)
{
	my ($tId) = @_;

	return if ($tabWin{$tId}{nTabs} <= 0);
	my $b = ($tabWin{$tId}{currentTab} == 0 ? 1 : 0);
	reorderTab($tId,
			   ($tabWin{$tId}{currentTab} - 1) % $tabWin{$tId}{nTabs},
			   $tabWin{$tId}{currentTab});
	swapRight($tId) if ($b);
}

sub saveState ()
{
	my $file = $pConfig->{stateFile};
	if (!open(OUT, ">$file"))
	{
		print(STDERR $fvwm->name() . ": Couldn't save state to $file.\n");
		return;
	}
	chmod(0600, $file);
	print(STDERR $fvwm->name() . ": Saving state to $file\n");
	foreach my $tId (sort(keys(%tabWin)))
	{
		print(OUT "createNewTabber($tId);\n");
		my ($x, $y) = getXYPos(getWrapperWinId($tId));
		print(OUT "\$fvwm->send(\"Move ${x}p ${y}p\", \$tabWin{$tId}{selfId});\n");
		my $desk = $winTracker->data($tabWin{$tId}{selfId})->{desk};
		print(OUT "\$fvwm->send(\"MoveToDesk 0 $desk\", \$tabWin{$tId}{selfId});\n");
		for (my $tabNo = 0; $tabNo < $tabWin{$tId}{nTabs}; $tabNo++)
		{
			print(OUT "addTab($tId, $tabWin{$tId}{tab}[$tabNo]{winId});\n");
		}
		if ($tabWin{$tId}{nTabs} > 0)
		{
			print(OUT "showTab($tId, $tabWin{$tId}{currentTab});\n");
		}
		if ($tabWin{$tId}{toplevel}->state() eq 'iconic')
		{
			print(OUT "\$fvwm->send(\"Iconify\", \$tabWin{$tId}{selfId});\n");
		}
	}
	close(OUT);
}

sub loadState ()
{
	my $file = $pConfig->{stateFile};
	if (-r $file)
	{
		print(STDERR $fvwm->name() . ": Reading state from $file\n");
		eval `cat $file`;
		print(STDERR $fvwm->name() . ": Error parsing $file\n") if ($@);
		unlink($file);
	}
}

# ======= ======= =======

sub createThingy ($$$;@)
{
	my ($w, $label, $var, @po) = @_;

	my $f = $w->Frame()->pack(@po, -expand => 0, -fill => 'x');
	$f->Label(-text => $label)->pack(-side => 'left', -anchor => 'w');
	my $lb = $f->BrowseEntry(-listwidth => 20,
							 -state => 'readonly',
							 -variable => $var,
							 -width => 3);
	$lb->Subwidget('entry')->Subwidget('entry')->configure(-bg => 'white');
	$lb->Subwidget('slistbox')->configure(-bg => 'white', -height => 4);
	$lb->Subwidget('choices')->configure(-bg => 'yellow');
	return $lb;
}

sub createSwallowDialog ($)
{
	my ($main) = @_;

	$global{tabberId} = $global{deskNo} = $global{pageNo} = 'Any';
	my @pad = qw/-padx 3 -pady 3/;
	my $name = $fvwm->name . ": Tabizer";
	my $tl = $main->Toplevel(-title => $name);
	my $top = $tl->Frame()->pack(-expand => 1, -fill => 'both', @pad);
	$tl->iconname($name);
	$tl->protocol('WM_DELETE_WINDOW', [$tl, 'destroy']);

	$global{eTabberId} = createThingy($top,
									  'Add to Tab-Manager no.:',
									  \$global{tabberId},
									  @pad);
	$global{eTabberId}->pack(-side => 'left', -anchor => 'w', @pad);

	my $lf = $top->LabFrame(-label => 'Swallow Matching Windows',
							-labelside => 'acrosstop');
	$lf->pack(-expand => 0, -fill => 'both', @pad);
	$global{regex} = $lf->LabEntry(-label => 'regex:',
								   -bg => 'white',
								   -labelPack => [qw/-side left/]);
	$global{regex}->pack(-fill => 'x', @pad);

	$global{regexType} = 'Name';
	my $f = $lf->Frame()->pack();
	foreach ('Name', 'Class', 'Resource')
	{
		$f->Radiobutton(-text => $_,
						-value => $_,
						-variable => \$global{regexType})->pack(-side => 'left');
	}

	$f = $lf->Frame()->pack(-expand => 0, -fill => 'x');
	$global{eDeskNo} = createThingy($f, 'Desk:',
									\$global{deskNo},
									-side => 'left', @pad)->pack(@pad);
	$global{ePageNo} = createThingy($f, 'Page:',
									\$global{pageNo},
									-side => 'left', @pad)->pack(@pad);
	$lf->Button(-text => 'Add Matching',
				-activeforeground => 'LimeGreen',
				-command => \&doRegexSwallow)->pack(-fill => 'x', @pad);

	$lf = $top->LabFrame(-label => 'Swallow Individual Windows',
						 -labelside => 'acrosstop');
	$lf->pack(-expand => 1, -fill => 'both', @pad);

	$global{list} = $lf->Scrolled('Listbox',
								  -width => 40,
								  -height => 10,
								  -setgrid => 1,
								  -bg => 'white',
								  -selectmode => 'extended',
								  -selectbackground => 'darkblue',
								  -selectforeground => 'white',
								  -scrollbars => 'osoe');
	$global{list}->pack(-expand => 1, -fill => 'both', -padx => 2, -pady => 2);
	my @po = qw/-side left -expand 1 -fill x/;
	$lf->Button(-text => 'Add Selected',
				-activeforeground => 'LimeGreen',
				-command => \&doSwallow)->pack(@po, @pad);
	$lf->Button(-text => 'Refresh List',
				-activeforeground => 'orange',
				-command => \&fillDialog)->pack(@po, @pad);
	$top->Button(-text => 'Close',
				 -activeforeground => 'red',
				 -command => [$tl, 'destroy'])->pack(@po, @pad);
	# $tl->resizable(0, 0);
}

sub doSwallow ()
{
	my $tId = $global{tabberId};
	$tId = emptiestTabber() if ($global{tabberId} eq 'Any');
	return if (!defined $tId);
	foreach ($global{list}->curselection())
	{
		addTab($tId, $global{windows}[$_]);
	}
	fillDialog();
}

sub doRegexSwallow ()
{
	my $regex = $global{regex}->get();
	if ($regex ne '')
	{
		$regex =~ s|/|\/|g;
		my $deskNo = $global{deskNo};
		my $pageNo = $global{pageNo};
		my %p = (lc($global{regexType}) => $regex, type => $global{tabberId});
		my @a;
		push(@a, \%p);
		foreach my $window ($winTracker->windows)
		{
			next if ($deskNo ne 'Any' &&
					 $window->{desk} != $deskNo);
			next if ($pageNo ne 'Any' &&
					 $window->{page_nx} != $pageNo);

			swallowCheck($window->{win_id}, \@a);
		}
	}
	fillDialog();
}

sub tabizeWindows ($)
{
	my ($tId) = @_;

	createSwallowDialog($TOP);
	$global{eTabberId}->configure(-choices => ['Any', sort(keys(%tabWin))]);
	$global{tabberId} = $tId;
	fillDialog();
}

sub max ($$) { return ($_[0] > $_[1] ? $_[0] : $_[1]); }
sub min ($$) { return ($_[0] < $_[1] ? $_[0] : $_[1]); }

sub fillDialog ()
{
	$global{pageWidth} = $winTracker->pageInfo('vp_width');
	$global{pageHeight} = $winTracker->pageInfo('vp_height');
	$global{nPagesPerDesk} = $winTracker->pageInfo('desk_pages_x');
	$global{maxDesk} = 3; # TODO

	my $nPages = $global{nPagesPerDesk} - 1;
	$global{eDeskNo}->configure(-choices => ['Any', 0 .. $global{maxDesk}]);
	$global{ePageNo}->configure(-choices => ['Any', 0 .. $nPages]);

	$global{list}->delete('0.0', 'end');
	@{$global{windows}} = ();
	foreach my $window ($winTracker->windows)
	{
		$global{list}->insert('end', $window->{name});
		push(@{$global{windows}}, $window->{win_id});
	}
}

# ======= ======= =======

sub setResizing ($$)
{
	my ($tId, $winId) = @_;

	my @s = $xServer->GetProperty($winId,
								  $xServer->atom('WM_NORMAL_HINTS'),
								  'AnyPropertyType', 0, 200, 0);

	my ($flags) = unpack("L", $s[0]);
	my ($wInc, $hInc, $baseW, $baseH) = (1, 1, 0, 0);
	if ($flags & (1 << 6)) # PResizeInc
	{
		# $wInc & $hInc specify multiples of pixels to increment by.
		($wInc, $hInc) = unpack("II", substr($s[0], 36, 8));
		# $baseW & $baseH are number of pixels in window that aren't
		# part of the resizable area. But note that this is completely
		# different to the $baseW & $baseH we need to input to wmGrid().
		($baseW, $baseH) = unpack("II", substr($s[0], 60, 8));
	}

	my %g = $xServer->GetGeometry($winId);
	# $baseW & $baseH are number of grid units of *resizable* part of window.
	$baseW = ($g{width} - $baseW) / $wInc;
	$baseH = ($g{height} - $baseH) / $hInc;

	# In pre-804.025 versions of Tk there is a bug in wmGrid().
	# $tabWin{$tId}{toplevel}->wmGrid($baseW, $baseH, $wInc, $hInc);
	$tabWin{$tId}{toplevel}->wm('grid', $baseW, $baseH, $wInc, $hInc);
}

sub enableDND ($)
{
	foreach my $tId (keys(%tabWin))
	{
		$tabWin{$tId}{enableSwallowDND} = $_[0];
	}
}

sub resizeAll ($$$)
{
	my ($tId, $w, $h) = @_;
	for (my $tabNo = 0; $tabNo < $tabWin{$tId}{nTabs}; $tabNo++)
	{
		$xServer->ConfigureWindow($tabWin{$tId}{tab}[$tabNo]{winId},
								  "height" => $h,
								  "width" => $w);
	}
}

sub doResize ($)
{
	my ($tId) = @_;
	return if (!defined $tabWin{$tId}{currentTab});
	my $winId = $tabWin{$tId}{tab}[$tabWin{$tId}{currentTab}]{winId};
	my %g = $xServer->GetGeometry($winId);
	resizeAll($tId, $g{width}, $g{height});
}

sub toggleAutoResize ($)
{
	my ($tId) = @_;

	return if (!$tabWin{$tId}{autoResize});
	doResize($tId);
}


loadState();
print($fvwm->name() . " started with: Perl " . join('.', map(ord($_), split(//, $^V))) . ", X11::Protocol " .  $X11::Protocol::VERSION . ", Tk $Tk::VERSION.\n");
$fvwm->send("NOP FINISHED STARTUP");
$fvwm->event_loop();