Source Code 1992 March/Source_Code_CD-ROM_Walnut_Creek_March_1992.iso/usenet/altsrcs/1/1027

Internet Message Format | 1990-12-28 | 31.1 KB

From: [e-mail] (Tom Christiansen)
Newsgroups: comp.lang.perl,alt.sources
Subject: man rewrite
Message-ID: <[e-mail]>
Date: 17 Mar 90 22:49:08 GMT

I've received so many requests for my perl rewrite of man (several a day for
around a week) for that I've decided to repost the current version.  Its main
win is that it uses DBM whatis databases; you'll need ndbm support to run
this.  It affords you quick lookups and the ability to spare duplicate cat pages
for linked man pages.  That way strcat, strncat, strcmp, strncmp, strcpy,
strncpy, strlen, index, and rindex can each be looked up by name but share
the same man page and cat page.

Features include but are not limitded to:

    *   almost always faster than standard man (try 'man me')

    *    take much less diskspace for catpages

    *    supports per-tree tmac macros

    *    compressed man and cat files

    *    user-definable man path via $MANPATH or -M (mine is set this way
      setenv MANPATH "$HOME/man:/usr/local/man:/usr/local/mh/man:/usr/man"

    *   user-definable section search order via -S or $MANSECT

    *    $PAGER support

    *    looks up all the places you might find a man page (-w option)

    *   no limits on what subsections go where (if you want to add 7x, ok)

    *   support for multi-char sections like man1m/*.1m

    *    per man-tree tmac files

    *    ability to run man on a local file

    *    ability to easily troff (or preview) a man page

    *    recognizes Sun-style embedded filter directives for tbl and eqn

    *    does the right thing for man tree that don't have DBM whatis files

There's an extended usage message (man -U) for further help.


Here are some features of this version of makewhatis:

    *    it's faster.

    *    tries hard to make pretty output, stripping troff directives.

    *   doesn't blow up on more files in a man directory
    than the shell will glob.

    *   accepts troff string macros for the dashes in the
    the NAME section.

    *   prints a diagnostic for a malformed NAME section.

    *   detects linked (hard, soft, or via .so) man pages

    *   finds *all* references in the NAME section.

    *   recognizes MH's man macros (and .Sh from lwall).

    *   many other things that makewhatis used to do wrong

You should extract the following sharchive and install.  Remember to make
links from man to whatis and apropos, and to whman if you want that.  Check
the configuration section in the beginning for tuning it to your own system,
like whether you've col or ul, whether your grep is fast and whether it
understands -h, what your troff command is, what your default $MANPATH and
$MANSECT should be, what section aliases you want (eg. "public" for "p"), etc.

If you've gobs of disk space and you have undump support for perl, you might
considering calling it with 'man -u' to dump its memory to disk for faster
startup (around a 1.2 second speedup on a Convex C1).  Run makewhatis with -v
to see what gets stored where.  I usually run makewhatis this way:
    makewhatis -v -n -M /usr/man || makewhatis -v -M /usr/man
so it only runs if it's out of date.

--tom

#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create:
#    man
#    makewhatis
# This archive created: Sat Mar 17 16:07:54 1990
export PATH; PATH=/bin:/usr/bin:$PATH
echo shar: "extracting 'man'" '(18358 characters)'
if test -f 'man'
then
    echo shar: "will not over-write existing file 'man'"
else
sed 's/^    X//' << \SHAR_EOF > 'man'
    X#!/usr/bin/perl
    X#
    X# man - perl rewrite of man, whatis, apropos
    X#
    X# tom christiansen <[e-mail]>
    X#
    X# see usage message for details
    X#
    X
    X# --------------------------------------------------------------------------
    X# begin configuration section
    X# --------------------------------------------------------------------------
    X
    X$PAGER     = "more"         unless $PAGER   = $ENV{'PAGER'};
    X
    X# assume "less" pagers want -sf flags, all others must accept -s.
    X# note: some less's prefer -r to -f.  you might also add -i if supported.
    X$PAGER    .= ($PAGER =~ /^\S*less(\s+-\S.*)?$/) ? ' -sf' : ' -s';
    X
    X# man roots to look in
    X$MANPATH  = "/usr/local/man:/usr/man"    unless $MANPATH = $ENV{'MANPATH'};
    X
    X
    X# default sectional precedence
    X$MANSECT  = "ln16823457p"        unless $MANSECT = $ENV{'MANSECT'};
    X# colons optional unless you have multi-char section names
    X
    X# note that HP systems want this
    X#$MANSECT  = "1:1m:6:8:2:3:4:5:7"    unless $MANSECT = $ENV{'MANSECT'};
    X
    X# you really would MUST rather use a separate tree than manl and mann!
    X
    X# default -t command.
    X$TROFF    = "nitroff"             unless $TROFF   = $ENV{'TROFF'};
    X$NROFF    = "nroff";
    X
    X# this are used if line 1 is of the form m:'\\"\s+[et]:
    X$TBL      = "tbl";
    X$NEQN      = "neqn";
    X$EQN      = "eqn";
    X
    X$UL      = "ul";    # set to '' if you haven't got ul
    X
    X# without ul, you probably need COL defined unless your PAGER is very smart
    X$COL      = "";  # define this if you don't have UL
    X
    Xdie 'need either $COL or $UL' unless $UL || $COL;
    X
    X
    X# need these for .Z files or dirs
    X$COMPRESS = "compress";
    X$ZCAT      = "zcat";
    X$CAT      = "cat";
    X
    X# Command to format man pages to be viewed on a tty or printed on a line printer
    X
    X$CATSET      = "$NROFF -h -man -";
    X$CATSET  .= " | $COL" if $COL;
    X
    X# Command to typeset a man page
    X$TYPESET  = "$TROFF -man -";
    X
    X$FAST_GREP = 1;                # probably only true for GNU grep
    X$EGREP       = "egrep -ih";         # GNU && BSD both know -h
    X
    X$ARCH_PATH = "/usr/local/man";         # alternate architecture man pages in
    X                    # ${ARCH_PATH}/${machine}/man(?)/*.\1*
    X
    X# sections that have verbose aliases
    X# if you change this, change the usage message
    X%SECTIONS = (
    X    'local',    'l',
    X    'new',    'n',
    X    'old',    'o',
    X    'public',    'p' );
    X
    X# --------------------------------------------------------------------------
    X# end configuration section
    X# --------------------------------------------------------------------------
    X
    X($bogus, $version) = split(/:\s*/,'$CHeader: man 0.6 90/03/17 12:30:17 $',2);
    Xchop($version); chop($version);
    X
    X&source('getopts.pl');
    X
    XPARSE_ARGS: &Getopts('T:m:P:M:c:s:S:fkltvwduhU') || &usage;
    X
    X$version .= " (compiled)" if $compiled;
    X
    XDUMP: {
    X    if ($opt_u) {
    X    if ($compiled++) {
    X        warn "already dumped, ignoring -u\n";
    X        last DUMP;
    X    }
    X    &source('stat.pl');
    X    print STDERR "dumping...\n";
    X    reset 'o';       # so the opt_* vars (especially $opt_u!) go away
    X    dump PARSE_ARGS;
    X    # not reached
    X    }
    X}
    X
    X($program = $0) =~ s,.*/,,;
    X
    X$apropos = $program eq 'apropos';
    X$whatis  = $program eq 'whatis';
    X$whereis = $program eq 'whman';
    X
    Xif ($opt_U) {
    X    &version if $opt_v;
    X    &usage;
    X    # not reached
    X}
    X
    Xif ($opt_v) {
    X    &version;
    X    exit 0;
    X}
    X
    X&usage if $#ARGV < 0;
    X
    X$MANPATH = $opt_P     if $opt_P;    # backwards contemptibility
    X$MANPATH = $opt_M     if $opt_M;
    X
    X$want_section = $opt_c     if $opt_c;    # backwards contemptibility
    X$want_section = $opt_s     if $opt_s;
    X
    X$hard_way = $opt_h    if $opt_h;
    X
    Xif ($opt_T) {
    X    $opt_t = 1;
    X    $TYPESET =~ s/$TROFF/$opt_T/;
    X    $TROFF = $opt_T;
    X}
    X
    X$MANPATH = "$ARCH_PATH/$opt_m"        # want different machine type
    X            if $opt_m;
    X
    X$MANSECT = $opt_S    if $opt_S;    # prefer our own section ordering
    X
    X$whatis = 1        if $opt_f;
    X$apropos = 1        if $opt_k;
    X$fromfile = 1        if $opt_l;
    X$whereis = 1          if $opt_w;
    X$debug    = 1        if $opt_d;
    X
    X$roff = $opt_t ? 'troff' : 'nroff';
    X
    X@MANPATH = split(/:/,$MANPATH);
    X
    X$secidx = 0;
    X$delim = ($MANSECT =~ /:/) ? ':' : ' *';
    Xfor (split(/$delim/, $MANSECT)) {
    X    if ($_ eq '') {
    X    warn "null section in $MANSECT\n";
    X    next;
    X    }
    X    $MANSECT{$_} = $secidx++;
    X}
    X
    X
    Xif ($whatis) {
    X    &whatis;
    X} elsif ($apropos) {
    X    &apropos;
    X} elsif ($whereis) {
    X    &whereis;
    X} else {
    X    &man;
    X}
    X
    Xexit $status;
    X
    X# --------------------------------------------------------------------------
    Xsub genwhatis {
    X    local($elt,$whatis);
    X
    X    for $elt (@MANPATH) {
    X    $whatis = "$elt/whatis";
    X    push(@whatis, $whatis);
    X    }
    X}
    X
    X# --------------------------------------------------------------------------
    Xsub whatis {
    X    local($target, %seeking, $entry, $cmd, $page, $section, $desc, @entries);
    X
    X    &genwhatis;
    X
    X    for $target (@ARGV) { $seeking{$target} = 1; }
    X
    X    if ($hard_way) {
    X    &slow_whatis(@whatis);
    X    return;
    X    }
    X
    X    for $INDEX (@whatis) {
    X    unless (-f "$INDEX.pag" && dbmopen(INDEX,$INDEX,0644)) {
    X        warn "$program: No dbm file for $INDEX: $!\n";
    X        $status = 1;
    X        &slow_whatis($INDEX) if -f $INDEX;
    X        next;
    X    }
    X           for $target (@ARGV) {
    X        @entries = &quick_fetch($target,'INDEX');
    X        next if $#entries < 0;
    X        delete $seeking{$target};
    X        $target =~ s/([^\w])/\\$1/g;
    X        for $entry (@entries) {
    X        ($cmd, $page, $section, $desc) = split(/\001/, $entry);
    X        next unless $cmd =~ /$target/ || $page =~ /$target/;
    X        printf("%-20s - %s\n", "$cmd ($section)", $desc);
    X        }
    X    }
    X    dbmclose(INDEX);
    X    }
    X
    X    for $target (keys %seeking) {
    X    print "$program: $target: not found.\n";
    X    $status = 1;
    X    }
    X}
    X
    X# --------------------------------------------------------------------------
    Xsub slow_whatis {
    X    local(@whatis) = @_;
    X
    X    local($query);
    X    local($WHATIS);
    X
    X    $query = '^[^-]*(' . join('|',@ARGV) . ')[^-]* -';
    X
    X    if ($EGREP && ($FAST_GREP || $#ARGV > 0))  {
    X    delete $seeking{$target}
    X        if &run("$EGREP '$query' @whatis");
    X    } else {
    X    foreach $WHATIS (@whatis)  {
    X        unless (open WHATIS) {
    X        warn "can't open $WHATIS: $!";
    X        next;
    X        }
    X        while (<WHATIS>) {
    X        next unless /$query/i;
    X        ($target = $+) =~ y/A-Z/a-z/;
    X        delete $seeking{$target};
    X        print;
    X        }
    X        close WHATIS;
    X    }
    X    }
    X}
    X
    X# --------------------------------------------------------------------------
    Xsub apropos {
    X    &genwhatis;
    X
    X    $query = join('|',@ARGV);
    X
    X    for $target (@ARGV) {
    X    $target =~ y/A-Z/a-z/;
    X    $seeking{$target} = 1;
    X    }
    X
    X    if ($EGREP && ($FAST_GREP || $#ARGV > 0))  {
    X    unless (&run("$EGREP $query @whatis")) {
    X        print STDERR "$program: @ARGV: nothing appropriate\n";
    X        $status = 1;
    X    }
    X    } else {  # perl is faster than all grep's but GNU
    X    foreach $WHATIS (@whatis) {
    X        unless (open WHATIS) {
    X        warn "can't open $WHATIS: $!";
    X        next;
    X        }
    XWHATIS:        while (<WHATIS>) {
    X        next unless /$query/io;          # ok, because only called once
    X        ($target = $+) =~ y/A-Z/a-z/;
    X        delete $seeking{$target};
    X        print;
    X        }
    X        close WHATIS;
    X    }
    X
    X    for $target (keys %seeking) {
    X        print STDERR "$program: $target: nothing appropriate\n";
    X        $status = 1;
    X    }
    X    }
    X}
    X
    X
    X# --------------------------------------------------------------------------
    Xsub source {
    X    local($file) = @_;
    X    local($return) = 0;
    X
    X
    X    $return = do $file;
    X    die "couldn't do \"$file\": $!" unless defined $return;
    X    die "couldn't parse \"$file\": $@" if $@;
    X    die "couldn't run \"$file\"" unless $return;
    X}
    X
    X# --------------------------------------------------------------------------
    Xsub usage {
    X    unless ($opt_U) {
    X    print STDERR "usage: $program [-flags] [section] page ...\n";
    X    print STDERR "        (use -U for long usage message)\n";
    X    } else {
    X    open (PIPE, "| $PAGER");
    X    print PIPE <<'USAGE';  # in case he wants a page
    XUSAGE SUMMARY:
    X    man [-flags] [section] page ...
    X    (section is [1-8lnop], or "new", "local", "public", "old")
    X
    X    man [-flags] -f topic ...
    X    (aka "whatis")
    X
    X    man [-flags] -k keyword ...
    X    (aka "apropos")
    X
    X    man [-flags] -w topic
    X       (to find which man pages you'd get on a topic in what order)
    X
    X    man [-flags] -l filename
    X    (do the format on a given filename)
    X
    XFLAGS:
    X    -M path    use colon-delimited man path for searching (also as -P)
    X    -m machine  like -M /usr/local/man/${machine}
    X    -S sects    define new section precedence
    X
    X    -U        this message
    X    -v        print version string
    X    -t        troff the man page
    X    -T path    call alternate troff on the man page
    X    -h        do the lookups the hard-way, ignoring DBM files
    X    -d        print out all system() commands before running them
    X    -u         generate dump of this program
    X
    XENVIRONMENT:
    X    $PAGER    pager to pipe terminal-destined output through
    X    $MANPATH    like -M path
    X    $MANSECT    like -S sects
    X    $TROFF    like -T path
    X
    XNOTES:
    X    * If $manroot/whatis DBM files do not exist, a warning will be
    X    printed and -h will be assumed for that $manroot only.
    X    * If $manroot/tmac.an exists, it will be used for formatting
    X    instead of the normal -man macros.
    X    * Man pages may be compressed either in (for example) man1.Z/who.1
    X        or man1/who.1.Z; cat pages will go into corresponding places.
    X    * If the first line of the page is of the form
    X      '\" X
    X    where X is 'e' or 't' or both, eqn and tbl filters will be called.
    XUSAGE
    X    close PIPE;
    X    }
    X    if ($?) {
    X    print STDERR "couldn't run long usage message thru $PAGER\n";
    X    exit 1;
    X    }
    X    exit 0;
    X}
    X
    X# --------------------------------------------------------------------------
    X
    Xsub fetch {
    X    local($key,$root) = @_;
    X    local(%recursed);
    X
    X    return $dbmopened{$root}
    X    ? &quick_fetch($key,$dbm{$root})
    X    : &slow_fetch($key,$root);
    X}
    X
    Xsub quick_fetch {
    X    local($key,$array) = @_;
    X    local(@retlist) = ();
    X    local(@tmplist) = ();
    X    local($_, $entry);
    X
    X    return @retlist unless $entry = eval "\$$array".'{$key};';
    X
    X    if ($@) { chop $@; die "bad eval: $@"; }
    X
    X    @tmplist = split(/\002/, $entry);
    X    for (@tmplist) {
    X    if (/\001/) {
    X        push(@retlist, $_);
    X    } else {
    X        push(@retlist, &quick_fetch($_,$array))
    X        unless $recursed{$_}++;
    X    # explain and diction are near duplicate man pages referencing
    X    # each other, requiring this check.  one should be removed
    X    }
    X    }
    X    return @retlist;
    X}
    X
    X# --------------------------------------------------------------------------
    Xsub slow_fetch {
    X    local($key,$root) = @_;
    X    local($glob, $stem, $entry);
    X    local($mandir);
    X
    X    if ($want_section) {
    X    if ($MANSECT{$want_section}) {
    X        $stem = $want_section;
    X    } else {
    X        $stem = substr($want_section,0,1);
    X        }
    X    $glob = "man$stem* man$stem*.Z";
    X    } else {
    X    $glob = 'man*';
    X    }
    X
    X    $glob = "$root/$glob/$target.*";
    X
    X    return <${glob}>;
    X}
    X
    X# --------------------------------------------------------------------------
    Xsub whereis {
    X    local($target, @files);
    X
    X    foreach $target (@ARGV) {
    X    @files = &find_files($target);
    X    if ($#files < $[) {
    X        print STDERR "$program: $target not found\n";
    X        $status = 1;
    X    } else {
    X        print "$target: @files\n";
    X    }
    X    }
    X}
    X
    X
    X# --------------------------------------------------------------------------
    Xsub find_files {
    X    local($target) = @_;
    X    local($root, $entry);
    X    local(@retlist) = ();
    X    local(@tmplist) = ();
    X    local(@entries) = ();
    X    # globals: $vars, $called_before, %dbm
    X
    X    $vars = 'dbm00';
    X
    X    if (!$hard_way && !$called_before++) {
    X    # generate dbm names
    X    for $root (@MANPATH) {
    X        $dbm{$root} = $vars++; # magic incr
    X        $string = "dbmopen($dbm{$root},\"$root/whatis\",0644);";
    X        unless (-f "$root/whatis.pag" && eval $string) {
    X        if ($@) {
    X            chop $@;
    X            warn "Can't eval $string: $@";
    X        } else {
    X            warn "No dbm file for $root/whatis: $!\n";
    X        }
    X        $status = 1;
    X        next;
    X        }
    X        $dbmopened{$root} = 1;
    X    }
    X    }
    X
    X    for $root (@MANPATH) {
    X    @tmplist = ();
    X    unless ($dbmopened{$root})  {
    X        @tmplist = &slow_fetch($target,$root);
    X    } else {
    X        @entries = &fetch($target,$root);
    X        next if $#entries < 0;
    X        for $entry (@entries) {
    X        ($cmd, $page, $section, $desc) = split(/\001/, $entry);
    X        $target =~ s/([^\w])/\\$1/g;
    X        next unless $cmd =~ /$target/ || $page =~ /$target/;
    X        ($stem) = $section =~ /^(.)/;
    X
    X        # Check that it exists
    X        if (-f "$root/man$stem/$page.$section") {
    X            push(@tmplist,  "$root/man$stem/$page.$section");
    X        # perhaps it is compressed ?
    X        } elsif (-f "$root/man$stem.Z/$page.$section") {
    X            push(@tmplist,  "$root/man$stem.Z/$page.$section");
    X        } elsif (-f "$root/man$stem/$page.$section.Z") {
    X            push(@tmplist,  "$root/man$stem/$page.$section.Z");
    X        # perhaps a strange section (i.e. 1m)?
    X        } elsif (-f "$root/man$section/$page.$section") {
    X            push(@tmplist,  "$root/man$section/$page.$section");
    X        # perhaps a strange section (i.e. 1m) AND compressed?
    X        } elsif (-f "$root/man$section.Z/$page.$section") {
    X            push(@tmplist,  "$root/man$section.Z/$page.$section");
    X        } elsif (-f "$root/man$section/$page.$section.Z") {
    X            push(@tmplist,  "$root/man$section/$page.$section.Z");
    X        } else {
    X            printf STDERR "%s: %s.%s has disappeared from %s/man%s\n",
    X                    $program, $page, $section, $root, $stem;
    X            last;
    X        }
    X        }
    X    }
    X    push(@retlist, sort bysection @tmplist);
    X    }
    X    return &trimdups(@retlist);
    X}
    X
    X# --------------------------------------------------------------------------
    Xsub man {
    X    local($target);
    X    $isatty = -t STDOUT;
    X
    X    &get_section unless $want_section;
    X
    X    die "But what do you want from section $want_section?\n"
    X    if $want_section && $#ARGV < 0;
    X
    X    while ($target = shift(@ARGV)) {
    X    $target = &get_page($target) unless $fromfile;
    X    do $roff($target) if $target;
    X    }
    X}
    X
    X# --------------------------------------------------------------------------
    Xsub get_section {
    X    return if $want_section; # already got it
    X    local($section) = $ARGV[0];
    X    $section =~ tr/A-Z/a-z/;
    X
    X    if ($want_section = $SECTIONS{$section}) {
    X    shift @ARGV;
    X    }  elsif (defined($MANSECT{$section}) || $section =~ /^\d\w*$/i) {
    X    $want_section = shift @ARGV;
    X    }
    X}
    X
    X# --------------------------------------------------------------------------
    Xsub get_page {
    X    local($target) = @_;
    X    local(@places);
    X
    X    @places = &find_files($target);
    X    if ($#places < 0) {
    X    &no_entry($target);
    X    return '';
    X    }
    X    for ( ; $#places >= 0; shift @places) {
    X    if ($want_section) {
    X        if (length($want_section) == 1) {
    X        next unless $places[0] =~ /\.$want_section[^.]*$/i;
    X        } else {
    X        next unless $places[0] =~ /\.$want_section$/i;
    X        }
    X    }
    X    last;
    X    }
    X    if ($#places < 0) {
    X    &no_entry($target);
    X    return '';
    X    }
    X    return $places[0];
    X}
    X
    X# --------------------------------------------------------------------------
    Xsub no_entry {
    X    print STDERR "No manual entry for $_[0]";
    X    print STDERR " in section $want_section of the manual" if $want_section;
    X    print STDERR ".\n";
    X    $status = 1;
    X}
    X
    X# --------------------------------------------------------------------------
    Xsub bysection {
    X    $a1 = $MANSECT{substr($a,rindex($a,'.')+1,1)};
    X    $a2 = $MANSECT{substr($b,rindex($b,'.')+1,1)};
    X    $a1 == $a2
    X    ? 0
    X    : $a2 < 0 || $a1 < $a2
    X        ? -1
    X        : 1;
    X}
    X
    X# --------------------------------------------------------------------------
    Xsub troff {
    X    local ($file) = $_[0];
    X    local ($command);
    X    local ($manroot);
    X    local ($macros);
    X
    X    ($manroot) = $file =~ m,^(.*)/man([^\.]*)(\.Z)?/([^/]*),;
    X
    X
    X    $command = ((($file =~ m:\.Z/:)
    X            ? $ZCAT
    X            : $CAT)
    X        . " < $file | $TYPESET");
    X
    X    $command =~ s,-man,$manroot/tmac.an, if -e "$manroot/tmac.an";
    X
    X    &insert_filters($command,$file);
    X    &run($command);
    X}
    X
    X# --------------------------------------------------------------------------
    Xsub nroff {
    X    local($manpage) = $_[0];
    X    local($catpage);
    X    local($tmppage);
    X    local($command);
    X    local($manroot);
    X    local($macros);
    X
    X    die "trying to nroff a null man page" if $manpage eq '';
    X
    X    if ($fromfile) {
    X    $command = (($manpage =~ m:\.Z/:) ? $ZCAT : $CAT)
    X            . " < $manpage | $CATSET";
    X    &insert_filters($command, $manpage);
    X    } else {
    X    &source('stat.pl') unless defined &Stat;
    X    # compiled version has this already
    X
    X    ($catpage = $manpage)
    X        =~ s,^(.*)/man([^\.]*)(\.Z)?/([^/]*)$,$1/cat$2/$4,;
    X
    X    $manroot = $1;
    X
    X    # Does the cat page exist?
    X    if (! -f $catpage){
    X        # No, maybe it is compressed?
    X        if (-f "$1/cat$2.Z/$4"){
    X        # Yes it was.
    X        $catpage = "$1/cat$2.Z/$4";
    X        } else {
    X        # Nope, the cat file doesn't exist.
    X            # Prefer the compressed cat directory if it exists.
    X            $catpage = "$1/cat$2.Z/$4"
    X            if $catpage !~ /\.Z$/ && -d "$1/cat$2.Z";
    X        }
    X    }
    X
    X
    X    @st_man = &Stat($manpage);
    X    @st_cat = &Stat($catpage);
    X
    X    if ($st_cat[$ST_MTIME] < $st_man[$ST_MTIME]) {
    X
    X        $command = (($manpage =~ m:\.Z:) ? $ZCAT : $CAT)
    X            . " < $manpage | $CATSET";
    X
    X        &insert_filters($command, $manpage);
    X        $command =~ s,-man,$manroot/tmac.an, if -e "$manroot/tmac.an";
    X
    X        ($catdir = $catpage) =~ s!^(.*/?cat[^/]+)/[^/]*!$1!;
    X
    X        unless (-d $catdir && -w _) {
    X        warn "can't put catpage in $catdir\n" if $debug;
    X        $command .= "| $UL"     if $UL;
    X        $command .= "| $PAGER"  if $isatty;
    X        &run($command);
    X        return;
    X        }
    X
    X        $tmppage = "$catpage.$$";
    X
    X        print STDERR "Reformating page.  Please wait ... " if $isatty;
    X
    X        $command .= "| $COMPRESS" if $catpage =~ /\.Z/;
    X        $command .= "> $tmppage";
    X
    X        unless (&run($command)) {
    X        warn "\n$program: nroff of $manpage failed\n";
    X        unlink $tmppage;
    X        $status = 1;
    X        return;
    X        }
    X        print STDERR "done\n" if $isatty;
    X        rename($tmppage,$catpage) ||
    X        die "couldn't rename $tmppage to $catpage: $!\n";
    X    }
    X    $command = (($catpage =~ m:\.Z:)
    X            ? $ZCAT
    X            : $CAT)
    X            . " < $catpage";
    X    }
    X    $command .= "| $UL"     if $UL;
    X    $command .=  "| $PAGER"      if $isatty;
    X
    X    &run($command);
    X}
    X
    Xsub run {
    X    local($command) = $_[0];
    X    $command =~ s/^\s*cat\s*<?\s*([^\s|]+)\s*\|\s*([^|]+)/$2 < $1/;
    X    print STDERR "running: $command\n" if $debug;
    X    $status = 1 if system $command;
    X    print STDERR "\"$command\" exited $?\n" if $debug && $?;
    X    return ($? == 0);
    X}
    X
    Xsub insert_filters {
    X    local($filters,$_);
    X
    X    open(PAGE,$_[1]) || die ("can't open $_[0] to check filters: $!\n");
    X    $_ = <PAGE>;
    X    close PAGE;
    X
    X    if (/^'\\"\s+([et])/) {
    X    $filters = $1;
    X    if ($roff eq 'troff') {
    X        $_[0] =~ s/(\S+roff)/$EQN | $1/
    X        if $filters =~ /e/;
    X        $_[0] =~ s/(\S+roff)/$TBL | $1/
    X        if $filters =~ /t/;
    X    } else { # nroff
    X        $_[0] =~ s/(\S+roff)/$NEQN | $1/
    X        if $filters =~ /e/;
    X        $_[0] =~ s/(\S+roff)/$TBL -TX | $1/
    X        if $filters =~ /t/;
    X    }
    X    }
    X
    X}
    X
    Xsub trimdups {
    X    local(%seen) = ();
    X    local(@retlist) = ();
    X
    X    while ($file = shift) {
    X    push(@retlist,$file) unless $seen{$file}++;
    X    }
    X    return @retlist;
    X}
    X
    Xsub version  {
    X    print STDERR "$0: version is \"$version\"\n" ;
    X}
SHAR_EOF
if test 18358 -ne "`wc -c < 'man'`"
then
    echo shar: "error transmitting 'man'" '(should have been 18358 characters)'
fi
chmod 555 'man'
fi
echo shar: "extracting 'makewhatis'" '(7052 characters)'
if test -f 'makewhatis'
then
    echo shar: "will not over-write existing file 'makewhatis'"
else
sed 's/^    X//' << \SHAR_EOF > 'makewhatis'
    X#!/usr/bin/perl
    X#
    X# makewhatis: perl rewrite for makewhatis
    X# author: tom christiansen <[e-mail]>
    X#
    X
    Xeval "exec /usr/bin/perl -S $0 $*"    # some bozo called us with 'sh foo'
    X    if $running_under_some_shell;     #   'catman -w' likes to do this; sigh
    X
    X&source('stat.pl');
    X
    X($program = $0) =~ s,.*/,,;
    X
    X$UNCOMPRESS = "uncompress";
    X
    X$MAXWHATISLEN = 300;
    X
    Xumask 022;
    X
    X&source('getopts.pl');
    X
    Xdo Getopts('nvdP:M:') || &usage;
    X
    X&usage if $#ARGV > -1;
    X
    Xsub usage { die "usage: $program [-n] [-v] [-P manpath]\n"; }
    X
    X$nflag = 1 if $opt_n;
    X
    X$manpath = $ENV{'MANPATH'};
    X$manpath = $opt_P if $opt_P;
    X$manpath = $opt_M if $opt_M;        # backwards contemptibility
    X$manpath = "/usr/man" unless $manpath;
    X@manpath = split(/:/,$manpath);
    X
    X$debug = ($opt_d || $opt_v);
    X
    X$SIG{'INT'} = 'CLEANUP';
    X
    Xchop($cwd = `pwd`);
    X
    X$WHATIS = "whatis";
    X
    XROOT: foreach $root ( @manpath ) {
    X    $filecount = $entries = 0;
    X    @WHATIS = ();
    X    $root = "$cwd/$root" if $root !~ m:^/:;
    X    chdir $root || die "can't chdir to $root: $!";
    X    print "root to $root\n" if $debug;
    X
    X
    X    if ($nflag) {
    X    unless (&Stat('whatis.pag')) {
    X        print "couldn't stat $root/whatis DBM file\n" if $debug;
    X        $rebuild++;
    X        next;
    X    }
    X    $dbtime = $st_mtime;
    X    } else {
    X    if (!open (WHATIS, "> $WHATIS.$$")) {
    X        warn "can't open $root/$WHATIS.$$: $!\n";
    X        next;
    X    }
    X    if (!dbmopen(WHATIS, "$WHATIS.$$", 0644)) {
    X        warn "Can't dbmopen $root/$WHATIS: $!\n";
    X        next;
    X    }
    X    }
    X
    X    foreach $mandir ( <man?*> ) {
    X    next if $mandir =~ /man0.*/;
    X    if (!chdir $mandir) {
    X        warn "can't chdir to $root/$mandir: $!\n";
    X        next;
    X    }
    X    print "subdir is $mandir\n" if $debug;
    X    if (!opendir(mandir,'.')) {
    X        warn "can't opendir('$root/$mandir'): $!\n";
    X        next;
    X    }
    X
    XFILE:    while ($FILE = readdir(mandir)) {
    X        $compressed = $mandir =~ m:.*\.Z:;
    X        next if $FILE =~ /^\.{1,2}/;
    X        if ($FILE !~ /\S\.\S/) {
    X        print "skipping non man file: $FILE\n" if $debug;
    X        next;
    X        }
    X        next if $FILE =~ /\.(bak|old)$/i || $FILE =~ /^\./;
    X
    X        unless (&Stat($FILE)) {
    X        warn "can't stat $FILE: $!\n";
    X        next FILE;
    X        }
    X
    X        if ($nflag) {
    X        next unless $st_mtime > $dbtime;
    X        print "$root/$mandir/$FILE newer than its dbm whatis file\n";
    X        closedir mandir;
    X        chdir $root;
    X        $rebuild++;
    X        next ROOT;
    X        }
    X
    X        if ($apage = $seen{$st_dev,$st_ino}) {
    X        printf "already saw %s, linked to %s\n", $FILE, $apage
    X            if $debug;
    X        ($page = $FILE) =~ s/\.[^.]+$//;
    X        unless ($WHATIS{$page}) {
    X            print "forgot $page\n" if $debug;
    X            $WHATIS{$page} .= "\002" if $WHATIS{$page};
    X            $apage =~ s/\.[^.]+$//;
    X            $WHATIS{$page} .= $apage;
    X        }
    X        next FILE;
    X        }
    X        $seen{$st_dev,$st_ino} = $FILE;
    X
    X        $compressed |= $FILE =~ /\.Z$/;
    X
    X        if (!open(FILE,
    X        $compressed ? "$UNCOMPRESS < $FILE |" : $FILE))
    X        {
    X        warn "can't open $FILE: $!\n";
    X        next FILE;
    X        }
    X        $filecount++;
    X        print "opened $root/$mandir/$FILE\n" if $debug;
    X        &extract_names();  # need other subr due to old perl bug, since fixed
    X    }
    X    closedir mandir;
    X    chdir $root || die "can't chdir back to $root: $!";
    X    }
    X    if (!$nflag) {
    X    $, = "\n";
    X    print WHATIS (sort @WHATIS),'';
    X    $, = '';
    X    close WHATIS || warn "can't close $WHATIS.$$: $!";
    X    system 'pwd';
    X    rename ("$WHATIS.$$", $WHATIS)
    X        || warn "can't rename $WHATIS.$$ to $WHATIS: $!";
    X    dbmclose(WHATIS) || warn  "can't dbmclose $WHATIS: $!";
    X    for $ext ( 'pag', 'dir' ) {
    X        unlink "$WHATIS.$ext";
    X        rename("$WHATIS.$$.$ext", "$WHATIS.$ext")
    X        || warn "can't rename $WHATIS.$$.$ext:  $!";
    X    }
    X    print "$program: $root: found $entries entries in $filecount files\n";
    X    }
    X}
    X
    Xexit $nflag ? $rebuilt : 0;
    X
    Xsub CLEANUP {
    X    print stderr "<<INTERRUPTED>> reading $FILE\n";
    X    chdir $root;
    X    unlink "$WHATIS.$$", "$WHATIS.pag", "$WHATIS.dir";
    X    exit 1;
    X}
    X
    Xsub getline {
    X    local ($_);
    X    #print "getline called\n" if $debug;
    X
    X    $_ = <FILE>;
    X    #print "gonna loop\n" if $debug;
    X    {
    X        chop;
    X        if (/\\$/) {
    X            chop;
    X        #print "gonna continue\n" if $debug;
    X            $_ .= ' ';
    X            $_ .= <FILE>;
    X            redo;
    X        }
    X    }
    X    #print "gonna return\n" if $debug;
    X    $_;
    X}
    X
    Xsub extract_names {
    X    local($_);
    X    local($needcmdlist) = 0;
    X
    XLINE: while (<FILE>) {
    X    if (/^\.so\s+(man.\/\S+)/) {
    X        print "$FILE is just a .so alias for $1\n" if $debug;
    X        return;
    X    }
    X    next LINE unless /^\.S[hH]\s+"?NAME"?/ || /^\.NA\s?/;
    X    $linecount = 0;
    X    @lines = ();
    X    $nameline = '';
    XNAME:    while ($_ = &getline()) {
    X        last NAME if /^\.(S[hH]|SY|SS)\s?/;  # damn MH
    X        if ( $_ eq '.br' ) {
    X        push(@lines, $nameline) if $nameline;
    X        $nameline = '';
    X        next;
    X        }
    X        s/^\.[IB]\s*//;    # Kill Bold and Italics
    X        next if /^\./;
    X        $nameline .= ' ' if $nameline;
    X        $nameline .= $_;
    X        $linecount++;
    X    }
    X
    X    print "${FILE}'s NAME section was $linecount lines long\n"
    X        if $linecount > 1 && $debug;
    X
    X    push(@lines, $nameline);
    X
    X    unless ($lines[0]) {
    X        print STDERR "$FILE has no NAME lines in it!\n";
    X        return;
    X    }
    X
    X
    X    for ( @lines ) {
    X        next unless ord;
    X        s/\\f([PBIR]|\(..)//g;    # kill font changes
    X        s/\\s[+-]?\d+//g;        # kill point changes
    X        s/\\&//g;
    X        s/\\\((ru|ul)/_/g;
    X        s/\\\((mi|hy|em)/-/g;
    X        s/\\\(..//g;
    X        s/\\//g;                # kill backslashes
    X        s/^\.\\"\s*//;
    X        if (!/\s+-+\s+/) {
    X        printf STDERR "%s: %s: no separated dash in \"%s\"\n",
    X                $program, $FILE, $_;
    X        $needcmdlist = 1;   # forgive their braindamage
    X        s/.*-//;
    X        $desc = $_;
    X        } else {
    X        ($cmdlist, $desc) = ( $`, $' );
    X        $cmdlist =~ s/^\s+//;
    X        }
    X        $ocmdlist = $cmdlist;
    X        if (length($cmdlist) > $MAXWHATISLEN) {
    X        printf STDERR "truncating cmdlist for $FILE from %d to %d bytes\n",
    X            length($cmdlist), $MAXWHATISLEN;
    X        $cmdlist = substr($cmdlist,0,$MAXWHATISLEN) . "...";
    X        }
    X        ($tmpfile = $FILE) =~ s/\.Z$//;
    X        ($page, $section) = $tmpfile =~ /^(\S+)\.(\S+)$/;
    X        $cmdlist = $page if $needcmdlist;
    X        push(@WHATIS,sprintf("%-20s - %s",
    X        "$cmdlist ($section)", $desc));
    X        #"$cmdlist (see $page($section))", $desc));
    X        $prototype = '';
    X        $seenpage = 0;
    X        foreach $cmd (split(/[\s,]+/,$ocmdlist)) {
    X        next unless $cmd;
    X        $seenpage |= ($cmd eq $page);
    X        $WHATIS{$cmd} .= "\002" if $WHATIS{$cmd};
    X        if (! $prototype) {
    X            print "storing $cmd\n" if $debug;
    X            $WHATIS{$cmd} .= join("\001",
    X                $cmdlist, $page, $section, $desc);
    X            $prototype = $cmd;
    X        } else {
    X            print "also storing $cmd under $prototype\n" if $debug;
    X            $WHATIS{$cmd} .= $prototype;
    X        }
    X        $entries++;
    X        }
    X        unless ($seenpage) {
    X        print "forgot $page\n" if $debug;
    X        $WHATIS{$page} .= "\002" if $WHATIS{$page};
    X        $WHATIS{$page} .= $prototype;
    X        }
    X    }
    X    }
    X
    X    if ($. == 0) {
    X    print "no lines in $FILE\n" if $debug;
    X    }
    X}
    X
    X# --------------------------------------------------------------------------
    Xsub source {
    X    local($file) = @_;
    X    local($return) = 0;
    X
    X
    X    $return = do $file;
    X    die "couldn't parse \"$file\": $@" if $@;
    X    die "couldn't do \"$file\": $!" unless defined $return;
    X    die "couldn't run \"$file\"" unless $return;
    X}
SHAR_EOF
if test 7052 -ne "`wc -c < 'makewhatis'`"
then
    echo shar: "error transmitting 'makewhatis'" '(should have been 7052 characters)'
fi
chmod 755 'makewhatis'
fi
exit 0
#    End of shell archive

--

    Tom Christiansen                       {uunet,uiucdcs,sun}!convex!tchrist
    Convex Computer Corporation                            [e-mail]
         "EMACS belongs in <sys/errno.h>: Editor too big!"