FM / Perldoc

/usr/share/perl5/Pod/Perldoc

Name	Size	Mode	Actions
BaseTo.pm	474	0644	edit dl rm
GetOptsOO.pm	2795	0644	edit dl rm
ToChecker.pm	1488	0644	edit dl rm
ToMan.pm	5352	0644	edit dl rm
ToNroff.pm	2582	0644	edit dl rm
ToPod.pm	2011	0644	edit dl rm
ToRtf.pm	2076	0644	edit dl rm
ToText.pm	2064	0644	edit dl rm
ToTk.pm	3396	0644	edit dl rm
ToXml.pm	1313	0644	edit dl rm

Edit: /usr/share/perl5/Pod/Perldoc/ToTk.pm (3396B)

require 5;
package Pod::Perldoc::ToTk;
use strict;
use warnings;

use base qw(Pod::Perldoc::BaseTo);

sub is_pageable        { 1 }
sub write_with_binmode { 0 }
sub output_extension   { 'txt' } # doesn't matter
sub if_zero_length { }  # because it will be 0-length!
sub new { return bless {}, ref($_[0]) || $_[0] }

# TODO: document these and their meanings...
sub tree      { shift->_perldoc_elem('tree'    , @_) }
sub tk_opt    { shift->_perldoc_elem('tk_opt'  , @_) }
sub forky     { shift->_perldoc_elem('forky'   , @_) }

use Pod::Perldoc ();
use File::Spec::Functions qw(catfile);

use Tk;
die join '', __PACKAGE__, " doesn't work nice with Tk.pm verison $Tk::VERSION"
 if $Tk::VERSION eq '800.003';

BEGIN { eval { require Tk::FcyEntry; }; };
use Tk::Pod;

# The following was adapted from "tkpod" in the Tk-Pod dist.

sub parse_from_file {

my($self, $Input_File) = @_;
    if($self->{'forky'}) {
      return if fork;  # i.e., parent process returns
    }
    
    $Input_File =~ s{\\}{/}g
     if Pod::Perldoc::IS_MSWin32 or Pod::Perldoc::IS_Dos
     # and maybe OS/2
    ;
    
    my($tk_opt, $tree);
    $tree   = $self->{'tree'  };
    $tk_opt = $self->{'tk_opt'};
    
    #require Tk::ErrorDialog;
    
    # Add 'Tk' subdirectories to search path so, e.g.,
    # 'Scrolled' will find doc in 'Tk/Scrolled'
    
    if( $tk_opt ) {
      push @INC, grep -d $_, map catfile($_,'Tk'), @INC;
    }
    
    my $mw = MainWindow->new();
    #eval 'use blib "/home/e/eserte/src/perl/Tk-App";require Tk::App::Debug';
    $mw->withdraw;
    
    # CDE use Font Settings if available
    my $ufont = $mw->optionGet('userFont','UserFont');     # fixed width
    my $sfont = $mw->optionGet('systemFont','SystemFont'); # proportional
    if (defined($ufont) and defined($sfont)) {
        foreach ($ufont, $sfont) { s/:$//; };
        $mw->optionAdd('*Font',       $sfont);
        $mw->optionAdd('*Entry.Font', $ufont);
        $mw->optionAdd('*Text.Font',  $ufont);
    }
    
    $mw->optionAdd('*Menu.tearOff', $Tk::platform ne 'MSWin32' ? 1 : 0);
    
    $mw->Pod(
      '-file' => $Input_File,
      (($Tk::Pod::VERSION >= 4) ? ('-tree' => $tree) : ())
    )->focusNext;
    
    # xxx dirty but it works. A simple $mw->destroy if $mw->children
    # does not work because Tk::ErrorDialogs could be created.
    # (they are withdrawn after Ok instead of destory'ed I guess)
    
    if ($mw->children) {
        $mw->repeat(1000, sub {
                    # ErrorDialog is withdrawn not deleted :-(
                    foreach ($mw->children) {
                            return if "$_" =~ /^Tk::Pod/  # ->isa('Tk::Pod')
                    }
                    $mw->destroy;
                });
    } else {
        $mw->destroy;
    }
    #$mw->WidgetDump;
    MainLoop();

exit if $self->{'forky'}; # we were the child!  so exit now!
    return;
}

1;
__END__

=head1 NAME

Pod::Perldoc::ToTk - let Perldoc use Tk::Pod to render Pod

=head1 SYNOPSIS

perldoc -o tk Some::Modulename &

=head1 DESCRIPTION

This is a "plug-in" class that allows Perldoc to use
Tk::Pod as a formatter class.

You have to have installed Tk::Pod first, or this class won't load.

=head1 SEE ALSO

L<Tk::Pod>, L<Pod::Perldoc>

=head1 AUTHOR

Sean M. Burke C<sburke@cpan.org>, with significant portions copied from
F<tkpod> in the Tk::Pod dist, by Nick Ing-Simmons, Slaven Rezic, et al.

=cut

cmd: