#!/usr/bin/perl -w

###############################################################################
## Converts all SciTE property files in the current folder to PN2 schemes.
## Output will be place at "./pn2_schemes". License is GPL. // 2006-02-03
## 
## Written by Sebastian Pipping <webmaster@hartwork.org>
###############################################################################

use strict;
use Switch;


# Config
use constant DIR_IN           => "./";
use constant DIR_OUT          => "./pn2_schemes/";
use constant ENABLE_WARNINGS  => 0;
use constant ENABLE_NOTES     => 1;


# Internal
use constant MODE_DEFAULT   => 1;
use constant MODE_KEYWORDS  => 2;


sub WARNING
{
	if( !ENABLE_WARNINGS )
	{
		return;
	}
	my $text = shift( @_ );
	print "WARNING: " . $text . "\n";
}

sub ERROR
{
	my $text = shift( @_ );
	print "ERROR: " . $text . "\n";
}

sub NOTE
{
	if( !ENABLE_NOTES )
	{
		return;
	}
	my $text = shift( @_ );
	print "NOTE: " . $text . "\n";
}


# Create output dir
mkdir( DIR_OUT, 0777 );

# Open input dir
if( !opendir( DIR, DIR_IN ) )
{
	ERROR( "Directory access failed" );
	exit;
}
my @files_to_process = readdir( DIR );
closedir( DIR );


foreach( @files_to_process )
{
	if( $_ =~ /^\.+$/ )
	{
		next;	
	}
	elsif( $_ !~ /^.+properties$/ )
	{
		next;
	}
	my $fin = DIR_IN . $_;

	print "Converting [" . $fin . "]...\n";
	

	# Scheme accumulator (xml)
	my $SCH = "";


	# Read input file
	my $content = "";
	if( !open( FIN, "<" . $fin ) )
	{
		ERROR( "File could not be opened" );
		next;
	}
	read( FIN, $content, ( stat( $fin ) )[ 7 ] );
	close( FIN );
	my @lines = split( /[\015\012]+/, $content );


	my $prop_lang = "";
	my $prop_lexer = "";
	my @prop_keyword_group_names = ();
	my @prop_keyword_class_names = ();
	
	my $styles_before_default = "";
	my $bool_default_style_found = 0;

	my @last_keyword_group = ();
	my $last_keyword_group_name = "";
	my $last_comm_line = "";
	my $bool_first_style = 1;
	my $bool_first_keyword_group = 1;

	my $cur_mode = MODE_DEFAULT;
	foreach( @lines )
	{
		switch( $cur_mode )
		{
		case MODE_DEFAULT
			{
				# Keyword start line
				if( $_ =~ /^[ \t]*keyword[^.]*\.[^=]+=(.*)$/ )
				{
					my $word_string = $1;
					
					# Reset keyword list
					@last_keyword_group = ();

					$last_keyword_group_name = $last_comm_line;

					if( $bool_first_keyword_group )
					{
						$SCH .= "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
						$SCH .= "<Scheme>\n";
						$SCH .= "\t<keyword-classes>\n";
						
						$bool_first_keyword_group = 0;
					}

					if( $word_string eq "" )
					{
						# No keywords at all
					}
					elsif( $word_string =~ /^([^\\]*)\\[ \t]*$/ )
					{
						# Not last keyword line
						$word_string = $1;
						
						# Append keywords
						push( @last_keyword_group, split( /[ \t]+/, $word_string ) );

						$cur_mode = MODE_KEYWORDS;
					}
					else
					{
						# Last keyword line

						# Append keywords
						push( @last_keyword_group, split( /[ \t]+/, $word_string ) );
						
						# Last line with keywords
						my $valid_classname = $last_keyword_group_name;
						$valid_classname =~ s/(.)/\l$1/g;   # Lowercase
						$valid_classname =~ s/[. \t-]/_/g;  # Underlines

						$SCH .= "\t\t<keyword-class name=\"" . $valid_classname . "\">\n";
						foreach( @last_keyword_group )
						{
							$SCH .= "\t\t\t" . $_ . "\n";
						}
						$SCH .= "\t\t</keyword-class>\n";

						push( @prop_keyword_group_names, $last_keyword_group_name );
						push( @prop_keyword_class_names, $valid_classname );

						my $arrlen = @last_keyword_group;
						my $arrpos = @prop_keyword_group_names; $arrpos--;
						print "  Keygroup " . $arrpos . " \"" . $last_keyword_group_name . "\" (" . $arrlen . " keywords)\n";
					}
				}

				# Language name
				elsif( $_ =~ /^[ \t]*filter\.[^.]+[ \t]*=([^|]+)\|.+$/ )
				{
					$prop_lang = $1;
					print "  Language = \"" . $prop_lang . "\"\n";
				}

				# Comment line
				elsif( $_ =~ /^[ \t]*#[ \t]*(.+)$/ )
				{
					$last_comm_line = $1;
				}

				# Lexer name
				elsif( $_ =~ /^[ \t]*lexer[^=]+=(.+)$/ )
				{
					$prop_lexer = $1;
					print "  Lexer name = \"" . $prop_lexer . "\"\n";
				}

				# Style line
				if( $_ =~ /^style\.[^.]+\.([0-9]+)=(.*)$/ )
				{
					my $style_id             = $1;
					my $style_name           = $last_comm_line;
					my $style_attrib_string  = $2;
					print "  Style " . $style_id . " \"" . $style_name . "\" --> " . $style_attrib_string . "\n";

					if( $bool_first_style )
					{
						$SCH .= "\t</keyword-classes>\n";
						$SCH .= "\t<language name=\"" . $prop_lexer . "\" title=\"" . $prop_lang . "\" folding=\"true\" foldcomments=\"true\" foldcompact=\"true\" foldpreproc=\"true\">\n";
						$SCH .= "\t\t<lexer name=\"" . $prop_lexer . "\"/>\n";
						$SCH .= "\t\t<use-keywords>\n";
						my $arrlen = @prop_keyword_group_names;
						for( my $i = 0; $i < $arrlen; $i++ )
						{
							$SCH .= "\t\t\t<keyword key=\"" . $i . "\" name=\"" . $prop_keyword_group_names[ $i ] . "\" class=\"" . $prop_keyword_class_names[ $i ]. "\"/>\n";
						}
						$SCH .= "\t\t</use-keywords>\n";
						$SCH .= "\t\t<use-styles>\n";

						$bool_first_style = 0;
					}
					
					# TODO We could guess some classes for 'class=""' from the style name
					
					my $style_accum .= "\t\t\t<style name=\"" . $style_name . "\" key=\"" . $style_id . "\"";
					my @style_attribs = split( /,[ \t]*/, $style_attrib_string );
					foreach( @style_attribs )
					{
						if( $_ =~ /^(back|fore):(.+)$/ )
						{
							my $target  = $1;
							my $value   = $2;

							my $colour  = "";
							if( $value =~ /^#([0-9A-F-a-f]{6})$/ )
							{
								$colour = $1;
							}
							elsif( $value =~ /^\$\((colour.[^)]+)\)$/ )
							{
								WARNING( "Unsupported colour \"" . $1 . "\"" );
								next;
								# $colour = $1;
							}
							else
							{
								WARNING( "Strange colour" );
								next;	
							}
							
							if( $target eq "back" )
							{
								$style_accum .= " back=\"" . $colour . "\"";
							}
							else
							{
								$style_accum .= " fore=\"" . $colour . "\"";
							}
						}
						elsif( $_ eq "bold" )
						{
							$style_accum .= " bold=\"true\"";
						}
						elsif( $_ eq "italics" )
						{
							$style_accum .= " italic=\"true\"";
						}
						elsif( $_ eq "eolfilled" )
						{
							$style_accum .= " eolfilled=\"true\"";
						}
						elsif( $_ =~ /\$\(((font|colour).[^)]+)\)$/ )
						{
							WARNING( "Unsupported font style \"" . $1 . "\"" );
							next;
							# $style_accum .= " font=\"" . $1 . "\"";
						}
						else
						{
							ERROR( "Unexpected style attribute \"" . $_ . "\"" );
							next;
						}
					}

					$style_accum .= "/>\n";
					
					if( $style_name =~ /^Default/i )
					{
						$SCH .= $style_accum;
						if( $styles_before_default ne "" )
						{
							NOTE( "Default style moved to beginning" );
							$SCH .= $styles_before_default;
							$styles_before_default = "";
						}
						$bool_default_style_found = 1;
					}
					else
					{
						if( $bool_default_style_found )
						{
							# Append right now
							$SCH .= $style_accum;
						}
						else
						{
							# Save for later
							$styles_before_default .= $style_accum;
						}
					}
					
					
					$cur_mode = MODE_DEFAULT;
				}
				
				# Blank line
				elsif( $_ =~ /^[ \t]+$/ )
				{
					;
				}
				
				# ???
				else
				{
					# print "  >" . $_ . "\n";
				}
			}
			
		case MODE_KEYWORDS
			{
				if( $_ =~ /^[ \t]*([^\\]+)\\?[ \t]*$/ )
				{
					my $word_string   = $1;
					
					# Append keywords
					push( @last_keyword_group, split( /[ \t]+/, $word_string ) );
					
					if( $_ !~ /^.+\\[ \t]*$/ )
					{
						# Last line with keywords
						my $valid_classname = $last_keyword_group_name;
						$valid_classname =~ s/(.)/\l$1/g;   # Lowercase
						$valid_classname =~ s/[. \t-]/_/g;  # Underlines

						$SCH .= "\t\t<keyword-class name=\"" . $valid_classname . "\">\n";
						foreach( @last_keyword_group )
						{
							$SCH .= "\t\t\t" . $_ . "\n";
						}
						$SCH .= "\t\t</keyword-class>\n";

						push( @prop_keyword_group_names, $last_keyword_group_name );
						push( @prop_keyword_class_names, $valid_classname );

						my $arrlen = @last_keyword_group;
						my $arrpos = @prop_keyword_group_names; $arrpos--;
						print "  Keygroup " . $arrpos . " \"" . $last_keyword_group_name . "\" (" . $arrlen . " keywords)\n";
						
						$cur_mode = MODE_DEFAULT;
					}
				}
				
				else
				{
					$cur_mode = MODE_DEFAULT;
				}
			}

		}
	}

	$SCH .= "\t\t</use-styles>\n";
	$SCH .= "\t</language>\n";
	$SCH .= "</Scheme>\n";

	my $fout = DIR_OUT . $prop_lexer . ".scheme";
	open( FOUT, ">" . $fout );
	print FOUT $SCH;
	close( FOUT );
	
	print "\n";
}

print "Done.";