Xref: utzoo alt.sources:2972 comp.lang.perl:3479
Path: utzoo!utgpu!cs.utexas.edu!uunet!convex!usenet
From: tchrist@convex.COM (Tom Christiansen)
Newsgroups: alt.sources,comp.lang.perl
Subject: The Answer to All Man's Problems (part 5 of 6)
Keywords: man perl
Message-ID: <1991Jan07.222338.10803@convex.com>
Date: 7 Jan 91 22:23:38 GMT
References: <1991Jan07.220902.9726@convex.com>
Sender: usenet@convex.com (news access account)
Reply-To: tchrist@convex.COM (Tom Christiansen)
Followup-To: alt.sources.d
Organization: CONVEX Software Development, Richardson, TX
Lines: 1001
Nntp-Posting-Host: pixel.convex.com


	X# ${MANALT}/${machine}/man(.+)/*.\11*
	X$MANALT = $ENV{'MANALT'} || '/usr/local/man';
	X
	X# default program for -t command 
	X$TROFF    = $ENV{'TROFF'} || 'nitroff';
	X
	X$NROFF    = 'nroff';
	X$NROFF_CAN_BOLD = 0;	# if nroff puts out bold as H\bH
	X
	X# this are used if filters are needed
	X$TBL	  = 'tbl';
	X$NTBL 	  = "$TBL -D";	# maybe you need -TX instead
	X$NEQN	  = 'neqn';
	X$EQN	  = 'eqn';
	X$SED	  = 'sed';
	X
	X# define this if you don't have/want UL;
	X# without ul, you probably need COL defined unless your PAGER is very smart
	X# you also must use col instead of ul if you've any tbl'd man pages, such 
	X# as from the X man pages or the eqnchar.7 page.
	X$COL	  = 'col';  
	X$UL	  = '';		# set to '' if you haven't got ul
	Xdie 'need either $UL or $COL' unless $UL || $COL;
	X
	X# need these for .Z files or dirs
	X$COMPRESS = 'compress';
	X$ZCAT	  = 'zcat';
	X$CAT	  = 'cat';
	X
	X# define COMPRESS_DIR if pages might have moved to manX.Z/page.X (like HPs)
	X$COMPRESS_DIR = 1;
	X# define COMPRESS_PAGE if pages might have moved to manX/page.X.Z  (better)
	X$COMPRESS_PAGE = 1;
	X
	X# Command to format man pages to be viewed on a tty or printed on a line printer
	X$CATSET	  = "$NROFF -h -man -";
	X
	X$CATSET  .= " | $COL" if $COL;
	X
	X# Command to typeset a man page
	X$TYPESET  = "$TROFF -man";
	X
	X
	X# flags: GNU likes -i, BSD doesn't; both like -h, but BSD doesn't document it
	X# if you don't put -i here, i'll make up for it later the hard way
	X$EGREP = '/usr/local/bin/egrep';	
	Xif (-x $EGREP) {
	X    $EGREP .= ' -i -h';
	X} else {
	X    $EGREP = '/usr/bin/egrep';
	X    unless (-x $EGREP) {
	X	$EGREP = '';
	X    } else {
	X	$EGREP .= ' -h';
	X    }
	X} 
	X
	X# sections that have verbose aliases
	X# if you change this, change the usage message
	X#
	X# if you put any of these in their own trees, comment them out and make 
	X# a link in $MANALT so people can still say 'man local foo'; for local,
	X#	cd $MANALT; ln -s . local
	X# for the other trees (new, old, public) put either them or links
	X# to them in $MANALT
	X#
	X%SECTIONS = (				
	X    'local',	'l',
	X    'new',	'n',
	X    'old',	'o',
	X    'public',	'p' );
	X
	X# turn this on if you want linked (via ".so" or otherwise) man pages
	X# to be found even if the thing they are linked to doesn't know it's
	X# being linked to -- that is, its NAME section doesn't have reference
	X# to it.  eg, if you call a man page 'gnugrep' but it's own NAME section
	X# just calls it grep, then you need this.  usually a good idea.
	X#
	X$STUPID_SO	= 1;  
	X
	X# --------------------------------------------------------------------------
	X# end configuration section
	X# --------------------------------------------------------------------------
	X
	X# CONVEX RCS keeps CHeader; others may prefer Header
	X($bogus, $version) = split(/:\s*/,'$CHeader: man 0.40 91/01/07 15:40:15 $',2);
	Xchop($version); chop($version);
	X
	Xrequire 'getopts.pl';
	X
	X# could do this via ioctl(0,$TIOCGETP,$sgtty) if I were really concerned
	X#
	X$rows = ($ENV{'TERMCAP'} =~ /:li#(\d+):/) ? $1 : 24;
	X
	X%options = (
	X    'man',	'T:m:P:M:c:s:S:fkltvwdguhaiDK',
	X    'apropos',	'm:P:MvduaK',
	X    'whatis',	'm:P:M:vduh',
	X    'whereis',	'm:P:M:vduh'
	X);
	X
	X($program = $0) =~ s,.*/,,;
	X
	X$apropos = $program eq 'apropos';
	X$whatis  = $program eq 'whatis';
	X$whereis = $program eq 'whman';
	X$program = 'man' unless $program;
	X
	X&Getopts($options = $options{$program}) || &usage;
	X
	Xif ($opt_u) {
	X    &version if $opt_v;
	X    &usage;
	X    # not reached
	X} 
	X
	Xif ($opt_v) {
	X    &version;
	X    exit 0;
	X}
	X
	X&usage if $#ARGV < 0;
	X
	X$MANPATH = $opt_P 	if $opt_P;	# backwards contemptibility
	X$MANPATH = $opt_M 	if $opt_M;
	X
	X$want_section = $opt_c 	if $opt_c;	# backwards contemptibility
	X$want_section = $opt_s 	if $opt_s;
	X
	X$hard_way = $opt_h	if $opt_h;
	X
	Xif ($opt_T) {
	X    $opt_t = 1;
	X    $TYPESET =~ s/$TROFF/$opt_T/;
	X    $TROFF = $opt_T;
	X} 
	X
	X$MANPATH = "$MANALT/$opt_m"		# want different machine type (undoc)
	X			if $machine = $opt_m;
	X
	X$MANSECT = $opt_S	if $opt_S;	# prefer our own section ordering
	X
	X$whatis = 1		if $opt_f;
	X$apropos = 1		if $opt_k || $opt_K;
	X$fromfile = 1		if $opt_l;
	X$whereis = 1  		if $opt_w;
	X$grepman = 1		if $opt_g;	
	X$| = $debug = 1		if $opt_d;
	X$full_index = 1 	if $opt_i;
	X$show_all = 1		if $opt_a;
	X$stripBS = 1		if $opt_D;
	X
	X$roff = $opt_t ? 'troff' : 'nroff';   # for indirect function call
	X
	X
	X# maybe they said something like 'man vax ls'
	Xif ($#ARGV > 0) {
	X    local($machdir) = $MANALT . '/' . $ARGV[0];
	X    if (-d $machdir) {
	X	$MANPATH = $machdir;
	X	$machine = shift;
	X    } 
	X} 
	X
	X@MANPATH = split(/:/,$MANPATH);
	X
	X# assign priorities to the sections he cares about
	X# the nearer the front the higher the sorting priority
	X$secidx = 0;
	X$delim = ($MANSECT =~ /:/) ? ':' : ' *';
	Xfor (reverse split(/$delim/, $MANSECT)) {
	X    if ($_ eq '') {
	X	warn "null section in $MANSECT\n";
	X	next;
	X    } 
	X    $MANSECT{$_} = ++$secidx;
	X} 
	X
	X
	Xif ($whatis) {
	X    &whatis;
	X} elsif ($apropos) {
	X    &apropos;
	X} elsif ($whereis) {
	X    &whereis;
	X} elsif ($grepman) {
	X    &grepman;
	X} else {
	X    &man;
	X} 
	X
	Xexit $status;
	X
	X# --------------------------------------------------------------------------
	X# fill out @whatis array with all possible names of whatis files
	X# --------------------------------------------------------------------------
	Xsub genwhatis {
	X    local($elt,$whatis);
	X
	X    for $elt (@MANPATH) {
	X	$whatis = "$elt/whatis";
	X	push(@whatis, $whatis) if -f $whatis;
	X    } 
	X
	X    die "$program: No whatis databases found, please run makewhatis\n" 
	X	if $#whatis < 0;
	X} 
	X
	X# --------------------------------------------------------------------------
	X# run whatis (man -f)
	X# --------------------------------------------------------------------------
	Xsub whatis {
	X    local($target, %seeking, $section, $desc, @entries);
	X
	X    &genwhatis;
	X
	X    for $target (@ARGV) { $seeking{$target} = 1; } 
	X
	X    if ($hard_way) {
	X	&slow_whatis;
	X    } else { 
	X	&fast_whatis;
	X    }
	X
	X    for $target (keys %seeking) {
	X	print "$program: $target: not found.\n";
	X	$status = 1;
	X    } 
	X} 
	X
	X# --------------------------------------------------------------------------
	X# do whatis lookup against dbm file(s)
	X# --------------------------------------------------------------------------
	Xsub fast_whatis {
	X    local($entry, $cmd, $page, $section, $desc, @entries);
	X
	X    for $INDEX (@whatis) {
	X	unless (-f "$INDEX.pag" && dbmopen(INDEX,$INDEX,0444)) {
	X	    warn "$program: No dbm file for $INDEX: $!\n" if $debug; 
	X	    #$status = 1;
	X	    if (-f $INDEX) {
	X		local(@whatis) = ($INDEX);  # dynamic scoping obfuscation
	X		&slow_whatis;
	X	    }
	X	    next;
	X	} 
	X       	for $target (@ARGV) {
	X	    local($ext);
	X	    @entries = &quick_fetch($target,'INDEX');
	X	    next if $#entries < 0;
	X	    # $target =~ s/([^\w])/\\$1/g;
	X	    for $entry (@entries) {
	X		($cmd, $page, $section, $desc) = split(/\001/, $entry);
	X		#  STUPID_SO is one that .so's that reference things that
	X		#  don't know they are being referenced.  STUPID_SO may cause
	X		#  some peculiarities.
	X		unless ($STUPID_SO) {
	X		    next unless $cmd =~ /$target/i || $cmd =~ /\.{3}/;
	X		}
	X
	X		delete $seeking{$target};
	X		($ext) = $page =~ /\.([^.]*)$/;
	X		printf("%-20s - %s\n", "$cmd ($ext)", $desc);
	X	    }
	X	} 
	X	dbmclose(INDEX);
	X    } 
	X    
	X} 
	X
	X# --------------------------------------------------------------------------
	X# do whatis lookup the hard way
	X# --------------------------------------------------------------------------
	Xsub slow_whatis {
	X    local($query);
	X    local($WHATIS);
	X
	X    for (@ARGV) { s/([^\w])/\\$1/g; } 
	X
	X    $query = '^[^-]*\b?(' . join('|',@ARGV) . ')\b[^-]* -';
	X
	X    if ($EGREP)  {
	X	if (&run("$EGREP '$query' @whatis")) {
	X	    # pity can't tell which i found
	X	    %seeking = ();
	X	}
	X    } else {
	X	foreach $WHATIS (@whatis)  {
	X	    unless (open WHATIS) {
	X		warn "can't open $WHATIS: $!\n";
	X		next;
	X	    } 
	X	    while (<WHATIS>) {
	X		next unless /$query/i;
	X		($target = $+) =~ y/A-Z/a-z/;
	X		delete $seeking{$target};
	X		print;
	X	    } 
	X	    close WHATIS;
	X	} 
	X    } 
	X} 
	X
	X# --------------------------------------------------------------------------
	X# run apropos (man -k)
	X# --------------------------------------------------------------------------
	Xsub apropos {
	X    local($_, %seeking, $target, $query);
	X    &genwhatis;  
	X
	X    # fold case on apropos args
	X    for (@ARGV) { 
	X	y/A-Z/a-z/; 
	X	$seeking{$_} = 1; 
	X	s/(\W)/\\$1/g unless $opt_K;
	X    } 
	X    $query = join('|',@ARGV);
	X
	X
	X    if ($EGREP)  {
	X	# need to fake a -i flag?
	X	unless ($EGREP =~ /-\w*i/) {
	X	    local($C);
	X	    local(@pat) = split(//,$query);
	X	    for (@pat) {
	X		($C = $_) =~ y/a-z/A-Z/ && ($_ = '[' . $C . $_ . ']');
	X	    } 
	X	    $query = join('',@pat);
	X	} 
	X	if (&run("$EGREP '$query' @whatis | $PAGER")) {
	X	    %seeking = ();
	X	} 
	X    } else {  # use perl
	X	foreach $WHATIS (@whatis) {
	X	    unless (open WHATIS) {
	X		warn "can't open $WHATIS: $!\n";
	X		next;
	X	    } 
	XWHATIS:	    while (<WHATIS>) {
	X		next unless /$query/io;	      # /o ok, because only called once
	X		$target = $+;
	X		$target =~ s/\\//g;
	X		delete $seeking{$query};
	X		print;
	X	    } 
	X	    close WHATIS;
	X	} 
	X
	X    } 
	X
	X    for $target (keys %seeking) {
	X	warn "$program: $target: nothing appropriate\n";
	X	$status = 1;
	X    }
	X}
	X
	X# --------------------------------------------------------------------------
	X# print out usage message via pager and exit
	X# --------------------------------------------------------------------------
	Xsub usage {
	X    unless ($opt_u) {
	X	warn "usage: $program [-flags] topic ...\n";
	X	warn "        (use -u for long usage message)\n";
	X    } else {
	X	open (PIPE, "| $PAGER");
	X	print PIPE <<USAGE;  # in case he wants a page
	XUSAGE SUMMARY: 
	X    man [-flags] [section] page[/index] ...
	X	(section is [1-8lnop], or "new", "local", "public", "old")
	X	(index is section or subsection header)
	X
	X    man [-flags] -f topic ...  
	X	(aka "whatis")
	X
	X    man [-flags] -k keyword ...
	X	(aka "apropos")
	X
	XFLAGS: (most only make sense when invoked as 'man')
	X    -a		show all possible man pages for this topic
	X    -l file	do man processing on local file
	X    -f topic	list table of contents entry for topic
	X    -k keyword	give table of contents entries containing keyword
	X    -K pattern  as -K but allow regexps
	X    -g pattern  grep through all man pages for patterns
	X    -w topic    which files would be shown for a given topic
	X    -i topic    show section and subsection index for use with topic/index
	X
	X    -M path	use colon-delimited man path for searching (also as -P)
	X    -S sects	define new section precedence 
	X
	X    -t		troff the man page
	X    -T path	call alternate typesetter on the man page
	X
	X    -d		print out all system() commands before running them
	X    -h		do all lookups the hard way, ignoring any DBM files
	X    -u		this message
	X    -v		print version string
	X    -D		strip backspaces from output
	X
	XENVIRONMENT:
	X    \$PAGER	pager to pipe terminal-destined output through 
	X    \$MANPATH	like -M path
	X    \$MANSECT	like -S sects
	X    \$MANALT	used for alternate hardware types (or obsolete -m flag)
	X    \$TROFF	like -T path
	X
	XCURRENT DEFAULTS:
	X    PAGER	$PAGER
	X    MANPATH	$MANPATH
	X    MANSECT	$MANSECT
	X    MANALT	$MANALT
	X    TROFF	$TROFF
	X
	XNOTES:  (\$manroot is each component in \$MANPATH)
	X    * If \$manroot/whatis DBM files do not exist, a warning will be 
	X	printed (if -d flag) and -h will be assumed for that \$manroot only.
	X    * If \$manroot/tmac.an exists, it will be used for formatting 
	X	instead of the normal -man macros.
	X    * Man pages may be compressed either in (for example) man1.Z/who.1 
	X        or man1/who.1.Z; cat pages will go into corresponding places.
	X    * If the man page contains .EQ or .TS directives, eqn and/or tbl
	X        will be invoked as needed at format time.
	XUSAGE
	X	close PIPE;
	X    }
	X    warn "couldn't run long usage message thru $PAGER?!?!\n" if $?;
	X    exit 1;
	X}
	X
	X# --------------------------------------------------------------------------
	X# lookup a given key in the given man root; returns list of hits
	X# --------------------------------------------------------------------------
	Xsub fetch {
	X    local($key,$root) = @_;
	X    local(%recursed);
	X
	X    return $dbmopened{$root}
	X	? &quick_fetch($key,$dbm{$root})
	X	: &slow_fetch($key,$root);
	X}
	X
	X# --------------------------------------------------------------------------
	X# do a quick fetch of a key in the dbm file, recursing on indirect references
	X# --------------------------------------------------------------------------
	Xsub quick_fetch {
	X    local($key,$array) = @_;
	X    local(@retlist) = ();
	X    local(@tmplist) = ();
	X    local($_, $entry);
	X    local($name, $ext);
	X    local(@newlist);
	X
	X    return @retlist unless $entry = eval "\$$array".'{$key};';
	X
	X    if ($@) { chop $@; die "bad eval: $@"; }
	X
	X    @tmplist = split(/\002/, $entry);
	X    for (@tmplist) {
	X	if (/\001/) {
	X	    push(@retlist, $_);
	X	} else {
	X	    ($name, $ext) = /(.+)\.([^.]+)/;
	X	    push(@retlist, 
	X		grep(/[^\001]+\001[^\001]+\001${ext}\001/ || /[^\001]+${ext}\001/,
	X			&quick_fetch($name, $array)))
	X		    unless $recursed{$name}++;
	X	# explain and diction are near duplicate man pages referencing
	X	# each other, requiring the $recursed check.  one should be removed
	X	}
	X    } 
	X    return @retlist;
	X} 
	X
	X# --------------------------------------------------------------------------
	X# do a slow fetch for target using perl's globbing notation
	X# --------------------------------------------------------------------------
	Xsub slow_fetch {
	X    local($target,$root) = @_;
	X    local($glob, $stem, $entry);
	X
	X    if ($want_section) {
	X	if ($MANSECT{$want_section}) {
	X	    $stem = $want_section;
	X	} else {
	X	    $stem = substr($want_section,0,1);
	X        } 
	X	$glob = "man$stem*";
	X    } else {
	X	$glob = 'man*';
	X    } 
	X    $glob = "$root/$glob/$target.*";
	X    return <${glob}>;
	X}
	X
	X# --------------------------------------------------------------------------
	X# run 'man -w'
	X# --------------------------------------------------------------------------
	Xsub whereis {
	X    local($target, @files);
	X
	X    foreach $target (@ARGV) {
	X	@files = &find_files($target);
	X	if ($#files < $[) {
	X	    warn "$program: $target not found\n";
	X	    $status = 1;
	X	} else {
	X	    print "$target: ";
	X	    for (@files) { print " ", &verify($_); }
	X	    print "\n";
	X	}
	X    } 
	X} 
	X
	X
	X# --------------------------------------------------------------------------
	X# what are the file names matching this target?
	X# --------------------------------------------------------------------------
	Xsub find_files {
	X    local($target) = @_;
	X    local($root, $entry);
	X    local(@retlist) = ();
	X    local(@tmplist) = ();
	X    local(@entries) = ();
	X    local($tar_regx);
	X    local($found) = 0;
	X    # globals: $vars, $called_before, %dbm, $hard_way (kinda)
	X
	X    $vars = 'dbm00';  # var for magic autoincrementation
	X
	X    ($tar_regx = $target) =~ s/(\W)/\\$1/g;  # quote meta
	X
	X    if (!$hard_way && !$called_before++) {
	X	# generate dbm names
	X	for $root (@MANPATH) {
	X	    $dbm{$root} = $vars++; # magic incr
	X	    $string = "dbmopen($dbm{$root},\"$root/whatis\",0444);";
	X	    unless (-f "$root/whatis.pag" && eval $string) {
	X		if ($@) { 
	X		    chop $@;
	X		    warn "Can't eval $string: $@";
	X		} else {
	X		    warn "No dbm file for $root/whatis: $!\n" if $debug;
	X		}
	X		#$status = 1;
	X		next;
	X	    } 
	X	    $dbmopened{$root} = 1;
	X	}
	X    } 
	X
	X    for $root (@MANPATH) {
	X	local($fullname);
	X	@tmplist = ();
	X	if ($hard_way || !$dbmopened{$root})  {
	X	    next unless -d $root;
	X	    warn "slow fetch on $target in $root\n" if $debug;
	X	    @tmplist = &slow_fetch($target,$root);
	X	} else {
	X	    @entries = &fetch($target,$root);
	X	    next if $#entries < 0;
	X
	X	    for $entry (sort @entries) {
	X		($cmd, $page, $section, $desc) = split(/\001/, $entry);
	X
	X		# STUPID_SO is so that .so's that reference things that
	X		# don't know they are being referenced.  STUPID_SO may
	X		# cause peculiarities.
	X		unless ($STUPID_SO) {
	X		    next unless $cmd =~ /$tar_regx/i || $cmd =~ /\.{3}/;
	X		}
	X		push(@tmplist, "$root/man$section/$page");
	X	    }
	X	}
	X	push(@retlist, sort bysection @tmplist);
	X	last if $#retlist >= 0 && $hard_way;
	X    }
	X#    unless (@retlist || $hard_way) {
	X#	# shameless (ab?)use of dynamic scoping
	X#	local($hard_way) = 1;
	X#	warn "recursing on find_files\n" if $debug;
	X#	return &find_files($target);
	X#    } 
	X     return &trimdups(@retlist);
	X} 
	X
	X# --------------------------------------------------------------------------
	X# run a normal man command
	X# --------------------------------------------------------------------------
	Xsub man {
	X    local($target,$page);
	X    $isatty = -t STDOUT;
	X
	X    &get_section;
	X
	X    while ($target = shift(@ARGV)) {
	X	undef $idx_topic;
	X
	X	if (!$fromfile && $target =~ m!^([^/]+)/(.*)!) {
	X	    if (!$isatty) {
	X		warn "$program: no tty, so no pager to prime with index\n";
	X		$target = $1;
	X	    }  else {
	X		($target, $idx_topic) = ($1, $2);
	X	    } 
	X	} else {
	X	    undef $idx_topic;
	X	} 
	X
	X	if ($show_all) {
	X	    local(@pages);
	X	    local($was_defined) = defined $idx_topic;
	X	    @pages = &find_files($target);
	X	    if (!@pages) {
	X		&no_entry($target);
	X		next;
	X	    } 
	X	    while ($tpage = shift @pages) {
	X		undef $idx_topic unless $was_defined;
	X		do $roff(&verify($tpage));
	X		&prompt_RTN("to read $pages[0]") 
	X		    if $roff eq 'nroff' && @pages;
	X	    } 
	X	} else {
	X	    $target = &get_page($target) unless $fromfile;
	X	    do $roff($target) if $target;
	X	}
	X	&prompt_RTN("to read man page for $ARGV[0]") 
	X	    if $roff eq 'nroff' && @ARGV;
	X    } 
	X} 
	X
	X# --------------------------------------------------------------------------
	X# find out if he wants a special section and save in $want_section
	X# --------------------------------------------------------------------------
	Xsub get_section {
	X    if (!$want_section) {
	X	local($section) = $ARGV[0];
	X	$section =~ tr/A-Z/a-z/;
	X
	X	if ($want_section = $SECTIONS{$section}) {
	X	    shift @ARGV;
	X	}  elsif (defined($MANSECT{$section}) || $section =~ /^\d\S*$/i) { 
	X	    $want_section = shift @ARGV;
	X	} 
	X    }
	X    $want_section =~ tr/A-Z/a-z/;
	X
	X    die "But what do you want from section $want_section?\n" 
	X	if $want_section && $#ARGV < 0;
	X}
	X
	X# --------------------------------------------------------------------------
	X# pick the first page matching his target and search orders
	X# --------------------------------------------------------------------------
	Xsub get_page {
	X    local($target) = @_;
	X    local(@found, @want);
	X
	X    unless (@found = &find_files($target)) {
	X	&no_entry($target);
	X	return '';
	X    } 
	X
	X    if (!$want_section) {
	X	@want = @found;
	X    } else {{
	X	local($patsect); # in case it's section 3c++ 
	X	($patsect = $want_section) =~ s/(\W)/\\$1/g;
	X
	X	# try exact match first
	X	last if @want = grep (/\.$patsect$/, @found);
	X
	X	# otherwise how about a subsection
	X	last if @want = grep (/\.$patsect[^.]*$/, @found);
	X
	X	# maybe it's in the wrong place (mano is notorious for this)
	X	last if @want = grep (/man$patsect[^.]*\//, @found);
	X
	X	&no_entry($target);
	X	return '';
	X    }}
	X
	X    do {
	X	($found = &verify($want[0])) || shift @want;
	X    } until $found || $#want < 0;
	X
	X    return $found;
	X}
	X
	X# --------------------------------------------------------------------------
	X# figure out full path name of man page, which may have been compressed
	X# --------------------------------------------------------------------------
	Xsub verify {
	X    local($path) = @_;
	X    local($orig) = $path;
	X
	X    return $path if -f $path;
	X
	X    if ($COMPRESS_PAGE) {
	X	$path .= '.Z';
	X	return $path if -f $path;
	X	$path =~ s/.Z//;
	X    } 
	X
	X    if ($COMPRESS_DIR) {
	X	$path =~ s-(/[^/]*)$-.Z$1-;
	X	return $path if -f $path;
	X    } 
	X
	X    warn "$program: $orig has disappeared -- rerun makewhatis\n";
	X    $status = 1;
	X    return '';
	X}
	X
	X
	X# --------------------------------------------------------------------------
	X# whine about something not being found
	X# --------------------------------------------------------------------------
	Xsub no_entry {
	X    print STDERR "No manual entry for $_[0]";
	X    if ($machine || $want_section) {
	X	print STDERR " in";
	X	print STDERR " section $want_section of" if $want_section;
	X	print STDERR " the";
	X	print STDERR " $machine" if $machine;
	X	print STDERR " manual";
	X    }
	X    print STDERR ".\n";
	X    $status = 1;
	X} 
	X
	X# --------------------------------------------------------------------------
	X# order by section.  if the complete extension has a section
	X# priority, use that.  otherwise use the first char of extension
	X# only.  undefined priorities are lower than any defined one.
	X# --------------------------------------------------------------------------
	Xsub bysection {
	X    local ($e1, $e2, $p1, $p2, $s1, $s2);
	X
	X    ($s1, $e1) = $a =~ m:.*/man([^/]+)/.*\.([^.]+)(\.Z)?$:;
	X    ($s2, $e2) = $b =~ m:.*/man([^/]+)/.*\.([^.]+)(\.Z)?$:;
	X
	X    $e1 = $s1 if $e1 !~ /^${s1}.*/;
	X    $e2 = $s2 if $e2 !~ /^${s2}.*/;
	X
	X    $p1 = $MANSECT{$e1} || $MANSECT{substr($e1,0,1)};
	X
	X    $p2 = $MANSECT{$e2} || $MANSECT{substr($e2,0,1)};
	X
	X    $p1 == $p2 ? $a cmp $b : $p2 <=> $p1;
	X} 
	X
	X# --------------------------------------------------------------------------
	X# see whether they want to start at a subsection, then run the command
	X# --------------------------------------------------------------------------
	Xsub run_topic {
	X    local($_);
	X    local($menu_rtn) = defined $idx_topic && $idx_topic eq '';
	X    {
	X	&append_sub_topic;
	X	last if $idx_topic eq "\004";
	X	if ($idx_topic eq '0') {
	X	    $menu_rtn = 0;
	X	    $idx_topic = '';
	X	    $command =~ s: '\+/[^']*'::;
	X	}
	X	$fromfile ? &reformat($command) : &run($command);
	X	if ($menu_rtn) {
	X	    $idx_topic = '';
	X	    &prompt_RTN("to return to the index");
	X	    $command =~ s! '\+/.*$!!;
	X	    redo;
	X	} 
	X    }
	X    
	X} 
	X
	X# --------------------------------------------------------------------------
	X# run through the typesetter
	X# --------------------------------------------------------------------------
	Xsub troff {
	X    local ($file) = $_[0];
	X    local ($command);
	X    local ($manroot);
	X    local ($macros);
	X
	X    ($manroot) = $file =~ m,^(.*)/man([^\.]*)(\.Z)?/([^/]*),;
	X
	X    $command = ((($file =~ m:\.Z:) 
	X			? $ZCAT 
	X			: $CAT) 
	X		. " < $file | $TYPESET");
	X
	X    $command =~ s,-man,$manroot/tmac.an, if -e "$manroot/tmac.an";
	X
	X    &insert_filters($command,$file);
	X    &run($command);
	X} 
	X
	X# --------------------------------------------------------------------------
	X# just run a regular nroff, possibly showing the index first.
	X# --------------------------------------------------------------------------
	Xsub nroff {
	X    local($manpage) = $_[0];
	X    local($catpage);
	X    local($tmppage);
	X    local($command);
	X    local(@saveidx);
	X    local($manroot);
	X    local($macros);
	X    local($intmp);
	X    local(@st_cat, @st_man);
	X
	X    die "trying to nroff a null man page" if $manpage eq '';
	X
	X    umask 022;
	X
	X    if ($full_index) {
	X	&show_index($manpage);
	X	return;
	X    } 
	X    if ($fromfile) {
	X	$command = (($manpage =~ m:\.Z/:) ? $ZCAT : $CAT)
	X			. " < $manpage | $CATSET";
	X	&insert_filters($command, $manpage);
	X    } else {
	X	require 'stat.pl' unless defined &Stat;   
	X	# compiled version has this already
	X
	X
	X	($catpage = $manpage) 
	X	    =~ s,^(.*)/man([^\.]*)(\.Z)?/([^/]*)$,$1/cat$2/$4,;
	X
	X	$manroot = $1;
	X
	X	# Does the cat page exist?
	X	if (! -f $catpage && $COMPRESS_DIR){
	X	    # No, maybe it is compressed?
	X	    if (-f "$1/cat$2.Z/$4"){
	X		# Yes it was.
	X		$catpage = "$1/cat$2.Z/$4";
	X	    } else {
	X		# Nope, the cat file doesn't exist.
	X	    	# Prefer the compressed cat directory if it exists.
	X	    	$catpage = "$1/cat$2.Z/$4" 
	X		    if $catpage !~ /\.Z$/ && -d "$1/cat$2.Z";
	X	    }
	X	}
	X
	X
	X	@st_man = &Stat($manpage);
	X	@st_cat = &Stat($catpage);
	X
	X	if ($st_cat[$ST_MTIME] < $st_man[$ST_MTIME]) {
	X
	X	    $command = (($manpage =~ m:\.Z:) ? $ZCAT : $CAT)
	X			. " < $manpage | $CATSET";
	X
	X	    $command = &insert_filters($command, $manpage);
	X	    $command =~ s,-man,$manroot/tmac.an, if -e "$manroot/tmac.an";
	X
	X	    ($catdir = $catpage) =~ s!^(.*/?cat[^/]+)/[^/]*!$1!;
	X
	X	    chdir $manroot;
	X
	X	    $tmppage = "$catpage.$$";
	X
	X	    unless (-d $catdir && -w _ 
	X		    && open(tmppage, ">$tmppage") # usually EROFS
	X		    && close(tmppage) )
	X	    {
	X		$catpage = $tmppage = "/tmp/man.$$";
	X		$intmp = 1;
	X	    }
	X
	X	    printf STDERR "Reformatting page.  Please wait ... " if $isatty;
	X
	X	    $command .= "| $COMPRESS" if $catpage =~ /\.Z/;
	X	    $command .= "> $tmppage";
	X
	X	    $SIG{'INT'} = $SIG{'QUIT'} = $SIG{'HUP'} = $SIG{'TERM'} 
	X		= 'tmp_cleanup';
	X
	XREFORMAT:   { unless (&reformat($command)) {
	X		warn "$program: nroff of $manpage into $tmppage failed\n";
	X		unlink $tmppage;
	X		if (!$intmp++) {
	X		    $catpage = $tmppage = "/tmp/man.$$";
	X		    warn "$program: hang on... retrying into $tmppage\n";
	X		    $command =~ s/> \S+$/> $tmppage/;
	X		    $status = 0;
	X		    redo REFORMAT;
	X		} else {
	X		    #$status = 1;
	X		    return;
	X		}
	X	    }} 
	X	    warn "done\n" if $isatty;
	X
	X	    $intmp || rename($tmppage,$catpage) || 
	X		die "couldn't rename $tmppage to $catpage: $!\n";
	X	    
	X	    $SIG{'INT'} = $SIG{'QUIT'} = $SIG{'HUP'} = $SIG{'TERM'} 
	X		= 'DEFAULT';
	X
	X	} 
	X	$command = (($catpage =~ m:\.Z:)
	X			? $ZCAT
	X			: $CAT)
	X		    . " < $catpage";
	X    }
	X    if (-z $catpage) {
	X	unlink $catpage;
	X	die "$program: $catpage was length 0; disk full?\n";
	X    } 
	X    $command .= "| $UL" 		if $UL;
	X    $command .= "| $SED 's/.\b//g'" 	if $stripBS;
	X    $command .= "| $PAGER"  		if $isatty;
	X
	X    &run_topic;
	X    unlink($tmppage) if $intmp;
	X} 
	X
	X
	X# --------------------------------------------------------------------------
	X# modify $command to prime the pager with the subsection they want
	X# --------------------------------------------------------------------------
	Xsub append_sub_topic {
	X    if (defined $idx_topic)  {{
	X	local($key);
	X	last if $idx_topic eq '0';
	X	unless ($idx_topic) {
	X	    $idx_topic = &pick_index;
	X	    last if $idx_topic eq "\004" || $idx_topic eq '0';
	X	}
	X	if ($idx_topic =~ m!^/!) {
	X	    $command .= " '+$idx_topic'";
	X	    last;
	X	}
	X	unless ($key = &find_index($manpage, $idx_topic)) {
	X	    warn "No subsection $idx_topic for $manpage\n\n";
	X	    $idx_topic = '';
	X	    redo;
	X	}
	X	$key =~ s/([!-~])/$1.$1/g unless $is_less;
	X	$command .= " '+/^[ \t]*$key'";
	X    }}
	X}
	X
	X
	X# --------------------------------------------------------------------------
	X# present subsections and let user select one
	X# --------------------------------------------------------------------------
	Xsub pick_index {
	X     local($_);
	X     print "Valid sections for $page follow.  Choose the section\n";
	X     print "index number or string pattern. (0 for full page, RTN to quit.)\n\n";
	X     &show_index;
	X     print "\nWhich section would you like? ";
	X     ($_ = <>) ? chop : ($_ = "\004");
	X     $_ = "\004" if 'quit' =~ /^$_/;
	X     return $_;
	X} 
	X
	X# --------------------------------------------------------------------------
	X# strip arg of extraneous cats and redirects	
	X# --------------------------------------------------------------------------
	Xsub unshell {
	X    $_[0] =~ s/^\s*cat\s*<?\s*([^\s|]+)\s*\|\s*([^|]+)/$2 < $1/;
	X    $_[0] =~ s/^([^|<]+)<([^Z|<]+)$/$1 $2/;
	X    ($roff eq 'troff') && $_[0] =~ s#(/usr/man/pr\S+)\s+(\S+)#$2 $1#;
	X}
	X
	X# --------------------------------------------------------------------------
	X# call system on command arg, stripping of sh-isms and echoing for debugging
	X# --------------------------------------------------------------------------
	Xsub run {
	X    local($command) = $_[0];
	X
	X    &unshell($command);
	X
	X    warn "running: $command\n" if $debug;
	X    if (system $command) {
	X	$status = 1;
	X	printf STDERR "\"%s\" exited %d, sig %d\n", $command, 
	X	    ($? >> 8), ($? & 255) if $debug;
	X    }
	X    return ($? == 0);
	X} 
	X
	X# --------------------------------------------------------------------------
	X# check if page needs tbl or eqn, modifying command if needed
	X# add known problems for PR directory if applicable
	X# --------------------------------------------------------------------------
	Xsub insert_filters {
	X    local($filters,$eqn, $tbl, $_);
	X    local(*PAGE);
	X    local($c, $PAGE) = @_;
	X    local($page,$sect, $prs);
	X