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