home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / perl / scripts-convex / man.shar / man / man < prev    next >
Encoding:
Text File  |  1991-03-04  |  39.7 KB  |  1,507 lines
  1. #!/usr/local/bin/perl 
  2. # 
  3. # man - perl rewrite of man system
  4. # tom christiansen <tchrist@convex.com>
  5. #
  6. # Copyright 1990 Convex Computer Corporation.
  7. # All rights reserved.
  8. #
  9. # --------------------------------------------------------------------------
  10. # begin configuration section
  11. #
  12. # this should be adequate for CONVEX systems.  if you copy this script 
  13. # to non-CONVEX systems, or have a particularly outre local setup, you may
  14. # wish to alter some of the defaults.
  15. # --------------------------------------------------------------------------
  16.  
  17. $PAGER = $ENV{'MANPAGER'} || $ENV{'PAGER'} || 'more';
  18.  
  19. # assume "less" pagers want -sf flags, all others must accept -s.
  20. # note: some less's prefer -r to -f.  you might also add -i if supported.
  21. #
  22. $is_less = $PAGER =~ /^\S*less(\s+-\S.*)?$/;
  23. $PAGER    .= $is_less ? ' -si' : ' -s';       # add -f if using "ul"
  24.  
  25. # man roots to look in; you would really rather use a separate tree than 
  26. # manl and mann!  see %SECTIONS and $MANALT if you do.
  27. $MANPATH  = &config_path;
  28.  
  29. # default section precedence
  30. $MANSECT  = $ENV{'MANSECT'} || 'ln16823457po';
  31.  
  32. # colons optional unless you have multi-char section names
  33. # note that HP systems want this:
  34. #    $MANSECT  = $ENV{'MANSECT'} || '1:1m:6:8:2:3:4:5:7';
  35.  
  36. # alternate architecture man pages in 
  37. # ${MANALT}/${machine}/man(.+)/*.\11*
  38. $MANALT = $ENV{'MANALT'} || '/usr/local/man';
  39.  
  40. # default program for -t command 
  41. $TROFF    = $ENV{'TROFF'} || 'nitroff';
  42.  
  43. $NROFF    = 'nroff';
  44. $NROFF_CAN_BOLD = 0;    # if nroff puts out bold as H\bH
  45.  
  46. # this are used if filters are needed
  47. $TBL      = 'tbl';
  48. $NTBL       = "$TBL -D";    # maybe you need -TX instead
  49. $NEQN      = 'neqn';
  50. $EQN      = 'eqn';
  51. $SED      = 'sed';
  52.  
  53. # define this if you don't have/want UL;
  54. # without ul, you probably need COL defined unless your PAGER is very smart
  55. # you also must use col instead of ul if you've any tbl'd man pages, such 
  56. # as from the X man pages or the eqnchar.7 page.
  57. $COL      = 'col';  
  58. $UL      = '';        # set to '' if you haven't got ul
  59. die 'need either $UL or $COL' unless $UL || $COL;
  60.  
  61. # need these for .Z files or dirs
  62. $COMPRESS = 'compress';
  63. $ZCAT      = 'zcat';
  64. $CAT      = 'cat';
  65.  
  66. # define COMPRESS_DIR if pages might have moved to manX.Z/page.X (like HPs)
  67. $COMPRESS_DIR = 1;
  68. # define COMPRESS_PAGE if pages might have moved to manX/page.X.Z  (better)
  69. $COMPRESS_PAGE = 1;
  70.  
  71. # Command to format man pages to be viewed on a tty or printed on a line printer
  72. $CATSET      = "$NROFF -h -man -";
  73.  
  74. $CATSET  .= " | $COL" if $COL;
  75.  
  76. # Command to typeset a man page
  77. $TYPESET  = "$TROFF -man";
  78.  
  79.  
  80. # flags: GNU likes -i, BSD doesn't; both like -h, but BSD doesn't document it
  81. # if you don't put -i here, i'll make up for it later the hard way
  82. $EGREP = '/usr/local/bin/egrep';    
  83. if (-x $EGREP) {
  84.     $EGREP .= ' -i -h';
  85. } else {
  86.     $EGREP = '/usr/bin/egrep';
  87.     unless (-x $EGREP) {
  88.     $EGREP = '';
  89.     } else {
  90.     $EGREP .= ' -h';
  91.     }
  92. } 
  93.  
  94. # sections that have verbose aliases
  95. # if you change this, change the usage message
  96. #
  97. # if you put any of these in their own trees, comment them out and make 
  98. # a link in $MANALT so people can still say 'man local foo'; for local,
  99. #    cd $MANALT; ln -s . local
  100. # for the other trees (new, old, public) put either them or links
  101. # to them in $MANALT
  102. #
  103. %SECTIONS = (                
  104.     'local',    'l',
  105.     'new',    'n',
  106.     'old',    'o',
  107.     'public',    'p' );
  108.  
  109. # turn this on if you want linked (via ".so" or otherwise) man pages
  110. # to be found even if the thing they are linked to doesn't know it's
  111. # being linked to -- that is, its NAME section doesn't have reference
  112. # to it.  eg, if you call a man page 'gnugrep' but it's own NAME section
  113. # just calls it grep, then you need this.  usually a good idea.
  114. #
  115. $STUPID_SO    = 1;  
  116.  
  117. # --------------------------------------------------------------------------
  118. # end configuration section
  119. # --------------------------------------------------------------------------
  120.  
  121. # CONVEX RCS keeps CHeader; others may prefer Header
  122. ($bogus, $version) = split(/:\s*/,'$CHeader: man 0.43 91/02/16 10:42:57 $',2);
  123. chop($version); chop($version);
  124.  
  125. require 'getopts.pl';
  126.  
  127. # could do this via ioctl(0,$TIOCGETP,$sgtty) if I were really concerned
  128. #
  129. $rows = ($ENV{'TERMCAP'} =~ /:li#(\d+):/) ? $1 : 24;
  130.  
  131. %options = (
  132.     'man',    'T:m:P:M:c:s:S:fkltvwdguhaAiDK',
  133.     'apropos',    'm:P:MvduaK',
  134.     'whatis',    'm:P:M:vduh',
  135.     'whereis',    'm:P:M:vduh'
  136. );
  137.  
  138. ($program = $0) =~ s,.*/,,;
  139.  
  140. $apropos = $program eq 'apropos';
  141. $whatis  = $program eq 'whatis';
  142. $whereis = $program eq 'whman';
  143. $program = 'man' unless $program;
  144.  
  145. &Getopts($options = $options{$program}) || &usage;
  146.  
  147. if ($opt_u) {
  148.     &version if $opt_v;
  149.     &usage;
  150.     # not reached
  151. } 
  152.  
  153. if ($opt_v) {
  154.     &version;
  155.     exit 0;
  156. }
  157.  
  158. &usage if $#ARGV < 0;
  159.  
  160. $MANPATH = $opt_P     if $opt_P;    # backwards contemptibility
  161. $MANPATH = $opt_M     if $opt_M;
  162.  
  163. $want_section = $opt_c     if $opt_c;    # backwards contemptibility
  164. $want_section = $opt_s     if $opt_s;
  165.  
  166. $hard_way = $opt_h    if $opt_h;
  167.  
  168. if ($opt_T) {
  169.     $opt_t = 1;
  170.     $TYPESET =~ s/$TROFF/$opt_T/;
  171.     $TROFF = $opt_T;
  172. } 
  173.  
  174. $MANPATH = "$MANALT/$opt_m"        # want different machine type (undoc)
  175.             if $machine = $opt_m;
  176.  
  177. $MANSECT = $opt_S    if $opt_S;    # prefer our own section ordering
  178.  
  179. $whatis = 1        if $opt_f;
  180. $apropos = 1        if $opt_k || $opt_K;
  181. $fromfile = 1        if $opt_l;
  182. $whereis = 1          if $opt_w;
  183. $grepman = 1        if $opt_g;    
  184. $| = $debug = 1        if $opt_d;
  185. $full_index = 1     if $opt_i;
  186. $show_all = 1        if $opt_a;
  187. $stripBS = 1        if $opt_D;
  188. $query_all = $opt_A    if $opt_A;
  189.  
  190. $roff = $opt_t ? 'troff' : 'nroff';   # for indirect function call
  191.  
  192.  
  193. # maybe they said something like 'man vax ls'
  194. if ($#ARGV > 0) {
  195.     local($machdir) = $MANALT . '/' . $ARGV[0];
  196.     if (-d $machdir) {
  197.     $MANPATH = $machdir;
  198.     $machine = shift;
  199.     } 
  200. } 
  201.  
  202. @MANPATH = split(/:/,$MANPATH);
  203.  
  204. # assign priorities to the sections he cares about
  205. # the nearer the front the higher the sorting priority
  206. $secidx = 0;
  207. $delim = ($MANSECT =~ /:/) ? ':' : ' *';
  208. for (reverse split(/$delim/, $MANSECT)) {
  209.     if ($_ eq '') {
  210.     warn "null section in $MANSECT\n";
  211.     next;
  212.     } 
  213.     $MANSECT{$_} = ++$secidx;
  214. } 
  215.  
  216.  
  217. if ($whatis) {
  218.     &whatis;
  219. } elsif ($apropos) {
  220.     &apropos;
  221. } elsif ($whereis) {
  222.     &whereis;
  223. } elsif ($grepman) {
  224.     &grepman;
  225. } else {
  226.     &man;
  227. } 
  228.  
  229. exit $status;
  230.  
  231. # --------------------------------------------------------------------------
  232. # fill out @whatis array with all possible names of whatis files
  233. # --------------------------------------------------------------------------
  234. sub genwhatis {
  235.     local($elt,$whatis);
  236.  
  237.     for $elt (@MANPATH) {
  238.     $whatis = "$elt/whatis";
  239.     if (-f $whatis) {
  240.         push(@whatis, $whatis);
  241.     } else {
  242.         warn "$whatis: $!\n";# if $opt_M || $opt_P; # they asked for it
  243.     } 
  244.     } 
  245.  
  246.     die "$program: No whatis databases found, please run makewhatis\n" 
  247.     if $#whatis < 0;
  248. } 
  249.  
  250. # --------------------------------------------------------------------------
  251. # run whatis (man -f)
  252. # --------------------------------------------------------------------------
  253. sub whatis {
  254.     local($target, %seeking, $section, $desc, @entries);
  255.  
  256.     &genwhatis;
  257.  
  258.     for $target (@ARGV) { $seeking{$target} = 1; } 
  259.  
  260.     if ($hard_way) {
  261.     &slow_whatis;
  262.     } else { 
  263.     &fast_whatis;
  264.     }
  265.  
  266.     for $target (keys %seeking) {
  267.     print "$program: $target: not found.\n";
  268.     $status = 1;
  269.     } 
  270. } 
  271.  
  272. # --------------------------------------------------------------------------
  273. # do whatis lookup against dbm file(s)
  274. # --------------------------------------------------------------------------
  275. sub fast_whatis {
  276.     local($entry, $cmd, $page, $section, $desc, @entries);
  277.  
  278.     for $INDEX (@whatis) {
  279.     unless (-f "$INDEX.pag" && dbmopen(INDEX,$INDEX,0444)) {
  280.         warn "$program: No dbm file for $INDEX: $!\n" if $debug; 
  281.         #$status = 1;
  282.         if (-f $INDEX) {
  283.         local(@whatis) = ($INDEX);  # dynamic scoping obfuscation
  284.         &slow_whatis;
  285.         }
  286.         next;
  287.     } 
  288.            for $target (@ARGV) {
  289.         local($ext);
  290.         @entries = &quick_fetch($target,'INDEX');
  291.         next if $#entries < 0;
  292.         # $target =~ s/([^\w])/\\$1/g;
  293.         for $entry (@entries) {
  294.         ($cmd, $page, $section, $desc) = split(/\001/, $entry);
  295.         #  STUPID_SO is one that .so's that reference things that
  296.         #  don't know they are being referenced.  STUPID_SO may cause
  297.         #  some peculiarities.
  298.         unless ($STUPID_SO) {
  299.             next unless $cmd =~ /$target/i || $cmd =~ /\.{3}/;
  300.         }
  301.  
  302.         delete $seeking{$target};
  303.         ($ext) = $page =~ /\.([^.]*)$/;
  304.         printf("%-20s - %s\n", "$cmd ($ext)", $desc);
  305.         }
  306.     } 
  307.     dbmclose(INDEX);
  308.     } 
  309.     
  310. } 
  311.  
  312. # --------------------------------------------------------------------------
  313. # do whatis lookup the hard way
  314. # --------------------------------------------------------------------------
  315. sub slow_whatis {
  316.     local($query);
  317.     local($WHATIS);
  318.  
  319.     for (@ARGV) { s/([^\w])/\\$1/g; } 
  320.  
  321.     $query = '^[^-]*\b?(' . join('|',@ARGV) . ')\b[^-]* -';
  322.  
  323.     if ($EGREP)  {
  324.     if (&run("$EGREP '$query' @whatis")) {
  325.         # pity can't tell which i found
  326.         %seeking = ();
  327.     }
  328.     } else {
  329.     foreach $WHATIS (@whatis)  {
  330.         unless (open WHATIS) {
  331.         warn "can't open $WHATIS: $!\n";
  332.         next;
  333.         } 
  334.         while (<WHATIS>) {
  335.         next unless /$query/i;
  336.         ($target = $+) =~ y/A-Z/a-z/;
  337.         delete $seeking{$target};
  338.         print;
  339.         } 
  340.         close WHATIS;
  341.     } 
  342.     } 
  343. } 
  344.  
  345. # --------------------------------------------------------------------------
  346. # run apropos (man -k)
  347. # --------------------------------------------------------------------------
  348. sub apropos {
  349.     local($_, %seeking, $target, $query);
  350.     &genwhatis;  
  351.  
  352.     # fold case on apropos args
  353.     for (@ARGV) { 
  354.     y/A-Z/a-z/; 
  355.     $seeking{$_} = 1; 
  356.     s/(\W)/\\$1/g unless $opt_K;
  357.     } 
  358.     $query = join('|',@ARGV);
  359.  
  360.  
  361.     if ($EGREP)  {
  362.     # need to fake a -i flag?
  363.     unless ($EGREP =~ /-\w*i/) {
  364.         local($C);
  365.         local(@pat) = split(//,$query);
  366.         for (@pat) {
  367.         ($C = $_) =~ y/a-z/A-Z/ && ($_ = '[' . $C . $_ . ']');
  368.         } 
  369.         $query = join('',@pat);
  370.     } 
  371.     if (&run("$EGREP '$query' @whatis | $PAGER")) {
  372.         %seeking = ();
  373.     } 
  374.     } else {  # use perl
  375.     foreach $WHATIS (@whatis) {
  376.         unless (open WHATIS) {
  377.         warn "can't open $WHATIS: $!\n";
  378.         next;
  379.         } 
  380. WHATIS:        while (<WHATIS>) {
  381.         next unless /$query/io;          # /o ok, because only called once
  382.         $target = $+;
  383.         $target =~ s/\\//g;
  384.         delete $seeking{$query};
  385.         print;
  386.         } 
  387.         close WHATIS;
  388.     } 
  389.  
  390.     } 
  391.  
  392.     for $target (keys %seeking) {
  393.     warn "$program: $target: nothing appropriate\n";
  394.     $status = 1;
  395.     }
  396. }
  397.  
  398. # --------------------------------------------------------------------------
  399. # print out usage message via pager and exit
  400. # --------------------------------------------------------------------------
  401. sub usage {
  402.     unless ($opt_u) {
  403.     warn "usage: $program [-flags] topic ...\n";
  404.     warn "        (use -u for long usage message)\n";
  405.     } else {
  406.     open (PIPE, "| $PAGER");
  407.     print PIPE <<USAGE;  # in case he wants a page
  408. USAGE SUMMARY: 
  409.     man [-flags] [section] page[/index] ...
  410.     (section is [1-8lnop], or "new", "local", "public", "old")
  411.     (index is section or subsection header)
  412.  
  413.     man [-flags] -f topic ...  
  414.     (aka "whatis")
  415.  
  416.     man [-flags] -k keyword ...
  417.     (aka "apropos")
  418.  
  419. FLAGS: (most only make sense when invoked as 'man')
  420.     -a        show all possible man pages for this topic
  421.     -A        ask which selection if several available
  422.  
  423.     -l file    do man processing on local file
  424.     -f topic    list table of contents entry for topic
  425.     -k keyword    give table of contents entries containing keyword
  426.     -K pattern  as -K but allow regexps
  427.     -g pattern  grep through all man pages for patterns
  428.     -w topic    which files would be shown for a given topic
  429.     -i topic    show section and subsection index for use with topic/index
  430.  
  431.     -M path    use colon-delimited man path for searching (also as -P)
  432.     -S sects    define new section precedence 
  433.  
  434.     -t        troff the man page
  435.     -T path    call alternate typesetter on the man page
  436.  
  437.     -d        print out all system() commands before running them
  438.     -h        do all lookups the hard way, ignoring any DBM files
  439.     -u        this message
  440.     -v        print version string
  441.     -D        strip backspaces from output
  442.  
  443. ENVIRONMENT:
  444.     \$PAGER    pager to pipe terminal-destined output through 
  445.     \$MANPATH    like -M path
  446.     \$MANSECT    like -S sects
  447.     \$MANALT    used for alternate hardware types (or obsolete -m flag)
  448.     \$TROFF    like -T path
  449.  
  450. CURRENT DEFAULTS:
  451.     PAGER    $PAGER
  452.     MANPATH    $MANPATH
  453.     MANSECT    $MANSECT
  454.     MANALT    $MANALT
  455.     TROFF    $TROFF
  456.  
  457. NOTES:  (\$manroot is each component in \$MANPATH)
  458.     * If \$manroot/whatis DBM files do not exist, a warning will be 
  459.     printed (if -d flag) and -h will be assumed for that \$manroot only.
  460.     * If \$manroot/tmac.an exists, it will be used for formatting 
  461.     instead of the normal -man macros.
  462.     * Man pages may be compressed either in (for example) man1.Z/who.1 
  463.         or man1/who.1.Z; cat pages will go into corresponding places.
  464.     * If the man page contains .EQ or .TS directives, eqn and/or tbl
  465.         will be invoked as needed at format time.
  466. USAGE
  467.     close PIPE;
  468.     }
  469.     warn "couldn't run long usage message thru $PAGER?!?!\n" if $?;
  470.     exit 1;
  471. }
  472.  
  473. # --------------------------------------------------------------------------
  474. # lookup a given key in the given man root; returns list of hits
  475. # --------------------------------------------------------------------------
  476. sub fetch {
  477.     local($key,$root) = @_;
  478.     local(%recursed);
  479.  
  480.     return $dbmopened{$root}
  481.     ? &quick_fetch($key,$dbm{$root})
  482.     : &slow_fetch($key,$root);
  483. }
  484.  
  485. # --------------------------------------------------------------------------
  486. # do a quick fetch of a key in the dbm file, recursing on indirect references
  487. # --------------------------------------------------------------------------
  488. sub quick_fetch {
  489.     local($key,$array) = @_;
  490.     local(@retlist) = ();
  491.     local(@tmplist) = ();
  492.     local($_, $entry);
  493.     local($name, $ext);
  494.     local(@newlist);
  495.  
  496.     return @retlist unless $entry = eval "\$$array".'{$key};';
  497.  
  498.     if ($@) { chop $@; die "bad eval: $@"; }
  499.  
  500.     @tmplist = split(/\002/, $entry);
  501.     for (@tmplist) {
  502.     if (/\001/) {
  503.         push(@retlist, $_);
  504.     } else {
  505.         ($name, $ext) = /(.+)\.([^.]+)/;
  506.         push(@retlist, 
  507.         grep(/[^\001]+\001[^\001]+\001${ext}\001/ || /[^\001]+${ext}\001/,
  508.             &quick_fetch($name, $array)))
  509.             unless $recursed{$name}++;
  510.     # explain and diction are near duplicate man pages referencing
  511.     # each other, requiring the $recursed check.  one should be removed
  512.     }
  513.     } 
  514.     return @retlist;
  515. } 
  516.  
  517. # --------------------------------------------------------------------------
  518. # do a slow fetch for target using perl's globbing notation
  519. # --------------------------------------------------------------------------
  520. sub slow_fetch {
  521.     local($target,$root) = @_;
  522.     local($glob, $stem, $entry);
  523.  
  524.     if ($want_section) {
  525.     if ($MANSECT{$want_section}) {
  526.         $stem = $want_section;
  527.     } else {
  528.         $stem = substr($want_section,0,1);
  529.         } 
  530.     $glob = "man$stem*";
  531.     } else {
  532.     $glob = 'man*';
  533.     } 
  534.     $glob = "$root/$glob/$target.*";
  535.     return <${glob}>;
  536. }
  537.  
  538. # --------------------------------------------------------------------------
  539. # run 'man -w'
  540. # --------------------------------------------------------------------------
  541. sub whereis {
  542.     local($target, @files);
  543.  
  544.     foreach $target (@ARGV) {
  545.     @files = &find_files($target);
  546.     if ($#files < $[) {
  547.         warn "$program: $target not found\n";
  548.         $status = 1;
  549.     } else {
  550.         print "$target: " if $#ARGV;
  551.         for (@files) { print &verify($_), " "; }
  552.         print "\n";
  553.     }
  554.     } 
  555. } 
  556.  
  557.  
  558. # --------------------------------------------------------------------------
  559. # what are the file names matching this target?
  560. # --------------------------------------------------------------------------
  561. sub find_files {
  562.     local($target) = @_;
  563.     local($root, $entry);
  564.     local(@retlist) = ();
  565.     local(@tmplist) = ();
  566.     local(@entries) = ();
  567.     local($tar_regx);
  568.     local($found) = 0;
  569.     # globals: $vars, $called_before, %dbm, $hard_way (kinda)
  570.  
  571.     $vars = 'dbm00';  # var for magic autoincrementation
  572.  
  573.     ($tar_regx = $target) =~ s/(\W)/\\$1/g;  # quote meta
  574.  
  575.     if (!$hard_way && !$called_before++) {
  576.     # generate dbm names
  577.     for $root (@MANPATH) {
  578.         $dbm{$root} = $vars++; # magic incr
  579.         $string = "dbmopen($dbm{$root},\"$root/whatis\",0444);";
  580.         unless (-f "$root/whatis.pag" && eval $string) {
  581.         if ($@) { 
  582.             chop $@;
  583.             warn "Can't eval $string: $@";
  584.         } else {
  585.             warn "No dbm file for $root/whatis: $!\n" 
  586.             if $opt_M || $opt_P || $debug;
  587.         }
  588.         #$status = 1;
  589.         next;
  590.         } 
  591.         $dbmopened{$root} = 1;
  592.     }
  593.     } 
  594.  
  595.     for $root (@MANPATH) {
  596.     local($fullname);
  597.     @tmplist = ();
  598.     if ($hard_way || !$dbmopened{$root})  {
  599.         next unless -d $root;
  600.         warn "slow fetch on $target in $root\n" if $debug;
  601.         @tmplist = &slow_fetch($target,$root);
  602.     } else {
  603.         @entries = &fetch($target,$root);
  604.         next if $#entries < 0;
  605.  
  606.         for $entry (sort @entries) {
  607.         ($cmd, $page, $section, $desc) = split(/\001/, $entry);
  608.  
  609.         # STUPID_SO is so that .so's that reference things that
  610.         # don't know they are being referenced.  STUPID_SO may
  611.         # cause peculiarities.
  612.         unless ($STUPID_SO) {
  613.             next unless $cmd =~ /$tar_regx/i || $cmd =~ /\.{3}/;
  614.         }
  615.         push(@tmplist, "$root/man$section/$page");
  616.         }
  617.     }
  618.     push(@retlist, sort bysection @tmplist);
  619.     last if $#retlist >= 0 && $hard_way;
  620.     }
  621. #    unless (@retlist || $hard_way) {
  622. #    # shameless (ab?)use of dynamic scoping
  623. #    local($hard_way) = 1;
  624. #    warn "recursing on find_files\n" if $debug;
  625. #    return &find_files($target);
  626. #    } 
  627.      return &trimdups(@retlist);
  628. } 
  629.  
  630. # --------------------------------------------------------------------------
  631. # run a normal man command
  632. # --------------------------------------------------------------------------
  633. sub man {
  634.     local($target,$page);
  635.     $isatty = -t STDOUT;
  636.  
  637.     &get_section;
  638.  
  639.     while ($target = shift(@ARGV)) {
  640.     undef $idx_topic;
  641.  
  642.     if (!$fromfile && $target =~ m!^([^/]+)/(.*)!) {
  643.         if (!$isatty) {
  644.         warn "$program: no tty, so no pager to prime with index\n";
  645.         $target = $1;
  646.         }  else {
  647.         ($target, $idx_topic) = ($1, $2);
  648.         } 
  649.     } else {
  650.         undef $idx_topic;
  651.     } 
  652.  
  653.     if ($show_all) {
  654.         local(@pages);
  655.         local($was_defined) = defined $idx_topic;
  656.         @pages = &find_files($target);
  657.         if (!@pages) {
  658.         &no_entry($target);
  659.         next;
  660.         } 
  661.         while ($tpage = shift @pages) {
  662.         undef $idx_topic unless $was_defined;
  663.         do $roff(&verify($tpage));
  664.         &prompt_RTN("to read $pages[0]") 
  665.             if $roff eq 'nroff' && @pages;
  666.         } 
  667.     } else {
  668.         $target = &get_page($target) unless $fromfile;
  669.         do $roff($target) if $target;
  670.     }
  671.     &prompt_RTN("to read man page for $ARGV[0]") 
  672.         if $roff eq 'nroff' && @ARGV;
  673.     } 
  674. } 
  675.  
  676. # --------------------------------------------------------------------------
  677. # find out if he wants a special section and save in $want_section
  678. # --------------------------------------------------------------------------
  679. sub get_section {
  680.     if (!$want_section) {
  681.     local($section) = $ARGV[0];
  682.     $section =~ tr/A-Z/a-z/;
  683.  
  684.     if ($want_section = $SECTIONS{$section}) {
  685.         shift @ARGV;
  686.     }  elsif (defined($MANSECT{$section}) || $section =~ /^\d\S*$/i) { 
  687.         $want_section = shift @ARGV;
  688.     } 
  689.     }
  690.     $want_section =~ tr/A-Z/a-z/;
  691.  
  692.     die "But what do you want from section $want_section?\n" 
  693.     if $want_section && $#ARGV < 0;
  694. }
  695.  
  696. # --------------------------------------------------------------------------
  697. # pick the first page matching his target and search orders
  698. # --------------------------------------------------------------------------
  699. sub get_page {
  700.     local($target) = @_;
  701.     local(@found, @want);
  702.  
  703.     unless (@found = &find_files($target)) {
  704.     &no_entry($target);
  705.     return '';
  706.     } 
  707.  
  708.     if (!$want_section) {
  709.     @want = @found;
  710.     } else {{
  711.     local($patsect); # in case it's section 3c++ 
  712.     ($patsect = $want_section) =~ s/(\W)/\\$1/g;
  713.  
  714.     # try exact match first
  715.     last if @want = grep (/\.$patsect$/, @found);
  716.  
  717.     # otherwise how about a subsection
  718.     last if @want = grep (/\.$patsect[^.]*$/, @found);
  719.  
  720.     # maybe it's in the wrong place (mano is notorious for this)
  721.     last if @want = grep (/man$patsect[^.]*\//, @found);
  722.  
  723.     &no_entry($target);
  724.     return '';
  725.     }}
  726.  
  727.     for (@want) { $_ = &verify($_) ; }
  728.     $found = $want[0];
  729.  
  730.     if (@want > 1 && $query_all) {
  731.     local($ans, $i);
  732.  
  733.     select(STDERR);
  734.  
  735.     print "There are ", 0+@want, 
  736.         " manual entries available for $target:\n";
  737.     for ($i = 0; $i <= $#want; $i++) {
  738.         printf "%3d\t%s\n", $i+1, $want[$i];
  739.     } 
  740.     {
  741.         print "Which section would you like? (select 0 for all) ";
  742.         ($ans = <STDIN>) ? chop($ans) : ($ans = "\004");
  743.  
  744.         exit if $ans eq "\004";
  745.         redo if $ans eq '';
  746.  
  747.         if ($ans eq '0') {
  748.         # more dynamic scope abuse
  749.         local(@ARGV) = ($target);
  750.         local($show_all) = 1;
  751.         &man;
  752.         return '';
  753.         } 
  754.         if (--$ans > $#want) {
  755.         print "But we only have ",1+$#want, " man pages!\n";
  756.         redo;
  757.         } 
  758.  
  759.         $found = $want[$ans];
  760.     }
  761.     } 
  762.  
  763.  
  764.     select(STDOUT);
  765.  
  766.     $found;
  767. }
  768.  
  769. # --------------------------------------------------------------------------
  770. # figure out full path name of man page, which may have been compressed
  771. # --------------------------------------------------------------------------
  772. sub verify {
  773.     local($path) = @_;
  774.     local($orig) = $path;
  775.  
  776.     return $path if -f $path;
  777.  
  778.     if ($COMPRESS_PAGE) {
  779.     $path .= '.Z';
  780.     return $path if -f $path;
  781.     $path =~ s/.Z//;
  782.     } 
  783.  
  784.     if ($COMPRESS_DIR) {
  785.     $path =~ s-(/[^/]*)$-.Z$1-;
  786.     return $path if -f $path;
  787.     } 
  788.  
  789.     warn "$program: $orig has disappeared -- rerun makewhatis\n";
  790.     $status = 1;
  791.     return '';
  792. }
  793.  
  794.  
  795. # --------------------------------------------------------------------------
  796. # whine about something not being found
  797. # --------------------------------------------------------------------------
  798. sub no_entry {
  799.     print STDERR "No manual entry for $_[0]";
  800.     if ($machine || $want_section) {
  801.     print STDERR " in";
  802.     print STDERR " section $want_section of" if $want_section;
  803.     print STDERR " the";
  804.     print STDERR " $machine" if $machine;
  805.     print STDERR " manual";
  806.     }
  807.     print STDERR ".\n";
  808.     $status = 1;
  809. } 
  810.  
  811. # --------------------------------------------------------------------------
  812. # order by section.  if the complete extension has a section
  813. # priority, use that.  otherwise use the first char of extension
  814. # only.  undefined priorities are lower than any defined one.
  815. # --------------------------------------------------------------------------
  816. sub bysection {
  817.     local ($e1, $e2, $p1, $p2, $s1, $s2);
  818.  
  819.     ($s1, $e1) = $a =~ m:.*/man([^/]+)/.*\.([^.]+)(\.Z)?$:;
  820.     ($s2, $e2) = $b =~ m:.*/man([^/]+)/.*\.([^.]+)(\.Z)?$:;
  821.  
  822.     $e1 = $s1 if $e1 !~ /^${s1}.*/;
  823.     $e2 = $s2 if $e2 !~ /^${s2}.*/;
  824.  
  825.     $p1 = $MANSECT{$e1} || $MANSECT{substr($e1,0,1)};
  826.  
  827.     $p2 = $MANSECT{$e2} || $MANSECT{substr($e2,0,1)};
  828.  
  829.     $p1 == $p2 ? $a cmp $b : $p2 <=> $p1;
  830. } 
  831.  
  832. # --------------------------------------------------------------------------
  833. # see whether they want to start at a subsection, then run the command
  834. # --------------------------------------------------------------------------
  835. sub run_topic {
  836.     local($_);
  837.     local($menu_rtn) = defined $idx_topic && $idx_topic eq '';
  838.     {
  839.     &append_sub_topic;
  840.     last if $idx_topic eq "\004";
  841.     if ($idx_topic eq '0') {
  842.         $menu_rtn = 0;
  843.         $idx_topic = '';
  844.         $command =~ s: '\+/[^']*'::;
  845.     }
  846.     $fromfile ? &reformat($command) : &run($command);
  847.     if ($menu_rtn) {
  848.         $idx_topic = '';
  849.         &prompt_RTN("to return to the index");
  850.         $command =~ s! '\+/.*$!!;
  851.         redo;
  852.     } 
  853.     }
  854.     
  855. } 
  856.  
  857. # --------------------------------------------------------------------------
  858. # run through the typesetter
  859. # --------------------------------------------------------------------------
  860. sub troff {
  861.     local ($file) = $_[0];
  862.     local ($command);
  863.     local ($manroot);
  864.     local ($macros);
  865.  
  866.     ($manroot) = $file =~ m,^(.*)/man([^\.]*)(\.Z)?/([^/]*),;
  867.  
  868.     $command = ((($file =~ m:\.Z:) 
  869.             ? $ZCAT 
  870.             : $CAT) 
  871.         . " < $file | $TYPESET");
  872.  
  873.     $command =~ s,-man,$manroot/tmac.an, if -e "$manroot/tmac.an";
  874.  
  875.     &insert_filters($command,$file);
  876.     &run($command);
  877. } 
  878.  
  879. # --------------------------------------------------------------------------
  880. # just run a regular nroff, possibly showing the index first.
  881. # --------------------------------------------------------------------------
  882. sub nroff {
  883.     local($manpage) = $_[0];
  884.     local($catpage);
  885.     local($tmppage);
  886.     local($command);
  887.     local(@saveidx);
  888.     local($manroot);
  889.     local($macros);
  890.     local($intmp);
  891.     local(@st_cat, @st_man);
  892.  
  893.     die "trying to nroff a null man page" if $manpage eq '';
  894.  
  895.     umask 022;
  896.  
  897.     if ($full_index) {
  898.     &show_index($manpage);
  899.     return;
  900.     } 
  901.     if ($fromfile) {
  902.     $command = (($manpage =~ m:\.Z/:) ? $ZCAT : $CAT)
  903.             . " < $manpage | $CATSET";
  904.     &insert_filters($command, $manpage);
  905.     } else {
  906.     require 'stat.pl' unless defined &Stat;   
  907.     # compiled version has this already
  908.  
  909.  
  910.     ($catpage = $manpage) 
  911.         =~ s,^(.*)/man([^\.]*)(\.Z)?/([^/]*)$,$1/cat$2/$4,;
  912.  
  913.     $manroot = $1;
  914.  
  915.     # Does the cat page exist?
  916.     if (! -f $catpage && $COMPRESS_DIR){
  917.         # No, maybe it is compressed?
  918.         if (-f "$1/cat$2.Z/$4"){
  919.         # Yes it was.
  920.         $catpage = "$1/cat$2.Z/$4";
  921.         } else {
  922.         # Nope, the cat file doesn't exist.
  923.             # Prefer the compressed cat directory if it exists.
  924.             $catpage = "$1/cat$2.Z/$4" 
  925.             if $catpage !~ /\.Z$/ && -d "$1/cat$2.Z";
  926.         }
  927.     }
  928.  
  929.  
  930.     @st_man = &Stat($manpage);
  931.  
  932.     if ($st_man[$ST_SIZE] == 0) {
  933.         warn "$program: $manpage is length 0!\n";
  934.         $status = 1;
  935.         return;
  936.     } 
  937.  
  938.     @st_cat = &Stat($catpage);
  939.  
  940.  
  941.     if ($st_cat[$ST_MTIME] < $st_man[$ST_MTIME]) {
  942.  
  943.         $command = (($manpage =~ m:\.Z:) ? $ZCAT : $CAT)
  944.             . " < $manpage | $CATSET";
  945.  
  946.         $command = &insert_filters($command, $manpage);
  947.         $command =~ s,-man,$manroot/tmac.an, if -e "$manroot/tmac.an";
  948.  
  949.         ($catdir = $catpage) =~ s!^(.*/?cat[^/]+)/[^/]*!$1!;
  950.  
  951.         chdir $manroot;
  952.  
  953.         $tmppage = "$catpage.$$";
  954.  
  955.         unless (-d $catdir && -w _ 
  956.             && open(tmppage, ">$tmppage") # usually EROFS
  957.             && close(tmppage) )
  958.         {
  959.         $catpage = $tmppage = "/tmp/man.$$";
  960.         $intmp = 1;
  961.         }
  962.  
  963.         printf STDERR "Reformatting page.  Please wait ... " if $isatty;
  964.  
  965.         $command .= "| $COMPRESS" if $catpage =~ /\.Z/;
  966.         $command .= "> $tmppage";
  967.  
  968.         $SIG{'INT'} = $SIG{'QUIT'} = $SIG{'HUP'} = $SIG{'TERM'}  
  969.         = 'tmp_cleanup';
  970.  
  971.         $SIG{'PIPE'} = 'PLUMBER';
  972.  
  973. REFORMAT:   { unless (&reformat($command)) {
  974.         warn "$program: nroff of $manpage into $tmppage failed\n"
  975.             unless $@;
  976.         unlink $tmppage;
  977.         if (!$intmp++) {
  978.             $catpage = $tmppage = "/tmp/man.$$";
  979.             warn "$program: hang on... retrying into $tmppage\n";
  980.             $command =~ s/> \S+$/> $tmppage/;
  981.             $status = 0;
  982.             redo REFORMAT;
  983.         } else {
  984.             #$status = 1;
  985.             return;
  986.         }
  987.         }} 
  988.         warn "done\n" if $isatty;
  989.  
  990.         $intmp || rename($tmppage,$catpage) || 
  991.         die "couldn't rename $tmppage to $catpage: $!\n";
  992.         
  993.         $SIG{'INT'} = $SIG{'QUIT'} = $SIG{'HUP'} = $SIG{'TERM'} =
  994.         $SIG{'PIPE'} = 'DEFAULT';
  995.  
  996.     } 
  997.     $command = (($catpage =~ m:\.Z:)
  998.             ? $ZCAT
  999.             : $CAT)
  1000.             . " < $catpage";
  1001.     }
  1002.     if (-z $catpage) {
  1003.     unlink $catpage;
  1004.     die "$program: $catpage was length 0; disk full?\n";
  1005.     } 
  1006.     $command .= "| $UL"         if $UL;
  1007.     $command .= "| $SED 's/.\b//g'"     if $stripBS;
  1008.     $command .= "| $PAGER"          if $isatty;
  1009.  
  1010.     &run_topic;
  1011.     unlink($tmppage) if $intmp;
  1012. } 
  1013.  
  1014.  
  1015. # --------------------------------------------------------------------------
  1016. # modify $command to prime the pager with the subsection they want
  1017. # --------------------------------------------------------------------------
  1018. sub append_sub_topic {
  1019.     if (defined $idx_topic)  {{
  1020.     local($key);
  1021.     last if $idx_topic eq '0';
  1022.     unless ($idx_topic) {
  1023.         $idx_topic = &pick_index;
  1024.         last if $idx_topic eq "\004" || $idx_topic eq '0';
  1025.     }
  1026.     if ($idx_topic =~ m!^/!) {
  1027.         $command .= " '+$idx_topic'";
  1028.         last;
  1029.     }
  1030.     unless ($key = &find_index($manpage, $idx_topic)) {
  1031.         warn "No subsection $idx_topic for $manpage\n\n";
  1032.         $idx_topic = '';
  1033.         redo;
  1034.     }
  1035.     $key =~ s/([!-~])/$1.$1/g unless $is_less;
  1036.     $command .= " '+/^[ \t]*$key'";
  1037.     }}
  1038. }
  1039.  
  1040.  
  1041. # --------------------------------------------------------------------------
  1042. # present subsections and let user select one
  1043. # --------------------------------------------------------------------------
  1044. sub pick_index {
  1045.      local($_);
  1046.      print "Valid sections for $page follow.  Choose the section\n";
  1047.      print "index number or string pattern. (0 for full page, RTN to quit.)\n\n";
  1048.      &show_index;
  1049.      print "\nWhich section would you like? ";
  1050.      ($_ = <STDIN>) ? chop : ($_ = "\004");
  1051.      $_ = "\004" if 'quit' =~ /^$_/;
  1052.      return $_;
  1053. } 
  1054.  
  1055. # --------------------------------------------------------------------------
  1056. # strip arg of extraneous cats and redirects    
  1057. # --------------------------------------------------------------------------
  1058. sub unshell {
  1059.     $_[0] =~ s/^\s*cat\s*<?\s*([^\s|]+)\s*\|\s*([^|]+)/$2 < $1/;
  1060.     $_[0] =~ s/^([^|<]+)<([^Z|<]+)$/$1 $2/;
  1061.     ($roff eq 'troff') && $_[0] =~ s#(/usr/man/pr\S+)\s+(\S+)#$2 $1#;
  1062. }
  1063.  
  1064. # --------------------------------------------------------------------------
  1065. # call system on command arg, stripping of sh-isms and echoing for debugging
  1066. # --------------------------------------------------------------------------
  1067. sub run {
  1068.     local($command) = $_[0];
  1069.  
  1070.     &unshell($command);
  1071.  
  1072.     warn "running: $command\n" if $debug;
  1073.     if (system $command) {
  1074.     $status = 1;
  1075.     printf STDERR "\"%s\" exited %d, sig %d\n", $command, 
  1076.         ($? >> 8), ($? & 255) if $debug;
  1077.     }
  1078.     return ($? == 0);
  1079. } 
  1080.  
  1081. # --------------------------------------------------------------------------
  1082. # check if page needs tbl or eqn, modifying command if needed
  1083. # add known problems for PR directory if applicable
  1084. # --------------------------------------------------------------------------
  1085. sub insert_filters {
  1086.     local($filters,$eqn, $tbl, $_);
  1087.     local(*PAGE);
  1088.     local($c, $PAGE) = @_;
  1089.     local($page,$sect, $prs, $prdir);
  1090.  
  1091.     ( $page = $PAGE ) =~ s/\.Z//;
  1092.     ($prdir = $page) =~ s#/[^/]*$##;
  1093.     $prdir =~ s#man([^/]*)$#pr$1#;
  1094.     $page =~ s#.*/([^/]+)$#$1#;
  1095.  
  1096.     $PAGE = "$ZCAT < $PAGE|" if $PAGE =~ /\.Z/;
  1097.  
  1098.     (open PAGE) || die ("$program: can't open $PAGE to check filters: $!\n");
  1099.     warn "open $PAGE to check for filters in $_[0]\n" if $debug;
  1100.  
  1101.     while (<PAGE>) {
  1102.     if (/^\.EQ/) {
  1103.         $_ = <PAGE>;
  1104.         $eqn = 1 unless /\.(if|nr)/;  # has eqn output not input
  1105.     } 
  1106.     if (/^\.TS/) {
  1107.         $_ = <PAGE>;
  1108.         $tbl = 1 unless /\.(if|nr)/;  # has tbl output not input
  1109.     } 
  1110.     last if $eqn && $tbl;
  1111.     } 
  1112.     close PAGE;
  1113.  
  1114.     if ($roff eq 'troff') {
  1115.     $eqn && $_[0] =~ s/(\S+roff)/$EQN | $1/;
  1116.     $tbl && $_[0] =~ s/(\S+roff)/$TBL | $1/;
  1117.     } else { # nroff
  1118.     $eqn && $_[0] =~ s/(\S+roff)/$NEQN | $1/;
  1119.     $tbl && $_[0] =~ s/(\S+roff)/$NTBL | $1/;
  1120.     }
  1121.  
  1122.     ($sect) = $page =~ /\.(\d)[^.]*$/;
  1123.     $prs = "$prdir/$page";
  1124.     if (-e $prs) {
  1125.     warn "found PRs for $page\n" if $debug;
  1126.     if ($roff eq 'nroff')  {
  1127.         $_[0] =~ s/ - / - $prs/;
  1128.     } else {
  1129.         $_[0] .= " $prs";
  1130.     } 
  1131.     } else {
  1132.     print "no PRS for $page in $prs\n" if $debug;
  1133.     } 
  1134.     $_[0];
  1135. } 
  1136.  
  1137. # --------------------------------------------------------------------------
  1138. # due to aliasing the dbase sometimes has the same thing twice
  1139. # --------------------------------------------------------------------------
  1140. sub trimdups {
  1141.     local(%seen) = ();
  1142.     local(@retlist) = ();
  1143.  
  1144.     while ($file = shift) {
  1145.     push(@retlist,$file) unless $seen{$file}++;
  1146.     } 
  1147.     return @retlist;
  1148. } 
  1149.  
  1150. # --------------------------------------------------------------------------
  1151. # just print the version
  1152. # --------------------------------------------------------------------------
  1153. sub version  {
  1154.     warn "$program: version is \"$version\"\n" ;
  1155. }
  1156.  
  1157. # --------------------------------------------------------------------------
  1158. # create and display subsection index via pager
  1159. # --------------------------------------------------------------------------
  1160. sub show_index {
  1161.     local($_);
  1162.     &load_index($_[0]);
  1163.     if ($#ssindex > ($rows - 4) && $isatty) {
  1164.     print "Hit <RTN> for $#ssindex subsections via pager: ";
  1165.     $_ = <STDIN>;
  1166.     if ($no_idx_file) {
  1167.         open (PAGER, "| $PAGER");
  1168.         print PAGER @ssindex;
  1169.         close PAGER;
  1170.     } else {
  1171.         &run("$PAGER $idx_file");
  1172.     } 
  1173.     } else {
  1174.     print STDOUT @ssindex;
  1175.     }
  1176. } 
  1177.  
  1178. # --------------------------------------------------------------------------
  1179. # find closest match on index selection in full index
  1180. # --------------------------------------------------------------------------
  1181. sub find_index {
  1182.     local($manpage, $expr) = @_;
  1183.     local($_, @matches);
  1184.  
  1185.     &load_index($manpage);
  1186.  
  1187.     $expr =~ s!^/+!!;
  1188.  
  1189.     for (@ssindex) { 
  1190.     s/^\s*\d+\s+//; 
  1191.     s/\s+\d+\s*$//; 
  1192.     }
  1193.  
  1194.     if ($expr > 0) {
  1195.     return $ssindex[$expr];
  1196.     } else {
  1197.     $ssindex[0] = '';
  1198.     if (@matches = grep (/^$expr/i, @ssindex)) {
  1199.         return $matches[0];
  1200.     } elsif (@matches = grep (/$expr/i, @ssindex)) {
  1201.         return $matches[0];
  1202.     } else {
  1203.         return '';
  1204.     }
  1205.     } 
  1206. } 
  1207.  
  1208. # --------------------------------------------------------------------------
  1209. # read in subsection index into @ssindex
  1210. # --------------------------------------------------------------------------
  1211. sub load_index {
  1212.     local($manpage)  = @_;
  1213.     $no_idx_file = 0;
  1214.     &getidx($manpage) if $#saveidx < 0;
  1215.     @ssindex = @saveidx;
  1216.     die "should have have an index for $manpage" if $#saveidx < 0;
  1217. } 
  1218.  
  1219. # --------------------------------------------------------------------------
  1220. # create subsection index is out of date wrt source man page
  1221. # --------------------------------------------------------------------------
  1222. sub getidx {
  1223.     local($manpage) = @_;
  1224.     local($is_mh);
  1225.     local($_, $i, %lines, %sec, $sname, @snames);
  1226.     local(@retlist, $maxlen, $header, @idx , @st_man, @st_idx);
  1227.     # global no_idx_file, idx_file
  1228.  
  1229.     ( $idx_file = $manpage ) =~ s:/man(\w+)(\.Z)?/:/idx$1/:;
  1230.     $idx_file =~ s/\.Z//;
  1231.  
  1232.     require 'stat.pl' unless defined &Stat;
  1233.  
  1234.     @st_man = &Stat($manpage);
  1235.     @st_idx = &Stat($idx_file);
  1236.  
  1237.     if ($st_man[$ST_MTIME] < $st_idx[$ST_MTIME]) {
  1238.     unless (open idx_file) {
  1239.         warn "$program: can't open $idx_file: $!\n";
  1240.         return ();
  1241.     } 
  1242.     @retlist = <idx_file>;
  1243.     close idx_file;
  1244.     return @saveidx = @retlist;
  1245.     } 
  1246.  
  1247.     if (!open(manpage, $manpage =~ /\.Z/ ? "$ZCAT < $manpage|" : $manpage)) {
  1248.         warn "$program: can't open $manpage: $!\n";
  1249.     return ();
  1250.     }
  1251.     warn "building section index\n" if $debug;
  1252.     ($header = "Subsections in $manpage")  =~ s!/?\S*/!!;
  1253.     $maxlen = length($header);
  1254.     push(@snames, $sname = 'preamble');;
  1255.  
  1256.     # MH has these alias for sections and subsectdions
  1257.     if ($is_mh = $manpage =~ m:/mh/:) {
  1258.     %mh_sections = (
  1259.         "NA", "NAME",
  1260.         "SY", "SYNOPSIS",
  1261.         "DE", "DESCRIPTION",
  1262.         "Fi", "FILES",
  1263.         "Pr", "PROFILE",
  1264.         "Sa", "SEE ALSO",
  1265.         "De", "DEFAULTS",
  1266.         "Co", "CONTEXT",
  1267.         "Hh", "HELPFUL HINTS",
  1268.         "Hi", "HISTORY",
  1269.         "Bu", "BUGS"
  1270.     );
  1271.     $mh_expr = join('|',keys %mh_sections);
  1272.     } 
  1273.  
  1274.     while (<manpage>) {
  1275.     if ($is_mh && /^\.($mh_expr)/) {
  1276.         $sname = $mh_sections{$+};
  1277.         $maxlen = length($sname) if $maxlen < length($sname); 
  1278.         push(@snames,$sname);
  1279.     } 
  1280.     if (/^\.s[sh]\s+(.*)/i ) {
  1281.         $line = $_;
  1282.         $_ = $1;
  1283.         s/"//g;
  1284.         s/\\f([PBIR]|\(..)//g;    # kill font changes
  1285.         s/\\s[+-]?\d+//g;        # kill point changes
  1286.         s/\\&//g;            # and \&
  1287.         s/\\\((ru|ul)/_/g;        # xlate to '_'
  1288.         s/\\\((mi|hy|em)/-/g;    # xlate to '-'
  1289.         s/\\\*\(..//g;         # no troff strings
  1290.         s/\\//g;               # kill all remaining backslashes 
  1291.         $sname = $_;
  1292.         $_ = $line;
  1293.         $maxlen = length($sname) if $maxlen < length($sname); 
  1294.         push(@snames,$sname);
  1295.     } 
  1296.     $lines{$sname}++;
  1297.     } 
  1298.  
  1299.     $mask = sprintf("%%2d   %%-%ds %%5d\n", $maxlen + 2);
  1300.  
  1301.     $no_idx_file = $idx_file eq $manpage || !open(idx, ">$idx_file");
  1302.  
  1303.     $line = sprintf(sprintf("Idx  %%-%ds Lines\n", $maxlen + 2), $header);
  1304.     @retlist = ($line);
  1305.  
  1306.     for ($i = 1; $i <= $#snames; $i++)  {
  1307.     push(@retlist, sprintf($mask, $i, $snames[$i], $lines{$snames[$i]}));
  1308.     } 
  1309.     if (!$no_idx_file) {
  1310.     warn "storing section index in $idx_file\n" if $debug;
  1311.     print idx @retlist;
  1312.     close idx;
  1313.     }
  1314.     return @saveidx = @retlist;
  1315. }
  1316.  
  1317. # --------------------------------------------------------------------------
  1318. # interrupted -- unlink temp page
  1319. # --------------------------------------------------------------------------
  1320. sub tmp_cleanup {
  1321.     warn "unlink $tmppage\n" if $debug;
  1322.     unlink $tmppage;
  1323.     die "Interrupted!\n";
  1324. } 
  1325.  
  1326. #--------------------------------------------------------------------------
  1327. # in case we die writing to the pipe
  1328. # --------------------------------------------------------------------------
  1329. sub PLUMBER {
  1330.     warn "unlink $tmppage\n" if $debug;
  1331.     unlink $tmppage;
  1332.     die "Broken pipe while reformating $manpage\n" ;
  1333. } 
  1334.  
  1335.  
  1336. # --------------------------------------------------------------------------
  1337. # print line with C\bC style emboldening 
  1338. # --------------------------------------------------------------------------
  1339. sub print {
  1340.     local($_) = @_;
  1341.  
  1342.     if (!$inbold) {
  1343.     print;
  1344.     } else {
  1345.     local($last);
  1346.     for (split(//)) {
  1347.             if ($last eq "\033") {
  1348.                 print;
  1349.             } else {
  1350.                 print /[!-~]/ ? $_."\b".$_ : $_;
  1351.             }
  1352.             $last = $_;
  1353.     }
  1354.     } 
  1355. }
  1356.  
  1357. # --------------------------------------------------------------------------
  1358. # reformat the page with nroff, fixing up bold escapes
  1359. # --------------------------------------------------------------------------
  1360. sub reformat { 
  1361.     local($_) = @_; 
  1362.     local($nroff, $col); 
  1363.     local($inbold) = 0;
  1364.  
  1365.     if ($NROFF_CAN_BOLD) {
  1366.     return &run($_);
  1367.     } 
  1368.  
  1369.     &unshell($_);
  1370.     ($nroff, $col) = m!(.*)\|\s*($COL.*)!;
  1371.  
  1372.     warn "$nroff | (this proc) | $col\n" if $debug;
  1373.  
  1374.     open (NROFF, "$nroff |");
  1375.     $colpid = open (COL, "| $col");
  1376.  
  1377.     select(COL);
  1378.  
  1379.     while (<NROFF>) {
  1380.     s/\033\+/\001/;
  1381.     s/\033\,/\002/;
  1382.     if ( /^([^\001]*)\002/ || /^([^\002]*)\001/ )  {
  1383.         &print($1);
  1384.         $inbold = !$inbold;
  1385.         $_ = $';
  1386.         redo;
  1387.     }   
  1388.     &print($_);
  1389.     }
  1390.  
  1391.     close NROFF;
  1392.     if ($?) { 
  1393.     warn "$program: \"$nroff\" failed!\n" if $debug;
  1394.     $status++;
  1395.     } 
  1396.     close COL;
  1397.     if ($?) {
  1398.     warn "$program: \"$col\" failed!\n" if $debug;
  1399.     $status++;
  1400.     }
  1401.     select(STDOUT);
  1402.     $status == 0;
  1403. } 
  1404.  
  1405. # --------------------------------------------------------------------------
  1406. # prompt for <RET> if we're a tty and have a non-stopping pager
  1407. # --------------------------------------------------------------------------
  1408. sub prompt_RTN {
  1409.     local($why) = $_[0] || "to continue";
  1410.     return unless $isatty;
  1411.     unless ($is_less && $ENV{'LESS'} !~ /E/) {
  1412.     print "Hit <RTN> $why: ";
  1413.     $_ = <STDIN>;
  1414.     }
  1415. }
  1416.  
  1417. # --------------------------------------------------------------------------
  1418. # dynamically determine MANPATH (if unset) according to PATH
  1419. # --------------------------------------------------------------------------
  1420. sub config_path {
  1421.     local($_);        # for traversing $PATH
  1422.     local(%seen);    # weed out duplicates
  1423.     local(*manpath);    # eventual return values
  1424.  
  1425.     if (defined $ENV{'MANPATH'}) {
  1426.     $manpath = $ENV{'MANPATH'};
  1427.     } else {
  1428.     for (split(/:/, $ENV{'PATH'})) {
  1429.         next if $_ eq '.';
  1430.         next if $_ eq '..';
  1431.         s![^/+]*$!man! && -d && !$seen{$_}++ && push(@manpath,$_);
  1432.     }
  1433.     $manpath = join(':', @manpath);
  1434.     } 
  1435.     # $manpath;    # last expr is assign to this anyway
  1436. } 
  1437.  
  1438. # --------------------------------------------------------------------------
  1439. # grep through MANPATH for a pattern
  1440. # --------------------------------------------------------------------------
  1441. sub grepman {
  1442.     local($code, $_, $dir, $root, $FILE, $found);
  1443.     
  1444.     $code = "while (<FILE>) {\n";
  1445.  
  1446.     for (@ARGV) {
  1447.     s#/#\\/#g;
  1448.     $code .= <<EOCODE;
  1449.         if (/$_/) { 
  1450.         print "\$path: \$_"; 
  1451.         \$found++;
  1452.         next; 
  1453.         }
  1454. EOCODE
  1455.     } 
  1456.  
  1457.     $code .= "}\n";
  1458.  
  1459.     print "grep eval code: $code" if $debug;
  1460.  
  1461.     
  1462.     foreach $root ( split(/:/, $MANPATH)) {
  1463.     unless (chdir($root)) {
  1464.         warn "can't chdir to $root: $!";
  1465.         $status++;
  1466.         next;
  1467.     } 
  1468.     foreach $dir ( <man?*> ) {
  1469.         unless (chdir($dir)) {
  1470.         warn "can't chdir to $root/$dir: $!";
  1471.         $status++;
  1472.         next;
  1473.         } 
  1474.         unless (opendir(DIR, '.')) {
  1475.         warn "can't opendir $root/$dir: $!";
  1476.         $status++;
  1477.         next;
  1478.         } 
  1479.         foreach $FILE ( readdir(DIR) ) {
  1480.         next if $FILE eq '.' || $FILE eq '..';
  1481.         $path = "$root/$dir/$FILE";
  1482.         if ($FILE !~ /\S\.\S/ || !-f $FILE) {
  1483.             print "skipping non-man file: $path\n" if $debug;
  1484.             next;
  1485.         } 
  1486.         if ($FILE =~ /\.Z$/ || $dir =~ /\.Z$/) {
  1487.             $FILE = "$ZCAT $FILE|";
  1488.         } 
  1489.         print STDERR "grepping $path\n" if $debug;
  1490.         unless (open FILE) {
  1491.             warn "can't open $root/$dir/$FILE: $!";
  1492.             $status++;
  1493.             next;
  1494.         } 
  1495.         eval $code;
  1496.         die $@ if $@;
  1497.         } 
  1498.         unless (chdir ($root)) {
  1499.         warn "can't return to $root: $!";
  1500.         $status++;
  1501.         last;
  1502.         } 
  1503.     } 
  1504.     } 
  1505.     exit ($status || !$found);
  1506. } 
  1507.