#!/usr/bin/perl

$program = $0;


do 'stat.pl';

local($expr, $manpage) = @ARGV;

local(@retlist);

&getidx($manpage);
@idx = @retlist;

if ($#idx < 0) {
    print "no idx for $manpage\n";
    exit 1;
} 


if ($expr eq '-') {
    print @idx;
    exit;
} else {
    for $_ (@idx) { 
	s/^\s*\d+\s+//; 
	s/\s+\d+\s*$/\n/; 
    }
} 

if ($expr > 0) {
    print $idx[$expr];
} else {
    $idx[0] = '';
    if (@matches = grep (/^$expr/oi, @idx)) {
	print $matches[0];
    } elsif (@matches = grep (/$expr/oi, @idx)) {
	print $matches[0];
    } else {
	print "no index on \"$expr\" in $manpage";
	exit 1;
    }
} 
exit 0;


sub getidx {
    local($manpage) = @_;
    local($_, $i, %lines, %sec, $sname, @snames);
    local($maxlen, $header, $nowrite, @idx ,$idx, @st_man, @st_idx);

    ( $idx = $manpage ) =~ s:/man(\w+)/:/idx$1/:;

    @st_man = &Stat($manpage);
    @st_idx = &Stat($idx);

    if ($st_man[$ST_MTIME] < $st_idx[$ST_MTIME]) {
	unless (open idx) {
	    print STDERR "$program: can't open $idx: $!\n";
	    return ();
	} 
	@retlist = <idx>;
	close idx;
	return @retlist;
    } 

    if (!open manpage) {
    	print STDERR "$program: can't open $manpage: $!\n";
	return ();
    }
    ($header = $manpage) =~ s:.*/(.*)\.([^.]+)$:$1($2):;
    $header .= ' subsections';
    $maxlen = length($header);
    push(@snames, $sname = 'preamble');;

    while (<manpage>) {
	if (/^\.s[sh]\s+(.*)/i) {
	    $line = $_;
	    $_ = $1;
	    s/"//g;
	    s/\\f([PBIR]|\(..)//g;	# kill font changes
	    s/\\s[+-]?\d+//g;		# kill point changes
	    s/\\&//g;			# and \&
	    s/\\\((ru|ul)/_/g;		# xlate to '_'
	    s/\\\((mi|hy|em)/-/g;	# xlate to '-'
	    s/\\\*\(..//g; 		# no troff strings
	    s/\\//g;		   	# kill all remaining backslashes 
	    $sname = $_;
	    $_ = $line;
	    $maxlen = length($sname) if $maxlen < length($sname); 
	    push(@snames,$sname);
	} 
	$sec{$sname} .= $_;
	$lines{$sname}++;
    } 

    $mask = sprintf("%%2d   %%-%ds %%5d\n", $maxlen + 2);

    $nowrite = $idx eq $manpage || !open(idx, ">$idx");

    $line = sprintf(sprintf("Idx  %%-%ds lines\n", $maxlen + 2), $header);
    @retlist = ($line);

    for ($i = 1; $i <= $#snames; $i++)  {
	push(@retlist, sprintf($mask, 
	    $i, $snames[$i], $lines{$snames[$i]}, length($sec{$snames[$i]})));
    } 
    if (!$nowrite) {
	print idx @retlist;
	close idx;
    }
    return @newlist = @retlist;
}
