The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# -*- perl -*-
BEGIN { $|=1; $^W=1; }
use strict;
use FindBin;
use lib $FindBin::RealBin;

BEGIN {
    if (!eval q{
	use Test::More;
	1;
    }) {
	print "1..0 # skip: no Test::More module\n";
	exit;
    }
}

use TkTest qw(catch_grabs);

plan tests => 13;

if (!defined $ENV{BATCH}) { $ENV{BATCH} = 1 }

use_ok("Tk");
use_ok("Tk::FBox");

my $top = new MainWindow;
eval { $top->geometry('+10+10'); }; # This works for mwm and interactivePlacement

my $f;

my $delay = 500;

######################################################################
# open
eval {
    $f = $top->FBox(-defaultextension => ".PL",
		    -filetypes => [
				   ['Text Files',       ['.txt', '.text']],
				   ['TCL Scripts',      '.tcl'           ],
				   ['C Source Files',   '.c',      'TEXT'],
				   ['GIF Files',        '.gif',          ],
				   ['GIF Files',        '',        'GIFF'],
				   ['All Files',        '*',             ],
				  ],
		    -initialdir => ".",
		    -initialfile => "Makefile.PL",
		    -title => "Load file (with filetypes)",
		    -type => "open",
		    -filter => "*.PL", # ignored
		    -font => "Helvetica 14",
		   );
};
is($@, "", "creating Tk::FBox widget");

catch_grabs {
    $f->after($delay, sub { $f->destroy }) if $ENV{BATCH};
    my $result = $f->Show;
    if (!$ENV{BATCH}) {
	diag "Result is <$result>";
    }
    pass("After showing FBox")
} 1;

######################################################################
# open without filetypes
eval {
    $f = $top->FBox(-defaultextension => ".PL",
		    -initialdir => ".",
		    -initialfile => "Makefile.PL",
		    -title => "Load file (without filetypes, with filter)",
		    -type => "open",
		    -filter => "*.PL",
		    -font => "Helvetica 14",
		   );
};
is($@, "", "creating Tk::FBox widget");

catch_grabs {
    $f->after($delay, sub { $f->destroy }) if $ENV{BATCH};
    my $result = $f->Show;
    if (!$ENV{BATCH}) {
	diag "Result is <$result>";
    }
    pass("After showing FBox")
} 1;

######################################################################
# save
eval {
    $f = $top->FBox(-defaultextension => ".PL",
		    -filetypes => [
				   ['Text Files',       ['.txt', '.text']],
				   ['TCL Scripts',      '.tcl'           ],
				   ['C Source Files',   '.c',      'TEXT'],
				   ['GIF Files',        '.gif',          ],
				   ['GIF Files',        '',        'GIFF'],
				   ['All Files',        '*',             ],
				  ],
		    -initialdir => ".",
		    -initialfile => "Makefile.PL",
		    -title => "Save file",
		    -type => "save",
		    -filter => "*.PL", # ignored
		    -font => "Helvetica 14",
		   );
};
is($@, "", "creating Tk::FBox widget for save");

catch_grabs {
    $f->after($delay, sub { $f->destroy }) if $ENV{BATCH};
    my $result = $f->Show;
    if (!$ENV{BATCH}) {
	diag "Result is <$result>";
    }
    pass("After showing FBox");
} 1;

######################################################################
# dir
eval {
    $f = $top->FBox(-initialdir => ".",
		    -title => "Choose directory",
		    -type => "dir",
		    -font => "Helvetica 14",
		   );
};
is($@, "", "creating Tk::FBox widget for choosing directories");

catch_grabs {
    $f->after($delay, sub { $f->destroy }) if $ENV{BATCH};
    my $result = $f->Show;
    if (!$ENV{BATCH}) {
	diag "Result is <$result>";
    }
    pass("After showing FBox");
} 1;

######################################################################
# getOpenFile etc.
SKIP: {
    skip("getOpenFile etc. only on X11", 3)
	if $Tk::platform ne 'unix';

    {
	my $mw = MainWindow->new;
	$mw->after($delay, sub { $mw->destroy }) if $ENV{BATCH};
	my $result = $mw->getOpenFile;
	if (!$ENV{BATCH}) {
	    diag "Result is <$result>";
	}
	pass("called getOpenFile");
    }

    {
	my $mw = MainWindow->new;
	$mw->after($delay, sub { $mw->destroy }) if $ENV{BATCH};
	my $result = $mw->getSaveFile;
	if (!$ENV{BATCH}) {
	    diag "Result is <$result>";
	}
	pass("called getSaveFile");
    }

    {
	my $mw = MainWindow->new;
	$mw->after($delay, sub { $mw->destroy }) if $ENV{BATCH};
	my $result = $mw->chooseDirectory;
	if (!$ENV{BATCH}) {
	    diag "Result is <$result>";
	}
	pass("called chooseDirectory");
    }
}

1;
__END__