fvwm 1:2.6.5.ds-3 / usr / bin / fvwm-perllib

#!/usr/bin/perl

# Copyright (c) 2002-2009 Mikhael Goikhman
#
# 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 Utilities" fvwm-perllib | nroff -man | less -e

#use strict;  # comment to make it faster

BEGIN {
#	use vars qw($prefix $datarootdir $datadir $perllibdir);
	$prefix = "/usr";
	$datarootdir = "${prefix}/share";
	$datadir = "${datarootdir}";
	$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.6.5";
my $version_info = "";

my $pager = $ENV{PAGER} || "less -e";
my $do_man = 0;
my $do_cat = 0;
my $do_raw = 0;

GetOptions(
	"help|h|?"    => \&show_help,
	"version|v|V" => \&show_version,
	"man"         => \$do_man,
	"cat"         => \$do_cat,
	"raw"         => \$do_raw,
	"dir"         => sub { print $perllibdir; exit(0); },
) || wrong_usage();

if ($ARGV[0] eq 'man') {
	$do_man = 1;
	shift;
} elsif ($ARGV[0] eq 'cat') {
	$do_cat = 1;
	shift;
} elsif ($ARGV[0] eq 'raw') {
	$do_raw = 1;
	shift;
}

wrong_usage() if !$do_man && !$do_cat && !$do_raw || @ARGV > 1;

my $man_or_cat_str = $do_man || $do_raw ? "man" : "cat";
my $internal_pods = {};

$internal_pods->{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 $man_or_cat_str <topic>

	Available topics:

	    index
	    tutorial
	    events
	    {{CLASS_NAMES}}

	For example:

	    % fvwm-perllib $man_or_cat_str FVWM::Module

	:head1 AUTHOR

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

$internal_pods->{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. The window manager defines
	window placement and focus policies. 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 man page "events". 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->add_handler(M_NEW_PAGE, \&got_new_page);

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

	    sub got_new_page {
	        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 for all events are defined 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->event_loop;

	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 Using event trackers

	In fact, the task of calculating page coordinates, or managing
	information about all windows, or gathering colorset, module or
	global information is so often, that there are existing
	implentation in the form of event trackers. Tracker is an instance
	of L<FVWM::Tracker> superclass. Currently these tracker classes are
	available (see their man pages):

	    FVWM::Tracker::Colorsets
	    FVWM::Tracker::GlobalConfig
	    FVWM::Tracker::ModuleConfig
	    FVWM::Tracker::PageInfo
	    FVWM::Tracker::Scheduler
	    FVWM::Tracker::WindowList

	Using a tracker is easy, something along lines:

	    my $tracker = $module->track("WindowList");
	    my $colorset_tracker = $module->track("Colorsets");

	Our module that we wrote above may be reduced if we use:

	    my $viewport = $module->track("PageInfo");

	    my $page_nx = $viewport->data("page_nx");
	    my $page_ny = $viewport->data("page_ny");

	Note that the tracker continues to work and maintain the up-to-date
	information about the current page and desk (or up-to-date windows
	or colorsets depending on the tracker type) at any given moment.

	Internally, trackers listen to appropriate events using the same
	event handler mechanism, so there is no speed advantage. However
	it is a good idea to reuse the existing verified code and reduce
	the number of events needed to be trapped manually. There is
	usually no problem if the developer and the tracker define
	handlers for the same events (besides the handler order maybe).

	:head2 On the module masks

	In our example above we explicitly defined Mask in constructor.
	This is not really needed. If not specified, the event mask is
	managed automatically (it is updated every time a new event handler
	is added).

	Note, there are actually two event masks, called "mask" and
	"xmask" (extended mask). If you are interested in the details,
	refer to the fvwm documentation or perllib sources.

	When trackers are added or removed, the module mask (and xmask)
	are automatically tweaked underhand. In short, there is often no
	reason to worry about the module masks. However, in rare cases
	you may want to define SyncMask (or SyncXMask), so that fvwm is
	synchronized with the module on certain events.

	: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->add_handler(M_STRING, sub {
	        my ($module, $event) = @_;
	        my $line = $event->_text;
	        my ($action, @args) = get_tokens($line);

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

	Now, let's 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 POSIX qw(SIGALRM);
	    Gtk->init;

	    my $format = "(%d, %d)";
	    my $module = new FVWM::Module::Gtk;
	    my $pageinfo = $module->track("PageInfo");

	    $pageinfo->observe("desk/page changed", sub {
	        my ($module, $tracker, $data) = @_;

	        my $page_nx = $data->{page_nx};
	        my $page_ny = $data->{page_ny};
	        my $width  = $data->{vp_width};
	        my $height = $data->{vp_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;

	        POSIX::sigaction(SIGALRM, POSIX::SigAction->new(
	            sub { $window->destroy(); }
	        ));
	        alarm(1);
	    });

	    $module->event_loop;

	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>.
};

$internal_pods->{events} = q{
	:head1 NAME

	events - list of all fvwm events with arguments

	:head1 DESCRIPTION

	This list is automatically generated from L<FVWM::EventNames> package.

	Given L<FVWM::Event> object of certain event type, say I<M_STRING>,
	here is the syntax to get value of its I<win_id> argument:

	    $win_id = $event->_win_id;

	There are several more ways to access arguments, like:

	    $win_id = $event->arg_values->[0];
	    $text = $event->args->{text};

	:head1 EVENTS WITH ARGUMENTS

	{{EVENT_NAMES}}

	:head1 ARGUMENT TYPE LEGEND

	Here is a mapping of fvwm argument types to perl native types:

	    number - integer
	    bool   - boolean, true or false
	    window - X window id in decimal, use sprintf("0x%07x", $wid)
	    pixel  - "rgb:" . join('/', sprintf("%06lx", $val) =~ /(..)(..)(..)/)
	    string - string (scalar)
	    wflags - window flags in binary string
	    looped - loop of zero or more fixed argument bunches

	Run L<FvwmDebug> or L<FvwmGtkDebug> to browse events.

	:head1 SEE ALSO

	See "tutorial", L<FVWM::Event>, L<FVWM::EventNames> and L<FvwmDebug>.

	:head1 AUTHOR

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

my $topic = $ARGV[0] || "index";
my $file = "-";
my $text = "";
if (exists $internal_pods->{$topic}) {
	$text = $internal_pods->{$topic};
	$text =~ s/^\t//mg;
	$text =~ s/^:/=/mg;

	if ($topic eq 'index') {
		my @class_names = sort @{list_filenames($perllibdir, 1)};
		@class_names = map { s!\.pm$!!; s!/!::!g; $_ } @class_names;
		$text =~ s/{{CLASS_NAMES}}/join("\n    ", @class_names)/seg;
	}

	if ($topic eq 'events') {
		my $content = `cat '$perllibdir/FVWM/EventNames.pm'`;
		my $result = "";
		foreach ($content =~ /\t&([^\s]+.*?\t\tfields[^\n]+(?:\n\t\t\t[^\n]+)*)/sg) {
			my ($name, $rest) = /^([^\s]+).*?((?:\n\t\t\t[^\n]+)*)$/s;  # ]
			$result .= "    $name\n";
			$rest =~ s/([^\s]+)\s*=>\s*([\w]+)/
				$result .= sprintf("        %-16s\t%s\n", $1, $2)
			/eg;
			$result .= "\n";
		}
		$text =~ s!{{EVENT_NAMES}}!$result!se;
	}

} else {
	$file = "$perllibdir/$topic.pm";
	$file =~ s!::!/!g;
	die "No $file found.\n" unless -f $file;
}

my $man_converter = $do_man ? " | nroff -man | $pager" : "";
open(MANPIPE, $do_cat ? "| pod2text '$file' | $pager" :
	"| pod2man --section 3 --release 'fvwm $version$version_info'" .
		" --center 'Fvwm Perl library' '$file'" .
		" | sed 's/<STANDARD INPUT>/perllib/ig'$man_converter")
	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 show_help {
	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 show_version {
	print "$version\n";
	exit 0;
}

sub wrong_usage {
	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

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