File Coverage

blib/lib/Wx/Perl/PodEditor.pm

Criterion	Covered	Total	%
statement	16	18	88.8
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	22	24	91.6

package Wx::Perl::PodEditor;

use strict;
use warnings;

use Data::Dumper;
use File::Basename;
use File::Spec;

use Wx qw(
    wxVERTICAL wxTOP wxHORIZONTAL
    wxBITMAP_TYPE_XPM
    wxNO_BORDER
    wxDEFAULT
    wxNORMAL
    wxRE_MULTILINE wxRICHTEXT_TYPE_XML
);

use Wx::Event qw( :everything );
use Wx::RichText;

use Wx::Perl::PodEditor::FormatActions qw(:all);
use Wx::Perl::PodEditor::PodParser;
use Wx::Perl::PodEditor::XMLParser;

Wx::Perl::PodEditor::FormatActions->define_styles;

our $AUTOLOAD;

our $VERSION = 0.03;

sub create {
    my ($class, $parent, $size) = @_;

    my $panel = Wx::Panel->new( $parent, -1, [-1,-1], [-1,-1], 0 );

    my $self  = bless {}, $class;
    my $sizer = $self->sizer();

    my $editor  = $self->_editor( $panel, $size );
    $sizer->Add( $editor, 0, wxTOP, 0 );

    return $self;
}

sub sizer {
    my ($self) = @_;

    unless( $self->{sizer} ){
        $self->{sizer} = Wx::BoxSizer->new( wxVERTICAL );
    }

    $self->{sizer};
}

sub _editor {
    my ($self,$panel,$size) = @_;

    if( @_ == 3 ){
        $self->{editor} = Wx::RichTextCtrl->new( $panel, -1, '',[-1,-1], $size, wxRE_MULTILINE );
        my $font = Wx::Font->new( 10, wxDEFAULT, wxNORMAL, wxNORMAL, 0, 'Courier New' );

        EVT_KEY_DOWN( $self->{editor}, sub{ $self->_handle_key_down(@_) } );
    }

    $self->{editor};
}

sub _handle_key_down {
    my ($self,$editor,$event) = @_;

    my $mod  = $event->GetModifiers || 0;
    my $code = $event->GetKeyCode;

    if( $code == 13 ){ # handle return
        $event->Skip;
        if( $self->_is_headline ){
            $editor->Newline;
            $self->default;
            $self->_is_headline( 0 );
        }
    }
    else{
        $event->Skip;
    }
}

sub set_pod {
    my ($self,$pod) = @_;

    if( @_ == 2 ){
        $self->{pod}  = $pod;
        $self->{text} = $self->_pod2text;
    }
}

sub _is_headline {
    my ($self,$bool) = @_;

    $self->{is_headline} = $bool if @_ == 2;
    $self->{is_headline};
}

sub get_pod {
    my ($self) = @_;

    $self->_text2pod;
}

sub _pod2text {
    my ($self) = @_;

    my $pod = $self->{pod};
    my $parser = Wx::Perl::PodEditor::PodParser->new( $self->_editor );
    $parser->parse_string_document( $pod );
}

sub _text2pod {
    my ($self) = @_;

    my $buffer = $self->_editor->GetBuffer;
    my $file_handler = Wx::RichTextXMLHandler->new( '', '', wxRICHTEXT_TYPE_XML );
    $buffer->AddHandler( $file_handler );

    open my $fh, '>', \my $xml;
    $file_handler->SaveFile( $buffer, $fh );

    warn $xml;
    my $parser = Wx::Perl::PodEditor::XMLParser->new;
    $parser->parse( $xml );
}

sub AUTOLOAD {
    my ($self) = shift;
    my $name = $AUTOLOAD;

    $name =~ s/.*:://;

    return if $name eq 'DESTROY';

    my $editor = $self->_editor;
    if( my $sub = $editor->can( $name ) ){
        $sub->( $editor, @_ )
    }
    else{
        my @info    = caller(0);
        my $package = __PACKAGE__;
        my $msg     = qq~Can't locate object method "$name" via package "$package" at $info[1] line $info[2]~;
        print STDERR $msg;
        exit;
    }
}

1;
__END__