The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/local/bin/perl -w

use strict;
use Tk;
use Tk::ROText;
use Tk::Font;
use Carp;

my $mw = MainWindow->new;
my $mfont     = $mw->Font(family => 'courier', slant => 'r', point => 140, weight  => 'medium');
my $bfont     = $mfont->Clone(weight  => 'bold');
my $t         = $mw->Scrolled('ROText',-font => $mfont, -wrap => 'none');
$t->Tag('bold',-font => $bfont);
$t->Tag('underline',-underline => 1);

$t->pack(-expand => 1, -fill => 'both');

# Netscape/Mosaic like paging
$t->bind('<space>',['yview','scroll',1,'page']);
$t->bind('<BackSpace>',['yview','scroll',-1,'page']);

@ARGV = qw(perl) unless (@ARGV);

load_doc($t,@ARGV);

$mw->focusNext;

MainLoop;

sub load_doc
{
  my $t = shift;
  open(PIPE,join(' ','perldoc',@_,'|')) || die "Cannot open pipe:$!";
  $t->delete('1.0' => 'end');
  $t->insert('end','');
  while (<PIPE>)
   {
    my $line  = "";
    my @bold  = ();
    my @under = ();
    while (length($_))
     {
      if (s/^(\n)//)
       {
        $t->insert('end',$1);
        $t->markSet(insert => 'end');
       }
      elsif (s/^_\010(.)//)
       {
        $t->insert('insert',$1,['underline']);
       }
      elsif (s/^([^\010])(\010\1)+//)
       {
        $t->insert('insert',$1,['bold']);
       }
      elsif (s/^\+\010o//)
       {
        $t->insert('insert','o',['bold']);
       }
      elsif (s/^(\010+)//)
       {
#       my $offset = length($1);
#       $t->markSet(insert => "insert - $offset c");
       }
      elsif (s/^(.)//)
       {
        $t->insert('insert',$1);
       }
     }
   }
  close(PIPE);

}