[Summary view] [Print] [Text view]

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