File Coverage

blib/lib/Gtk2/Ex/FormFactory.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package Gtk2::Ex::FormFactory;

$VERSION = "0.67";

use strict;

use base qw( Gtk2::Ex::FormFactory::Container );

use Gtk2;
use Gtk2::Ex::FormFactory::Loader;
use Scalar::Util;

sub get_type { "form_factory" }

use Gtk2::Ex::FormFactory::Context;
use Gtk2::Ex::FormFactory::Layout;
use Gtk2::Ex::FormFactory::Rules;

sub get_context			{ shift->{context}			}
sub get_sync			{ shift->{sync}				}
sub get_layouter		{ shift->{layouter}			}
sub get_rule_checker		{ shift->{rule_checker}			}
sub get_gtk_size_groups		{ shift->{gtk_size_groups}		}
sub get_parent_ff		{ shift->{parent_ff}			}
sub get_widgets_by_name		{ shift->{widgets_by_name}		}
sub get_buffered		{ shift->{buffered}			}

sub set_context			{ shift->{context}		= $_[1]	}
sub set_sync			{ shift->{sync}			= $_[1]	}
sub set_layouter		{ shift->{layouter}		= $_[1]	}
sub set_rule_checker		{ shift->{rule_checker}		= $_[1]	}
sub set_gtk_size_groups		{ shift->{gtk_size_groups}	= $_[1]	}
sub set_parent_ff		{ shift->{parent_ff}		= $_[1]	}
sub set_widgets_by_name		{ shift->{widgets_by_name}	= $_[1]	}
sub set_buffered		{ shift->{buffered}		= $_[1]	}

sub get_form_factory		{ shift					}

sub new {
	my $class = shift;
	my %par = @_;
	my  ($context, $parent_ff, $sync, $layouter, $rule_checker) =
	@par{'context','parent_ff','sync','layouter','rule_checker'};

	my $self = $class->SUPER::new(@_);

	$sync           = 1 unless defined $sync;
	$context      ||= Gtk2::Ex::FormFactory::Context->new;
	$layouter     ||= Gtk2::Ex::FormFactory::Layout->new;
	$rule_checker ||= Gtk2::Ex::FormFactory::Rules->new;

	$self->set_parent_ff       ($parent_ff);
	$self->set_context         ($context);
	$self->set_sync	           ($sync);
	$self->set_layouter        ($layouter);
	$self->set_rule_checker    ($rule_checker);
	$self->set_gtk_size_groups ({});
	$self->set_widgets_by_name ({});
	$self->set_buffered	   (1);

	return $self;
}

sub cleanup {
	my $self = shift;

	$self->SUPER::cleanup(@_);

	$self->set_gtk_size_groups({});
	$self->set_widgets_by_name({});

	1;
}

sub open {
	my $self = shift;
	my %par = @_;
	my ($hide) = $par{'hide'};

	#-- First build all widgets as implemented in the Widget class
	$self->build();

	#-- Now show all widgets, if we shouldn't keep the hided
	$self->show if not $hide;

	1;
}

sub build {
	my $self = shift;

        return if $self->get_built;

	#-- first register all widgets of this FormFactory
	#-- to resolve cross references between Widgets
	#-- during building.
	$self->register_all_widgets($self);

	#-- Now call Container's build
	$self->SUPER::build();

	1;
}

sub show {
	my $self = shift;

	#-- Show all widgets
	foreach my $child ( @{$self->get_content} ) {
		$child->get_gtk_parent_widget->show_all;
	}

	#-- And finally connect the changed signals - this need to be
	#-- done *after* showing the widgets. For containers ->show()
	#-- could trigger updates which cause object updates. Since
	#-- ->update() isn't called yet, this would invalidate the
	#-- object's state.
	$self->connect_signals;

	1;
}

sub update {
	my $self = shift;
	$self->update_all;
}

sub ok {
	my $self = shift;

	$self->apply;
	$self->close;

	1;
}

sub apply {
	my $self = shift;

	if ( $self->get_sync ) {
		$self->commit_proxy_buffers_all;
	} else {
		$self->apply_changes_all;
	}

	1;
}

sub cancel {
	my $self = shift;

	$self->discard_proxy_buffers_all if $self->get_sync;
	$self->close;

	1;
}

sub close {
	my $self = shift;

	$_->get_gtk_parent_widget->destroy for @{$self->get_content};

	$self->cleanup;

	1;
}

sub register_all_widgets {
	my $self = shift;
	my ($widget) = @_;

	if ( $widget->isa("Gtk2::Ex::FormFactory::Container") ) {
		$self->register_widget($widget);
		foreach my $child ( @{$widget->get_content} ) {
			$self->register_all_widgets($child);
		}
	} else {
		$self->register_widget($widget);
	}

	1;
}

sub register_widget {
	my $self = shift;
	my ($widget) = @_;

	$self->get_widgets_by_name->{$widget->get_name} = $widget;

	$self->set_buffered(0) if $widget->get_object &&
				  !$self->get_context
				        ->get_proxy($widget->get_object)
				        ->get_buffered;

	1;
}

sub get_form_factory_gtk_window {
	my $self = shift;

	my $gtk_window;
	foreach my $child ( @{$self->get_content} ) {
		if ( $child->isa("Gtk2::Ex::FormFactory::Window") ) {
			$gtk_window = $child->get_gtk_parent_widget;
			last;
		}
	}

	return $gtk_window;
}

sub open_confirm_window {
	my $self = shift;
	my %par = @_;
	my  ($message, $yes_callback, $no_callback, $position, $with_cancel) =
	@par{'message','yes_callback','no_callback','position','with_cancel'};
        my  ($yes_label, $no_label) =
        @par{'yes_label','no_label'};

	$position  ||= "center-on-parent";
        $yes_label ||= "gtk-yes";
        $no_label  ||= "gtk-no";

	my $confirm = Gtk2::MessageDialog->new_with_markup (
		$self->get_form_factory_gtk_window,
		["modal","destroy-with-parent"],
		"question",
		"none",
		$message
	);

	$confirm->add_buttons ("gtk-cancel", "cancel") if $with_cancel;
	$confirm->add_buttons ($no_label,     "no");
	$confirm->add_buttons ($yes_label,    "yes");

	$confirm->signal_connect("response", sub {
		my ($widget, $answer) = @_;
		if ( $answer eq 'yes' ) {
			&$yes_callback() if $yes_callback;
		}
		if ( $answer eq 'no' ) {
			&$no_callback() if $no_callback;
		}
		$widget->destroy;
		1;
	});

	$confirm->set_position ($position);
	$confirm->show;

	1;
}

sub open_message_window {
	my $self = shift;
	my %par = @_;
	my  ($type, $message, $position) =
	@par{'type','message','position'};

	$position  ||= "center-on-parent";
	$type      ||= "info";

	my $confirm = Gtk2::MessageDialog->new_with_markup (
		$self->get_form_factory_gtk_window,
		["modal","destroy-with-parent"],
		$type,
		"ok",
		$message
	);

	$confirm->signal_connect("response", sub {
		my ($widget) = @_;
		$widget->destroy;
		1;
	});
	$confirm->set_position ($position);
	$confirm->show;

	1;
}

sub get_image_path {
	my $class = shift;
	my ($filename) = @_;

	foreach my $dir ( @INC ) {
		return "$dir/$filename" if -f "$dir/$filename";
	}

	return;
}

sub change_mouse_cursor {
	my $self = shift;
	my ($type, $gtk_window) = @_;

	$gtk_window ||= $self->get_form_factory_gtk_window;
	return unless $gtk_window;

	my $cursor = $type ? Gtk2::Gdk::Cursor->new($type) : undef;
	$gtk_window->window->set_cursor($cursor);
	Gtk2->main_iteration while Gtk2->events_pending;

	1;
}

1;

__END__