r27395 - in /branches/upstream/libwx-perl-dialog-perl/current: ./ eg/ lib/ lib/Wx/ lib/Wx/Perl/ lib/Wx/Perl/Dialog/ t/ xt/
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Fri Nov 28 20:21:42 UTC 2008
Author: gregoa
Date: Fri Nov 28 20:21:39 2008
New Revision: 27395
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=27395
Log:
Load Wx-Perl-Dialog-0.02/ into
branches/upstream/libwx-perl-dialog-perl/current.
Added:
branches/upstream/libwx-perl-dialog-perl/current/Build.PL
branches/upstream/libwx-perl-dialog-perl/current/Changes
branches/upstream/libwx-perl-dialog-perl/current/MANIFEST
branches/upstream/libwx-perl-dialog-perl/current/META.yml
branches/upstream/libwx-perl-dialog-perl/current/README
branches/upstream/libwx-perl-dialog-perl/current/eg/
branches/upstream/libwx-perl-dialog-perl/current/eg/01_prompt.pl
branches/upstream/libwx-perl-dialog-perl/current/eg/02_password.pl
branches/upstream/libwx-perl-dialog-perl/current/eg/03_filename.pl
branches/upstream/libwx-perl-dialog-perl/current/eg/04_choice.pl
branches/upstream/libwx-perl-dialog-perl/current/eg/05_dir_selector.pl
branches/upstream/libwx-perl-dialog-perl/current/eg/06_single_choice.pl
branches/upstream/libwx-perl-dialog-perl/current/eg/07_single_choice.pl
branches/upstream/libwx-perl-dialog-perl/current/eg/08_dir_picker.pl
branches/upstream/libwx-perl-dialog-perl/current/eg/09_file_picker.pl
branches/upstream/libwx-perl-dialog-perl/current/eg/10_date_picker.pl
branches/upstream/libwx-perl-dialog-perl/current/eg/11_colour_picker.pl
branches/upstream/libwx-perl-dialog-perl/current/eg/wxer
branches/upstream/libwx-perl-dialog-perl/current/lib/
branches/upstream/libwx-perl-dialog-perl/current/lib/Wx/
branches/upstream/libwx-perl-dialog-perl/current/lib/Wx/Perl/
branches/upstream/libwx-perl-dialog-perl/current/lib/Wx/Perl/Dialog/
branches/upstream/libwx-perl-dialog-perl/current/lib/Wx/Perl/Dialog.pm
branches/upstream/libwx-perl-dialog-perl/current/lib/Wx/Perl/Dialog/Frame.pm
branches/upstream/libwx-perl-dialog-perl/current/lib/Wx/Perl/Dialog/Simple.pm
branches/upstream/libwx-perl-dialog-perl/current/lib/Wx/Perl/Dialog/SingleChoice.pm
branches/upstream/libwx-perl-dialog-perl/current/t/
branches/upstream/libwx-perl-dialog-perl/current/t/01-load.t
branches/upstream/libwx-perl-dialog-perl/current/xt/
branches/upstream/libwx-perl-dialog-perl/current/xt/90-pod.t
branches/upstream/libwx-perl-dialog-perl/current/xt/99-critic.t
Added: branches/upstream/libwx-perl-dialog-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwx-perl-dialog-perl/current/Build.PL?rev=27395&op=file
==============================================================================
--- branches/upstream/libwx-perl-dialog-perl/current/Build.PL (added)
+++ branches/upstream/libwx-perl-dialog-perl/current/Build.PL Fri Nov 28 20:21:39 2008
@@ -1,0 +1,73 @@
+use strict;
+use warnings;
+use Module::Build ();
+
+my %prereqs = (
+ 'perl' => '5.008',
+
+ 'Exporter' => 0,
+ 'File::Copy::Recursive' => 0,
+ 'File::Spec' => 0,
+ 'File::Spec::Functions' => 0,
+ 'FindBin' => 0,
+
+ 'Wx' => 0,
+ 'Wx::Perl::ProcessStream' => 0,
+);
+
+
+
+my $class = Module::Build->subclass(
+ class => 'Wx::Perl::Dialog::Install',
+ code => <<'END_SUBCLASS' );
+
+sub ACTION_code {
+ my $self = shift;
+
+ $self->SUPER::ACTION_code(@_);
+
+ use FindBin ();
+ use File::Spec::Functions qw(catfile catdir);
+ require File::Copy::Recursive;
+ import File::Copy::Recursive qw(dircopy);
+
+ my $dir = catdir($FindBin::Bin, 'blib', 'lib', 'auto', 'share', 'dist', $self->dist_name);
+ dircopy(catfile($FindBin::Bin, 'eg'), $dir);
+ return;
+}
+
+END_SUBCLASS
+
+use File::Spec::Functions qw(catdir);
+
+
+my $builder = $class->new(
+ module_name => 'Wx::Perl::Dialog',
+ license => 'perl',
+ dist_author => 'Gabor Szabo',
+ create_makefile_pl => 0,
+ create_readme => 0,
+ recursive_test_files => 0,
+
+ script_files => [ ],
+ requires => \%prereqs,
+ build_requires => {
+ 'Test::More' => '0.47',
+ 'Test::Exception' => 0,
+ 'Test::NoWarnings' => 0,
+ },
+ meta_merge => {
+ resources => {
+ homepage => 'http://padre.perlide.org/',
+ bugtracker => 'http://padre.perlide.org/',
+ Repository => 'http://svn.perlide.org/padre',
+ MailingList => 'http://mail.perlide.org/mailman/listinfo/padre-dev',
+ },
+ no_index => {
+ directory => [ qw{ t eg share } ],
+ },
+ },
+);
+
+$builder->create_build_script();
+
Added: branches/upstream/libwx-perl-dialog-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwx-perl-dialog-perl/current/Changes?rev=27395&op=file
==============================================================================
--- branches/upstream/libwx-perl-dialog-perl/current/Changes (added)
+++ branches/upstream/libwx-perl-dialog-perl/current/Changes Fri Nov 28 20:21:39 2008
@@ -1,0 +1,13 @@
+v0.02 2008.11.04
+
+ Add several new dialogs
+ Directory, File, Date and Colour pickers
+ Single Choice
+ Rename the class that provides the simple dialogs to
+ Wx::Perl::Dialog::Simple
+ The new Wx::Perl::Dialog was extracted from Padre after 0.15 was release.
+
+v0.01 2008.09.01
+
+ First version as Wx::Perl::Dialog
+ Moved from Padre::Demo after v0.06
Added: branches/upstream/libwx-perl-dialog-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwx-perl-dialog-perl/current/MANIFEST?rev=27395&op=file
==============================================================================
--- branches/upstream/libwx-perl-dialog-perl/current/MANIFEST (added)
+++ branches/upstream/libwx-perl-dialog-perl/current/MANIFEST Fri Nov 28 20:21:39 2008
@@ -1,0 +1,28 @@
+Build.PL
+Changes
+MANIFEST
+README
+META.yml
+
+lib/Wx/Perl/Dialog.pm
+lib/Wx/Perl/Dialog/Simple.pm
+lib/Wx/Perl/Dialog/Frame.pm
+lib/Wx/Perl/Dialog/SingleChoice.pm
+
+t/01-load.t
+
+xt/99-critic.t
+xt/90-pod.t
+
+eg/wxer
+eg/01_prompt.pl
+eg/02_password.pl
+eg/03_filename.pl
+eg/04_choice.pl
+eg/05_dir_selector.pl
+eg/06_single_choice.pl
+eg/07_single_choice.pl
+eg/08_dir_picker.pl
+eg/09_file_picker.pl
+eg/10_date_picker.pl
+eg/11_colour_picker.pl
Added: branches/upstream/libwx-perl-dialog-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwx-perl-dialog-perl/current/META.yml?rev=27395&op=file
==============================================================================
--- branches/upstream/libwx-perl-dialog-perl/current/META.yml (added)
+++ branches/upstream/libwx-perl-dialog-perl/current/META.yml Fri Nov 28 20:21:39 2008
@@ -1,0 +1,48 @@
+---
+name: Wx-Perl-Dialog
+version: 0.02
+author:
+ - Gabor Szabo
+abstract: Abstract dialog class for simple dialog creation
+license: perl
+resources:
+ MailingList: http://mail.perlide.org/mailman/listinfo/padre-dev
+ Repository: http://svn.perlide.org/padre
+ bugtracker: http://padre.perlide.org/
+ homepage: http://padre.perlide.org/
+ license: http://dev.perl.org/licenses/
+requires:
+ Exporter: 0
+ File::Copy::Recursive: 0
+ File::Spec: 0
+ File::Spec::Functions: 0
+ FindBin: 0
+ Wx: 0
+ Wx::Perl::ProcessStream: 0
+ perl: 5.008
+build_requires:
+ Test::Exception: 0
+ Test::More: 0.47
+ Test::NoWarnings: 0
+provides:
+ Wx::Perl::Dialog:
+ file: lib/Wx/Perl/Dialog.pm
+ version: 0.02
+ Wx::Perl::Dialog::Frame:
+ file: lib/Wx/Perl/Dialog/Frame.pm
+ version: 0.02
+ Wx::Perl::Dialog::Simple:
+ file: lib/Wx/Perl/Dialog/Simple.pm
+ version: 0.02
+ Wx::Perl::Dialog::SingleChoice:
+ file: lib/Wx/Perl/Dialog/SingleChoice.pm
+ version: 0.02
+generated_by: Module::Build version 0.2808
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
+no_index:
+ directory:
+ - t
+ - eg
+ - share
Added: branches/upstream/libwx-perl-dialog-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwx-perl-dialog-perl/current/README?rev=27395&op=file
==============================================================================
--- branches/upstream/libwx-perl-dialog-perl/current/README (added)
+++ branches/upstream/libwx-perl-dialog-perl/current/README Fri Nov 28 20:21:39 2008
@@ -1,0 +1,13 @@
+
+Wx::Perl::Dialog - a set of simple stand alone dialogs
+
+
+installation:
+
+Alien::WxWidgets
+Wx
+Wx::Perl::Dialog
+
+For more detailed instructions visit
+http://padre.perlide.org/
+
Added: branches/upstream/libwx-perl-dialog-perl/current/eg/01_prompt.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwx-perl-dialog-perl/current/eg/01_prompt.pl?rev=27395&op=file
==============================================================================
--- branches/upstream/libwx-perl-dialog-perl/current/eg/01_prompt.pl (added)
+++ branches/upstream/libwx-perl-dialog-perl/current/eg/01_prompt.pl Fri Nov 28 20:21:39 2008
@@ -1,0 +1,11 @@
+#!/usr/bin/perl
+
+use 5.008;
+use strict;
+use warnings;
+
+use lib 'lib';
+use Wx::Perl::Dialog::Simple;
+
+my $how = entry(title => "Asking Foo", prompt => "How are you today?");
+message(text => $how);
Added: branches/upstream/libwx-perl-dialog-perl/current/eg/02_password.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwx-perl-dialog-perl/current/eg/02_password.pl?rev=27395&op=file
==============================================================================
--- branches/upstream/libwx-perl-dialog-perl/current/eg/02_password.pl (added)
+++ branches/upstream/libwx-perl-dialog-perl/current/eg/02_password.pl Fri Nov 28 20:21:39 2008
@@ -1,0 +1,18 @@
+#!/usr/bin/perl
+
+use 5.008;
+use strict;
+use warnings;
+
+use lib 'lib';
+use Wx::Perl::Dialog::Simple;
+
+
+my $empty = password();
+message(text => $empty);
+
+#my $name = entry(title => "What is your name?");
+#display_text("How are you $name today?\n");
+
+#my $how = entry(title => $name, prompt => "How are you?");
+#display_text("$name, $how");
Added: branches/upstream/libwx-perl-dialog-perl/current/eg/03_filename.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwx-perl-dialog-perl/current/eg/03_filename.pl?rev=27395&op=file
==============================================================================
--- branches/upstream/libwx-perl-dialog-perl/current/eg/03_filename.pl (added)
+++ branches/upstream/libwx-perl-dialog-perl/current/eg/03_filename.pl Fri Nov 28 20:21:39 2008
@@ -1,0 +1,14 @@
+#!/usr/bin/perl
+
+use 5.008;
+use strict;
+use warnings;
+
+use lib 'lib';
+use Wx::Perl::Dialog::Simple;
+
+my $filename = file_selector();
+message(text => "The file you selected is $filename\n");
+
+my $file = file_selector(title => "Select source file");
+message(text => "The file you selected is $file\n");
Added: branches/upstream/libwx-perl-dialog-perl/current/eg/04_choice.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwx-perl-dialog-perl/current/eg/04_choice.pl?rev=27395&op=file
==============================================================================
--- branches/upstream/libwx-perl-dialog-perl/current/eg/04_choice.pl (added)
+++ branches/upstream/libwx-perl-dialog-perl/current/eg/04_choice.pl Fri Nov 28 20:21:39 2008
@@ -1,0 +1,10 @@
+#!/usr/bin/perl
+
+use 5.008;
+use strict;
+use warnings;
+
+use lib 'lib';
+use Wx::Perl::Dialog::Simple;
+
+print map {"$_\n"} choice( choices => [qw(a b c)] );
Added: branches/upstream/libwx-perl-dialog-perl/current/eg/05_dir_selector.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwx-perl-dialog-perl/current/eg/05_dir_selector.pl?rev=27395&op=file
==============================================================================
--- branches/upstream/libwx-perl-dialog-perl/current/eg/05_dir_selector.pl (added)
+++ branches/upstream/libwx-perl-dialog-perl/current/eg/05_dir_selector.pl Fri Nov 28 20:21:39 2008
@@ -1,0 +1,13 @@
+#!/usr/bin/perl
+
+use 5.008;
+use strict;
+use warnings;
+
+use lib 'lib';
+use Wx::Perl::Dialog::Simple;
+
+
+my $empty = dir_selector();
+message(text => $empty);
+
Added: branches/upstream/libwx-perl-dialog-perl/current/eg/06_single_choice.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwx-perl-dialog-perl/current/eg/06_single_choice.pl?rev=27395&op=file
==============================================================================
--- branches/upstream/libwx-perl-dialog-perl/current/eg/06_single_choice.pl (added)
+++ branches/upstream/libwx-perl-dialog-perl/current/eg/06_single_choice.pl Fri Nov 28 20:21:39 2008
@@ -1,0 +1,10 @@
+#!/usr/bin/perl
+
+use 5.008;
+use strict;
+use warnings;
+
+use lib 'lib';
+use Wx::Perl::Dialog::Simple;
+
+print map {"$_\n"} single_choice( choices => [qw(a b c)] );
Added: branches/upstream/libwx-perl-dialog-perl/current/eg/07_single_choice.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwx-perl-dialog-perl/current/eg/07_single_choice.pl?rev=27395&op=file
==============================================================================
--- branches/upstream/libwx-perl-dialog-perl/current/eg/07_single_choice.pl (added)
+++ branches/upstream/libwx-perl-dialog-perl/current/eg/07_single_choice.pl Fri Nov 28 20:21:39 2008
@@ -1,0 +1,9 @@
+use strict;
+use warnings;
+
+use Wx qw(:everything);
+use Wx::Event qw(:everything);
+
+use Wx::Perl::Dialog::SingleChoice;
+print Wx::Perl::Dialog::SingleChoice::dialog( title => 'Select one', values => ['a'..'d'] ), "\n";
+
Added: branches/upstream/libwx-perl-dialog-perl/current/eg/08_dir_picker.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwx-perl-dialog-perl/current/eg/08_dir_picker.pl?rev=27395&op=file
==============================================================================
--- branches/upstream/libwx-perl-dialog-perl/current/eg/08_dir_picker.pl (added)
+++ branches/upstream/libwx-perl-dialog-perl/current/eg/08_dir_picker.pl Fri Nov 28 20:21:39 2008
@@ -1,0 +1,13 @@
+#!/usr/bin/perl
+
+use 5.008;
+use strict;
+use warnings;
+
+use lib 'lib';
+use Wx::Perl::Dialog::Simple;
+
+my $empty = dir_picker() || '';
+print "$empty\n";
+message(text => $empty);
+
Added: branches/upstream/libwx-perl-dialog-perl/current/eg/09_file_picker.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwx-perl-dialog-perl/current/eg/09_file_picker.pl?rev=27395&op=file
==============================================================================
--- branches/upstream/libwx-perl-dialog-perl/current/eg/09_file_picker.pl (added)
+++ branches/upstream/libwx-perl-dialog-perl/current/eg/09_file_picker.pl Fri Nov 28 20:21:39 2008
@@ -1,0 +1,13 @@
+#!/usr/bin/perl
+
+use 5.008;
+use strict;
+use warnings;
+
+use lib 'lib';
+use Wx::Perl::Dialog::Simple;
+
+my $empty = file_picker() || '';
+print "$empty\n";
+message(text => $empty);
+
Added: branches/upstream/libwx-perl-dialog-perl/current/eg/10_date_picker.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwx-perl-dialog-perl/current/eg/10_date_picker.pl?rev=27395&op=file
==============================================================================
--- branches/upstream/libwx-perl-dialog-perl/current/eg/10_date_picker.pl (added)
+++ branches/upstream/libwx-perl-dialog-perl/current/eg/10_date_picker.pl Fri Nov 28 20:21:39 2008
@@ -1,0 +1,13 @@
+#!/usr/bin/perl
+
+use 5.008;
+use strict;
+use warnings;
+
+use lib 'lib';
+use Wx::Perl::Dialog::Simple;
+
+my $empty = date_picker() || '';
+print "$empty\n";
+message(text => $empty);
+
Added: branches/upstream/libwx-perl-dialog-perl/current/eg/11_colour_picker.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwx-perl-dialog-perl/current/eg/11_colour_picker.pl?rev=27395&op=file
==============================================================================
--- branches/upstream/libwx-perl-dialog-perl/current/eg/11_colour_picker.pl (added)
+++ branches/upstream/libwx-perl-dialog-perl/current/eg/11_colour_picker.pl Fri Nov 28 20:21:39 2008
@@ -1,0 +1,14 @@
+#!/usr/bin/perl
+
+use 5.008;
+use strict;
+use warnings;
+
+use lib 'lib';
+use Wx::Perl::Dialog::Simple;
+
+my $empty = colour_picker() || '';
+my $str = sprintf("%x%x%x", @$empty);
+print "$str\n";
+message(text => $str);
+
Added: branches/upstream/libwx-perl-dialog-perl/current/eg/wxer
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwx-perl-dialog-perl/current/eg/wxer?rev=27395&op=file
==============================================================================
--- branches/upstream/libwx-perl-dialog-perl/current/eg/wxer (added)
+++ branches/upstream/libwx-perl-dialog-perl/current/eg/wxer Fri Nov 28 20:21:39 2008
@@ -1,0 +1,51 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use Getopt::Long qw(GetOptions);
+
+use Wx::Perl::Dialog::Simple ();
+
+
+my %opt;
+
+GetOptions( \%opt,
+ "entry",
+ "file-selection",
+
+ "title=s",
+
+ "help",
+) or usage();
+
+
+
+if ($opt{help}) {
+ usage();
+}
+
+usage() unless $opt{entry} xor $opt{'file-selection'};
+
+if ($opt{entry}) {
+ print Wx::Perl::Dialog::Simple::entry( %opt );
+} elsif ($opt{'file-selection'}) {
+ print Wx::Perl::Dialog::Simple::file_selector( %opt );
+} else {
+ usage();
+}
+
+
+
+sub usage {
+ die <<"USAGE";
+Usage: $0
+ --entry
+ --file-selection
+
+
+ --title TITLE
+
+ --help This help
+USAGE
+
+}
Added: branches/upstream/libwx-perl-dialog-perl/current/lib/Wx/Perl/Dialog.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwx-perl-dialog-perl/current/lib/Wx/Perl/Dialog.pm?rev=27395&op=file
==============================================================================
--- branches/upstream/libwx-perl-dialog-perl/current/lib/Wx/Perl/Dialog.pm (added)
+++ branches/upstream/libwx-perl-dialog-perl/current/lib/Wx/Perl/Dialog.pm Fri Nov 28 20:21:39 2008
@@ -1,0 +1,291 @@
+package Wx::Perl::Dialog;
+
+use 5.008;
+use strict;
+use warnings;
+
+our $VERSION = '0.02';
+
+use Wx ':everything';
+
+use base 'Wx::Dialog';
+
+=head1 NAME
+
+Wx::Perl::Dialog - Abstract dialog class for simple dialog creation
+
+=head1 SYNOPSIS
+
+ my $layout = [
+ [
+ [ 'Wx::StaticText', undef, 'Some text entry'],
+ [ 'Wx::TextCtrl', 'name_of', 'Default value' ],
+ ],
+ [
+ [ 'Wx::Button', 'ok', Wx::wxID_OK ],
+ [ 'Wx::Button', 'cancel', Wx::wxID_CANCEL ],
+ ],
+ ];
+
+ my $dialog = Wx::Perl::Dialog->new(
+ parent => $win,
+ title => 'Widgetry dialog',
+ layout => $layout,
+ width => [150, 200],
+ );
+
+ return if not $dialog->show_modal;
+
+
+Where $win is the Wx::Frame of your application.
+
+
+=head1 DESCRIPTION
+
+=head2 Layout
+
+The layout is reference to a two dimensional array.
+Every element (an array) represents one line in the dialog.
+
+Every element in the internal array is an array that describes a widget.
+
+The first value in each widget description is the type of the widget.
+
+The second value is an identifyer (or undef if we don't need any access to the widget).
+
+The widget will be accessible form the dialog object using $dialog->{_widgets_}{identifyer}
+
+The rest of the values in the array depend on the widget.
+
+Supported widgets and their parameters:
+
+=over 4
+
+=item Wx::StaticText
+
+ 3.: "the text",
+
+=item Wx::Button
+
+ 3.: button type (stock item such as Wx::wxID_OK or string "&do this")
+
+=item Wx::DirPickerCtrl
+
+ 3. default directory (must be '') ???
+ 4. title to show on the directory browser
+
+=item Wx::TextCtrl
+
+ 3. default value, if any
+
+=item Wx::Treebook
+
+ 3. array ref for list of values
+
+=back
+
+=head1 METHODS
+
+=cut
+
+=head2 new
+
+=cut
+
+sub new {
+ my ($class, %args) = @_;
+
+ my %default = (
+ parent => undef,
+ id => -1,
+ style => Wx::wxDEFAULT_FRAME_STYLE,
+ title => '',
+ pos => [-1, -1],
+ size => [-1, -1],
+
+ top => 5,
+ left => 5,
+ bottom => 20,
+ right => 5,
+ element_spacing => [0, 5],
+ );
+ %args = (%default, %args);
+
+ my $self = $class->SUPER::new( @args{qw(parent id title pos size style)});
+ $self->_build_layout( map {$_ => $args{$_} } qw(layout width top left bottom right element_spacing) );
+ $self->{_layout_} = $args{layout};
+
+ return $self;
+}
+
+=head2 get_data
+
+ my $data = $dialog->get_data;
+
+Returns a hash with the keys being the names you gave for each widgets
+and the value being the value of that widget in the dialog.
+
+=cut
+
+sub get_data {
+ my ( $dialog ) = @_;
+
+ my $layout = $dialog->{_layout_};
+ my %data;
+ foreach my $i (0..@$layout-1) {
+ foreach my $j (0..@{$layout->[$i]}-1) {
+ next if not @{ $layout->[$i][$j] }; # [] means Expand
+ my ($class, $name, $arg, @params) = @{ $layout->[$i][$j] };
+ if ($name) {
+ next if $class eq 'Wx::Button';
+
+ if ($class eq 'Wx::DirPickerCtrl') {
+ $data{$name} = $dialog->{_widgets_}{$name}->GetPath;
+ } elsif ($class eq 'Wx::FilePickerCtrl') {
+ $data{$name} = $dialog->{_widgets_}{$name}->GetPath;
+ } elsif ($class eq 'Wx::Choice') {
+ $data{$name} = $dialog->{_widgets_}{$name}->GetSelection;
+ } else {
+ $data{$name} = $dialog->{_widgets_}{$name}->GetValue;
+ }
+ }
+ }
+ }
+
+ return \%data;
+}
+
+=head2 show_modal
+
+Helper function that will probably change soon...
+
+ return if not $dialog->show_modal;
+
+=cut
+
+sub show_modal {
+ my ( $dialog ) = @_;
+
+ my $ret = $dialog->ShowModal;
+ if ( $ret eq Wx::wxID_CANCEL ) {
+ $dialog->Destroy;
+ return;
+ } else {
+ return $ret;
+ }
+}
+
+
+# Internal function
+#
+# $dialog->_build_layout(
+# layout => $layout,
+# width => $width,
+# top => $top
+# left => $left,
+# element_spacing => $element_spacing,
+# );
+#
+sub _build_layout {
+ my ($dialog, %args) = @_;
+
+ # TODO make sure width has enough elements to the widest row
+ # or maybe we should also check that all the rows has the same number of elements
+ my $box = Wx::BoxSizer->new( Wx::wxVERTICAL );
+
+ # Add top margin
+ $box->Add(0, $args{top}, 0) if $args{top};
+
+ foreach my $i (0..@{$args{layout}}-1) {
+ my $row = Wx::BoxSizer->new( Wx::wxHORIZONTAL );
+ $box->Add(0, $args{element_spacing}[1], 0) if $args{element_spacing}[1] and $i;
+ $box->Add($row);
+
+ # Add left margin
+ $row->Add($args{left}, 0, 0) if $args{left};
+
+ foreach my $j (0..@{$args{layout}[$i]}-1) {
+ my $width = [$args{width}[$j], -1];
+
+ if (not @{ $args{layout}[$i][$j] } ) { # [] means Expand
+ $row->Add($args{width}[$j], 0, 0, Wx::wxEXPAND, 0);
+ next;
+ }
+ $row->Add($args{element_spacing}[0], 0, 0) if $args{element_spacing}[0] and $j;
+ my ($class, $name, $arg, @params) = @{ $args{layout}[$i][$j] };
+
+ my $widget;
+ if ($class eq 'Wx::StaticText') {
+ $widget = $class->new( $dialog, -1, $arg, Wx::wxDefaultPosition, $width );
+ } elsif ($class eq 'Wx::Button') {
+ my $s = Wx::Button::GetDefaultSize;
+ #print $s->GetWidth, " ", $s->GetHeight, "\n";
+ my @args = $arg =~ /[a-zA-Z]/ ? (-1, $arg) : ($arg, '');
+ my $size = Wx::Button::GetDefaultSize();
+ $widget = $class->new( $dialog, @args, Wx::wxDefaultPosition, $size );
+ } elsif ($class eq 'Wx::DirPickerCtrl') {
+ my $title = shift(@params) || '';
+ $widget = $class->new( $dialog, -1, $arg, $title, Wx::wxDefaultPosition, $width );
+ # it seems we cannot set the default directory and
+ # we still have to set this directory in order to get anything back in
+ # GetPath
+ $widget->SetPath(Cwd::cwd());
+ } elsif ($class eq 'Wx::FilePickerCtrl') {
+ my $title = shift(@params) || '';
+ $widget = $class->new( $dialog, -1, $arg, $title, Wx::wxDefaultPosition, $width );
+ $widget->SetPath(Cwd::cwd());
+ } elsif ($class eq 'Wx::TextCtrl') {
+ $widget = $class->new( $dialog, -1, $arg, Wx::wxDefaultPosition, $width );
+ } elsif ($class eq 'Wx::CheckBox') {
+ my $default = shift @params;
+ $widget = $class->new( $dialog, -1, $arg, Wx::wxDefaultPosition, $width, @params );
+ $widget->SetValue($default);
+ } elsif ($class eq 'Wx::ComboBox') {
+ $widget = $class->new( $dialog, -1, $arg, Wx::wxDefaultPosition, $width, @params );
+ } elsif ($class eq 'Wx::Choice') {
+ $widget = $class->new( $dialog, -1, Wx::wxDefaultPosition, $width, $arg, @params );
+ $widget->SetSelection(0);
+ } elsif ($class eq 'Wx::Treebook') {
+ my $height = @$arg * 27; # should be height of font
+ $widget = $class->new( $dialog, -1, Wx::wxDefaultPosition, [$args{width}[$j], $height] );
+ foreach my $name ( @$arg ) {
+ my $count = $widget->GetPageCount;
+ my $page = Wx::Panel->new( $widget );
+ $widget->AddPage( $page, $name, 0, $count );
+ }
+ } else {
+ warn "Unsupported widget $class\n";
+ next;
+ }
+
+ $row->Add($widget);
+
+ if ($name) {
+ $dialog->{_widgets_}{$name} = $widget;
+ }
+ }
+ $row->Add($args{right}, 0, 0, Wx::wxEXPAND, 0) if $args{right}; # margin
+ }
+ $box->Add(0, $args{bottom}, 0) if $args{bottom}; # margin
+
+ $dialog->SetSizerAndFit($box);
+
+ return;
+}
+
+=head1 BUGS
+
+Please submit bugs you find on L<http://padre.perlide.org/>
+
+=head1 COPYRIGHT
+
+Copyright 2008 Gabor Szabo. L<http://www.szabgab.com/>
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl 5 itself.
+
+=cut
+
+1;
Added: branches/upstream/libwx-perl-dialog-perl/current/lib/Wx/Perl/Dialog/Frame.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwx-perl-dialog-perl/current/lib/Wx/Perl/Dialog/Frame.pm?rev=27395&op=file
==============================================================================
--- branches/upstream/libwx-perl-dialog-perl/current/lib/Wx/Perl/Dialog/Frame.pm (added)
+++ branches/upstream/libwx-perl-dialog-perl/current/lib/Wx/Perl/Dialog/Frame.pm Fri Nov 28 20:21:39 2008
@@ -1,0 +1,49 @@
+package Wx::Perl::Dialog::Frame;
+
+use 5.008;
+use strict;
+use warnings;
+use File::Spec ();
+use Wx qw(:everything);
+use Wx::STC ();
+use Wx::Event qw(:everything);
+use Wx::Perl::Dialog::Frame ();
+use base 'Wx::Frame';
+
+our $VERSION = '0.02';
+
+sub new {
+ my ($class) = @_;
+
+ my $self = $class->SUPER::new(
+ undef,
+ -1,
+ 'Wx::Perl::Dialog',
+ wxDefaultPosition,
+ wxDefaultSize,
+ );
+
+
+# EVT_ACTIVATE($self, \&on_activate);
+ Wx::Event::EVT_CLOSE( $self, sub {
+ my ( $self, $event ) = @_;
+ $event->Skip;
+ } );
+
+ return $self;
+}
+
+sub on_activate {
+ my ($frame, $event) = @_;
+
+ $frame->EVT_ACTIVATE(sub {});
+ #$Wx::Perl::Dialog::app->Yield;
+ return $Wx::Perl::Dialog::main->($frame);
+}
+
+1;
+
+# Copyright 2008 Gabor Szabo.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
Added: branches/upstream/libwx-perl-dialog-perl/current/lib/Wx/Perl/Dialog/Simple.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwx-perl-dialog-perl/current/lib/Wx/Perl/Dialog/Simple.pm?rev=27395&op=file
==============================================================================
--- branches/upstream/libwx-perl-dialog-perl/current/lib/Wx/Perl/Dialog/Simple.pm (added)
+++ branches/upstream/libwx-perl-dialog-perl/current/lib/Wx/Perl/Dialog/Simple.pm Fri Nov 28 20:21:39 2008
@@ -1,0 +1,417 @@
+package Wx::Perl::Dialog::Simple;
+
+use 5.008;
+use strict;
+use warnings;
+
+use base 'Exporter';
+use File::Spec;
+
+our $VERSION = '0.02';
+
+$| = 1;
+
+our @EXPORT = qw(
+ entry
+ password
+ file_selector
+ dir_selector
+ dir_picker
+ file_picker
+ date_picker
+ colour_picker
+ choice
+ single_choice
+ message
+ calendar
+ );
+# print_out close_app open_frame display_text
+
+use Wx qw(:everything);
+#qw(wxID_CANCEL wxID_OK wxOK wxFD_OPEN :sizer :datepicker);
+use Wx::STC ();
+use Wx::Event qw(:everything);
+
+=head1 NAME
+
+Wx::Perl::Dialog::Simple - a set of simple dialogs (a partial Zenity clone in wxPerl)
+
+=head1 SYNOPIS
+
+As a module:
+
+ use Wx::Perl::Dialog::Simple;
+
+ my $name = entry(title => "What is your name?");
+ message(text => "How are you $name today?\n");
+
+
+On the command line try
+
+ wxer --help
+
+=head1 General Options
+
+There are some common option for every dialog
+
+title
+
+window-icon NA
+
+width NA
+
+height NA
+
+=cut
+
+=head1 METHODS
+
+Dialogs
+
+=head2 entry
+
+Display a text entry dialog
+
+=cut
+
+sub entry {
+ my ( %args ) = @_;
+
+ %args = (
+ title => '',
+ prompt => '',
+ default => '',
+ %args);
+
+ my $class = $args{password} ? 'Wx::PasswordEntryDialog' : 'Wx::TextEntryDialog';
+ my $dialog = $class->new( undef, $args{prompt}, $args{title}, $args{default} );
+ if ($dialog->ShowModal == wxID_CANCEL) {
+ return;
+ }
+ my $resp = $dialog->GetValue;
+ $dialog->Destroy;
+ return $resp;
+}
+
+=head2 password
+
+=cut
+
+sub password {
+ my ( %args ) = @_;
+
+ $args{password} = 1;
+
+ return entry( %args );
+}
+
+=head2 file_selector
+
+=cut
+
+sub file_selector {
+ my ( %args ) = @_;
+ %args = (
+ title => '',
+ %args);
+
+ my $dialog = Wx::FileDialog->new( undef, $args{title}, '', "", "*.*", wxFD_OPEN);
+ if ($^O !~ /win32/i) {
+ $dialog->SetWildcard("*");
+ }
+ if ($dialog->ShowModal == wxID_CANCEL) {
+ return;
+ }
+ my $filename = $dialog->GetFilename;
+ my $default_dir = $dialog->GetDirectory;
+
+ return File::Spec->catfile($default_dir, $filename);
+}
+
+=head2 dir_selector
+
+=cut
+
+sub dir_selector {
+ my ( %args ) = @_;
+ %args = (
+ title => '',
+ path => '',
+ %args);
+
+ my $dialog = Wx::DirDialog->new( undef, $args{title}, $args{path});
+ if ($dialog->ShowModal == wxID_CANCEL) {
+ return;
+ }
+ my $dir = $dialog->GetPath;
+
+ return $dir;
+}
+
+=head2 date_picker
+
+=cut
+
+sub date_picker {
+
+ require Wx::DateTime;
+ require Wx::Calendar;
+ my $date = Wx::DateTime->newFromDMY( 8, 0, 1979, 1, 1, 1, 1 );
+ my $calendar = Wx::DatePickerCtrl->new( undef, -1, $date );
+
+ return dialog(
+ sub { Wx::DatePickerCtrl->new( $_[0], -1 ) },
+ sub { $_[0]; },
+ sub { $_[0]->GetValue->Format; },
+ {
+ title => 'Select date',
+ },
+ );
+}
+
+=head2 colour_picker
+
+=cut
+
+sub colour_picker {
+
+ return dialog(
+ sub { Wx::ColourPickerCtrl->new( $_[0], -1 ) },
+ sub { $_[0]; },
+ sub { my $c = $_[0]->GetColour; return [$c->Red, $c->Green, $c->Blue] },
+ {
+ title => 'Select colour',
+ },
+ );
+}
+
+=head2 file_picker
+
+=cut
+
+sub file_picker {
+
+ require Cwd;
+ return dialog(
+ sub { Wx::FilePickerCtrl->new( $_[0] ) },
+ sub { $_[0]->SetPath(Cwd::cwd()) }, # setup
+ sub { $_[0]->GetPath; }, # get data
+ {
+ title => 'Select file',
+ },
+ );
+}
+
+=head2 dir_picker
+
+=cut
+
+sub dir_picker {
+ require Cwd;
+ return dialog(
+ sub { Wx::DirPickerCtrl->new( $_[0] ) },
+ sub { $_[0]->SetPath(Cwd::cwd()) }, # setup
+ sub { $_[0]->GetPath; }, # get data
+ {
+ title => 'Select directory',
+ },
+ );
+}
+
+=head2 dialog
+
+Generic dialog, with two buttons and a place for some control.
+It needs 4 parameters: 3 subroutines and a hash-ref
+
+ dialog(
+ sub { create_and_return_the_control },
+ sub { setup_data_in_the control },
+ sub { fetch_and_return_data_from_the_control },
+ {
+ title => "",
+ other arguments,
+ }
+
+=cut
+
+sub dialog {
+ my ($control, $setup, $getdata, $args) = @_;
+
+ $args ||= {};
+ $args->{title} ||= '';
+
+ my $dialog = Wx::Dialog->new( undef, -1, $args->{title} );
+ my $ctrl = $control->($dialog);
+ my $ok = Wx::Button->new( $dialog, wxID_OK, '');
+ my $cancel = Wx::Button->new( $dialog, wxID_CANCEL, '', [-1, -1], $ok->GetSize);
+
+ my $box = Wx::BoxSizer->new( wxVERTICAL );
+ my $top = Wx::BoxSizer->new( wxHORIZONTAL );
+ my $buttons = Wx::BoxSizer->new( wxHORIZONTAL );
+ $box->Add($top);
+ $box->Add($buttons);
+ $top->Add($ctrl);
+ $buttons->Add($ok);
+ $buttons->Add($cancel);
+ $ok->SetDefault;
+ $dialog->SetSizer($box);
+
+
+ my ($bw, $bh) = $ok->GetSizeWH;
+ my ($w, $h) = $ctrl->GetSizeWH;
+ $dialog->SetSize($bw*2, $h+$bh+20);
+
+ $setup->($ctrl);
+
+
+ if ($dialog->ShowModal == wxID_CANCEL) {
+ return;
+ }
+
+ my $data = $getdata->($ctrl);
+
+ $dialog->Destroy;
+
+ return $data;
+}
+
+
+=head2 choice
+
+=cut
+
+sub choice {
+ my ( %args ) = @_;
+ %args = (
+ title => '',
+ message => '',
+ choices => [],
+
+ %args);
+
+ my $dialog = Wx::MultiChoiceDialog->new( undef, $args{message}, $args{title}, $args{choices});
+ if ($dialog->ShowModal == wxID_CANCEL) {
+ return;
+ }
+ return map {$args{choices}[$_]} $dialog->GetSelections;
+}
+
+sub single_choice {
+ my ( %args ) = @_;
+ %args = (
+ title => '',
+ message => '',
+ choices => [],
+
+ %args);
+
+ my $dialog = Wx::SingleChoiceDialog->new( undef, $args{message}, $args{title}, $args{choices});
+ if ($dialog->ShowModal == wxID_CANCEL) {
+ return;
+ }
+ return $args{choices}[ $dialog->GetSelection ];
+}
+
+
+
+
+#=head2 print_out
+#
+#=cut
+
+#sub print_out {
+# my ($output, $text) = @_;
+# $output->AddText($text);
+# #$Wx::Perl::Dialog::Simple::app->Yield;
+# return;
+#}
+#
+
+=head2 message
+
+=cut
+
+sub message {
+ my ( %args ) = @_;
+
+ %args = (
+ title => '',
+ text => '',
+
+ %args);
+
+ Wx::MessageBox( $args{text}, $args{title}, wxOK|wxCENTRE);
+
+ return;
+}
+
+#=head2 calendar
+#
+#=cut
+
+#sub calendar {
+# my ( %args ) = @_;
+#
+# my $cal = Wx::CalendarCtrl->new();
+# $cal->Show;
+#
+# return;
+#}
+#
+
+#=head2 open_frame
+#
+#=cut
+
+#sub open_frame {
+# my $frame = Wx::Perl::Dialog::Frame->new;
+# my $output = Wx::StyledTextCtrl->new($frame, -1, [-1, -1], [750, 700]);
+# $output->SetMarginWidth(1, 0);
+# $frame->Show( 1 );
+# return $output;
+#}
+#
+#
+#=head2 close_app
+#
+#=cut
+
+#sub close_app {
+## $frame->Close;
+#}
+#
+
+
+#our $main;
+#our $app;
+
+=head1 SUPPORT
+
+See L<http://padre.perlide.org/>
+
+=head1 COPYRIGHT
+
+Copyright 2008 Gabor Szabo. L<http://www.szabgab.com/>
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl 5 itself.
+
+=head1 WARRANTY
+
+There is no warranty whatsoever.
+If you lose data or your hair because of this program,
+that's your problem.
+
+=head1 CREDITS and THANKS
+
+To Mattia Barbon for providing WxPerl.
+
+The idea was taken from the Zenity project.
+
+=cut
+
+
+
+1;
Added: branches/upstream/libwx-perl-dialog-perl/current/lib/Wx/Perl/Dialog/SingleChoice.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwx-perl-dialog-perl/current/lib/Wx/Perl/Dialog/SingleChoice.pm?rev=27395&op=file
==============================================================================
--- branches/upstream/libwx-perl-dialog-perl/current/lib/Wx/Perl/Dialog/SingleChoice.pm (added)
+++ branches/upstream/libwx-perl-dialog-perl/current/lib/Wx/Perl/Dialog/SingleChoice.pm Fri Nov 28 20:21:39 2008
@@ -1,0 +1,83 @@
+package Wx::Perl::Dialog::SingleChoice;
+
+use strict;
+use warnings;
+
+use Wx qw(:everything);
+use Wx::Event qw(:everything);
+
+our $VERSION = '0.02';
+
+$| = 1;
+
+=head1 NAME
+
+Wx::Perl::Dialog::SingleChoice - a single choice dialog
+
+=head1 SYNOPSIS
+
+ use Wx::Perl::Dialog::SingleChoice;
+ print Wx::Perl::Dialog::SingleChoice::dialog( title => 'Select one', values => ['a'..'d'] ), "\n";
+
+=cut
+
+sub dialog {
+ my ( %args ) = @_;
+ $args{title} ||= '';
+ $args{values} ||= [];
+
+ return if not @{ $args{values} };
+
+ my $box = Wx::BoxSizer->new( wxVERTICAL );
+ my $row1 = Wx::BoxSizer->new( wxHORIZONTAL );
+ my $row2 = Wx::BoxSizer->new( wxHORIZONTAL );
+ $box->Add($row1);
+ $box->Add($row2);
+
+ my $dialog = Wx::Dialog->new(undef);
+ $dialog->SetTitle( $args{title} );
+ my $height = @{ $args{values} } * 25; # should be height of font
+ my $width = 25; # should be widest string?
+
+ my $tb = Wx::Treebook->new( $dialog, -1, [-1, -1], [$width, $height] );
+ foreach my $name ( @{ $args{values} } ) {
+ my $count = $tb->GetPageCount;
+ my $page = Wx::Panel->new( $tb );
+ $tb->AddPage( $page, $name, 0, $count );
+ }
+ $tb->SetFocus;
+
+ my $ok = Wx::Button->new( $dialog, wxID_OK, '' );
+ EVT_BUTTON( $dialog, $ok, sub { $dialog->EndModal(wxID_OK) } );
+ $ok->SetDefault;
+
+ my $cancel = Wx::Button->new( $dialog, wxID_CANCEL, '', [-1, -1], $ok->GetSize);
+ EVT_BUTTON( $dialog, $cancel, sub { $dialog->EndModal(wxID_CANCEL) } );
+
+ $row1->Add( $tb );
+ $row2->Add( $ok );
+ $row2->Add( $cancel );
+ $dialog->SetSizer($box);
+ my ($bw, $bh) = $ok->GetSizeWH;
+
+ my $dialog_width = $width > 2* $bw ? $width : 2 *$bw;
+ $dialog->SetSize(-1, -1, $dialog_width, $height + $bh);
+
+
+ my $ret = $dialog->ShowModal;
+ if ( $ret eq wxID_CANCEL ) {
+ $dialog->Destroy;
+ return;
+ }
+ my $value = $args{values}[ $tb->GetSelection ];
+ $dialog->Destroy;
+
+ return $value;
+}
+
+1;
+
+# Copyright 2008 Gabor Szabo.
+# LICENSE
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl 5 itself.
Added: branches/upstream/libwx-perl-dialog-perl/current/t/01-load.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwx-perl-dialog-perl/current/t/01-load.t?rev=27395&op=file
==============================================================================
--- branches/upstream/libwx-perl-dialog-perl/current/t/01-load.t (added)
+++ branches/upstream/libwx-perl-dialog-perl/current/t/01-load.t Fri Nov 28 20:21:39 2008
@@ -1,0 +1,21 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+my $tests;
+
+plan tests => $tests;
+
+use Wx::Perl::Dialog;
+use Wx::Perl::Dialog::Simple;
+
+ok(1, "test_app done");
+BEGIN { $tests += 1; }
+
+#{
+#my $entry = entry();
+#}
+
+
Added: branches/upstream/libwx-perl-dialog-perl/current/xt/90-pod.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwx-perl-dialog-perl/current/xt/90-pod.t?rev=27395&op=file
==============================================================================
--- branches/upstream/libwx-perl-dialog-perl/current/xt/90-pod.t (added)
+++ branches/upstream/libwx-perl-dialog-perl/current/xt/90-pod.t Fri Nov 28 20:21:39 2008
@@ -1,0 +1,3 @@
+use Test::More;
+plan skip_all => 'Needs Test::Pod' if not eval "use Test::Pod; 1";
+all_pod_files_ok();
Added: branches/upstream/libwx-perl-dialog-perl/current/xt/99-critic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwx-perl-dialog-perl/current/xt/99-critic.t?rev=27395&op=file
==============================================================================
--- branches/upstream/libwx-perl-dialog-perl/current/xt/99-critic.t (added)
+++ branches/upstream/libwx-perl-dialog-perl/current/xt/99-critic.t Fri Nov 28 20:21:39 2008
@@ -1,0 +1,7 @@
+use strict;
+use warnings;
+
+use Test::More;
+plan skip_all => 'Test::Perl::Critic required to criticise code' if not eval "use Test::Perl::Critic; 1";
+all_critic_ok('blib/lib/Padre', 't');
+
More information about the Pkg-perl-cvs-commits
mailing list