#!/usr/local/bin/perl

# NAME
#   abctoc - ABC Table of Contents

# SYNOPSIS
#   abctoc file...

# DESCRIPTION
#   This builds a table of contents from the abc files  listed.   The
#   output will show all the T: lines along the left, in alphabetical
#   order, with the file names on the right.

#   The file names may have .abc or .ps as a suffix.  If .ps is used,
#   the corresponding .abc file will be read.

# OPTIONS

# ENVIRONMENT

# FILES

# BUGS
#   People sometimes put strange things into the T:   lines,  and  we
#   don't try too hard to make sense of nonsense.

# AUTHOR
#  John Chambers <jc@trillian.mit.edu>

use Carp;
$| = 1;
($me = $0) =~ s'^.*/'';		# Script name without directory.
$V = $ENV{"V_$me"} || $ENV{"D_$me"} || $ENV{"T_$me"} || 1;

#where = {};	# Title -> file mapping.
%C = (
	"\\AA"  => 'Á',
	"\\aa"  => 'å',
	"\\'A"  => 'Á',
	"\\'a"  => 'á',
	"\\`A"  => 'À',
	"\\`a"  => 'à',
	"\\'E"  => 'É',
	"\\'e"  => 'é',
	"\\\"A" => 'Ä',
	"\\\"A" => 'ä',
	"\\O"   => 'Ø',
	"\\o"   => 'ø',
	"\\\"O" => 'Ö',
	"\\\"o" => 'ö',
	"\\\"U" => 'Ü',
	"\\\"u" => 'ü',
);

file:
for $name (@ARGV) {
	print "$me: File \"$name\"\n" if $V>1;
	if (($root,$suff) = ($name =~ /^(.*)\.(\w+)$/)) {
		$file = "$root.abc";
		$where = "$root";
		$where =~ s/_[A-G]$//;
	} else {
		$file = $where = $name;
	}
	unless (open(FILE,$file)) {
		print STDERR "$me: Can't read \"$file\" ($!)\n" if $V;
		next file;
	}
	$X = 0;
	for $line (<FILE>) {
		$line =~ s/[\s\r]+$//;
		if ($line =~ /^X:\s*(\d+)/) {
			$X = $1;
		} elsif ($line =~ /^[TP]:\s*(.*)$/) {
			$title = $1;
#			next unless ($title =~ /^[a-z][a-z]/i);
			$title =~ s/^the\s+//i;
			while ($title =~ s"\s*\(([^)]+)\)\s*" ") {
				$ttl = $1;
				&onetitle($1,$where,$X) if ($ttl =~ /^[a-z][a-z]/i);
			}
			&onetitle($title,$where,$X) if ($title =~ /^[a-z][a-z]/i);
		}
	}
}

for $k (sort keys %where) {
	if (($T,$F) = ($k =~ /^(.*)\t(.*)$/)) {
		$X = $where{$k};
		next if !$X;
		$t = length($T);
		$f = length($F);
		$x = length($X);
		$a = 70 - ($t + $f);
		$b = 5 - $x;
		print $T, ' ', '.' x $a, ' ', $F, ' ', '.' x $b, $X, "\n";
	} else {
	}
}
exit 0;

sub	onetitle {
	local($t,$f,$x) = @_;
	$t =~ s/^[\s'"a-z]+//;
	$t =~ s/[\s'"]+$//;
	$t =~ s/(\\.\w)/$C{$1}/ge;
	return unless $t;
	local($index) = "$t\t$f";
	if (defined $where{$index}) {
		print STDERR "$me: More than one title \"$title\" in \"$file\"\n" if $V>1;
	} else {
		$where{$index} = $X;
	}
}