1
2require 5;
3package Tk::Pod::Text;
4
5use strict;
6
7BEGIN {  # Make a DEBUG constant very first thing...
8  if(defined &DEBUG) {
9  } elsif(($ENV{'TKPODDEBUG'} || '') =~ m/^(\d+)/) { # untaint
10    my $debug = $1;
11    *DEBUG = sub () { $debug };
12  } else {
13    *DEBUG = sub () {0};
14  }
15}
16
17use Carp;
18use Config;
19use Tk qw(catch);
20use Tk::Frame;
21use Tk::Pod;
22use Tk::Pod::SimpleBridge;
23use Tk::Pod::Cache;
24use Tk::Pod::Util qw(is_in_path is_interactive detect_window_manager start_browser);
25
26use vars qw($VERSION @ISA @POD $IDX
27	    @tempfiles @gv_pids $terminal_fallback_warn_shown);
28
29$VERSION = '5.32';
30
31@ISA = qw(Tk::Frame Tk::Pod::SimpleBridge Tk::Pod::Cache);
32
33BEGIN { DEBUG and warn "Running ", __PACKAGE__, "\n" }
34
35Construct Tk::Widget 'PodText';
36
37BEGIN {
38  unshift @POD, (
39   @INC,
40   $ENV{'PATH'} ?
41     grep(-d, split($Config{path_sep}, $ENV{'PATH'}))
42    : ()
43  );
44  $IDX = undef;
45  DEBUG and warn "POD: @POD\n";
46};
47
48{
49    package # hide from CPAN indexer
50	Tk::Pod::Text::_HistoryEntry;
51
52    use File::Basename qw(basename);
53
54    for my $member (qw(file text index pod_title)) {
55	my $sub = sub {
56	    my $self = shift;
57	    if (@_) {
58		$self->{$member} = $_[0];
59	    }
60	    $self->{$member};
61	};
62	no strict 'refs';
63	*{$member} = $sub;
64    }
65
66    sub create {
67	my($class,$what,$index) = @_;
68	my $o = bless {}, $class;
69	if (ref $what eq 'HASH') {
70	    $o->file($what->{file});
71	    $o->text($what->{text});
72	} else {
73	    $o->file($what);
74	}
75	$o->index($index);
76	$o;
77    }
78
79    sub get_label {
80	my $self = shift;
81	my $pod_title = $self->pod_title;
82	return $pod_title if defined $pod_title;
83	my $file = $self->file;
84	return basename $file if defined $file;
85	return "<Untitled document>";
86    }
87}
88
89use constant HISTORY_DIALOG_ARGS => [-icon => 'info',
90				     -title => 'History Error',
91				     -type => 'OK'];
92sub Dir
93{
94 my $class = shift;
95 unshift(@POD,@_);
96}
97
98sub Find
99{
100 my ($file) = @_;
101 return $file if (-f $file);
102 my $dir;
103 foreach $dir ("",@POD)
104  {
105   my $prefix;
106   foreach $prefix ("","pod/","pods/")
107    {
108     my $suffix;
109     foreach $suffix (".pod",".pm",".pl","")
110      {
111       my $path = "$dir/" . $prefix . $file . $suffix;
112       return $path if (-r $path && -T $path);
113       $path =~ s,::,/,g;
114       return $path if (-r $path && -T $path);
115      }
116    }
117  }
118  return undef;
119}
120
121sub findpod {
122    my ($w,$name,%opts) = @_;
123    my $quiet = delete $opts{-quiet};
124    warn "Unhandled extra options: ". join " ", %opts
125	if %opts;
126    unless (defined $name and length $name) {
127	return if $quiet;
128	$w->_die_dialog("Empty Pod file/name");
129    }
130
131    my $absname;
132    if (-f $name) {
133	$absname = $name;
134    } else {
135	if ($name !~ /^[-_+:.\/A-Za-z0-9]+$/) {
136	    return if $quiet;
137	    $w->_die_dialog("Invalid path/file/module name '$name'\n");
138	}
139	$absname = Find($name);
140    }
141    if (!defined $absname) {
142	return if $quiet;
143	$w->_error_dialog("Can't find Pod '$name'\n");
144	die "Can't find Pod '$name' in @POD\n";
145    }
146    if (eval { require File::Spec; File::Spec->can("rel2abs") }) {
147	DEBUG and warn "Turn $absname into an absolute file name";
148	$absname = File::Spec->rel2abs($absname);
149    }
150    $absname;
151}
152
153sub _remember_old {
154    my $w = shift;
155    for (qw(File Text)) {
156	$w->{"Old$_"} = $w->{$_};
157    }
158}
159
160sub _restore_old {
161    my $w = shift;
162    for (qw(File Text)) {
163	$w->{$_} = $w->{"Old$_"};
164    }
165}
166
167sub file {   # main entry point
168  my $w = shift;
169  if (@_)
170    {
171      my $file = shift;
172      $w->_remember_old;
173      eval {
174	  my $calling_from_history = $w->privateData()->{'from_history'};
175	  $w->{'File'} = $file;
176	  $w->{'Text'} = undef;
177	  my $path = $w->findpod($file);
178	  if (!$calling_from_history) {
179	      $w->history_modify_entry;
180	      $w->history_add({file => $path}, "1.0");
181	  }
182	  $w->configure('-path' => $path);
183	  $w->delete('1.0' => 'end');
184	  my $tree_sw = $w->parent->Subwidget("tree");
185	  if ($tree_sw) {
186	      $tree_sw->SeePath("file:$path");
187	  }
188	  my $t;
189	  if (DEBUG) {
190	      require Benchmark;
191	      $t = Benchmark->new;
192	  }
193	  if (!$w->get_from_cache) {
194	      $w->process($path);
195	      $w->add_to_cache; # XXX pass time for processing?
196	      if (!$calling_from_history) {
197		  $w->history_modify_current_title; # now the pod_title is known
198	      }
199	  }
200	  if (defined $t) {
201	      print Benchmark::timediff(Benchmark->new, $t)->timestr,"\n";
202	  }
203	  $w->focus;
204      };
205      if ($@) {
206	  $w->_restore_old;
207	  die $@;
208      }
209    }
210  $w->{'File'};
211}
212
213sub text {
214  my $w = shift;
215  if (@_)
216    {
217      my $text = shift;
218      $w->_remember_old;
219      eval {
220	  my $calling_from_history = $w->privateData()->{'from_history'};
221	  $w->{'Text'} = $text;
222	  $w->{'File'} = undef;
223	  if (!$calling_from_history) {
224	      $w->history_modify_entry;
225	      $w->history_add({text => $text}, "1.0");
226	  }
227	  $w->configure('-path' => undef);
228	  $w->delete('1.0' => 'end');
229## XXX Implementation unclear, maybe should be done in showcommand call...
230#	  my $tree_sw = $w->parent->Subwidget("tree");
231#	  if ($tree_sw) {
232#	      $tree_sw->SeeFunc("file:$path");
233#	  }
234	  my $t;
235	  if (DEBUG) {
236	      require Benchmark;
237	      $t = Benchmark->new;
238	  }
239	  # No caching here
240	  # XXX title: the 2nd part of the hack
241	  my $title = $w->cget(-title);
242	  $w->process(\$text, $title);
243	  if (!$calling_from_history) {
244	      $w->history_modify_current_title; # now the pod_title is known
245	  }
246	  if (defined $t) {
247	      print Benchmark::timediff(Benchmark->new, $t)->timestr,"\n";
248	  }
249	  $w->focus;
250      };
251      if ($@) {
252	  $w->_restore_old;
253	  die $@;
254      }
255    }
256  $w->{'Text'};
257}
258
259sub reload
260{
261 my ($w) = @_;
262 # remember old y position
263 my ($currpos) = $w->yview;
264 $w->delete('0.0','end');
265 $w->delete_from_cache;
266 $w->process($w->cget('-path'));
267 # restore old y position
268 $w->yview(moveto => $currpos);
269 # set (invisible) insertion cursor into the visible text area
270 $w->markSet(insert => '@0,0');
271}
272
273# Works also for viewing source code
274sub _get_editable_path
275{
276 my ($w) = @_;
277 my $path = $w->cget('-path');
278 if (!defined $path)
279  {
280   my $text = $w->cget("-text");
281   $w->_need_File_Temp;
282   my($fh,$fname) = File::Temp::tempfile(UNLINK => 1,
283					 SUFFIX => "_tkpod.pod");
284   print $fh $text;
285   close $fh;
286   $path = $fname;
287  }
288 $path;
289}
290
291sub edit
292{
293 my ($w,$edit,$linenumber) = @_;
294 my $path = $w->_get_editable_path;
295 if (!defined $edit)
296  {
297   $edit = $ENV{TKPODEDITOR};
298  }
299 if ($^O eq 'MSWin32')
300  {
301   if (defined $edit && $edit ne "")
302    {
303     system(1, $edit, $path);
304    }
305   else
306    {
307     system(1, "ptked", $path);
308    }
309  }
310 else
311  {
312   if (!defined $edit || $edit eq "")
313    {
314     # VISUAL and EDITOR are supposed to have a terminal, but tkpod can
315     # be started without a terminal.
316     my $isatty = is_interactive();
317     if (!$isatty)
318      {
319       if (!defined $edit || $edit eq "")
320        {
321         $edit = $ENV{XEDITOR};
322        }
323       if (!defined $edit || $edit eq "")
324        {
325         if (!$terminal_fallback_warn_shown)
326	  {
327           $w->_warn_dialog("No terminal and neither TKPODEDITOR nor XEDITOR environment variables set. Fallback to ptked.");
328	   $terminal_fallback_warn_shown = 1;
329          }
330         $edit = 'ptked';
331        }
332      }
333     else
334      {
335       $edit = $ENV{VISUAL} || $ENV{'EDITOR'} || '/usr/bin/vi';
336      }
337    }
338
339   if (defined $edit)
340    {
341     if (fork)
342      {
343       wait; # parent
344      }
345     else
346      {
347       #child
348       if (fork)
349        {
350         # still child
351         exec("true");
352        }
353       else
354        {
355         # grandchild
356	 if (defined $linenumber && $edit =~ m{\bemacsclient\b}) # XXX an experiment, maybe support more editors?
357	  {
358	   exec("$edit +$linenumber $path");
359          }
360	 else
361	  {
362           exec("$edit $path");
363          }
364        }
365      }
366    }
367  }
368}
369
370sub edit_get_linenumber
371{
372 my($w) = @_;
373 my $linenumber = $w->get_linenumber;
374 $w->edit(undef, $linenumber);
375}
376
377sub get_linenumber
378{
379 my($w) = @_;
380 for my $tag ($w->tagNames('@' . ($w->{MenuX} - $w->rootx) . ',' . ($w->{MenuY} - $w->rooty)))
381  {
382   if ($tag =~ m{start_line_(\d+)})
383    {
384     return $1;
385    }
386  }
387 undef;
388}
389
390sub view_source
391{
392 my($w) = @_;
393 # XXX why is -title empty here?
394 my $title = $w->cget(-title) || $w->cget('-file');
395 my $t = $w->Toplevel(-title => "Source of $title - Tkpod");
396 my $font_size = $w->base_font_size;
397 my $more = $t->Scrolled('More',
398			 -font => "Courier $font_size",
399			 -scrollbars => $Tk::platform eq 'MSWin32' ? 'e' : 'w',
400			)->pack(-fill => "both", -expand => 1);
401 $more->Load($w->_get_editable_path);
402 my $linenumber = $w->get_linenumber;
403 if (defined $linenumber)
404  {
405   $more->see($linenumber.'.'.0);
406  }
407 $more->AddQuitBindings;
408 $more->focus;
409}
410
411sub copy_pod_location
412{
413 my($w) = @_;
414 my $file = $w->_get_editable_path;
415 if (!defined $file)
416  {
417   $w->_error_dialog("Cannot copy location: this Pod is not associated with a file");
418   return;
419  }
420 $w->SelectionOwn;
421 $w->SelectionHandle(sub {
422			 my($offset,$maxbytes) = @_;
423			 # XXX It's not exactly clear why I have to
424			 # call _get_editable_path again here and not
425			 # reuse $file.
426			 my $file = $w->_get_editable_path;
427			 return undef if $offset > length($file);
428			 substr($file, $offset, $maxbytes);
429		     });
430}
431
432sub _sgn { $_[0] cmp 0 }
433
434sub zoom_normal {
435    my $w = shift;
436    $w->adjust_font_size($w->standard_font_size);
437    $w->clear_cache;
438}
439
440# XXX should use different increments for different styles
441sub zoom_out {
442    my $w = shift;
443    $w->adjust_font_size($w->base_font_size - 1 * _sgn($w->base_font_size));
444    $w->clear_cache;
445}
446
447sub zoom_in {
448    my $w = shift;
449    $w->adjust_font_size($w->base_font_size + 1 * _sgn($w->base_font_size));
450    $w->clear_cache;
451}
452
453sub More_Widget { "More" }
454sub More_Module { "Tk::More" }
455
456sub Populate
457{
458    my ($w,$args) = @_;
459
460    if ($w->More_Module) {
461	eval q{ require } . $w->More_Module;
462	die $@ if $@;
463    }
464
465    $w->SUPER::Populate($args);
466
467    $w->privateData()->{history} = [];
468    $w->privateData()->{history_index} = -1;
469
470    my $p = $w->Scrolled($w->More_Widget,
471			 -helpcommand => sub {
472			     $w->parent->help if $w->parent->can('help');
473			 },
474			 -scrollbars => $Tk::platform eq 'MSWin32' ? 'e' : 'w');
475    my $p_scr = $p->Subwidget('scrolled');
476    $w->Advertise('more' => $p_scr);
477    $p->pack(-expand => 1, -fill => 'both');
478
479    # XXX Subwidget stuff needed because Scrolled does not
480    #     delegate bind, bindtag to the scrolled widget. Tk402.* (and before?)
481    #	  (patch posted and included in Tk402.004)
482    $p_scr->bindtags([$p_scr, $p_scr->bindtags]);
483    $p_scr->bind('<Double-1>',       sub  { $w->DoubleClick($_[0]) });
484    $p_scr->bind('<Shift-Double-1>', sub  { $w->ShiftDoubleClick($_[0]) });
485    $p_scr->bind('<Double-2>',       sub  { $w->ShiftDoubleClick($_[0]) });
486    $p_scr->bind('<3>',              sub  { $w->PostPopupMenu($p_scr, $w->pointerxy) });
487    $p_scr->bind('<ButtonRelease-2>', [sub {
488					   # A hack solution to prevent from firing this
489					   # event over pod links. See http://wiki.tcl.tk/6101
490					   my($ro,$x,$y) = @_;
491					   if (grep { $_ eq 'pod_link' } $ro->tagNames("\@$x,$y")) {
492					       Tk->break;
493					   } else {
494					       $w->OpenPodBySelection;
495					   }
496				       }, Tk::Ev("x"), Tk::Ev("y")]);
497
498    $p->configure(-font => $w->Font(family => 'courier'));
499
500    $p->tag('configure','text', -font => $w->Font(family => 'times'));
501
502    $p->insert('0.0',"\n");
503
504    $w->{List}   = []; # stack of =over
505    $w->{Item}   = undef;
506    $w->{'indent'} = 0;
507    $w->{Length}  = 64;
508    $w->{Indent}  = {}; # tags for various indents
509
510    # Seems like a perl bug: ->can() does not work before actually calling
511    # the subroutines (perl5.6.0 isa bug?)
512    eval {
513	$p->EditMenuItems;
514	$p->SearchMenuItems;
515	$p->ViewMenuItems;
516    };
517
518    my $m = $p->Menu
519	(-title => "Tkpod",
520	 -tearoff => $Tk::platform ne 'MSWin32',
521	 -menuitems =>
522	 [
523	  [Button => 'Back',     -command => [$w, 'history_move', -1]],
524	  [Button => 'Forward',  -command => [$w, 'history_move', +1]],
525	  [Button => 'Reload',   -command => sub{$w->reload} ],
526	  [Button => 'Edit Pod',       -command => sub{ $w->edit_get_linenumber } ],
527	  [Button => 'View source',    -command => sub{ $w->view_source } ],
528	  [Button => 'Copy Pod location', -command => sub { $w->copy_pod_location } ],
529	  [Button => 'Search full text',-command => ['SearchFullText', $w]],
530	  [Separator => ""],
531	  [Cascade => 'Edit',
532	   ($Tk::VERSION > 800.015 && $p->can('EditMenuItems') ? (-menuitems => $p->EditMenuItems) : ()),
533	  ],
534	  [Cascade => 'Search',
535	   ($Tk::VERSION > 800.015 && $p->can('SearchMenuItems') ? (-menuitems => $p->SearchMenuItems) : ()),
536	  ],
537	  [Cascade => 'View',
538	   ($Tk::VERSION > 800.015 && $p->can('ViewMenuItems') ? (-menuitems => $p->ViewMenuItems) : ()),
539	  ]
540	 ]);
541    eval { $p->menu($m) }; warn $@ if $@;
542
543    $w->Delegates(DEFAULT => $p,
544		  'SearchFullText' => 'SELF',
545		 );
546
547    $w->ConfigSpecs(
548            '-file'       => ['METHOD'  ],
549            '-text'       => ['METHOD'  ],
550            '-path'       => ['PASSIVE' ],
551            '-poddone'    => ['CALLBACK'],
552	    '-title'      => ['PASSIVE' ], # XXX unclear
553
554            '-wrap'       => [ $p, qw(wrap       Wrap       word) ],
555	    # -font ignored because it does not change the other fonts
556	    #'-font'	  => [ 'PASSIVE', undef, undef, undef],
557            '-scrollbars' => [ $p, qw(scrollbars Scrollbars), $Tk::platform eq 'MSWin32' ? 'e' : 'w' ],
558	    '-basefontsize' => ['METHOD'], # XXX may change
559
560            'DEFAULT'     => [ $p ],
561            );
562
563    $args->{-width} = $w->{Length};
564}
565
566sub basefontsize
567{
568 my($w, $val) = @_;
569 if ($val)
570  {
571   $w->set_base_font_size($val);
572  }
573 else
574  {
575   $w->base_font_size;
576  }
577}
578
579sub Font
580{
581 my ($w,%args)    = @_;
582 $args{'family'}  = 'times'  unless (exists $args{'family'});
583 $args{'weight'}  = 'medium' unless (exists $args{'weight'});
584 $args{'slant'}   = 'r'      unless (exists $args{'slant'});
585 $args{'size'}    = 140      unless (exists $args{'size'});
586 $args{'spacing'} = '*'     unless (exists $args{'spacing'});
587 $args{'slant'}   = substr($args{'slant'},0,1);
588 my $name = "-*-$args{'family'}-$args{'weight'}-$args{'slant'}-*-*-*-$args{'size'}-*-*-$args{'spacing'}-*-iso8859-1";
589 return $name;
590}
591
592sub ShiftDoubleClick {
593    shift->DoubleClick(shift, 'new');
594}
595
596sub DoubleClick
597{
598 my ($w,$ww,$how) = @_;
599 my $Ev = $ww->XEvent;
600 $w->SelectToModule($Ev->xy);
601 my $sel = catch { $w->SelectionGet };
602 if (defined $sel)
603  {
604   my $file;
605   if ($file = $w->findpod($sel)) {
606       if (defined $how && $how eq 'new')
607	{
608	 my $tree = eval { $w->parent->cget(-tree) };
609	 my $exitbutton = eval { $w->parent->cget(-exitbutton) };
610         $w->MainWindow->Pod('-file' => $sel,
611			     '-tree' => $tree,
612			     -exitbutton => $exitbutton);
613	}
614       else
615	{
616         $w->configure('-file'=>$file);
617        }
618   } else {
619       $w->_die_dialog("No Pod documentation found for '$sel'\n");
620   }
621  }
622 Tk->break;
623}
624
625sub Link
626{
627 my ($w,$how,$index,$man,$sec) = @_;
628
629 # If clicking on a Link, the <Leave> binding is never called, so it
630 # have to be done here:
631 $w->LeaveLink;
632
633 $man = '' unless defined $man;
634 $sec = '' unless defined $sec;
635
636 if ($how eq 'reuse' && $man ne '')
637  {
638   my $file = $w->cget('-file');
639   $w->configure('-file' => $man)
640    unless ( defined $file and ($file =~ /\Q$man\E\.\w+$/ or $file eq $man) );
641  }
642
643 if ($how eq 'new')
644  {
645   $man = $w->cget('-file') if ($man eq "");
646   my $tree = eval { $w->parent->cget(-tree) };
647   my $exitbutton = eval { $w->parent->cget(-exitbutton) };
648   my $old_w = $w;
649   my $new_pod = $w->MainWindow->Pod('-tree' => $tree,
650				     -exitbutton => $exitbutton,
651				    );
652   $new_pod->configure('-file' => $man); # see tkpod for the same problem
653
654   $w = $new_pod->Subwidget('pod');
655   # set search term for new window
656   my $search_term_ref = $old_w->Subwidget('more')->Subwidget('searchentry')->cget(-textvariable);
657   if (defined $$search_term_ref && $$search_term_ref ne "") {
658       $ {$w->Subwidget('more')->Subwidget('searchentry')->cget(-textvariable) } = $$search_term_ref;
659   }
660  }
661  # XXX big docs like Tk::Text take too long until they return
662
663 if ($sec ne '' && $man eq '') # XXX reuse vs. new
664  {
665   $w->history_modify_entry;
666  }
667
668 if ($sec ne '')
669  {
670
671   my $highlight_match = sub
672    {
673     my $start = shift;
674     my($line) = split(/\./, $start);
675     $w->tag('remove', '_section_mark', qw/0.0 end/);
676     $w->tag('add', '_section_mark',
677	     $line . ".0",
678	     $line . ".0 lineend");
679     $w->yview("_section_mark.first");
680     $w->after(500, [$w, qw/tag remove _section_mark 0.0 end/]);
681    };
682
683   DEBUG and warn "Looking for section \"$sec\" across Sections entries...\n";
684
685   foreach my $s ( @{$w->{'sections'} || []} )
686    {
687     if($s->[1] eq $sec)
688      {
689       DEBUG and warn " $sec is $$s[1] (at $$s[2])\n";
690       my $start = $s->[2];
691       my($line) = split(/\./, $start);
692       $line--; # off by one, why?
693       $highlight_match->("$line.0");
694       return;
695      }
696     else
697      {
698       DEBUG > 2 and warn " Nope, it's not $$s[1] (at $$s[2])\n";
699      }
700    }
701
702   my $start = ($w->tag('nextrange',$sec, '1.0'))[0];
703
704   if (defined $start)
705    {
706     DEBUG and warn " Found at $start\n";
707     $highlight_match->($start);
708     return;
709    }
710   else
711    {
712     DEBUG and warn " Not found so far.  Using a quoted nextrange search...\n";
713     my $link = ($man || '') . $sec;
714     $start = ($w->tag('nextrange',"\"$link\"",'1.0'))[0];
715    }
716
717   if (defined $start)
718    {
719     DEBUG and warn " Found at $start\n";
720     $highlight_match->($start);
721     return;
722    }
723   else
724    {
725     DEBUG and warn " Again not found.  Using an exact search at line beginnings...\n";
726     $start = $w->search(qw/-regexp -nocase --/, qr{^\s*\Q$sec}, '1.0');
727    }
728
729   if (defined $start)
730    {
731     DEBUG and warn " Found at $start\n";
732     $highlight_match->($start);
733     return;
734    }
735   else
736    {
737     DEBUG and warn " Again not found.  Using an exact search...\n";
738     $start = $w->search(qw/-exact -nocase --/, $sec, '1.0');
739    }
740
741   if (defined $start)
742    {
743     DEBUG and warn " Found at $start\n";
744     $highlight_match->($start);
745     return;
746    }
747   else
748    {
749     DEBUG and warn " Not found! (\"sec\")\n";
750     $w->_die_dialog("Section '$sec' not found\n");
751    }
752   DEBUG and warn "link-zapping to $start linestart\n";
753   $w->yview("$start linestart");
754  }
755
756 if ($sec ne '' && $man eq '') # XXX reuse vs. new
757  {
758   $w->history_add({file => $w->cget(-path)}, $w->index('@0,0'));
759  }
760
761}
762
763sub Link_url {
764    my ($w,$how,$index,$man,$sec) = @_;
765    if (my($lat,$lon) = $man =~ m{^geo:([^,]+),([^,]+)}) {
766        DEBUG and warn "Translate geo URI $man\n";
767        # XXX currently hardcoded to OSM, maybe make configurable
768        $man = "http://www.openstreetmap.org/?mlat=$lat&mlon=$lon";
769    }
770    DEBUG and warn "Start browser with $man\n";
771    start_browser($man);
772}
773
774sub Link_man {
775    my ($w,$how,$index,$man,$sec) = @_;
776    my $mansec;
777    if ($man =~ s/\s*\((.*)\)\s*$//) {
778	$mansec = $1;
779    }
780    my @manbrowser;
781    if (exists $ENV{TKPODMANVIEWER} && $ENV{TKPODMANVIEWER} eq "internal") {
782	DEBUG and warn "Use internal man viewer\n";
783    } else {
784	my $manurl = "man:$man($mansec)";
785	if (defined $sec && $sec ne "") {
786	    $manurl .= "#$sec";
787	}
788	DEBUG and warn "Try to start any man browser for $manurl\n";
789	@manbrowser = ('gnome-help-browser', 'khelpcenter');
790	my $wm = detect_window_manager($w);
791	DEBUG and warn "Window manager system is $wm\n";
792	if ($wm eq 'kde') {
793	    unshift @manbrowser, 'khelpcenter';
794	}
795	if (defined $ENV{TKPODMANVIEWER}) {
796	    unshift @manbrowser, $ENV{TKPODMANVIEWER};
797	}
798	for my $manbrowser (@manbrowser) {
799	    DEBUG and warn "Try $manbrowser...\n";
800	    if (is_in_path($manbrowser)) {
801		if (fork == 0) {
802		    DEBUG and warn "Use $manbrowser...\n";
803		    exec($manbrowser, $manurl);
804		    die $!;
805		}
806		return;
807	    }
808	}
809    }
810    if (!$w->InternalManViewer($mansec, $man)) {
811	$w->_die_dialog("No useable man browser found. Tried @manbrowser and internal man viewer via `man'");
812    }
813}
814
815sub InternalManViewer {
816    my($w, $mansec, $man) = @_;
817    my $man_exe = "man";
818    if (!is_in_path($man_exe)) {
819	if ($^O eq 'MSWin32') {
820	    $man_exe = "c:/cygwin/bin/man.exe";
821	    if (!-e $man_exe) {
822		return 0;
823	    }
824	} else {
825	    return 0;
826	}
827    }
828    my $t = $w->Toplevel(-title => "Manpage $man($mansec)");
829    my $font_size = $w->base_font_size;
830    my $more = $t->Scrolled("More",
831			    -font => "Courier $font_size",
832			    -scrollbars => $Tk::platform eq 'MSWin32' ? 'e' : 'w',
833			   )->pack(-fill => "both", -expand => 1);
834    $more->tagConfigure("bold", -font => "Courier $font_size bold");
835    my $menu = $more->menu;
836    $t->configure(-menu => $menu);
837    local $SIG{PIPE} = "IGNORE";
838    my $can_langinfo = $] >= 5.008 && eval { require I18N::Langinfo; 1 };
839    local $ENV{LANG} = $ENV{LANG};
840    if (!$can_langinfo) {
841	$ENV{LANG} = "C";
842    }
843    open(MAN, $man_exe . (defined $mansec ? " $mansec" : "") . " $man |")
844	or die $!;
845    if ($can_langinfo) {
846	my $codeset = I18N::Langinfo::langinfo(I18N::Langinfo::CODESET());
847	eval qq{ binmode MAN, q{:encoding($codeset)} };
848	warn $@ if $@;
849    }
850    if (eof MAN) {
851	$more->insert("end", "No entry for for $man" . (defined $mansec ? " in section $mansec of" : "") . " the manual");
852    } else {
853	while(<MAN>) {
854	    chomp;
855	    (my $line = $_) =~ s/.\cH//g;
856	    my @bold;
857	    while (/(.*?)((?:(.)(\cH\3)+)+)/g) {
858		my($pre, $bm) = ($1, $2);
859		$pre =~ s/.\cH//g;
860		$bm  =~ s/.\cH//g;
861		push @bold, length $pre, length $bm;
862	    }
863	    if (@bold) {
864		my $is_bold = 0;
865		foreach my $length (@bold) {
866		    if ($length > 0) {
867			(my($s), $line) = $line =~ /^(.{$length})(.*)/;
868			$more->insert("end", $s, $is_bold ? "bold" : ());
869		    }
870		    $is_bold = 1 - $is_bold;
871		}
872		$more->insert("end", "$line\n");
873	    } else {
874		$more->insert("end", "$line\n");
875	    }
876	}
877    }
878    close MAN;
879    1;
880}
881
882sub EnterLink {
883    my $w = shift;
884    $w->configure(-cursor=>'hand2');
885}
886
887sub LeaveLink {
888    my $w = shift;
889    $w->configure(-cursor=>undef);
890}
891
892sub SearchFullText {
893    my $w = shift;
894    unless (defined $IDX && $IDX->IsWidget) {
895	require Tk::Pod::Search; #
896	$IDX = $w->Toplevel(-title=>'Perl Library Full Text Search');
897	$IDX->transient($w);
898
899	my $current_path;
900	my $tree_sw = $w->parent->Subwidget("tree");
901	if ($tree_sw) {
902	    $current_path = $tree_sw->GetCurrentPodPath;
903	}
904
905	$IDX->PodSearch(
906			-command =>
907			sub {
908			    my($pod, %args) = @_;
909			    $w->configure('-file' => $pod);
910			    $w->focus;
911			    my $more = $w->Subwidget('more');
912			    $more->SearchText
913				(-direction => 'Next',
914				 -quiet => 1,
915				 -searchterm => $args{-searchterm},
916				 -onlymatch => 1,
917				);
918			},
919			-currentpath => $current_path,
920		       )->pack(-fill=>'both',-expand=>'both');
921	# XXX A very rough solution:
922	$IDX->Button(-text => "Rebuild search index",
923		     -command => sub {
924		      my $installscriptdir = $Config{'installscript'};
925		      my $perlindex = 'perlindex';
926		      if (-d $installscriptdir)
927		       {
928			$perlindex = "$installscriptdir/perlindex";
929			if (!-f $perlindex)
930			 {
931			  $w->_error_dialog("perlindex was expected in the path '$perlindex', but not found. Cannot build search index.");
932			  return;
933			 }
934		       }
935		      my $pw_bg_msg = "The next dialog will ask for the root password. The search index building will happen in background.";
936		      if (!is_in_path("gksu"))
937		       {
938			if (!is_in_path("xsu"))
939			 {
940			  $w->_error_dialog("gksu or xsu needed to start perlindex");
941			  return;
942			 }
943			$w->_warn_dialog($pw_bg_msg);
944			if (fork == 0)
945		         {
946			  system('xsu',
947				 '--command', "$perlindex -index",
948				 '--username', 'root',
949				 '--title' => 'Rebuild search index',
950				 '--set-display' => $w->screen,
951				);
952			  CORE::exit(0);
953			 }
954		       }
955		      else
956		       {
957			$w->_warn_dialog($pw_bg_msg);
958			if (fork == 0)
959			 {
960			  system('gksu',
961				 '--user', 'root',
962				 #'--description', 'Rebuild search index',
963				 "perlindex -index",
964				);
965			  CORE::exit(0);
966			 }
967		       }
968		     }
969		    )->pack(-fill => 'x');
970	$IDX->Button(-text => "Close",
971		     -command => sub { $IDX->destroy },
972		    )->pack(-fill => 'x');
973    }
974    $IDX->deiconify;
975    $IDX->raise;
976    $IDX->bind('<Escape>' => [$IDX, 'destroy']);
977    (($IDX->children)[0])->focus;
978}
979
980sub _need_File_Temp {
981    my $w = shift;
982    if (!eval { require File::Temp; 1 }) {
983	$w->_die_dialog("The perl module 'File::Temp' is missing");
984    }
985}
986
987sub Print {
988    my $w = shift;
989
990    my($text, $path);
991    $path = $w->cget(-path);
992    if (defined $path) {
993	if (!-r $path) {
994	    $w->_die_dialog("Cannot find file `$path`");
995	}
996    } else {
997	$text = $w->cget("-text");
998	$w->_need_File_Temp;
999	my($fh,$fname) = File::Temp::tempfile(UNLINK => 1,
1000					      SUFFIX => "_tkpod.pod");
1001	print $fh $text;
1002	close $fh;
1003	$path = $fname;
1004    }
1005
1006    if ($ENV{'TKPODPRINT'}) {
1007	my @cmd = _substitute_cmd($ENV{'TKPODPRINT'}, $path);
1008	DEBUG and warn "Running @cmd\n";
1009	system @cmd;
1010	return;
1011    } elsif ($^O =~ m/Win32/) {
1012	return $w->Print_MSWin($path);
1013    }
1014    # otherwise fall thru...
1015
1016    my $success = $w->_print_pod_unix($path);
1017
1018    if (!$success) {
1019	$w->_error_dialog("Can't print on your system.\nEither pod2man, groff,\ngv or ghostview are missing.");
1020    }
1021}
1022
1023sub _print_pod_unix {
1024    my($w, $path) = @_;
1025    if (is_in_path("pod2man") && is_in_path("groff")) {
1026	my $pod2ps_pipe = "pod2man $path | groff -man -Tps";
1027
1028	if ($^O eq 'darwin') {
1029	    my $cmd = "$pod2ps_pipe | /usr/bin/open -a Preview -f";
1030	    system($cmd) == 0
1031		or $w->_die_dialog("Error while executing <$cmd>. Status code is $?");
1032	    return 1;
1033	}
1034
1035	# XXX maybe determine user's environment (GNOME vs. KDE vs. plain X11)?
1036	my $gv = is_in_path("gv")
1037	      || is_in_path("ghostview")
1038	      || is_in_path("ggv")         # newer versions seem to work
1039	      || is_in_path("kghostview");
1040	if ($gv) {
1041	    $w->_need_File_Temp;
1042
1043	    my($fh,$fname) = File::Temp::tempfile(SUFFIX => "_tkpod.ps");
1044	    system("$pod2ps_pipe > $fname");
1045	    push @tempfiles, $fname;
1046	    my $pid = fork;
1047	    if (!defined $pid) {
1048		die "Can't fork: $!";
1049	    }
1050	    if ($pid == 0) {
1051		exec($gv, $fname);
1052		warn "Exec of $gv $fname failed: $!";
1053		CORE::exit(1);
1054	    }
1055	    push @gv_pids, $pid;
1056	    return 1;
1057	}
1058    }
1059    return 0;
1060}
1061
1062
1063sub _substitute_cmd {
1064    my($cmd, $path) = @_;
1065    my @cmd;
1066    if ($cmd =~ /%s/) {
1067	($cmd[0] = $cmd) =~ s/%s/$path/g;
1068    } else {
1069	@cmd = ($cmd, $path);
1070    }
1071    @cmd;
1072}
1073
1074sub Print_MSWin {
1075  my($self, $path) = @_;
1076  my $is_old;
1077  $is_old = 1  if
1078   defined(&Win32::GetOSVersion) and
1079   eval {require Win32; 1} and
1080   defined(&Win32::GetOSName) and
1081    (Win32::GetOSName() eq 'Win32s'  or   Win32::GetOSName() eq 'Win95');
1082  require POSIX; # XXX should be probably replaced by File::Temp, but I have no Win machine to test...
1083
1084  my $temp = POSIX::tmpnam(); # XXX it never gets deleted
1085  $temp =~ tr{/}{\\};
1086  $temp =~ s/\.$//;
1087  DEBUG and warn "Using $temp as the temp file for hardcopying\n";
1088  # XXX cleanup of temp file?
1089
1090  if($is_old) { # so we can't assume that write.exe can handle RTF
1091    require Pod::Simple::Text;
1092    require Text::Wrap;
1093    local $Text::Wrap::columns = 65; # reasonable number, I think.
1094    $temp .= '.txt';
1095    Pod::Simple::Text->parse_from_file($path, $temp);
1096    system("notepad.exe", "/p", $temp);
1097
1098  } else { # Assume that our write.exe should understand RTF
1099    require Pod::Simple::RTF;
1100    $temp .= '.rtf';
1101    Pod::Simple::RTF->parse_from_file($path, $temp);
1102    system("write.exe", "/p", "\"$temp\"");
1103  }
1104
1105  return;
1106}
1107
1108sub PrintHasDialog { $^O ne 'MSWin32' }
1109
1110# Return $first and $last indices of the word under $index
1111sub _word_under_index {
1112    my($w, $index)= @_;
1113    my ($first,$last);
1114    $first = $w->search(qw/-backwards -regexp --/, '[^\w:]', $index, "$index linestart");
1115    $first = $w->index("$first + 1c") if $first;
1116    $first = $w->index("$index linestart") unless $first;
1117    $last  = $w->search(qw/-regexp --/, '[^\w:]', $index, "$index lineend");
1118    $last  = $w->index("$index lineend") unless $last;
1119    ($first, $last);
1120}
1121
1122sub SelectToModule {
1123    my($w, $index)= @_;
1124    my ($first,$last) = $w->_word_under_index($index);
1125    if ($first && $last) {
1126	$w->tagRemove('sel','1.0',$first);
1127	$w->tagAdd('sel',$first,$last);
1128	$w->tagRemove('sel',$last,'end');
1129	$w->idletasks;
1130    }
1131}
1132
1133#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1134
1135# Add the file $file (with optional text index position $index) to the
1136# history.
1137sub history_add {
1138    my ($w,$what,$index) = @_;
1139    my($file, $text);
1140    if (ref $what eq 'HASH') {
1141	$file = $what->{file};
1142	$text = $what->{text};
1143    } else {
1144	$file = $what;
1145	$what = {file => $file};
1146    }
1147    if (defined $file) {
1148	unless (-f $file) {
1149	    $w->messageBox(-message => "Not a file '$file'. Can't add to history\n",
1150			   @{&HISTORY_DIALOG_ARGS});
1151	    return;
1152	}
1153    }
1154    my $hist = $w->privateData()->{history};
1155    my $hist_entry = Tk::Pod::Text::_HistoryEntry->create($what, $index, $w->{pod_title});
1156    $hist->[++$w->privateData()->{history_index}] = $hist_entry;
1157    splice @$hist, $w->privateData()->{history_index}+1;
1158    $w->history_view_update;
1159    $w->history_view_select;
1160    $w->_history_navigation_update;
1161    undef;
1162}
1163
1164# Perform a "history back" operation, if possible. The current page is
1165# updated in the history.
1166sub history_back {
1167    my ($w) = @_;
1168    my $hist = $w->privateData()->{history};
1169    if (!@$hist) {
1170        $w->messageBox(-message => "History is empty",
1171		       @{&HISTORY_DIALOG_ARGS});
1172	return;
1173    }
1174    if ($w->privateData()->{history_index} <= 0) {
1175	$w->messageBox(-message => "Can't go back in history",
1176		       @{&HISTORY_DIALOG_ARGS});
1177	return;
1178    }
1179
1180    $w->history_modify_entry;
1181
1182    $hist->[--$w->privateData()->{history_index}];
1183}
1184
1185# Perform a "history forward" operation, if possible. The current page is
1186# updated in the history.
1187sub history_forward {
1188    my ($w) = @_;
1189    my $hist = $w->privateData()->{history};
1190    if (!@$hist) {
1191        $w->messageBox(-message => "History is empty",
1192		       @{&HISTORY_DIALOG_ARGS});
1193	return;
1194    }
1195    if ($w->privateData()->{history_index} >= $#$hist) {
1196	$w->messageBox(-message => "Can't go forward in history",
1197		       @{&HISTORY_DIALOG_ARGS});
1198	return;
1199    }
1200
1201    $w->history_modify_entry;
1202
1203    $hist->[++$w->privateData()->{history_index}];
1204}
1205
1206# Private method: update the pod view if called from a history back/forward
1207# operation. This method will set the specified _HistoryEntry object.
1208sub _history_update {
1209    my($w, $hist_entry) = @_;
1210    if ($hist_entry) {
1211	if (defined $hist_entry->file) {
1212	    if ($w->cget('-path') ne $hist_entry->file) {
1213		$w->privateData()->{'from_history'} = 1;
1214		$w->configure('-file' => $hist_entry->file);
1215		$w->privateData()->{'from_history'} = 0;
1216	    }
1217	} elsif (defined $hist_entry->text) {
1218	    $w->privateData()->{'from_history'} = 1;
1219	    $w->configure('-text' => $hist_entry->text);
1220	    $w->privateData()->{'from_history'} = 0;
1221	}
1222	$w->_history_navigation_update;
1223	$w->afterIdle(sub { $w->see($hist_entry->index) })
1224	    if $hist_entry->index;
1225    }
1226}
1227
1228sub _history_navigation_update {
1229    my $w = shift;
1230    # XXX Be careful with the search pattern
1231    # if I decide to I18N Tk::Pod one day...
1232    my $m_history;
1233    if ($w->parent and $m_history = $w->parent->Subwidget("menubar")) {
1234	$m_history = $m_history->entrycget("History", "-menu");
1235	my $inx = $w->privateData()->{history_index};
1236	if ($inx == 0) {
1237	    $m_history->entryconfigure("Back", -state => "disabled");
1238	} else {
1239	    $m_history->entryconfigure("Back", -state => "normal");
1240	}
1241	if ($inx == $#{$w->privateData()->{history}}) {
1242	    $m_history->entryconfigure("Forward", -state => "disabled");
1243	} else {
1244	    $m_history->entryconfigure("Forward", -state => "normal");
1245	}
1246    }
1247}
1248
1249# Move the history backward ($inc == -1) or forward ($inc == +1)
1250sub history_move {
1251    my($w, $inc) = @_;
1252    my $hist_entry = ($inc == -1 ? $w->history_back : $w->history_forward);
1253    $w->_history_update($hist_entry);
1254    $w->history_view_select;
1255}
1256
1257# Set the history to the given index $inx.
1258sub history_set {
1259    my($w, $inx) = @_;
1260    if ($inx >= 0 && $inx <= $#{$w->privateData()->{history}}) {
1261	$w->history_modify_entry;
1262	$w->privateData()->{history_index} = $inx;
1263	$w->_history_update($w->privateData()->{history}->[$inx]);
1264    }
1265}
1266
1267# Modify the index (position) information of the current history entry.
1268sub history_modify_entry {
1269    my $w = shift;
1270    if ($w->privateData()->{'history_index'} >= 0) {
1271	my $entry = $w->privateData()->{'history'}->[$w->privateData()->{'history_index'}];
1272	$entry->index($w->index('@0,0'));
1273    }
1274}
1275
1276# Modify the pod title of the current history entry.
1277sub history_modify_current_title {
1278    my $w = shift;
1279    my $pod_title = $w->{pod_title};
1280    if (defined $pod_title) {
1281	my $history_index = $w->privateData()->{'history_index'};
1282	if ($history_index >= 0) {
1283	    my $entry = $w->privateData()->{'history'}->[$history_index];
1284	    $entry->pod_title($pod_title);
1285	    $w->history_view_update;
1286	    $w->history_view_select;
1287	}
1288    }
1289}
1290
1291# Create a new history view toplevel or reuse an old one.
1292sub history_view {
1293    my $w = shift;
1294    my $t = $w->privateData()->{'history_view_toplevel'};
1295    if (!$t || !Tk::Exists($t)) {
1296	$t = $w->Toplevel(-title => 'History');
1297	$t->transient($w);
1298	$w->privateData()->{'history_view_toplevel'} = $t;
1299	my $lb = $t->Scrolled("Listbox", -scrollbars => 'oso'.($Tk::platform eq 'MSWin32'?'e':'w'))->pack(-fill => "both", '-expand' => 1);
1300	$t->Advertise(Lb => $lb);
1301	$lb->bind("<1>" => sub {
1302		      my $lb = shift;
1303		      my $y = $lb->XEvent->y;
1304		      $w->history_set($lb->nearest($y));
1305		  });
1306	$lb->bind("<Return>" => sub {
1307		      my $lb = shift;
1308		      my $sel = $lb->curselection;
1309		      return if !defined $sel;
1310		      $w->history_set($sel);
1311		  });
1312	$t->Button(-text => "Close",
1313		   -command => sub { $t->destroy },
1314		  )->pack(-fill => 'x');
1315    }
1316    $t->deiconify;
1317    $t->raise;
1318    $w->history_view_update;
1319    $w->history_view_select;
1320}
1321
1322# Re-fill the history view with the current history array.
1323sub history_view_update {
1324    my $w = shift;
1325    my $t = $w->privateData()->{'history_view_toplevel'};
1326    if ($t && Tk::Exists($t)) {
1327	my $lb = $t->Subwidget('Lb');
1328	$lb->delete(0, "end");
1329	foreach my $histentry (@{$w->privateData()->{'history'}}) {
1330	    $lb->insert("end", $histentry->get_label);
1331	}
1332    }
1333}
1334
1335# Move the history view selection to the current selected history entry.
1336sub history_view_select {
1337    my $w = shift;
1338    my $t = $w->privateData()->{'history_view_toplevel'};
1339    if ($t && Tk::Exists($t)) {
1340	my $lb = $t->Subwidget('Lb');
1341	$lb->selectionClear(0, "end");
1342	$lb->selectionSet($w->privateData()->{history_index});
1343    }
1344}
1345
1346sub PostPopupMenu {
1347    my($w, $p_scr, $X, $Y) = @_;
1348    $w->{MenuX} = $X;
1349    $w->{MenuY} = $Y;
1350    $p_scr->PostPopupMenu($X, $Y);
1351}
1352
1353sub OpenPodBySelection {
1354    my($w) = @_;
1355    my $sel;
1356    Tk::catch {
1357	$sel = $w->SelectionGet('-selection' => ($Tk::platform eq 'MSWin32'
1358						 ? "CLIPBOARD"
1359						 : "PRIMARY"));
1360    };
1361    $sel =~ s{\s}{}g; # no whitespace in Pod names possible
1362    $w->configure(-file => $sel);
1363}
1364
1365sub _die_dialog {
1366    shift->_error_dialog(@_);
1367    die;
1368}
1369
1370sub _error_dialog {
1371    my($w, $message) = @_;
1372    $w->messageBox(
1373      -title   => "Tk::Pod Error",
1374      -message => $message,
1375      -icon => 'error',
1376    );
1377}
1378
1379sub _warn_dialog {
1380    my($w, $message) = @_;
1381    $w->messageBox(
1382      -title   => "Tk::Pod Warning",
1383      -message => $message,
1384      -icon => 'warning',
1385    );
1386}
1387
1388sub cleanup_tempfiles {
1389    if (@tempfiles) {
1390	# first get rid of all possible zombies
1391	# before we can check with kill 0 => ...
1392	require POSIX;
1393	if (defined &POSIX::WNOHANG) { # defined everywhere?
1394	    while (waitpid(-1, &POSIX::WNOHANG) > 0) { }
1395	}
1396
1397	my $gv_running;
1398	for my $pid (@gv_pids) {
1399	    if (kill 0 => $pid) {
1400		$gv_running = 1;
1401		last;
1402	    }
1403	}
1404
1405	if ($gv_running) {
1406	    warn "A ghostscript (or equivalent) process is still running, won't delete temporary files: @tempfiles\n";
1407	} else {
1408	    for my $temp (@tempfiles) {
1409		unlink $temp;
1410	    }
1411	    @tempfiles = ();
1412	}
1413    }
1414}
1415
1416END {
1417    cleanup_tempfiles();
1418}
1419
14201;
1421
1422__END__
1423
1424=head1 NAME
1425
1426Tk::Pod::Text - Pod browser widget
1427
1428=head1 SYNOPSIS
1429
1430    use Tk::Pod::Text;
1431
1432    $pod = $parent->Scrolled("PodText",
1433			     -file	 => $file,
1434			     -scrollbars => "osoe",
1435		            );
1436
1437    $file = $pod->cget('-path');   # ?? the name path is confusing :-(
1438
1439=cut
1440
1441# also works with L<show|man/sec>. Therefore it stays undocumented :-)
1442
1443#    $pod->Link(manual/section)	# as L<manual/section> see perlpod
1444
1445
1446=head1 DESCRIPTION
1447
1448B<Tk::Pod::Text> is a readonly text widget that can display Pod
1449documentation.
1450
1451=head1 OPTIONS
1452
1453=over
1454
1455=item -file
1456
1457The named (pod) file to be displayed.
1458
1459=item -path
1460
1461Return the expanded path of the currently displayed Pod. Useable only
1462with the C<cget> method.
1463
1464=item -poddone
1465
1466A callback to be called if parsing and displaying of the Pod is done.
1467
1468=item -wrap
1469
1470Set the wrap mode. Default is C<word>.
1471
1472=item -scrollbars
1473
1474The position of the scrollbars, see also L<Tk::Scrolled>. By default,
1475the vertical scrollbar is on the right on Windows systems and on the
1476left on X11 systems.
1477
1478Note that it is not necessary and usually will do the wrong thing if
1479you put a C<Tk::Pod::Text> widget into a C<Scrolled> component.
1480
1481=back
1482
1483Other options are propagated to the embedded L<Tk::More> widget.
1484
1485=head1 ENVIRONMENT
1486
1487=over
1488
1489=item TKPODDEBUG
1490
1491Turn debugging mode on if set to a true value.
1492
1493=item TKPODPRINT
1494
1495Use the specified program for printing the current pod. If the string
1496contains a C<%s>, then filename substitution is used, otherwise the
1497filename of the Pod document is appended to the value of
1498C<TKPODPRINT>. Here is a silly example to send the Pod to a web browser:
1499
1500    env TKPODPRINT="pod2html %s > %s.html; galeon %s.html" tkpod ...
1501
1502=item TKPODEDITOR
1503
1504Use the specified program for editing the current pod. If
1505C<TKPODEDITOR> is not specified then the first defined value of
1506C<XEDITOR>, C<VISUAL>, or C<EDITOR> is used on Unix. As a last
1507fallback, C<ptked> or C<vi> are used, depending on platform and
1508existance of a terminal.
1509
1510=item TKPODMANVIEWER
1511
1512Use the specified program as the manpage viewer. The manpage viewer
1513should accept a manpage URL (C<man://>I<manpage>(I<section>)).
1514Alternatively the special viewer "internal" may be used. As fallback,
1515the default GNOME and/or KDE manpage viewer will be called.
1516
1517=back
1518
1519=head1 SEE ALSO
1520
1521L<Tk::More|Tk::More>
1522L<Tk::Pod|Tk::Pod>
1523L<Tk::Pod::SimpleBridge|Tk::Pod::SimpleBridge>
1524L<Tk::Pod::Styles|Tk::Pod::Styles>
1525L<Tk::Pod::Search|Tk::Pod::Search>
1526L<Tk::Pod::Search_db|Tk::Pod::Search_db>
1527L<perlpod|perlpod>
1528L<tkpod|tkpod>
1529L<perlindex|perlindex>
1530
1531
1532=head1 KNOWN BUGS
1533
1534See L<TODO> file of Tk-Pod distribution
1535
1536
1537
1538=head1 POD TO VERIFY B<PodText> WIDGET
1539
1540For B<PodText> see L<Tk::Pod::Text>.
1541
1542A C<fixed width> font.
1543
1544Text in I<slant italics>.
1545
1546A <=for> paragraph is hidden between here
1547
1548=for refcard  this should not be visisble.
1549
1550and there.
1551
1552A file: F</usr/local/bin/perl>.  A variable $a without markup.
1553
1554S<boofar> is in SE<lt>E<gt>.
1555
1556Indexed items are not supported in Tk::Pod. X<Index Test>
1557
1558Zero-Z<>effect formatting.
1559
1560German umlauts:
1561
1562=over 4
1563
1564=item auml: E<auml> �,
1565
1566=item Auml: E<Auml> �,
1567
1568=item ouml: E<ouml> �,
1569
1570=item Ouml: E<Ouml> �,
1571
1572=item Uuml: E<uuml> �,
1573
1574=item Uuml: E<Uuml> �,
1575
1576=item sz: E<szlig> �.
1577
1578=back
1579
1580Unicode outside Latin1 range: E<0x20ac> (euro sign).
1581
1582Pod with umlaut: L<ExtUtils::MakeMaker>.
1583
1584Details:  L<perlpod> or perl, perlfunc.
1585
1586External links: L<http://www.cpan.org> (URL), L<< URL with link text|http://www.cpan.org >>, L<perl(1)> (man page), L<Berliner Fernsehturm|geo:52.520685,13.409461> (geo: URL)
1587
1588Links to local sections: L<a section (SYNOPSIS)|/SYNOPSIS>, L<an item
1589(-file, currently wrong)|/-file>, L<a working item (auml)|/auml>.
1590
1591Links to external sections: L<a section (DESCRIPTION in
1592perl.pod)|perl/DESCRIPTION>, L<an item (Uncuddled elses in
1593perlstyle.pod)|perlstyle/Uncuddled elses>.
1594
1595Here some code in a as is paragraph
1596
1597    use Tk;
1598    my $mw = MainWindow->new;
1599    ...
1600    MainLoop
1601    __END__
1602
1603
1604Fonts: C<fixed>, B<bold>, I<italics>, normal, or file
1605F</path/to/a/file>
1606
1607Mixed Fonts: B<C<bold-fixed>>, B<I<bold-italics>>
1608
1609Non-breakable text: S<The quick brown fox jumps over the lazy fox.>
1610
1611Modern Pod constructs (multiple E<lt>E<gt>): I<< italic >>, C<< fixed
1612with embedded < and > >>.
1613
1614Itemize with numbers:
1615
1616=over
1617
1618=item 1.
1619
1620First
1621
1622=item 2.
1623
1624Second
1625
1626=item 3.
1627
1628Thirs
1629
1630=back
1631
1632Itemize with bullets:
1633
1634=over
1635
1636=item *
1637
1638First
1639
1640=item *
1641
1642Second
1643
1644=item *
1645
1646Thirs
1647
1648=back
1649
1650=head1 TESTING HEAD1
1651
1652=head2 TESTING HEAD2
1653
1654=head3 TESTING HEAD3
1655
1656=head4 TESTING HEAD4
1657
1658=begin a_format_which_does_not_exist
1659
1660This section should be invisible (=begin and =end).
1661
1662=end a_format_which_does_not_exist
1663
1664Other Pod docu: Tk::Font, Tk::BrowseEntry (not underlined, but
1665double-clickable in Tk::Pod)
1666
1667=head1 AUTHOR
1668
1669Nick Ing-Simmons <F<nick@ni-s.u-net.com>>
1670
1671Current maintainer is Slaven ReziE<0x107> <F<slaven@rezic.de>>.
1672
1673Copyright (c) 1998 Nick Ing-Simmons.
1674Copyright (c) 2015 Slaven Rezic.
1675All rights reserved. This program is free software; you can
1676redistribute it and/or modify it under the same terms as Perl itself.
1677
1678=cut
1679
1680# Local Variables:
1681# mode: cperl
1682# cperl-indent-level: 4
1683# End:
1684