Add libwx-perl

[pkg-perl] / deb-src / libwx-perl / libwx-perl-0.96 / blib / lib / Wx / Perl / TextValidator.pm

diff --git a/deb-src/libwx-perl/libwx-perl-0.96/blib/lib/Wx/Perl/TextValidator.pm b/deb-src/libwx-perl/libwx-perl-0.96/blib/lib/Wx/Perl/TextValidator.pm
new file mode 100755 (executable)
index 0000000..77d09c2
--- /dev/null
+++ b/deb-src/libwx-perl/libwx-perl-0.96/blib/lib/Wx/Perl/TextValidator.pm
@@ -0,0 +1,130 @@
+#############################################################################
+## Name:        ext/pperl/textval/TextValidator.pm
+## Purpose:     Wx::Perl::TextValidator, a perl-ish wxTextValidator
+## Author:      Johan Vromans, Mattia Barbon
+## Modified by:
+## Created:     15/08/2005
+## RCS-ID:      $Id: TextValidator.pm 2057 2007-06-18 23:03:00Z mbarbon $
+## Copyright:   (c) 2005 Johan Vromans, Mattia Barbon
+## Licence:     This program is free software; you can redistribute itand/or
+##              modify it under the same terms as Perl itself
+#############################################################################
+
+package Wx::Perl::TextValidator;
+
+=head1 NAME
+
+Wx::Perl::TextValidator - Perl replacement for wxTextValidator
+
+=head1 SYNOPSIS
+
+    my $storage = '';
+    my $validator1 = Wx::Perl::TextValidator->new( '\d', \$storage );
+    my $validator2 = Wx::Perl::TextValidator->new( '[abcdef]' );
+    my $validator3 = Wx::Perl::TextValidator->new( qr/[a-zA-Z]/ );
+
+    my $textctrl = Wx::TextCtrl->new( $parent, -1, "", $pos, $size, $style,
+                                      $validator1 );
+
+=head1 DESCRIPTION
+
+A C<Wx::Validator> subclass that allows filtering user input to
+a C<Wx::TextCtrl>.
+
+=head1 METHODS
+
+    my $validator1 = Wx::Perl::TextValidator->new( $regexp, \$storage );
+    my $validator2 = Wx::Perl::TextValidator->new( $regexp );
+
+Constructs a new C<Wx::Perl::Validator>. The first argument must be
+a regular expression matching a single-character string and is used
+to validate the field contents and user input. The second argument,
+if present, is used in TransferDataToWindow/TransferDataToWindow as
+the source/destination for the fields contents.
+
+  The first argument can be a string as well as a reqular expression
+object created using C<qr//>.
+
+=cut
+
+use strict;
+use Wx qw(:keycode wxOK wxICON_EXCLAMATION);
+use Wx::Event qw(EVT_CHAR);
+use Wx::Locale qw(:default);
+
+use base qw(Wx::PlValidator);
+
+our $VERSION = '0.01';
+
+sub new {
+    my( $class, $validate, $data ) = @_;
+    my $self = $class->SUPER::new;
+
+    $self->{validate} = ref $validate ? $validate : qr/^$validate$/;
+    $self->{data} = $data;
+
+    EVT_CHAR($self, \&OnKbdInput);
+
+    return $self;
+}
+
+sub OnKbdInput {
+    my ($self, $event) = @_;
+    my $c = $event->GetKeyCode;
+
+    if( $c  < WXK_SPACE   ||   # skip control characters
+        $c == WXK_DELETE  ||
+        $c  > WXK_START   ||
+        $event->HasModifiers   # allow Ctrl-C and such
+       ) {
+        $event->Skip;
+    } elsif( pack( "C", $c ) =~ $self->{validate} ) {
+        $event->Skip;
+    } else {
+        Wx::Bell;
+    }
+}
+
+sub Clone {
+    my( $self ) = @_;
+
+    return ref( $self )->new( $self->{validate}, $self->{data} );
+}
+
+sub Validate {
+    my( $self, $window ) = @_;
+    my $value = $self->GetWindow->GetValue;
+
+    my $ko = grep { !/$self->{validate}/ }
+                  split //, $value;
+
+    if( $ko ) {
+        Wx::MessageBox( sprintf( gettext( "'%s' is invalid" ), $value ),
+                        gettext( "Validation conflict" ),
+                        wxOK | wxICON_EXCLAMATION, $window );
+    }
+
+    return !$ko;
+}
+
+sub TransferToWindow {
+    my( $self ) = @_;
+
+    if( $self->{data} ) {
+        $self->GetWindow->SetValue( ${$self->{data}} );
+    }
+
+    return 1;
+}
+
+sub TransferFromWindow {
+    my( $self ) = @_;
+
+    if( $self->{data} ) {
+        ${$self->{data}} = $self->GetWindow->GetValue;
+    }
+
+    return 1;
+}
+
+1;