view release on metacpan or  search on metacpan

lib/Config/Model/Tk/Wizard.pm  view on Meta::CPAN

#
# This file is part of Config-Model-TkUI
#
# This software is Copyright (c) 2008-2021 by Dominique Dumont.
#
# This is free software, licensed under:
#
#   The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Tk::Wizard 1.381;

use strict;
use warnings;
use Carp;
use Try::Tiny;

use base qw/Tk::Toplevel/;
use vars qw/$icon_path/;
use Log::Log4perl;

use Config::Model::Tk::LeafEditor;
use Config::Model::Tk::CheckListEditor;
use Config::Model::Tk::ListEditor;
use Config::Model::Tk::HashEditor;

Construct Tk::Widget 'ConfigModelWizard';

my $logger = Log::Log4perl::get_logger('Tk::Wizard');

my @fbe1 = qw/-fill both -expand 1/;
my @fxe1 = qw/-fill x    -expand 1/;
my @fx   = qw/-fill x    /;

sub ClassInit {
    my ( $class, $mw ) = @_;

    # ClassInit is often used to define bindings and/or other
    # resources shared by all instances, e.g., images.

    # cw->Advertise(name=>$widget);
}

sub Populate {
    my ( $cw, $args ) = @_;

    foreach my $parm (qw/-root/) {
        my $attr = $parm;
        $attr =~ s/^-//;
        $cw->{$attr} = delete $args->{$parm}
            or croak "Missing $parm arg\n";
    }

    foreach my $parm (qw/-from_widget -stop_on_important -store_cb -show_cb -end_cb -font/) {
        my $attr = $parm;
        $attr =~ s/^-//;
        $cw->{$attr} = delete $args->{$parm};
    }

    $logger->info("Creating wizard widget");
    $cw->{show_cb}  ||= sub { };
    $cw->{store_cb} ||= sub { };
    $cw->{has_stopped} = 0;

    my $title = delete $args->{'-title'}
        || "config wizard " . $cw->{root}->config_class_name;

    $cw->Label(
        -text => "Configuration of " . $cw->{root}->config_class_name,
    )->pack;

    my $ed = $cw->{ed_frame} = $cw->Frame->pack(qw/-pady 0 -fill both -expand 1 -anchor n/);
    $cw->{ed_frame}->packPropagate(0);

    $args->{-title} = $title;