
# Script type: perl5

# To do:
# - option to replace list of unsupported specials in the special-char file
# with an updated list.  To do this, must be able to hold current contents
# in order, and to recognize the current list of unsupported characters.
# - Use actions file reader to write out a "strike": name: \(xx.  This too
# should list the built-in specials.

# chk-specials - check a postprocessor special-char list to see which
# special characters aren't listed.


($prog = $0) =~ s|.*/||;	# get script name for messages

$usage = "Usage: $prog special-char-list";

die "$usage\n" unless @ARGV;

$actions = "$(TOP)/troffcvt/actions";	# troffcvt actions file

# List of special character names.  It's initialized with the built-in
# specials.  Then the special characters listed in the actions file are
# added to the list.

%special = (
	"backslash"	=> "backslash",
	"at"		=> "at",
	"quoteleft"	=> "quoteleft",
	"quoteright"	=> "quoteright",
	"quotedblleft"	=> "quotedblleft",
	"quotedblright"	=> "quotedblright",
	"zerospace"	=> "zerospace",
	"twelfthspace"	=> "twelfthspace",
	"sixthspace"	=> "sixthspace",
	"digitspace"	=> "digitspace",
	"hardspace"	=> "hardspace",
	"minus"		=> "minus",
	"grave"		=> "grave",
	"acute"		=> "acute",
	"backspace"	=> "backspace",
	"emdash"	=> "emdash",
	"opthyphen"	=> "opthyphen",
	"tab"		=> "tab",
	"leader"	=> "leader",
	"fieldbegin"	=> "fieldbegin",
	"fieldend"	=> "fieldend",
	"fieldpad"	=> "fieldpad",
);

open (IN, $actions) || die "$prog: cannot open $actions\n";
while (<IN>)
{
	chomp;
	@word = split (' ', $_);
	next unless $word[0] eq "imm";
	next unless $word[1] eq "special-char";
	$name = $word[3];
	warn "$name\n" if $name !~ /^@/;
	$name =~ s/^@//;
	$special{$name} = $name;
}
close (IN);

ProcessFile (shift (@ARGV)) while @ARGV;

exit (0);

# --------------------------------------------------------------------------

sub ProcessFile
{
my ($filename) = shift;
my (%name, @name, $name, $rest, $count);
my (@known, @unknown);

	open (IN, $filename) || die "$prog: cannot open $filename\n";
	while (<IN>)
	{
		chomp;
		next if /^#/;		# ignore comments
		next if /^\s*$/;
		($name, $rest) = split (' ', $_, 2);
		$name =~ s|/.*||;	# name/modifier -> name
		push (@name, $name);
		++$name{$name};
	}
	close (IN);

	foreach $name (@name)
	{
		if (defined ($special{$name}))
		{
			push (@known, $name);
		}
		else
		{
			push (@unknown, $name);
		}
	}

	print "Known special character names listed in $filename:\n";
	foreach $name (sort (@known))
	{
		print "\t$name\n";
	}

	print "Unknown special character names listed in $filename:\n";
	foreach $name (sort (@unknown))
	{
		print "\t$name\n";
	}

	delete $special{shift (@name)} while @name;

	print "Special character names not listed in $filename:\n";
	foreach $name (sort (keys (%special)))
	{
		print "\t$name\n";
	}

	foreach $name (keys (%name))
	{
		delete $name{$name} if $name{$name} == 1;
	}

	print "Special character names listed multiple times in $filename:\n";
	foreach $name (sort (keys (%name)))
	{
		$count = $name{$name};
		print "\t$name ($count time", $count > 1 ? "s" : "", ")\n";
	}
}
