<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package Pod::Perldoc::ToTk;
use strict;
use warnings;

use vars qw($VERSION);
$VERSION = '3.23';

use parent 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-&gt;_perldoc_elem('tree'    , @_) }
sub tk_opt    { shift-&gt;_perldoc_elem('tk_opt'  , @_) }
sub forky     { shift-&gt;_perldoc_elem('forky'   , @_) }

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

BEGIN{ # Tk is not core, but this is
  eval { require Tk } ||
  __PACKAGE__-&gt;die( &lt;&lt;"HERE" );
You must have the Tk module to use Pod::Perldoc::ToTk.
If you have it installed, ensure it's in your Perl library
path.
HERE

  __PACKAGE__-&gt;die(
    __PACKAGE__,
    " doesn't work nice with Tk.pm version $Tk::VERSION"
    ) if $Tk::VERSION eq '800.003';
  }


BEGIN { eval { require Tk::FcyEntry; }; };
BEGIN{ # Tk::Pod is not core, but this is
  eval { require Tk::Pod } ||
  __PACKAGE__-&gt;die( &lt;&lt;"HERE" );
You must have the Tk::Pod module to use Pod::Perldoc::ToTk.
If you have it installed, ensure it's in your Perl library
path.
HERE
  }

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

sub parse_from_file {

    my($self, $Input_File) = @_;
    if($self-&gt;{'forky'}) {
      return if fork;  # i.e., parent process returns
    }

    $Input_File =~ s{\\}{/}g
     if $self-&gt;is_mswin32 or $self-&gt;is_dos
     # and maybe OS/2
    ;

    my($tk_opt, $tree);
    $tree   = $self-&gt;{'tree'  };
    $tk_opt = $self-&gt;{'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-&gt;new();
    #eval 'use blib "/home/e/eserte/src/perl/Tk-App";require Tk::App::Debug';
    $mw-&gt;withdraw;

    # CDE use Font Settings if available
    my $ufont = $mw-&gt;optionGet('userFont','UserFont');     # fixed width
    my $sfont = $mw-&gt;optionGet('systemFont','SystemFont'); # proportional
    if (defined($ufont) and defined($sfont)) {
        foreach ($ufont, $sfont) { s/:$//; };
        $mw-&gt;optionAdd('*Font',       $sfont);
        $mw-&gt;optionAdd('*Entry.Font', $ufont);
        $mw-&gt;optionAdd('*Text.Font',  $ufont);
    }

    $mw-&gt;optionAdd('*Menu.tearOff', $Tk::platform ne 'MSWin32' ? 1 : 0);

    $mw-&gt;Pod(
      '-file' =&gt; $Input_File,
      (($Tk::Pod::VERSION &gt;= 4) ? ('-tree' =&gt; $tree) : ())
    )-&gt;focusNext;

    # xxx dirty but it works. A simple $mw-&gt;destroy if $mw-&gt;children
    # does not work because Tk::ErrorDialogs could be created.
    # (they are withdrawn after Ok instead of destory'ed I guess)

    if ($mw-&gt;children) {
        $mw-&gt;repeat(1000, sub {
                    # ErrorDialog is withdrawn not deleted :-(
                    foreach ($mw-&gt;children) {
                            return if "$_" =~ /^Tk::Pod/  # -&gt;isa('Tk::Pod')
                    }
                    $mw-&gt;destroy;
                });
    } else {
        $mw-&gt;destroy;
    }
    #$mw-&gt;WidgetDump;
    MainLoop();

    exit if $self-&gt;{'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 &amp;

=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&lt;Tk::Pod&gt;, L&lt;Pod::Perldoc&gt;

=head1 AUTHOR

Current maintainer: Mark Allen C&lt;&lt; &lt;mallen@cpan.org&gt; &gt;&gt;

Past contributions from:
brian d foy C&lt;&lt; &lt;bdfoy@cpan.org&gt; &gt;&gt;
Adriano R. Ferreira C&lt;&lt; &lt;ferreira@cpan.org&gt; &gt;&gt;;
Sean M. Burke C&lt;&lt; &lt;sburke@cpan.org&gt; &gt;&gt;;
significant portions copied from
F&lt;tkpod&gt; in the Tk::Pod dist, by Nick Ing-Simmons, Slaven Rezic, et al.

=cut

</pre></body></html>