view release on metacpan or  search on metacpan

lib/Tk/PodSingle.pm  view on Meta::CPAN

package Tk::PodSingle;
our $VERSION = '1.01';

=head1 NAME

Tk::PodSingle - Pod browser toplevel widget for single pod files

=head1 DESCRIPTION

This module inherits Tk::Pod and slightly changes its' features by removing menu entries
(and bindings) that pertain to opening a different pod file.

It is suitable for when you want to only display a single pod file
or a group of self-contained pod files. It hides access to the system's pod archive
and removes the options that allow opening a new pod file.

What it does not do is prevent going to a different pod file through a link
in the loaded pod file. This is why I kept the History menu intact.

The widget is created like this:

	use Tk::PodSingle;
	$Pod = $Parent->PodSingle(-file => $name);

Other than the removed menu entries and bindings, it behaves exactly as Tk::Pod does.

=head1 AUTHOR

Ken Prows (perl@xev.net)

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.6 or,
at your option, any later version of Perl 5 you may have available.

=cut

use base qw(Tk::Derived Tk::Pod);
use strict;

Construct Tk::Widget 'PodSingle';

sub Populate
{
 my ($w,$args) = @_;

 $args->{-tree} = 0;

 if ($w->Pod_Text_Module)
  {
   eval q{ require } . $w->Pod_Text_Module;
   die $@ if $@;
  }
 #if ($w->Pod_Tree_Module)
 # {
 #  eval q{ require } . $w->Pod_Tree_Module;
 #  die $@ if $@;
 # }
  
 # SUPER wont work here because it will use the Populate from Tk::Pod, which is wrong
 #$w->SUPER::Populate($args);
 $w->Tk::Toplevel::Populate($args); 

 #my $tree = $w->Scrolled($w->Pod_Tree_Widget,
 #			 -scrollbars => 'oso'.($Tk::platform eq 'MSWin32'?'e':'w')
 #			);
 #$w->Advertise('tree' => $tree);

 my $searchcase = 0;
 my $p = $w->Component($w->Pod_Text_Widget => 'pod', -searchcase => $searchcase)->pack(-expand => 1, -fill => 'both');
 $p->bind('<Double-1>', sub  { }); # disable double-click file loading
 $p->menu(undef); # disable right-click menu

 my $exitbutton = delete $args->{-exitbutton} || 0;

 # Experimental menu compound images:
 # XXX Maybe there should be a way to turn this off, as the extra
 # icons might be memory consuming...
 my $compound = sub { () };
 if ($Tk::VERSION >= 804 && eval { require Tk::ToolBar; 1 }) {
     $w->ToolBar->destroy;
     if (!$Tk::Pod::empty_image_16) { # XXX multiple MainWindows?
	 $Tk::Pod::empty_image_16 = $w->MainWindow->Photo(-data => <<EOF);
R0lGODlhEAAQAIAAAP///////yH+FUNyZWF0ZWQgd2l0aCBUaGUgR0lNUAAh+QQBCgABACwA
AAAAEAAQAAACDoyPqcvtD6OctNqLsz4FADs=
EOF
     }
     $compound = sub {
	 if (@_) {
	     (-image => $_[0] . "16", -compound => "left");
	 } else {
	     (-image => $Tk::Pod::empty_image_16, -compound => "left");
	 }
     };
 }

 my $menuitems =
 [