#!/usr/bin/env perl
#
# Updates http://cvs.gnome.org/viewcvs/gtk%2B/gtk/gtkimcontextsimple.c from upstream (X.org 6.9/7.0),
# from http://cvs.freedesktop.org/xorg/xc/nls/Compose/en_US.UTF-8
#
# Name    : gtkimcontextsimple-update
# Author  : Simos Xenitellis <simos at gnome dot org>.
# Version : 1.0
#
# Input   : http://cvs.freedesktop.org/xorg/xc/nls/Compose/en_US.UTF-8
# Output  : http://cvs.gnome.org/viewcvs/gtk%2B/gtk/gtkimcontextsimple.c
#
# Notes   : It downloads en_US.UTF-8 from the Internet if not found locally
# Notes   : and creates an updated gtkimcontextsimple.c
#

use strict;

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

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

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

if ( ! -f "en_US.UTF-8" )
{
        print "Trying to download en_US.UTF-8 from\n";
        print "http://cvs.freedesktop.org/xorg/xc/nls/Compose/en_US.UTF-8: ";
        die "Unable to download en_US.UTF-8 from http://cvs.freedesktop.org/xorg/xc/nls/Compose/en_US.UTF-8\n"
                unless system("wget -q \"http://cvs.freedesktop.org/*checkout*/xorg/xc/nls/Compose/en_US.UTF-8\"") == 0;
        print " done.\n\n";
}
else
{
        print "We are using an existing en_US.UTF-8 (Compose) file found in this directory.\n";
        print "It is assumed that you took care and it is a recent version\n";
        print "as found at http://cvs.freedesktop.org/xorg/xc/nls/Compose/en_US.UTF-8\n\n";
}


# Source: http://cvs.freedesktop.org/xorg/xc/nls/Compose/en_US.UTF-8?view=markup
# or /usr/share/X11/locale/en_US.UTF-8/Compose
# The file can be used verbatim. Comments start with "^XCOMM".
die "Could not open en_US.UTF-8: $!\n" unless open(IN_COMPOSE, "<:utf8", "en_US.UTF-8");

if ( ! -f "gdkkeysyms.h" )
{
        print "It appears you do not have a gdkkeysyms.h file in this directory.\n";
        print "This script requires an updated gdkkeysyms.h in order to run.\n";
        die "See http://bugzilla.gnome.org/show_bug.cgi?id=321896 on how to create it.\n"
}


# Source: gtk+/gdk/gdkkeysyms.h
# or /usr/include/gtk-2.0/gdk/gdkkeysyms.h
die "Could not open file gdkkeysyms.h: $!\n" unless open(IN_GDKKEYSYMS, "<:utf8", "gdkkeysyms.h");

if ( ! -f "UnicodeData.txt" )
{
        print "Trying to download UnicodeData.txt from\n";
        print "http://www.unicode.org/Public/UNIDATA/UnicodeData.txt: ";
        die "Unable to download UnicodeData.txt from http://www.unicode.org/Public/UNIDATA/UnicodeData.txt\n"
                unless system("wget -q \"http://www.unicode.org/Public/UNIDATA/UnicodeData.txt\"") == 0;
        print " done.\n\n";
}
else
{
        print "We are using an existing UnicodeData.txt file found in this directory.\n";
        print "It is assumed that you took care and it is a recent version\n";
        print "as found at http://www.unicode.org/Public/UNIDATA/UnicodeData.txt\n\n";
}


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

if ( ! -f "gtkimcontextsimple.c" )
{
        print "It appears you do not have an existing gtkimcontextsimple.c in this directory.\n";
        print "This script requires the gtkimcontextsimple.c that you want to patch.\n";
        print "You can get it from http://cvs.gnome.org/viewcvs/gtk%2B/gtk/gtkimcontextsimple.c\n";
        die "This script will create gtkimcontextsimple.c.UPDATED, the updated version.\n"
}

# Source: gtk+/gtk/gtkimcontextsimple.c
die "Could not open prearranged file gtkimcontextsimple.c: $!\n" unless open(IN_GTKIMCONTEXTSIMPLE, "<:utf8", "gtkimcontextsimple.c");

# if ( -f "gtkimcontextsimple.c.UPDATED" )
# {
#         print "It appears there is already an gtkimcontextsimple.c.UPDATED file in this directory.\n";
#         print "We are going to create this file with the script. Therefore, we cannot continue,\n";
#         die "unless you move the file somewhere else.\n"
# }

# Output file: gtkimcontextsimple.c.UPDATED
die "Could not open output file gtkimcontextsimple.c.UPDATED: $!\n" unless open(OUT_GTKIMCONTEXTSIMPLE_UPDATED, ">:utf8", "gtkimcontextsimple.c.UPDATED"); 

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

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

keys(%unicodedata) = 20000;
keys(%gdksyms) = 2500;

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

  print OUT_MULTIPLES "  $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 OUT_CONFLICTS "  $a[0],\t$a[1],\t$a[2],\t$a[3],\t$a[4],\t$a[5], /* $a[6] */\n";

  return;
}

while (<IN_UNICODEDATA>)
{
	@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 IN_UNICODEDATA;

print STDERR "Done reading Unicode Data\n";

while (<IN_GDKKEYSYMS>)
{
	last if (/^#define GDK/);
}

while (<IN_GDKKEYSYMS>)
{
	last if ( /^$/ );

	@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 IN_GDKKEYSYMS;

print STDERR "Done reading GDK Key Syms\n";

LINE:
while (<IN_COMPOSE>)
{
	next if ( /^XCOMM/ );

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

	# There is one line in the input file that has no space between >:
	$line =~ s/>:/> :/g;

	# There are some lines where keysyms have no whitespace in between, like <dead_acute><Y>
	$line =~ s/></> </g;

	# Some lines begin with spaces, let's remove them first for the split to work.
	$line =~ s/^\s+//g;	

	@components = split(/\s+/, $line);
	die "Internal error, no components, \$_: $_, \@components: @components\n" unless @components;

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

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

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

	# Some keysyms look like <U11ab>. We have to detect them
	# and convert to hex. Else gtk+ won't compile.
	# I still have to check that things work this way.
	for ( $i = 0; $i < 5; $i++ )
	{
		# If it begins with U (the string has already "GDK_" attached to it),
		if ( index($entry[$i], "GDK_U") == 0 )
		{
			# If it is not just <U>,
			if ( length($entry[$i]) > 5 ) 
			{
				# If it is not something like <Uhorn>,
				if ( hex(substr($entry[$i], 5)) > 0 )
				{
					$entry[$i] = sprintf("0x%04X", hex(substr($entry[$i], 5)));
				}
			}
		}
	}

	# Now it is time to check if the GDK_* keysyms we guessed
	# actually exists in gdkkeysyms.h
	for ( $i = 0; $i < 5; $i++ )
	{
		# If it begins with "GDK_",
		if ( index($entry[$i], "GDK_") == 0 )
		{
			if ( length($gdksyms{$entry[$i]}) == 0 )
			{
				print "Could not find $entry[$i], I just got $gdksyms{$entry[$i]}\n";
				print "A keysym was used in the Compose file but was not found in keysymdef.h\n";
				print "See https://bugs.freedesktop.org/show_bug.cgi?id=5107\n";
				die "Fix this first and try again\n";
			}
			else
			{
#				printf "I got %s = 0x%X\n", $entry[$i], $gdksyms{$entry[$i]};
			}
		}
	}

	$letter = $components[$semicolon_pos + 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;
	# printf "%s %s %s %s %s : %s  %s\n", $entry[0], $entry[1], $entry[2], $entry[3], $entry[4], $codepointhex, $unicodedata{$codepoint};
	# Example: { GDK_dead_acute, GDK_dead_diaeresis, GDK_Greek_upsilon, 0, 0, 0x03B0, GREEK_SMALL_LETTER_UPSILON_WITH_DIALYTIKA_AND_TONOS }
}

close IN_COMPOSE;

print STDERR "Done reading en_US.UTF-8 Compose file\n";

# The Compose files has either keysyms or unicode values. We need to do
# sorting, so this function allows to compare the two on their value.
sub get_symbolunivalue
{
	my $a = pop;
  
	# If it begins with GDK_ (it's a keysym),
	if ( index($a, "GDK_") == 0 )
	{
#		printf "We got a keysym %s: %d\n", $a, $gdksyms{$a};
		return $gdksyms{$a};
	}
	else
	{
		# It's already a Unicode character, send it over.
#		printf "We got a unichar : %d\n", hex($a);
		return hex($a);
	}
}

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 ( get_symbolunivalue($a[$i]) <=> get_symbolunivalue($b[$i]) )
    {
      return get_symbolunivalue($a[$i]) <=> get_symbolunivalue($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 they are different, comparison is over and return.
    if ( get_symbolunivalue($a[$i]) <=> get_symbolunivalue($b[$i]) )
    {
      return get_symbolunivalue($a[$i]) <=> get_symbolunivalue($b[$i]);
    }
  }

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

### gtkimcontextsimple.c has some compose sequences that are specific to Win32
#   and do not exist in the X.org Compose file. This stuff has to be added.
#   This script should it at this point.
#
# 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;
}


while (<IN_GTKIMCONTEXTSIMPLE>)
{
	print OUT_GTKIMCONTEXTSIMPLE_UPDATED $_;
	last if (/^static const guint16 gtk_compose_seqs/);
}

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

while (<IN_GTKIMCONTEXTSIMPLE>)
{
	last if ( /^};$/ );
}

print OUT_GTKIMCONTEXTSIMPLE_UPDATED "};\n";

while (<IN_GTKIMCONTEXTSIMPLE>)
{
	print OUT_GTKIMCONTEXTSIMPLE_UPDATED $_;
}

close IN_GTKIMCONTEXTSIMPLE;

print STDERR "Done writing gtkimcontextsimple.c.UPDATED\n";

close OUT_GTKIMCONTEXTSIMPLE_UPDATED;
close OUT_MULTIPLES;
close OUT_CONFLICTS;

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";
