#!/usr/bin/perl
#-------------------------------------
# perlman: perldoc pod/man page viewer
#-------------------------------------
# Adapted (very loosely) by David Graff, from example code that came
# with a perl-Tk distribution.
#
# version 1.0, 4-May-1999
# version 2.0, 20-Sep-2002: adapted to handle user-selected perl versi
+on properly
# (basically, the pod/man pages you get depend on which version of per
+l you use
# to run the app; very handy on systems where more than one version is
+ installed

use strict;
use Tk;

my ($perlbase) = grep m%lib%, @INC;
$perlbase =~ s%/lib.*%%;
my $perldoc = "$perlbase/bin/perldoc";    # /path/name of perldoc to s
+how man and pod pages

scout_man_dirs();
create_ui();
MainLoop();

#-------------------------------------------------------------------
my $showEntry;       # for user to type in a doc name to "Show"
my $searchEntry;     # for user to type in a string pattern to "Search
+" for
my $fullListbox;     # presents complete list of perl man page names
my $srchListbox;     # presents search-matched list of perl man page n
+ames
my %doclist;         # hash lookup for man page file paths, keyed by m
+an page name
my $docnames;        # sorted concatenation of man page names
my @docnames;        # sorted array of man page names

sub show_man {
    my $entry = $showEntry->get();   # get entry from $show

    if ( $docnames =~ / ($entry) /i || $docnames =~ / (\w+\:+$entry) /
+i ) {
        $entry = $1;
    }
    system( "xterm -geometry 85x45 -T '$entry' -n '$entry' -e $perldoc
+ $entry &" );
}
sub print_man {
    my $entry = $showEntry->get();   # get entry from $show

    if ( $docnames =~ / ($entry) /i || $docnames =~ / (\w+\:+$entry) /
+i ) {
        $entry = $1;
    }
    system( "$perldoc $entry | enscript -2rl 2> /dev/null" );
}

sub create_ui {
    my $mainWin = MainWindow->new();
    $mainWin->title("Perl Documentation");
    my $topFrame = $mainWin->Frame()->pack(-side => 'top', -fill => 'x
+');
    my $cntlFrame = $mainWin->Frame()->pack(-side => 'top', -fill => '
+x');
    my $listFrame = $mainWin->Frame()->pack(-side => 'top', -fill => '
+x');

    $topFrame->Label(-text => "POD/MAN page index for Perl $]")->pack(
+-side => 'left');
    $topFrame->Button(-text => 'Reload',
                      -command => \&scout_man_dirs )->pack(-side => 'l
+eft');
    $topFrame->Button(-text => 'Exit',
                      -command => \&exit )->pack(-side => 'left', -pad
+x => 5);

    $cntlFrame->Label(-text => 'Show:')->pack(-side => 'left', -padx =
+> 5);
    $showEntry = $cntlFrame->Entry (-width => 15)->pack(-side => 'left
+');
    $showEntry->bind('<KeyPress-Return>', \&show_man);

    $cntlFrame->Button(-text => 'Print',
                       -command => \&print_man )->pack(-side => 'left'
+, -padx => 5);

    $cntlFrame->Label(-text => 'Search:')->pack(-side => 'left', -padx
+ => 5);
    $searchEntry = $cntlFrame->Entry (-width => 15)->pack(-side => 'le
+ft');
    $searchEntry->bind('<KeyPress-Return>', \&search);


    $fullListbox = $listFrame->Scrolled('Listbox',
                                        -scrollbars => 'oe',
                                        -width =>  25, 
                                        -height => 20)->pack(-side => 
+'left');
    $srchListbox = $listFrame->Scrolled('Listbox',
                                        -scrollbars => 'oe',
                                        -width =>  25, 
                                        -height => 20)->pack(-side => 
+'left');

    $fullListbox->insert( "end", @docnames );

    $mainWin->bind('Tk::Listbox', '<Double-1>', \&pick_word);
}

sub pick_word {
    my( $lw ) = @_;
    my $mname = $lw->get( $lw->curselection );
    $showEntry->delete( 0, "end" );
    $showEntry->insert( 0, $mname );
    show_man();
}

sub search {
    my $search_pattern = $searchEntry->get();
    my @search_matches = grep( /$search_pattern/i, @docnames );

    $srchListbox->delete( 0, "end" );
    if ( $#search_matches < 0 ) {
        $srchListbox->insert( "end", "No matches for $search_pattern" 
+);
    } else {
        $srchListbox->insert( "end", @search_matches );
    }
}

use File::Basename;
sub scout_man_dirs {
    my @man_files = `find $perlbase/man -name '*.[13]'`;
    my @suffixes = qw/.1 .3/;

    fileparse_set_fstype();
    foreach my $docpath ( @man_files )
    {
        chomp $docpath;
        my $docname = basename( $docpath, @suffixes );
        $doclist{$docname} = $docpath;
    }
    @docnames = sort( keys( %doclist ));
    $docnames = join( " ", "", @docnames, "" );
}

[download]

In reply to PerlMan - Perl/Tk based pod pick/view by graff

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.