Tk-ApplicationNest
view release on metacpan or search on metacpan
ApplicationNest.pm view on Meta::CPAN
}
# ------------------------------------------
sub Populate {
# ------------------------------------------
my ($obj, $args) = @_;
$obj->{app} = delete $args->{'-app'} || 'Program';
$obj->{cfg} = delete $args->{'-cfg'} || sprintf( '%s/.%s.cfg', ($ENV{HOME} ? $ENV{HOME} : $ENV{HOMEDRIVE}.$ENV{HOMEPATH}), $obj->{app} );
$obj->{add_prefs} = delete $args->{'-add_prefs'};
$obj->{about} = delete $args->{'-about'};
$obj->{help} = delete $args->{'-help'} || $0;
$obj->SUPER::Populate($args);
$obj->ConfigSpecs(
-set_logo => ["METHOD", "set_logo", "Set_Logo", undef],
-set_icon => ["METHOD", "set_icon", "Set_Icon", undef],
-init_menu => ["METHOD", "init_menu", "Init_Menu", undef],
-init_prefs => ["METHOD", "init_prefs", "Init_Prefs", undef],
-init_main => ["METHOD", "init_main", "Init_Main", undef],
-init_status => ["METHOD", "init_status", "Init_Status", undef],
-add_status => ["METHOD", "add_status", "Add_Status", undef],
-add_toolbar => ["METHOD", "add_toolbar", "Add_Toolbar", undef],
-config => ["METHOD", "config", "Config", undef],
-skin => ["METHOD", "skin", "Skin", undef],
-prefs => ["METHOD", "prefs", "Prefs", undef],
-splash => ["METHOD", "splash", "Splash", undef],
-exit => ["METHOD", "exit", "Exit", undef],
-exit_cb => ["CALLBACK", "exit_cb", "Exit_Cb", undef],
);
$obj->bind( "<Configure>", sub{ $obj->{opt}->{'Geometry'} = $obj->geometry } );
$obj->bind( "<Double-Escape>", sub { $obj->exit } );
$obj->Icon('-image' => $obj->Photo( -file => $obj->{icon} ) ) if($obj->{icon});
ApplicationNest.pm view on Meta::CPAN
$obj->init_menu();
$obj->init_main();
$obj->init_status();
$obj->packall();
$obj->Advertise('menu' => $obj->{menu});
$obj->Advertise('main' => $obj->{main});
$obj->Advertise('status' => $obj->{status});
$obj->init_prefs();
$obj->update;
}
# ------------------------------------------
sub exit {
# ------------------------------------------
my $obj = shift || return error('No Object');
$obj->Callback(-exit_cb);
$obj->save_prefs;
exit;
}
# ------------------------------------------
sub set_icon {
# ------------------------------------------
my $obj = shift || return error('No Object');
$obj->{icon} = shift || return $obj->{icon};
my $image = $obj->{icon};
ApplicationNest.pm view on Meta::CPAN
}
return $obj->{splash};
} else {
return error('Can\'t find a logo or text to display. Please define first -set_logo!');
}
}
# ------------------------------------------
sub prefs {
# ------------------------------------------
my $obj = shift || return error('No Object');
return error('Please call Tk::ApplicationNest::init_prefs before call prefs')
unless defined $obj->{optobj};
my $w = $obj->{optobj}->option_editor(
$obj,
-buttons => [qw/ok save cancel defaults/],
-delaypagecreate => 0,
-wait => 1,
-transient => $obj,
);
}
ApplicationNest.pm view on Meta::CPAN
-anchor => 'w')->pack(
-side => 'left',
-fill => 'x',
-expand => 1,
);
}
$obj->Advertise('status_'.$name => $w);
}
# ------------------------------------------
sub init_prefs {
# ------------------------------------------
my $obj = shift || return error('No Object');
return $obj->{optobj} if defined $obj->{optobj};
my $optionen = shift || $obj->get_prefs($obj->{add_prefs});
my %opts;
$obj->{opt} = \%opts;
$obj->{optobj} = Tk::Getopt->new(
-opttable => $optionen,
-options => \%opts,
-filename => $obj->{cfg}
);
$obj->{optobj}->set_defaults;
$obj->{optobj}->load_options;
if (! $obj->{optobj}->get_options) {
die $obj->{optobj}->usage;
}
$obj->{optobj}->process_options;
return $obj->{opt};
}
# ------------------------------------------
sub save_prefs {
# ------------------------------------------
my $obj = shift || return error('No Object');
return $obj->{optobj}->save_options()
if defined $obj->{optobj};
}
# ------------------------------------------
sub get_prefs {
# ------------------------------------------
my $obj = shift || return error('No Object');
my $to_add = shift || [];
if(! ref $to_add and -e $to_add) {
$to_add = $obj->load_config($to_add);
}
my $default =
ApplicationNest.pm view on Meta::CPAN
}
# ------------------------------------------
sub init_menu {
# ------------------------------------------
my $obj = shift || return error('No Object');
return $obj->{menu} if defined $obj->{menu};
my $menuitems = shift || [
[Cascade => "File", -menuitems =>
[
[Button => "Prefs", -command => sub{ $obj->prefs() } ],
[Button => "Quit", -command => sub{ $obj->exit }],
]
],
[Cascade => "Help", -menuitems =>
[
[Button => "Help", -command => sub{ $obj->help() } ],
[Button => "About", -command => sub{ $obj->about() } ],
]
ApplicationNest.pm view on Meta::CPAN
use Tk;
use Tk::ApplicationNest;
my $top = Tk::ApplicationNest->new(
-app => 'xpix',
-cfg => './testconfig.cfg',
-set_icon => './icon.gif',
-set_logo => './logo.gif',
-about => \$about,
-help => '../Tk/Program.pm',
-add_prefs => [
'Tools',
['acrobat', '=s', '/usr/local/bin/acroread',
{ 'subtype' => 'file',
'help' => 'Path to acrobat reader.'
} ],
],
);
MainLoop;
=head1 DESCRIPTION
This is a megawidget to display a program window. I was tired of creating
menues, prefs dialogues, about dialogues,... for every new application..... I
searched for a generic way wrote this module. This modules stores the main
window's font, size and position and embodies the fucntions from the
Tk::Mainwindow module.
=head1 WIDGET-SPECIFIC OPTIONS
=head2 -app => $Applikation_Name
Set a Application name, default is I<Program>
ApplicationNest.pm view on Meta::CPAN
=head2 -set_icon => $Path_to_icon_image
Set a Application Icon, please give this in 32x32 pixel and in gif format.
=head2 -cfg => $path_to_config_file;
Set the path to the config file, default:
$HOME/.$Application_Name.cfg
=head2 -add_prefs => $arrey_ref_more_prefs or $path_to_cfg_file;
This allows to include your Preferences into default:
-add_prefs => [
'Tools',
['acrobat', '=s', '/usr/local/bin/acroread',
{ 'subtype' => 'file',
'help' => 'Path to acrobat reader.'
} ],
],
Also you can use a config file as parameter:
-add_prefs => $path_to_cfg_file;
=head2 -set_logo => $image_file;
One logo for one program This picture will be use from the Splash and About
Method.
Carefully, if not defined in the Splash then an error is returned.
=head2 -help => $pod_file;
This includes a Help function as a topwindow with Poddisplay. Look for more
Information on Tk::Pod. Default is the program source ($0).
=head1 METHODS
These are the methods you can use with this Widget.
=head2 $top->init_prefs( I<$prefs> );
This will initialize the user or default preferences. It returns a
reference to the options hash. More information about the prefsobject look at
B<Tk::Getopt> from
slaven. The Program which uses this Module has a configuration dialog in tk
and on the commandline with the following standard options:
=over 4
=item I<Geometry>: Save the geometry (size and position) from mainwindow.
=item I<Font>: Save the font from mainwindow.
=item I<Color>: Save the color from mainwindow.
=back
In the Standard menu you find the preferences dialog under I<File - Prefs>.
I.E.:
my $opt = $top->init_prefs();
print $opt->{Geometry};
....
=head2 $top->prefs();
Display the Configuration dialog.
=head2 $top->set_icon( I<$path_to_icon> );
Set a new Icon at runtime.
=head2 $top->set_logo( I<$path_to_logo> );
Set a new Logo at runtime.
Tk::ApplicationNest
============================
This is a megawidget to display a program window. I was tyred in every
application to create a menu, prefs dialog, about .... I search for a
standard way and write this module. This remember the font, size and postion
from the Mainwindow and use also the function from Tk::Mainwindow.
INSTALLATION
To install this module type the following:
perl Makefile.PL
make
make test
demos/test.pl view on Meta::CPAN
© 2002 Netzwert AG
Berlin, Germany
|;
my $mw = Tk::ApplicationNest->new(
-app => 'xpix',
-cfg => './testconfig.cfg',
-set_logo => './logo.gif',
-about => \$about,
-help => '../Tk/ApplicationNest.pm',
-add_prefs => [
'Tools',
['acrobat', '=s', '/usr/local/bin/acroread',
{ 'subtype' => 'file',
'help' => 'Path to acrobat reader.'
} ],
],
);
# MENU ------------------------------
my $edit_menu = $mw->Menu();
( run in 0.845 second using v1.01-cache-2.11-cpan-8f98c5d2c55 )