| package Pod::Perldoc::ToTk; |
| use strict; |
| use warnings; |
| |
| use vars qw($VERSION); |
| $VERSION = '3.17'; |
| |
| 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->_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); |
| |
| BEGIN{ # Tk is not core, but this is |
| eval { require Tk } || |
| __PACKAGE__->die( <<"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__->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__->die( <<"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->{'forky'}) { |
| return if fork; # i.e., parent process returns |
| } |
| |
| $Input_File =~ s{\\}{/}g |
| if $self->is_mswin32 or $self->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 |
| |
| Current maintainer: Mark Allen C<< <mallen@cpan.org> >> |
| |
| Past contributions from: |
| brian d foy C<< <bdfoy@cpan.org> >> |
| Adriano R. Ferreira C<< <ferreira@cpan.org> >>; |
| Sean M. Burke C<< <sburke@cpan.org> >>; |
| significant portions copied from |
| F<tkpod> in the Tk::Pod dist, by Nick Ing-Simmons, Slaven Rezic, et al. |
| |
| =cut |
| |