1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
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
|
