home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 1 / 1027 < prev    next >
Internet Message Format  |  1990-12-28  |  32KB
  1. From: tchrist@convex.com (Tom Christiansen)
  2. Newsgroups: comp.lang.perl,alt.sources
  3. Subject: man rewrite
  4. Message-ID: <100660@convex.convex.com>
  5. Date: 17 Mar 90 22:49:08 GMT
  6.  
  7. I've received so many requests for my perl rewrite of man (several a day for
  8. around a week) for that I've decided to repost the current version.  Its main
  9. win is that it uses DBM whatis databases; you'll need ndbm support to run
  10. this.  It affords you quick lookups and the ability to spare duplicate cat pages
  11. for linked man pages.  That way strcat, strncat, strcmp, strncmp, strcpy,
  12. strncpy, strlen, index, and rindex can each be looked up by name but share
  13. the same man page and cat page.
  14.  
  15. Features include but are not limitded to:
  16.  
  17.     *   almost always faster than standard man (try 'man me')
  18.  
  19.     *    take much less diskspace for catpages
  20.  
  21.     *    supports per-tree tmac macros
  22.     
  23.     *    compressed man and cat files
  24.  
  25.     *    user-definable man path via $MANPATH or -M (mine is set this way
  26.       setenv MANPATH "$HOME/man:/usr/local/man:/usr/local/mh/man:/usr/man"
  27.  
  28.     *   user-definable section search order via -S or $MANSECT
  29.     
  30.     *    $PAGER support
  31.  
  32.     *    looks up all the places you might find a man page (-w option)
  33.     
  34.     *   no limits on what subsections go where (if you want to add 7x, ok)
  35.  
  36.     *   support for multi-char sections like man1m/*.1m
  37.  
  38.     *    per man-tree tmac files
  39.  
  40.     *    ability to run man on a local file 
  41.  
  42.     *    ability to easily troff (or preview) a man page
  43.  
  44.     *    recognizes Sun-style embedded filter directives for tbl and eqn
  45.  
  46.     *    does the right thing for man tree that don't have DBM whatis files
  47.    
  48. There's an extended usage message (man -U) for further help.   
  49.  
  50.  
  51. Here are some features of this version of makewhatis:
  52.  
  53.     *    it's faster.
  54.  
  55.     *    tries hard to make pretty output, stripping troff directives.
  56.  
  57.     *   doesn't blow up on more files in a man directory 
  58.     than the shell will glob.  
  59.  
  60.     *   accepts troff string macros for the dashes in the
  61.     the NAME section.
  62.  
  63.     *   prints a diagnostic for a malformed NAME section.
  64.  
  65.     *   detects linked (hard, soft, or via .so) man pages
  66.  
  67.     *   finds *all* references in the NAME section.
  68.  
  69.     *   recognizes MH's man macros (and .Sh from lwall).
  70.  
  71.     *   many other things that makewhatis used to do wrong
  72.  
  73. You should extract the following sharchive and install.  Remember to make
  74. links from man to whatis and apropos, and to whman if you want that.  Check
  75. the configuration section in the beginning for tuning it to your own system,
  76. like whether you've col or ul, whether your grep is fast and whether it
  77. understands -h, what your troff command is, what your default $MANPATH and
  78. $MANSECT should be, what section aliases you want (eg. "public" for "p"), etc.
  79.  
  80. If you've gobs of disk space and you have undump support for perl, you might
  81. considering calling it with 'man -u' to dump its memory to disk for faster
  82. startup (around a 1.2 second speedup on a Convex C1).  Run makewhatis with -v
  83. to see what gets stored where.  I usually run makewhatis this way:
  84.     makewhatis -v -n -M /usr/man || makewhatis -v -M /usr/man 
  85. so it only runs if it's out of date.
  86.  
  87. --tom
  88.  
  89. #! /bin/sh
  90. # This is a shell archive, meaning:
  91. # 1. Remove everything above the #! /bin/sh line.
  92. # 2. Save the resulting text in a file.
  93. # 3. Execute the file with /bin/sh (not csh) to create:
  94. #    man
  95. #    makewhatis
  96. # This archive created: Sat Mar 17 16:07:54 1990
  97. export PATH; PATH=/bin:/usr/bin:$PATH
  98. echo shar: "extracting 'man'" '(18358 characters)'
  99. if test -f 'man'
  100. then
  101.     echo shar: "will not over-write existing file 'man'"
  102. else
  103. sed 's/^    X//' << \SHAR_EOF > 'man'
  104.     X#!/usr/bin/perl 
  105.     X# 
  106.     X# man - perl rewrite of man, whatis, apropos
  107.     X#
  108.     X# tom christiansen <tchrist@convex.com>
  109.     X#
  110.     X# see usage message for details 
  111.     X#
  112.     X
  113.     X# --------------------------------------------------------------------------
  114.     X# begin configuration section
  115.     X# --------------------------------------------------------------------------
  116.     X
  117.     X$PAGER     = "more"         unless $PAGER   = $ENV{'PAGER'};
  118.     X
  119.     X# assume "less" pagers want -sf flags, all others must accept -s.
  120.     X# note: some less's prefer -r to -f.  you might also add -i if supported.
  121.     X$PAGER    .= ($PAGER =~ /^\S*less(\s+-\S.*)?$/) ? ' -sf' : ' -s';
  122.     X
  123.     X# man roots to look in
  124.     X$MANPATH  = "/usr/local/man:/usr/man"    unless $MANPATH = $ENV{'MANPATH'};
  125.     X
  126.     X
  127.     X# default sectional precedence
  128.     X$MANSECT  = "ln16823457p"        unless $MANSECT = $ENV{'MANSECT'};
  129.     X# colons optional unless you have multi-char section names
  130.     X
  131.     X# note that HP systems want this
  132.     X#$MANSECT  = "1:1m:6:8:2:3:4:5:7"    unless $MANSECT = $ENV{'MANSECT'};
  133.     X
  134.     X# you really would MUST rather use a separate tree than manl and mann!
  135.     X
  136.     X# default -t command. 
  137.     X$TROFF    = "nitroff"             unless $TROFF   = $ENV{'TROFF'};
  138.     X$NROFF    = "nroff";
  139.     X
  140.     X# this are used if line 1 is of the form m:'\\"\s+[et]:
  141.     X$TBL      = "tbl";
  142.     X$NEQN      = "neqn";
  143.     X$EQN      = "eqn";
  144.     X
  145.     X$UL      = "ul";    # set to '' if you haven't got ul
  146.     X
  147.     X# without ul, you probably need COL defined unless your PAGER is very smart
  148.     X$COL      = "";  # define this if you don't have UL
  149.     X
  150.     Xdie 'need either $COL or $UL' unless $UL || $COL;
  151.     X
  152.     X
  153.     X# need these for .Z files or dirs
  154.     X$COMPRESS = "compress";
  155.     X$ZCAT      = "zcat";
  156.     X$CAT      = "cat";
  157.     X
  158.     X# Command to format man pages to be viewed on a tty or printed on a line printer
  159.     X
  160.     X$CATSET      = "$NROFF -h -man -";
  161.     X$CATSET  .= " | $COL" if $COL;
  162.     X
  163.     X# Command to typeset a man page
  164.     X$TYPESET  = "$TROFF -man -";
  165.     X
  166.     X$FAST_GREP = 1;                # probably only true for GNU grep
  167.     X$EGREP       = "egrep -ih";         # GNU && BSD both know -h 
  168.     X
  169.     X$ARCH_PATH = "/usr/local/man";         # alternate architecture man pages in 
  170.     X                    # ${ARCH_PATH}/${machine}/man(?)/*.\1*
  171.     X
  172.     X# sections that have verbose aliases
  173.     X# if you change this, change the usage message
  174.     X%SECTIONS = (                
  175.     X    'local',    'l',
  176.     X    'new',    'n',
  177.     X    'old',    'o',
  178.     X    'public',    'p' );
  179.     X
  180.     X# --------------------------------------------------------------------------
  181.     X# end configuration section
  182.     X# --------------------------------------------------------------------------
  183.     X
  184.     X($bogus, $version) = split(/:\s*/,'$CHeader: man 0.6 90/03/17 12:30:17 $',2);
  185.     Xchop($version); chop($version);
  186.     X
  187.     X&source('getopts.pl');
  188.     X
  189.     XPARSE_ARGS: &Getopts('T:m:P:M:c:s:S:fkltvwduhU') || &usage;
  190.     X
  191.     X$version .= " (compiled)" if $compiled;
  192.     X
  193.     XDUMP: {
  194.     X    if ($opt_u) {
  195.     X    if ($compiled++) {
  196.     X        warn "already dumped, ignoring -u\n";
  197.     X        last DUMP;
  198.     X    } 
  199.     X    &source('stat.pl');
  200.     X    print STDERR "dumping...\n";
  201.     X    reset 'o';       # so the opt_* vars (especially $opt_u!) go away
  202.     X    dump PARSE_ARGS;
  203.     X    # not reached
  204.     X    } 
  205.     X}
  206.     X
  207.     X($program = $0) =~ s,.*/,,;
  208.     X
  209.     X$apropos = $program eq 'apropos';
  210.     X$whatis  = $program eq 'whatis';
  211.     X$whereis = $program eq 'whman';
  212.     X
  213.     Xif ($opt_U) {
  214.     X    &version if $opt_v;
  215.     X    &usage;
  216.     X    # not reached
  217.     X} 
  218.     X
  219.     Xif ($opt_v) {
  220.     X    &version;
  221.     X    exit 0;
  222.     X}
  223.     X
  224.     X&usage if $#ARGV < 0;
  225.     X
  226.     X$MANPATH = $opt_P     if $opt_P;    # backwards contemptibility
  227.     X$MANPATH = $opt_M     if $opt_M;
  228.     X
  229.     X$want_section = $opt_c     if $opt_c;    # backwards contemptibility
  230.     X$want_section = $opt_s     if $opt_s;
  231.     X
  232.     X$hard_way = $opt_h    if $opt_h;
  233.     X
  234.     Xif ($opt_T) {
  235.     X    $opt_t = 1;
  236.     X    $TYPESET =~ s/$TROFF/$opt_T/;
  237.     X    $TROFF = $opt_T;
  238.     X} 
  239.     X
  240.     X$MANPATH = "$ARCH_PATH/$opt_m"        # want different machine type
  241.     X            if $opt_m;
  242.     X
  243.     X$MANSECT = $opt_S    if $opt_S;    # prefer our own section ordering
  244.     X
  245.     X$whatis = 1        if $opt_f;
  246.     X$apropos = 1        if $opt_k;
  247.     X$fromfile = 1        if $opt_l;
  248.     X$whereis = 1          if $opt_w;
  249.     X$debug    = 1        if $opt_d;
  250.     X
  251.     X$roff = $opt_t ? 'troff' : 'nroff';
  252.     X
  253.     X@MANPATH = split(/:/,$MANPATH);
  254.     X
  255.     X$secidx = 0;
  256.     X$delim = ($MANSECT =~ /:/) ? ':' : ' *';
  257.     Xfor (split(/$delim/, $MANSECT)) {
  258.     X    if ($_ eq '') {
  259.     X    warn "null section in $MANSECT\n";
  260.     X    next;
  261.     X    } 
  262.     X    $MANSECT{$_} = $secidx++;
  263.     X} 
  264.     X
  265.     X
  266.     Xif ($whatis) {
  267.     X    &whatis;
  268.     X} elsif ($apropos) {
  269.     X    &apropos;
  270.     X} elsif ($whereis) {
  271.     X    &whereis;
  272.     X} else {
  273.     X    &man;
  274.     X} 
  275.     X
  276.     Xexit $status;
  277.     X
  278.     X# --------------------------------------------------------------------------
  279.     Xsub genwhatis {
  280.     X    local($elt,$whatis);
  281.     X
  282.     X    for $elt (@MANPATH) {
  283.     X    $whatis = "$elt/whatis";
  284.     X    push(@whatis, $whatis);
  285.     X    } 
  286.     X} 
  287.     X
  288.     X# --------------------------------------------------------------------------
  289.     Xsub whatis {
  290.     X    local($target, %seeking, $entry, $cmd, $page, $section, $desc, @entries);
  291.     X
  292.     X    &genwhatis;
  293.     X
  294.     X    for $target (@ARGV) { $seeking{$target} = 1; } 
  295.     X
  296.     X    if ($hard_way) {
  297.     X    &slow_whatis(@whatis);
  298.     X    return;
  299.     X    } 
  300.     X
  301.     X    for $INDEX (@whatis) {
  302.     X    unless (-f "$INDEX.pag" && dbmopen(INDEX,$INDEX,0644)) {
  303.     X        warn "$program: No dbm file for $INDEX: $!\n";
  304.     X        $status = 1;
  305.     X        &slow_whatis($INDEX) if -f $INDEX;
  306.     X        next;
  307.     X    } 
  308.     X           for $target (@ARGV) {
  309.     X        @entries = &quick_fetch($target,'INDEX');
  310.     X        next if $#entries < 0;
  311.     X        delete $seeking{$target};
  312.     X        $target =~ s/([^\w])/\\$1/g;
  313.     X        for $entry (@entries) {
  314.     X        ($cmd, $page, $section, $desc) = split(/\001/, $entry);
  315.     X        next unless $cmd =~ /$target/ || $page =~ /$target/;
  316.     X        printf("%-20s - %s\n", "$cmd ($section)", $desc);
  317.     X        }
  318.     X    } 
  319.     X    dbmclose(INDEX);
  320.     X    } 
  321.     X
  322.     X    for $target (keys %seeking) {
  323.     X    print "$program: $target: not found.\n";
  324.     X    $status = 1;
  325.     X    } 
  326.     X} 
  327.     X
  328.     X# --------------------------------------------------------------------------
  329.     Xsub slow_whatis {
  330.     X    local(@whatis) = @_;
  331.     X
  332.     X    local($query);
  333.     X    local($WHATIS);
  334.     X
  335.     X    $query = '^[^-]*(' . join('|',@ARGV) . ')[^-]* -';
  336.     X
  337.     X    if ($EGREP && ($FAST_GREP || $#ARGV > 0))  {
  338.     X    delete $seeking{$target}
  339.     X        if &run("$EGREP '$query' @whatis");
  340.     X    } else {
  341.     X    foreach $WHATIS (@whatis)  {
  342.     X        unless (open WHATIS) {
  343.     X        warn "can't open $WHATIS: $!";
  344.     X        next;
  345.     X        } 
  346.     X        while (<WHATIS>) {
  347.     X        next unless /$query/i;
  348.     X        ($target = $+) =~ y/A-Z/a-z/;
  349.     X        delete $seeking{$target};
  350.     X        print;
  351.     X        } 
  352.     X        close WHATIS;
  353.     X    } 
  354.     X    } 
  355.     X} 
  356.     X
  357.     X# --------------------------------------------------------------------------
  358.     Xsub apropos {
  359.     X    &genwhatis;  
  360.     X
  361.     X    $query = join('|',@ARGV);
  362.     X
  363.     X    for $target (@ARGV) { 
  364.     X    $target =~ y/A-Z/a-z/; 
  365.     X    $seeking{$target} = 1; 
  366.     X    } 
  367.     X
  368.     X    if ($EGREP && ($FAST_GREP || $#ARGV > 0))  {
  369.     X    unless (&run("$EGREP $query @whatis")) {
  370.     X        print STDERR "$program: @ARGV: nothing appropriate\n";
  371.     X        $status = 1;  
  372.     X    } 
  373.     X    } else {  # perl is faster than all grep's but GNU
  374.     X    foreach $WHATIS (@whatis) {
  375.     X        unless (open WHATIS) {
  376.     X        warn "can't open $WHATIS: $!";
  377.     X        next;
  378.     X        } 
  379.     XWHATIS:        while (<WHATIS>) {
  380.     X        next unless /$query/io;          # ok, because only called once
  381.     X        ($target = $+) =~ y/A-Z/a-z/;
  382.     X        delete $seeking{$target};
  383.     X        print;
  384.     X        } 
  385.     X        close WHATIS;
  386.     X    } 
  387.     X
  388.     X    for $target (keys %seeking) {
  389.     X        print STDERR "$program: $target: nothing appropriate\n";
  390.     X        $status = 1;
  391.     X    }
  392.     X    } 
  393.     X}
  394.     X
  395.     X
  396.     X# --------------------------------------------------------------------------
  397.     Xsub source {
  398.     X    local($file) = @_;
  399.     X    local($return) = 0;
  400.     X
  401.     X
  402.     X    $return = do $file;
  403.     X    die "couldn't do \"$file\": $!" unless defined $return;
  404.     X    die "couldn't parse \"$file\": $@" if $@;
  405.     X    die "couldn't run \"$file\"" unless $return;
  406.     X}
  407.     X
  408.     X# --------------------------------------------------------------------------
  409.     Xsub usage {
  410.     X    unless ($opt_U) {
  411.     X    print STDERR "usage: $program [-flags] [section] page ...\n";
  412.     X    print STDERR "        (use -U for long usage message)\n";
  413.     X    } else {
  414.     X    open (PIPE, "| $PAGER");
  415.     X    print PIPE <<'USAGE';  # in case he wants a page
  416.     XUSAGE SUMMARY: 
  417.     X    man [-flags] [section] page ...
  418.     X    (section is [1-8lnop], or "new", "local", "public", "old")
  419.     X
  420.     X    man [-flags] -f topic ...  
  421.     X    (aka "whatis")
  422.     X
  423.     X    man [-flags] -k keyword ...
  424.     X    (aka "apropos")
  425.     X
  426.     X    man [-flags] -w topic
  427.     X       (to find which man pages you'd get on a topic in what order)
  428.     X
  429.     X    man [-flags] -l filename
  430.     X    (do the format on a given filename)
  431.     X
  432.     XFLAGS:
  433.     X    -M path    use colon-delimited man path for searching (also as -P)
  434.     X    -m machine  like -M /usr/local/man/${machine}
  435.     X    -S sects    define new section precedence 
  436.     X
  437.     X    -U        this message
  438.     X    -v        print version string
  439.     X    -t        troff the man page
  440.     X    -T path    call alternate troff on the man page
  441.     X    -h        do the lookups the hard-way, ignoring DBM files
  442.     X    -d        print out all system() commands before running them
  443.     X    -u         generate dump of this program
  444.     X
  445.     XENVIRONMENT:
  446.     X    $PAGER    pager to pipe terminal-destined output through
  447.     X    $MANPATH    like -M path
  448.     X    $MANSECT    like -S sects
  449.     X    $TROFF    like -T path
  450.     X
  451.     XNOTES: 
  452.     X    * If $manroot/whatis DBM files do not exist, a warning will be 
  453.     X    printed and -h will be assumed for that $manroot only.
  454.     X    * If $manroot/tmac.an exists, it will be used for formatting 
  455.     X    instead of the normal -man macros.
  456.     X    * Man pages may be compressed either in (for example) man1.Z/who.1 
  457.     X        or man1/who.1.Z; cat pages will go into corresponding places.
  458.     X    * If the first line of the page is of the form
  459.     X      '\" X
  460.     X    where X is 'e' or 't' or both, eqn and tbl filters will be called.
  461.     XUSAGE
  462.     X    close PIPE;
  463.     X    }
  464.     X    if ($?) {
  465.     X    print STDERR "couldn't run long usage message thru $PAGER\n";
  466.     X    exit 1;
  467.     X    } 
  468.     X    exit 0;
  469.     X}
  470.     X
  471.     X# --------------------------------------------------------------------------
  472.     X
  473.     Xsub fetch {
  474.     X    local($key,$root) = @_;
  475.     X    local(%recursed);
  476.     X
  477.     X    return $dbmopened{$root}
  478.     X    ? &quick_fetch($key,$dbm{$root})
  479.     X    : &slow_fetch($key,$root);
  480.     X}
  481.     X
  482.     Xsub quick_fetch {
  483.     X    local($key,$array) = @_;
  484.     X    local(@retlist) = ();
  485.     X    local(@tmplist) = ();
  486.     X    local($_, $entry);
  487.     X
  488.     X    return @retlist unless $entry = eval "\$$array".'{$key};';
  489.     X
  490.     X    if ($@) { chop $@; die "bad eval: $@"; }
  491.     X
  492.     X    @tmplist = split(/\002/, $entry);
  493.     X    for (@tmplist) {
  494.     X    if (/\001/) {
  495.     X        push(@retlist, $_);
  496.     X    } else {
  497.     X        push(@retlist, &quick_fetch($_,$array))
  498.     X        unless $recursed{$_}++; 
  499.     X    # explain and diction are near duplicate man pages referencing
  500.     X    # each other, requiring this check.  one should be removed
  501.     X    }
  502.     X    } 
  503.     X    return @retlist;
  504.     X} 
  505.     X
  506.     X# --------------------------------------------------------------------------
  507.     Xsub slow_fetch {
  508.     X    local($key,$root) = @_;
  509.     X    local($glob, $stem, $entry);
  510.     X    local($mandir);
  511.     X
  512.     X    if ($want_section) {
  513.     X    if ($MANSECT{$want_section}) {
  514.     X        $stem = $want_section;
  515.     X    } else {
  516.     X        $stem = substr($want_section,0,1);
  517.     X        } 
  518.     X    $glob = "man$stem* man$stem*.Z";
  519.     X    } else {
  520.     X    $glob = 'man*';
  521.     X    } 
  522.     X
  523.     X    $glob = "$root/$glob/$target.*";
  524.     X
  525.     X    return <${glob}>;
  526.     X}
  527.     X
  528.     X# --------------------------------------------------------------------------
  529.     Xsub whereis {
  530.     X    local($target, @files);
  531.     X
  532.     X    foreach $target (@ARGV) {
  533.     X    @files = &find_files($target);
  534.     X    if ($#files < $[) {
  535.     X        print STDERR "$program: $target not found\n";
  536.     X        $status = 1;
  537.     X    } else {
  538.     X        print "$target: @files\n";
  539.     X    }
  540.     X    } 
  541.     X} 
  542.     X
  543.     X
  544.     X# --------------------------------------------------------------------------
  545.     Xsub find_files {
  546.     X    local($target) = @_;
  547.     X    local($root, $entry);
  548.     X    local(@retlist) = ();
  549.     X    local(@tmplist) = ();
  550.     X    local(@entries) = ();
  551.     X    # globals: $vars, $called_before, %dbm
  552.     X
  553.     X    $vars = 'dbm00';
  554.     X
  555.     X    if (!$hard_way && !$called_before++) {
  556.     X    # generate dbm names
  557.     X    for $root (@MANPATH) {
  558.     X        $dbm{$root} = $vars++; # magic incr
  559.     X        $string = "dbmopen($dbm{$root},\"$root/whatis\",0644);";
  560.     X        unless (-f "$root/whatis.pag" && eval $string) {
  561.     X        if ($@) { 
  562.     X            chop $@;
  563.     X            warn "Can't eval $string: $@";
  564.     X        } else {
  565.     X            warn "No dbm file for $root/whatis: $!\n";
  566.     X        }
  567.     X        $status = 1;
  568.     X        next;
  569.     X        } 
  570.     X        $dbmopened{$root} = 1;
  571.     X    }
  572.     X    } 
  573.     X
  574.     X    for $root (@MANPATH) {
  575.     X    @tmplist = ();
  576.     X    unless ($dbmopened{$root})  {
  577.     X        @tmplist = &slow_fetch($target,$root);
  578.     X    } else {
  579.     X        @entries = &fetch($target,$root);
  580.     X        next if $#entries < 0;
  581.     X        for $entry (@entries) {
  582.     X        ($cmd, $page, $section, $desc) = split(/\001/, $entry);
  583.     X        $target =~ s/([^\w])/\\$1/g;
  584.     X        next unless $cmd =~ /$target/ || $page =~ /$target/;
  585.     X        ($stem) = $section =~ /^(.)/;
  586.     X
  587.     X        # Check that it exists
  588.     X        if (-f "$root/man$stem/$page.$section") {
  589.     X            push(@tmplist,  "$root/man$stem/$page.$section");
  590.     X        # perhaps it is compressed ?
  591.     X        } elsif (-f "$root/man$stem.Z/$page.$section") {
  592.     X            push(@tmplist,  "$root/man$stem.Z/$page.$section");
  593.     X        } elsif (-f "$root/man$stem/$page.$section.Z") {
  594.     X            push(@tmplist,  "$root/man$stem/$page.$section.Z");
  595.     X        # perhaps a strange section (i.e. 1m)?
  596.     X        } elsif (-f "$root/man$section/$page.$section") {
  597.     X            push(@tmplist,  "$root/man$section/$page.$section");
  598.     X        # perhaps a strange section (i.e. 1m) AND compressed?
  599.     X        } elsif (-f "$root/man$section.Z/$page.$section") {
  600.     X            push(@tmplist,  "$root/man$section.Z/$page.$section");
  601.     X        } elsif (-f "$root/man$section/$page.$section.Z") {
  602.     X            push(@tmplist,  "$root/man$section/$page.$section.Z");
  603.     X        } else {
  604.     X            printf STDERR "%s: %s.%s has disappeared from %s/man%s\n",
  605.     X                    $program, $page, $section, $root, $stem;
  606.     X            last;
  607.     X        } 
  608.     X        }
  609.     X    }
  610.     X    push(@retlist, sort bysection @tmplist);
  611.     X    }
  612.     X    return &trimdups(@retlist);
  613.     X} 
  614.     X
  615.     X# --------------------------------------------------------------------------
  616.     Xsub man {
  617.     X    local($target);
  618.     X    $isatty = -t STDOUT;
  619.     X
  620.     X    &get_section unless $want_section;
  621.     X
  622.     X    die "But what do you want from section $want_section?\n" 
  623.     X    if $want_section && $#ARGV < 0;
  624.     X
  625.     X    while ($target = shift(@ARGV)) {
  626.     X    $target = &get_page($target) unless $fromfile;
  627.     X    do $roff($target) if $target;
  628.     X    } 
  629.     X} 
  630.     X
  631.     X# --------------------------------------------------------------------------
  632.     Xsub get_section {
  633.     X    return if $want_section; # already got it
  634.     X    local($section) = $ARGV[0];
  635.     X    $section =~ tr/A-Z/a-z/;
  636.     X
  637.     X    if ($want_section = $SECTIONS{$section}) {
  638.     X    shift @ARGV;
  639.     X    }  elsif (defined($MANSECT{$section}) || $section =~ /^\d\w*$/i) { 
  640.     X    $want_section = shift @ARGV;
  641.     X    } 
  642.     X}
  643.     X
  644.     X# --------------------------------------------------------------------------
  645.     Xsub get_page {
  646.     X    local($target) = @_;
  647.     X    local(@places);
  648.     X
  649.     X    @places = &find_files($target);
  650.     X    if ($#places < 0) {
  651.     X    &no_entry($target);
  652.     X    return '';
  653.     X    } 
  654.     X    for ( ; $#places >= 0; shift @places) {
  655.     X    if ($want_section) {
  656.     X        if (length($want_section) == 1) {
  657.     X        next unless $places[0] =~ /\.$want_section[^.]*$/i;
  658.     X        } else {
  659.     X        next unless $places[0] =~ /\.$want_section$/i;
  660.     X        }
  661.     X    } 
  662.     X    last;
  663.     X    } 
  664.     X    if ($#places < 0) {
  665.     X    &no_entry($target);
  666.     X    return '';
  667.     X    }
  668.     X    return $places[0];
  669.     X}
  670.     X
  671.     X# --------------------------------------------------------------------------
  672.     Xsub no_entry {
  673.     X    print STDERR "No manual entry for $_[0]";
  674.     X    print STDERR " in section $want_section of the manual" if $want_section;
  675.     X    print STDERR ".\n";
  676.     X    $status = 1;
  677.     X} 
  678.     X
  679.     X# --------------------------------------------------------------------------
  680.     Xsub bysection {
  681.     X    $a1 = $MANSECT{substr($a,rindex($a,'.')+1,1)};
  682.     X    $a2 = $MANSECT{substr($b,rindex($b,'.')+1,1)};
  683.     X    $a1 == $a2
  684.     X    ? 0
  685.     X    : $a2 < 0 || $a1 < $a2
  686.     X        ? -1 
  687.     X        : 1;
  688.     X} 
  689.     X
  690.     X# --------------------------------------------------------------------------
  691.     Xsub troff {
  692.     X    local ($file) = $_[0];
  693.     X    local ($command);
  694.     X    local ($manroot);
  695.     X    local ($macros);
  696.     X
  697.     X    ($manroot) = $file =~ m,^(.*)/man([^\.]*)(\.Z)?/([^/]*),;
  698.     X
  699.     X
  700.     X    $command = ((($file =~ m:\.Z/:) 
  701.     X            ? $ZCAT 
  702.     X            : $CAT) 
  703.     X        . " < $file | $TYPESET");
  704.     X
  705.     X    $command =~ s,-man,$manroot/tmac.an, if -e "$manroot/tmac.an";
  706.     X
  707.     X    &insert_filters($command,$file);
  708.     X    &run($command);
  709.     X} 
  710.     X
  711.     X# --------------------------------------------------------------------------
  712.     Xsub nroff {
  713.     X    local($manpage) = $_[0];
  714.     X    local($catpage);
  715.     X    local($tmppage);
  716.     X    local($command);
  717.     X    local($manroot);
  718.     X    local($macros);
  719.     X
  720.     X    die "trying to nroff a null man page" if $manpage eq '';
  721.     X
  722.     X    if ($fromfile) {
  723.     X    $command = (($manpage =~ m:\.Z/:) ? $ZCAT : $CAT)
  724.     X            . " < $manpage | $CATSET";
  725.     X    &insert_filters($command, $manpage);
  726.     X    } else {
  727.     X    &source('stat.pl') unless defined &Stat;   
  728.     X    # compiled version has this already
  729.     X
  730.     X    ($catpage = $manpage) 
  731.     X        =~ s,^(.*)/man([^\.]*)(\.Z)?/([^/]*)$,$1/cat$2/$4,;
  732.     X
  733.     X    $manroot = $1;
  734.     X
  735.     X    # Does the cat page exist?
  736.     X    if (! -f $catpage){
  737.     X        # No, maybe it is compressed?
  738.     X        if (-f "$1/cat$2.Z/$4"){
  739.     X        # Yes it was.
  740.     X        $catpage = "$1/cat$2.Z/$4";
  741.     X        } else {
  742.     X        # Nope, the cat file doesn't exist.
  743.     X            # Prefer the compressed cat directory if it exists.
  744.     X            $catpage = "$1/cat$2.Z/$4" 
  745.     X            if $catpage !~ /\.Z$/ && -d "$1/cat$2.Z";
  746.     X        }
  747.     X    }
  748.     X
  749.     X
  750.     X    @st_man = &Stat($manpage);
  751.     X    @st_cat = &Stat($catpage);
  752.     X
  753.     X    if ($st_cat[$ST_MTIME] < $st_man[$ST_MTIME]) {
  754.     X
  755.     X        $command = (($manpage =~ m:\.Z:) ? $ZCAT : $CAT)
  756.     X            . " < $manpage | $CATSET";
  757.     X
  758.     X        &insert_filters($command, $manpage);
  759.     X        $command =~ s,-man,$manroot/tmac.an, if -e "$manroot/tmac.an";
  760.     X
  761.     X        ($catdir = $catpage) =~ s!^(.*/?cat[^/]+)/[^/]*!$1!;
  762.     X
  763.     X        unless (-d $catdir && -w _) {
  764.     X        warn "can't put catpage in $catdir\n" if $debug;
  765.     X        $command .= "| $UL"     if $UL;
  766.     X        $command .= "| $PAGER"  if $isatty;
  767.     X        &run($command);
  768.     X        return;
  769.     X        } 
  770.     X
  771.     X        $tmppage = "$catpage.$$";
  772.     X
  773.     X        print STDERR "Reformating page.  Please wait ... " if $isatty;
  774.     X
  775.     X        $command .= "| $COMPRESS" if $catpage =~ /\.Z/;
  776.     X        $command .= "> $tmppage";
  777.     X
  778.     X        unless (&run($command)) {
  779.     X        warn "\n$program: nroff of $manpage failed\n";
  780.     X        unlink $tmppage;
  781.     X        $status = 1;
  782.     X        return;
  783.     X        } 
  784.     X        print STDERR "done\n" if $isatty;
  785.     X        rename($tmppage,$catpage) || 
  786.     X        die "couldn't rename $tmppage to $catpage: $!\n";
  787.     X    } 
  788.     X    $command = (($catpage =~ m:\.Z:)
  789.     X            ? $ZCAT
  790.     X            : $CAT)
  791.     X            . " < $catpage";
  792.     X    }
  793.     X    $command .= "| $UL"     if $UL;
  794.     X    $command .=  "| $PAGER"      if $isatty;
  795.     X
  796.     X    &run($command);
  797.     X} 
  798.     X
  799.     Xsub run {
  800.     X    local($command) = $_[0];
  801.     X    $command =~ s/^\s*cat\s*<?\s*([^\s|]+)\s*\|\s*([^|]+)/$2 < $1/;
  802.     X    print STDERR "running: $command\n" if $debug;
  803.     X    $status = 1 if system $command;
  804.     X    print STDERR "\"$command\" exited $?\n" if $debug && $?;
  805.     X    return ($? == 0);
  806.     X} 
  807.     X
  808.     Xsub insert_filters {
  809.     X    local($filters,$_);
  810.     X
  811.     X    open(PAGE,$_[1]) || die ("can't open $_[0] to check filters: $!\n");
  812.     X    $_ = <PAGE>;
  813.     X    close PAGE;
  814.     X
  815.     X    if (/^'\\"\s+([et])/) {
  816.     X    $filters = $1;
  817.     X    if ($roff eq 'troff') {
  818.     X        $_[0] =~ s/(\S+roff)/$EQN | $1/
  819.     X        if $filters =~ /e/;
  820.     X        $_[0] =~ s/(\S+roff)/$TBL | $1/
  821.     X        if $filters =~ /t/;
  822.     X    } else { # nroff
  823.     X        $_[0] =~ s/(\S+roff)/$NEQN | $1/
  824.     X        if $filters =~ /e/;
  825.     X        $_[0] =~ s/(\S+roff)/$TBL -TX | $1/
  826.     X        if $filters =~ /t/;
  827.     X    }
  828.     X    } 
  829.     X
  830.     X} 
  831.     X
  832.     Xsub trimdups {
  833.     X    local(%seen) = ();
  834.     X    local(@retlist) = ();
  835.     X
  836.     X    while ($file = shift) {
  837.     X    push(@retlist,$file) unless $seen{$file}++;
  838.     X    } 
  839.     X    return @retlist;
  840.     X} 
  841.     X
  842.     Xsub version  {
  843.     X    print STDERR "$0: version is \"$version\"\n" ;
  844.     X}
  845. SHAR_EOF
  846. if test 18358 -ne "`wc -c < 'man'`"
  847. then
  848.     echo shar: "error transmitting 'man'" '(should have been 18358 characters)'
  849. fi
  850. chmod 555 'man'
  851. fi
  852. echo shar: "extracting 'makewhatis'" '(7052 characters)'
  853. if test -f 'makewhatis'
  854. then
  855.     echo shar: "will not over-write existing file 'makewhatis'"
  856. else
  857. sed 's/^    X//' << \SHAR_EOF > 'makewhatis'
  858.     X#!/usr/bin/perl
  859.     X#
  860.     X# makewhatis: perl rewrite for makewhatis
  861.     X# author: tom christiansen <tchrist@convex.com>
  862.     X#
  863.     X
  864.     Xeval "exec /usr/bin/perl -S $0 $*"    # some bozo called us with 'sh foo'
  865.     X    if $running_under_some_shell;     #   'catman -w' likes to do this; sigh
  866.     X
  867.     X&source('stat.pl');
  868.     X
  869.     X($program = $0) =~ s,.*/,,;
  870.     X
  871.     X$UNCOMPRESS = "uncompress";
  872.     X
  873.     X$MAXWHATISLEN = 300;   
  874.     X
  875.     Xumask 022;
  876.     X
  877.     X&source('getopts.pl');
  878.     X
  879.     Xdo Getopts('nvdP:M:') || &usage;
  880.     X
  881.     X&usage if $#ARGV > -1;
  882.     X
  883.     Xsub usage { die "usage: $program [-n] [-v] [-P manpath]\n"; } 
  884.     X
  885.     X$nflag = 1 if $opt_n;
  886.     X
  887.     X$manpath = $ENV{'MANPATH'};
  888.     X$manpath = $opt_P if $opt_P;
  889.     X$manpath = $opt_M if $opt_M;        # backwards contemptibility
  890.     X$manpath = "/usr/man" unless $manpath;
  891.     X@manpath = split(/:/,$manpath);
  892.     X
  893.     X$debug = ($opt_d || $opt_v);
  894.     X
  895.     X$SIG{'INT'} = 'CLEANUP';
  896.     X
  897.     Xchop($cwd = `pwd`);
  898.     X
  899.     X$WHATIS = "whatis";
  900.     X
  901.     XROOT: foreach $root ( @manpath ) {
  902.     X    $filecount = $entries = 0;
  903.     X    @WHATIS = ();
  904.     X    $root = "$cwd/$root" if $root !~ m:^/:;
  905.     X    chdir $root || die "can't chdir to $root: $!";
  906.     X    print "root to $root\n" if $debug;
  907.     X
  908.     X
  909.     X    if ($nflag) { 
  910.     X    unless (&Stat('whatis.pag')) {
  911.     X        print "couldn't stat $root/whatis DBM file\n" if $debug;
  912.     X        $rebuild++;
  913.     X        next;
  914.     X    }
  915.     X    $dbtime = $st_mtime;
  916.     X    } else {
  917.     X    if (!open (WHATIS, "> $WHATIS.$$")) {
  918.     X        warn "can't open $root/$WHATIS.$$: $!\n";
  919.     X        next;
  920.     X    }
  921.     X    if (!dbmopen(WHATIS, "$WHATIS.$$", 0644)) {
  922.     X        warn "Can't dbmopen $root/$WHATIS: $!\n";
  923.     X        next;
  924.     X    }
  925.     X    }
  926.     X
  927.     X    foreach $mandir ( <man?*> ) {
  928.     X    next if $mandir =~ /man0.*/;
  929.     X    if (!chdir $mandir) {
  930.     X        warn "can't chdir to $root/$mandir: $!\n";
  931.     X        next;
  932.     X    }
  933.     X    print "subdir is $mandir\n" if $debug;
  934.     X    if (!opendir(mandir,'.')) {
  935.     X        warn "can't opendir('$root/$mandir'): $!\n";
  936.     X        next;
  937.     X    }
  938.     X
  939.     XFILE:    while ($FILE = readdir(mandir)) {
  940.     X        $compressed = $mandir =~ m:.*\.Z:;
  941.     X        next if $FILE =~ /^\.{1,2}/;
  942.     X        if ($FILE !~ /\S\.\S/) {
  943.     X        print "skipping non man file: $FILE\n" if $debug;
  944.     X        next;
  945.     X        } 
  946.     X        next if $FILE =~ /\.(bak|old)$/i || $FILE =~ /^\./;
  947.     X
  948.     X        unless (&Stat($FILE)) {
  949.     X        warn "can't stat $FILE: $!\n";
  950.     X        next FILE;
  951.     X        } 
  952.     X
  953.     X        if ($nflag) {
  954.     X        next unless $st_mtime > $dbtime;
  955.     X        print "$root/$mandir/$FILE newer than its dbm whatis file\n";
  956.     X        closedir mandir;
  957.     X        chdir $root;
  958.     X        $rebuild++;
  959.     X        next ROOT;
  960.     X        }
  961.     X
  962.     X        if ($apage = $seen{$st_dev,$st_ino}) {
  963.     X        printf "already saw %s, linked to %s\n", $FILE, $apage
  964.     X            if $debug;
  965.     X        ($page = $FILE) =~ s/\.[^.]+$//;
  966.     X        unless ($WHATIS{$page}) {
  967.     X            print "forgot $page\n" if $debug;
  968.     X            $WHATIS{$page} .= "\002" if $WHATIS{$page};
  969.     X            $apage =~ s/\.[^.]+$//;
  970.     X            $WHATIS{$page} .= $apage;
  971.     X        }
  972.     X        next FILE;
  973.     X        } 
  974.     X        $seen{$st_dev,$st_ino} = $FILE;
  975.     X
  976.     X        $compressed |= $FILE =~ /\.Z$/;
  977.     X        
  978.     X        if (!open(FILE, 
  979.     X        $compressed ? "$UNCOMPRESS < $FILE |" : $FILE)) 
  980.     X        {
  981.     X        warn "can't open $FILE: $!\n";
  982.     X        next FILE; 
  983.     X        }
  984.     X        $filecount++;
  985.     X        print "opened $root/$mandir/$FILE\n" if $debug;
  986.     X        &extract_names();  # need other subr due to old perl bug, since fixed
  987.     X    } 
  988.     X    closedir mandir;
  989.     X    chdir $root || die "can't chdir back to $root: $!";
  990.     X    } 
  991.     X    if (!$nflag) {
  992.     X    $, = "\n";
  993.     X    print WHATIS (sort @WHATIS),'';
  994.     X    $, = '';
  995.     X    close WHATIS || warn "can't close $WHATIS.$$: $!";
  996.     X    system 'pwd';
  997.     X    rename ("$WHATIS.$$", $WHATIS) 
  998.     X        || warn "can't rename $WHATIS.$$ to $WHATIS: $!";
  999.     X    dbmclose(WHATIS) || warn  "can't dbmclose $WHATIS: $!";
  1000.     X    for $ext ( 'pag', 'dir' ) {
  1001.     X        unlink "$WHATIS.$ext"; 
  1002.     X        rename("$WHATIS.$$.$ext", "$WHATIS.$ext")
  1003.     X        || warn "can't rename $WHATIS.$$.$ext:  $!";
  1004.     X    } 
  1005.     X    print "$program: $root: found $entries entries in $filecount files\n";
  1006.     X    } 
  1007.     X} 
  1008.     X
  1009.     Xexit $nflag ? $rebuilt : 0;
  1010.     X
  1011.     Xsub CLEANUP {
  1012.     X    print stderr "<<INTERRUPTED>> reading $FILE\n";
  1013.     X    chdir $root;
  1014.     X    unlink "$WHATIS.$$", "$WHATIS.pag", "$WHATIS.dir";
  1015.     X    exit 1;
  1016.     X} 
  1017.     X
  1018.     Xsub getline {
  1019.     X    local ($_);
  1020.     X    #print "getline called\n" if $debug;
  1021.     X
  1022.     X    $_ = <FILE>;
  1023.     X    #print "gonna loop\n" if $debug;
  1024.     X    {
  1025.     X        chop;
  1026.     X        if (/\\$/) {
  1027.     X            chop;
  1028.     X        #print "gonna continue\n" if $debug;
  1029.     X            $_ .= ' ';
  1030.     X            $_ .= <FILE>;
  1031.     X            redo;
  1032.     X        }
  1033.     X    }
  1034.     X    #print "gonna return\n" if $debug;
  1035.     X    $_;
  1036.     X}
  1037.     X
  1038.     Xsub extract_names {
  1039.     X    local($_);
  1040.     X    local($needcmdlist) = 0;
  1041.     X
  1042.     XLINE: while (<FILE>) {
  1043.     X    if (/^\.so\s+(man.\/\S+)/) {
  1044.     X        print "$FILE is just a .so alias for $1\n" if $debug;
  1045.     X        return;
  1046.     X    } 
  1047.     X    next LINE unless /^\.S[hH]\s+"?NAME"?/ || /^\.NA\s?/;
  1048.     X    $linecount = 0;
  1049.     X    @lines = ();
  1050.     X    $nameline = '';
  1051.     XNAME:    while ($_ = &getline()) {
  1052.     X        last NAME if /^\.(S[hH]|SY|SS)\s?/;  # damn MH
  1053.     X        if ( $_ eq '.br' ) {
  1054.     X        push(@lines, $nameline) if $nameline;
  1055.     X        $nameline = '';
  1056.     X        next;
  1057.     X        } 
  1058.     X        s/^\.[IB]\s*//;    # Kill Bold and Italics
  1059.     X        next if /^\./;
  1060.     X        $nameline .= ' ' if $nameline;
  1061.     X        $nameline .= $_;
  1062.     X        $linecount++;
  1063.     X    } 
  1064.     X
  1065.     X    print "${FILE}'s NAME section was $linecount lines long\n" 
  1066.     X        if $linecount > 1 && $debug;
  1067.     X
  1068.     X    push(@lines, $nameline);
  1069.     X
  1070.     X    unless ($lines[0]) {
  1071.     X        print STDERR "$FILE has no NAME lines in it!\n";
  1072.     X        return;
  1073.     X    } 
  1074.     X
  1075.     X
  1076.     X    for ( @lines ) {
  1077.     X        next unless ord;
  1078.     X        s/\\f([PBIR]|\(..)//g;    # kill font changes
  1079.     X        s/\\s[+-]?\d+//g;        # kill point changes
  1080.     X        s/\\&//g;        
  1081.     X        s/\\\((ru|ul)/_/g;        
  1082.     X        s/\\\((mi|hy|em)/-/g;
  1083.     X        s/\\\(..//g;
  1084.     X        s/\\//g;                # kill backslashes 
  1085.     X        s/^\.\\"\s*//;
  1086.     X        if (!/\s+-+\s+/) {
  1087.     X        printf STDERR "%s: %s: no separated dash in \"%s\"\n",
  1088.     X                $program, $FILE, $_;
  1089.     X        $needcmdlist = 1;   # forgive their braindamage
  1090.     X        s/.*-//;
  1091.     X        $desc = $_;
  1092.     X        } else {
  1093.     X        ($cmdlist, $desc) = ( $`, $' );
  1094.     X        $cmdlist =~ s/^\s+//;
  1095.     X        }
  1096.     X        $ocmdlist = $cmdlist;
  1097.     X        if (length($cmdlist) > $MAXWHATISLEN) {
  1098.     X        printf STDERR "truncating cmdlist for $FILE from %d to %d bytes\n",
  1099.     X            length($cmdlist), $MAXWHATISLEN;
  1100.     X        $cmdlist = substr($cmdlist,0,$MAXWHATISLEN) . "...";
  1101.     X        } 
  1102.     X        ($tmpfile = $FILE) =~ s/\.Z$//;
  1103.     X        ($page, $section) = $tmpfile =~ /^(\S+)\.(\S+)$/;
  1104.     X        $cmdlist = $page if $needcmdlist;
  1105.     X        push(@WHATIS,sprintf("%-20s - %s",
  1106.     X        "$cmdlist ($section)", $desc));
  1107.     X        #"$cmdlist (see $page($section))", $desc));
  1108.     X        $prototype = '';
  1109.     X        $seenpage = 0;
  1110.     X        foreach $cmd (split(/[\s,]+/,$ocmdlist)) {
  1111.     X        next unless $cmd;
  1112.     X        $seenpage |= ($cmd eq $page);
  1113.     X        $WHATIS{$cmd} .= "\002" if $WHATIS{$cmd};
  1114.     X        if (! $prototype) {
  1115.     X            print "storing $cmd\n" if $debug;
  1116.     X            $WHATIS{$cmd} .= join("\001",
  1117.     X                $cmdlist, $page, $section, $desc);
  1118.     X            $prototype = $cmd;
  1119.     X        } else {
  1120.     X            print "also storing $cmd under $prototype\n" if $debug;
  1121.     X            $WHATIS{$cmd} .= $prototype;
  1122.     X        } 
  1123.     X        $entries++;
  1124.     X        } 
  1125.     X        unless ($seenpage) {
  1126.     X        print "forgot $page\n" if $debug;
  1127.     X        $WHATIS{$page} .= "\002" if $WHATIS{$page};
  1128.     X        $WHATIS{$page} .= $prototype;
  1129.     X        }
  1130.     X    }
  1131.     X    }  
  1132.     X
  1133.     X    if ($. == 0) {
  1134.     X    print "no lines in $FILE\n" if $debug;
  1135.     X    } 
  1136.     X}
  1137.     X
  1138.     X# --------------------------------------------------------------------------
  1139.     Xsub source {
  1140.     X    local($file) = @_;
  1141.     X    local($return) = 0;
  1142.     X
  1143.     X
  1144.     X    $return = do $file;
  1145.     X    die "couldn't parse \"$file\": $@" if $@;
  1146.     X    die "couldn't do \"$file\": $!" unless defined $return;
  1147.     X    die "couldn't run \"$file\"" unless $return;
  1148.     X}
  1149. SHAR_EOF
  1150. if test 7052 -ne "`wc -c < 'makewhatis'`"
  1151. then
  1152.     echo shar: "error transmitting 'makewhatis'" '(should have been 7052 characters)'
  1153. fi
  1154. chmod 755 'makewhatis'
  1155. fi
  1156. exit 0
  1157. #    End of shell archive
  1158.  
  1159. --
  1160.  
  1161.     Tom Christiansen                       {uunet,uiucdcs,sun}!convex!tchrist 
  1162.     Convex Computer Corporation                            tchrist@convex.COM
  1163.          "EMACS belongs in <sys/errno.h>: Editor too big!"
  1164.