1N/A
1N/Arequire 5;
1N/Apackage Pod::Perldoc::ToTk;
1N/Ause strict;
1N/Ause warnings;
1N/A
1N/Ause base qw(Pod::Perldoc::BaseTo);
1N/A
1N/Asub is_pageable { 1 }
1N/Asub write_with_binmode { 0 }
1N/Asub output_extension { 'txt' } # doesn't matter
1N/Asub if_zero_length { } # because it will be 0-length!
1N/Asub new { return bless {}, ref($_[0]) || $_[0] }
1N/A
1N/A# TODO: document these and their meanings...
1N/Asub tree { shift->_perldoc_elem('tree' , @_) }
1N/Asub tk_opt { shift->_perldoc_elem('tk_opt' , @_) }
1N/Asub forky { shift->_perldoc_elem('forky' , @_) }
1N/A
1N/Ause Pod::Perldoc ();
1N/Ause File::Spec::Functions qw(catfile);
1N/A
1N/Ause Tk;
1N/Adie join '', __PACKAGE__, " doesn't work nice with Tk.pm verison $Tk::VERSION"
1N/A if $Tk::VERSION eq '800.003';
1N/A
1N/ABEGIN { eval { require Tk::FcyEntry; }; };
1N/Ause Tk::Pod;
1N/A
1N/A# The following was adapted from "tkpod" in the Tk-Pod dist.
1N/A
1N/Asub parse_from_file {
1N/A
1N/A my($self, $Input_File) = @_;
1N/A if($self->{'forky'}) {
1N/A return if fork; # i.e., parent process returns
1N/A }
1N/A
1N/A $Input_File =~ s{\\}{/}g
1N/A if Pod::Perldoc::IS_MSWin32 or Pod::Perldoc::IS_Dos
1N/A # and maybe OS/2
1N/A ;
1N/A
1N/A my($tk_opt, $tree);
1N/A $tree = $self->{'tree' };
1N/A $tk_opt = $self->{'tk_opt'};
1N/A
1N/A #require Tk::ErrorDialog;
1N/A
1N/A # Add 'Tk' subdirectories to search path so, e.g.,
1N/A # 'Scrolled' will find doc in 'Tk/Scrolled'
1N/A
1N/A if( $tk_opt ) {
1N/A push @INC, grep -d $_, map catfile($_,'Tk'), @INC;
1N/A }
1N/A
1N/A my $mw = MainWindow->new();
1N/A #eval 'use blib "/home/e/eserte/src/perl/Tk-App";require Tk::App::Debug';
1N/A $mw->withdraw;
1N/A
1N/A # CDE use Font Settings if available
1N/A my $ufont = $mw->optionGet('userFont','UserFont'); # fixed width
1N/A my $sfont = $mw->optionGet('systemFont','SystemFont'); # proportional
1N/A if (defined($ufont) and defined($sfont)) {
1N/A foreach ($ufont, $sfont) { s/:$//; };
1N/A $mw->optionAdd('*Font', $sfont);
1N/A $mw->optionAdd('*Entry.Font', $ufont);
1N/A $mw->optionAdd('*Text.Font', $ufont);
1N/A }
1N/A
1N/A $mw->optionAdd('*Menu.tearOff', $Tk::platform ne 'MSWin32' ? 1 : 0);
1N/A
1N/A $mw->Pod(
1N/A '-file' => $Input_File,
1N/A (($Tk::Pod::VERSION >= 4) ? ('-tree' => $tree) : ())
1N/A )->focusNext;
1N/A
1N/A # xxx dirty but it works. A simple $mw->destroy if $mw->children
1N/A # does not work because Tk::ErrorDialogs could be created.
1N/A # (they are withdrawn after Ok instead of destory'ed I guess)
1N/A
1N/A if ($mw->children) {
1N/A $mw->repeat(1000, sub {
1N/A # ErrorDialog is withdrawn not deleted :-(
1N/A foreach ($mw->children) {
1N/A return if "$_" =~ /^Tk::Pod/ # ->isa('Tk::Pod')
1N/A }
1N/A $mw->destroy;
1N/A });
1N/A } else {
1N/A $mw->destroy;
1N/A }
1N/A #$mw->WidgetDump;
1N/A MainLoop();
1N/A
1N/A exit if $self->{'forky'}; # we were the child! so exit now!
1N/A return;
1N/A}
1N/A
1N/A1;
1N/A__END__
1N/A
1N/A
1N/A=head1 NAME
1N/A
1N/APod::Perldoc::ToTk - let Perldoc use Tk::Pod to render Pod
1N/A
1N/A=head1 SYNOPSIS
1N/A
1N/A perldoc -o tk Some::Modulename &
1N/A
1N/A=head1 DESCRIPTION
1N/A
1N/AThis is a "plug-in" class that allows Perldoc to use
1N/ATk::Pod as a formatter class.
1N/A
1N/AYou have to have installed Tk::Pod first, or this class won't load.
1N/A
1N/A=head1 SEE ALSO
1N/A
1N/AL<Tk::Pod>, L<Pod::Perldoc>
1N/A
1N/A=head1 AUTHOR
1N/A
1N/ASean M. Burke C<sburke@cpan.org>, with significant portions copied from
1N/AF<tkpod> in the Tk::Pod dist, by Nick Ing-Simmons, Slaven Rezic, et al.
1N/A
1N/A=cut
1N/A