#############################################################################
## 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;