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