@rem = ' vi:syntax=perl
@echo off
perl -x -S %0 %*
goto endofperl
@rem ';
#!perl
#line 8


# some config vars:

my $geom = '1280x1024'; # initial window width x height
my $unzip = "c:\\sw\\GnuWin32\\bin\\unzip.exe"; #"c:\\Program Files\\GnuWin32\\bin\\unzip.exe";

# Version: 2009-04-26

use Tk;
use Tk::JPEG;
use Tk::Pane;
use Tk::BrowseEntry;
use Tk::DialogBox;
use File::Find;
use List::Util;
use File::stat;
use XML::Simple;
use Getopt::Long;
use Data::Dumper;
use Carp;
eval { require File::Wildcard::Find };
use strict;
use warnings;

sub Gui_mw { }

{
	package BrowseEntryDialog;

=pod  Example:

my $bed = BrowseEntryDialog->new(
	'Enter Filter Code',
	sub { warn "Doing '$_[0]'\n" },
);
$bed->update( @preload ) if @preload;

$mw->Button( -text => 'Filter', -command => sub { $bed->popup } )->pack;

=cut

	# inside-out
	my %be;
	my %dg;
	my %cb;

	sub new
	{
		my $pkg = shift;
		my $mw = shift;
		my $dlg_lbl = shift;
		my $cb = shift;
		my $d = $mw->DialogBox( -title => $dlg_lbl, -buttons => [qw( OK Cancel )] );
		$d->bind( '<Escape>', sub { $d->Subwidget('B_Cancel')->invoke } );
		my $f = $d->add('Frame')->pack( -expand => 1, -fill => 'both' );
		my $b = $f->BrowseEntry( -choices => [@_], -buttontakefocus => 1, -width => 80 )->pack;
		$b->Subwidget('entry')->configure( -validate => 'none' );
		my $self = bless {}, $pkg;
		$be{$self} = $b;
		$dg{$self} = $d;
		$cb{$self} = $cb;
		$self
	}

	# if it's not already in the list, adds it at the top.
	# if it is, it pulls it out of line and moves it to the top. (MRU)
	sub update
	{
		my( $self, @vals ) = @_;
		my %vals; @vals{@vals} = ();
		my $ar = $be{$self}->cget('-choices');
		@$ar = ( @vals, grep { not exists $vals{$_} } @$ar );
		$be{$self}->configure( -choices => $ar );
		$self
	}

	sub popup
	{
		my $self = shift;
		$be{$self}->Subwidget('entry')->focus;
		if ( $dg{$self}->Show eq 'OK' )
		{
			my $sr = $be{$self}->cget('-variable');
			my $foo = $$sr;
			eval {
				# True indicates failure.
				$cb{$self}->($foo) or
				$self->update($foo);
			};
		}
	}
}

{
	# XXX Windows specific!
	local $_ = `assoc .jpg`;
	my( $assoc ) = /=(.*)$/;
	$_ = `ftype $assoc`;
	my( $command ) = /=(.*)$/;
	sub external_edit
	{
		my $fname = shift;
		$fname =~ s/\//\\/g;
		my $cmd = $command;
		$cmd =~ s/%1/$fname/;
warn "system => $cmd\n";
		system $cmd;
	}
}



# WSH for manipulating Windows shortcuts:

my $on_Windows = ( $^O =~ /mswin/i );
if ( $on_Windows )
{
	require Win32::OLE;
	Win32::OLE->import;
	Win32::OLE->Option(Warn => 0);
	my $wsh;
	sub wsh() { $wsh ||= new Win32::OLE 'WScript.Shell' }
}


{ # begin symlink-related stuff

my %from_symlink; # { realpath, symlink }

sub create_symlink($) # can THROW EXCEPTIONS
{
	my( $target_path ) = @_;
	my $lnk_path = $target_path;
	$lnk_path =~ s#.*[\\/]##; # to be created in cwd

	if ($on_Windows)
	{
		$lnk_path = "Shortcut to $lnk_path.lnk";

		$target_path =~ s#/#\\#g;
		$target_path =~ /^[a-z]:\\/i or die(
			"invalid target path '$target_path' - Must be absolute!\n" ), return();

		my $shcut = wsh()->CreateShortcut($lnk_path) or die(
			qq(Error creating symlink named "$lnk_path"\n) ), return();

		$shcut->{'TargetPath'} = $target_path;
# 'Arguments' is a string appended to the actual target path field:
# $shcut->{'Arguments'} = "-w 640 -h 480";
# 'Description' is shown as the "Comments:" field in the Shortcut Properties window:
$shcut->{'Description'} = "Foo! Bar!";
# these two could be useful, but are NOT automatically set when
# TargetPath is set:
# $shcut->RelativePath 
# $shcut->WorkingDirectory 
		$shcut->Save;
		-e $lnk_path or die( qq(Failed to create symlink "$lnk_path") ), return();
	}
	else
	{
		warn "symlinks not yet supported on non-Windows platforms. :-(\n";
	}

	# now we know this file as symlinked. Useful in case we want
	# to delete the symlink during the same session.
	warn qq(Remembering symlink "$target_path" => "$lnk_path"\n);
	$from_symlink{lc $target_path} = $lnk_path;

	$lnk_path # a success message
}
sub remove_symlink
{
	my $file = shift;
	$file =~ s#/#\\#g;
	if ( $from_symlink{lc $file} )
	{
		if ( unlink $from_symlink{lc $file} )
		{
			warn qq(Forgetting symlink "$file" => "$from_symlink{lc $file}"\n);
			delete $from_symlink{lc $file};
		}
		else
		{
			alert( qq(Error trying to unlink symlink "$from_symlink{lc $file}" => "$file" : $!\n) );
		}
	}
	else
	{
		alert( "Ctrl-Del means nothing unless the file was loaded via a symlink/shortcut!\n($file)\n" );
	}
}
sub real_path($)
{
	#Carp::confess "real_path(@_)\n";
	my $path = shift;
	my $shcut;
	if ( $on_Windows )
	{
		$shcut = wsh()->CreateShortcut($path);
	}
	# non-Windows not yet supported
	$shcut or return $path;
	my $realpath = $shcut->TargetPath;
	warn qq("$realpath" => "$path"\n);
	$from_symlink{lc $realpath} = $path;
	$realpath
}
sub symlinked($)
{
	my $f = shift;
	$f =~ s#/#\\#g;
	exists $from_symlink{lc $f}
}

} # end symlink-related stuff.




{
my $tmpdir;
sub expand_zip_files
{
	my $files_ar = shift; # \@files

	unless ( $tmpdir )
	{
		my $dir = "tmp.$$";
		while ( -e $dir and !-d $dir ) { warn "Can't use $dir; trying ${dir}a ...\n"; $dir .= 'a' }
		-d $dir or mkdir $dir or return alert( "Failed to create tmp dir $dir - $!" );
		$tmpdir = $dir;
	}

	my $suck_tmpdir;
	my @f = map {
		if ( /\.zip$/i )
		{
			system $unzip, $_, '-d', $tmpdir
				and exit alert( "unzip seems to have failed" );
			$suck_tmpdir = 1;
			();
		}
		else
		{
			$_
		}
	} @$files_ar;

	$suck_tmpdir and push @f, glob "$tmpdir/*";

	@$files_ar = @f; # only update the list if everything went OK
}
END {
	if ( defined $tmpdir )
	{
		system qq(rmdir /s /q "$tmpdir") and 
			warn qq(rmdir /s /q "$tmpdir" seems to have failed!);
		-e $tmpdir or warn "\nCleaned up.\n";
		undef $tmpdir;
	}
}
}

{
# this is the "List" pseudo-package / singleton object.

my @files;
my $ii = -1; # image index
my $slideshow_file;

sub List_slideshow_filename() { $slideshow_file }
sub List_count() { scalar @files }
sub List_current_item() { @files && $ii >= 0 ? $files[$ii] : undef }
sub List_current_item_seqno() { $ii+1 } # this is a 1-based index.
sub List_remove_current_item() {
	@files && $ii >= 0 or return;
	splice @files, $ii, 1;
	$ii > $#files and $ii =0;
}

sub List_initialize_from_file
{
	my $file = shift;
	$file =~ s#\/#\\#g if $on_Windows; # XXX
	my $ds = XMLin $file;
	$ds or return alert("Error opening $file !!!");
	$slideshow_file = $file;
	bless $_, 'FileItem' for @{ $ds->{'item'} };
	@files = @{ $ds->{'item'} };
}

# unceremoniously dumps the previous contents of @files onto the ground.
sub List_initialize_from_filenames
{
	expand_zip_files( \@_ );
	my $n_before = @_;
	@files = map FileItem->new_from_filename($_), @_;
	my $n_after = @files;
	my $n_failed = $n_before - $n_after;
	$n_failed and alert("Looks like $n_failed of the $n_before files specified did not pass the image validator.");
	undef $slideshow_file;
}
sub List_add_from_filenames
{
	expand_zip_files( \@_ );
	push @files, map FileItem->new_from_filename($_), @_;
	# should probably remove dups.
}

sub List_set_index_0 { $ii = 0; }
sub List_advance_index { $ii = ( $ii + @files - 1 ) % @files; }
sub List_retreat_index { $ii = ( $ii + 1 ) % @files; }

sub List_count_selected() { scalar( grep { $_->is_selected } @files ) }
sub List_get_selected() { grep { $_->is_selected } @files }
sub List_clear_selection() { $_->unselect for @files }
sub List_invert_selection() { $_->toggle_selection_state() for @files }
sub List_set_no_current_item { $ii = -1 }
sub List_set_current_item
{
	my $obj = shift;
	$ii = 0;
	for ( my $i = 0; $i <= $#files; $i++ )
	{
		$files[$i] eq $obj and $ii = $i;
	}
}

sub List_for_each
{
	my $code = shift; # remaining args will be passed
	
	wantarray and
		return map { ref $code ? $code->( $_, @_ ) : $_->$code( @_ ) } @files;

	my $n;
	if ( ref $code )
	{
		$n += !!$code->( $_, @_ ) for @files;
	}
	else # assume it's a method name
	{
		$n += !!$_->$code( @_ ) for @files;
	}
	$n;
}

sub List_filter
{
	my $func = shift;
	@files = $func->( @files );
}

# notice that in the resulting XML, the first line (<list>) has a leading space,
# the <item> lines have a leading tab, and the last line has the < in the first column.
# this has the effect that when passed through sort, the first line stays first
# and the last line stays last.
sub List_as_xml
{
	local $_ = XMLout \@files;
# may need to handle the possibility of the XML having newlines within each 'record'.
	s/opt>$/list>/mg;
	s/(<list)/ $1/;
	s/^\s*<anon/\t<item/mg;
	$_
}

}

# here's the (real) class for items of the list.
{
package FileItem;

use Image::ExifTool 'ImageInfo';
use Data::Dumper;

sub new_from_filename
{
	my $pkg = shift;
	my $filename = shift;

	my $self = ImageInfo( $filename, qw(
		Comment
		FileModifyDate
		FileName
		FileSize
		ImageHeight
		ImageWidth
		Error
	));
	bless $self, $pkg;

        $self->{'Error'} and warn("$filename: Error: $self->{'Error'}\n"), return();

	$self->{'FileSize'} =~ s/mb/000000/i;
	$self->{'FileSize'} =~ s/kb/000/i;
	$self->{'FileSize'} =~ s/b//i;

	$self->{'filename'} = $filename;

	$self->sanitize_datamembers;
	$self
}

	sub sanitize_property_name_and_value
	{
		my( $self, $name, $value ) = @_;
		for ( $name )
		{
			s/ \((.+)\)$/_$1/;
			s/[^0-9a-zA-Z_:]+/_/g;
		}
		for ( $value )
		{
			s/[^\x20-\x7E]/ /g;
			s/"/'/g;
			s/\s+/ /g;
			s/\s+$//;
		}
		( $name, $value )
	}

sub sanitize_datamembers
{
	my $self = shift;
	%$self = map {
		$self->sanitize_property_name_and_value( $_, $self->{$_} )
	} keys %$self;
	$self
}

sub as_string
{
	my $self = shift;
	local $Data::Dumper::Indent = 1;
	local $Data::Dumper::Terse = 1;
	local $Data::Dumper::Quotekeys = 0;
	my @a = split /\n/, Dumper($self);
	pop @a; shift @a;
	s/,$// for @a;
	s/'$// for @a;
	s/ => '/: / for @a;
	s/ => /: / for @a;
	join "\n", sort @a;
}

sub show_info
{
	my $self = shift;
	if ( ::Gui_mw() )
	{
		::alert( $self->as_string );
	}
	else
	{
		warn $self->as_string;
	}
}

sub name
{
	my $self = shift;
	$on_Windows
		? lc( $self->{'filename'} )
		: $self->{'filename'}
}

sub set_as_current
{
	my $self = shift;
	::List_set_current_item( $self );
	$self
}

sub set_properties
{
	my( $self, $hr ) = @_;
	$self->{$_} = $hr->{$_} for keys %$hr;
	$self
}
sub property
{
	my( $self, $propname ) = @_;
	$self->{$propname}
}

sub set_scrolledto
{
	my $self = shift;
	$self->{'scrolledto_x'} = shift;
	$self->{'scrolledto_y'} = shift;
	$self
}
sub scrolledto_x
{
	exists $_[0]{'scrolledto_x'} ? $_[0]{'scrolledto_x'} : 0.5
}
sub scrolledto_y
{
	exists $_[0]{'scrolledto_y'} ? $_[0]{'scrolledto_y'} : 0.5
}

sub set_scalefactor
{
	my( $self, $sf ) = @_;
	$self->{'scale_factor'} = $sf;
	$self
}
sub scalefactor
{
	my( $self ) = @_;
	$self->{'scale_factor'} || 0
}

sub is_selected
{
	my $self = shift;
	$self->{'selected'} 
}
sub select
{
	my $self = shift;
	$self->{'selected'} = 'selected';
	$self
}
sub unselect
{
	my $self = shift;
	delete $self->{'selected'};
	$self
}
sub toggle_selection_state
{
	my $self = shift;
	$self->is_selected ? $self->unselect : $self->select
}

# List_current_item()->update_pos( Gui_scrolled()->xview, Gui_scrolled()->yview );
sub update_pos
{
	my( $self, $xlo,$xhi, $ylo,$yhi ) = @_;
	# these are all normalized to the current size of the image [0,1]
	# that is, when the image exactly fits in the viewport,
	# lo=0 and hi=1.
	#my($xlo,$xhi) = Gui_scrolled()->xview;
	#my($ylo,$yhi) = Gui_scrolled()->yview;
	$self->set_scrolledto( ( $xhi + $xlo ) / 2, ( $yhi + $ylo ) / 2 );
}

} # end of package FileItem






sub initialize_data_structures
{
my $read_from_stdin; # -i means get specs from stdin, NOT from cmdline
my $initial_scalefactor;
my @initial_commands; # those which affect the loaded data, principally the list.
my @postinit_commands; # those which affect the gui, e.g. call GUI commands
my $slideshow_file;
my $slideshow_dir;
my $use_File_Wildcard;
my $directory_recursion_depth; # undef means unlimited.
$::auto_advance_time = 2000; # milliseconds


=pod

These are the commands which it might make some sense to allow "calling" via commandline switches:

Edit_order_by_file_name
Edit_order_by_file_size
Edit_order_random
Edit_order_reverse
File_open
File_print_to_stdout
File_save_as
File_write_batch_copier_onto_clipboard
File_write_onto_clipboard

=cut


GetOptions(
	'input|stdin!' => \$read_from_stdin,
	'iconified|iconify|iconized!' => \$::begin_iconified,
	'destination=s' => \$::dest_dir,
	'file=s' => \$slideshow_file,
	'directory|folder=s' => \$slideshow_dir,
	'recurse|recursion_limit=i' => \$directory_recursion_depth,

	# initial commands: those which affect the loaded data, principally the list:
	'scale|factor=i' => sub { my $scale = pop; push @initial_commands, sub { List_for_each( set_scalefactor => $scale ) } },
	'grep=s' => sub { my $code = pop; push @initial_commands, sub { run_custom_filter('grep',$code) } },
	'sort=s' => sub { my $code = pop; push @initial_commands, sub { run_custom_filter('sort',$code) } },

	# commands which can't be run until after the gui is initialized:
	'exit!' => sub { push @postinit_commands, \&File_exit },
	'auto!' => sub { push @postinit_commands, \&View_start_slideshow },
	'first!' => sub { push @postinit_commands, \&View_first },
	'byname!' => sub { push @postinit_commands, \&Edit_order_by_file_name },
	'bysize!' => sub { push @postinit_commands, \&Edit_order_by_file_size },
	'random!' => sub { push @postinit_commands, \&Edit_order_random },
);

# note that any post-init commands on the commandline *after* --exit will never get executed!

# Changed: No longer reads from cwd by default.
# You must now specify the files/folders you want to read, explicitly - even the cwd (.).

my @args = grep {
	chomp;
	s/\s*#.*//; # kill comments
	s,\\,\/,g; # XXX system specific!
	/\S/
} $read_from_stdin ? <> : @ARGV;

my $slideshow_on_disk_type; # value will be a keyword string, one of: 'xml', 'symlinks',

defined $slideshow_file &&
defined $slideshow_dir and exit
	alert("You can't specify both a slideshow file AND a slideshow directory, Silly!");

if ( defined $slideshow_file )
{
	-e $slideshow_file && !-f $slideshow_file and exit
		alert("$slideshow_file exists but is not a file!");

	if ( -e $slideshow_file )
	{
		warn "reading list from XML file $slideshow_file\n";
		# attempt to load the file as XML
		List_initialize_from_file( $slideshow_file );
		$slideshow_on_disk_type = 'xml';
	}
	else # doesn't exist yet. Don't try to read it now, but remember it for later.
	{
	}
}

if( defined $slideshow_dir )
{
	-e $slideshow_dir && !-d $slideshow_dir and exit
		alert("$slideshow_dir exists but is not a directory!");

	if ( -e $slideshow_dir ) # exists a directory already
	{
		warn "Using $slideshow_dir as directory of symlinks\n";
		# first, assert that the folder contains no files of any type other than symlink
exit alert( "Not implemented yet!" );
		$slideshow_on_disk_type = 'symlinks';
	}
	else # doesn't exist yet. Don't try to read it now, but remember it for later.
	{
	}
}

# now handle filespecs from the commandline:

if ( @args ) # filespecs
{
	$use_File_Wildcard &&= grep /File.Wildcard.Find/, keys %INC; # can't use it if it hasn't been loaded.

	my @filenames;
	if ( $use_File_Wildcard )
	{
		#warn "using File::Wildcard::Find\n";
		@filenames =
			map File::Wildcard->new(
				path => $_,
				case_insensitive => 1,
				follow => 1,
				ellipsis_order => 'breadth-first',
				sort => 1,
				debug => 0,
			)->all, @args;
	}
	else
	{
		warn "\nusing glob\n\n";
		@filenames =
			#map { real_path($_) } # resolves symlinks/shortcuts
			map { glob( /\s/ ? qq("$_") : $_ ) }
			@args;
	}

	if ( @filenames )
	{
		while ( !defined($directory_recursion_depth) or $directory_recursion_depth-- )
		{
			my $n_dirs_expanded;
			@filenames = map {
				-d $_ ? do { $n_dirs_expanded++; glob( /\s/ ? qq("$_/*") : qq($_/*) ) } : $_
			} @filenames;
			$n_dirs_expanded or last;
		}

		if ( List_count() )
		{
			my $choice = choice_prompt(
				-title => 'List Spec Conflict',
				-text => "There is already a slideshow resident, but your commandline args have specified ".@filenames." other files.\nWhat do you want to do?",
				-buttons => [
					"Add spec'd files to the current slideshow",
					"Replace current slideshow contents with spec'd files",
					"Discard the list of spec'd files",
				],
			);
			defined $choice or exit alert( "BOGUS!  choice_prompt() returned undef!" );
			if ( $choice =~ /^A/ )
			{
				List_add_from_filenames( @filenames );
			}
			elsif ( $choice =~ /^R/ )
			{
				List_initialize_from_filenames( @filenames );
			}
		}
		else
		{
			List_initialize_from_filenames( @filenames );
		}
	}
	else
	{
		alert("You gave some filespecs on the commandline, but no filenames resulted!");
	}
}


alert( "Loaded ".List_count()." files.\n" );

$_->() for @initial_commands;

*process_postinit_commands = sub { $_->() for @postinit_commands };

} # end initialize_data_structures




{
my $autoadvancing;
my $showimage_timer;
sub clear_showimage_timer
{ 
	Gui_mw() or return;
	Gui_mw()->afterCancel( $showimage_timer );
	$showimage_timer = undef;
}
sub set_showimage_timer
{
	Gui_mw() or return;
	clear_showimage_timer();
	$showimage_timer = Gui_mw()->after( 100, \&show_image );
}

my $autoadvance_timer;
sub start_autoadvancing
{
	Gui_mw() or return;
	stop_autoadvancing();
	$autoadvance_timer = Gui_mw()->after( $::auto_advance_time, sub { View_next(); start_autoadvancing(); } );
	$autoadvancing=1;
}
sub stop_autoadvancing
{
	Gui_mw() or return;
	Gui_mw()->afterCancel( $autoadvance_timer ) if defined $autoadvance_timer;
	undef $autoadvance_timer;
	$autoadvancing=0;
}
sub Menu_add_autoadvancing_checkbutton
{
	my $menu = shift; # a Menu widget
$menu->checkbutton(
	-label => 'AutoAdvance',
	-command => sub { $autoadvancing ? View_start_slideshow() : View_stop_slideshow(); },
	-onvalue => 1,
	-offvalue => 0,
	-variable => \$autoadvancing,
);
}
}



sub Gui_die_die_die
{
	my $mw = Gui_mw() or return;
	$mw->destroy;
	undef $mw;
	no warnings;
	*Gui_mw = sub { };
}

sub Gui_initialize
{
	my $mw = new MainWindow;

	!List_count() and alert( "No files found!\n" );

	$mw->iconify if $::begin_iconified;

	my $menubar = $mw->Menu( -type => 'menubar' );
	$mw->configure( -menu => $menubar );

	my $scrolled = $mw
		->Scrolled( 'Pane', -scrollbars => 'osoe', ) # -width => 640, -height => 480, )
		->pack( -expand => 1, -fill => 'both', );

	my $imagit = $scrolled
		->Label
		->pack( -expand => 1, -fill => 'both', );

	no warnings;
	*Gui_mw       = sub { $mw };
	*Gui_menubar  = sub { $menubar };
	*Gui_scrolled = sub { $scrolled };
	*Gui_imagit   = sub { $imagit };


# create menu and other bindings:



	my $commands_config = <<EOF;

File	Open	File_open	Control-KeyPress-o
File	Save as...	File_save_as	KeyPress-s
File	Print to stdout	File_print_to_stdout	KeyPress-l
File	List on Clipboard	File_write_onto_clipboard	KeyPress-c
File	Batch Copier on Clipboard	File_write_batch_copier_onto_clipboard	KeyPress-b
File	~Exit	File_exit	KeyPress-q	Escape

# a bunch of things for altering the order of the list.
Edit	Order by file name	Edit_order_by_file_name	KeyPress-F3
Edit	Order by file size	Edit_order_by_file_size	KeyPress-F4
Edit	Randomize the order	Edit_order_random	KeyPress-F5
Edit	Reverse the order	Edit_order_reverse	KeyPress-F6
Edit	custom grep	grep_bed_popup	KeyPress-G
Edit	custom sort	sort_bed_popup	KeyPress-S
Edit	Select/unSelect current image	Edit_current_toggle_selection	space
Edit	Remove current element from list	Edit_remove_current	Delete
# this originally had KeyPress-r associated with it:
Edit	Remove selected	Edit_remove_selected
Edit	Remove unselected	Edit_remove_unselected

View	Go to first image	View_first	KeyPress-0
View	Previous	View_prev	Prior
View	Next	View_next	Next
View	--------
View	Zoom In	View_zoom_in	KeyPress-plus	KeyPress-=
View	Zoom Out	View_zoom_out	KeyPress-minus
View	Up	View_scroll_up	Up
View	Down	View_scroll_down	Down
View	Left	View_scroll_left	Left
View	Right	View_scroll_right	Right
#View	Start Slideshow	View_start_slideshow
#View	Stop Slideshow	View_stop_slideshow

ImageFile	Edit current	ImageFile_edit_current	KeyPress-e
ImageFile	Delete current	ImageFile_delete_current	Control-Delete
ImageFile	Rename current	ImageFile_rename_current
# these should not be menu items, but either command-line switches, or exit-time prompted actions (or both).
#ImageFile	Copy all files to destination directory	ImageFile_copy_all_to_destdir	KeyPress-d
#ImageFile	Create symlink (in current directory) to this imagefile	ImageFile_current_createsymlink
#ImageFile	Create symlinks (in current directory) to all imagefiles	ImageFile_all_createsymlinks
ImageFile	View info	ImageFile_view_info

EOF

	for ( split /\n/, $commands_config )
	{
		my( $menu, $label, $funcname, @keysyms ) = split /\t/;
		defined $label or next;
		$menu =~ /^#/ and next;
		$label =~ /^----/ and add_menu_separator($menu), next;
		defined $funcname or next;
		@keysyms
		? add_command( \&{ $funcname }, $menu, $label, @keysyms )
		: add_menu_command( \&{ $funcname }, $menu, $label );
	}

	Menu_add_autoadvancing_checkbutton( $::Menu{'View'} );


	# other bindings:

	Gui_imagit()->bind( '<Button1-ButtonRelease>' => sub { undef $::last_x } );
	Gui_imagit()->bind( '<Button1-Motion>' => [ \&drag, Ev('X'), Ev('Y'), ] );
	Gui_mw()->bind( "<MouseWheel>" => [ sub {
		my( $xscroll, $yscroll ) = Gui_scrolled()->Subwidget( 'xscrollbar', 'yscrollbar' );
		if ( $yscroll->ismapped )
		{
			$_[1] > 0 ? View_scroll_up() : View_scroll_down()
		}
#		elsif ( $xscroll->ismapped )
#		{
#			$_[1] > 0 ? View_scroll_left() : View_scroll_right()
#		}
# maybe use button3down to indicate that we want horizontal scrolling.
	}, Ev('D') ] );

	add_event_handler( \&Help, 'KeyPress-F1' );

	# display the keysym of keypresses not otherwise bound:
	Gui_mw()->bind( '<KeyPress>' => [ sub { shift; print "KeyPress = @_ \n"; }, Ev('s'), Ev('K'), Ev('k'), ] );

	# if there's ever anything you want to do when the window is resized:
	#Gui_mw()->bind( "<Configure>" => [ sub { my(undef,$W,$h,$w)=@_; return unless $W == Gui_mw(); %scale_factor=(); }, Ev('W'), Ev('h'), Ev('w') ] );
	# however, it looks like the <Expose> handler does what we need.


# and start me up!

	Gui_mw()->after( 100, sub {
		process_postinit_commands();
		Gui_mw()->geometry( $geom . '+0+0' ); # set initial width, height
		View_first();
	});
	Gui_mw()->bind( '<Expose>' => [ sub { $_[0] == Gui_mw() and show_image() }, Ev('c'), Ev('h'), Ev('w'), ] );
	warn "\nReady!\n";

} # Gui_initialize.




{ # start of subs

sub Help
{
	alert(<<EOF);
Help!

Menu

Hotkeys

Commandline

EOF
}

sub View_scroll_up    { Gui_scrolled()->yview( scroll => -0.1, 'pages' ); List_current_item()->update_pos( Gui_scrolled()->xview, Gui_scrolled()->yview ); }
sub View_scroll_down  { Gui_scrolled()->yview( scroll =>  0.1, 'pages' ); List_current_item()->update_pos( Gui_scrolled()->xview, Gui_scrolled()->yview ); }
sub View_scroll_left  { Gui_scrolled()->xview( scroll => -0.1, 'pages' ); List_current_item()->update_pos( Gui_scrolled()->xview, Gui_scrolled()->yview ); }
sub View_scroll_right { Gui_scrolled()->xview( scroll =>  0.1, 'pages' ); List_current_item()->update_pos( Gui_scrolled()->xview, Gui_scrolled()->yview ); }

sub choice_prompt
{
	my %args = @_; # just as for Tk::DialogBox, i.e. -title and -buttons, but also -text
	my $text = delete $args{'-text'};
	my $response;
	if ( Gui_mw() )
	{
		my $d = Gui_mw()->DialogBox( %args );
		$d->add('Label', -text => $text );
		$response = $d->Show;
	}
	else
	{
		local @ARGV; # so that <> doesn't try to read files.
		my $n;
		print "\n$text\n\n";
READ_NUMBER_INPUT:
		for ( 0 .. $#{ $args{'-buttons'} } )
		{
			print ''.($_+1).") $args{'-buttons'}[$_]\n";
		}
		$n = <>; chomp $n;
		$n =~ /^\d+$/ or goto READ_NUMBER_INPUT;
		$n--;
		$n >= 0 && $n <= $#{ $args{'-buttons'} } or goto READ_NUMBER_INPUT;
		$response = $args{'-buttons'}[$n];
	}
	$response
}

sub alert
{
	if ( Gui_mw() )
	{
		Gui_mw()->messageBox( -message => $_[0],
			-type => 'Ok', -icon => 'warning', -title => 'Warning' );
	}
	else
	{
		warn "$_[0]\n";
	}
	1 # since we often do things like <c> exit alert('...'); </c>
}

sub filter # rearrange the list or remove items from it.
{
	my $func = pop;
	if ( List_current_item() )
	{
		my $current = List_current_item();
		clear_showimage_timer();
		List_filter( $func );
		$current->set_as_current(); # re-find the proper index.
		set_showimage_timer(); # necessary?
	}
	else
	{
		# running this filter before we've begun displaying.
		List_filter( $func );
	}
}

# binds a given command to a key or a menu item.
# the keysym(s) get bound directly to the cmd.
# the menu entry (bound to the cmd) is added to the menu.
sub add_menu_command
{
	my( $cmd, $menu, $label, $accel_string ) = @_;
	$::Menu{$menu} ||= Gui_menubar()->cascade( -label => $menu, -underline => 0, -tearoff => 1, );
	$::Menu{$menu}->command( -label => $label, -command => $cmd, defined($accel_string) ? ( -accelerator => $accel_string ) : () );
	1;
}
sub add_menu_separator
{
	my( $menu, ) = @_;
	$::Menu{$menu} ||= Gui_menubar()->cascade( -label => $menu, -underline => 0, -tearoff => 1, );
	$::Menu{$menu}->separator();
	1;
}
sub add_event_handler
{
	my( $cmd, @eventsyms ) = @_;
	Gui_mw()->bind( $_, $cmd ) for map { /^<.*>$/ ? $_ : "<$_>" } @eventsyms;
}
sub add_command
{
	my( $cmd, $menu, $label, $keysym, @additional_keysyms ) = @_;
# $keysym should be the full keysym spec, NOT including the angle brackets.
	my $accel = $keysym;
	$accel =~ s/KeyPress-//i;
	add_menu_command( $cmd, $menu, $label, $accel );
	add_event_handler( $cmd, $keysym, @additional_keysyms );
}



sub Edit_order_by_file_name
{
# the 'name' method is special, in that it returns a string which is
# case-sensitive or not, depending on the OS.
	filter( sub { sort { $a->name cmp $b->name } @_ } )
}
sub Edit_order_by_file_size
{
	filter( sub { sort { $a->property('FileSize') <=> $b->property('FileSize') } @_ } )
}
sub Edit_order_random
{
	filter( sub { List::Util::shuffle(@_) } )
}
sub Edit_order_reverse
{
	filter( sub { reverse @_ } )
}


# let the user define a custom filter.
# they have a choice of grep or sort.
# we use string eval on whatever they enter. (Shhh!)
# see the note above about how to grep/sort using the
# info stored in %fileinfo.
sub run_custom_filter
{
	my( $fltyp, $code ) = @_;
	$code =~ s#(\$[ab_])\.(\w+)#$1->property('$2')#g;
	undef $@;
	my $evalcode = "sub { $fltyp {\n$code\n} \@_ }";
	#warn "Will eval this code to create a lambda:\n$evalcode\n";
	my $sub = eval $evalcode;
	unless ( $@ )
	{
		my $before = List_count();
		eval { filter( $sub ); };
		my $after = List_count();
		$fltyp eq 'grep' and warn "$before files before grep, $after files after.\n";
		$@ or return 0;
	}
	local $_ = $@;
	s/ at \(eval \d+\) line \d+.*//;
	alert( qq(Error:\n  $fltyp {\n    $code\n  }\n$_) );
	1; # failure
}


sub grep_bed_popup
{
	$::grep_bed ||= new BrowseEntryDialog Gui_mw(), "Enter grep code", sub { run_custom_filter( grep => $_[0] ) };
	$::grep_bed->popup;
}
sub sort_bed_popup
{
	$::sort_bed ||= new BrowseEntryDialog Gui_mw(), "Enter sort code", sub { run_custom_filter( sort => $_[0] ) };
	$::sort_bed->popup;
}


=pod

Image scaling here is designed to strike a balance
between not wanting to scroll too much and not
wanting to lose too much resolution by downsampling.
The heuristic is:

1. if the image fits within the scrolled pane in one
or both dimensions (that is, only zero or one scrollbar
would be shown), no downsampling is done.

2. otherwise (i.e. if two scrollbars would be needed),
the downsampling factor is incremented (from 1) until
condition #1 (above) is met.

(Of course, we don't actually increment and check like
that; we calculate the desired factor algebraically.)

This way, when you do have to scroll, it will often be
on one axis only; and the distance you'll have to 
scroll will be minimized (or rather, optimized).

Another approach would be to downsample the picture
sufficiently such that the image always fits entirely
within the pane, and scrolling won't be necessary, but
I'd rather give minimization of resolution loss 
slightly more weight than eliminating the need to scroll.

=cut

	sub factor
	{
		my( $n, $m ) = @_;
		($n>$m) ? int($n/$m) : 1
	}

	sub min { $_[0] < $_[1] ? $_[0] : $_[1] }

sub clear_window_title
{
	Gui_mw() or return;
	Gui_mw()->configure( -title => "- - - - - - - - - - -" );
}

sub set_window_title
{
	Gui_mw() or return;
	defined List_current_item() or return
		Carp::cluck("No 'current' defined (#files=".List_count().")");
	my $z = List_current_item()->property('FileSize');
	$z =~ s/000000$/mb/;
	$z =~ s/000$/kb/;
	Gui_mw()->configure( -title => join ' ',
		(List_current_item()->is_selected() ? '#' : ' '),
		#(List_current_item()->symlinked() ? 'K' : ' '),
		"[".List_current_item_seqno()."/".List_count()."]",
		List_current_item()->name,
		"(". List_current_item()->property('ImageWidth') ." x ". List_current_item()->property('ImageHeight') . ")",
		$z,
	);
}


sub clear_image
{
	Gui_imagit()->configure( -image => undef );
}

sub logo_imagedata_64 
{
qq{/9j/4AAQSkZJRgABAQEAYABgAAD/2wBDAAgGBgcGBQgHBwcJCQgKDBQNDAsLDBkSEw8UHRofHh0a
HBwgJC4nICIsIxwcKDcpLDAxNDQ0Hyc5PTgyPC4zNDL/2wBDAQkJCQwLDBgNDRgyIRwhMjIyMjIy
MjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjL/wAARCAB5AHADASIA
AhEBAxEB/8QAHwAAAQUBAQEBAQEAAAAAAAAAAAECAwQFBgcICQoL/8QAtRAAAgEDAwIEAwUFBAQA
AAF9AQIDAAQRBRIhMUEGE1FhByJxFDKBkaEII0KxwRVS0fAkM2JyggkKFhcYGRolJicoKSo0NTY3
ODk6Q0RFRkdISUpTVFVWV1hZWmNkZWZnaGlqc3R1dnd4eXqDhIWGh4iJipKTlJWWl5iZmqKjpKWm
p6ipqrKztLW2t7i5usLDxMXGx8jJytLT1NXW19jZ2uHi4+Tl5ufo6erx8vP09fb3+Pn6/8QAHwEA
AwEBAQEBAQEBAQAAAAAAAAECAwQFBgcICQoL/8QAtREAAgECBAQDBAcFBAQAAQJ3AAECAxEEBSEx
BhJBUQdhcRMiMoEIFEKRobHBCSMzUvAVYnLRChYkNOEl8RcYGRomJygpKjU2Nzg5OkNERUZHSElK
U1RVVldYWVpjZGVmZ2hpanN0dXZ3eHl6goOEhYaHiImKkpOUlZaXmJmaoqOkpaanqKmqsrO0tba3
uLm6wsPExcbHyMnK0tPU1dbX2Nna4uPk5ebn6Onq8vP09fb3+Pn6/9oADAMBAAIRAxEAPwD3+iii
gAorJ1nxPovh/YNU1CK3d8bY+Xcg552qCccHnGKp674lt7bwVceINPuPOiEavA8YDBmLAAMD23HD
DhgN2MEVDqRV9djpp4SvNwtF2k0k7Ozb8zoqKy7LWo77X9U0pIWVtOWHfIx4cyKWwB6AAc+pPHGS
3U9TuLfWdI021jy95JI80jRF1jhjXLdGGCWZFBORz9AXzq1/67ErD1Ofkas7X+Vua/3amtRRWTrP
ifRfD+wapqEVu742x8u5BzztUE44POMU3JRV2yKdKdWXJTi2+yV2a1Fc34g8TRweDJNW0eVbmW5V
YrHyz8zyOdo2qQcsOTtxn5SDjmukpKSbsip0J04Kcla7a87q1/zCiiiqMQooooAKqarff2ZpF7f+
X5n2WCSbZuxu2qTjPbOKt1k6tquhJ5+latf2sHnQfvIp5hFvjfcvBJGejDg5HtkVMnZbmtCDnNe6
2uqXYyNG8C2MO++15ItX1i4y1xcXC70ycfKiHgAYABxn6D5RR1iw02DxPo+j2cEFnZwTNrd95eI1
iEahI35+UKSMMAM8Z45JwZfH2o+HdZTS7W/tfE1oZNkWzd9owVUIhkUbGOT1AYkg5wTgVvEVxqB1
vxPJJb3kWqXGlQpFbjEkcNsUD3BLEbdoKsuR1ZjgZPHDKpT5bRWz1/PfzsfU0cFjXX5689JRbjrZ
atR+HRpRvfaysdhpnjDSItIk1uWO6gOq3bm2tiBJLcMirGBGq88iNRz0Y4zggnL0nxDHcalrfjTV
LSeytrC2j05IcZffkNIjDruEjKATtGDyBzjGttYB8W2a2VvdTPa2kVl4fhuopEWRWUq10+P4AqnJ
C/MpHA2kjDnP2jwfaQXcGqLbQXdxLrVwsO5lu23LFneQSQANwyB84ydxFS68vu/P+nf0N6eWUrtN
Nc9lvqou7sl6RUbu95OyR6HpfxBmvbe8e70KWzki0x9TgVpwwmiUkddoK5IGODkc9MZt6N4FsYd9
9ryRavrFxlri4uF3pk4+VEPAAwADjP0Hyjk/DOp6XfE211d/ZbB4y95earc7LjVt0bxAfewI1O/g
M2Cq9Dk0S+PtR8O6yml2t/a+JrQybItm77RgqoRDIo2McnqAxJBzgnAuNWNlKq7/ANdjmq4Ct7Sd
HAx5Hu1rql05ne3dptXur6qy1vEkui6H4h0bTYbGJLdZ21Se2tkIdpVTy4BGoIBLPgbV/u5OBuJ1
rDx9Yy+F7nWtTt5dPNrO1tLbOdzmUAHYvQkkEcEDGDngZrMs9Mutf+J76lq1ktsul2VuYoD82ZHU
sDnBDhWMo3DHKrjoa53SLkaZpNj4g1ux1aWKDUbue9UQoF+1sUVHKHHyjDjPVZARx0o9pKMm1onf
p2sv6+YvqtCvShTneU4qN/e1blzSsumqsr/4V3v32i+Jr69voLTV9FbSZbqEy2gkuUczBcblxwys
AwOCM43dMUN4qlvLFrjRdLa9P2mS3i824jgW4KdTExJ3g/MR2wj5IIAPJR3GseNJ7/xLFbz2thp9
ldR6SkfE0szIVLcAkn6HghQMkMaZo+rJZaT4XvUhltvDmmZF1ctGzeZcSQuGZQAW2K7MpbgFnwBh
c1SrPa+nf7te3f8AAxnltPWSguZbxTbSdpPl35m37qsnvzdEd94c16HxFpf2uOCW3mjkMNxbyqQ0
Mq43KcjnGRz784OQNauV8BRSHSb/AFFo2ji1TUZ76BJBhxG5AXcPU7c8EjBBzXVV1Um5QTZ4mNpw
p4icKeyf3eXy2CsbWvCmh+IZoptUsFnliUqrh2RsdcEqRkfXpk+prZoqpRUlZq5jSrVKMuenJxfd
OzMvSfDmj6EoGm6dBbsFK+Yq5kIJyQXOWIz6nsPStSoba6hu4mkgfeiyPGTgj5kYow59GUj8Kmoi
kl7uwVZ1JzbqtuXW+4UUUUzMxta8KaH4hmim1SwWeWJSquHZGx1wSpGR9emT6mpdJ8OaPoSgabp0
FuwUr5irmQgnJBc5YjPqew9K1KKnkjfmtqbvFV3T9k5vl7Xdvu2CiiiqMAooooAKKKKACiisPxjq
X9k+D9VvA0qOsDJG8Rwyu/yKQcjGGYHPtSlJRTb6GlGk6tSNOO8ml95R8Fa7ZX+hWheeCC8vprm5
S0aYGTDTytwOCQMHnHY10l1dW9lbvcXdxFBAmN0krhFXJwMk8dSBXkGoaL4f8LXGiW8X7zWtPkjv
9TnWRmVY0G5l5woLNtVBgE5XJG4E3vDf2rW9f0q3v51lleaTxBeQ7uIyVVLdVIYtlRtbaSBtYA5x
XHCvJJQa1PocVldGpKWKpyag7vVa2u3pq9Glo33V9z1eiiiu0+aCiiigAooooAKKKKACiiigArL1
3RI9fsY7SW8vLVUmWYPaS7GJXkZODwDg/UA9q1KKTSasy6dSVOanB2aOdXwToq6He6V5MpS+w11c
NKWmlcch2c99w3Y6ZJ45NY3gC2tbXWvE0cMV4kq3KIXuH3iZULp5m4jJZpFlLdgSAOhru6qWGmWe
mfafscPl/ap2uZvmJ3SNjc3J4zgcDisnSXNGSWx2xx9R0KtKpJvnt103V7/JJFuiiitjzwooooAK
KKKACiiigAooooAKKKo61eSadoWoX0Kq0ttbSTIHGVJVSRnHbik3ZXKhBzkordlTw7eahfrqc18q
iNdRnhtQoGPJjIQe+dyvnPf2xVaO6l1Dx5Nbx3H+iaVaL5sau6kzzHI3D7rgIuRnoX9enN2nirVp
dJs9IsV05dXl046hd3zSLHBaqx3b3XHLkMGYYADMDgqTVTwrrmpLB59tbwX+seIWmugMFRaBH8se
a24sYQN20cEFSoyWyOX2yfLH7/69bHvvLakfa1LJdIq/4vsuVSd3a+/VX9RorjbjxVq9hpklpPY2
t14iN39jgt7Rz5cjGNZN+GwwRVcbvcdQDkFlf6x4e1nT7LxHrUV8moQTPvFukS2zxKHb5wRlCpbk
j+EdMmtvbRv/AFoed/ZtXlbur6tLrJJXbVltbq7X2Wuh2VZ2ial/a2mm8DROjTzpG8RyrIkropBy
c5VQc+9ec6r4p8T634RTWNNnXToSyWggWP8AfXsrgBzESCQAxwoU54ckggCqk2peJPA+lRacNb06
S4842UVmtsFjh+RH83zSEG4eYmd2Qd+STg4xeKSd7Ox6FPIqkqfI5x9o3a2ult72TXVeS6u+h7FR
Xm1h4y1LR9G1C71jUbXUIY54VtbhEVDdDcq3AiXK7wmSA2ME85xwOq0OLXLpl1TVL9oY51Ekelxw
qFgBBwruy72bBUn7uGBHI4rWFZT0SPPxGW1KCcpyVlonrq7J2Wl9L63tZ6PU36KKK2PPCiiigArJ
8U/8ihrX/XhP/wCi2rWrhPFWl+LZJ7+z0NLOSw1hh9olk+WS3+RI2HJwVKp1Ck8txkAnOrJqLsrn
bl9KNSvHmmo2s9dFo119P8jmPDvhXxPdaHNZqFgtdStlmk1D7Vlpo/JAggxyVVS2G45XIBwBufot
x4st/EswtvD0U15pekw6YYTdIBHkB0djnDZIJwuOCBnIyfV9Ps49O021sYWZoraFIULnLEKABnHf
is7StJa08Qa9qUgYNfTQhMsCpjjiUAgDkHcXHPoPx5/q3Ly2b/r/AIJ67zv2vtnUhFprTfV3S11/
l+6ytZaHNP4Y13RNOs9R0tLDUddjknluhOhCyyTlN7xncoUgIF7AqW4BODXs/CWuX9treua/tk1u
7sp7a0tFKlbcMpAAOSATnAwejHJJY49GorX6vC/9ff6nAs4xCi1ZXfW2tr35fKN+i9L2OP1/Q75v
DWgRaTaNNLpNza3AtZ5kSR1jXG0sPl3cjJ6cHGeAeW1fwT4iuXGtzafYapqN/HsvbKVtqwHcChjY
MvRVVD8xPXlgxx6zRRPDxnuPDZxXw6XIlu9db662vfa+ulndLU8/i8JandNoWo6zumvLe9jcWtmU
jhsIAGIRVyAQGEe48thQBnGT6BRRWkKahsceKxlTEtc9tL2S0Su7/wBfjqFFFFWcoUUUUAFFFFAB
RRRQAUUUUAFFFFABRRRQAUUUUAFFFFAH/9k=
}
}

sub show_default_image
{
	my $logo_image;
	eval {
		my $oi = Gui_mw()->Photo( 'logo',
			-data => logo_imagedata_64(),
		);
		$logo_image = $oi;
	};
	if ( $@ )
	{
		alert( $@ );
		return;
	}
	$logo_image or alert( "Failed to create a Photo object from in-memory data" );
	clear_window_title();

	Gui_imagit()->configure(
		-image => 'logo',
		-width => $logo_image->width,
		-height => $logo_image->height,
	);

	Gui_imagit()->update; Gui_scrolled()->update; Gui_mw()->update;
}

sub show_image
{
	Gui_mw() or return; # not ready to do GUI stuff.

	List_current_item() or return show_default_image();

	clear_window_title();

	my $original_image;
	eval {
		my $oi = Gui_mw()->Photo( 'fullscale',
			-file => List_current_item()->name,
		);
		$original_image = $oi;
	};
	if ( $@ )
	{
		print STDERR "\nDon't worry about the above; it was caused when trying to read the file\n\t".List_current_item()->{'filename'}."\n(which was subsequently removed from the list.)\n\n";
		alert( "Failed to create a Photo object from file\n".List_current_item()->name."\n$@\n\nImage removed from list!" );
		Edit_remove_current();
		goto &show_image;
		#return;
	}

	$original_image or alert( "Failed to create a Photo object from file\n".List_current_item()->name );

	# it's possible to manipulate an image during reading
	# from disk, but unfortunately you don't get quite as
	# much control as you do when copying one image to another,
	# and some of the things we need to do we can only do
	# during copy, not reading.
	my $factor = min(
		factor( $original_image->width,  Gui_scrolled()->width ),
		factor( $original_image->height, Gui_scrolled()->height ),
	) + ( List_current_item()->scalefactor() || 0 );
	my $scaled_image = Gui_mw()->Photo( 'myScaledImage' );
	$scaled_image or return alert( "Failed to create a Photo(myScaledImage)!" );
	$scaled_image->copy( $original_image, -shrink => -subsample => $factor, $factor );
	Gui_imagit()->configure(
		-image => 'myScaledImage', # the (arbitrary) name we have assigned to the image we've stored in memory.
		-width => $scaled_image->width,
		-height => $scaled_image->height,
	);

	# do these later?
	Gui_imagit()->update; Gui_scrolled()->update; Gui_mw()->update;

	( $::iwidth, $::iheight ) = ( $scaled_image->width, $scaled_image->height );
	#( $::iwidth, $::iheight ) = ( Gui_imagit()->width, Gui_imagit()->height );
	# imagit width and height are 4 pixels greater than image width and height.

	my $xmid = List_current_item()->scrolledto_x();
	my $ymid = List_current_item()->scrolledto_y();
	my $xscrollto = $xmid - Gui_scrolled()->width  / ( $::iwidth  * 2 );
	my $yscrollto = $ymid - Gui_scrolled()->height / ( $::iheight * 2 );
	my $kx = Gui_imagit()->width  / $scaled_image->width;
	my $ky = Gui_imagit()->height / $scaled_image->height;
	$kx = 1 + 5 * ( $kx - 1 );
	$ky = 1 + 5 * ( $ky - 1 );
	$xscrollto *= $kx;
	$yscrollto *= $ky;
	$xscrollto <= 0.002 and $xscrollto = 0;
	$yscrollto <= 0.002 and $yscrollto = 0;
	$xscrollto >= 0 and Gui_scrolled()->xview( moveto => $xscrollto );
	$yscrollto >= 0 and Gui_scrolled()->yview( moveto => $yscrollto );
	List_current_item()->update_pos( Gui_scrolled()->xview, Gui_scrolled()->yview );

	set_window_title();
}

sub drag
{
	my( $w, $x, $y ) = @_;
	if ( defined $::last_x )
	{
		my( $xscroll, $yscroll ) = Gui_scrolled()->Subwidget( 'xscrollbar', 'yscrollbar' );
		my( $dx, $dy ) = ( $x-$::last_x, $y-$::last_y );
		my( $xf1, $xf2 ) = $xscroll->get;
		my( $yf1, $yf2 ) = $yscroll->get;
		if ( $dx < 0 )
		{
			Gui_scrolled()->xview( moveto => $xf1-($dx/$::iwidth) );
		}
		else
		{
			Gui_scrolled()->xview( moveto => $xf1-($xf2*$dx/$::iwidth) );
		}
		if ( $dy < 0 )
		{
			Gui_scrolled()->yview( moveto => $yf1-($dy/$::iheight) );
		}
		else
		{
			Gui_scrolled()->yview( moveto => $yf1-($yf2*$dy/$::iheight) );
		}
		List_current_item()->update_pos( Gui_scrolled()->xview, Gui_scrolled()->yview );
	}
	( $::last_x, $::last_y ) = ( $x, $y );
}



sub File_exit { Gui_die_die_die(); }

sub File_open
{
	List_count() and alert("Warning! If you open a slideshow file, you will lose any changes you have made to the current slideshow!");

	my $open_file = Gui_mw()->getOpenFile(
		-defaultextension => '.slideshow',
		-filetypes => [ ['Slideshow Files', '.slideshow' ], ['All Files', '*' ] ],
	) or return;
	List_initialize_from_file( $open_file );
	View_first();
}

sub File_save_as
{
	my $saveas_file = Gui_mw()->getSaveFile(
		-defaultextension => '.slideshow',
		-filetypes => [ ['Slideshow Files', '.slideshow' ], ['All Files', '*' ] ],
		List_slideshow_filename() ? ( -initialfile => List_slideshow_filename() ) : ()
	) or return;
	open F, '>', $saveas_file or return alert("Unable to open file for writing:\n$saveas_file\n$!");
	print F List_as_xml();
	close F;
}

sub File_print_to_stdout
{
	print List_as_xml();
}

sub File_write_onto_clipboard {
	Gui_mw()->clipboardClear;
	List_for_each( sub {
		local $_ = shift;
		Gui_mw()->clipboardAppend($_->name."\n");
	} );
}

sub File_write_batch_copier_onto_clipboard {
	my $dd = defined $::dest_dir ? $::dest_dir : '.';
	if ( ! -d $dd )
	{
		alert( "The dest dir '$dd' does not exist, or is not valid from where you launched the program." );
		return;
	}

	Gui_mw()->clipboardClear;
	Gui_mw()->clipboardAppend(qq{\@echo off\n});
	List_for_each( sub {
		my $fi = shift;
		local $_ = $fi->name;
		s#\/#\\#g;
		Gui_mw()->clipboardAppend( qq{copy /y "}.$_->name.qq{" "$dd"\n} );
	});
	Gui_mw()->clipboardAppend(qq{\@echo on\n});
}


sub Edit_current_toggle_selection # for the current: toggle its selection state
{
	List_current_item()->toggle_selection_state();
	View_next();
}

# if the list storage mode is "use directory of symlinks", then the "Save"
# operation should udpate the directory with the current contents of the list.
# it can use the remove_symlink() function.

sub Edit_remove_current
{
	List_remove_current_item();
	clear_showimage_timer();
	show_image();
}

sub Edit_remove_selected
{
	run_custom_filter('grep','! $_.selected');
	List_clear_selection();
}

sub Edit_remove_unselected
{
	run_custom_filter('grep','$_.selected');
	List_clear_selection();
}


	sub _twiddle_view_pointer
	{
		my $cr = shift; # a sub which sets the List's current index.
		if ( List_count() )
		{
			if ( List_current_item() )
			{
				# the normal situation
				$cr->();
			}
			else
			{
				# unusual: there are items in the list, but $ii==-1
				List_set_index_0();
			}
		}
		else
		{
			List_set_no_current_item(); # should be already, but just to make sure.
		}
		clear_showimage_timer();
		show_image();
	}

sub View_first
{
	_twiddle_view_pointer( \&List_set_index_0 );
	Gui_mw() or return;
	Gui_mw()->focus;
}

sub View_prev
{
	_twiddle_view_pointer( \&List_advance_index );
}

sub View_next
{
	_twiddle_view_pointer( \&List_retreat_index );
}



sub View_zoom_in
{
	List_current_item()->scalefactor() or return; # can only be positive (or rather, non-negative)
	List_current_item()->set_scalefactor( List_current_item()->scalefactor() - 1 );
	clear_showimage_timer();
	show_image();
}

sub View_zoom_out
{
	List_current_item()->set_scalefactor( List_current_item()->scalefactor() + 1 );
	clear_showimage_timer();
	show_image();
}

sub View_no_item
{
	clear_image();
	clear_window_title();
	List_set_no_current_item();
}

sub View_start_slideshow
{
	List_current_item() or return;
	start_autoadvancing();
}
sub View_stop_slideshow
{
	List_current_item() or return;
	stop_autoadvancing();
}


sub ImageFile_edit_current { List_current_item()->external_edit() }

sub ImageFile_rename_current
{
	my $old_name = List_current_item()->property('FileName');
	my $rename_dialog = Gui_mw()->DialogBox( -title => 'Rename Image File', -buttons => [qw( OK Cancel )] );
	$rename_dialog->bind( '<Escape>', sub { $rename_dialog->Subwidget('B_Cancel')->invoke } );
	my $rename_entry = 
	$rename_dialog->add('Frame')->pack( -expand => 1, -fill => 'both' )
	->Entry( 
		-width => 80,
		-validate => 'all',
		-validatecommand => sub {
			local $_ = shift; # proposed new value
			/./ and not /[\\\/:?*"<>|]/;
		},
	)->pack;
	$rename_entry->insert('end',$old_name);
	my $b = $rename_dialog->Show;
	my $new_name = $rename_entry->get;
	$rename_dialog->destroy;
	undef $rename_dialog;
	$b eq 'OK' or return;
	lc($old_name) eq lc($new_name) and $on_Windows and return alert("Sorry, mere case changes are not allowed!");
	rename $old_name, $new_name or return alert(<<EOF);
Error trying to rename
  $old_name
to
  $new_name
$!
EOF
	my $long_name = List_current_item()->property('filename');
	$long_name =~ s/\Q$old_name\E/$new_name/;
	List_current_item()->set_properties({
		FileName => $new_name,
		filename => $long_name,
	});
	set_showimage_timer(); # since title has changed
}

sub ImageFile_delete_current
{
	warn "Going to delete current imagefile!";
	unlink( List_current_item()->name ) or return alert("Failed to remove current file!\n".List_current_item()->name."\n$!");
	Edit_remove_current();
}

sub ImageFile_current_createsymlink
{
	# just do current image, and advance
	undef $@;
	eval {
		my $msg = List_current_item()->create_symlink();
		warn qq(Created symlink "$msg"\n);
		#View_next();
	};
	$@ and warn $@;
}

sub ImageFile_all_createsymlinks
{
	print "Creating ".List_count()." symlinks.\n";
	List_for_each( sub {
		my $f = shift;
		undef $@;
		eval {
			my $msg = $f->create_symlink();
			warn qq(Created symlink "$msg"\n);
		};
		$@ and warn $@;
	});
	print "Done.\n";
}

# also need a "copy selected to..."
sub ImageFile_copy_all_to_destdir
{
	defined $::dest_dir && -d $::dest_dir or return alert("No valid dest dir defined!");
	List_for_each( sub {
		my $fi = shift;
		local $_ = $fi->name;
		s#\/#\\#g; # XXX system specific
		print( qq{copy /y "$_" "$::dest_dir" \n} );
		system( qq{copy /y "$_" "$::dest_dir" \n} );
	});
}

sub ImageFile_view_info
{
	List_current_item()->show_info();
}

} # end of subs


### MAIN PROGRAM!

initialize_data_structures();

Gui_initialize();

MainLoop;



# for more information, visit this project's home page at:
# 	http://www.perlmonks.com/?node_id=600092

=pod TO DO

Enable assigning tags (i.e. keywords) to an image.
Enable filtering by tags. 

Enable assigning a free-text comment to an image.
Enable displaying (overlaying) the comment text on the image.

Improve platform independence.
Get a Better Glob.

Strategize slideshow storage management.
Add strategy for storing a slideshow as a directory of symlinks. Lots of existing code to salvage.

Allow overriding/canceling commands entered on the commandline.
(Obviously, commands which execute immediately aren't eligible.)

Enable setting various config params via commandline switches AND via dialogs.
(e.g. the auto-advance dwell time).

Implement Undo.

Implement an 'ex'-like command interface.
Implement a 'vi'-like command interface.


Support a s/// style of file renaming.
Can re-invoke a stored filename renaming transformation on subsequent files.
Apply a renaming transformation on all of the selection.

Allow selecting (adding to selection) based on a filter.

Add more Selection-aware variants of commands.

Add transition effects. (Idea credit to [bart].)

=cut

__END__
:endofperl