#!@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 $datarootdir $datadir);
	$prefix = "@prefix@";
	$datarootdir = "@datarootdir@";
	$datadir = "@datadir@";
}

use lib "@FVWM_PERLLIBDIR@";
use FVWM::Module;
use General::Parse qw(get_token);

my $module_type = "";
my $module_class = "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;
		$module_type = "gtk";
		$module_class = "FVWM::Module::Gtk";
	}
}

# init the module
# set Debug = 0 for no messages at all
# set Debug = 1 to see messages about window decisions
# set Debug = 2 to see also perllib messages about communication
my $module = new $module_class(
	Name => "FvwmWindowMenu",
	Mask => M_STRING,
	Debug => 0,
);

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

my $config_tracker = $module->track('ModuleConfig',
	DefaultConfig => {
		OnlyIconified => 'off',
		AllDesks => 'off',
		AllPages => 'off',
		MaxLen => 32,
		MenuName => 'MyMenu',
		MenuStyle => '',
		Debug => 0,
		Function => 'WindowListFunc',
		ItemFormat => '%m%n%t%t(+%x+%y) - Desk %d',
		ShowName => '',
		ShowClass => '',
		ShowResource => '',
		DontShowName => '',
		DontShowClass => '',
		DontShowResource => '',
	},
);

my $config = $config_tracker->data;
my $win_tracker = $module->track("WindowList", "!stack icons names winfo");

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

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

	my @sections;

	# loop on list of all windows
	my $windows = $win_tracker->data;
	while (my ($id, $w) = each %$windows) {
		$module->debug("\twindow: " . $w->{name});

		if ($config->{AllDesks} =~ /off/i &&
			$w->{desk} != $win_tracker->page_info('desk_n'))
		{
			$module->debug("\t\tnot on this desk");
			next;
		}

		if ($config->{AllPages} =~ /off/i &&
			($w->{page_nx} != $win_tracker->page_info('page_nx') ||
			 $w->{page_ny} != $win_tracker->page_info('page_ny')))
		{
			$module->debug("\t\tnot on this page");
			next;
		}

		if ($config->{OnlyIconified} =~ /on/i && !$w->{iconified})
		{
			$module->debug("\t\tnot iconified");
			next;
		}

 		my $section = 3;
		if ($config->{ShowName} ne '' &&
 			$w->{name} =~ /$config->{ShowName}/i) {
			$section = 0;
		} elsif ($config->{ShowClass} ne '' &&
			$w->{res_class_name} =~ /$config->{ShowClass}/i) {
			$section = 1;
		} elsif ($config->{ShowResource} ne '' &&
			$w->{res_name} =~ /$config->{ShowResource}/i) {
			$section = 2;
		}

		if ($section == 3)
		{
			if (($config->{DontShowName} ne '' &&
				$w->{name} =~ /$config->{DontShowName}/i) ||
				($config->{DontShowClass} ne '' &&
				$w->{res_class_name} =~ /$config->{DontShowClass}/i) ||
				($config->{DontShowResource} ne '' &&
				$w->{res_name} =~ /$config->{DontShowResource}/i))
			{
				$module->debug("\t\tin dontshow list");
				next;
			}
		}
		$module->debug("\t\tadding to section $section");
		AddToSection(\$sections[$section], $id);
	}

	# tell fvwm to start the menu
	$module->send("DestroyMenu recreate $config->{MenuName}");
	$module->send("AddToMenu " . $config->{MenuName} . " 'Desk " .
		$win_tracker->page_info('desk_n') . ", Page " .
		$win_tracker->page_info('page_nx') . ' ' .
		$win_tracker->page_info('page_ny') . "' Title");

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

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

	# set a menustyle if one given
	$module->send("ChangeMenuStyle $config->{MenuStyle} $config->{MenuName}")
		if ($config->{MenuStyle} ne '');

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


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

	my $format = $config->{ItemFormat};
	my $w = $win_tracker->data($id);

	# 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($w->{name})/ge;
	$format =~ s/%i/&Shorten($w->{icon_name})/ge;
	$format =~ s/%c/&Shorten($w->{res_class_name})/ge;
	$format =~ s/%r/&Shorten($w->{res_name})/ge;
	$format =~ s/%X/$w->{X}/g;
	$format =~ s/%Y/$w->{Y}/g;
	$format =~ s/%x/$w->{x}/g;
	$format =~ s/%y/$w->{y}/g;
	$format =~ s/%d/$w->{desk}/g;

	# TODO: doesn't handle EWMH icons yet.
	$format =~ s/%m// if ($w->{mini_icon_name} eq 'ewmh_mini_icon');
	$format =~ s/%m/__%__$w->{mini_icon_name}__%__/g;

	# %M is strange - does anyone really want this behaviour? -- SS.
	if ($w->{iconified}) {
		$format =~ s/%M/__%__$w->{mini_icon_name}__%__/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 $config->{Function} $id\n);
}


# shorten a string to given length and append ellipses
sub Shorten ($) {
	my ($string) = @_;
	my $length = $config->{MaxLen};

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

	# For some special characters, fvwm expects a double sequence to get
	# a literal character.
	$r =~ s/([*&%^])/$1$1/g;

	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);

	my $screenW = $win_tracker->page_info('vp_width');
	my $screenH = $win_tracker->page_info('vp_height');
	$window->set_uposition(($screenW - $w) / 2, ($screenH - $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 $win_id = $window->window->XWINDOW();
#	$module->send("Schedule 2000 WindowId $win_id Close");
}

$module->send(
	"Style FvwmWindowMenuBar UsePPosition, !Title, !Borders, " .
	"StaysOnTop, WindowListSkip, CascadePlacement, SloppyFocus"
) if $module_type eq "gtk";

$module->event_loop;

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, windows may
be sorted into sections based on a regexp matching the window
name, class or resource and included in the menu.

Similarly, another set of regular expressions can be used to exclude
items from the menu.

Any windows not matching an instance of the include or exclude list 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 include (Show) or exclude (DontShow).
The syntax is:

    *FvwmWindowMenu: ShowName pattern
    *FvwmWindowMenu: ShowClass pattern
    *FvwmWindowMenu: ShowResource pattern
    *FvwmWindowMenu: DontShowName pattern
    *FvwmWindowMenu: DontShowClass pattern
    *FvwmWindowMenu: DontShowResource pattern

Pattern is a perl regular expression that will be evaluated in m// context.
See perlre(1).

For example:

    *FvwmWindowMenu: ShowResource ^gvim
    *FvwmWindowMenu: ShowName Galeon|Navigator|mozilla-bin|Firefox

will define two sections containing respectively browsers, and GVim. A third
section will contain all other windows.

To only include matching windows, add:

    *FvwmWindowMenu: DontShowName .*

Similarly:

    *FvwmWindowMenu: DontShowName ^Fvwm
    *FvwmWindowMenu: DontShowClass Gkrellm

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

Other options:

=over 4

=item *FvwmWindowMenu: I<OnlyIconified> {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 w.r.t. the page the window is on.

=item %X, %Y

the window x or y coordinates w.r.t. the desk the window is on.

=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 AUTHORS

Richard Lister <ric+lister@cns.georgetown.edu>.

Scott Smedley <ss@aao.gov.au>.

Mikhael Goikhman <migo@homemail.com>.

=cut