git.maemo.org Git - pkg-perl/blob - deb-src/libwx-perl/libwx-perl-0.96/debian/libwx-perl/usr/lib/perl5/Wx/Perl/TextValidator.pm

   1 #############################################################################
   2 ## Name:        ext/pperl/textval/TextValidator.pm
   3 ## Purpose:     Wx::Perl::TextValidator, a perl-ish wxTextValidator
   4 ## Author:      Johan Vromans, Mattia Barbon
   5 ## Modified by:
   6 ## Created:     15/08/2005
   7 ## RCS-ID:      $Id: TextValidator.pm 2057 2007-06-18 23:03:00Z mbarbon $
   8 ## Copyright:   (c) 2005 Johan Vromans, Mattia Barbon
   9 ## Licence:     This program is free software; you can redistribute itand/or
  10 ##              modify it under the same terms as Perl itself
  11 #############################################################################
  12
  13 package Wx::Perl::TextValidator;
  14
  15 =head1 NAME
  16
  17 Wx::Perl::TextValidator - Perl replacement for wxTextValidator
  18
  19 =head1 SYNOPSIS
  20
  21     my $storage = '';
  22     my $validator1 = Wx::Perl::TextValidator->new( '\d', \$storage );
  23     my $validator2 = Wx::Perl::TextValidator->new( '[abcdef]' );
  24     my $validator3 = Wx::Perl::TextValidator->new( qr/[a-zA-Z]/ );
  25
  26     my $textctrl = Wx::TextCtrl->new( $parent, -1, "", $pos, $size, $style,
  27                                       $validator1 );
  28
  29 =head1 DESCRIPTION
  30
  31 A C<Wx::Validator> subclass that allows filtering user input to
  32 a C<Wx::TextCtrl>.
  33
  34 =head1 METHODS
  35
  36     my $validator1 = Wx::Perl::TextValidator->new( $regexp, \$storage );
  37     my $validator2 = Wx::Perl::TextValidator->new( $regexp );
  38
  39 Constructs a new C<Wx::Perl::Validator>. The first argument must be
  40 a regular expression matching a single-character string and is used
  41 to validate the field contents and user input. The second argument,
  42 if present, is used in TransferDataToWindow/TransferDataToWindow as
  43 the source/destination for the fields contents.
  44
  45   The first argument can be a string as well as a reqular expression
  46 object created using C<qr//>.
  47
  48 =cut
  49
  50 use strict;
  51 use Wx qw(:keycode wxOK wxICON_EXCLAMATION);
  52 use Wx::Event qw(EVT_CHAR);
  53 use Wx::Locale qw(:default);
  54
  55 use base qw(Wx::PlValidator);
  56
  57 our $VERSION = '0.01';
  58
  59 sub new {
  60     my( $class, $validate, $data ) = @_;
  61     my $self = $class->SUPER::new;
  62
  63     $self->{validate} = ref $validate ? $validate : qr/^$validate$/;
  64     $self->{data} = $data;
  65
  66     EVT_CHAR($self, \&OnKbdInput);
  67
  68     return $self;
  69 }
  70
  71 sub OnKbdInput {
  72     my ($self, $event) = @_;
  73     my $c = $event->GetKeyCode;
  74
  75     if( $c  < WXK_SPACE   ||   # skip control characters
  76         $c == WXK_DELETE  ||
  77         $c  > WXK_START   ||
  78         $event->HasModifiers   # allow Ctrl-C and such
  79        ) {
  80         $event->Skip;
  81     } elsif( pack( "C", $c ) =~ $self->{validate} ) {
  82         $event->Skip;
  83     } else {
  84         Wx::Bell;
  85     }
  86 }
  87
  88 sub Clone {
  89     my( $self ) = @_;
  90
  91     return ref( $self )->new( $self->{validate}, $self->{data} );
  92 }
  93
  94 sub Validate {
  95     my( $self, $window ) = @_;
  96     my $value = $self->GetWindow->GetValue;
  97
  98     my $ko = grep { !/$self->{validate}/ }
  99                   split //, $value;
 100
 101     if( $ko ) {
 102         Wx::MessageBox( sprintf( gettext( "'%s' is invalid" ), $value ),
 103                         gettext( "Validation conflict" ),
 104                         wxOK | wxICON_EXCLAMATION, $window );
 105     }
 106
 107     return !$ko;
 108 }
 109
 110 sub TransferToWindow {
 111     my( $self ) = @_;
 112
 113     if( $self->{data} ) {
 114         $self->GetWindow->SetValue( ${$self->{data}} );
 115     }
 116
 117     return 1;
 118 }
 119
 120 sub TransferFromWindow {
 121     my( $self ) = @_;
 122
 123     if( $self->{data} ) {
 124         ${$self->{data}} = $self->GetWindow->GetValue;
 125     }
 126
 127     return 1;
 128 }
 129
 130 1;