#!/usr/bin/perl
use strict;
require v5.6.1;
use File::Spec::Functions;
use Tk;
use Tk::Dialog;
use Tk::DialogBox;
use Tk::FileSelect;

my(%conf) = (
	'__Another_HTML_lint__'	=>	'',
	'__JcodeModule__'		=>	'',
	'__HTML_lint_wrapper_path__'	=>	'',
	'__HTML_lint_wrapper__'	=>	'htmllint.pl',
	'__HIDE_path__'			=>	'',
	'__HIDE_macro__'		=>	'htmllint.mac',
	'__Shift_JIS_Convert__'	=>	q{&jcode::convert(*log, 'sjis')},
);


my $top = new MainWindow(-title => 'Setup');

my $label = 'Setup Another HTML-lint launch macro from Hidemru';

	$top->Label(
		-textvariable => \$label
	)->pack(
	);

	$top->Button(
		-text	=> 'Create Another HTML-lint perl wrapper',
		-state	=> 'active',
		-command => [\&CreatePerlWrapper],
	 )->pack(
	 	-fill	=> 'both',
		-padx	=> 2,
		-pady	=> 2,
	 );

	$top->Button(
		-text	=> 'Create Hidemaru macro',
		-state	=> 'normal',
		-command => [\&CreateHideMac],
	 )->pack(
	 	-fill	=> 'both',
		-padx	=> 2,
		-pady	=> 2,
	 );
	$top->Button(
		-text	=> 'Exit',
		-state	=> 'normal',
		-command => [sub {exit(0);}],
	 )->pack(
		-ipadx	=> 30,
	 );


MainLoop;
exit(0);
#////////////////////////////////////
sub	CreateHideMac
{
my $macroname = $conf{'__HIDE_macro__'};
my $macropath = $conf{'__HIDE_path__'};

	if( $conf{'__HTML_lint_wrapper_path__'} eq '' || ! -d $conf{'__HTML_lint_wrapper_path__'} )
	{
		$top->Dialog(
			-title	=> 'Warning',
			-text	=> 'Must be create HTML-lint perl wrapper before this.',
		)->Show;
		return;
	}

my $dialog = $top->DialogBox(
		-title			=> 'Create hidemaru macro',
		-buttons		=> ['OK', 'Cancel'],
		-default_button	=> 'OK',
	);

	$dialog->add(
		'Label',
		-text	=> 'fill following form'
	)->grid(
		-column	=> 0,
		-row	=> 0,
		-columnspan => 3,
#		-sticky => 'nsew',
	);

	{# specify macroname
		my $row = 1;
		$dialog->add(
			'Label',
			-text	=> 'Macro name:'
		)->grid(
			-column	=> 0,
			-row	=> $row,
#			-sticky => 'nsew',
		);

		$dialog->add(
			'Entry',
			-textvariable => \$macroname,
		)->grid(
			-column	=> 1,
			-columnspan => 2,
			-row	=> $row,
#			-sticky => 'nsew',
		);
	}

	{# set hidemaru path
		my $row = 2;
		$dialog->add(
			'Label',
			-text	=> 'Create macro to:'
		)->grid(
			-column	=> 0,
			-row	=> $row,
#			-sticky => 'nsew',
		);

		$dialog->add(
			'Entry',
			-textvariable => \$macropath,
		)->grid(
			-column	=> 1,
			-row	=> $row,
#			-sticky => 'nsew',
		);

		$dialog->add(
			'Button',
			-text	=> 'refer',
			-command => [
				sub{
					my $rh_fs = $dialog->FileSelect();
					$rh_fs->configure(-verify => ['-d'],);
					$macropath = $rh_fs->Show;
				}
			],
		)->grid(
			-column => 2,
			-row	=> $row,
			-padx	=> 2,
			-pady	=> 2,
#			-sticky => 'nsew',
		);
	}

	return unless $dialog->Show eq 'OK';

	$conf{'__HIDE_macro__'} = $macroname;
	$conf{'__HIDE_path__'} = $macropath;


my $perlpath = catfile($conf{'__HTML_lint_wrapper_path__'}, $conf{'__HTML_lint_wrapper__'});
	$perlpath =~ s!\\!/!g;

my $hidemac =<< "__HIDE_MACRO__";
runsync2 "perl $perlpath " + filename;
newfile
paste
__HIDE_MACRO__

my $macfile = catfile($macropath, $macroname);
my $fh;
	unless( open($fh, ">$macfile") )
	{
		$dialog->Dialog(
			-title	=> 'Error',
			-text	=> "Can NOT create $macfile:\n $!",
		)->Show;
		return;
	}
	print $fh $hidemac;
	close $fh;
#warn $macfile;
#warn $hidemac;

	$dialog->Dialog(
		-title	=> 'Info',
		-text	=> "Complete to create $macfile",
	)->Show;
}
#////////////////////////////////////
sub	CreatePerlWrapper
{
my $row = 0;
my $wrappername = $conf{'__HTML_lint_wrapper__'};
my $wrapperpath = $conf{'__HTML_lint_wrapper_path__'};
my $anotherpath = $conf{'__Another_HTML_lint__'};
my $jcodepath = $conf{'__JcodeModule__'};
my $sjisconv = '';

my $dialog = $top->DialogBox(
		-title			=> 'Create Another HTML-lint wrapper',
		-buttons		=> ['OK', 'Cancel'],
		-default_button	=> 'OK',
	);

	$dialog->add(
		'Label',
		-text	=> 'fill following form'
	)->grid(
		-column	=> 0,
		-row	=> $row,
		-columnspan => 3,
#		-sticky => 'nsew',
	);

	++$row;
	{# set Another HTML-lint path
		$dialog->add(
			'Label',
			-text => 'Another HTML-lint path:'
		)->grid(
			-column	=> 0,
			-row	=> $row,
#			-sticky => 'nsew',
		);

		$dialog->add(
			'Entry',
			-textvariable => \$anotherpath,
		)->grid(
			-column	=> 1,
			-row	=> $row,
#			-sticky => 'nsew',
		);

		$dialog->add(
			'Button',
			-text	=> 'refer',
			-command => [
				sub{
					my $rh_fs = $dialog->FileSelect();
					$rh_fs->configure(-verify => ['-d'],);
					$anotherpath = $rh_fs->Show;
				}
			],
		)->grid(
			-column	=> 2,
			-row	=> $row,
			-padx	=> 2,
			-pady	=> 2,
#			-sticky => 'nsew',
		);
	}

	++$row;
	{# specify wrapper name
		$dialog->add(
			'Label',
			-text	=> 'wrapper name:'
		)->grid(
			-column	=> 0,
			-row	=> $row,
			-sticky	=> 'nsew',
		);

		$dialog->add(
			'Entry',
			-textvariable => \$wrappername,
		)->grid(
			-column => 1,
			-columnspan => 1,
			-row	=> $row,
			-padx	=> 2,
			-pady	=> 2,
#			-fill	=> 'both',
#			-sticky => 'nsew',
		);
	}

	++$row;
	{# set warpper path
		$dialog->add(
			'Label',
			-text	=> 'Create wrapper to:'
		)->grid(
			-column	=> 0,
			-row	=> $row,
#			-sticky	=> 'nsew',
		);

		$dialog->add(
			'Entry',
			-textvariable => \$wrapperpath,
		)->grid(
			-column	=> 1,
			-row	=> $row,
#			-sticky	=> 'nsew',
		);

		$dialog->add(
			'Button',
			-text	=> 'refer',
			-command => [
				sub{
					my $rh_fs = $dialog->FileSelect();
					$rh_fs->configure(-verify => ['-d'],);
					$wrapperpath = $rh_fs->Show;
				}
			],
		)->grid(
			-column	=> 2,
			-row	=> $row,
			-padx	=> 2,
			-pady	=> 2,
#			-sticky => 'nsew',
		);
	}

	++$row;
	{# set jcode.pl path
		$dialog->add(
			'Label',
			-text	=> "jcode.pl path:\n[optional]"
		)->grid(
			-column	=> 0,
			-row	=> $row,
#			-sticky	=> 'nsew',
		);

		$dialog->add(
			'Entry',
			-textvariable => \$jcodepath,
		)->grid(
			-column	=> 1,
			-row	=> $row,
#			-sticky	=> 'nsew',
		);

		$dialog->add(
			'Button',
			-text	=> 'refer',
			-command => [
				sub{
					my $rh_fs = $dialog->FileSelect();
					$rh_fs->configure(-verify => ['-d'],);
					$jcodepath = $rh_fs->Show;
				}
			],
		)->grid(
			-column	=> 2,
			-row	=> $row,
			-padx	=> 2,
			-pady	=> 2,
#			-sticky => 'nsew',
		);
	}

	return unless $dialog->Show eq 'OK';

	$conf{'__Another_HTML_lint__'} = $anotherpath;
	$conf{'__HTML_lint_wrapper__'} = $wrappername;
	$conf{'__HTML_lint_wrapper_path__'} = $wrapperpath;
	$conf{'__JcodeModule__'} = $jcodepath;

	$anotherpath = qq{use lib '$anotherpath';} if $anotherpath ne '';

	if( $jcodepath ne '' )
	{
		my  $jcodelib = catfile($jcodepath, 'jcode.pl');
#warn $jcodelib;
		$jcodepath = qq{use lib '$jcodepath';\n} ;
		if( -e $jcodelib )
		{
			$jcodepath .= qq{require 'jcode.pl';};
			$sjisconv = qq{\&jcode::convert(*log, 'sjis');};
		}
		else
		{
			$jcodepath .= qq{require 'Jcode';};
			$sjisconv = qq{\&Jcode::convert(*log, 'sjis');};
		}
	}
	else
	{
		if( eval 'require Jcode' )
		{
			$jcodepath .= qq{require 'Jcode';};
			$sjisconv = qq{\&Jcode::convert(*log, 'sjis');};
		}
		else
		{
			$jcodepath .= qq{require 'jcode.pl';};
			$sjisconv = qq{\&jcode::convert(*log, 'sjis');};
		}
	}
my $perl =<< "__PERL_SCRIPT__";
use strict;
$anotherpath

use Win32::Clipboard;
use File::Temp qw/ tempfile /;
use File::Basename;
$jcodepath


push \@INC => [\&fileparse(\$0)]->[1];

my \$add_options; # = '-noscore -pedantic etc...';

if (\$add_options) {
  require 'shellwords.pl';
  unshift \@ARGV => \&shellwords(\$add_options);
}

require 'htmllint.pm';

my(\$fh, \$filename )= tempfile( DIR => './');
select \$fh;

my \$result = &htmllint::HTMLlint(\@ARGV);

seek \$fh, 0, 0;
our \$log = join('', <\$fh>);
close(\$fh);
unlink \$filename;

$sjisconv;
my \$CLIP = Win32::Clipboard();
\$CLIP->Set(\$log);

exit(\$result);
__PERL_SCRIPT__

	$wrappername = catfile($wrapperpath, $wrappername) if $wrapperpath ne '';

my $fh;
	unless( open($fh, ">$wrappername") )
	{
		$dialog->Dialog(
			-title	=> 'Error',
			-text	=> "Can NOT create $wrappername:\n $!",
		)->Show;
		return;
	}
	print $fh $perl;
	close $fh;
#	warn $wrappername;
#	warn $perl;

	$dialog->Dialog(
		-title	=> 'Info',
		-text	=> "Complete to create $wrappername",
	)->Show;

}
#////////////////////////////////////