Initial Commit

database/perl/lib/Pod/Perldoc/ToTk.pm

@@ -0,0 +1,154 @@
+package Pod::Perldoc::ToTk;
+use strict;
+use warnings;
+
+use vars qw($VERSION);
+$VERSION = '3.28';
+
+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
+