#!/usr/local/bin/perl

###
### Copyright 1992, Patrick A. O'Donnell
### Written at the MIT Artificial Intelligence Laboratory
### All rights reserved.
###
### This software may be freely copied and distributed subject to the
### following restrictions.  Any distribution of this software must return
### no profit, must be for educational or scientific use, and must include
### these copyright and distribution notices without modification.  The
### author also grants to individuals the license to modify or enhance this
### software, however distribution of these derivative works is prohibited.
### Such enhancements or modifications may be returned to the author to be
### included in future versions.  Distribution of this sofware contrary to
### the terms of this notice may be subject to penalties under applicable
### law.
### 
### Permission to copy or distribute this software other than under
### these conditions may be granted by the author in writing.
###

$badentries = 0;
$dupdefns = 0;
$count = 0;
$redirects = 0;

if (@ARGV > 2) {
  if ($ARGV[0] eq "-sa") {
    shift;
    &SeeAlsoProcess(shift);
  }
}

&InProcess;
&Stats;
&OutProcess;

#
#  Subroutines:
#  Variables:
#    %pages -- array listing the pages for each entry.
#    %Original -- array listing the original spelling for each entry.
#    %defns -- array counting multiple \defn's for a term.
#


sub SeeAlsoProcess {
  local($safile) = @_;
  local($silent, $entry, $target, $OTarget);

  open(SAFILE, $safile) || warn "Couldn't open $safile\n" && return;
  while (<SAFILE>) {
    next if /^\s*#/;
    chop;
    if (!(($silent,$also,$entry,$target) = /^(-?)(\+?){([^{}]+)}{([^{}]+)}$/)) {
      warn "Bad $safile entry, ignoring: $_\n";
      $badentries++;
      next;
    }

    ## Strip leading and trailing spaces from both the entry and the target.
    $entry = &StripSpace($entry);
    $target = &StripSpace($target);

    $entry =~ tr/\|/\001/;

    unless ($silent) {
      &AddToEntry($entry, "see");
      $count++;
    }
	# This must come after the AddToEntry, since that subroutine
	# looks for the translation!
    $entry =~ tr/A-Z/a-z/;
    $target =~ tr/\|/\001/;
    $OTarget = $target;
    $target =~ tr/A-Z/a-z/;
    $SeeAlso{$entry} = $target;
    $Original{$target} = $OTarget;
  }  
}

sub InProcess {
  while (<>) {
    chop;  # flush newline in original text for warning messages.

    # We don't allow any control sequences in the index entries,
    # because they won't alphabetize right.

    if (!(($entry,$page) = /^\\indexentry{([^{}@\\]+)}{([\divx]+)}$/)) {
      warn "Bad index entry, ignoring: $_\n";
      $badentries++;
      next;
    }

    $entry = &StripSpace($entry);

    # ******** USER MODIFICATION ********
    # Comment out the following one line to disable the tilde --> lower case feature
    $entry =~ tr/A-Z~/a-z/d if ($entry =~ /^~/);
    $entry =~ tr/\|/\001/;

    &AddToEntry($entry, $page);
    $count++;
  }
}

sub StripSpace {
  local($entry) = @_;
  local(@entry);

  @entry = split(/\|/,$entry);
  if (@entry == 3) {
      return join("|",
	  &StripSpaceAux($entry[0], "entry", $entry),
	  &StripSpaceAux($entry[1], "subentry", $entry),
	  &StripSpaceAux($entry[2], "subsubentry", $entry));
  } 
  if (@entry == 2) {
      return join("|",
	  &StripSpaceAux($entry[0], "entry", $entry),
	  &StripSpaceAux($entry[1], "subentry", $entry));
  }
  if (@entry == 1) {
      return &StripSpaceAux($entry[0], "entry", $entry);
  }
}

sub StripSpaceAux {
  local($part,$name,$line) = @_;

  (($part =~ /^\s*(\S|\S.*\S)\s*$/) == 1) || warn "Blank $name? $line";
  return $1;
}

# Each "page" is formatted as " #%flags,", where the flags are a sequence of characters
# indicating the presence or absence of a feature.
# There are 2 flags: 'b' (for \bf) and 'f' (for ff).
# Page "see" is special, indicating a "see also" entry.
# That page had better be first...

sub AddToEntry {
  local($entry, $page) = @_;
  local($flags, $opage, $OriginalEntry, $bfpage, $ffpage);

  # Set flags for this page
  $bfpage = "";
  $ffpage = "";

  # ******** USER MODIFICATION ********
  # Comment out the following four lines to disable the plus-sign --> \bf page feature.
  if ($entry =~ m/^\+/) {
    $entry = substr($entry, 1);
    $bfpage = "b";
  }

  # ******** USER MODIFICATION ********
  # Comment out the following four lines to disable the equal-sign --> "page ff" feature.
  if ($entry =~ m/^\=/) {
    $entry = substr($entry, 1);
    $ffpage = "f";
  }

  # Canonicalize entry
  $OriginalEntry = $entry;
  $entry =~ tr/A-Z/a-z/;

  # Look up translations
  $maxredirects = 10;
  while ($temp = $SeeAlso{$entry}) {
    $entry = $temp;
    $redirects++;
    $maxredirects-- || die "Too many redirects: $temp ($OriginalEntry)\n";  }

  (warn ("Duplicate \\defn entry: $_\n"),
	$dupdefns++) if $bfpage && $defns{$entry}++;


  @entry = split (/\001/,$entry);

  $main{$entry[0]}++;

  if (!$Original{$entry}) { $Original{$entry} = $OriginalEntry; }

  ($opage) = ($pages{$entry} =~ / ($page\%b?f?),/);

  warn "Page reference for 'see also' entry: $_\n"
	if ($pages{$entry} =~ / see\%,/);

  if ($opage) {
#    warn "Duplicate entry on page ($opage): $_\n";
    ($flags) = $opage =~ /\%(b?f?),/;
    $flags = "b" . $flags if $bfpage && !($flags =~ /b/);
    $flags = $flags . "f" if $ffpage && !($flags =~ /f/);
    $pages{$entry} =~ s/ $opage,/ $page%$flags,/;
  } else {
    $pages{$entry} .= " $page%$bfpage$ffpage,";
  }
}

sub Stats {
  local(@foo) = keys(%pages);
  local(@bar) = keys(%main);
  print STDERR "----------\n";
  print STDERR $count, " index entries processed.\n";
  print STDERR scalar(@foo), " distinct entries.\n";
  print STDERR scalar(@bar), " main entries.\n";
  print STDERR $dupdefns, " duplicate \\defn entries.\n";
  print STDERR $badentries, " bad entries encountered.\n";
  print STDERR $redirects, " redirections.\n";
}

#
#  OUT PROCESSING ****************************************
#

sub OutProcess {
  local($lastchar) = " ";
  local($lastmain) = "";
  local($lastsub) = "";

  foreach $key (sort(keys(%pages))) {
    if ($lastchar ne substr($key, 0, 1)) {
	  $lastchar = substr($key, 0, 1);
	  $xlastchar = $lastchar;
	  $xlastchar =~ tr/a-z/A-Z/;
	  print "\\newindexletter ", $xlastchar, "\n";
    }
    &PrintEntry($key);
  }
}

sub PrintEntry {
  local($entry) = @_;

  $pages = $pages{$entry};

  @entry = split (/\001/, $entry);

  if (@entry == 1) { &PrintMain; }
  if (@entry == 2) { &PrintSub; }
  if (@entry == 3) { &PrintSubSub; }
}

sub PrintPages {
  # Parse the flags to indicate bold face or a ff.
  local($apage,$pagelist);

  $pagelist = $pages;

  while ($pagelist) {
    if ((($pageno,$flags,$rest) = ($pagelist =~ /^ ([\divxse]+)\%(b?f?),(.*)$/)) != 3) {
      die "Eh? Badly formatted \$pages: \"$pages\" (\"$pagelist\")\n";
    }
    $pagelist = $rest;

    if ($pageno eq "see") {
      &PrintSeeAlso;
    } else {
      $pageno .= "ff" if $flags =~ /f/;
      $pageno = "{\\bf $pageno}" if $flags =~ /b/;
      print ", ", $pageno;
    }
  }
  print "\n";
}

sub PrintSeeAlso {
  $target = $entry;
  while ($temp = $SeeAlso{$target}) { $target = $temp; }
  $temp = $Original{$target};
  $temp =~ s/\001/, /;
  print ", \\indexsee{$temp}";
}

sub PrintMain {
  print "\\item $Original{$entry}";
  &PrintPages;
  $lastmain = $entry;
  $lastsub = "";
}

sub PrintSub {
  @Original = split(/\001/, $Original{$entry});
  if ($lastmain ne $entry[0]) {
    print "\\item $Original[0],\n";
    $lastmain = $entry[0];
  }
  print "\\subitem $Original[1]";
  &PrintPages;
  $lastsub = $entry[1];
}

sub PrintSubSub {
  @Original = split(/\001/, $Original{$entry});
  if ($lastmain ne $entry[0]) {
    print "\\item $Original[0],\n\\subitem $Original[1]\n";
    $lastmain = $entry[0];
    $lastsub = $entry[1];
  } elsif ($lastsub ne $entry[1]) {
    print "\\subitem $Original[1],\n";
    $lastsub = $entry[1];
  }
  print "\\subsubitem $Original[2]";
  &PrintPages;
}