The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w

# Copyright 2012 Kevin Ryde

# This file is part of Wx-Perl-PodBrowser.
#
# Wx-Perl-PodBrowser is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Wx-Perl-PodBrowser is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Wx-Perl-PodBrowser.  If not, see <http://www.gnu.org/licenses/>.


package Wx::DemoModules::WxPerlPodRichText;
use 5.008;
use strict;
use Wx;
use Wx::Perl::PodRichText;

use base 'Wx::DemoModules::lib::BaseModule';

# uncomment this to run the ### lines
#use Smart::Comments;


use constant title         => 'WxPerlPodRichText';
use constant add_to_tags   => 'controls';
use constant expandinsizer => 1;

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

  return ({ with_value  => 1,
            label       => 'Goto Module',
            action => sub {
              my ($module) = @_;
              $self->{'podtext'}->goto_pod (module => $module);
            },
          },
          # { with_value  => 1,
          #   label       => 'Goto Line',
          #   action => sub {
          #     my ($linenum) = @_;
          #     $self->{'podtext'}->goto_pod(line => $linenum);
          #   },
          # },
         );
}

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

  my $panel = $self->{'panel'} = Wx::Panel->new ($self, Wx::wxID_ANY());

  my $heading_label = Wx::StaticText->new ($panel, Wx::wxID_ANY(),
                                           'Headings');
  my $line_height = $heading_label->GetSize->GetHeight;

  my $heading_listbox
    = $self->{'heading_listbox'}
      = Wx::ListBox->new ($panel,
                          Wx::wxID_ANY(),
                          Wx::wxDefaultPosition(),
                          Wx::wxDefaultSize(),
                          [], # initial list
                          Wx::wxLB_SINGLE());
  Wx::Event::EVT_LISTBOX($self, $heading_listbox, '_do_listbox');

  my $podtext
    = $self->{'podtext'}
      = Wx::Perl::PodRichText->new($panel, Wx::wxID_ANY());
  # Note: EVT_PERL_PODRICHTEXT_CHANGED() not yet a documented feature, might
  # change
  Wx::Perl::PodRichText::EVT_PERL_PODRICHTEXT_CHANGED
      ($self, $podtext, \&_do_pod_changed);

  my $heading_sizer = Wx::BoxSizer->new (Wx::wxVERTICAL());
  $heading_sizer->Add ($heading_label,
                       0);                # proportion, no stretch
  $heading_sizer->AddSpacer (0.3 * $line_height);
  $heading_sizer->Add ($heading_listbox,
                       1,                 # proportion, stretch
                       (Wx::wxGROW()
                        | Wx::wxALL()));  # border all sides

  my $sizer = $self->{'sizer'} = Wx::BoxSizer->new (Wx::wxHORIZONTAL());
  $sizer->Add ($heading_sizer,
               1,                    # proportion
               (Wx::wxGROW()
                | Wx::wxALL()),      # border all sides
               0.5 * $line_height);  # border width
  $sizer->Add ($podtext,
               3,                    # proportion
               (Wx::wxGROW()
                | Wx::wxALL()),      # border all sides
               0.5 * $line_height);  # border width
  $panel->SetSizerAndFit($sizer);

  $podtext->goto_pod (module => ref $self);
  return $panel;
}

sub _do_pod_changed {
  my ($self, $event) = @_;
  my $what = $event->GetWhat;

  ### _do_pod_changed() ...
  ### $what

  if ($what eq 'heading_list') {
    my $podtext = $self->{'podtext'};
    my $heading_listbox = $self->{'heading_listbox'};
    ### heading_list: $podtext->get_heading_list
    $heading_listbox->Clear;
    $heading_listbox->InsertItems([$podtext->get_heading_list], 0);
  }
}

sub _do_listbox {
  my ($self, $event) = @_;
  ### _do_listbox(): $self->{'heading_listbox'}->GetStringSelection

  my $heading_listbox = $self->{'heading_listbox'};
  my $podtext = $self->{'podtext'};
  $podtext->goto_pod (section => $heading_listbox->GetStringSelection);
}

1;
__END__

=for stopwords Wx Wx-Perl-PodBrowser Ryde

=head1 NAME

Wx::DemoModules::WxPerlPodRichText -- sample of Wx::Perl::PodRichText

=head1 DESCRIPTION

This is a sample L<Wx::Perl::PodRichText> widget for L<Wx::Demo>.

This code in this module is slightly complicated by displaying a headings
list as well as the PodRichText.  

=head1 SEE ALSO

L<Wx::Demo>,
L<Wx::Perl::PodRichText>,
L<Wx>

=head1 HOME PAGE

L<http://user42.tuxfamily.org/wx-perl-podbrowser/index.html>

=head1 LICENSE

Copyright 2012 Kevin Ryde

Wx-Perl-PodBrowser is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by the
Free Software Foundation; either version 3, or (at your option) any later
version.

Wx-Perl-PodBrowser is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
more details.

You should have received a copy of the GNU General Public License along with
Wx-Perl-PodBrowser.  If not, see L<http://www.gnu.org/licenses/>.

=cut

# Local variables:
# compile-command: "perl -I ../.. /usr/bin/wxperl_demo.pl -s WxPerlPodRichText"
# End: