#!/usr/bin/env perl

# Author: Simos Xenitellis <simos@gnome.org>.
# By reading this line, you are forbidden from making negative comments
# on my Perl coding abilities.

use strict;
use utf8;

my $line;
my $firstletter;
my @components;
my $i;
my $semicolon;
my $letter;
my $codepoint;
my $codepointhex;
my @entry;
my @gtkimcontext;
my @gtkimcontextsorted;
my @gtkimcontextsorteduniqued;
my $packedline;
my @unpackeda;
my @unpackedb;
my $element;
my $previouselement;
my @c;

# Used for reading the existing elements in gtkimcontextsimple.c.
my @existingelements;
my @existingseqs;

# Used for reading the GDK key symbols.
my @gdkelements;
my %gdksyms;

# Used for reading the UnicodeData.txt file.
my @unicodeelements;
my %unicodedata;

binmode DATA, ":utf8";

# Source: http://cvs.freedesktop.org/xorg/xc/nls/Compose/el_GR.UTF-8?view=markup
# or /usr/X11R6/lib/X11/locale/el_GR.UTF-8/Compose
# (requires stripping off unneeded lines (=non-greek), is ok with comments or blank lines).
die "Could not open prearranged file Compose.Greek: $!\n" unless open(INCOMPOSE, "<:utf8", "Compose.Greek");

# Source: gtk+/gdk/gdkkeysyms.h (requires to strip off unneeded lines!).
# or /usr/include/gtk-2.0/gdk/gdkkeysyms.h
die "Could not open prearranged file gdkkeysyms.dat: $!\n" unless open(INGDKSYMS, "<:utf8", "gdkkeysyms.dat");

# Source: http://www.unicode.org/Public/UNIDATA/UnicodeData.txt
# or /usr/lib/perl5/5.8.3/unicore/UnicodeData.txt
die "Could not open prearranged file UnicodeData.txt: $!\n" unless open(INUNICODEDATA, "<:utf8", "UnicodeData.txt");

# Source: gtk+/gtk/gtkimcontextsimple.c (requires to strip off unneeded lines, remove commas and fix comments!).
die "Could not open prearranged file gtkimcontextsimple.c.reduced: $!\n" unless open(INGTKIMCONTEXTSIMPLE, "<:utf8", "gtkimcontextsimple.c.reduced");

# Output file: gtkimcontext.result
die "Could not open output file: $!\n" unless open(OUTGTKIMCONTEXT, ">:utf8", "gtkimcontext.result");
                                                                                                                               
# Output file: multiples.result
die "Could not open output file: $!\n" unless open(OUTMULTIPLES, ">:utf8", "multiples.result");

# Output file: conflicts.result
die "Could not open output file: $!\n" unless open(OUTCONFLICTS, ">:utf8", "conflicts.result");

keys(%unicodedata) = 17000;
keys(%gdksyms) = 1500;

sub printgtkentrymultiples
{
  my @a = unpack("A100 A100 A100 A100 A100 A50 A150", shift);
  my $destinationfile = shift;

  print OUTMULTIPLES "  $a[0],\t$a[1],\t$a[2],\t$a[3],\t$a[4],\t$a[5], /* $a[6] */\n";

  return;
}

sub printgtkentryconflicts
{
  my @a = unpack("A100 A100 A100 A100 A100 A50 A150", shift);
  my $destinationfile = shift;

  print OUTCONFLICTS "  $a[0],\t$a[1],\t$a[2],\t$a[3],\t$a[4],\t$a[5], /* $a[6] */\n";

  return;
}

while (<INUNICODEDATA>)
{
	@unicodeelements = split(/;/);
	die "Internal error, no unicodeelements, \$_: $_, \@unicodeelements: @unicodeelements\n" unless @unicodeelements;

	$unicodeelements[1] =~ s/\s+/_/g; 
	$unicodedata{$unicodeelements[0]} = $unicodeelements[1];
	# Example: { "00ED" } = "LATIN_SMALL_LETTER_I_WITH_ACUTE";
}

close INUNICODEDATA;

while (<INGDKSYMS>)
{
	@gdkelements = split(/\s+/);
	die "Internal error, no gdkelements, \$_: $_, \@gdkelements: @gdkelements\n" unless @gdkelements;

	$gdksyms{$gdkelements[1]} = hex($gdkelements[2]);
	# Example: { "GDK_dead_grave" } = "FE50";
}

$gdksyms{"0"} = "0000";

close INGDKSYMS;

LINE:
while (<INCOMPOSE>)
{
	$line = $_;
	$firstletter = substr($line, 0, 1);
	if ( $firstletter eq "#" || $firstletter eq "\n" )
	{
		next LINE;
	}

	@components = split(/\s+/, $line);
	die "Internal error, no components, \$_: $_, \@components: @components\n" unless @components;
	$semicolon = 0;
	for ($i = 0; $i < @components; $i++ )
	{
		if ( $components[$i] eq ":" )
		{
			$semicolon = $i;
			last;
		}
	}	
	die "Internal error, no colon, \$_: $_\n" unless $semicolon;

	@entry = ();
	for ( $i = 0; $i < $semicolon; $i++ )
	{
		$_ = $components[$i];
		if ( /^\</ )
		{
			$_ =~ s/^\<(\w*)\>/GDK_$1/g;
			push @entry, $_;
		} 
	}

	for ( $i = $semicolon; $i < 5; $i++ )
	{		
		push @entry, "0";
	}

	$letter = $components[$semicolon + 1];	
	$letter =~ s/\"//g;
	$codepoint = sprintf("%04X", ord($letter));
	$codepointhex = sprintf("0x%04X", ord($letter));
	push @entry, $codepointhex;
	push @entry, $unicodedata{$codepoint};

	$packedline = pack("A100 A100 A100 A100 A100 A50 A150", @entry);
	push @gtkimcontext, $packedline;
	# Example: { GDK_dead_acute, GDK_dead_diaeresis, GDK_Greek_upsilon, 0, 0, 0x03B0, GREEK_SMALL_LETTER_UPSILON_WITH_DIALYTIKA_AND_TONOS }
}

close INCOMPOSE;

while (<INGTKIMCONTEXTSIMPLE>)
{
	@existingelements = split(/\s+/);
	die "Internal error, no existingelements, \$_: $_, \@existingelements: @existingelements\n" unless @existingelements;

	@existingelements[6] = $unicodedata{ substr($existingelements[5],2) };
	$packedline = pack("A100 A100 A100 A100 A100 A50 A150", @existingelements);
	push @existingseqs, $packedline;
	# Example: { GDK_Multi_key, GDK_cedilla, GDK_s, 0, 0, 0x015F, LATIN_SMALL_LETTER_S_WITH_CEDILLA }
}

close INGTKIMCONTEXTSIMPLE;

sub gtkentrycmp
{
  my @a = unpack("A100 A100 A100 A100 A100 A50 A150", shift);
  my @b = unpack("A100 A100 A100 A100 A100 A50 A150", shift);
  my $verbose = shift;

  for ( $i = 0; $i < 5; $i++ )
  {
    if ( $gdksyms{$a[$i]} <=> $gdksyms{$b[$i]} )
    {
      return $gdksyms{$a[$i]} <=> $gdksyms{$b[$i]};
    }
  }
  
  if ( $a[5] ne $b[5] )
  { 
    if ( $verbose eq "yes" )
    {
      print STDERR "WARNING: Same keysyms for\n1: $a[6] and \n2: $b[6]\n($a[0], $a[1], $a[2], $a[3], $a[4])\n"; 
    }
    return 0;
  }

  return 0;
}

sub gtkentrycmpall
{
  my @a = unpack("A100 A100 A100 A100 A100 A50 A150", shift);
  my @b = unpack("A100 A100 A100 A100 A100 A50 A150", shift);
  my $verbose = shift;

  for ( $i = 0; $i < 5; $i++ )
  {
    if ( $gdksyms{$a[$i]} <=> $gdksyms{$b[$i]} )
    {
      return $gdksyms{$a[$i]} <=> $gdksyms{$b[$i]};
    }
  }

  return $a[5] cmp $b[5];
}

# Let's concatenate the old list with the new one;
push(@gtkimcontext, @existingseqs);

# Now, let's play. Sorting is ascending.
@gtkimcontextsorted = sort { gtkentrycmpall $a, $b; } @gtkimcontext;

# Ok, also need to uniq this.
$previouselement = "";
foreach $element (@gtkimcontextsorted)
{
	if ( $previouselement eq "" ) 
	{ 
		push @gtkimcontextsorteduniqued, $element;
		$previouselement = $element;
		next; 
	}

	if ( gtkentrycmpall($element, $previouselement) )
	{
	  push @gtkimcontextsorteduniqued, $element;
	}
	else 
	{ 
	  printgtkentrymultiples($element);
	}

	$previouselement = $element;
}

# Now we print same sequences that produce different characters.
$previouselement = "";
foreach $element (@gtkimcontextsorteduniqued)
{
	# Just starting?
	if ( $previouselement eq "" ) 
 	{ 
 		$previouselement = $element;
 		next; 
 	}
  
 	if ( gtkentrycmp($element, $previouselement, "yes") == 0)
 	{
 	  printgtkentryconflicts($element); 
 	  printgtkentryconflicts($previouselement); 
 	}
 
 	$previouselement = $element;
}

# Final printing of the structure.
foreach $element (@gtkimcontextsorteduniqued)
{
	@c = unpack("A100 A100 A100 A100 A100 A50 A150", $element);	
       print OUTGTKIMCONTEXT "  $c[0],\t$c[1],\t$c[2],\t$c[3],\t$c[4],\t$c[5], /* $c[6] */\n";
}

close OUTGTKIMCONTEXT;
close OUTMULTIPLES;
close OUTCONFLICTS;

print "\nThe above messages are for debuging purposes\n";

print "\nWe generated three files\n";
print " - gtkimcontext.result, the combined with all keysyms file which is to be placed in gtk+2.[78].x/gtk/gtkimcontextsimple.c in the struct \"static const guint16 gtk_compose_seqs[] = {\", provided it has been cleaned by the two following files,\n";  
print " - multiples.result, in the case of Greek, the Compose file has sequences that produce different Unicode characters (modern and ancient Greek). Per Unicode standard, most of these are equivalent characters. Secondly, we are working on revumping the Ancient Greek support so this does not appear anymore. In any case, we favour Modern Greek in those limited multiples cases.\n";  
print " - conflicts.result, these are conflicts (same sequence producing different Unicode characters) between Greek (or the keysyms we are adding) and the existing keysyms. We favour the existing keysyms.\n";
print "\nTherefore, you are required to use multiples.result and conflicts.result, along with clever use of diff (or comm) on gtkimcontext.result to produce a final patch.\n";
print "See http://bugzilla.gnome.org/show_bug.cgi?id=167940 for those files, plus final patch.\n";
