#!/local/bin/perl -w

eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_0-9]+=)(.*)/ && shift;
			# process any FOO=bar switches

$html  = 0;
$split = 1;
$help  = 0;
$file  = "";

# Process options.
option: while ($_ = $ARGV[0], /^-/) {
    shift;
    last if /^--$/;
    if (/^-html/)    { $html  = 1; next option }
    if (/^-nosplit/) { $split = 0; next option }
    if (/^-h/)       { $help  = 1; last option }
    if (/^-f/)       { $file = $ARGV[0]; next option }
}

if ("$file" ne "") {
    open(FILE_LIST, $file);
    $file_list = <FILE_LIST>;
    @ARGV = split(' ', $file_list);
}

if ($#ARGV < 0 || $help == 1) {
  print STDERR "Usage: extractManApropos [<option>...] <filename>...\n";
  print STDERR "  where <option> is chosen from\n";
  print STDERR "  -html     : Write output suitable for HTML 3.0 table" .
                            " (default no).\n";
  print STDERR "  -nosplit  : Do not split all names with the same manual" .
                            "  page description\n";
  print STDERR "              (only if not '-html').\n";
  print STDERR "  -f <file> : Read filenames from <file>.\n";
  print STDERR "  -h        : Print this text.\n";
  exit;
}

$[ = 0;			# set array base to 0
$, = ' ';		# set output field separator
$\ = "\n";		# set output record separator

$found   = 0;
$line    = -1;
$minus   = -1;
$docName = "";
$names   = "";
$out     = "";
$descr   = "";

line: while (<>) {
    chop;	# strip record separator
    @Fld = split(' ', $_, 9999);
    if (/^\#?\/\*[PFD]:.+\*/ .. /^\*\//) {
        # Inside manual page comment.

	if ($#Fld >= 0 &&
            (substr($Fld[0], 0, 2) =~ /^\/\*$/ ||
             substr($Fld[0], 0, 3) =~ /^\#\/\*$/)
            && $found == 0) {
            # Start of manual page comment.

	    if ((substr($Fld[0], 0, 4) =~ /^\/\*P:$/ ||
                 substr($Fld[0], 0, 5) =~ /^\#\/\*P:$/) && $#Fld == 0) {
		$man = ' (1)';
		$found = 1;
                ($docName = $Fld[0]) =~ s/^\#?\/\*P:(.+)\*/$1/;
	    }
	    elsif ((substr($Fld[0], 0, 4) =~ /^\/\*F:$/ ||
                substr($Fld[0], 0, 5) =~ /^\#\/\*F:$/) && $#Fld == 0) {
		$man = ' (3)';
		$found = 1;
                ($docName = $Fld[0]) =~ s/^\#?\/\*F:(.+)\*/$1/;
	    }
	    elsif ((substr($Fld[0], 0, 4) =~ /^\/\*D:$/ ||
                substr($Fld[0], 0, 5) =~ /^\#\/\*D:$/) && $#Fld == 0) {
		$man = ' (5)';
		$found = 1;
                ($docName = $Fld[0]) =~ s/^\#?\/\*D:(.+)\*/$1/;
	    }
	}

	if ($#Fld >= 0 && $Fld[0] =~ /^\#?Name:/) {
            # Found Name:-line
	    $line = $.;
	    $\ = '';
	    $found = 0;
	    $minus = -1;
            $names = "";
            $descr = "";
	    if ($Fld[1] !~ /.*,/ && $#Fld >= 2 && $Fld[2] !~ /^-$/) {
		print STDERR "Multi-word man-page name close to line ";
		print STDERR "$line in $ARGV. Skipping $names.\n";
                $line = -1;
                next line;
            }
	    $out   = sprintf('%s', $Fld[1]);
            $names = sprintf('%s', $Fld[1]);

            # For each word in "apropos" text
            $i = 2;
            while ($i <= $#Fld) {
		if ($Fld[$i] =~ /^-$/) {
                    # Found separating dash.
		    $minus = $i;
		    $out = $out . sprintf('%s', $man);
		    $blanks = 20 - length($out);
                    $out = $out . ' ' x $blanks;
		    $out = $out . sprintf((' -'));
		}
		else {
                    # Not dash.
		    $out = $out . sprintf(' %s', $Fld[$i]);
                    if ($minus == -1) {
                        $names = $names . sprintf(' %s', $Fld[$i]);
                    } else {
                        $descr = $descr . sprintf(' %s', $Fld[$i]);
                    }
		}
            $i++;
	    }
	    next line;
	}

	if ($. == $line + 1) {
            # Another line belonging to the Name:-line, or a line belonging
            # to a new section.

	    if ($#Fld >= 0 && substr($Fld[0], length($Fld[0])-1, 1) !~ /:/) {
                # This line still belongs to a Name:-line.

		if (length($_) > 0) {
                    # Not a blank line.

                    $i = 0;
		    while ($i <= $#Fld) {
                        if ($i == 0 && ($Fld[$i] =~ /^\#$/)) {
                            ;
                        }
                        elsif ($Fld[$i] =~ /^-$/) {
                            # Found separating dash.

			    $minus = $i;
			    $out = $out . sprintf('%s', $man);
			    $blanks = 20 - length($out);
                            $out = $out . ' ' x $blanks;
			    $out = $out . sprintf((' -'));
			}
			else {
			    $out = $out . sprintf(' %s', $Fld[$i]);
                            if ($minus == -1) {
                                $names = $names . sprintf(' %s', $Fld[$i]);
			    } else {
				$descr = $descr . sprintf(' %s', $Fld[$i]);
			    }
			} # else
                        $i++;
		    } # while
		    $line++;
		} # if not blank line
		next line;
	    } # if line belongs to Name:-line
        } # Name:-line or new section

	if ($. == $line + 1) {
            # Has reached end of man NAME: section.
	    if ($minus >= 0) {

		@Names = split(' ', $names, 9999);
                if ($split || $html) {
		    $i = 0;

                    if ($html) {
			while ($name = $Names[$i]) {
			    $name =~ s/(.+),/$1/;    # Remove trailing ','.
			    print STDOUT "<tr> <td>\n";
			    print STDOUT "<a href=\"$name.html\">$name</a>";
			    print STDOUT "<td> $descr\n";
			    $i++;
			}
                    } else {
			while ($name = $Names[$i]) {
			    $name =~ s/(.+),/$1/;    # Remove trailing ','.
			    print STDOUT "$name" . $man;
			    print STDOUT ' ' x (20 - length($name));
			    print STDOUT " - $descr\n";
			    $i++;
			}
                    }
                } else {
		    print STDOUT $out . "\n";
                }
		$minus = -1;
	    } # if $minus >= 0
	    else {
		print STDERR "Dash missing close to line " . $line;
                print STDERR " in $ARGV. Skipping $names.\n";
	    }
	} # if end of Name: section
    } # Inside manual page comment.

    if (eof) {
        close(ARGV);
        $found = 0;
        $line  = -1;
        $minus = -1;
    }

} # line
