#!/usr/bin/perl -w

# 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

# Filter this script to pod2man to get a man page:
#   pod2man -c "FVWM Module" FvwmWindowMenu | nroff -man | less -e

use 5.004;
use strict;

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

use lib "${datadir}/fvwm/perllib";
use FVWM::Module;
use General::FileSystem "-quiet";
use General::Parse;
use Getopt::Long;

my $moduleType = "";
my $moduleClass = "FVWM::Module";
if ($ARGV[5] && $ARGV[5] eq "-g") {
	splice(@ARGV, 5, 1);
	eval "use FVWM::Module::Gtk;";
	if ($@) {
		print STDERR $@;
		print STDERR "FvwmWindowMenu: Ignoring the -g switch\n";
	} else {
		Gtk->init;
		$moduleType = "gtk";
		$moduleClass = "FVWM::Module::Gtk";
	}
}

# default user options
my $opt = {
	onlyiconic   => 0,      # only list iconified windows
	alldesks     => 0,      # list windows on all desks
	allpages     => 0,      # list windows on all pages
	maxlen       => 32,     # max chars for window name in menu
	menuname     => "MenuFvwmWindowMenu",  # name of fvwm menu to create
	menustyle    => undef,  # name of fvwm menu style to use
	itemformat   => "%m%n%t%t(+%x+%y) - Desk %d",  # format of menu items
	function     => "WindowListFunc",
};

# get size of your screen
my $screen;

# I would like a better way of getting screen dimensions!
open(XWININFO, "xwininfo -root|") || die "can't run xwininfo";
while (<XWININFO>) {
	$screen->{w} = $1 if /Width:\s*(\d+)/;
	$screen->{h} = $1 if /Height:\s*(\d+)/;
}
close(XWININFO);


# some global vars
my %window;
my $desk = 0;
my $page_nx = 0;
my $page_ny = 0;

# show = window matches to display in order, each entry defines a section
# dontshow = window matches to ignore, none of these will show up in the menu
my (@show, @dontshow);

# init the module
# set Debug = 0 for no messages at all
# set Debug = 1 to see my messages about window decisions
# set Debug = 2 to see also perllib messages about communication
my $module = new $moduleClass(
	Name => "FvwmWindowMenu",
	Mask => M_WINDOW_NAME | M_STRING |
		M_NEW_PAGE | M_NEW_DESK |
		M_ADD_WINDOW | M_CONFIGURE_WINDOW |
		M_RES_NAME | M_RES_CLASS | M_ICON_NAME |
		M_DESTROY_WINDOW | M_END_WINDOWLIST |
		M_ICONIFY | M_DEICONIFY | M_MINI_ICON |
		M_CONFIG_INFO | M_SENDCONFIG,
	Debug => 0,
);

$module->debug("starting " . $module->name);

# process module options
$module->addHandler(M_CONFIG_INFO, sub {
	my ($module, $event) = @_;

	my $modname = $module->name;
	return unless $event->_text =~ /^\*$modname(.*)$/;
	$_ = $1;

	# get show array
	if ( /^show\s+(\w+)\s*=\s*(.*)$/i ) {
		(my $type = $1) =~ tr/A-Z/a-z/;
		push(@show, { type => $type, pattern => $2 });
	}

	# get dontshow array
	elsif ( /^dontshow\s+(\w+)\s*=\s*(.*)$/i ) {
		(my $type = $1) =~ tr/A-Z/a-z/;
		push(@dontshow, { type => $type, pattern => $2 });
	}

	# match format string in quotes
	elsif ( /^itemformat\s+([\"\'])(.*)\1/i ) {
		$opt->{itemformat} = $2;
	}

	# get all other options, arg of 'off' sets opt to 0
	elsif (  /^(\w+)\s*(\w+)/i ) {
		(my $arg1 = $1) =~ tr/A-Z/a-z/;
		$opt->{$arg1} = ($2 =~ /^off$/i) ? 0 : $2;
	}

	# should probably do more error checking
});


# handler to get page and desk info
$module->addHandler(M_NEW_PAGE, sub {
	my ($module, $event) = @_;

	$desk = $event->_desk;

	my $width  = $event->_vp_width || 1;
	my $height = $event->_vp_height || 1;

	$page_nx = int($event->_vp_x / $width);
	$page_ny = int($event->_vp_y / $height);
});


$module->addHandler(M_NEW_DESK, sub {
	my ($module, $event) = @_;
	$desk = $event->_desk;
});


$module->addHandler(M_STRING, sub{
	my ($module, $event) = @_;
	my ($action, $args) = getToken($event->_text);
	return unless $action;
	if ($action =~ /^Post|Menu|Popup$/i) {
		&PopupMenu($action, $args);
	} elsif ($action =~ /^ShowBar$/i) {
		if ($moduleType ne "gtk") {
			$module->debug("Not started with Gtk support", 0);
			return;
		}
		&PopupTaskBar();
	} else {
		$module->debug("Unknown action $action", 0);
	}
});


$module->addHandler(M_ADD_WINDOW|M_CONFIGURE_WINDOW, sub {
	my ($module, $event) = @_;

	$window{$event->_win_id}->{desk} = $event->_desk;
	$window{$event->_win_id}->{x} = $event->_frame_x;
	$window{$event->_win_id}->{y} = $event->_frame_y;
});


$module->addHandler(M_DESTROY_WINDOW, sub {
	my ($module, $event) = @_;
	delete $window{$event->_win_id};
});


$module->addHandler(M_WINDOW_NAME, sub {
	my ($module, $event) = @_;
	$window{$event->_win_id}->{name} = $event->_name;
});

$module->addHandler(M_ICON_NAME, sub {
	my ($module, $event) = @_;
	$window{$event->_win_id}->{icon} = $event->_name;
});

$module->addHandler(M_RES_CLASS, sub {
	my ($module, $event) = @_;
	$window{$event->_win_id}->{class} = $event->_name;
});

$module->addHandler(M_RES_NAME, sub {
	my ($module, $event) = @_;
	$window{$event->_win_id}->{resource} = $event->_name;
});



$module->addHandler(M_ICONIFY, sub {
	my ($module, $event) = @_;
	$window{$event->_win_id}->{iconic} = 1;
});


$module->addHandler(M_DEICONIFY, sub {
	my ($module, $event) = @_;
	$window{$event->_win_id}->{iconic} = 0;
});


$module->addHandler(M_MINI_ICON, sub {
	my ($module, $event) = @_;
	$window{$event->_win_id}->{mini_icon} = $event->_name;
});


# does all the work and pops up the menu
sub PopupMenu {
	my ($action, $args) = @_;
	my $command = $action =~ /^Popup$/i? "Popup": "Menu";

	my @section;

	# loop on list of windows
	foreach my $id ( keys %window ) {

		$module->debug("\t$id - " . $window{$id}->{name});

		# skip windows in the dontshow array
		my $dont_show_me;
		foreach ( @dontshow ) {
			my $p = $_->{pattern};
			$dont_show_me = 1, last
				if $window{$id}->{$_->{type}} =~ /$p/;
		}

		$module->debug("\t\tin dontshow list"), next
			if $dont_show_me;

		# skip windows not on this desk if alldesks not set
		$module->debug("\t\tnot on this desk"), next
			unless $opt->{alldesks} || $window{$id}->{desk} == $desk;

		# show only iconic windows if onlyiconic set
		$module->debug("\t\tskipping because not iconified"), next
			if $opt->{onlyiconic} && ! $window{$id}->{iconic};

		# skip window if its top left is not on this page
		$module->debug("\t\tnot on this page"), next
			if ! $opt->{allpages} && (
				$window{$id}->{x} < 0 ||
				$window{$id}->{x} >= $screen->{w} ||
				$window{$id}->{y} < 0 ||
				$window{$id}->{y} >= $screen->{h});

		# loop on sections and choose which one to file in
		my $sectctr = 0;
		foreach ( @show ) {
 			my $p = $_->{pattern};
 			last if $window{$id}->{$_->{type}} =~ /$p/ ;
			++$sectctr;
		}

		# if we got here add the window to the last section
		# which is 'none of the above'
		$module->debug("\t\tadding to section $sectctr");
		&AddToSection(\$section[$sectctr], $id);
	}


	# tell fvwm to start the menu
	$module->send("DestroyMenu $opt->{menuname}");
	$module->send("AddToMenu $opt->{menuname} 'Desk $desk, "
		. "Page $page_nx $page_ny' Title");

	# now loop on sections sending menu entries to fvwm
	while ( @section ) {
		my $s = shift @section;

		if ($s) {
			$module->send($s);

			# add separator after section unless it is the last
			$module->send("+ \"\" Nop") if @section;
		}
	}

	# set a menustyle if one given
	$module->send("ChangeMenuStyle $opt->{menustyle} $opt->{menuname}")
		if $opt->{menustyle};

	# popup the menu with args we were sent
	$module->send("$command $opt->{menuname} $args");
}


# build a line containing the fvwm menu entry for a window
# then add it to the appropriate member of the global array @section
# args: pointer to section, window id
sub AddToSection {
	my ($s, $id) = @_;

	my $format = $opt->{itemformat};

	# hack: insert __%__ instead of % to avoid bogus substitution later
	$format =~ s/%%/__%____%__/g;

	# make format string substitutions
	$format =~ s/%t/\t/g;
	$format =~ s/%n/&Shorten($window{$id}->{name}, $opt->{maxlen})/ge;
	$format =~ s/%i/&Shorten($window{$id}->{icon}, $opt->{maxlen})/ge;
	$format =~ s/%c/&Shorten($window{$id}->{class}, $opt->{maxlen})/ge;
	$format =~ s/%r/&Shorten($window{$id}->{resource}, $opt->{maxlen})/ge;
	$format =~ s/%x/$window{$id}->{x}/g;
	$format =~ s/%y/$window{$id}->{y}/g;
	$format =~ s/%d/$window{$id}->{desk}/g;

	$format =~ s/%m/__%__$window{$id}->{mini_icon}__%__/g;

	if ($window{$id}->{iconic}) {
		$format =~ s/%M/__%__$window{$id}->{mini_icon}__%__/g;
	}
	else {
		$format =~ s/%M//g;
	}
	
	# now fix __%__ hack
	$format =~ s/__%__/%/g;

	# escape quotes
	$format =~ s/"/\\"/g;

	# add the entry to the section
	# support two ways for now: window context (new), window id param (old)
	$$s .= qq(+ "$format" WindowId $id $opt->{function} $id\n);
}


# shorten a string to given length and append ellipses
sub Shorten {
	my($string, $length) = @_;

	my $r = substr($string, 0, $length);
	$r .= "..." if length($string) > $length;

	return $r;
}


sub PopupTaskBar () {
	my ($w, $h) = (180, 60);

	my $window = new Gtk::Window('toplevel');
	$window->set_title("FvwmWindowMenuBar");
	$window->set_border_width(5);
	$window->set_usize($w, $h);
	$window->set_uposition(($screen->{w} - $w) / 2, ($screen->{h} - $h) / 2);

	my $frame = new Gtk::Frame();
	$window->add($frame);
	$frame->set_shadow_type('etched_out');

	my $vbox = new Gtk::VBox();
	$frame->add($vbox);

	my $label = new Gtk::Label("Nothing interesting yet");
	$vbox->add($label);

	my $button = new Gtk::Button("Close");
	$vbox->add($button);
	$button->signal_connect("clicked", sub { $window->destroy; });

	$window->show_all;

#	my $winId = $window->window->XWINDOW();
#	$module->send("Schedule 2000 WindowId $winId Close");
}


# main loop
$module->send("Send_ConfigInfo");
$module->send("Send_WindowList");
$module->send(
	"Style FvwmWindowMenuBar UsePPosition, !Title, !Borders, " .
	"StaysOnTop, WindowListSkip, CascadePlacement, SloppyFocus"
) if $moduleType eq "gtk";
$module->eventLoop;

1;

__END__

# ----------------------------------------------------------------------------

=head1 NAME

FvwmWindowMenu - open configurable fvwm menu listing current windows

=head1 SYNOPSIS

FvwmWindowMenu should be spawned by fvwm(1) for normal functionality.

Run this module from your StartFunction:

    AddToFunc StartFunction
    + I Module FvwmWindowMenu

=head1 DESCRIPTION

A substitute for I<fvwm> builtin B<WindowList>, but written in Perl
and easy to customize. Unlike B<FvwmIconMan> or B<FvwmWinList> the
module does not draw its own window, but instead creates an
I<fvwm> menu and asks I<fvwm> to pop it up.

By defining a set of regular expressions using Show, windows may
be sorted into sections based on the regexp matching their
name, icon name, class or resource.

Similarly, matches in DontShow will be excluded from the list.

Any windows not matching an instance of Show or DontShow will
be placed in the last section of the menu.

=head1 USAGE

Run the module, supposedly from StartFunction in I<.fvwm2rc>:

    Module FvwmWindowMenu

To actually invoke the menu add something like:

    Key Menu A N SendToModule FvwmWindowMenu \
        Post Root c c SelectOnRelease Menu

or:

    Mouse 2 A N SendToModule FvwmWindowMenu Popup

The additional parameters are any valid B<Menu> command parameters without a
menu name, see L<fvwm>.

Recognized actions are B<Post> (or its alias B<Menu>) and B<Popup>, they
create I<fvwm> menus and invoke them using the corresponding commands
B<Menu> and B<Popup>. If the module was started with "-g" switch, it
additionally supports B<PostBar> (not implemented yet).

Set module options for windows to show or not show. The syntax is:

    *FvwmWindowMenu: Show type = pattern
    *FvwmWindowMenu: DontShow type = pattern

where type is one of I<name>, I<icon>, I<class> or I<resource>. Pattern is
a perl regular expression that will be evaluated in m// context.
See perlre(1).

For example:

    *FvwmWindowMenu: Show resource = Galeon|Navigator|mozilla-bin
    *FvwmWindowMenu: Show name = ^emacs

will define two sections containing respectively browsers, and emacs.
Number of sections is unlimited. The strings are perl regular
expressions that will be evaluated in m// context. See perlre(1).

Similarly:

    *FvwmWindowMenu: DontShow name = ^Fvwm
    *FvwmWindowMenu: DontShow class = Gkrellm

will cause the menu to ignore windows with name beginning with Fvwm
or class gkrellm.

Other options:

=over 4

=item *FvwmWindowMenu: I<OnlyIconic> {on|off}

show only iconified windows

=item *FvwmWindowMenu: I<AllDesks> {on|off}

show windows from all desks

=item *FvwmWindowMenu: I<AllPages> {on|off}

show windows from all pages

=item *FvwmWindowMenu: I<Maxlen> 32

max length in chars of entry

=item *FvwmWindowMenu: I<MenuName> MyMenu

name of menu to popup

=item *FvwmWindowMenu: I<MenuStyle> MyMenuStyle

name of MenuStyle to apply

=item *FvwmWindowMenu: I<Debug> {0,1,2,3}

level of debug info output, 0 means no debug

=item *FvwmWindowMenu: I<Function> MyWindowListFunc

function to invoke on menu entries; defaults to WindowListFunc

=item *FvwmWindowMenu: I<ItemFormat> formatstring

how to format menu entries; substitutions are made as follows:

=over 4

=item %n, %i, %c, %r

the window name, icon name, class or resource

=item %x, %y

the window x or y coordinates on current page

=item %d

the window desk number

=item %m

the window's mini-icon

=item %M

the window's mini-icon only for iconified windows, otherwise empty

=item %t

a tab

=item %%

a literal %

=back

The format string must be quoted. The default string is
"%m%n%t%t(+%x+%y) - Desk %d".

=back

=head1 MORE EXAMPLES

Fancy binding of the window menu to the right windows key on some keyboards.
Hold this button while navigating using cursor keys, then release it.

    CopyMenuStyle * WindowMenu
    MenuStyle WindowMenu SelectOnRelease Super_R
    *FvwmWindowMenu: MenuStyle WindowMenu

    AddToFunc StartFunction I Module FvwmWindowMenu

    Key Super_R A A SendToModule FvwmWindowMenu Post Root c c WarpTitle

=head1 AUTHOR

Ric Lister <http://cns.georgetown.edu/~ric/>

=cut
