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 Getopt::Long;

use TkTest qw(catch_grabs);

plan tests => 15;

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;

GetOptions("delay=i" => \$delay)
    or die "usage: $0 [-delay ...ms]";

######################################################################
# 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.
TODO: {
## XXX works everywhere?
#     skip("getOpenFile etc. only on X11", 3)
# 	if $Tk::platform ne 'unix';
    todo_skip("known coredumps with multiple MainWindows on some systems", 5)
	if 1;

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

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

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

    catch_grabs {
	my $mw = MainWindow->new;
	$mw->geometry('+0+0');
	$mw->after($delay, sub { $mw->destroy }) if $ENV{BATCH};
	my $result = $mw->getOpenFile(-multiple => 1, -title => "getOpenFile with -multiple");
	ok(!defined $result || ref($result) eq "ARRAY", "Result of -multiple is an array reference or undef");
	if (!$ENV{BATCH}) {
	    diag "Result is <@$result>" if $result;
	}
	pass("called getOpenFile with -multiple");
    };
}

1;
__END__