#!/usr/bin/perl

# Filter this script to pod2man to get a man page:
#   pod2man -c "FVWM Utilities" fvwm-perllib | nroff -man | less -e

#use strict;  # comment to make it faster

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

	# try to do it as fast as possible
	if ($ARGV[0] eq 'dir') {
		print $perllibdir;
		exit(0);
	}
}

use Getopt::Long;
use lib $perllibdir;
use General::FileSystem '-die';

my $version = "2.5.12";
my $versionInfo = "";

my $pager = $ENV{PAGER} || "less -e";
my $doMan = 0;
my $doCat = 0;
my $doRaw = 0;

GetOptions(
	"help|h|?"    => \&showHelp,
	"version|v|V" => \&showVersion,
	"man"         => \$doMan,
	"cat"         => \$doCat,
	"raw"         => \$doRaw,
	"dir"         => sub { print $perllibdir; exit(0); },
) || wrongUsage();

if ($ARGV[0] eq 'man') {
	$doMan = 1;
	shift;
} elsif ($ARGV[0] eq 'cat') {
	$doCat = 1;
	shift;
} elsif ($ARGV[0] eq 'raw') {
	$doRaw = 1;
	shift;
}

wrongUsage() if !$doMan && !$doCat && !$doRaw || @ARGV > 1;

my $manOrCatStr = $doMan || $doRaw? "man": "cat";
my $internalPods = {};

$internalPods->{index} = qq{
	:head1 NAME

	index - lists all available help topics

	:head1 DESCRIPTION

	Recent I<fvwm> versions install the Perl library that makes creating
	FVWM modules in Perl possible and easy.

	You may read the Perl library documentation locally by running:

	    % fvwm-perllib $manOrCatStr <topic>

	Available topics:

	    index
	    tutorial
	    {{CLASS_NAMES}}

	For example:

	    % fvwm-perllib $manOrCatStr FVWM::Module

	:head1 AUTHOR

	Mikhael Goikhman <migo\@homemail.com>.
};

$internalPods->{tutorial} = q{
	:head1 NAME

	tutorial - common techniques for writting FVWM modules

	:head1 TUTORIAL

	:head2 What is a window manager

	A window manager is a program that runs on top of the X Window
	System and manages windows, menus, key and mouse bindings, virtual
	desktops and pages, draws window decorations using defined colors or
	images, title-bar buttons and fonts.  It may also manage such things
	as root background, mouse cursors, sounds, run applications and
	do other nice things.

	:head2 What is a module

	In the unix traditions, different functionality may be implemented
	by separate programs to reduce a bloat. A module is an optional
	program that is intended to extend the window manager using a defined
	module protocol.

	FVWM modules are spawned by the main I<fvwm> executable. They
	usually listen to the window manager events, do some useful work and
	send back commands for execution. There are transient modules that
	exit immediately or shortly, and persistent modules that exit
	together with a window manager or when a user requests.  Some
	modules may control windows or other modules. Some modules may supply
	a GUI, others may be non interactive.

	:head2 Creating a simple module

	Let's create a module that shows a flash window for one second when
	you change pages. We will use I<xmessage> with nifty options for our
	flash purposes, but you may use your fantasy to do this better.

	First, we should understand when our module works. Usually a module
	does nothing (sleeps) and is awaken when something interesting
	happens. This is achieved using events. A module defines events that
	it is interesting to receive and set-ups event handlers (perl
	functions) to be called when the event happens. Then a module enters
	the event loop where it sleeps all the time until one or another
	event happens. Most of the module work is done in the event
	handlers. When an event is processed, the module enters the event
	loop again.

	In our case, we should listen to an FVWM event I<M_NEW_PAGE>. The list
	of all events may be found in L<FVWM::Constants>. When we receive
	the event we want to get new page coordinates and display them
	using our special xmessage window.

	Now, from theory to practice. The header of all modules written in
	Perl is pretty standard:

	    #!/usr/bin/perl -w

	    use lib `fvwm-perllib dir`;
	    use FVWM::Module;

	Then create the actual module object:

	    my $module = new FVWM::Module(
	        Mask => M_NEW_PAGE | M_NEW_DESK,
	        Debug => 1,
	    );

	The B<Debug> option tells to print the event names that a module
	receives to help writing a module, it also echoes all sent commands.
	The B<Mask> option tells which events a module wants to receive, in
	our case these are events generated on the page and desk changes.

	To handle events, event handlers that are perl functions, should be
	defined. It is ok not to define any event handler for I<M_NEW_DESK>
	and to define two event handlers for I<M_NEW_PAGE>. But for our
	purposes one I<M_NEW_PAGE> would be more than enough:

	    $module->addHandler(M_NEW_PAGE, \&gotNewPage);

	It is a time to implement our C<gotNewPage> function that will be
	called every time the desktop page is changed.

	    sub gotNewPage {
	        my ($module, $event) = @_;

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

	        if (!$width || !$height) {
	            # this may happen when doing DeskTopSize 1x1 on page 2 2
	            return;
	        }
	        my $page_nx = int($event->_vp_x / $width);
	        my $page_ny = int($event->_vp_y / $height);

		# actually show the flash
	        $module->send("Exec xmessage -name FlashWindow \
	            -bg cyan -fg white -center -timeout 1 -button '' \
	            -xrm '*cursorName: none' -xrm '*borderWidth: 2' \
	            -xrm '*borderColor: yellow' -xrm '*Margin: 12' \
	            '($page_nx, $page_ny)'");
	    }

	All event handlers are called with 2 parameters, a module and an
	event objects. The arguments of the event are described in
	L<FVWM::EventNames>. Each event type has its own arguments. Our
	I<M_NEW_PAGE> has 5 arguments: vp_x vp_y desk vp_width vp_height.
	We should do some calculations to get the page numbers from viewport
	coordinates.

	The B<send> method passes the command to I<fvwm> for execution.
	It would be better to set-up the FlashWindow specially:

	    $module->send("Style FlashWindow StaysOnTop, NoTitle, NoHandles, \
		BorderWidth 10, WindowListSkip, NeverFocus, UsePPosition");

	Finally, all persistent modules should enter the event loop:

	    $module->eventLoop;

	The full module source that we just wrote is available at
	ftp://ftp.fvwm.org/pub/fvwm/devel/sources/tests/perl/module-flash .
	To run it execute this fvwm command:

	    Module /path/to/module-flash

	To kill the module, execute:

	    KillModule /path/to/module-flash

	:head2 Creating a more functional module

	Let's extend our new-page-flash example above and add a way to stop
	our module and to define another string format. This would be
	possible using the following I<fvwm> commands:

	    SendToModule /path/to/module-flash stop
	    SendToModule /path/to/module-flash format '[%d %d]'

	To handle such commands, we should define I<M_STRING> event handler.

	    use General::Parse;
	    my $format = "(%d, %d)";  # the default format

	    $module->mask($module->mask | M_STRING);
	    $module->addHandler(M_STRING, sub {
	        my ($module, $event) = @_;
	        my $line = $event->_text;
	        my ($action, @args) = getTokens($line);

	        if ($action eq "stop") {
	            $module->terminate;
	        } elsif ($action eq "format") {
	            $format = $args[0];
	        }
	    });

	Now, let convert our module to be GTK+ based and not to be
	dependent on I<xmessage>.

	    use lib `fvwm-perllib dir`;
	    use FVWM::Module::Gtk;
	    use Gtk;
	    init Gtk;

	    my $format = "(%d, %d)";
	    my $module = new FVWM::Module::Gtk(Mask => M_NEW_PAGE);

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

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

	        if (!$width || !$height) {
	            return;
	        }
	        my $page_nx = int($event->_vp_x / $width);
	        my $page_ny = int($event->_vp_y / $height);

		# actually show the flash
	        my ($w, $h) = (80, 50);
	        my $string = sprintf($format, $page_nx, $page_ny);

	        my $window = new Gtk::Window('toplevel');
	        $window->set_title("FlashWindow");
	        $window->set_border_width(5);
	        $window->set_usize($w, $h);
	        $window->set_uposition(($width - $w) / 2, ($height - $h) / 2);

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

	        my $label = new Gtk::Label($string);
	        $frame->add($label);
	        $window->show_all;

	        $SIG{ALRM} = sub { $window->destroy(); };
	        alarm(1);
	    });

	    $module->eventLoop;

	The full module source that we just wrote is available at
	ftp://ftp.fvwm.org/pub/fvwm/devel/sources/tests/perl/module-gtkflash .

	:head1 EXAMPLES

	Currently see I<ftp://ftp.fvwm.org/pub/fvwm/devel/sources/tests/perl/>
	for examples.

	Learning the sources of B<FvwmPerl>, B<FvwmDebug>, B<FvwmGtkDebug>
	modules may help too.

	:head1 SEE ALSO

	See L<FVWM::Module> and L<FVWM::Module::Gtk> for the module API.

	:head1 AUTHOR

	Mikhael Goikhman <migo@homemail.com>.
};

my $topic = $ARGV[0] || "index";
my $file = "-";
my $text = "";
if (exists $internalPods->{$topic}) {
	$text = $internalPods->{$topic};
	$text =~ s/^\t//mg;
	$text =~ s/^:/=/mg;
	my @classNames = sort @{listFileNames($perllibdir, 1)};
	@classNames = map { s!\.pm$!!; s!/!::!g; $_ } @classNames;
	$text =~ s/{{CLASS_NAMES}}/join("\n    ", @classNames)/seg;
} else {
	$file = "$perllibdir/$topic.pm";
	$file =~ s!::!/!g;
	die "No $file found.\n" unless -f $file;
}

my $manConverter = $doMan? " | nroff -man | $pager": "";
open(MANPIPE, $doCat? "| pod2text '$file' | $pager":
	"| pod2man --section 3 --release 'FVWM $version$versionInfo'" .
		" --center 'FVWM Perl library' '$file'" .
		" | sed 's/<STANDARD INPUT>/perllib/ig'$manConverter")
	or die "Can't open pipe to pod/man viewer\n";
print MANPIPE $text
	or die "Can't write to pod/man viewer\n";
close MANPIPE;

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

sub showHelp {
	print "Shows documentation of the supplied FVWM Perl library.\n\n";
	print "Usage: fvwm-perllib man|cat\n";
	print "\tAn introduction to the FVWM Perl library\n\n";
	print "Usage: fvwm-perllib man|cat|raw <Perl::Class>\n";
	print "\tManual page for <Perl::Class>, try: man FVWM::Module\n";
	print "\t\$PAGER is used for a pager, the default is '$pager'\n\n";
	print "Usage: fvwm-perllib dir\n";
	print "\tFor use in FVWM modules written in Perl\n\n";
	print "Usage: fvwm-perllib [OPTIONS]\n";
	print "Options:\n";
	print "\t--help           show this help and exit\n";
	print "\t--version        show the version and exit\n";
	exit 0;
}

sub showVersion {
	print "$version\n";
	exit 0;
}

sub wrongUsage {
	print STDERR "Try '$0 --help' for more information.\n";
	exit -1;
}

__END__

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

=head1 NAME

fvwm-perllib - shows the documentation of the FVWM Perl library

=head1 SYNOPSIS

B<fvwm-perllib>
[ B<--help>|B<-h>|B<-?> ]
[ B<--version>|B<-v>|B<-V> ]
[ B<man> [ I<Perl::Class> ] ]
[ B<cat> [ I<Perl::Class> ] ]
[ B<raw> [ I<Perl::Class> ] ]
[ B<dir> ]

=head1 DESCRIPTION

Starting from fvwm-2.5.x versions there is a built-in support for creating
FVWM modules in Perl. This B<fvwm-perllib> utility provides help services
for the FVWM Perl library.

=head1 OPTIONS

B<--help>
    show the help and exit

B<--version>
    show the version and exit

B<--man> or B<man> [ I<Perl::Class> ]
    show manual page just like man(1)

B<--cat> or B<cat> [ I<Perl::Class> ]
    show manual page in plain text

B<--raw> or B<raw> [ I<Perl::Class> ]
    generate output in man format (not human readable)

B<--dir> or B<dir>
    print perllib directory without a trailing end of line

=head1 USAGE

Use this in the FVWM modules written in Perl:

    use lib `fvwm-perllib dir`;

Introduction to the FVWM Perl library:

    % fvwm-perllib man

Manual page for the C<FVWM::Module> class:

    % fvwm-perllib man FVWM::Module

Standard options:

    % fvwm-perllib --help
    % fvwm-perllib --version

=head1 AUTHORS

Mikhael Goikhman <migo@homemail.com>.

=head1 COPYING

The script is distributed by the same terms as fvwm itself.
See GNU General Public License for details.

=head1 BUGS

No known bugs.

Report bugs to fvwm-bug@fvwm.org.

=cut

# ***************************************************************************
