#============================================================
# MyTkApplication
#============================================================
package MyTkApplication;
use MyApplication;
use MyTk::TkCommon;
@ISA = qw(MyApplication TkCommon);

use strict;
use Config;
use English;

#============================================================
#　変数等取得、再定義関数
#============================================================
sub mw            { return shift->{MainWindow}; }
sub MainWindow    { return shift->{MainWindow}; }
sub SetMainWindow { my($this,$mw)=@_; return shift->{MainWindow} = $mw; }

#============================================================
#　コンストラクタ、デストラクタ
#============================================================
sub new
{
	my ($module) = @_;
	my $this = {};
	bless $this;
#	$this->SUPER::new(@_);
	$this->{'IniFileVariables'} = {};
	$this->{'IniFileDefaultVariables'} = {};
	return $this;
}

sub DESTROY
{
	my $this = shift;
#	$this->mw()->DESTROY();
	$this->SUPER::DESTROY(@_);
}

sub MainLoop
{
	my ($this) = @_;
	Tk::MainLoop();
}

#============================================================
#　継承クラスで定義しなおす関数
#============================================================

#============================================================
#　一般関数
#============================================================
sub CreateWindow
{
	my ($this, $MainWindow, $icon) = @_;
	$icon = 'widget' unless($icon);
	$this->SetMainWindow($MainWindow);
	$MainWindow->SetApplication($this);
	$MainWindow->SetIcon($icon);

	$MainWindow->packPropagate(0);
	$MainWindow->CreateMenu();
	$MainWindow->CreateWidgets();
	$MainWindow->ModifyMenu();
	$MainWindow->packPropagate(1);

	return $MainWindow;
}

sub FreeWin32Console
{
	my ($this) = @_;
require Win32::Console;
	Win32::Console::Free();
#	Win32::Console::Close();
}

sub ShowInfoDialog {
	my ($this, $parent) = @_;

	my $dialog = $parent->DialogBox(
		-title		  => 'System Information',
		-default_button => 'OK',
		-buttons		=> ['OK'],
	);
	my $Text = $dialog->add('Scrolled',
			'MyText',
			-scrollbars => 'osoe',
			-relief => 'sunken',
#			-width  => $width,
#			-height => $height,
			);
	$Text->pack(-expand => 'yes', -fill => 'both');
	$Text->tagConfigure('normal', 
		-font => "{Courier New} 10");
	$Text->tagConfigure('bold', 
		-font => "{Courier New} 10 {bold}");

	my $IniFile = $this->IniFile();
	my $LF = $this->{'LF'};
	$LF =~ s/\n/\\n/g; $LF =~ s/\r/\\r/g; $LF =~ s/\t/\\t/g;
	my $StartTime = Utils::BuildDateString($this->{'StartTime'});
	my $uname = `uname -s`;

	$Text->insert('end', "Operating system:\n", 'bold');
	$Text->insert('end', "  Name              : ", 'bold');
		$Text->insert('end', "$this->{'OS'}\n", "normal");
	$Text->insert('end', "  Type              : ", 'bold'); 
		$Text->insert('end', "$IniFile->{'OSType'}\n", "normal");
	if($uname) {
		$Text->insert('end', "  uname             : ", 'bold');
			$Text->insert('end', "$uname\n", "normal");
	}
	if($IniFile->{'WinDir'}) {
		$Text->insert('end', "  WinDir            : ", 'bold'); 
			$Text->insert('end', "$IniFile->{'WinDir'}\n", "normal");
	}
	$Text->insert('end', "  Shell             : ", 'bold'); 
		$Text->insert('end', "$IniFile->{'ComSpec'}\n", "normal");
	if($IniFile->{'LANG'}) {
		$Text->insert('end', "  Lang              : ", 'bold'); 
			$Text->insert('end', "$IniFile->{'LANG'}\n", "normal")
	}
	$Text->insert('end', "  LF                : ", 'bold'); 
		$Text->insert('end', "$LF\n", "normal");
	$Text->insert('end', "  DirSeparator      : ", 'bold'); 
		$Text->insert('end', "$this->{'DirectorySeparator'}\n", "normal");
	if($IniFile->{'TempDir'}) {
		$Text->insert('end', "  TempDir           : ", 'bold');
			$IniFile->{'TempDir'} = '' unless(defined $IniFile->{'TempDir'});
			$Text->insert('end', "$IniFile->{'TempDir'}\n", "normal");
	}
	$Text->insert('end', "Machine:\n", 'bold');
	$Text->insert('end', "  HostName          : ", 'bold'); 
		$Text->insert('end', "$IniFile->{'HostName'}\n", "normal");
	$Text->insert('end', "  MachineType       : ", 'bold'); 
		$Text->insert('end', "$IniFile->{'MachineType'}\n", "normal");
	if($IniFile->{'CPU'}) {
		$Text->insert('end', "  CPU               : ", 'bold'); 
			$Text->insert('end', "$IniFile->{'CPU'}\n", "normal");
	}
	$Text->insert('end', "  Vendor            : ", 'bold'); 
		$IniFile->{'Vendor'} = '' unless(defined $IniFile->{'Vendor'});
		$Text->insert('end', "$IniFile->{'Vendor'}\n", "normal");
	$Text->insert('end', "Program:\n", 'bold');
	$Text->insert('end', "  ProgramDir        : ", 'bold'); 
		$Text->insert('end', "$IniFile->{'MyDir'}\n", "normal");
	$Text->insert('end', "  Program           : ", 'bold'); 
		$Text->insert('end', "$this->{'Program'}\n", "normal");
	$Text->insert('end', "  ProgramPath       : ", 'bold'); 
		$Text->insert('end', "$this->{'ProgramPath'}\n", "normal");
	$Text->insert('end', "  Version           : ", 'bold'); 
		$Text->insert('end', "$this->{'Version'}\n", "normal");
	$Text->insert('end', "  IniFile           : ", 'bold'); 
		$Text->insert('end', "$IniFile->{'IniFile'}\n", "normal");
	$Text->insert('end', "  StartTime         : ", 'bold'); 
		$Text->insert('end', "$StartTime\n", "normal");
	$Text->insert('end', "Process:\n", 'bold');
	$Text->insert('end', "  Process ID        : ", 'bold'); 
		$Text->insert('end', "$PROCESS_ID\n", "normal");
	$Text->insert('end', "  Real User ID      : ", 'bold'); 
		$Text->insert('end', "$REAL_USER_ID\n", "normal");
	$Text->insert('end', "  Effective User ID : ", 'bold'); 
		$Text->insert('end', "$EFFECTIVE_USER_ID\n", "normal");
	$Text->insert('end', "  Real Group ID     : ", 'bold'); 
		$Text->insert('end', "$REAL_GROUP_ID\n", "normal");
	$Text->insert('end', "  Effective Group ID: ", 'bold'); 
		$Text->insert('end', "$EFFECTIVE_GROUP_ID\n", "normal");
	$Text->insert('end', "Character code:\n", 'bold');
	$Text->insert('end', "  OSCharCode        : ", 'bold'); 
		$Text->insert('end', "$this->{'OSCharCode'}\n", "normal");
	$Text->insert('end', "  FileSystemCharCode: ", 'bold'); 
		$Text->insert('end', "$this->{'FileSystemCharCode'}\n", "normal");
	$Text->insert('end', "  PerlCharCode      : ", 'bold'); 
		$Text->insert('end', "$this->{'PerlCharCode'}\n", "normal");
	$Text->insert('end', "  WebCharCode       : ", 'bold'); 
		$Text->insert('end', "$this->{'WebCharCode'}\n", "normal");
	$Text->insert('end', "  WebCharSet        : ", 'bold'); 
		$Text->insert('end', "$this->{'WebCharSet'}\n", "normal");
	$Text->insert('end', "  MySQLCharCode     : ", 'bold'); 
		$Text->insert('end', "$this->{'MySQLCharCode'}\n", "normal");
	$Text->insert('end', "Perl:\n", 'bold');
	$Text->insert('end', "  Perl version      : ", 'bold'); 
		$Text->insert('end', $] . "\n", "normal");
	$Text->insert('end', "  Perl/Tk version   : ", 'bold'); 
		$Text->insert('end', $Tk::VERSION . "\n", "normal");
	$Text->insert('end', "  Tk patchLevel     : ", 'bold'); 
		$Text->insert('end', $Tk::patchLevel . "\n", "normal");
	$Text->insert('end', "  Executable Name   : ", 'bold'); 
		$Text->insert('end', "$EXECUTABLE_NAME\n", "normal");
	$Text->insert('end', "Arguments:\n", 'bold') if(@ARGV > 0);
	for(my $i = 0 ; $i < @ARGV ; $i++) {
		$Text->insert('end', "  Arg$i             : ", 'bold'); 
			$Text->insert('end', "$ARGV[$i]\n", "normal");
	}

	my $mw = $this->MainWindow();
	my $server   = $mw->server;
	my $display  = $mw->screen;
	my $id       = $mw->id;
	my $g        = $mw->geometry;
	my $gm       = $mw->manager;
	my $name     = $mw->name;
	my $class    = $mw->class;
	my $pathname = $mw->pathname($id);
	my $rootX    = $mw->rootx;
	my $rootY    = $mw->rooty;
	my $w        = $mw->width;
	my $h        = $mw->height;
	my $reqw     = $mw->reqwidth;
	my $reqh     = $mw->reqheight;
	my $depth    = $mw->depth;
	my $sdepth   = $mw->screendepth;

	$Text->insert('end', "MainWindow:\n", 'bold');
	$Text->insert('end', "  Server            : ", 'bold'); 
		$Text->insert('end', "$server\n", "normal");
	$Text->insert('end', "  Display           : ", 'bold'); 
		$Text->insert('end', "$display\n", "normal");
	$Text->insert('end', "  ID                : ", 'bold'); 
		$Text->insert('end', "$id\n", "normal");
	$Text->insert('end', "  Geometry          : ", 'bold'); 
		$Text->insert('end', "$g\n", "normal");
	$Text->insert('end', "  GeometryManger    : ", 'bold'); 
		$Text->insert('end', "$gm\n", "normal");
	$Text->insert('end', "  Name              : ", 'bold'); 
		$Text->insert('end', "$name\n", "normal");
	$Text->insert('end', "  Widget Class      : ", 'bold'); 
		$Text->insert('end', "$class\n", "normal");
	$Text->insert('end', "  Pathname          : ", 'bold'); 
		$Text->insert('end', "$pathname\n", "normal");
	$Text->insert('end', "  RootX,Y           : ", 'bold'); 
		$Text->insert('end', "$rootX,$rootY\n", "normal");
	$Text->insert('end', "  width,height      : ", 'bold'); 
		$Text->insert('end', "$w,$h\n", "normal");
	$Text->insert('end', "  Req. width,height : ", 'bold'); 
		$Text->insert('end', "$reqw,$reqh\n", "normal");
	$Text->insert('end', "  Color depth       : ", 'bold'); 
		$Text->insert('end', "$depth bits\n", "normal");
	$Text->insert('end', "  Screen depth      : ", 'bold'); 
		$Text->insert('end', "$sdepth bits\n", "normal");

	$Text->insert('end', "Config perl module:\n", 'bold');
	foreach my $key (keys %Config) {
		next unless($Config{$key});
		$Text->insert('end', "  $key: ", 'bold'); 
			$Text->insert('end', "$Config{$key}\n", "normal");
	}

	my $button = $dialog->Show;
}

1;