#!/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('',['yview','scroll',1,'page']); $t->bind('',['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 () { 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); }