From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

#!/usr/local/bin/perl -w
use strict;
use Tk;
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);
}