package Gtk2::Ex::GladeCustom;

use utf8;
use strict qw(subs vars);
use warnings;

use Gtk2::GladeXML;
use UNIVERSAL qw(can);

our %funs;

sub _shown {
    $_[0]->show();
    $_[0];
}

sub handler {
    my ($self, $fn, $name, @args) = @_;
    if($args[0] =~ /^\(.*\)$/ and !$args[1] and !$args[2] and !$args[3]) {
	@args = eval $args[0];
	die "Error in parameters for ctor of $name: $@" if $@;
    }
    if($funs{$fn}) {
	return _shown($funs{$fn}->(@args));
    }
    if($fn =~ /::/ && defined *{$fn}{CODE}) {
	return _shown($fn->(@args));
    }
    if(can($fn, 'new')) {
	return _shown($fn->new(@args));
    }
    local $" = ', ';
    die "Widget ctor $fn for object $name not found.";
}

sub import {
    my $class = shift;
    my $pkg = caller;
    my ($n, $f);
    while(($n, $f) = splice @_, 0, 2) {
	$funs{$n} = ref($f) eq 'CODE' ? $f :
		    $f =~ /::/ ? $f : $pkg.'::'.$f;
    }
}

Gtk2::Glade->set_custom_handler(\&handler);

1;
__END__
=head1 NAME

Gtk2::Ex::GladeCustom - Make Gtk2-perl widgets available from glade.

=head1 SYNOPSIS

From the widget:

  package CustomWidget;
  use Gtk2::Ex::GladeCustom custom_widget => sub { CustomWidget->new() };

And then from glade add custom widget and use custom_widget as it's
construction function.

=head2 DESCRIPTION

This module allows writing widgets in perl and then constructing them from
glade.

From the module implementing the new widget, you use this module and register
constructor. Registering constructor is not mandatory as fully-qualified
names can be used and you can register more than one constructor.

The constructor will be called with the four arguments from glade file --
2 strings and 2 integers (in that order).

From glade, the function to be called can be specified in 3 ways:

=over 4

=item Defined constructor

Name registered with use Gtk2::Ex::GladeCustom. The associated function will
be called.

=item Fully-qualified name

That function will be looked-up and called.

=item Package name

Class method C<new> in that class will be called, if the class has such
method.

=back

The parameters passed to that function will be either:

=over 4

=item *

The four arguments, 2 string and 2 integers, as speicifed in glade.

=item *

If the first string in glade is in parenthesis, and if it's the only
parameter set, that it will be expanded to perl list (using eval) and used as
argument-list instead. That allows calling arbitrary functions as widget
constructors.

=back

=head2 CAVEATS

Libglade does not provide the default custom widget handler. Thus once this
module is used, C-based custom widgets won't be found. You have to bind their
constructors to perl.

=head2 AUTHORS

Jan Hudec <bulb ucw cz>

=head2 COPYING

This library is free software. It can be distributed under the same terms as
perl itself.

# arch-tag: 8719e9a6-7b6e-4f8d-a91d-b15666fbee48