#!/usr/bin/perl
# makeindex.pl -- build index
# SCCS Status     : %Z%@ %M%	%I%
# Author          : Johan Vromans
# Created On      : Thu Sep 21 10:30:32 1993
# Last Modified By: Johan Vromans
# Last Modified On: Fri Jan 10 21:04:06 2003
# Update Count    : 24
# Status          : Development

################ Common stuff ################

$LIBDIR = $ENV{"MH_DOCLIB"} || "/usr/local/lib/mh_doc";
unshift (@INC, $LIBDIR);
require "common.pl";
$my_version = "%I%";
$my_name = "%M%";

################ Program parameters ################

&options;
open (STDOUT, ">$opt_output") if defined $opt_output;

################ Presets ################

$debug = $opt_debug;
$trace = $opt_test || $opt_trace | $opt_debug;
$TMPDIR = $ENV{"TMPDIR"} || "/usr/tmp";
$LIBDIR = "." if $debug;

$tmp = $TMPDIR . "/idx$$";
require "ctime.pl";

################ The Process ################

&phase_msg ("Generating Index") unless $opt_quiet;

open (TMP, ">$tmp");
while ( <> ) {
    # Read indexentry, and break into fields.
    ($tag, $part, $sec, $page) = 
	m|^\\indexentry{(.*)}{(.*)}{([\dA-Z]*)}{([a-zA-Z0-9]+)}$|;

    # Special treatment of page numbers.
    # We want appendices to sort after the normal pages, and
    # unnumbered setions before everything else.
    # Also, we must sort roman numerals as decimal.
    if ( $sec =~ /^[A-Z]+$/ ) {
	# Appendix.
	$pagetype = 'C';
    }
    elsif ( $page =~ /^[ivxlcm]+$/i ) {
	# Roman numeral. Store the original page number for display purposes.
	$pagetype = "A${page}";
	$page = &R2d ($page);
    }
    else {
	# Normal page  number.
	$pagetype = 'B';
    }

    # Special treatment for the index tags.
    # Accented characters must be sorted w/o accent, collected, but
    # still treated different.
    ($stag = $tag) =~ tr/A-Z/a-z/;
    $stag =~ s/([aeiuon])/$1 /g;
    $stag =~ s/\\(['"`^~]){([aeiuon]) }/$2$1/g;		#']/;
    print TMP ("$stag\t$tag\t$part\t$sec\t$pagetype\t$page\n");
}
close (TMP);

$cmd = "sort5 < $tmp '-t\t' ".
#### SHOULD DICT ORDER BE USED??
	"+0d -1 ".		# sort key -- dict order
	"+2d -3 ".		# part name -- dict order
	"+3n -4 ".		# section number -- numeric
	"+4 -5 ".		# pagenumber type 
	"+5n ".			# page number -- numeric
        "";

print STDERR ("+ $cmd\n") if $opt_trace;
open (DATA, "$cmd|");

# Preamble for the index.
print STDOUT ("%% Index file generated by %M% version %I%, ", &ctime(time));
print STDOUT ('\begin{theindex}');

# Read the sorted data and process it.
while ( <DATA> ) {
    next if $lline eq $_;
    $lline = $_;
    chop;
    ($dummy, $tag, $part, $sec, $pagetype, $page) = split (/\t/);

    # Get pagenumber from pagetype, if needed.
    $page = $' if $pagetype =~ /^A/;

    # Check modification of keyword.
    if ( $tag ne $ltag ) {
	$ltag = $tag;
	@tags = split (/!/, $tag);

	print STDOUT ("\n\\item ", $tags[0])
	    if @tags >= 1 && $tags[0] ne $ltags[0];
	print STDOUT ("\n\\subitem ", $tags[1])
	    if @tags >= 2 && $tags[1] ne $ltags[1];
	print STDOUT ("\n\\subsubitem ", $tags[2])
	    if @tags >= 3 && $tags[2] ne $ltags[2];

	@ltags = @tags;
	$lpart = undef;
    }

    # Include the part name, if present.
    if ( (!defined $lpart || $part ne $lpart) && $part ne '' ) {
	if ( defined $lpart ) {
	    print STDOUT (",\\hfill\\break\n",
			  "\\hspace{\\leftmargin}{\\it $part\\/}~");
	}
	else {
	    print STDOUT (", {\\it $part\\/}~");
	}
	$lpart = $part;
	$nosep = 1;
    }

    # Output the section and page number.
    print STDOUT ($nosep ? "" : ", ",
		  $sec ne '' ? "$sec-" : '', 
		  "$page");

    $nosep = 0;
}
print STDOUT ("\n");
print STDOUT ("\\end{theindex}\n");
close (DATA);

if ( $result = $? ) {
    &die ("Problem executing \"$cmd\"\n",
	  "Wait return status = ",
	  sprintf ("0x%x", $result),
	  "\n");
}

# Cleanup and exit.
&unlink ($tmp);
close (STDOUT);
exit (0);

################ Subroutines ################

sub R2d {
    # As suggested by rick@rick.infoserv.com (Rick Klement)
    local($_, $ans, $i) = (@_, 0, 0);
    tr/a-z/A-Z/;
    for $ltr ('IV','IX','XL','XC','CD','CM','I','V','X','L','C','D','M') {
	$ans += (4,9,40,90,400,900,1,5,10,50,100,500,1000)[$i]
	    while s/$ltr//;
	$i++;
    }
    $ans;
}

sub options {
    local ($opt_help) = 0;	# handled locally
    local ($opt_ident) = 0;	# handled locally

    # Preset defaults.
    $opt_trace = $opt_debug = 0;
    $opt_verbose = $opt_quiet = 0;

    # Process options.
    if ( @ARGV > 0 && $ARGV[0] =~ /^-/ ) {
	require "newgetopt.pl";
	&usage 
	    unless &NGetOpt ( "output=s",
			     "ident", "verbose", "quiet",
			     "trace", "help", "debug")
		&& !$opt_help;
    }
    print STDERR "This is $my_package [$my_name $my_version]\n"
	if $opt_ident;
}

sub usage {
    require "common.pl";
    print STDERR <<EndOfUsage;
This is $my_package [$my_name, $my_version]

Usage: $0 [options] [file ...]
    -help		this message
    -ident		show identification
    -quiet		show only error messages
    -verbose		verbose information
    -output XXX		name of output file (no printing will be done)
EndOfUsage
    exit 1;
}

sub unlink {
    for $file ( @_ ) {
	print STDERR ("+ unlink ", $file, "\n") if $opt_trace;
	next unless -f $file;
	unlink ($file) ||
	    print STDERR ("Warning: could not unlink \"$file\" [$!]\n");
    }
}

sub die {
    print STDERR @_;
    &phase_msg (1);
}
