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