1package Pod::Perldoc::ToTk;
2use strict;
3use warnings;
4
5use vars qw($VERSION);
6$VERSION = '3.28';
7
8use parent qw(Pod::Perldoc::BaseTo);
9
10sub is_pageable        { 1 }
11sub write_with_binmode { 0 }
12sub output_extension   { 'txt' } # doesn't matter
13sub if_zero_length { }  # because it will be 0-length!
14sub new { return bless {}, ref($_[0]) || $_[0] }
15
16# TODO: document these and their meanings...
17sub tree      { shift->_perldoc_elem('tree'    , @_) }
18sub tk_opt    { shift->_perldoc_elem('tk_opt'  , @_) }
19sub forky     { shift->_perldoc_elem('forky'   , @_) }
20
21use Pod::Perldoc ();
22use File::Spec::Functions qw(catfile);
23
24BEGIN{ # Tk is not core, but this is
25  eval { require Tk } ||
26  __PACKAGE__->die( <<"HERE" );
27You must have the Tk module to use Pod::Perldoc::ToTk.
28If you have it installed, ensure it's in your Perl library
29path.
30HERE
31
32  __PACKAGE__->die(
33    __PACKAGE__,
34    " doesn't work nice with Tk.pm version $Tk::VERSION"
35    ) if $Tk::VERSION eq '800.003';
36  }
37
38
39BEGIN { eval { require Tk::FcyEntry; }; };
40BEGIN{ # Tk::Pod is not core, but this is
41  eval { require Tk::Pod } ||
42  __PACKAGE__->die( <<"HERE" );
43You must have the Tk::Pod module to use Pod::Perldoc::ToTk.
44If you have it installed, ensure it's in your Perl library
45path.
46HERE
47  }
48
49# The following was adapted from "tkpod" in the Tk-Pod dist.
50
51sub parse_from_file {
52
53    my($self, $Input_File) = @_;
54    if($self->{'forky'}) {
55      return if fork;  # i.e., parent process returns
56    }
57
58    $Input_File =~ s{\\}{/}g
59     if $self->is_mswin32 or $self->is_dos
60     # and maybe OS/2
61    ;
62
63    my($tk_opt, $tree);
64    $tree   = $self->{'tree'  };
65    $tk_opt = $self->{'tk_opt'};
66
67    #require Tk::ErrorDialog;
68
69    # Add 'Tk' subdirectories to search path so, e.g.,
70    # 'Scrolled' will find doc in 'Tk/Scrolled'
71
72    if( $tk_opt ) {
73      push @INC, grep -d $_, map catfile($_,'Tk'), @INC;
74    }
75
76    my $mw = MainWindow->new();
77    #eval 'use blib "/home/e/eserte/src/perl/Tk-App";require Tk::App::Debug';
78    $mw->withdraw;
79
80    # CDE use Font Settings if available
81    my $ufont = $mw->optionGet('userFont','UserFont');     # fixed width
82    my $sfont = $mw->optionGet('systemFont','SystemFont'); # proportional
83    if (defined($ufont) and defined($sfont)) {
84        foreach ($ufont, $sfont) { s/:$//; };
85        $mw->optionAdd('*Font',       $sfont);
86        $mw->optionAdd('*Entry.Font', $ufont);
87        $mw->optionAdd('*Text.Font',  $ufont);
88    }
89
90    $mw->optionAdd('*Menu.tearOff', $Tk::platform ne 'MSWin32' ? 1 : 0);
91
92    $mw->Pod(
93      '-file' => $Input_File,
94      (($Tk::Pod::VERSION >= 4) ? ('-tree' => $tree) : ())
95    )->focusNext;
96
97    # xxx dirty but it works. A simple $mw->destroy if $mw->children
98    # does not work because Tk::ErrorDialogs could be created.
99    # (they are withdrawn after Ok instead of destory'ed I guess)
100
101    if ($mw->children) {
102        $mw->repeat(1000, sub {
103                    # ErrorDialog is withdrawn not deleted :-(
104                    foreach ($mw->children) {
105                            return if "$_" =~ /^Tk::Pod/  # ->isa('Tk::Pod')
106                    }
107                    $mw->destroy;
108                });
109    } else {
110        $mw->destroy;
111    }
112    #$mw->WidgetDump;
113    MainLoop();
114
115    exit if $self->{'forky'}; # we were the child!  so exit now!
116    return;
117}
118
1191;
120__END__
121
122
123=head1 NAME
124
125Pod::Perldoc::ToTk - let Perldoc use Tk::Pod to render Pod
126
127=head1 SYNOPSIS
128
129  perldoc -o tk Some::Modulename &
130
131=head1 DESCRIPTION
132
133This is a "plug-in" class that allows Perldoc to use
134Tk::Pod as a formatter class.
135
136You have to have installed Tk::Pod first, or this class won't load.
137
138=head1 SEE ALSO
139
140L<Tk::Pod>, L<Pod::Perldoc>
141
142=head1 AUTHOR
143
144Current maintainer: Mark Allen C<< <mallen@cpan.org> >>
145
146Past contributions from:
147brian d foy C<< <bdfoy@cpan.org> >>
148Adriano R. Ferreira C<< <ferreira@cpan.org> >>;
149Sean M. Burke C<< <sburke@cpan.org> >>;
150significant portions copied from
151F<tkpod> in the Tk::Pod dist, by Nick Ing-Simmons, Slaven Rezic, et al.
152
153=cut
154
155