#!/usr/bin/env perl
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2, or (at your option)
#   any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software Foundation,
#   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
#   The latest version of this software can be obtained here:
#
#   http://www.normalesup.org/~martinez/macosx/compose2plist.perl

use encoding 'utf8';
require Encode;

# Each line written on standard output is indented at some level by
# a repetition of $indent_pattern
my $indent_pattern = "\t"; 

# The level of the root
my $base_indent = 0;

# The key which Compose is mapped to 
my $multi_key = "\3";

my %char_table = (
	"<Multi_key>" => $multi_key,
	"<apostrophe>" => "'",
	"<asciicircum>" => "\\^",
	"<asciitilde>" => "\\~",
	"<backslash>" => "\\",
	"<bar>" => "|",
	"<comma>" => ",",
	"<equal>" => "=",
	"<exclam>" => "!",
	"<grave>" => "`",
	"<greater>" => ">",
	"<less>" => "<",
	"<minus>" => "-",
	"<numbersign>" => "\\#",
	"<parenleft>" => "(",
	"<parenright>" => ")",
	"<percent>" => "%",
	"<period>" => ".",
	"<plus>" => "+",
	"<question>" => "?",
	"<quotedbl>" => "\"",
	"<slash>" => "/",
	"<space>" => " ",
	"<underscore>" => "_",
	"<KP_Add>" => "#+",
	"<KP_Divide>" => "#/",
	"<KP_Equal>" => "#=",
	"<KP_Space>" => "# ",
	"<0>" => "0",
	"<1>" => "1",
	"<2>" => "2",
	"<3>" => "3",
	"<4>" => "4",
	"<5>" => "5",
	"<6>" => "6",
	"<7>" => "7",
	"<8>" => "8",
	"<9>" => "9",
	"<KP_0>" => "#0",
	"<KP_1>" => "#1",
	"<KP_2>" => "#2",
	"<KP_3>" => "#3",
	"<KP_4>" => "#4",
	"<KP_5>" => "#5",
	"<KP_6>" => "#6",
	"<KP_7>" => "#7",
	"<KP_8>" => "#8",
	"<KP_9>" => "#9",
	"<A>" => "A",
	"<B>" => "B",
	"<C>" => "C",
	"<D>" => "D",
	"<E>" => "E",
	"<F>" => "F",
	"<G>" => "G",
	"<H>" => "H",
	"<I>" => "I",
	"<J>" => "J",
	"<K>" => "K",
	"<L>" => "L",
	"<M>" => "M",
	"<N>" => "N",
	"<O>" => "O",
	"<P>" => "P",
	"<Q>" => "Q",
	"<R>" => "R",
	"<S>" => "S",
	"<S>" => "S",
	"<T>" => "T",
	"<U>" => "U",
	"<V>" => "V",
	"<W>" => "W",
	"<X>" => "X",
	"<Y>" => "Y",
	"<Z>" => "Z",
	"<a>" => "a",
	"<b>" => "b",
	"<c>" => "c",
	"<d>" => "d",
	"<e>" => "e",
	"<f>" => "f",
	"<g>" => "g",
	"<h>" => "h",
	"<i>" => "i",
	"<j>" => "j",
	"<k>" => "k",
	"<l>" => "l",
	"<m>" => "m",
	"<n>" => "n",
	"<o>" => "o",
	"<p>" => "p",
	"<q>" => "q",
	"<r>" => "r",
	"<s>" => "s",
	"<s>" => "s",
	"<t>" => "t",
	"<u>" => "u",
	"<v>" => "v",
	"<w>" => "w",
	"<x>" => "x",
	"<y>" => "y",
	"<z>" => "z"
);

my $table = {};
my $line_index = 0;

while ($line = <>) {
	++$line_index;
	# Strip comments then ignore blank lines
	$line =~ /^(([^#"]|"[^"]*")*)(#.*)?$/;
	my $body = $1;
	if ($body =~ /^(.*)XCOMM .*$/) {
		$body = $1;
	}
	if ($body =~ /^[[:space:]]*$/) {
		next;
	}
	# Parse line
	if (!($body =~ /^([^:]*):[[:space:]]*"([^"])*".*$/)) {
		print stderr "Line $line_index: syntax error\n";
		next;
	}
	my $path = $1;
	my $symbol = $2;
	my @items = split(/[[:space:]]+/, $path);
	my $t = \$table;
	my $ignore = 0;
	while ($item = shift(@items)) {
		if (!defined($$t)) {
			$$t = {};
		}
		elsif (ref($$t) ne "HASH") {
			print stderr "Line $line_index: bound conflict\n";
			$ignore = 1;
			last;
		}
		$v = $char_table{$item};
		if (!defined($v)) {
			print stderr "Line $line_index: unknown key $item\n";
			$ignore = 1;
			last;
		}
		$t = \($$t->{$v});
	}
	if ($ignore) {
		next;
	}
	if (defined($$t)) {
		print stderr "Line $line_index: bound conflict\n";
		next;
	}
	$$t = $symbol;
}

sub output_indent($) {
	my ($lvl) = @_;
	for (my $i = 0; $i < $lvl; ++$i) {
		print $indent_pattern;
	}
}

sub output_unicode($) {
	my ($s) = @_;
	for (my $i = 0; $i < length($s); ++$i) {
		my $chr = substr($s, $i, 1);
		if ($chr eq "\\") {
			print "\\\\";
		}
		elsif ($chr eq "\"") {
			print "\\\"";
		}
		else {
			my $code = ord($chr);
			if ($code >= 0x20 && $code <= 0x80) {
				print $chr;
			}
			else {
				printf "\\U%.4X", $code;
			}
		}
	}
}

sub output_table($$) {
	my ($lvl, $t) = @_;
	foreach my $key (keys %$t) {
		output_indent($lvl);
		print "\"";
		output_unicode($key);
		print "\" = ";
		my $value = $t->{$key};
		if (ref($value) eq "HASH") {
			print "{\n";
			output_table($lvl + 1, $value);
			output_indent($lvl);
			print "};\n";
		}
		else {
			print "(\"insertText:\", \"";
			output_unicode($value);
			print "\");\n";
		}
	}
}

output_indent($base_indent);
print "{\n";
output_table($base_indent + 1, $table);
output_indent($base_indent);
print "}\n";