#!/usr/bin/perl
# the line above could be the first line for a typical UNIX systems
# you can find perl on your system by using "which perl" in the shell

# to build an exectuable for windows use this PAR call:
# pp -M Tk::DragDrop::Win32Site -o mapivi.exe mapivi

# to build an exectuable for Linux use this PAR call:
# pp -M Tk::DragDrop::XDNDSite -M Tk::DragDrop::SunSite -M PerlIO -o mapivi.exe mapivi

# include perl packages
use strict;
use Encode::Unicode; # needed according to the PAR FAQ (for perl apps on Microsoft Windows)
use warnings;
#use diagnostics;

# pod (to view the formated document try "perldoc mapivi" in the shell

=head1 NAME

MaPiVi - Picture Viewer and Organizer
         MaPiVi means Martin's Picture Viewer

=head1 DESCRIPTION

JPEG picture viewer / image management system with meta info support
written in Perl/Tk for UNIX, Mac OS X and Windows.

I wrote mapivi just for me, because I needed a image viewer which is
also able to display and edit meta infos of JPEG pictures, like EXIF,
JPEG comments and IPTC/IIM infos.
As hobby photographer I am mostly interested in the EXIF infos (like timestamp,
camera model, focal length, exposure time, aperture, etc.) and the
possibility to add and edit IPTC infos and JPEG comments.
But I also want to rename pictures according to their internal date/time
and to do lossless rotation, lossless cropping and other stuff.

mapivi can be found here:
http://mapivi.de.vu (link to the mapivi site)
or if this won't work:
http://herrmanns-stern.de (real site)
http://sourceforge.net/projects/mapivi (download)

I would be happy to receive some feedback (e.g. on which os mapivi
works), bugfixes, patches or suggestions about mapivi.

Copyright (c) 2002, 2003, 2004, 2005, 2006, 2007, 2008  Martin Herrmann
All rights reserved.

Feel free to redistribute.  Enjoy!

=head1 USAGE

mapivi [-i ] [file|folder]

to display a certain picture use:

mapivi picture.jpg

mapivi will generate and display all pictures in the folder
as thumbnails. The given picture will be displayed in
original size or zoomed to fit the window (picture frame).

to view a folder containing pictures use:

mapivi ~/pics/

mapivi will generate and display all pictures in the given folder
as thumbnails.

to start mapivi with the import wizard

mapivi -i

=head1 KEYS

mapivi is controlled by the following keys:
see also menu Help->Keys (the list is generated from the source
code and is always actual.)

=over 4

=item Space, Page-Down

Show the next picture in folder

=item BackSpace, Page-Up

Show the previous picture in folder

=item Escape

Iconify MaPiVi (Boss-Key :)

=item Cursor-up, -down, -left, -right

Scroll the picture, if it's bigger than the Canvas

=item Shift-Cursor-up, -down, -left, -right

Move to the border of the picture, if it's bigger than the Canvas

=item q

Quit MaPiVi

For all other key bindings, see the menu Help->Keys

=back

=head1 MOUSE

Try the right mouse button in the thumbnail picture list for a popup menu to copy, move, rename, rotate or delete pictures, to open a new folder, to add or remove comments or to exit MaPiVi.

Use the buttons to add, edit or remove JPG comments, or to display all EXIF infos.

If you hold the mouse over the buttons or labels a help message will pop up (or at least at most of them :).

=cut

# boolean, if we run on Windows  this variable is set to 1
my $EvilOS = 0; $EvilOS = 1 if ($^O =~ m/win/i);
my $MacOSX = 0; # boolean, if we run on Mac OS X this is 1
if ($^O =~ m/darwin/i) { # Mac OS X is not evil, but unfortunately contains the string "win"!
 $MacOSX = 1;
 $EvilOS = 0;
}

my $home = glob("~");
use Env;
if ($EvilOS) {
  $home = $ENV{HOME} if defined  $ENV{HOME};
  $home = $ENV{HOMEDRIVE}.$ENV{HOMEPATH} if (!-d $home and (defined $ENV{HOMEDRIVE} and defined $ENV{HOMEPATH}));
  $home = "C:/" if (!-d $home);
  die "mapivi can not find a home dir" if (!-d $home);
}
my $maprogsdir  = "$home/.maprogs";       # the main config dir for my programms
if (($EvilOS) and (defined $ENV{APPDATA}) and ($maprogsdir ne $ENV{APPDATA}."/maprogs")) {
  # migration from the old config dir to the new only for windows
  if (-d "$maprogsdir/mapivi") {
	my $olddir     = "$maprogsdir/mapivi";
	my $newdir     = $ENV{APPDATA}."/maprogs/mapivi";
	warn "\nMapivi 0.3.6: Error!\n\nYou still have the old Mapivi config folder:\n$olddir,\n\n1) please create a new folder for the configuration here:\n   $newdir,\n2) copy all folders and files from the old folder to the new one\n3) delete the old folder and then\n4) restart Mapivi.\n\nKindly excuse this inconvenience! (will exit in 30 seconds)\n";
	sleep 30;
	exit;
  }
}
# for windows we use this path
$maprogsdir     = $ENV{APPDATA}."/maprogs" if defined $ENV{APPDATA};
my $configdir   = "$maprogsdir/mapivi";   # the configuration dir
my $icon_path   = "/usr/local/share/mapivi/icons";     # the icon dir

my $splashAvail = (eval "require Tk::Splash")  ? 1 : 0 ;
my $splash;
my $logo = "/usr/local/share/mapivi/pics/logo.jpg";
if ($splashAvail and -f $logo and -d $configdir) {
  # Splash->Show parameters: $image, $width, $height, $title, $overrideredirect
  $splash = Tk::Splash->Show($logo, 844, 259, "", 1);
}

use File::Basename;
use POSIX qw(ceil);
use Cwd qw(cwd abs_path);

my $verbose = 0;   # boolean (1 = print debug infos, 0 = be quiet)

# get version from RCS version
my @RCSVersion  = split / /, '$Revision: 9.7 $';
my $version     = "0.".$RCSVersion[1];
$main::VERSION  = $version;
my $mapiviInfo  = "<a href=\"http://mapivi.de.vu\" title=\"gallery produced by mapivi $version\">mapivi</a>";

showCopyright();

#use Encode qw(is_utf8 encode decode);
use Encode;
#use encoding "utf8"
#use utf8;
use Getopt::Std;
our($opt_i);
$Getopt::Std::STANDARD_HELP_VERSION = 1;
use File::Copy;
use File::Find;
use File::Path;  # for rmtree, mkpath
use Text::Wrap;
use Tk;
use Tk::JPEG;
use Tk::PNG;
use Tk::HList;
use Tk::ItemStyle;
use Tk::ROText;
use Tk::ProgressBar;
use Tk::IO;
use Tk::ErrorDialog;
use Tk::Balloon;
use Tk::DirTree;
use Tk::Font;
use Tk::Pane;
use Tk::Tiler;
use Tk::NoteBook;
use Tk::FileSelect;
use Image::Info qw(image_info dim);
use Storable qw(nstore retrieve dclone);
use Tk::Adjuster;
use Tk::DragDrop;
use Tk::DropSite;
use Tk::Compound; # for icons in the menues
#use Image::ExifTool;

# this will be used in future to provide a multilanguage mapivi
# keywords: i18n, gettext
#use Locale::TextDomain ('mapivi', $configdir."/locale");
#use POSIX qw(locale_h);
#setlocale (LC_MESSAGES, '');

use Image::MetaData::JPEG;
# disable warnings from this module
$Image::MetaData::JPEG::show_warnings = 0; # todo: use metadatawarn to switch this
my $metadataVersionNeeded = 0.14;
my $metadataVersion       = $Image::MetaData::JPEG::VERSION;
$metadataVersion          =~ s/[a-zA-Z]//g;
die "Aborting, because Mapivi needs at least version $metadataVersionNeeded of perl module Image::MetaData::JPEG!\n(installed version: $metadataVersion)\n" if ($metadataVersion < $metadataVersionNeeded);

use Time::Local; # timelocal()
#use Tk::Date; # not in the Tk distro

# This should prevent opening DOS boxes on windows when doing background tasks, but does not work. ToDo
#my $win32Avail = (eval "require Win32") ? 1 : 0;
#SetChildShowWindow() if ($EvilOS and $win32Avail);


# optional modules

# seems not to work so I comment it out for a future test
#my $win32FOAvail = (eval "require Win32::FileOp")    ? 1 : 0;
my $win32FOAvail = 0;

my $exiftoolAvail  = (eval "require Image::ExifTool") ? 1 : 0;

my $resizeAvail  = (eval "require Tk::ResizeButton") ? 1 : 0;

my $filespecAvail  = (eval "require File::Spec") ? 1 : 0;

use constant Win32ProcAvail => eval { require Win32::Process; 1 };

use constant MatchEntryAvail => eval { require Tk::MatchEntry; 1 };

#use Time::HiRes qw(gettimeofday tv_interval); # needed just for debugging
#my $hiresstart;

# constants
use constant WITH_PATH => 1;
use constant JUST_FILE => 0;
use constant LONG      => 1;
use constant SHORT     => 0;
use constant WRAP      => 1;
use constant NO_WRAP   => 0;
use constant FORMAT    => 1;
use constant NO_FORMAT => 0;
use constant NUMERIC   => 1;
use constant STRING    => 0;
use constant WAIT      => 1;
use constant NO_WAIT   => 0;
use constant TOUCH     => 1;
use constant NO_TOUCH  => 0;
use constant OVERWRITE => 1;
use constant ASK_OVERWRITE => 0;
use constant ASK       => 1;
use constant NO_ASK    => 0;
use constant PREVIEW   => 1;
use constant NO_PREVIEW => 0;
use constant SHOW       => 1;
use constant NO_SHOW    => 0;
use constant COPY       => 0;
use constant BACKUP     => 1;
use constant TRASH      => 0;
use constant REMOVE     => 1;
use constant OK         => 1;
use constant CANCEL     => 0;
use constant ADD        => 1;
use constant RESET      => 0;
use constant PIXEL      => 0;
use constant ASPECT_RATIO => 1;
use constant RELATIVE   => 2;
use constant SINGLE     => 0;
use constant MULTIPLE   => 1;
use constant COPY       => 0;
use constant MOVE       => 1;
use constant RENAME     => 2;

# function prototypes
sub progressWinInit($$);
sub progressWinCheck($);
sub progressWinUpdate($$$$);
sub progressWinEnd($);
sub updateOneRow($$);
sub insertPic($$$);
sub checkDateFormat($);
sub checkGeometry($);
sub checkTempFile($);
sub checkWriteable($);
sub getRealFile($);
sub getThumbFileName($);
sub addComment($);
sub addCommentToPic($$$);
sub buildBackupName($);
sub makeBackup($);
sub getIPTCByLine($);
sub doubleList($$$$);
sub overwrite($$);
sub copyPicsDialog($$);
sub getDirDialog($);
sub is_a_JPEG($);
sub setProperty($$$);
sub formatString($$$);

# globals
my @dirHist;             # folder history - stores the last folders visited
my @cachedPics;          # a list of all cached pictures
my @savedselection;
my @savedselection2;

# search database: hash to store all the data of all pictures in the visited folders (comments, EXIF, IPTC)
my %searchDB;
# folder checklist: hash to store properties of folders (key: dir value: hash SORT, META, PRIO, COMM)
my %dirProperties;
# hash to store all loaded photo objects (real size or zoomed) key = path/file name, value = photo object
my %photos;
# hash to store all loaded thumbnail photo objects key = path/file name, value = photo object
my %thumbs;
my %searchthumbs;# hash containing all thumbnails of the search dialog, for memory clean up
my %light_table_thumbs;# hash containing all thumbnails of the light table, for memory clean up
my %thumbDBhash; # store the thumb dirs for one session: dir -> thumbdir
my %dirHotlist;  # often visited dirs
# minimum set of the hot dirs
foreach my $dir ("/", $home, cwd()) {
  $dirHotlist{$dir} = 1 unless (defined $dirHotlist{$dir});
}

my %quickSortHash;
my %quickSortHashSize;
my %quickSortHashPixel;
my %quickSortHashBitsPixel;
my $quickSortSwitch =  0;

my $actpic          = ""; # the path and file name of the actual picture
my $actdir          = ""; # the actual folder
my $widthheight     = "";
my $loadtime        = "";
my $size            = "";
my $zoomFactorStr   = "";
my $urgencyStr      = "-";
my $urgencyScale    = 0;
my $nrof            = "";
my $exif            = "";
my $userinfo        = "";
my $otherFiles      = "";
my $proccount       = 0;
my $nrToConvert     = 0;
my $maxCommentLength = 2**16 - 3; # a comment block may have max 64kB

my $trashdir        = "$configdir/trash";     # the trashcan
my $plugindir       = "/usr/local/share/mapivi/PlugIns";   # the mapivi plugin dir
my $iptcdir         = "$configdir/IPTC_templates";  # the IPTC templates folder
my $configFile      = "$configdir/mapivirc";  # the configuration file
my $file_Entry_values = "$configdir/Entry_values";
my $exifdirname     = ".exif";                # the subdir to store exif infos
my $thumbdirname    = ".thumbs";              # the subdir to store thumbnails
my $xvpicsdirname   =  ".xvpics";             # a subdir from GIMP we usualy ignore
my $thumbExample    = "$configdir/thumbExample.jpg";
my $nonJPEGsuffixes = "gif|png|tif|tiff|bmp|ppm|ps";    # xcf works, but makes problems with layers
my $cameraJunkSuffixes = "ctg"; # uninteresting files created by cameras
my $copyright_year            = (localtime(time()))[5] + 1900; # the actual year, for the copyright notice
my $HTMLPicDir      = "pics";   # this is the name of the subdir for pics when building html pages
my $HTMLThumbDir    = "thumbs"; # this is the name of the subdir for thumbs when building HTML pages
my $slideshow       = 0;   # start/stop flag for slideshow
my $showPicInAction = 0;   # bool = 1 while loading picture
my $mapiviURL       = "http://mapivi.de.vu";
my %topFullSceenConf;
my $topFullScreen = 0;
my %winapps;                # used for sub findApp()

my $defaultthumbP;
my $clocktimer;
my $time;
my $date;
my $clockL;
my $scsw;
my $wizW;
my $impW;
my $interpW;
my $fuzzybw;            # fuzzy border dialod window
my $ll_b_w;             # lossless border dialog window
my $ll_r_w;             # lossless relative border dialog window
my $ll_a_w;             # lossless aspect ratio border dialog window
my $ll_w_w;             # lossless watermark dialog window
my $bpw;                # border preview window
my $ow;                 # options window, see sub options()
my $sw;                 # the search window, see searchMetaInfo()
my $dpw;                # the dir properties window, see showDirProperties()
my $dsw;                # the dir size window
my $ltw;                # the light table window for slideshows
my @light_table_list;   # the light table slideshow pic list
my $ddw;                # dirDiffWindow widget
my $catw;               # the IPTC categories window, see editIPTCCategories()
my $keyw;               # the IPTC keywords window, see editIPTCKeywords()
my $locw;               # the location window, see search_by_location()
my $keycw;              # the comment keywords window, see editCommentKeywords()
my $dupw;               # the duplicate search window, see sub finddups()
my $filterW;            # the filter window
my $menubar;            # handle for menubar of main window
my $balloon;            # balloon handle
my $dirMenu;            # context menu for dirs
my $thumbMenu;          # context menu for thumbnails
my $picMenu;            # context menu for picture
my $copyEXIFDataSource; # global variable of sub copyEXIFData()
my $copyCommentSource;  # global variable of sub copyComment()
my $iptcCopy;           # global hash ref for copyIPTC()
my ($idx, $idy);        # coordinates of actual item when clicked on or moved
my ($width, $height);
my %nonJPEGdirNoAskAgain; # hash to store the dirs with non-JPEG files not to convert (valid for one session)
#my $stopButStop = 0;    # stop actual action if 1
my $cleanDirNoAsk = 0;  # needed in sub cleanDir()
my $cleanDirLevel = 0;  # needed in sub cleanDir()
my $keyXBut;            # close button of IPTC keyword window 

# some example hierarchical categories
my @precats = sort qw(Nature Nature/Flower Nature/Landscape Nature/Macro Nature/Animal Nature/Animal/Fish Nature/Animal/Cat Nature/Animal/Insect Nature/Animal/Insect/Ant People People/Portrait People/Wedding Architecture Architecture/Tower Architecture/Bridge Architecture/Church Technology Technology/Car Technology/Train Technology/Computer);
# overwrite them, when some stored categories are available
@precats = readArrayFromFile("$configdir/categories") if (-f "$configdir/categories");
uniqueArray(\@precats);                  # remove double entries
foreach (@precats) { $_ =~ s|^/||; }     # cut leading slash
@precats = qw(Nature) unless (@precats); # add a starting point if array is empty

# some example hierarchical keywords
my @prekeys = qw(Family Family/Einstein Family/Einstein/Albert Family/Einstein/Hermann Family/Einstein/Pauline Family/Planck Family/Planck/Max Family/Planck/Johann Family/Planck/Marie Family/Planck/Karl Family/Planck/Grete Family/Planck/Emma Family/Planck/Erwin Family/Planck/Hermann Friend Friend/Bundy Friend/Bundy/Al Friend/Bundy/Bud Friend/Bundy/Kelly Friend/Bundy/Peggy);
# overwrite them, when some stored keywords are available
@prekeys = readArrayFromFile("$configdir/keywords") if (-f "$configdir/keywords");
uniqueArray(\@prekeys);                  # remove double entries
foreach (@prekeys) { $_ =~ s|^/||; }     # cut leading slash
@prekeys = qw(Family) unless (@prekeys); # add a starting point if array is empty
# global hash for new keywords found in displayed pictures
my %new_keywords;
# global hash to store keywords, which should be ignored (e.g. nature.animal.dog)
my %ignore_keywords;

# external programs used by mapivi
my %exprogs = qw/convert 0 composite 0 jhead 0 jpegtran 0 jpegpixi 0 mogrify 0 gimp 0 montage 0 identify 0 exiftool 0/;
# short comment about the usage of the external programs
my %exprogscom = (
		   "convert"        => "build thumbnails",
		   "composite"      => "combine pictures e.g. thumbnails with a background",
		   "jhead"          => "handle EXIF infos and embedded thumbnail pictures",
		   "jpegtran"       => "do lossless rotation of pictures",
		   "jpegpixi"       => "do nearly lossless interpolation (remove dead pixels)",
		   "mogrify"        => "change the size/quality of pictures",
		   "montage"        => "combine pictures to e.g. index prints",
		   "gimp"   	    => "edit pictures with The GIMP (only UNIX)",
		   "identify"       => "describe the format and characteristics of a picture",
		   "thunderbird"    => "send pictures via email",
		   "exiftool"       => "Read/write meta information in image files",
		  );
# where to find the external programs (resources)
my %exprogsres = (
		   "convert"        => "Image Magick http://www.imagemagick.org",
		   "composite"      => "Image Magick http://www.imagemagick.org",
		   "jhead"          => "http://www.sentex.net/~mwandel/jhead/",
		   "jpegtran"       => "libjpeg http://www.ijg.org",
		   "jpegpixi"       => "http://www.zero-based.org/software/jpegpixi/",
		   "mogrify"        => "Image Magick http://www.imagemagick.org",
		   "montage"        => "Image Magick http://www.imagemagick.org",
		   "gimp"           => "The GIMP http://www.gimp.org",
		   "identify"       => "Image Magick http://www.imagemagick.org",
		   "thunderbird"    => "http://www.mozilla.org/projects/thunderbird/",
		   "exiftool"       => "http://owl.phy.queensu.ca/~phil/exiftool/",	
		  );

# hash to replace (german) umlaute by corresponding letters
my %umlaute = qw( ae  Ae  oe  Oe  ue  Ue  ss);
my $umlaute = join "", keys(%umlaute);

# stolen from Image::ExifTool (thanks to Phil Harvey)
my %iptcCharset = (
    "\x1b%G"  => 'UTF8',
   # don't translate these (at least until we handle ISO 2022 shift codes)
   # because the sets are only designated and not invoked 
   # "\x1b,A"  => 'Latin',  # G0 = ISO 8859-1 (similar to Latin1, but codes 0x80-0x9f are missing)
   # "\x1b-A"  => 'Latin',  # G1     "
   # "\x1b.A"  => 'Latin',  # G2
   # "\x1b/A"  => 'Latin',  # G3
);

# hash to replace (german) umlaute by corresponding HTML-tags
my %umlauteHTML = qw( &auml;  &Auml;  &ouml;  &Ouml;  &uuml;  &Uuml;  &szlig;);
my $umlauteHTML = join "", keys(%umlauteHTML);

# hash to escape special HTML characters
my %htmlChars = (
	"<"	=> "&lt;",
	">"	=> "&gt;",
	"&"	=> "&amp;",
	"\""	=> "&#34;",
	"'"	=> "&#39;",
	);
my $htmlChars = join "", keys(%htmlChars);

# config hash
# insert here all default configurations
# these configurations will be overwritten by $configFile
# at startup
my %config = (
			  "Geometry"        => "790x560+1+1", # fit on a 800x600 screen
			  "SearchGeometry"  => "790x560+1+1", # fit on a 800x600 screen
			  "KeyGeometry"     => "250x500+50+50", # fit on a 800x600 screen
			  "LocGeometry"     => "250x500+50+50", # fit on a 800x600 screen
			  "LtwGeometry"     => "700x500+10+10", # fit on a 800x600 screen
			  "FontSize"        => 12,
			  "FontFamily"      => "itc avant garde",
			  "PropFontSize"    => 12,
			  "PropFontFamily"  => "helvetica",
			  "ColorFG"         => "black",
			  "ColorBG"         => "#efefef",
			  "ColorMenuBG"     => "LightGoldenrod3",
			  "ColorMenuFG"     => "black",
			  "ColorBG2"        => "#e5e5e5",
			  "ColorBGCanvas"   => "#efefef",
			  "ColorHlBG"       => "#eeeeee",
			  "ColorActBG"      => "LightGoldenrod1",
			  "ColorEntry"      => "gray90",
			  "ColorSel"        => "LightGoldenrod2",
			  "ColorSelBut"     => "red3",
			  "ColorSelFG"      => "black",
			  "ColorName"       => "black",
			  "ColorComm"       => "black",
			  "ColorIPTC"       => "black",
			  "ColorEXIF"       => "black",
			  "ColorFile"       => "black",
			  "ColorDir"        => "black",
			  "ColorThumbBG"    => "azure3",
			  "ColorProgress"   => "#106dba",
			  "ColorPicker"     => "#efefef", # last color selected with color picker
		          "DefaultThumb"    => "/usr/local/share/mapivi/pics/EmptyThumb.jpg",
			  "Copyright"       => "copyright (c) $copyright_year Herrmann",
			  "Comment"         => "This picture was taken in south africa ...",
			  "MaxProcs"        => 1,
			  "MaxCachedPics"   => 3,
			  "NrOfRuns"        => 0,  # count how often mapivi was started
			  "ShowPic"         => 1,  # boolean (1 = show pic, 0 = do not show pic)
			  "ShowThumbs"      => 1,  # boolean (1 = show thumbs, 0 = show default thumb)
			  "UseDefaultThumb" => 1,  # boolean (1 = show def thumb if no thumb is shown, 0 = show nothing at all)
			  "ThumbCapt"       => "none", # thumbnail caption
			  "ThumbCaptFontSize" => 10,
			  "ShowDirTree"     => 1,  # boolean (1 = show dir tree, 0 = hide)
			  "ShowInfoFrame"   => 1,  # boolean (1 = show info frame, 0 = hide)
			  "ShowThumbFrame"  => 1,  # boolean (1 = show thumb frame, 0 = hide)
			  "ShowPicFrame"    => 1,  # boolean (1 = show pic frame, 0 = hide)
			  "ShowComment"     => 1,  # boolean (1 = show comment, 0 = hide comment in thumbnail view)
			  "ShowCommentField"=> 0,  # boolean (1 = show comment, 0 = hide comment in picture view)
			  "ShowCaptionField"=> 0,  # boolean (1 = show IPTC captiob, 0 = hide caption in picture view)
			  "ShowEXIF"        => 1,  # boolean (1 = show EXIF, 0 = hide EXIF in thumbnail view)
			  "ShowEXIFField"   => 0,  # boolean (1 = show EXIF, 0 = hide EXIF in picture view)
			  "ShowIPTC"        => 1,  # boolean (1 = show IPTC, 0 = hide IPTC in thumbnail view)
			  "ShowFile"        => 1,  # boolean (1 = show Size, 0 = hide Size in thumbnail view)
			  "ShowDirectory"   => 1,  # boolean (1 = show directory, 0 = hide dir in thumbnail view)
			  "ShowMenu"        => 1,  # boolean (1 = show menu, 0 = hide the menu bar)
			  "ShowHiddenDirs"  => 0,  # boolean (1 = show hidden dirs (starting with .), 0 = hide them)
			  "Overrideredirect"=> 0,  # boolean (1 = no window frame, 0 = window frame)
			  "PicQuality"      => 95, # quality of jpg picture (in %)
			  "PicSharpen"      => 5,  # sharpness of picture
			  "PicBlur"         => 0,  # blur the pictur
			  "PicGamma"        => 1.0,# gamma value of picture
			  "PicBrightness"   => 100,# Brightnes of picture (in %)
			  "PicSaturation"   => 100,# Saturation of picture (in %)
			  "PicHue"          => 100,# Hue of picture (in %)
                          "PicStrip"        => 0,  # boolean (1 = strip all meta info when resizing pic)
			  "ThumbQuality"    => 85, # quality of thumbnail jpg picture
			  "SortBy"          => "name",
			  "SortReverse"     => 0,
			  "LastDir"         => $home,
			  "FileNameFormat"   => "%y%m%d-%h%M%s", # the actual file name format when renaming
			  "FileNameFormatDef"=> "%y%m%d-%h%M%s", # the default file name format when renaming
			  "ThumbSharpen"    => 1,
			  "ThumbSize"       => 100,
			  "ThumbBorder"     => 4,
			  "HTMLaddComment"  => 1,
			  "HTMLaddEXIF"     => 1,
			  "HTMLaddIPTC"     => 1,
			  "HTMLcols"        => 2,
			  "HTMLTargetDir"   => $home,
			  "HTMLGalleryIndex"=> "../galleries.html",
			  "HTMLGalleryTitle"=> "My gallery",
			  "HTMLHomepage"    => "../../index.shtml",
			  "HTMLTemplate"    => "$configdir/pagetemplate.html",
			  "HTMLFooter"      => "&copy; <a href=\"http://herrmanns-stern.de\">Martin Herrmann</a> <a href=\"mailto:Martin-Herrmann\@gmx.de\">&lt;Martin-Herrmann\@gmx.de&gt;</a>",
			  "HTMLBGcolor"     => "white",
			  "HTMLPicSize"     => 600,
			  "HTMLPicSharpen"  => 1,
			  "HTMLPicCopyright"=> 0,   # bool - add a visible copyright info into the picture
			  "HTMLPicQuality"  => 80,  # quality of html jpg pictures
			  "HTMLPicEXIF"     => 1,   # bool - 1 = copy the EXIF infos to the converted HTML pics
              "HTMLnoPicChange" => 0,   # bool - 1 = no pic changes (no resize etc ...)
			  "AutoZoom"        => 1,   # boolean - zoom big pictures to fill the canvas
			  "UseEXIFThumb"    => 0,   # boolean - use EXIF Thumbnails if available
			  "AskGenerateThumb"=> 1,   # ask before generating thumbnails
			  "AskDeleteThumb"  => 1,   # ask before deleting thumbnails
			  "AskMakeDir"      => 1,   # ask before makeing a directory (e.g. .thumbs or .exif)
			  "MaxTrashSize"    => 50,  # MB - a warning will appear if the trash contains more than this
			  "BitsPixel"       => 0,   # boolean - show bits per pixel info
			  "AspectRatio"     => 1,   # boolean - show image aspect ratio e.g. 4:3 or 3:2
			  "NameComment"     => 0,   # boolean - 1 = add file name to comment, when importing pics
			  "NameComRmSuffix" => 1,   # boolean - 1 = remove file suffix when adding filename to comment
			  "ShowClock"       => 1,   # boolean - 1 = show actual time
			  "SaveDatabase"    => 1,   # boolean - 1 = save dir info to a file
			  "UseThumbShadow"  => 0,
			  "MakeBackup"      => 1,   # make a backup of the original file, before appling a filter
			  "PicListFile"     => "$home/filelist",
			  "XMLFile"         => "$home/IPTCinfo.xml",
			  "saveEXIFforEdit" => 0,   # save the EXIF info before editing the picture with GIMP (needed for GIMP version 1.3.15 and lower)
			  "indexRows"       => 2,   # indexPrint
			  "indexCols"       => 2,   # indexPrint
			  "indexPicX"       => 500, # indexPrint
			  "indexPicY"       => 500, # indexPrint
			  "indexDisX"       => 10,  # indexPrint
			  "indexDisY"       => 10,  # indexPrint
			  "indexBG"         => "white",   # indexPrint background color
			  "indexLabel"      => 1,   # indexPrint
			  "indexLabelStr"   => "%f (%wx%h, %b)",   # indexPrint
			  "WarnBeforeResize"=> 1,   # warn before using mogrify in resize
			  "ShowMoreEXIF"    => 0,   # show more EXIF infos: contrast sharpness saturation metering wb in thumbnail list ...
			  "IPTCoverwrite"   => 0,   # overwrite IPTC attributes, when editing multiple pictures
			  "IPTCmergeCatKey" => 1,   # merge categories and keywords, when editing multiple pictures
			  "IPTCdateEXIF"    => 0,   # use EXIF date as creation date
			  "IPTCtimeEXIF"    => 0,   # use EXIF time as creation time
			  "IPTCbylineEXIF"  => 0,   # use EXIF owner as ByLine
			  "IPTCaddMapivi"   => 0,   # add Mapivi infos to IPTC
			  "IPTC_action"     => 'UPDATE', # ADD UPDATE or REPLACE
			  "CheckForNonJPEGs"=> 0,   # check if there are non JPEGs in the dir and ask to convert them
			  "ShowPicInfo"     => 1,   # show a balloon info box with EXIF, comment, ... for the actual picture
			  "SearchPattern"   => "",  # the search pattern
			  "SearchExPattern" => "",  # the search exclude pattern
			  "SearchCom"       => 1,   # search in the picture comments
			  "SearchExif"      => 1,   # search in the picture EXIF info
			  "SearchIptc"      => 1,   # search in the picture IPTC info
			  "SearchKeys"      => 1,   # search in the picture keywords
			  "SearchName"      => 1,   # search in the picture file name
			  "SearchDir"       => 1,   # search in the picture path
			  "SearchCase"      => 0,   # search case sensitive
			  "SearchWord"      => 0,   # 1 = search only complete words 0 = match also parts
			  "SearchType"      => 'exactly', # search type: "exactly", "all" or "any"
			  "SearchOnlyInDir" => 0,   # search only in dirs matching the actual/selected dir
			  "SearchUrgencyOn" => 0,   # search for pictures with a certain IPTC urgency level
			  "SearchUrgency"   => 0,   # search only for pictures with this IPTC urgency level
			  "SearchUrgencyRel"=> '<=',# <=, ==, >=
			  "SearchPixelOn"   => 0,   # search for pictures with a certain pixel size
			  "SearchPixel"     => 0,   # 
			  "SearchPixelRel"  => '<=',   # <=, ==, >=
			  "SearchPopOn"     => 0,   # search for pic with a certain number of views
			  "SearchPopRel"    => 0,   # <=, ==, >=
			  "SearchPop"       => 0,   # search for pic with a certein numer of views
			  "SearchJoin"      => 0,   # join comment, EXIF, IPTC and filename before searching
			  "SearchDate"      => 0,   # search pics by date
			  "SearchDateStart" => "01.01.1970",   # start date
			  "SearchDateEnd"   => "25.08.2010",   # end date
                          "SearchMore"      => 0,   # show more search options in search window 
			  "SearchDBOnlyNew" => 0,   # add only new pics when building DB
			  "CopyPosition"    => 'SouthEast', # position of the visible copyright info
			  "CopyX"           => 20,  # x offset of the visible copyright info
			  "CopyY"           => 20,  # Y offset of the visible copyright info
			  "CopyAdd"         => 0,   # bool - add a visible copyright info
			  "CopyFontFamily"  => "Courier",  # font family of the embedded copyright info
			  "CopyFontSize"    => 12,  # font size of the embedded copyright info
			  "CopyFontColFG"   => "white",  # foreground color of the embedded copyright info font
			  "CopyFontColBG"   => "black",  # background color of the embedded copyright info font
			  "CopyFontShadow"  => 1,  # bool - add a shadow to the copyright text
			  "CopyrightLogo"   => "$configdir/MapiviIcon.gif",
			  "CopyTextOrLogo"  => "text",
			  "BorderWidth1x"   => 10,      # border 1 width in x direction
			  "BorderWidth1y"   => 10,      # border 1 width in y direction
			  "BorderColor1"    => "white", # border 1 color
			  "BorderWidth2x"   => 0,       # border 2 width in x direction
			  "BorderWidth2y"   => 0,       # border 2 width in y direction
			  "BorderColor2"    => "black", # border 2 color
			  "BorderWidth3x"   => 0,       # border 3 width in x direction
			  "BorderWidth3y"   => 0,       # border 3 width in y direction
			  "BorderColor3"    => "white", # border 3 color
			  "BorderWidth4x"   => 0,       # border 4 width in x direction
			  "BorderWidth4y"   => 0,       # border 4 width in y direction
			  "BorderColor4"    => "gray80",# border 4 color
			  "BorderAdd"       => 0,   # bool - add a border
			  "DropShadow"      => 0,   # bool - add a drop shadow
			  "DropShadowWidth" => 5,   # the width of the drop shadow
			  "DropShadowBlur"  => 3,   # the blur sigma factor of the drop shadow
			  "DropShadowBGColor" => "white",  # the background color of the drop shadow
			  "jpegtranTrim"    => 0,   # bool - use the -trim switch of jpegtran
			  "SlideShowTime"   => 4,   # pause between picture loading im sec
			  "CropAspect"      => 3/2, # 0 for no aspect ratio, 3/2 for 3:2 1 for 1:1 4/3 for 4:3
			  "CropGrid"        => 1,   # bool show 1/3 crop grid
			  "AspectSloppyFactor" => 2.0, # delta factor for aspect ratio calculation in %
			  "FilterDeco"      => 0,   # add a border or a text to the pictures when filtering
			  "FilterPrevSize"  => 200, # filter preview size (100% zoom crop of the picture)
			  "EXIFshowApp"     => 1,   # show App*-Info and MakerNotes and ColorComponents in EXIF info
			  "AddMapiviComment"=> 0,   # add a comment to pictures created/processed by mapivi
			  "Layout"          => 0,   # layout of the dir, thumb and picture frame
			  "Layout0dirX"     => 25,  # default percentual width of the different layouts
			  "Layout0thumbX"   => 30,  # ""
			  "Layout1dirX"     => 20,  # ""
			  "Layout3thumbX"   => 20,  # ""
			  "Layout5dirX"     => 20,  # ""
			  "CommentHeight"   => 2,   # height of the comment text frame above the picture
			  "Gamma"           => 1.0, # the gamma value, when displaying pictures
			  "ShowFileDate"    => 0,   # show the file date in the size coloumn
			  "Unsharp"         => 0,   # bool unsharp mask operation on/off
			  "UnsharpRadius"   => 0,   # unsharp mask radius (blur)
			  "UnsharpSigma"    => 1.0, # unsharp mask sigma (blur)
			  "UnsharpAmount"   => 1.0, # unsharp mask amount
			  "UnsharpThreshold"=> 0.05,# unsharp mask threshold
			  "ResizeFilter"    => "Lanczos",
			  "RenameBackup"    => 1,   # bool, if 1 a backup file will be renamed if the file is renamed
			  "ThumbMaxLimit"   => 200, # maximum number of displayed thumbnails
			  "Level"           => 0,   # level a picture
			  "LevelBlack"      => 8,   # level a picture black point (%)
			  "LevelWhite"      => 92,  # level a picture white point (%)
			  "LevelGamma"      => 1.0, # level a picture mid point (gamma value)
			  "indexBorder"     => 0,   # bool add a border around the index print
			  "indexBorderWidth"=> 50,
			  "indexBorderColor"=> 'white',
			  "indexInnerBorder"     => 0,   # bool add a border around the each picture
			  "indexInnerBorderWidth"=> 2,
			  "indexInnerBorderColor"=> 'black',
			  "indexFontSize"   => 10,  # the font size of the index labels (0 = automatic)
			  "CheckForLinks"   => 1,   # bool - check if a file is a link before processing it
			  "ColorAdj"        => 0,   # bool - do some color adjustments when filtering a pic
			  "LineLimit"       => 8,   # max nr of lines in the thumbnail table e.g. for comments
			  "LineLength"      => 30,  # length of one line in the thumbnail table e.g. for comments
			  "ExtViewer"       => 'display', # name of external picture viewer
			  "ExtViewerMulti"  => 0,   # bool
			  "ConvertUmlaut"   => 1,   # convert german umlaute (e.g.  -> ae etc.)
			  "DeadPixelStr"    => "1300,846,3 85,411,3 7,365,3 1529,185,3 1593,201,3 1387,1003,3 1957,1057,3 50,1043,2 615,935,3", # info about the dead pixels of your camera see: http://www.zero-based.org/software/jpegpixi/
			  "DeadPixelMethod" => "linear",
              "ShowCoordinates" => 0,
              "ImportSource"    => "/mnt/usb/DCIM/DIMG",
              "ImportSubdirs"   => 0,  # bool - import also from all subdirs
              "ImportTargetFix" => "$home/pictures",
              "ImportTargetVar" => "2008/02/14_Birthday_Sam",
              "ImportDeadPixel" => 1,
              "ImportRotate"    => 1,
              "ImportRename"    => 1,
			  "ImportDeleteCameraJunk" => 0,
              "ImportDelete"    => 1,
              "ImportShowPics"  => 1,
              "ImportAddCom"    => 0,
              "ImportAddComment"=> "(c) $copyright_year Martin Herrmann",
              "ImportAddIPTC"   => 0,
              "ImportIPTCTempl" => 'template.iptc2',
              "ImportMore"      => 0,  # bool - show additional import options in wizard 
              "ImportMarkLocked"=> 0,  # bool - add a high rating to locked (= write protected) pictures during import
			  "Borderwidth"     => 1,  # border width of GUI elements (widgets)
			  "PrintBaseDir"    => "$home/pictures/print",
			  "PrintVarDir"     => "3_times_13x18",
			  "PrintTimes"      => "1",
			  "PrintTimesStr"   => "times",
			  "PrintSize"       => "10x15",
			  "CenterThumb"     => 0,    # move the thumbnails up or down, so that the next e.g. previous thumb is also visible
			  "ShowNextPicAfterDel" => 0, # open and display next pic after a delete
			  "BeepWhenLooping" => 1,    # play a beep when looping to the first e.g. last picture
			  "SlowButMoreFeatures" => 0, # enable some features slowing down mapivi
			  "setEXIFDateAskAgain" => 0, # show/don't show ask dialog
			  "EXIFDateAbs"     => "2008:02:20-18:51:45",
			  "EXIFPlusMin"     => "+",   # used in setEXIFdate
			  "EXIFAbsRel"      => "abs", # used in setEXIFdate
			  "EXIFyears"       => 0,     # used in setEXIFdate
			  "EXIFdays"        => 0,     # used in setEXIFdate
			  "EXIFhours"       => 0,     # used in setEXIFdate
			  "EXIFmin"         => 0,     # used in setEXIFdate
			  "EXIFsec"         => 0,     # used in setEXIFdate
			  "RotateThumb"     => 1,     # bool - rotate thumb when rotating the pic
			  "ToggleBorder"    => 0,     # bool - switch window decoration on/off in fullscreen mode
			  "CentralThumbDB"  => 0,     # bool - 1 = central thumb DB, 0 = decentral .thumbs dirs
			  "IPTCLastPad"     => "cap", # remember the NoteBook page on the IPTC dialog
			  "OptionsLastPad"  => "gen", # remember the NoteBook page on the IPTC dialog
			  "MetadataWarn"    => 0,     # print a warning to stdout if some strange metadata is found (e.g. in EXIF)
			  "dirDiffDirA"     => $home,
			  "dirDiffDirB"     => $home,
			  "dirDiffSize"     => 1,
			  "dirDiffPixel"    => 1,
			  "dirDiffComment"  => 1,
			  "dirDiffEXIF"     => 1,
			  "dirDiffIPTC"     => 1,
			  "MailPicNoChange" => 0,
			  "MailPicMaxLength"=> 800,
			  "MailPicQuality"  => 75,
              "MailTool"        => 'thunderbird',
			  "winDirRequesterAskAgain" => 1,
			  "FuzzyBorderWidth"=> 10,
			  "FuzzyBorderBlur" => 10,
			  "FuzzyBorderColor"=> "black",
			  "ShowInfoInCanvas"=> 1,
			  "llBorderWidthX"  => 16,
			  "llBorderWidthY"  => 16,
			  "llBorderWidthIX" => 1,
			  "llBorderWidthIY" => 1,
			  "llBorderColor"   => "white",
			  "llBorderColorI"  => "black",
			  "supportOtherPictureFormats" => 0,
			  "CategoriesAll"   => 2,     # category mode 0= last, 1=all, 2=join
			  "KeywordsAll"     => 2,     #  keyword mode 0= last, 1=all, 2=join
			  "Version"         => '000',
			  "ShowUnfinishedDirs" => 1,
			  "ShowFinishedDirs" => 1,
			  "trackPopularity" => 1,
			  "ChannelRed"      => 100,
			  "ChannelGreen"    => 100,
			  "ChannelBlue"     => 100,
			  "ChannelDeco"     => 0,
			  "ChannelBright"   => 1,
			  'SlideShowDir'    => $home, # settings for slideshows
			  'relative_path'   => 1,     # settings for xnview slideshows
			  'xnview_loop'     => 1,     # settings for xnview slideshows
			  'xnview_fullscreen' => 1,   # settings for xnview slideshows
			  'xnview_filename' => 0,     # settings for xnview slideshows
			  'xnview_random'   => 0,     # settings for xnview slideshows
			  'xnview_mouse'    => 0,     # settings for xnview slideshows
			  'xnview_title'    => 0,     # settings for xnview slideshows
			  'PicWinBalloon'   => 1,     # boolean -1 show balloon info in pic window
			  'IPTCProfessional'=> 1,     # boolean - 1 = professional IPTC, 0 = simple dialog
			  'CheckNewKeywords'=> 1,
			  'KeywordMore'     => 0,     # boolean 1 = show more options in keyword search window
			  'KeywordExclude'  => '',    # space separated list of keywords to exclude
			  'KeywordLimit'    => 0,     # boolean 1 = limit number of displayed keywords
			  'KeywordDate'     => 0,     # boolean 1 = limit to a date range
			  'KeywordStart'    => 1070254800, # start date (UNIX time)
			  'KeywordEnd'      => 1170254800, # end date (UNIX time)
			  'KeywordRating'   => 0,      # boolean 1 = limit to a rating range
			  'KeywordRatingA'  => 1,      # rating range
			  'KeywordRatingB'  => 3,      # rating range
			  'UrgencyChangeWarning' => 1, # boolean 1 = show a warning when urgency changed
			  'ActPic'          => '',     # the last picture shown
			  'SelectLastPic'   => 1,      # Select last shown pic after startup
			  'AutoImport'      => 1,      # boolean = 1 start import at Mapivi wizard if memory card is inserted (ImportSource)
			  'llWatermarkX'    => 16,     # lossless watermark x position
			  'llWatermarkY'    => -16,    # lossless watermark y position
			  'llWatermarkFile' => "$configdir/EmptyThumb.jpg", # lossless watermark file name
			  'AspectBorderN'   => 3,      # lossless aspect ratio border
			  'AspectBorderM'   => 2,      # lossless aspect ratio border
			  'RelativeBorderX' => 10,     # lossless relative border
			  'RelativeBorderY' => 10,     # lossless relative border
			  'RelativeBorderIX' => 0.1,   # lossless relative border
			  'RelativeBorderIY' => 0.1,   # lossless relative border
			  'RelativeBorderEqual'=> 1,   # boolean lossless relative border
			  'KeywordDialogDock'=> 0,     # boolean dock keyword dialog to main window
			  'KeywordDialogDockL'=> 1,    # boolean dock keyword dialog on left side 
			  'XMP_file_operations'=> 1,   # boolean XMP sidecar files follow picture file operations
			  'WAV_file_operations'=> 1,   # boolean WAV audio files follow picture file operations
			  'RAW_file_operations'=> 0,   # boolean RAW files follow picture file operations
			  'LocationMode'       => 'UPDATE', # UPDATE or REPLACE - mode for writing IPTC location info
 			 );

# some platform specific default settings

# for windows
if ($EvilOS) {
  $config{ExtViewer} = 'C:\Program Files\IrfanView\iview_32.exe';
}

# for Mac OS X
if ($MacOSX) {
  $config{ExtViewer}         = "macosx-preview";
  $config{ExtViewerMulti}    = 1;
}

my @IPTCAttributes = (
			"Urgency",
			"Keywords",
			"Headline",
			"Caption/Abstract",
			"SubLocation",
			"City",
			"Province/State",
			"Country/PrimaryLocationCode",
			"Country/PrimaryLocationName",
			"Writer/Editor",
			"ObjectName",
			"CopyrightNotice",
			"Category",
			"Source",
			"EditStatus",
			"OriginatingProgram",
			"ProgramVersion",
			"EditorialUpdate",
			"ObjectCycle",
			"ByLine",
			"ByLineTitle",
			"FixtureIdentifier",
			"ContentLocationName",
			"ContentLocationCode",
			"ReleaseDate",
			"ReleaseTime",
			"OriginalTransmissionReference",
			"ExpirationDate",
			"ExpirationTime",
			"Credit",
			"SpecialInstructions",
			"ActionAdvised",
			"Contact",
			#"ReferenceService", # only usefull for multiple objects
			#"ReferenceDate",    # only usefull for multiple objects
			#"ReferenceNumber",  # only usefull for multiple objects
			"DateCreated",
			"TimeCreated",
			"ImageType",
			"ImageOrientation",
			"DigitalCreationDate",
			"DigitalCreationTime",
			"LanguageIdentifier",
			#"RecordVersion", # binary
			"ObjectTypeReference",
			"ObjectAttributeReference",
			"SubjectReference",
			"SupplementalCategory",
			#"RasterizedCaption", # binary
			# Audio... and ObjDataPreview... left out by now ...
		   );

my %iptcHelp = (
				"ByLine" => "Contains name of the creator of the objectdata, e.g. writer, photographer or graphic artist. Examples: Robert Capa, Ernest Hemingway, Pablo Picasso (max. 32 chars)",
				"ByLineTitle" => "A ByLineTitle is the title of the creator or creators of an objectdata. Where used, a by-line title should follow the ByLine it modifies. Examples: Staff Photographer, Corresponsal, Envoye Special (max. 32 chars)",
				"Caption/Abstract" => "The Caption field is the text that accompanies the photo, containing the who, what, when, where and why information (max. 2000 chars)",
				"CaptionWriter" => "The Caption Writer field lists the initials of all the people who wrote or edited the caption, header fields or image file. This includes toning and pixel editing",
				"Category" => "Identifies the subject of the objectdata in the opinion of the provider. A list of categories will be maintained by a regional registry, where available, otherwise by the provider. Note: Use of this DataSet is Deprecated. It is likely that this DataSet will not be included in further versions of the IIM. The Category field lists codes that aid in a more detailed search. (max. 3 chars)",
				"SubLocation" => "Identifies the location within a city. Examples: Capitol Hill, Maple Leaf Gardens, Strandgateparken (max. 32 chars)",
				"City" => "The City field lists where the photo was originally made. For file photos, do not use the transmission point's city (max. 32 chars)",
				"Country/PrimaryLocationCode" => "The Country field lists the three-letter country code where the photo was originally made. For file photos, do not put the transmission points country. Examples: USA (United States), GER (Germany), FRA (France), XUN (United Nations) (max. 3 chars)",
				"Country/PrimaryLocationName" => "Provides full, publishable, name of the country/primary location where the intellectual property of the objectdata was created, according to guidelines of the provider. (max. 64 chars)",
				"DateCreated" => "The Create Date field is the date the photo was originally made. For file photos, use the date the photo was originally made, if known. If the complete date is not known, leaf the field blank. The field will not accept a partial date. (8 chars CCYYMMDD)",
				"TimeCreated" => "Represented in the form HHMMSS+HHMM (or -HHMM) to designate the time the intellectual content of the objectdata current source material was created rather than the creation of the physical representation. Follows ISO 8601 standard. Where the time cannot be precisely determined, the closest approximation should be used. Example: 133015+0100 indicates that the object intellectual content was created at 1:30 p.m. and 15 seconds Frankfurt time, one hour ahead of UTC. (11 chars HHMMSS+HHMM)",
				"Credit" => "Identifies the provider of the objectdata, not necessarily the owner/creator. (The Credit field is the name of the service transmitting the photo) (max. 32 chars)",
				"Headline" => "The Headline field lists keywords to aid in a more detailed search for a photo. Example: Lindbergh Lands In Paris (max. 256 chars)",
				"SpecialInstructions" => "The Instructions field lists special notations that apply uniquely to a photo, such as file photo, correction, advance or outs Examples: SECOND OF FOUR STORIES, 3 Pictures follow, Argentina OUT (max. 256 chars)",
				"ObjectName" => "Used as a shorthand reference for the object. Changes to existing data, such as updated stories or new crops on photos, should be identified in Edit Status. Examples: Wall St., Ferry Sinks. The Object Name field lists the story slug associated with a photo. For photos without a story, Associated Press photographers or photo editors will make up a logical slug to aid in a search and note it as a stand alone photo in the INSTRUCTIONS field of the NAA/IPTC header. If a related story moves on Data-Stream, the photo will be retransmitted with the appropriate OBJECT NAME to match the story. (max. 64 chars)",
				"Source" => "Identifies the original owner of the intellectual content of the objectdata. This could be an agency, a member of an agency or an individual. (The Source field lists who is the original provider of a photo, such as: AP, an AP member, pool photo provider or handout photo provider.) (max. 32 chars)",
				"Province/State" => "The State field lists the state where the photo was originally made. Use U.S. postal code abbreviations. For file photos, do not use the transmission point's state. Examples: WA, Sussex, Baden-Wuerttenberg (max. 32 chars)",
				"SupplementalCategory" => "The Supplemental Categories field lists codes that aid in a more detailed search for a photo.",
				"OriginalTransmissionReference" => "A code representing the location of original transmission according to practices of the provider. Examples: BER-5, PAR-12-11-01. (The Trans Reference field lists a call letter/number combination associated with a photo. It includes an originating transmit points call letters and picture number from that point's sequence of offerings for a given day. Example: NY105.) (max. 32 chars)",
				"Urgency" => "priority 0 meaning None, 1 meaning High to 8 meaning Low",
				"CopyrightNotice" => "Contains any necessary copyright notice. (max. 128 chars)",
				"ExpirationTime" => "Designates in the form HHMMSS+HHMM (or -HHMM) the latest time the provider or owner intends the objectdata to be used. Follows ISO 8601 standard. Example: 090000-0500 indicates an objectdata that should not be used after 0900 in New York (five hours behind UTC).",
				"ExpirationDate" => "Designates in the form CCYYMMDD the latest date the provider or owner intends the objectdata to be used. Follows ISO 8601 standard. Example: 19940317 indicates an objectdata that should not be used after 17 March 1994.",
				"ReleaseTime" => "Designates in the form HHMMSS+HHMM (or -HHMM) the earliest time the provider intends the object to be used. Follows ISO 8601 standard. Example: 090000-0500 indicates object for use after 0900 in New York (five hours behind UTC)",
				"ReleaseDate" => "Designates in the form CCYYMMDD the earliest date the provider intends the object to be used. Follows ISO 8601 standard. Example: 19890317 indicates data for release on 17 March 1989. (8 chars)",
				"FixtureIdentifier" => "Identifies objectdata that recurs often and predictably. Enables users to immediately find or recall such an object. Example: EUROWEATHER",
				"EditStatus" => "Status of the objectdata, according to the practice of the provider. Examples: Lead, CORRECTION (max. 64 chars)",
				"Writer/Editor" => "Identification of the name of the person involved in the writing, editing or correcting the objectdata or caption/abstract. (max. 32 chars)",
				"LanguageIdentifier" => "Describes the major national language of the object, according to the 2-letter codes of ISO 639:1988. Does not define or imply
any coded character set, but is used for internal routing, e.g. to various editorial desks. Example: en (english), de (german) (2 or 3 chars)",
				"ObjectCycle" => "Where: a = morning, p = evening, b = both. Virtually only used in North America. (1 char)",
				"Contact" => "Identifies the person or organisation which can provide further background information on the objectdata. (max. 128 chars)"
			   );

# store all values which were entered in the labeled entry widgets
# key = label of entry, value = reference to array containing all unique values
my %entryHistory;

my @allcolors = qw/black gray10 gray20 gray30 gray40 gray50 gray60 gray70 gray80 gray85 gray90
gray95 white snow2 snow3 snow4 seashell1 seashell2 seashell3 seashell4
AntiqueWhite1 AntiqueWhite2 AntiqueWhite3 AntiqueWhite4 bisque1
bisque2 bisque3 bisque4 PeachPuff1 PeachPuff2 PeachPuff3 PeachPuff4
NavajoWhite1 NavajoWhite2 NavajoWhite3 NavajoWhite4 LemonChiffon1
LemonChiffon2 LemonChiffon3 LemonChiffon4 cornsilk1 cornsilk2
cornsilk3 cornsilk4 ivory1 ivory2 ivory3 ivory4 honeydew1 honeydew2
honeydew3 honeydew4 LavenderBlush1 LavenderBlush2 LavenderBlush3
LavenderBlush4 MistyRose1 MistyRose2 MistyRose3 MistyRose4 azure1
azure2 azure3 azure4 SlateBlue1 SlateBlue2 SlateBlue3 SlateBlue4
RoyalBlue1 RoyalBlue2 RoyalBlue3 RoyalBlue4 blue1 blue2 blue3 blue4
DodgerBlue1 DodgerBlue2 DodgerBlue3 DodgerBlue4 SteelBlue1 SteelBlue2
SteelBlue3 SteelBlue4 DeepSkyBlue1 DeepSkyBlue2 DeepSkyBlue3
DeepSkyBlue4 SkyBlue1 SkyBlue2 SkyBlue3 SkyBlue4 LightSkyBlue1
LightSkyBlue2 LightSkyBlue3 LightSkyBlue4 SlateGray1 SlateGray2
SlateGray3 SlateGray4 LightSteelBlue1 LightSteelBlue2 LightSteelBlue3
LightSteelBlue4 LightBlue1 LightBlue2 LightBlue3 LightBlue4 LightCyan1
LightCyan2 LightCyan3 LightCyan4 PaleTurquoise1 PaleTurquoise2
PaleTurquoise3 PaleTurquoise4 CadetBlue1 CadetBlue2 CadetBlue3
CadetBlue4 turquoise1 turquoise2 turquoise3 turquoise4 cyan1 cyan2
cyan3 cyan4 DarkSlateGray1 DarkSlateGray2 DarkSlateGray3
DarkSlateGray4 aquamarine1 aquamarine2 aquamarine3 aquamarine4
DarkSeaGreen1 DarkSeaGreen2 DarkSeaGreen3 DarkSeaGreen4 SeaGreen1
SeaGreen2 SeaGreen3 SeaGreen4 PaleGreen1 PaleGreen2 PaleGreen3
PaleGreen4 SpringGreen1 SpringGreen2 SpringGreen3 SpringGreen4 green1
green2 green3 green4 chartreuse1 chartreuse2 chartreuse3 chartreuse4
OliveDrab1 OliveDrab2 OliveDrab3 OliveDrab4 DarkOliveGreen1
DarkOliveGreen2 DarkOliveGreen3 DarkOliveGreen4 khaki1 khaki2 khaki3
khaki4 LightGoldenrod1 LightGoldenrod2 LightGoldenrod3 LightGoldenrod4
LightYellow1 LightYellow2 LightYellow3 LightYellow4 yellow1 yellow2
yellow3 yellow4 gold1 gold2 gold3 gold4 goldenrod1 goldenrod2
goldenrod3 goldenrod4 DarkGoldenrod1 DarkGoldenrod2 DarkGoldenrod3
DarkGoldenrod4 RosyBrown1 RosyBrown2 RosyBrown3 RosyBrown4 IndianRed1
IndianRed2 IndianRed3 IndianRed4 sienna1 sienna2 sienna3 sienna4
burlywood1 burlywood2 burlywood3 burlywood4 wheat1 wheat2 wheat3
wheat4 tan1 tan2 tan3 tan4 chocolate1 chocolate2 chocolate3 chocolate4
firebrick1 firebrick2 firebrick3 firebrick4 brown1 brown2 brown3
brown4 salmon1 salmon2 salmon3 salmon4 LightSalmon1 LightSalmon2
LightSalmon3 LightSalmon4 orange1 orange2 orange3 orange4 DarkOrange1
DarkOrange2 DarkOrange3 DarkOrange4 coral1 coral2 coral3 coral4
tomato1 tomato2 tomato3 tomato4 OrangeRed1 OrangeRed2 OrangeRed3
OrangeRed4 red1 red2 red3 red4 DeepPink1 DeepPink2 DeepPink3 DeepPink4
HotPink1 HotPink2 HotPink3 HotPink4 pink1 pink2 pink3 pink4 LightPink1
LightPink2 LightPink3 LightPink4 PaleVioletRed1 PaleVioletRed2
PaleVioletRed3 PaleVioletRed4 maroon1 maroon2 maroon3 maroon4
VioletRed1 VioletRed2 VioletRed3 VioletRed4 magenta1 magenta2 magenta3
magenta4 orchid1 orchid2 orchid3 orchid4 plum1 plum2 plum3 plum4
MediumOrchid1 MediumOrchid2 MediumOrchid3 MediumOrchid4 DarkOrchid1
DarkOrchid2 DarkOrchid3 DarkOrchid4 purple1 purple2 purple3 purple4
MediumPurple1 MediumPurple2 MediumPurple3 MediumPurple4 thistle1
thistle2 thistle3 thistle4/;

# get the configurations from the rc file if the configdir exists
readConfig($configFile, \%config) if (-d $configdir);
$actpic = $config{ActPic};

# At startup the menu should always be visible
$config{ShowMenu} = 1;

# check if this is the first start of a new Mapivi version
mapiviUpdate() if (($config{Version} eq '000') or ($version ne $config{Version}));
$config{Version} = $version;

processARGV(); # process the command line arguments as early as possible to give a fast feedback

my $layoutOld = $config{Layout}; # this must be done after readConfig!

# for zoom and subsample of Tk::Photo objects
# the higher the zoom value the longer the time to zoom
# subsample is quite fast, so the first number (zoom) should not be bigger than 4
# the second (subsample) may be bigger
my @frac;
if ($config{SlowButMoreFeatures}) {
  @frac = (10,1, 6,1, 4,1, 3,1, 2,1, 3,2, 4,3, 1,1, 4,5, 3,4, 2,3, 3,5, 1,2, 2,5, 1,3, 1,4, 1,5, 1,6, 1,7, 1,8, 1,10, 1,12, 1,16, 1,25, 1,50);
}
else {
  @frac = (10,1, 6,1, 4,1, 3,1, 2,1, 3,2, 4,3, 1,1, 4,5, 3,4, 2,3, 1,2, 1,3, 1,4, 1,5, 1,6, 1,7, 1,8, 1,10, 1,12, 1,16, 1,25, 1,50);
}

# open main window
my $top = MainWindow->new;
# hide it, while building up
$top->withdraw;

# set the window size
checkGeometry(\$config{Geometry});
$top->geometry($config{Geometry});

# add a window and icon picture
my $icon_data = <<EOF;
R0lGODlhIAAgAOcAAAAAAAAAAQEBAQEBAwICBAICBQMDBgUFBQUFCQYGCgYGDAcHBwcHDQcIDQgI
DwkJEAkKEQsMFQwMFgwNFg0NFw0OGBAQHBERHhESIBISIBMUIhMUIxQVJBUVJRUWJhYXKRgZLBka
LRobLxscMBscMRwdMh0eNB4fNR4fNh8gOCAhOiAiOyEiOyEiPCIjPiIkPiIkPyMkPyMkQCUmQiUm
QyUnRCgpRygpSCgqSSkqSyosTSstTi0uUC0vUS4wVC8xVTAyVjAyVzAyWDEyVzEzWDE0WjI0WzQ2
XjU3XzU3YDY3YTU4YTY5YjY5Yzc6ZDg7Zjk7Zzk7aDk8aDo8aTs9ajs9azs+azs+bD0/bT0/bj4/
bz1Abz1AcD5AcEBCc0BDdEFEdkFEd0RGe0RHe0VIfkZJfkZJf0dKgUhKgUhLgkhLg0hLhElLg0lN
hUpNhUpOh0tOiExPiU1Qi05QjE5RjU9RjVBTkVFTkVFVk1JVlFJWlVNWllRXl1VYmVdanVdbnlhb
nllbn1lcoFlcoVtfpVxfpVxfplxgpl1gpl1gp11gqF5hqV9jrGBjrWBkrWFkrmJlsGJmsWNnsmRo
tGRotWVotWVptmZqt2ZquGdrumhrumhru2hsu2lsvGltvWptvmpuv2tuwGtvwWxww21xxG5xxW9z
x29zyHBzyHB0ynF1y3F1zHJ2zHN2znN3znN3z3R40HR40XV50nZ61Hd71Xd71nh8132B2IOG2oSI
2oiL24iM3IyP3JGU3pSX35ye4Zyf4Z2g4qurq6Wo5Kao5Kut5rS36bm76r2/68HD7MzN787P8NLT
8dna89vc9Nzd9OHi9v///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH+FUNyZWF0ZWQgd2l0aCBU
aGUgR0lNUAAh+QQBCgD/ACwAAAAAIAAgAAAI/gABHDgAoKDBgwgTKhQoTBjBhgUhApDY8KGwiBcn
XlwQLdoCAB0LhgQZTaRHkiZTHqioEaNLjRZfShy4sKbNmhNM8MAiJxGpEzcVrjgihk8lWLaSKrU1
6AIAKqtASTLUpw6aL1CM7JCRoGCENKyS9lI2bKktTioACFIazNdSTWZgcDBQUEEOW7yaQdtlFhYQ
Aq9sAXN2zG3STGOcpGhwsIKtXM9+2aJl9syIpMiSmRXlQ2EIW7iY3bIVyuyfLUmLGVaq6ohCGrZ0
LUuaCKlSSYiUjjI7q4pCIrGNJX10ZymqwLZSMTJrq4zCLKCJJeX0YxZzW3swMZeDICGb6ElR/gGZ
w5zTGFXM80hI2Ae8rVlSOvB+E+U6IA0JH9nytVoNgEBLLRLGENcpIkJCpOy3Gh4OnMAaGS6IcV0k
LSA0AGX8KSVIBgBAkhQfVhCwyHWb4IAQBdc5UgIANtjiyRgeFBDLdaT8gBAI12lSAwABZAKHEAB8
dp0rTCA0w3Wm2AhABE9AAIAR19lSCxcIBXHdLE8YpEBBcURpyxoCHIRFlGcg9EAnXtrBgEEkWBIl
HowBQEASqXhpSyxaEMBiIZ3YZpYsblAAQApKsHGII5FMcskmn4hSyimqtFIJCwB8cMQUYLRBhx5+
ENIIJZtY4oUFGKCwQgw13KBDDz8UcUQTPlBc0cUSAhEEwAANVLBBCCnQoIMQSLzwQFAGreRQS8hS
dKyyLnF00kjQlkTSR9GqxBKzyS6bEbY0EestAAEBADs=
EOF
my $mapiviicon = $top->Photo(-data => $icon_data);
my $mapiviiconfile = "$icon_path/MapiviIcon.gif";
$mapiviiconfile    = "$configdir/MapiviIcon32.gif" if $EvilOS;
#my $mapiviicon = $top->Photo(-file => $mapiviiconfile) if (-f $mapiviiconfile);
$top->idletasks if $EvilOS; # this line is crucial (at least on windows)
$top->iconimage($mapiviicon) if $mapiviicon;

my $dragAndDrop1     = "$configdir/MiniPic.jpg";
my $dragAndDrop2     = "$configdir/MiniPicMulti.jpg";
my $dragAndDropIcon1 = $top->Photo(-file => $dragAndDrop1) if (-f $dragAndDrop1);
my $dragAndDropIcon2 = $top->Photo(-file => $dragAndDrop2) if (-f $dragAndDrop2);

# button bitmap needed for color buttons
my $mcbut = pack("b8" x 8,
				".......",
				".......",
				".......",
				".......",
				".......",
				".......",
				".......",
				".......");
$top->DefineBitmap('mcbut' => 8, 8, $mcbut);

# button bitmap needed for + buttons
my $plusbut = pack("b5" x 5,
				"..1..",
				"..1..",
				"11111",
				"..1..",
				"..1..",);
$top->DefineBitmap('plusbut' => 5, 5, $plusbut);
# button bitmap needed for - buttons
my $minusbut = pack("b5" x 5,
					".....",
					".....",
					"11111",
					".....",
					".....",);
$top->DefineBitmap('minusbut' => 5, 5, $minusbut);

# pseudo transpartent bitmap for cropDialog
my $transbits = pack("b4" x 4,
    "11..",
    "11..",
    "..11",
    "..11");
$top->DefineBitmap('transp' => 4, 4, $transbits);

# pseudo transpartent bitmap for cropDialog
my $transbits2 = pack("b1" x 3,
    "1",
    "1",
    ".");
$top->DefineBitmap('transp2' => 1, 3, $transbits2);

# pseudo transpartent bitmap for cropDialog
my $transbits3 = pack("b1" x 3,
    "1",
    ".",
    "1");
$top->DefineBitmap('transp3' => 1, 3, $transbits3);

# set title and icon
$top->title("MaPiVi $version");
$top->iconname("MaPiVi");

# set options
my $ScW = 10;
$ScW = 14 if $EvilOS;  # the small scrollbars look ugly under windows
for (qw(Scale Scrollbar)) {
  $top->optionAdd("*$_.width", $ScW, "userDefault");
}

# override -takefocus for frames and scrollbars
$top->optionAdd('*Frame.TakeFocus','0');
$top->optionAdd('*Scrollbar.TakeFocus','0');
$top->optionAdd('*ResizeButton.TakeFocus','0');

# change menu style to compact
$top->optionAdd('*Menu.borderWidth'       => 1);
$top->optionAdd('*Menu.activeBorderWidth' => 0);
$top->optionAdd('*Menu.borderWidth'       => 1);

$top->optionAdd('*selectForeground',    $config{ColorSelFG}, 'userDefault');
$top->optionAdd('*selectBackground',    $config{ColorSel},   'userDefault');
$top->optionAdd("*highlightColor",      $config{ColorSel},   'userDefault');
$top->optionAdd("*highlightBackground", $config{ColorHlBG},  'userDefault');
$top->optionAdd("*background",          $config{ColorBG},    'userDefault');
$top->optionAdd("*activeBackground",    $config{ColorActBG}, 'userDefault');

# must be after the *background optionAdd call
$top->optionAdd("*Menu.background",  $config{ColorMenuBG},    'userDefault');

for (qw(foreground)) {
  $top->optionAdd("*$_", $config{ColorFG}, 'userDefault');
}

# must be after the *foreground and *background optionAdd call
$top->optionAdd("*Menu.background",  $config{ColorMenuBG},    'userDefault');
$top->optionAdd("*Menu.foreground",  $config{ColorMenuFG},    'userDefault');

for (qw(Scale Scrollbar Adjuster)) {
  $top->optionAdd("*$_.troughColor", $config{ColorEntry}, "userDefault");
}

$top->optionAdd("*ProgressBar.troughColor", $config{ColorBG}, "userDefault");

$top->optionAdd("*Label.background", $config{ColorBG}, "userDefault");

for (qw(Entry NumEntry Listbox KListbox K2Listbox TixHList HList Text
	    BrowseEntry.Entry NoteBook)) {
  $top->optionAdd("*$_.background", $config{ColorEntry}, "userDefault");
}

for (qw(Button Checkbutton Radiobutton Menubutton
	    FlatCheckbox FireButton Menu)) {
	$top->optionAdd("*$_.cursor", "hand2", "userDefault");
}

$top->optionAdd("*Radiobutton.selectColor", $config{ColorSelBut}, "userDefault");
$top->optionAdd("*Checkbutton.selectColor", $config{ColorSelBut}, "userDefault");
$top->optionAdd("*Menu.selectColor", $config{ColorSelBut}, "userDefault");

my $font = $top->Font(-family => $config{FontFamily},
					  -size   => $config{FontSize},
					  #-weight => "normal,-slant,roman,-underline,0,-overstrike,0
					  );
my $small_font = $top->Font(-family => $config{FontFamily}, -size => 8);

$top->optionAdd("*font", $font, "userDefault");

# slick scrollbars
$top->optionAdd('*Scrollbar.borderWidth' => $config{Borderwidth});
$top->optionAdd('*Adjuster.borderWidth' => $config{Borderwidth});
$top->optionAdd('*Button.borderWidth' => $config{Borderwidth});
$top->optionAdd('*ResizeButton.borderWidth' => $config{Borderwidth});
$top->optionAdd('*Entry.borderWidth' => $config{Borderwidth});
$top->optionAdd('*Scale.borderWidth' => $config{Borderwidth});
$top->optionAdd('*Slider.borderWidth' => $config{Borderwidth});
$top->optionAdd('*NoteBook.borderWidth' => $config{Borderwidth});
$top->optionAdd('*Frame.borderWidth' => $config{Borderwidth});
$top->optionAdd('*NoteBook.Frame.borderWidth' => 0);
$top->optionAdd('*checkbutton.borderWidth' => $config{Borderwidth});
$top->optionAdd('*Checkbutton.borderWidth' => $config{Borderwidth});
$top->optionAdd('*Radiobutton.borderWidth' => $config{Borderwidth});
$top->optionAdd('*radiobutton.borderWidth' => $config{Borderwidth});
$top->optionAdd('*separator.borderWidth' => $config{Borderwidth});
$top->optionAdd('*Menu.borderWidth' => $config{Borderwidth});
$top->optionAdd('*Cascade.borderWidth' => $config{Borderwidth});
$top->optionAdd('*Label.borderWidth' => $config{Borderwidth});
$top->optionAdd('*Canvas.borderWidth' => $config{Borderwidth});
$top->optionAdd('*ROText.borderWidth' => $config{Borderwidth});
$top->optionAdd('*Optionmenu.borderWidth' => $config{Borderwidth});
$top->optionAdd('*DirTree.borderWidth' => $config{Borderwidth});
$top->optionAdd('*HList.borderWidth' => $config{Borderwidth});

# call quitMain when the window is closed by the window manager
$top->protocol("WM_DELETE_WINDOW" => sub { quitMain(); });

# init stuff
$balloon = $top->Balloon(-bg => $config{ColorSel}, -initwait => 1000);
$balloon->Subwidget("message")->configure(-justify => "left");

$top->fontCreate(qw/C_big -family courier -size 14 -weight bold/);

#createMenubar();

my $infoF  = $top->Frame(-relief => 'raised');

# $subF contains the 3 frames: dirtree ($dirF), thumbnails ($thumbF) and picture ($mainF)
my $subF   = $top->Frame();

my $dirF   = $subF->Frame();
my $dirA   = $subF->Adjuster();
my $thumbF = $subF->Frame();
my $thumbA = $subF->Adjuster();
my $mainF  = $subF->Frame();

my $exifF  = $mainF->Frame(-relief => "raised");

my $iptcB  = makeButton($exifF, "left", "IPTC", "iptc.gif", 'displayIPTCData($picLB)');
$balloon->attach($iptcB, -msg => "Show all IPTC Information of displayed picture");

my $exifB  = makeButton($exifF, "left", "EXIF", "exif.gif", 'displayEXIFData($picLB)');
$balloon->attach($exifB, -msg => "Show all EXIF Information of displayed picture");

my $exifL  = $exifF->Label(-textvariable => \$exif, -anchor => 'w', -justify => "left", -relief => "sunken")->pack(-side => "left", -fill => 'both', -expand => 1);
$balloon->attach($exifL, -msg => "EXIF Information of displayed picture");

my $comF   = $mainF->Frame(-relief => "raised");
my $comBF  = $comF->Frame()->pack(-side => "left", -expand => 1, -fill => "both", -anchor=>"nw", -padx => 0, -pady => 0);

my $capF   = $mainF->Frame(-relief => "raised");

my $nrofL = $infoF->Label(-justify => "left",-textvariable => \$nrof, -relief => "sunken", -anchor => 'w'
						 )->pack(-side => "left", -expand => 0, -fill => "y");
$balloon->attach($nrofL, -msg => "x/y (z, s) = first selected picture is number x\nfrom y pictures in the actual folder\nz pictures are selected\ns is the size of all selected pictures");

my $dirtreedir;

# if the actual dir should be displayed in the dir frame, just change $thumbF to $dirF in the line below
my $actdirF = $thumbF->Frame()->pack(-expand => 1, -fill => 'x', -padx => 2, -pady => 1);

my $actdirL = $actdirF->Label(-textvariable => \$actdir, -width => 10, -anchor => "e", -relief => "sunken", -bd => $config{Borderwidth})->pack(-side => "left", -expand => 1, -fill => 'x');
$balloon->attach($actdirL, -msg => "actual folder\nClick here to open a simple folder requester.");
$actdirL->bind("<Button-1>", sub { getDirAndOpen(); });

my $otherFilesL = $actdirF->Label(-textvariable => \$otherFiles, -relief => "sunken", -bd => $config{Borderwidth})->pack(-side => "left");
$balloon->attach($otherFilesL, -msg => "number of non-JPEG files in the actual folder");
my $otherFilesB = $actdirF->Button(-text => "i", -command => sub {showNonJPEGS();}, -padx => 1, -pady => 0)->pack(-side => "left");
$balloon->attach($otherFilesB, -msg => "show non-JPEG files in the actual folder");

my $parentDirB = $actdirF->Button(-text => "..", -command => sub {
								 my $parentdir = dirname($actdir);
								 print "changing to $parentdir (was: $actdir)\n" if $verbose;
								 openDirPost($parentdir);
							   }, -padx => 0, -pady => 0)->pack(-side => "left");
$balloon->attach($parentDirB, -msg => "open parent folder");

my $dirPropSORT = 0;
my $dirPropMETA = 0;
my $dirPropPRIO = 0;
$actdirF->{cbSORT} = $actdirF->Checkbutton(-variable => \$dirPropSORT, -command => sub { $dirProperties{$actdir}{SORT} = $dirPropSORT; })->pack(-side => 'left', -anchor=>'w', -padx => 0);
$actdirF->{cbMETA} = $actdirF->Checkbutton(-variable => \$dirPropMETA, -command => sub { $dirProperties{$actdir}{META} = $dirPropMETA; })->pack(-side => 'left', -anchor=>'w', -padx => 0);
$actdirF->{cbPRIO} = $actdirF->Checkbutton(-variable => \$dirPropPRIO, -command => sub { $dirProperties{$actdir}{PRIO} = $dirPropPRIO; })->pack(-side => 'left', -anchor=>'w', -padx => 0);
$balloon->attach($actdirF->{cbSORT}, -msg => "Sort:\nCheck this button, if the pictures\nin this folder are sorted out.");
$balloon->attach($actdirF->{cbMETA}, -msg => "Meta:\nCheck this button, if all needed meta infos\n(comments, IPTC) of the pictures in this folder are added.");
$balloon->attach($actdirF->{cbPRIO}, -msg => "Prio:\nCheck this button, if the pictures in this\nfolder are rated with a IPTC urgency flag.");

my $dirtree;
$dirtree = $dirF->Scrolled('DirTree',
						   -scrollbars => 'osoe',
						   -width => 30,
						   -height => 200,
						   -showhidden => $config{ShowHiddenDirs},
						   -selectmode => 'browse',
						   -exportselection => 1,
						   -browsecmd => sub {
							 # this function will show all subdirs when clicking on the + sign of a dir
							 $dirtreedir = shift;
							 $dirtreedir = Encode::encode('iso-8859-1', $dirtreedir);
							 return if (@_ >= 1);
							 if (!-d $dirtreedir) { print "dirtree xxx: $dirtreedir does not exists!\n"; return; }
							 $top->Busy;
							 my @dirs = getDirs($dirtreedir);
							 $top->Unbusy;
							 return if (@dirs < 1);
							 $top->Busy;
							 my $lastdir = $dirtreedir."/".$dirs[-1];
							 if ($dirtree->info("exists", "$lastdir")) {
							   $dirtree->see($lastdir) if (-d $lastdir);
							 }
							 $top->Unbusy;
						   },
						   -command   => sub { openDirPost($dirtreedir); },
						  )->pack(-fill => "both", -expand => 1);


# Set the initial folder
exists &Tk::DirTree::chdir ? $dirtree->chdir($actdir) : $dirtree->set_dir($actdir);

bindMouseWheel($dirtree);

$dirtree->bind('<Enter>', sub { $dirtree->focus; } ) unless $EvilOS;

$dirtree->bind('<ButtonPress-3>', sub {
				 $dirMenu->Popup(-popover => "cursor", -popanchor => "nw");
			   } );

my $dtr = $dirtree->Subwidget("scrolled");
# change the binding order of the dirtree
$dtr->bindtags([$dtr,ref $dtr,$dtr->toplevel,'all']);
# stop the execution of the scape key
$dtr->bind('<Key-space>',   sub { Tk->break; } );

my $c = $mainF->Scrolled('Canvas',
						 -scrollbars  => 'osoe',
						 -width       => 2000,
						 -height      => 2000,
						 -relief      => "flat",
						 -borderwidth => 0,
						 -highlightthickness => 0,
						 -bg          => $config{ColorBGCanvas},
						);

$c->configure(-scrollregion => [0, 0, 100, 100]);

my $whL = $infoF->Label(-textvariable => \$widthheight, -relief => "sunken")->pack(-side => "left", -expand => 0, -fill => "y");
$balloon->attach($whL, -msg => "width and height of displayed picture in pixels");

my $sizeL = $infoF->Label(-textvariable => \$size, -relief => "sunken")->pack(-side => "left", -fill => "y");
$balloon->attach($sizeL, -msg => "file size of displayed picture in kByte");

my $zoomL = $infoF->Label(-textvariable => \$zoomFactorStr, -relief => "sunken")->pack(-side => "left", -fill => "y");
$balloon->attach($zoomL, -msg => "zoom factor of the actual picture");

my $urgF = $infoF->Frame(-relief => "sunken")->pack(-side => "left", -fill => "y");
my $urgL = $urgF->Label(-textvariable => \$urgencyStr)->pack(-side => "left", -fill => "y");
$balloon->attach($urgF, -msg => "Rating (IPTC urgency) of actual picture\n0 or - meaning None, 1 meaning High to 8 meaning Low\nTo change use Ctrl-F1, -F2, ... -F8");
my $urgAnchor  = 's'; $urgAnchor = 'n' if ($Tk::VERSION < 804); # the anchor behavior has changed
my $urgencyBar =
  $urgF->ProgressBar(-takefocus => 0,
  				     -borderwidth => 0,
					 -width => 12,
					 -length => (2*$config{FontSize}), # try to guess the height of the labels
					 -padx => 0,
					 -pady => 0,
					 -variable => \$urgencyScale,
					 -colors => [0, $top->Darken($config{ColorSel}, 30), 1, $top->Darken($config{ColorSel}, 40), 2, $top->Darken($config{ColorSel}, 50), 3, $top->Darken($config{ColorSel}, 60), 4, $top->Darken($config{ColorSel}, 70), 5, $top->Darken($config{ColorSel}, 80), 6, $top->Darken($config{ColorSel}, 90), 7, $config{ColorSel} ],
					 -troughcolor => $config{ColorBG},
					 -resolution => 1,
					 -blocks => 0,
					 -gap => 0,
					 -anchor => $urgAnchor,
					 -from => 0,
					 -to => 8
					 )->pack(-side => 'left', -fill => 'both', -expand => 0, -padx => 0, -pady => 0);

my $userInfoL = $infoF->Label(-textvariable => \$userinfo, -relief => "sunken")->pack(-side => "left", -fill => 'both', -expand => 1);
my $userInfoMsg;
$balloon->attach($userInfoL, -postcommand => sub { $userInfoMsg = "information about what's going on"; $userInfoMsg .= "\n(actual folder: $actdir)"}, -msg => \$userInfoMsg);

my $colorPickerInfo = $infoF->Label(-text => ' ', -background => $config{ColorPicker}, -relief => "sunken")->pack(-side => "left", -fill => 'both', -expand => 0);
$balloon->attach($colorPickerInfo, -msg => "Color picker: last color picked by clicking\non the picture in the main window.\nPlease click to clear.");
$colorPickerInfo->bind('<ButtonRelease-1>', sub {
  $config{ColorPicker} = $config{ColorBG};
  $colorPickerInfo->configure(-background => $config{ColorPicker}); });

#my $stopB  = makeButton($infoF, "left", "STOP", "StopPic.gif", 'stopButStop()');
#$balloon->attach($stopB, -msg => "Stop actual action.\nThis may take a while, pressing the button once is enough,\neven if no immidiate feedback is visible.");
#stopButEnd();

my $nrTCL = $infoF->Label(-textvariable => \$nrToConvert, -relief => "sunken")->pack(-side => "left", -expand => 0, -fill => "y");
$balloon->attach($nrTCL, -msg => "Number of thumbnails to generate/refresh");

my  $progressBar =
  $infoF->ProgressBar(-takefocus => 0,
					  -borderwidth => 1,
					  -relief => 'sunken',
					  -width => (2*$config{FontSize}), # try to guess the height of the labels
					  -length => 30,
					  -padx => 0,
					  -pady => 0,
					  -variable => \$proccount,
					  -colors => [0 => $config{ColorProgress}],
 					  -resolution => 1,
					  -blocks => $config{MaxProcs},
					  -anchor => 'w',
					  -from => 0,
					  -to => $config{MaxProcs}
					 )->pack(-side => 'left', -fill => 'both', -expand => 0, -padx => 0, -pady => 0);
$balloon->attach($progressBar, -msg => "info about the number of background processes\n(generating thumbnail pictures)");

$clockL = $infoF->Label(-textvariable => \$time, -relief => "sunken")->pack(-side => "left", -fill => "y");
$balloon->attach($clockL, -msg => \$date);

# JPEG comment box
my $commentText = $comF->Scrolled("ROText",
							   -scrollbars => 'oe',
							   -wrap => 'word',
							   -width => 200,
							   -height => $config{CommentHeight},
							  )->pack(-side => "left", -fill => 'both', -expand => "1", -padx => 0, -pady => 0);
$balloon->attach($commentText, -msg => "Comment(s) of displayed picture");

my $addB = makeButton($comBF, "left", "add", "add.gif", 'addComment($picLB)');
$balloon->attach($addB, -msg => "Add a comment");

my $editB = makeButton($comBF, "left", "edit", "edit.gif", 'editComment($picLB)');
$balloon->attach($editB, -msg => "Edit a comment");

my $remB = makeButton($comBF, "left", "del", "delete.gif", 'removeComment()');
$balloon->attach($remB, -msg => "Remove comment(s)");

my $picLB = makeThumbListbox($thumbF);
$picLB->bind('<Enter>', sub { $picLB->focus; } ) unless $EvilOS;

# IPTC caption edit box
my $captionText;
$capF->Label(-text => "Caption")->pack(-side => "left", -fill => 'both');
$captionText = $capF->Scrolled("Text",
							   -scrollbars => 'oe',
							   -wrap => 'word',
							   -width => 20,
							   -height => $config{CommentHeight},
							  )->pack(-side => 'left', -fill => 'both', -expand => "1");
$balloon->attach($captionText, -msg => "IPTC caption of displayed picture");

my $saveB = $capF->Button(-image => compound_menu($top, 'save', 'media-floppy.png', 0),
                           #-text => "save",
						   -command => sub {
										 my $iptc = { "Caption/Abstract" => $captionText->get(0.1, 'end') };
                                         my @list = ($actpic); 
					                     applyIPTC($picLB, $iptc, \@list);
									 }
						   )->pack(-side => "left", -fill => 'both');
$balloon->attach($saveB, -msg => "Save the IPTC caption to the file and database.\nPlease press this button after adding or editing.");
#$captionText->Subwidget("scrolled")->bindtags([]);
#$captionText->Subwidget("scrolled")->bind('<Key-a>', sub {});
#->Subwidget("scrolled")

# item styles for the thumbnail view
my $thumbCaptionFont = $top->Font(-family => $config{FontFamily},
								  -size   => $config{ThumbCaptFontSize});
my $thumbS =  $picLB->ItemStyle('imagetext', -anchor => 'w', -textanchor => 's', -foreground=>$config{ColorFG}, -background=>$config{ColorBG}, -font => $thumbCaptionFont);
my $fileS  =  $picLB->ItemStyle('text', -anchor=>'nw', -foreground=>$config{ColorFile}, -background=>$config{ColorBG});
my $iptcS  =  $picLB->ItemStyle('text', -anchor=>'nw', -foreground=>$config{ColorIPTC}, -background=>$config{ColorBG});
my $comS   =  $picLB->ItemStyle('text', -anchor=>'nw', -foreground=>$config{ColorComm}, -background=>$config{ColorBG2});
my $exifS  =  $picLB->ItemStyle('text', -anchor=>'nw', -foreground=>$config{ColorEXIF}, -background=>$config{ColorBG2});
my $dirS   =  $picLB->ItemStyle('text', -anchor=>'nw', -foreground=>$config{ColorDir},  -background=>$config{ColorBG2});

toggleHeaders();

# mouse and button bindings
# key-desc,double click,show picture in own window
#$picLB->bind('<Double-Button-1>', sub { showPicInOwnWin(); } ); # does not always work ???
# key-desc,MiddleMouseButton,show picture in own window
$picLB->bind('<ButtonPress-2>', sub {
			   return if (!$picLB->info('children'));
			   showPicInOwnWin(getNearestItem($picLB));
		   } );

# experimental stuff
#$top->bind('<ButtonPress-4>', sub {	print "Mouse Press But 4\n"; } );
#$top->bind('<ButtonPress-5>', sub {	print "Mouse Press But 5\n"; } );

# Define the source for drags.
# Drags are started while pressing the Ctrl key and the left mouse button and moving the
# mouse. Then the StartDrag callback is executed.
my $token;
# key-desc,S-C-LeftBut,(Shift-Ctrl-LeftMouseButton) drag and drop pictures to a dir
$token = $picLB->DragDrop
  (-event     => '<Shift-Control-B1-Motion>',
   -sitetypes => 'Local',
   -startcommand => sub { dragFromPicLB($token) },
  );

# Define the target for drops.
$dirtree->DropSite
  (-droptypes     => 'Local',
   -dropcommand   => sub { dropToDirTree(); },
  );

$picLB->bind('<ButtonPress-1>', sub {
  # saved here for undo function
  @savedselection2 = @savedselection;
  @savedselection = $picLB->info('selection');
} );

$picLB->bind('<ButtonRelease-1>', sub { showSelectedPic(); } );

$picLB->bind('<ButtonPress-3>',   sub {
			   if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off
			   $thumbMenu->Popup(-popover => "cursor", -popanchor => "nw");
			 } );

# key-desc,Return,display the selected picture
$picLB->bind('<Key-Return>',        sub { showSelectedPic(); } );

$c->CanvasBind('<ButtonPress-3>',   sub {
				 if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off
				 $picMenu->Popup(-popover => "cursor", -popanchor => "nw");
			   } );

# we can't bind all keys to the complete window ($top) as we have e.g. the IPTC Caption entry which should get all key events
addWindowKeyBindings($dirtree, $picLB);
addWindowKeyBindings($picLB,   $picLB);
addWindowKeyBindings($c,       $picLB);

addCommonKeyBindings($dirtree, $picLB);
addCommonKeyBindings($picLB,   $picLB);
addCommonKeyBindings($c,       $picLB);

# key-desc,d,display picture in own window
#$picLB->bind('<Key-d>',             sub { showPicInOwnWin(); } );
$picLB->bind('<Key-d>',             sub {
  my @sellist = getSelection($picLB);
  return unless checkSelection($top, 1, 0, \@sellist);
  show_multiple_pics(\@sellist, 0);
} );
$dirtree->bind('<Key-d>',             sub {
				 my $dir = getRightDir();
				 my @list = getPics($dir, WITH_PATH);
				 sortPics($config{SortBy}, $config{SortReverse}, \@list);
				 showThumbList(\@list, $dir); });
$dirtree->bind('<ButtonPress-2>', sub {
				 $dirtree->selectionClear();
				 $dirtree->selectionSet(getNearestItem($dirtree));
				 my $dir = getRightDir();
				 my @list = getPics($dir, WITH_PATH);
				 sortPics($config{SortBy}, $config{SortReverse}, \@list);
				 showThumbList(\@list, $dir); });

# window resize event
$top->bind("<Configure>" => sub {
  # only if dock is selected
  return unless ($config{KeywordDialogDock});
  # and the keyword dialog is open
  return unless (Exists($keyw));
  dock_keyword_dialog();
});

# support drag and drop from extern
# this enables dropping pictures and folders on the mapivi window
if ($Tk::VERSION < 804) {
  $top->DropSite
	(-dropcommand => \&dragAndDropExtern,
	 -droptypes => ($^O eq 'MSWin32' ? 'Win32' : ['KDE', 'XDND', 'Sun'])
	);
}
else {
  $top->DropSite
	(#-entercommand => sub { print "DragAndDrop - Entercommand\n";},
	 -dropcommand => \&dragAndDropExtern,
	 -droptypes => ($^O eq 'MSWin32' ? 'Win32' : ['XDND', 'Sun']) # KDEsite was removed in Tk804.026
	);
}


startup();

# show all types of images supported by Tk::Image
#my @types = $top->imageTypes;printlist(@types);

# Perl/Tk-Mainloop
$top->MainLoop;


# override the Motion sub of listbox (extended selection mode)
# seems not to help with the drag and drop problem
#sub Tk::HList::Motion {
#sub Tk::Listbox::Motion {
#	return;
#}

##############################################################
# stillBusy - block some keys, untill loading of pictures is finished
##############################################################
sub stillBusy {
  if ($showPicInAction) {
	beep();
	$userinfo = "busy (loading pic), please retry later"; $userInfoL->update;
	return 1;
  }
  return 0;
}

##############################################################
# makeThumbListbox - create a scrolled HList for thumbnail display
##############################################################
sub makeThumbListbox {

  my $widget = shift;

  my $lb = $widget->Scrolled('HList',
							 -header     => 1,
							 -separator  => ';', # todo here we hope that ; will never be in a folder or file name
							 -pady       => 0,
							 -columns    => 6,
							 -scrollbars => 'osoe',
							 -selectmode => 'extended',
							 -background => $config{ColorBG},
							 -width      => 30,
							 -height     => 200,
							)->pack(-expand => 1, -fill => 'both');

  bindMouseWheel($lb);

  my $colNr = 0;

  if ($resizeAvail) {
	my $thumbH = $lb->ResizeButton(-text => 'Thumbnail',
								  -relief => 'flat', -pady => 0,-anchor => 'w',
								  -widget => \$lb, -column => $colNr);
	$lb->{thumbcol} = $colNr;
	$lb->header('create', $colNr++, -itemtype => 'window', -widget => $thumbH, -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});


	my $sizeH = $lb->ResizeButton(-text => 'File',
								  -relief => 'flat', -pady => 0,-anchor => 'w',
								  -command => sub {
									return unless ($lb == $picLB);
									if ($config{SortBy} eq 'name') {
									  toggle(\$config{SortReverse});
									} else {
									  $config{SortReverse} = 0;
									}
									$config{SortBy} = 'name';
									updateThumbsPlus(); },
								  -widget => \$lb, -column => $colNr);
	$lb->{filecol} = $colNr;
	$lb->header('create', $colNr++, -itemtype => 'window', -widget => $sizeH, -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});



	my $iptcH = $lb->ResizeButton(-text => 'IPTC',
								  -relief => 'flat', -pady => 0,-anchor => 'w',
								  -command => sub {
									return unless ($lb == $picLB);
									if ($config{SortBy} eq 'urgency') {
									  toggle(\$config{SortReverse});
									} else {
									  $config{SortReverse} = 0;
									}
									$config{SortBy} = 'urgency';
									updateThumbsPlus(); },
								  -widget => \$lb, -column => $colNr);
	$lb->{iptccol} = $colNr;
	$lb->header('create', $colNr++, -itemtype => 'window', -widget => $iptcH, -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});


	my $comH = $lb->ResizeButton(-text => 'Comments',
								 -relief => 'flat', -pady => 0,-anchor => 'w',
								 -widget => \$lb, -column => $colNr);
	$lb->{comcol} = $colNr;
	$lb->header('create', $colNr++, -itemtype => 'window', -widget => $comH, -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});

	my $exifH = $lb->ResizeButton(-text => 'EXIF',
								  -relief => 'flat', -pady => 0,-anchor => 'w',
								  -command => sub {
									return unless ($lb == $picLB);
									$config{SortBy} = 'exifdate';
									toggle(\$config{SortReverse});
									updateThumbsPlus(); },
								  -widget => \$lb, -column => $colNr);
	$lb->{exifcol} = $colNr;
	$lb->header('create', $colNr++, -itemtype => 'window', -widget => $exifH, -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});


	my $dirH = $lb->ResizeButton(-text => 'Folder',
								 -relief => 'flat', -pady => 0,-anchor => 'w',
								 -command => sub {
								   return unless ($lb == $picLB);
								   if ($config{SortBy} eq 'name') {
									 toggle(\$config{SortReverse});
								   } else {
									 $config{SortReverse} = 0;
								   }
								   $config{SortBy} = 'name';
								   updateThumbsPlus(); },
								 -widget => \$lb, -column => $colNr);

	$lb->{dircol} = $colNr;
	$lb->header('create', $colNr, -itemtype => 'window', -widget => $dirH, -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
  }
  else { # no resizeAvail
	$lb->{thumbcol} = $colNr;
	$lb->header('create', $colNr++, -text => 'Thumbnail', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
	#$lb->{namecol} = $colNr;
	#$lb->header('create', $colNr++, -text => 'Name',      -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
	$lb->{filecol} = $colNr;
	$lb->header('create', $colNr++, -text => 'File',      -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
	$lb->{iptccol} = $colNr;
	$lb->header('create', $colNr++, -text => 'IPTC',      -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
	$lb->{comcol} = $colNr;
	$lb->header('create', $colNr++, -text => 'Comments',   -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
	$lb->{exifcol} = $colNr;
	$lb->header('create', $colNr++, -text => 'EXIF',      -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
	$lb->{dircol} = $colNr;
	$lb->header('create', $colNr,   -text => 'Folder', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
  }

  return $lb;
}

##############################################################
# addWindowKeyBindings - add key shortcuts to a widget
##############################################################
sub addWindowKeyBindings {
  my $bind_w = shift; # widget to bind keys to
  my $lb_w   = shift; # thumbnail listbox to use

  # key-desc,b,show backup picture (if available)
  $bind_w->bind('<Key-b>', sub { showBackup(); });
  # key-desc,w,show window list
  $bind_w->bind('<Key-w>', sub { showWindowList(); });
  # key-desc,Ctrl-r,rebuild selected thumbnails
  $bind_w->bind('<Control-r>', sub { rebuildThumbs(); } );
  # key-desc,Ctrl-s,search database
  $bind_w->bind('<Control-s>', sub { searchMetaInfo(); } );
  # key-desc,k,search by keyword (tag cloud)
  $bind_w->bind('<Key-k>', sub { keyword_browse(); } );
  # key-desc,o,open a new folder
  $bind_w->bind('<Key-o>', sub { openDir(); } );
  # key-desc,h,show hot folders
  $bind_w->bind('<Key-h>', sub { $dirMenu->Popup(-popover => "cursor", -popanchor => "nw"); } );

  # key-desc,u,update (reread folder and Image)
  $bind_w->bind('<Key-u>', sub { updateThumbsPlus(); } );
  # key-desc,F05,smart update (add new and remove deleted images)
  $bind_w->bind('<Key-F5>', sub { smart_update(); } );

  # key-desc,U,update image
  $bind_w->bind('<Key-U>', sub {
			 deleteCachedPics($actpic);
			 showPic($actpic);
		   } );

  # layouts
  # key-desc,l,cycle layout of folder thumbnail and picture frame
  $bind_w->bind('<Key-l>', sub { $config{Layout}++; layout(1); } );

  # key-desc,F01,toggle show menu bar
  $bind_w->bind('<Key-F1>', sub { $config{ShowMenu}         = $config{ShowMenu}         ? 0 : 1; showHideFrames(); } );
  # key-desc,F02,toggle show status bar
  $bind_w->bind('<Key-F2>', sub { $config{ShowInfoFrame}    = $config{ShowInfoFrame}    ? 0 : 1; showHideFrames(); } );
  # key-desc,F03,toggle show EXIF box
  $bind_w->bind('<Key-F3>', sub { $config{ShowEXIFField}    = $config{ShowEXIFField}    ? 0 : 1; showHideFrames(); } );
  # key-desc,F04,toggle show comment box
  $bind_w->bind('<Key-F4>', sub { $config{ShowCaptionField} = $config{ShowCaptionField} ? 0 : 1; showHideFrames(); } );

  # key-desc,F06,layout 0: folders-thumbnails-picture (25-30-45)
  $bind_w->bind('<Key-F6>', sub { $config{Layout} = 0 ; layout(1);} );
  # key-desc,F07,layout 1: folders-thumbnails (20-80-0)
  $bind_w->bind('<Key-F7>', sub { $config{Layout} = 1 ; layout(1);} );
  # key-desc,F08,layout 2: thumbnails (0-100-0)
  $bind_w->bind('<Key-F8>', sub { $config{Layout} = 2 ; layout(1);} );
  # key-desc,F09,layout 3: thumbnails-picture (0-50-50)
  $bind_w->bind('<Key-F9>', sub { $config{Layout} = 3 ; layout(1);} );
  # key-desc,F10,layout 4: picture (0-0-100)
  $bind_w->bind('<Key-F10>', sub { $config{Layout} = 4 ; layout(1); Tk->break; # stop default binding of this key
							} );
  # key-desc,F11,fullscreen mode
  $bind_w->bind('<Key-F11>', sub { topFullScreen(); });

  # key-desc,Delete,delete selected pictures to trash
  $bind_w->bind('<Key-Delete>',        sub { deletePics($lb_w, TRASH); } );
  # key-desc,Shift-Delete,remove selected pictures
  $bind_w->bind('<Shift-Delete>',      sub { deletePics($lb_w, REMOVE); } );
  # key-desc,q,quit mapivi
  $bind_w->bind('<Key-q>',             sub { quitMain(); } );
  # key-desc,R,smart rename selected pictures (e.g to EXIF date)
  $bind_w->bind('<Key-R>',             sub { renameSmart($lb_w); } );
  # key-desc,F12,quit mapivi
  $bind_w->bind('<Key-F12>',           sub { quitMain(); } );
  # show picture, EXIF, Comment and IPTC info
  # key-desc,c,display JPEG comment
  $bind_w->bind('<Key-c>',             sub { showComment(); } );
  # key-desc,t,display embedded EXIF thumbnail
  $bind_w->bind('<Key-t>',             sub { showEXIFThumb(); } );
  # key-desc,Ctrl-v,toggle verbose output
  $bind_w->bind('<Control-v>',             sub { toggle(\$verbose); $userinfo = "verbose switched to $verbose"; $userInfoL->update; } );
  # key-desc,Ctrl-c,crop (lossless)
  $bind_w->bind('<Control-c>',             sub { crop($lb_w); } );
  # key-desc,Ctrl-b,add border and/or copyright
  $bind_w->bind('<Control-b>',             sub { losslessBorder(PIXEL); } );
  # key-desc,Ctrl-q,change size/quality
  $bind_w->bind('<Control-q>',             sub { changeSizeQuality(); } );
  # key-desc,Ctrl-o,open options dialog
  $bind_w->bind('<Control-o>',             sub { options(); } );
  # key-desc,Ctrl-e,edit picture in GIMP
  $bind_w->bind('<Control-e>', sub { GIMPedit(); } );
  # key-desc,Ctrl-f,apply a filter to the picture
  $bind_w->bind('<Control-f>', sub { filterPic(); } );
  # key-desc,H,display picture histogram
  $bind_w->bind('<H>',         sub { showHistogram($lb_w); });
  # key-desc,9,rotate picture(s) 90 degrees clockwise
  $bind_w->bind('<Key-9>',             sub { rotate(90);  });
  # key-desc,8,rotate picture(s) 180 degrees clockwise
  $bind_w->bind('<Key-8>',             sub { rotate(180); });
  # key-desc,7,rotate picture(s) 270 degrees clockwise
  $bind_w->bind('<Key-7>',             sub { rotate(270); });
  # key-desc,0,auto rotate picture(s) (EXIF orientation)
  $bind_w->bind('<Key-0>',             sub { rotate("auto"); });


  # key-desc,Escape,iconify the main window/close any other window
  $bind_w->bind('<Key-Escape>',      sub { $top->iconify; } );

  # thumbnail navigation
  # key-desc,Space,display the next picture
  $bind_w->bind('<Key-space>',     sub {
			 return if (stillBusy()); # block, until last picture is loaded
			 if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off
			 showPic(nextPic($actpic));
  } );
  # key-desc,S,display the next selected picture
  $bind_w->bind('<S>',     sub {
			 return if (stillBusy()); # block, until last picture is loaded
			 if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off
			 my @sellist = $lb_w->info('selection');
			 showPic(nextSelectedPic($actpic));
			 reselect($lb_w, @sellist);
  } );
  # key-desc,Page-Down,display the next picture
  $bind_w->bind('<Key-Next>',      sub {
			 return if (stillBusy()); # block, until last picture is loaded
			 if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off
			 showPic(nextPic($actpic));} );
  # key-desc,Backspace,display the previous picture
  $bind_w->bind('<Key-BackSpace>', sub {
			 return if (stillBusy()); # block, until last picture is loaded
			 if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off
			 showPic(prevPic($actpic));} );
  # key-desc,Page-Up,display the previous picture
  $bind_w->bind('<Key-Prior>',     sub {
			 return if (stillBusy()); # block, until last picture is loaded
			 if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off
			 showPic(prevPic($actpic));} );
  # key-desc,Home,display the first picture
  $bind_w->bind('<Key-Home>',      sub {
			 return if (stillBusy()); # block, until last picture is loaded
			 if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off
			 my @childs = $lb_w->info('children');
			 return unless (@childs);
			 showPic($childs[0]); } );
  # key-desc,End,display the last picture
  $bind_w->bind('<Key-End>',      sub {
			 return if (stillBusy()); # block, until last picture is loaded
			 if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off
			 my @childs = $lb_w->info('children');
			 return unless (@childs);
			 showPic($childs[-1]);
		   });

  # key-desc,Ctrl-g,goto picture
  $bind_w->bind('<Control-g>',      sub { gotoPic($lb_w); } );

  # key-desc,s,start/stop slideshow
  $bind_w->bind('<Key-s>',     sub {
			 if ($slideshow == 0) { $slideshow = 1; } else { $slideshow = 0; }
			 slideshow();
		   } );

  # key-desc,-,zoom out or faster slideshow
  $bind_w->bind('<Key-minus>',  sub {
			 if ($slideshow) {
			   $config{SlideShowTime}-- if ($config{SlideShowTime} >= 1);
			   $userinfo = "slideshow time: ".$config{SlideShowTime}." sec"; $userInfoL->update;
			 }
			 else {
			   zoomStep(-1);
			 }
		   } );
  # key-desc,+,zoom in or slideshow slower
  $bind_w->bind('<Key-plus>',   sub {
			 if ($slideshow) {
			   $config{SlideShowTime}++ if ($config{SlideShowTime} < 30);
			   $userinfo = "slideshow time: ".$config{SlideShowTime}." sec"; $userInfoL->update;
			 }
			 else {
			   zoomStep(1);
			 }
		   });

  # key-desc,Ctrl-h,display picture in original size (100% zoom)
  $bind_w->bind('<Control-h>',         sub { zoom100(); });
  # key-desc,z,display picture in original size (100% zoom)
  $bind_w->bind('<Key-z>',             sub { zoom100(); });
  # key-desc,f,fit picture in canvas (auto zoom)
  $bind_w->bind('<Key-f>',             sub { fitPicture(); });

}

##############################################################
# addCommonKeyBindings - add key shortcuts to a widget
##############################################################
sub addCommonKeyBindings {
  my $bind_w = shift; # widget to bind keys to
  my $lb_w   = shift; # thumbnail listbox to use

  # key-desc,a,add JPEG comment
  $bind_w->bind('<Key-a>',             sub { addComment($lb_w); } );
  # key-desc,e,edit JPEG comment
  $bind_w->bind('<Key-e>',             sub { editComment($lb_w); } );
  # key-desc,v,open picture in external viewer
  $bind_w->bind('<Key-v>',             sub { openPicInViewer($lb_w); } );
  # key-desc,r,rename selected pictures
  $bind_w->bind('<Key-r>',             sub { renamePic($lb_w); } );
  # key-desc,x,display embedded EXIF data
  $bind_w->bind('<Key-x>',             sub { displayEXIFData($lb_w); } );
  # key-desc,Ctrl-a,select all pictures
  $bind_w->bind('<Control-a>',         sub { selectAll($lb_w); } );
  # key-desc,i,display IPTC data
  $bind_w->bind('<Key-i>',             sub { displayIPTCData($lb_w); } );
  # key-desc,Ctrl-i,edit IPTC data
  $bind_w->bind('<Control-i>',         sub { editIPTC($lb_w); } );
  # key-desc,Ctrl-p,copy to print
  $bind_w->bind('<Control-p>',         sub { copyToPrint($lb_w); } );
  # key-desc,Ctrl-l,show selected thumbnails on light table
  $bind_w->bind('<Control-l>',         sub { light_table_add_from_lb($lb_w); } );
  # key-desc,Ctrl-t,add/remove categories
  $bind_w->bind('<Control-t>',         sub { editIPTCCategories($lb_w); } );
  # key-desc,Ctrl-k,add/remove keywords
  $bind_w->bind('<Control-k>',         sub { editIPTCKeywords($lb_w); } );

  # key-desc,Ctrl-F01,set IPTC urgency to 1 - high
  $bind_w->bind('<Control-F1>',        sub { setIPTCurgency($lb_w, 1); } );
  # key-desc,Ctrl-F02,set IPTC urgency to 2
  $bind_w->bind('<Control-F2>',        sub { setIPTCurgency($lb_w, 2); } );
  # key-desc,Ctrl-F03,set IPTC urgency to 3
  $bind_w->bind('<Control-F3>',        sub { setIPTCurgency($lb_w, 3); } );
  # key-desc,Ctrl-F04,set IPTC urgency to 4
  $bind_w->bind('<Control-F4>',        sub { setIPTCurgency($lb_w, 4); } );
  # key-desc,Ctrl-F05,set IPTC urgency to 5 -  normal
  $bind_w->bind('<Control-F5>',        sub { setIPTCurgency($lb_w, 5); } );
  # key-desc,Ctrl-F06,set IPTC urgency to 6
  $bind_w->bind('<Control-F6>',        sub { setIPTCurgency($lb_w, 6); } );
  # key-desc,Ctrl-F07,set IPTC urgency to 7
  $bind_w->bind('<Control-F7>',        sub { setIPTCurgency($lb_w, 7); } );
  # key-desc,Ctrl-F08,set IPTC urgency to 8 - low
  $bind_w->bind('<Control-F8>',        sub { setIPTCurgency($lb_w, 8); } );
  # key-desc,Ctrl-F09,set IPTC urgency to 0 - none
  $bind_w->bind('<Control-F9>',        sub { setIPTCurgency($lb_w, 0); } );
  # key-desc,Ctrl-F10,remove IPTC urgency flag
  $bind_w->bind('<Control-F10>',       sub { setIPTCurgency($lb_w, 9); } );
}

##############################################################
# startup - process all stuff needed to set up mapivi
##############################################################
sub startup {

  print "sub startup ...\n" if $verbose;
  $picLB->focus;
  
  if ($config{NrOfRuns} == 0) {
    print "first run ...\n" if $verbose;
	makeConfigDir();
	# todo this should be done outside mapivi (we need an installer!!! :)
	#copyConfigPics();
	#copyOtherStuff();
	#copyPlugIns();
  }
  $config{NrOfRuns}++;
  gratulation() if (($config{NrOfRuns} % 1000 == 0) and ($config{NrOfRuns} > 0)); # modulo

  # create menus
  createMenubar();
  createDirMenu();
  createThumbMenu();
  createPicMenu();

  checkSystem();

  startStopClock();

  # migrate from the old file name "dirInfo" to "SearchDataBase"
  if (-f "$configdir/dirInfo") {
	if (-f "$configdir/SearchDataBase") {
	  warn "Mapivi: there is something wrong! I found a file \"dirInfo\" and \"SearchDataBase\" in $configdir\n";
	}
	else {
	  if (rename("$configdir/dirInfo", "$configdir/SearchDataBase")) {
		print "Mapivi: I have renamed the file \"dirInfo\" to \"SearchDataBase\" in $configdir\n";
	  }
	  else {
		warn "Mapivi: error renaming \"dirInfo\" to \"SearchDataBase\" in $configdir: $!\n";
	  }
	}
  }

  # try to get the saved database (meta info hash)
  if ($config{SaveDatabase} and -f "$configdir/SearchDataBase") {
	my $hashRef = retrieve("$configdir/SearchDataBase");
	warn "could not retrieve searchDB" unless defined $hashRef;
	%searchDB = %{$hashRef};
  }

  # try to get the saved hotlist folders
  if (-f "$configdir/hotlist") {
	my $hashRef = retrieve("$configdir/hotlist");
	warn "could not retrieve hotlist" unless defined $hashRef;
	%dirHotlist = %{$hashRef};
  }

  # try to get the saved folder properties
  if (-f "$configdir/dirProperties") {
	my $hashRef = retrieve("$configdir/dirProperties");
	warn "could not retrieve dirProperties" unless defined $hashRef;
	%dirProperties = %{$hashRef};
  }

  # try to get the saved ignore keywords
  if (-f "$configdir/keywords_ignore") {
	my $hashRef = retrieve("$configdir/keywords_ignore");
	warn "could not retrieve keywords_ignore" unless defined $hashRef;
	%ignore_keywords = %{$hashRef};
  }

  if (MatchEntryAvail) {
	# try to get the saved entry values
	if (-f $file_Entry_values) {
	  my $hashRef = retrieve($file_Entry_values);
	  warn "could not retrieve $file_Entry_values" unless defined $hashRef;
	  %entryHistory = %{$hashRef};
	}
  }

  updateDirMenu();

  if (-f $config{DefaultThumb}) {
	  $defaultthumbP = $picLB->Photo(-format => 'jpeg', -file => $config{DefaultThumb}, -gamma => $config{Gamma});
  }
  else {
	  warn "Mapivi info: no file ".$config{DefaultThumb}." found! (Please copy any thumbnail to this folder and rename it ".basename($config{DefaultThumb}).")\n";
	  undef $defaultthumbP;
  }

  layout(0);

  # remove splash screen
  $splash->Destroy if $splash;

  # show main window
  $top->deiconify;
  $top->raise;

  setDirProperties();
  updateThumbs();
  setAdjusterPos();
  
  my $tmp = $config{ShowPic};
  $config{ShowPic} = 0;
  showPic($actpic) if ($config{SelectLastPic} and (defined $actpic) and ($actpic ne '') and (dirname($actpic) eq $actdir));
  $config{ShowPic} = $tmp;
  
  selectDirInTree($actdir);

  checkTrash();
  
  # if command line option -i is set or a memory card is inserted we start the import wizard
  importWizard() if (($opt_i) or ($config{AutoImport} and (-d $config{ImportSource})));

  if ($EvilOS) {
	warn "Win32::Process module not available\n" unless (Win32ProcAvail);
  }

  $top->update();
}

##############################################################
# testSuite - automated regression tests for mapivi
##############################################################
sub testSuite {

  my @childs = $picLB->info('children');

  if (@childs < 2) {
	$top->messageBox(-icon => 'error', -message => "test suite must be started in a folder with at least two picture!",
					 -title => "test suite", -type => 'OK');
	return;
  }

  my $startdir = dirname($childs[0]);

  my $rc = $top->messageBox(-icon => 'question', -message => "Start some internal test with ".scalar @childs." pictures in $actdir.\nTest results will go to STDOUT (shell/DOS-box where you've started Mapivi).\nOk to go on?",
							-title => "Start test  suite?", -type => 'OKCancel');
  return unless ($rc =~ m/Ok/i);

  # test single selection
  print "testSuite: testing single selection\n";
  foreach (@childs) {
	selectThumb($picLB, $_);
	my @sel = $picLB->info('selection');
	print "testSuite: *** wrong selection\n" if (@sel != 1);
	print "testSuite: *** wrong selection\n" if ($sel[0] ne $_);
  }

  # test all selection
  print "testSuite: testing all selection\n";
  selectAll($picLB);
  my @sel = $picLB->info('selection');
  print "testSuite: *** wrong selection\n" if (@sel != @childs);

  my $dir1 = "$trashdir/testdir1";
  my $dir2 = "$trashdir/testdir2";
  # cleanup
  foreach ($dir1, $dir2) {
	print "testSuite: removing temp dir $_\n";
	rmtree($_, 0, 1) if (-d $_); # dir, 0 = no message for each file, 1 = skip write protected files
  }
  foreach ($dir1, $dir2) { unless (makeDir($_, NO_ASK)) { print "testSuite: could not create $_\n"; } }
  print "testSuite: temp dirs created\n";

  foreach ($dir1, $dir2) { unless (-d $_) { warn "testSuite: *** $_ not found!\n"; return; } }

  # test copy actdir -> dir1
  print "testSuite: testing copy all\n";
  selectAll($picLB);
  copyPics($dir1, COPY, $picLB, @childs);
  openDirPost($dir1);

  my @childs1 = $picLB->info('children');
  if (@childs1 != @childs) {
	warn "testSuite: *** copy error ".scalar @childs1." ne ".scalar @childs."\n";
  }
  foreach my $i (0 .. $#childs1) {
	# todo this will fail, if files are sorted by file date (copy date)
	if (basename($childs[$i]) ne basename($childs1[$i])) {
	  warn "testSuite: *** copy error $childs[$i] ne $childs1[$i]\n";
	}
  }

  # copy first pic dir1 -> dir2
  print "testSuite: testing copy first\n";
  selectThumb($picLB, $childs1[0]);
  @sel = $picLB->info('selection');
  if (@sel ne 1) {
	warn "testSuite: *** sel error ".scalar @sel." ne 1\n";
  }
  copyPics($dir2, COPY, $picLB, @sel);
  openDirPost($dir2);
  my @childs2 = $picLB->info('children');
  if (@childs2 ne 1) {
	warn "testSuite: *** copy error ".scalar @childs2." ne 0\n";
  }
  if (basename($childs1[0]) ne basename($childs2[0])) {
	warn "testSuite: *** copy error $childs[0] ne $childs1[0]\n";
  }

  # clean dir2
  selectAll($picLB);
  deletePics($picLB, TRASH);

  # copy last pic dir1 -> dir2
  print "testSuite: testing copy last\n";
  openDirPost($dir1);
  selectThumb($picLB, $childs1[-1]);
  @sel = $picLB->info('selection');
  if (@sel ne 1) {
	warn "testSuite: *** sel error ".scalar @sel." ne 1\n";
  }
  copyPics($dir2, COPY, $picLB, @sel);
  openDirPost($dir2);
  @childs2 = $picLB->info('children');
  if (@childs2 ne 1) {
	warn "testSuite: *** copy error ".scalar @childs2." ne 0\n";
  }
  if (basename($childs1[-1]) ne basename($childs2[-1])) {
	warn "testSuite: *** copy error $childs[-1] ne $childs1[-1]\n";
  }

  # clean dir2
  print "testSuite: cleaning dir\n";
  selectAll($picLB);
  deletePics($picLB, TRASH);

  # move all pics dir1 -> dir2
  print "testSuite: testing move all\n";
  openDirPost($dir1);
  selectAll($picLB);
  @sel = $picLB->info('selection');
  movePics($dir2, $picLB, @sel);
  openDirPost($dir2);
  @childs2 = $picLB->info('children');
  if (@childs2 != @childs1) {
	warn "testSuite: *** move error ".scalar @childs2." ne ".scalar @childs1."\n";
  }

  # move first and last pics dir2 -> dir1
  print "testSuite: testing move first and last\n";
  selectThumb($picLB, $childs2[0]);
  @sel = $picLB->info('selection');
  movePics($dir1, $picLB, @sel);
  selectThumb($picLB, $childs2[-1]);
  @sel = $picLB->info('selection');
  movePics($dir1, $picLB, @sel);
  openDirPost($dir1);
  @childs1 = $picLB->info('children');
  if (@childs1 != 2) {
	warn "testSuite: *** move error ".scalar @childs1." ne 2\n";
  }

  # test backup dir1
  print "testSuite: testing backup all\n";
  selectAll($picLB);
  @sel = $picLB->info('selection');
  copyPics($dir1, BACKUP, $picLB, @sel);
  @childs1 = $picLB->info('children');
  if (@childs1 != 4) {
	warn "testSuite: *** backup error ".scalar @childs1." ne 4\n";
  }

  # test delete backups dir1
  selectBak();
  @sel = $picLB->info('selection');
  warn "testSuite: *** sel error ".scalar @sel." ne 2\n" if (@sel != 2);
  deletePics($picLB, TRASH);
  @childs1 = $picLB->info('children');
  warn "testSuite: *** delete backup error ".scalar @childs1." ne 2\n" if (@childs1 != 2);

  # move the two pics back dir1 -> dir2
  print "testSuite: testing move back\n";
  selectAll($picLB);
  @sel = $picLB->info('selection');
  warn "testSuite: *** sel error ".scalar @sel." ne 2\n" if (@sel != 2);
  movePics($dir2, $picLB, @sel);
  @childs1 = $picLB->info('children');
  if (@childs1 != 0) {
	warn "testSuite: *** delete backup error ".scalar @childs1." ne 0\n";
  }

  # check if nothing is lost
  openDirPost($dir2);
  @childs2 = $picLB->info('children');
  warn "testSuite: *** we lost some pics ".scalar @childs2." ne ".scalar @childs."\n" if (@childs2 != @childs);
  warn "testSuite: move ".scalar @childs2." = ".scalar @childs."?\n";


  # link all pics dir2 -> dir1
  print "testSuite: testing link all\n";
  openDirPost($dir2);
  @childs2 = $picLB->info('children');
  selectAll($picLB);
  @sel = $picLB->info('selection');
  linkPics($dir1, @sel);
  @childs2 = $picLB->info('children');
  openDirPost($dir1);
  @childs1 = $picLB->info('children');
  warn "testSuite: link ".scalar @childs2." = ".scalar @childs1."?\n";
  if (@childs2 != @childs1) {
	warn "testSuite: *** link error ".scalar @childs2." ne ".scalar @childs1."\n";
  }

  # clean dir1
  print "testSuite: cleaning dir\n";
  selectAll($picLB);
  deletePics($picLB, TRASH);

  # test comments first pic
  print "testSuite: testing comment single\n";
  my $testcom = "xxxcccxxx1234ABC";
  openDirPost($dir2);
  @childs2 = $picLB->info('children');
  selectThumb($picLB, $childs2[0]);
  @sel = $picLB->info('selection');
  addCommentToPic($testcom, $sel[0], TOUCH);
  my $com = getComment($sel[0], LONG);
  if ($com !~ m/.*$testcom.*/) {
	warn "testSuite: *** comment $com does not contain $testcom\n";
  }

  # test comments join
  print "testSuite: testing comments remove and join\n";
  # add a comment to all pics
  selectAll($picLB);
  @sel = $picLB->info('selection');
  addCommentToPic($testcom, $_, TOUCH) foreach (@sel);
  # remove the comments from the last pic, so we have at least one example for no comment
  selectThumb($picLB, $childs2[-1]);
  removeAllComments(NO_ASK);
  warn "testSuite: *** remove comment error\n" if (scalar getComments($childs2[-1]) != 0);
  selectAll($picLB);
  my %comNr; # hash: key:dpic value:nr of comments
  foreach (@childs2) {
	my @com = getComments($_);
	$comNr{$_} = scalar @com;
  }
  joinComments(NO_ASK);
  foreach (@childs2) {
	my @com = getComments($_);
	my $nr = $comNr{$_};
	$nr = 1 if ($nr >= 2);
	print $comNr{$_}." -> $nr act: ".scalar @com."($#com)\n" if $verbose;
	warn "testSuite: *** comment join error\n" if ($nr != @com);
  }

  # test rotate
  print "testSuite: testing rotate single\n";
  selectThumb($picLB, $childs2[0]);
  rotate(90);
  rotate(270);
  my $size = getFileSize($childs2[0]);
  rotate(90);
  rotate(270);
  warn "testSuite: *** rotate single file mismatch!\n" if ($size != getFileSize($childs2[0]));


  @childs2 = $picLB->info('children');
  warn "testSuite: *** rotate all 90 ".scalar @childs2." ne ".scalar @childs."\n" if (@childs2 != @childs);

  ##################################################
  print "testSuite: going back to start dir\n";
  openDirPost($startdir);
  changeDir($startdir); # linking files changes the cwd so we must move back before we try to remove the dirs

  # end
  $top->messageBox(-icon => 'info', -message => "test suite finished",
				   -title => "test suite", -type => 'OK');

  # cleanup
  foreach ($dir1, $dir2) {
	print "testSuite: removing temp dir $_\n";
	rmtree($_, 0, 1) if (-d $_); # dir, 0 = no message for each file, 1 = skip write protected files
  }
}

##############################################################
# addToCachedPics - add a image (path and file name) to
#                  the cachedPics list
#                  if it is already in the list, move it to
#                  the end
##############################################################
sub addToCachedPics {

  my $dpic = shift;
  for my $t ( 0 .. $#cachedPics ) {
	if ($cachedPics[$t] eq $dpic) {
	  splice @cachedPics, $t, 1;  # remove it from list
	  last;
	}
  }
  push @cachedPics, $dpic;  # add item to the list
  print "addToCachedPics: $dpic list:$#cachedPics\n" if $verbose;
  checkCachedPics();
}

##############################################################
# checkCachedPics - check if the cachedPics list contains more
#                   images than allowed, remove the oldest
#                   if necessary
##############################################################
sub checkCachedPics {

  # first check if all entries are valid pictures
  my @rm_list;
  for my $t ( 0 .. $#cachedPics ) {
	push @rm_list, $t unless (-f $cachedPics[$t]);
  }

  # remove the invalid pictures
  for my $t (reverse @rm_list) {
	my $dpic = $cachedPics[$t];
	next unless ($dpic);
	print "checkCachedPics: removing not existing $dpic\n" if $verbose;
	$c->delete('withtag', $dpic);                # remove it from the canvas
	$photos{$dpic}->delete if $photos{$dpic};  # delete the photo object
	delete $photos{$dpic};                      # delete the hash item
	splice @cachedPics, $t, 1;                 # remove not existing pictures it from list
  }

  # short the list, if it is to long
  while (@cachedPics > $config{MaxCachedPics}) {
	if ($actpic eq $cachedPics[0]) {
	  print "this is the aktual pic - skipping!\n" if $verbose;
	  next;
	}
	my $dpic = shift @cachedPics;       # get the oldest
	print "checkCachedPics: removing old $dpic list:$#cachedPics\n" if $verbose;
	$c->delete('withtag', $dpic);           # remove it from the canvas
	$photos{$dpic}->delete if $photos{$dpic}; # delete the photo object
	delete $photos{$dpic};                    # delete the hash item
  }
  #printlist(@cachedPics);
  # just for safety
  warn "*** checkCachedPics: photos hash contains more than MaxCachedPics pics (".scalar @cachedPics."(".scalar(keys(%photos)).") > ".$config{MaxCachedPics}.")" if (keys %photos > $config{MaxCachedPics});
}


##############################################################
# renameCachedPic - rename a list item
##############################################################
sub renameCachedPic($$) {
  my $old = shift;
  my $new = shift;

  return unless (defined $photos{$old});

  # open new photo object
  $photos{$new} = $top->Photo;
  $photos{$new}->blank;
  $photos{$new}->copy($photos{$old});
  $c->delete('withtag', $old);   # remove it from the canvas
  $photos{$old}->delete if $photos{$old}; # delete the photo object
  delete $photos{$old};                    # delete the hash item
  my $xoffset = 0; my $yoffset = 0;
  $xoffset = int(($c->width  - $photos{$new}->width) /2) if ($c->width  > $photos{$new}->width);
  $yoffset = int(($c->height - $photos{$new}->height)/2) if ($c->height > $photos{$new}->height);
  # hide all items on the canvas
  canvasHide();
  # insert pic
  my $id = $c->createImage($xoffset, $yoffset, -image => $photos{$new}, -tag => ["pic", $new], -anchor => "nw");
  bindItem($id);

  for my $t ( 0 .. $#cachedPics ) {
	if ($cachedPics[$t] eq $old) {
	  $cachedPics[$t] = $new;           # rename list item
	}
  }
  print "renameCachedPic: $old -> $new\n" if $verbose;
  checkCachedPics();
}

##############################################################
# deleteCachedPics - delete all or just one element(s)
#                    and photo objects of the cachedPics list
##############################################################
sub deleteCachedPics {
  my $dpic = shift;     # optional, if available this picture will be removed from the cachedPics list,
                        # if not available all elements will be deleted

  if (defined($dpic) and isInList($dpic, \@cachedPics)) {
	print "deleteCachedPics: delete single pic $dpic (".scalar @cachedPics.")\n" if $verbose;
	$c->delete('withtag', $dpic);   # remove it from the canvas
	$photos{$dpic}->delete if $photos{$dpic}; # delete the photo object
	delete $photos{$dpic};                 # delete the hash item

	#printlist(@cachedPics);
	my @list = @cachedPics;  # copy list
	@cachedPics = ();        # empty list

	foreach my $i (reverse 0 .. $#list) {
	  unless ($list[$i] eq $dpic) {
		print "deleteCachedPics: adding $list[$i]\n" if $verbose;
		push @cachedPics, $list[$i];
	  }
	}
  }
  else {
	print "deleteCachedPics: delete all (".scalar @cachedPics.")\n" if $verbose;
	foreach (@cachedPics) {
	  $c->delete('withtag', $_);        # remove it from the canvas
	  $photos{$_}->delete if $photos{$_}; # delete the photo object
	  delete $photos{$_};                 # delete the hash item
	  print "deleteCachedPics: deleting pic $_\n" if $verbose;
	}
	@cachedPics = ();               # empty list
  }
}

##############################################################
# showSelectedPic - displays the original picture of the
#                   selected thumbnail
##############################################################
sub showSelectedPic {

  return if (stillBusy()); # block, until last picture is loaded

  my @sellist = $picLB->info('selection');

  # show index number in window
  showNrOf();

  return unless ($picLB->info('children'));
  return if (@sellist > 1);

  showPic($sellist[0]);
}

##############################################################
# showNrOf
##############################################################
sub showNrOf {
  my @pics    = $picLB->info('children');
  my @sellist = $picLB->info('selection');
  my $index   = 0;
  my $size    = 0;
  my $sizeStr = "";

  if (@sellist >= 1) {  # selection available
	foreach (@pics) {
	  $index++;
	  last if ($_ eq $sellist[0]);
	}
  }

  if (@sellist >= 2) {  # more than one selected
	foreach (@sellist) {
	  $size += getFileSize($_, NO_FORMAT);
	}
	$sizeStr = computeUnit($size) if $size;
	$sizeStr = ", $sizeStr" if ($sizeStr ne "");
  }

  # show index number in window
  $nrof = "$index/".@pics." (".@sellist."$sizeStr)";
}

##############################################################
# computeUnit - do a byte to kB or MB conversion
##############################################################
sub computeUnit {
	my $size = shift;
	my $sizeStr;

	$size = int($size/1024);                   # KiloByte
	
	if ($size > 1024) {                        # MegaByte
      if ($size > 1024*1024) {                 # GigaByte
		if ($size < (1024*1024*100)) {              # less than 100GB
			$size    = int($size*10/(1024*1024))/10;  # e.g. 6.9GB or 23.4GB
		}
		else {
			$size    = int($size/(1024*1024));        # e.g. 104GB
		}
		$sizeStr = "${size}GB";
      }
      else {
		if ($size < (1024*100)) {              # less than 100MB
			$size    = int($size*10/1024)/10;  # e.g. 6.9MB or 23.4MB
		}
		else {
			$size    = int($size/1024);        # e.g. 104MB
		}
		$sizeStr = "${size}MB";
      }
	}
	else {
		$sizeStr = "${size}kB";
	}

	return $sizeStr;
}

##############################################################
# showPic - displays the picture with the given index $i
##############################################################
sub showPic {

  my $dpic   = shift;

  my @pics = $picLB->info('children');

  return if ((!defined $dpic) or (!@pics));

  if (@pics < 1) {
	warn "no pictures in picLB!" if $verbose;
	$userinfo = "no JPEG pictures in dir $actdir"; $userInfoL->update;
	return;
  }

  $actpic = $dpic;

  return if ((!defined $actpic) or ($actpic eq ""));

  setTitle();

  # show EXIF info and comment
  showImageInfo($dpic);

  my $pic = basename($dpic);

  # select thumb in list even if picture is not shown (see "ShowPic" below)
  selectThumb($picLB, $dpic);

  return if (!$config{ShowPic});

  # we are still not able to display RAW pictures (nefextract may be a solution for NEFs)
  return if ($dpic =~ m/.*\.(nef)|(raw)$/i);

  # do not show a picture if there is no picture frame
  if (!$config{ShowPicFrame}) {
	$userinfo = "$pic not displayed - no picture frame (hint: try F9 or F11)"; $userInfoL->update;
	return;
  }

  # do not show a picture if the frame is very small
  if ($mainF->width < 200) {
	$userinfo = "$pic not displayed (picture frame too small)"; $userInfoL->update;
	return;
  }

  $showPicInAction = 1;

  $balloon->detach($c); # clear the balloon info for the actual pic (right frame of main window)

  $userinfo = "loading $pic ..."; $userInfoL->update;

  my @ids = $c->find('withtag', $dpic);

  my $id;
  if (@ids > 0) { # pic is already loaded
	print "showPic: using cached pic $dpic\n" if $verbose;
	# hide all items on the canvas
	canvasHide();
	$c->itemconfigure($ids[0], -state => 'normal');
	$id = $ids[0];
	$top->update();
  }
  else {
	print "showPic: loading pic $dpic\n" if $verbose;
	if (-f $dpic) { # load pic
	  $top->Busy();
	  #my $dpic_jpg = "";
	  #if ($dpic =~ m/(.*)\.nef$/i) {
		#  $dpic_jpg = $1.".jpg";
		#  print "$dpic is a NEF -> $dpic_jpg\n";
		#  my $command = "nefextract \"$dpic\" > \"$dpic_jpg\" ";
		#  execute($command);
	  #}
	  #if (-f $dpic_jpg) {
		  # load pic
		#  $photos{$dpic} =  $top->Photo(-file => $dpic_jpg, -gamma => $config{Gamma});
		  # zoom pic
		#  autoZoom(\$photos{$dpic}, $dpic_jpg, $c->width, $c->height);
	  #}
	  #else {
		  # load pic
		  $photos{$dpic} = $top->Photo(-file => $dpic, -gamma => $config{Gamma});
		  # zoom pic
		  autoZoom(\$photos{$dpic}, $dpic, $c->width, $c->height) if (exists $photos{$dpic} and $config{AutoZoom});
	  #}

	  if (exists $photos{$dpic}) {
		# center pic in canvas, only when it's smaller
		my $xoffset = 0; my $yoffset = 0;
		$xoffset = int(($c->width  - $photos{$dpic}->width) /2) if ($c->width  > $photos{$dpic}->width);
		$yoffset = int(($c->height - $photos{$dpic}->height)/2) if ($c->height > $photos{$dpic}->height);
		# hide all items on the canvas
		canvasHide();
		# insert pic
		$id = $c->createImage($xoffset, $yoffset, -image => $photos{$dpic}, -tag => ['pic',"$dpic"], -anchor => 'nw');
		bindItem($id);
		addToCachedPics($dpic);
	  }
	  else {
		$userinfo = "error loading $actpic"; $userInfoL->update;
		warn "showPic: error loading $actpic!" if $verbose;
	  }
	  $top->Unbusy();
	  addToCachedPics($dpic);
	}
	else {
	  canvasHide();
	  warn "showPic: error $actpic not available!" if $verbose;
	}
  }

  # show zoom info
  showZoomInfo($dpic, $id);
  showImageInfoCanvas($dpic);

  increasePicPopularity($dpic);
  updateOneRow($dpic, $picLB) if ($config{trackPopularity});

  if ($config{ShowPicInfo}) {
	# balloon info for displayed picture (right frame of the main window)
	my $balloonmsg = makeBalloonMsg($dpic);
	# bind the balloon to the canvas
	$balloon->attach($c->Subwidget('canvas'), -balloonposition => 'mouse',  -msg => {"pic" => $balloonmsg} );
  }
  else { $balloon->detach($c->Subwidget('canvas')); }

  $userinfo = "$pic"; $userInfoL->update;

  # adjust the canvas scrollbars
  my ($x1, $y1, $x2, $y2) = $c->bbox($id);
  if (defined($x1) and defined($x2) and defined($y1) and defined($y2)) {
	$c->configure(-scrollregion => [0, 0, $x2-$x1, $y2-$y1]);
  }

  $top->Unbusy();

  $showPicInAction = 0;
}

##############################################################
# canvasHide
##############################################################
sub canvasHide {
  # hide all items on the canvas
  $c->update();
  #$c->itemconfigure('all', -state => 'hidden');
  #$c->itemconfigure('withtag', 'pic', -state => 'hidden');
  foreach ($c->find('withtag', 'pic')) {
	$c->itemconfigure($_, -state => 'hidden');
  }

}

##############################################################
# setTitle - set the window title and the userinfo to the
#            actual pic
##############################################################
sub setTitle {
  my $title = "";
  $title = basename($actpic)." - " if ((defined $actpic) and ($actpic ne "") and (-f $actpic));
  $title .= "MaPiVi $version";

  # just a little gag
  my (undef,undef,undef,$d,$m,$y,undef,undef, undef,undef) = localtime(time());
  $y += 1900; $m++;
  $title .= " - Happy new year $y!" if ($d == 1 and $m == 1);

  $top->title($title);
  $userinfo = basename($actpic); $userInfoL->update;
}

##############################################################
# increasePicPopularity
##############################################################
sub increasePicPopularity {

  return unless ($config{trackPopularity});

  my $dpic = shift;

  if (defined $searchDB{$dpic}{POP}) {
	$searchDB{$dpic}{POP}++;
  }
  else {
	$searchDB{$dpic}{POP} = 1;
  }

  print "$dpic has been shown $searchDB{$dpic}{POP} times.\n" if $verbose;

}

##############################################################
# showMostPopularPics - display the Top 100 of the best rated pics
##############################################################
sub showMostPopularPics {

  # open window
  my $win = $top->Toplevel();
  $win->title('Best rated pictures - TOP 100');
  $win->iconimage($mapiviicon) if $mapiviicon;

  my $text = "searching ...";

  $win->Label(-textvariable => \$text)->pack(-expand => 0, -fill => 'x');
  my $tlb = $win->Scrolled("HList",
						   -header     => 1,
						   -separator  => ';',  # todo here we hope that ; will never be in a folder or file name
						   -pady       => 0,
						   -columns    => 3,
						   -scrollbars => 'osoe',
						   -selectmode => 'extended',
						   -background => $config{ColorBG}, #8fa8bf
						   -width      => 100,
						   -height     => 60,
						  )->pack(-expand => 1, -fill => "both");

  bindMouseWheel($tlb);
  $tlb->header('create', 0, -text => 'Place', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
  $tlb->header('create', 1, -text => 'Thumbnail', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
  $tlb->header('create', 2, -text => 'Info',      -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});


  my $butF = $win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);

  my $Xbut = $butF->Button(-text => 'Close',
						   -command => sub {
							 $win->destroy();
						   })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $win->bind('<Control-q>',  sub { $Xbut->invoke; });
  $win->bind('<Key-Escape>', sub { $Xbut->invoke; });
  $win->bind('<Control-a>',  sub { selectAll($tlb); } );
  $win->bind('<ButtonPress-2>', sub {
			   return if (!$tlb->info('children'));
			   my $dpic = getNearestItem($tlb);
			   showPicInOwnWin($dpic); });

  $win->Popup(-popover => 'cursor');
  repositionWindow($win);

  my @populatity_list = sort {
	  my $urga = 0;
	  $urga = $searchDB{$a}{URG} if (defined $searchDB{$a}{URG});
	  $urga = 9 if ($urga == 0);
	  my $urgb = 0;
	  $urgb = $searchDB{$b}{URG} if (defined $searchDB{$b}{URG});
	  $urgb = 9 if ($urgb == 0);
	  $urga <=> $urgb;
  } keys %searchDB;

#  my @populatity_list = sort {
#	  my $popa = 0;
#	  $popa = $searchDB{$a}{POP} if (defined $searchDB{$a}{POP});
#	  my $popb = 0;
#	  $popb = $searchDB{$b}{POP} if (defined $searchDB{$b}{POP});
#	  $popb <=> $popa;
# } keys %searchDB;

  $win->update();

  $text = "loading ...";

  my %thumbs;
  foreach my $nr (0 .. 99) {
	my $dpic  = $populatity_list[$nr];
	my $num   = $nr + 1;
	my $pic   = basename($dpic);
	my $path  = dirname($dpic);
	my $thumb = getThumbFileName($dpic);
	$tlb->add($dpic);
	$text = "loading $num ...";

	$tlb->itemCreate($dpic, 0, -text => $num,  -style => $comS);

	if (-f $thumb) {
	  $thumbs{$thumb} = $top->Photo(-file => $thumb, -gamma => $config{Gamma});
	  if (defined $thumbs{$thumb}) {
		$tlb->itemCreate($dpic, 1, -image => $thumbs{$thumb}, -itemtype => 'imagetext', -style => $thumbS);
	  }
	}

	my $pop = 0;
	$pop = $searchDB{$dpic}{POP} if (defined $searchDB{$dpic}{POP});
	my $urg = 0;
	$urg = $searchDB{$dpic}{URG} if (defined $searchDB{$dpic}{URG});
	$tlb->itemCreate($dpic, 2, -text => "$pic\n$path\nRating: $urg\n(viewed $pop times)", -style => $fileS);
  }


  $text = "Ready";

  $win->waitWindow;
  foreach (keys %thumbs) { $thumbs{$_}->delete if (defined $thumbs{$_}); } # free memory
}

##############################################################
# stopWatchStart
##############################################################
my $stopWatchTime;
sub stopWatchStart {
  $stopWatchTime = Tk::timeofday();
}

##############################################################
# stopWatchStop
##############################################################
sub stopWatchStop {
  my $text = '';
  $text = shift;
  printf "stopWatch: %.5f secs ($text)\n", (Tk::timeofday() - $stopWatchTime);
}

##############################################################
# selectThumb
##############################################################
sub selectThumb {
  my $lb    = shift;
  my $index = shift;
  $lb->selectionClear();
  return unless (defined $index);
  unless ($lb->info("exists", $index)) {
	warn "selectThumb: $index is not availabel!" if $verbose;
	return;
  }
  $lb->selectionSet($index);
  $lb->anchorSet($index);
  $lb->see($index);
  $lb->update;
  if ($config{CenterThumb}) {
	my $next = $lb->info('next', $index);
	my $prev = $lb->info('prev', $index);
	$lb->see($prev) if ($prev);
	$lb->update;
	$lb->see($next) if ($next);
  }
  showNrOf();
}

##############################################################
# selectAll
##############################################################
sub selectAll {

  my $lb = shift;
  my @pics = $lb->info('children');
  return unless (@pics);
  $lb->selectionSet($pics[0], $pics[-1]);
  showNrOf() if ($lb == $picLB);
}

##############################################################
# selectBak
##############################################################
sub selectBak {

  $picLB->selectionClear();
  my @pics = $picLB->info('children');
  foreach (@pics) {
	if ($_ =~ m/.*-bak\.jp(g|eg)$/i) {
	  $picLB->selectionSet($_);
	}
  }
  showNrOf();
  if (!defined $picLB->info('selection')) {
	$top->messageBox(-icon => 'info', -message => "Nothing selected!\nThere are no file names matching the pattern: \"*-bak.jp(e)g\".",
					 -title => "No backups", -type => 'OK');
  }
}

##############################################################
# selectInv
##############################################################
sub selectInv {

  my @sellist = $picLB->info('selection');
  $picLB->selectionClear();
  my @pics = $picLB->info('children');
  foreach (@pics) {
	if (!isInList($_, \@sellist)) {
	  $picLB->selectionSet($_);
	}
  }
  showNrOf();
}

##############################################################
# getThumbFileName - return the location of the corresponding
#                    thumbnail file (full path)
##############################################################
sub getThumbFileName($) {
  my $dpic = shift;

  my $dir = dirname( $dpic);
  my $pic = basename($dpic);

  # normalize the path
  $dir =~ s!\\!\/!g;     # replace Windows path delimiter with UNIX style \ -> /
  #$dir =~ s/\\/\//g;     # replace Windows path delimiter with UNIX style \ -> /

  if (defined $thumbDBhash{$dir}) {
	return $thumbDBhash{$dir}."/$pic";
  }

  #$dir =~ s!^([a-z]:)/!$1\\!i if $EvilOS; # replace E:/ with E:\ else Win will fire an error message that E: is not mounted

  my @thumbDirNoNos = qw( /mnt/cdrom /mnt/dvd ); # todo
  my $thumbDB  = "$configdir/thumbDB";
  my $thumbdir = "$dir/$thumbdirname";

  # central thumbDB
  if (($config{CentralThumbDB})            or # config option set to central thumbdir
   (!-d $dir)                               or # if the folder is not mounted/available
   ((-d $thumbdir) and (!-w $thumbdir))     or # or .thumbdir exists but is write protected
   (-f "$dir/.nothumbs")                    or # or file .nothumbs is found
   ((!-w $dir) and (!-d $thumbdir))) {         # or dir is write protected but there is no .thumbdir

	if ($EvilOS) { # in windows we have to get rid of the device names (C:\ d:/ etc.)
	  print "getThumbFileName: $dir " if $verbose;
	  $dir =~ s!^[a-z]:/!!i;                   # for slash
	  $dir =~ s!^[a-z]:\\!!i;                  # for backslash
	  print "-> $dir\n" if $verbose;
	}
	else {  # for other OS (Linux etc.) we cut off special parts
	  foreach (@thumbDirNoNos) {
		if ($dir =~ /^$_/) {
		  print "getThumbFileName: $dir " if $verbose;
		  $dir =~ s/^$_//;   # cut off unwanted dir part e.g. /mnt/cdrom
		  print "-> $dir\n" if $verbose;
		  last;              # one is enough
		}
	  }
	}
	$thumbdir =  "$thumbDB/$dir";
	$thumbdir =~ s/\/+/\//g;    # replace multiple slashes with one             // -> /
  }

  $thumbDBhash{$dir} = $thumbdir; # store for quicker response

  my $thumb = "$thumbdir/$pic";   # add the pic name

  return $thumb;
}

##############################################################
# generateThumbs - generate thumbnails for each picture
#                  remove outdated thumbs
##############################################################
sub generateThumbs {

  print "generateThumbs\n"  if $verbose;
  my $ask     = shift;	# ASK = ask the user befor making a thumbnail dir, NO_ASK
  my $show    = shift;	# SHOW = show the generated thumbs in $picLB, NO_SHOW
  my $getpics = shift;  # optional bool, get the pics with getpics not from the listbox
  my ($pic, $dpic, $lpic, $thumb, $string);
  my $nrofprocs = 0;
  my @pics;

  if ((defined $getpics) and ($getpics == 1)) {
	@pics = getPics($actdir, WITH_PATH);
    # if the thumbs won't be shown, no need to sort
	sortPics($config{SortBy}, $config{SortReverse}, \@pics) if ($show == SHOW);
  }
  else {
	@pics = $picLB->info('children');	# this should be much faster than getPics($actdir);
  }

  # remove outdated thumbs and exif data
  cleanSubDirs($actdir);

  return if (@pics <= 0);

  my $thumbdir = dirname(getThumbFileName("$actdir/dummy.jpg"));

  return if (!makeDir("$thumbdir", $ask));

  # if thumb dir is not writeable
  if (!-w $thumbdir) {
	$top->messageBox(-icon => 'warning', -message => "$thumbdir is not writeable, so mapivi is not able to generate thumbnails", -title => "No write access", -type => 'OK');
	return;
  }

  # look what's to do
  $nrToConvert = 0;
  foreach $lpic (@pics) {
	$dpic = $lpic;
	next if (!getRealFile(\$dpic));
	$thumb = getThumbFileName($lpic);
	if (aNewerThanb($dpic, $thumb)) {
	  $nrToConvert++;			# count the nr of thumbs to generate/refresh
	}
  }
  return if ($nrToConvert == 0); # nothing to do

  # ask the user, if he wants to update the thumbs now
  if ($config{AskGenerateThumb}) {
	my $rc    = checkDialog("Generate thumbnails?",
						 "There are $nrToConvert thumbnails to generate.\nShall I do this now?",
						 \$config{AskGenerateThumb},
						 "ask every time",
						 "",
						 'OK', 'Cancel');
	return if ($rc ne 'OK');
  }

  my $pre = makeCommandString(\%config);

  # generate thumbs
  my $i = 0;					# pic list index
  foreach $lpic (@pics) {
	$dpic = $lpic;
	next if (!getRealFile(\$dpic));
	$pic   = basename($dpic);
	$thumb = getThumbFileName($lpic);

	if (!aNewerThanb($dpic, $thumb)) {
	  $i++;
	  next;
	}

	if (-z $dpic) {				# file is empty (size zero)
	  $top->messageBox(-icon => 'warning', -message => "$pic is an empty file. Skipping.",
					   -title => 'Error', -type => 'OK');
	  $i++;
	  next;
	}

	removeFile($thumb);

	# try to get the EXIF thumbnail
	if ($config{UseEXIFThumb}) {
	  my $errors = "";
	  extractThumb($dpic, $thumb, \$errors);
	}

	# found a EXIF thumbnail -> show it
	if (-f $thumb) {
	  # here we increase the process counter, just because ...
	  proccount(1);
	  # ... in updateOneThumb it will be decreased
	  updateOneThumb($thumb, $lpic, $show);
	  $i++;
	  next;
	}

	# thumbnail is always in JPEG format, but the suffix of the picture is not changed
	$string = "$pre \"$dpic\" JPEG:\"$thumb\" ";

	print "command: $string\n" if $verbose;

	if (!$EvilOS) { # running on a "good" OS like Linux we can use background processes :)
	  # start a background process for each pic
	  my $fh = Tk::IO->new(-linecommand => \&nop, -childcommand => [\&updateOneThumb, $thumb, $dpic, $show]);
	  #$hiresstart = [gettimeofday];  # hires - measure the loading time
	  $fh->exec($string);
	  proccount(1);				# count processes
	  $nrofprocs = proccount();
	  if ($nrofprocs >= $config{MaxProcs}) {
		# waiting for current process to finish
		$fh->wait();
	  }
	}

	else { # we run on a evil OS like windows - no threading :(
	  proccount(1);				# count processes
	  (system "$string") == 0 or warn "$string failed: $!";
	  updateOneThumb($thumb, $lpic, $show);
	}

	$i++;
  }

  print "...done\n" if $verbose;
}

##############################################################
# generateOneThumb
##############################################################
sub generateOneThumb {
  my $dpic   = shift;
  my $pre    = makeCommandString(\%config);
  my $thumb  = getThumbFileName($dpic);
  my $string = "$pre \"$dpic\" JPEG:\"$thumb\" ";
  execute($string);
}

##############################################################
# cleanSubDirs - remove thumbs and exif infos without a
#                corresponding picture
##############################################################
sub cleanSubDirs {
  my $dir      = shift;
  my $thumbdir = dirname(getThumbFileName("$dir/dummy.jpg"));
  my $exifdir  = "$dir/$exifdirname";
  my $pic;

  return if (!-d $dir);

  # clean thumb and exif dir
  foreach my $subdir ($thumbdir, $exifdir) {
	if (-d $subdir) {
	  my @subpics = getPics($subdir, JUST_FILE); # no sort needed
	  foreach $pic (@subpics) {
		if (!-f "$dir/$pic") {
		  removeFile("$subdir/$pic");
		}
	  }
	}
  }

}

##############################################################
# makeCommandString - build up the command string for the
#                     generation of thumbnails depending on
#                     the settings in the given config hash
##############################################################
sub makeCommandString {
  my $conf = shift;
  my $pre  = "";

  $pre = " montage -size $conf->{'ThumbSize'}x$conf->{'ThumbSize'} -geometry $conf->{'ThumbSize'}x$conf->{'ThumbSize'}+$conf->{'ThumbBorder'}+$conf->{'ThumbBorder'} -quality $conf->{'ThumbQuality'} -background \"$conf->{'ColorThumbBG'}\" ";
  #$pre .= "-frame $conf->{'ThumbBorder'}x$conf->{'ThumbBorder'} " if $conf->{UseThumbFrame};
  $pre .= "-shadow " if $conf->{UseThumbShadow};

  # ! Sharpen is the most time consuming option, when building thumbnails!
  if ($conf->{ThumbSharpen} > 0) {
	$pre .= "-sharpen $conf->{'ThumbSharpen'} " # the higher the value the slower
  }

  return $pre;
}

##############################################################
# light_table_open_window
##############################################################
sub light_table_open_window {

  if (Exists($ltw)) {
	$ltw->deiconify;
	$ltw->raise;
	$ltw->focus;
	return;
  }

  # open window
  $ltw = $top->Toplevel();
  $ltw->title('Mapivi Light table');
  $ltw->iconimage($mapiviicon) if $mapiviicon;

  $ltw->bind('<Key-Escape>', sub {light_table_close(ASK);});
  $ltw->bind('<Key-q>',      sub {light_table_close(ASK);});
  $ltw->bind('<Control-a>',      sub {light_table_select_all();});
  # window resize event
  $ltw->bind("<Configure>" => sub {
  # if there is a timer running cancel it
  $ltw->{LAST_RESIZE_TIMER_MH}->cancel if ($ltw->{LAST_RESIZE_TIMER_MH});
  $ltw->{LAST_RESIZE_MH} = Tk::timeofday;
  # after 200 msec we reorder the thumbnails according to the new geometry to give a preview
  $ltw->{LAST_RESIZE_TIMER_MH} = $ltw->after(200, sub {
                                   light_table_reorder();
                               });
  });

  # call quitMain when the window is closed by the window manager
  $ltw->protocol("WM_DELETE_WINDOW" => sub { light_table_close(ASK); });

  $ltw->{menu} = $ltw->Menu;
  $ltw->configure(-menu => $ltw->{menu});

  my $file_menu = $ltw->{menu}->cascade(-label => "Slideshow");
  $file_menu->cget(-menu)->configure(-title => "Slideshow menu");
 #$file_menu->command(-label => "Rename pics ...", -command  => sub { rename_pics(); });
  $file_menu->command(-label => "Open ...", -command  => sub { light_table_open(RESET); });
  $file_menu->command(-label => "Show selected pictures", -command  => sub { my @sel = getSelection($ltw->{canvas}); show_multiple_pics(\@sel, 0);});
  $file_menu->command(-label => "Add list ...", -command  => sub { light_table_open(ADD); });
  $file_menu->command(-label => "Save", -command  => sub {
	  if ((defined $ltw->{file}) and (-f $ltw->{file})) {
		  light_table_save($ltw->{file});
	  }
  });
  $file_menu->command(-label => "Save as ...", -command  => sub { light_table_save_as(); });
  $file_menu->command(-label => "Clear", -command  => sub { undef @light_table_list; light_table_clear(); });
  $file_menu->command(-label => "Update", -command  => sub { light_table_reorder(); });
  $file_menu->command(-label => "Close", -command  => sub { light_table_close(NO_ASK); });

  my $sort_menu = $ltw->{menu}->cascade(-label => 'Sort');
  $sort_menu->command(-label => 'file name (A - Z)',
					  -command  => sub {
						  $ltw->Busy;
						  sortPics('name', 0, \@light_table_list);	
						  $ltw->Unbusy;
						  light_table_reorder();
					  });
  $sort_menu->command(-label => 'file name (Z - A)',
					  -command  => sub {
						  $ltw->Busy;
						  sortPics('name', 1, \@light_table_list);	
						  $ltw->Unbusy;
						  light_table_reorder();
					  });
  $sort_menu->command(-label => 'EXIF date (new first)',
					  -command  => sub {
						  $ltw->Busy;
						  sortPics('exifdate', 0, \@light_table_list);	
						  $ltw->Unbusy;
						  light_table_reorder();
					  });
  $sort_menu->command(-label => 'EXIF date (old first)',
					  -command  => sub {
						  $ltw->Busy;
						  sortPics('exifdate', 1, \@light_table_list);	
						  $ltw->Unbusy;
						  light_table_reorder();
					  });
  $sort_menu->command(-label => 'IPTC urgency/rating (high first)',
					  -command  => sub {
						  $ltw->Busy;
						  sortPics('urgency', 0, \@light_table_list);	
						  $ltw->Unbusy;
						  light_table_reorder();
					  });
  $sort_menu->command(-label => 'IPTC urgency (low first)',
					  -command  => sub {
						  $ltw->Busy;
						  sortPics('urgency', 1, \@light_table_list);	
						  $ltw->Unbusy;
						  light_table_reorder();
					  });

  my $opt_menu = $ltw->{menu}->cascade(-label => "Options");
  $ltw->{show_balloon} = 1; # todo: move to config hash
  $ltw->{show_status}  = 1; # todo: move to config hash
  $opt_menu->checkbutton(-label => "show balloon info", -variable => \$ltw->{show_balloon}, -command => sub { light_table_balloon();});
  $opt_menu->checkbutton(-label => "show status line", -variable => \$ltw->{show_status}, -command => sub { light_table_status();});

  $ltw->{status_line} = $ltw->Label(-textvariable => \$ltw->{label});

  $ltw->{frame} = $ltw->Scrolled('Canvas',
							 -scrollbars         => 'oe',
							 -confine            => 1,
							 -xscrollincrement   => 117,
							 -yscrollincrement   => 117,
							 -height             => 570,
							 -width              => 370,
							 -relief             => 'flat',
							 -borderwidth        => 0,
							 -highlightthickness => 0,
							 )->pack(-fill =>'both', -expand => 1, -padx => 3, -pady => 3);

  #bindMouseWheel($ltw->{frame});

  light_table_status();

  $ltw->{canvas}   = $ltw->{frame}->Subwidget('canvas');

  my $context_menu = $ltw->Menu(-title => "Context Menu");
  $ltw->bind('<ButtonPress-3>', sub {
				 $context_menu->Popup(-popover => "cursor", -popanchor => "nw");
			   } );
  $ltw->bind('<Key-Delete>', sub {light_table_delete(); });
  $context_menu->command(-image => compound_menu($top, 'move selected to top', 'go-first.png'), -command => sub { light_table_shift('top'); });
  $context_menu->command(-image => compound_menu($top, 'move selected to bottom', 'go-first.png'), -command => sub { light_table_shift('bottom'); });
  $context_menu->separator;
  $context_menu->command(-label => 'remove selected from light table',
						 -accelerator => "<Delete>",
						 -command => sub { light_table_delete(); });
  $context_menu->command(-label => 'copy and rename selected',
						 -command => sub { light_table_copy_rename(); });
  $context_menu->command(-image => compound_menu($top, 'copy to print ...', 'printer.png'), -command => sub { copyToPrint($ltw->{canvas}); });
  $context_menu->separator;
  $context_menu->command(-label => 'montage/index print ...',
						 -command => sub { my @pics = getSelection($ltw->{canvas}); indexPrint(\@pics); });
  $context_menu->separator;
  $context_menu->command(-image => compound_menu($top, 'open picture in external viewer', 'image-x-generic.png'),
						 -command => sub { openPicInViewer($ltw->{canvas}); });
  #$context_menu->command(-label => 'Show in external viewer',
	#					 -command => sub { openPicInViewer($ltw);(); });
  #$context_menu->command(-label => 'Add pics', -command => sub { add_pics(); });

  $ltw->{thumb_distance} = 5;   # in pixels
  $ltw->{thumb_size}     = 108; # in pixels todo

  $ltw->Popup;
  checkGeometry(\$config{LtwGeometry});
  $ltw->geometry($config{LtwGeometry});
}

##############################################################
# light_table_status
##############################################################
sub light_table_status {
	if ($ltw->{show_status}) {
		$ltw->{status_line}->pack(-before => $ltw->{frame} ,-fill => 'x');
	}
	else {
		$ltw->{status_line}->packForget;
	}
}

##############################################################
# light_table_open
##############################################################
sub light_table_open {

	my $mode = shift; # must be ADD or RESET
	
	my $text = 'Open';
	$text = 'Add to' if ($mode == ADD);

	my $fileSelect = $ltw->FileSelect(-title => "$text slideshow",
									  -initialfile => "slideshow.sld",
									  -create => 0,
									  -directory => $config{SlideShowDir},
									  -width => 30, -height => 30);
	my $file = $fileSelect->Show;
	return unless (defined $file);
	return if ($file eq '');
	return unless (-f $file);
	unless (-T $file) {
		$ltw->messageBox(-icon => 'warning',
						 -message => 'Please select a valid slideshow (ASCII) file.',
						 -title => 'Wrong file type',
						 -type => 'OK');
		return;
	}

	$config{SlideShowDir} = dirname($file) if (-d dirname($file));

	my $fh;
	if (!open($fh, "<$file")) {
		warn "open slideshow: Couldn't open $file: $!";
		return;
	}

	if ($mode == RESET) {
		# reset list and clean up canvas
		undef @light_table_list;
		light_table_clear();
	}

	my @pics;
	my $pic_number = 0;
	my $errors = '';
	my $double = '';
	my $double_count = 0;
	while (<$fh>) {
		chomp;						# no newline
		if ($_ =~ m|\"(.*)\"|) {    # match just quoted lines 
			$pic_number++;
			my $dpic;
			# $dpic may also have a relative path!
			if ($filespecAvail) {
				$dpic = File::Spec->rel2abs($1, dirname($file));
			}
			print "found $dpic - " if $verbose;
			if (-f $dpic) {
				print "file\n" if $verbose;
				if (isInList($dpic, \@light_table_list)) {
					$double .= "$dpic\n";
					$double_count++;
				}
				else {
					push @pics, $dpic;
				}
			}
			else {
				print "no file\n" if $verbose;
				$errors .= "error: $dpic not found! (number: $pic_number)\n";
			}
		}
		else { $errors .= "info:  ignoring line $_\n"; }
	}
	close $fh;
	
	$errors .= "\nadded ".scalar @pics." of $pic_number pictures!\n";
	
	# add pics to end of global list
	push @light_table_list, @pics;

	# add new pictures to light table
	light_table_add_list(\@pics);
	$ltw->{label} = scalar @light_table_list.' pictures';

	if (($errors ne '') or ($double_count > 0)) {
		my $text;
		$text = "These $double_count pictures are already in the slideshow and have been skipped:\n$double\n\n" if ($double_count > 0);
		$text .= "Information and errors while reading $file:\n$errors" if ($errors ne '');
		showText("Information and Errors", $text, NO_WAIT);
	}

	if ($mode == RESET) {
		$ltw->title('Light table: '.basename($file));
		$ltw->{file} = $file;
	}
}

##############################################################
# light_table_save_as
##############################################################
sub light_table_save_as {

	my $fileSelect = $ltw->FileSelect(-title => "Save as (use .sld suffix)",
									  -initialfile => "slideshow.sld",
									  -create => 1,
									  -directory => $config{SlideShowDir},
									  -width => 30, -height => 30);
	my $file = $fileSelect->Show;
	return unless (defined $file);
	return if ($file eq '');
	$config{SlideShowDir} = dirname($file) if (-d dirname($file));

	if (-f $file) {
		my $rc = $ltw->messageBox(-icon  => 'warning', -message => "Slideshow file $file exist.\nOk to overwrite?",
								  -title => "Overwrite slideshow?",   -type    => "OKCancel");
		return if ($rc !~ m/Ok/i);
	}

	my $rc = 0;

	# open window
	my $win = $top->Toplevel();
	$win->title('Save slideshow options');
	$win->iconimage($mapiviicon) if $mapiviicon;
	$win->Checkbutton(-variable => \$config{relative_path}, -text => "Use relative file paths")->pack(-anchor=>'w');
	$win->Checkbutton(-variable => \$config{xnview_loop}, -text => "Loop slide show")->pack(-anchor=>'w');
	$win->Checkbutton(-variable => \$config{xnview_fullscreen}, -text => "Full screen display")->pack(-anchor=>'w');
	$win->Checkbutton(-variable => \$config{xnview_title}, -text => "Show title bar")->pack(-anchor=>'w');
	$win->Checkbutton(-variable => \$config{xnview_filename}, -text => "Show file name")->pack(-anchor=>'w');
	$win->Checkbutton(-variable => \$config{xnview_mouse}, -text => "Hide mouse")->pack(-anchor=>'w');
	$win->Checkbutton(-variable => \$config{xnview_random}, -text => "Random order")->pack(-anchor=>'w');

	my $but_frame =
		$win->Frame()->pack(-fill =>'x');

	my $ok_but =
		$but_frame->Button(-text => 'OK',
						   -command => sub {
							   $rc = 1;
							   $win->withdraw();
							   $win->destroy();
						   })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 2, -pady => 3);
	my $x_but =
		$but_frame->Button(-text => 'Cancel',
						   -command => sub {
							   $win->withdraw();
							   $win->destroy();
						   })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 2, -pady => 3);

	$win->Popup(-popover => 'cursor');
	repositionWindow($win);
	$win->waitWindow;

	return unless ($rc);

	light_table_save($file);
}

##############################################################
# light_table_save
##############################################################
sub light_table_save {
	my $file = shift;
	print "writing slideshow to $file\n" if $verbose;
	my $fh;
	if (!open($fh, ">$file")) {
		print "could not open $file for write access!: $!\n";
		return;
	}

	my $xnview_slideshow_header = 
		'# Slide Show Sequence
View = 1
CenterWindow = 0
ReadErrors = 1
BackgroundColor = 0';

	print $fh "$xnview_slideshow_header\n";
	print $fh "Loop = $config{xnview_loop}\n";
	print $fh "FullScreen = $config{xnview_fullscreen}\n";
	print $fh "TitleBar = $config{xnview_title}\n";
	print $fh "HideMouse = $config{xnview_mouse}\n";
	print $fh "RandomOrder = $config{xnview_random}\n";
	print $fh "ShowFilename = $config{xnview_filename}\n";

	foreach my $dpic (@light_table_list) {
		my $rel = $dpic;
		if ($filespecAvail and $config{relative_path}) {
			$rel = File::Spec->abs2rel($dpic, dirname($file));
		}
		print $fh "\"$rel\"\n";
		print "\"$rel\"\n" if $verbose;
	}

	close $fh;
	$ltw->{label} = "wrote slideshow: ".basename($file);
	$ltw->title('Light table: '.basename($file));
	$ltw->{file} = $file;
}

##############################################################
# light_table_close
##############################################################
sub light_table_close {

  my $ask = shift;
  if ((defined $ask) and ($ask == ASK)) {
	  my $rc = $ltw->messageBox(-icon => 'question',
								-message => "The slideshow will not be saved automatically.\nOK to close light table?",
								-title => "Close light table?", -type => 'OKCancel');
	  return unless ($rc =~ m/Ok/i);
  }
  
  undef @light_table_list;
  light_table_clear();
  $config{LtwGeometry} = $ltw->geometry;
  $ltw->destroy();
}

##############################################################
# light_table_clear
##############################################################
sub light_table_clear {

  $ltw->{canvas}->delete('all');

  # delete all photo objects (thumbnnails)
  foreach (keys %light_table_thumbs) {
	$light_table_thumbs{$_}->delete if (defined $light_table_thumbs{$_}); # delete photo object
	delete $light_table_thumbs{$_};                           # delete hash entry
  }
  $ltw->{label} = scalar @light_table_list.' pictures';
  $ltw->title('Mapivi Light table');
}

##############################################################
# light_table_add_from_lb
##############################################################
sub light_table_add_from_lb {

	my $lb = shift;
	my @sellist = $lb->info('selection');
	light_table_add(\@sellist);
}

##############################################################
# light_table_add
##############################################################
sub light_table_add {

	my $list_ref = shift;
	return unless checkSelection($top, 1, 0, $list_ref);

	# open light table window if needed
	light_table_open_window() unless (Exists($ltw));

	my $error       = '';
	my $error_count = 0;
	my @list;
	# check for double pictures (not yet supported)
	foreach my $dpic (@$list_ref) {
		if (isInList($dpic, \@light_table_list)) {
			$error .= "$dpic\n";
			$error_count++;
		}
		else {
			push @list, $dpic;
		}
	}

	if ($error ne '') {
		$error = "These $error_count pictures are already in the slideshow and have been skipped:\n\n".$error;
		showText('Ignored pictures', $error, NO_WAIT);
	}

	return unless (@list);

	# add selected pictures at end of slideshow list
	push @light_table_list, @list;

	# add selected pictures to light table
	light_table_add_list(\@list);
}

##############################################################
# light_table_add_list
##############################################################
sub light_table_add_list {

	my $list_ref = shift; # list of JPEG pics with full path
	return if (@$list_ref < 1); # no pics to add

	# get thumb size info from first thumbnail in list (this may be wrong, as others may be bigger)
	my ($tw, $th) = getSize(getThumbFileName($$list_ref[0]));
	$ltw->{thumb_size} = $tw if ($tw > 1);

	my $i = 0;
	my $pw = progressWinInit($ltw, "Add pictures to light table");
	foreach my $dpic (@$list_ref) {
		my $thumb = getThumbFileName($dpic);
		last if progressWinCheck($pw);
		$i++;
		progressWinUpdate($pw, "adding picture ($i/".scalar @$list_ref.") ...", $i, scalar @$list_ref);

		if (-f $thumb) {
			# save all thumb photo objects in global hash %light_table_thumbs
			# to delete them later
			$light_table_thumbs{$dpic} = $ltw->Photo(-file => $thumb);
		}
                else {
                  if ($config{UseDefaultThumb} and $defaultthumbP) {
		    $light_table_thumbs{$dpic} = $defaultthumbP;
	          }
                }

		if ($light_table_thumbs{$dpic}) {
			my $id = $ltw->{canvas}->createImage(0, 0,
												-image => $light_table_thumbs{$dpic},
												-tag => ['THUMB_MH',$dpic],
												-anchor => 'nw');
			# add bindings
			$ltw->{canvas}->bind($id,'<ButtonPress-1>',
								sub { light_table_select($id); });
			$ltw->{canvas}->bind($id,'<Shift-ButtonPress-1>',
								sub {$ltw->{LOCK_MH} = 1; light_table_select_range();});
			$ltw->{canvas}->bind($id,'<Control-ButtonPress-1>',
								sub {$ltw->{LOCK_MH} = 1; light_table_select_add($id); });
			$ltw->{canvas}->bind($id,'<B1-Motion>',
								sub { light_table_move($id); });
			$ltw->{canvas}->bind($id,'<ButtonRelease-1>',
								sub { return if ($ltw->{LOCK_MH}); light_table_drop($id); });
			$ltw->{canvas}->bind($id,'<Shift-ButtonRelease-1>',
								sub { $ltw->{LOCK_MH} = 0; });
			$ltw->{canvas}->bind($id,'<Control-ButtonRelease-1>',
								sub { $ltw->{LOCK_MH} = 0; });
			$ltw->{canvas}->bind($id,'<ButtonPress-2>',
								sub { showPicInOwnWin($dpic); });
								#sub { show_multiple_pics($list_ref, 0); });

		}
	}
	progressWinEnd($pw);

	light_table_reorder();
	$ltw->{canvas}->yviewMoveto(1);
	$ltw->{label} = scalar @light_table_list.' pictures';
}

##############################################################
# light_table_balloon
##############################################################

sub light_table_balloon {

	if ($ltw->{show_balloon}) {
		my $msg;
		# the balloon message is generated on demand later, to speed up the loading of the thumbs
		$balloon->attach($ltw->{canvas},
						 -postcommand => sub {
							 my @curr = $ltw->{canvas}->find('withtag', 'current');
							 my $dpic = get_path_from_id($curr[0]);
							 $msg = makeBalloonMsg($dpic);
						 },
						 -balloonposition => 'mouse',
						 -msg => \$msg);
	}
	else {
		$balloon->detach($ltw->{canvas});
	}
}

##############################################################
# light_table_reorder
##############################################################
sub light_table_reorder {

    $ltw->update;
    #$ltw->Busy; # resizing the window does not work under windows if Busy is used
	my $dis    = $ltw->{thumb_size} + $ltw->{thumb_distance};
	# get canvas size
	my $cx     = $ltw->{canvas}->width;
	my $cy     = $ltw->{canvas}->height;
	# calc visible columns and rows
	my $c_cols = int($cx/$dis);
	$c_cols    = 1 if ($c_cols < 1); # avoid division by zero
	my $c_rows = int($cy/$dis);

	# how many rows are needed for all pics?
	my $all_rows = int(@light_table_list / $c_cols);
	$all_rows++ if ((@light_table_list % $c_cols) != 0);
	# adjust scrollbar
	$ltw->{canvas}->configure(-scrollregion => [0, 0, $c_cols*$dis + $ltw->{thumb_distance}, $all_rows*$dis + $ltw->{thumb_distance}]);


	my $index = 0;
	foreach my $dpic (@light_table_list) {
		my $row = int ($index / $c_cols);
        my $col = $index % $c_cols;       # modulo
		#print "reorder: $index col:$col row:$row $dpic\n";
		# we move the thumbs by tag which is the path+file name
		# this excludes the possibility to have a pic twice in the list
		$ltw->{canvas}->coords($dpic, $col*$dis+$ltw->{thumb_distance}, $row*$dis+$ltw->{thumb_distance});
		$index++;
	}
	light_table_update_selection();
	$ltw->{label} = scalar @light_table_list.' pictures';
	#$ltw->Unbusy; # resizing the window does not work under windows if Busy is used
}

##############################################################
# get_path_from_id
##############################################################
sub get_path_from_id {
	my $id = shift;
	my @tags = $ltw->{canvas}->gettags($id);
	my $dpic = '';
	foreach (@tags) {
		next if ($_ eq 'current');
		next if ($_ =~ m/.*_MH/);  # all my thumb tags are ending with _MH
		$dpic = $_;                # so this must be the path with file name
	}
	if ($dpic eq '') {
		print "Error could not find path from item: ";
		print "$_ " foreach (@tags);
		print "\n";
	}
	return $dpic;
}

##############################################################
# light_table_copy_rename
##############################################################
sub light_table_copy_rename {
	# find all selected thumbs
	my @sel = $ltw->{canvas}->find('withtag', 'THUMBSELECT_MH');
	return unless checkSelection($top, 1, 0, \@sel);

	my $rc = $ltw->messageBox(-icon  => 'warning', -message => "Copy and rename the ".scalar @sel." selected pictures.\nThe pictures will be renamed by adding a leading number according to the current order.\npic.jpg will for example be renamed to: 000-pic.jpg.\n\nOk to proceed?",
							  -title => "Copy and rename", -type => "OKCancel");
	return if ($rc !~ m/Ok/i);

	my $targetdir = getDirDialog("Copy pictures to");
	return if ($targetdir eq "");
	return unless (-d $targetdir);
	makeDir(dirname(getThumbFileName("$targetdir/dummy.jpg")), ASK);

	my $i  = 0;
	$rc = 1;
	#my $digits = 3;
	# idea from Yann Michel
	my $digits = int(log(@sel)/log(10))+1; # calculate the needed digits dynamically
	my $pw = progressWinInit($ltw, "Copy and rename pictures");
	foreach my $id (@sel) {
		my $dpic  = get_path_from_id($id);
		last if progressWinCheck($pw);
		my $pic       = basename($dpic);
		my $tpic      = $targetdir.'/'.sprintf "%0*d-$pic", $digits, $i; 
		my $thumbpic  = getThumbFileName($dpic);
		my $thumbtpic = getThumbFileName($tpic);

		$i++;
		progressWinUpdate($pw, "copy and rename picture ($i/".scalar @sel.") ...", $i, scalar @sel);

		$rc = overwritePic($tpic, $dpic, (scalar(@sel) - $i + 1)) if ($rc != 2);
		next if ($rc ==  0);
		last if ($rc == -1);

		if (mycopy ($dpic, $tpic, OVERWRITE)) {
			if ((-d dirname($thumbtpic)) and (-f $thumbpic)) {
				mycopy ("$thumbpic","$thumbtpic", OVERWRITE)
				}
			$searchDB{$tpic} = $searchDB{$dpic}; # copy meta info in search database
		}

	}								# foreach - end
	progressWinEnd($pw);
}

##############################################################
# light_table_drop
##############################################################
sub light_table_drop {

	# where the drop happened
	my $x = $ltw->{canvas}->canvasx($Tk::event->x());
	my $y = $ltw->{canvas}->canvasy($Tk::event->y());

	# distance between upper left corner of thumbs
	my $dis = $ltw->{thumb_size} + $ltw->{thumb_distance};
	$dis = 1 if ($dis == 0); # avoid division by zero
	# drop position in cols/rows
	my $col = sprintf "%0d", ($x / $dis); # round
	my $row = sprintf "%0d", ($y / $dis);

	print "drop at x=$x y=$y col=$col row=$row\n";

	# get size of canvas in cols/rows
	my $cx = $ltw->{canvas}->width;
	my $cy = $ltw->{canvas}->height;
	my $c_cols = int($cx/$dis);
	my $c_rows = int($cy/$dis);

	# new position in list
	my $to_index = $row * $c_cols + $col;
	my $to_dpic  = $light_table_list[$to_index];

	# find all selected thumbs
	my @sel = $ltw->{canvas}->find('withtag', 'THUMBSELECT_MH');

	my @sel_dpics;
	# remove selected pics from the pic list
	foreach my $id (@sel) {
		my $dpic  = get_path_from_id($id);
		my $index = index_in_list($dpic, \@light_table_list);
		#print "drop: removing index $index ($dpic)\n";
		# remove this pic from the list
		push @sel_dpics, splice @light_table_list, $index, 1;
	}

	# add the removed pics at the right place again
	foreach my $dpic (@sel_dpics) {
		#print "drop: adding at $to_index $dpic\n";
		# add it at the right position
		splice @light_table_list, $to_index, 0, $dpic;
	}

	#print "the list has now ".scalar @light_table_list." items\n";

	light_table_reorder();
	light_table_update_selection();
}

##############################################################
# index_in_list - returns the index of an element in a list
#                 return -1 if not found 
##############################################################
sub index_in_list {
  my $e       = shift;
  my $listRef = shift;
  my $index   = 0;

  foreach (@$listRef) {
	last if ($e eq $_);
	$index++;
  }

  if ($index > @$listRef) {
	  print "$index is bigger than @$listRef\n";
	  $index = -1;
  }

  return $index;
}

##############################################################
# light_table_select - select a thumbnail, remove all other selections
##############################################################
sub light_table_select {
	my $id = shift;

	# remember the current selection
	my @sel_IDs  = $ltw->{canvas}->find('withtag', 'THUMBSELECT_MH');
	$ltw->{sel_IDs}  = \@sel_IDs; 
	$ltw->{sel_time} = Tk::timeofday();

	# delete all selection frames
	print "light_table_select\n";
	remove_tag_from_all('THUMBSELECT_MH');
	remove_tag_from_all('ANCHOR_MH');

	# select just the current thumb
	$ltw->{canvas}->addtag('THUMBSELECT_MH', 'withtag', 'current');
	# this is the new anchor
	$ltw->{canvas}->addtag('ANCHOR_MH', 'withtag', 'current');

	# update the selection frames
	light_table_update_selection();
}

##############################################################
# remove_tag_from_all - delete a certain tag from all elements
#                       in the canvas
##############################################################
sub remove_tag_from_all {
	my $tag = shift;
	#print "remove_tag_from_all: $tag\n";

	# build a list of all thumbs with this tag
	#my @sel = $ltw->{canvas}->find( qw|withtag $tag| );
	my @sel = $ltw->{canvas}->find('withtag', $tag);

	# remove the tag from these thumbs 
	foreach my $id (@sel) {
		#print "remove_tag_from_all: removing $tag\n";
		$ltw->{canvas}->dtag($id, $tag);
	}
}

##############################################################
# light_table_select_add - toggle selection of single thumbnail
##############################################################
sub light_table_select_add {
	my @tags = $ltw->{canvas}->gettags('current');
	if (isInList('THUMBSELECT_MH', \@tags)) {
		$ltw->{canvas}->dtag('current', 'THUMBSELECT_MH');
	}
	else {
		$ltw->{canvas}->addtag('THUMBSELECT_MH', 'withtag', 'current');
	}
	light_table_update_selection();
}

##############################################################
# light_table_select_all - select all thumbnail
##############################################################
sub light_table_select_all {

  remove_tag_from_all('THUMBSELECT_MH');

  my @all = $ltw->{canvas}->find('all');

  foreach my $id (@all) {
	$ltw->{canvas}->addtag('THUMBSELECT_MH', 'withtag', $id);
  }

  light_table_update_selection();
}

##############################################################
# light_table_select_range - select range of thumbnail
##############################################################
sub light_table_select_range {

	# build a list of all thumbs with tag ANCHOR_MH
	my @sel = $ltw->{canvas}->find('withtag', 'ANCHOR_MH');
	
	if (@sel < 1) {
		print "no anchor found!\n";
		return;
	}
	if (@sel > 1) {
		print "error ".scalar @sel." anchors found! - removing anchors\n";
		remove_tag_from_all('ANCHOR_MH');
		return;
	}

	my $start_id = $sel[0];
	my $start_dpic = get_path_from_id($start_id);
	my $start_index = index_in_list($start_dpic, \@light_table_list);

	@sel = $ltw->{canvas}->find('withtag', 'current');
	my $end_id = $sel[0];
	my $end_dpic = get_path_from_id($end_id);
	my $end_index = index_in_list($end_dpic, \@light_table_list);

	print "light_table_select_range: select from $start_dpic ($start_index) to $end_dpic ($end_index)\n";

	# do we need to swap?
	if ($end_index < $start_index) {
		my $tmp = $start_index;
		$start_index = $end_index;
		$end_index = $tmp;
	}

	foreach ($start_index .. $end_index) {
		$ltw->{canvas}->addtag('THUMBSELECT_MH', 'withtag', $light_table_list[$_]);
	}

	#$ltw->{canvas}->addtag('THUMBSELECT_MH', 'withtag', 'current');
	#$ltw->{canvas}->dtag($id, 'THUMBSELECT_MH');
	light_table_update_selection();
}

##############################################################
# light_table_update_selection - draw a frame around each selected
#                           thumbnail (with tag THUMBSELECT_MH)
##############################################################
sub light_table_update_selection {
	# first we remove all frames
	$ltw->{canvas}->delete('withtag', 'FRAME');

	# find all selected thumbs
	my @sel = $ltw->{canvas}->find('withtag', 'THUMBSELECT_MH');

	# draw a frame
	foreach my $thumb (@sel) {
		my ($x, $y) = $ltw->{canvas}->coords( $thumb );
		$ltw->{canvas}->createRectangle( $x, $y, $x+$ltw->{thumb_size}+1, $y+$ltw->{thumb_size}+1,
				-tags => ['FRAME'],
				-outline => $config{ColorSel},
				-width => 3,
			 );
	}
	
	$ltw->{label} = scalar @light_table_list.' pictures, '.scalar @sel.' selected';
}

##############################################################
# light_table_delete - remove the selected thumbs from the list
#               will - of course - not remove the files!!!
##############################################################
sub light_table_delete {

	# find all selected thumbs
	my @sel = $ltw->{canvas}->find('withtag', 'THUMBSELECT_MH');

	# remove them from the list and the canvas
	foreach my $id (@sel) {
		my $dpic  = get_path_from_id($id);
		my $index = index_in_list($dpic, \@light_table_list);
		print "deleting index $index ($dpic)\n";
		# remove this pic from the list
		splice @light_table_list, $index, 1;
		# delete item from canvas
		$ltw->{canvas}->delete($id);
		$light_table_thumbs{$dpic}->delete if (defined $light_table_thumbs{$dpic}); # delete photo object
		delete $light_table_thumbs{$dpic};			# delete hash entry
	}
	
	light_table_reorder();
	light_table_update_selection();
}

##############################################################
# light_table_shift - move the selected thumbs to the top or
#                     bottom of the list
##############################################################
sub light_table_shift {

	my $where = shift; # must be 'top' or 'bottom'

	return unless (defined $where);
	return if (($where ne 'top') and ($where ne 'bottom'));

	# find all selected thumbs
	my @sel = $ltw->{canvas}->find('withtag', 'THUMBSELECT_MH');

	my @shift_pics; # pics to move

	# remove them from the list
	foreach my $id (@sel) {
		my $dpic  = get_path_from_id($id);
		my $index = index_in_list($dpic, \@light_table_list);
		# remove this pic from the list and add it to @shift_pics
		push @shift_pics, splice @light_table_list, $index, 1;
	}
	
	if ($where eq 'top') {
		unshift @light_table_list, @shift_pics; # add them at the start of the list
	}
	elsif ($where eq 'bottom') {
		push @light_table_list, @shift_pics; # add them to the end of the list
	}
	else {
		warn "light_table_shift: should not be reached where = $where";
	}
	light_table_reorder();
	light_table_update_selection();
}

##############################################################
# light_table_move - called if a thumbnail is dragged inside the light table
##############################################################
sub light_table_move {
	# stop repeat timer
	$ltw->{SCROLL_MH}->cancel if $ltw->{SCROLL_MH};

	my $id = shift;
	# if the last selection happened just 400ms ago and the clicked
	# thumb was inside the last selection, we reselect the last selection
	if (((Tk::timeofday() - $ltw->{sel_time}) < 0.4) and isInList($id, $ltw->{sel_IDs})) {
		# reset time
		$ltw->{sel_time} = 0;
		# first remove the tags
		remove_tag_from_all('THUMBSELECT_MH');
		# then add the selection from the saved list
		foreach my $id (@{$ltw->{sel_IDs}}) {
			my $dpic = get_path_from_id($id);
			$ltw->{canvas}->addtag('THUMBSELECT_MH', 'withtag', $dpic);
		}
		light_table_update_selection();
	}

	$ltw->{canvas}->raise($id);
	# get mouse coordinates
	my $ex = $Tk::event->x();
	my $ey = $Tk::event->y();
	my $x = $ltw->{canvas}->canvasx($ex);
	my $y = $ltw->{canvas}->canvasy($ey);
	my $offset = int($ltw->{thumb_size}/2);
	# move thumb to mouse position
	$ltw->{canvas}->coords($id, $x-$offset, $y-$offset);


	# autoscroll: scroll up or down if needed
	# get actual scroll state
	my ($y1,$y2) = $ltw->{canvas}->yview;
	my $cy = $Tk::event->y;
	print "light_table_move cy:$cy\n" if $verbose;
	# everything is visible no scrolling needed
	return if ($y1 == 0 and $y2 == 1);

	my $c_h  = $ltw->{canvas}->height; # the visible height
	#my @sr = $ltw->{canvas}->cget(-scrollregion);
	#my @sr = $ltw->{frame}->cget(-scrollregion);
	#my $c_h_all = $sr[3] - $sr[1];   # the height of the scrollregion

    # scroll up if mouse is less then a half thumbnailsize away from the upper border 
    # and there is still room to scroll ($y1 > 0) and no button release has happened
	if (($cy < $offset) and ($y1 > 0)) {
		$ltw->{SCROLL_MH} = $ltw->repeat(100, sub { 
			print "scroll up\n";
			$ltw->{canvas}->yview('scroll',-1,'units');
			# move thumb to mouse position
			my $x = $ltw->{canvas}->canvasx($ex);
			my $y = $ltw->{canvas}->canvasy($ey);
			$ltw->{canvas}->coords($id, $x-$offset, $y-$offset);
			$ltw->idletasks; });
	}

    # scroll down if mouse is less then a half thumbnailsize away from the lower border
    # and there is still room to scroll ($y2 < 1)  and no button release has happened
	if (($cy > $c_h - $offset) and ($y2 < 1)) {
		$ltw->{SCROLL_MH} = $ltw->repeat(100, sub {
			print "scroll down\n";
			$ltw->{canvas}->yview('scroll',1,'units');
			# move thumb to mouse position
			my $x = $ltw->{canvas}->canvasx($ex);
			my $y = $ltw->{canvas}->canvasy($ey);
			$ltw->{canvas}->coords($id, $x-$offset, $y-$offset);
			$ltw->idletasks; });
	}

}

##############################################################
# nop - a do nothing function, needed from Tk::IO
##############################################################
sub nop { return; }

##############################################################
# getThumbCaption - return the appropriate caption for the
#                   thumbnail of a picture, possibly empty
##############################################################
sub getThumbCaption {
  my $dpic = shift;

  if (($config{ThumbCapt} eq '') or ($config{ThumbCapt} eq 'none')) {
    return '';
  }
  elsif ($config{ThumbCapt} eq 'filename') {
    my $capt = basename($dpic);
    $capt =~ s/(.*)\.jp(g|eg)$/$1/i; # remove suffix
    return $capt;
  }
  elsif ($config{ThumbCapt} eq 'filenameSuffix') {
    my $capt = basename($dpic);
    return $capt;
  }
  elsif ($config{ThumbCapt} eq 'objectname') {
    return getIPTCObjectName($dpic);
  }
  else {
	warn 'getThumbCaption: ThumbCapt has unexpected value: "'.$config{ThumbCapt}.'"';
    return "";
  }
}

##############################################################
# updateOneThumb - this function is called when a convert
#                  process is finished; replaces the default
#                  thumbnail with the actual thumbnail
##############################################################
sub updateOneThumb {
  my $thumb = shift;
  my $dpic  = shift; # the index (entrypath) of the hlist element
  my $show  = shift; # SHOW, NO_SHOW

  proccount(-1);
  $nrToConvert--; $nrToConvert = 0 if ($nrToConvert < 0);

  # check if we are still in the same dir
  if (dirname($thumb) ne dirname(getThumbFileName("$actdir/dummy.jpg"))) {
	return; # no, we are not so do not display the generated thumbs
  }

  if (($show == SHOW) and (-f $thumb)) {
	$thumbs{$thumb} = $picLB->Photo(-format => "jpeg", -file => $thumb, -gamma => $config{Gamma});

	# if there is already an image ...
	if ($picLB->itemCget($dpic, $picLB->{thumbcol}, -itemtype) eq "imagetext") {
	  # ... configure it
	  $picLB->itemConfigure($dpic, $picLB->{thumbcol}, -image => $thumbs{$thumb}, -itemtype => "imagetext");
	}
	else {
		$picLB->itemCreate($dpic, $picLB->{thumbcol}, -style => $thumbS, -itemtype => 'imagetext', -image => $thumbs{$thumb}, -text => getThumbCaption($dpic));
	}
  }
}

##############################################################
# proccount - count the spawned processes
#             returns the number of running processes if no
#             parameter is given
##############################################################
sub proccount {
  my $diff = shift; # optional parameter

  return $proccount unless (defined $diff);
  $proccount = 0 unless (defined $proccount); # todo why?
  $proccount += $diff;
  $proccount = 0 if ($proccount < 0); # should never happen!
  $top->update;
  print "proccount = $proccount\n" if $verbose;
}

##############################################################
# showPicViewList
##############################################################
sub showPicViewList {

  my $fs = $top->FileSelect(-title => "read picture view list from file",
							-directory => $actdir,
							-width => 30, -height => 30);
  my $file = $fs->Show;
  return if ((!defined $file) or ($file eq "") or (!-f $file));

  my @pics = readArrayFromFile($file);

  # todo: handle absolute and relative paths in lists

  # check pic list
  my $error_text = '';
  foreach (@pics) {
	$error_text .= "$_\n" unless (-f $_);
  }
  if ($error_text ne '') {
	$error_text = "These pictures of the list in $file are missing:\n".$error_text;
	showText('Info about picture view list', $error_text, NO_WAIT);
  }

  $userinfo = "loading thumbnails ...";
  $top->update;
  checkCachedPics();

  canvasHide();

  # delete all photo objects (thumbnnails)
  foreach (keys %thumbs) {
	print "updateThumbs: deleting thumbnail object of $_\n" if $verbose;
	$thumbs{$_}->delete if (defined $thumbs{$_}); # delete photo object
	delete $thumbs{$_};			# delete hash entry
  }

  if ($verbose) {
	my @check = $top->imageNames;
	print " there are ".scalar @check." pics left\n";
  }

  # clean the thumbnail table
  # with this step all references to the already deleted photo objects are cleared
  # so the memory is now free again
  $picLB->delete("all");

  if (showThumbsInList($picLB, \@pics)) {
	$userinfo = "loading thumbnails ... ready";  $userInfoL->update;
	#generateThumbs(ASK, SHOW);
  } else {
	$userinfo = "user abord (not all pictures are loaded!)";  $userInfoL->update;
  }
  showNrOf();
}

##############################################################
# smart_update - reread actual directory, add new and remove
#                deleted pics, without reloading the existing
#                thumbnails; the goal is to have a faster
#                update for large folders
##############################################################
sub smart_update {

  # get the new list of pics in the actual folder
  my @act_pics = getPics($actdir, WITH_PATH);
  sortPics($config{SortBy}, $config{SortReverse}, \@act_pics);

  # get the displayed pics from the listbox
  my @disp_pics  = $picLB->info('children');

  my $removed_pics = 0;
  my $new_pics = 0;
  
  # remove deleted pictures first
  foreach my $dpic (@disp_pics) {
    if ((!isInList($dpic, \@act_pics)) and ($picLB->info('exists', $dpic))) {
      print "deleting $dpic from picLB\n" if $verbose;	
      $removed_pics++;
	  $picLB->delete('entry', $dpic);
	}
  }

  # get the displayed pics from the listbox again after the deletion
  @disp_pics  = $picLB->info('children');

  # count new pictures first
  foreach my $dpic (@act_pics) {
    $new_pics++ if (!$picLB->info('exists', $dpic));
  }

  if ($new_pics > 0) {
    # todo this init is not the perfect solution as a rename of the
    # first pic will be shown as second pic
    my $after = $disp_pics[0];
    my $pw = progressWinInit($picLB, "Smart update");
    my $n = 0;
    # add the new pics to the listbox
    foreach my $dpic (@act_pics) {
      last if progressWinCheck($pw);
      if (!$picLB->info('exists', $dpic)) {
        $n++;
        progressWinUpdate($pw, "adding new picture ($n/$new_pics) ...", $n, $new_pics);
        print "adding $dpic to picLB\n" if $verbose;	
        addOneRow($picLB, $dpic, 1, $after);
      }
      $after = $dpic;
    }
    progressWinEnd($pw);
  }

  showNrOf();
  $userinfo = "ready! removed $removed_pics and added $new_pics picture(s)"; $userInfoL->update;
  generateThumbs(ASK, SHOW);
}

##############################################################
# showThumbs - display all thumbnail pictures of the actual
#              directory in the listbox
##############################################################
sub showThumbs {

  # clean the thumbnail table
  # with this step all references to the already deleted photo objects are cleared
  # so the memory is now free again
  $picLB->delete('all');

  if ($verbose) {
	my @check = $top->imageNames;
	print " there are ".scalar @check." pics left\n";
  }

  my @pics = getPics($actdir, WITH_PATH);
  sortPics($config{SortBy}, $config{SortReverse}, \@pics);

  cleanOneDir($actdir) if (@pics == 0); # remove .thumbs subdir etc.

  my $rc = showThumbsInList($picLB, \@pics);

  return $rc;
}

##############################################################
# showThumbsInList
##############################################################
sub showThumbsInList {

  my $lb    = shift; # the listbox widget
  my $listR = shift; # the list of pics to show

  # show some infos to the user while loading
  my $n  = 0;        # actual number
  my $nr = @$listR;  # total number

  if (@$listR > $config{ThumbMaxLimit}) {
	$lb->messageBox(-icon  => 'info', -message => "There are $nr pictures to show. The thumbnail limit is set to ".$config{ThumbMaxLimit}.". ".($nr - $config{ThumbMaxLimit})." pictures will be displayed with a default thumbnail.",
					-title => "Info", -type => 'OK');
  }

  my $pw = progressWinInit($lb, "Load pictures");

  foreach my $dpic (@$listR) {
	last if progressWinCheck($pw);
	$n++;
	progressWinUpdate($pw, "loading picture ($n/$nr) ...", $n, $nr);
	my $with_thumb = 0;
	$with_thumb    = 1 if ($n <= $config{ThumbMaxLimit});
	addOneRow($lb, $dpic, $with_thumb);
  }

  progressWinEnd($pw);

  if (($lb == $picLB) and ($n != $nr)) {
	$userinfo = "user abord at $n of $nr";  $userInfoL->update;
	$lb->after(1000); # just a litte delay to show the message above
	return 0;
  }
  return 1;
}

##############################################################
# addOneRow - adds a new row, or updates an existing row
##############################################################
sub addOneRow {
  my $lb         = shift;
  my $dpic       = shift;
  my $with_thumb = shift;		# bool 1 = thumb, 0 = defaultthumb
  my $after;
  $after         = shift;       # optional

  unless ($lb->info("exists", $dpic)) {
	# create new row, we use the path and file name (=$dpic) as unique index for the hlist entry
	if (($after) and ($lb->info("exists", $after))) {
	  $lb->add($dpic, -after => $after);
	}
	else {
	  $lb->add($dpic);
	}
  }

  my $thumb  = getThumbFileName($dpic);
  my $thumbP = undef;

  if ($config{ShowThumbs} and -f $thumb) {
	$thumbP = $lb->Photo(-format => "jpeg", -file => $thumb, -gamma => $config{Gamma});
	$thumbs{$dpic} = $thumbP;	# save all thumb photo objects in global hash %thumbs to delete them when changing the dir
  }

  # test feature to improve speed: read meta info only if there is no info in the DB or the modification date has changed
  # on windows this is 10 times faster to read in a folder with 200 pics (34 secs vs. 3 secs)
  # todo there should be a possibility to force a reread, if somebody added metainfo without changing the modification date - however this is still possible using add to database 
  if ($searchDB{$dpic} and $searchDB{$dpic}{MOD}) {
    if ($searchDB{$dpic}{MOD} != getFileDate($dpic, NO_FORMAT)) {
      addToSearchDB($dpic); # save the infos into the search data base
    }
  }
  else { # branch for pics not yet stored in the database or with missing modification dates
    addToSearchDB($dpic); # save the infos into the search data base
  }

  my $iptc = ''; my $exif = ''; my $com = ''; my $size = '';

  my $pic  = basename($dpic);
  my $dir  = dirname($dpic);
  $com     = $searchDB{$dpic}{COM};
  $exif    = $searchDB{$dpic}{EXIF};
  $iptc    = displayIPTC($dpic); 
  $size    = getAllFileInfo($dpic);
  $com     = formatString($com,  $config{LineLength}, , $config{LineLimit}); # format the comment for the list
  $iptc    = formatString($iptc, $config{LineLength},, $config{LineLimit}); # format the IPTC info for the list

  my $image;
  if ((defined $thumbP) and $with_thumb) {
	$image = $thumbP;
  } else {
	if ($config{UseDefaultThumb} and $defaultthumbP) {
	  $image = $defaultthumbP;
	}
	else {
	  undef $image;
	}
  }

  if (defined $image) {
	$lb->itemCreate($dpic, $lb->{thumbcol}, -style => $thumbS, -itemtype => 'imagetext', -image => $image, -text => getThumbCaption($dpic));
   }

  # insert items in the table row
  $lb->itemCreate($dpic, $lb->{filecol}, -text => $size, -style => $fileS);
  $lb->itemCreate($dpic, $lb->{iptccol}, -text => $iptc, -style => $iptcS);
  $lb->itemCreate($dpic, $lb->{comcol},  -text => $com,  -style => $comS);
  $lb->itemCreate($dpic, $lb->{exifcol}, -text => $exif, -style => $exifS);
  $lb->itemCreate($dpic, $lb->{dircol},  -text => $dir,  -style => $dirS);
}

##############################################################
# displayIPTC - convert the searchdb info into a formated string
##############################################################
sub displayIPTC {
  my $dpic = shift;
  my $iptc = "";
  $iptc    = displayUrgency($searchDB{$dpic}{URG});
  $iptc   .= "Keywords: ".$searchDB{$dpic}{KEYS}."\n" if (defined $searchDB{$dpic}{KEYS});
  $iptc   .= $searchDB{$dpic}{IPTC}                   if (defined $searchDB{$dpic}{IPTC});
  return $iptc;
}

##############################################################
# displayUrgency - convert the integer value into a string with stars (*)
##############################################################
sub displayUrgency {
  my $urg = shift;
  return '' unless (defined $urg);
  my $durg = '';
  for (my $x = 8; $x >= $urg; $x -= 1) {
    $durg .= '*';
  }
  return "Rating  : $durg ($urg)\n";
} 

##############################################################
# addToSearchDB - add a picture to the search data base
#                 this function can be called with one or four
#                 parameters
##############################################################
sub addToSearchDB {
  my $dpic = shift;

  # normalize the path
  $dpic =~ s/\\/\//g;     # replace Windows path delimiter with UNIX style \ -> /
  $dpic =~ s/\/+/\//g;    # replace multiple slashes with one             // -> /
  $dpic =~ s/\/\.\//\//g; # replace dot dir                              /./ -> /

  if (!-f $dpic) {
	warn "addToSearchDB: $dpic not found!";
	return undef;
  }
  #print "addToSearchDB $dpic\n";
  # do not save pics to the database which are located in .thumbs/ .xvpics/ .exif/
  my $dir = dirname($dpic);
  $dir =~ s!/$!!g; # remove trailing /
  if ($dir =~ m/$thumbdirname|$exifdirname|$xvpicsdirname$/) {
	print "addToSearchDB: ignoring $dpic\n" if $verbose;
	return undef;
  }

  my ($com, $exif, $ctime, $mtime, $iptc, $urgency, $size, $x, $y, $keys, @keys, $pop);

  # $meta is returned at the end of the sub,
  # the SOF segment is needed for the latter call of getAllFileInfo
  my $meta = getMetaData($dpic, "COM|APP1|APP13|SOF", 'FASTREADONLY');

  $exif   = getShortEXIF(   $dpic, WRAP,  $meta);
  $com    = getComment(     $dpic, LONG,  $meta);
  $iptc   = getIPTC(        $dpic, SHORT, $meta);
  $size   = getFileSize(    $dpic, NO_FORMAT);
  ($x,$y) = getSize(        $dpic, $meta);
  $mtime  = getFileDate(    $dpic, NO_FORMAT);
  @keys   = getIPTCkeywords($dpic, $meta);
  $pop    = 0;
  $pop    = $searchDB{$dpic}{POP} if (defined $searchDB{$dpic}{POP});
  
  # handling of non-printables is already done in getIPTC and getIPTCkeywords
  # todo: It is needed here too, but why?
  $iptc =~ tr/\n -~//cd; # remove all non-printable chars, but not newline
  foreach (@keys) {
    $_ =~ tr/ -~//cd; # remove all non-printable chars (Picasa adds one to each keyword)
  }

  # build a space separated string from the keyword list
  # todo find a better separator, so that keywords with spaces can be supported better
  foreach (@keys) { $keys .= "$_ "; }

  # check if the pictures contain new keywords
  if ($config{CheckNewKeywords}) {
    foreach (@keys) {
      # store all keywords in a hash and count them
      if (defined $new_keywords{$_}) {
        $new_keywords{$_}++;
      }
      else {
        $new_keywords{$_} = 1;
      }
    }
  }

  # try to get the EXIF date from the short EXIF info format: "dd.mm.yyyy hh:mm:ss"
  # there may be [t] or [s] before the date!
  undef $ctime;
  if (defined($exif)) {
    my $year; my $mon; my $day; my $hour; my $min; my $sec;
    # support three different date formats
    # dd.mm.yyyy hh:mm:ss
    if ($exif =~ m/(\d\d)\.(\d\d)\.(\d\d\d\d)\s(\d\d):(\d\d):(\d\d)/) {
      $day  = $1;
	  $mon  = $2;
	  $year = $3;
      $hour = $4;
      $min  = $5;
      $sec  = $6;
	}
	# mm/dd/yyyy hh:mm:ss
    if ($exif =~ m/(\d\d)\/(\d\d)\/(\d\d\d\d)\s(\d\d):(\d\d):(\d\d)/) {
      $mon  = $1;
	  $day  = $2;
	  $year = $3;
      $hour = $4;
      $min  = $5;
      $sec  = $6;
	}
	# yyyy-mm-dd hh:mm:ss
    if ($exif =~ m/(\d\d\d\d)-(\d\d)-(\d\d)\s(\d\d):(\d\d):(\d\d)/) {
      $year = $1;
	  $mon  = $2;
	  $day  = $3;
      $hour = $4;
      $min  = $5;
      $sec  = $6;
	}
	$mon--;
	if (defined $year) {
	  if ($year > $copyright_year) {  # fix wrong dates
	    print "Mapivi warning: $dpic: EXIF year: $year is in the future, correcting to $copyright_year\n";
	    $year = $copyright_year;
	  }
	  $year -= 1900;

	  if ($mon >= 0 and $mon <= 11) {
	    # calculate the time as value in seconds since the Epoch (Midnight, January 1, 1970)
	    $ctime = timelocal($sec,$min,$hour,$day,$mon,$year);
	    #warn "using exifdate for $dpic: $ctime\n" if $verbose;

	    # optional checks
	    #my ($s,$m,$h,$d,$mo,$y) = localtime $ctime;
	    #$y += 1900; $mo++;			# do some adjustments
	    # build up the date time string, sim#lar to the EXIF format
	    #my $date1 = sprintf "%04d:%02d:%02d %02d:%02d:%02d", $y, $mo, $d, $h, $m, $s;
	    #my $date2 = "$3:$2:$1 $4:$5:$6";
	    #print "$date2 $date $dpic\n" if ($date1 ne $date2);
	  }
	}
	#else { print "mon = $mon $3:$2:$1 $4:$5:$6\n";}
  }
  #else { print "no exif date: $exif" if $verbose; }

  # if there is no exif time available use the file modification date
  unless (defined $ctime) {
	$ctime = (lstat $dpic)[9]; # 9 is the modification date time
	#warn "using filedate for $dpic: $ctime\n" if $verbose;
  }

  # replace all newlines with space before adding to the database
  #$com  =~ s/\n/ /g if (defined $com);
  #$exif =~ s/\n/ /g if (defined $exif);
  #$iptc =~ s/\n/ /g if (defined $iptc);

  # maybe there was something defined before, so we better overwrite it with ""
  $com  = '' unless (defined $com);
  $exif = '' unless (defined $exif);
  $iptc = '' unless (defined $iptc);

  $iptc =~ s/urgency\s*:\s*\d*\s*//i; # remove urgency from the IPTC field
  $iptc =~ s/keywords\s*:\s*.*\n//i;  # remove keywords from the IPTC field

  $urgency = getIPTCurgency($dpic, $meta);
  $urgency = undef if ($urgency == 9);

  delete $searchDB{$dpic};  # clear hash item first

  #print "adding: IPTC: $iptc\n";
  #print "adding: Keys: $keys\n";
  #print "adding: URG : $urgency\n";

  $searchDB{$dpic}{COM}  = $com;   # save (complete!) comment
  $searchDB{$dpic}{EXIF} = $exif;  # save short EXIF info
  $searchDB{$dpic}{SIZE} = $size;  # save file size in Bytes
  $searchDB{$dpic}{PIXX} = $x;     # save pixel size (x = width)
  $searchDB{$dpic}{PIXY} = $y;     # save pixel size (y = height)
  $searchDB{$dpic}{TIME} = $ctime; # save EXIF/file creation time
  $searchDB{$dpic}{MOD}  = $mtime; # save file modification time
  $searchDB{$dpic}{IPTC} = $iptc;  # save complete IPTC info
  $searchDB{$dpic}{URG}  = $urgency; # save IPTC urgency
  $searchDB{$dpic}{KEYS} = $keys;  # save IPTC keywords
  $searchDB{$dpic}{POP}  = $pop if ($config{trackPopularity});   # save popularity (how often the pic was shown)
  #print "---IPTC: $searchDB{$dpic}{IPTC}---\n";
  return $meta;
}

##############################################################
# getMetaData - returns the Image::MetaData::JPEG
#               object of $dpic
##############################################################
sub getMetaData {
  my $dpic   = shift;
  my $what   = shift; # regex to match the needed segments e.g. "COM" for comment,
                      # or "APP13|COM" for IPTC info and comment segments
  my $option = shift; # optional option, if set to 'FASTREADONLY' will speed things up

  return undef unless is_a_JPEG($dpic);

  # mapivi just needs the comments (COM), EXIF (APP1), IPTC (APP13) and size (SOF) segments
  my $meta = new Image::MetaData::JPEG($dpic, $what, $option);
  print "getMetaData: Kind:$what pic:$dpic\n" if $verbose;
  warn "Error: " . Image::MetaData::JPEG::Error() unless $meta;
  return $meta;
}

##############################################################
# getAllFileInfo
##############################################################
sub getAllFileInfo {

  my $dpic = shift;
  my $bpic = buildBackupName($dpic);
  my $size = '';
  my $w    = 0;
  my $h    = 0;
  return '' if (!-f $dpic);

  $size         = basename($dpic)."\n\n";
  $size        .= int($searchDB{$dpic}{SIZE}/1024).'kB' if $searchDB{$dpic}{SIZE};
  $size        .= '[bak]' if (-f $bpic);             # show that there is a backup file
  my ($basename, $suffix) = getBasenameSuffix($dpic);
  $size        .= '[raw]' if ((-f $basename.'.nef') or (-f $basename.'.NEF'));  # show that there is a raw file
  $size        .= '[raw]' if ((-f $basename.'.crw') or (-f $basename.'.CRW'));  # show that there is a raw file
  $size        .= '[XMP]' if ((-f $basename.'.xmp') or (-f $basename.'.XMP'));  # show that there is a XMP sidecar file
  $size        .= '[WAV]' if ((-f $basename.'.wav') or (-f $basename.'.WAV'));  # show that there is a WAV audio file

  $size .= "\n".buildDateTime($searchDB{$dpic}{MOD}) if ($config{ShowFileDate} and defined $searchDB{$dpic}{MOD});

  $w = $searchDB{$dpic}{PIXX} if $searchDB{$dpic}{PIXX};
  $h = $searchDB{$dpic}{PIXY} if $searchDB{$dpic}{PIXY};

  # MP = MegaPixel
  my $p         = sprintf "%.2f", ($w*$h/1000000); 
  $size        .= "\n${w}x$h (${p}MP)";

  if ($config{BitsPixel}) {
	my $bitPix = getBitPix($dpic);
	$bitPix = sprintf "%.2f", $bitPix;
	$size    .= "\n${bitPix}b/p";
  }
  $size .= "\n".getAspectRatio($w, $h) if ($config{AspectRatio} and ($w > 0) and ($h > 0));
  if (-l $dpic) { $size .= "\n(Link)"; }
  $size .= "\nViewed ".$searchDB{$dpic}{POP}.' times' if (($config{trackPopularity}) and (defined $searchDB{$dpic}{POP}));
  return $size;
}

##############################################################
# getAspectRatio
##############################################################
sub getAspectRatio {
  my $w           = shift;
  my $h           = shift;
  return "" if (($h == 0) or ($w == 0));
  my $aspectdelta = 1 + ($config{AspectSloppyFactor} / 100);  # delta factor for aspect ratio
  my $r           = $w/$h; # aspect ratio
  my $ratio       = "";
  if (($r <= $aspectdelta*4/3) and ($r >= (4/3)/$aspectdelta)) {
	$ratio = "[4:3]";
  } elsif (($r <= $aspectdelta*3/4) and ($r >= (3/4)/$aspectdelta)) {
	$ratio = "[3:4]";
  } elsif (($r <= $aspectdelta*2/3) and ($r >= (2/3)/$aspectdelta)) {
	$ratio = "[2:3]";
  } elsif (($r <= $aspectdelta*3/2) and ($r >= (3/2)/$aspectdelta)) {
	$ratio = "[3:2]";
  } elsif (($r <= $aspectdelta*5/4) and ($r >= (5/4)/$aspectdelta)) {
	$ratio = "[5:4]";
  } elsif (($r <= $aspectdelta*4/5) and ($r >= (4/5)/$aspectdelta)) {
	$ratio = "[4:5]";
  } elsif (($r <= $aspectdelta*7/5) and ($r >= (7/5)/$aspectdelta)) {
	$ratio = "[7:5]";
  } elsif (($r <= $aspectdelta*5/7) and ($r >= (5/7)/$aspectdelta)) {
	$ratio = "[5:7]";
  } elsif (($r <= $aspectdelta*16/9) and ($r >= (16/9)/$aspectdelta)) {
	$ratio = "[16:9]";
  } elsif (($r <= $aspectdelta*9/16) and ($r >= (9/16)/$aspectdelta)) {
	$ratio = "[9:16]";
  } elsif ($w == $h) {
	$ratio = "[1:1]";
  } else {
	if ($w > $h) { $ratio = sprintf "[%.2f:1]", ($w/$h); }
	else         { $ratio = sprintf "[1:%.2f]", ($h/$w); }
  }
  return $ratio;
}

##############################################################
# removeIPTC
##############################################################
sub removeIPTC {

  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);

  my $rc = $top->messageBox(-icon => 'question', -message => "Please press Ok to remove all IPTC info of the ".scalar @sellist." selected pictures.\nThere is no undo!",
							-title => "Remove all IPTC info?", -type => 'OKCancel');
  return if ($rc !~ m/Ok/i);

  my ($dpic, $ii, $iptcread, $iptcL);
  my $errors = "";
  my $i      = 0;
  my $pw     = progressWinInit($top, "Remove IPTC info");

  foreach $dpic (@sellist){
	last if progressWinCheck($pw);
	$i++;
	progressWinUpdate($pw, "Removing IPTC info ($i/".scalar @sellist.") ...", $i, scalar @sellist);

	next unless (-f $dpic);
	next if (!checkWriteable($dpic));

	my $meta = getMetaData($dpic, "APP13");
	$meta->remove_app13_info(-1, 'IPTC'); # remove all APP13 IPTC segments
	unless ($meta->save()) {
	  $errors .= "removeIPTC: save $dpic failed!\n";
	}

	updateOneRow($dpic, $picLB);
  }
  progressWinEnd($pw);
  $userinfo = "ready! (removed IPTC info of $i/".scalar @sellist.")"; $userInfoL->update;
  showText("Errors while removing IPTC infos", $errors, NO_WAIT) if ($errors ne "");

  return;
}

##############################################################
# cutString - cat a string to a given length, remove newline
#             and carriage return and add e.g. dots if cut
# examples:   cutString("elephant",20,"..") -> "elephant"
#             cutString("elephant", 7,"..") -> "eleph.."
#             cutString("elephant",-7,"..") -> "..phant"
##############################################################
sub cutString {
  my $str = shift; # input string
  my $len = shift; # the max length
  my $dot = shift; # the dots (e.g. ".." or "...")

  return unless (defined $str);
  return if ($str eq "");

  my $dotlen = length($dot);

  my $out = $str;

  if (length($dot) >= abs($len)) {
	warn "cutString: lenght of dots is longer or equal than length";
	return $out;
  }

  if ($len >= 0) {
	$out = substr($out, 0, ($len-$dotlen)).$dot if (length($out) > $len);
  }
  else {
	$out = $dot.substr($out, ($len+$dotlen), length($str)) if (length($out) > -$len);
  }

  $out =~ s/\n//g;   # remove newlines
  $out =~ s/\r//g;   # remove \r (carriage return)

  return $out;
}

##############################################################
# formatString - cuts and formats a string to
#                a width of $linelenght chars and a length of
#                $line_nr_limit lines.
#                this function wont work as expected with
#                comments containing a lot of nearly empty lines
##############################################################
sub formatString($$$) {
  my $string        = shift;
  my $linelenght    = shift;
  my $line_nr_limit = shift;  # use -1 if there should be no line nr limit

  return '' if ((!defined $string) or ($string eq ''));

  $Text::Wrap::columns = $linelenght+1;

  $string =~ s/\r//g;			       # cut \r (carriage return)
  $string =~ tr[\200-\377][\000-\177]; # remove the eight bit

  $string = wrap('','',$string);

  # limit the number of lines (cut off the rest)
  if ($line_nr_limit > 0) {
    # split up in an array of single lines
    my @l = split /\n/, $string;         
    my $max = $line_nr_limit;
    $max = @l if (@l < $max);
    $string = '';
    # rebuild string by using the first $max lines
    for ( 0 .. ($max - 1)) {
	  $string .= sprintf "%s\n", $l[$_];
    }
    $string =~ s/\n+$//;                 # cut off trailing newline(s)
  }

  return $string;
}

##############################################################
# getFileSize - get the size in kB of a file, even if it is a link
##############################################################
sub getFileSize {
  my $dpic   = shift;
  my $format = shift;   # NO_FORMAT = return size unformated in Bytes (integer) FORMAT = with "kB" added (string)
  my $size   = "";

  return $quickSortHashSize{$dpic} if ($quickSortSwitch and defined $quickSortHashSize{$dpic});

  if (!-f $dpic) {
	warn "getFileSize: $dpic is no file!";
	if ((defined $format) and ($format == NO_FORMAT)) {
	  return 0;
	}
	else {
	  return "";
	}
  }

  if (-l $dpic) {
	$size = (lstat (getLinkTarget($dpic)))[7];
  }
  else {
	$size = (lstat $dpic)[7];
  }

  if ((defined $format) and ($format == FORMAT)) {
	$size = int($size/1024)."kB" if $size;
  }

  $quickSortHashSize{$dpic} = $size if $quickSortSwitch;
  return $size;
}

##############################################################
# makeDir - create the directory for storing the
#           thumbnail pictures or EXIF infos
##############################################################
sub makeDir {

  my $dir  = shift;
  my $ask  = shift; # ASK = ask before creating a dir, NO_ASK

  return 1 if (-d $dir);

  if ( ($ask == ASK) and $config{AskMakeDir} ) {
	my $rc    = checkDialog("Create new folder?",
						 "MaPiVi would like to create this folder:\n$dir\nContinue?",
						 \$config{AskMakeDir},
						 "ask every time",
						 "",
						 'OK', 'Cancel');
	return if ($rc ne 'OK');
  }

  # 0755 = rwxr.xr.x
  eval { mkpath($dir, 0, 0755) }; # 0 = no output, 0755 = access rights
  if ($@) {
	$top->messageBox(-icon => 'warning', -message => "makeDir: can not create $dir: $@",
							  -title => 'Error', -type => 'OK');
	return 0;
  }

  return 1;
}

##############################################################
# aNewerThanb - true if file a is newer than file b, or if
#               file a exists and file b does not
##############################################################
sub aNewerThanb {

  my $afile = shift;
  my $bfile = shift;

  if (-f $afile) {
      if (-f $bfile) {
	  # compare modification times
	  return (lstat $afile)[9] > (lstat $bfile)[9];
      }
      return 1;
  }
  return 0;
}

##############################################################
# nextPic - get the index of the next picture in the directory
##############################################################
sub nextPic {

  my $actpic = shift;

  my @pics = $picLB->info('children');

  # if there are no pics return an empty string
  return "" if (@pics == 0);

  # if there is no actpic we start with the first
  return $pics[0] if ($actpic eq "");

  # try to get the next pic
  my $next = $picLB->info('next', $actpic);

  # if there is no next pic
  unless ($next) {
	# we have reached the end and start again with the first picture
	beep() if ($config{BeepWhenLooping});
	$next = $pics[0];
  }

  return $next;
}

##############################################################
# nextSelectedPic - get the index of the next selected picture
#                   in the directory
##############################################################
sub nextSelectedPic {

  my $actpic = shift;

  my @pics = $picLB->info('children');
  my @sel  = $picLB->info('selection');

  # if there are no pics return an empty string
  return "" if (@pics == 0);
  return "" if (@sel  == 0);

  my $start   = 0;
  my $next    = "";
  my $nextsel = "";
  foreach my $dpic (@pics) {
	# skip all pics until we reach the actual picture
	$start = 1 if ($dpic eq $actpic);
	next unless $start;

	# get the next picture
	$next = $picLB->info('next', $dpic);

	# check if it is selected
	if ($next and isInList($next, \@sel)) {
	  $nextsel = $next;
	  last;
	}
  }

  # if there is no next pic
  if ($nextsel eq "") {
	# we have reached the end and start again with the first selected picture
	#beep() if ($config{BeepWhenLooping});
	$nextsel = $sel[0];
  }

  return $nextsel;
}

##############################################################
# prevPic - show the previous picture in the directory
##############################################################
sub prevPic {

  my $actpic = shift;

  my @pics = $picLB->info('children');

  # if there are no pics return an empty string
  return "" if (@pics == 0);

  # if there is no actpic we start with the first
  return $pics[-1] if ($actpic eq "");

  # try to get the previous pic
  my $prev = $picLB->info('prev', $actpic);

  # if there is no prev pic
  unless ($prev) {
	# we have reached the start and jump to the last picture
	beep() if ($config{BeepWhenLooping});
	$prev = $pics[-1];
  }

  return $prev;
}

##############################################################
# gotoPic
##############################################################
sub gotoPic {

  my $lb = shift;

  return if (stillBusy()); # block, until last picture is loaded
  if ($slideshow == 1) {
	$slideshow = 0; slideshow();
  }		# switch slideshow off
  my @childs = $lb->info('children');
  return if (!@childs);

  my $goto = "";
  my $rc = myEntryDialog("Go to picture/select pictures", "Please enter a part of the name or the index number of the picture(s) to select/show.\nIndex number are entered like this: /number.\nUse /c to switch to case sensitive and /s if the filename starts with the search string.\n\nExamples:\nabc      show and select all pictures containing abc (any case)\n/10      show picture number 10\n/sabc    show and select all pictures starting with abc (any case)\n/cABC    show and select all pictures containing an upper case ABC\n/s/cABC  show and select all pictures starting with an upper case ABC", \$goto);

  return if (($rc ne 'OK') or ($goto eq ""));

   if ($goto =~ m/(\/)(\d+)/) {  # $goto is a number
 	if (($2 > 0) and ($2 < @childs + 1)) {
	  # saved here for undo function
	  @savedselection2 = @savedselection;
	  @savedselection = $lb->info('selection');
	  $lb->selectionClear();
	  showPic($childs[$2-1]) if ($lb == $picLB);
	}
 	else {
 	  $userinfo = "number $2 is out of range!"; $userInfoL->update;
 	}
   }
   else { # $goto is a string
	my @pics;
	my $case = "i";
	my $start = ".*";
	if ($goto =~ m/.*\/c/) { $case = "";  $goto =~ s/\/c//; }
	if ($goto =~ m/.*\/s/) { $start = "^"; $goto =~ s/\/s//; }
	foreach (@childs) {
	  if (basename($_) =~ m/(?$case)$start$goto.*/) {
		push @pics, $_;
	  }
	}
	if (@pics) {
	  # saved here for undo function
	  @savedselection2 = @savedselection;
	  @savedselection = $lb->info('selection');
	  $lb->selectionClear();
	  showPic($pics[0]) if ($lb == $picLB);
	  reselect($lb, @pics);
	  $userinfo = "selected ".scalar @pics." pictures matching \"$goto\""; $userInfoL->update;
	}
	else {
	  $userinfo = "string $goto was not found in the picture names"; $userInfoL->update;
	}
  }
}

##############################################################
# showImageInfo - display infos and comment of given image
#                 if availabel
##############################################################
sub showImageInfo {
  my $dpic = shift;

  if (!-f $dpic) {
	$widthheight  = "";
	$size         = "";
	$exif         = "";
	$urgencyStr   = "";
	$urgencyScale = 0;
	$commentText->delete( 0.1, 'end') if ($config{ShowCommentField});
  }
  else {
	my $meta = getMetaData($dpic, "COM|APP13|APP1|SOF", 'FASTREADONLY');
	($width, $height) = getSize($dpic, $meta);
	$widthheight      = $width.'x'.$height;
	if ($config{ShowEXIFField}) {
	  $exif = getShortEXIF($dpic, NO_WRAP, $meta);
	}
	if ($config{ShowCommentField}) {
	  my $comment = getComment($dpic, LONG, $meta);
	  # does not work! mh 14.07.03
	  # 	# determine the height of the textbox by counting the number of lines
	  # 	my $height = ($comment =~ tr/\n//);
	  # 	$height++;
	  # 	$height    = 10 if ($height > 10); # not to big, we have scrollbars
	  # 	print "h = $height\n";
	  # 	$commentText->configure(-height => $height);
	  $commentText->delete( 0.1, 'end');       # remove old comment
	  $commentText->insert('end', $comment);   # insert new comment
	}
	if ($config{ShowCaptionField}) {
	  my $caption = getIPTCCaption($dpic);
	  $captionText->delete( 0.1, 'end');       # remove old caption
	  $captionText->insert('end', $caption);   # insert new caption
	}
	$urgencyStr   = getIPTCurgency($dpic, $meta);
	$urgencyScale = 9 - $urgencyStr;
	$urgencyScale = 0 if (($urgencyStr < 1) or ($urgencyStr > 8));
	$urgencyStr   = "" if ($urgencyStr > 8);
	
	$size = getFileSize($dpic, FORMAT);
  }
  setTitle();
}

##############################################################
# showImageInfoCanvas - display infos on the canvas
##############################################################
sub showImageInfoCanvas {
  my $dpic = shift;

  $c->delete('withtag', 'TEXT');

  return unless (defined $dpic);
  return unless (-f $dpic);
  return unless ($config{ShowInfoInCanvas});

  my $info = "";
  my $meta = getMetaData($dpic, "COM|APP13|APP1|SOF", 'FASTREADONLY');
  my $exif = formatString(getShortEXIF($dpic, NO_WRAP, $meta), 80, -1);
  my $comm = formatString(getComment($dpic, LONG, $meta), 80, -1);
  my $iptc = formatString(getIPTC($dpic, LONG, $meta), 80, -1);
  $info   .= "EXIF:\n$exif\n"         if ($exif ne "");
  $info   .= "--------------------\n" if (($exif ne "") and (($comm ne "") or ($iptc ne "")));
  $info   .= "IPTC:\n$iptc"           if ($iptc ne "");
  $info   .= "--------------------\n" if (($comm ne "") and ($iptc ne ""));
  $info   .= "Comment:\n$comm"        if ($comm ne "");

  return if ($info eq '');
  # show image info on canvas white font with black shadow
  $c->createText( 5, 5, -font => $font, -text => $info, -anchor => 'nw', -fill => 'black', -tags => ['TEXT']);
  $c->createText( 4, 4, -font => $font, -text => $info, -anchor => 'nw', -fill => 'white', -tags => ['TEXT']);
}

##############################################################
# showZoomInfo - calculate the zoom factor of the displayed
#                pic by messuring the size of the file
#                and the size on the canvas
##############################################################
sub showZoomInfo {
  my $dpic = shift;
  my $id   = shift;

  if (-f $dpic) {
	my ($width, $height)    = getSize($dpic);
	my ($x1, $y1, $x2, $y2) = $c->bbox($id);

	if (defined $x2 and defined $x1 and ($x2 - $x1 != 0)) {
	  my $z = $width/($x2 - $x1);
	  if ($z > 0) { # avoid divison by zero
		$zoomFactorStr = int(1/$z * 100)."%";
		return;
	  }
	}
  }

  $zoomFactorStr = "?%";

}

##############################################################
# handleNonJPEG
##############################################################
sub handleNonJPEG {

  my $dir     = shift;
  my @pics    =  @_;
  my $changed = 0;    # counter

  return 0 if ((defined $nonJPEGdirNoAskAgain{"$dir"}) and ($nonJPEGdirNoAskAgain{"$dir"} == 1));

  # open window
  my $myDiag = $top->Toplevel();
  $myDiag->title('Non-JPEG pictures');

  $myDiag->Label(-text => "There are ".scalar @pics." non-JPEG pictures in folder ".basename($dir).".\nShould I convert these pictures to JPEG format?\n(After convertion these pictures will be visible in Mapivi.)",
				 -bg => $config{ColorBG}
				  )->pack(-fill => 'x', -padx => 3, -pady => 3);

  my $qS = labeledScale($myDiag, 'top', 40, "Quality of JPEG picture when converting", \$config{PicQuality}, 10, 100, 1);
  qualityBalloon($qS);

  my $removeOrig = 0;
  $myDiag->Checkbutton(-variable => \$removeOrig, -text => "Remove the original pictures after conversion")->pack(-anchor=>'w');

  my $ButF =
	$myDiag->Frame()->pack(-fill =>'x', -padx => 0, -pady => 0);

  my $OKB =
	$ButF->Button(-text => 'OK',
				  -command => sub {
					$myDiag->withdraw();
					$myDiag->destroy();
					$changed = convertToJPEG($dir, $removeOrig, @pics);
				  })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 2, -pady => 3);

  $ButF->Button(-text => "Show picture list",
				-command => sub {
				  my $info = "Non-JPEG pictures in $dir:\n\n";
				  foreach (sort @pics) {
					my $size = getFileSize("$dir/$_", NO_FORMAT);
					$info .= sprintf "%-45s %12s Bytes\n", $_, $size;
				  }
				  showText("Non-JPEG pictures", $info, WAIT);
				})->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 2, -pady => 3);

  $ButF->Button(-text => 'Cancel',
				-command => sub {
				  # save dir in hash, so we don't bother the user again if he reopens the dir
				  $nonJPEGdirNoAskAgain{"$dir"} = 1;
				  $myDiag->withdraw();
				  $myDiag->destroy();
				})->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 2, -pady => 3);

  $myDiag->Popup(-popover => 'cursor');
  repositionWindow($myDiag);
  if ($EvilOS) { # sometimes to dialog disappears when clicked on, so we need a short grab
	$myDiag->grab;
	$myDiag->after(50, sub{$myDiag->grabRelease});
  }
  $myDiag->waitWindow;

  my $reread = ($changed > 0) ? 1 : 0;
  return $reread;
}

##############################################################
# convertToJPEG - convert the piclist to JPEG format
##############################################################
sub convertToJPEG {
  my $dir = shift;
  my $del = shift; # delete orig after conversion (bool)
  my @pics =  @_;
  my $converted = 0;

  foreach (@pics) {
	my $dpic  = "$dir/$_";
	my $tpic  = $dpic;
	$tpic     =~ s/($nonJPEGsuffixes)$/jpg/i;

	print "convertToJPEG: $_ -> $tpic\n" if $verbose;

	if (-f $tpic) {
	  $top->messageBox(-icon => 'warning', -message => "$tpic exists - skipping!",
					   -title => 'Warning', -type => 'OK');
	  next;
	}
	$userinfo = "converting $_ to JPEG $tpic ..."; $userInfoL->update;
	my $command = "convert";
	$command .= " -quality ".$config{PicQuality}." \"$dpic\" \"$tpic\"";
	$top->Busy;
	#(system "$command") == 0 or warn "$command failed: $!";
	execute($command);
	$top->Unbusy;
	$converted++ if ((-f $tpic) and (!-z $tpic));

	if (($del) and ((-f $tpic) and (!-z $tpic))) { removeFile($dpic); }
  }
  return $converted;
}

##############################################################
# showNonJPEGS - show all non JPEG files of the actual dir
##############################################################
sub showNonJPEGS {

  my @files = getFiles($actdir);

  # put just the files not matching jpg, jpeg, JPG or JPEG in the file list
  my @nonjpeg  = grep {!m/.*\.jp(g|eg)$/i} @files;

  my $info = "There are ".scalar @nonjpeg." non-JPEGs in $actdir:\n\n";

  foreach (sort @nonjpeg) {
	my $size = getFileSize("$actdir/$_", NO_FORMAT);
	$info .= sprintf "%-45s %12s Bytes\n", $_, $size;
  }

  showText("Non-JPEGs", $info, WAIT);

}

##############################################################
# convertNonJPEGS
##############################################################
sub convertNonJPEGS {

  my @files = getFiles($actdir);

  # put just the files not matching jpg, jpeg, JPG or JPEG in the file list
  my @nonjpeg  = grep {!m/.*\.jp(g|eg)$/i} @files;

  handleNonJPEG($actdir, @nonjpeg);
  updateThumbs();
}

##############################################################
# getPics - returns the piclist of the given dir
##############################################################
sub getPics {

  my $dir       = shift;
  my $with_path = shift;  # WITH_PATH or JUST_FILE
  my @other;

  my @files = getFiles($dir);

  # are there non-JPEG pictures in this directory?
  if ($config{CheckForNonJPEGs}) {# and !$dirHotlist{$dir}) {
	@other  = grep {m/.*\.($nonJPEGsuffixes)$/i} @files;

	my @otherNoJPEG;
	foreach (@other) {
	  $_ =~ m/(.*)\.($nonJPEGsuffixes)$/i; # separate the name from the suffix
	  my $jpeg = "$1.jpg";                 # built the corresponding jpeg file name
	  if (!-f "$dir/$jpeg") {              # if this doesn't exists
		push @otherNoJPEG, $_              # we push it to this list
	  }
	}

    # are there some non-JPEGs without corresponding JPEGs?
	if (@otherNoJPEG > 0) {
	  my $reread = handleNonJPEG($dir, @otherNoJPEG); # ask the user to convert them
	  @files     = getFiles($dir) if $reread;       # reread file list if necessary
	}
  }

  # put just the files matching jpg, jpeg, JPG or JPEG in the file list
  #my @jpegs  = grep {m/.*\.(jp(g|eg))|(gif)|(xpm)|(ppm)|(xbm)|(ti(f|ff))|(svg)|(png)|(bmp)$/i} @files;
  my @jpegs;
  if ($config{supportOtherPictureFormats}) {
	@jpegs  = grep {m/.*\.(jp(g|eg))|(gif)|(xpm)|(ppm)|(xbm)|(ti(f|ff))|(svg)|(png)|(bmp)|(nef)|(raw)$/i} @files;
  }
  else {
	@jpegs  = grep {m/.*\.jp(g|eg)$/i} @files;
  }

  # if we are in the actual dir, display the number of non-JPEG files
  if ($dir eq $actdir) {
	$otherFiles = @files - @jpegs;
	$otherFiles = "" if ($otherFiles == 0);
  }

  $dir =~ s|/*$||;                        # remove trailing slashes
  if ($with_path == WITH_PATH) {
	foreach (@jpegs) { $_ = "$dir/$_"; }  # add the path to each file
  }

  return @jpegs;
}

##############################################################
# sortPics - sorts a list of pictures according to $sortby
##############################################################
sub sortPics {
  my $sortby      = shift;
  my $sortreverse = shift;
  my $pics        = shift; # reference on array to sort

  print "sortby = $sortby\n" if $verbose;

  my $str = "sorting ".scalar @$pics." pictures by $sortby";
  $str   .= " (reverse)" if $sortreverse;
  $userinfo = "$str ...";
  $userInfoL->update;

  clearQuickSortHashes(); # remove old values
  $quickSortSwitch = 1;   # activate quick sort/buffering

  if ($sortby eq "name") { # sort alphabetical with no case
	@$pics = sort { uc(basename($a)) cmp uc(basename($b)) } @$pics;
  }
  elsif ($sortby eq "date") { # sort by file date and name
	#@$pics = sort { getFileDate($b, NO_FORMAT) <=> getFileDate($a, NO_FORMAT) ||
				 #uc($a) cmp uc($b) } @$pics;
	@$pics = sort { $searchDB{$b}{MOD} <=> $searchDB{$a}{MOD} ||
				 uc($a) cmp uc($b) } @$pics;
  }
  elsif ($sortby eq "exifdate") {
	#@$pics = sort { getEXIFDate($b) cmp getEXIFDate($a) ||
				 #uc($a) cmp uc($b) } @$pics;
	@$pics = sort { $searchDB{$b}{TIME} <=> $searchDB{$a}{TIME} ||
				 uc($a) cmp uc($b) } @$pics;
  }
  elsif ($sortby eq "aperture") {
	@$pics = sort { getEXIFAperture($a, NUMERIC) <=> getEXIFAperture($b, NUMERIC) ||
					 uc($a) cmp uc($b) } @$pics;
  }
  elsif ($sortby eq "exposuretime") {
	@$pics = sort { getEXIFExposureTime($a, NUMERIC) <=> getEXIFExposureTime($b, NUMERIC) ||
					 uc($a) cmp uc($b) } @$pics;
  }
  elsif ($sortby eq "model") {
	@$pics = sort { uc(getEXIFModel($a)) cmp uc(getEXIFModel($b)) ||
				 uc($a) cmp uc($b) } @$pics;
  }
  elsif ($sortby eq "artist") {
	@$pics = sort { uc(getEXIFArtist($a)) cmp uc(getEXIFArtist($b)) ||
				 uc($a) cmp uc($b) } @$pics;
  }
  elsif ($sortby eq "size") {
	#@$pics = sort { getFileSize($a, NO_FORMAT) <=> getFileSize($b, NO_FORMAT) ||
				 #uc($b) cmp uc($a) } @$pics;
	@$pics = sort { $searchDB{$b}{SIZE} <=> $searchDB{$a}{SIZE} ||
				 uc($a) cmp uc($b) } @$pics;
  }
  elsif ($sortby eq "pixel") {
	@$pics = sort { getPixels($a) <=> getPixels($b) ||
				 uc($b) cmp uc($a) } @$pics;
  }
  elsif ($sortby eq "bitpix") {
	@$pics = sort { getBitPix($a) <=> getBitPix($b) ||
				 uc($b) cmp uc($a) } @$pics;
  }
  elsif ($sortby eq "urgency") {
	@$pics = sort { getIPTCurgencyDB($a) <=> getIPTCurgencyDB($b) ||
					uc($a) cmp uc($b) } @$pics;
  }
  elsif ($sortby eq "popularity") {
	@$pics = sort { $searchDB{$b}{POP} <=> $searchDB{$a}{POP} ||
					uc($a) cmp uc($b) } @$pics;
  }
  elsif ($sortby eq "byline") {
	@$pics = sort { uc(getIPTCByLine($a)) cmp uc(getIPTCByLine($b)) ||
				 uc($a) cmp uc($b) } @$pics;
  }
  elsif ($sortby eq "random") {
	fisher_yates_shuffle($pics);
	#@$pics = @$pics;
  }
  else {
	my $sort = "undefined!";
	$sort = $sortby if (defined $sortby);
	warn "sortPics: error: wrong sort: $sort - sorting by name";
	@$pics = sort { uc($a) cmp uc($b); } @$pics;
  }

  clearQuickSortHashes();  # free mem
  $quickSortSwitch = 0;    # stop quick search

  if ($sortreverse and ($sortby ne "random")) {
	@$pics = reverse @$pics;
  }
}

##############################################################
# clearQuickSortHashes - reset all sort hashes
##############################################################
sub clearQuickSortHashes {
  undef %quickSortHash;
  undef %quickSortHashSize;
  undef %quickSortHashPixel;
  undef %quickSortHashBitsPixel;
}

##############################################################
# getFileDate - parameter: file (with absolute path)
#                          format
##############################################################
sub getFileDate {
  my $dpic   = shift;
  my $format = shift; # FORMAT = the date is returned in this date format (dd.mm.yyyy hh:mm:ss); NO_FORMAT

  return $quickSortHash{$dpic} if ($quickSortSwitch and defined $quickSortHash{$dpic});

  unless (-f $dpic) {
	warn "$dpic is no file!" if $verbose;
	return 0;
  }

  my $filedate = (lstat $dpic)[9]; # 9 is the modify time

  $filedate = buildDateTime($filedate) if ((defined $format) and ($format == FORMAT));

  $quickSortHash{$dpic} = $filedate if $quickSortSwitch;

  return $filedate;
}

##############################################################
# getEXIFDate - parameter: file (with absolute path)
#                          image info (optional)
#               returns yyyy:mm:dd hh:mm:ss
##############################################################
sub getEXIFDate {

  my $dpic = shift;
  my $er   = shift;  # optional, the EXIF hash ref if available

  return "" unless (is_a_JPEG($dpic));

  return $quickSortHash{$dpic} if ($quickSortSwitch and defined $quickSortHash{$dpic});

  unless (defined($er)) {
	my $meta = getMetaData($dpic, 'APP1$', 'FASTREADONLY') ;
	$er      = $meta->get_Exif_data('ALL', 'TEXTUAL');
	warn "$dpic has no exif info" if ($verbose and (!defined($er)));
  }

  my $date    = [];
  my $datestr = "";

  if (defined $er->{'SUBIFD_DATA'}->{DateTimeOriginal}) {
	$datestr = ${$er->{'SUBIFD_DATA'}->{DateTimeOriginal}}[0];
  } elsif (defined $er->{'SUBIFD_DATA'}->{DateTimeDigitized}) {
	$datestr = ${$er->{'SUBIFD_DATA'}->{DateTimeDigitized}}[0];
  } elsif (defined $er->{'IFD0_DATA'}->{DateTime}) {
	$datestr = ${$er->{'IFD0_DATA'}->{DateTime}}[0];
  } else {
  }

  $datestr =~ tr/\000/ /;  # remove null termination (\000) chars
  $datestr =~ s/( )*$//g;  # remove trailing space

  printf "getEXIFDate: -%s- (%s)\n", $datestr, basename($dpic) if $verbose;

  $quickSortHash{$dpic} = $datestr if $quickSortSwitch;

  return $datestr;
}

##############################################################
# getEXIFModel - parameter: file (with absolute path)
#                          image info (optional)
##############################################################
sub getEXIFModel {

  my $dpic = shift;
  my $er   = shift;  # optional, the EXIF hash ref if available

  return $quickSortHash{$dpic} if ($quickSortSwitch and defined $quickSortHash{$dpic});

  unless (defined($er)) {
	my $meta = getMetaData($dpic, 'APP1$', 'FASTREADONLY') ;
	$er      = $meta->get_Exif_data('ALL', "TEXTUAL");
	warn "$dpic has no exif info" unless (defined $er);
  }

  my $maker = "";
  if (defined $er->{'IFD0_DATA'}->{'Make'}) {
	$maker =  ${$er->{'IFD0_DATA'}->{'Make'}}[0];
	$maker =~ s/( co\.,ltd)//i;	# some companies are a little to verbose here,
	$maker =~ s/( co\., ltd\.)//i;
	$maker =~ s/( optical)//i;     # so we try to short some words
	$maker =~ s/( electric)//i;
	$maker =~ s/(\.)//i;
	$maker =~ s/( corporation)//i;
	$maker =~ s/(eastman kodak company)/KODAK/i;
	$maker =~ s/(hewlett-packard company)/Hewlett-Packard/i;
	$maker =~ s/(konica)/Konica/i;
	$maker =~ s/(pentax)/Pentax/i;
	$maker =~ s/(nikon)/Nikon/i;
  }

  my $model = "";
  if (defined $er->{'IFD0_DATA'}->{'Model'}) {
	$model = ${$er->{'IFD0_DATA'}->{'Model'}}[0];
	$model =~ s/(digital camera )//i;  # uh, really!  :) - ok it could also be a scanner ...
	$model =~ s/(digital camera)//i;   # sometimes with trailing space, sometimes not ...
	$model =~ s/(digital science )//i; # this is really to verbose ...
	$model =~ s/(digital science)//i;  # sometimes with trailing space, sometimes not ...
	$model =~ s/( digital)//i;         #
	$model =~ s/(kodak )//i;           # hello! we already had this in the Make field ...
	$model =~ s/(canon )//i;
	$model =~ s/(konica )//i;
	$model =~ s/(pentax )//i;
	$model =~ s/(nikon )//i;
	$model =~ s/(sigma )//i;
	$model =~ s/(HP )//;
  }

  $quickSortHash{$dpic} = "$maker $model" if $quickSortSwitch;

  return "$maker $model";
}

##############################################################
# getEXIFArtist - parameter: file (with absolute path)
#                            image info (optional)
##############################################################
sub getEXIFArtist {

  my $dpic = shift;
  my $er   = shift;  # optional, the EXIF hash ref if available

  return $quickSortHash{$dpic} if ($quickSortSwitch and defined $quickSortHash{$dpic});

  unless (defined($er)) {
	my $meta = getMetaData($dpic, 'APP1$', 'FASTREADONLY') ;
	$er      = $meta->get_Exif_data('ALL', "TEXTUAL");
	warn "$dpic has no exif info" unless (defined $er);
  }

  my $artist = "";
  if (defined $er->{'IFD0_DATA'}->{Artist}) {
	$artist = ${$er->{'IFD0_DATA'}->{Artist}}[0];
  }

  $quickSortHash{$dpic} = $artist if $quickSortSwitch;

  print "Artist: $artist pic:$dpic\n" if $verbose;

  return $artist;
}

##############################################################
# getEXIFAperture - parameter: file (with absolute path)
#                              format (boolean)
#                              image info (optional)
##############################################################
sub getEXIFAperture {

  my $dpic   = shift;
  my $format = shift;  # NUMERIC or STRING
  my $er     = shift;  # optional, the EXIF hash ref if available

  return $quickSortHash{$dpic} if ($quickSortSwitch and defined $quickSortHash{$dpic});

  unless (defined($er)) {
	my $meta = getMetaData($dpic, 'APP1$', 'FASTREADONLY') ;
	$er      = $meta->get_Exif_data('ALL', "TEXTUAL");
	warn "$dpic has no exif info" unless (defined $er);
  }

  # FNumber: The actual F-number (F-stop) of lens when the image was taken.

  my $aperture = 0;
  if (defined        $er->{'SUBIFD_DATA'}->{FNumber}) {
	$aperture = calc($er->{'SUBIFD_DATA'}->{FNumber});
  }
  elsif (defined     $er->{'SUBIFD_DATA'}->{ApertureValue}) {
	$aperture = calc($er->{'SUBIFD_DATA'}->{ApertureValue});
  }
  else { }

  $aperture = sprintf("F%02.1f ", $aperture) if (($format == STRING) and ($aperture != 0));

  $quickSortHash{$dpic} = $aperture if $quickSortSwitch;

  return $aperture;
}

##############################################################
# getEXIFExposureTime - parameter: file (with absolute path)
#                              format (boolean)
#                              image info (optional)
##############################################################
sub getEXIFExposureTime {

  my $dpic   = shift;
  my $format = shift; # STRING -> return a string ("1/20s "), NUMERIC -> return a value (0,05)
  my $er     = shift; # optional, EXIF hash ref

  my $exti  = "";     # exposure time as string
  my $extiN = 0;      # exposure time as number

  return $quickSortHash{$dpic} if ($quickSortSwitch and defined $quickSortHash{$dpic});

  unless (defined($er)) {
	my $meta = getMetaData($dpic, 'APP1$', 'FASTREADONLY') ;
	$er      = $meta->get_Exif_data('ALL', "TEXTUAL");
	if ($verbose) { warn "$dpic has no exif info" unless (defined $er); }
  }

  if (defined  $er->{'SUBIFD_DATA'}->{'ExposureTime'}) {
	my $time = $er->{'SUBIFD_DATA'}->{'ExposureTime'};

	warn "getEXIFExposureTime: not enough numbers!" if (@{$time} < 2);

	# this should not happen
	if ($$time[1] == 0) {
	  warn "error ".basename($dpic)." wrong EXIF exposure time t0:$$time[0] t1:$$time[1]";
	  $format == STRING ? return "" : return 0;
	}
	if (($$time[0]/$$time[1]) >= 1) {	# handle long time exposure (e.g. 800/100)
	  $exti  = sprintf "%.2f",($$time[0]/$$time[1]);
	  $extiN = $exti;
	}
	else {					# handle everything faster than one second
	  if ($$time[0] != 1) {		# some cameras use the format 10/600
		  if ($$time[0] == 0) {
			  print "error ".basename($dpic)." div by zero exti:$exti t0: $$time[0] t1:$$time[1]\n" if $verbose;
			  $exti  = "1/$$time[1]?";
			  $extiN =  0;
		  }
		  else {
			  $exti  = "1/".int($$time[1]/$$time[0]); # instead of 1/60 so we have to normalize this
			  $extiN = 1/int($$time[1]/$$time[0]);
		  }
	  }
	  else {
		$exti  = "1/".$$time[1];
		$extiN = 1/$$time[1];
	  }
	}
  }
  elsif (defined $er->{'SUBIFD_DATA'}->{'ShutterSpeedValue'}) {
	my $time =   $er->{'SUBIFD_DATA'}->{'ShutterSpeedValue'};
	$exti    = ($$time[0]/$$time[1]);
	$exti    = int(2**$exti);
	$extiN   = 1/$exti;
	$exti    = "1/".$exti;
  }
  else {
	$exti  = "";
	$extiN = 0;
  }

  my $rc = 0;
  if ($format == STRING) {
	if ($exti eq "") {
	  $rc = "";
	} else {
	  $rc = $exti."s ";		# add the time unit (s = second)
	}
  } else { #$format == NUMERIC
	$rc = $extiN;
  }

  $quickSortHash{$dpic} = $rc if $quickSortSwitch;
  return $rc;
}

##############################################################
# getFiles - returns the filelist of the given dir
##############################################################
sub getFiles {

  my $dir = shift;
  print "  getFiles: in $dir\n" if $verbose;
  my @fileDirList = readDir($dir);
  my @fileList;
  foreach (@fileDirList) {
	# put only files which are not empty into the filelist
	push @fileList, $_ if ((-f "$dir/$_") and (!-z "$dir/$_"));
  }
  return @fileList;
}

##############################################################
# getDirs - returns the dir list of the given dir
##############################################################
sub getDirs {

  my $dir = shift;

  my @fileDirList = readDir($dir);
  my @dirList;
  foreach (@fileDirList) {
	next if (($_ eq '.') or ($_ eq '..'));
	my $item = Encode::encode('iso-8859-1', "$dir/$_");
	#my $d2 = Encode::encode('iso-8859-1', $d);
	#print "getDirs: encoded: $item";
	#if (-d $item) { print " is a dir\n"; }
	#else  { print " is not a dir\n"; }
	push @dirList, $item if (-d $item);
  }

  @dirList = sort { uc($a) cmp uc($b) } @dirList;
  
  return @dirList;
}

##############################################################
# getDirsRecursive - returns all subdirs of the given dir
#                    $dir is also included in list
#                    mapivi and gimp subdirs are skipped
#                    dirs starting with "." are skipped
##############################################################
sub getDirsRecursive {
  my $dir = shift;

  my @dirs;

  find(sub {
		 if (-d and ($_ !~ m|^\.|) and ($_ ne $thumbdirname) and ($_ ne $exifdirname)) {
		   push @dirs, $File::Find::name;
		 }
	   }, $dir);

  return @dirs;
}

##############################################################
# readDir - reads the contents of the given directory
##############################################################
sub readDir {

  my $dir = shift;
  $dir = Encode::encode('iso-8859-1', $dir);
  
  if (! -d $dir) {
	warn "readDir: $dir is no dir!: $!" unless (($dir =~ m/.*$thumbdirname$/) or ($dir =~ m/.*$plugindir$/));
	return 0;
  }

  my @fileDirList;

  # open the directory
  if (!opendir ACTDIR, "$dir") {
	warn "Can't open folder $dir: $!";
	return 0;
  }

  # show no files starting with a '.', but '..'
  @fileDirList = grep /^(\.\.)|^[^\.]+.*$/, readdir ACTDIR;

  closedir ACTDIR;

  return @fileDirList;
}

##############################################################
# restart
##############################################################
sub restart {
  saveAllConfig();
  freeMem();
  system "mapivi &";
  exit;
}

##############################################################
# quitMain
##############################################################
sub quitMain {
  saveAllConfig();
  freeMem();
  exit;
}

##############################################################
# freeMem
##############################################################
sub freeMem {
  # clean up all photo objects
  $userinfo = "free mem ..."; $userInfoL->update;
  foreach ($top->imageNames) {
	if (defined $_) {
	  print "cleaning up: $_\n" if $verbose;
	  $_->delete;
	}
	else {
	  warn "image $_ is not defined!";
	}
  }
  $userinfo = "exit ..."; $userInfoL->update;
}

##############################################################
# saveAllConfig
##############################################################
sub saveAllConfig {

  $userinfo = "saving configuration ..."; $userInfoL->update;

  $config{Geometry} = $top->geometry;
  $keyXBut->invoke if (Exists($keyw)); # this will trigger the saving of the treemode and win geometry
  
  saveAdjusterPos();

  $config{LastDir} = $actdir if (-d $actdir);
  $config{ActPic}  = $actpic;
  
  # we don't want to start in full screen mode
  # so if we've been in fullscreen mode, we save the settings from before the fullscreen switch
  if ($topFullScreen) {
	print "saveAllConfig called in full screen mode\n" if $verbose;
	$config{Geometry}         = $topFullSceenConf{Geometry};
	$config{ShowMenu}         = $topFullSceenConf{ShowMenu};
	$config{ShowInfoFrame}    = $topFullSceenConf{ShowInfoFrame};
	$config{ShowCommentField} = $topFullSceenConf{ShowCommentField};
	$config{ShowCaptionField} = $topFullSceenConf{ShowCaptionField};
	$config{ShowEXIFField}    = $topFullSceenConf{ShowEXIFField};
	$config{Layout}           = $topFullSceenConf{Layout};
  }
  else { print "saveAllConfig called in normal screen mode\n" if $verbose; }

  $userinfo = "saving options ..."; $userInfoL->update;
  saveConfig($configFile, \%config);

  if ($config{SaveDatabase}) {
	  $userinfo = "saving search database ..."; $userInfoL->update;
	  nstore(\%searchDB,  "$configdir/SearchDataBase") or warn "could not store searchDB in file $configdir/SearchDataBase: $!";
  }

  $userinfo = "saving dir hotlist ..."; $userInfoL->update;
  nstore(\%dirHotlist, "$configdir/hotlist") or warn "could not store $configdir/hotlist: $!";
  my $datetime = getDateTime();
  # save a copy of the old hash in the trash # todo: remove very old backups
  $userinfo = "saving dir check list ..."; $userInfoL->update;
  mycopy("$configdir/dirProperties", "$trashdir/dirProperties-$datetime", OVERWRITE) if (-f "$configdir/dirProperties");
  nstore(\%dirProperties, "$configdir/dirProperties") or warn "could not store $configdir/dirProperties: $!";
  nstore(\%ignore_keywords, "$configdir/keywords_ignore") or warn "could not store $configdir/keywords_ignore: $!";

  if (MatchEntryAvail) {
	$userinfo = "saving entry values ..."; $userInfoL->update;
	nstore(\%entryHistory, $file_Entry_values) or warn "could not store $file_Entry_values: $!";
  }

  $userinfo = "saving categories ..."; $userInfoL->update;
  saveArrayToFile("$configdir/categories", \@precats);
  $userinfo = "saving keywords ..."; $userInfoL->update;
  saveArrayToFile("$configdir/keywords",   \@prekeys);

  $userinfo = "ready!"; $userInfoL->update;
}

##############################################################
# getComment - returns a string containing all Comments
#              (if available) of the given pic (up to 64K per
#              block, nr of blocks is not limited, so this can
#              get pretty huge!)
##############################################################
sub getComment {

  my $dpic   = shift;
  my $format = shift; # LONG or SHORT
  my $meta   = shift; # optional, the Image::MetaData::JPEG object of $dpic if available

  return "" unless is_a_JPEG($dpic); # todo support GIF and PNG comments

  my @comments = getComments($dpic, $meta);
  return "" if (@comments <= 0);

  my $comment = "";
  # put the comments togehter, adding a newline after each comment
  foreach (@comments) {
	$comment .= "$_\n";
  }

  $comment =~ s/\r*//g;  # remove \r (carriage return)
  $comment =~ s/\n+$//;  # cut off last newline(s)

  $comment = formatString($comment, $config{LineLength}, $config{LineLimit}) if ($format == SHORT);

  print "getComment: $comment $dpic\n" if $verbose;

  return $comment;
}

##############################################################
# getComments - returns an array containing all Comments
#              (if available) of the given pic (up to 64K per
#              block, nr of blocks is not limited, so this can
#              get pretty huge!)
##############################################################
sub getComments {
  my $dpic = shift;
  my $meta = shift; # optional, the Image::MetaData::JPEG object of $dpic if available
  $meta = getMetaData($dpic, "COM", 'FASTREADONLY') unless (defined($meta));

  my @coms = ();
  if ($meta) {
	@coms = $meta->get_comments();
	#print "getComments: $dpic:\n"; foreach (@coms) { print "  com: $_\n"; } print "\n";
	#foreach (@coms) {
	 # if (Encode::is_utf8($_)) {
	#	$_ = decode("utf8", $_);
	#	#print "getComments: decoded UTF8: $_\n";
	#  }
	#}
  }
  else {
	warn "*** getComments: no meta for $dpic available!" if ($verbose);
  }
  #foreach (@coms) { print "getComments: $_\n"; }

  return @coms;
}

##############################################################
# getShortEXIF - returns a string containing some of the
#                EXIF-Data (if available) of the given pic
#                if wrap is true the string is broken in
#                several lines (for thumbnail view)
##############################################################
sub getShortEXIF {

  my $dpic = shift;
  my $wrap = shift; # WRAP or NO_WRAP
  my $meta = shift; # optional

  my $exif = "";

  return $exif unless is_a_JPEG($dpic);

  $meta = getMetaData($dpic, 'APP1$', 'FASTREADONLY') unless (defined($meta));

  # add a symbol ([s]) to the exif column for each picture with saved EXIF data
  if (-f dirname($dpic)."/$exifdirname/".basename($dpic)) {
	$exif .= "[s] ";
  }

  return unless (defined($meta));

  my $er = $meta->get_Exif_data('ALL', 'TEXTUAL'); # er = exif hash ref todo: use IMAGE_DATA instead of ALL?
  unless (defined $er) {
	return $exif;
  }

  # Some cameras store settings in Maker Notes, so it is important to know
  # the make of the camera.
  my $make = "";
  if (defined $er->{'IFD0_DATA'}->{'Make'}) {
	$make =  ${$er->{'IFD0_DATA'}->{'Make'}}[0];
  }

  # check for thumbnail
  if (defined $er->{ROOT_DATA}->{ThumbnailData}) {
	$exif .= "[t] ";
  }

  my $datestr = "";
  $datestr    = getEXIFDate($dpic, $er);
  if ($datestr ne "") {
	if (my ($y, $M, $d, $h, $m, $s) = $datestr =~ m/(\d\d\d\d):(\d\d):(\d\d) (\d\d):(\d\d):(\d\d)/) {
	  #$exif   .= "$d.$M.$y $h:$m:$s ";  # german date format
	  #$exif   .= "$M/$d/$y $h:$m:$s ";   # american date format
	  $exif   .= "$y-$M-$d $h:$m:$s ";   # ISO 8601 date format
	  $exif   .= "\n" if $wrap;
    }
    else {
	  warn "picture has an unusual EXIF date: \"$datestr\" ($dpic)\n" if $config{MetadataWarn};
    }
  }

  if (defined $er->{'SUBIFD_DATA'}->{FocalLength}) {
	my $flength = int(calc($er->{'SUBIFD_DATA'}->{FocalLength}));
	$exif .= $flength."mm ";
  }
  if (defined $er->{'SUBIFD_DATA'}->{'FocalLengthIn35mmFilm'}) {
	$exif .= "(".join('', @{$er->{'SUBIFD_DATA'}->{'FocalLengthIn35mmFilm'}})."mm) ";
  }

  my $aperture = getEXIFAperture($dpic, STRING, $er);
  $exif   .= $aperture if ($aperture ne "0");

  my $exti   = getEXIFExposureTime($dpic, STRING, $er);
  $exif .= "$exti";

  if (defined $er->{'SUBIFD_DATA'}->{'ExposureBiasValue'}) {
	my $bias = calc($er->{'SUBIFD_DATA'}->{'ExposureBiasValue'});
	if (($bias eq "-") and $config{MetadataWarn}) {
      warn "unusal EXIF ExposureBiasValue (".$er->{'SUBIFD_DATA'}->{'ExposureBiasValue'}.") in picture $dpic\n";
    }
	$exif .= sprintf("+%1.1f ", $bias) if (($bias ne "-") and ($bias > 0));
	$exif .= sprintf( "%1.1f ", $bias) if (($bias ne "-") and ($bias < 0));
  }

  if (defined $er->{'SUBIFD_DATA'}->{'ISOSpeedRatings'}) {
	$exif .= "ISO".${$er->{'SUBIFD_DATA'}->{'ISOSpeedRatings'}}[0]." ";
  }
  else{ # Same as ISOSpeedRatings. Only Kodak's camera uses this tag instead of ISOSpeedRating
	if (defined $er->{'SUBIFD_DATA'}->{'ExposureIndex'}) {
	  my $iso = calc($er->{'SUBIFD_DATA'}->{'ExposureIndex'});
	  $exif .= "ISO$iso ";
	}
	else { # Nikon and Canon hide the ISO settings in the Makernotes
	  my $seg = $meta->retrieve_app1_Exif_segment();
	  if ($seg) {
		my $makernote = $seg->get_Exif_data('MAKERNOTE_DATA', 'TEXTUAL');
		if ($make =~ m/Canon/) {
		    if (exists $makernote->{'CameraSettings'}) {
			my $iso = $makernote->{'CameraSettings'}[16];
			if ($iso == 15) {
			    $exif .= "ISO-Auto ";
			} elsif (16 <= $iso && $iso <= 19) {
			    $exif .= "ISO".(50 * (1 << ($iso - 16)))." ";
			}
		    }
	        } elsif (exists $makernote->{'ISOSetting'}) {
		  my $iso = $makernote->{'ISOSetting'};
		  $exif .= "ISO$$iso[1] ";
		}
	  }
	}
  }
          # this part will repair Nikon D70 files (ISO info is just available in the Makernotes)
          # by setting the ISO value in the right EXIF tag (ISOSpeedRatings)
		  #if (($iso_value > 1) and ($iso_value < 30000)) {
			#print "adding ISO value $iso_value to $dpic\n";
			## the other $meta is read only
			#my $meta2= new Image::MetaData::JPEG($dpic, 'APP1$');
			#my $hash = $meta2->set_Exif_data({'ISOSpeedRatings' => $iso_value}, 'IMAGE_DATA', 'ADD');
			#if (%$hash) {
            #  print "ISO record rejected\n";
            #}
            #else {
            #  unless ($meta2->save()) {
	        #    print "Save ISO failed for $dpic\n";
            #  }
            #}

  $exif .= "\n" if $wrap;

  my $exposureStr = "";

  # Canon places specific exposure program in maker note.
  if ($make =~ m/Canon/) {
    my $seg = $meta->retrieve_app1_Exif_segment();
    if ($seg) {
      my $makernote = $seg->get_Exif_data('MAKERNOTE_DATA', 'TEXTUAL');
      if (exists $makernote->{'CameraSettings'}) {
	my %CanonExp = (
			0 => "Easy shooting",
			1 => "Program",
			2 => "Shutter priority",
			3 => "Aperture priority",
			4 => "Manual",
			5 => "Auto-DEP",
			6 => "DEP"
			);
	my %CanonEasy = (
			 0 => "Auto",
			 1 => "Manual",
			 2 => "Landscape",
			 3 => "Fast shutter",
			 4 => "Slow shutter",
			 5 => "Night",
			 6 => "B/W",
			 7 => "Sepia",
			 8 => "Portrait",
			 9 => "Sports",
			 10 => "Macro/Close-Up",
			 11 => "Pan focus"
			 );
	my $exp = $makernote->{'CameraSettings'}[20];
	if (defined $exp) {
	  $exposureStr = $CanonExp{$exp} if (defined $CanonExp{$exp});

	  if ($exp == 0) { # Find more specific "Easy shooting" mode
	    $exp = $makernote->{'CameraSettings'}[11];
	    $exposureStr = "\$" . $exp;
	    $exposureStr = $CanonEasy{$exp} if (defined $CanonEasy{$exp});
	  }
	}
  }
  }
  }

  if (($exposureStr eq "") && defined $er->{'SUBIFD_DATA'}->{'ExposureProgram'}) {
	my @ExposureProgram = ("Not defined",
						   "Manual",
						   "Program",
						   "Aperture priority",
						   "Shutter priority",
						   "Creative program",
						   "Action program",
						   "Portrait mode",
						   "Landscape mode");
	my $prog = ${$er->{'SUBIFD_DATA'}->{ExposureProgram}}[0];
	#print "$dpic: ".$ExposureProgram[$prog]; foreach (@{$er->{'SUBIFD_DATA'}->{ExposureProgram}}) { print " +Expo : $_"; } print "\n";

	$exposureStr = $ExposureProgram[$prog] if ($prog > 0);
  }

  if ($exposureStr eq "") {
        # some camera uses this tag instead of ExposureProgram
	if (defined $er->{'SUBIFD_DATA'}->{ExposureMode}) {
	  my @ExposureMode = ("Auto exposure",
						  "Manual exposure",
						  "Auto bracket");
	  my $mode = ${$er->{'SUBIFD_DATA'}->{ExposureMode}}[0];

	  $exposureStr = $ExposureMode[$mode] if ($mode >= 0);
	}
  }

  $exif .= $exposureStr." " if ($exposureStr ne "");

  if (defined $er->{'SUBIFD_DATA'}->{'Flash'}) {
	if (${$er->{'SUBIFD_DATA'}->{'Flash'}}[0] & 1) {
	  $exif .= "flash ";
	}
  }

  if ($config{ShowMoreEXIF}) { # show contrast sharpness saturation metering white balance
	my @automanual = ("Auto",
					  "Manual");
	my @saturation = ("Normal",
					  "Low",
					  "High");
	my @contrast = ("Normal",
					"Soft",
					"Hard");
	my @metering = ("unknown",
					"Average",
					"CenterWeightedAverage",
					"Spot",
					"MultiSpot",
					"Pattern",
					"Partial",
				    "Other");

	my $exifplus = "";

	if (defined $er->{'SUBIFD_DATA'}->{Contrast}) {
	  my $con = ${$er->{'SUBIFD_DATA'}->{Contrast}}[0];
	  $exifplus .= "Contrast: ".$contrast[$con]." " if ($con > 0);
	}
	if (defined $er->{'SUBIFD_DATA'}->{Sharpness}) {
	  my $sha = ${$er->{'SUBIFD_DATA'}->{Sharpness}}[0];
	  $exifplus .= "Sharpness: ".$contrast[$sha]." " if ($sha > 0);
	}
	if (defined $er->{'SUBIFD_DATA'}->{Saturation}) {
	  my $sat = ${$er->{'SUBIFD_DATA'}->{Saturation}}[0];
	  $exifplus .= "Saturation: ".$saturation[$sat]." " if ($sat > 0);
	}

	$exifplus = "\n$exifplus" if ($wrap and ($exifplus ne ""));

	if (defined $er->{'SUBIFD_DATA'}->{MeteringMode}) {
	  my $met = ${$er->{'SUBIFD_DATA'}->{MeteringMode}}[0];
	  $exifplus .= "\n" if $wrap;
      $met = 7 if ($met > 7);
	  $exifplus .= "Metering: ".$metering[$met]." " if ($met >= 0);
	}

	if ($verbose and (defined $er->{'SUBIFD_DATA'}->{'OwnerName'})) { print "*** Owner $dpic: ".join('', @{$er->{'SUBIFD_DATA'}->{'OwnerName'}})."\n"; }
	if ($verbose and (defined $er->{'SUBIFD_DATA'}->{'UserComment'})) { print "*** EXIF comment $dpic: -".join('', @{$er->{'SUBIFD_DATA'}->{'UserComment'}})."-\n"; }

	my $wbStr = ""; # white balance string

	# Canon places specific white balance in maker note.
	if ($make =~ m/Canon/) {
	    my $seg = $meta->retrieve_app1_Exif_segment();
	    if ($seg) {
		my $makernote = $seg->get_Exif_data('MAKERNOTE_DATA', 'TEXTUAL');
		if (exists $makernote->{'ShotInfo'}) {
		  my %CanonWB = (
				 0 => "Auto",
				 1 => "Daylight",
				 2 => "Cloudy",
				 3 => "Tungsten",
				 4 => "Fluorescent",
				 5 => "Flash",
				 6 => "Custom",
				 7 => "B/W",
				 8 => "Shade",
				 9 => "Manual Temperature",
				 14 => "FluorescentH"
				 );
		    my $wb = $makernote->{'ShotInfo'}[7];
		    $wbStr = $CanonWB{$wb} if exists $CanonWB{$wb};
		}
	    }
        }

	if (($wbStr eq "") && defined $er->{'SUBIFD_DATA'}->{WhiteBalance}) {
	  my $wb = ${$er->{'SUBIFD_DATA'}->{WhiteBalance}}[0];
	  $wbStr = $automanual[$wb] if ($wb >= 0);
	}

	if ($wbStr ne "") {
	  $exifplus .= "\n" if $wrap;
	  $exifplus .= "WB: $wbStr ";
	}

	#if (defined $er->{'SUBIFD_DATA'}->{'Orientation'}) {
	#  $exifplus .= "Orientation: ".$er->{'SUBIFD_DATA'}->{'Orientation'}." ";
	#}

	my $artist = getEXIFArtist($dpic, $er);
	$exifplus  .= "\nArtist: $artist" if ($artist ne "");

	if ($exifplus ne "") {
	  $exif .= "$exifplus" ;
	}

  }

  my $exmod  = getEXIFModel($dpic, $er);
  $exif  .= "\n$exmod" if ($exmod ne "");

  $exif =~ tr/\000/ /;  # remove null termination (\000) chars
  $exif =~ s/( )+/ /g;  # replace more than one space with one

  my $tmp = $exif;
  $tmp =~ s/\n//g;   # remove newlines
  $tmp =~ s/\s//g;   # remove whitespaces
  # if there are just newlines and spaces we return an empty string
  $exif = "" if ($tmp eq "");

  return $exif;
}

##############################################################
# getEXIFMeta
##############################################################
sub getEXIFMeta {
  my $dpic = shift;
  my $exif = '';

  return $exif unless is_a_JPEG($dpic);

  my $pic = basename($dpic);

  my $meta = getMetaData($dpic, 'APP1$', 'FASTREADONLY');
  my $hash_ref = $meta->get_Exif_data('ALL', "TEXTUAL");
  #if (defined $hash_ref->{APP1}->{ThumbnailData}) {
	#printf "[t] %s\n", basename($dpic);
  #}

  #return unless ($verbose);

  my $num =  $meta->retrieve_app1_Exif_segment(-1);
  print "getEXIFMeta: $pic has $num EXIF APP1 segments\n" if $verbose;
  my $ref =  $meta->retrieve_app1_Exif_segment();
  unless (defined $ref) {
	print "getEXIFMeta: $pic has no EXIF APP1 segments\n" if $verbose;
	return $exif;
  }

  while (my ($d, $h) = each %$hash_ref) {
	while (my ($t, $a) = each %$h) {
	  my $a2 = '';
	  foreach (@$a) {
        $_ =~ tr/ -~//cd; # remove all non-printable chars
		$a2 .= sprintf "%-5s", $_;
	  }
	  $a2    = cutString($a2, 30 , '..');
	  $exif .= sprintf "%-25s\t%-25s\t-> %-s\n", $d, $t, $a2;
	}
  }
  return $exif;
}

##############################################################
# calc - make a number from an array ref containing two numbers
#        input e.g. [28, 10] -> output: 2.8
##############################################################
sub calc {
  my $value = shift;

  if (@{$value} != 2) {
	warn "calc: no separator -> no values! or division by zero\n" if $config{MetadataWarn};
	return join("/", $value);
  }
  if ($$value[1] == 0) {
	if ($$value[0] == 0) {
	  return 0;
	}
	else {
	  warn "calc: division by zero" if $config{MetadataWarn};
	  return 0;
	}
  }
  return ($$value[0] / $$value[1]);  #return the calculated number
}

##############################################################
# displayEXIFData - displays all EXIF-Data in a window
##############################################################
sub displayEXIFData($) {

  my $lb = shift;
  my @sellist = $lb->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);
  return unless askSelection(\@sellist, 10, "EXIF info");

  my $selected = @sellist;

  my ($pic, $dpic, $i, $thumb);

  $userinfo = "displaying EXIF data of $selected pictures"; $userInfoL->update;

  my $pw = progressWinInit($lb, "Display EXIF data");
  $i = 0;
  foreach $dpic (@sellist) {
	last if progressWinCheck($pw);
	$i++;
	progressWinUpdate($pw, "Display EXIF data ($i/$selected) ...", $i, $selected);
	$pic      = basename($dpic);
	$thumb    = getThumbFileName($dpic);

	# check if file is a link and get the real target
	next if (!getRealFile(\$dpic));

	my $ii = getImageInfo($dpic);
	if ($ii eq "") {
	  $lb->messageBox(-icon => 'warning', -message => "There are no EXIF-Infos in $dpic!",
					   -title => "No EXIF infos", -type => 'OK');
	  next;
	}

	my $title = "EXIF info of $pic";

	my $exifs = getShortEXIF($dpic, NO_WRAP);
	my $exif  = "compact EXIF info:\n$exifs\n\n" if ($exifs ne "");
	$exif    .= "detailed EXIF info (from Image::Info):\n";

	foreach (sort { uc($a) cmp uc($b); } keys %{$ii}) {

	  next if (($_ eq "MakerNote") or ($_ eq "ColorComponentsDecoded") or ($_ =~ m/^App.*/));

	  if (ref($ii->{$_}) eq "ARRAY") {  # handle array entries
		$exif .= sprintf "%-25s ",$_;
		foreach (@{$ii->{$_}}) {
		  if (ref($_) eq "ARRAY") {	    # handle array in array entries
			foreach (@{$_}) {
			  $exif .= "$_, ";
			}
		  } elsif (ref($_) eq "HASH") {	# handle hash in array entries
			my %hash = %{$_};
			foreach (sort keys %hash) {
			  $exif .= "$_=".$hash{$_}.", ";
			}
		  } else {			# handle normal strings in array entries
			$exif .= "$_, ";
		  }
		}
		$exif =~ s/, $//;	# remove trailing comma and space
	  }

	  else {				# handle normal string entries
		$exif .= sprintf "%-25s %s",$_, $ii->{$_};
	  }
	  $exif .= "\n";
	}

	if ($config{EXIFshowApp}) {
	  foreach (sort { uc($a) cmp uc($b); } keys %{$ii}) {

		next unless (($_ eq "MakerNote") or ($_ eq "ColorComponentsDecoded") or ($_ =~ m/^App.*/));

		if (ref($ii->{$_}) eq "ARRAY") { # handle array entries
		  $exif .= sprintf "%-25s ",$_;
		  foreach (@{$ii->{$_}}) {
			if (ref($_) eq "ARRAY") { # handle array in array entries
			  foreach (@{$_}) {
				$exif .= "$_, ";
			  }
			} elsif (ref($_) eq "HASH") { # handle hash in array entries
			  my %hash = %{$_};
			  foreach (sort keys %hash) {
				$exif .= "$_=".$hash{$_}.", ";
			  }
			} else {			# handle normal strings in array entries
			  $exif .= "$_, ";
			}
		  }
		  $exif =~ s/, $//;		# remove trailing comma and space
		} else {				# handle normal string entries
		  my $part = sprintf "%-25s %s",$_, $ii->{$_};
		  $part =~ s/\n//g;
		  $exif .= $part;
		}
		$exif .= "\n";
	  }
	}

	$exif    .= "\ndetailed EXIF info (from Image::MetaData::JPEG):\n";
	$exif .= getEXIFMeta($dpic);

	$exif =~ tr/\n -~//cd; # remove non-printable characters (but not \n)

	showText($title, $exif, NO_WAIT, $thumb);
  }
  progressWinEnd($pw);
  $userinfo = "ready! ($i of $selected displayed)"; $userInfoL->update;
}

##############################################################
# removeEXIFData - remove all EXIF data in all selected pictures
##############################################################
sub removeEXIFData {

  my $mode = shift;
  if (!defined $mode) {
	warn "removeEXIFData: Missing a mode, should be thumb or all!";
	return;
  }
  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);
  my $selected = @sellist;
  my ($pic, $dpic, $i, $dirthumb, $text);

  if ($mode eq "all") {
	$text = "Remove all EXIF infos (picture and camera data and embedded thumbnail picture) of $selected selected pictures.";
  }
  elsif ($mode eq "thumb") {
	$text = "Remove the embedded EXIF thumbnails and other non-camera settings from the EXIF headers of $selected selected pictures.";
  }
  else {
	warn "removeEXIFData: Wrong mode ($mode), should be thumb or all!";
	return;
  }

  my $rc = $top->messageBox(-icon    => 'question',
							-message => "$text\nOk to continue?",
							-title => "Question",
							-type => 'OKCancel');
  return if ($rc !~ m/Ok/i);

  $userinfo = "removing EXIF data of $selected pictures"; $userInfoL->update;

  $i = 0;
  my $errors = "";
  my $pw = progressWinInit($top, "Remove EXIF data");
  foreach $dpic (@sellist) {
	last if progressWinCheck($pw);
	$i++;
	progressWinUpdate($pw, "Remove EXIF data ($i/$selected) ...", $i, $selected);
	$pic      = basename($dpic);
	$dirthumb = getThumbFileName($dpic);

	# check if file is a link and get the real target
	next if (!getRealFile(\$dpic));

	next if (!checkWriteable($dpic));

	next if (!removeEXIF($dpic, $mode, \$errors));

	# touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time
	touch($dirthumb);

	updateOneRow($dpic, $picLB);
	showImageInfo($dpic) if ($dpic eq $actpic);
  }
  progressWinEnd($pw);
  $userinfo = "ready! ($i of $selected infos removed)"; $userInfoL->update;
  showText("Errors while removing EXIF data", $errors, NO_WAIT) if ($errors ne "");
}

##############################################################
# removeEXIF
##############################################################
sub removeEXIF {
  my $dpic   = shift;
  my $mode   = shift;
  my $errors = shift; # reference

  my $meta = getMetaData($dpic, "APP1");
  unless ($meta) {
	$$errors .= "No EXIF data in $dpic\n";
	return 0;
  }

  if ($mode eq "all") {
	$meta->remove_app1_Exif_info(-1);
  } elsif ($mode eq "thumb") {
	my $nothumb = "";
	my $hash = $meta->set_Exif_data(\$nothumb, 'THUMBNAIL', 'REPLACE');
	$$errors .= "Thumbnail record rejected for $dpic\n" if (keys %$hash);
  } else {
	die;
  }

  unless ($meta->save()) {
	$$errors .= "Save failed $dpic\n";
	return 0;
  }

  return 1;
}

##############################################################
# getEXIFThumb - extract the embedded EXIF thumbnail
##############################################################
sub getEXIFThumb {

  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);
  my $selected = @sellist;

  my $rc = $top->messageBox(-icon    => 'question',
							-message => "Extract embedded EXIF thumbnails of $selected selected pictures and write them to a (new created) subfolder \"EXIFThumbs/\" in the current folder.\nShould I continue?",
							-title => "Question",
							-type => 'OKCancel');
  return if ($rc !~ m/Ok/i);

  $userinfo = "extracting embedded EXIF thumbnails of $selected pictures"; $userInfoL->update;

  if (!-d "$actdir/EXIFThumbs") {
	if ( !mkdir "$actdir/EXIFThumbs", 0755) {
	  warn "makedir: can not create $actdir/EXIFThumbs: $!";
	  return;
	}
  }

  my $i = 0;
  my $errors = "";
  my $pw = progressWinInit($top, "Extracting EXIF thumbnails");
  foreach my $dpic (@sellist) {
	last if progressWinCheck($pw);
	$i++;
	progressWinUpdate($pw, "Extracting EXIF thumbnail ($i/$selected) ...", $i, $selected);
	my $pic    = basename($dpic);
	my $dthumb = "$actdir/EXIFThumbs/$pic";

	next if (!getRealFile(\$dpic));

	extractThumb($dpic, $dthumb, \$errors);

  }
  progressWinEnd($pw);
  $userinfo = "ready! ($i of $selected thumbs extracted)"; $userInfoL->update;
  showText("Errors while saving EXIF thumbnail", $errors, NO_WAIT) if ($errors ne "");
}

##############################################################
# setEXIFDate - adjust the date and time field in the EXIF header
##############################################################
sub setEXIFDate {

  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);
  my $selected = @sellist;
  my ($pic, $dpic, $i, $dirthumb, $rc, $command);
  my $count = 0;
  if (!$config{setEXIFDateAskAgain}) {
	$rc = checkDialog("Change EXIF date/time?",
					  "Change the date and time info (EXIF: DateTimeOriginal) of $selected selected pictures. The previous information will be lost!\nShould I continue?",
					  \$config{setEXIFDateAskAgain},
					  "don't ask again",
					  "",
					  'OK', 'Cancel');
	return if ($rc ne 'OK');
  }

  my $datetime = $config{EXIFDateAbs};

  $rc = setEXIFDateDialog(\$datetime);
  return if ($rc ne 'OK');

  if (($config{EXIFAbsRel} eq "abs") and !($datetime =~ m/\d{4}:\d{2}:\d{2}-\d{2}:\d{2}:\d{2}/)) {
	$top->messageBox(-icon => 'warning',
					 -message => "Sorry, but $datetime has a wrong format!\nShould be: yyyy:mm:dd-hh:mm:ss Aborting.",
					 -title => 'Error', -type => 'OK');
	return;
  }

  $config{EXIFDateAbs} = $datetime if ($config{EXIFAbsRel} eq "abs");

  $userinfo = "changing the date and time of $selected pictures"; $userInfoL->update;

  $i = 0;
  my $errors = "";
  my $pw = progressWinInit($top, "Changing EXIF date and time");
  foreach $dpic (@sellist) {
	last if progressWinCheck($pw);
	$i++;
	progressWinUpdate($pw, "Changing EXIF date and time ($i/$selected) ...", $i, $selected);
	$pic      = basename($dpic);
	$dirthumb = getThumbFileName($dpic);

	# check if file is a link and get the real target
	next if (!getRealFile(\$dpic));
	next if (!checkWriteable($dpic));

	if ($config{EXIFAbsRel} eq "abs") {
	  # nothing to do, we just use $datetime
	  $datetime =~ s/-/ /; # replace just the "-" with a space between date and time
	} elsif ($config{EXIFAbsRel} eq "rel") {
      my $exif = getEXIFDate($dpic);
	  if (defined($exif) and ($exif =~ m/(\d\d\d\d):(\d\d):(\d\d)\s(\d\d):(\d\d):(\d\d)/)) {
		my $mon  = $2;
		my $year = $1;
		$mon--;
		$year -= 1900;
		if ($mon >= 0 and $mon <= 11) {
		  # calculate the time as value in seconds since the Epoch (Midnight, January 1, 1970)
		  my $ctime = timelocal($6,$5,$4,$3,$mon,$year);
		  my $hours   = $config{EXIFyears} * 365 * 24 + $config{EXIFdays} * 24 + $config{EXIFhours};
		  my $seconds = $hours * 60 * 60 + $config{EXIFmin} * 60 + $config{EXIFsec};
		  if ($config{EXIFPlusMin} eq "+") {
			$ctime = $ctime + $seconds;
		  } else {
			$ctime = $ctime - $seconds;
		  }
		  my ($s,$m,$h,$d,$mo,$y) = localtime $ctime;
		  $y += 1900; $mo++;	# do some adjustments
		  # build up the date time string, similar to the EXIF format
		  $datetime = sprintf "%04d:%02d:%02d %02d:%02d:%02d", $y, $mo, $d, $h, $m, $s;
		} else {
		  $errors .= "Wrong month in EXIF date in $dpic\n";
		}
	  } else {
		$errors .= "No EXIF date in $dpic\n";
	  }
	} else {
	  warn "setEXIFDate: wrong value: ", $config{EXIFAbsRel};
	  return 0;
	}

	print "set EXIF datetime: $datetime to $dpic\n" if $verbose;

	my $meta = getMetaData($dpic, 'APP1$');
	unless (defined $meta) {
	  $errors .= "No meta available: $dpic\n";
	  next;
	}

	#date time format: 2007:04:04 11:12:13
	my $hash = $meta->set_Exif_data({'DateTime'          => $datetime,
                                     'DateTimeOriginal'  => $datetime,
                                     'DateTimeDigitized' => $datetime}, 'IMAGE_DATA', 'ADD');
	if (keys %$hash) {
	  $errors .= "DateTime record rejeced: $dpic\n";
	  next;
	}

	unless ($meta->save()) {
	  $errors .= "Save failed $dpic\n";
	  next;
	}

	$count++;
	# touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time
	touch($dirthumb);

	updateOneRow($dpic, $picLB);
	showImageInfo($dpic) if ($dpic eq $actpic);
  }
  progressWinEnd($pw);
  $userinfo = "ready! ($i/$selected)"; $userInfoL->update;
  showText("Errors while adjusting EXIF date", $errors, NO_WAIT) if ($errors ne "");
}

##############################################################
# remap_abs_rel
##############################################################
sub remap_abs_rel {
  my $tf = shift;
  my $af = shift;
  my $rf = shift;
  
  if ($config{EXIFAbsRel} eq 'abs') {
    $rf->packForget if ($rf->ismapped);
    $af->pack(-in => $tf, -fill => 'both', -padx => 3, -pady => 3) unless ($af->ismapped);
  }
  else {
    $af->packForget if ($af->ismapped);
    $rf->pack(-in => $tf, -fill => 'both', -padx => 3, -pady => 3) unless ($rf->ismapped);
  }
}

##############################################################
# setEXIFDateDialog - get the date/time info from the user
#                     returns 'OK' or 'Cancel'
##############################################################
sub setEXIFDateDialog {

  my $datetime  = shift; # var ref date time string (absolute)

  my $rc = 'Cancel';

  # open window
  my $dtw = $top->Toplevel();
  $dtw->title('Set EXIF date and time');
  $dtw->iconimage($mapiviicon) if $mapiviicon;

  $dtw->Label(-text => "You may set the date and time to an absolute or relative value",
			-bg => $config{ColorBG},
		   )->pack(-anchor => 'w');


  # frame for the absolute/relative radio buttons
  my $arf = $dtw->Frame(-bd => 1, -relief => 'raised')->pack(-fill => 'both', -padx => 3, -pady => 3);
  # frame for the time/date adjustment
  my $tf  = $dtw->Frame(-bd => 1, -relief => 'raised')->pack(-fill => 'both', -padx => 3, -pady => 3);
  my $af  = $tf->Frame();
  my $rf  = $tf->Frame();
  $arf->Radiobutton(-text => "use absolute value", -variable => \$config{EXIFAbsRel}, -value => 'abs', -command => sub { remap_abs_rel($tf, $af, $rf); })->pack(-anchor => 'w', -side => "left");

  $arf->Radiobutton(-text => "use relative value", -variable => \$config{EXIFAbsRel}, -value => 'rel', -command => sub {remap_abs_rel($tf, $af, $rf); })->pack(-anchor => 'w', -side => "left");

  remap_abs_rel($tf, $af, $rf);

  ######### absolute


  $af->Label(-text => "Please enter the new date and time to store\nin the selected pictures\n(please use the format: yyyy:mm:dd-hh:mm:ss\nexample: 2008:05:21-11:07:59)",
			-bg => $config{ColorBG}, -justify => "left")->pack(-anchor => 'w');

  my $entry = $af->Entry(-textvariable => \$$datetime,
						 -width => 40,
						)->pack(-fill => 'x', -padx => 3, -pady => 3);

  # todo that's not enough to switch when focusIn
  #$entry->bind('<FocusIn>', sub { $config{EXIFAbsRel} = "abs"; $af->update(); } );

  $entry->selectionRange(0,'end');      # select all
  $entry->icursor('end');
  $entry->xview('end');

  ######### relative


  $rf->Radiobutton(-text => "+ (add time)", -variable => \$config{EXIFPlusMin}, -value => "+")->pack(-anchor => 'w');
  $rf->Radiobutton(-text => "- (subtract time)", -variable => \$config{EXIFPlusMin}, -value => "-", -command => sub {$config{EXIFAbsRel} = "rel"})->pack(-anchor => 'w');

  labeledScale($rf, 'top', 8, "years",   \$config{EXIFyears}, 0, 100, 1);
  labeledScale($rf, 'top', 8, "days",    \$config{EXIFdays},  0, 365, 1);
  labeledScale($rf, 'top', 8, "hours",   \$config{EXIFhours}, 0,  24, 1);
  labeledScale($rf, 'top', 8, "minutes", \$config{EXIFmin},   0,  59, 1);
  labeledScale($rf, 'top', 8, "seconds", \$config{EXIFsec},   0,  59, 1);

  my $OKB;
  $entry->bind('<Return>', sub { $OKB->invoke; } );
  $entry->focus;

  my $ButF = $dtw->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);

  $OKB = $ButF->Button(-text => 'OK',
					   -command => sub {
						 $rc = 'OK';
						 $dtw->destroy();
					   })->pack(-side => 'left', -expand => 1, -fill => 'x',
								-padx => 3, -pady => 3);

  my $XBut = $ButF->Button(-text => 'Cancel',
						   -command => sub {
							 $rc = 'Cancel';
							 $dtw->destroy();
						   }
						  )->pack(-side => 'left', -expand => 1, -fill => 'x',
								  -padx => 3, -pady => 3);

  $dtw->bind('<Key-Escape>', sub { $XBut->invoke; });
  $dtw->Popup;
  $dtw->waitWindow();
  return $rc;
}

##############################################################
# showEXIFThumb - displays the embedded EXIF thumbnail
##############################################################
sub showEXIFThumb {

  my $noThumbIn = "";

  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);
  return unless askSelection(\@sellist, 10, "EXIF thumbnail");

  if (!-d $trashdir) { # we need the trash dir for the temp files
	$top->messageBox(-icon => 'warning', -message => "Trash folder $trashdir not found!\nPlease create this folder (shell: mkdir $trashdir) and retry.\n\nAborting.",
					 -title => "No trash folder", -type => 'OK');
	return;
  }

  my $pw = progressWinInit($top, "Show EXIF thumbnail");
  my $i = 0;
  foreach my $dpic (@sellist) {
	last if progressWinCheck($pw);
	$i++;
	progressWinUpdate($pw, "Show EXIF thumbnail ($i/".scalar @sellist.") ...", $i, scalar @sellist);
	my $pic       = basename($dpic);
	my $exifthumb = "$trashdir/EXIFthumb-$pic";

	if (-f $exifthumb) {
	  $top->messageBox(-icon => 'warning', -message => "There is something wrong, $exifthumb already exists.\nPlease delete it first.\nSkipping!",
					   -title => 'Warning', -type => 'OK');
	  next;
	}

	my $errors = "";
	extractThumb($dpic, $exifthumb, \$errors);

	if (!-f $exifthumb) {
	  $noThumbIn .= "$pic\n";
	  next;
	}

	showPicInOwnWin($exifthumb); # show the thumb

	# remove the thumb
	removeFile($exifthumb);
  }
  progressWinEnd($pw);
  showText("No EXIF thumbnail",
		   "Sorry, there seems to be no embedded EXIF thumbnail in the following pictures:\n\n$noThumbIn"
		   ,NO_WAIT) if ($noThumbIn ne "");
  $userinfo = "ready! ($i of ".scalar @sellist." thumbs)"; $userInfoL->update;
}

##############################################################
# copyEXIFData - copy the EXIF infos from one picture to others
##############################################################
sub copyEXIFData {

  my $direction = shift;
  if (!defined $direction) {
	warn "copyEXIFData: Missing a direction, should be from or to!";
	return;
  }

  #return if (!checkExternProgs("copyEXIFData", "jhead"));

  my @sellist  = $picLB->info('selection');
  my $selected = @sellist;
  my ($pic, $dpic, $i, $dirthumb);
  my $errors = "";

  if ($direction eq "from") {	# set the copy source
	if (@sellist != 1) {
	  $top->messageBox(-icon => 'warning', -message => "Please select exactly one picture (the picture from which the EXIF info should be taken) for this function!",
					   -title => 'Error', -type => 'OK');
	  return;
	}
	$copyEXIFDataSource = $sellist[0]; # save source pic to global variable
	$userinfo = "copy source set to ".basename($copyEXIFDataSource); $top->update;
	return;						# that's all for now ;-)
  }

  elsif ($direction eq "to") {

	return unless checkSelection($top, 1, 0, \@sellist);
	if ((!defined $copyEXIFDataSource) or (!-f $copyEXIFDataSource)) {
	  $top->messageBox(-icon => 'warning', -message => "Please select a source picture (the picture from which the EXIF info should be taken) first, and than choose EXIF info->copy from!",
					   -title => 'Error', -type => 'OK');
	  return;
	}

	my $exif      = getShortEXIF($copyEXIFDataSource, WRAP);
	my $EXIFthumb = "";  # temp file holding the embedded EXIF thumbnail

	$EXIFthumb = "$configdir/".basename($copyEXIFDataSource);
	extractThumb($copyEXIFDataSource, $EXIFthumb, \$errors);

	my $message = "Copy the EXIF infos:\
-------------\
$exif\
-------------\
and the embedded thumbnail from\
\"".basename($copyEXIFDataSource)."\"\
to $selected selected pictures.\
The original EXIF infos and thumbnails of these pictures will be lost!\
Ok to continue?";

	my $rc = myButtonDialog("Copy EXIF data", "$message", $EXIFthumb, 'OK', 'Cancel');

	removeFile($EXIFthumb); # remove temp thumbnail file

	return if ($rc ne 'OK');

	$userinfo = "transfering EXIF infos to $selected pictures"; $userInfoL->update;

	$i = 0;
	my $pw = progressWinInit($picLB, "Copy EXIF data");
	foreach $dpic (@sellist) {
	  last if progressWinCheck($pw);
	  $i++;
	  progressWinUpdate($pw, "transfering EXIF info ($i/$selected) ...", $i, $selected);
	  $pic      = basename($dpic);
	  $dirthumb = getThumbFileName($dpic);

	  # check if file is a link and get the real target
	  next if (!getRealFile(\$dpic));
	  next if (!checkWriteable($dpic));

	  my $rc = copyEXIF( $copyEXIFDataSource, $dpic);
	  $errors .= "$rc\n" if ($rc ne "1");

	  updateOneRow($dpic, $picLB);
	  showImageInfo($dpic) if ($dpic eq $actpic);

	  # touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time
	  touch($dirthumb);
	}
	progressWinEnd($pw);

  } else {
	warn "copyEXIFData: Wrong direction ($direction), should be from or to!";
	return;
  }

  $userinfo = "ready! ($i/$selected copied)"; $userInfoL->update;
  showText("Errors while copying EXIF infos", $errors, NO_WAIT) if ($errors ne "");
}

##############################################################
# copyEXIF
##############################################################
sub copyEXIF {
  my $from = shift;
  my $to   = shift;
  if (!-f $from) {
	warn "copyEXIF: file $from does not exists!\n";
	return;
  }
  if (!-f $to) {
	warn "copyEXIF: file $to does not exists!\n";
	return;
  }

  # from file
  my $meta = getMetaData($from, '^APP1$', 'FASTREADONLY');
  return "Could not get EXIF info of source $from!" unless (defined $meta);

  # to file
  my $meta2 = getMetaData($to, '^APP1$');
  return "Could not get EXIF info of target $to!" unless (defined $meta2);

  # find the EXIF segment
  my $seg = extract_app1_Exif_segment($meta);
  return "Could not get EXIF segment of source $from!" unless (defined $seg);

  # insert the segment and save the picture
  insert_app1_Exif_segment($meta2, $seg);
  my $result  = $meta2->save();
  return "save failed for $to" unless ($result);

  return 1;
}

##############################################################
# extract_app1_Exif_segment - sub supplied from Stefano Bettelli
##############################################################
sub extract_app1_Exif_segment {
    my ($this) = @_;
    my $segment = $this->retrieve_app1_Exif_segment();
    return undef unless $segment;
    # this removes the segment from the picture (in memory)
    # you could skip this if the picture is no more used
    @{$this->{segments}} = grep { $_ != $segment } @{$this->{segments}};
    # this unlinks the picture from the segment, orphaning it
    $segment->{parent} = undef;
    return $segment;
}

##############################################################
# insert_app1_Exif_segment - sub supplied from Stefano Bettelli
##############################################################
sub insert_app1_Exif_segment {
    my ($this, $segment) = @_;
    # this locates or produces an Exif segment
    my $old = $this->provide_app1_Exif_segment();
    for (@{$this->{segments}}) {
	  # looking for the segment to replace ...
	  next unless $_ == $old;
	  # tell the segment it now belongs to the picture
	  $segment->{parent} = $this;
	  # tell the picture it now owns the segment
	  $_ = $segment;
	  last;
	}
}

##############################################################
# restoreComments - remove existing comments and store the
#                   given list of comments
##############################################################
sub restoreComments {
  my $dpic     = shift;
  my @comments = @_;
  my $meta = getMetaData($dpic, "COM");
  if ($meta) {
	# remove all existing comments, we want to restore exactly
	$meta->remove_all_comments();

	# write the old comments back
	if (@comments) {
	  foreach (@comments) {
		$meta->add_comment($_);
	  }
	}
	unless ($meta->save()) {
	  warn "restoreComments: save $dpic failed!";
	}
  }
}

##############################################################
# EXIFsave - make a new subdir .exif, copy the thumbnail of
#            the selected pics to this dir, copy the EXIF
#            info from the original pics to the thumbs
##############################################################
sub EXIFsave {

  my @sellist  = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);

  # make EXIF subdir
  return if (!makeDir("$actdir/$exifdirname", ASK));

  my ($pic, $dpic, $i, $exiffile);

  my $errors = "";
  $i = 0;
  my $pw = progressWinInit($top, "Save EXIF infos");
  foreach $dpic (@sellist) {
	last if progressWinCheck($pw);
	$i++;
	progressWinUpdate($pw, "Saving EXIF info ($i/".scalar @sellist.") ...", $i, scalar @sellist);
	$pic      = basename($dpic);
	$exiffile = "$actdir/$exifdirname/$pic";

	# check if file is a link and get the real target
	next if (!getRealFile(\$dpic));

	my $meta = getMetaData($dpic, '^APP1$', 'FASTREADONLY');
    unless (defined $meta) {
      $errors .= "Could not get EXIF info of $pic!\n";
      next;
    }

    my $seg = extract_app1_Exif_segment($meta);
    unless (defined $seg) {
      $errors .= "Could not get EXIF segment of $pic!\n";
      next;
    }

	unless (nstore($seg, $exiffile)) {
	  $errors .= "could not store EXIF segment in file $exiffile: $!\n";
	  next;
	}

	updateOneRow($dpic, $picLB); # display the new exif info (flag [s] is now set)
	showImageInfo($dpic) if ($dpic eq $actpic);
  }

  progressWinEnd($pw);
  $userinfo = "ready! ($i/".scalar @sellist." saved)"; $userInfoL->update;
  showText("Errors while saving EXIF infos", $errors, NO_WAIT) if ($errors ne "");
}

##############################################################
# EXIFrestore - copy the saved EXIF info back to the selected
#               pics
##############################################################
sub EXIFrestore {

  my @sellist  = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);

  if (!-d "$actdir/$exifdirname") {
	  $top->messageBox(-icon => 'warning', -message => "Found no saved EXIF infos in this folder!",
					   -title => "No EXIF infos", -type => 'OK');
	  return;
	}

  # message for one picture
  my $message = "Restore saved EXIF infos to ".basename($sellist[0]).".\nThe actual EXIF infos of this picture will be lost!\nOk to continue?";
  # message for more than one picture
  if (@sellist > 1) {
	$message = "Restore saved EXIF infos\nto the ".scalar @sellist." pictures.\nThe actual EXIF infos of this picture will be lost!\nOk to continue?"
  }
  return if (myButtonDialog("Restore EXIF data", "$message", undef, 'OK', 'Cancel') ne 'OK');

  my $errors = "";
  my $i      = 0;
  my $pw     = progressWinInit($top, "Restore EXIF info");

  foreach my $dpic (@sellist) {
	last if progressWinCheck($pw);
	$i++;
	progressWinUpdate($pw, "Restore EXIF info ($i/".scalar @sellist.") ...", $i, scalar @sellist);
	my $pic       = basename($dpic);
	my $dirthumb  = getThumbFileName($dpic);
	my $exiffile = "$actdir/$exifdirname/$pic";

	unless (-f $exiffile) {
	  $errors .= "Found no saved EXIF infos for $dpic!\n";
	  next;
	}

	# check if file is a link and get the real target
	next if (!getRealFile(\$dpic));
	next if (!checkWriteable($dpic));

    my $meta = getMetaData($dpic, '^APP1$');
	unless (defined $meta) {
	  $errors .= "Could not get EXIF info of $dpic!\n";
	  next;
	}

    # load stored EXIF segment from the file
	my $exif = retrieve($exiffile);
	unless (defined $exif) {
	  $errors .= "could not retrieve saved EXIF info\n";
	  next;
	}

    insert_app1_Exif_segment($meta, $exif);

	unless ($meta->save()) {
	  $errors .= "save failed for $dpic\n";
	  next;
	}

	updateOneRow($dpic, $picLB);
	showImageInfo($dpic) if ($dpic eq $actpic);

	# touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time
	touch($dirthumb);
  }
  progressWinEnd($pw);
  $userinfo = "ready! ($i/".scalar @sellist."restored)"; $userInfoL->update;
  showText("Errors while restoring EXIF data", $errors, NO_WAIT) if ($errors ne "");
}

##############################################################
# EXIFremoveSaved - remove the saved exif info file
##############################################################
sub EXIFremoveSaved {

  my @sellist  = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);

  if (!-d "$actdir/$exifdirname") {
	  $top->messageBox(-icon => 'warning', -message => "Sorry, but there are no saved EXIF infos in this folder!",
					   -title => "no EXIF infos", -type => 'OK');
	  return;
	}

  my $rc = $top->messageBox(-icon => 'warning', -message => "Remove the saved EXIF infos and the embedded thumbnails of ".scalar @sellist." pictures.\nOk to continue?",
					 -title => "Warning", -type => 'OKCancel');
  return if ($rc !~ m/Ok/i);

  my ($pic, $dpic, $i, $exifthumb);

  $i = 0;
  my $pw = progressWinInit($top, "Remove saved EXIF infos");
  foreach $dpic (@sellist) {
	last if progressWinCheck($pw);
	$i++;
	progressWinUpdate($pw, "Removing saved EXIF info ($i/".scalar @sellist.") ...", $i, scalar @sellist);
	$pic       = basename($dpic);
	$exifthumb = "$actdir/$exifdirname/$pic";

	if ((!-f $exifthumb) and (@sellist == 1)) { # show this info only when removing from one file
	  $top->messageBox(-icon => 'warning', -message => "Sorry, but there are no saved EXIF infos for $pic!",
					   -title => "no EXIF infos", -type => 'OK');
	  next;
	}

	# check if file is a link and get the real target
	next if (!getRealFile(\$dpic));

	# remove the saved EXIF info file
	removeFile($exifthumb );

	updateOneRow($dpic, $picLB);
	showImageInfo($dpic) if ($dpic eq $actpic);
  }
  progressWinEnd($pw);
  $userinfo = "ready! ($i/".scalar @sellist." exif removed)"; $userInfoL->update;
}

##############################################################
# copyComment - copy the comment from one picture to others
##############################################################
sub copyComment {

  my $direction = shift;
  if (!defined $direction) {
	warn "copyComment: Missing a direction, should be from or to!";
	return;
  }

  my @sellist  = $picLB->info('selection');
  my $selected = @sellist;
  my ($pic, $dpic, $i, $dirthumb);

  if ($direction eq "from") {	# set the copy source
	if (@sellist != 1) {
	  $top->messageBox(-icon => 'warning', -message => "Please select exactly one picture (the picture from which comments should be taken) for this function!",
					   -title => 'Error', -type => 'OK');
	  return;
	}

	$copyCommentSource = $sellist[0]; # save source pic to global variable
	$userinfo = "copy source set to ".basename($copyCommentSource); $top->update;
	return;						# that's all for now ;-)
  }

  elsif ($direction eq "to") {

	return unless checkSelection($top, 1, 0, \@sellist);
	if ((!defined $copyCommentSource) or (!-f $copyCommentSource)) {
	  $top->messageBox(-icon => 'warning', -message => "Please select a source picture (the picture from which the EXIF info should be taken) first, and than choose EXIF info->copy from!",
					   -title => 'Error', -type => 'OK');
	  return;
	}

	my $com   = getComment($copyCommentSource, SHORT);
	my $thumb = getThumbFileName($copyCommentSource);

	my $message = "Copy the comments:\
-------------\
$com\
-------------\
from\
\"".basename($copyCommentSource)."\"\
to $selected selected pictures.\
The original comments won't be lost!\
Ok to continue?";

	my $rc = myButtonDialog("Copy comments", "$message", $thumb, 'OK', 'Cancel');

	return if ($rc ne 'OK');

	$userinfo = "transfering comments to $selected pictures"; $userInfoL->update;

	my $pw = progressWinInit($top, "Transfer comments");
	$i = 0;
	foreach $dpic (@sellist) {
	  last if progressWinCheck($pw);
	  $i++;
	  progressWinUpdate($pw, "transfering comments ($i/$selected) ...", $i, $selected);
	  $dirthumb = getThumbFileName($dpic);

	  next if (!checkWriteable($dpic));

	  # check if file is a link and get the real target
	  next if (!getRealFile(\$dpic));

	  my @comments = getComments($copyCommentSource);

	  my $meta = getMetaData($dpic, "COM");
	  next unless ($meta);

	  # add the comments
	  foreach (@comments) {
		$meta->add_comment($_);
	  }
	  unless ($meta->save()) { warn "copyComment: save $dpic failed!"; }

	  updateOneRow($dpic, $picLB);

	  # touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time
	  touch($dirthumb);
	} # foreach end
	progressWinEnd($pw);

  } else {
	warn "copyComment: Wrong direction ($direction), should be from or to!";
	return;
  }

  $userinfo = "ready! ($i of $selected copied)"; $userInfoL->update;
}

##############################################################
# displayIPTCData - displays all IPTC-Data in a window
##############################################################
sub displayIPTCData {

  my $lb = shift;
  my @sellist = $lb->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);
  return unless askSelection(\@sellist, 10, "IPTC info");

  my ($pic, $dpic, $iptc, $title, $thumb);

  my $i = 0;
  my $pw = progressWinInit($lb, "Display IPTC data");
  foreach $dpic (@sellist) {
	last if progressWinCheck($pw);
	$i++;
	$iptc = "";
	progressWinUpdate($pw, "displaying IPTC data ($i/".scalar @sellist.") ...", $i, scalar @sellist);
	$pic      = basename($dpic);
	$thumb    = getThumbFileName($dpic);

	# check if file is a link and get the real target
	next if (!getRealFile(\$dpic));

	$title = "IPTC/IIM info of $pic";

	$iptc = getIPTC($dpic, LONG);

	if ($iptc eq '') {
	  $iptc = "Found no IPTC/IIM info in \"$pic\"\n";
	}

	showText($title, $iptc, NO_WAIT, $thumb);
  }
  progressWinEnd($pw);
  if ($lb == $picLB) {
	$userinfo = "ready! ($i/".scalar @sellist." IPTC displayed)";
	$userInfoL->update;
  }
}

##############################################################
# saveIPTC - save IPTC info hash as template to a file
##############################################################
sub saveIPTC {

  my @sellist = $picLB->info('selection');
  if (@sellist != 1) {
	  $top->messageBox(-icon => 'warning', -message => "Please select exactly one picture.",
					   -title => "Save IPTC info", -type => 'OK');
	  return;
  }

  my $dpic = $sellist[0];

  my $meta = getMetaData($dpic, 'APP13');
  my $iptc = $meta->get_app13_data('TEXTUAL', 'IPTC');

  unless (defined $iptc) {
	$top->messageBox(-icon => 'warning', -message => "There is no IPTC info in $dpic!",
					 -title => "Save IPTC info", -type => 'OK');
	return;
  }

  if (!-d $iptcdir) {
	if ( !mkdir $iptcdir, 0755 ) {
	  $top->messageBox(-icon => 'warning', -message => "Error making IPTC template folder $iptcdir: $!",
					   -title => "Save IPTC template", -type => 'OK');
	  return;
	}
  }

  my $fileSelect = $top->FileSelect(-title => "Set file name (please use the .iptc2 suffix)",
									-initialfile => "template.iptc2",
									-create => 1,
									-directory => $iptcdir,
									-width => 30, -height => 30);
  my $file = $fileSelect->Show;

  return unless (defined $file);
  return if ($file eq '');

  if (-f $file) {
	my $rc = $top->messageBox(-icon => 'warning',
							  -message => "file $file exist. Ok to overwrite?",
							  -title => "Save IPTC info", -type => 'OKCancel');
	return if ($rc !~ m/Ok/i);
  }

  my $rc = nstore($iptc, $file) or warn "could not store IPTC in file $file: $!";

  $userinfo = "IPTC template saved ($rc)"; $userInfoL->update;

}

##############################################################
# copyFromIPTC - 
##############################################################
sub copyIPTC {

  my @sellist = $picLB->info('selection');
  if (@sellist != 1) {
	  $top->messageBox(-icon => 'warning', -message => "Please select exactly one picture.",
					   -title => "Copy IPTC info", -type => 'OK');
	  return;
  }

  my $dpic = $sellist[0];

  my $meta = getMetaData($dpic, 'APP13');
  $iptcCopy = $meta->get_app13_data('TEXTUAL', 'IPTC');

  unless (defined $iptcCopy) {
	$top->messageBox(-icon => 'warning', -message => "There is no IPTC info in $dpic!",
					 -title => "Copy IPTC info", -type => 'OK');
	return;
  }

  $userinfo = "IPTC copy ready"; $userInfoL->update;

}

##############################################################
# pasteIPTC -
##############################################################
sub pasteIPTC {

  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);

  applyIPTC($picLB, $iptcCopy, \@sellist);
}

##############################################################
# mergeIPTC - merge a IPTC info hash template to a file
##############################################################
sub mergeIPTC {

  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);

  my $file = $top->FileSelect(-title => "Open IPTC template",
							  -directory => $iptcdir,
							  -width => 30, -height => 30)->Show;
  return unless (defined $file);
  return if ($file eq "");
  return unless (-f $file);

  my $iptc = retrieve($file);
  unless (defined $iptc) {
	warn "could not retrieve $file";
	return;
  }

  applyIPTC($picLB, $iptc, \@sellist);
}

##############################################################
# applyIPTC - apply a IPTC info hash to a list of pics
##############################################################
sub applyIPTC {
  my $lb      = shift; # reference to listbox widget
  my $iptc    = shift; # reference to an IPTC hash as provided by Image::MetaData::JPEG
  my $piclist = shift; # picture list reference

  my $errors = '';

  my $pw = 0;
  $pw = progressWinInit($lb, 'Apply IPTC template') if (@$piclist > 1);
  my $i = 0;
  foreach my $dpic (@$piclist) {
	last if ($pw and progressWinCheck($pw));
	$i++;
	progressWinUpdate($pw, "applying IPTC template ($i/".scalar @$piclist.") ...", $i, scalar @$piclist) if $pw;

	next if (!checkWriteable($dpic));

	my $meta = getMetaData($dpic, 'APP13');

	unless (defined $meta) {
	  $errors .= "could not create IPTC info for $dpic!";
	  next;
	}

	# todo, we could also use UPDATE or REPLACE here
	$meta->set_app13_data($iptc, 'ADD', 'IPTC');

	# make the SupplementalCategories and Keywords unique and sorted
	uniqueIPTC($meta);

	if ($meta->save()) {
		my $dirthumb = getThumbFileName($dpic);
		# touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time
		touch($dirthumb);
		updateOneRow($dpic, $lb);
        showImageInfoCanvas($dpic) if ($dpic eq $actpic);
	}
	else {
		$errors .= "save failed for $dpic\n";
	}
  }
  progressWinEnd($pw) if $pw;
  $userinfo = "ready! ($i of ".scalar @$piclist." processed)"; $userInfoL->update;

  showText('Errors while applying IPTC infos', $errors, NO_WAIT) if ($errors ne '');
}

##############################################################
# uniqueArray
##############################################################
sub uniqueArray {
	my $listR = shift;
	my %d;   # build a hash
	foreach (@{$listR}) { $d{$_} = 1; }
	@{$listR} = (sort { uc($a) cmp uc($b); } keys %d);
}

##############################################################
# uniqueIPTC - remove double entries from SupplementalCategories
#              and Keywords and sort them alphabetically
#              !Function will not save IPTC!
##############################################################
sub uniqueIPTC {
	my $meta = shift;
	my $iptc = $meta->get_app13_data('TEXTUAL', 'IPTC');
	
	# todo - doesn't work
        # replace (german) umlaute by corresponding letters
	#${$iptc->{Caption}}[0] =~ s/([$umlaute])/$umlaute{$1}/g if ($config{ConvertUmlaut});

        # replace all non-printable chars, but not newline etc.
        ${$iptc->{Caption}}[0] =~ tr/\n\t\r\f -~//cd if (${$iptc->{Caption}}[0]);

	my %d;   # build a hash
	foreach (@{$iptc->{SupplementalCategory}}) {
	  $_ =~ tr/ -~//cd; # replace all non-printable chars
	  $d{$_} = 1;
	}
	@{$iptc->{SupplementalCategory}} = (sort { uc($a) cmp uc($b); } keys %d);

	%d = (); # completely empty %d
	foreach (@{$iptc->{Keywords}}) {
	  $_ =~ tr/ -~//cd; # replace all non-printable chars (Picasa adds one to each keyword)
	  $d{$_} = 1;
	}
	@{$iptc->{Keywords}} = (sort { uc($a) cmp uc($b); } keys %d);

	$meta->set_app13_data($iptc, 'REPLACE', 'IPTC');
}

##############################################################
# editIPTCCategories
##############################################################
sub editIPTCCategories {

  my $lb = shift;
  if (Exists($catw)) {
	$catw->deiconify;
	$catw->raise;
	$catw->focus;
	return;
  }

  # open window
  $catw = $lb->Toplevel();
  $catw->withdraw;
  $catw->title('Categories');
  $catw->iconimage($mapiviicon) if $mapiviicon;

  my $cattree;

  my $XBut = $catw->Button(-text => "Close",
						   -command => sub {
							   saveTreeMode($cattree);
							   nstore($cattree->{m_mode}, "$configdir/categoryMode") or warn "could not store $configdir/categoryMode: $!";
							   $catw->destroy;
						   })->pack(-expand => 0,-fill => 'x',-padx => 1,-pady => 1);

  my $af = $catw->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
  $af->Radiobutton(-text => "all",  -variable => \$config{CategoriesAll}, -value => 1)->pack(-side => 'left');
  $af->Radiobutton(-text => "join", -variable => \$config{CategoriesAll}, -value => 2)->pack(-side => 'left');
  $af->Radiobutton(-text => "last", -variable => \$config{CategoriesAll}, -value => 0)->pack(-side => 'left');
  my $addB =
	  $af->Button(-text => "add",
				  -command => sub {
					  my @cats = $cattree->info('selection');
					  return unless checkSelection($catw, 1, 0, \@cats);
					  my @sellist = $lb->info('selection');
					  return unless checkSelection($catw, 1, 0, \@sellist);
					  my $warning = '';
					  my @catlist;
					  foreach my $cat (@cats) {
						  my @items;
						  if ($config{CategoriesAll} == 1) { # all, separated
							  @items = getAllItems($cat);
						  }
						  elsif ($config{CategoriesAll} == 2) { # all, joined
							  @items = getAllItems($cat);
							  my $joined = join('.', @items);
							  if (length($joined) > 32) {
								  $warning .= "Category $joined has ".length($joined)." characters";
								  next;
							  }
							  undef @items;
							  push @items, $joined;
						  }
						  elsif ($config{CategoriesAll} == 0) { # last
							  @items = getLastItem($cat);
						  }
						  else {
							  warn "editIPTCCategories: should never be reached ($config{CategoriesAll})!";
						  }
						  push @catlist, @items;
					  }
                                          if (@catlist) {
					    my $iptc = { SupplementalCategory => \@catlist };
					    applyIPTC($lb, $iptc, \@sellist);
                                          }
					  if ($warning ne '') {
						  $warning = "IPTC supp. categories are limited to 32 characters. Please shorten category.\n$warning";
						  showText("Warnings while adding keywords", $warning, NO_WAIT);
					  }
				  } )->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 1, -pady => 1);
  $balloon->attach($addB, -msg => "Add the selected categories to the selected pictures");

  my $rmB =
	  $af->Button(-text => "remove",
				  -command => sub {
					  my @cats = $cattree->info('selection');
					  return unless checkSelection($catw, 1, 0, \@cats);
					  my @sellist = $lb->info('selection');
					  return unless checkSelection($catw, 1, 0, \@sellist);
					  my $pw = progressWinInit($catw, "Remove category");
					  my $i = 0;
					  my $sum = @sellist;
					  foreach my $dpic (@sellist) {
						  last if progressWinCheck($pw);
						  $i++;
						  progressWinUpdate($pw, "removing category ($i/$sum) ...", $i, $sum);
						  foreach my $cat (@cats) {
							  last if progressWinCheck($pw);
							  progressWinUpdate($pw, "removing category $cat ($i/$sum) ...", $i, $sum);
							  my $item;
							  if ($config{CategoriesAll} == 2) { # all, joined
								  my @items = getAllItems($cat);
								  $item = join('.', @items);
							  }
							  else { # last							  
								  $item = getLastItem($cat);
							  }
							  print "remove category $item ($cat) from $dpic\n" if $verbose;
							  removeIPTCItem($dpic, 'SupplementalCategory', $item);
							  updateOneRow($dpic, $lb);
						  }
					  }
					  progressWinEnd($pw);
				  })->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 1, -pady => 1);
  $balloon->attach($rmB, -msg => "Remove the selected categories from the selected pictures");

  $cattree = $catw->Scrolled('Tree',
							 -separator  => '/',
							 -scrollbars => 'osoe',
							 -selectmode => 'extended',
							 -exportselection => 0,
							 -width      => 25,
							 -height     => 25,
							 )->pack(-expand => 1, -fill =>'both', -padx => 4, -pady => 2);
  bindMouseWheel($cattree->Subwidget("scrolled"));
  $balloon->attach($cattree, -msg => "Double click on a category to insert it.\nIt's possible to edit the categories, use the\nright mouse button to open the edit menu.");

  # try to get the saved mode
  if (-f "$configdir/categoryMode") {
	my $hashRef = retrieve("$configdir/categoryMode");
	warn "could not retrieve mode" unless defined $hashRef;
	$cattree->{m_mode} = $hashRef;
  }

  $cattree->bind('<Double-Button-1>', sub { $addB->invoke; });

  addTreeMenu($cattree, \@precats);

  insertTreeList($cattree, @precats);

  $catw->bind('<Key-q>',      sub { $XBut->invoke; });
  $catw->bind('<Key-Escape>', sub { $XBut->invoke; });

  $catw->Popup;
  $catw->waitWindow;
}

##############################################################
# editIPTCKeywords
##############################################################
sub editIPTCKeywords {

  my $lb = shift;
  if (Exists($keyw)) {
    my $x = $keyw->parent; print "parent widget = $x lb = $lb keyw = $keyw\n";
    # todo this doesn't work
	# but there should be a difference because when the win is already open from the main win and is called from the search win, the keywords of the wrong window are being modified!
    if ($lb eq $keyw->parent) {
	  print "editIPTCKeywords called from same widget\n";
	}
	else {
	  print "editIPTCKeywords called from other widget\n";
	}
    $keyw->deiconify;
	$keyw->raise;
	$keyw->focus;
	return;
  }

  # open window
  $keyw = $lb->Toplevel();
  $keyw->withdraw;
  $keyw->title('Keywords');
  $keyw->iconimage($mapiviicon) if $mapiviicon;

  my $keytree;

  my $af = $keyw->Frame()->pack(-fill =>'x', -padx => 2, -pady => 1);
  # global button, as it has to be called from saveAllConfig  (todo: find better solution for this)
  $keyXBut = $af->Button(-text => "Close",
						  -command => sub {
						      saveTreeMode($keytree);
							  nstore($keytree->{m_mode}, "$configdir/keywordMode") or warn "could not store $configdir/keywordMode: $!";
                              $config{KeyGeometry} = $keyw->geometry;
							  $keyw->destroy;
						  })->pack(-side => 'left', -expand => 1,-fill => 'x');

  my $addB =
	  $af->Button(-text => "add",
				  -command => sub {
					  my @keys = $keytree->info('selection');
					  return unless checkSelection($keyw, 1, 0, \@keys);
					  my @sellist = $lb->info('selection');
					  return unless checkSelection($keyw, 1, 0, \@sellist);
					  my @keylist;
					  my $warning = '';
					  foreach my $key (@keys) {
						  my @items;
						  if ($config{KeywordsAll} == 1) { # all, separated
							  @items = getAllItems($key);
						  }
						  elsif ($config{KeywordsAll} == 2) { # all, joined
							  @items = getAllItems($key);
							  my $joined = join('.', @items);
							  if (length($joined) > 64) {
								  $warning .= "Keyword $joined has ".length($joined)." characters";
								  next;
							  }
							  undef @items;
							  push @items, $joined;
						  }
						  elsif ($config{KeywordsAll} == 0) { # last
							  @items = getLastItem($key);
						  }
						  else {
							  warn "editIPTCKeywords: should never be reached!";
						  }
						  push @keylist, @items;
					  }
					  if (@keylist) {
						  my $iptc = { Keywords => \@keylist };
						  applyIPTC($lb, $iptc, \@sellist);
					  }
					  if ($warning ne '') {
						  $warning = "IPTC keywords are limited to 64 characters. Please shorten keyword.\n$warning";
						  showText("Warnings while adding keywords", $warning, NO_WAIT);
					  }
				  } )->pack(-side => 'left', -expand => 0, -fill => 'x');

  $balloon->attach($addB, -msg => "Add the selected keywords to the selected pictures");

  my $rmB =
	  $af->Button(-text => "remove",
				  -command => sub {
					  my @keys = $keytree->info('selection');
					  return unless checkSelection($keyw, 1, 0, \@keys);
					  my @sellist = $lb->info('selection');
					  return unless checkSelection($keyw, 1, 0, \@sellist);
					  my $pw = progressWinInit($keyw, "Remove keyword");
					  my $i = 0;
					  my $sum = @sellist;
					  foreach my $dpic (@sellist) {
						  last if progressWinCheck($pw);
						  $i++;
						  progressWinUpdate($pw, "removing keyword ($i/$sum) ...", $i, $sum);
						  foreach my $key (@keys) {
							  last if progressWinCheck($pw);
							  progressWinUpdate($pw, "removing keyword $key ($i/$sum) ...", $i, $sum);
							  my $item;
							  if ($config{KeywordsAll} == 2) { # all, joined
								  my @items = getAllItems($key);
								  $item = join('.', @items);
							  }
							  else { # last							  
								  $item = getLastItem($key);
							  }
							  print "remove key $item ($key) from $dpic\n" if $verbose;
							  removeIPTCItem($dpic, 'Keywords', $item);
							  updateOneRow($dpic, $lb);
							  showImageInfoCanvas($dpic) if ($dpic eq $actpic);
						  }
					  }
					  progressWinEnd($pw);
				  })->pack(-side => 'left', -expand => 0, -fill => 'x');

  $balloon->attach($rmB, -msg => "Remove the selected keywords from the selected pictures");

  my $bf = $keyw->Frame()->pack(-fill =>'x', -padx => 2, -pady => 1);
  $bf->Radiobutton(-text => "join", -variable => \$config{KeywordsAll}, -value => 2)->pack(-side => 'left');
  $bf->Radiobutton(-text => "all",  -variable => \$config{KeywordsAll}, -value => 1)->pack(-side => 'left');
  $bf->Radiobutton(-text => "last", -variable => \$config{KeywordsAll}, -value => 0)->pack(-side => 'left');
  $balloon->attach($bf, -msg => "Keyword add mode\nExample keyword: Friend/Bundy/Kelly\nmode join: one keyword:    Friend.Bundy.Kelly\nmode all:  three keywords: Friend, Bundy and Kelly\nmode last: one keyword:    Kelly\n\nDefault and recommended mode: join\nIf you want to store and retrieve your keyword\nhierarchie from your pictures you should use join mode.");

  my $df = $keyw->Frame()->pack(-fill =>'x', -padx => 3, -pady => 1);
  $balloon->attach($df, -msg => "Use the checkbutton to dock the keyword window to the main window.\nSelect < to dock it to the left side and > to dock it to the right side.");
  $df->Checkbutton(-text => 'dock', -variable => \$config{KeywordDialogDock}, -command => sub {dock_keyword_dialog();})->pack(-side => 'left');
  $df->Radiobutton(-text => '<', -variable => \$config{KeywordDialogDockL}, -value => 1, -command => sub {dock_keyword_dialog();})->pack(-side => 'left');
  $df->Radiobutton(-text => '>', -variable => \$config{KeywordDialogDockL}, -value => 0, -command => sub {dock_keyword_dialog();})->pack(-side => 'left');
  
  $keytree = $keyw->Scrolled('Tree',
							 -separator  => '/',
							 -scrollbars => 'osoe',
							 -selectmode => 'extended',
							 -exportselection => 0,
							 -width      => 25,
							 -height     => 25,
							 )->pack(-expand => 1, -fill =>'both', -padx => 1, -pady => 1);
  $keyw->{tree} = $keytree;

  bindMouseWheel($keytree->Subwidget("scrolled"));
  $balloon->attach($keytree, -msg => "Double click on a keyword to insert it.\nIt's possible to edit the keywords, use the\nright mouse button to open the edit menu.");

  # try to get the saved mode
  if (-f "$configdir/keywordMode") {
	my $hashRef = retrieve("$configdir/keywordMode");
	warn "could not retrieve mode" unless defined $hashRef;
	$keytree->{m_mode} = $hashRef;
  }

  $keytree->bind('<Double-Button-1>', sub { $addB->invoke; });

  addTreeMenu($keytree, \@prekeys);

  insertTreeList($keytree, @prekeys);

  $keyw->bind('<Key-q>',      sub { $keyXBut->invoke; });
  $keyw->bind('<Key-Escape>', sub { $keyXBut->invoke; });
  # invoke $but when the window is closed by the window manager (x-button)
  $keyw->protocol("WM_DELETE_WINDOW" => sub { $keyXBut->invoke; });

  $keyw->Popup;
  checkGeometry(\$config{KeyGeometry});
  $keyw->geometry($config{KeyGeometry});
  $keyw->waitWindow;
}

##############################################################
# editCommentKeywords
##############################################################
sub editCommentKeywords {

  my $lb = shift;
  if (Exists($keycw)) {
	$keycw->deiconify;
	$keycw->raise;
	$keycw->focus;
	return;
  }

  # open window
  $keycw = $top->Toplevel();
  $keycw->withdraw;
  $keycw->title('Keywords for comments');
  $keycw->iconimage($mapiviicon) if $mapiviicon;

  my $keytree;

  my $XBut = $keycw->Button(-text => "Close",
						  -command => sub {
							  saveTreeMode($keytree);
							  nstore($keytree->{m_mode}, "$configdir/keywordMode") or warn "could not store $configdir/keywordMode: $!";
							  $keycw->destroy;
						  })->pack(-expand => 0,-fill => 'x',-padx => 1,-pady => 1);

  my $af = $keycw->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
  $af->Radiobutton(-text => "all",  -variable => \$config{KeywordsAll}, -value => 1)->pack(-side => 'left');
  $af->Radiobutton(-text => "last", -variable => \$config{KeywordsAll}, -value => 0)->pack(-side => 'left');
  my $addB =
	  $af->Button(-text => "add",
				  -command => sub {
					  my @keys = $keytree->info('selection');
					  return unless checkSelection($keycw, 1, 0, \@keys);
					  my @sellist = $lb->info('selection');
					  return unless checkSelection($keycw, 1, 0, \@sellist);
					  my $comment;
					  foreach my $key (@keys) {
						  my @items;
						  if ($config{KeywordsAll}) {
							  @items = getAllItems($key);
						  }
						  else {
							  @items = getLastItem($key);
						  }
						  $comment .= "$_ " foreach (@items);
					  }
					  # todo add to end of existing comment or as new comment
					  foreach my $dpic (@sellist) {
						  # todo progressbar
						  addCommentToPic($comment, $dpic, TOUCH);
						  updateOneRow($dpic, $lb);
						  showImageInfo($dpic) if ($dpic eq $actpic);
					  }
				  } )->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 1, -pady => 1);
  $balloon->attach($addB, -msg => "Add the selected keywords to the selected pictures");

=pod

  my $rmB =
	  $af->Button(-text => "remove",
				  -command => sub {
					  my @keys = $keytree->info('selection');
					  return unless checkSelection($keycw, 1, 0, \@keys);
					  my @sellist = $lb->info('selection');
					  return unless checkSelection($top, 1, 0, \@sellist);
					  my $pw = progressWinInit($keycw, "Remove keyword");
					  my $i = 0;
					  my $sum = @sellist;
					  foreach my $dpic (@sellist) {
						  last if progressWinCheck($pw);
						  $i++;
						  progressWinUpdate($pw, "removing keyword ($i/$sum) ...", $i, $sum);
						  foreach my $key (@keys) {
							  last if progressWinCheck($pw);
							  progressWinUpdate($pw, "removing keyword $key ($i/$sum) ...", $i, $sum);
							  my $name = getLastItem($key);
							  print "remove key $name ($key) from $dpic\n" if $verbose;
							  removeIPTCItem($dpic, 'Keywords', $name);
							  updateOneRow($dpic, $lb);
						  }
					  }
					  progressWinEnd($pw);
				  })->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 1, -pady => 1);
  $balloon->attach($rmB, -msg => "Remove the selected keywords from the selected pictures");

=cut

  $keytree = $keycw->Scrolled('Tree',
							 -separator  => '/',
							 -scrollbars => 'osoe',
							 -selectmode => 'extended',
							 -exportselection => 0,
							 -width      => 25,
							 -height     => 25,
							 )->pack(-expand => 1, -fill =>'both', -padx => 4, -pady => 2);
  bindMouseWheel($keytree->Subwidget("scrolled"));
  $balloon->attach($keytree, -msg => "Double click on a keyword to insert it.\nIt's possible to edit the keywords, use the\nright mouse button to open the edit menu.");

  # try to get the saved mode
  if (-f "$configdir/keywordMode") {
	my $hashRef = retrieve("$configdir/keywordMode");
	warn "could not retrieve mode" unless defined $hashRef;
	$keytree->{m_mode} = $hashRef;
  }

  $keytree->bind('<Double-Button-1>', sub { $addB->invoke; });

  addTreeMenu($keytree, \@prekeys);

  insertTreeList($keytree, @prekeys);

  $keycw->bind('<Key-q>',      sub { $XBut->invoke; });
  $keycw->bind('<Key-Escape>', sub { $XBut->invoke; });

  $keycw->Popup;
  $keycw->waitWindow;
}

##############################################################
# addTreeMenu - add a menu to a tree widget to edit a tree
##############################################################
sub addTreeMenu {
	my $tree    = shift; # tree widget
	my $listRef = shift; # the list displayed in the tree

	my $menu = $tree->Menu(-title => "Tree edit menu");

	$menu->command(-label => "add new item", -command => sub {
		my @keys = $tree->info('selection');
		return unless checkSelection($tree, 0, 1, \@keys);
		my $item = '';
		my $parent = '';
		$parent = $keys[0] if (@keys);
		if ($parent !~ m/.*\/.*/) {
			$parent = '';
		}
		else {
			# cut of last element
			$parent  = $1 if ($parent =~ m/(.*\/).*/);
			$parent .= '/' if (($parent ne '') and ($parent !~ m/.*\/$/));
		}
		my $rc = myEntryDialog('New item',
							   "Please enter the new item (below $parent)",
							   \$item);
		return if ($rc ne 'OK');
		return if ($item eq '');

        # avoid slash and backslash
        if (($item =~ m|.*\/.*|) or ($item =~ m|.*\\.*|)) {
          $tree->messageBox(-icon  => 'info',
                            -message => 'Sorry, but the slash (/) and the backslash (\) are not allowed.',
					        -title => 'Wrong character', -type => 'OK');
          return;
        }

        # avoid double entries
        if (isInList($parent.$item, $listRef)) {
          $tree->messageBox(-icon  => 'info',
                            -message => "Sorry, but $parent$item is already in the list.",
					        -title => 'Double entry', -type => 'OK');
          return;
        }

		push @{$listRef}, $parent.$item;
		insertTreeList($tree, @{$listRef});
	});

	$menu->command(-label => "add new item below selected item", -command => sub {
		my @keys = $tree->info('selection');
		return unless checkSelection($tree, 1, 1, \@keys);

		my $item = '';
		my $parent = $keys[0];
		my $rc = myEntryDialog('New sub item',
							   "Please enter the new sub item (below $parent)",
							   \$item);
		return if ($rc ne 'OK');
		return if ($item eq '');

        # avoid slash and backslash
        if (($item =~ m|.*\/.*|) or ($item =~ m|.*\\.*|)) {
          $tree->messageBox(-icon  => 'info',
                            -message => 'Sorry, but the slash (/) and the backslash (\) are not allowed.',
					        -title => 'Wrong character', -type => 'OK');
          return;
        }
		$parent .= '/' if (($parent ne '') and ($parent !~ m/.*\/$/));

        # avoid double entries
        if (isInList($parent.$item, $listRef)) {
          $tree->messageBox(-icon  => 'info',
                            -message => "Sorry, but $parent$item is already in the list.",
					        -title => 'Double entry', -type => 'OK');
          return;
        }

		push @{$listRef}, $parent.$item;
		insertTreeList($tree, @{$listRef});
	});

	$menu->separator;
	$menu->command(-label => "rename (move) selected item", -command => sub {
		my @keys = $tree->info('selection');
		return unless checkSelection($tree, 1, 1, \@keys);

		my $parent = $keys[0];
		my $rc = myEntryDialog('Rename item',
							   "Please enter the new name for item $parent",
							   \$parent);
		return if ($rc ne 'OK');
		return if ($parent eq '');
		$parent =~ s|^/||;			# cut leading slash

		for my $t (0 .. $#{@{$listRef}} ) {
			if ($$listRef[$t] =~ m/^$keys[0](.*)/) {
				print "rename: $$listRef[$t] ($t) to $parent$1\n" if $verbose;
				$$listRef[$t] = $parent.$1;
			}
		}
		insertTreeList($tree, @{$listRef});
	});

	$menu->separator;
	$menu->command(-label => "delete selected item(s)", -command => sub {
		my @keys = $tree->info('selection');
		return unless checkSelection($tree, 1, 0, \@keys);

		for my $t (reverse 0 .. $#{@{$listRef}} ) {
		  foreach my $key (@keys) {
			if ($$listRef[$t] =~ m/^$key.*/) {
				print "trow out: $$listRef[$t] ($t)\n" if $verbose;
				splice @{$listRef}, $t, 1;  # remove it from list
			}
	      }
		}
		insertTreeList($tree, @{$listRef});
	});

	$menu->separator;
	$menu->command(-label => "search selected items", -command => sub {
		my @keys = $tree->info('selection');
		return unless checkSelection($tree, 1, 0, \@keys);
		
		my $pat = '';
		foreach (@keys) {
		  my @parts = split /\//, $_; # todo add join and all mode
		  $pat .= $parts[-1].' ';
		}
		$pat =~ s/\s+$//;   # cut trailing whitespace
		$pat =~ s/^\s+//;   # cut leading whitespace

		my $pat_orig = $pat;

		if (@keys > 1) {
			$pat = "(?=.*".$pat;       # and-function with look-ahead
			$pat =~ s/\s+/)(?=.*/g;    # replace one or more whitespaces with )(?=.*
			$pat .= ')';               # "Tom Tim" is now: "(?=.*Tom)(?=.*Tim)"
		  }

		my $start_time = Tk::timeofday();
		my $case  = 'i';
		my $count = 0;
		my @dpics;
		# loop through all database entries
	    foreach my $dpic (sort keys %searchDB) {
		  my $keys = $searchDB{$dpic}{KEYS};
		  if ((defined $keys) and ($keys =~ m/(?$case).*$pat.*/)) {
			$count ++;
			push @dpics, $dpic;
		  }
		}

		my $time_elapsed = sprintf "%.2f", (Tk::timeofday() - $start_time);

		my $rc = myButtonDialog('Search finished',
						   "Found $count pictures in ${time_elapsed}sec matching \"$pat_orig\"",
						   undef,
						   'Show found pictures', 'Cancel',);

		# todo showing the pics in the light table is not always the best idea! -> showThumbListInNewWin
		light_table_add(\@dpics) if ((@dpics > 0) and ($rc eq 'Show found pictures'));

	});

	$tree->bind('<ButtonPress-3>',   sub {
		$menu->Popup(-popover => 'cursor', -popanchor => 'nw');
	} );

}

##############################################################
# showThumbListInNewWin
##############################################################
sub showThumbListInNewWin {

}

##############################################################
# getLastItem - returns the last item of a scalar separated with
#               a slash:  family/Miller/Robert -> Robert
##############################################################
sub getLastItem($) {
  my $item = shift;
  my @names = split /\//, $item;
  my $name  = $names[-1];
  $name     = $item if ((!defined $name) or ($name eq ""));
  return $name;
}

##############################################################
# getAllItems - returns a list of all items of a scalar
#               separated with a slash:
#               family/Miller/Robert -> family, Miller, Robert
##############################################################
sub getAllItems($) {
  my $item = shift;
  return split /\//, $item;
}

##############################################################
# insertTreeList
##############################################################
sub insertTreeList {
  my $tree = shift;
  my %mode;

  saveTreeMode($tree);

  %mode = %{$tree->{m_mode}} if (defined $tree->{m_mode});

  $tree->delete("all");

  # insert the list (@_)
  foreach (sort { uc($a) cmp uc($b); } @_ ) {
	  my @names = split /\//, $_;
	  my $name  = $names[-1];
	  $name     = $_ if ((!defined $name) or ($name eq ""));
	  $tree->add($_, -text=>$name);
  }

  $tree->autosetmode;

  # reset mode to the the old setting for the first 3 levels
  foreach ($tree->info('children')) {
	  $tree->close($_) if ((defined $mode{$_}) and ($mode{$_} eq 'open'));
	  $tree->open($_)  if ((defined $mode{$_}) and ($mode{$_} eq 'close'));
	  foreach ($tree->info('children', $_)) {
		  $tree->close($_) if ((defined $mode{$_}) and ($mode{$_} eq 'open'));
		  $tree->open($_)  if ((defined $mode{$_}) and ($mode{$_} eq 'close'));
		  foreach ($tree->info('children', $_)) {
			  $tree->close($_) if ((defined $mode{$_}) and ($mode{$_} eq 'open'));
			  $tree->open($_)  if ((defined $mode{$_}) and ($mode{$_} eq 'close'));
		  }
	  }
  }
}

##############################################################
# saveTreeMode - save the mode (open, close) of the first 3
#                levels of a tree in $widget->{m_mode}
#                {m_mode} is mapivi private data stored in the
#                widget hash
##############################################################
sub saveTreeMode {
  my $tree = shift;
  my %mode;
  %mode = %{$tree->{m_mode}} if (defined $tree->{m_mode});
  # save mode (open, close) of existing items for the first 3 levels
  foreach ($tree->info('children')) {
	  $mode{$_} = $tree->getmode($_);
	  foreach ($tree->info('children', $_)) {
		  $mode{$_} = $tree->getmode($_);
		  foreach ($tree->info('children', $_)) {
			  $mode{$_} = $tree->getmode($_);
		  }
	  }
  }
  $tree->{m_mode} = \%mode;
}

##############################################################
# removeIPTCItem
##############################################################
sub removeIPTCItem {
	my $dpic = shift;
	my $kind = shift;
	my $item = shift;

	if (($kind ne 'Keywords') and ($kind ne 'SupplementalCategory')) {
		warn "removeIPTCItem: $kind is wrong kind";
		return;
	}

	print "removeIPTCItem: kind:$kind item:$item pic:$dpic\n" if $verbose;

	my $meta = getMetaData($dpic, 'APP13');
	unless (defined $meta) {
		print "removeIPTCItem: Could not create IPTC info for $dpic!\n";
		return;
	}

	my $iptc = $meta->get_app13_data('TEXTUAL', 'IPTC');

	my %d;   # build a hash
	foreach (@{$iptc->{$kind}}) { $d{$_} = 1; }
	return unless (defined $d{$item});
	delete $d{$item}; # remove item from list
	@{$iptc->{$kind}} = (sort { uc($a) cmp uc($b); } keys %d);
	$meta->set_app13_data($iptc, 'REPLACE', 'IPTC');

	if ($meta->save()) {
		my $dirthumb = getThumbFileName($dpic);
		# touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time
		touch($dirthumb);
	}
	else {
		print "removeIPTCItem: save failed for $dpic\n";
	}
}

#my %get_encoding_name_from_tag = (
#  "0x1b0x250x47" => "UTF8",

# stolen from Image::ExifTool (thanks to Phil Harvey)
#------------------------------------------------------------------------------
# Print conversion for CodedCharacterSet
# Inputs: 0) value
sub PrintCodedCharset($)
{
    my $val = shift;
    return $iptcCharset{$val} if $iptcCharset{$val};
    $val =~ s/(.)/ $1/g;
    $val =~ s/ \x1b/, ESC/g;
    $val =~ s/^,? //;
    return $val;
}


##############################################################
# getIPTC - returns all IPTC-Data of the given picture
##############################################################
sub getIPTC {

  # the pic with complete path
  my $dpic = shift;
  # bool, if = LONG  a better complete readable output,
  #       if = SHORT a compact but complete IPTC info for e.g. the search database
  my $format = shift;
  my $meta   = shift; # optional, the Image::MetaData::JPEG object of $pic if available

  my $iptc = '';

  return $iptc unless is_a_JPEG($dpic);

  my $shortkey;
  
  # todo: is , 'FASTREADONLY' here possible?
  $meta = getMetaData($dpic, 'APP13') unless (defined($meta));
  if ($meta) {
    my $seg = $meta->retrieve_app13_segment(undef, 'IPTC');
    if ($seg) {
      my $hashref = $seg->get_app13_data('TEXTUAL', 'IPTC');
      foreach my $key (@IPTCAttributes) {
        # this causes trouble (cuts off the rest) because it's binary
	    next if ($key eq "RecordVersion");

 	    if (defined($hashref->{$key})) {
	      if (($format == LONG)) {
	        $iptc .= sprintf "%-31s: ", $key;
	      } else {
	        my $shortkey = $key;
	        $shortkey =~ s/SupplementalCategory/SuppCategories/;
	        $shortkey = substr($shortkey, 0, 7)."." if (length($shortkey) > 8);
	        $iptc .= sprintf "%-8s: ", $shortkey;
	      }
	      $iptc .= "$_ " for @{$hashref->{$key}};
	      $iptc  =~ s/\s+$//;		# cut trailing whitespace
	      $iptc .= "\n";
        }
      }
	  
	  # add Coded Character Set info
	  my $hash_1 = $seg->get_app13_data('TEXTUAL', 'IPTC_1');
      if (defined $hash_1->{'CodedCharacterSet'}) {
		my $encoding = PrintCodedCharset(${$hash_1->{'CodedCharacterSet'}}[0]);
	    if (($format == LONG)) {
	      $iptc .= sprintf "%-31s: ", 'CodedCharacterSet';
	    } else {
	      $iptc .= 'CCharSet: ';
		}
		$iptc .= "$encoding\n";
		#print "found Coded character set in $dpic: [$encoding][${$hash_1->{'CodedCharacterSet'}}[0]]\n";
      }

    }
  }
  
  $iptc =~ tr/\n -~//cd; # remove all non-printable chars, but not newline
  return $iptc;
}

##############################################################
# getShortIPTC - get just one attribute of the IPTC comment
#                I decided to use the caption/abstract, but
#                I am not sure if this is the best attribute
#                here?
#                if there is no file or no IPTC info in the file
#                an empty string is returned
##############################################################
sub getShortIPTC {
  my $dpic = shift;
  # optional, if set to LONG the complete contents of the @iptcs attributes
  # (see below) will be returned
  # else (SHORT) it will be cut to fit in the hlist
  my $format = shift; # LONG or SHORT

  return "" unless (-f $dpic);

  my $info = getIPTC($dpic, SHORT);

  $info = formatString($info, $config{LineLength}, $config{LineLimit}) if ((defined $format) and ($format == SHORT));

  return $info;
}

##############################################################
# getImageInfo - returns a hash containing the image info
##############################################################
sub getImageInfo {

  my $pic = shift;
  if (!-f $pic) {
	return "";
  }
  my $ii = image_info($pic);
  if (!$ii) {
	return "";
  }

  if ($ii->{Errno} and $ii->{Errno} ne "0") {
	return "";
  }
  return $ii;
}

##############################################################
# getNearestItem - finds the nearest item to the mouse pointer
#                  in a listbox
##############################################################
sub getNearestItem {

   my($LB) = @_;
   my ($X,$Y) = $LB->pointerxy();
   my $y = $LB->rooty();
   my $yy = $Y - $y;
   return ($LB->nearest($yy));
}

##############################################################
# processARGV - handels the command line arguments (if any)
##############################################################
sub processARGV {

  getopts('i'); # sets $opt_i if switch -i is found

  my $nr = @ARGV;

  if ($nr < 1) { # no arguments - open the last dir
	$actdir = $config{LastDir};
	dirSave($actdir);
	return;
  }
  
  if ($nr > 1) { # too many argument
	print "Mapivi error: to many command line options\n";
	printUsage();
	exit;
  }

  my $item = abs_path($ARGV[0]);
  #print "processARGV: -e $item = ", -e $item, "\n";
  $item = Encode::encode('iso-8859-1', $item);
  #print "processARGV: item: $item  item2: $item2\n";
  #print "processARGV: -e $item = ", -e $item, "\n";

  if (-f $item) {
	$actpic  = $item;
	$actdir  = dirname($item);
  }
  elsif (-d $item) {
	$actdir  = $item;
  }
  else {
	printUsage();
	exit;
  }

  dirSave($actdir);
}

##############################################################
# getDirAndOpen - let the user select a new dir and open it
#                 with a simple text entry
##############################################################
sub getDirAndOpen {

  my $dir = $actdir;
  my $rc  = myEntryDialog("open dir","Please enter folder:",\$dir);
  return if ($rc ne 'OK');

  print " --$dir--\n" if $verbose;
  $dir = glob("$dir");
  print "g--$dir--\n" if $verbose;
  while (!-d $dir) {
	$top->messageBox(-icon => 'warning', -message => "Sorry, but I can't find the folder \"$dir\"",
					 -title => "No valid folder", -type => 'OK');
	$rc = myEntryDialog("open dir","Please enter folder:",\$dir);
	return if ($rc ne 'OK');
	$dir = glob("$dir");
  }
  openDirPost($dir);
}

##############################################################
# openDir - let the user select a new dir and open it
#           with a real dir dialog
##############################################################
sub openDir {

  my $dir = dirDialog($actdir);
  openDirPost($dir);
}

##############################################################
# openDirPost - things to do when opening a new dir
##############################################################
sub openDirPost {
  my $dir = shift;
  $dir = Encode::encode('iso-8859-1', $dir);
  #print "openDirPost: dir: $dir";
  #if (-d $dir) { print " is a dir\n"; }
  #else  { print " is not a dir\n"; }

  
  $dir  =~ s/\/\//\//g;     # replace all // with /

  return unless (defined $dir);
  return unless (-d $dir);

  $actdir  = $dir;
  my $path = cutString($dir, -22, "..");
  $userinfo = "opening $path ..."; $userInfoL->update;
  $actpic = ""; # reset var $actpic - needed to get a correct window title
  setDirProperties();
  dirSave($dir);
  clearLabels();
  showImageInfoCanvas();
  setTitle();
  $exif = "" if ($config{ShowEXIFField});
  $commentText->delete( 0.1, 'end') if ($config{ShowCommentField} and defined $commentText);
  $captionText->delete( 0.1, 'end') if ($config{ShowCaptionField} and defined $captionText);
  $dirtree->configure(-directory => $actdir);
  # Set the folder
  exists &Tk::DirTree::chdir ? $dirtree->chdir($actdir) : $dirtree->set_dir($actdir);
  selectDirInTree($actdir);

  updateThumbs();
}

##############################################################
# setDirProperties
##############################################################
sub setDirProperties {
  $dirPropSORT = 0;
  $dirPropMETA = 0;
  $dirPropPRIO = 0;
  $dirPropSORT = $dirProperties{$actdir}{SORT} if (defined $dirProperties{$actdir}{SORT});
  $dirPropMETA = $dirProperties{$actdir}{META} if (defined $dirProperties{$actdir}{META});
  $dirPropPRIO = $dirProperties{$actdir}{PRIO} if (defined $dirProperties{$actdir}{PRIO});
  #foreach my $prop (@dirPropList) {
	#  $dirProp{$prop} = 0;
	 # $dirProp{$prop} = $dirProperties{$actdir}{SORT}
}

##############################################################
# showDirProperties
##############################################################
sub showDirProperties {

  if (Exists($dpw)) {
	$dpw->deiconify;
	$dpw->raise;
	$dpw->focus;
	return;
  }

  # open window
  $dpw = $top->Toplevel();
  $dpw->withdraw;
  $dpw->title('Folder Checklist');
  $dpw->iconimage($mapiviicon) if $mapiviicon;

  my $topf = $dpw->Frame()->pack();

  my $dplb = $dpw->Scrolled("HList",
							-header     => 1,
							-separator  => ';',  # todo here we hope that ; will never be in a folder or file name
							-pady       => 1,
							-columns    => 5,
							-scrollbars => 'osoe',
							#-selectmode => "dragdrop", todo
							-selectmode => "extended",
							-background => $config{ColorBG}, #8fa8bf
							-width      => 40,
							-height     => 60,
							)->pack(-expand => 1, -fill => "both");

  bindMouseWheel($dplb);
  my $count = 0;
  $dplb->{dircol} = $count;
  $dplb->header('create', $count++, -text => 'Folder', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
  $dplb->{sortcol} = $count;
  $dplb->header('create', $count++, -text => 'Sort', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
  $dplb->{metacol} = $count;
  $dplb->header('create', $count++, -text => 'Meta', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
  $dplb->{priocol} = $count;
  $dplb->header('create', $count++, -text => 'Prio', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
  $dplb->{commcol} = $count;
  $dplb->header('create', $count++, -text => 'Comment', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});

  my $Xbut = $topf->Button(-text => "Close",
						  -command => sub { $dpw->withdraw; $dpw->destroy; }
						  )->pack(-side => 'left', -expand => 0,-fill => 'x',-padx => 1,-pady => 1);

  my $upd_but = $topf->Button(-text => "Update",
							  -command => sub {
								my @dirs = $dplb->info('selection');
								my $last = $dirs[-1];
								$dplb->delete("all");
								insertDirProperties($dplb);
								reselect($dplb, @dirs);
								$dplb->see($last) if ($dplb->info("exists", $last));;
							  })->pack(-side => 'left', -expand => 0,-padx => 1,-pady => 1);

  $topf->Checkbutton(-text => "Show unfinished folders",
					 -variable => \$config{ShowUnfinishedDirs}
					 )->pack(-side => 'left', -expand => 0,-fill => 'x',-padx => 1,-pady => 1);
  $topf->Checkbutton(-text => "Show finished folders",
					 -variable => \$config{ShowFinishedDirs}
					 )->pack(-side => 'left', -expand => 0,-fill => 'x',-padx => 1,-pady => 1);

  my $dpmenu = $dpw->Menu(-title => "Folder Checklist Menu");

  $dpmenu->command(-label => "open folder",
				   -command => sub {
					   my @dirs  = $dplb->info('selection');
					   return unless checkSelection($dpw, 1, 1, \@dirs);
					   if (-d $dirs[0]) {
					     openDirPost($dirs[0]);
					     # show main window
	                                     $top->deiconify;
	                                     $top->raise;
					   } else {
					     $dplb->messageBox(-icon => 'info', -message => "Sorry, but this folder is currently not available!", -title => "Folder not available", -type => 'OK');
					   }
                      } );
  $dpmenu->command(-label => "add all sub folders to this list",
				   -command => sub {
					   my @dirs  = $dplb->info('selection');
					   return unless checkSelection($dpw, 1, 1, \@dirs);
					   @dirs = getDirsRecursive($dirs[0]);
					   my $nr = 0;
					   foreach (@dirs) {
						   # todo skip empty dirs
						   if (!defined $dirProperties{$_}) {
							   print "adding $_\n" if $verbose;
							   $dirProperties{$_}{SORT} = 0 ;
							   $dirProperties{$_}{META} = 0 ;
							   $dirProperties{$_}{PRIO} = 0 ;
							   $nr++;
						   }
					   }
					   $upd_but->invoke;
					   $dplb->messageBox(-icon => 'info', -message => "Added $nr folders.",
										-title => "Added sub folders", -type => 'OK');
				   } );
  $dpmenu->command(-label => "remove selected from list",
				   -command => sub {
					   my @dirs  = $dplb->info('selection');
					   return unless checkSelection($dpw, 1, 0, \@dirs);
					   foreach my $dir (@dirs) {
						 delete $dirProperties{$dir};
						 $dplb->delete("entry", $dir) if ($dplb->info('exists', $dir));
					   }
					 } );
  $dpmenu->command(-label => "edit comment",
				   -command => sub {
					   my @dirs  = $dplb->info('selection');
					   return unless checkSelection($dpw, 1, 1, \@dirs);
					   my $text = "";
					   $text = $dirProperties{$dirs[0]}{COMM} if (defined $dirProperties{$dirs[0]}{COMM});
					   my $rc = myTextDialog("Edit comment", "Please edit comment of $dirs[0]", \$text);
					   return if ($rc ne 'OK');
					   # replace (german) umlaute by corresponding letters
					   $text =~ s/([$umlaute])/$umlaute{$1}/g if ($config{ConvertUmlaut});
					   $dirProperties{$dirs[0]}{COMM} = $text;
					   $dplb->itemConfigure($dirs[0], $dplb->{commcol}, -text => $dirProperties{$dirs[0]}{COMM}, -style => $fileS);
					   } );
  my $sort_menu = $dpmenu->cascade(-label => "Sort");
  my $meta_menu = $dpmenu->cascade(-label => "Meta");
  my $prio_menu = $dpmenu->cascade(-label => "Prio");
  my $all_menu  = $dpmenu->cascade(-label => "All");
  $sort_menu->command(-label => "set",   -command => sub { setProperty($dplb, 'SORT', 1); } );
  $sort_menu->command(-label => "reset", -command => sub { setProperty($dplb, 'SORT', 0); } );
  $meta_menu->command(-label => "set",   -command => sub { setProperty($dplb, 'META', 1); } );
  $meta_menu->command(-label => "reset", -command => sub { setProperty($dplb, 'META', 0); } );
  $prio_menu->command(-label => "set",   -command => sub { setProperty($dplb, 'PRIO', 1); } );
  $prio_menu->command(-label => "reset", -command => sub { setProperty($dplb, 'PRIO', 0); } );
  $all_menu->command( -label => "set",   -command => sub { setProperty($dplb, 'ALL', 1); } );
  $all_menu->command( -label => "reset", -command => sub { setProperty($dplb, 'ALL', 0); } );


  $dplb->bind('<ButtonPress-3>',   sub {
			   $dpmenu->Popup(-popover => "cursor", -popanchor => "nw");
		   } );
  $dplb->bind('<Double-Button-1>',   sub {
	  my @dirs  = $dplb->info('selection');
	  return unless checkSelection($dpw, 1, 1, \@dirs);
	  if (-d $dirs[0]) {
		openDirPost($dirs[0]);
	    # show main window
	    $top->deiconify;
	    $top->raise;
	  } else {
		$dplb->messageBox(-icon => 'info', -message => "Sorry, but this folder is currently not available!", -title => "Folder not available", -type => 'OK');
	  }
  } );

  $dpw->bind('<Control-q>',  sub { $Xbut->invoke; });
  $dpw->bind('<Key-Escape>', sub { $Xbut->invoke; });
  $dpw->Popup;
  my $ws = 0.7; # window size is 70% of screen
  my $w = int($ws * $dpw->screenwidth);
  my $h = int($ws * $dpw->screenheight);
  my $x = int(($dpw->screenwidth  - $w)/3);
  my $y = int(($dpw->screenheight - $h)/3);
  $dpw->geometry("${w}x${h}+${x}+${y}");

  insertDirProperties($dplb);

  $dpw->waitWindow;
}

##############################################################
# insertDirProperties
##############################################################
sub insertDirProperties {
  my $lb = shift;
  my $normal_S    = $lb->ItemStyle('text', -anchor=>'nw', -foreground=>'#009', -background=>$config{ColorBG});
  my $finished_S  = $lb->ItemStyle('text', -anchor=>'nw', -foreground=>'#090', -background=>$config{ColorBG});
  my $not_avail_S = $lb->ItemStyle('text', -anchor=>'nw', -foreground=>'#900',   -background=>$config{ColorBG});
  my $last_time;
  foreach my $dir (sort { uc($a) cmp uc($b); } keys %dirProperties) {
      my $style = $normal_S;
	  $style    = $finished_S if (defined $dirProperties{$dir}{SORT} and
								  defined $dirProperties{$dir}{META} and
								  defined $dirProperties{$dir}{PRIO} and
								  $dirProperties{$dir}{SORT} == 1 and
								  $dirProperties{$dir}{META} == 1 and
								  $dirProperties{$dir}{PRIO} == 1);
	  next if (!$config{ShowFinishedDirs} and $style == $finished_S);
	  next if (!$config{ShowUnfinishedDirs} and $style != $finished_S);
	  $style = $not_avail_S  unless (-d $dir);
	  # create new row
	  $lb->add($dir);
	  $lb->itemCreate($dir, $lb->{dircol},  -text => $dir,                       -style => $style);
	  $lb->itemCreate($dir, $lb->{sortcol}, -text => $dirProperties{$dir}{SORT}, -style => $comS);
	  $lb->itemCreate($dir, $lb->{metacol}, -text => $dirProperties{$dir}{META}, -style => $iptcS);
	  $lb->itemCreate($dir, $lb->{priocol}, -text => $dirProperties{$dir}{PRIO}, -style => $comS);
	  $lb->itemCreate($dir, $lb->{commcol}, -text => $dirProperties{$dir}{COMM}, -style => $iptcS);

	  # show progress every 0.5 seconds - idea from Slaven
	  if (!defined $last_time || Tk::timeofday()-$last_time > 0.5) {
		  $lb->update;
		  $last_time = Tk::timeofday();
	  }
  }
}

##############################################################
# showDirSizes
##############################################################
sub showDirSizes {

	if (Exists($dsw)) {
		$dsw->deiconify;
		$dsw->raise;
		$dsw->focus;
		return;
	}

	my @dirs = @_; # just one dir at the moment, because the dir tree is configured to single selection

	# will contain all dirs
	my @alldirs;

	my $break = 0;
	my $pw = progressWinInit($top, "Collect sub folders");
	foreach my $dir (@dirs) {
	  if (progressWinCheck($pw)) {
		$break = 1;
		last;
	  }
	  find(sub {
			 # process just dirs, but not .thumbs/ .xvpics/ etc.
			 if (progressWinCheck($pw)) { $break = 1; $File::Find::prune = 1; }
			 if (-d and ($_ ne $thumbdirname) and ($_ ne ".xvpics") and ($_ ne $exifdirname)) {
			   progressWinUpdate($pw, "collecting folders, found ".scalar @alldirs." ...", 0, 0);
			   push @alldirs, $File::Find::name;
			   # add dir if it contains at least one picture
			   #if (getPics($File::Find::name, JUST_FILE) > 0) {
			   #}
			 }
		   }, $dir);
	}
	progressWinEnd($pw);
	return if ($break);

	shift @alldirs if (@alldirs > 1); # remove the parent (starting) dir if there are subdirs

	#$label = "Found ".scalar @alldirs." folders, getting size ...";

	# hash key: folder value: size of dir in Bytes (including all subdirs)
	my %dirsize;
	my $max       = 0;
	#my $allsize   = 0;
	my $dirCount  = 0;
	my $fileCount = 0;
	my $i  = 0;
	$pw = progressWinInit($top, "Calculate folder sizes");
	foreach my $dir (@alldirs) {
	  if (progressWinCheck($pw)) {
		$break = 1;
		last;
	  }
	  $i++;
	  progressWinUpdate($pw, "in folder $dir ($i/".scalar @alldirs.") ...", $i, scalar @alldirs);
	    my $size  = 0;
		$dirCount++;
		find(sub {
			$fileCount++;
			$size += -s if (defined -s);
		}, $dir);
		$dirsize{$dir} = $size;
		$max = $size if ($size > $max);
	  #$allsize += $size; # this will count deeper structures several times
	}
	progressWinEnd($pw);
	return if ($break);

	# open window
	$dsw = $top->Toplevel();
	#$dsw->withdraw;
	$dsw->title('Folder Sizes');
	$dsw->iconimage($mapiviicon) if $mapiviicon;

	#$dsw->{label} = "Starting soon";
	my $label = "Starting soon";

	my $Xbut = $dsw->Button(-text => "Close",
							-command => sub { $dsw->withdraw; $dsw->destroy; }
							)->pack(-expand => 0,-fill => 'x',-padx => 1,-pady => 1);

	$dsw->Label(-textvariable => \$label,
				)->pack(-expand => 0,-fill => 'x',-padx => 1,-pady => 1);

	my $dc_width = 700;
	my $dc = $dsw->Scrolled('Canvas',
							-scrollbars => 'osoe',
							-width  => $dc_width,
							-height => 400,
							-relief => 'sunken',
							-bd => $config{Borderwidth})->pack(-expand => 1,-fill => 'both',-padx => 1, -pady => 1);

	my $height = 16;
	$dc->configure(-scrollregion => [0, 0, $dc_width, ($#alldirs * $height)]);

	$max = 1 if ($max <= 0); # avoid divison by zero
	my $scale =  ($dc_width - 2)/$max;

	my $y = 2;
	my $x = 2;
	foreach my $dir (sort keys %dirsize) {
		$dc->createRectangle( $x, $y, $x + ($dirsize{$dir} * $scale), $y+$height,
							-tags => ['RECT'],
							#-outline => undef,
							-outline => 'black',
							-fill => 'goldenrod3',
						  );
		my $text = sprintf "%6s", computeUnit($dirsize{$dir});
		$dc->createText( $x+1,  $y+1, -text => $text, -anchor => 'nw');
		$dc->createText( $x+50, $y+1, -text => $dir,  -anchor => 'nw');
		$y += $height;
	}

	$max = computeUnit($max);
	#$allsize = computeUnit($allsize);
	$label = "Ready! $dirCount folders, $fileCount files, (max folder size: $max)";

	$dsw->waitWindow;
}

##############################################################
# setProperty
##############################################################
sub setProperty($$$) {
	my $lb    = shift;
	my $prop  = shift;
	my $value = shift;
	my @dirs  = $lb->info('selection');
	return unless checkSelection($dpw, 1, 0, \@dirs);

	if ((!defined $value) or ($value < 0) or ($value > 1)) {
		warn "wrong value $value";
		return;
	}

	if ((!defined $prop) or (($prop ne 'SORT') and ($prop ne 'META') and ($prop ne 'PRIO') and ($prop ne 'ALL'))) {
		warn "wrong property $prop";
		return;
	}

	foreach my $dir (@dirs) {
		# set property to given value
		unless ($prop eq 'ALL') {
			$dirProperties{$dir}{$prop} = $value;
		}
		else {
			$dirProperties{$dir}{SORT} = $value;
			$dirProperties{$dir}{META} = $value;
			$dirProperties{$dir}{PRIO} = $value;
		}
		# show changed property
		my $style = $iptcS;
		$style = $exifS if (defined $dirProperties{$dir}{SORT} and
							defined $dirProperties{$dir}{META} and
							defined $dirProperties{$dir}{PRIO} and
							$dirProperties{$dir}{SORT} == 1 and
							$dirProperties{$dir}{META} == 1 and
							$dirProperties{$dir}{PRIO} == 1);
		$lb->itemConfigure($dir, $lb->{dircol},  -text => $dir,                       -style => $style);
		$lb->itemConfigure($dir, $lb->{sortcol}, -text => $dirProperties{$dir}{SORT}, -style => $comS);
		$lb->itemConfigure($dir, $lb->{metacol}, -text => $dirProperties{$dir}{META}, -style => $iptcS);
		$lb->itemConfigure($dir, $lb->{priocol}, -text => $dirProperties{$dir}{PRIO}, -style => $comS);
		$lb->itemConfigure($dir, $lb->{commcol}, -text => $dirProperties{$dir}{COMM}, -style => $iptcS);
	}
}

##############################################################
# selectDirInTree
##############################################################
sub selectDirInTree {
  my $dir = shift;
  $dir = Encode::encode('iso-8859-1', $dir);
  
  $dirtree->selectionClear();
  if ($dirtree->info('exists', "/$dir")) {
	$dirtree->selectionSet("/$dir");
	$dirtree->show('entry', "/$dir");
  }
  elsif ($dirtree->info('exists', $dir)) {
	$dirtree->selectionSet($dir);
	$dirtree->show('entry', $dir);
  }
}

##############################################################
# dirSave - save the last used dirs, build a hotlist of
#           often used dirs and update the dir menu
##############################################################
sub dirSave {
  my $dir = shift;

  return if ($dir eq $trashdir);

  # check if dir is already in history list
  my $i = 0;
  foreach (@dirHist) {
	if ($_ eq $dir) {
	  splice @dirHist, $i, 1; # throw old entry away
	  last;
	}
	$i++;
  }
  # add dir to history list
  push @dirHist, $dir;

  # no more than 10 entries in history list
  if (@dirHist > 10) {
	shift @dirHist;
  }

  # count the number of accesses to each dir
  if (defined $dirHotlist{$dir}) {
	$dirHotlist{$dir}++;
  }
  else {
	$dirHotlist{$dir} = 1;
  }

  updateDirMenu();
}

##############################################################
# clearLabels - clear the labels containing infos about the
#               actual picture
##############################################################
sub clearLabels {
  # show index number in window
  $nrof          = "0/0 (0)";
  $widthheight   = "";
  $size          = "";
  $zoomFactorStr = "";
  $urgencyStr    = "";
  $urgencyScale  = 0;
}

##############################################################
# dirDialog - open a window and a dir tree
##############################################################
sub dirDialog {
  my $dir = shift;
  $dir = Encode::encode('iso-8859-1', $dir);
  
  if ($EvilOS) {
	if  ($win32FOAvail) {
	  print "FileOp is available!\n" if $verbose;
	  # this is untested!!! todo
	  $dir = BrowseForFolder("Choose folder", "CSIDL_DESKTOP");
	  $dir =~ s|\\|/|g;			# perl likes the slashes like this
	  return $dir;
	}
	else { # windows, but no win32 FileOp available
	  print "FileOp is not available!\n" if $verbose;
#	  checkDialog('Select file instead of folder',
#				  'There is no folder selector available, so please select a file instead of the folder.
#You may use any file, Mapivi will use the folder of that file.
#If the folder is empty, you may create a new file and select this.
#Sorry for that inconvenience!

#Example:
#To use the folder C:\pictures\2006\ select e.g. C:\pictures\2006\pic1.jpg',
#				  \$config{winDirRequesterAskAgain},
#				  "remind everytime",
#				  "",
#				  'OK') if ($config{winDirRequesterAskAgain});

#	  my $file = $top->getOpenFile();       # little tricky here
#	  if ((defined $file) and (-f $file)) { # until there is no win folder dialog
#		$dir = dirname($file);              # we take a file and jump to the dir of that file
#	  }                                     # but empty dirs are a problem!!!
#	  else {
#		$dir = "";
#	  }

	  $dir = $top->chooseDirectory(-title => "Select folder", -initialdir => $dir);
	  $dir = '' unless (defined $dir);
	  $dir = '' unless (-d $dir);
	  return $dir;
	}
  } else { # non windows system
	# code based on Tk::chooseDirectory
	my $t = $top->Toplevel;
	$t->withdraw;
	$t->title('Open folder ...');
	$t->iconimage($mapiviicon) if $mapiviicon;
	my $ok = 0;					# flag: "1" means OK, "0" means cancelled

	# Create Frame widget before the DirTree widget, so it's always visible
	# if the window gets resized.
	my $f = $t->Frame->pack(-fill => 'x', -side => "bottom");

	my $d;

	my $mkdB = $t->Button(-text => 'Make new folder',
						  -command => sub { makeNewDir($dir, $d); })->pack(-fill => 'x');
	$balloon->attach($mkdB, -msg => "The new folder will be created underneath the selected folder.\nSo, please select a folder in the tree first");

	$d = $t->Scrolled('DirTree',
					  -scrollbars => 'osoe',
					  -showhidden => $config{ShowHiddenDirs},
					  -selectmode => 'browse',
					  -exportselection => 1,
					  -browsecmd => sub {
						# this function will show all subdirs when pressing on the + sign
						$dir = shift;
						$dir = Encode::encode('iso-8859-1', $dir);
						return if (@_ >= 1);
						if (!-d $dir) { print "dirDialog: $dir does not exists!\n"; return; }
						$t->Busy;
						my @dirs = getDirs($dir);
						$t->Unbusy;
						return if (@dirs < 1);
						$t->Busy;
						my $lastdir = $dir.'/'.$dirs[-1];
						if ($d->info('exists', "$lastdir")) {
						  $d->see($lastdir) if (-d $lastdir);
						}
						$t->Unbusy;
					  },
					  # With this version of -command a double-click will
					  # select the folder
					  -command   => sub { $ok = 1; $t->destroy; },
					  # With this version of -command a double-click will
					  # open a folder. Selection is only possible with
					  # the Ok button.
					  #-command   => sub { $d->opencmd($_[0]) },
					 )->pack(-fill => "both", -expand => 1);
	# Set the initial folder
	exists &Tk::DirTree::chdir ? $d->chdir($dir) : $d->set_dir($dir);

	$f->Button(-text => 'Ok',
			   -command => sub { $ok = 1; $t->destroy; })->pack(-side => 'left',-fill => 'x', -expand => 1);
	$f->Button(-text => 'Cancel',
			   -command => sub { $ok = 0; $t->destroy; })->pack(-side => 'left',-fill => 'x', -expand => 1);

	# file and dir requester should always be big! (50% of screenwidth and 90% of screenheight)
	my $w = int(0.5 * $t->screenwidth);
	my $h = int(0.9 * $t->screenheight);
	$t->geometry("${w}x${h}+0+0");
	$t->deiconify;
	$t->raise;

	$f->waitWindow();
	$t->destroy() if (Exists($t));
	$dir = "" if ($ok != 1);
	return $dir;
  }
}

##############################################################
# printUsage - show the user how to use mapivi
##############################################################
sub printUsage {
	print "\nUsage: mapivi [-i] [file|folder]\n";
	print "\n               -i start with import wizard\n";
}

##############################################################
# touch - set the modification date of the given file to the
#         actual date and time
##############################################################
sub touch {
  my $file   = shift;
  my $now    = time;
  utime($now, $now, $file);
}

##############################################################
# addComment - add a comment to all selected pics in the given
#              listbox
##############################################################
sub addComment($) {
  my $lb = shift;    # the reference to the active listbox widget

  my @sellist = $lb->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);

  my ($dpic, $i);

  $userinfo = "adding comments to ".scalar @sellist." pictures"; $userInfoL->update;

  # check if some files are links
  return if (!checkLinks($lb, @sellist));

  my $info = "Please enter comment to add to the ".scalar @sellist." selected pictures";
  my $text = "";
  my $thumb = "";

  # if just one pic should be commented we show the thumbnail and the real name
  if (@sellist == 1) {
	$thumb = getThumbFileName($sellist[0]);
	$info  = "Please enter comment to add to ".basename($sellist[0]);
  }

  my $rc = myTextDialog("Add comment", $info, \$text, $thumb);
  return if ($rc ne 'OK' or $text eq "");
  # replace (german) umlaute by corresponding letters
  # (a lot of programs seem to have problems with Umlauten in comments)
  $text =~ s/([$umlaute])/$umlaute{$1}/g if ($config{ConvertUmlaut});
  $config{Comment} = $text; # save changed comment to global config hash

  my $pw = progressWinInit($lb, "Add comment");
  $i = 0;
  foreach $dpic (@sellist) {
	last if progressWinCheck($pw);
	$i++;
	progressWinUpdate($pw, "adding comment ($i/".scalar @sellist.") ...", $i, scalar @sellist);
	next if (!checkWriteable($dpic));

	addCommentToPic($text, $dpic, TOUCH); # touch thumbnail

	updateOneRow($dpic, $lb);
	showImageInfo($dpic) if ($dpic eq $actpic);
  }
  progressWinEnd($pw);

  $userinfo = "ready! ($i of ".scalar @sellist." commented)"; $userInfoL->update;
}

##############################################################
# grayscalePic
##############################################################
sub grayscalePic {
	my $lb = shift;    # the reference to the active listbox widget

	# check if ImageMagick convert version is at least or bigger than 6
	if ((`convert 2>&1` =~ m/.*ImageMagick (\d+)\.(\d+)\.(\d+).*/) and ($1 < 6)) {
	  $top->messageBox(-icon => 'warning', -message => "Sorry, but for these function you need at least ImageMagick (convert) in version 6.x.x. You have $1.$2.$3.\nPlease download at http://www.imagemagick.org.", -title => "Wrong ImageMagick version ($1.$2.$3)", -type => 'OK');
	  return;
	}

	#return if (!checkExternProgs("grayscalePic", "jpegtran"));

	my @sellist = $lb->info('selection');
	return unless checkSelection($top, 1, 0, \@sellist);

	# check if some files are links
	return if (!checkLinks($lb, @sellist));

	my $rc = 0;

	# open window
	my $win = $top->Toplevel();
	$win->title('Convert to B/W');
	$win->iconimage($mapiviicon) if $mapiviicon;

	my $topF    = $win->Frame()->pack(-expand => 1, -fill =>'both', -padx => 5);
	my $picF    = $topF->Frame(-height => $config{FilterPrevSize}, -width => $config{FilterPrevSize})->pack(-side => 'left', -expand => 1, -fill =>'both');
	my $presetF = $topF->Frame()->pack(-side => 'left', -expand => 1, -fill =>'both');

	$win->{status} = $picF->Label(-textvariable => \$win->{label})->pack();

	my $w = 18;
	labeledScale($win, 'top', $w, "Red channel (%)", \$config{ChannelRed}, -100, 200, 1);
	labeledScale($win, 'top', $w, "Green channel (%)", \$config{ChannelGreen}, -100, 200, 1);
	labeledScale($win, 'top', $w, "Blue channel (%)", \$config{ChannelBlue}, -100, 200, 1);

	my $original_pic      = $sellist[0];
	my $preview_start_pic = $trashdir.'/'.basename($original_pic).'-start';
	my $preview_pic       = $trashdir.'/'.basename($original_pic);
	my $preview_photo;

	$win->Button(-text => "update",
				 -command => sub {
				  $win->Busy;
				  $win->{label} = "preparing preview ...";
				  return if (!mycopy ($preview_start_pic, $preview_pic, OVERWRITE));
				  grayscalePicInt($preview_pic, PREVIEW);
				  $preview_photo = $win->Photo(-file => $preview_pic, -gamma => $config{Gamma});
				  $win->{photo}->configure(-image => $preview_photo);
				  $win->{label} = "preview finished";
				  $win->Unbusy;
				 })->pack();

	$presetF->Label(-text => 'Presets')->pack();

	my $preset = 
	$presetF->Scrolled('Listbox',
				   -scrollbars => 'osoe',
				   -selectmode => 'single',
				   -exportselection => 0,
				   -width      => 20,
				   -height     => 10,
				   )->pack(-expand => 1, -fill =>'both', -padx => 2, -pady => 2);
  bindMouseWheel($preset->Subwidget("scrolled"));

  # preset for channel mixer (hash of lists HoL; list is red, green , blue = RGB)
  my %channel_mixer = (
					   'Filter Yellow'    => [30, 70, 20],
					   'Filter Orange'    => [78, 22,  0],
					   'Filter Red'       => [75,  0, 25],
					   'Filter Red II'    => [150,-25,-25],
					   'Filter Red 25a'   => [200, 0,-100],
					   'Filter Green'     => [20, 60, 40],
					   'Normal 1'         => [30, 59, 11],
					   'Normal 2'         => [80, 15,  5],
					   'Normal 3'         => [70, 20, 10],
					   'Normal 4'         => [80, 20,-20],
					   'Normal 5'         => [65, 25, 10],
					   'Contrast High'    => [40, 34, 60],
					   'Contrast Normal'  => [43, 33, 30],
					   );


  $preset->insert('end', (sort keys %channel_mixer));
  $preset->bind('<Button-1>', sub {
	  my @sel = $preset->curselection();
	  my $key = $preset->get($sel[0]);
	  $config{ChannelRed}   = @{$channel_mixer{$key}}[0];
	  $config{ChannelGreen} = @{$channel_mixer{$key}}[1];
	  $config{ChannelBlue}  = @{$channel_mixer{$key}}[2];
      $win->update();
	  $win->Busy;
	  $win->{label} = "preparing preview ...";
	  return if (!mycopy ($preview_start_pic, $preview_pic, OVERWRITE));
	  grayscalePicInt($preview_pic, PREVIEW);
	  $preview_photo = $win->Photo(-file => $preview_pic, -gamma => $config{Gamma});
	  $win->{photo}->configure(-image => $preview_photo);
	  $win->{label} = "preview finished";
	  $win->Unbusy;
  } );

	$win->Checkbutton(-variable => \$config{ChannelBright}, -text => "Keep brightness")->pack(-anchor=>'w', -padx => 5, -pady => 3);

  my $decoF = $win->Frame()->pack(-fill =>'x', -padx => 5);
	$decoF->Checkbutton(-variable => \$config{ChannelDeco},
						-anchor => 'w',
						-text => "Add border or text (not visible in preview)")->pack(-side => "left", -anchor => 'w', -fill => 'x', -expand => 1);
	$decoF->Button(-text => "Options",
				   -anchor => 'w',
				   -command => sub {decorationDialog(scalar @sellist,0);})->pack(-side => "left", -anchor => 'w', -padx => 3);
	
  buttonBackup($win, 'top');

  my $qs = labeledScale($win, 'top', 18, "Quality (%)", \$config{PicQuality}, 10, 100, 1);
  qualityBalloon($qs);

	my $plural = 's'; $plural = '' if (@sellist == 1);
	$win->Label(-text => "Convert ".scalar @sellist." selected picture$plural to grayscale (B/W) picture$plural.\nPress OK to continue.")->pack();

	my $but_frame =
		$win->Frame()->pack(-fill =>'x');

	my $ok_but =
		$but_frame->Button(-text => 'OK',
						   -command => sub {
							   $rc = 1;
							   $win->withdraw();
							   $win->destroy();
						   })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 2, -pady => 3);
	my $x_but =
		$but_frame->Button(-text => 'Cancel',
						   -command => sub {
							   $win->withdraw();
							   $win->destroy();
						   })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 2, -pady => 3);

	$win->{label} = "preparing preview ...";
	$win->Popup(-popover => 'cursor');
	repositionWindow($win);
	$win->Busy;
	$win->update;

	return if (!mycopy   ($original_pic,      $preview_start_pic, OVERWRITE));
	return if (!resizePic($preview_start_pic, $config{FilterPrevSize}, $config{FilterPrevSize}, 80));
	return if (!mycopy   ($preview_start_pic, $preview_pic,       OVERWRITE));
	grayscalePicInt($preview_pic, PREVIEW);
	$preview_photo = $win->Photo(-file => $preview_pic, -gamma => $config{Gamma});
	$win->{photo} = $picF->Label(-image => $preview_photo, -relief => "sunken",
			   )->pack(-padx => 3, -pady => 3);
	$win->{label} = "preview finished";
	$win->Unbusy;
	$win->waitWindow;

	return unless ($rc);

	$userinfo = "converting ".scalar @sellist." pictures to grayscale"; $userInfoL->update;

	my $pw = progressWinInit($lb, "Convert to grayscale");
	my $i = 0;
	foreach my $dpic (@sellist) {
		last if progressWinCheck($pw);
		progressWinUpdate($pw, "converting ($i/".scalar @sellist.") this may take a while ...", $i, scalar @sellist);
		next if (!checkWriteable($dpic));
		next if (!makeBackup($dpic));

		grayscalePicInt($dpic, NO_PREVIEW);

		$i++;
		progressWinUpdate($pw, "converting ($i/".scalar @sellist.") ...", $i, scalar @sellist);

		updateOneRow($dpic, $lb);
		showImageInfo($dpic) if ($dpic eq $actpic);
	    showPic($dpic) if ($dpic eq $actpic); # redisplay the picture if it is the actual one
	}
	progressWinEnd($pw);
	
        reselect($lb, @sellist);
	$userinfo = "ready! ($i of ".scalar @sellist." converted)"; $userInfoL->update;
	generateThumbs(ASK, SHOW);
	$preview_photo->delete if $preview_photo;
}

##############################################################
# grayscalePicInt
##############################################################
sub grayscalePicInt {
  my $dpic    = shift;
  my $preview = shift;
  my $sum     = 100;

  if ($config{ChannelBright}) {
	$sum = $config{ChannelRed}+$config{ChannelGreen}+$config{ChannelBlue};
  }
  $sum = 1 if ($sum == 0); # avoid division by zero

  my $command = "convert ";
  $command .= " \"$dpic\" -fx \"(r*$config{ChannelRed}+g*$config{ChannelGreen}+b*$config{ChannelBlue})/$sum\" ";
  # windows needs the " instead of '
  #\'(r*$config{ChannelRed}+g*$config{ChannelGreen}+b*$config{ChannelBlue})/$sum\'  ";
  $command .= makeDrawOptions($dpic) if ($config{ChannelDeco} and !$preview);
  $command .= " \"$dpic\" ";

  print "grayscalePicInt: command: $command\n" if $verbose;
  execute($command);
}

##############################################################
# updateOneRow - update the (changed) metainfo of one picture
#                in the given listbox and store them in the
#                search database
##############################################################
sub updateOneRow($$) {
  my $dpic = shift; # pic with path
  my $lb   = shift; # the listbox reference

  return unless (-f $dpic);

  # check if listbox entry exists
  unless ($lb->info('exists', $dpic)) {
	warn "entry $dpic not found in listbox!";
	return;
  }
  my $iptc = ''; my $exif = ''; my $com = ''; my $size = '';
  my $meta = addToSearchDB($dpic);  # save meta data of picture into the search data base

  $com     = $searchDB{$dpic}{COM};
  $exif    = $searchDB{$dpic}{EXIF};
  $iptc    = displayIPTC($dpic); 
  $size    = getAllFileInfo($dpic);

  $com     = formatString($com,  $config{LineLength}, $config{LineLimit}); # format the comment for the list
  $iptc    = formatString($iptc, $config{LineLength}, $config{LineLimit}); # format the IPTC info for the list

  # update the metainfo in the listbox
  $lb->itemConfigure($dpic, $lb->{thumbcol}, -text => getThumbCaption($dpic)) if (defined $lb->{thumbcol});
  $lb->itemConfigure($dpic, $lb->{comcol},   -text => $com)  if (defined $lb->{comcol});
  $lb->itemConfigure($dpic, $lb->{exifcol},  -text => $exif) if (defined $lb->{exifcol});
  $lb->itemConfigure($dpic, $lb->{iptccol},  -text => $iptc) if (defined $lb->{iptccol});
  $lb->itemConfigure($dpic, $lb->{filecol},  -text => $size) if (defined $lb->{filecol});
}

##############################################################
# addCommentToPic - add a comment to a single picture
##############################################################
sub addCommentToPic($$$) {

  my $com    = shift;
  my $dpic   = shift;
  my $touch  = shift; # TOUCH = touch thumbnail, NO_TOUCH
  return if (!-f $dpic);

  # check if file is a link and get the real target
  return if (!getRealFile(\$dpic));

  my $meta = getMetaData($dpic, "COM");
  return unless ($meta);

  printf "addCommentToPic: %-30s %s\n", cutString($com,30,".."), $dpic if $verbose;

  #$com = encode("utf8", $com);
  $meta->add_comment($com);
  unless ($meta->save()) { warn "addCommentToPic: save $dpic failed!"; }

  # touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time
  touch(getThumbFileName($dpic)) if ($touch == TOUCH);

  addToSearchDB($dpic);
}

##############################################################
# replaceComment - search/replace a string in a comment to all
#                  selected pics in the given listbox
##############################################################
sub replaceComment {
  my $lb = shift;    # the reference to the active listbox widget

  my @sellist = $lb->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);

  my ($dpic, $dthumb, $i, $j, $pic, $meta, @com, $replace, $spat, $stextd, $rtextd);

  $userinfo = "replacing comments in ".scalar @sellist." pictures"; $userInfoL->update;

  # check if some files are links
  return if (!checkLinks($lb, @sellist));

  my $info  = "Please enter the string to replace in the ".scalar @sellist." selected pictures";
  my $stext = $config{SearchPattern}; # search string
  my $rtext = '';                     # replace string

  # if just one pic should be commented we show the real name
  if (@sellist == 1) {
	$info  = "Please enter the string to replace in ".basename($sellist[0]);
  }

  my $test = 1;
  while ($test) {
	# todo: one search/replace dialog with upper/lower case support
	my $rc = myReplaceDialog("Replace comment", $info, \$stext, \$rtext);
	return if (($rc eq 'Cancel') or ($stext eq ''));
	$test = 0 if ($rc eq 'OK');
	$config{SearchPattern} = $stext;
	# replace (german) umlaute by corresponding letters
	# (a lot of programs seem to have problems with Umlauten in comments)
	$stext =~ s/([$umlaute])/$umlaute{$1}/g if ($config{ConvertUmlaut});
	$rtext =~ s/([$umlaute])/$umlaute{$1}/g if ($config{ConvertUmlaut});
	$spat  = makePattern($stext);

	$config{Comment} = $rtext; # save changed comment to global config hash

	my $nocom = "";
	my $nostr = "";
	my $countComments = 0;
	my $countFiles = 0;
	my $pw = progressWinInit($lb, "Replace comments");
	$i = 0;
	foreach $dpic (@sellist) {
	  last if progressWinCheck($pw);
	  $i++;
	  progressWinUpdate($pw, "replacing comments ($i/".scalar @sellist.") ...", $i, scalar @sellist);

	  $pic      = basename($dpic);
	  print "replaceComment: pic:$pic\n" if $verbose;
	  $dthumb   = getThumbFileName($dpic);
	  next if (!checkWriteable($dpic));

	  $meta = getMetaData($dpic, "COM");
	  unless ($meta) {
		$nocom .= "$dpic\n";
		next;
	  }

	  @com  = getComments($dpic, $meta); # get all comments from the file
	  unless (@com) {
		$nocom .= "$dpic\n";
		next;
	  }

	  $replace = 0;
	  for $j (0 .. $#com) {
		if ($com[$j] =~ m/$spat/) { # todo handle lower/uppercase
		  unless ($test) {
			print "replacing $stext with $rtext in $pic: -$com[$j]- " if $verbose;
			$com[$j] =~ s/$spat/$rtext/g;
			print "to -$com[$j]-\n" if $verbose;
			$meta->set_comment($j, $com[$j]);
		  }
		  $replace++;
		  $countComments++;
		}
	  }
	  if ($replace > 0) {
		unless ($test) {
		  unless ($meta->save()) {
			warn "replaceComment: save $pic failed!";
		  }
		  # touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time
		  touch($dthumb);
		  updateOneRow($dpic, $lb);
		}
		$countFiles++;
	  } else {
		$nostr .= "$dpic\n";
	  }

	}
	progressWinEnd($pw);

	# short the strings for better output
	$stextd = cutString($stext, 20, "..");
	$rtextd = cutString($rtext, 20, "..");
	my $text = "Replaced ";
	$text = "Test mode:\nMapivi would replace " if $test;
	$text .= "the string \"$stextd\" with \"$rtextd\"\nin $countComments comments of $countFiles pictures\n\n";
	if (($nocom ne "") or ($nostr ne "")) {
	  $text .= "Found no comments in these pictures:\n$nocom\n" if ($nocom ne "");
	  $text .= "Found no string matching \"$stextd\" in these pictures:\n$nostr\n" if ($nostr ne "");
	}
	showText("Replace comment log", $text, WAIT);
  }
  $userinfo = "ready! ($i of ".scalar @sellist." pictures processed)"; $userInfoL->update;
}

##############################################################
# nameToComment - add the filename as comment to all selected
#                 pictures
##############################################################
sub nameToComment {

  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);
  my $selected = @sellist;
  my ($pic, $dpic, $dirthumb, $i, $com);

  my $dia = $top->DialogBox(-title => "Add filename to comment",
							-buttons => ['OK', 'Cancel']);
  $dia->add("Label", -text => "This function will add a comment containing\nthe individual filename of $selected pictures!", -bg => $config{ColorBG}, -justify => "left")->pack;
  $dia->add("Checkbutton", -text => "Remove suffix (.jpg)", -variable => \$config{NameComRmSuffix})->pack;
  my $rc  = $dia->Show();
  $top->focusForce;
  return if ($rc ne 'OK');

  $userinfo = "adding filename as comment of $selected pictures"; $userInfoL->update;

  # check if some files are links
  return if (!checkLinks($picLB, @sellist));

  my $pw = progressWinInit($top, "Adding file name as comment");
  $i = 0;
  foreach $dpic (@sellist) {
	last if progressWinCheck($pw);
	$i++;
	progressWinUpdate($pw, "Adding file name ($i/$selected) ...", $i, $selected);
	$pic      = basename($dpic);
	$dirthumb = getThumbFileName($dpic);
	$com      = $pic;

	next if (!checkWriteable($dpic));

	if (($config{NameComRmSuffix}) and ($pic =~ /(.*)(\.jp(g|eg))/i)) {
	  $com = $1;  # remove .jp(e)g suffix
	}

	# check if file is a link and get the real target
	next if (!getRealFile(\$dpic));

	my $meta = getMetaData($dpic, "COM");
	next unless ($meta);
	$meta->add_comment($com);
	unless ($meta->save()) { warn "nameToComment: save $pic failed!"; }

	# touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time
	touch($dirthumb);

	updateOneRow($dpic, $picLB);
	showImageInfo($dpic) if ($dpic eq $actpic);
  }
  progressWinEnd($pw);
  $userinfo = "ready! ($i of $selected processed)"; $userInfoL->update;
}

##############################################################
# showComment - show the comment of all selected pictures
##############################################################
sub showComment {

  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);
  return unless askSelection(\@sellist, 10, "comment");
  my $selected = @sellist;
  my $nocomment = "";
  my ($pic, $dpic, $i, $plural, $thumb);

  $userinfo = "displaying JPEG comments of $selected pictures"; $userInfoL->update;

  my $pw = progressWinInit($top, "Display comments");
  $i = 0;
  foreach $dpic (@sellist) {
	last if progressWinCheck($pw);
	$i++;
	progressWinUpdate($pw, "displaying comment ($i/$selected) ...", $i, $selected);
	$pic      = basename($dpic);
	$thumb    = getThumbFileName($dpic);

	# check if file is a link and get the real target
	next if (!getRealFile(\$dpic));

	my @comments = getComments($dpic);
	my $comment  = "";

	foreach (@comments) {
	  $comment .= "$_\n";
	}

	(@comments > 1) ? ($plural = "s") : ($plural = "");
	if ($comment ne "") {
	  showText("$pic contains ".scalar @comments." comment$plural", $comment, NO_WAIT, $thumb);
	}
	else {
	  $nocomment .= "$pic\n";
	}
  }
  progressWinEnd($pw);

  if ($nocomment ne "") {
	showText("no comments", "no comments in:\n$nocomment", NO_WAIT);
  }
  $userinfo = "ready! ($i of $selected displayed)"; $userInfoL->update;
}

##############################################################
# addDecoration
##############################################################
sub addDecoration {

  return if (!checkExternProgs("addDecoration", "mogrify"));

  my $index = shift;
  my @sellist;
  if ((defined $index) and ($index >= 0) and ($index < $picLB->info('children'))) {
	push @sellist, $index;
  }
  else {
	@sellist = $picLB->info('selection');
  }
  my $selected = @sellist;
  my ($dpic, $i, $command);

  return unless checkSelection($top, 1, 0, \@sellist);

  $userinfo = "adding decorations to $selected pictures"; $userInfoL->update;

  # check if some files are links
  return if (!checkLinks($picLB, @sellist));

  return if (!decorationDialog($selected,1));

  my $pw = progressWinInit($top, "Adding decoration");
  $i = 0;
  foreach $dpic (@sellist) {
	last if progressWinCheck($pw);
	$i++;
	progressWinUpdate($pw, "adding decorations ($i/$selected) ...", $i, $selected);

	# check if file is a link and get the real target
	next if (!getRealFile(\$dpic));

	next if (!checkWriteable($dpic));

	next if (!makeBackup($dpic));

	$command = "mogrify ".makeDrawOptions($dpic)."-quality ".$config{PicQuality}." \"$dpic\"";
	execute($command);

	addDropShadow($dpic);

	deleteCachedPics($dpic);
	showPic($dpic) if ($dpic eq $actpic); # redisplay the picture if it is the actual one
	updateOneRow($dpic, $picLB);
  }
  progressWinEnd($pw);
  reselect($picLB, @sellist);
  $userinfo = "ready! ($i of $selected)"; $userInfoL->update;
  generateThumbs(ASK, SHOW);
}

##############################################################
# addDropShadow - to be called after makeDrawOptions and
#                 mogrify
#                 operates on the pic directly
#                 a backup has to be made before
##############################################################
sub addDropShadow {
  my $dpic = shift;
  return unless (-f $dpic);
  return unless ($config{DropShadow});

  my $b4 = $config{DropShadowWidth} * 4;
  my $b3 = $config{DropShadowWidth} * 3;
  my $command = "convert -depth 8 -colors 1 -gamma 0 \"$dpic\" -bordercolor \"".$config{DropShadowBGColor}."\" -border ${b4}x${b4} -gaussian 0x".$config{DropShadowBlur}." -shave ${b3}x${b3} - | composite -quality ".$config{PicQuality}." -gravity northwest \"$dpic\" - \"$dpic\"";
  #(system "$command") == 0 or warn "$command failed: $!";
  print "addDropShadow: $command\n" if $verbose;
  execute($command);
}

##############################################################
# makeDrawOptions
##############################################################
sub makeDrawOptions {

  my $dpic    = shift;
  my $command = "";
  my $x = $config{CopyX};
  my $y = $config{CopyY};

  if ($config{BorderAdd}) {
	$command .= '-bordercolor "'.$config{BorderColor1}.'" -border '.$config{BorderWidth1x}.'x'.$config{BorderWidth1y}.' ';
	$command .= '-bordercolor "'.$config{BorderColor2}.'" -border '.$config{BorderWidth2x}.'x'.$config{BorderWidth2y}.' ' if (($config{BorderWidth2x} > 0) or ($config{BorderWidth2y} > 0));
	$command .= '-bordercolor "'.$config{BorderColor3}.'" -border '.$config{BorderWidth3x}.'x'.$config{BorderWidth3y}.' ' if (($config{BorderWidth3x} > 0) or ($config{BorderWidth3y} > 0));
	$command .= '-bordercolor "'.$config{BorderColor4}.'" -border '.$config{BorderWidth4x}.'x'.$config{BorderWidth4y}.' ' if (($config{BorderWidth4x} > 0) or ($config{BorderWidth4y} > 0));
  }

  if ($config{CopyAdd}) {

	if ($config{CopyTextOrLogo} eq "text") {       # text

	  $command .= "-gravity $config{CopyPosition} ";

	  my $geo1 = ($x+1).",".($y+1);
	  my $geo2 = "$x,$y";
	  print "drawoptions: x = $x y = $y geo1 = $geo1 geo2 = $geo2\n" if $verbose;

	  $command .= "-font '-*-".$config{CopyFontFamily}."-medium-r-*-*-".$config{CopyFontSize}."-*-*-*-*-*-iso8859-*'  ";
	  $command .= "-fill \"".$config{CopyFontColBG}."\" -draw 'text $geo1 \"".$config{Copyright}."\"' " if $config{CopyFontShadow};
	  $command .= "-fill \"".$config{CopyFontColFG}."\" -draw 'text $geo2 \"".$config{Copyright}."\"' ";
	}
	else {                                              # logo image
	  my ($lw, $lh) = getSize($config{CopyrightLogo});
	  my ($pw, $ph) = getSize($dpic);
	  if ($config{BorderAdd}) { # calc new size of pic (including borders)
		$pw += 2 * $config{BorderWidth1x};
		$pw += 2 * $config{BorderWidth2x};
		$pw += 2 * $config{BorderWidth3x};
		$ph += 2 * $config{BorderWidth1y};
		$ph += 2 * $config{BorderWidth2y};
		$ph += 2 * $config{BorderWidth3y};
	  }
	  if ($config{CopyPosition} eq 'NorthEast') {
		$x = $pw - $lw - $x;
	  } elsif ($config{CopyPosition} eq 'North') {
		$x = $pw/2 - $lw/2 - $x;
	  } elsif ($config{CopyPosition} eq 'SouthWest') {
		$y = $ph - $lh - $y;
	  } elsif ($config{CopyPosition} eq 'South') {
		$y = $ph - $lh - $y;
		$x = $pw/2 - $lw/2 - $x;
	  } elsif ($config{CopyPosition} eq 'SouthEast') {
		$y = $ph - $lh - $y;
		$x = $pw - $lw - $x;
	  }

	  $x = int($x); $y = int($y);
	  my $geo = "$x,$y";

	  $command .= "-draw \"image Over $geo $lw,$lh '".$config{CopyrightLogo}."'\" ";
	}
  }

  print "command == $command\n" if $verbose;

  return $command;
}

##############################################################
# buildBackupName
##############################################################
sub buildBackupName($) {
  my $bpic = shift;
  $bpic    =~ s/(.*)\.(.*)/$1-bak.$2/i;
  return $bpic;
}

##############################################################
# getBasenameSuffix
##############################################################
sub getBasenameSuffix {
	my $suffix;
	my $base;
	my $file = shift;
	my @parts = split /\./, $file;
	if (@parts > 1) {
		$suffix = $parts[-1];
		$base = substr($file, 0, length($file)-length($suffix)-1);
	}
	else {
		$suffix = '';
		$base = $file;
	}

	return ($base, $suffix);
}

##############################################################
# makeBackup
##############################################################
sub makeBackup($) {
  my $dpic = shift;

  return 0 if (!-f $dpic);
  return 1 if (!$config{MakeBackup});

  my $dir    = dirname($dpic);
  my $dthumb = getThumbFileName($dpic);
  my $bpic   = buildBackupName($dpic);
  # make a backup file
  if (!mycopy("$dpic", "$bpic", ASK_OVERWRITE)) {
	my $rc =
	  $top->messageBox(-icon  => 'question', -message => "Proceed anyway?",
					   -title => "Proceed?", -type => 'OKCancel');
	if ($rc =~ m/Ok/i) {
	  return 1;
	}
	else {
	  return 0;
	}
  }
  # copy the thumbnail too
  mycopy($dthumb, getThumbFileName($bpic), OVERWRITE);

  if (!-f $bpic) {
	warn "backup failed, there is no $bpic, giving up ...";
	return 0;
  }
  else {
	# copy meta info in search database (needed e.g. for nr. of views)
	$searchDB{$bpic} = $searchDB{$dpic};
	# insert backup in listbox
	addOneRow($picLB, $bpic, 1, $dpic);
  }
  return 1;
}

##############################################################
# getImageMagickFonts - get the font families supported by IM
##############################################################
sub getImageMagickFonts {

  return if (!checkExternProgs('getImageMagickFonts', 'identify'));
  my $fonts = `identify -list type`;
  my %families;

  my @lines = split(/\n/, $fonts);
  foreach my $line (@lines) {
    #print "line = $line\n";
    # \s = whitespace \S = non-whitespece  \d = number
    if ($line =~ m |(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\d+)|) {
      $families{$2} = 1;
    }
  }
  my @font_families = sort keys(%families);
  #print "font_families: $_\n" foreach (@font_families);
  return @font_families;
}

my $decoW;
##############################################################
# decorationDialog
##############################################################
sub decorationDialog {

  if (Exists($decoW)) {
	$decoW->deiconify;
	$decoW->raise;
	return;
  }

  my $pics  = shift;
  my $QandB = shift; # bool - show Quality-Scale and Backup-Checkbutton
  my $rc   = 0;
  my $max  = 1000;

  #my @fontFamilies = sort $top->fontFamilies;
  my @fontFamilies = getImageMagickFonts();

  # open window
  $decoW = $top->Toplevel();
  $decoW->title('Add border/copyright/shadow');
  $decoW->iconimage($mapiviicon) if $mapiviicon;

  my $addF = $decoW->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-anchor => 'w', -fill => 'x', -padx => 5, -pady => 3);

  $addF->Label(-text => "Process $pics pictures", -bg => $config{ColorBG})->pack(-side => 'left', -anchor => 'w', -fill => 'x', -padx => 5, -pady => 3);

  $addF->Label(-text => "Add ", -bg => $config{ColorBG})->pack(-side => 'left', -anchor => 'w');
  $addF->Checkbutton(-text => "border  ",         -variable => \$config{BorderAdd})->pack(-side => 'left', -anchor => 'w');
  $addF->Checkbutton(-text => "copyright info  ", -variable => \$config{CopyAdd})->pack(-side => 'left', -anchor => 'w');
  $addF->Checkbutton(-text => "drop shadow",      -variable => \$config{DropShadow})->pack(-side => 'left', -anchor => 'w');

  my $notebook =
	$decoW->NoteBook(#-width => 500,
					   -background => $config{ColorBG}, # background of active page (including its tab)
					   -inactivebackground => $config{ColorEntry}, # tabs of inactive pages
					   -backpagecolor => $config{ColorBG}, # background behind notebook
					  )->pack(-expand => "yes",
							  -fill => "both",
							  -padx => 5, -pady => 5);

  my $cF  = $notebook->add("border",  -label => "Border");
  my $bF  = $notebook->add("copy",    -label => "Copyright");
  my $dF  = $notebook->add("shadow",  -label => "Drop shadow");


  if ($QandB) {
	my $qS = labeledScale($decoW, 'top', 19, "Quality (%)", \$config{PicQuality}, 10, 100, 1);
	qualityBalloon($qS);

	buttonBackup($decoW, 'top');
	buttonComment($decoW, 'top');
  }

  # ### copyright ###

  my $pfa = $bF->Frame()->pack(-anchor => 'w');
  $pfa->Label(-text => "Position in picture", -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w', -padx => 3);
  my $pf = $pfa->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-side => "left");
  my $pfn = $pf->Frame()->pack();
  my $pfs = $pf->Frame()->pack();
  foreach my $gravity (qw(NorthWest North NorthEast)) {
	my $but = $pfn->Radiobutton(-text => "", -variable => \$config{CopyPosition}, -value => $gravity)->pack(-side => 'left');
	$balloon->attach($but, -msg => "Align the copyright text or logo in $gravity position");
  }
  foreach my $gravity (qw(SouthWest South SouthEast)) {
	my $but = $pfs->Radiobutton(-text => "", -variable => \$config{CopyPosition}, -value => $gravity)->pack(-side => 'left');
	$balloon->attach($but, -msg => "Align the copyright text or logo in $gravity position");
  }
  labeledScale($bF, 'top', 17, "x offset", \$config{CopyX}, 0, $max, 1);
  labeledScale($bF, 'top', 17, "y offset", \$config{CopyY}, 0, $max, 1);

  my $ctF = $bF->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-anchor => 'w', -fill => 'x',-padx => 5, -pady => 5);
  my $clF = $bF->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-anchor => 'w', -fill => 'x', -padx => 5, -pady => 5);

  $ctF->Radiobutton(-text => "add copyright text", -variable => \$config{CopyTextOrLogo}, -value => "text")->pack(-anchor => 'w');
  labeledEntry($ctF, 'top', 17, "Copyright text", \$config{Copyright});
  my $fontF  = $ctF->Frame(-bd => 0)->pack(-anchor => 'w', -padx => 5, -pady => 3);
  my $fontF2 = $ctF->Scrolled('Pane', -bd => $config{Borderwidth}, -relief => 'groove', -scrollbars => 'osoe', -height => 80, -width => 480)->pack(-anchor => 'w', -padx => 5, -pady => 3);
  $fontF->Label(-text => "Font family", -bg => $config{ColorBG})->pack(-side => "left");
  my $fontL  = $fontF2->Label(-textvariable => \$config{Copyright}, -bg => $config{ColorBG})->pack(-side => "left");
  $fontF->Optionmenu(-textvariable => \$config{CopyFontFamily},
                     -options => \@fontFamilies,
                     -command => sub {
                        $decoW->Busy;
                        my $font = $top->Font(-family => $config{CopyFontFamily},
					                          -size   => $config{CopyFontSize});
                        $fontL->configure(-font => $font) if (ref($font) eq 'HASH');
                        $fontL->update();
                        $decoW->Unbusy;
                     })->pack(-side => "left", -anchor => 'w');

  $fontF->Label(-text => "Font size", -bg => $config{ColorBG})->pack(-side => "left");
  $fontF->Scale(
			 -variable => \$config{CopyFontSize},
			 -from => 5,
			 -to => 200,
			 -resolution => 1,
			 -sliderlength => 30,
			 -orient => 'horizontal',
			 -showvalue => 0,
             -width => 15,
			 -bd => $config{Borderwidth},
             -command => sub {
                     $decoW->Busy;
                        my $font = $top->Font(-family => $config{CopyFontFamily},
					                          -size   => $config{CopyFontSize});
                     $fontL->configure(-font => $font);
                     $fontL->update();
                     $decoW->Unbusy;
                     })->pack(-side => "left", -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  $fontF->Label(-textvariable => \$config{CopyFontSize})->pack(-side => "left");

  labeledEntryColor($ctF, 'top', 17, "Foreground color", 'Set', \$config{CopyFontColFG});
  $ctF->Checkbutton(-variable => \$config{CopyFontShadow},
						  -anchor   => 'w',
						  -text     => "Add a shadow to the copyright text"
						 )->pack(-anchor => 'w', -padx => 5, -pady => 3);
  labeledEntryColor($ctF, 'top', 17, "Shadow color", 'Set', \$config{CopyFontColBG});

  $clF->Radiobutton(-text => "add copyright logo (image)", -variable => \$config{CopyTextOrLogo}, -value => "logo")->pack(-anchor => 'w');
  labeledEntryButton($clF,'top',17,"path/name of logo",'Set',\$config{CopyrightLogo});

  # ### border ###

  $cF->Label(-text => "Add one or several borders around pictures", -bg => $config{ColorBG})->pack(-anchor => 'w', -padx => 3);

  my $wi = 25;

  my $bF1 = $cF->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3);
  $bF1->Label(-text => "Border 1 - innermost border", -bg => $config{ColorBG})->pack(-anchor => 'w', -padx => 3);
  labeledScale($bF1, 'top', $wi, "Border width x-direction", \$config{BorderWidth1x}, 0, $max, 1);
  labeledScale($bF1, 'top', $wi, "Border width y-direction", \$config{BorderWidth1y}, 0, $max, 1);
  labeledEntryColor($bF1, 'top', $wi, "Color", 'Set', \$config{BorderColor1});

  my $bF2 = $cF->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3);
  $bF2->Label(-text => "Border 2 - border around border 1 (use width 0 to disable)", -bg => $config{ColorBG})->pack(-anchor => 'w', -padx => 3);
  labeledScale($bF2, 'top', $wi, "Border width x-direction", \$config{BorderWidth2x}, 0, $max, 1);
  labeledScale($bF2, 'top', $wi, "Border width y-direction", \$config{BorderWidth2y}, 0, $max, 1);
  labeledEntryColor($bF2, 'top', $wi, "Color", 'Set', \$config{BorderColor2});

  my $bF3 = $cF->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3);
  $bF3->Label(-text => "Border 3 - border around border 2 (use width 0 to disable)", -bg => $config{ColorBG})->pack(-anchor => 'w', -padx => 3);
  labeledScale($bF3, 'top', $wi, "Border width x-direction", \$config{BorderWidth3x}, 0, $max, 1);
  labeledScale($bF3, 'top', $wi, "Border width y-direction", \$config{BorderWidth3y}, 0, $max, 1);
  labeledEntryColor($bF3, 'top', $wi, "Color", 'Set', \$config{BorderColor3});

  my $bF4 = $cF->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3);
  $bF4->Label(-text => "Border 4 - border around border 3 (use width 0 to disable)", -bg => $config{ColorBG})->pack(-anchor => 'w', -padx => 3);
  labeledScale($bF4, 'top', $wi, "Border width x-direction", \$config{BorderWidth4x}, 0, $max, 1);
  labeledScale($bF4, 'top', $wi, "Border width y-direction", \$config{BorderWidth4y}, 0, $max, 1);
  labeledEntryColor($bF4, 'top', $wi, "Color", 'Set', \$config{BorderColor4});

  # ### drop shadow ###

  $dF->Label(-text => "Add a drop shadow to the pictures", -bg => $config{ColorBG})->pack(-anchor => 'w', -padx => 3);
  $dF->Label(-text => "(conversion may take some time)", -bg => $config{ColorBG})->pack(-anchor => 'w', -padx => 3);

  labeledScale($dF, 'top', 17, "Border width", \$config{DropShadowWidth}, 1, $max, 1);
  labeledScale($dF, 'top', 17, "Shadow blur", \$config{DropShadowBlur}, 1, 9, 1);

  labeledEntryColor($dF, 'top', 17, "Background color", 'Set', \$config{DropShadowBGColor});

  my $ButF =
	$decoW->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);

  my $OKB =
	$ButF->Button(-text => 'OK',
				  -command => sub {
					$decoW->withdraw();
					$decoW->destroy();
					$rc = 1;
				  })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  my $Xbut = $ButF->Button(-text => 'Cancel',
						   -command => sub { $rc = 0;
											 $decoW->withdraw();
											 $decoW->destroy();
										   })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $decoW->bind('<Key-q>',      sub { $Xbut->invoke; });
  $decoW->bind('<Key-Escape>', sub { $Xbut->invoke; });

  $decoW->Popup;
  $decoW->waitWindow;

  return $rc;
}

my $colw;
##############################################################
# colorDialog
##############################################################
sub colorDialog  {

  if (Exists($colw)) {
	$colw->deiconify;
	$colw->raise;
	return;
  }

  my $rc = 0;

  # open window
  $colw = $top->Toplevel();
  $colw->title('Color options');
  $colw->iconimage($mapiviicon) if $mapiviicon;

  foreach (qw(Brightness Saturation Hue)) {
	labeledScale($colw, 'top', 16, "$_ (%)", \$config{"Pic$_"}, 0, 200, 1);
  }

  labeledScale($colw, 'top', 16, "Gamma", \$config{PicGamma}, 0.1, 10.0, 0.01);

  $colw->Button(-text => "Reset",
			   -command => sub {
				 foreach (qw(Brightness Saturation Hue)) {
				   $config{"Pic$_"} = 100;
				 }
				 $config{PicGamma} = 1.00;
			   })->pack(-anchor => 'w', -padx => 3, -pady => 3);

  my $OKB =
	$colw->Button(-text => "Close",
				  -command => sub { $rc = 1; $colw->destroy; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $colw->bind('<Key-q>',      sub { $OKB->invoke; });
  $colw->bind('<Key-Escape>', sub { $OKB->invoke; });

  $colw->Popup;
  $colw->waitWindow;
}

my $uw;
##############################################################
# unsharpDialog
##############################################################
sub unsharpDialog {

  if (Exists($uw)) {
	$uw->deiconify;
	$uw->raise;
	return;
  }

  my $rc   = 0;

  # open window
  $uw = $top->Toplevel();
  $uw->title('Unsharp mask options');
  $uw->iconimage($mapiviicon) if $mapiviicon;

  my $usr =labeledScale($uw, 'top', 16, "Radius (pixel)", \$config{UnsharpRadius}, 0, 10, 1);
	$balloon->attach($usr, -msg => "The radius of the Gaussian, in pixels,
not counting the center pixel.
Use a radius of 0 and the function selects a suitable radius
for you (default 0)");

  my $uss = labeledScale($uw, 'top', 16, "Sigma  (pixel)", \$config{UnsharpSigma}, 0.1, 10, 0.1);
	$balloon->attach($uss, -msg => "The standard deviation of the Gaussian,\nin pixels (default 1.0)");

  my $usa = labeledScale($uw, 'top', 16, "amount (%)", \$config{UnsharpAmount}, 0, 100, 0.1);
	$balloon->attach($usa, -msg => "The percentage of the difference between the original\nand the blur image that is added back into the original\n(default 1.0)");

  my $ust = labeledScale($uw, 'top', 16, "Threshold (frac)", \$config{UnsharpThreshold}, 0, 10, 0.01);
	$balloon->attach($ust, -msg => "The threshold, as a fraction of MaxRGB,\nneeded to apply the difference amount\n(default 0.05)");

  $uw->Button(-text => "Default",
			  -command => sub {
				$config{UnsharpRadius}    = 0;
				$config{UnsharpSigma}     = 1.0;
				$config{UnsharpAmount}    = 1.0;
				$config{UnsharpThreshold} = 0.05;
			  })->pack(-anchor => 'w', -padx => 3, -pady => 3);

  my $OKB =
	$uw->Button(-text => "Close",
				-command => sub { $rc = 1; $uw->destroy; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $uw->bind('<Key-q>',      sub { $OKB->invoke; });
  $uw->bind('<Key-Escape>', sub { $OKB->invoke; });

  $uw->Popup;
  $uw->waitWindow;
}

my $lw;
##############################################################
# levelDialog
##############################################################
sub levelDialog {

  if (Exists($lw)) {
	$lw->deiconify;
	$lw->raise;
	return;
  }

  my $rc   = 0;

  # open window
  $lw = $top->Toplevel();
  $lw->title('Levels');
  $lw->iconimage($mapiviicon) if $mapiviicon;

  my $lws = labeledScale($lw, 'top', 18, "White point (%)", \$config{LevelWhite}, 0, 100, 1);
	$balloon->attach($lws, -msg => "White point specifies the lightest color in the image.
Colors brighter than the white point are set to the maximum quantum value.");

  my $lms = labeledScale($lw, 'top', 18, "Mid point (gamma)", \$config{LevelGamma}, 0.1, 10.0, 0.1);
	$balloon->attach($lms, -msg => "Mid point specifies a gamma correction to apply to the image.");

  my $lbs = labeledScale($lw, 'top', 18, "Black point (%)", \$config{LevelBlack}, 0, 100, 1);
	$balloon->attach($lbs, -msg => "The black point specifies the darkest color in the image.
Colors darker than the black point are set to zero.");

  $lw->Button(-text => "Reset",
			  -command => sub {
				$config{LevelWhite} = 100;
				$config{LevelGamma} = 1.0;
				$config{LevelBlack} = 0;
			  })->pack(-anchor => 'w', -padx => 3, -pady => 3);

  my $OKB =
	$lw->Button(-text => "Close",
				-command => sub { $rc = 1; $lw->destroy; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $lw->bind('<Key-q>',      sub { $OKB->invoke; });
  $lw->bind('<Key-Escape>', sub { $OKB->invoke; });

  $lw->Popup;
  $lw->waitWindow();
}

##############################################################
# editIPTC - edit IPTC info of one or multiple pictures
##############################################################
sub editIPTC($) {

  my $lb = shift;
  my @sellist  = $lb->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);

  my ($pic, $dpic, $dirthumb, @in, @out, %saw);

  # check if some files are links
  return if (!checkLinks($lb, @sellist));

  $dpic     = $sellist[0];
  $pic      = basename($dpic);

  my %iptcmh;
  my $iptcm = \%iptcmh; # $iptcm = IPTC master, must be a hash reference

  # take the first picture as master for the IPTC data
  my $meta = getMetaData($dpic, 'APP13');
  unless ($meta) {
    warn "no APP13 in $dpic";
	return;
  }
  if (defined $meta->get_app13_data('TEXTUAL', 'IPTC')) {
	$iptcm = $meta->get_app13_data('TEXTUAL', 'IPTC');
  }

  # handle several pictures: the IPTC dialog should just show common elements
  if (@sellist > 1) {
    my $i = 0;
    # show a progressbar if there are more than 5 pictures selected
    my $pw = progressWinInit($lb, 'Analyzing IPTC data ...') if (@sellist > 5);
    foreach my $dpic (@sellist) {
      if ($pw) {last if progressWinCheck($pw)};
      $i++;
      progressWinUpdate($pw, "Collecting common data ($i/".scalar @sellist.") ...", $i, scalar @sellist) if ($pw);
      my $iptc;
      # get IPTC data
      my $meta = getMetaData($dpic, 'APP13');
      unless ($meta) {
		warn "no APP13 in $dpic";
		next;
	  }
	  if (defined $meta->get_app13_data('TEXTUAL', 'IPTC')) {
		$iptc = $meta->get_app13_data('TEXTUAL', 'IPTC');
	  }
	  
	  # compare each key from the master
	  foreach my $key (keys %{$iptcm}) {
		my $ref = ref($iptcm->{$key});
		my $nr = scalar @{$iptcm->{$key}};
        # if key doesn't exists in one of the pictures we remove this key
	    unless (exists $iptc->{$key}) {
          delete $iptcm->{$key};
		  next;
		}
		# get the intersection of the key content (this works for single elements and lists)
		my @intersection = listIntersection($iptcm->{$key}, $iptc->{$key});
        # if there is something left we take the intersection
		if (@intersection) {
          $iptcm->{$key} = \@intersection;
		}
		# else we remove the key
		else {
          delete $iptcm->{$key};
		}
	  }
	}
    progressWinEnd($pw) if ($pw);
  }
  
  my @keywords_common = ();
  my @suppcats_common = ();
  foreach (@{$iptcm->{Keywords}}) {
	$_ =~ tr/ -~//cd; # remove non-printables (Picasa adds one to each keyword)
  }
  ${$iptcm->{Caption}}[0] =~ tr/\n\t\r\f -~//cd if (${$iptcm->{Caption}}[0]); # replace all non-printable chars, but not newline etc.

  # these are the common items (e.g. common keywords of all selected pictures)
  @keywords_common = @{$iptcm->{Keywords}} if (exists $iptcm->{Keywords});
  @suppcats_common = @{$iptcm->{SupplementalCategory}} if (exists $iptcm->{SupplementalCategory});

  my $rc = iptcDialog($iptcm, $pic, scalar @sellist);
  return if ($rc ne 'OK');

  # after user interaction in the dialog
  my @keywords_master = ();
  @keywords_master = @{$iptcm->{Keywords}} if (exists $iptcm->{Keywords});
  my @suppcats_master = ();
  @suppcats_master = @{$iptcm->{SupplementalCategory}} if (exists $iptcm->{SupplementalCategory});

  # to remove keywords and categories we need to figure out what has been removed by the user
  my @keywords_removed = diffList(\@keywords_common, \@keywords_master);
  my @suppcats_removed = diffList(\@suppcats_common, \@suppcats_master);
  
  my $IPTC_action = $config{IPTC_action};
  $IPTC_action = 'REPLACE' if (@sellist == 1);

  my $errors = "";
  my $i = 0;
  my $pw = progressWinInit($lb, "Writing IPTC info");
  foreach $dpic (@sellist) {
	last if progressWinCheck($pw);
	$i++;
	progressWinUpdate($pw, "Writing IPTC info ($i/".scalar @sellist.") ...", $i, scalar @sellist);
	$pic      = basename($dpic);
	$dirthumb = getThumbFileName($dpic);

	# check if file is a link and get the real target
	next if (!getRealFile(\$dpic));
	next if (!checkWriteable($dpic));

	my $meta = getMetaData($dpic, 'APP1'); # APP1 includes EXIF and IPTC (APP13)
	my $er   = $meta->get_Exif_data('ALL', 'TEXTUAL');

    my $iptc;
	# copy (clone) master iptc hash to picture iptc hash
    $iptc = dclone($iptcm);

	if (($config{IPTCdateEXIF}) or ($config{IPTCtimeEXIF})) {
	  my $date = getEXIFDate($dpic, $er); # date format YYYY:MM:DD HH:mm:SS
	  if (my ($y, $M, $d, $h, $m, $s) = $date =~ m/(\d\d\d\d):(\d\d):(\d\d) (\d\d):(\d\d):(\d\d)/) {
		my $time      = timelocal($s,$m,$h,$d,($M-1),($y-1900));
		my $diff      = ((localtime($time))[2] - (gmtime($time))[2]);
		# RJW: Correct timezone calculation in case of migration over
		# 24 hour border
		if ( $diff > 12 ) {
			$diff -= 24;
		} elsif ( $diff < -12 ) {
			$diff += 24;
		}
		my $GMToffset = sprintf("%+03d00", $diff);
		my $IPTCdate  = $y.$M.$d;
		my $IPTCtime  = $h.$m.$s.$GMToffset;
		# according to IPTC - NAA INFORMATION INTERCHANGE MODEL, Version No. 4, 1999, http://www.iptc.org/IIM/
		${$iptc->{DateCreated}}[0] = $IPTCdate if ($config{IPTCdateEXIF}); # format CCYYMMDD
		${$iptc->{TimeCreated}}[0] = $IPTCtime if ($config{IPTCtimeEXIF}); # format HHMMSS+HHMM
	  }
	  else {
		warn "picture has an unusual EXIF date: \"$date\" ($dpic)\n" if $config{MetadataWarn};
	  }
	}

	if ($config{IPTCbylineEXIF}) {
	  if (defined $er) {
		my $owner = '';
		if (defined $er->{SUBIFD_DATA}->{OwnerName}) {
		  $owner = join('', @{$er->{SUBIFD_DATA}->{OwnerName}});
		}
		elsif (defined $er->{IFD0_DATA}->{Artist}) {
		  $owner = join('', @{$er->{IFD0_DATA}->{Artist}});
		}
		elsif (defined $er->{SUBIFD_DATA}->{UserComment}) {
		  $owner = join('', @{$er->{SUBIFD_DATA}->{UserComment}});
		}
		else { }
		if ($owner ne '') {
		  $owner =~ tr/ -~//cd;              # remove non-printable characters (but not \n)
		  $owner =~ s/ASCII//g;			       # cut 'ASCII'
		  $owner =~ s/^\s+//;			       # cut leading white
		  $owner =~ s/\s+$//;			       # cut trailing white
		  print "*** Writing \"$owner\" to $dpic\n" if $verbose;
		  ${$iptc->{ByLine}}[0] = $owner;
	    }
	  }
	}

	if ($config{IPTCaddMapivi}) {
		  ${$iptc->{OriginatingProgram}}[0] = 'Mapivi';
		  ${$iptc->{ProgramVersion}}[0] = $version;
	}
		
	# make some corrections for keywords and supp cats
	# according to the documentation of Image::MetaData::JPEG this should not be needed
	if ((@sellist > 1) and (($IPTC_action eq 'UPDATE') or ($IPTC_action eq 'ADD'))) {
	   # todo problem is still, that removed elements (where nothing is left, e.g. a headline) are not removed in Update mode
       my $seg = $meta->retrieve_app13_segment(undef, 'IPTC'); # todo should be possible without segement
       if ($seg) {
         my $hashref = $seg->get_app13_data('TEXTUAL', 'IPTC');
	   
	     my @keywords;
	     # take the original items and add the items from the dialog (master)
         push @keywords, @{$hashref->{Keywords}} if (defined($hashref->{Keywords}));
	     push @keywords, @keywords_master;
	     # then remove items which have been removed in the dialog
	     @keywords = diffList(\@keywords, \@keywords_removed);
	     #@keywords = ('') unless (@keywords);
	     $iptc->{Keywords} = \@keywords;
	   
	     my @suppcats;
	     # take the original items and add the items from the dialog (master)
         push @suppcats, @{$hashref->{SupplementalCategory}} if (defined($hashref->{SupplementalCategory}));
	     push @suppcats, @suppcats_master;
	     # then remove items which have been removed in the dialog
	     @suppcats = diffList(\@suppcats, \@suppcats_removed);
	     $iptc->{SupplementalCategory} = \@suppcats;
       }
    }

	$meta->set_app13_data($iptc, $IPTC_action, 'IPTC');
	uniqueIPTC($meta);
	unless ($meta->save()) { $errors .= "save failed for $dpic\n"; }

	# touch the thumbnail pic (set actual time stamp), to suppress rebuilding
	touch($dirthumb);

	updateOneRow($dpic, $lb);
    if ($dpic eq $actpic) {
      showImageInfoCanvas($dpic);
	  if ($config{ShowCaptionField}) {
	    my $caption = getIPTCCaption($dpic);
	    $captionText->delete( 0.1, 'end');       # remove old caption
	    $captionText->insert('end', $caption);   # insert new caption
	  }
    }
  }
  progressWinEnd($pw);
  $userinfo = "ready! ($i/".scalar @sellist." written)"; $userInfoL->update;
  showText("Errors while editing IPTC info", $errors, NO_WAIT) if ($errors ne "");
}

##############################################################
# setIPTCurgency - set the urgency flag to a given value (0 .. 8)
##############################################################
sub setIPTCurgency {

  my $lb      = shift; # the reference to the active listbox widget
  my $urgency = shift;

  return unless (defined($urgency));
  return if (($urgency < 0) or ($urgency > 9)); # 9 is used to clear the urgency flag

  my @sellist = getSelection($lb);
  return unless checkSelection($lb, 1, 0, \@sellist);

  my ($pic, $dpic, $dirthumb, $msg);

  # check if some files are links
  return if (!checkLinks($lb, @sellist));

  $urgency = "" if ($urgency == 9); # 9 is used to clear the urgency flag
  $msg     = "Writing IPTC urgence $urgency";
  $msg     = "Deleting IPTC urgence flag" if ($urgency eq "");

  my $errors = "";
  my $i = 0;
  my $pw = progressWinInit($lb, $msg);
  foreach $dpic (@sellist) {
	last if progressWinCheck($pw);
	$i++;
	progressWinUpdate($pw, "$msg ($i/".scalar @sellist.") ...", $i, scalar @sellist);
	$pic      = basename($dpic);
	$dirthumb = getThumbFileName($dpic);

	# check if file is a link and get the real target
	next if (!getRealFile(\$dpic));
	next if (!checkWriteable($dpic));

	my $meta = getMetaData($dpic, 'APP13');
	my $iptc = $meta->get_app13_data('TEXTUAL', 'IPTC');
    warn "IPTC segment of $dpic has errors!" if ($iptc->{error});

	if ($config{UrgencyChangeWarning} and (defined $iptc->{"Urgency"}) and (${$iptc->{"Urgency"}}[0] != $urgency)) {
		$errors .=  "Info: Urgency changed from ".${$iptc->{"Urgency"}}[0]." to $urgency $dpic\n";
	}

	$iptc->{Urgency} = $urgency;
	
    # todo why is this here
	foreach (@{$iptc->{Keywords}}) {
	  $_ =~ tr/ -~//cd; # remove non-printables (Picasa adds one to each keyword)
    }
    # todo why is this here
    ${$iptc->{Caption}}[0] =~ tr/\n\t\r\f -~//cd if (${$iptc->{Caption}}[0]); # replace all non-printable chars, but not newline etc.

	$meta->set_app13_data($iptc, 'REPLACE', 'IPTC');
	if (!$meta->save()) {
	  $errors .= "save failed for $dpic\n";
	}
	else { # urgency changed successfully!
	  print "saved IPTC urgency $urgency to $pic\n" if $verbose;
	  # touch the thumbnail pic (set actual time stamp), to suppress rebuilding
	  touch($dirthumb);
	  updateOneRow($dpic, $lb);
	  if ($dpic eq $actpic) {
        showImageInfoCanvas($dpic);
		$urgencyStr   = $urgency; # display new urgency in the status bar
		unless ($urgency eq "") {
		  $urgencyScale = 9 - $urgencyStr;
		  $urgencyScale = 0 if (($urgencyStr < 1) or ($urgencyStr > 8));
		}
	  }
	}
  }
  progressWinEnd($pw);
  $msg     = "urgency $urgency written to";
  $msg     = "removed urgency flag in" if ($urgency eq "");
  $userinfo = "ready! ($msg $i/".scalar @sellist.") pictures"; $userInfoL->update;
  showText("Errors and infos while saving IPTC urgency", $errors, NO_WAIT) if ($errors ne "");
}

##############################################################
# getIPTCurgencyDB - get the urgency flag of a given file from
#                    the search database
#                    returns 9 if there is no file or no urgency
##############################################################
sub getIPTCurgencyDB {

  my $dpic    = shift;
  my $urgency = 9;
  $urgency = $searchDB{$dpic}{URG} if (defined $searchDB{$dpic}{URG});
  return $urgency;
}


##############################################################
# getIPTCurgency - get the urgency flag of a given file
#                  returns 9 if there is no file or no urgency
##############################################################
sub getIPTCurgency {

  my $dpic    = shift;
  my $meta    = shift; # optional, the Image::MetaData::JPEG object of $dpic if available
  my $urgency = 9;

  return $quickSortHash{$dpic} if ($quickSortSwitch and defined $quickSortHash{$dpic});

  return 9 unless (-f $dpic);
  $meta = getMetaData($dpic, "APP13", 'FASTREADONLY') unless (defined($meta));
  return 9 unless ($meta);
  my $seg = $meta->retrieve_app13_segment(undef, 'IPTC'); # todo should be possible without segement
  return 9 unless ($seg);
  my $hashref = $seg->get_app13_data("TEXTUAL", 'IPTC');

  if (defined($hashref->{Urgency})) {
	$urgency = ${$hashref->{Urgency}}[0];
	$urgency = 8 if ($urgency =~ /l/i);
	$urgency = 1 if ($urgency =~ /h/i);
	$urgency = 9 if ($urgency !~ /\d/);
	$urgency = 9 if ( ($urgency > 9) or ($urgency < 0) );
  }

  $quickSortHash{$dpic} = $urgency if $quickSortSwitch;
  print "getIPTCurgency: -$urgency- $dpic\n" if $verbose;
  return $urgency;
}

##############################################################
# getIPTCkeywords - get the keywords of a given file
#                   returns empty list if there is no file or
#                   no keyword
##############################################################
sub getIPTCkeywords {

  my $dpic    = shift;
  my $meta    = shift; # optional, the Image::MetaData::JPEG object of $dpic if available
  my @keywords = ();

  return @keywords unless (-f $dpic);
  $meta = getMetaData($dpic, 'APP13', 'FASTREADONLY') unless (defined($meta));
  return @keywords unless ($meta);
  my $seg = $meta->retrieve_app13_segment(undef, 'IPTC'); # todo should be possible without segement
  return @keywords unless ($seg);
  my $hashref = $seg->get_app13_data('TEXTUAL', 'IPTC');

  if (defined($hashref->{Keywords})) {
	@keywords = @{$hashref->{Keywords}};
  }
  
  foreach (@keywords) {
  	# translate it to a string if it is non-printing
	#my $key = $_;
	#$key =~ s/[\000-\037\177-\377]/sprintf "\\%02x",ord($&)/e;
	#print "key = -$key-\n";
	$_ =~ tr/ -~//cd; # replace all non-printable chars (Picasa adds one to each keyword)
  }

  return @keywords;
}

##############################################################
# getIPTCByLine -  get the by-line info of a given file
##############################################################
sub getIPTCByLine($) {

  my $dpic    = shift;
  my $byline  = "";

  return $quickSortHash{$dpic} if ($quickSortSwitch and defined $quickSortHash{$dpic});

  return $byline unless (-f $dpic);

  my $meta = getMetaData($dpic, "APP13", 'FASTREADONLY');
  return $byline unless ($meta);
  my $seg = $meta->retrieve_app13_segment(undef, 'IPTC'); # todo should be possible without segement
  return $byline unless ($seg);
  my $hashref = $seg->get_app13_data("TEXTUAL", 'IPTC');

  $byline = ${$hashref->{ByLine}}[0] if (defined($hashref->{ByLine}));

  $quickSortHash{$dpic} = $byline if $quickSortSwitch;
  print "getIPTCByLine: $byline ($dpic)\n" if $verbose;
  return $byline;
}

##############################################################
# getIPTCAttr -  get an IPTC attribute of a given file
##############################################################
sub getIPTCAttr {

  my $dpic = shift;
  my $name = shift;
  my $val = "";

  if (-f $dpic) {
    my $meta = getMetaData($dpic, "APP13", 'FASTREADONLY');
    if ($meta) {
      my $seg = $meta->retrieve_app13_segment(undef, 'IPTC'); # todo should be possible without segement
      if ($seg) {
		my $hashref = $seg->get_app13_data("TEXTUAL", 'IPTC');
		if (defined($hashref->{$name})) {
		  $val = ${$hashref->{$name}}[0];
		  print "getIPTCAttr: $name=$val ($dpic)\n" if $verbose;
        }
      }
    }
  }

  return $val;
}

##############################################################
# getIPTCObjectName -  get the object name of a given file
##############################################################
sub getIPTCObjectName {
  my $dpic = shift;
  return getIPTCAttr($dpic, "ObjectName");
}

##############################################################
# getIPTCHeadline -  get the headline of a given file
##############################################################
sub getIPTCHeadline {
  my $dpic = shift;
  return getIPTCAttr($dpic, "Headline");
}

##############################################################
# getIPTCCaption -  get the caption of a given file
##############################################################
sub getIPTCCaption {
  my $dpic = shift;
  return getIPTCAttr($dpic, "Caption/Abstract");
}

##############################################################
# getIPTCByLineTitle -  get the by-line title of a given file
##############################################################
sub getIPTCByLineTitle {
  my $dpic = shift;
  return getIPTCAttr($dpic, "ByLineTitle");
}

##############################################################
# getIPTCSublocation -  get the sublocation of a given file
##############################################################
sub getIPTCSublocation {
  my $dpic = shift;
  return getIPTCAttr($dpic, "SubLocation");
}

##############################################################
# getIPTCCity -  get the city of a given file
##############################################################
sub getIPTCCity {
  my $dpic = shift;
  return getIPTCAttr($dpic, "City");
}

##############################################################
# getIPTCProvince -  get the province/state of a given file
##############################################################
sub getIPTCProvince {
  my $dpic = shift;
  return getIPTCAttr($dpic, "Province/State");
}

##############################################################
# getIPTCCountryCode -  get the country code of a given file
##############################################################
sub getIPTCCountryCode {
  my $dpic = shift;
  return getIPTCAttr($dpic, "Country/PrimaryLocationCode");
}

##############################################################
# iptcDialog
##############################################################
sub iptcDialog {

  my $iptc    = shift;
  my $picname = shift;
  my $nr      = shift;  # number of pics

  my $rc = 'Cancel';

  my @tag_list;  # used to store all IPTC tags which are already displayed, all others will go to the misc tab

  # open window
  my $t = $top->Toplevel();
  $t->title("Edit IPTC/IIM information of $nr pictures ($picname)");
  $t->iconimage($mapiviicon) if $mapiviicon;

  my $notebook =
	$t->NoteBook(-width => 750,
				 -background => $config{ColorBG}, # background of active page (including its tab)
				 -inactivebackground => $config{ColorEntry}, # tabs of inactive pages
				 -backpagecolor => $config{ColorBG}, # background behind notebook
				)->pack(-expand => 1,
						-fill => 'both',
						-padx => 5, -pady => 5);

  my $aN  = $notebook->add('stan',  -label => 'Standard');
  my $bN  = $notebook->add('misc',  -label => 'Misc');
  my $cN  = $notebook->add('opt',  -label => 'Options');

  $notebook->raise($config{IPTCLastPad});

  my $w = 11;
  my $ent;
  ####### Standart IPTC tags  #############
  # left and right frame on standard tab
  my $aF = $aN->Frame(-bd => 0)->pack(-side => 'left', -expand => 1, -fill => 'both', -padx => 3, -pady => 0);
  my $bF = $aN->Frame(-bd => 0)->pack(-side => 'left', -expand => 1, -fill => 'both', -padx => 3, -pady => 0);
  
  my @alist = ('Headline', 'ObjectName');
  foreach (@alist) {
	  $ent = labeledEntry($aF,'top',$w,$_,\${$iptc->{$_}}[0], 5);
	  if (defined $iptcHelp{$_}) {
		  $balloon->attach($ent, -msg => formatString($_.":\n".$iptcHelp{$_}, 80, -1)) if (Exists $ent);
	  }
  }
  push @tag_list, @alist; # add already displayed elements to the list
  
  ####### Caption  #############
  my $capF = $aF->Frame(-bd => 0)->pack(-anchor=>'w', -expand => 1, -fill => 'both', -padx => 3, -pady => 3);
  $capF->Label(-text => 'Caption/Abstract', -bg => $config{ColorBG})->pack(-anchor => 'w', -padx => 2, -pady => 2);
  my $caption = $capF->Scrolled("Text",
						 -scrollbars => 'osoe',
						 -wrap => 'word',
						 -width => 60,
						 -height => 6,
						 )->pack(-expand => 1, -fill => 'both', -padx => 2, -pady => 2);
  $caption->insert('end', ${$iptc->{'Caption/Abstract'}}[0]);
  $caption->see(0.1);
  push @tag_list, 'Caption/Abstract'; # add already displayed elements to the list

  ####### Urgency  #############
  my $oF = $aF->Frame(-bd => 0)->pack(-anchor=>'w', -padx => 3, -pady => 6);
  $balloon->attach($oF, -msg => "Rating/Urgency\n0 = no\n1 = High   ********\n2 =        *******\n3 =        ******\n4 =        *****\n5 = Normal ****\n6 =        ***\n7 =        **\n8 = Low    *");
  $oF->Label(-text => "Rating/Urgency", -bg => $config{ColorBG}, -width => 15, -anchor => 'w')->pack(-side => "left", -anchor => 'w', -padx => 2, -pady => 2);
  $oF->Optionmenu(-variable => \${$iptc->{Urgency}}[0], -textvariable => \${$iptc->{Urgency}}[0], -options => [0,1,2,3,4,5,6,7,8])->pack(-side => "left", -anchor => 'w', -padx => 0);
  push @tag_list, 'Urgency'; # add already displayed elements to the list

  if ($config{IPTCProfessional}) {
    ####### Writer/Editor and Credit  #############
    labeledDoubleEntry($aF, 'top', $w, 'Writer/Editor', 'Credit',
					   \${$iptc->{'Writer/Editor'}}[0],
					   formatString("Writer/Editor:\n".$iptcHelp{'Writer/Editor'}, 80, -1),
					   \${$iptc->{'Credit'}}[0],
					   formatString("Credit:\n".$iptcHelp{'Credit'}, 80, -1));
    push @tag_list, ('Writer/Editor', 'Credit'); # add already displayed elements to the list
  }
  
  ####### BylineTitle and Byline  #############
  # !!! todo byline and bylinetitle are repeatable use e.g. .= "$_, " for @{$iptc->{$_}};
  labeledDoubleEntry($aF, 'top', $w, 'ByLineTitle', 'Name',
					 \${$iptc->{ByLineTitle}}[0],
					 formatString("ByLineTitle:\n".$iptcHelp{'ByLineTitle'}, 80, -1),
					 \${$iptc->{ByLine}}[0],
					 formatString("ByLine:\n".$iptcHelp{'ByLine'}, 80, -1));
  push @tag_list, ('ByLineTitle', 'ByLine'); # add already displayed elements to the list

  ####### EditStatus etc. ##############
  if ($config{IPTCProfessional}) {
    @alist = ('EditStatus', 'SpecialInstructions', 'Contact', 'Source', 'CopyrightNotice');
    foreach (@alist) {
	    $ent = labeledEntry($aF,'top',$w,$_,\${$iptc->{$_}}[0]);
	    if (defined $iptcHelp{$_}) {
		    # todo this cuts very long desc because of config{LineLimit}
		    $balloon->attach($ent, -msg => formatString($_.":\n".$iptcHelp{$_}, 80, -1)) if (Exists $ent);
	    }
    }
    push @tag_list, @alist; # add already displayed elements to the list
  }
  
  ####### Location ##############
  my $locF = $aF->Frame(-relief => 'raised')->pack(-anchor=>'w', -padx => 3, -pady => 3, -fill => 'x');
  $locF->Label(-text => 'Location')->pack(-anchor => 'w', -padx => 2, -pady => 2);
  $ent = labeledEntry($locF,'top',$w,'SubLocation',\${$iptc->{'SubLocation'}}[0]);
  if (defined $iptcHelp{'SubLocation'}) {
    # todo this cuts very long desc because of config{LineLimit}
    $balloon->attach($ent, -msg => formatString("SubLocation:\n".$iptcHelp{'SubLocation'}, 80, -1)) if (Exists $ent);
  }
  labeledDoubleEntry($locF, 'top', $w, 'City', 'Province/State',
					 \${$iptc->{'City'}}[0],
					 formatString("City:\n".$iptcHelp{'City'}, 80, -1),
					 \${$iptc->{'Province/State'}}[0],
					 formatString("Province/State:\n".$iptcHelp{'Province/State'}, 80, -1));
  labeledDoubleEntry($locF, 'top', $w, 'Country', 'Code',
					 \${$iptc->{'Country/PrimaryLocationName'}}[0],
					 formatString("Country/PrimaryLocationName:\n".$iptcHelp{'Country/PrimaryLocationName'}, 80, -1),
					 \${$iptc->{'Country/PrimaryLocationCode'}}[0],
					 formatString("Country/PrimaryLocationCode:\n".$iptcHelp{'Country/PrimaryLocationCode'}, 80, -1));
  push @tag_list, ('SubLocation', 'City', 'Province/State', 'Country/PrimaryLocationName', 'Country/PrimaryLocationCode');

  #######  Date and Time ############
  if ($config{IPTCProfessional}) {
    @alist = ('ReleaseDate', 'ReleaseTime', 'DateCreated', 'TimeCreated');
    my $dateF = $aF->Frame(-bd => $config{Borderwidth}, -relief => 'raised')->pack(-anchor=>'w', -padx => 3, -pady => 3, -fill => 'x');
    $dateF->Label(-text => 'Date and time')->pack(-anchor => 'w', -padx => 2, -pady => 2);
    labeledDoubleEntry($dateF, 'top', $w, 'Date created', 'Time',
					   \${$iptc->{DateCreated}}[0],
					   formatString("DateCreated:\n".$iptcHelp{'DateCreated'}, 80, -1),
					   \${$iptc->{TimeCreated}}[0],
					   formatString("TimeCreated:\n".$iptcHelp{'TimeCreated'}, 80, -1));

    labeledDoubleEntry($dateF, 'top', $w, 'Date released', 'Time',
					   \${$iptc->{ReleaseDate}}[0],
					   formatString("ReleaseDate:\n".$iptcHelp{'ReleaseDate'}, 80, -1),
					   \${$iptc->{ReleaseTime}}[0],
					   formatString("ReleaseTime:\n".$iptcHelp{'ReleaseTime'}, 80, -1));
    push @tag_list, @alist; # add already displayed elements to the list
  }
  
  #######  Keywords ############
  my $keyword_frame = $bF->Frame(-bd => 0)->pack(-expand => 1, -fill => 'both', -padx => 0, -pady => 0);
  # get the keywords (list ref)
  doubleList($keyword_frame, \@prekeys, \@{$iptc->{Keywords}}, 'keywords');
  push @tag_list, 'Keywords';
  
  #######  Categories ##########
  my $category_frame;
  if ($config{IPTCProfessional} == 1) {
    $category_frame = $bF->Frame(-bd => 0)->pack(-expand => 1, -fill => 'both', -padx => 0, -pady => 0);
    $ent = labeledEntry($category_frame,'top',$w,'Category',\${$iptc->{Category}}[0]);
    if (defined $iptcHelp{Category}) {
	  $balloon->attach($ent, -msg => formatString("Category:\n".$iptcHelp{Category}, 80, -1)); # todo
    }
    # supp categories ###
    doubleList($category_frame, \@precats, \@{$iptc->{SupplementalCategory}}, 'supplemental categories');
    push @tag_list, ('Category', 'SupplementalCategory');
  }
  
  ####### Misc #################
  my $p = $bN->Scrolled("Pane", -scrollbars => "oe", -height => 300)->pack(-fill => "both", -expand => "1");

  # build a frame, a label and an entry for every tag which is not yet displayed
  foreach (@IPTCAttributes) {
	next if (isInList($_, \@tag_list));
    $ent = labeledEntry($p,'top',40,$_,\${$iptc->{$_}}[0]);
	if (defined $iptcHelp{$_}) {
	    $balloon->attach($ent, -msg => formatString($_.":\n".$iptcHelp{$_}, 80, -1)); # todo
	  }
  }

  ###### bottom frame

  my $exf = $t->Frame()->pack(-anchor=>'w');
  #my $exf2 = $t->Frame()->pack(-anchor=>'w');
  my $edb =
  $exf->Checkbutton(-variable => \$config{IPTCdateEXIF},
				  -text => "EXIF date -> creation date ")->pack(-anchor => 'w', -side => 'left');
  $balloon->attach($edb, -msg => 'This option will copy EXIF date,
to the IPTC date created tag.');
  my $etb =
  $exf->Checkbutton(-variable => \$config{IPTCtimeEXIF},
				  -text => "EXIF time -> creation time ")->pack(-anchor => 'w', -side => 'left');
  $balloon->attach($etb, -msg => 'This option will copy EXIF time,
to the IPTC time created tag.');
  my $IbEo =
  $exf->Checkbutton(-variable => \$config{IPTCbylineEXIF},
				  -text => "EXIF owner -> ByLine ")->pack(-anchor => 'w', -side => 'left');
  $balloon->attach($IbEo, -msg => 'This option will copy the content of EXIF Owner,
or if not available the content of EXIF Artist,
or if not available the content of EXIF UserComment
to the IPTC ByLine tag.');
  my $IMap =
  $exf->Checkbutton(-variable => \$config{IPTCaddMapivi},
				  -text => "Add Mapivi infos")->pack(-anchor => 'w', -side => 'left');
  $balloon->attach($IMap, -msg => 'This option will insert Mapivi
in the IPTC OriginatingProgram tag
and the actual Mapivi version
into the ProgramVersion tag.');

  my $optF = $cN->Frame()->pack();
  $optF->Label(-text => 'IPTC dialog layout')->pack(-anchor => 'w');
  $optF->Radiobutton(-text => 'Simple', -variable => \$config{IPTCProfessional}, -value => 0)->pack(-anchor => 'w');
  $optF->Radiobutton(-text => 'Professional without Category', -variable => \$config{IPTCProfessional}, -value => 2)->pack(-anchor => 'w');
  $optF->Radiobutton(-text => 'Professional with Category', -variable => \$config{IPTCProfessional}, -value => 1)->pack(-anchor => 'w');
  $cN->Label(-text => 'Note: According to the IPTC standard Categories are deprecated.')->pack();
  $cN->Label(-text => 'Please choose IPTC dialog layout, close dialog and open it again to see changes.')->pack();

  my $f = $t->Frame()->pack(-anchor=>'w',-fill => 'x', -expand => 0);

  # edit mode buttons only for more than one pictures
  if ($nr > 1) {
	my $rf = $f->Frame()->pack(-side => 'left', -anchor=>'w', -fill => 'x', -expand => 0);

	my $radioB =
	$rf->Label(-text => 'Edit mode')->pack(-side => 'left', -anchor => 'w');
	$rf->Radiobutton(-text => 'Add', -variable => \$config{IPTC_action}, -value => 'ADD')->pack(-side => 'left', -anchor => 'w');
	$rf->Radiobutton(-text => 'Update', -variable => \$config{IPTC_action}, -value => 'UPDATE')->pack(-side => 'left', -anchor => 'w');
	$rf->Radiobutton(-text => 'Replace', -variable => \$config{IPTC_action}, -value => 'REPLACE')->pack(-side => 'left', -anchor => 'w');
	$balloon->attach($rf, -msg =>
'Add:     new records are added and nothing is deleted; however, if you
         try to add a non-repeatable record which is already present,
         the newly supplied value ejects (replaces) the pre-existing value.
Update:  new records replace those characterised by the same tags,
         but the others are preserved. This makes it possible to modify
         some repeatable IPTC records without deleting the other tags.
Replace: all records present in the IPTC sub folder are deleted
         before inserting the new ones.');

  }

  my $okb =
	$f->Button(-text => 'OK', -command =>
			 sub {
			   # get the caption
			   ${$iptc->{'Caption/Abstract'}}[0] = $caption->get(0.1, 'end');
			   ${$iptc->{'Caption/Abstract'}}[0] =~ s/\s+$//;	# remove trailing whitespace
			   $config{IPTCLastPad} = $notebook->raised();
			   if (Exists $keyword_frame) {
                 saveTreeMode($keyword_frame->{m_tree});  # todo
                 nstore($keyword_frame->{m_tree}->{m_mode}, "$configdir/keywordMode") or warn "could not store $configdir/keywordMode: $!";
               }
			   if (Exists $category_frame) {
                 saveTreeMode($category_frame->{m_tree}); # todo
                 nstore($category_frame->{m_tree}->{m_mode}, "$configdir/categoryMode") or warn "could not store $configdir/categoryMode: $!";
			   }
			   $t->destroy; # close window
			   $rc = 'OK';
			  }
			)->pack(-side => "left", -fill => 'x', -expand => 1, -padx => 3, -pady => 3);
  $balloon->attach($okb, -msg => "You can press Control-x to close the dialog (like OK button)");
  $t->bind('<Control-x>', sub { $okb->invoke; });

  my $Xbut = $f->Button(-text => 'Cancel', -command =>
						sub {
						  $config{IPTCLastPad} = $notebook->raised();
						  $t->destroy; # close window
						  $rc = 'Cancel';
						}
					   )->pack(-side => "left", -fill => 'x', -expand => 1, -padx => 3, -pady => 3);
  $balloon->attach($Xbut, -msg => "You can press ESC to close the dialog (like Cancel button)");
  $t->bind('<Key-Escape>', sub { $Xbut->invoke; });

  $t->waitWindow;
  return $rc;
}

##############################################################
# cleanList - remove empty elements from a list reference
##############################################################
sub cleanList {
  my $listRef = shift;

  if (ref($listRef) ne 'ARRAY') {
	warn "cleanList: $listRef is no an array ref!";
	return;
  }

  my @list;
  foreach (@$listRef) {
	push @list, $_ if ($_ ne "");
  }
  $listRef = \@list;
}

##############################################################
# doubleList - mega widget containing two listboxes, a entry
#              and some buttons
##############################################################
sub doubleList($$$$) {

  my $widget = shift; # mother widget
  my $l1     = shift; # predefined list ref
  my $l2     = shift; # real list ref
  my $name   = shift;

  # build a frame for the keywords/categories
  my $f = $widget->Frame(-bd => $config{Borderwidth}, -relief => 'raised')->pack(-expand => 1, -fill => 'both', -anchor=>'w', -padx => 3, -pady => 3);
  $f->Label(-text => $name, -bg => $config{ColorBG})->pack(-anchor=>'w', -padx => 2, -pady => 2);

  my $fc1 = $f->Frame()->pack(-expand => 1, -fill => "both", -side => "left", -anchor=>"n");
  my $fc2 = $f->Frame()->pack(-expand => 0, -fill => 'x',    -side => "left", -anchor=>"n");
  my $fc3 = $f->Frame()->pack(-expand => 1, -fill => "both", -side => "left", -anchor=>"n");
  $fc1->Label(-text => "common tags", -bg => $config{ColorBG})->pack(-anchor=>'w', -padx => 2, -pady => 2);
  my $catLB2;
  my $category = "";
  my $fcent = $fc1->Entry(-textvariable => \$category,
			  -width => 20)->pack(-fill => 'x', -padx => 2, -pady => 2);
  $fcent->bind('<Return>',
			   sub {
				 return if ($category eq "");
				 # check if keyword/category is allready in list
				 return if isInList($category, $l2);
				 push @$l2, $category;
				 $category = "";
				 @$l2 = sort { uc($a) cmp uc($b) } @$l2;
				 $catLB2->delete(0, 'end');
				 $catLB2->insert('end', @$l2);
			   });

  my $tree = $fc1->Scrolled('Tree',
						   -separator  => '/',
						   -scrollbars => 'osoe',
						   -selectmode => 'extended',
						   -exportselection => 0,
						   -width      => 26,
						   -height     => 14,
						  )->pack(-expand => 1, -fill => 'both', -padx => 2, -pady => 2);
  $widget->{m_tree} = $tree;
  bindMouseWheel($tree->Subwidget("scrolled"));
  $balloon->attach($tree, -msg => "Double click on a item to insert it.\nIt's possible to edit the items, use the\nright mouse button to open the edit menu.");

  # try to get the saved mode
  my $modeRef;
  if ($name eq 'keywords' and -f "$configdir/keywordMode") {
	$modeRef = retrieve("$configdir/keywordMode");
  }
  if ($name eq 'supplemental categories' and -f "$configdir/categoryMode") {
	$modeRef = retrieve("$configdir/categoryMode");
  }
  $tree->{m_mode} = $modeRef if (defined $modeRef);

  addTreeMenu($tree, $l1);

  insertTreeList($tree, @$l1);

#  $tree->bind("<Double-Button-1>", sub {
#	  my @keys = $keytree->info('selection');
#	  return unless checkSelection($myDiag, 1, 0, \@keys);
#	  $entry->insert("insert", getLastItem($keys[0])." ");
#  });

  $fc2->Label(-text => "command", -bg => $config{ColorBG})->pack(-expand => 0, -anchor=>'w', -padx => 2, -pady => 2);

  my $all = 0;
  my $all_ref = \$all;
  $all_ref = \$config{CategoriesAll} if ($name eq 'supplemental categories');
  $all_ref = \$config{KeywordsAll}   if ($name eq 'keywords');

  my $addB =
	  $fc2->Button(-text => "add",
				  -command => sub {
					  my @keys = $tree->info('selection');
					  return unless checkSelection($widget, 1, 0, \@keys);
					  my @keylist;
					  my $warning = '';
					  my @items;
					  foreach my $key (@keys) {
						if ($$all_ref == 1) { # all, separated
						  push @items, getAllItems($key);
						}
						elsif ($$all_ref == 2) { # all, joined
							  my $joined = join('.', getAllItems($key));
							  if (length($joined) > 64) {
								  $warning .= "Keyword $joined has ".length($joined)." characters";
								  next;
							  }
							  push @items, $joined;
						  }
						elsif ($$all_ref == 0) { # last
							push @items, getLastItem($key);
						}else {
							warn "doubleList: should never be reached!";
						}
					  }
					  foreach my $item (@items) {
						next if isInList($item, $l2); # make @$l2 unique
						push @$l2, $item;             # by adding just new items
						@$l2 = sort { uc($a) cmp uc($b) } @$l2; # sort alphabetical
						$catLB2->delete(0, 'end');
						$catLB2->insert('end', @$l2);
					  }
				  } )->pack(-expand => 0, -fill => 'x', -padx => 1, -pady => 1);
  $balloon->attach($addB, -msg => "Add the selected items to the picture");

  my $fc2a = $fc2->Frame()->pack();
  $fc2a->Radiobutton(-text => "all",  -variable => $all_ref, -value => 1)->pack(-anchor => 'w');
  $fc2a->Radiobutton(-text => "join", -variable => $all_ref, -value => 2)->pack(-anchor => 'w');
  $fc2a->Radiobutton(-text => "last", -variable => $all_ref, -value => 0)->pack(-anchor => 'w');
  $balloon->attach($fc2a, -msg => "$name add mode\nExample $name: Friend/Bundy/Kelly\nmode all:  three $name: Friend, Bundy and Kelly\nmode join: one $name:   Friend.Bundy.Kelly\nmode last: one $name:   Kelly");

  my $rmB =
	  $fc2->Button(-text => "remove",
				  -command => sub {
					my @sellist = $catLB2->curselection();
					if (@sellist < 1) {
					  print "nothing selected\n" if $verbose;
					  return;
					}
					# delete the selected elements in reverse order
					foreach (reverse @sellist) {
					  splice @$l2, $_, 1;
					}
					$catLB2->delete(0, 'end');
					$catLB2->insert('end', @$l2);
				  })->pack(-expand => 0, -fill => 'x', -padx => 1, -pady => 1);
  $balloon->attach($rmB, -msg => "Remove the selected items from the picture");

  $tree->bind('<Double-Button-1>', sub { $addB->invoke(); } );

  $fc3->Label(-text => "tags of picture", -bg => $config{ColorBG})->pack(-anchor=>'w');
  $catLB2 =
	  $fc3->Scrolled('Listbox',
					-scrollbars => 'osoe',
					-selectmode => 'extended',
					-exportselection => 0,
					-width      => 25,
					-height     => 14,
				   )->pack(-expand => 1, -fill =>'both', -padx => 2, -pady => 2);
  bindMouseWheel($catLB2->Subwidget("scrolled"));

  $catLB2->insert('end', @$l2);
  $catLB2->bind('<Double-Button-1>', sub { $rmB->invoke(); } );
}

##############################################################
# removeAllComments
##############################################################
sub removeAllComments {

  my $ask = shift;
  unless ($ask == ASK or $ask == NO_ASK) { warn "removeAllComments called with wrong argument: $ask"; return; }

  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);
  my $selected = @sellist;
  my ($pic, $dpic, $dirthumb, $dirtpic, $i, $com);

  if ($ask == ASK) {
	my $rc = $top->messageBox(-icon => 'question', -message => "Ok to remove all comments of $selected selected pictures?\nThere is no undo!",
							  -title => "Remove all comments?", -type => 'OKCancel');
	return if ($rc !~ m/Ok/i);
  }

  $userinfo = "removing comments ..."; $userInfoL->update;

  # check if some files are links
  return if (!checkLinks($picLB, @sellist));

  my $pw = progressWinInit($top, "Remove all comments");
  $i = 0;
  foreach $dpic (@sellist) {
	last if progressWinCheck($pw);
	$i++;
	progressWinUpdate($pw, "removing all comments ($i/$selected) ...", $i, $selected);
	$pic      = basename($dpic);
	$dirthumb = getThumbFileName($dpic);

	next if (!checkWriteable($dpic));

	# check if file is a link and get the real target
	next if (!getRealFile(\$dpic));

	my $meta = getMetaData($dpic, "COM");
	next unless ($meta);
	$meta->remove_all_comments();
	unless ($meta->save()) { warn "removeAllComments: save $pic failed!"; }

	# touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time
	touch($dirthumb);

	updateOneRow($dpic, $picLB);
	showImageInfo($dpic) if ($dpic eq $actpic);
  }
  progressWinEnd($pw);
  $userinfo = "ready! (removed comments in $i of $selected pictures)"; $userInfoL->update;
}

##############################################################
# editComment
##############################################################
sub editComment {
  my $lb = shift;    # the reference to the listbox widget to update

  my @sellist = $lb->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);
  my $selected = @sellist;
  my ($pic, $dpic, $dirthumb, $dirtpic, $com);

  $userinfo = "editing comments from $selected pictures"; $userInfoL->update;

  # check if some files are links
  return if (!checkLinks($lb, @sellist));

  my $pw = progressWinInit($lb, "Edit comments");
  my $i = 0;
  foreach $dpic (@sellist) {
	last if progressWinCheck($pw);
	$i++;
	progressWinUpdate($pw, "editing comment ($i/$selected) ...", $i, $selected);
	$pic      = basename($dpic);
	$dirthumb = getThumbFileName($dpic);

	next if (!checkWriteable($dpic));

	# check if file is a link and get the real target
	next if (!getRealFile(\$dpic));

	my @comsellist = ();

	my $text = "";
	my @comments = getComments($dpic);
	if (@comments <= 0) {
	  next;						# no comment -> no edit
	} elsif (@comments == 1) {
	  $text = $comments[0]; # one comment -> select the first
	  $comsellist[0] = 0;
	} else {
	  # more than one comment, let the user select one comment to edit
	  my $nr = @comments;
	  my @shortComments;
	  foreach (@comments) { push @shortComments, cutString($_, 80, "..."); }
	  next if (!mySelListBoxDialog("Edit comment of $pic",
								   "Please select one of the $nr comments to edit",
                                   SINGLE,
								   "Edit", \@comsellist, @shortComments));

	  if (@comsellist != 1) {
		$top->messageBox(-icon => 'warning', -message => "Please select just one comment.", -title => "Wrong selection", -type => 'OK');
		next;
	  }
	  $text = $comments[$comsellist[0]];
	}

	my $rc = myTextDialog("Edit comment", "Please edit comment of $pic", \$text, $dirthumb);
	next if ($rc ne 'OK');
	# replace (german) umlaute by corresponding letters
	$text =~ s/([$umlaute])/$umlaute{$1}/g if ($config{ConvertUmlaut});
	$config{Comment} = $text; # save changed comment to global config hash

	my $meta = getMetaData($dpic, "COM");
	next unless ($meta);

	$meta->set_comment($comsellist[0], $text);
	unless ($meta->save()) { warn "editComment: save $pic failed!"; }

	# touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time
	touch($dirthumb);

	updateOneRow($dpic, $lb);
	showImageInfo($dpic) if ($dpic eq $actpic);
  }
  progressWinEnd($pw);
  $userinfo = "ready! ($i of $selected edited)"; $userInfoL->update;
}

##############################################################
# joinComments
##############################################################
sub joinComments {

  my $ask = shift;
  unless ($ask == ASK or $ask == NO_ASK) { warn "joinComments called with wrong argument: $ask"; return; }
  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);
  my ($pic, $dpic, $dirthumb, $meta, $com, $nr);


  my $separator = "\n";
  if ($ask == ASK) {
	  my $rc = myButtonDialog('Join comments?', "Ok to join all comments to one comment in each of the ".scalar @sellist." selected pictures?\n\n(Some programms are only able to display the fist comment of a JPEG picture.\nPictures with no or just one comment will be skipped.)\nPlease choose the desired separator when joining the comments.", undef, 'Space', 'Newline', 'Nothing', 'Cancel');
	return if ($rc =~ m/Cancel/i);
	$separator = ' ' if ($rc =~ m/Space/i); 
	$separator = ''  if ($rc =~ m/Nothing/i); 
  }

  $userinfo = "joining comments from ".scalar @sellist." pictures"; $userInfoL->update;

  # check if some files are links
  return if (!checkLinks($picLB, @sellist));

  my $pw = progressWinInit($top, "Join comments");
  my $i  = 0;
  foreach $dpic (@sellist) {
	last if progressWinCheck($pw);
	$i++;
	progressWinUpdate($pw, "joining comments ($i/".scalar @sellist.") ...", $i, scalar @sellist);
	$pic      = basename($dpic);
	$dirthumb = getThumbFileName($dpic);

	next if (!checkWriteable($dpic));

	# check if file is a link and get the real target
	next if (!getRealFile(\$dpic));

	$meta = getMetaData($dpic, "COM");
	next unless ($meta);

	$nr   = $meta->get_number_of_comments();

	next if ($nr <= 1); # no or just one comment -> no join

	$com = getComments($dpic, 0);
    if ((defined $com) and (length $com > $maxCommentLength)) { # a JPEG comment may have max 64kB
	  my $rc = $top->messageBox(-icon => 'warning', -message => "The joined comments of $dpic are too long (".length $com." characters).\nJPEG-Comments may only be up to 64K.\nOK will skip this picture, Cancel will abort the operation.",
					   -title => "Comment to big", -type => 'OKCancel');
	  return if ($rc !~ m/Ok/i);
	  next;
	}

	# join comments with configurable separator string
	$meta->join_comments($separator);
	unless ($meta->save()) { warn "editComment: save $pic failed!"; }

	# touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time
	touch($dirthumb);

	updateOneRow($dpic, $picLB);
  }
  progressWinEnd($pw);
  $userinfo = "ready! ($i of ".scalar @sellist." joined)"; $userInfoL->update;
}

##############################################################
# checkTempFile - check if temp file exists
#                 returns 0 if it exists
#                 return s1 if not
##############################################################
sub checkTempFile($) {
  my $tmpfile = shift;
  if (-f $tmpfile) {
	$top->messageBox(-icon => 'warning', -message => "Temporary file $tmpfile already exists. Skipping!",
					 -title => 'Error', -type => 'OK');
	return 0;
  }
  return 1;
}

##############################################################
# removeComment - remove a JPEG comment from a picture
#                 if there is more than one comment in the
#                 picture the user can
#                 choose which to delete
#                 if the same comment is selected in two pics
#                 we ask, if we should delete this one in all
##############################################################
sub removeComment {

  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);
  my $selected = @sellist;
  my $doForAll = 0;
  my ($pic, $dpic, $dirthumb, $meta, $com, @removedComments);

  $userinfo = "removing comments from $selected pictures"; $userInfoL->update;

  # check if some files are links
  return if (!checkLinks($picLB, @sellist));

  my $pw = progressWinInit($top, "Remove comments");
  my $i = 0;
  my $j = 0; # the real number of changed pictures
  foreach $dpic (@sellist) {
	last if progressWinCheck($pw);
	$i++;
	progressWinUpdate($pw, "removing comment ($i/$selected) ...", $i, $selected);
	$pic      = basename($dpic);
	$dirthumb = getThumbFileName($dpic);

	next if (!checkWriteable($dpic));

	# check if file is a link and get the real target
	next if (!getRealFile(\$dpic));

	my @comments = getComments($dpic);
	next if (@comments <= 0);

	# let the user select the comments to delete
	my @comsellist = ();

	# normal modus - let the user select what to remove
	if (!$doForAll) {
	  my @shortComments;
	  foreach (@comments) { push @shortComments, cutString($_, 80, "..."); }
	  next if (!mySelListBoxDialog("Remove comments",
								   "Please select comment(s) to remove from $pic",
                                   MULTIPLE,
								   "Remove", \@comsellist, @shortComments));
	}
	# comment remove wizard mode :) - we choose the right comment to delete
	else {
	  for (0 .. $#comments) {                          # search in all comments
		if ($comments[$_] eq $removedComments[-1]) {   # for the magic comment
		  $comsellist[0] = $_;                         # remember the index
		  last;
		}
	  }
	}

	if ( (@comsellist == 1) and ($doForAll == 0) ) {    # if just one comment is removed
	  push @removedComments, $comments[$comsellist[0]]; # remember the removed comments
	  if (@removedComments >= 2) {                      # when we collected at least two ...
		if ($removedComments[-1] eq $removedComments[-2]) {  # and they are the same ...
		  if ($i < @sellist) {                               # and there is still some work to be done ...
			my $com = $removedComments[-1];
			$com    = substr($com, 0, 100)."..." if (length($com) > 103);
			my $rc  = $top->messageBox(-icon => 'question', -message => "You've selected the same comment two times. Should I remove this comment:\n-------------\n$com\n-------------\nfrom the rest (".(@sellist - $i).") of the selected pictures?",
									  -title => "Comment remove wizard", -type => 'OKCancel');
			$doForAll = 1 if ($rc =~ m/Ok/i);
		  }
		}
	  }
	}

	# this can only happen in wizard mode (for pictures not containing the comment to remove)
	next if (@comsellist == 0);

	$meta = getMetaData($dpic, "COM");
	next unless ($meta);
 	# delete the selected elements in reverse order, the unselected stay in the @comments
	foreach (reverse @comsellist) {
	  $meta->remove_comment($_);
	}
	unless ($meta->save()) { warn "editComment: save $pic failed!"; }

	$j++; # count the modified pics

	# touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time
	touch ($dirthumb);

	updateOneRow($dpic, $picLB);
	showImageInfo($dpic) if ($dpic eq $actpic);
  }
  progressWinEnd($pw);
  $userinfo = "ready! (removed comments in $j of $selected pictures)"; $userInfoL->update;
}

##############################################################
# rotate - rotate all selected pictures by 90, 180 or 270
#          degrees or do a flip transformation
##############################################################
sub rotate {

  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);
  my $selected = @sellist;
  my ($pic, $dpic, $dirtpic, $i);

  return if (!checkExternProgs("rotate", "jpegtran"));
  my $deg = shift; # 90, 180, 270, auto, clear, norot, horizontal or vertical

  my $mode = 0;
  if ($deg eq "auto") {
	$mode = 1;
	return if (!checkExternProgs("auto rotate", "jhead"));
	my $usage = `jhead -h 2>&1`;
	if ($usage !~ m/.*-autorot.*/) {
	  $top->messageBox(-icon  => 'warning', -message => "Sorry, but your version of jhead does not support automatic rotation!\nTry to get a newer version at: ".$exprogsres{jhead},
					   -title => "Wrong jhead version", -type => 'OK');
	  return;
	}
  }
  elsif ($deg eq "clear") {
	$mode = 2;
	return if (!checkExternProgs("auto rotate", "jhead"));
	my $usage = `jhead -h 2>&1`;
	if ($usage !~ m/.*-norot.*/) {
	  $top->messageBox(-icon  => 'warning', -message => "Sorry, but your version of jhead does not support the clearing of the rotation tag!\nTry to get a newer version at: ".$exprogsres{jhead},
					   -title => "Wrong jhead version", -type => 'OK');
	  return;
	}
  }
  else { $mode = 0; }

  my $transform = "-rotate $deg";
  if (($deg eq "horizontal") or ($deg eq "vertical")) {
	$transform = "-flip $deg";
  }
  my $errors = "";
  my $trim   = "";
  $trim = "-trim " if $config{jpegtranTrim};

  $userinfo = "rotating $selected pictures"; $userInfoL->update;

  # check if some files are links
  return if (!checkLinks($picLB, @sellist));

  my $pw = progressWinInit($top, "rotate pictures");
  $i = 0;
  foreach $dpic (@sellist) {
	last if progressWinCheck($pw);
	$i++;
	$pic      = basename($dpic);
	$dirtpic  = dirname($dpic)."/$pic"."-cjpg"; # temporary file

	next if (!checkWriteable($dpic));

	# check if temp file exists
	next if (!checkTempFile($dirtpic));

	
	my $command = "";

	if ($mode == 1) { # auto
	  if (is_a_JPEG($dpic)) {
		# call external command jhead and auto rotate the file directly
		$command = "jhead -autorot \"$dpic\" ";
	  }
	  else {
		$errors .= "auto rotation is only supported for JPEGs ($dpic)\n";
	  }
	}
	elsif ($mode == 2) { # clear
	  if (is_a_JPEG($dpic)) {
		# call external command jhead and clear the rotation flag of the file directly
		$command = "jhead -norot \"$dpic\" ";
	  }
	  else {
		$errors .= "clear rotation is only supported for JPEGs ($dpic)\n";
	  }
	}
	else {
	  if (is_a_JPEG($dpic)) {
		# call external command jpegtran and rotate to the temp file
		$command = "jpegtran -copy all $transform $trim -outfile \"$dirtpic\" \"$dpic\" ";
	  }
	  else {
		$transform = "-rotate $deg";
		if ($deg eq "horizontal") {
		  $transform = "-flip";
		}
		if ($deg eq "vertical") {
		  $transform = "-flop";
		}
		$command = "mogrify $transform \"$dpic\" ";
	  }
	}
	next if ($command eq "");
	execute($command);
	progressWinUpdate($pw, "rotating ($i/$selected) ...", $i, $selected);

	# now overwrite the original pic with the temp file and delete the temp file
	# (not needed for jhead and mogrify)
	# todo rotate also thumbs of autorotated pics (but how?)
	if (($mode == 0) and (is_a_JPEG($dpic))) {
	  rotateThumb("$dirtpic", $transform) if ($config{RotateThumb});
	  next if (!overwrite("$dpic", "$dirtpic"));
	}

	updateOneRow($dpic, $picLB);

	deleteCachedPics($dpic);
	showPic($dpic) if ($dpic eq $actpic); # redisplay the picture if it is the actual one
  }
  progressWinEnd($pw);
  reselect($picLB, @sellist);
  $userinfo = "ready! ($i of $selected rotated)"; $userInfoL->update;
  showText("Errors while rotating pictures", $errors, NO_WAIT) if ($errors ne "");
  generateThumbs(ASK, SHOW);
}

##############################################################
# rotateThumb
##############################################################
sub rotateThumb {
  my $dpic      = shift;
  my $pic       = basename($dpic);
  my $tmppic    = "$trashdir/$pic";
  my $tmppic2   = "$trashdir/$pic.tcjpeg";
  my $transform = shift;

  print "rotateThumb: $pic $transform\n" if $verbose;

  my $errors = "";
  extractThumb($dpic, $tmppic, \$errors);

  return unless (-f $tmppic); # there is no EXIF thumbnail

  my $trim = "";
  $trim = "-trim " if $config{jpegtranTrim};
  my $command = "jpegtran -copy all $transform $trim -outfile \"$tmppic2\" \"$tmppic\" ";
  execute($command);
  removeFile($tmppic);

  writeThumb($dpic, $tmppic2);
  removeFile($tmppic2);
}

##############################################################
# extractThumb
##############################################################
sub extractThumb {
  my $dpic   = shift;			# picture file with path
  my $dthumb = shift;			# thumbnail file with path (will be overwritten!)
  my $errors = shift;			# reference to error text scalar

  my $meta = getMetaData($dpic, 'APP1');

  if ($meta) {
    my $thumbData = $meta->get_Exif_data('THUMBNAIL');

	if ($thumbData and ($$thumbData ne "")) {
	  my $thumb = new Image::MetaData::JPEG($thumbData);

	  if ($thumb) {
		unless ($thumb->save($dthumb)) {
		  $errors .= "Couldn't save $dthumb";
		}
	  } else {
		$errors .= "Couldn't create thumb $dpic\n";
	  }
	} else {
	  $$errors .= "No EXIF thumbnail in $dpic\n";
	}
  } else {
	$$errors .= "No EXIF data in $dpic\n";
  }

}

##############################################################
# writeThumb - returns 1 if OK, else an error string
##############################################################
sub writeThumb {
  my $dpic    = shift;			# the picture file with path to which the thumb will be written
  my $dthumb  = shift;			# the thumbnail file name with path
  my $error   = 1;
  my $image   = new Image::MetaData::JPEG($dpic, 'APP1');
  return "Could not read meta data of $dpic" unless ($image);

  my $thimage = new Image::MetaData::JPEG($dthumb);
  return "Could not read meta data of $dthumb" unless ($thimage);

  my $data = "dummy";
  unless ($thimage->save(\$data)) {
	return "Could not build thumbnail for $dthumb";
  }

  my $hash = $image->set_Exif_data(\$data, 'THUMBNAIL');
  return "JPEG thumbnail rejected for $dpic" if (keys %$hash);

  my $result  = $image->save();
  return "save failed for $dpic" unless ($result);

  return 1;
}

##############################################################
# copyThumbnail
##############################################################
sub copyThumbnail {

  my @sellist  = $picLB->info('selection');
  my $selected = @sellist;
  my ($pic, $dpic, $i, $dirthumb);

  return unless checkSelection($top, 1, 0, \@sellist);

  if ((!defined $copyEXIFDataSource) or (!-f $copyEXIFDataSource)) {
	$top->messageBox(-icon => 'warning', -message => 'Please select a source picture first. This picture will be used as thumbnail, you may use "Save thumbnail ..." first. Than choose EXIF info->copy from!',
					 -title => 'No source picture', -type => 'OK');
	return;
  }

  my $size = getFileSize($copyEXIFDataSource, NO_FORMAT); # file size in bytes
  if ($size > 65535) {
	$top->messageBox(-icon => 'warning', -message => "Sorry, the thumbnail picture is too big ($size bytes). The thumbnail picture must have less than 65535 bytes.",
					 -title => "Thumbnail too big", -type => 'OK');
	return;
  }

  my $message = "Copy this thumbnail from\
\"".basename($copyEXIFDataSource)."\"\
to $selected selected pictures.\
The original thumbnails of these pictures will be lost!\
Ok to continue?";

  my $rc = myButtonDialog("Copy EXIF data", "$message", $copyEXIFDataSource, 'OK', 'Cancel');

  return if ($rc ne 'OK');

  $userinfo = "transfering thumbnail to $selected pictures"; $userInfoL->update;

  my $errors = "";
  $i = 0;
  my $pw = progressWinInit($top, "Copy thumbnail");
  foreach $dpic (@sellist) {
	last if progressWinCheck($pw);
	$i++;
	progressWinUpdate($pw, "transfering thumbnail ($i/$selected) ...", $i, $selected);
	$pic      = basename($dpic);
	$dirthumb = getThumbFileName($dpic);

	# check if file is a link and get the real target
	next if (!getRealFile(\$dpic));
	next if (!checkWriteable($dpic));

	my $rc = writeThumb($dpic, $copyEXIFDataSource);
	$errors .= "$rc\n" if ($rc ne '1');

	updateOneRow($dpic, $picLB);

	# touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time
	touch($dirthumb);
  }
  progressWinEnd($pw);

  $userinfo = "ready! ($i/$selected thumbnails transfered)"; $userInfoL->update;
  showText("Errors while transfering thumbnails", $errors, NO_WAIT) if ($errors ne "");
}

##############################################################
# buildEXIFThumb
##############################################################
sub buildEXIFThumb {

  my $rc  = $top->messageBox(-icon => "question",
							 -message => "This function will (re)build the embedded EXIF thumbnail of the selected pictures.\nThe original EXIF thumnail (if existent) will be overwritten!\nOk to continue?",
							 -title => "(Re)Build EXIF thumbnail", -type => 'OKCancel');
  return if ($rc !~ m/Ok/i);

  my @sellist  = $picLB->info('selection');
  my $selected = @sellist;
  my ($pic, $dpic, $i, $dirthumb, $thumb);

  return unless checkSelection($top, 1, 0, \@sellist);


  $userinfo = "(re)building EXIF thumbnail in $selected pictures"; $userInfoL->update;

  $i = 0;
  my $pw = progressWinInit($top, "(Re)build EXIF thumbnail");
  foreach $dpic (@sellist) {
	last if progressWinCheck($pw);
	progressWinUpdate($pw, "(Re)building EXIF thumbnail ($i/$selected) ...", $i, $selected);
	$i++;
	$pic      = basename($dpic);
	$dirthumb = getThumbFileName($dpic);
	$thumb = "$trashdir/$pic-exifthumb";

	if (-f $thumb) {
	  warn "the temp file $thumb exists - skipping!";
	  next;
	}

	# check if file is a link and get the real target
	next if (!getRealFile(\$dpic));
	next if (!checkWriteable($dpic));

	my $command = "convert -size 160x160 -geometry 160x160 -quality 75 -sharpen 0.4 -filter Lanczos \"$dpic\" \"$thumb\"";
	$top->Busy;
	execute($command);
	$top->Unbusy;

	if (!-f $thumb) {
	  warn "file $thumb not generated - skipping!";
	  next;
	}

	my $errors;
	removeEXIF($thumb, 'all', \$errors);

	my $size = getFileSize($thumb, NO_FORMAT); # file size in bytes

	if ($size > 65535) {
	  $top->messageBox(-icon => 'warning', -message => "Sorry, builded EXIF thumbnail picture is too big ($size bytes). The thumbnail picture must have less than 65535 bytes.\nSkipping picture ...",
					   -title => "Thumbnail too big", -type => 'OK');
	  next;
	}
	writeThumb($dpic, $thumb);
	removeFile($thumb);
	# touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time
	touch($dirthumb);

	updateOneRow($dpic, $picLB);
	showImageInfo($dpic) if ($dpic eq $actpic);
  }
  progressWinEnd($pw);

  $userinfo = "ready! ($i/$selected EXIF thumbnails (re)builded)"; $userInfoL->update;
}

##############################################################
# reselect - selects the index in the given list, if they exist
#            and shows the selection information in the status
#            bar
##############################################################
sub reselect {
  my $lb = shift;
  foreach (@_) { $lb->selectionSet($_) if ($lb->info("exists", $_)); }
  showNrOf() if ($lb == $picLB);
}

##############################################################
# rotateAny - rotate all selected pictures in any angle
##############################################################
sub rotateAny {

  return if (!checkExternProgs("rotateAny", "mogrify"));

  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);

  my $selected = @sellist;
  my ($dpic, $i, $command);

  $userinfo = "rotating $selected pictures"; $userInfoL->update;

  # check if some files are links
  return if (!checkLinks($picLB, @sellist));

  my $doforall = 0;
  my $degree   = 0;
  my $color    = "gray30";

  my $pw = progressWinInit($top, "Rotate pictures");
  $i = 0;
  foreach $dpic (@sellist) {
	last if progressWinCheck($pw);
	$i++;

	if (!$doforall) {
	  last if (!rotateDialog(\$degree, \$color, \$doforall, $dpic, $selected));
	}

	progressWinUpdate($pw, "rotating ($i/$selected) ...", $i, $selected);

	# check if file is a link and get the real target
	next if (!getRealFile(\$dpic));
	next if (!checkWriteable($dpic));
	next if (!makeBackup($dpic));

	$command = "mogrify -rotate $degree -bordercolor \"$color\" -background \"$color\" -quality $config{PicQuality} ";
	$command .= "-unsharp ".$config{UnsharpRadius}.'x'.$config{UnsharpSigma}."+".$config{UnsharpAmount}."+".$config{UnsharpThreshold}." " if $config{Unsharp};
	$command .= "\"$dpic\" ";
	print "$command\n" if $verbose;
	execute($command);

	if ($config{AddMapiviComment}) {
		$command =~ s/\"//g;
		$command = "Picture processed by Mapivi ($mapiviURL):\n".$command;
		addCommentToPic($command, $dpic, NO_TOUCH);
	}
	updateOneRow($dpic, $picLB);

	deleteCachedPics($dpic);
	showPic($dpic) if ($dpic eq $actpic); # redisplay the picture if it is the actual one
  }
  progressWinEnd($pw);
  reselect($picLB, @sellist);
  $userinfo = "ready! ($i of $selected rotated)"; $userInfoL->update;
  generateThumbs(ASK, SHOW);
}

my $rotw;
##############################################################
# rotateDialog
##############################################################
sub rotateDialog {

  my $deg      = shift; # reference
  my $col      = shift; # reference
  my $doforall = shift; # reference
  my $pic      = shift; # the preview pic
  my $nr       = shift; # the number of pics

  my $preview_size = 400;
  
  if (Exists($rotw)) {
	$rotw->deiconify;
	$rotw->raise;
	return;
  }

  my $orig = "$trashdir/".basename($pic);
  my $new  = "$trashdir/x-".basename($orig);

  unless (mycopy($pic, $orig, OVERWRITE)) {
	warn "rotateDialog: copy error $pic -> $orig ($new)\ncopy";
	return 0;
  }

  my ($w, $h) = getSize($orig);

  if ($w > $preview_size or $h > $preview_size) {
	$userinfo = "rotate: resizing preview picture ..."; $userInfoL->update;
	my $command = "mogrify -geometry ${preview_size}x${preview_size} -quality 80 \"$orig\"";
	$top->Busy;
	execute($command);
	$top->Unbusy;
	$userinfo = "ready!"; $userInfoL->update;
  }

  return 0 unless (-f $orig);

  # open window
  $rotw = $top->Toplevel();
  $rotw->title("Rotate picture");
  $rotw->iconimage($mapiviicon) if $mapiviicon;

  my $rc = 0;
  my $preview = $rotw->Photo(-file => "$orig", -gamma => $config{Gamma}) if (-f $orig);
  my $fc = $rotw->Frame()->pack();
  my $prevC = $fc->Scrolled("Canvas",
							  -scrollbars => 'osoe',
							  -width  => $preview_size,
							  -height => $preview_size,
							  -relief => 'sunken',
							  -bd => $config{Borderwidth})->pack(-side => "left", -padx => 3, -pady => 3,-anchor => 'w') if $preview;

  my $horizont = 0;
  my $vertical = 0;
  $fc->Scale(-variable => \$horizont,
			 -length => $preview_size,
			 -from => 0,
			 -to => $preview_size,
			 -resolution => 1,
			 -sliderlength => 10,
			 -orient => 'vertical',
			 -width => 10,
			 -bd => 1,
			 -showvalue => 0,
			 -relief => 'groove',
			 -command => sub {
			   drawHorizont($prevC, $horizont, $vertical);
			 } )->pack(-side => "left", -padx => 3,-pady => 3);
  $rotw->Scale(-variable => \$vertical,
 			   -length => $preview_size,
 			   -from => 0,
 			   -to => $preview_size,
 			   -resolution => 1,
 			   -sliderlength => 10,
 			   -orient => 'horizontal',
 			   -width => 10,
 			   -bd => 1,
			   -showvalue => 0,
 			   -relief => 'groove',
			   -command => sub {
				 drawHorizont($prevC, $horizont, $vertical);
			   } )->pack(-anchor => 'w', -padx => 3,-pady => 3);

  $prevC->createImage(0, 0, -image => $preview, -tag => "image", -anchor => "nw");

  my $f1 = $rotw->Frame()->pack(-anchor => 'w');
  my $auto = 0;
  $f1->Checkbutton(-text => "auto update", -variable => \$auto)->pack(-side => "left", -expand => 1, -fill => 'x');
  $f1->Button(-text => "--", -command => sub {
				$$deg--;
				rotUpdate($prevC, $preview, $orig, $new, $deg, $col) if $auto;
			  })->pack(-side => "left", -expand => 1, -fill => 'x');

  $f1->Button(-text => "-", -command => sub {
				$$deg -= 0.1;
				rotUpdate($prevC, $preview, $orig, $new, $deg, $col) if $auto;
			  })->pack(-side => "left", -expand => 1, -fill => 'x');

  $f1->Label(-textvariable => $deg, -relief => "sunken", -width => 5)->pack(-side => "left", );

  $f1->Button(-text => "+", -command => sub {
				$$deg += 0.1;
				rotUpdate($prevC, $preview, $orig, $new, $deg, $col) if $auto;
			  })->pack(-side => "left", -expand => 1, -fill => 'x');

  $f1->Button(-text => "++", -command => sub {
				$$deg++;
				rotUpdate($prevC, $preview, $orig, $new, $deg, $col) if $auto;
			  })->pack(-side => "left", -expand => 1, -fill => 'x');

  labeledScale($rotw, 'top', 26, "Angle (degrees, clockwise)", $deg, 0, 359.9, 0.1);

  my $qS = labeledScale($rotw, 'top', 26, "Quality (%)", \$config{PicQuality}, 10, 100, 1);
  qualityBalloon($qS);

  labeledEntryColor($rotw,'top',26,"Background color",'Set',$col);

  # check, if a new version of ImageMagick's mogrify with the unsharp option is available
  my $unsharp = 0;
  $unsharp    = 1 if (`mogrify` =~ m/.*-unsharp.*/);

  # sharpen the image with an unsharp mask operator
  if ($unsharp) {
	my $umF = $rotw->Frame()->pack(-fill =>'x');

	my $umcB = $umF->Checkbutton(-variable => \$config{Unsharp},
								 -anchor => 'w',
								 -text => "Unsharp mask")->pack(-side => "left", -anchor => 'w', -fill => 'x', -expand => 1);
	$balloon->attach($umcB, -msg => "The -unsharp option sharpens an image.
We convolve the image with a Gaussian operator of the given radius
and standard deviation (sigma).
For reasonable results, radius should be larger than sigma.
Use a radius of 0 to have the method select a suitable radius.");

	$umF->Button(-text => "Options",
				 -anchor => 'w',
				 -command => sub { unsharpDialog(); })->pack(-side => "left", -anchor => 'w', -padx => 3);
}

	buttonBackup($rotw, 'top');
	buttonComment($rotw, 'top');

  if ($nr > 1) {
	$rotw->Checkbutton(-variable => \$$doforall,
					   -anchor   => 'w',
					   -text     => "use this setting for all pics"
					  )->pack(-anchor => 'w');
  }

  my $ButF = $rotw->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);

  my $OKB = $ButF->Button(-text => 'OK',
						  -command => sub {
							$rc = 1;
							$rotw->withdraw();
							$rotw->destroy();
						  }
						 )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $ButF->Button(-text => "Preview",
				-command => sub {
				  rotUpdate($prevC, $preview, $orig, $new, $deg, $col);
				}
			   )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3) if $preview;

  my $XBut = $ButF->Button(-text => 'Cancel',
						   -command => sub {
							 $rc = 0;
							 $rotw->withdraw();
							 $rotw->destroy();
						   }
						  )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $rotw->bind('<Key-q>',      sub { $XBut->invoke; });
  $rotw->bind('<Key-Escape>', sub { $XBut->invoke; });

  $rotw->Popup;
  $rotw->waitWindow;
  $preview->delete;
  removeFile($orig);
  removeFile($new);
  return $rc;

}

##############################################################
# drawHorizont
##############################################################
sub drawHorizont {
  my $canvas = shift;
  my $y      = shift; # in percent of the canvas height
  my $x      = shift; # in percent of the canvas width

  $canvas->delete('withtag', 'line');
  $canvas->createLine( 0, $y, $canvas->width, $y,
						   -tags => "line",
						   -fill => "black",
					   -dash => [6,4,2,4],
						 );
  $canvas->createLine( 0, $y, $canvas->width, $y,
						   -tags => "line",
						   -fill => "white",
							-dash => [2,6,2,4],
						 );
  $canvas->createLine( $x, 0, $x, $canvas->height,
					   -tags => "line",
					   -fill => "black",
					   -dash => [6,4,2,4],
					 );
  $canvas->createLine( $x, 0, $x, $canvas->height,
					   -tags => "line",
					   -fill => "white",
					   -dash => [2,6,2,4],
					 );
}

##############################################################
# rotUpdate - update the picture in the rotateDialog with the
#             new degree setting
##############################################################
sub rotUpdate {
  my ($prevC, $preview, $orig, $new, $deg, $col) = @_;

  return if !mycopy("$orig", "$new", OVERWRITE);

  $rotw->Busy;
  # some versions of mogrify need bordercolor, some background so we supply both
  my $command = "mogrify -rotate $$deg -bordercolor \"$$col\" -background \"$$col\" \"$new\" ";
  execute($command);
  $preview->configure(-file => "$new", -gamma => $config{Gamma});
  my @ids = $prevC->find('withtag', 'image');
  my ($x1, $y1, $x2, $y2) = $prevC->bbox($ids[0]);
  $prevC->configure(-scrollregion => [0, 0, $x2-$x1, $y2-$y1]);
  $rotw->Unbusy;
}

##############################################################
# getRealFile - alters the path and file name to the real file
#               if it's a link, else do nothing
#               returns 1 if everything worked, else 0
##############################################################
sub getRealFile($) {
  my $dirfileR = shift; # reference to a file, which may be a link

  if (!-f $$dirfileR) {
	warn "getRealFile: $$dirfileR is no file!";
	return 0;
  }

  if (-l $$dirfileR) {
	my $linktargetfile = getLinkTarget($$dirfileR);
	if ($linktargetfile eq "") {
	  warn "error in getLinkTarget! ($$dirfileR)";
	  return 0;
	}
	else {
	  $$dirfileR = $linktargetfile;
	  return 1;
	}
  }
  else {      # no link, change nothing, return true
	return 1;
  }

}

##############################################################
# getLinkTarget - returns the file a link is pointing to
#                 input (folder, link) or (dirlink) where
#                 dirlink consists of folder and link
#                 works with relative and absolute links
##############################################################
sub getLinkTarget {
  my ($dir, $link);
  if (@_ == 2) {
	$dir  = shift;
	$link = shift;
  }
  elsif (@_ == 1) {
	$dir  = dirname($_[0]);
	$link = basename($_[0]);
  }
  else {
	warn "getLinkTarget: wrong # of parameters!";
	return "";
  }
  # change first to the start dir (to handle relative links)
  return "" if !changeDir($dir);
  my $linktargetfile = readlink $link;
  my $linktargetdir  = dirname  $linktargetfile;
  # change to link target, this should now work for relative and absolute links
  return "" if !changeDir($linktargetdir);
  # get the current dir
  my $cwd = cwd();
  $linktargetfile = $cwd."/".basename($linktargetfile);
  return $linktargetfile;
}

##############################################################
# overwrite - takes two files a and b, deletes a and moves b
#             to a
#             the filenames must include the absolute path
##############################################################
sub overwrite($$) {

  my $dpic  = shift;
  my $dirtpic = shift;

  if (!-f $dirtpic) {
	warn "overwrite: $dirtpic not created. Giving up!";
	return 0;
  }

  if (-l $dpic) {
	my $linktargetfile = getLinkTarget($dpic);
	$dpic = $linktargetfile;
  }

  return 0 if (! removeFile($dpic) );

  if (!move ("$dirtpic", "$dpic")) {
	$top->Dialog(-title => "Move $dirtpic",
				 -text    => "Couldn't move $dirtpic to $dpic: $!",
				 -buttons => ["Ok"])->Show();
	return 0;
  }
  return 1;
}

##############################################################
# myEntryDialog - get a string from the user
# returns 'OK' or 'Cancel'
##############################################################
sub myEntryDialog {

  my $title     = shift;
  my $text      = shift;
  my $varRef    = shift;
  my $thumbnail = shift; # optional
  my $icon;
  my $rc        = 'Cancel';

  # open window
  my $myDiag = $top->Toplevel();
  $myDiag->title($title);
  $myDiag->iconimage($mapiviicon) if $mapiviicon;

  my $f = $myDiag->Frame()->pack;
  if ((defined $thumbnail) and (-f $thumbnail)) {
	$icon  = $top->Photo(-file => "$thumbnail", -gamma => $config{Gamma});
	if ($icon) {
	  $f->Label(-image => $icon, -bg => $config{ColorBG}, -relief => "sunken",
			   )->pack(-side => "left", -fill => 'x', -padx => 3, -pady => 3);
	}
  }

  # determine the heigt of the textbox by counting the number of lines
  my $height = ($text =~ tr/\n//);
  $height += 2;
  $height = 50 if ($height > 50); # not to big, we have scrollbars
  my $rotext = $f->Scrolled("ROText",
							-scrollbars => 'osoe',
							-wrap => 'word',
							-tabs => '4',
							-width => 70,
							-height => $height,
							-relief => "flat",
							-bg => $config{ColorBG},
							-bd => 0
						   )->pack(-side => "right", -fill => 'both', -expand => "1", -padx => 3, -pady => 3);
  $rotext->insert('end', $text);

  my $OKB;

  my $entry =
    $myDiag->Entry(-textvariable => \$$varRef,
		   -width => 40,
		  )->pack(-fill => 'x', -padx => 3, -pady => 3);

  if ($$varRef =~ /(.*)(\.jp(g|eg))/i) {  # if it is a jpeg image name
    $entry->selectionRange(0,length($1)); # select only the part before the suffix
    $entry->icursor(length($1));
  }
  else {
    $entry->selectionRange(0,'end');      # else select all
    $entry->icursor('end');
  }
  $entry->xview('end');

  $entry->bind('<Return>', sub { $OKB->invoke; } );
  $entry->focus;

  my $ButF = $myDiag->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);

  $OKB = $ButF->Button(-text => 'OK',
		       -command => sub {
			 $rc = 'OK';
			 $myDiag->destroy;
		       })->pack(-side => 'left', -expand => 1, -fill => 'x',
				-padx => 3, -pady => 3);

  my $XBut = $ButF->Button(-text => 'Cancel',
			   -command => sub {
			     $rc = 'Cancel';
			     $myDiag->destroy;
			   }
			  )->pack(-side => 'left', -expand => 1, -fill => 'x',
				  -padx => 3, -pady => 3);

  $myDiag->bind('<Key-Escape>', sub { $XBut->invoke; });
  $myDiag->Popup;
  repositionWindow($myDiag);
  $myDiag->waitWindow();
  $icon->delete if $icon;
  return $rc;
}

##############################################################
# myFontDialog - dialog to select a font family
##############################################################
sub myFontDialog {

  my $widget    = shift;
  my $title     = shift;
  #my $text      = shift;
  my $varRef    = shift;
  my $size      = shift;
  my $rc        = 0;

  # open window
  my $myDiag = $widget->Toplevel();
  $myDiag->title($title);
  $myDiag->iconimage($mapiviicon) if $mapiviicon;

  my $listBox = $myDiag->Scrolled('Listbox',
				  -scrollbars => 'osoe',
				  -selectmode => 'single',
				  -exportselection => 0,
				  -width => 30,
				  #-height => 40,
				 )->pack(-side => 'left', -anchor => 'w', -expand => 1, -fill =>'y', -padx => 3, -pady => 3);

  my $f = $myDiag->Frame()->pack(-side => 'left', -expand => 1, -anchor => 'w', -fill =>'both');

  my @fontFamilies = sort $top->fontFamilies;
  shift @fontFamilies unless ($fontFamilies[0]);

  bindMouseWheel($listBox);

  $listBox->insert('end', @fontFamilies);

  foreach my  $i (0 .. $#fontFamilies) {
    if ($fontFamilies[$i] eq $$varRef) {
      $listBox->selectionSet($i);
      $listBox->see($i);
      last;
    }
  }

  my $normalText = "This is a preview Text, here you can see how the selected font will look like.\n\nThe brown fox jumps over the brigde.\n\n1      :\n12     :\n123    :\n1234   :\n12345  :\nWWWWWWW:\niiiiiii:\n\040\041\042\043\044\045\046\047\050\051\052\053\054\055\056\057\040\041\042\043\044\045\046\047\050\051\052\053\054\055\056\057\060\061\062\063\064\065\066\067\070\071\072\073\074\075\076\077\100\n\101\102\103\104\105\106\107\110\111\112\113\114\115\116\117\120\121\122\123\124\125\126\127\130\131\132\133\134\135\136\137\140\141\142\143\144\145\146\147\150\151\152\153\154\155\156\157\160\161\162\163\164\165\166\167\170\171\172\173\174\175\176\n\200\201\202\203\204\205\206\207\210\211\212\213\214\215\216\217\220\221\222\223\224\225\226\227\230\231\232\233\234\235\236\237\240\241\242\243\244\245\246\247\250\251\252\253\254\255\256\257\n\260\261\262\263\264\265\266\267\270\271\272\273\274\275\276\277\300\301\302\303\304\305\306\307\310\311\312\313\314\315\316\317\320\321\322\323\324\325\326\327\330\331\332\333\334\335\336\337\n\340\341\342\343\344\345\346\347\350\351\352\353\354\355\356\357\360\361\362\363\364\365\366\367\370\371\372\373\374\375\376\377"; 

  my $ButF = $f->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);

  my $pane = $f->Scrolled('Pane', -bd => $config{Borderwidth}, -relief => 'groove', -scrollbars => 'osoe', -width => 1000)->pack(-expand => 1, -anchor => 'w', -fill => 'both', -padx => 3, -pady => 3);
  my $example = $pane->Label(-text => $normalText, -bg => $config{ColorBG}, -justify => 'left')->pack(-fill => 'both', -expand => 1, -anchor => 'w');

  $listBox->bind('<ButtonRelease-1>', sub {
		   my @sell = $listBox->curselection();
		   return unless @sell;
		   my $actfont = $fontFamilies[$sell[0]];
		   return unless $actfont;
		   $myDiag->Busy;
		   my $font = $top->Font(-family => $actfont,
					 -size   => $size);
		   $example->configure(-font => $font);
		   $example->update();
		   $myDiag->Unbusy;
		 } );


  $ButF->Button(-text => 'next',
		-command => sub {
		  my @sell = $listBox->curselection();
		  return unless @sell;
		  my $index = $sell[0];
		  $listBox->selectionClear(0, 'end');
		  $index++;
		  $index = 0 if ($index >= @fontFamilies);
		  $listBox->selectionSet($index);
		  $listBox->see($index);
		  my $actfont = $fontFamilies[$index];
		  return unless $actfont;
		  $myDiag->Busy;
		  my $font = $top->Font(-family => $actfont,
					-size   => $size);
		  $example->configure(-font => $font);
		  $example->update();
		  $myDiag->Unbusy;
		})->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $ButF->Button(-text => 'previous',
		-command => sub {
		  my @sell = $listBox->curselection();
		  return unless @sell;
		  my $index = $sell[0];
		  $listBox->selectionClear(0, 'end');
		  $index--;
		  $index = $#fontFamilies if ($index < 0);
		  $listBox->selectionSet($index);
		  $listBox->see($index);
		  my $actfont = $fontFamilies[$index];
		  return unless $actfont;
		  $myDiag->Busy;
		  my $font = $top->Font(-family => $actfont,
					-size   => $size);
		  $example->configure(-font => $font);
		  $example->update();
		  $myDiag->Unbusy;
		})->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);


  my $OKB = $ButF->Button(-text => 'OK',
			  -command => sub {
			    my @sell = $listBox->curselection();
			    $$varRef = $fontFamilies[$sell[0]] if @sell;
			    $rc = 1;
			    $myDiag->destroy;
			  })->pack(-side => 'left', -expand => 1, -fill => 'x',
				   -padx => 3, -pady => 3);

  $myDiag->bind ('<Return>',          sub { $OKB->invoke; } );
  $listBox->bind('<Double-Button-1>', sub { $OKB->invoke; } );
  $OKB->focus;

  my $XBut = $ButF->Button(-text => 'Cancel',
			   -command => sub {
			     $rc = 0;
			     $myDiag->destroy;
			   }
			  )->pack(-side => 'left', -expand => 1, -fill => 'x',
				  -padx => 3, -pady => 3);

  $myDiag->bind('<Key-Escape>', sub { $XBut->invoke; });
  my $ws = 0.5;
  my $w = int($ws * $myDiag->screenwidth);
  my $h = int($ws * $myDiag->screenheight);
  my $x = int(((1 - $ws) * $myDiag->screenwidth)/3);
  my $y = int(((1 - $ws) * $myDiag->screenheight)/3);
  #print "geo==${w}x${h}+${x}+${y}\n";
  $myDiag->geometry("${w}x${h}+${x}+${y}");
  $myDiag->Popup;
  repositionWindow($myDiag);
  $myDiag->waitWindow();
  return $rc;
}

##############################################################
# myPicDialog - show some thumbnails and a text to the user
#               returns 'OK' or content of $button
##############################################################
sub myPicDialog {

  my $title      = shift;
  my $text       = shift;
  my $button     = shift; # optional button, if not needed set to ""
  my @thumbnails = @_;
  my @icons;
  my $rc         = $button;

  # open window
  my $myDiag = $top->Toplevel();
  $myDiag->title($title);
  $myDiag->iconimage($mapiviicon) if $mapiviicon;

  # determine the heigt of the textbox by counting the number of lines
  my $height = ($text =~ tr/\n//);
  $height += 2;
  $height = 50 if ($height > 50); # not to big, we have scrollbars
  my $rotext = $myDiag->Scrolled("ROText",
								 -scrollbars => 'osoe',
								 -wrap => 'word',
								 -tabs => '4',
								 -width => 40,
								 -height => $height,
								 -relief => "flat",
								 -bg => $config{ColorBG},
								 -bd => "0"
								)->pack(-fill => 'both', -expand => "1", -padx => 3, -pady => 3);
  $rotext->insert('end', $text);

  my $f = $myDiag->Frame()->pack;
  my $i = 0;
  # insert the thumbnails
  foreach (@thumbnails) {
	if ((defined $_) and (-f $_)) {
	  $icons[$i] = $top->Photo(-file => "$_", -gamma => $config{Gamma});
	  if ($icons[$i]) {
		$f->Label(-image => $icons[$i], -bg => $config{ColorBG}, -relief => "sunken",
				 )->pack(-side => "left", -anchor => "n", -fill => 'x', -padx => 3, -pady => 3);
		$i++;
	  }
	}
  }

  my $bf = $myDiag->Frame()->pack(-expand => 1, -fill => 'x');
  my $OKB = $bf->Button(-text => 'OK', -command => sub { $rc = 'OK'; $myDiag->destroy; }
					   )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  $OKB->focus;

  if ($button ne "") {
	$bf->Button(-text => $button, -command => sub { $rc = $button; $myDiag->destroy; }
			   )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  }

  $myDiag->bind('<Key-Escape>', sub { $OKB->invoke; });
  $myDiag->Popup;
  repositionWindow($myDiag);
  $myDiag->waitWindow();
  foreach (@icons) { $_->delete if $_; } # free memory
  return $rc;
}

##############################################################
# myButtonDialog - get a feedback from the user
#                  you may specify as many buttons as you like
#                  the return value will be the text of the button pressed
#                  The first one is the default button
#                  the last one is invoked when pressing Escape
##############################################################
sub myButtonDialog {

  my $title     = shift;
  my $text      = shift;
  my $thumbnail = shift;
  my @buttons   = @_;

  my $icon;
  my $rc        = "";

  # open window
  my $myDiag = $top->Toplevel();
  $myDiag->title($title);
  $myDiag->iconimage($mapiviicon) if $mapiviicon;

  my $f = $myDiag->Frame()->pack(-fill => 'both', -expand => "1");
  if ((defined $thumbnail) and (-f $thumbnail)) {
	$icon  = $top->Photo(-file => "$thumbnail", -gamma => $config{Gamma});
	if ($icon) {
	  $f->Label(-image => $icon, -bg => $config{ColorBG}, -relief => "sunken",
			   )->pack(-side => "left", -fill => 'x', -padx => 3, -pady => 3);
	}
  }

  # determine the heigt of the textbox by counting the number of lines
  my $height = ($text =~ tr/\n//);
  $height += 2;
  $height = 50 if ($height > 50); # not to big, we have scrollbars
  my $rotext = $f->Scrolled("ROText",
							-scrollbars => 'osoe',
							-wrap => 'word',
							-tabs => '4',
							-width => 80,
							-height => $height,
							-relief => "flat",
							-bg => $config{ColorBG},
							-bd => "0"
						   )->pack(-side => 'right', -fill => 'both', -expand => "1", -padx => 3, -pady => 3);
  $rotext->insert('end', $text);

  my %buts;
  my $ButF = $myDiag->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);

  # add the buttons
  foreach (@buttons) {
	my $name = $_;
	$buts{$name} = $ButF->Button(-text => "$name",
							  -command => sub {
								$rc = "$name";
							  })->pack(-side => 'left', -expand => 1, -fill => 'x',
									   -padx => 3, -pady => 3);
  }

  # the first button gets the focus and is invoked with return
  $myDiag->bind('<Return>', sub { $buts{$buttons[0]}->invoke; } );
  $buts{$buttons[0]}->focus;
  # the last button is invoked with the Escape key
  $myDiag->bind('<Key-Escape>', sub { $buts{$buttons[-1]}->invoke; });

  $myDiag->Popup;
  repositionWindow($myDiag);
  $myDiag->waitVariable(\$rc);
  $icon->delete if $icon;
  $myDiag->destroy();
  $top->focus;
  return $rc;
}

##############################################################
# checkDialog - a dialog with a Checkbutton (e.g. do not show
#               this again ...)
##############################################################
sub checkDialog {

  my $title     = shift;
  my $text      = shift;
  my $check     = shift;  # var ref
  my $checkT    = shift;  # the text for the checkbutton
  my $thumbnail = shift;  # !!! not optional, supply "" if there is no thumbnail to show
  my @buts      = @_;     # the button text, this text will be returned

  my $icon;
  my $rc;

  # open window
  my $myDiag = $top->Toplevel();
  $myDiag->title($title);
  $myDiag->iconimage($mapiviicon) if $mapiviicon;

  my $f = $myDiag->Frame()->pack;
  if ((defined $thumbnail) and (-f $thumbnail)) {
	$icon  = $top->Photo(-file => "$thumbnail", -gamma => $config{Gamma});
	if ($icon) {
	  $f->Label(-image => $icon, -bg => $config{ColorBG},
					)->pack(-side => "left", -fill => 'x', -padx => 3, -pady => 3);
	}
  }

  # determine the heigt of the textbox by counting the number of lines
  my $height = ($text =~ tr/\n//);
  $height += 2;
  $height = 50 if ($height > 50); # not to big, we have scrollbars
  my $rotext = $f->Scrolled("ROText",
							-scrollbars => 'osoe',
							-wrap => 'word',
							-tabs => '4',
							-width => 55,
							-height => $height,
							-relief => "flat",
							-bg => $config{ColorBG},
							-bd => "0"
						   )->pack(-side => "right", -fill => 'both', -expand => "1", -padx => 3, -pady => 3);
  $rotext->insert('end', $text);

  my $OKB;

  $myDiag->Checkbutton(-variable => \$$check,
					   -text => $checkT,
					  )->pack(-fill => 'x',
							  -padx => 3,
							  -pady => 3);


  my $ButF =
	$myDiag->Frame()->pack(-fill =>'x',
							 -padx => 3,
							 -pady => 3);

  foreach my $text (@buts) {
	$ButF->Button(-text => "$text",
				  -command => sub {
					$rc = "$text";
				  })->pack(-side => 'left',
						   -expand => 1,
						   -fill => 'x',
						   -padx => 3,
						   -pady => 3);
  }


  $myDiag->Popup;
  repositionWindow($myDiag);
  $myDiag->waitVariable(\$rc);
  $icon->delete if $icon;
  $myDiag->withdraw();
  $myDiag->destroy();
  return $rc;
}

##############################################################
# myTextDialog - get a text from the user
##############################################################
sub myTextDialog {

  my $title  = shift;
  my $text   = shift;
  my $varRef = shift;
  my $thumb  = shift; # optional file name of thumbnail
  my ($rc, $icon);

  # open window
  my $myDiag = $top->Toplevel();
  #$myDiag->grab();
  $myDiag->title($title);
  $myDiag->iconimage($mapiviicon) if $mapiviicon;

  $myDiag->Label(-text => $text, -bg => $config{ColorBG}
				  )->pack(-fill => 'x', -padx => 3, -pady => 3);

  my $fl = $myDiag->Frame()->pack(-anchor => "n", -side => "left");
  my $fm = $myDiag->Frame()->pack(-expand => 1, -fill => "both", -anchor => "n", -side => "left");
  my $fr = $myDiag->Frame()->pack(-expand => 1, -fill => "both", -anchor => "n", -side => "left");
  if ((defined $thumb) and (-f $thumb)) {
	$icon = $myDiag->Photo(-file => "$thumb", -gamma => $config{Gamma});
	if ($icon) {
	  $fl->Label(-image => $icon, -bg => $config{ColorBG}, -relief => "sunken",
			   )->pack(-padx => 1, -pady => 2);
	}
  }

  my $topButF = $fm->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-fill =>'x', -padx => 3, -pady => 3);

  my $midF = $fm->Frame()->pack(-expand => 1, -fill => "both", -padx => 0, -pady => 3);

  my $entry = $midF->Scrolled("Text",
							  -scrollbars => 'osoe',
							  -wrap => 'none',
							  -width => 65,
							  -height => 20,
							 )->pack(-side => "left", -expand => 1, -fill => "both", -padx => 3, -pady => 3);

  $entry->insert('end', $$varRef);
  #$entry->selectionRange(0,'end');
  $entry->see('end');
  $entry->markSet("insert",'end');

  my $keytree = $fr->Scrolled('Tree',
							  -separator  => '/',
							  -scrollbars => 'osoe',
							  -selectmode => 'single',
							  -exportselection => 0,
							  -width      => 20,
							  )->pack(-expand => 1, -fill => 'both', -padx => 2, -pady => 2);
  bindMouseWheel($keytree->Subwidget("scrolled"));
  $balloon->attach($keytree, -msg => "Double click on a keyword to insert it.\nIt's possible to edit the keywords, use the\nright mouse button to open the edit menu.");

  # try to get the saved mode
  if (-f "$configdir/keywordMode") {
	my $hashRef = retrieve("$configdir/keywordMode");
	warn "could not retrieve mode" unless defined $hashRef;
	$keytree->{m_mode} = $hashRef;
  }

  addTreeMenu($keytree, \@prekeys);

  insertTreeList($keytree, @prekeys);

  $keytree->bind("<Double-Button-1>", sub {
	  my @keys = $keytree->info('selection');
	  return unless checkSelection($myDiag, 1, 0, \@keys);
	  $entry->insert("insert", getLastItem($keys[0])." ");
	  $entry->focus;
  });

  my $ButF = $fm->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);

  my $umlautB = $ButF->Checkbutton(-variable => \$config{ConvertUmlaut}, -text => "convert german umlaute")->pack(-side => 'left', -anchor => 'w', -padx => 3, -pady => 1);
  $balloon->attach($umlautB, -msg => "Convert german umlaute (e.g.  -> ae)\nUmlaute often cause problems in other tools,\nso it's saver to convert them to plain ASCII.");

  my $OKB =
	$ButF->Button(-text => 'OK',
					-command => sub {
					  $$varRef = $entry->get(0.1, 'end');
					  trimComment($varRef);
					  my $len = length($$varRef);
					  if ($len >= $maxCommentLength) {
						$top->messageBox(-icon => 'warning', -message => "Sorry your comment is too long ($len characters).\nJPEG-Comments may only be up to 64K.\nPlease shorten your comment.",
					   -title => "Comment to long", -type => 'OK');
						return;
					  }
					  $rc = 'OK';
					  saveTreeMode($keytree);
					  nstore($keytree->{m_mode}, "$configdir/keywordMode") or warn "could not store $configdir/keywordMode: $!";
					  $myDiag->destroy();
					})->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  $balloon->attach($OKB, -msg => "You can press Control-x to close the dialog (OK button)");

# key-desc,Ctrl-x,accept text and close (in text dialog)
  $myDiag->bind('<Control-x>', sub { $OKB->invoke; });

  $topButF->Label(-text => "Insert ...", -bg => $config{ColorBG},
				  )->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 3, -pady => 3);

  my $crb =
  $topButF->Button(-text => "copyright",
				-command => sub {
				  $entry->insert("insert", $config{Copyright});
				})->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 3, -pady => 3);
  $myDiag->bind('<Control-c>', sub { $crb->invoke; });

  $topButF->Button(-text => "file name",
				-command => sub {
				  $entry->insert("insert", basename($actpic));
				})->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 3, -pady => 3);

  $topButF->Button(-text => "last comment",
				-command => sub {
				  $entry->insert("insert", $config{Comment});
				})->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 3, -pady => 1);

  $topButF->Button(-text => "file ...",
				-command => sub {
				  my $fs = $myDiag->FileSelect(-title => "read comment from file",
											   -directory => $actdir,
											   -width => 30, -height => 30);
				  my $file = $fs->Show;
				  if (!defined $file) { warn "not defined"; return;}
				  if ($file eq "") { warn "empty"; return;};
				  if (!-f $file) { warn "$file is no file"; return;};
				  my $fileH;
				  if (!open($fileH, "<$file")) {
					warn "Sorry, I couldn't open the file $file: $!";
					return;
				  }

				  my $buffer;
				  read $fileH, $buffer, 32768;
				  close($fileH);
				  $entry->insert("insert", $buffer);
				})->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 3, -pady => 3);

  $ButF->Button(-text => 'Cancel',
				-command => sub {
				  $rc = 'Cancel';
				  saveTreeMode($keytree);
				  nstore($keytree->{m_mode}, "$configdir/keywordMode") or warn "could not store $configdir/keywordMode: $!";
				  $myDiag->destroy();
				  })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $entry->focus;
  $myDiag->Popup(-popover => 'cursor');
  repositionWindow($myDiag);
  $myDiag->waitWindow;
  $icon->delete if $icon;
  return $rc;
}

##############################################################
# myReplaceDialog - get two strings from the user
##############################################################
sub myReplaceDialog {

  my $title   = shift;
  my $text    = shift;
  my $varARef = shift;
  my $varBRef = shift;

  my $rc = 'Cancel';

  # open window
  my $win = $top->Toplevel();
  #$win->grab();
  $win->title($title);
  $win->iconimage($mapiviicon) if $mapiviicon;

  $win->Label(-text => $text, -bg => $config{ColorBG}
				  )->pack(-anchor=>'w', -padx => 3, -pady => 3);

  my $midF = $win->Frame()->pack(-expand => 1, -fill => "both", -padx => 0, -pady => 0);

  $midF->Label(-text => "Replace this:", -bg => $config{ColorBG}
				  )->pack(-anchor=>'w', -padx => 3, -pady => 3);

  my $entryA = $midF->Scrolled("Text",
							   -scrollbars => 'osoe',
							   -wrap => 'none',
							   -height => 4,
							   -width => 80,
							 )->pack(-side => 'top', -expand => 1, -fill => "both", -padx => 3, -pady => 3);

  $midF->Label(-text => "with that:", -bg => $config{ColorBG}
				  )->pack(-anchor=>'w', -padx => 3, -pady => 3);

  my $entryB = $midF->Scrolled("Text",
							   -scrollbars => 'osoe',
							   -wrap => 'none',
							   -height => 4,
							   -width => 80,
							 )->pack(-side => 'top', -expand => 1, -fill => "both", -padx => 3, -pady => 3);

  $entryA->insert('end', $$varARef);
  $entryA->see('end');
  $entryA->markSet("insert",'end');

  $entryB->insert('end', $$varBRef);
  $entryB->see('end');
  $entryB->markSet("insert",'end');

  my $umlautB = $win->Checkbutton(-variable => \$config{ConvertUmlaut}, -text => "convert german umlaute")->pack(-anchor => 'w', -padx => 3, -pady => 3);
  $balloon->attach($umlautB, -msg => "Convert german umlaute (e.g.  -> ae)\nUmlaute often cause problems in other tools,\nso it's saver to convert them to plain ASCII.");

  my $ButF = $win->Frame()->pack(-fill =>'x', -padx => 0, -pady => 0);

  my $OKB =
	$ButF->Button(-text => 'OK',
					-command => sub {
					  $$varARef = $entryA->get(0.1, 'end');
					  trimComment($varARef);
					  my $len = length($$varARef);
					  if ($len >= $maxCommentLength) {
						$top->messageBox(-icon => 'warning', -message => "Sorry your comment is too long ($len characters).\nJPEG-Comments may only be up to 64K.\nPlease shorten your comment.",
					   -title => "Comment to long", -type => 'OK');
						return;
					  }
					  $$varBRef = $entryB->get(0.1, 'end');
					  trimComment($varBRef);
					  $len = length($$varBRef);
					  if ($len >= $maxCommentLength) {
						$top->messageBox(-icon => 'warning', -message => "Sorry your comment is too long ($len characters).\nJPEG-Comments may only be up to 64K.\nPlease shorten your comment.",
					   -title => "Comment to long", -type => 'OK');
						return;
					  }
					  $rc = 'OK';
					  $win->withdraw();
					  $win->destroy();
					})->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  $balloon->attach($OKB, -msg => "You can press Control-x to close the dialog (OK button)");

	$ButF->Button(-text => "Test",
					-command => sub {
					  $$varARef = $entryA->get(0.1, 'end');
					  trimComment($varARef);
					  my $len = length($$varARef);
					  if ($len >= $maxCommentLength) {
						$top->messageBox(-icon => 'warning', -message => "Sorry your comment is too long ($len characters).\nJPEG-Comments may only be up to 64K.\nPlease shorten your comment.",
					   -title => "Comment to long", -type => 'OK');
						return;
					  }
					  $$varBRef = $entryB->get(0.1, 'end');
					  trimComment($varBRef);
					  $len = length($$varBRef);
					  if ($len >= $maxCommentLength) {
						$top->messageBox(-icon => 'warning', -message => "Sorry your comment is too long ($len characters).\nJPEG-Comments may only be up to 64K.\nPlease shorten your comment.",
					   -title => "Comment to long", -type => 'OK');
						return;
					  }
					  $rc = "Test";
					  $win->withdraw();
					  $win->destroy();
					})->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);


  $win->bind('<Control-x>', sub { $OKB->invoke; });


  $ButF->Button(-text => 'Cancel',
				-command => sub {
				  $rc = 'Cancel';
				  $win->withdraw();
				  $win->destroy();
				  })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $entryA->focus;
  $win->Popup(-popover => 'cursor');
  repositionWindow($win);
  $win->waitWindow;
  return $rc;
}


##############################################################
# trimComment
##############################################################
sub trimComment {
  my $comRef = shift;
  $$comRef =~ s/\n*$//;   # remove trailing newlines
  $$comRef =~ s/\r*//g;    # remove \r (carriage return)
  #$$comRef =~ s/"/\\"/g; # replace " with \"
  $$comRef =~ s/\"/\'/g;    # replace " with '
}

##############################################################
# mySelListBoxDialog - let the user select some items of the
#                      given list
##############################################################
sub mySelListBoxDialog {

  my $title   = shift;
  my $text    = shift;
  my $mode    = shift;  #SINGLE (one selection) or MULTIPLE (several selections)
  my $OKBut   = shift;
  my $sellist = shift; # output list (list reference) - the list with the selected items
  my @list    = @_;    # input list - the list to choose from
  my $rc      = 0;

  # open window
  my $myDiag = $top->Toplevel();
  $myDiag->title($title);
  $myDiag->iconimage($mapiviicon) if $mapiviicon;

  $myDiag->Label(-anchor => 'w', -justify => "left", -text => $text, -bg => $config{ColorBG})->pack(-fill => 'x', -padx => 3, -pady => 3);

  my $listBoxY = @list;
  $listBoxY = 30 if ($listBoxY > 30); # not higher than 30 entries

  my $listBox =
	  $myDiag->Scrolled('Listbox',
						-scrollbars => 'osoe',
						-selectmode => 'extended',
						-exportselection => 0,
						-width => 80,
						-height => $listBoxY,
						)->pack(-expand => 1, -fill =>'both', -padx => 3, -pady => 3);
                        
  $listBox->configure(-selectmode => 'single') if ($mode == SINGLE);
  
  bindMouseWheel($listBox);

  $listBox->insert('end', @list);

  $listBox->bind('<Double-Button-1>', sub {
					  @$sellist = $listBox->curselection();
					  $rc = 1;
					} );

  # select all|none make only sense if multiple selection is possible
  if ($mode == MULTIPLE) {
    my $ubutF = $myDiag->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
    $ubutF->Button(-text => 'Select all',
					-command => sub {
                         $listBox->selectionSet(0, 'end');
					  })->pack(-side => 'left', -padx => 3, -pady => 3);
    $ubutF->Button(-text => 'Select none',
					-command => sub {
					  $listBox->selectionClear(0, 'end');
					  })->pack(-side => 'left', -padx => 3, -pady => 3);
  }
  
  my $ButF = $myDiag->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);

  my $OKB =
	$ButF->Button(-text => $OKBut,
					-command => sub {
					  @$sellist = $listBox->curselection();
					  $rc = 1;
					})->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $OKB->bind('<Return>', sub { $OKB->invoke; } );

  $ButF->Button(-text => 'Cancel',
				-command => sub { $rc = 0; }
				 )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $myDiag->Popup;
  if ($EvilOS) { # sometimes to dialog disappears when clicked on, so we need a short grab
	$myDiag->grab;
	$myDiag->after(50, sub{$myDiag->grabRelease});
  }
  $OKB->focus;
  $myDiag->waitVariable(\$rc);
  $myDiag->destroy() if Tk::Exists($myDiag);
  return $rc;
}

##############################################################
# createDirMenu
##############################################################
sub createDirMenu {
  $dirMenu =
	$top->Menu(-title => "Folder Menu");
}

##############################################################
# updateDirMenu
##############################################################
sub updateDirMenu {

  return if (!defined($dirMenu));

  # get number of items
  my $end = $dirMenu->index('end');

  # first call to function - build up menu fixed part
  if ($end < 10) { 

    $dirMenu->command(-image => compound_menu($top, 'open folder ...', 'folder.png'),
		      -command => sub {
			  my $dir = getRightDir();
			  openDirPost($dir);}, -accelerator => "double click");
  $dirMenu->command(-image => compound_menu($top, 'preview folder ...', ''),
		    -command => sub {
			my $dir = getRightDir();
			my @list = getPics($dir, WITH_PATH);
			sortPics($config{SortBy}, $config{SortReverse}, \@list);
			showThumbList(\@list, $dir); }, -accelerator => "middle click");
  $dirMenu->command(-image => compound_menu($top, 'search in folder ...', 'system-search.png'),
		    -command => sub {
			my $tmp = $config{SearchOnlyInDir}; # save search mode
			$config{SearchOnlyInDir} = 1;       # set to local search
			searchMetaInfo();
			$config{SearchOnlyInDir} = $tmp;    # restore search mode
		    });
  my $dir_size = $dirMenu->cascade(-image => compound_menu($top, 'folder size', ''));
  $dir_size->command(-label => "calculate folder size ...", -command => sub { calcDirSize(); } );
  $dir_size->command(-label => "display folder sizes (graphic) ...",
		     -command => sub { showDirSizes(getRightDir()); } );

  $dirMenu->separator;
  $dirMenu->command(-image => compound_menu($top, 'rename folder ...', ''),
		    -command => sub { renameDir(); });
  $dirMenu->command(-image => compound_menu($top, 'new folder ...', 'folder-new.png'),
		    -command => sub {
			my $dir = getRightDir();
			if (!-d $dir) { warn "dir $dir is no dir"; return; }
			makeNewDir($dir, $dirtree); });
  $dirMenu->command(-image => compound_menu($top, 'delete folder ...', ''),
		    -command => sub { deleteDir(); });

  $dirMenu->separator;
  my $dir_hot = $dirMenu->cascade(-image => compound_menu($top, 'folder hotlist', 'emblem-favorite.png'));
  $dir_hot->command(-label => "add to hotlist",
		    -command => sub {
			my $dir = getRightDir();
			my $max = 0;
			foreach (sort {$dirHotlist{$b} <=> $dirHotlist{$a}} keys %dirHotlist) {
			    $max = $dirHotlist{$_};
			    last;
			}
			$dirHotlist{$dir} = $max;
			$userinfo = "added $dir to hotlist!"; $userInfoL->update;
			updateDirMenu();
		    });
    $dir_hot->command(-label => "remove from hotlist", -command => sub {
	my $dir = getRightDir();
	delete $dirHotlist{$dir} if (defined($dirHotlist{$dir}));
	$userinfo = "removed $dir from hotlist!"; $userInfoL->update;
	updateDirMenu();
    });
  }
  else {
    # clear dir menu (dynamic part)
    $dirMenu->delete(11, 'end');
  }

  # add the dynamic part
  my $i = 0;

  # add the 12 most wanted hotlist folders :)
  my @dirlist;
  foreach (sort {$dirHotlist{$b} <=> $dirHotlist{$a}} keys %dirHotlist) {
	# remove deleted dirs
	if (!-d $_) {
	  delete $dirHotlist{$_};
	  next; # skip
	}
	next if ($_ eq $trashdir);
	$i++;
	push @dirlist, $_;
	last if ($i > 11);
  }

  foreach (sort @dirlist) {
	my $dir = $_; # we need a local copy
	# this will add the number of accesses of the folder
	#$dirMenu->command(-label => "$_", -command => sub { openDirPost($dir); }, -accelerator => "($dirHotlist{$_})");
	$dirMenu->command(-label => "$_", -command => sub { openDirPost($dir); });
  }

  $dirMenu->separator;

  # add the last used folders
  foreach (reverse @dirHist) {
	next if (!-d $_);
	my $dir = $_; # we need a local copy
	$dirMenu->command(-label => "$dir", -command => sub { openDirPost($dir); });
  }
}

##############################################################
# createThumbMenu
##############################################################
sub createThumbMenu {
  $thumbMenu =
	$top->Menu(-title => "Thumbnail Menu");
  addSelectMenu($thumbMenu);
  $thumbMenu->separator;
  addFileActionsMenu($thumbMenu, $picLB);
  $thumbMenu->separator;
  addPicProcessing($thumbMenu);
  $thumbMenu->separator;
  addMetaInfoMenu($thumbMenu);
  $thumbMenu->separator;
  $thumbMenu->command(-image => compound_menu($top, 'rescan folder', 'view-refresh.png'), -command => \&updateThumbsPlus, -accelerator => "<u>");
  $thumbMenu->command(-label => "rebuild thumbs ...", -command => \&rebuildThumbs, -accelerator => "<Ctrl-r>");
  $thumbMenu->command(-label => "add to light table", -command => sub {light_table_add_from_lb($picLB);}, -accelerator => "<Ctrl-l>");
}

##############################################################
# createPicMenu
##############################################################
sub createPicMenu {
  $picMenu = $top->Menu(-title => "Picture Menu");
  $picMenu->command(-label => "reload picture",  -command => \&reloadPic );
  $picMenu->command(-image => compound_menu($top, 'open picture in new window', 'image-x-generic.png'),  -command => \&showPicInOwnWin, -accelerator => "<d>" );
  $picMenu->separator;
  addPicProcessing($picMenu);
  $picMenu->separator;
  addZoomMenu($picMenu);
  $picMenu->separator;
  $picMenu->command(-image => compound_menu($top, 'options ...', 'preferences-system.png'),  -command => \&options, -accelerator => "<Ctrl-o>");
  $picMenu->command(-label => "toggle layout",  -command => sub { $config{Layout}++; layout(1); } );
  $picMenu->command(-image => compound_menu($top, 'toggle fullscreen mode', 'view-fullscreen.png'),  -command => sub { topFullScreen(); } );
}

##############################################################
# compoud_menu
##############################################################
sub compound_menu {
  my $w         = shift;
  my $text      = shift;
  my $icon_name = shift;
  my $space     = shift;  # optional
  $space        = 19 unless defined $space;

  my $compound_image = $w->Compound();
  if (-f "$icon_path/$icon_name") {
    $compound_image->Image(-image => $top->Photo(-file => "$icon_path/$icon_name", -gamma => $config{Gamma}));
    $compound_image->Space(-width => 3);
  }
  else {
    $compound_image->Space(-width => $space);
    print "Mapivi info: icon $icon_path/$icon_name not found.\n" if ($icon_name ne '');
  }
  $compound_image->Text(-text => $text);
  return $compound_image;
} 

##############################################################
# createMenubar
##############################################################
sub createMenubar {

  $menubar = $top->Menu;
  my $file_menu = $menubar->cascade(-label => "File"); # use "~File" for key shortcut
  $file_menu->cget(-menu)->configure(-title => "File menu");
  my $edit_menu = $menubar->cascade(-label => "Edit");
  $edit_menu->cget(-menu)->configure(-title => "Edit menu");
  my $view_menu = $menubar->cascade(-label => "View");
  $view_menu->cget(-menu)->configure(-title => "View menu");
  my $sort_menu = $menubar->cascade(-label => "Sort");
  $sort_menu->cget(-menu)->configure(-title => "Sort menu");
  my $find_menu = $menubar->cascade(-label => "Search");
  $find_menu->cget(-menu)->configure(-title => "Search menu");
  my $opti_menu = $menubar->cascade(-label => "Options");
  $opti_menu->cget(-menu)->configure(-title => "Options menu");
  my $extr_menu = $menubar->cascade(-label => "Extra");
  $extr_menu->cget(-menu)->configure(-title => "Extra menu");
  my $plug_menu = $menubar->cascade(-label => "PlugIns");
  $plug_menu->cget(-menu)->configure(-title => "PlugIn menu");
  my $help_menu = $menubar->cascade(-label => "Help");
  $help_menu->cget(-menu)->configure(-title => "Help menu");


  #my $icon = ;
  $file_menu->command(-image => compound_menu($top, 'open folder ...', 'folder.png'), -command => \&openDir, -accelerator => "<o>");
  #$file_menu->command(-image => compound_menu($top, 'open umlaut folder ...', ''),   -command => sub { openDirPost("/home/herrmann/tmp/dirb/subdir"); } );
  $file_menu->command(-image => compound_menu($top, 'preview folder', ''), -command => sub {
					  my $dir = getRightDir();
					  my @list = getPics($dir, WITH_PATH);
					  sortPics($config{SortBy}, $config{SortReverse}, \@list);
					  showThumbList(\@list, $dir); }, -accelerator => "middle click");

  $file_menu->command(-image => compound_menu($top, 'search in folder ...', ''), -command => sub {
					  my $tmp = $config{SearchOnlyInDir}; # save search mode
					  $config{SearchOnlyInDir} = 1;       # set to local search
					  searchMetaInfo();
					  $config{SearchOnlyInDir} = $tmp;    # restore search mode
					});
  my $dir_size  = $file_menu->cascade(-image => compound_menu($top, 'folder size', ''));
  $dir_size->command(-label => "calculate folder size ...", -command => sub { calcDirSize(); } );
  $dir_size->command(-label => "display folder sizes (graphic) ...", -command => sub { showDirSizes(getRightDir()); } );

  $file_menu->separator;
  $file_menu->command(-image => compound_menu($top, 'rename folder ...', ''), -command => \&renameDir);
  $file_menu->command(-image => compound_menu($top, 'new folder ...', 'folder-new.png'),    -command => sub { 
	  my $dir = getRightDir();
	  if (!-d $dir) { warn "dir $dir is no dir"; return; }
	  makeNewDir($dir, $dirtree); } );
  $file_menu->command(-image => compound_menu($top, 'delete folder ...', ''), -command => \&deleteDir);

  $file_menu->command(-image => compound_menu($top, 'hot folders ...', ''),  -command => sub {
						$dirMenu->Popup(-popover => "cursor", -popanchor => "nw");
						}, , -accelerator => "<h>");

  $file_menu->separator;
  addFileActionsMenu($file_menu, $picLB);

  $file_menu->separator;
  my $trash_menu = $file_menu->cascade(-image => compound_menu($top, 'trash', 'user-trash.png'));
  $trash_menu->command(-label => "empty trash ...",         -command => \&emptyTrash);
  $trash_menu->command(-label => "open trash in main window", -command => [\&openDirPost, $trashdir]);
  $file_menu->command(-image => compound_menu($top, 'folder checklist ...', ''), -command => sub { showDirProperties(); } );
  $file_menu->command(-image => compound_menu($top, 'import wizard ...', 'camera-photo.png'), -command => \&importWizard);

  $file_menu->separator;
  $file_menu->command(-image => compound_menu($top, 'light table (slideshow) ...', ''), -command => \&light_table_open_window);
  $file_menu->command(-image => compound_menu($top, 'convert non-JPEG pictures ...', ''), -command => \&convertNonJPEGS);
  $file_menu->command(-image => compound_menu($top, 'rescan folder', 'view-refresh.png'), -accelerator => "<u>",
					  -command => \&updateThumbsPlus);
  $file_menu->command(-image => compound_menu($top, 'smart update', 'view-refresh.png'), -command => sub { smart_update(); }, -accelerator => "<F5>");
  $file_menu->command(-image => compound_menu($top, 'rebuild selected thumbnails ...', ''), -command => \&rebuildThumbs, -accelerator => "<Ctrl-r>");
  $file_menu->command(-image => compound_menu($top, 'build thumbnails ...', ''), -command => \&buildThumbsRecursive);
  $file_menu->separator;
  $file_menu->command(-image => compound_menu($top, 'iconify', 'user-desktop.png'), -accelerator => "<ESC>",   -command => sub { $top->iconify; });
  $file_menu->command(-image => compound_menu($top, 'restart', ''), -command => \&restart) unless ($EvilOS);
  $file_menu->command(-image => compound_menu($top, 'quit', 'system-log-out.png'), -accelerator => "<q>",   -command => \&quitMain);


  addSelectMenu($edit_menu);
  $edit_menu->separator;

  addPicProcessing($edit_menu);
  $edit_menu->separator;

  # add the comments, EXIF and IPTC menu
  addMetaInfoMenu($edit_menu);

  $view_menu->command(-image => compound_menu($top, 'next', 'go-next.png'), -command => sub {
						return if (stillBusy()); # block, until last picture is loaded
						if ($slideshow == 1) {
						  $slideshow = 0; slideshow();
						}		# switch slideshow off
						showPic(nextPic($actpic));
					  }, -accelerator => "<Space>");
  $view_menu->command(-image => compound_menu($top, 'previous', 'go-previous.png'), -command => sub {
						return if (stillBusy()); # block, until last picture is loaded
						if ($slideshow == 1) {
						  $slideshow = 0; slideshow();
						}		# switch slideshow off
						showPic(prevPic($actpic));},
					  -accelerator => "<BackSpace>");

  $view_menu->separator;

  $view_menu->command(-image => compound_menu($top, 'first', 'go-first.png'), -command => sub {
						return if (stillBusy()); # block, until last picture is loaded
						if ($slideshow == 1) { $slideshow = 0; slideshow(); }		# switch slideshow off
						my @childs = $picLB->info('children');
						return unless (@childs);
						showPic($childs[0]); },
					  -accelerator => "<Home>");
  $view_menu->command(-image => compound_menu($top, 'last', 'go-last.png'), -command => sub {
						return if (stillBusy()); # block, until last picture is loaded
						if ($slideshow == 1) {
						  $slideshow = 0; slideshow();
						}		# switch slideshow off
						my @childs = $picLB->info('children');
						return unless (@childs);
						showPic($childs[-1]);
					  },
					  -accelerator => "<End>");

  $view_menu->separator;

  $view_menu->command(-image => compound_menu($top, 'go to/select ...', ''), -command => sub { gotoPic($picLB); }, -accelerator => "<Ctrl-g>");

  $view_menu->separator;

  addZoomMenu($view_menu);
  $view_menu->separator;

  $view_menu->command(-image => compound_menu($top, 'open picture in new window', 'image-x-generic.png'), -command => \&showPicInOwnWin, -accelerator => "<d>");
  $view_menu->command(-image => compound_menu($top, 'open picture in external viewer', 'image-x-generic.png'), -command => sub{openPicInViewer($picLB);}, -accelerator => "<v>");
  $view_menu->command(-label => "show infos about picture", -command => \&identifyPic);
  $view_menu->command(-label => "show histogram (ImageMagick)", -command => sub { showHistogram($picLB); } );
  $view_menu->command(-label => "show histogram (builtin)", -command => sub { showHistogram2($picLB); } );
  $view_menu->command(-label => "show JPEG segments", -command => \&showSegments);

  $view_menu->command(-image => compound_menu($top, 'start/stop slideshow', 'media-playback-start.png'), -command => sub {
						if ($slideshow == 0) {
						  $slideshow = 1;
						} else {
						  $slideshow = 0;
						}
						slideshow();
					  }, -accelerator => "<s>");
 
  $view_menu->separator;
  my $layout_menu = $view_menu->cascade(-label => "Window layout ...");
  $layout_menu->cget(-menu)->configure(-title => "Window layout ...");

  $layout_menu->command(-label => "toggle layout", -command => sub { $config{Layout}++; layout(1); }, -accelerator => "<l>");
  $layout_menu->separator;
  $layout_menu->command(-label => "folder-thumbnails-picture", -command => sub { $config{Layout} = 0 ; layout(1); }, -accelerator => "<F6>");
  $layout_menu->command(-label => "folder-thumbnails", -command => sub { $config{Layout} = 1 ; layout(1); }, -accelerator => "<F7>");
  $layout_menu->command(-label => "thumbnails", -command => sub { $config{Layout} = 2 ; layout(1); }, -accelerator => "<F8>");
  $layout_menu->command(-label => "thumbnails-picture", -command => sub { $config{Layout} = 3 ; layout(1); }, -accelerator => "<F9>");
  $layout_menu->command(-label => "picture", -command => sub { $config{Layout} = 4 ; layout(1); }, -accelerator => "<F10>");
  $layout_menu->separator;
  $layout_menu->checkbutton(-label => "menu bar", -variable => \$config{ShowMenu}, -command => sub { showHideFrames(); }, -accelerator => "<F1>");
  $layout_menu->checkbutton(-label => "status bar", -variable => \$config{ShowInfoFrame}, -command => sub { showHideFrames(); }, -accelerator => "<F2>");
  $layout_menu->checkbutton(-label => "EXIF box", -variable => \$config{ShowEXIFField}, -command => sub { showHideFrames(); }, -accelerator => "<F3>");
  $layout_menu->checkbutton(-label => "caption box", -variable => \$config{ShowCaptionField}, -command => sub { showHideFrames(); }, -accelerator => "<F4>");
  $layout_menu->checkbutton(-label => "comment box", -variable => \$config{ShowCommentField}, -command => sub { showHideFrames(); });
  $layout_menu->checkbutton(-label => "overlap picture with info", -variable => \$config{ShowInfoInCanvas}, -command => sub { showPic($actpic); });
  $layout_menu->checkbutton(-label => "display mouse coordinates", -variable => \$config{ShowCoordinates});

  $view_menu->separator;
  my $thumb_menu = $view_menu->cascade(-label => "Thumbnail table layout ...");
  $thumb_menu->cget(-menu)->configure(-title => "Thumbnail table layout ...");

  my $caption_menu = $thumb_menu->cascade(-label => "Thumbnail caption ...");
  $caption_menu->cget(-menu)->configure(-title => "Thumbnail caption ...");
  $caption_menu->radiobutton(-label => "none", -variable => \$config{ThumbCapt},  -value => "none", -command => sub { updateThumbsPlus(); });

  $caption_menu->radiobutton(-label => "file name without suffix", -variable => \$config{ThumbCapt},  -value => "filename", -command => sub { updateThumbsPlus(); });

  $caption_menu->radiobutton(-label => "file name with suffix", -variable => \$config{ThumbCapt},  -value => "filenameSuffix", -command => sub { updateThumbsPlus(); });

  $caption_menu->radiobutton(-label => "IPTC object name", -variable => \$config{ThumbCapt},  -value => "objectname", -command => sub { updateThumbsPlus(); });

  $thumb_menu->separator;

  $thumb_menu->checkbutton(-label => "show file info", -variable => \$config{ShowFile},  -command => \&toggleHeaders);
  $thumb_menu->checkbutton(-label => "show IPTC/IIM", -variable => \$config{ShowIPTC},  -command => \&toggleHeaders);
  $thumb_menu->checkbutton(-label => "show comments", -variable => \$config{ShowComment},  -command => \&toggleHeaders);
  $thumb_menu->checkbutton(-label => "show EXIF", -variable => \$config{ShowEXIF},  -command => \&toggleHeaders);
  $thumb_menu->checkbutton(-label => "show folder", -variable => \$config{ShowDirectory},  -command => \&toggleHeaders);


  $sort_menu->radiobutton(-label => "file name", -variable => \$config{SortBy},  -value => "name", -command => sub { updateThumbsPlus(); });
  $sort_menu->radiobutton(-label => "file date", -variable => \$config{SortBy},  -value => "date", -command => \&updateThumbsPlus);
  $sort_menu->radiobutton(-label => "file size", -variable => \$config{SortBy},  -value => "size", -command => \&updateThumbsPlus);
  $sort_menu->separator;
  $sort_menu->radiobutton(-label => "IPTC urgency/rating", -variable => \$config{SortBy},  -value => "urgency", -command => \&updateThumbsPlus);
  $sort_menu->radiobutton(-label => "IPTC by-line", -variable => \$config{SortBy},  -value => "byline", -command => \&updateThumbsPlus);
  $sort_menu->separator;
  $sort_menu->radiobutton(-label => "number of views", -variable => \$config{SortBy},  -value => "popularity", -command => \&updateThumbsPlus);
  $sort_menu->radiobutton(-label => "number of pixels", -variable => \$config{SortBy},  -value => "pixel", -command => \&updateThumbsPlus);
  $sort_menu->radiobutton(-label => "number of bits per pixels (b/p)", -variable => \$config{SortBy},  -value => "bitpix", -command => \&updateThumbsPlus) if ($config{BitsPixel});
  $sort_menu->separator;
  $sort_menu->radiobutton(-label => "EXIF date", -variable => \$config{SortBy},  -value => "exifdate", -command => \&updateThumbsPlus);
  $sort_menu->radiobutton(-label => "EXIF aperture", -variable => \$config{SortBy},  -value => "aperture", -command => \&updateThumbsPlus);
  $sort_menu->radiobutton(-label => "EXIF exposure time", -variable => \$config{SortBy},  -value => "exposuretime", -command => \&updateThumbsPlus);
  $sort_menu->radiobutton(-label => "EXIF camera maker/model", -variable => \$config{SortBy},  -value => "model", -command => \&updateThumbsPlus);
  $sort_menu->radiobutton(-label => "EXIF artist", -variable => \$config{SortBy},  -value => "artist", -command => \&updateThumbsPlus);
  $sort_menu->separator;
  $sort_menu->radiobutton(-label => "sort randomly", -variable => \$config{SortBy},  -value => "random", -command => \&updateThumbsPlus);
  $sort_menu->separator;
  $sort_menu->checkbutton(-label => "sort reverse", -variable => \$config{SortReverse}, -command => \&updateThumbsPlus);

  #my $data_menu = $extr_menu->cascade(-label => "Search database");
  #$data_menu->cget(-menu)->configure(-title => "Search database");
  $find_menu->command(-image => compound_menu($top, 'search ...', 'system-search.png'),             -command => \&searchMetaInfo, -accelerator => '<Ctrl-s>');
  $find_menu->command(-image => compound_menu($top, 'search by keywords (tag cloud) ...', 'weather-overcast.png'), -command => \&keyword_browse, -accelerator => '<k>');
  $find_menu->command(-image => compound_menu($top, 'search by timeline ...', 'x-office-calendar.png'), -command => \&database_info);
  $find_menu->command(-image => compound_menu($top, 'search by location ...', 'applications-internet.png'), -command => sub { search_by_location($picLB); } );
  $find_menu->command(-image => compound_menu($top, 'search duplicates ...', ''), -command => \&findDups);
  #$find_menu->command(-label => "check for new keywords ...", -command => \&check_new_keywords);
  $find_menu->separator;
  my $find_special_menu = $find_menu->cascade(-image => compound_menu($top, 'special searches', ''));
  $find_special_menu->command(-label => "show TOP 100 of best rated pictures",   -command => \&showMostPopularPics);
  $find_special_menu->command(-image => compound_menu($top, 'search for file name ...', 'edit-find.png'),  -command => sub { searchFileName($picLB);});
  $find_menu->separator;
  $find_menu->command(-image => compound_menu($top, 'add to database ...', 'list-add.png'),     -command => \&buildDatabase);
  $find_menu->command(-image => compound_menu($top, 'clean database ...', 'list-remove.png'),     -command => \&cleanDatabase);
  $find_menu->command(-image => compound_menu($top, 'check database ...', ''), -command => \&checkDatabase);
  $find_menu->command(-image => compound_menu($top, 'edit database ...', 'accessories-text-editor.png'),      -command => \&editDatabase);

  $opti_menu->command(-image => compound_menu($top, 'options ...', 'preferences-system.png'),  -command => \&options, -accelerator => "<Ctrl-o>");
  $opti_menu->command(-label => "save options",  -command => \&saveAllConfig);


  $extr_menu->command(-label => "export filelist ...",               -command => \&exportFilelist);
  $extr_menu->command(-label => "compare folders ...",              -command => sub { dirDiffWindow(); } );
  $extr_menu->command(-label => "compare pictures",          -command => \&diffPics);
  $extr_menu->command(-label => "show window list ...",              -command => \&showWindowList, -accelerator => "<w>");
  $extr_menu->separator;
  $extr_menu->command(-label => "montage/index print ...",           -command => sub { my @pics = getSelection($picLB); indexPrint(\@pics); });
  $extr_menu->command(-label => "interpolate dead pixels ...",       -command => \&interpolatePics);
  $extr_menu->command(-label => "add fuzzy border ...",              -command => \&fuzzyBorder);
  $extr_menu->command(-label => "add lossless watermark ...",        -command => \&losslessWatermark);
  $extr_menu->command(-label => "make screenshot ...",               -command => \&screenshot);
  $extr_menu->separator;
  $extr_menu->command(-label => "build thumbnails database ...",   -command => \&buildThumbsRecursive);
  $extr_menu->command(-label => "clean thumbnail database ...",      -command => sub { cleanThumbDB(); } );
  $extr_menu->command(-label => "clean folder ...",               -command => sub { cleanDir($actdir); } );
  $extr_menu->command(-label => "edit entry history ...",            -command => sub { editEntryHistory(); } );
  # just an experiment:
  #$extr_menu->separator;
  #$extr_menu->command(-label => "show picture view list",   -command => sub { showPicViewList(); });
  $extr_menu->separator;
  $extr_menu->command(-label => "mapivi test suite",   -command => \&testSuite);

  makePlugInsMenu($plug_menu);

  $help_menu->command(-image => compound_menu($top, 'About', 'dialog-information.png'),        -command => \&about);
  $help_menu->command(-image => compound_menu($top, 'Keys', 'input-keyboard.png'),         -command => \&showkeys);
  $help_menu->command(-image => compound_menu($top, 'System information', 'utilities-system-monitor.png'), -command => \&systemInfo);
  $help_menu->command(-image => compound_menu($top, 'License', ''),      -command => [\&showFile, "$configdir/License.txt"]) if (-f "$configdir/License.txt");
  $help_menu->command(-image => compound_menu($top, 'History', ''),      -command => [\&showFile, "$configdir/Changes.txt"]) if (-f "$configdir/Changes.txt");
  $help_menu->command(-image => compound_menu($top, 'Tips', 'help-browser.png'),         -command => sub { showFile("$configdir/Tips.txt") }) if (-f "$configdir/Tips.txt");
  $help_menu->command(-image => compound_menu($top, 'FAQ', 'help-browser.png'),          -command => [\&showFile, "$configdir/FAQ"]) if (-f "$configdir/FAQ");

  $top->configure(-menu => $menubar) if $config{ShowMenu};
}

##############################################################
# addPicProcessing
##############################################################
sub addPicProcessing {

  my $menu = shift;
  my $rot_menu = $menu->cascade(-image => compound_menu($top, 'rotate (clockwise) ...', 'transform-rotate.png'));
	$rot_menu->cget(-menu)->configure(-title => "rotation menu");
    $rot_menu->command(-label => "rotate 90 - right (lossless)", -command => [\&rotate,  90], -accelerator => "<9>");
    $rot_menu->command(-label => "rotate 180        (lossless)", -command => [\&rotate, 180], -accelerator => "<8>");
    $rot_menu->command(-label => "rotate 270 - left (lossless)", -command => [\&rotate, 270], -accelerator => "<7>");
    $rot_menu->command(-label => "flip horizontal   (lossless)", -command => [\&rotate, "horizontal"]);
    $rot_menu->command(-label => "flip vertical     (lossless)", -command => [\&rotate, "vertical"]);
    $rot_menu->command(-label => "auto rotate       (lossless)", -command => [\&rotate, "auto"], -accelerator => "<0>");
    $rot_menu->command(-label => "clear rotate flag (lossless)", -command => [\&rotate, "clear"]);
    $rot_menu->command(-label => "rotate ...", -command => [\&rotateAny]);

    $menu->command(-image => compound_menu($top, 'change size/quality ...', 'transform-scale.png'), -command => \&changeSizeQuality, -accelerator => "<Ctrl-q>" );
    $menu->command(-image => compound_menu($top, 'crop (lossless) ...', 'edit-cut.png'),     -command => sub { crop($picLB); }, -accelerator => "<Ctrl-c>");
    $menu->command(-image => compound_menu($top, 'image processing ...', 'camera-photo.png'), -command => \&filterPic, -accelerator => "<Ctrl-f>");
    $menu->command(-image => compound_menu($top, 'make grayscale ...', 'image-x-generic-bw.png'), -command => sub { grayscalePic($picLB); } );
  my $border_menu = $menu->cascade(-image => compound_menu($top, 'add border ...', 'image-x-generic.png'));
	$border_menu->cget(-menu)->configure(-title => 'border menu');

    $border_menu->command(-image => compound_menu($top, 'add border (lossless) ...', ''), -command => sub { losslessBorder(PIXEL); }, -accelerator => "<Ctrl-b>");
    $border_menu->command(-image => compound_menu($top, 'add border aspect ratio (lossless) ...', ''), -command => sub { losslessBorder(ASPECT_RATIO); } );
    $border_menu->command(-image => compound_menu($top, 'add relative border (lossless) ...', ''), -command => sub { losslessBorder(RELATIVE); } );
    $border_menu->command(-image => compound_menu($top, 'add border or copyright (lossy) ...', ''), -command => \&addDecoration);

    $menu->command(-image => compound_menu($top, 'edit in GIMP', 'applications-graphics.png'), -command => \&GIMPedit, -accelerator => "<Ctrl-e>") unless ($exprogs{"gimp"} or $exprogs{"gimp-win-remote"});
}

##############################################################
# addFileActionsMenu
##############################################################
sub addFileActionsMenu {

  my $menu = shift;
  my $lb   = shift;
  my $fop_menu = $menu->cascade(-image => compound_menu($top, 'file operations ...', ''));
  $fop_menu->command(-image => compound_menu($top, 'copy to ...', 'edit-copy.png'),    -command => sub { copyPicsDialog(COPY, $lb); } );
  $fop_menu->command(-image => compound_menu($top, 'link to ...', ''), -command => \&linkPicsDialog) if (!$EvilOS);
  $fop_menu->command(-image => compound_menu($top, 'move to ...', ''), -command => sub { movePicsDialog($lb); } );
  $fop_menu->command(-image => compound_menu($top, 'send to ...', 'mail-message-new.png'),    -command => sub { sendTo($lb); } );
  $fop_menu->command(-image => compound_menu($top, 'convert ...', ''), -command => sub { convertPics($lb); } );
  $fop_menu->command(-image => compound_menu($top, 'copy to print ...', 'printer.png'), -command => sub { copyToPrint($lb); }, -accelerator => "<Ctrl-p>");
  $fop_menu->command(-image => compound_menu($top, 'rename ...', ''), -command => sub { renamePic($lb); }, -accelerator => "<r>");
  $fop_menu->command(-image => compound_menu($top, 'smart rename ...', ''), -command => sub { renameSmart($lb); }, -accelerator => "<R>");
  $fop_menu->command(-image => compound_menu($top, 'make backup', ''), -command => sub { copyPicsDialog(BACKUP, $lb); } );
  $fop_menu->command(-image => compound_menu($top, 'make HTML ...', 'applications-internet.png'),  -command => sub { makeHTML($lb); });
  $fop_menu->separator;
  $fop_menu->command(-image => compound_menu($top, 'delete to trash', 'user-trash.png'),  -accelerator => "<Delete>",
					  -command => sub { deletePics($lb, TRASH); } );
  $fop_menu->command(-image => compound_menu($top, 'delete ...', ''), -accelerator => "<Shift-Delete>", -command => sub { deletePics($lb, REMOVE); } );
}

##############################################################
# addSelectMenu
##############################################################
sub addSelectMenu {

  my $menu = shift;
  my $sel_menu = $menu->cascade(-image => compound_menu($top, 'select ...', ''));
  $sel_menu->command(-label => "select all",  -accelerator => "<Ctrl-a>", -command => sub {selectAll($picLB);} );
  $sel_menu->command(-label => "select all backups",                      -command => \&selectBak );
  $sel_menu->command(-label => "invert selection",                        -command => \&selectInv );
  $sel_menu->command(-label => "redo selection",                          -command => sub { $picLB->selectionClear(); reselect($picLB, @savedselection2); } );
}

##############################################################
# addZoomMenu
##############################################################
sub addZoomMenu {

  my $menu = shift;
  $menu->checkbutton(-label => "Auto zoom", -variable => \$config{AutoZoom});
  my $zoom_menu = $menu->cascade(-label => "Zoom level ...");
  $zoom_menu->cget(-menu)->configure(-title => "Zoom menu");

  $zoom_menu->command(-label   => "fit",
					  -command => sub { fitPicture(); },
					  -accelerator => "<f>");

  my $i;
  for ($i = 0; $i < (@frac); $i += 2) {
	my $z = $frac[$i];
	my $s = $frac[$i+1];
	my $l = sprintf "%4d%%",($z/$s*100);
	unless ($l =~ m/\w*100%/) {
	  $zoom_menu->command(-label   => $l,
						  -command => sub { zoom($z, $s); } );
	}
	else {
	  $zoom_menu->command(-label   => $l,
						  -command => sub { zoom($z, $s); },
						  -accelerator => "<z>");
	}
  }
}

##############################################################
# addMetaInfoMenu
##############################################################
sub addMetaInfoMenu {

  my $menu = shift;

  my $iptc_menu = $menu->cascade(-image => compound_menu($top, 'IPTC/IIM info', ''));
  $iptc_menu->cget(-menu)->configure(-title => "IPTC/IIM menu");

  $iptc_menu->command(-image => compound_menu($top, 'show', ''), -command => sub { displayIPTCData($picLB); }, -accelerator => "<i>");
  $iptc_menu->command(-image => compound_menu($top, 'edit ...', 'accessories-text-editor.png'),   -command => sub { editIPTC($picLB); }, -accelerator => "<Ctrl-i>");
  $iptc_menu->command(-image => compound_menu($top, 'remove ...', ''), -command => \&removeIPTC);
  $iptc_menu->separator;
  $iptc_menu->command(-image => compound_menu($top, 'copy from ...', 'edit-copy.png'), -command => \&copyIPTC);
  $iptc_menu->command(-image => compound_menu($top, 'copy to ...', 'edit-paste.png'),   -command => \&pasteIPTC);
  $iptc_menu->separator;
  $iptc_menu->command(-image => compound_menu($top, 'add/remove keywords ...', ''), -command => sub { editIPTCKeywords($picLB); }, -accelerator => '<Ctrl-k>');
  $iptc_menu->command(-image => compound_menu($top, 'add/remove categories ...', ''), -command => sub { editIPTCCategories($picLB); } , -accelerator => '<Ctrl-t>');
  $iptc_menu->separator;
  $iptc_menu->command(-image => compound_menu($top, 'save template ...', ''),  -command => \&saveIPTC);
  $iptc_menu->command(-image => compound_menu($top, 'merge template ...', ''), -command => \&mergeIPTC);

  $iptc_menu->separator;
  addRatingMenu($iptc_menu, $picLB);
  addRatingMenu($menu, $picLB);

  if ($exiftoolAvail) {
    my $xmp_menu = $menu->cascade(-image => compound_menu($top, 'XMP info', ''));
    $xmp_menu->cget(-menu)->configure(-title => 'XMP menu');
    $xmp_menu->command(-image => compound_menu($top, 'show info', ''), -command => sub { xmp_show($picLB); }); # -accelerator => "<x>");
    $xmp_menu->command(-image => compound_menu($top, 'add title ...', ''), -command => sub { xmp_add_title($picLB); });
    $xmp_menu->command(-image => compound_menu($top, 'edit title ...', ''), -command => sub { xmp_edit_title($picLB); });
    $xmp_menu->command(-image => compound_menu($top, 'add keyword ...', ''), -command => sub { xmp_add_keyword($picLB); });
  }
  
  my $exif_menu = $menu->cascade(-image => compound_menu($top, 'EXIF info', ''));
  $exif_menu->cget(-menu)->configure(-title => "EXIF menu");
  $exif_menu->command(-image => compound_menu($top, 'show info', ''), -command => sub { displayEXIFData($picLB); }, -accelerator => "<x>");
  $exif_menu->command(-image => compound_menu($top, 'show thumbnail', ''), -command => \&showEXIFThumb,   -accelerator => "<t>");
  $exif_menu->command(-image => compound_menu($top, 'save thumbnail ...', ''), -command => \&getEXIFThumb);
  $exif_menu->command(-image => compound_menu($top, '(re)build thumbnail ...', ''), -command => \&buildEXIFThumb);
  $exif_menu->separator;
  $exif_menu->command(-image => compound_menu($top, 'copy from ...', 'edit-copy.png'), -command => [\&copyEXIFData, "from"]);
  $exif_menu->command(-image => compound_menu($top, 'copy to ...', 'edit-paste.png'), -command => [\&copyEXIFData, "to"]);
  $exif_menu->command(-image => compound_menu($top, 'copy thumbnail to ...', ''), -command => \&copyThumbnail);
  $exif_menu->separator;
  $exif_menu->command(-image => compound_menu($top, 'save', ''), -command => \&EXIFsave);
  $exif_menu->command(-image => compound_menu($top, 'restore ...', ''), -command => \&EXIFrestore);
  $exif_menu->command(-image => compound_menu($top, 'remove saved info ...', ''), -command => \&EXIFremoveSaved);
  $exif_menu->separator;
  $exif_menu->command(-image => compound_menu($top, 'set date/time ...', 'accessories-text-editor.png'), -command => \&setEXIFDate);
  $exif_menu->separator;
  $exif_menu->command(-image => compound_menu($top, 'remove thumbnail ...', ''), -command => [\&removeEXIFData, "thumb"]);
  $exif_menu->command(-image => compound_menu($top, 'remove all ...', ''), -command => [\&removeEXIFData, "all"]);

  my $comm_menu = $menu->cascade(-image => compound_menu($top, 'Comments', ''));
  $comm_menu->cget(-menu)->configure(-title => "Comment menu");
  $comm_menu->command(-label => "show ...",    -command => \&showComment, -accelerator => "<c>");
  $comm_menu->separator;
  $comm_menu->command(-label => "add ...",    -command => sub{ addComment($picLB);  }, -accelerator => "<a>");
  $comm_menu->command(-image => compound_menu($top, 'edit ...', 'accessories-text-editor.png'),   -command => sub{ editComment($picLB); }, -accelerator => "<e>");
  $comm_menu->command(-label => "join ...", -command => sub { joinComments(ASK); } );
  $comm_menu->command(-label => "search/replace ...", -command => sub{ replaceComment($picLB); } );
  $comm_menu->command(-label => 'add/remove keywords ...', -command => sub { editCommentKeywords($picLB); } );
  $comm_menu->separator;
  $comm_menu->command(-label => "remove ...", -command => \&removeComment);
  $comm_menu->command(-label => "remove all ...",  -command => sub { removeAllComments(ASK); } );
  $comm_menu->separator;
  $comm_menu->command(-image => compound_menu($top, 'copy from ...', 'edit-copy.png'),  -command => [\&copyComment, "from"]);
  $comm_menu->command(-image => compound_menu($top, 'copy to ...', 'edit-paste.png'),  -command => [\&copyComment, "to"]);
  $comm_menu->separator;
  $comm_menu->command(-label => "add filename as comment ...",  -command => [\&nameToComment, "to"]);
}

##############################################################
# addRatingMenu
##############################################################
sub addRatingMenu {
  my $menu   = shift;
  my $widget = shift;  # e.g. $picLB
  my $iptc_urge = $menu->cascade(-image => compound_menu($top, 'rating (IPTC urgency)', ''));
  $iptc_urge->cget(-menu)->configure(-title => "rating (IPTC urgency)");
  $iptc_urge->command(-label => "******** (1 high)",   -command => sub { setIPTCurgency($widget, 1); }, -accelerator => "<Ctrl-F1>");
  $iptc_urge->command(-label => "*******  (2)",        -command => sub { setIPTCurgency($widget, 2); }, -accelerator => "<Ctrl-F2>");
  $iptc_urge->command(-label => "******   (3)",        -command => sub { setIPTCurgency($widget, 3); }, -accelerator => "<Ctrl-F3>");
  $iptc_urge->command(-label => "*****    (4)",        -command => sub { setIPTCurgency($widget, 4); }, -accelerator => "<Ctrl-F4>");
  $iptc_urge->command(-label => "****     (5 normal)", -command => sub { setIPTCurgency($widget, 5); }, -accelerator => "<Ctrl-F5>");
  $iptc_urge->command(-label => "***      (6)",        -command => sub { setIPTCurgency($widget, 6); }, -accelerator => "<Ctrl-F6>");
  $iptc_urge->command(-label => "**       (7)",        -command => sub { setIPTCurgency($widget, 7); }, -accelerator => "<Ctrl-F7>");
  $iptc_urge->command(-label => "*        (8 low)",    -command => sub { setIPTCurgency($widget, 8); }, -accelerator => "<Ctrl-F8>");
  $iptc_urge->command(-label => "-        (0 none)",   -command => sub { setIPTCurgency($widget, 0); }, -accelerator => "<Ctrl-F9>");
  $iptc_urge->command(-label => "remove rating",       -command => sub { setIPTCurgency($widget, 9); }, -accelerator => "<Ctrl-F10>");
}

##############################################################
# makePlugInsMenu
##############################################################
sub makePlugInsMenu {

  my $menu = shift;
  my @plugins = getFiles($plugindir);
  my $file;

  foreach my $plugin (@plugins) {
	if ($plugin =~ m/.*\.txt$/) { # process just the describtions
	  if (!open($file, "<$plugindir/$plugin")) {
		warn "read plugin desc: Couldn't open $plugin: $!";
		next;
	  }

	  while (<$file>) {
		chomp;						# no newline
		s/^#.*//;               	# no comments (lines starting with #)
		s/^\s+//;					# no leading white
		s/\s+$//;					# no trailing white
		next unless length;			# anything left?
		my ($prog, $menuitem, $update, $desc) = split(/\s\+\s/, $_, 4);

		print "plugin: -$prog-$menuitem-$update-$desc-\n" if $verbose;

		if (!-f "$plugindir/$prog") { # look for the corresponding plugin
		  warn "warning: plugin for description $plugin not fount in $plugindir\n";
		  next;
		}

		my $item = $menu->command(-label => "$menuitem", -command => sub {
						 print "$prog $menuitem $desc\n" if $verbose;
						 my @sellist = $picLB->info('selection');
						 #return unless checkSelection($top, 1, 0, \@sellist);
						 my $command = "\"$plugindir/$prog\" ";
						 foreach (@sellist) {
						   $command .= "\"$_\" ";
						 }
						 print "com = $command\n" if $verbose;
						 my $buffer = `$command`;
						 showText("Output of PlugIn $menuitem", $buffer, NO_WAIT) if ($buffer ne '');
						 updateThumbsPlus() if $update;
					   });
		#$balloon->attach($item, -msg => "$desc"); # does not work :(

	  }
	  close $file;
	}
  }
}
##############################################################
# toggleHeaders - adjusts the width of the columns to zero
#                 or the width needed ("")
##############################################################
sub toggleHeaders {

  my @col = ($config{ColorBG}, $config{ColorBG2});
  my $c = 1;

  if ($config{ShowFile}) { $picLB->columnWidth($picLB->{filecol},""); $fileS->configure(-background=>$col[$c%2]); $c++; }
  else                     { $picLB->columnWidth($picLB->{filecol},0);  }

  if ($config{ShowIPTC}) { $picLB->columnWidth($picLB->{iptccol},""); $iptcS->configure(-background=>$col[$c%2]); $c++; }
  else                     { $picLB->columnWidth($picLB->{iptccol},0);  }

  if ($config{ShowComment}) { $picLB->columnWidth($picLB->{comcol},""); $comS->configure(-background=>$col[$c%2]); $c++; }
  else                        { $picLB->columnWidth($picLB->{comcol},0);  }

  if ($config{ShowEXIF}) { $picLB->columnWidth($picLB->{exifcol},""); $exifS->configure(-background=>$col[$c%2]); $c++; }
  else                     { $picLB->columnWidth($picLB->{exifcol},0);  }


  if ($config{ShowDirectory}) { $picLB->columnWidth($picLB->{dircol},""); $dirS->configure(-background=>$col[$c%2]); $c++; }
  else                     { $picLB->columnWidth($picLB->{dircol},0);  }
}

##############################################################
# calcDirSize
##############################################################
sub calcDirSize {
  my $dir   = getRightDir();
  my $size  = 0;
  my $break = 0;
  my $pw = progressWinInit($top, "Calculate folder size");
  find(sub {
		 if (progressWinCheck($pw)) { $break = 1; $File::Find::prune = 1; }
		 # we don't know how long it will take, so we set total to zero
		 progressWinUpdate($pw, "size $size Bytes", 0, 0);
		 $size += -s;
	   },$dir);
  progressWinEnd($pw);
  my $msg = "Calculation finished.";
  if ($break) { $msg = "Warning: The calculation wasn't finished!\nReal size may be bigger than displayed."; }
  my $unitSize = computeUnit($size);
  $top->messageBox(-icon => 'question', -message => "$msg\nThe folder size of $dir is $unitSize ($size Bytes)",
				   -title => "Folder size", -type => 'OK');
}

##############################################################
# buildThumbsRecursive - scans through all sub folders of
#                        the actual dir an collects JPEG files
#                        let the user select in which dirs
#                        mapivi should build/refresh thumbnails
##############################################################
sub buildThumbsRecursive {

  my $basedir = getRightDir();
  my $rc = $top->messageBox(-icon => 'question', -message => "MaPiVi will first scan through all sub folders of $basedir and collect all folders containing JPEG files.\nThen you are able to select in which folders mapivi should build/refresh thumbnails.",
				   -title => "Build thumbnails in all sub folders", -type => 'OKCancel');
  return if ($rc !~ m/Ok/i);

  $userinfo = "searching sub folders ..."; $userInfoL->update;
  my @dirlist;
  my @pictestlist;

  # no questions about NON-JPEGS while searching please!
  my $tmp = $config{CheckForNonJPEGs};
  $config{CheckForNonJPEGs} = 0;

  my $pic_count = 0;
  my $break = 0;
  my $pw = progressWinInit($top, "Collect sub folders");
  find(sub {
		 if (progressWinCheck($pw)) { $break = 1; $File::Find::prune = 1; }
		 # process just dirs containing pictures, but not .thumbs/ .xvpics/ etc. dirs
		 if (-d and ($_ ne $thumbdirname) and ($_ ne ".xvpics") and ($_ ne $exifdirname)) {
		   progressWinUpdate($pw, "collecting folders, found ".scalar @dirlist." ...", 0, 0);
		   @pictestlist = getPics($File::Find::name, JUST_FILE); # no sort needed
		   if (@pictestlist > 0) {
			 $pic_count += scalar @pictestlist;
			 push @dirlist, $File::Find::name;
			 $userinfo = "found ".@dirlist." subdirs ..."; $userInfoL->update;
		   }
		 }
	   }, $basedir);
  progressWinEnd($pw);
  if ($break) {
	$userinfo = "user break while counting sub folders";
	return;
  }

  $config{CheckForNonJPEGs} = $tmp;

  $userinfo = "found ".@dirlist." sub folders"; $userInfoL->update;

  my @sellist;
  return if (!mySelListBoxDialog("Select folders",
								 "Found ".scalar @dirlist." folders with $pic_count JPEG pictures.\nThumbnails will be created/updated in the selected folders.",
                                 MULTIPLE,
								 "build thumbnails", \@sellist, @dirlist));

  # copy the selected elements into the @sel_dirs list
  my @sel_dirs;
  foreach (@sellist) {
    push @sel_dirs, $dirlist[$_]; 
  }

  my $rebuild = 0;
  $rc = myButtonDialog('Update or rebuild thumbnails?', "Please select if you want to update or rebuild the thumbnails.\nUpdate will just create thumbnails for modified and new pictures, rebuild will rebuild all thumbnails.", undef, 'Update', 'Rebuild', 'Cancel');
  if    ($rc eq 'Cancel')  { return; }
  elsif ($rc eq 'Update')  { $rebuild = 0; }
  elsif ($rc eq 'Rebuild') { $rebuild = 1; }
  else { warn "buildThumbsRecursive: Error wrong rc: $rc"; return; }

  my $actdirold = $actdir;

  my ($dir, $dirshort, @pics);

  $tmp = $config{CheckForNonJPEGs};
  $config{CheckForNonJPEGs} = 0;

  my $i = 0;
  $pw = progressWinInit($top, "build/refresh thumbnails");
  foreach $dir (@sel_dirs) {
	last if progressWinCheck($pw);
	$i++;
	$dirshort = cutString($dir, -40, "...");
	progressWinUpdate($pw, "processing ($i/".scalar @sel_dirs.") $dirshort", $i, scalar @sel_dirs);
    $userinfo = "updating thumbnails in $dirshort ..."; $userInfoL->update;

	$actdir = $dir;

	if ($rebuild) {
	  my $thumbdir = dirname(getThumbFileName("$dir/dummy.jpg"));
	  my @thumbs   = getPics($thumbdir, WITH_PATH);
	  foreach (@thumbs) {
		#print "buildThumbsRecursive: remove $_\n";
		if ( unlink($_) != 1) { # unlink returns the number of successfull removed files
		  warn "buildThumbsRecursive: could not remove $_";
		}
	  }
	}

	generateThumbs(NO_ASK, NO_SHOW, 1);
	# do not ask the user when making a thumbnail dir
	# do not show (and sort!) the generated thumbs
	# 1 = read the pics from $actdir, not from the listbox
  }
  progressWinEnd($pw);
  $config{CheckForNonJPEGs} = $tmp;
  $userinfo = "thumbnails are now up to date!"; $userInfoL->update;
  $actdir = $actdirold;
}

##############################################################
# rebuildThumbs
##############################################################
sub rebuildThumbs {

  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);

  if ($config{AskDeleteThumb}) {
	my $rc    = checkDialog("Delete thumbnails?",
							"Please press Ok to delete ".scalar @sellist." thumbnails.",
							\$config{AskDeleteThumb},
							"ask every time", "", 'OK', 'Cancel');
	return if ($rc ne 'OK');
  }

  my $thumb;
  my $i = 0;
  my $pw = progressWinInit($top, "Delete thumbnails");
  foreach my $dpic (@sellist) {
	last if progressWinCheck($pw);
	# when the element is not available we jump out completly
	last if (!$picLB->info("exists", $dpic));
	$i++;
	progressWinUpdate($pw, "delete thumbnail ($i/".scalar @sellist.") ...", $i, scalar @sellist);
	$thumb = getThumbFileName($dpic);
	if (-f $thumb) {
	  if (!removeFile( $thumb)) {
		next;
	  }
	  else {
		# delete was successfull, so we insert the defaultthumb
 		$picLB->itemConfigure($dpic, $picLB->{thumbcol}, -image => $defaultthumbP, -itemtype => "imagetext") if $defaultthumbP;
	  }
	}
  }
  progressWinEnd($pw);
  generateThumbs(ASK, SHOW);
}

##############################################################
# copyPicsDialog - copy the selected pictures to a choosen dir
##############################################################
sub copyPicsDialog($$) {

  my $mode = shift; # constant COPY or BACKUP
  my $lb   = shift;	# the reference to the active listbox widget
  my @sellist = $lb->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);

  my $targetdir;
  if ($mode == BACKUP) {
	$targetdir = $actdir;
  } elsif ($mode == COPY) {
	$targetdir = getDirDialog("Copy pictures to");
  } else {
	warn "copyPicsDialog: error wrong mode: $mode";
	return;
  }
  return if ($targetdir eq "");

  copyPics($targetdir, $mode, $lb, @sellist);
}

##############################################################
# copyPics - copy the selected pictures to a choosen dir
##############################################################
sub copyPics {

	my $targetdir = shift;
	my $mode      = shift; # constant COPY or BACKUP
	my $lb        = shift; # the reference to the active listbox widget
	my @sellist   = @_;

	return unless (-d $targetdir);
	return if (@sellist < 1);

	makeDir(dirname(getThumbFileName("$targetdir/dummy.jpg")), ASK);

	my ($pic, $dpic, $tpic, $thumbpic, $thumbtpic, $njpic, $filename, $suffix);
	my $process = 'copy';
    my $errors = '';
	my $i  = 0;
	my $rc = 1;
	my $n  = 0;					# count successfull copied pictures

	my $pw = progressWinInit($lb, "Copy pictures");
	foreach $dpic (@sellist) {
		last if progressWinCheck($pw);
		$pic       = basename($dpic);

		$i++;
		$tpic      = "$targetdir/$pic";
		$thumbpic  = getThumbFileName($dpic);
		$thumbtpic = getThumbFileName($tpic);

		if ($mode == BACKUP) {
			$process   = 'backup';
			$tpic      = buildBackupName($dpic);
			$thumbtpic = buildBackupName(getThumbFileName($dpic));
			print "copyPics: duplicate mode $tpic\n" if $verbose;
		}

		progressWinUpdate($pw, "$process picture ($i/".scalar @sellist.") ...", $i, scalar @sellist);

		$rc = overwritePic($tpic, $dpic, (scalar(@sellist) - $i + 1)) if ($rc != 2);
		next if ($rc ==  0);
		last if ($rc == -1);

        # if the copy is successfull
		if (mycopy ($dpic, $tpic, OVERWRITE)) {
			$n++;
			# copy the thumbnail picture
			if ((-d dirname($thumbtpic)) and (-f $thumbpic)) {
				mycopy ($thumbpic, $thumbtpic, OVERWRITE)
			}
			
	        # copy XMP, WAV, RAW files
	        do_other_files(COPY, $dpic, $tpic, \$errors);

			# copy meta info in search database
			$searchDB{$tpic} = $searchDB{$dpic};

			if ($mode == BACKUP) {
				hlistCopy($lb, $dpic, $tpic); # insert and show the backup in the listbox
				$lb->itemConfigure($tpic, $lb->{thumbcol}, -text => getThumbCaption($tpic));
				$lb->itemConfigure($tpic, $lb->{filecol},  -text => getAllFileInfo($tpic));
			}
		}
	}								# foreach - end
	progressWinEnd($pw);
	$userinfo = "ready! ($n/".scalar @sellist." copied)"; $userInfoL->update;
    if ($errors ne '') {
	  $errors = "These errors occured while copying ".scalar @sellist." selected pictures:\n$errors";
	showText('Error while moving', $errors, NO_WAIT);
    }

	reselect($lb, @sellist);
}

##############################################################
# rename_XMP_file - rename XMP file if any
##############################################################
sub rename_XMP_file {

    # XMP files follow picture file operations if this option is set to 1
	return unless $config{XMP_file_operations};

	my $dpic = shift;
	my $ndpic = shift;
	my $error_ref = shift; # reference to error string to add warnings etc.

	my ($name,$dir,$suffix) = fileparse($dpic, '\.[^.]*'); # suffix = . and not-.  (one dot and zero or more non-dots)
	my $dpic_no_suffix = "$dir/$name";
	my ($nname,$ndir,$nsuffix) = fileparse($ndpic, '\.[^.]*'); # suffix = . and not-.  (one dot and zero or more non-dots)
	my $ndpic_no_suffix = "$ndir/$nname";
	my $xmp_file = '';
	# we have to support upper and lower case XMP suffix
	if ((-f $dpic_no_suffix.'.xmp')) {
		$xmp_file = $dpic_no_suffix.'.xmp';
	} 
	elsif ((-f $dpic_no_suffix.'.XMP')) {
		$xmp_file = $dpic_no_suffix.'.XMP';
	}
	else {
	}
	if ($xmp_file ne '') {
		my $txmp_file = "$ndir/${nname}.xmp";
        if (-f $txmp_file) {
		  $$error_ref .= "XMP file $txmp_file exists, file not renamed!\n";
		}
		else {
		  print "rename $xmp_file to $txmp_file\n" if $verbose;
		  rename ($xmp_file, $txmp_file);
		}
	}
}

##############################################################
# do_other_files - rename, copy, move XMP, WAV and RAW files
##############################################################
sub do_other_files {

    my $action = shift;  # COPY, MOVE or RENAME
    return unless ($action == RENAME or $action == COPY or $action == MOVE);

    my @suffixes;
	# we have to support upper and lower case XMP suffix
    push @suffixes, ('.xmp', '.XMP') if $config{XMP_file_operations};
    push @suffixes, ('.wav', '.WAV') if $config{WAV_file_operations};
    push @suffixes, ('.nef', '.NEF', '.crw', '.CRW') if $config{RAW_file_operations};

    return unless (@suffixes);
    #print "$action - suffixes: $_\n" foreach (@suffixes);

	my $dpic = shift;
	my $ndpic = shift;
	my $error_ref = shift; # reference to error string to add warnings etc.

	my ($name,$dir,$suffix) = fileparse($dpic, '\.[^.]*'); # suffix = . and not-.  (one dot and zero or more non-dots)
	my $dpic_no_suffix = "$dir/$name";
	my ($nname,$ndir,$nsuffix) = fileparse($ndpic, '\.[^.]*'); # suffix = . and not-.  (one dot and zero or more non-dots)
	my $ndpic_no_suffix = "$ndir/$nname";
    foreach my $suffix (@suffixes) {
	  if ((-f $dpic_no_suffix.$suffix)) {
		my $t_file = "$ndpic_no_suffix$suffix";
        if (-f $t_file) {
		  $$error_ref .= "$suffix file $t_file exists, file not ";
          $$error_ref .= "renamed!\n" if $action == RENAME;
          $$error_ref .= "copyed!\n"  if $action == COPY;
          $$error_ref .= "moved!\n"   if $action == MOVE;
		}
		else {
		  #print "rename, copy, move $action $dpic_no_suffix${suffix} to $t_file\n"; #if $verbose;
		  rename ($dpic_no_suffix.$suffix, $t_file)                if $action == RENAME;
		  move   ($dpic_no_suffix.$suffix, $ndir)                  if $action == MOVE;
		  mycopy ($dpic_no_suffix.$suffix, $t_file, ASK_OVERWRITE) if $action == COPY;
		}
      }
	}
}

##############################################################
# delete_XMP_file - delete XMP file if any
##############################################################
sub delete_XMP_file {

    # XMP files follow picture file operations if this option is set to 1
	return unless $config{XMP_file_operations};

	my $dpic = shift;

	my ($name,$dir,$suffix) = fileparse($dpic, '\.[^.]*'); # suffix = . and not-.  (one dot and zero or more non-dots)
	my $dpic_no_suffix = "$dir/$name";
	my $xmp_file = '';
	# we have to support upper and lower case XMP suffix
	if ((-f $dpic_no_suffix.'.xmp')) {
		$xmp_file = $dpic_no_suffix.'.xmp';
	} 
	elsif ((-f $dpic_no_suffix.'.XMP')) {
		$xmp_file = $dpic_no_suffix.'.XMP';
	}
	else {
	}
	if ($xmp_file ne '') {
	  print "remove $xmp_file\n" if $verbose;
	  removeFile($xmp_file);
	}
}

##############################################################
# rename_WAV_file - rename WAV audio file if any
##############################################################
# todo: check if this function could be integrated into the XMP function (rename with any suffix)
sub rename_WAV_file {

    # WAV files follow picture file operations if this option is set to 1
	return unless $config{WAV_file_operations};

	my $dpic = shift;
	my $ndpic = shift;
	my $error_ref = shift; # reference to error string to add warnings etc.

	my ($name,$dir,$suffix) = fileparse($dpic, '\.[^.]*'); # suffix = . and not-.  (one dot and zero or more non-dots)
	my $dpic_no_suffix = "$dir/$name";
	my ($nname,$ndir,$nsuffix) = fileparse($ndpic, '\.[^.]*'); # suffix = . and not-.  (one dot and zero or more non-dots)
	my $ndpic_no_suffix = "$ndir/$nname";
	my $wav_file = '';
	# we have to support upper and lower case WAV suffix
	if ((-f $dpic_no_suffix.'.wav')) {
		$wav_file = $dpic_no_suffix.'.wav';
	} 
	elsif ((-f $dpic_no_suffix.'.WAV')) {
		$wav_file = $dpic_no_suffix.'.WAV';
	}
	else {
	}
	if ($wav_file ne '') {
		my $twav_file = "$ndir/${nname}.wav";
        if (-f $twav_file) {
		  $$error_ref .= "WAV file $twav_file exists, file not renamed!\n";
		}
		else {
		  print "rename $wav_file to $twav_file\n" if $verbose;
		  rename ($wav_file, $twav_file);
		}
	}
}

##############################################################
# linkPicsDialog - link the selected pictures to a choosen dir
##############################################################
sub linkPicsDialog {

  if ($EvilOS) {
	$top->messageBox(-icon => 'warning', -message => "Sorry, but this OS does not support symbolic links.",
					 -title => 'Error', -type => 'OK');
	return;
  }
  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);

  my $targetdir = getDirDialog("Link pictures to");

  return if ($targetdir eq "");

  linkPics($targetdir, @sellist);
}

##############################################################
# linkPics - link the selected pictures to a choosen dir
##############################################################
sub linkPics {

  my $targetdir = shift;
  my @sellist   = @_;

  if ($EvilOS) {
	$top->messageBox(-icon => 'warning', -message => "Sorry, but this OS does not support symbolic links.",
					 -title => 'Error', -type => 'OK');
	return;
  }

  return unless (-d $targetdir);
  return if (@sellist < 1);

  makeDir(dirname(getThumbFileName("$targetdir/dummy.jpg")), ASK);

  my ($pic, $dpic, $tpic, $thumbpic, $thumbtpic, $njpic);
  my $i  = 0;
  my $rc = 1;
  my $n  = 0;					# count successfull copied pictures
  my $pw = progressWinInit($top, "Link pictures");
  foreach $dpic (@sellist) {
	last if progressWinCheck($pw);
	$pic       = basename($dpic);
	$i++;
	progressWinUpdate($pw, "linking ($i/".scalar @sellist.") ...", $i, scalar @sellist);
	$tpic      = "$targetdir/$pic";

	# Do not link to a link.  Always link to the original image.
	next if (!getRealFile(\$dpic));

	$thumbpic  = getThumbFileName($dpic);
	$thumbtpic = getThumbFileName($tpic);

	$rc = overwritePic($tpic, $dpic, (scalar(@sellist) - $i + 1)) if ($rc != 2);
	next if ($rc ==  0);
	last if ($rc == -1);

	if (mylink ("$dpic", "$tpic", 1)) {
	  $n++;
	  # if the link is created successfully, we COPY the thumbnail
	  # should the thumb also be a link???
	  if ((-d dirname($thumbtpic)) and (-f $thumbpic)) {
		mycopy ("$thumbpic","$thumbtpic", OVERWRITE)
	  }

# 	  unless ((defined $mode) and ($mode eq "backup")) {
# 		# ask to link non-JPEG file, if any
# 		foreach my $suf (split /\|/, $nonJPEGsuffixes) {
# 		  $njpic = $dpic;
# 		  $njpic =~ s/(.*)\.jp(g|eg)$/$1.$suf/i;
# 		  if (-f $njpic) {
# 			my $rc = $top->messageBox(-icon => 'question', -message => "There is a non-JPEG file\n\"".basename($njpic)."\"\nOk to link it too?",
# 								   -title => "Link non-JPEG?", -type => 'OKCancel');
# 			next if ($rc !~ m/Ok/i);

# 			mylink("$njpic", "$targetdir");
# 		  }
# 		}
# 	  }
	}

  }								# foreach - end
  progressWinEnd($pw);
  $userinfo = "ready! ($n/".scalar @sellist." linked)"; $userInfoL->update;

  reselect($picLB, @sellist);

}

##############################################################
# getDirDialog - let the user select a dir
##############################################################
sub getDirDialog($) {

  my $title   = shift;
  my $text    = "Please choose a target folder from the list below or open the folder browser\nby double clicking the first item or by just pressing OK.\n\nfolders from the hotlist and recently visited direcories:";
  my $another = "Open folder browser";
  my @list;
  my @sellist;


  # sort dirs hash by numerical value reverse (number of accesses)
  # %dirHotlist contains folders used as target in open dir, copy, link, move, ... operations
  foreach (sort { $dirHotlist{$b} <=> $dirHotlist{$a} } keys %dirHotlist) {
	next if (!-d $_); # skip non existing dirs
	next if ($_ eq $trashdir);
	push @list, $_;
	last if (@list > 15); # 15 entries should be enough
  }

  # add the last used folders
  foreach (reverse @dirHist) {
	next if (!-d $_);
	push @list, $_;
  }

  # remove duplicates and sort folder list alphabetical
  my %saw;
  @saw{@list} = ();
  @list = ();
  @list = sort keys %saw;

  # put the "Open folder browser" item at the first position
  unshift @list, $another;

  return '' unless (mySelListBoxDialog($title, $text, SINGLE, 'OK', \@sellist, @list));

  my $dir = '';
  $dir = $list[$sellist[0]] if $sellist[0];
  if (($dir eq '') or ($dir eq $another)) {
	my $dsdir = dirDialog($actdir);
	if ( defined $dsdir ) {
	  $dir = $dsdir;
	}
  }
  $dir  =~ s/\/\//\//g;              # replace all // with /
  if (-d $dir) { dirSave($dir); }
  else         { $dir = ''; }
  return $dir;
}

##############################################################
# movePicsDialog - move the selected pictures to a choosen dir
##############################################################
sub movePicsDialog($) {
  my $lb   = shift;	# the reference to the active listbox widget
  my @sellist = $lb->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);

  my $targetdir = getDirDialog("Move pictures to");

  return if ($targetdir eq "");

  movePics($targetdir, $lb, @sellist)
}

##############################################################
# movePics - move the selected pictures to a choosen dir
##############################################################
sub movePics {

  my $targetdir = shift;
  my $lb        = shift; # the reference to the active listbox widget
  my @sellist   = @_;

  return unless (-d $targetdir);
  return if (@sellist < 1);

  makeDir(dirname(getThumbFileName("$targetdir/dummy.jpg")), ASK);

  my ($pic, $dpic, $dir, $tpic, $thumbpic, $thumbtpic, $njpic);
  my $i = 0;
  my $rc = 1;
  my $changed = 0;
  my $errors = '';
  my $pw = progressWinInit($lb, "Move pictures");
  foreach $dpic (@sellist) {
	last if progressWinCheck($pw);
	$pic       = basename($dpic);
	$dir       = dirname($dpic);
	next if ($targetdir eq $dir);
	$i++;
	progressWinUpdate($pw, "moving ($i/".scalar @sellist.") ...", $i, scalar @sellist);
	$tpic      = "$targetdir/$pic";
	$thumbpic  = getThumbFileName($dpic);
	$thumbtpic = getThumbFileName($tpic);

	$rc = overwritePic($tpic, $dpic, (scalar(@sellist) - $i + 1)) if ($rc != 2);
	next if ($rc ==  0);
	last if ($rc == -1);

	# move picture
	if (!move ($dpic, $tpic)) {
	  $errors .= "Could not move $dpic to $tpic: $!";
	} else {
	  $changed++;				# count nr of successfull moves
	  # only if move was successfull, we also move the thumbnail
	  if ((-d dirname($thumbtpic)) and (-f $thumbpic)) {
		if (!move ($thumbpic, $thumbtpic)) {
	      $errors .= "Could not move thumbnail $thumbpic to $thumbtpic: $!";
		}
	  }
	  
	  # move XMP, WAV, RAW files
	  do_other_files(MOVE, $dpic, $tpic, \$errors);

	  # ask to move non-JPEG file, if any
#	  foreach my $suf (split /\|/, $nonJPEGsuffixes) {
#		$njpic = $dpic;
#		$njpic =~ s/(.*)\.jp(g|eg)$/$1.$suf/i;
#		if (-f $njpic) {
#		  my $rc = $lb->messageBox(-icon => 'question', -message => "There is a non-JPEG file\n\"".basename($njpic)."\"\nOk to move it too?",
#									-title => "Move non-JPEG?", -type => 'OKCancel');
#		  next if ($rc !~ m/Ok/i);
#		  if (!move ("$njpic","$targetdir")) {
#	               $errors .= "Could not move $njpic to $targetdir: $!";
#		  }
#		}
#	  }
	  $searchDB{$tpic} = $searchDB{$dpic}; # copy meta info in search database
	  delete $searchDB{$dpic};             # delete meta info of moved pic in search database
	}
  }
  progressWinEnd($pw);

  if ($errors ne '') {
	$errors = "These errors occured while moving ".scalar @sellist." selected pictures:\n$errors";
	showText('Error while moving', $errors, NO_WAIT);
  }

  if ($changed == 0) {      # nothing happend, no update needed
	$userinfo = "ready! (nothing moved)"; $userInfoL->update;
	return;
  }

  my @pics = $lb->info('children');
  if ($#pics > $#sellist) { # if not all pictures were selected
	#stopButStart();
	foreach $dpic (@sellist) {
	  #last if stopButCheck();
	  $lb->delete('entry', $dpic) if ($lb->info('exists', $dpic));
	  reloadPic() if (($lb == $picLB) and ($dpic eq $actpic));
	}
	#stopButEnd();
  }
  else { # all pictures were moved
	updateThumbsPlus() if ($lb == $picLB);
  }
  showNrOf() if ($lb == $picLB);
  $userinfo = "ready! ($changed/".scalar @sellist." moved)"; $userInfoL->update;
}

##############################################################
# overwritePic
##############################################################
sub overwritePic {

  my $old = shift; # this will be overwritten ny $new
  my $new = shift; # this will overwrite $old
  my $nr  = shift; # the number of all (left) files to check, if this nr is > 1 there will be two "for all" buttons

  return 1 if (!-f $old); # if $old does not exists, we don't need to ask ...

  my $rc = 3;   # dummy value

  my $olddir   = dirname($old);
  my $oldpic   = basename($old);
  my $oldthumb = getThumbFileName($old);
  my $olddate  = getFileDate($old, FORMAT);
  my $oldsize  = getFileSize($old, FORMAT);

  my $newdir   = dirname($new);
  my $newpic   = basename($new);
  my $newthumb = getThumbFileName($new);
  my $newdate  = getFileDate($new, FORMAT);
  my $newsize  = getFileSize($new, FORMAT);

  # open window
  my $oww = $top->Toplevel();
  $oww->title("Overwrite?");
  $oww->iconimage($mapiviicon) if $mapiviicon;

  $oww->Label(-anchor => 'w', -text => "\"$oldpic\" exists. Do you want to overwrite it?",
			  -bg => $config{ColorBG})->pack;

  my $nF = $oww->Frame()->pack(-anchor => 'w', -padx => 3, -pady => 3);
  my $ca = $oww->Canvas(-width => 100, -height => 50)->pack(-padx => 3, -pady => 3);
  my $oF = $oww->Frame()->pack(-anchor => 'w', -padx => 3, -pady => 3);

  # draw a red arrow
  $ca->createLine(50, 0,50,50, -width => 6, -fill => "red");
  $ca->createLine(50,50,70,20, -width => 6, -fill => "red");
  $ca->createLine(50,50,30,20, -width => 6, -fill => "red");

  my $newP = $oww->Photo(-file => "$newthumb", -gamma => $config{Gamma}) if (-f $newthumb);
  my $oldP = $oww->Photo(-file => "$oldthumb", -gamma => $config{Gamma}) if (-f $oldthumb);

  $nF->Label(-image => $newP)->pack(-side => "left") if $newP;
  $oF->Label(-image => $oldP)->pack(-side => "left") if $oldP;

  $nF->Label(-justify => "left", -text => "this file\n$newsize\n$newdate\n$newdir",
			 -bg => $config{ColorBG})->pack(-padx => 3, -side => "left");
  $oF->Label(-justify => "left", -text => "will overwrite this file\n$oldsize\n$olddate\n$olddir",
			 -bg => $config{ColorBG})->pack(-padx => 3, -side => "left");

  $oww->Label(-anchor => 'w', -text => "$nr files to go ...",
			  -bg => $config{ColorBG})->pack if ($nr > 1);

  my $bF = $oww->Frame()->pack(-padx => 3, -pady => 3, -fill => 'x', -expand => 1);
  $bF->Button(-text => "Overwrite", -command => sub { $rc = 1; })->pack(-side => "left",
																		-fill => 'x', -expand => 1);
  $bF->Button(-text => "Overwrite All",
			  -command => sub { $rc = 2; })->pack(-side => "left", -fill => 'x', -expand => 1) if ($nr > 1);
  $bF->Button(-text => 'Cancel',    -command => sub { $rc = 0; })->pack(-side => "left",
																		-fill => 'x', -expand => 1);
  $bF->Button(-text => "Cancel All",
			  -command => sub { $rc = -1; })->pack(-side => "left", -fill => 'x', -expand => 1)if ($nr > 1);

  $oww->Popup;
  $oww->waitVariable(\$rc);
  $oww->withdraw();
  $oww->destroy();
  die "wrong rc value: $rc" if (($rc < -1) or ($rc > 2));
  return $rc;
}

##############################################################
# sendTo - send all selected pics via email
##############################################################
sub sendTo {
  my $lb = shift;				# the reference to the active listbox widget

  my @sellist = $lb->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);

  # check if some files are links
  return if (!checkLinks($lb, @sellist));

  if ($config{MailTool} =~ m/thunderbird/i) {
  }
  elsif ($config{MailTool} =~ m/evolution/i) {
  }
  else {
	$top->messageBox(-icon    => 'warning',
					 -message => "Sorry, the selected mail tool ($config{MailTool}) is not supported! Please try to find the command line syntax to send a mail with attachment and send this info to Martin-Herrmann\@gmx.de.",
					 -title   => "External mail tool not yet supported",
					 -type    => 'OK');
    return;
  }


  if ((system "$config{MailTool} --version") != 0) {
	$top->messageBox(-icon    => 'warning',
					 -message => "Sorry, no mail tool ($config{MailTool}) found! Please use Ctrl-o (Options->Advanced->External mail tool) to select the right tool.",
					 -title   => "External mail tool not available",
					 -type    => 'OK');
    return;
  }


  # open dialog window
  my $myDiag = $top->Toplevel();
  $myDiag->title("Change size/quality before sending");
  $myDiag->iconimage($mapiviicon) if $mapiviicon;

  $myDiag->Label(-text =>"Change the size and/or quality of the ".scalar @sellist." selected pictures before sending via email.",
				 -bg => $config{ColorBG}
				)->pack(-anchor => 'w',-padx => 3,-pady => 3);

  $myDiag->Checkbutton(-variable => \$config{MailPicNoChange},
					   -text => "leave pictures untouched",
					   -command => sub {
						 my $state = "disabled";
						 $state = 'normal' unless ($config{MailPicNoChange});
						 setChildState($myDiag->{sq}, $state);
						 setChildState($myDiag->{sl}, $state);
					   })->pack(-anchor => 'w');

  $myDiag->{sq} = labeledScale($myDiag, 'top', 24, "Quality (%)", \$config{MailPicQuality}, 10, 100, 1);
  qualityBalloon($myDiag->{sq});

  $myDiag->{sl} = labeledScale($myDiag, 'top', 24, "Maximum length (pixels)", \$config{MailPicMaxLength}, 10, 2000, 1);

  my $ButF =
	$myDiag->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);

  my $OKB =
	$ButF->Button(-text => 'OK',
				  -command => sub {
					$myDiag->destroy();
					$userinfo = "sending ".scalar @sellist." pictures via email"; $userInfoL->update;

					my $pics = "";
					my $dpic;

					unless ($config{MailPicNoChange}) {
					  # copy to trash
					  $userinfo = "send to: copy pictures to temp folder"; $userInfoL->update;
					  foreach $dpic (@sellist) {
						mycopy($dpic, $trashdir, OVERWRITE);
					  }
					  # exchange the folder from original to trash
					  foreach (@sellist) {
						$_ = "$trashdir/".basename($_);
					  }
					  # resize
					  foreach $dpic (@sellist) {
						$userinfo = "send to: resizing pictures ".basename($dpic); $userInfoL->update;
						my $command = "mogrify";
						$command .= " -geometry \"".$config{MailPicMaxLength}.'x'.$config{MailPicMaxLength}.">\"";
						$command .= " -quality ".$config{MailPicQuality}." \"$dpic\"";
						print "changeSizeQuality: com = $command\n" if $verbose;
						execute($command);
					  }
					}
					foreach $dpic (@sellist) {
					  if ($pics eq "") {
						$pics = "file://$dpic";    # the first one
					  } else {
						$pics .= ",file://$dpic";  # additional pics
					  }
					}

# /usr/bin/evolution mailto:Martin-Herrmann@gmx.de?attach=file:///home/pic1.jpg\&attach=file:///home/pic2.jpg\&subject=My%20Pictures\&body=Text%20for%20description &

					$userinfo = "send to: starting email client ..."; $userInfoL->update;
					my $command = "$config{MailTool} ";
                    if ($config{MailTool} =~ m/thunderbird/i) {
                      $command .= "-compose \"subject=Pictures,attachment=\'$pics\'\"";
                    }
                    elsif ($config{MailTool} =~ m/evolution/i) {
                      $command .= "\"mailto:Receiver?attach=\'$pics\'\\&subject=Pictures\\&body=Text\"" ;
                    }
                    else {
                       # this case is already handled adove.
                    }
					$command .= " &" unless ($EvilOS);
					print "command = $command\n";# if $verbose;
					(system "$command") == 0 or warn "$command failed: $!";

# todo: this does not work, the pic still has to be there, when the user presses the send button
# extra dir which will be deleted at the next startup or simply leave it in the trash?
#					$top->after(5000); # wait 5 secs for mail client to pic up the pictures (ToDo)
#					$userinfo = "send to: removing temp pictures ..."; $userInfoL->update;
#					$top->after(1000);
#					unless ($config{MailPicNoChange}) {
#					  # remove pics in trash
#					  foreach (@sellist) {
#						removeFile($_);
#					  }
#					}
					$userinfo = "ready!"; $userInfoL->update;
				  })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $ButF->Button(-text => "Default",
				-command => sub {
				  $config{MailPicNoChange} = 0;
				  $config{MailPicQuality} = 75;
				  $config{MailPicMaxLength} = 800;
				  my $state = "disabled";
				  $state = 'normal' unless ($config{MailPicNoChange});
				  setChildState($myDiag->{sq}, $state);
				  setChildState($myDiag->{sl}, $state);
				})->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $OKB->bind('<Return>', sub { $OKB->invoke; } );

  $ButF->Button(-text => 'Cancel',
				-command => sub { $myDiag->destroy(); }
			   )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $myDiag->Popup;
  if ($EvilOS) {				# sometimes to dialog disappears when clicked on, so we need a short grab
	$myDiag->grab;
	$myDiag->after(50, sub{$myDiag->grabRelease});
  }
  $OKB->focus;
  $myDiag->waitWindow();
  $myDiag->destroy() if Tk::Exists($myDiag);
}

##############################################################
# convertPics - convert selected pics to another format
##############################################################
sub convertPics {
  my $lb = shift;				# the reference to the active listbox widget

  my @sellist = $lb->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);

  return if (!checkExternProgs("sendTo", "convert"));

  # check if some files are links
  return if (!checkLinks($lb, @sellist));

  # open dialog window
  my $win = $top->Toplevel();
  $win->title("Convert to other picture formats");
  $win->iconimage($mapiviicon) if $mapiviicon;

  $win->Label(-text =>"Convert the ".scalar @sellist." selected pictures to another picture format.\nThe orininal files will be left untouched.\nThe converted pictures are stored in the actual diretory.",
				 -bg => $config{ColorBG}
				)->pack(-anchor => 'w',-padx => 3,-pady => 3);

  my $notebook =
	$win->NoteBook(-width => 500,
				  -background => $config{ColorBG}, # background of active page (including its tab)
				  -inactivebackground => $config{ColorEntry}, # tabs of inactive pages
				  -backpagecolor => $config{ColorBG}, # background behind notebook
				 )->pack(-expand => "yes",
						 -fill => "both",
						 -padx => 5, -pady => 5);

  my $format = "gif";
  my $gifF  = $notebook->add("gif",     -label => "GIF",  -raisecmd => sub { $format = "gif"; });
  my $pngF  = $notebook->add("png",     -label => "PNG",  -raisecmd => sub { $format = "png"; });
  my $tifF  = $notebook->add("tiff",    -label => "TIFF", -raisecmd => sub { $format = "tiff"; });

  $win->{PicQuality} = 95;
 $pngF->{sq} = labeledScale($pngF, 'top', 24, "Quality (%)", \$win->{PicQuality}, 0, 100, 1);
  $balloon->attach($pngF->{sq}, -msg => 'Quality range from 0% (fastest compression) to 100% (best but slowest).
For 0%, the Huffman-only strategy is used, which is fastest but not necessarily the worst compression.
The default is 75%, which means nearly the best compression with adaptive filtering.
If the image is a natural image (a photo), then use "adaptive" filtering with quality 95%.
The quality setting has no effect on the appearance of PNG images, since the compression is always lossless.

For PNG images, quality is regarded as two decimal figures.
The first (tens) is the zlib compression level, 1-9.
The second (ones digit) is the PNG filtering type:
0 is none,
1 is "sub",
2 is "up",
3 is "average",
4 is "Paeth", and
5 is "adaptive".');

  my $ButF =
	$win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);

  my $OKB =
	$ButF->Button(-text => 'OK',
				  -command => sub {
					$win->destroy();
					#my $format = $notebook->raised();
					print "format = $format\n";
					$userinfo = "converting ".scalar @sellist." $format pictures"; $userInfoL->update;
					print $userinfo."\n";

					my ($dpic, $ndpic);
					my $i = 0;

					my $pw = progressWinInit($top, "Convert pictures");
					foreach $dpic (@sellist) {
						last if progressWinCheck($pw);
						progressWinUpdate($pw, "convert picture ($i/".scalar @sellist.") ...", $i, scalar @sellist);
						$i++;
						$ndpic = $dpic;
						$ndpic =~ s/(.*)\.jp(g|eg)$/$1.$format/i;
						if (-f $ndpic) {
							my $rc = $top->messageBox(-icon => 'question', -message => "$ndpic exists already.\nShould I really overwrite it?",
													  -title => "Overwrite?", -type => 'OKCancel');
							next if ($rc !~ m/Ok/i);
						}
						$userinfo = "convert picture ".basename($dpic); $userInfoL->update;
						my $command = "convert";
						$command .= " -quality ".$win->{PicQuality} if ($format eq "png");
						$command .= " \"$dpic\" \"$ndpic\"";
						print "convertPics:: com = $command\n"; # if $verbose;
						execute($command);
						progressWinUpdate($pw, "convert picture ($i/".scalar @sellist.") ...", $i, scalar @sellist);
					}
					progressWinEnd($pw);
					$userinfo = "ready!"; $userInfoL->update;
				})->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);


  $OKB->bind('<Return>', sub { $OKB->invoke; } );

  $ButF->Button(-text => 'Cancel',
				-command => sub { $win->destroy(); }
			   )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $win->Popup;
  if ($EvilOS) {				# sometimes to dialog disappears when clicked on, so we need a short grab
	$win->grab;
	$win->after(50, sub{$win->grabRelease});
  }
  $OKB->focus;
  $win->waitWindow();
  $win->destroy() if Tk::Exists($win);
}

##############################################################
# renamePic - let the user rename the seleced pictures
##############################################################
sub renamePic {

  my $lb = shift;
  my @sellist = $lb->info('selection');
  my @resellist = @sellist;
  return unless checkSelection($lb, 1, 0, \@sellist);
  my ($pic, $dir, $dpic, $newname, $rc, $thumb);

  my $i = 0;
  my $errors = '';
  my $pw = progressWinInit($lb, "Rename pictures");
  foreach $dpic (@sellist){
	last if progressWinCheck($pw);
	$i++;
	progressWinUpdate($pw, "renaming picture ($i/".scalar @sellist.") ...", $i, scalar @sellist);
	$pic     = basename($dpic);
	$dir     = dirname($dpic);
	$thumb   = getThumbFileName($dpic);
	$newname = $pic;
	next if (!checkWriteable($dpic));

	$rc = myEntryDialog("Rename picture", "Please enter a new name for file\n$pic\n(in $dir)", \$newname, getThumbFileName($dpic));
	next if (($rc ne 'OK') or ($newname eq "") or ($newname eq $pic));

	# check for correct JPEG suffix
	if (is_a_JPEG($dpic) and ($newname !~ /(.*)(\.jp(g|eg))/i)) {
	  $newname =~ /(.*)\.(.*)/;
	  my $correct = "$1.jpg";
	  my $rc = $lb->messageBox(-icon => 'question', -message => "$newname has not a correct JPEG suffix.\nShould I change it to $correct?",
					   -title => "Change suffix?", -type => 'OKCancel');
	  if ($rc eq "Ok") {
		$newname = "$correct";
	  }
	}

	my $ndpic = "$dir/$newname";

	# check if new file name already exists
	if (-f $ndpic) {
	  my $rc = $lb->Dialog( -title => "File exists",
							 -text => "$newname already exists!",
							 -buttons => ['Overwrite', 'Cancel'])->Show();
	  next if ($rc ne 'Overwrite'); # skip this file
	}

	if (!rename ($dpic, $ndpic)) {
	  $errors .= "Could not rename $pic to $newname: $!";
	  next;
	}

	# correct the searchDB
	$searchDB{$ndpic} = $searchDB{$dpic}; # copy meta info in search database
	delete $searchDB{$dpic};                          # delete meta info of renamed pic in search database

	renameCachedPic($dpic, $ndpic);
	foreach (@resellist) { $_ = $ndpic if ($_ eq $dpic); }

	if ($dpic eq $actpic) { $actpic = $ndpic; }

	hlistEntryRename($lb, $dpic, $ndpic);
	# change the displayed name
	$lb->itemConfigure($ndpic, $lb->{thumbcol}, -text => getThumbCaption($newname));
	$lb->itemConfigure($ndpic, $lb->{filecol},  -text => getAllFileInfo($ndpic));

	# rename thumbnail
	if (-f $thumb) {
	  if (!rename ($thumb, dirname($thumb)."/$newname")) {
		$errors .= "Could not rename thumbnail $pic to $newname: $!";
	  }
	}

	# rename XMP, WAV, RAW files
	do_other_files(RENAME, $dpic, $ndpic, \$errors);
	
	# rename exif info file, if any
	if (-f "$dir/$exifdirname/$pic") {
	  if (!rename ("$actdir/$exifdirname/$pic", "$actdir/$exifdirname/$newname")) {
		$errors .= "Could not rename exif info file $pic to $newname: $!";
	  }
	}

	# rename backup file, if any
	renameBackup($lb, $dpic, $newname, ASK);
  }

  if ($errors ne '') {
	$errors = "These errors occured while renaming ".scalar @sellist." selected pictures:\n$errors";
	showText('Error while renaming', $errors, NO_WAIT);
  }

  progressWinEnd($pw);
  reselect($lb, @resellist);
  if ($lb == $picLB) {
	  setTitle();
	  $userinfo = "ready! ($i/".scalar @sellist." renamed)"; $userInfoL->update;
  }
}

##############################################################
# renameNonJPEG - check if there are any non-JPEG files
#                 and rename them
##############################################################
# todo enhance this to cope with other formats
sub renameNonJPEG {
  my $dpic    = shift;
  my $newname = shift;

  foreach my $suf (split /\|/, $nonJPEGsuffixes) {
	my $njpic = $dpic;
	$njpic =~ s/(.*)\.jp(g|eg)$/$1.$suf/i;
	if (-f $njpic) {
	  my $nnjpic = "$actdir/$newname";
	  $nnjpic =~ s/(.*)\.jp(g|eg)$/$1\.$suf/i;
	  my $rc = $top->messageBox(-icon => 'question', -message => "There is a non-JPEG file\n\"".basename($njpic)."\"\nOk to rename it to:\n\"".basename($nnjpic)."\"?",
							 -title => "Rename non-JPEG?", -type => 'OKCancel');
	  return 0 if ($rc !~ m/Ok/i);

	  if (!rename ("$njpic", "$nnjpic")) {
		$top->messageBox(-icon => 'warning', -message => "Could not rename non-JPEG picture $njpic to $nnjpic: $!",
						 -title => 'Error', -type => 'OK');
	  }
	}
  }
  return 1;
}

##############################################################
# showBackup
##############################################################
sub showBackup {

  my @sellist = $picLB->info('selection');
  if (@sellist != 1) {
	$top->messageBox(-icon => 'info', -message => "Please select exacty one picture for this function.",
					 -title => "Wrong selection", -type => 'OK');
	return;
  }

  my $bpic = buildBackupName($sellist[0]);
  if (-f $bpic) {
	showPicInOwnWin($bpic);
  }
  else {
	$userinfo = 'Sorry, no backup "'.basename($bpic).'" found.'; $userInfoL->update;
  }
}

##############################################################
# renameBackup - check if there is a backup file
#                and rename it
##############################################################
sub renameBackup {
  my $lb      = shift;
  my $dpic    = shift;
  my $newname = shift;
  my $ask     = shift;

  return unless $config{RenameBackup};

  my $bpic = buildBackupName($dpic);
  return unless (-f $bpic); # no backup - no rename

  my $dir   = dirname($dpic);
  my $pic   = basename($dpic);
  my $nbpic = basename(buildBackupName("$dir/$newname"));
  my $rc    = $nbpic;

  if ((defined $ask) and ($ask == ASK)) {
	$rc = myButtonDialog("Rename backup?", "Should I also rename the backup file ".basename($bpic)."?\nRename to:", undef, $nbpic, $pic, 'Cancel');
	return if ($rc =~ m/Cancel/i);
  }

  my $new_bak_name = "$dir/$rc";

  if (-f $new_bak_name) { # should not happen
	$lb->messageBox(-icon => 'warning', -message => "Backup picture $bpic should be renamed to $new_bak_name. But $new_bak_name exists! Skipping rename action.",
					 -title => 'Error', -type => 'OK');
	return;
  }

  if (rename ($bpic, $new_bak_name)) {
	hlistEntryRename($lb, $bpic, $new_bak_name);
	# change the displayed name
	if ($lb->info("exists", $new_bak_name)) {
	  $lb->itemConfigure($new_bak_name, $picLB->{thumbcol}, -text => getThumbCaption($new_bak_name));
	  $lb->itemConfigure($new_bak_name, $picLB->{filecol},  -text => getAllFileInfo($new_bak_name));
	}

	# correct the searchDB
	$searchDB{$new_bak_name} = $searchDB{$bpic}; # copy meta info in search database
	delete $searchDB{$bpic};
	
	# rename thumbnail
	my $thumb = getThumbFileName($bpic);
	if (-f $thumb) {
	  my $nthumb = getThumbFileName($new_bak_name);
	  if (!rename ($thumb, $nthumb)) {
		$lb->messageBox(-icon => 'warning', -message => "Could not rename thumbnail $thumb to $nthumb: $!",
						 -title => 'Error', -type => 'OK');
	  }
	}
  } else {
	$lb->messageBox(-icon => 'warning', -message => "Could not rename backup picture $bpic to $new_bak_name: $!",
					 -title => 'Error', -type => 'OK');
  }
}

##############################################################
# getRenameFormat
##############################################################
sub getRenameFormat {

  my $format = $config{FileNameFormat}; # copy to tmp variable

  my $rc = myEntryDialog("Enter file name format",
						 'Please enter the file name format

%f = file name (without suffix)    %xa = EXIF aperture
%y = year      (yyyy)              %xe = EXIF exposure time
%m = month     (mm)                %xm = EXIF camera model
%d = day       (dd)                %xr = EXIF artist
%h = hour      (hh)                %iw = image width
%M = Minute    (MM)                %ih = image height
%s = second    (ss)                %F  = file name substring

Examples:
"%y%m%d-%h%M%s" will rename all pictures to their internal EXIF
date e.g. 20081231-155959 (the file date will be used, if there
is no EXIF date).

"%F4-7" will rename PIC0001.jpg to file name substring from
4th char up to 7th char e.g 0001.jpg

If you select 3 pictures and enter "flower" as file name format,
the pics will be renamed to "flower.jpg", "flower-01.jpg" and
"flower-02.jpg".

The suffix ".jpg" will always be added.

Leave the format line below empty to use the default format
('.$config{FileNameFormatDef}.').', \$format);

  return 'Cancel' if ($rc ne 'OK');

  if ($format eq "") {
    $format = $config{FileNameFormatDef};
  }

  if ($format =~ m/.*\/.*/) {
	$top->messageBox(-icon  => 'warning', -message => "Sorry, but a / is not allowed in a file name.",
					 -title => 'Error',   -type    => 'OK');

    return 'Cancel';
  }
  $config{FileNameFormat} = $format; # save back to the config
  return $rc;
}

##############################################################
# renameSmart - rename the selected pictures using e.g. the EXIF date
##############################################################
sub renameSmart {

  my $lb = shift;
  my @sellist = $lb->info('selection');
  my @resellist = @sellist;
  return unless checkSelection($lb, 1, 0, \@sellist);
  my ($pic, $dir, $dpic, $ndpic, $rc, @datetime, @times, $time, @dates, $date, $n, $base);
  my $doForAll = 0;
  my $errors   = '';
  my $useFileDate = undef;
  my @renamed;

  $rc = getRenameFormat();
  return if ($rc ne 'OK');

  my $format = $config{FileNameFormat};

  my $i = 0;
  my $pw = progressWinInit($lb, "smart rename");
  foreach $dpic (@sellist) {
	last if progressWinCheck($pw);
	$i++;
	$pic         = basename($dpic);
	$dir         = dirname($dpic);

	progressWinUpdate($pw, "renaming ($i/".scalar @sellist.") ...", $i, scalar @sellist);

	unless (-f $dpic) { # may happen when renaming backups
	  $errors .= "$pic: not found, seems to be an already renamed backup? - skipping\n";
	  next;
	}

	my $newname = "";
	$rc = applyRenameFormat($dpic, $format, \$newname, \$doForAll);
	next if ($rc eq "Skip this picture");
	last if ($rc eq "Cancel all");
	$newname = findNewName("$dir/$newname");
	# todo: handle backup pics it should be possible to preserve the "-bak" part

	$ndpic = "$dir/$newname";

	if (-f $ndpic) { # just a safety check
	  $errors .= "$pic: new name $newname already exists - skipping\n";
	  next;
	}

	# rename the picture

	if (renamePicInt($dpic, $ndpic, \$errors)) {
	  push @renamed, $ndpic;
	  # rename the hlist entry
	  hlistEntryRename($lb, $dpic, $ndpic);
	  # display the new file name
	  $lb->itemConfigure($ndpic, $lb->{thumbcol}, -text => getThumbCaption($ndpic));
	  $lb->itemConfigure($ndpic, $lb->{filecol},  -text => getAllFileInfo($ndpic));
	  foreach (@resellist) { $_ = $ndpic if ($_ eq $dpic); }
	}
  }

  # fix the renaming of the first pic of a set (pic.jpg -> pic-00.jpg)
  my $renamed = renameSmartFix(\$errors, @renamed);
  foreach my $dpic (keys %{$renamed}) {
	my $ndpic = $$renamed{$dpic};
	# rename the hlist entry
	hlistEntryRename($lb, $dpic, $ndpic);
	# display the new file name
	$lb->itemConfigure($ndpic, $lb->{thumbcol}, -text => getThumbCaption($ndpic));
	$lb->itemConfigure($ndpic, $lb->{filecol},  -text => getAllFileInfo($ndpic));
	foreach (@resellist) { $_ = $ndpic if ($_ eq $dpic); }
  }

  progressWinEnd($pw);
  reselect($lb, @resellist);
  if ($lb == $picLB) {
	  $userinfo = "ready! (renamed $i/".scalar @sellist.")"; $userInfoL->update;
	  setTitle();
  }
  if ($errors ne '') {
	$errors = "These errors occured while renaming ".scalar @sellist." selected pictures:\n$errors";
	showText("Error while renaming", $errors, NO_WAIT);
  }
  $lb->focusForce;
}

##############################################################
# renamePicInt - rename a pic, the thumb, backup, exif, nonjpeg
#                searchDB and cached pic
##############################################################
sub renamePicInt {
  my $dpic   = shift;
  my $ndpic  = shift;
  my $errors = shift; # ref to error string
  my $pic  = basename($dpic);
  my $dir  = dirname($dpic);
  my $npic = basename($ndpic);
  my $rc = 0;

  if (!rename ($dpic, $ndpic)) {
	# rename failed
	$$errors .= "Could not rename $pic to $npic: $!\n";
	$rc = 0;
  }
  else {
	# rename worked
	# rename the thumbnail
	my $thumbdir = dirname(getThumbFileName($dpic));
	if (!rename ("$thumbdir/$pic", "$thumbdir/$npic")) {
	  $$errors .= "Could not rename thumbnail $pic to $npic: $!\n";
	}
	# rename exif info file, if any
	if (-f "$dir/$exifdirname/$pic") {
	  if (!rename ("$dir/$exifdirname/$pic", "$dir/$exifdirname/$npic")) {
		$$errors .= "Could not rename exif info file $pic to $npic: $!\n";
	  }
	}
	
	# rename the XMP, WAV, RAW sidecar files, if any
	do_other_files(RENAME, $dpic, $ndpic, \$errors);

	# rename theWAV audio file, if any
	#rename_WAV_file($dpic, $ndpic, \$errors);

	# rename backup file, if any
	renameBackup($picLB, $dpic, $npic);

	# rename non-JPEG file, if any
	renameNonJPEG($dpic, $npic);

	# correct the searchDB
	$searchDB{$ndpic} = $searchDB{$dpic}; # copy meta info in search database
	delete $searchDB{$dpic};               # delete meta info of renamed pic in search database

	renameCachedPic($dpic, $ndpic);
	$actpic = $ndpic if (($dpic eq $actpic) and (-f $ndpic));
	$rc = 1;
  }
  return $rc;
}

##############################################################
# renameSmartFix - fix the renaming of renameSmart by adding
#                  "-000" to the first pic of a set
#                  e.g. pic1.jpg    and pic1-001.jpg will become
#                       pic1-000.jpg and pic1-001.jpg
# todo: this really is an ugly solution
##############################################################
sub renameSmartFix {

  my $errors  = shift; # ref to scalar, errors will be added
  my @piclist = @_;
  return unless (@piclist);

  my %hash;
  $hash{$_} = 1 foreach (@piclist);
  my %renamed; # hash of the renamed files (key: old name, value: new name)

  # search the list for files matching file-001.jpg
  foreach my $dpic (@piclist) {
	if ($dpic =~ m/(.*)-001\.(.*)$/i) {   # e.g. file-001.jpg
	  my $pic  = "$1.$2";
	  my $npic = "$1-000.$2";
	  # if there is a file named file.jpg
	  if (defined $hash{$pic}) {
		# and no file named file-000.jpg
		unless (defined $hash{$npic}) {
		  print "renameSmartFix: rename $pic to $npic\n" if $verbose;
		  # we rename file.jpg to file-000.jpg
		  if (renamePicInt($pic, $npic, $errors)) {
			$renamed{$pic} = $npic;
		  }
		}
	  }
	}

  }
  return \%renamed;
}

##############################################################
# applyRenameFormat
##############################################################
sub applyRenameFormat {
  my $dpic     = shift;
  my $format   = shift;           # e.g. %y%m%d-%h%M%s
  my $newname  = shift;           # reference to string
  my $doForAll = shift;           # reference to bool
  my $pic      = basename($dpic);

  $$newname = $format;

	# replace %f with the file name
	if (($format =~ m/\%f/) and ($pic =~ /(.*)\.(.*)/)) {
	  my $name = $1;     # $1 makes some problems in s///
	  $$newname =~ s/%f/$name/g;
	}

    # idea from Thierry Daucourt
    # replace %F with the file name substring
    if ($format =~ m/\%F(\d+)\-(\d+)/) {
      my $begin = $1 - 1; # we start with index 1, not 0
      my $end   = $2 - 1;
      if ($pic =~ /(.*)\.(.*)/) {
        my $name = $1;
        #print "begin: $begin end: $end length ($name): ",length($name),"\n";
        # some safety checks
        if (($begin <= $end) and
            ($end < length($name)) and
            ($begin >= 0)) { 
              $name = substr($name, $begin, $end - $begin + 1);
        }
        $$newname =~ s/\%F(\d+)\-(\d+)/$name/g;
      }
    }

	# get the date and replace it, only when needed
	if ($format =~ m/(\%y|\%m|\%d|\%h|\%M|\%s)/) {
	  my $datestr = "";
	  $datestr    = getEXIFDate($dpic);

	  if ($datestr eq "") {
		$datestr  = getFileDate($dpic, NO_FORMAT);
		$datestr  = buildEXIFDateTime($datestr);
		unless ($$doForAll) {
		  my $rc    = checkDialog("Use file date?",
								  "$pic has no EXIF date, shall I use the file date ($datestr) instead?",
								  $doForAll,
								  "don't ask again",
								  getThumbFileName($dpic),
								  'OK', "Skip this picture", "Cancel all");
		  return $rc if (($rc eq "Skip this picture") or ($rc eq "Cancel all"));
		}
	  }

	  my @datetime = split / /, $datestr;
	  my @times    = split /:/, $datetime[1];
	  my @dates    = split /:/, $datetime[0];

	  $$newname =~ s/%y/$dates[0]/g;
	  $$newname =~ s/%m/$dates[1]/g;
	  $$newname =~ s/%d/$dates[2]/g;
	  $$newname =~ s/%h/$times[0]/g;
	  $$newname =~ s/%M/$times[1]/g;
	  $$newname =~ s/%s/$times[2]/g;
	}
	
	# get EXIF data and replace it, only when needed
	if ($format =~ m/(\%xa|\%xe|%xm|%xr)/) {
	  my $aperture = sprintf("%02.1f", getEXIFAperture($dpic, NUMERIC));
	  $$newname =~ s/%xa/$aperture/g;
	  my $exposure = sprintf("%.3f", getEXIFExposureTime($dpic, NUMERIC));
	  $$newname =~ s/%xe/$exposure/g;
	  my $model = getEXIFModel($dpic);
	  $model =~ tr/\000/ /;  # remove null termination (\000) chars
	  $model =~ s/( )+/ /g;  # replace more than one space with one
	  $model =~ s/\s+$//;   # cut trailing whitespace
	  $$newname =~ s/%xm/$model/g;
	  my $artist = getEXIFArtist($dpic);
	  $$newname =~ s/%xr/$artist/g;
	}

	# get image data and replace it, only when needed
	if ($format =~ m/(\%iw|\%ih)/) {
	  my ($w, $h) = getSize($dpic);
	  $$newname =~ s/%iw/$w/g;
	  $$newname =~ s/%ih/$h/g;
    }
	
	print "applyRenameFormat: $pic -> -$$newname- (format: $format)\n" if $verbose;
	return 'OK';
}

##############################################################
# findNewName - find a unused name by adding a number
#               e.g.  name-001.jpg
#               input: filename with dir! with or without suffix
#               output: new filename - no dir!!!
##############################################################
sub findNewName {

  my $dpic = shift;
  my $dir  = dirname($dpic);
  my $pic  = basename($dpic);

  if ($pic !~ /(.*)(\.jp(g|eg))/i) {
	$pic .= ".jpg"; # pic does not have a jpeg suffix - adding .jpg
  }

  $pic =~ /(.*)(\.jp(g|eg))/i; # now split again (we need $1 and $2)
  my $base   = $1;
  my $new    = $base;
  my $suffix = $2;

  # if a file with this name already exists, we add a number
  for ( 1 .. 999 ) {                           # three digits
	if (-f  "$dir/$new$suffix") {
	  $new = sprintf "%s-%03d", $base, $_;     # three digits
	} else {
	  last;
	}
  }

  print "findNewName: $pic -> $new$suffix\n" if $verbose;
  return "$new$suffix";
}

##############################################################
# updateThumbsPlus - update and show the actual pic again
##############################################################
sub updateThumbsPlus {
  updateThumbs();
  showPic($actpic);
}

##############################################################
# updateThumbs - reads the pictures of the actual dir, shows the
#                thumbnails, the given picture and generates
#                the thumbnails
##############################################################
sub updateThumbs {

  $userinfo = "loading thumbnails ...";
  $top->update;
  checkCachedPics();

  canvasHide();

  # delete all photo objects (thumbnnails)
  foreach (keys %thumbs) {
	print "updateThumbs: deleting thumbnail object of $_\n" if $verbose;
	$thumbs{$_}->delete if (defined $thumbs{$_}); # delete photo object
	delete $thumbs{$_};                           # delete hash entry
  }

  if ($verbose) {
	my @check = $top->imageNames;
	print " there are ".scalar @check." pics left\n";
  }

 if (showThumbs()) {
	$userinfo = "loading thumbnails ... ready";  $userInfoL->update;
	generateThumbs(ASK, SHOW);
  }
  else {
	$userinfo = "user abord (not all pictures are loaded!)";  $userInfoL->update;
  }
  showNrOf();
  
  check_new_keywords();
}

##############################################################
#  check_new_keywords - check if new keywords were found in the pictures and ask to add them to the catalog
##############################################################
sub check_new_keywords {
  return unless ($config{CheckNewKeywords});
  return if (keys %new_keywords <= 0);
  
  return unless (get_new_keywords());

  # open window
  my $win = $top->Toplevel();
  $win->title('New IPTC keywords');
  $win->iconimage($mapiviicon) if $mapiviicon;

  my $text = 'Found new IPTC keywords, please choose how to proceed.';

  $win->Label(-textvariable => \$text)->pack(-expand => 0, -fill => 'x');
  my $tlb = $win->Scrolled("HList",
						   -header     => 1,
						   -separator  => ';',  # todo here we hope that ; will never be in a folder or file name
						   -pady       => 0,
						   -columns    => 2,
						   -scrollbars => 'osoe',
						   -selectmode => 'extended',
						   -width      => 80,
						   -height     => 30,
						  )->pack(-expand => 1, -fill => "both");

  bindMouseWheel($tlb);
  $tlb->header('create', 0, -text => 'Keyword', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
  $tlb->header('create', 1, -text => 'Occurance', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});

  my $butF1 = $win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
  my $butF2 = $win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);

  $butF1->Button(-text => 'add selected to keyword catalog',
				-command => sub {
				  my @sellist = $tlb->info('selection');
                  return unless (@sellist);
				  add_new_keywords(\@sellist);
                  my $nr = show_new_keywords($tlb);
				  $win->destroy() if ($nr < 1);
				})->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  $butF1->Button(-text => 'add selected to ignore list',
				-command => sub {
				  my @sellist = $tlb->info('selection');
                  return unless (@sellist);
				  foreach (@sellist) {
                    $ignore_keywords{$_} = 1;
                    delete $new_keywords{$_} if (defined $new_keywords{$_});
                  }
                  my $nr = show_new_keywords($tlb);
				  $win->destroy() if ($nr < 1);
				})->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $butF2->Checkbutton(-variable => \$config{CheckNewKeywords},
				   -text => "Check for new keywords")->pack(-side => 'left', -anchor => 'w');

  my $Xbut = $butF2->Button(-text => 'Ask later',
				-command => sub { $win->destroy();
				})->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $win->bind('<Control-q>',  sub { $Xbut->invoke; });
  $win->bind('<Key-Escape>', sub { $Xbut->invoke; });
  $win->bind('<Control-a>',  sub { selectAll($tlb); } );

  $win->Popup(-popover => 'cursor');
  repositionWindow($win);

  my $nr = show_new_keywords($tlb);
  $text = "Found $nr new IPTC keywords, please choose how to proceed.";

  $win->waitWindow;
}

##############################################################
# show_new_keywords - show a list of keywords in a hlist
##############################################################
sub show_new_keywords {
  my $lb = shift; # the hlist widget
  my @list = get_new_keywords();

  $lb->delete('all');
  foreach my $key (sort @list) {
	$lb->add($key);
	$lb->itemCreate($key, 0, -text => $key, -style => $comS);
	$lb->itemCreate($key, 1, -text => $new_keywords{$key}, -style => $iptcS);
  }
  return (scalar @list);
}

##############################################################
# get_new_keywords - get new keywords from global hash, return list with new keywords (e.g. nature.animal.dog)
##############################################################
sub get_new_keywords {
  my @new_keywords;
  foreach my $key (keys %new_keywords) {
    # skip if keyword is in the ignore list
    next if (defined $ignore_keywords{$key});
    # replace dot "." with slash "/" - that's the way they are stored in the prekeys list
    my $keyS = $key;
    $keyS =~ s|\.|\/|g;
    # check if this is a new key (not in @prekeys list)
    if (!isInList($keyS, \@prekeys)) { 
      # add new keyword to list
      push @new_keywords, $key;
    }
  }
  return @new_keywords;
}
  
##############################################################
# add_new_keywords - add new keywords to my keyword catalog (e.g. nature.animal.dog)
##############################################################
sub add_new_keywords {

  my $new_keys_ref = shift;

  foreach my $key (@{$new_keys_ref}) {
    my $new_key = '';
    # add hierarchical (joined) keywords e.g. nature.animal.dog as nature, nature.dog and nature.animal.dog
    foreach (split /\./, $key) {
      $new_key .= $_;
      push @prekeys, $new_key unless (isInList($new_key, \@prekeys));
      $new_key .= '/';
    }
    # remove from global hash
    delete $new_keywords{$key};
  }
  
   # show in keyword window (if open)
  if (Exists($keyw)) {
	insertTreeList($keyw->{tree}, @prekeys);
  }
}

##############################################################
# deletePics - deletes selected pictures
#              mode: trash|rm
#                    trash = move to $trashdir
#                    rm    = remove
##############################################################
sub deletePics {
  my $lb   = shift; # the reference to the active listbox widget
  my $mode = shift; # constant TRASH or REMOVE

  my @sellist = $lb->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);
  my @childs = $lb->info('children');
  my $all = 0; $all = 1 if (@childs == @sellist); # all pics are selected

  my ($pic, $dpic, $thumb, $rc, $bakpic, $bakthumb, $njpic, $size, $str);
  my @dummylist     = ();
  my $changed       = 0;
  my $update        = 0;
  my $lastOne;

  # build the show and the delete list
  foreach $dpic (@sellist) {
	$pic     = basename($dpic);
	$size    = getFileSize($dpic, FORMAT);
	$str    .= sprintf "%-40s %10s\n", $pic, $size;
	# after deletion we select the one after the last one deleted
	$lastOne = $dpic;
  }
  my $reselectPic = $lb->info('next', $lastOne);

  if ($mode == REMOVE) {  # remove mode
	$rc = myButtonDialog("Really delete?",
						 "Please press Ok to delete these ".scalar @sellist." files.\nThere is no undelete!\n\nPath: $actdir\n\n$str",
						 undef,
						 'OK', 'Cancel');
	return unless ($rc eq 'OK');
  }
  elsif ($mode == TRASH) { # remove to trash mode
	# check if the trash dir is available
	if (!-d $trashdir) {
	  $lb->messageBox(-icon => 'warning',
					  -message => "Trashdir $trashdir not found!\nPlease create this dir (shell: mkdir $trashdir) and retry.\n\nAborting.",
					  -title => "Delete pictures", -type => 'OK');
	  return;
	}
	# check if we are in the trash dir
	if ($actdir eq $trashdir) {
	  $lb->messageBox(-icon => 'warning', -message => "Please use <Shift-Delete> to really remove files from the trash!",
					  -title => "Delete pictures", -type => 'OK');
	  return;
	}
	makeDir("$trashdir/$thumbdirname", NO_ASK);
  }
  else {
	warn "deletePics called without or with a wrong mode ($mode). Aborting";
	return;
  }

  my $errors = "";
  my $i      = 0;
  my $pw     = progressWinInit($lb, "Delete pictures");
  foreach $dpic (@sellist) {
	last if progressWinCheck($pw);
	$i++;
	$pic      = basename($dpic);
	$bakpic   = $dpic;
	$bakpic   =~ s/(.*)(\.jp(g|eg))/$1-bak$2/i;
	$thumb    = getThumbFileName($dpic);
	$bakthumb = $thumb;
	$bakthumb =~ s/(.*)(\.jp(g|eg))/$1-bak$2/i;

	progressWinUpdate($pw, "deleting ($i/".scalar @sellist.") ...", $i, scalar @sellist);

	if ($mode == REMOVE) {
	  if ( removeFile($dpic) ) {
		$changed++;
		#delete $searchDB{$dpic}; # line is moved to removeFile()
		deleteCachedPics($dpic);
		delete_XMP_file($dpic);
		$lb->delete('entry', $dpic) unless $all;
	  }
	} else { # $mode == TRASH - move picture to trash
	  if (move ($dpic, $trashdir)) {
		$changed++; # count nr of successfull moves
		my $tpic         = "$trashdir/$pic";
        # change the location info in the search database
		$searchDB{$tpic} = $searchDB{$dpic};
		$searchDB{$tpic}{odir} = dirname($dpic);
        delete $searchDB{$dpic};
		deleteCachedPics($dpic);
		$lb->delete('entry', $dpic) unless $all;
		# only if move was successfull, we also move the thumbnail
		if ((-d "$trashdir/$thumbdirname") and (-f $thumb)) {
		  if (!move ("$thumb", "$trashdir/$thumbdirname")) {
			$errors .= "Could not move thumbnail \"$thumb\" to $trashdir/$thumbdirname: $!\n";
		  }
		}
		do_other_files(MOVE, $dpic, $tpic, \$errors);
	  } else {
		$errors .= "Could not move picture \"$pic\" to $trashdir: $!\n";
	  }
	}

	# if file is removed and a backup file exists and is not in the delete list,
	# we offer to rename the backup to the original name
	# todo this should be done in one dialog for all files at the end
	if ((!-f $dpic) and (-f $bakpic) and !isInList($bakpic, \@sellist)) {
	  my $age = getAgeOfFile($bakpic);
	  $age = " (which is $age old)" unless ($age eq "");
	  my $bakname = basename($bakpic);
	  $rc = myButtonDialog('Restore backup?',
						   "Picture \"$pic\" has a backup file$age.\nShould I rename the backup \"$bakname\" to \"$pic\"?",
						   $bakthumb,
						   'Rename', 'Cancel', 'Cancel all');
	  last if ($rc eq 'Cancel all');
	  if ($rc eq 'Rename') {
		if (!rename ("$bakpic", "$dpic")) {
		  $errors .= "Could not rename $bakpic to $pic: $!\n";
		}
		else {
		  $searchDB{$dpic} = $searchDB{$bakpic};
		  delete $searchDB{$bakpic};
		  # rename thumbnail
		  rename ("$bakthumb", "$thumb");
		  if ($lb->info("exists", $bakpic)) {
			unless (hlistEntryRename($lb, $bakpic, $dpic)) { warn "error renaming hlist entry $bakpic to $dpic"; }
		  }
		  # if the backup is already visible we don't need an update
		  if ($lb->info("exists", $dpic)) {
			# change the displayed name
 			$lb->itemConfigure($dpic, $lb->{thumbcol}, -text => getThumbCaption($pic));
			$lb->itemConfigure($dpic, $lb->{filecol},  -text => getAllFileInfo($dpic));
		  }
		  else {
			$update++;
		  }
		}
	  }
	}

	if (!-f $dpic) {
	  # ask to delete non-JPEG file, if any
	  foreach my $suf (split /\|/, $nonJPEGsuffixes) {
		$njpic = $dpic;
		$njpic =~ s/(.*)\.jp(g|eg)$/$1.$suf/i;
		if (-f $njpic) {
		  $rc = $lb->messageBox(-icon => 'question', -message => "There is a non-JPEG file\n\"".basename($njpic)."\"\nOk to delete it too?",
								 -title => "Delete non-JPEG?", -type => 'OKCancel');
		  last if ($rc !~ m/Ok/i);

		  if ($mode == REMOVE) {
			if ( removeFile($njpic) ) {
			}
		  } elsif ($mode == TRASH) {
			if (!move ("$njpic", "$trashdir")) {
			  $errors .="Could not move \"".basename($njpic)."\" to $trashdir: $!\n";
			}
		  }
		}
	  }
	}
  }								# foreach
  progressWinEnd($pw);
  $userinfo = "deleted $changed of ".scalar @sellist." pictures"; $userInfoL->update;

  if ($errors ne "") {
	$errors = "These errors occured while deleting the ".scalar @sellist." selected pictures:\n$errors";
	showText("Error while deleting", $errors, NO_WAIT);
  }

  checkTrash() if ($changed > 0);

  $update++ if $all;

  if ($update > 0) {
	if ($lb == $picLB) {
	  updateThumbs();
	}
	else {
	  $lb->delete("all");
	}
  }

  unless ($reselectPic) {
	my @childs = $lb->info('children');
	$reselectPic = $childs[-1];
  }

  if ($lb->info("exists", $reselectPic)) {
	if (($lb == $picLB) and $config{ShowNextPicAfterDel}) {
	  showPic($reselectPic);
	}
	else { # just select it
	  $actpic = $reselectPic if ($lb == $picLB);
	  selectThumb($lb, $reselectPic);
	}
  }
  $lb->focus;
}

##############################################################
# getAgeOfFile - returns a string representing the age of the
#                given file (with max two of the units:
#                day, hour, minute, second)
##############################################################
sub getAgeOfFile {
  my $file = shift;
  return "" unless (-f $file);

  my $diff = abs(time() - (lstat $file)[9]);
  my @secs = qw/86400 3600  60/;
  my @unit = qw/days  hours minutes/;
  my $str = "";
  my $t;
  my $count = 0;
  for $t ( 0 .. $#secs) {
	my $i = int($diff/$secs[$t]);
	if ($i > 0) {
	  $str  = "$str $i $unit[$t]";
	  $count++;
	  last if ($count >= 2);  # two numbers are enough
	}
	$diff  %= $secs[$t];
  }
  $str = "$str $diff seconds" if ($count < 2);

  return "$str";
}

##############################################################
# findValidIndex - try to find a index to show e.g. after a
#                  delete
##############################################################
sub findValidIndex {

  my $lb   = shift;
  my $i    = shift; # startindex

  my @pics = $lb->info('children');

  if ((defined $i) and ($i > $#pics)) {
	$i = $#pics;
  }

  # if possible show the pic following the last deleted one
  while ((!$lb->info("exists", $i)) and ($i < $#pics)) {
	$i++;
  }

  if ($i > $#pics) { $i = 0; }

  return $i;
}

sub centerWindow {
####################################################
# Args: (0) window to center
#	(1) [optional] desired width
#	(2) [optional] desired height
#
# Returns: *nothing*
####################################################
    my($window, $width, $height) = @_;

    $window->idletasks;
    $width  = $window->reqwidth  unless $width;
    $height = $window->reqheight unless $height;
    my $x = int(($window->screenwidth  / 2) - ($width  / 2));
    my $y = int(($window->screenheight / 2) - ($height / 2));
    $window->geometry($width . 'x' . $height . "+" . $x . "+" . $y);
}

##############################################################
# repositionWindow - reposition window to fit in the desktop
##############################################################
sub repositionWindow {

  my $win        = shift;
  my $xoffset    = shift; # optional x offset (1 or 0) reposition window by half the width
  my $border     = 40;
  my $reposition = 0;
  my $geo        = $win->geometry;
  my ($w, $h, $x, $y) = splitGeometry($geo);
  print "geo $w $h $x $y\n" if $verbose;

  $h = $win->screenheight if ($h > $win->screenheight);
  $w = $win->screenwidth  if ($w > $win->screenwidth);

  if ( ($y+$h+$border) > $win->screenheight) {
	$y = $y - ( ($y+$h+$border) - $win->screenheight );
	$reposition = 1;
  }

  if ( ($x+$w+$border) > $win->screenwidth) {
	$x = $x - ( ($x+$w+$border) - $win->screenwidth );
	$reposition = 1;
  }

  if ($x < 0) {
	$x = 0;
	$reposition = 1;
  }

  if ($y < 0) {
	$y = 0;
	$reposition = 1;
  }

  if ($xoffset) {
	if ($x > 400) {
	  $x -= int($w/2+10);
	}
	else {
	  $x += int($w/2+10);
	}
	$reposition = 1;
  }

  if ($reposition) {
	print "reposing to $w $h $x $y\n" if $verbose;
	$win->geometry($w . 'x' . $h . "+" . $x . "+" . $y);
	$win->update;
  }

}

##############################################################
# printlist
##############################################################
sub printlist {
  print "---\n";
  foreach (@_) {print "$_\n";}
  print "---\n";
}

##############################################################
# printhash
##############################################################
sub printhash {
  my $hash = shift;
  foreach (sort keys %{$hash}) {
	print "$$hash->{$_} = $_ \n";
  }
}

##############################################################
# bindItem - binds the motion event to the picture
##############################################################
sub bindItem {

  my $id = shift;

  $c->bind($id, '<Button-1>'  => sub {
			 ($idx,$idy)=($Tk::event->x,$Tk::event->y);
		   });
  # change the mouse pointer
  $c->bind($id, '<ButtonRelease-1>'  => sub {
             # Color picker
  		     # get mouse coordinates
		     my $x = $c->canvasx($Tk::event->x);
		     my $y = $c->canvasy($Tk::event->y);
		     # get and apply offset (because pic may be centered in canvas)
		     my ($x1, $y1, $x2, $y2) = $c->bbox($id);
		     $x -= $x1;
		     $y -= $y1;
             $x = 1 if ($x < 1);
             $y = 1 if ($y < 1);
             $x = $x2-$x1-2 if ($x > $x2-$x1-2);
             $y = $y2-$y1-2 if ($y > $y2-$y1-2);
             # get the color information from the picture
             my($r,$g,$b) = $c->itemcget($id, -image)->get($x, $y);
             #convert to hex from decimal
             $config{ColorPicker} = sprintf "#%.2x%.2x%.2x", $r, $g, $b;
             $userinfo = "Color picker: $config{ColorPicker}";
             $colorPickerInfo->configure(-background => $config{ColorPicker});
             $userInfoL->update;
 			 $c->configure(-cursor => "crosshair");
 		   });
  $c->bind($id, '<Enter>'  => sub {
 			 $c->configure(-cursor => "crosshair");
 		   });
  $c->bind($id, '<Leave>'  => sub {
 			 $c->configure(-cursor => "top_left_arrow");
 		   });
  # enable panning in the canvas (autoscroll)
  $c->bind($id, '<B1-Motion>' => sub {
			 # actual mouse coordinates
 			 $c->configure(-cursor => "fleur");
			 my ($mx,$my)=($Tk::event->x,$Tk::event->y);
			 my ($x1,$x2) = $c->xview;
			 my ($y1,$y2) = $c->yview;
			 return if ($x1 == 0 and $x2 == 1 and $y1 == 0 and $y2 == 1);
			 my $dx = 0; $dx = ($mx-$idx)/$width  if ($width  >= 1); # avoid division by zero
			 my $dy = 0; $dy = ($my-$idy)/$height if ($height >= 1); # avoid division by zero
			 $c->xviewMoveto($x1-$dx) unless ($x1 == 0 and $x2 == 1);
			 $c->yviewMoveto($y1-$dy) unless ($y1 == 0 and $y2 == 1);
			 ($idx,$idy)=($mx,$my);
		   });
  # show picture coordinates
  $c->bind($id, '<Motion>'  => sub {
	     return unless $config{ShowCoordinates};
		 my $zf = 1;
		 # get mouse coordinates
		 my $x = $c->canvasx($Tk::event->x);
		 my $y = $c->canvasy($Tk::event->y);
		 # get the actual zoom factor from the global variable $zoomFactorStr
		 if ($zoomFactorStr =~ m/(.*)%$/) {      # cut off the % sign
		   return if ($1 eq "?");
		   $zf = $1;                             # get the zoom factor in % (e.g. 80%)
		   $zf /= 100;                           # the zoom factor as float (e.g. 0.8)
		 } else {
		   warn "zoomStep: zoomFactorStr not matching *% -  returning!" if $verbose;
		   return;
		 }
		 return if ($zf <= 0);
		 # get and apply offset (because pic may be centered in canvas)
		 my ($x1, $y1, $x2, $y2) = $c->bbox($id);
		 $x -= $x1;
		 $y -= $y1;
		 # apply zoom factor
		 $x  = int($x/$zf);
		 $y  = int($y/$zf);
		 # set borders
		 $x  = 0 if ($x < 0);
		 $y  = 0 if ($y < 0);
		 $x  = $width  if ($x > $width);
		 $y  = $height if ($y > $height);

		 $userinfo = "mouse coordinates: $x, $y"; $userInfoL->update;
	   });
}

##############################################################
# changeDir
##############################################################
sub changeDir {
	my $newDir = shift;
	return 0 unless defined $newDir;
	if ( !chdir $newDir ) {
		my $dialog = $top->Dialog(-title => "Changing to $newDir folder failed",
								  -text => "Can't change to $newDir folder: $!",
								  -buttons => ['OK']);
		$dialog->Show();
		warn "Can't change to $newDir folder: $!";
		return 0;
	}
	return 1;
}

##############################################################
# getCorners - get the visible corners of an canvas
##############################################################
sub getCorners {
    my $c              = shift;
    my(@xview)         = $c->xview;
    my(@yview)         = $c->yview;
    my(@scrollregion)  = @{$c->cget(-scrollregion)};
    ($xview[0] * ($scrollregion[2]-$scrollregion[0]) + $scrollregion[0],
     $yview[0] * ($scrollregion[3]-$scrollregion[1]) + $scrollregion[1],
     $xview[1] * ($scrollregion[2]-$scrollregion[0]) + $scrollregion[0],
     $yview[1] * ($scrollregion[3]-$scrollregion[1]) + $scrollregion[1],
    );
}
##############################################################
# autozoom - zooms the given picture to fit into the available size
##############################################################
sub autoZoom {

  if (!$config{AutoZoom}) {
	#$zoomFactor    = 1;
	return "100%";
  }

  my $photo     = shift;		# reference to a photo object
  my $dpic      = shift;		# the file including dir (e.g. /home/herrmann/Bild.jpg)
  my $cw        = shift;		# the available width
  my $ch        = shift;		# the available height
  my ($pw, $ph) = getSize($dpic);
  my ($wf, $hf, $zoom, $subsample, $max, $i);

  return "" if (!$$photo);
  return "" if (!-f $dpic);
  return "" if (!defined($cw));
  return "" if (!defined($ch));

  print "autoZoom: place: $cw/$ch pic:$pw/$ph\n" if $verbose;

  $wf = $pw/($cw - 6); # the offset (6) is needed, maybe because of the border?
  $hf = $ph/($ch - 6);
  $max = max($wf, $hf); # find the biggest zoom factor

  #print "width factor = $wf h fac = $hf max = $max\n";
  return "100%" if ($max <= 1);

  # search for a zoom/subsample pair which will zoom the pic at least to the needed factor 1/$max
  for ($i = 0; $i < (@frac - 2); $i += 2) {
	if (($frac[$i]/$frac[$i+1]) < (1/$max)) {
	  last;
	}
  }
  $zoom      = $frac[$i];
  $subsample = $frac[$i+1];

  # show the user what's going on ...
  my $zoomFactor = $subsample/$zoom;
  $zoomFactor    = int(1/$zoomFactor * 100)."%";
  $userinfo = "zooming to $zoomFactor ..."; $userInfoL->update;

  return "100%" if ($zoom == $subsample);

  # open new photo object
  my $zoomed =  $top->Photo;
  $zoomed->blank;
  $zoomed->copy($$photo, -zoom => $zoom);           # first zoom it
  $$photo->delete;
  $$photo = undef;
  $$photo = $top->Photo;
  #$$photo->blank;
  $$photo->copy($zoomed, -subsample => $subsample); # then subsample it
  $$photo->configure(-gamma => $config{Gamma});
  $zoomed->delete;
  $zoomed = undef;

  print "autoZoom: $zoomFactor\n" if $verbose;
  return $zoomFactor;
}

##############################################################
# getZoomAndSub - build a appropriate fraction for zoom and
#                 subsample from a zoomfactor (float)
##############################################################
sub getZoomAndSub {
  my $targetfactor = shift; # the target zoom factor e.g. 0.66
  my $step         = shift; # -1 = stay beyond $targetfactor; +1 = return a bigger value than $targetfactor

  my $i = 0;
  my $dif     = 1000;     # difference to the targetfactor
  my $diflast = $dif + 1; # last difference

  # search the @frac array for the right fraction
  for ($i = 0; $i < (@frac - 2); $i += 2) {
	$dif = abs(($frac[$i]/$frac[$i+1]) - $targetfactor); # how far are we away?
	#$dif *= -1 if ($dif < 0);                       # the difference must allways be positive
	#printf " up %1.3f %2d %1.3f %2d/%-2d %1.3f\n", $targetfactor, $i, ($frac[$i]/$frac[$i+1]), $frac[$i], $frac[$i+1], $dif;
	last if ( $dif > $diflast);                     # if the difference starts to grow we jump out
	$diflast = $dif;
  }
  $i -= 2;       # the last fraction had the lowest difference to the targetfactor
  $i -= $step*2; # go to the next or previous fraction

  # boundary checks (stay in the array)
  $i = 0 if ($i < 0);
  $i = @frac - 1 if ($i > @frac - 1);

  return ($frac[$i], $frac[$i+1]);
}

##############################################################
# max - returns the biggest number in a list
##############################################################
sub max {
  my $max = shift;
  for(@_) {
	$max = $_ if $max < $_;
  }
  return $max;
}

##############################################################
# zoomStep - increase/decrease the actual zoom factor
##############################################################
sub zoomStep {
  my $step = shift;  # +1 or -1

  my $zoom      = 1; # fallback value
  my $subsample = 5; # fallback value

  # get the actual zoom factor from the global variable $zoomFactorStr
  if ($zoomFactorStr =~ m/(.*)%$/) {      # cut off the % sign
	print "matching *% $1\n" if $verbose;
	my $zf = $1;                          # get the zoom factor in %
	$zf /= 100;                           # the zoom factor as float
	# find the next / previous zoom level
	($zoom, $subsample) = getZoomAndSub($zf, $step);
	print "z = $zoom s = $subsample for $zf\n" if $verbose;
  } else {
	warn "zoomStep: zoomFactorStr not matching *% -  returning!" if $verbose;
	return;
  }

  # zoom the picture
  zoom ($zoom, $subsample);
}

##############################################################
# zoom - zooms the actual displayed picture to the given
#        zoom and subsample values
##############################################################
sub zoom {
  my ($zoom, $subsample) = @_;
  print "zoom: $zoom $subsample\n" if $verbose;

  my $dpic = $actpic;

  # zoom the actual picture
  return unless (defined $photos{$dpic});

  $top->Busy;

  $userinfo = "zooming to ".int($zoom/$subsample*100)."% ..."; $userInfoL->update();

  $photos{$dpic}->delete;
  delete $photos{$dpic};
  print "reloading $actpic\n" if $verbose;
  $photos{$dpic} = $top->Photo(-file => $dpic, -gamma => $config{Gamma});

  my $zoomed = $top->Photo;
  $zoomed->blank;
  $zoomed->copy($photos{$dpic}, -zoom => $zoom);

  # delete item from canvas
  $c->delete('withtag', $dpic);   # remove it from the canvas
  #deleteCachedPics($dpic);

  #$photos{$dpic} = undef;
  #$photos{$dpic} = $top->Photo;
  $photos{$dpic}->blank if $photos{$dpic};
  $photos{$dpic}->copy($zoomed, -subsample => $subsample);
  $photos{$dpic}->configure(-gamma => $config{Gamma});
  $zoomed->delete;
  $zoomed = undef;

  # center pic in canvas, only when it's smaller
  my $xoffset = 0; my $yoffset = 0;
  $xoffset = int(($c->width  - $photos{$dpic}->width) /2) if ($c->width  > $photos{$dpic}->width);
  $yoffset = int(($c->height - $photos{$dpic}->height)/2) if ($c->height > $photos{$dpic}->height);
  # insert pic to the canvas
  my $id = $c->createImage($xoffset, $yoffset, -image => $photos{$dpic}, -anchor => "nw", -tag => ["pic","$dpic"], -state => "hidden");
  bindItem($id);
  addToCachedPics($dpic);
  $top->Unbusy;
  showPic($dpic);
}

##############################################################
# makeButton
##############################################################
sub makeButton {

	my $parentWidget = shift;
	my $position     = shift;
	my $text         = shift;
	my $picName      = shift;
	my $func         = shift;

	my $pic   = "/usr/local/share/mapivi/$picName";
	my $image = $parentWidget->Photo(-file => $pic) if -f $pic;

	if ($image) {
		return $parentWidget->Button(-image => $image,
									 -borderwidth => 0,
									 -command => sub {
										 eval "$func";
									 }
									 )->pack(-side => $position,
											 -padx => 0,
											 -pady => 0);
	}
	else {
		return $parentWidget->Button(-text    => $text,
									 -command => sub {
										 eval "$func";
									 }
									 )->pack(-side => $position,
											 -padx => 0,
											 -pady => 0);
	}
}

##############################################################
# layout - an sub, to change the layout of mapivi
##############################################################
sub layout {

  my $withAdjuster = shift;

  saveAdjusterPos() if $withAdjuster;

  $config{Layout} = 0 if (($config{Layout} > 5) or ($config{Layout} < 0));
  my $info = "";

  if ($config{Layout} == 0) {
	$info = "folders|thumbnails|picture";
	$config{ShowDirTree}    = 1;
	$config{ShowThumbFrame} = 1;
	$config{ShowPicFrame}   = 1;
  }
  elsif ($config{Layout} == 1) {
	$info = "folders|thumbnails";
	$config{ShowDirTree}    = 1;
	$config{ShowThumbFrame} = 1;
	$config{ShowPicFrame}   = 0;
  }
  elsif ($config{Layout} == 2) {
	$info = "thumbnails";
	$config{ShowDirTree}    = 0;
	$config{ShowThumbFrame} = 1;
	$config{ShowPicFrame}   = 0;
  }
  elsif ($config{Layout} == 3) {
	$info = "thumbnails|picture";
	$config{ShowDirTree}    = 0;
	$config{ShowThumbFrame} = 1;
	$config{ShowPicFrame}   = 1;
  }
  elsif ($config{Layout} == 4) {
	$info = "picture";
	$config{ShowDirTree}    = 0;
	$config{ShowThumbFrame} = 0;
	$config{ShowPicFrame}   = 1;
  }
  elsif ($config{Layout} == 5) {
	$info = "folders|picture";
	$config{ShowDirTree}    = 1;
	$config{ShowThumbFrame} = 0;
	$config{ShowPicFrame}   = 1;
  }
  else {
	warn "error: toggle = ".$config{Layout}.", this should never happen!";
	$config{Layout} = 0;
	return;
  }

  if ($info ne "") { $userinfo = "layout $info"; $userInfoL->update; }

  showHideFrames();

  $top->update;
  setAdjusterPos() if $withAdjuster;
  $layoutOld = $config{Layout};  # save the actual Layout
}

##############################################################
# setAdjusterPos - set the position of the Adjusters according
#                  to the global hash values
##############################################################
sub setAdjusterPos {

	my $x         = $subF->width;   # width of the surrounding frame
	my $dirS      = $dirA->slave;
	my $thuS      = $thumbA->slave;
	my $min       = 40;             # min distance for safety
	my $dirXnew   = $min;           # width of adjuser $dirA
	my $thumbXnew = $min;           # width of adjuser $thumbA

	$x = $top->width if ($x == 1); # $x = 1 at startup, so we use the window width

	if    ($config{Layout} == 0) { # dirs thumbs picture
		$dirXnew   = int($config{Layout0dirX}*$x/100);
		$thumbXnew = int($config{Layout0thumbX}*$x/100);
	}
	elsif ($config{Layout} == 1) { # dirs thumbs
		$dirXnew   = int($config{Layout1dirX}*$x/100);
		$thumbXnew = int($x - $dirXnew);
	}
	elsif ($config{Layout} == 2) { }
	elsif ($config{Layout} == 3) { # thumbs picture
		$thumbXnew = int($config{Layout3thumbX}*$x/100);
	}
	elsif ($config{Layout} == 4) { }
	elsif ($config{Layout} == 5) { # dirs picture
		$dirXnew = int($config{Layout5dirX}*$x/100);
	}
	else {
		warn "error: toggle = ".$config{Layout}.", this should never happen!";
		$dirXnew = 1, $thumbXnew = 1; $config{Layout} = 0;
		return;
	}

	print "layoutNew=".$config{Layout}." dirXnew=$dirXnew (".int($dirXnew/$x*100)."%) thumbXnew=$thumbXnew (".int($thumbXnew/$x*100)."%) x=$x dir=".$config{ShowDirTree}." thumb=".$config{ShowThumbFrame}." pic=".$config{ShowPicFrame}."\n" if $verbose;

	$dirS->configure(-width => $dirXnew)   if ($dirS->ismapped());
	#print "[dirS]" if ($dirS->ismapped());
	$thuS->configure(-width => $thumbXnew) if ($thuS->ismapped());
	#print "[thuS]" if ($thuS->ismapped());print "\n";
	$top->update;
}

##############################################################
# saveAdjusterPos - save the actual position of the Adjusters
#                   to the global hash
##############################################################
sub saveAdjusterPos {

	my $x         = $subF->width;   # width of the surrounding frame
	my $dirS      = $dirA->slave;
	my $thuS      = $thumbA->slave;

	return if ($x < 1);

	my $dirX      = 0;
	my $thumbX    = 0;

	if ($dirS->ismapped()) {
		# get the actual width of the dir frame
		$dirX = $dirS->width;
		# convert it to a percentual value
		$dirX = $dirX / $x * 100;
		# not too small not to wide (between 5% and 95%)
		$dirX = 95 if ($dirX > 95);
		$dirX = 5  if ($dirX < 5);
	}
	if ($thuS->ismapped()) {
		# get the actual width of the thumb frame
		$thumbX = $thuS->width;
		# convert it to a percentual value
		$thumbX = $thumbX / $x * 100;
		# not too small not to wide (between 5% and 95%)
		$thumbX = 95 if ($thumbX > 95);
		$thumbX = 5  if ($thumbX < 5);
	}

	if ($layoutOld == 0) {
		$config{Layout0dirX}   = $dirX   if ($dirS->ismapped());
		$config{Layout0thumbX} = $thumbX if ($thuS->ismapped());
	}
	elsif ($layoutOld == 1) {
		$config{Layout1dirX}   = $dirX   if ($dirS->ismapped());
	}
	elsif ($layoutOld == 3) {
		$config{Layout3thumbX} = $thumbX if ($thuS->ismapped());
	}
	elsif ($layoutOld == 5) {
		$config{Layout5dirX}   = $dirX   if ($dirS->ismapped());
	}

	print "layoutOld=$layoutOld dirX=$dirX% thumbX=$thumbX% x=$x\n" if $verbose;
}

##############################################################
# readConfig - read the configuration from file to hash
##############################################################
sub readConfig {

  my $rcfile = shift;
  my $configRef = shift;

  print "readConfig: reading $rcfile\n" if $verbose;

  if (!$rcfile) {
	warn "readConfig: no file!";   return;
  }
  if (ref($configRef) ne 'HASH') {
	warn "readConfig: $configRef is no hash ref!"; return;
  }

  return 0 if (!-f $rcfile);

  my $file;
  if (!open($file, "<$rcfile")) {
	warn "readConfig: Couldn't open $rcfile: $!";
	return 0;
  }

  my $errors = 0;
  while (<$file>) {
	chomp;						# no newline
	s/^#.*//;               	# no comments (lines starting with #)
	s/^\s+//;					# no leading white
	s/\s+$//;					# no trailing white
	next unless length;			# anything left?
	my ($key, $value) = split(/\s*=\s*/, $_, 2);	# split around the equal sign
	$value =~ s/<br>/\n/g;      # replace "<br>" by newline

	if (!defined $configRef->{$key}) {
	  warn "readConfig: key $key (value: $value) should not belong to the config hash - removing\n" ;
	  $errors++;
	  next;
	}
	# save in global config hash, overwrite default value
	$configRef->{$key} = $value;
  }

  close $file;

  if (($errors > 0) and (-d $trashdir))  {
	my $datetime = getDateTime();
	# save a copy of the old config in the trash # todo: remove very old backups
	warn "saving a backup of the config in the trash ($trashdir)\n";
	mycopy($rcfile, $trashdir."/".basename($rcfile)."-$datetime", OVERWRITE);
  }

  return 1;
}

##############################################################
# saveConfig - save the configuration from hash to file
##############################################################
sub saveConfig {

  my $rcfile = shift;
  my $config = shift;
  my $value;

  print "saveConfig: writing $rcfile\n" if $verbose;

  my $file;
  if (!open($file, ">$rcfile")) {
	warn "saveConfig: Couldn't open $rcfile: $!";
	return 0;
  }

  print $file "\n# Configuration file for mapivi $version\n\n";
  print $file "# last update: ", scalar localtime, "\n\n";
  print $file "# This file will be overwritten each time you quit mapivi\n";
  #print $file "# or call the \"Save config\" menu item.\n\n";
  foreach (sort keys %{$config}) {
	$value = $$config{$_};
	$value =~ s/\n/<br>/g; # replace newline by "<br>"
	print $file $_," = ", $value,"\n";
  }

  close $file;
  return 1;
}

##############################################################
# readArrayFromFile - read an array from a file
##############################################################
sub readArrayFromFile {

  my $file = shift;
  my @list;

  if (!$file) {
	warn "readArrayFromFile: no file!";   return;
  }

  return () if (!-f $file);

  my $fileH;
  if (!open($fileH, "<$file")) {
	warn "readArrayFromFile:: Couldn't open $file: $!";
	return ();
  }

  while (<$fileH>) {
	chomp;						# no newline
	s/^#.*//;               	# no comments (lines starting with #)
	s/^\s+//;					# no leading white
	s/\s+$//;					# no trailing white
	next unless length;			# anything left?
	push @list, $_;
  }

  close $fileH;

  return @list;
}

##############################################################
# saveArrayToFile - save a array to a file
##############################################################
sub saveArrayToFile {

  my $file    = shift;
  my $listref = shift;
  my $value;

  my $fileH;
  if (!open($fileH, ">$file")) {
	warn "saveArrayToFile: Couldn't open $file: $!";
	return 0;
  }

  foreach (@$listref) {
	print $fileH "$_\n";
  }

  close $fileH;
  return 1;
}

##############################################################
# showPicInOwnWin - displays a picture in a separate window
#                   a mouse click on the picture will close
#                   the window
##############################################################
sub showPicInOwnWin {

  my $dpic = shift;
  #if ((!defined $dpic) or ($dpic eq "") or (!-f $dpic)) {
    # no picture given, take selection from main window
   # my @sellist = $picLB->info('selection');
	#return unless checkSelection($top, 1, 0, \@sellist);
    #$dpic = $sellist[0]; # simply take the first if there are more selected
	#$lb = $picLB;
  #}
  return unless -f $dpic;
  my @list;
  push @list, $dpic;
  show_multiple_pics(\@list, 0);
}

##############################################################
# show_multiple_pics - displays several  pictures in a separate window
#                   a mouse click on the picture will close
#                   the window
##############################################################
sub show_multiple_pics($$) {

  my $pic_list  = shift;  # reference to a picture list, each with full path
  my $index     = shift;  # start index number, first pic is index = 0

  unless (defined $pic_list) { warn "pic list undef"; return; }
  unless (ref($pic_list) eq 'ARRAY') {warn "pic list is no array reference"; return; }
  unless (@{$pic_list} >= 1) {warn "pic list is empty"; return; }

  my $fullscreen = 0;
  my $balloon_addon = "\n\n(Click on picture to close window; use PgUp and PgDown for next/previous picture)";

  my $dpic = @{$pic_list}[$index];
  my $pic  = basename($dpic);
  my ($photo, $zoomFactor);
  
  my $rc = load_zoom_pic($dpic, \$photo, \$zoomFactor);
  return unless ($rc);
  
  # open window
  my $win = $top->Toplevel(-bg => 'black');
  my $total_pics = scalar @{$pic_list};
  $win->title(sprintf "(%d/%d) %s %s", ($index+1), $total_pics, $pic, $zoomFactor);
  $win->iconname($pic);
  # use the picture thumbnail as window icon
  my $iconfile  = getThumbFileName($dpic);
  my $iconPhoto = $win->Photo(-file => $iconfile) if (-f $iconfile);
  $win->idletasks if $EvilOS; # this line is crucial (at least on windows)
  $win->iconimage($iconPhoto) if $iconPhoto;

  my $but = $win->Button(-image   => $photo,
						 -border  => 0,
						 -relief  => 'flat',
						 -command => sub {
							 $win->grabRelease();
							 $win->withdraw();
							 $photo->delete;
							 $iconPhoto->delete if $iconPhoto;
							 $win->destroy();
						 },)->pack(-anchor => "center", -expand => 1, -padx => 0, -pady => 0);

  my $balloonmsg = makeBalloonMsg($dpic).$balloon_addon;
  if ($config{PicWinBalloon}) {
    $balloon->attach($but, -balloonposition => "mouse", -msg => \$balloonmsg);
  }

  # the context menu
  my $menu = $win->Menu(-title => "Menu");
  $menu->checkbutton(-label => "Balloon popup info",
                     -variable => \$config{PicWinBalloon},
					 -command => sub {
					 if ($config{PicWinBalloon}) {
					   $balloon->attach($but, -balloonposition => "mouse", -msg => \$balloonmsg);
					 } else {
					   $balloon->detach($but);
					 }
					 });
  #$menu->command(-label => "next picture", -command => sub { print "use PageDown instead\n"; }); # todo
  #$menu->command(-label => "previous picture", -command => sub { print "use PageUp instead\n"; }); # todo
  $menu->command(-label => "close window", -command => sub { $but->invoke; });
  # mouse and button bindings
  $win->bind('<ButtonPress-3>',   sub {
				 $menu->Popup(-popover => "cursor", -popanchor => "nw");
			   } );

  $win->bind('<Key-q>',      sub { $but->invoke; });
  $win->bind('<Key-Escape>', sub { $but->invoke; });
  # invoke $but when the window is closed by the window manager (x-button)
  $win->protocol("WM_DELETE_WINDOW" => sub { $but->invoke; });

  $win->bind('<Key-Next>', sub {
    return if ($total_pics <= 1);  
	$but->Busy; # we can't use $win here else the cursor won't change
	$index++;
	$index = 0 if ($index > $#{@{$pic_list}});
    $dpic = @$pic_list[$index];
    $pic  = basename($dpic);
    $win->title(sprintf "(%d/%d) loading %s ...", ($index+1), ($#{@{$pic_list}}+1), $pic);
    my $rc = load_zoom_pic($dpic, \$photo, \$zoomFactor);
    $but->invoke unless ($rc);
    $win->title(sprintf "(%d/%d) %s %s", ($index+1), ($#{@{$pic_list}}+1), $pic, $zoomFactor);
    $win->iconname($pic);
	$but->configure(-image => $photo);
    $balloonmsg = makeBalloonMsg($dpic).$balloon_addon;
	$but->Unbusy;
  });
  
  $win->bind('<Key-Prior>', sub {
    return if ($total_pics <= 1);  
	$but->Busy; # we can't use $win here else the cursor won't change
	$index--;
	$index = $#{@{$pic_list}} if ($index < 0);
    $dpic = @$pic_list[$index];
    $pic  = basename($dpic);
    $win->title(sprintf "(%d/%d) loading %s ...", ($index+1), ($#{@{$pic_list}}+1), $pic);
    my $rc = load_zoom_pic($dpic, \$photo, \$zoomFactor);
    $but->invoke unless ($rc);
    $win->title(sprintf "(%d/%d) %s %s", ($index+1), ($#{@{$pic_list}}+1), $pic, $zoomFactor);
    $win->iconname($pic);
	$but->configure(-image => $photo);
    $balloonmsg = makeBalloonMsg($dpic).$balloon_addon;
	$but->Unbusy;
	});

# key-desc,F11,toggle fullscreen mode when displaying picture in own window
  $win->bind('<Key-F11>', sub
			 {
			   toggle(\$fullscreen);
			   # the fullscreen modus is always without border when the option ToggleBorder is set
			   $config{Overrideredirect} = 0;
			   $config{Overrideredirect} = $fullscreen if $config{ToggleBorder};
			   fullscreen($win, $fullscreen);
			   # the next two lines may hlep if there are focus problems
			   #$win->bind('<Enter>',sub{$win->focusForce;$win->grabGlobal;});
			   #$win->bind('<Leave>',sub{$win->grabRelease});
			 });

  $but->focusForce if (Exists($but));
  $userinfo = "ready!"; $userInfoL->update;
}

##############################################################
# load_zoom_pic - load and zoom a picture
# returns 1 on success and 0 on failure
##############################################################
sub load_zoom_pic {
	my $dpic = shift;
	my $photo = shift; # reference to photo object
	my $zoomFactor = shift; # reference to zoom factor (string)

	if (!-f $dpic) {
	$top->messageBox(-icon => 'warning', -message => "load_zoom_pic: Error no file $dpic",
					 -title => 'Error', -type => 'OK');
	return 0;
  }

  $userinfo = "opening $dpic in new window ..."; $userInfoL->update;
  $$photo = $top->Photo(-file => $dpic, -gamma => $config{Gamma});
  if (!$$photo) {
	$top->messageBox(-icon => 'warning', -message => "load_zoom_pic: Error no photo $dpic!",
					 -title => 'Error', -type => 'OK');
	$userinfo = ""; $userInfoL->update;
	return 0;
  }

  increasePicPopularity($dpic);
  if ($config{trackPopularity}) {
	  updateOneRow($dpic, $picLB); # update popularity (viewed x times) info
	  $picLB->update;
  }

  $$zoomFactor = autoZoom(\$$photo, $dpic, $top->screenwidth, $top->screenheight);
	return 1;
  }

##############################################################
# showThumbList - displays a list of thumbs on a scrollable pane
##############################################################
sub showThumbList {

  my $thumbs = shift; # reference on an array containing pictures
  my $title  = shift; # optinal window title

  unless (@$thumbs) {
	$userinfo = "$title: no pictures"; $userInfoL->update;
	return;
  }

  my $nr = @$thumbs;  # total number

  $userinfo = "displaying $nr thumbs in new window ..."; $userInfoL->update;
  #stopWatchStart();

  # open window
  my $win = $top->Toplevel(-bg => "black");
  $win->withdraw;
  $win->title("$title - $nr pictures");
  # set the icon
  $win->iconname("Pictures");
  $win->iconimage($mapiviicon) if $mapiviicon;

  my $topFrame = $win->Frame()->pack(-fill => 'both');

  my %tphotos;      # local hash to store the thumbnail photo objects

  $topFrame->Button(-text => "Close",
					-command => sub { cleanUpAndClose($win, \%tphotos); })->pack(-side => 'left');

  $win->{label} = "$nr pictures, 0 selected";
  $topFrame->Label(-textvariable => \$win->{label})->pack(-side => 'left');

  my $cols    = 6;
  $cols    = $nr if ($nr < $cols);
  my $maxrows = int($win->screenheight/($config{ThumbSize} + 20));
  # todo for 10 pics there should be 2 rows but the window is not high enough
  my $rows    = int($nr/$cols) + 1;
  $rows    = $maxrows if ($rows > $maxrows);
  print "tiler: nr:$nr col:$cols row:$rows maxrows:$maxrows\n" if $verbose;

  my $tiler = $win->Scrolled("Tiler",
							 -columns    => $cols,
							 -rows       => $rows,
							 -scrollbars => 'oe',
						   )->pack(-fill => 'both', -expand => 1);

  bindMouseWheel($tiler->Subwidget("scrolled"));

  # list of all the window objects of $tiler
  # special values are $a[$i]->{selected} a boolean value 1=selected 0=not selected
  # and $a[$i]->{dpic} the path and the name of the displayed picture
  my @a;

  # the context menu
  my $menu = $win->Menu(-title => "Menu");

  ############# selection menu
  my $sel_menu = $menu->cascade(-label => "select ...");
  $sel_menu->cget(-menu)->configure(-title => "Selection menu");

  ############# select all
  $sel_menu->command(-label => "select all", -command => sub {
				   foreach (@a) { $_->{selected} = 1; }
				   my $sel = 0;
				   foreach (@a) { $sel++ if $_->{selected}; }
				   $win->{label} = "$nr pictures, $sel selected";
				 });

  ############# select none
  $sel_menu->command(-label => "select none", -command => sub {
				   foreach (@a) { $_->{selected} = 0; }
				   my $sel = 0;
				   foreach (@a) { $sel++ if $_->{selected}; }
				   $win->{label} = "$nr pictures, $sel selected";
				 });

  ############# invert selection
  $sel_menu->command(-label => "invert selection", -command => sub {
				   foreach (@a) { toggle(\$_->{selected}); }
				   my $sel = 0;
				   foreach (@a) { $sel++ if $_->{selected}; }
				   $win->{label} = "$nr pictures, $sel selected";
				 });

  ############# list selection
  $sel_menu->command(-label => "list selection", -command => sub {
				   my @sel = ();
				   # get the selection
				   foreach (@a) { push @sel, $_->{dpic} if $_->{selected}; }
				   my $text = scalar @sel." pictures are selected:\n";
				   foreach (@sel) { $text .= "$_\n"; }
				   showText("selected pictures", $text, NO_WAIT);
				 });

  $menu->separator;

  ############# open picture in main window
  $menu->command(-label => "open picture in main window", -accelerator => '<m>', -command => sub {
				   my @sel;
				   # get the selection
				   foreach (@a) { push @sel, $_->{dpic} if $_->{selected}; }
                                   return unless checkSelection($win, 1, 1, \@sel);
				   my $dpic = $sel[0];
				   my $dir  = dirname($dpic);
				   my $pic  =  basename($dpic);
				   if (!-d $dir) {
					 $win->messageBox(-icon => 'warning', -message => "Sorry, but the folder\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.",
									  -title => 'folder not found', -type => 'OK');
					 return;
				   }
				   $top->deiconify;
				   $top->raise;
				   $top->focus;
				   openDirPost($dir) if ($dir ne $actdir);
				   showPic($dpic);
				 });


  ############# add to light table
  $menu->command(-label => "add to light table", -command => sub {
				   my @sel;
				   # get the selection
				   foreach (@a) { push @sel, $_->{dpic} if $_->{selected}; }
				   return unless (@sel);
                   light_table_add(\@sel);
           });

  ############# copy selected
  $menu->command(-label => "copy selected ...", -command => sub {
				   my @sel;
				   # get the selection
				   foreach (@a) { push @sel, $_->{dpic} if $_->{selected}; }
				   return unless (@sel);
				   my $targetdir = getDirDialog("Copy pictures to");
				   return unless (-d $targetdir);

				   makeDir(dirname(getThumbFileName("$targetdir/dummy.jpg")), ASK);

				   my ($pic, $dpic, $tpic, $thumbpic, $thumbtpic, $njpic);
				   my $pw = progressWinInit($win, "copy pictures");
				   my $i  = 0;
				   my $rc = 1;
				   my $n  = 0;					# count successfull copied pictures
				   foreach $dpic (@sel) {
					 last if progressWinCheck($pw);
					 $pic       = basename($dpic);
					 $i++;
					 progressWinUpdate($pw, "copy picture ($i/".scalar @sel.") ...", $i, scalar @sel);
					 $tpic      = "$targetdir/$pic";
					 # if the pic exists, ask if the user wants to overwrite it
					 $rc = overwritePic($tpic, $dpic, (scalar(@sel) - $i + 1)) if ($rc != 2);
					 next if ($rc ==  0);
					 last if ($rc == -1);
					 if (mycopy ("$dpic", "$tpic", OVERWRITE)) {
					   $n++;
					   $thumbpic  = getThumbFileName($dpic);
					   $thumbtpic = getThumbFileName($tpic);
					   if ((-d dirname($thumbtpic)) and (-f $thumbpic)) {
						 mycopy ("$thumbpic","$thumbtpic", OVERWRITE)
					   }
					 }

				   }								# foreach - end
				   progressWinEnd($pw);
				 });

  ############# show infos
  $menu->command(-label => "show picture info", -command => sub {
				   my @sel;
				   foreach (@a) { push @sel, $_->{dpic} if $_->{selected}; }
				   return unless (@sel);
				   return unless askSelection(\@sel, 10, "picture info");
				   foreach my $dpic (@sel) {
					 my $info = makeBalloonMsg($dpic);
					 showText($dpic, $info, NO_WAIT, getThumbFileName($dpic));
				   } });

  ############# delete
  $menu->command(-label => "delete selected pictures to trash", -command => sub {
				   delPicsToTrash($win, \@a, $thumbs, $title, \%tphotos);
				 }, -accelerator => '<Delete>');
  $win->bind('<Key-Delete>',  sub { delPicsToTrash($win, \@a, $thumbs, $title, \%tphotos); } );

  # mouse and button bindings
  $win->bind('<ButtonPress-3>',   sub {
				 $menu->Popup(-popover => "cursor", -popanchor => "nw");
			   } );

  my $i = 0;
  my $frame;
  my $pw = progressWinInit($picLB, "Show thumbnails");
  foreach my $dpic (@$thumbs) {
	last if progressWinCheck($pw);
	progressWinUpdate($pw, "loading thumbnail (".($i+1)."/$nr) ...", ($i+1), $nr);

	#if ( $i % $cols == 1 or $cols == 1 ) { # start new table row (modulo)
	#  $frame = $tiler->Frame()->pack();
	#}

	my $thumbFile = getThumbFileName($dpic);
	$tphotos{$dpic} = $win->Photo(-file => $thumbFile, -gamma => $config{Gamma}) if (-f $thumbFile);
	if (! $tphotos{$dpic}) {
	  #$top->messageBox(-icon => 'warning', -message => "showThumbList: Error no thumb for photo $dpic!",
		#			   -title => 'Error', -type => 'OK');
	  $tphotos{$dpic} = $defaultthumbP if $defaultthumbP;
	  next unless $tphotos{$dpic};
	}
	my $j = $i;                                   # we need a local copy here
	$a[$i] = $tiler->Frame(-border => 1, -relief => "raised");
	$a[$i]->{selected} = 0;
	$a[$i]->{dpic}     = $dpic;
	my $check = $a[$i]->Checkbutton(-variable => \$a[$i]->{selected},
						-border  => 1,
						-padx => 0, -pady => 0,
						-command => sub {
						  my $sel = 0;
						  foreach (@a) { $sel++ if $_->{selected}; }
						  $win->{label} = "$nr pictures, $sel selected";
					},)->pack(-side => "left", -expand => 0, -fill => "none", -anchor => "s", -padx => 0, -pady => 0);
	my $but = $a[$i]->Button(-image   => $tphotos{$dpic},
							 -border  => 0,
							 -relief  => "flat",
							 -padx => 0, -pady => 0,
							 -command => sub {
							   $check->invoke if (Exists($check));
							 },)->pack(-side => "left", -expand => 0, -fill => "none", -padx => 0, -pady => 0);

	$but->bind('<ButtonPress-2>', sub { showPicInOwnWin($dpic); });

	my $msg; # the balloon message is generated on demand later, to speed up the loading of the thumbs
	$balloon->attach($but, -postcommand => sub { $msg = makeBalloonMsg($dpic); $msg .= "\n\nRight mouse button for context menu, middle mouse button to open picture";}, -balloonposition => "mouse", -msg => \$msg);

	$tiler->Manage($a[$i]);
	$i++;
  }
  progressWinEnd($pw);
  $win->bind('<Key-Escape>', sub { cleanUpAndClose($win, \%tphotos); });
  $win->bind('<Key-q>',      sub { cleanUpAndClose($win, \%tphotos); });

  $win->deiconify;
  $win->raise;
  #stopWatchStop("showThumbList");
  $userinfo = "ready!"; $userInfoL->update;
}

##############################################################
# cleanUpAndClose - for showThumbList
##############################################################
sub cleanUpAndClose($$) {
  my $win = shift;
  my $hashref = shift;

  $win->withdraw;

  foreach (keys %{$hashref}) {
	if ($$hashref{$_}) {
	  # do not delete the default thumbnail!
	  $$hashref{$_}->delete unless ($$hashref{$_} == $defaultthumbP);
	}
  }
  Tk->break;
}

##############################################################
# delPicsToTrash
##############################################################
sub delPicsToTrash {
  my ($win, $a, $thumbs, $title, $tphotos) = @_;

  unless (defined $a) { warn "a undef"; return; }
  unless (ref($a) eq 'ARRAY') {warn "a is no array"; return; }
  unless (defined $thumbs) { warn "thumbs undef"; return; }
  unless (ref($thumbs) eq 'ARRAY') {warn "thumbs is no array"; return; }

  my @sel;
  my $deleted = 0;
  my $errors  = "";
  if (!-d $trashdir) {
	$win->messageBox(-icon => 'warning',
					 -message => "Trashdir $trashdir not found!\nPlease create this dir (shell: mkdir $trashdir) and retry.\n\nAborting.",
					 -title => "Delete pictures", -type => 'OK');
	return;
  }
  # check if we are in the trash dir
  if ($actdir eq $trashdir) {
	$win->messageBox(-icon => 'warning', -message => "Please use <Shift-Delete> to really remove files from the trash!",
					 -title => "Delete pictures", -type => 'OK');
	return;
  }
  makeDir("$trashdir/$thumbdirname", NO_ASK);

  foreach my $i (reverse 0 .. $#{$a}) {
	if ($$a[$i]->{selected}) {
	  my $dpic = $$a[$i]->{dpic};
	  my $pic  = basename($dpic);
	  if (move ($dpic, $trashdir)) {
		$deleted++;				# count nr of successfull moves
		my $tpic = "$trashdir/$pic";
		$searchDB{$tpic} = $searchDB{$dpic};
		$searchDB{$tpic}{odir} = dirname($dpic);
		delete $searchDB{$dpic};
		deleteCachedPics($dpic);

		my $thumb = getThumbFileName($dpic);
		if ((-d "$trashdir/$thumbdirname") and (-f $thumb)) {
		  if (!move ($thumb, "$trashdir/$thumbdirname")) {
			$errors .= "Could not move thumbnail \"$thumb\" to $trashdir/$thumbdirname: $!\n";
		  }
		}

		splice @$thumbs, $i, 1; # remove picture from list

	  } else { $errors .= "Could not move picture \"$dpic\" to $trashdir: $!\n"; }
	}
  }

  # clean up and close window
  if ($errors ne "") {
	$errors = "These errors occured while deleting the selected pictures:\n$errors";
	showText("Error while deleting", $errors, NO_WAIT);
  }
  $userinfo = "deleted $deleted pictures"; $userInfoL->update;

  # while it's not possible to remove objects from Tk::Tiler we need to close the
  # window and reload the function with the rest of the pictures
  cleanUpAndClose($win, $tphotos);
  # recursive call of this function
  showThumbList($thumbs, $title);
}

##############################################################
# makeBalloonMsg
##############################################################
sub makeBalloonMsg {

  my $dpic = shift;
  return "$dpic\nis currently not available" if (!-f $dpic);

  my $linktarget = "";
  my $pic        = basename($dpic);
  my $dir        = dirname($dpic);
  my $fsize      = getFileSize($dpic, FORMAT);
  my $fdate      = getFileDate($dpic, FORMAT);
  my ($w, $h)    = getSize($dpic);
  my $exif       = getShortEXIF($dpic, NO_WRAP);
  if ($exif ne "") {
	  $exif = formatString($exif, 80, -1);
	  $exif = "\nEXIF: ".$exif;
  }
  my $iptc       = getIPTC($dpic, SHORT);
  $iptc = formatString($iptc, 80, -1);  # needed for many joined keywords
  if ($iptc ne '') {
	$iptc = "\n\n".$iptc; # if IPTC is not empty, add a little distance
  }
  my $comment = getComment($dpic, LONG);
  # show only the first 800 chars of the comment, else the balloon box is too full
  $comment = cutString($comment, 797, "...");
  $comment = formatString($comment, 80, -1);
  if ($comment ne "") {
	$comment = "\n\n".$comment; # if comment is not empty, add a little distance
  }
  if (-l $dpic) {
	$linktarget  = "\nLink: links to: ".readlink($dpic);
  }
  return "File: $pic\nDir:  $dir\nSize: $fsize (${w}x$h)\nDate: $fdate $linktarget$exif$iptc$comment";
}

##############################################################
# saveOffsets
##############################################################
# sub saveOffsets {
#   my $win = shift;
#   my $geo = $win->geometry;
#   my ($w, $h, $x, $y) = splitGeometry($geo);
#   $picwinx = $x;
#   $picwiny = $y;
#   print "saveOffsets: $x $y\n" if $verbose;
# }

##############################################################
# options
##############################################################
sub options {

  if (Exists($ow)) {
	$ow->deiconify;
	$ow->raise;
	return;
  }

  $ow = $top->Toplevel();
  $ow->withdraw;
  $ow->title("Mapivi options");
  $ow->iconname("Options");
  $ow->iconimage($mapiviicon) if $mapiviicon;

  my $notebook =
	$ow->NoteBook(-width => 500,
				  -background => $config{ColorBG}, # background of active page (including its tab)
				  -inactivebackground => $config{ColorEntry}, # tabs of inactive pages
				  -backpagecolor => $config{ColorBG}, # background behind notebook
				 )->pack(-expand => "yes",
						 -fill => "both",
						 -padx => 5, -pady => 5);
  my $aF  = $notebook->add("gen",     -label => "General");
  my $bF  = $notebook->add("thumbs",  -label => "Thumbnails");
  my $cF  = $notebook->add("view",    -label => "Window");
  my $eF  = $notebook->add("col",     -label => "Colors");
  my $dF  = $notebook->add("adv",     -label => "Advanced");

  $notebook->raise($config{OptionsLastPad});

  my %tmpconf = %{ dclone(\%config) };

  my $w = 37;

  labeledEntry($aF,'top',20,"Copyright notice",\$tmpconf{Copyright});


  my $sdbB =
	$aF->Checkbutton(-variable => \$tmpconf{SaveDatabase},
					 -text => "Store the search database to a file")->pack(-anchor => 'w');
  $balloon->attach($sdbB, -msg =>
				   "If this is enabled all image meta information
(Comments, EXIF, IPTC, file name) of all images
visited will be stored into a database.
The database can be used to search pictures.
It is highly recommended to enable this option.");
my $sexfeB =
  $aF->Checkbutton(-variable => \$tmpconf{saveEXIFforEdit},
				   -text => "Save EXIF information before editing picture in The GIMP")->pack(-anchor => 'w');
  $balloon->attach($sexfeB, -msg => "Some older picture editors (e.g. GIMP 1.3.15 and lower)
won't save the picture EXIF information.
With this option the EXIF info is saved
and you can restore it later.
(see menu Edit->EXIF info->restore)");
  $aF->Checkbutton(-variable => \$tmpconf{ShowHiddenDirs},
				   -text => 'Show hidden folders (starting with a dot ".")')->pack(-anchor => 'w');
  $aF->Checkbutton(-variable => \$tmpconf{AskGenerateThumb}, -text =>
				   "Ask before generating thumbnails")->pack(-anchor => 'w');
  $aF->Checkbutton(-variable => \$tmpconf{AskDeleteThumb}, -text =>
				   "Ask before deleting thumbnails")->pack(-anchor => 'w');
  $aF->Checkbutton(-variable => \$tmpconf{AskMakeDir},
				   -text => "Ask before making a folder (e.g. $thumbdirname)")->pack(-anchor => 'w');
  $aF->Checkbutton(-variable => \$tmpconf{WarnBeforeResize},
				   -text => "Warn me before using change size/quality")->pack(-anchor => 'w');
  my $cfnjB =
	$aF->Checkbutton(-variable => \$tmpconf{CheckForNonJPEGs},
					 -text => "Check for non-JPEG pictures")->pack(-anchor => 'w');
  $balloon->attach($cfnjB, -msg =>
				   "If this is enabled and there are some non-JPEGs
Mapivi will ask the user if they should be converted
to JPEGs. After the conversion the images can be
displayed by Mapivi. The originals (non-JPEGs) may
be left untouched or deleted.");
  $aF->Checkbutton(-variable => \$tmpconf{ShowMoreEXIF}, -text =>
				   "Show detailed EXIF data (sharpness, contrast, artist, white balance, ...)")->pack(-anchor => 'w');
  $aF->Checkbutton(-variable => \$tmpconf{BitsPixel}, -text =>
				   "Calculate and show picture compression in bit per pixel")->pack(-anchor => 'w');
  $aF->Checkbutton(-variable => \$tmpconf{AspectRatio}, -text =>
				   "Calculate and show image aspect ratio (e.g. 4:3 or 3:2)")->pack(-anchor => 'w');
  $aF->Checkbutton(-variable => \$tmpconf{ShowFileDate}, -text =>
				   "Show file date in the size column")->pack(-anchor => 'w');
  $aF->Checkbutton(-variable => \$tmpconf{RenameBackup}, -text =>
				   "Rename backup file, if the file is renamed")->pack(-anchor => 'w');
  $aF->Checkbutton(-variable => \$tmpconf{WAV_file_operations}, -text =>
				   "WAV audio files follow picture file operations (copy, move, rename, delete *.wav file)")->pack(-anchor => 'w');
  $aF->Checkbutton(-variable => \$tmpconf{XMP_file_operations}, -text =>
				   "XMP sidecar files follow picture file operations (copy, move, rename, delete *.xmp file)")->pack(-anchor => 'w');
  $aF->Checkbutton(-variable => \$tmpconf{RAW_file_operations}, -text =>
				   "RAW (nef, crw) files follow picture file operations (copy, move, rename, delete *.nef or *.crw file)")->pack(-anchor => 'w');

  my $trb = 
	$aF->Checkbutton(-variable => \$tmpconf{jpegtranTrim},
					 -text => "use the -trim switch when doing lossless rotation")->pack(-anchor => 'w');
  $balloon->attach($trb, -msg =>
				   "The rotation operates rather oddly if the image dimensions are not a
multiple of the iMCU size (usually 8 or 16 pixels), because they can
only transform complete blocks in the desired way. jpegtran's default
behavior when transforming an odd-size image is designed to preserve
exact reversibility and mathematical consistency of the transformation
set.
For practical use, you may prefer to discard any untransformable
edge pixels using the -trim switch rather than having a
strange-looking strip along the right and/or bottom edges of a
transformed image.");


  my $aFcp = labeledScale($aF, 'top', $w, "Max number of cached pictures", \$tmpconf{MaxCachedPics}, 2, 10, 1);

  $balloon->attach($aFcp, -msg => "MaPiVi is able to cache some pictures.\nCached pictures can be displayed very fast, but eat up memory.");

my $aFtp = labeledScale($aF, 'top', $w, "Max number of displayed thumbnails", \$tmpconf{ThumbMaxLimit}, 10, 10000, 10);

  $balloon->attach($aFtp, -msg => "Each thumbnail eats up a little bit of memory
(about 40kByte), so opening a folder
with a huge number of pictures may be dangerous.
With this option you are able to limit the
memory consumption of the thumbnails.
The remaining thumbnails will be displayed
with the default thumbnail."); 

  my $aFst = labeledScale($aF, 'top', $w, "Maximum size of trash (MB)", \$tmpconf{MaxTrashSize}, 1, 500, 5);
  $balloon->attach($aFst, -msg => "The trash size is not really limited,
but there will be a warning,
when this limit is reached.");


  labeledScale($aF, 'top', $w, "Slideshow pause time (sec)", \$tmpconf{SlideShowTime}, 1, 300, 1);

  # ###############  Thumbnail notepad  ########################


  my $abF  = $bF->Frame()->pack(-fill => 'x', -expand => 0);
  my $a1bF = $abF->Frame()->pack(-side => "left", -fill => 'x', -expand => 0);
  my $a2bF = $abF->Frame()->pack(-side => "left", -fill => 'x', -expand => 0);

  my $bFst =
	$a1bF->Checkbutton(-variable => \$tmpconf{ShowThumbs},
					   -text => "Show thumbnail pictures")->pack(-anchor => 'w');
  $balloon->attach($bFst, -msg => "Show thumbnails or nothing at all\n(disable this for compact view)");

  my $bFuet =
	$a1bF->Checkbutton(-variable => \$tmpconf{UseEXIFThumb},
					   -text => "Use EXIF thumbnails where available")->pack(-anchor => 'w');
  $balloon->attach($bFuet, -msg => "Use the EXIF thumbnails where availabe,\nif not available a thumbnail is generated from the picture\n(very fast, but may not reflect a post processed picture).");

	$a1bF->Checkbutton(-variable => \$tmpconf{RotateThumb},
					   -text => "Rotate EXIF thumbnail when rotating picture")->pack(-anchor => 'w');

  my $bFudt =
	$a1bF->Checkbutton(-variable => \$tmpconf{UseDefaultThumb},
					   -text => "Use default thumbnail")->pack(-anchor => 'w');
  $balloon->attach($bFudt, -msg => "Show default thumbnail if no thumbnail available.");

  my $example;
  my $previewB;
  if (-f $thumbExample) {
	$example  = $top->Photo(-file => "$thumbExample", -gamma => $config{Gamma});
	if ($example) {
	  $a2bF->Label(-text => 'Click here for a preview')->pack();
	  $previewB =
		$a2bF->Button(-image   => $example,
					  -bd      => $config{Borderwidth},
					  -command => sub {
						my $thumb = "$trashdir/thumbExample.jpg";
						my $com = makeCommandString(\%tmpconf);
						$com   .= " \"$thumbExample\" \"$thumb\" ";
						$ow->Busy;
						if ((system "$com") != 0) {
						  warn "$com failed: $!";
						  $ow->Unbusy;
						  return;
						}
						if (-f $thumb) {
						  my $prev = $top->Photo(-file => "$thumb", -gamma => $config{Gamma});
						  $previewB->configure(-image => $prev) if $prev;
						}
						$ow->Unbusy;
					  })->pack();
	  $balloon->attach($previewB, -msg => "Press here to update the thumbnail\nwith the choosen options");
	}
  }

  $previewB->invoke if (Exists($previewB));

  my $bFdt = labeledEntryButton($bF,'top',$w,"Path/name of default thumbnail",'Set',\$tmpconf{DefaultThumb});
  $balloon->attach($bFdt, -msg => "This default thumbnail will be displayed when the real thumbnail\nis not available (e.g. while building the thumbnails).");

  #my $bfF = $bF->Frame()->pack(-fill => 'x', -expand => "1");

  my $bFstp = labeledScale($bF, 'top', $w, "Size (pixel)", \$tmpconf{ThumbSize}, 10, 200, 1);
  $balloon->attach($bFstp, -msg => "This is the length and the heigt of the thumbnail.\nWith a value of e.g. 100 you will get a 100x100 thumbnail.");

  my $bFqt = labeledScale($bF, 'top', $w, "Quality (%)", \$tmpconf{ThumbQuality}, 30, 100, 5);
  qualityBalloon($bFqt);

  #my $zF = $bF->Frame()->pack(-fill => 'x', -expand => "1");

  my $zshS = labeledScale($bF, 'top', $w, "Sharpness (radius)", \$tmpconf{ThumbSharpen}, 0, 40, 0.1);
  $balloon->attach($zshS, -msg => "The higher the value, the slower the conversion\n(suggestion: between 0 and 4)");


  my $bFbs = labeledScale($bF, 'top', $w, "Frame size (pixel)", \$tmpconf{ThumbBorder}, 0, 50, 1);
  $balloon->attach($bFbs, -msg => "Set the thumbnail frame size.");

  $bF->Checkbutton(-variable => \$tmpconf{UseThumbShadow}, -text => "Add a shadow")->pack(-anchor => 'w');

  my $bFbgc = labeledEntryColor($bF,'top',$w,"Thumbnail frame color",'Set',\$tmpconf{ColorThumbBG});
  $balloon->attach($bFbgc, -msg => "Set the thumbnail frame color.");

  my $bFnob = labeledScale($bF, 'top', 42, "Number of processes generating thumbnails", \$tmpconf{MaxProcs}, 1, 10, 1);
  $balloon->attach($bFnob, -msg => "MaPiVi will generate the thumbnails in the background.\nChoose the maximum number of parallel executed processes.\nNumbers greater than one or two may only be appropriate on a muliprocessor plattform.");

  # ###############  window notepad  ########################

  $cF->Checkbutton(-variable => \$tmpconf{ShowClock},
				   -text => "Display a clock in the status bar")->pack(-anchor => 'w');

  $cF->Checkbutton(-variable => \$tmpconf{ShowMenu},
							 -text => "Show menu bar")->pack(-anchor => 'w');
  $cF->Checkbutton(-variable => \$tmpconf{ShowInfoFrame},
							 -text => "Show info frame on the upper side")->pack(-anchor => 'w');
  $cF->Checkbutton(-variable => \$tmpconf{ShowDirTree},
							 -text => "Show folder tree on the left side")->pack(-anchor => 'w');
  $cF->Checkbutton(-variable => \$tmpconf{ShowThumbFrame},
							 -text => "Show thumbnail list")->pack(-anchor => 'w');
  $cF->Checkbutton(-variable => \$tmpconf{ShowPicFrame},
							 -text => "Show picture frame on the right side")->pack(-anchor => 'w');

  my $aFe =	$cF->Checkbutton(-variable => \$tmpconf{ShowEXIFField},
							 -text => "Show EXIF info and buttons in picture view")->pack(-anchor => 'w');
  $balloon->attach($aFe, -msg => "show/hide the textfield containing the picture EXIF data\nand the EXIF- and IPTC-show buttons.\nThis field is usually located above the actual picture");

  my $aFc =	$cF->Checkbutton(-variable => \$tmpconf{ShowCommentField},
							 -text => "Display comment info in picture view")->pack(-anchor => 'w');
  $balloon->attach($aFc, -msg => "show/hide the textfield containing the picture comments\nand the buttons to add, edit and remove a comment.\nThis field is usually located above the actual picture");

  my $aFic = $cF->Checkbutton(-variable => \$tmpconf{ShowCaptionField},
							 -text => "Display IPTC caption info in picture view")->pack(-anchor => 'w');
  $balloon->attach($aFic, -msg => "show/hide the textfield containing the picture IPTC caption\nand a button to store it.\nThis field is usually located above the actual picture");

  my $aFp =	$cF->Checkbutton(-variable => \$tmpconf{ShowPicInfo},
							 -text => "Show picture info as a balloon on the actual picture")->pack(-anchor => 'w');
  $balloon->attach($aFp, -msg => "if this is enabled and you move and hold your mouse pointer\nover the actual picture (right frame of the main window)\na balloon info box (with EXIF, comment, size, ...) will appear");

  my $aIc =	$cF->Checkbutton(-variable => \$tmpconf{ShowInfoInCanvas},
							 -text => "Overlap picture with picture info (EXIF, IPTC, ...)")->pack(-anchor => 'w');
  $balloon->attach($aIc, -msg => "show/hide picture infos on the picture itself");

  $cF->Checkbutton(-variable => \$tmpconf{AutoZoom},
					  -text => "Zoom big pictures to fit the canvas (auto zoom)")->pack(-anchor => 'w');

  $cF->Checkbutton(-variable => \$tmpconf{ShowCoordinates},
				   -text => "Display the coordinates of the mouse cursor in the status bar")->pack(-anchor => 'w');

  my $fontF = $cF->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  $balloon->attach($fontF, -msg => "Font for the main window and nearly all dialogs.\nIt's recommeded to choose a fixed font.");
  my $fontL = $fontF->Label(-text => "Font family: ", -bg => $config{ColorBG})->pack(-side => "left");
  $fontF->Label(-textvariable => \$tmpconf{FontFamily}, -bg => $config{ColorBG})->pack(-side => "left");

  $fontF->Button(-text => 'Set',
                 -command => sub {
                    my $font = $tmpconf{FontFamily};
                    my $rc = myFontDialog($ow, 'Select font family', \$font, $tmpconf{FontSize});
                    return unless $rc;
                    $tmpconf{FontFamily} = $font;
                    $ow->Busy;
                    my $font2 = $top->Font(-family => $tmpconf{FontFamily},
					                      -size   => $tmpconf{FontSize});
                    $fontL->configure(-font => $font2);
                    $fontL->update();
                    $ow->Unbusy;
                })->pack(-side => "left");

  $fontF->Label(-text => " Font size: ", -bg => $config{ColorBG})->pack(-side => "left");
  $fontF->Scale(
			 -variable => \$tmpconf{FontSize},
			 -from => 5,
			 -to => 20,
			 -resolution => 1,
			 -sliderlength => 30,
			 -orient => 'horizontal',
			 -showvalue => 0,
             -width => 15,
			 -bd => $config{Borderwidth},
             -command => sub {
                     $ow->Busy;
                     my $font = $top->Font(-family => $tmpconf{FontFamily},
				                           -size   => $tmpconf{FontSize});
                     $fontL->configure(-font => $font);
                     $fontL->update();
                     $ow->Unbusy;
                     })->pack(-side => "left", -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  $fontF->Label(-textvariable => \$tmpconf{FontSize})->pack(-side => "left");

  my $propFontF = $cF->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  $balloon->attach($propFontF, -msg => "Please choose a propotional font here which is available in different sizes.\nIt will be used in the keyword browser (tag cloud).");
  my $propFontL = $propFontF->Label(-text => "Proportional font family: ", -bg => $config{ColorBG})->pack(-side => "left");
  $propFontF->Label(-textvariable => \$tmpconf{PropFontFamily}, -bg => $config{ColorBG})->pack(-side => "left");

  $propFontF->Button(-text => 'Set',
                 -command => sub {
                    my $font = $tmpconf{PropFontFamily};
                    my $rc = myFontDialog($ow, 'Select font family', \$font, $tmpconf{PropFontSize});
                    return unless $rc;
                    $tmpconf{PropFontFamily} = $font;
                    $ow->Busy;
                    my $font2 = $top->Font(-family => $tmpconf{PropFontFamily},
					                      -size   => $tmpconf{PropFontSize});
                    $propFontL->configure(-font => $font2);
                    $propFontL->update();
                    $ow->Unbusy;
                })->pack(-side => "left");

  $propFontF->Label(-text => " Font size: ", -bg => $config{ColorBG})->pack(-side => "left");
  $propFontF->Scale(
			 -variable => \$tmpconf{PropFontSize},
			 -from => 5,
			 -to => 30,
			 -resolution => 1,
			 -sliderlength => 30,
			 -orient => 'horizontal',
			 -showvalue => 0,
             -width => 15,
			 -bd => $config{Borderwidth},
             -command => sub {
                     $ow->Busy;
                     my $font = $top->Font(-family => $tmpconf{PropFontFamily},
				                           -size   => $tmpconf{PropFontSize});
                     $propFontL->configure(-font => $font);
                     $propFontL->update();
                     $ow->Unbusy;
                     })->pack(-side => "left", -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  $propFontF->Label(-textvariable => \$tmpconf{PropFontSize})->pack(-side => "left");


  my $tfontF = $cF->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  my $tfontL = $tfontF->Label(-text => "Thumbnail font size:", -bg => $config{ColorBG})->pack(-side => "left");
  $tfontF->Scale(
			 -variable => \$tmpconf{ThumbCaptFontSize},
			 -from => 5,
			 -to => 20,
			 -resolution => 1,
			 -sliderlength => 30,
			 -orient => 'horizontal',
			 -showvalue => 0,
             -width => 15,
			 -bd => $config{Borderwidth},
             -command => sub {
                     $ow->Busy;
                     my $font = $top->Font(-family => $tmpconf{FontFamily},
				                           -size   => $tmpconf{ThumbCaptFontSize});
                     $tfontL->configure(-font => $font);
                     $tfontL->update();
                     $ow->Unbusy;
                     })->pack(-side => "left", -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  $tfontF->Label(-textvariable => \$tmpconf{ThumbCaptFontSize})->pack(-side => "left");

  # ###############  color notepad  ########################

  $w = 36;

  $eF->Label(-text => 'Please restart Mapivi to see all color changes')->pack();

  my $presets = $eF->Frame()->pack(-fill =>'x', -padx => 0, -pady => 0);

  $presets->Label(-text => 'Presets')->pack(-side => 'left', -anchor => 'w');

  $presets->Button(-text => 'bright',
				  -command => sub {
$tmpconf{ColorBG}       = "#efefef";
$tmpconf{ColorMenuBG}   = "LightGoldenrod2";
$tmpconf{ColorMenuFG}   = "black";
$tmpconf{ColorBG2}      = "#e5e5e5";
$tmpconf{ColorBGCanvas} = "#efefef";
$tmpconf{ColorHlBG}     = "#eeeeee";
$tmpconf{ColorActBG}    = "LightGoldenrod1";
$tmpconf{ColorEntry}    = "gray90";
$tmpconf{ColorSel}      = "LightGoldenrod2";
$tmpconf{ColorSelBut}   = "red3";
$tmpconf{ColorSelFG}    = "black";
$tmpconf{ColorName}     = "black";
$tmpconf{ColorComm}     = "black";
$tmpconf{ColorIPTC}     = "black";
$tmpconf{ColorEXIF}     = "black";
$tmpconf{ColorFile}     = "black";
$tmpconf{ColorDir}      = "black";
$tmpconf{ColorThumbBG}  = "azure3";
				  })->pack(-side => 'left');

  $presets->Button(-text => 'white/yellow',
				  -command => sub {
$tmpconf{ColorBG}       = "white";
$tmpconf{ColorMenuBG}   = "LightGoldenrod3";
$tmpconf{ColorMenuFG}   = "black";
$tmpconf{ColorBG2}      = "#fff9d8";
$tmpconf{ColorBGCanvas} = "white";
$tmpconf{ColorHlBG}     = "white";
$tmpconf{ColorActBG}    = "LightGoldenrod1";
$tmpconf{ColorEntry}    = "gray90";
$tmpconf{ColorSel}      = "LightGoldenrod2";
$tmpconf{ColorSelBut}   = "red3";
$tmpconf{ColorSelFG}    = "black";
$tmpconf{ColorName}     = "black";
$tmpconf{ColorComm}     = "black";
$tmpconf{ColorIPTC}     = "black";
$tmpconf{ColorEXIF}     = "black";
$tmpconf{ColorFile}     = "black";
$tmpconf{ColorDir}      = "black";
$tmpconf{ColorThumbBG}  = "LightGoldenrod1";
				  })->pack(-side => 'left');

  $presets->Button(-text => 'blue',
				  -command => sub {
$tmpconf{ColorBG}       = "SlateGray1";
$tmpconf{ColorMenuBG}   = "SlateGray3";
$tmpconf{ColorMenuFG}   = "black";
$tmpconf{ColorBG2}      = "SlateGray2";
$tmpconf{ColorBGCanvas} = "SlateGray1";
$tmpconf{ColorHlBG}     = "#e3f6ff";
$tmpconf{ColorActBG}    = "DeepSkyBlue1";
$tmpconf{ColorEntry}    = "SlateGray1";
$tmpconf{ColorSel}      = "DeepSkyBlue1";
$tmpconf{ColorSelBut}   = "red3";
$tmpconf{ColorSelFG}    = "black";
$tmpconf{ColorName}     = "black";
$tmpconf{ColorComm}     = "black";
$tmpconf{ColorIPTC}     = "black";
$tmpconf{ColorEXIF}     = "black";
$tmpconf{ColorFile}     = "black";
$tmpconf{ColorDir}      = "black";
$tmpconf{ColorThumbBG}  = "SlateGray3";
				  })->pack(-side => 'left');

  $presets->Button(-text => 'bright/blue',
				  -command => sub {
$tmpconf{ColorBG}       = "#efefef";
$tmpconf{ColorMenuBG}   = "gray40";
$tmpconf{ColorMenuFG}   = "white";
$tmpconf{ColorBG2}      = "#e5e5e5";
$tmpconf{ColorBGCanvas} = "#efefef";
$tmpconf{ColorHlBG}     = "#eeeeee";
$tmpconf{ColorActBG}    = "#9fb6cd";
$tmpconf{ColorEntry}    = "gray90";
$tmpconf{ColorSel}      = "#9fb6cd";
$tmpconf{ColorSelBut}   = "red3";
$tmpconf{ColorSelFG}    = "black";
$tmpconf{ColorName}     = "black";
$tmpconf{ColorComm}     = "black";
$tmpconf{ColorIPTC}     = "black";
$tmpconf{ColorEXIF}     = "black";
$tmpconf{ColorSize}     = "black";
$tmpconf{ColorDir}      = "black";
$tmpconf{ColorThumbBG}  = "gray85";
				  })->pack(-side => 'left');

  $presets->Button(-text => 'gray',
				  -command => sub {
$tmpconf{ColorBG}       = "#aeaeae";
$tmpconf{ColorMenuBG}   = "#aaa";
$tmpconf{ColorMenuFG}   = "black";
$tmpconf{ColorBG2}      = "#c8c8c8";
$tmpconf{ColorBGCanvas} = "#222";
$tmpconf{ColorHlBG}     = "#a1a1a1";
$tmpconf{ColorActBG}    = "#ae6666";
$tmpconf{ColorEntry}    = "#ccc";
$tmpconf{ColorSel}      = "#9fb6cd";
$tmpconf{ColorSelBut}   = "red3";
$tmpconf{ColorSelFG}    = "#000";
$tmpconf{ColorName}     = "#000060";
$tmpconf{ColorComm}     = "#600000";
$tmpconf{ColorIPTC}     = "#404000";
$tmpconf{ColorEXIF}     = "#006000";
$tmpconf{ColorFile}     = "#004040";
$tmpconf{ColorDir}      = "#000060";
$tmpconf{ColorThumbBG}  = "#ccc";
				  })->pack(-side => 'left');

  labeledEntryColor($eF,'top',$w,"Background color: window",'Set',\$tmpconf{ColorBG});
  labeledEntryColor($eF,'top',$w,"Background color: menu",'Set',\$tmpconf{ColorMenuBG});
  labeledEntryColor($eF,'top',$w,"Background color: thumbnail table",'Set',\$tmpconf{ColorBG2});
  labeledEntryColor($eF,'top',$w,"Background color: picture",'Set',\$tmpconf{ColorBGCanvas});
  labeledEntryColor($eF,'top',$w,"Background color: highlight",'Set',\$tmpconf{ColorHlBG});
  labeledEntryColor($eF,'top',$w,"Background color: active",'Set',\$tmpconf{ColorActBG});
  labeledEntryColor($eF,'top',$w,"Background color: entry fields",'Set',\$tmpconf{ColorEntry});
  labeledEntryColor($eF,'top',$w,"Background color: selections",'Set',\$tmpconf{ColorSel});
  labeledEntryColor($eF,'top',$w,"Background color: selected button",'Set',\$tmpconf{ColorSelBut});
  labeledEntryColor($eF,'top',$w,"Foreground color: selections",'Set',\$tmpconf{ColorSelFG});
  labeledEntryColor($eF,'top',$w,"Font color: menu",'Set',\$tmpconf{ColorMenuFG});
  labeledEntryColor($eF,'top',$w,"Font color: name",'Set',\$tmpconf{ColorName});
  labeledEntryColor($eF,'top',$w,"Font color: comment",'Set',\$tmpconf{ColorComm});
  labeledEntryColor($eF,'top',$w,"Font color: IPTC",'Set',\$tmpconf{ColorIPTC});
  labeledEntryColor($eF,'top',$w,"Font color: EXIF",'Set',\$tmpconf{ColorEXIF});
  labeledEntryColor($eF,'top',$w,"Font color: size",'Set',\$tmpconf{ColorFile});
  labeledEntryColor($eF,'top',$w,"Font color: folder",'Set',\$tmpconf{ColorDir});

  # ###############  advanced notepad  ########################

  $w = 37;
  $dF->Checkbutton(-variable => \$verbose,
				   -text => "verbose: print some debug info to STDOUT")->pack(-anchor => 'w');

  my $trackB =
  $dF->Checkbutton(-variable => \$tmpconf{trackPopularity},
				   -text => "Track popularity of pictures (how often viewed in Mapivi)")->pack(-anchor => 'w');
  $balloon->attach($trackB, -msg => "If this is enabled Mapivi will increase a counter\neverytime a picture is viewed with Mapivi.\nThe counter value is not saved in the picture\njust in the Mapivi database.");

  $dF->Checkbutton(-variable => \$tmpconf{CheckForLinks},
				   -text => "Check if a file is a link before processing it")->pack(-anchor => 'w');

  my $addMapB = 
  $dF->Checkbutton(-variable => \$tmpconf{AddMapiviComment},
				   -text => "add a comment to pictures created/processed by mapivi")->pack(-anchor => 'w');
  $balloon->attach($addMapB, -msg => "If this is enabled Mapivi will add a JPEG comment\nto each created or processed picture.");

  $dF->Checkbutton(-variable => \$tmpconf{EXIFshowApp},
				   -text => "show App*-Info and MakerNotes and ColorComponents in EXIF info")->pack(-anchor => 'w');

  my $ctcb =
  $dF->Checkbutton(-variable => \$tmpconf{CenterThumb},
				   -text => "center selected thumbnail")->pack(-anchor => 'w');
  $balloon->attach($ctcb, -msg => "center the selected thumbnail,\nto show at least the next\nand the previous thumbnail");

  $dF->Checkbutton(-variable => \$tmpconf{ShowNextPicAfterDel},
				   -text => "jump to next picture after delete")->pack(-anchor => 'w');

  $dF->Checkbutton(-variable => \$tmpconf{BeepWhenLooping},
				   -text => "play a beep sound when jumping to the first e.g. last picture")->pack(-anchor => 'w');

  my $ctdb =
  $dF->Checkbutton(-variable => \$tmpconf{CentralThumbDB},
				   -text => "Store all thumbnails in a central place")->pack(-anchor => 'w');
  $balloon->attach($ctdb, -msg => "If this is enabled all thumbnails will be\nstored in a central place (~/.maprogs/thumbDB),\nif disabled thumbnails will be stored\ndecentral in sub folders (.thumbs).");

  my $tbb =
  $dF->Checkbutton(-variable => \$tmpconf{ToggleBorder},
				   -text => "Remove the window border in fullscreen mode (experimental)")->pack(-anchor => 'w');
  $balloon->attach($tbb, -msg => "Enable a real fullscreen mode,\nbut may not work as expected on all\noperating systems and window managers.\nTry it, switch to fullscreen (key: F11),\nif it works it's fine, if not just disable it again.");

  my $fblfb =
  $dF->Checkbutton(-variable => \$tmpconf{SlowButMoreFeatures},
				   -text => "enable some time intensive features (needs restart)")->pack(-anchor => 'w');
  $balloon->attach($fblfb, -msg => "If this is selected, you will get e.g. some\nmore zoom levels.\nThis may slow down Mapivi a bit, so this option\nis only recommended for faster computers.");

  $dF->Checkbutton(-variable => \$tmpconf{CheckNewKeywords},
				   -text => "Check for new keywords and ask to add them to my catalog")->pack(-anchor => 'w');

  $dF->Checkbutton(-variable => \$tmpconf{UrgencyChangeWarning},
				   -text => "Show a warning when a rating/urgency has been changed")->pack(-anchor => 'w');

  $dF->Checkbutton(-variable => \$tmpconf{AutoImport},
				   -text => "Start import wizard at Mapivi startup if source folder is available")->pack(-anchor => 'w');

  $dF->Checkbutton(-variable => \$tmpconf{SelectLastPic},
				   -text => "Select last shown picture after Mapivi startup")->pack(-anchor => 'w');

  my $opfb = $dF->Checkbutton(-variable => \$tmpconf{supportOtherPictureFormats},
				   -text => "Show also other picture formats than just JPEG. Danger! (experimental feature)")->pack(-anchor => 'w');
  $balloon->attach($opfb, -msg => "If this is selected, Mapivi will also show other picture formats (e.g. GIF and PNG),\nat least as thumbnails. But adding IPTC and other meta information is not possible.\nThis feature is not tested, so use it on your own risk.");

  my $aspS = labeledScale($dF, 'top', $w, "Delta factor for aspect ratio (%)", \$tmpconf{AspectSloppyFactor}, 0, 5, 0.1);
  $balloon->attach($aspS, -msg => "Adjust the accuracy of the aspect ratio display (rightmost column size).\nThis is the delta factor in percent when calculating the aspect ratio.\nFor example a picture with size 304x200 will still be displayed as a 3:2 picture,\nif the factor is equal or bigger than 1.4%.\nUse 0.0% if you need really exact values.\n3.0% is acceptable for me.");

  labeledScale($dF, 'top', $w, "preview size in filter dialog (pixel)", \$tmpconf{FilterPrevSize}, 50, 500, 5);
  labeledScale($dF, 'top', $w, "Comment text box height (lines)", \$tmpconf{CommentHeight}, 1, 50, 1);
  labeledScale($dF, 'top', $w, "Gamma value, when displaying pictures", \$tmpconf{Gamma}, 0.1, 10.0, 0.01);
  labeledScale($dF, 'top', $w, "Maximum number of lines of a IPTC info/comment", \$tmpconf{LineLimit}, 1, 20, 1);
  labeledScale($dF, 'top', $w, "Maximum length of a comment line", \$tmpconf{LineLength}, 5, 80, 1);
  my $epv = labeledEntry($dF, 'top', $w, "External picture viewer",\$tmpconf{ExtViewer});
  $balloon->attach($epv,
                   -msg => "Enter the command to start the external picture viewer here.\nYou may also add options.\nExamles: \"gqview -f\", \"gthumb --fullscreen\"");
  my $evmf =
  $dF->Checkbutton(-variable => \$tmpconf{ExtViewerMulti},
				   -text => "External picture viewer can handle multiple files")->pack(-anchor => 'w');
  $balloon->attach($evmf,
                   -msg => 'If the external viewer is able to handle multiple files enable this.
Example:
You have selected 3 pictures.
If this option is enabled one viewer will be started like this:
"viewer pic1.jpg pic2.jpg pic3.jpg",
if not 3 viewers will be started like this:
"viewer pic1.jpg" "viewer pic2.jpg" "viewer pic3.jpg".');
  my $emt = labeledEntry($dF, 'top', $w, "External mail tool",\$tmpconf{MailTool});
  $balloon->attach($emt,
                   -msg => "Enter the command to start the external mail tool here.\nExamles: \"thunderbird\", \"mozilla-thunderbird\", \"evolution\"");

  # ###############  button frame  ########################

  my $butF =
	$ow->Frame()->pack(-fill =>'x',
					   -padx => 3,
					   -pady => 3);

  my $OKB = $butF->Button(-text => 'OK',
				-command => sub {
				  %config = %{ dclone(\%tmpconf) };
				  applyConfig();
                  $example->delete if $example;
				  $config{OptionsLastPad} = $notebook->raised();
				  $ow->destroy();
				}
			   )->pack(-side=>'left', -expand => 1, -fill =>'x');

  # bind ctrl-x to OK button
  $ow->bind('<Control-x>', sub { $OKB->invoke; });

  $butF->Button(-text => "Apply",
				-command => sub {
				  %config = %{ dclone(\%tmpconf) };
                  $previewB->invoke() if (Exists($previewB));
				  applyConfig();
				}
			   )->pack(-side=>'left', -expand => 1, -fill =>'x');

  my $Xbut = $butF->Button(-text => 'Cancel',
						   -command => sub {
                             $example->delete if $example;
				             $config{OptionsLastPad} = $notebook->raised();
							 $ow->destroy();
						   }
						  )->pack(-side=>'left', -expand => 1, -fill =>'x');

  $ow->bind('<Control-q>',  sub { $Xbut->invoke; });
  $ow->bind('<Key-Escape>', sub { $Xbut->invoke; });

  $ow->Popup;
}

##############################################################
# applyConfig
##############################################################
sub applyConfig {

  $progressBar->configure(-blocks => $config{MaxProcs},
						  -to     => $config{MaxProcs});

  $dirtree->configure(-showhidden => $config{ShowHiddenDirs});

  $comS->configure( -foreground=>$config{ColorComm}, -background=>$config{ColorBG2});
  $iptcS->configure(-foreground=>$config{ColorIPTC}, -background=>$config{ColorBG});
  $exifS->configure(-foreground=>$config{ColorEXIF}, -background=>$config{ColorBG2});
  $fileS->configure(-foreground=>$config{ColorFile}, -background=>$config{ColorBG});
  $dirS->configure( -foreground=>$config{ColorDir},  -background=>$config{ColorBG2});

  toggleHeaders();

  $top->optionAdd('*selectBackground', $config{ColorSel}, 'userDefault');
  $picLB->configure(-selectbackground => $config{ColorSel});

  # undocumented feature, but does not work (it stops the execution of the sub)
  # $top->RecolorTree(-background => $config{ColorBG});
  # we don't try to color everything, just a few widgets to give a visual feedback
  $top->configure    (-bg => $config{ColorBG});
  $dirtree->configure(-bg => $config{ColorBG},
					  -selectbackground => $config{ColorSel});
  $c->configure      (-bg => $config{ColorBGCanvas});
  $menubar->configure(-bg => $config{ColorBG});

  my @wlist = $top->children;
  foreach my $widget (@wlist) {
	my $ref = ref($widget);
	if ($ref eq "Tk::Frame" or $ref eq "Tk::Menu") {
	  $widget->configure(-bg => $config{ColorBG});
	}
  }

  # don't know if this is very appropriate
  $top->optionAdd('*selectBackground',    $config{ColorSel},   'userDefault');
  $top->optionAdd("*highlightColor",      $config{ColorSel},   'userDefault');
  $top->optionAdd("*highlightBackground", $config{ColorHlBG},  'userDefault');
  $top->optionAdd("*background",          $config{ColorBG},    'userDefault');
  $top->optionAdd("*activeBackground",    $config{ColorActBG}, 'userDefault');

  # change font
  my $font = $top->Font(-family => $config{FontFamily},
						-size   => $config{FontSize},
					   );
  $top->optionAdd("*font", $font, "userDefault");
  $top->Walk( sub {
				print "changing widget font ",ref($_[0])," to $font\n" if $verbose;
				eval { $_[0]->configure(-font => $font); }
			  });

  showHideFrames();
  $top->update;
  setAdjusterPos();

  startStopClock();
  #print "Sortby Apply = ".$config{SortBy}."\n"; #???
}

##############################################################
# showHideFrames -  pack or packForget the EXIF and Comment
#                   frame
##############################################################
sub showHideFrames {

  # the pack command seems only to work, if we packforget all
  # following widgets
  # so we always remove them all - from the inner to the outer ones
  # and pack them again according to the actual settings
  foreach ($c, $capF, $comF, $exifF, $mainF, $thumbA, $thumbF, $dirA, $dirF, $subF, $infoF) {
	$_->packForget if ($_->ismapped);
  }

  if ($config{ShowMenu}) {
	$top->configure(-menu => $menubar);
  }
  else {
	$top->configure(-menu => "");
  }

  if ($config{ShowInfoFrame}) {
	$infoF->pack(-side => 'top', -anchor=>'w', -padx => 0, -pady => 0, -fill => 'x', -expand => "0");
  }
  $subF->pack(-side => 'top', -anchor=>'w', -padx => 0, -pady => 0, -fill => 'both', -expand => 1);

  if ($config{ShowDirTree}) {
	$dirF->pack(-side => "left", -anchor=>'w', -padx => 0, -pady => 0, -expand => 1, -fill => "both");
	$dirA->packAfter($dirF, -side => "left", -padx => 3) if (($config{ShowThumbFrame}) or ($config{ShowPicFrame}));
  }

  if ($config{ShowThumbFrame}) {
	$thumbF->pack(-side => "left", -anchor=>'w', -padx => 0, -pady => 0, -expand => 1, -fill => "both");
  }

  if ($config{ShowPicFrame}) {
	$thumbA->packAfter($thumbF, -side => "left", -padx => 3) if ($config{ShowThumbFrame}) ;
	$mainF->pack(-side => "left", -anchor=>'w', -padx => 0, -pady => 0, -ipadx => 0, -ipady => 0);
  }

  if ($config{ShowEXIFField}) {
	$exifF->pack(-fill => 'x', -expand => 1, -padx => 0, -pady => 0);
  }
  if ($config{ShowCommentField}) {
	$comF->pack(-fill => 'x',-expand => "1", -anchor=>'w', -padx => 0, -pady => 0) ;
  }
  if ($config{ShowCaptionField}) {
	$capF->pack(-fill => 'x',-expand => "1", -anchor=>'w', -padx => 0, -pady => 0) ;
  }

  $c->pack(-expand => 1, -fill => "both", -padx => 0, -pady => 0, -ipadx => 0, -ipady => 0);
}

##############################################################
# buttonComment
##############################################################
sub buttonComment {
	my $widget = shift;
	my $side   = shift;
	my $but = $widget->Checkbutton(-variable => \$config{AddMapiviComment},
								   -anchor   => 'w',
								   -text     => "Add comment"
								   )->pack(-side => $side, -anchor => 'w', -padx => 5, -pady => 3);
	$balloon->attach($but, -msg => "Add a comment to pictures created\nor processed with Mapivi");
}

##############################################################
# buttonBackup
##############################################################
sub buttonBackup {
	my $widget = shift;
	my $side   = shift;
	my $but = $widget->Checkbutton(-variable => \$config{MakeBackup},
								   -anchor   => 'w',
								   -text     => "Create backup"
								   )->pack(-side => $side, -anchor => 'w', -padx => 5, -pady => 3);
	$balloon->attach($but, -msg => "Create a backup of the original picture\nin the same folder named \"name-bak.jpg\"");
}

##############################################################
# labeledEntryButton - build a frame containing a labeled entry
#                      and a button with a file selector
##############################################################
sub labeledEntryButton {

  # input values
  my ($parentWidget, $position, $width, $label, $buttext, $varRef, $dir) = @_;
  my $frame = labeledEntry($parentWidget, $position, $width, $label, $varRef);
  setFileButton($frame,"right",$buttext,$label,$varRef, $dir);
  return $frame;
}

##############################################################
# labeledEntryColor - build a frame containing a labeled entry
#                     and a button with a color selector
##############################################################
sub labeledEntryColor {

  # input values
  my ($parentWidget, $position, $width, $label, $buttext, $varRef) = @_;
  my $frame = labeledEntry($parentWidget, $position, $width, $label, $varRef);
  setColorButton($frame,"right",$buttext,$varRef);
  return $frame;
}

##############################################################
# labeledEntry - build a frame containing a labeled entry
# for backward compability
##############################################################
sub labeledEntry {

  # input values
  my ($parentWidget, $position, $width, $label, $varRef, $width2) = @_;

  labeledEntryFlex($parentWidget, $position, $width, $label, $varRef, "left", $width2);
}

##############################################################
# labeledEntryFlex - build a frame containing a labeled entry
##############################################################
sub labeledEntryFlex {

  # input values
  my ($parentWidget, $position, $width, $label, $varRef, $int_pos, $width2) = @_;
  # $width2 is optional and the width of the entry field, defaults to the first width
  $width2 = $width unless defined $width2;

  my $frame =
	$parentWidget->Frame()->pack(-side => $position, -expand => 0, -fill => 'x', -padx => 0, -pady => 3);

  $frame->Label(-text   => $label,
				-width  => $width,
				-anchor => 'w',
			   )->pack(-side => $int_pos, -padx => 3, -fill => 'x');

  my $entry;

  if (MatchEntryAvail) {
	# set the choice list to an empty list, if it's undefined
	$entryHistory{$label} = [] unless (defined $entryHistory{$label});

	$entry = $frame->MatchEntry(-textvariable => $varRef,
								-choices      => $entryHistory{$label},
								-ignorecase   => 0,
								-maxheight    => 20,
								# add the new value to the list when enter or tab is pressed
								-entercmd   => sub { addItemToList($entry, $entryHistory{$label}, $varRef); },
								-tabcmd     => sub { addItemToList($entry, $entryHistory{$label}, $varRef); },
								-width      => $width2,
							   )->pack(-side => $int_pos, -expand => 1, -fill => 'x', -padx => 0);
  }
  else {
	$entry = $frame->Entry(-textvariable => $varRef,
						   -width        => $width2,
						  )->pack(-side => $int_pos, -expand => 1, -fill => 'x', -padx => 0);
  }
  $entry->xview('end');
  $entry->icursor('end');

  return $frame;
}

##############################################################
# addItemToList - add a new value to the list and remove double entries
##############################################################
sub addItemToList {
  my $widget  = shift;
  my $listref = shift;
  my $varref  = shift;
  return if (!defined $$varref);
  return if ($$varref eq "");
  # todo: remove double values and remove old values
  push @{$listref}, $$varref;
  my %d;   # build a hash
  foreach (@{$listref}) { $d{$_} = 1; }
  @{$listref} = (sort { uc($a) cmp uc($b); } keys %d);
  $widget->configure(-choices => $listref);
}

##############################################################
# labeledEntry2 - build a frame containing two labeled entrys
##############################################################
sub labeledEntry2 {

  # input values
  my ($parentWidget, $position, $width1, $width2, $label1, $varRef1, $label2, $varRef2) = @_;

  my $frame =
	$parentWidget->Frame()->pack(-side => $position, -expand => 0, -fill => 'x', -padx => 3, -pady => 3);

  $frame->Label(-text   => $label1,
				-width  => $width1,
				-anchor => 'w',
				-bg => $config{ColorBG},
			   )->pack(-side => "left", -padx => 3);

  my $entry1 =
	$frame->Entry(-textvariable => $varRef1,
				  -width        => $width2,
				 )->pack(-side => "left", -fill => 'x', -expand => "1", -padx => 1);
  $entry1->xview('end');
  $entry1->icursor('end');

  $frame->Label(-text   => $label2,
				-width  => $width1,
				-anchor => 'w',
				-bg => $config{ColorBG},
			   )->pack(-side => "left", -padx => 3);

  my $entry2 =
	$frame->Entry(-textvariable => $varRef2,
				  -width        => $width2,
				 )->pack(-side => "left", -fill => 'x', -expand => "1", -padx => 1);
  $entry2->xview('end');
  $entry2->icursor('end');

  return $frame;
}

##############################################################
# labeledDoubleEntry - build a frame containing two labeled entrys
##############################################################
sub labeledDoubleEntry {
  # input values
  my ($parentWidget, $position, $width, $label, $label2, $dVarRef, $dBalloon, $tVarRef, $tBalloon) = @_;

  my $fullframe =
	$parentWidget->Frame()->pack(-side => $position, -fill => 'x', -expand => 0, -padx => 0, -pady => 0);

  my $frame = labeledEntry($fullframe, 'left', $width, $label, $dVarRef, ($width+5));
  $balloon->attach($frame, -msg => $dBalloon);

  $frame = labeledEntry($fullframe, 'left', $width, $label2, $tVarRef, ($width+5));  
  $balloon->attach($frame, -msg => $tBalloon);

  return $fullframe;
}

##############################################################
# labeledScale - build a frame containing a labeled scale
##############################################################
sub labeledScale {

  # input values
  my ($parentWidget, $position, $width, $label, $varRef, $from, $to, $res) = @_;

  my $frame =
	$parentWidget->Frame(-bd => 0)->pack(-side => $position, -fill => 'x', -padx => 3, -pady => 3);

  $frame->Label(-text   => $label,
				-width  => $width,
				-anchor => 'w',
				-bg => $config{ColorBG},
			   )->pack(-side => "left", -padx => 3);

  my $scale = $frame->Scale(-variable     => $varRef,
							#-length       => $width,
							-from         => $from,
							-to           => $to,
							-resolution   => $res,
							-sliderlength => 30,
							-orient       => 'horizontal',
							-width        => 15,
							-showvalue    => 0,
						   )->pack(-side => "left", -fill => 'x', -expand => "1", -padx => 1);

  $frame->Label(-textvariable => $varRef,
				-width  => 5,
				-anchor => "e",
				-bd => $config{Borderwidth},
				-relief => "sunken",
				-bg => $config{ColorBG},
			   )->pack(-side => "left", -padx => 1);

  return $frame;
}

##############################################################
# setFileButton - open a file selector and set file or dir name
##############################################################
sub setFileButton {

  # input values
  my ($parentWidget, $position, $butlabel, $fileselLabel, $varRef, $dir) = @_;
  # $dir is optional, if defined and true a dir will be selected instead of a file

  $parentWidget->Button(-text => $butlabel,
						-command => sub {
						  if ($EvilOS) { # windows
							my $file = $parentWidget->getOpenFile();
							if ((defined $file) and (-f $file)) {
							  $$varRef = $file;
							}
							if ((defined $dir) and ($dir == 1)) {
							  if  (!-d $file) {
								$$varRef = dirname($file);
							  }
							}
						  }
						  else {         # non windows system
							my $fs = $parentWidget->FileSelect(-title => $fileselLabel,
															   -directory => dirname($$varRef),
															   -width => 30, -height => 30);
							if ((defined $dir) and ($dir == 1)) {
							  $fs->configure(-verify => ['-d']);
							}
							my $file = $fs->Show;
							if (defined $file and $file ne "") {
							  if (-f $file) {
								$$varRef = $file;
							  }
							  if ((defined $dir) and ($dir == 1) and (-d $file)) {
								$$varRef = $file;
							  }
							}
						  }
						},
					   )->pack(-side => $position);
}

##############################################################
# setColorButton - open a color selector and set the color
##############################################################
sub setColorButton {

  # input values
  my ($parentWidget, $position, $butlabel, $varRef) = @_;
  my $ccbut;
  $ccbut = $parentWidget->Button(-text => $butlabel,
                                -pady => 0,
				-bg => $$varRef,
				-command => sub {
				  my $rc = color_chooser();
				  if (defined $rc) {
					$ccbut->configure(-bg => $rc);
					$$varRef = $rc;

                                # this is needed when updating the button
                                if ($$varRef eq 'black') {
	                              $ccbut->configure(-fg => 'white');
	                            }
	                            else {
	                              $ccbut->configure(-fg => 'black');
	                            }
							  }
				})->pack(-side => $position, -pady => 0,);

  # this is needed when drawing the button
  if ($$varRef eq 'black') {
    $ccbut->configure(-fg => 'white');
  }
  else {
    $ccbut->configure(-fg => 'black');
  }

}

##############################################################
# color_chooser - open a window and offer some colors to select
##############################################################
sub color_chooser {

  my $title = 'Please select a color';

  # open window
  my $win = $top->Toplevel();
  $win->withdraw;
  $win->title($title);
  $win->iconimage($mapiviicon) if $mapiviicon;
  $win->iconname($title);
  my $frame;
  my $return_color = 0;

  my $colP = 
  $win->Button(-text       => 'Color picker',
			   -height     => 0,
			   -width      => 0,
			   -padx       => 0,
			   -pady       => 0,
			   -relief     => "groove",
			   -background => $config{ColorPicker},
			   -command    => sub {
				  $return_color = $config{ColorPicker};
				}
			   )->pack(-padx => 0, -pady => 0);
	$balloon->attach($colP, -msg => $config{ColorPicker});


  my $colorF = $win->Frame()->pack(-fill => 'both', -expand => "1");
  my $i = 0;
  foreach (@allcolors) {
	$i++;
	if ($i == 1 or $i % 12 == 1) { # a frame for the first and every 12th button (modulo)
	  $frame = $colorF->Frame()->pack(-side => "left", -anchor => "n");
	}
	my $but;
	$but =
	  $frame->Button(#-bitmap => "cbut",
					 -text       => " ",
					 -height     => 0,
					 -width      => 0,
					 -padx       => 0,
					 -pady       => 0,
					 -relief     => "groove",
					 -background => $_,
					 -command    => sub {
					   my $col = $but->cget(-bg);
				       $return_color = $col;
					 }
					)->pack(-padx => 0, -pady => 0);
	$balloon->attach($but, -msg => $_);
  }

  my $xBut =
  $win->Button(-text => "Close",
			   -command => sub {
                 print "returning: undef\n";
				 $return_color = undef;
			   },
			  )->pack(-fill => 'x');

  # 50 ways to leave your window ;)
  $win->bind('<Key-Escape>'          , sub {$xBut->invoke;});
  $win->bind('<Key-q>'               , sub {$xBut->invoke;});
  $win->protocol("WM_DELETE_WINDOW" => sub {$xBut->invoke;} );


  $xBut->focus;
  $win->Popup;
  #repositionWindow($win);
  $win->waitVariable(\$return_color);
  $win->withdraw;
  $win->destroy;
  return $return_color;
}

##############################################################
# makeNewDir - get a new dir name from the user and create this
#              new dir in the actual dir
##############################################################
sub makeNewDir {

  my $path    = shift;
  my $tree    = shift;
  my $newDir  = "newdir";
  my $rc      = myEntryDialog("Make a new folder","Enter name of new folder in $path",\$newDir);

  return if ($rc ne 'OK' or $newDir eq "");

  if (-d "$path/$newDir") {
	$top->messageBox(-icon => 'warning', -message => "$newDir already exists!",
					 -title => 'Error', -type => 'OK');
	return;
  }

  if (!mkdir "$path/$newDir", 0750) {
	$top->messageBox(-icon => 'warning', -message => "error making dir $path/$newDir: $!",
					 -title => 'Error', -type => 'OK');
	return;
  }

  dirSave("$path/$newDir");

  exists &Tk::DirTree::chdir ? $tree->chdir("$path/$newDir")    : $tree->set_dir("$path/$newDir");
  exists &Tk::DirTree::chdir ? $dirtree->chdir("$path/$newDir") : $dirtree->set_dir("$path/$newDir");
}

##############################################################
# getRightDir - get the selected or the actual dir
##############################################################
sub getRightDir {

	my $dir = "";
	# if the dir frame is visible, try to get the selected dir
	if ($dirF->ismapped()) {
		$dir = ($dirtree->selectionGet())[0];
		# normalize the path
		if (defined $dir) {
			$dir =~ s/\\/\//g;  # replace Windows path delimiter with UNIX style \ -> /
			$dir =~ s/\/+/\//g; # replace multiple slashes with one             // -> /
		}
	}

	# this is the fall back solution
	$dir = $actdir if ((!defined $dir) or ($dir eq "") or (!-d $dir));

	return $dir;
}

##############################################################
# cleanOneDir - remove the .thumbs and .exif subdir
##############################################################
sub cleanOneDir {

  my $dir = shift;
  my ($rc, $subdir);

  my @subdirs = ("$dir/$thumbdirname", "$dir/$exifdirname");
  foreach $subdir (@subdirs) {
	if (-d $subdir) {
	  $rc = rmtree($subdir, 0, 1); # dir, 0 = no message for each file, 1 = skip write protected files
	  print "removed $rc elements in $subdir\n" if $verbose;
	}
  }
}

##############################################################
# deleteDir
##############################################################
sub deleteDir {

	my $dir = getRightDir();

	if (!-d $dir) {
		$top->messageBox(-icon => 'warning', -message => "Sorry, but \"$dir\" does not exists!",
						 -title => 'Error', -type => 'OK');
		return;
	}

	my $dirname = basename($dir);
	my $rc = $top->messageBox(-icon    => 'question',
							  -message => "Do you really want to delete folder \"$dirname\"\n($dir)?\nThere is no undelete!",
							  -title => "Delete folder?",
							  -type    => 'OKCancel');
	return if ($rc !~ m/Ok/i);

	# get some infos about the dir
	my $dirs    = 0;
	my $files   = 0;
	my $size    = 0;
	my $timeout = "";
	my $start_time = Tk::timeofday();
	$userinfo = "scanning folder ..."; $userInfoL->update;
	$top->Busy;
	find(sub {
		# jump out after 5 seconds
		if (Tk::timeofday()-$start_time > 5) {
			$timeout = " at least (scanning stopped by timeout)";
			$File::Find::prune = 1;
			return; }
		$dirs++ if (-d "$File::Find::name");
		if (-f "$File::Find::name") {
			$files++;
			$size += getFileSize("$File::Find::name", NO_FORMAT);
		}
	}, "$dir");
	$top->Unbusy;
	$userinfo = "folder scanned!"; $userInfoL->update;
	$size = computeUnit($size);

	my $question = sprintf "There are%s\n%8d folders and\n%8d files with a total size of\n%8s in \"%s\".\nReally delete?", $timeout, $dirs, $files, $size, $dirname;
	$rc = $top->messageBox(-icon    => 'question',
						   -message => $question,
						   -title => "Delete folder?",
						   -type    => 'OKCancel');
	return if ($rc !~ m/Ok/i);

	print "rmtree: dir = $dir\n" if $verbose;
	rmtree($dir, 0, 1); # dir, 0 = no message for each file, 1 = skip write protected files
	# remove the deleted pics from the search database
        cleanDatabaseFolder($dir);

	# refresh the dir tree
	my $path = dirname($dir);
	while (!-d $path) {
	  $path = dirname($dir);
	  last if ($path eq "");
	}
	my $slash = "";
	$slash = "/" if ($Tk::VERSION < 800.025);   # the additional slash is needed for older Tk!
	# todo I don't know if 800.025 is really exactly the version the behavior changed
	$dirtree->close("$slash$path");
	$dirtree->open("$slash$path");

	# open parent dir if we've deleted the actual dir
	openDirPost($path) unless (-d $dir);

	$userinfo = "ready! (removed folder \"$dirname\" with $files files)"; $userInfoL->update;
}

##############################################################
# renameDir
##############################################################
sub renameDir {

  my $dir = getRightDir();
  if (!-d $dir) { warn "dir $dir is no dir"; return; }

  my $path   = dirname($dir);
  my $newDir = basename($dir);
  my $rc     = myEntryDialog("rename folder","Enter new name for folder $dir",\$newDir);

  return if ($rc ne 'OK' or $newDir eq "");

  if (-d "$path/$newDir") {
	$top->messageBox(-icon => 'warning', -message => "$newDir already exists!",
					 -title => 'Error', -type => 'OK');
	return;
  }

  if (!rename "$dir", "$path/$newDir") {
	$top->messageBox(-icon => 'warning', -message => "error renaming folder $dir to $path/$newDir: $!",
					 -title => 'Error', -type => 'OK');
	return;
  }

  # refresh the dir tree display
  my $slash = "";
  $slash = "/" if ($Tk::VERSION < 800.025);   # the additional slash is needed for older Tk!
  $dirtree->close("$slash$path");
  $dirtree->open("$slash$path");

  exists &Tk::DirTree::chdir ? $dirtree->chdir("$path/$newDir") : $dirtree->set_dir("$path/$newDir");

  $dirtree->Subwidget("scrolled")->configure(-directory => "$path/$newDir");
  if ($dirtree->info("exists", "$path/$newDir")) {
	$dirtree->see("$path/$newDir");
  }

  # select the new dir
  $dirtree->selectionSet("$slash$path/$newDir");

  $actdir = "$path/$newDir" if (!-d $actdir);
}

##############################################################
# calcSize - calc new picture size
#            considering the aspect ratio and landscape/portait
#            mode
##############################################################
sub calcSize {
  my ($w, $h, $ow, $oh) = @_;
  my $aspect = $ow/$oh;
  my ($nw, $nh);
  if ($ow >= $oh) { # landscape
	$nw  = $w;
	$nh = round($nw/$aspect);
  }
  else {            # portrait
	$nh = $w;
	$nw = round($aspect*$nh);
  }
  return ($nw, $nh);
}

##############################################################
# qualityBalloon
##############################################################
sub qualityBalloon {
  $balloon->attach(shift, -msg => "Quality of picture\nAppropriate settings are between 50% and 95%,\n80% is often a good tradeoff between size and quality for web and email\nfor further processing and best quality 95% is recommended\nValues over 95% just increase file size, not quality");
}

##############################################################
# changeSizeQuality - change the size and quality of all
#                     selected JPEG pictures
# based on code from Hans-Peter Rangol 10/13/2002.
# Needs mogrify from ImageMagick, preserves Exif-Data,
# depending on the version of mogrify (at least 5.1.1 does not!)
##############################################################
sub changeSizeQuality {

  return if (!checkExternProgs("changeSizeQuality", "mogrify"));
  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);
  my $selected = @sellist;
  my ($pic, $dpic, $dirthumb, $dirtpic, $i);
  my $rc = 0;

  if ($config{WarnBeforeResize}) {
	my $rc = checkDialog("Change size quality",
						"This function will change the size and/or quality\
of $selected selected pictures to a choosable value.\
The EXIF/IPTC and JPEG comment may be preserved,\
depending on your version of the program mogrify.\
So please make a test with a backup picture first.\
It's possible to save and restore the EXIF info with\
menu: \"EXIF info\"->\"save\".\n",
						\$config{WarnBeforeResize},
						"ask every time",
						"",
						'OK', 'Cancel');
	return if ($rc ne 'OK');
  }

  # get the size of the first picture
  my ($width, $height) = getSize($sellist[0]);
  my $origW            = $width;
  my $origH            = $height;
  my $widthP           = 100;
  my $heightP          = 100;
  if ($height == 0) { # avoid division by zero
	$top->messageBox(-message => "Sorry, but the size of ".basename($sellist[0])." is not available - Aborting.", -icon => 'warning', -title => "No size info", -type => 'OK');
	return;
  }
  my $aspect           = $width/$height;
  my $PixPro           = "pro";

  # open dialog window
  my $myDiag = $top->Toplevel();
  $myDiag->title("Change size/quality");
  $myDiag->iconimage($mapiviicon) if $mapiviicon;

  $myDiag->Label(-text =>"Change the size and/or quality of $selected selected pictures",
				 -bg => $config{ColorBG}
				)->pack(-anchor => 'w',-padx => 3,-pady => 3);

  #my $scf =	$myDiag->Frame()->pack(-expand => 1, -fill =>'both',-padx => 3,-pady => 3);
  my $qS = labeledScale($myDiag, 'top', 18, "Quality (%)", \$config{PicQuality}, 10, 100, 1);
  qualityBalloon($qS);

  # check if the Imagemagick version supports the strip command
  my $strip = 0;
  $strip = 1 if (`mogrify` =~ m/.*-strip.*/);
  # check, if the ImageMagick version supports the unsharp command
  my $unsharp = 0;
  $unsharp    = 1 if (`mogrify` =~ m/.*-unsharp.*/);

  my $keepaspect = 1;
  my $csf1 =	$myDiag->Frame()->pack(-fill =>'x',-padx => 3,-pady => 3);
  $csf1->Button(-text => "original size",
			   -width => 12,
			   -command => sub {
				 $height  = $origH;
				 $width   = $origW;
				 $widthP  = round($width/$origW  * 100);
				 $heightP = round($height/$origH * 100);
			   })->pack(-side => "left", -padx => 0);
  $csf1->Button(-text => "email preset",
			   -command => sub {
				 $PixPro               = "pix";
				 $keepaspect           = 1;
				 $config{PicQuality}   = 80;
			         if ($unsharp) {
                                   $config{Unsharp}    = 1;
				   $config{PicSharpen} = 0;
                                 }
                                 else {
                                   $config{Unsharp}    = 0;
				   $config{PicSharpen} = 1;
                                 }
				 $config{PicBlur}      = 0;
				 ($width, $height)     = calcSize(640, 480, $origW, $origH);
				 $widthP               = round($width/$origW  * 100);
				 $heightP              = round($height/$origH * 100);
			   })->pack(-side => "left", -padx => 0);
  $csf1->Button(-text => "half",
			   -width => 9,
			   -command => sub {
				 $PixPro           = "pro";
				 $keepaspect       = 1;
				 $widthP           = 50;
				 $heightP          = 50;
				 $width            = round($origW * $widthP/100);
				 $height           = round($origH * $heightP/100);
			   })->pack(-side => "left", -padx => 0);
  my $csf2 =	$myDiag->Frame()->pack(-fill =>'x',-padx => 3,-pady => 3);
  $csf2->Button(-text => "640x480",
			   -width => 9,
			   -command => sub {
				 $PixPro           = "pix";
				 $keepaspect       = 1;
				 ($width, $height) = calcSize(640, 480, $origW, $origH);
				 $widthP           = round($width/$origW  * 100);
				 $heightP          = round($height/$origH * 100);
			   })->pack(-side => "left", -padx => 0);
  $csf2->Button(-text => "720x576",
			   -width => 9,
			   -command => sub {
				 $PixPro           = "pix";
				 $keepaspect       = 1;
				 ($width, $height) = calcSize(720, 576, $origW, $origH);
				 $widthP           = round($width/$origW  * 100);
				 $heightP          = round($height/$origH * 100);
			   })->pack(-side => "left", -padx => 0);
  $csf2->Button(-text => "800x600",
			   -width => 9,
			   -command => sub {
				 $PixPro           = "pix";
				 $keepaspect       = 1;
				 ($width, $height) = calcSize(800, 600, $origW, $origH);
				 $widthP           = round($width/$origW  * 100);
				 $heightP          = round($height/$origH * 100);
			   })->pack(-side => "left", -padx => 0);
  $csf2->Button(-text => "1024x768",
			   -width => 9,
			   -command => sub {
				 $PixPro           = "pix";
				 $keepaspect       = 1;
				 ($width, $height) = calcSize(1024, 768, $origW, $origH);
				 $widthP           = round($width/$origW  * 100);
				 $heightP          = round($height/$origH * 100);
			   })->pack(-side => "left", -padx => 0);
  $csf2->Button(-text => "1280x960",
			   -width => 9,
			   -command => sub {
				 $PixPro           = "pix";
				 $keepaspect       = 1;
				 ($width, $height) = calcSize(1280, 960, $origW, $origH);
				 $widthP           = round($width/$origW  * 100);
				 $heightP          = round($height/$origH * 100);
			   })->pack(-side => "left", -padx => 0);

  my $w = 20;
  $myDiag->Checkbutton(-variable => \$keepaspect,
					   -anchor => 'w',
					   -text => "Keep aspect ratio (original size ${origW}x$origH)")->pack(-anchor => 'w');

  $myDiag->Radiobutton(-text => "use absolute size (pixel)", -variable => \$PixPro, -value => "pix")->pack(-anchor => 'w');
  my $labFw  = labeledEntry($myDiag, 'top', $w, "Width  (pixel)", \$width);
  my $labFh  = labeledEntry($myDiag, 'top', $w, "Height (pixel)", \$height);

  $myDiag->Radiobutton(-text => "use relative size (%)",     -variable => \$PixPro, -value => "pro")->pack(-anchor => 'w');
  my $labFwp = labeledEntry($myDiag, 'top', $w, "Width  (%)", \$widthP);
  my $labFhp = labeledEntry($myDiag, 'top', $w, "Height (%)", \$heightP);
  my $labEw  = ($labFw->children)[1];
  my $labEh  = ($labFh->children)[1];
  my $labEwp = ($labFwp->children)[1];
  my $labEhp = ($labFhp->children)[1];
  $labEw->bind('<FocusOut>', sub {
				 if ($keepaspect) {
				   $height = round($width/$aspect); # int() does not round!
				 }
				 $widthP  = round($width/$origW  * 100);
				 $heightP = round($height/$origH * 100);
				 $PixPro  = "pix";
			   });
  $labEh->bind('<FocusOut>', sub {
				 if ($keepaspect) {
				   $width = sprintf("%.0f",($aspect*$height));
				 }
				 $widthP  = round($width/$origW  * 100);
				 $heightP = round($height/$origH * 100);
				 $PixPro  = "pix";
			   });
  $labEwp->bind('<FocusOut>', sub {
				  if ($keepaspect) {
					$heightP = $widthP; # int() does not round!
				  }
				  $width  = round($origW * $widthP/100);
				  $height = sprintf("%.0f",($origH * $heightP/100));
				  $PixPro  = "pro";
				});
  $labEhp->bind('<FocusOut>', sub {
				  if ($keepaspect) {
					$widthP = $heightP;
				  }
				  $width  = round($origW * $widthP/100);
				  $height = sprintf("%.0f",($origH * $heightP/100));
				  $PixPro  = "pro";
				});

  my $filf = $myDiag->Frame()->pack(-fill =>'x',-padx => 3,-pady => 3);

  $filf->Label(-text => "Resize filter", -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w');
  $filf->Optionmenu(-options => [qw(Point Box Triangle Hermite Hanning Hamming Blackman Gaussian Quadratic Cubic Catrom Mitchell Lanczos Bessel Sinc)], -variable => \$config{ResizeFilter}, -textvariable => \$config{ResizeFilter})->pack(-side => "left", -anchor => 'w');

  if ($strip) {
    $myDiag->Checkbutton(-variable => \$config{PicStrip},
		   -anchor => 'w',
		   -text => "Strip all meta info (EXIF, IPTC, ...)")->pack(-anchor => 'w');
  }

  # option to sharpen the image with an unsharp mask operator
  if ($unsharp) {
	my $umF = $myDiag->Frame()->pack(-fill =>'x');

	my $umcB = $umF->Checkbutton(-variable => \$config{Unsharp},
			 	     -anchor => 'w',
			             -text => "Unsharp mask")->pack(-side => "left", -anchor => 'w', -fill => 'x', -expand => 1);
	$balloon->attach($umcB, -msg => "The unsharp option sharpens an image.
We convolve the image with a Gaussian operator of the given radius
and standard deviation (sigma).
For reasonable results, radius should be larger than sigma.
Use a radius of 0 to have the method select a suitable radius.");

	$umF->Button(-text => "Options",
		     -anchor => 'w',
		     -command => sub { unsharpDialog(); })->pack(-side => "left", -anchor => 'w', -padx => 3);
  }

  my $sS = labeledScale($myDiag, 'top', 18, "Sharpness (radius)", \$config{PicSharpen}, 0, 10, 0.1);
  $balloon->attach($sS, -msg => "Resizing a picture to a smaller size usually causes some blurring\nuse this function to sharpen the picture and reduce the blurring\nHowever if the unsharp mask option is available I recommend using it instead of sharpen\nThis function is deactivated when set to 0");

  my $blS = labeledScale($myDiag, 'top', 18, "Blur (radius)", \$config{PicBlur}, 0, 10, 0.1);
  $balloon->attach($blS, -msg => "Maybe used in conjunction with Sharpness"); 

  buttonBackup($myDiag, 'top');
  buttonComment($myDiag, 'top');

  my $ButF = $myDiag->Frame()->pack(-fill =>'x',-padx => 3,-pady => 3);

  my $OKB =	$ButF->Button(-text => 'OK',
						  -command => sub {
							$rc = 1;
							$myDiag->withdraw();
							$myDiag->destroy();
						  })->pack(-side => 'left',-expand => 1,-fill => 'x',-padx => 3,-pady => 3);

  $ButF->Button(-text => 'Cancel',
				-command => sub {
				  $rc = 0;
				  $myDiag->withdraw();
				  $myDiag->destroy();
				}
			   )->pack(-side => 'left',-expand => 1,-fill => 'x',-padx => 3,-pady => 3);

  $OKB->focus;
  $myDiag->Popup;
  $myDiag->waitWindow;
  return if ($rc != 1);

  # check if some files are links
  return if (!checkLinks($picLB, @sellist));
  return if (checkWriteableMulti(@sellist) eq 'Cancel All');

  $userinfo = "changing the size/quality of $selected pictures ..."; $userInfoL->update;

  my $pw = progressWinInit($top, "changing size/quality");
  $i = 0;
  foreach $dpic (@sellist) {
	last if progressWinCheck($pw);
	$i++;
	$pic      = basename($dpic);
	$dirthumb = getThumbFileName($dpic);

	# check if file is a link and get the real target
	next if (!getRealFile(\$dpic));

	next if (!checkWriteable($dpic));

	next if (!makeBackup($dpic));

	my ($w, $h) = getSize($dpic);
	if ($PixPro eq "pro") {
	  if (($w == 0) or ($h == 0)) { # avoid division by zero
		$top->messageBox(-message => "Sorry, but the size of $pic is not available - skipping picture.", -icon => 'warning', -title => "No size info", -type => 'OK');
		next;
	  }
	  $width  = sprintf("%.0f",($w * $widthP/100));
	  $height = sprintf("%.0f",($h * $heightP/100));
	  print "resizing to procent $w $h -> $width $height ($widthP $heightP)\n" if $verbose;
	}

	# call external command mogrify
	# the comment option of mogrify overwrites all existing comments!
	my $command = "mogrify";
	$command .= " -blur ".$config{PicBlur} if ($config{PicBlur} > 0);
	$command .= " -size ${width}x${height}";
	$command .= " -geometry ${width}x${height}";
	$command .= "\\\!" if (!$keepaspect);
	$command .= " -filter ".$config{ResizeFilter};
	$command .= " -strip ".$config{PicStrip} if ($config{PicStrip} and $strip);
	$command .= " -sharpen ".$config{PicSharpen} if ($config{PicSharpen} > 0);
	$command .= " -unsharp ".$config{UnsharpRadius}.'x'.$config{UnsharpSigma}."+".$config{UnsharpAmount}."+".$config{UnsharpThreshold}." " if ($config{Unsharp} and $unsharp);
	$command .= " -quality ".$config{PicQuality}." \"$dpic\"";
	print "changeSizeQuality: com = $command\n" if $verbose;
	execute($command);
	progressWinUpdate($pw, "changing size/quality ($i/$selected) ...", $i, $selected);

	# touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time
	print "new $width x $height old: $w x $h\n" if $verbose;
	touch($dirthumb) if (($width == $w) and ($height == $h)); # only when the size changed
	if ($config{AddMapiviComment}) {
		$command =~ s/\"//g;
		$command = "Picture processed by Mapivi ($mapiviURL):\n".$command;
		addCommentToPic($command, $dpic, NO_TOUCH);
	}

	updateOneRow($dpic, $picLB);

	showImageInfo($dpic) if ($dpic eq $actpic);
  } # foreach end
  progressWinEnd($pw);
  $userinfo = "ready! ($i of $selected changed)"; $userInfoL->update;
  generateThumbs(ASK, SHOW);
}


##############################################################
# dragPic - enable panning of an object in a canvas
#           needs $c->{picWidth} and $c->{picHeight} to be
#           set to the object (picture) width and height
##############################################################
sub dragPic {
  my $c = shift; # the canvas
  my $i = shift; # the item to drag

  $c->bind($i, '<Button-1>'  => sub {
			 ($c->{idx}, $c->{idy})=($Tk::event->x,$Tk::event->y);
		   });

  $c->bind($i, '<B1-Motion>' => sub {
			 # actual mouse coordinates
 			 $c->configure(-cursor => "fleur");
			 my ($mx,$my) = ($Tk::event->x,$Tk::event->y);
			 my ($x1,$x2) = $c->xview;
			 my ($y1,$y2) = $c->yview;
			 return if ($x1 == 0 and $x2 == 1 and $y1 == 0 and $y2 == 1);
			 my $dx = 0; $dx = ($mx-$c->{idx})/$c->{picWidth}  if ($c->{picWidth}  >= 1); # avoid division by zero
			 my $dy = 0; $dy = ($my-$c->{idy})/$c->{picHeight} if ($c->{picHeight} >= 1); # avoid division by zero
			 $c->xviewMoveto($x1-$dx) unless ($x1 == 0 and $x2 == 1);
			 $c->yviewMoveto($y1-$dy) unless ($y1 == 0 and $y2 == 1);
			 ($c->{idx},$c->{idy}) = ($mx,$my);
		   });
}

##############################################################
# filterPic - apply a image filter to the picture
##############################################################
sub filterPic {

  if (Exists($filterW)) {
	$filterW->deiconify;
	$filterW->raise;
	return;
  }

  my $fdir = $actdir;

  return if (!checkExternProgs("filterPic", "mogrify"));

  # check, if a new version of ImageMagick's mogrify with the unsharp and level option is available
  my $unsharp = 0;
  my $level   = 0;
  my $usage   = `mogrify`;
  $unsharp    = 1 if ($usage =~ m/.*-unsharp.*/);
  $level      = 1 if ($usage =~ m/.*-level.*/);

  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);

  # check if some files are links
  return if (!checkLinks($picLB, @sellist));

  my ($pic, $dpic, $dirtpic, $i);

  $userinfo = "image processing: preparing preview ..."; $userInfoL->update;

  # take the first picture as preview picture
  $dpic = $sellist[0];
  $pic  = basename($dpic);

  # open dialog window
  $filterW = $top->Toplevel();
  $filterW->withdraw(); # hide window while populating
  $filterW->title("Image processing $pic");
  $filterW->iconimage($mapiviicon) if $mapiviicon;

  my $p = $filterW;

  my $lF     = $p->Frame()->pack(-anchor => "n", -side => "left");
  my $rF     = $p->Frame()->pack(-anchor => "n", -side => "left");
  my $leftF  = $lF->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-expand => 1, -fill => "both", -side => "left");
  my $rightF = $lF->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-expand => 1, -fill => "both", -side => "right");

  $leftF->Label (-text => "Original")->pack(-fill => 'x');
  $rightF->Label(-text => "Processed")->pack(-fill => 'x');

  my %filters = (
				 "equalize"   => 0,
				 "normalize"  => 0,
				 "despeckle"  => 0,
				 "grayscale"  => 0,
				 "enhance"    => 0,
				 "negate"     => 0,
				 "antialias"  => 0,
				 "contrast"   => 0,
				);

  # try to get the saved filter settings
  if (-f "$configdir/filters") {
	my $hashRef = retrieve("$configdir/filters");
	warn "could not retrieve filter settings" unless defined $hashRef;
	%filters    = %{$hashRef};
  }

  # layout infos:
  # leftF                rightF
  # original             processed
  # $icon($thumb)        $thumbicon($thumbnew)
  # $photo($actdir/pic)  $previewP($prevpic)

  my @xy = (0, 0);
  my $pc;
  my $icon;
  my $thumbicon;
  my $previewP;

  # the preview thumb
  my $thumb      = "$trashdir/$thumbdirname/$pic.jpg";
  my $thumbnew   = "$trashdir/$thumbdirname/$pic";
  my $thumbPreviewB;
  return if (!mycopy   ("$fdir/$pic", "$thumb", OVERWRITE));
  return if (!resizePic("$thumb", $config{FilterPrevSize}, $config{FilterPrevSize}, $config{PicQuality}));

  # the cropped preview pic
  my $prevpic    = "$trashdir/$pic";
  my $previewB;
  return if (!mycopy ("$fdir/$pic", $prevpic, OVERWRITE));
  return if (!cropPic($prevpic, $config{FilterPrevSize}, $config{FilterPrevSize},0,0, $config{PicQuality}));

  if ((defined $thumb) and (-f $thumb)) {
	$icon  = $top->Photo(-file => "$thumb", -gamma => $config{Gamma});
	if ($icon) {
	  $leftF->Label(-image => $icon
					)->pack(-padx => 3, -pady => 3,-anchor => "e");
	  $thumbPreviewB =
	  $rightF->Button(-image => $icon,
					  -command => sub {
						return if !mycopy("$thumb"    , "$thumbnew", OVERWRITE);
						return if !mycopy("$fdir/$pic", "$prevpic" , OVERWRITE);

						# we need to recrop everytime, because the crop sector may be changed by the user
						@xy = getCorners($pc); # get the crop offset
						return if !cropPic($prevpic, $config{FilterPrevSize},$config{FilterPrevSize},$xy[0],$xy[1], $config{PicQuality});

						$filterW->Busy;

						applyFilter("$thumbnew", \%filters, PREVIEW);
						if ($thumbicon) { # if the photo object is already defined we just need to configure it
						  $thumbicon->configure(-file => "$thumbnew", -gamma => $config{Gamma});
						}
						else {            # else we define it
						  $thumbicon = $top->Photo(-file => "$thumbnew", -gamma => $config{Gamma});
						  $thumbPreviewB->configure(-image => $thumbicon);
						}

						applyFilter("$prevpic", \%filters, PREVIEW);
						if ($previewP) { # if the photo object is already defined we just need to configure it
						  $previewP->configure(-file => "$prevpic", -gamma => $config{Gamma});
						}
						else {            # else we define it
						  $previewP = $top->Photo(-file => "$prevpic", -gamma => $config{Gamma});
						  $previewB->configure(-image => $previewP);
						}
						$filterW->Unbusy;

					  })->pack(-padx => 3, -pady => 3,-anchor => 'w');
	  $balloon->attach($thumbPreviewB, -msg => "Press on the thumbnail or the Preview-button\nto see how the settings affect the picture");
	}
  }

  # load the original picture in original size into a scrollable canvas
  # to set the crop frame
  $pc = $leftF->Scrolled("Canvas",
						 -scrollbars => 'osoe',
						 -width  => $config{FilterPrevSize},
						 -height => $config{FilterPrevSize},
						 -relief => 'sunken',
						 #-cursor => "fleur",
						 -bd => $config{Borderwidth})->pack(-expand => 1, -fill => "both");

  # this is needed for dragPic()
  ($pc->{picWidth}, $pc->{picHeight}) = getSize("$fdir/$pic");

  $top->Busy;
  my $photo = $top->Photo(-file => "$fdir/$pic", -gamma => $config{Gamma});
  my $id = $pc->createImage(0, 0, -image => $photo, -anchor => "nw");
  dragPic($pc, $id); # enable panning of the pic in the canvas
  my ($x1, $y1, $x2, $y2) = $pc->bbox($id);
  $pc->configure(-scrollregion => [0, 0, $x2-$x1, $y2-$y1]);

  # load the croped preview picture
  $previewP = $top->Photo(-file => "$prevpic", -gamma => $config{Gamma});
  if ($previewP) {
	$previewB =
	$rightF->Button(-image => $previewP,
					-command => sub {$thumbPreviewB->invoke();},
				   )->pack(-expand => 1, -fill => "both", -padx => 0, -pady => 0, -anchor => "nw");
	$balloon->attach($previewB, -msg => "Press on the picture or the Preview-button\nto see how the settings affect the picture");
  }
  $top->Unbusy;

  my $mF  = $rF->Frame()->pack(-expand => 1, -fill => "both");
  my $lbf = $mF->Frame()->pack(-expand => 1, -fill => "both", -side => "left");
  my $rbf = $mF->Frame()->pack(-expand => 1, -fill => "both", -side => "right");

  foreach (sort keys %filters) {
	$lbf->Checkbutton(-variable => \$filters{$_},
						 -anchor => 'w',
						 -text => "$_")->pack(-anchor => 'w');
  }

  #my $scF = $rF->Frame()->pack(-fill =>'x', -expand => "1");

  my $qS = labeledScale($rF, 'top', 12, "Quality (%)", \$config{PicQuality}, 10, 100, 1);
  qualityBalloon($qS);

  my $sS = labeledScale($rF, 'top', 12, "Sharpness", \$config{PicSharpen}, 0, 10, 0.1);
  $balloon->attach($sS, -msg => "appropriate settings are between 0 (no sharpen) and 4,\nthe higher the value the slower the conversion");

  my $colF = $rF->Frame()->pack(-fill =>'x');

  my $colcB = $colF->Checkbutton(-variable => \$config{ColorAdj},
								 -anchor => 'w',
								 -text => "Color adjustment")->pack(-side => "left", -anchor => 'w', -fill => 'x', -expand => 1);
  $balloon->attach($colcB, -msg => "Adjust brightness, hue,\nsaturation and gamma");

  $colF->Button(-text => "Options",
				-anchor => 'w',
				-command => sub { colorDialog(); })->pack(-side => "left", -anchor => 'w', -padx => 3);

  # sharpen the image with an unsharp mask operator
  if ($unsharp) {
	my $umF = $rF->Frame()->pack(-fill =>'x');
	my $umcB = $umF->Checkbutton(-variable => \$config{Unsharp},
								 -anchor => 'w',
								 -text => "Unsharp mask")->pack(-side => "left", -anchor => 'w', -fill => 'x', -expand => 1);
	$balloon->attach($umcB, -msg => "The -unsharp option sharpens an image.
We convolve the image with a Gaussian operator of the given radius
and standard deviation (sigma).
For reasonable results, radius should be larger than sigma.
Use a radius of 0 to have the method select a suitable radius.");

	$umF->Button(-text => "Options",
				 -anchor => 'w',
				 -command => sub { unsharpDialog(); })->pack(-side => "left", -anchor => 'w', -padx => 3);
  }

  if ($level) {
	my $lvF = $rF->Frame()->pack(-fill =>'x');
	my $lvB = $lvF->Checkbutton(-variable => \$config{Level},
								-anchor => 'w',
								-text => "Level")->pack(-side => "left", -anchor => 'w', -fill => 'x', -expand => 1);
	$balloon->attach($lvB, -msg => "Level adjusts the levels of an image by scaling
the colors falling between specified white and
black points to the full available quantum range.");

	$lvF->Button(-text => "Options",
				 -anchor => 'w',
				 -command => sub { levelDialog(); })->pack(-side => "left", -anchor => 'w', -padx => 3);
  }

  my $decoF = $rF->Frame()->pack(-fill =>'x');
  $decoF->Checkbutton(-variable => \$config{FilterDeco},
					  -anchor => 'w',
					  -text => "Add border or text")->pack(-side => "left", -anchor => 'w', -fill => 'x', -expand => 1);
  $decoF->Button(-text => "Options",
				 -anchor => 'w',
				 -command => sub {decorationDialog(scalar @sellist,0);})->pack(-side => "left", -anchor => 'w', -padx => 3);

  buttonBackup($rF, 'top');
  buttonComment($rF, 'top');

  my $ButF =
	$rF->Frame()->pack(-fill =>'x');

  $ButF->Button(-text => "Preview",
				-command => sub {$thumbPreviewB->invoke();}
			   )->pack(-side => 'left',-expand => 1,-fill => 'x',-padx => 3,-pady => 3);

  my $OKB =
	$ButF->Button(-text => 'OK',
					-command => sub {
					  # save the filter settings
					  nstore(\%filters, "$configdir/filters") or warn "could not store filter settings in file";
					  $uw->withdraw    if (Exists($uw));
					  $lw->withdraw    if (Exists($lw));
					  $colw->withdraw  if (Exists($colw));
					  $decoW->withdraw if (Exists($decoW));
					  $filterW->withdraw(); # close window

					  my $pw = progressWinInit($top, "Process pictures");
					  my $nr = 0;
					  foreach my $dpic (@sellist) {
						last if progressWinCheck($pw);
						$pic = basename($dpic);
						next if (!checkWriteable($dpic));
						last if (!makeBackup($dpic));
						$nr++;
						progressWinUpdate($pw, "processing ($nr/".scalar @sellist.") ...", $nr, scalar @sellist);
						# we need to reread the picture to show the effect,
						# so we should clear the cachedPics list first
						deleteCachedPics($dpic);

						applyFilter($dpic, \%filters, NO_PREVIEW, "processing ($nr/".scalar @sellist.") ...");
						updateOneRow($dpic, $picLB);
						# redisplay the processed picture if it is the actual picture
						showPic($dpic) if ($dpic eq $actpic);
					  }
					  progressWinEnd($pw);
					  reselect($picLB, @sellist);
					  $userinfo = "ready! ($nr of ".scalar @sellist." processed)"; $userInfoL->update;
					  generateThumbs(ASK, SHOW);
					  $filterW->destroy;
					})->pack(-side => 'left',-expand => 1,-fill => 'x',-padx => 3,-pady => 3);

  my $Xbut =
  $ButF->Button(-text => 'Cancel',
				-command => sub { $filterW->destroy  if (Exists($filterW));
								  $uw->destroy       if (Exists($uw));
								  $lw->destroy       if (Exists($lw));
								  $colw->destroy     if (Exists($colw));
								  $decoW->destroy    if (Exists($decoW));
								}
			   )->pack(-side => 'left',-expand => 1,-fill => 'x',-padx => 3,-pady => 3);

  $filterW->bind('<Key-q>',      sub { $Xbut->invoke; });
  $filterW->bind('<Key-Escape>', sub { $Xbut->invoke; });

  $OKB->focus;
  $filterW->Popup;
  $userinfo = "image processing: preview ready!"; $userInfoL->update if (Exists($userInfoL));
  $filterW->waitWindow;

  $userinfo = "image processing: cleaning up ..."; $userInfoL->update if (Exists($userInfoL));
  $icon->delete      if $icon;
  $photo->delete     if $photo;
  $thumbicon->delete if $thumbicon;
  $previewP->delete  if $previewP;
  $uw->destroy       if (Exists($uw));
  $lw->destroy       if (Exists($lw));
  $colw->destroy     if (Exists($colw));
  $decoW->destroy    if (Exists($decoW));
  removeFile($prevpic);
  removeFile($thumb);
  removeFile($thumbnew);
  $userinfo = "image processing ready!"; $userInfoL->update if (Exists($userInfoL));
}

##############################################################
# applyFilter
##############################################################
sub applyFilter {

  my $dpic    = shift;
  my $filters = shift;
  my $preview = shift; # PREVIEW = preview mode, NO_PREVIEW = real conversion
  my $info    = shift; # optional, user info text

  $info = "processing ".basename($dpic)." ..." if (!defined $info);
  $userinfo = $info; $userInfoL->update;

  # check if file is a link and get the real target
  return if (!getRealFile(\$dpic));

  # call external command mogrify
  my $command = "mogrify ";
  foreach (keys %{$filters}) {
	if ($_ eq "grayscale") {
	  $command .= "-colorspace GRAY -colors 256 " if $$filters{$_};
	}
	else {
	  $command .= "-$_ " if $$filters{$_};
	}
   }
  $command .= "-sharpen ".$config{PicSharpen}." " if ($config{PicSharpen} > 0);
  $command .= "-gamma ".$config{PicGamma}." " if (($config{PicGamma} != 1.0) and ($config{ColorAdj}));
  $command .= "-modulate ".$config{PicBrightness}.",".$config{PicSaturation}.",".$config{PicHue}." " if ($config{ColorAdj});
  $command .= makeDrawOptions($dpic) if ((!$preview) and ($config{FilterDeco})); # do not add a border or a text in the preview
  $command .= "-unsharp ".$config{UnsharpRadius}.'x'.$config{UnsharpSigma}."+".$config{UnsharpAmount}."+".$config{UnsharpThreshold}." " if $config{Unsharp};
  $command .= "-level \"".$config{LevelBlack}."%/".$config{LevelWhite}."%/".$config{LevelGamma}."\" " if $config{Level};
  $command .= "-quality ".$config{PicQuality};

  execute($command." \"$dpic\" ");

  addDropShadow($dpic) if ($config{FilterDeco});

  if ($config{AddMapiviComment}) {
	$command =~ s/\"//g;
	$command = "Picture processed by Mapivi ($mapiviURL):\n".$command;
	addCommentToPic($command, $dpic, NO_TOUCH);
  }
  $userinfo = "image processing ready!"; $userInfoL->update;
}

##############################################################
# removeFile - delete a file
##############################################################
sub removeFile {
  my $file = shift;
  return 1 if (!-f $file);
  if ( unlink($file) != 1) { # unlink returns the number of successfull removed files
	$top->messageBox(-icon => 'warning', -message => "Could not delete file \"$file\": $!",
					 -title => 'Error', -type => 'OK');
	return 0;
  }
  else {
	  # remove file from search database, if it exists
	  delete $searchDB{$file};
  }
  return 1;
}

##############################################################
# resizePic
##############################################################
sub resizePic {
  my ($dpic, $x, $y, $quality) = @_;

  unless (-f $dpic) {
	warn "no picture $dpic found!";
	return 0;
  }

  my $command = "mogrify -size ${x}x${y} -geometry ${x}x${y} -quality $quality \"$dpic\" ";
  execute($command);

  return 1;
}

##############################################################
# crop - crop pictures in a lossless way
##############################################################
sub crop {

  if (!checkExternProgs("crop", "jpegtran")) {
	  $top->messageBox(-icon  => 'warning', -message => "Could not find jpegtran, so there is no support for lossless JPEG cropping!\nYou will get jpegtran here: http://jpegclub.org\nNote: Download and install the jpegtran version with crop patch.\nNormal cropping is however possible.",
	-title => "No jpegtran available", -type => 'OK');
  }
  else {
    # check if jpegtran supports lossless cropping
    my $usage = `jpegtran -? 2>&1`;
    if ($usage !~ m/.*-crop.*/) {
	  $top->messageBox(-icon  => 'warning', -message => "Sorry, but your version of jpegtran does not support lossless cropping!\nTry to get the lossless crop patch from http://jpegclub.org.\nNormal cropping is however possible.",
					   -title => "Wrong jpegtran version", -type => 'OK');
    }
  }
  my $lb = shift;				# the reference to the active listbox widget

  my @sellist = $lb->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);

  my ($pic, $dpic, $w, $h, $wo, $ho, $x, $y);
  my $i          = 0;
  my $doforall   = 0;
  my $askDifSize = 1;
  my $first      = $sellist[0];
  my ($wm, $hm) = getSize($first);

  my $pw = progressWinInit($lb, "Crop pictures");
  foreach $dpic (@sellist) {
	last if progressWinCheck($pw);
	$i++;
	progressWinUpdate($pw, "cropping picture ($i/".scalar @sellist.") ...", $i, scalar @sellist);
	$pic = basename($dpic);

	# check if file is a link and get the real target
	next if (!getRealFile(\$dpic));

	next if (!checkWriteable($dpic));

	($wo, $ho) = getSize($dpic);

	if ($wo == 0 or $ho == 0) {
	  $top->messageBox(-icon  => 'warning', -message => "Sorry, picture $pic has no correct size (${wo}x$ho)!",
					   -title => "Crop file", -type => 'OK');
	  next;
	}

	if ($doforall and $askDifSize and (($wo != $wm) or ($ho != $hm))) {
	  my $rc = $top->messageBox(-icon    => 'question',
								-message => "Picture $pic has not the same size as the preview picture.\nShould I continue and adjust the crop range if necessary?\nNote:\nThis will be done for all following pictures too!",
								-title => "Question",
								-type => 'OKCancel');
	  if ($rc !~ m/Ok/i) {
		$i--;
		last;
	  }
	  else {
		$askDifSize = 0;
	  }
	}

	if (!$doforall) {
	  ($w, $h) = calcAspectSize($wo, $ho);
	  $x  = 0;
	  $y  = 0;
	  last if (!cropDialog($dpic, \$x, \$y, \$w, \$h, $wo, $ho, \$doforall, scalar @sellist));
	  print "cropDialog returned $pic x:$x y:$y w:$w  h:$h" if $verbose;
	}

	# save crop frame offset before adjusting too small pics
	my $xsave = $x;	my $ysave = $y;

	if (($x + $w) > $wo) { # crop frame outside the picture
	  $x = $wo - $w;
	  if ($x < 0) {
		$top->messageBox(-icon  => 'warning', -message => "Skipping picture $pic!\nThe width ($wo) is too small for the crop frame ($w).",
						 -title => "Picture too small", -type => 'OK');
		# restore crop frame offset after adjusting to small pics
		$x = $xsave; $y = $ysave;
		next;
	  }
	}
	if (($y + $h) > $ho) { # crop frame outside the picture
	  $y = $ho - $h;
	  if ($y < 0) {
		$top->messageBox(-icon  => 'warning', -message => "Skipping picture $pic!\nThe height ($ho) is too small for the crop frame ($h).",
						 -title => "Picture too small", -type => 'OK');
		# restore crop frame offset after adjusting to small pics
		$x = $xsave; $y = $ysave;
		next;
	  }
	}
	printf "cropping $pic %4dx%4d+%4d+%4d\n", $w, $h, $x, $y if $verbose;

	next if (!makeBackup($dpic));

	# crop the picture
	$top->Busy;
	cropPic($dpic,$w,$h,$x,$y,95);
	$top->Unbusy;

	# check if crop has the right size
	# due to the 8 pixel blocks, sometimes the size is too big (a few pixels)
	my ($nw, $nh) = getSize($dpic);
	if (($nw > $w) or ($nh > $h)) {
	  # but a recrop will help ...
	  $top->Busy;
	  cropPic($dpic,$w,$h,0,0,95);
	  $top->Unbusy;
	  print "recropping $pic w:$nw > $w h: $nh > $h n" if $verbose;
	}

	# restore crop frame offset after adjusting to small pics
	$x = $xsave; $y = $ysave;

	addCommentToPic("Picture lossless cropped by Mapivi ($mapiviURL)", $dpic, NO_TOUCH) if ($config{AddMapiviComment});

	updateOneRow($dpic, $lb);

	deleteCachedPics($dpic);
	showPic($dpic) if ($dpic eq $actpic); # redisplay the picture if it is the actual one
  } # foreach end
  progressWinEnd($pw);

  reselect($lb, @sellist);
  $userinfo = "ready! ($i of ".scalar @sellist." cropped)"; $userInfoL->update;
  generateThumbs(ASK, SHOW);
}

##############################################################
# calcAspectSize
##############################################################
sub calcAspectSize {

  my $w  = shift;				# width
  my $h  = shift;				# height
  my $m  = shift;				# (optional) master ('w' if the width is the master or "h" for height)

  # calculate new size
  if ($config{CropAspect} != 0) {   # if there is no aspect ratio there is nothing to do
	if (defined $m) {                # master defined
	  if ($m eq 'w') {               # width is master
		if ($w >= $h) {			     # landscape image
		  $h = sprintf "%.0f", ($w / $config{CropAspect}); # int() does not round!
		} else {				     # portait image
		  $h = sprintf "%.0f", ($w * $config{CropAspect});
		}
	  } else {                       # height is master
		if ($w >= $h) {			     # landscape image
		  $w = sprintf "%.0f", ($h * $config{CropAspect});
		} else {				     # portait image
		  $w = sprintf "%.0f", ($h / $config{CropAspect}); # round
		}
	  }
	} else {                         # no master defined
	  if ($w >= $h) {			     # landscape image
		if (($h != 0) and ($w/$h >= $config{CropAspect})) { # too wide
		  $w = sprintf "%.0f", ($h * $config{CropAspect}); # round
		} else {				     # too high
		  $h = sprintf "%.0f", ($w / $config{CropAspect}); # round
		}
	  } else {					     # portait image
		if (($h != 0) and ($w/$h >= 1/$config{CropAspect})) { # too wide
		  $w = sprintf "%.0f", ($h / $config{CropAspect}); # round
		} else {				     # too high
		  $h = sprintf "%.0f", ($w * $config{CropAspect}); # round
		}
	  }
	}
  }
  return ($w, $h);
}

##############################################################
# setNewAspect
##############################################################
sub setNewAspect {
  my $c = shift;
  my $info_ref = shift;
  my $w = $c->{m_x2} - $c->{m_x1};
  my $h = $c->{m_y2} - $c->{m_y1};
  ($w, $h) = calcAspectSize($w, $h);
  $c->{m_x2} = $c->{m_x1} + $w;
  $c->{m_y2} = $c->{m_y1} + $h;
  $c->{m_aspect} = getAspectRatio($w, $h);
  drawFrame($c);
}

##############################################################
# bindForResize
# based on code from Jason Tiller and Ala Qumsieh posted in the Perl/TK (ptk; comp.lang.perl.tk) list in 2003
##############################################################
sub bindForResize {
   my $canvas = shift;

   # Drag requests:
   # 0 = No drag requested in this direction.
   # 1 = Drag top (for y) or left (for x) edge of rectangle.
   # -1 = Drag bottom (for y) or right (for x) edge of rectangle.
   my ( $dx, $dy ) = ( 0, 0 );

   # Drag mode: NO_ACTIVE_MODE, MOVE_MODE, or RESIZE_MODE.
   use constant M_NO_ACTIVE_MODE => 0;
   use constant M_MOVE_MODE => 1;
   use constant M_RESIZE_MODE => 2;
   my $mode = M_NO_ACTIVE_MODE;

   # How close to the edge we have to be to initiate a resize (instead
   # of a move) drag.  Expressed in percentage of overall
   # height/width.
   my $resize_within = 0.05; # Within 5% of edge to resize.

   # Initial location of mouse pointer.
   my ($oldx, $oldy) = (0) x 2;

   # ID of rectangle that we're resizing.
   my $rect;

   # Bind left-mouse clicks (<1>) over any widget with a 'RECT' tag to
   # do...
   $canvas->CanvasBind('<1>' =>
      sub {
         my ( $x, $y ) = ( $Tk::event->x, $Tk::event->y );
         my ( $x0, $y0, $x1, $y1 ) = $canvas->coords( 'RECT' );
         return if ( !defined $x0 or !defined $y0 or !defined $x1 or !defined $y1 or $x < $x0 or $x > $x1 or $y < $y0 or $y > $y1);
         #my ( $x0, $y0, $x1, $y1 ) = $canvas->coords( 'RECT' );

         my ( $width, $height ) = ( $x1 - $x0, $y1 - $y0 );

         # Determine if the user wants to size in the x direction.  If
         # the user clicks within $resize_within of the edge, then he
         # wants to resize.
          $dx = 0;
          if(    $x < ( $x0 + $resize_within * $width ) ) { $dx =  1; }
          elsif( $x > ( $x1 - $resize_within * $width ) ) { $dx = -1; }

          # Do the same for the y direction.
          $dy = 0;
          if(    $y < ( $y0 + $resize_within * $width ) ) { $dy =  1; }
          elsif( $y > ( $y1 - $resize_within * $width ) ) { $dy = -1; }

         # If resizing in either direction, set resize mode.
         $mode = ( $dx || $dy ) ? M_RESIZE_MODE : M_MOVE_MODE;
         my $id = $canvas ->find( qw|withtag RECT| );
         ( $oldx, $oldy, $rect ) = ( $x, $y, $id );

         return;
      }
   );

   # Bind motion with the left mouse button down (<B1-Motion>) over a
   # widget with a 'RECT' tag to do...
   $canvas->CanvasBind('<B1-Motion>' =>
      sub {
         my ( $x, $y ) = ( $Tk::event->x, $Tk::event->y );
         #print "B1 Motion: $x $y\n";
         if( $mode == M_RESIZE_MODE ) {
            #print "M_RESIZE_MODE\n";
            # Get coordinates of resizing rectangle. 
            my ( $x0, $y0, $x1, $y1 ) = $canvas->coords( 'RECT' );

            # Resize logic.  If we're moving the left border, then
            # change the coordinates of the left edge ($x0) to be the
            # current mouse position's x position ($x), else set the
            # rectangle's right edge.
            if    ( $dx ==  1 ) { $x0 = $x; }
            elsif ( $dx == -1 ) { $x1 = $x; }

            if    ( $dy ==  1 ) { $y0 = $y; }
            elsif ( $dy == -1 ) { $y1 = $y; }

			$x0 = 0 if ($x0 < 0);
			$x1 = $canvas->width if ($x1 > $canvas->width);
			$y0 = 0 if ($y0 < 0);
			$y1 = $canvas->height if ($y1 > $canvas->height);
            # Set the coordinates of the resizing rectangle.
            $canvas->coords( 'RECT', $x0, $y0, $x1, $y1 );
            draw_grid($canvas, $x0, $y0, $x1, $y1);
         } else {
            #print "M_MOVE_MODE\n";
            my ( $x0, $y0, $x1, $y1 ) = $canvas->coords( 'RECT' );
            return if ( !defined $x0 or !defined $y0 or !defined $x1 or !defined $y1 or $x < $x0 or $x > $x1 or $y < $y0 or $y > $y1);
            # Move the rectangle under mouse pointer relative to its
            # old position.
            $canvas->move( $canvas->find( 'withtag', 'RECT' ),
                           $x - $oldx,
                           $y - $oldy );
            draw_grid($canvas, $canvas->coords( 'RECT' ));
            # Update "old" coordinates.
            ( $oldx, $oldy ) = ( $x, $y );
         }
      }
   );

   # Set to false when we've changed the cursor.  Tells us we want to
   # reset the cursor when we leave a rectangle.
   my $cursor_is_normal = 1;

   # Maps cursor position to cursor shape.
   # 0 = middle of shape, 1 = left/top edge, 2 = right/bottom edge.
   # [$x][$y]
   my @cursors = (
      # [ (0,0),    (0,1),        (0,2) ]
      [    'fleur', 'top_side', 'bottom_side' ],
      # [ (1,0),       (1,1),             (1,2) ]
      [    'left_side', 'top_left_corner', 'bottom_left_corner' ],
      # [ (2,0),        (2,1),              (2,2) ]
      [    'right_side', 'top_right_corner', 'bottom_right_corner' ]
   );
   my @old_cursors = ( 3, 3 ); # ( x, y )

   $canvas->CanvasBind( '<B1-ButtonRelease>' =>
      sub {
		 my @coords = $canvas->coords( 'RECT' );
         $mode = M_NO_ACTIVE_MODE;
         $canvas->configure( -cursor => 'left_ptr' );
         @old_cursors = ( 3, 3 );
         $cursor_is_normal = 1;
		 drawFrame($canvas, @coords);
		 $canvas->raise($rect);
      }
   );

   # Update the mouse cursor based on where the pointer is on the
   # canvas.  If it's not over a rectangle, set it to the default
   # ('left_ptr').  If it's over a rectangle, set to a target cursor
   # if the pointer is in the drag region (center) else to a resize
   # cursor.
   $canvas->CanvasBind( '<Motion>' =>
      sub {
	     #print "CanvasBind Motion\n";
         #my $id = $canvas->find( qw|withtag current| );
		 #my @tags = $canvas->gettags($id);
		 #for (0 .. $#tags) { print "$_ $tags[$_]\n"; }
         # Bail if we're not over a rectangle.

         my ( $x, $y ) = ( $Tk::event->x, $Tk::event->y );
         my ( $x0, $y0, $x1, $y1 ) = $canvas->coords( 'RECT' );

         if ( !defined $x0 or !defined $y0 or !defined $x1 or !defined $y1 or $x < $x0 or $x > $x1 or $y < $y0 or $y > $y1) {
            unless( $cursor_is_normal ) {
               $canvas->configure( -cursor => 'left_ptr' );
               @old_cursors = ( 3, 3 );
               $cursor_is_normal = 1;
            }
            return;
         }

         # Don't update the cursor once we've started a drag or resize
         # operation.
         return unless $mode == M_NO_ACTIVE_MODE;

         my( $width, $height ) = ( $x1 - $x0, $y1 - $y0 );

         # Now figure out where we are in the widget.
         my ( $px, $py ) = ( 0, 0 );

         # Determine if the user wants to size in the x direction.  If
         # the user clicks within $resize_within of the edge, then he
         # wants to resize.
         if(    $x > ( $x1 - $resize_within * $width ) ) { $px = 2; }
         elsif( $x < ( $x0 + $resize_within * $width ) ) { $px = 1; }

         # Do the same for the y direction.
         if( $y > ( $y1 - $resize_within * $width ) ) { $py = 2; }
         if( $y < ( $y0 + $resize_within * $width ) ) { $py = 1; }

         # Don't update cursor unless it's changed.
         return if ( $px == $old_cursors[0] and $py == $old_cursors[1] );

         $canvas->configure( -cursor => $cursors[$px][$py] );
         @old_cursors = ( $px, $py );
         $cursor_is_normal = 0;
	   }
	);
}

##############################################################
# cropDialog - let the user set the crop offset
##############################################################
sub cropDialog {
  my ($dpic, $xr, $yr, $wr, $hr, $wo, $ho, $doforallr, $nr) = @_;

  # $xr, $yr, $wr $hr x,y-offset and width and height of crop frame (type: reference on scalar)
  # $wo, $ho width and height of original picture (type: scalar)
  # $doforallr bool (type: reference on scalar)
  # $nr number of pics to crop

  my $rc;
  my $pc; # the canvas widget
  my $x2 = $$xr + $$wr;
  my $y2 = $$yr + $$hr;
  $userinfo = "crop: creating preview picture ..."; $userInfoL->update;
  my $zpic = "$trashdir/".basename($dpic);
  warn "copy error" if (!mycopy($dpic, $zpic, OVERWRITE));
  my $per = 0.75;				# preview pic should be 75% of the min screen size
  my $cropPreviewSize = int($per * $top->screenwidth);
  $cropPreviewSize = int($per * $top->screenheight) if ($top->screenheight < $top->screenwidth);
  # just shrink big pictures, do not blow up small ones
  my $command = 'mogrify -geometry "'.$cropPreviewSize.'x'.$cropPreviewSize.'>" -quality 80 "'.$zpic.'"';
  print "croppreview: $command\n" if $verbose;
  $top->Busy;
  (system $command) == 0 or warn "$command failed: $!";
  $top->Unbusy;
  $userinfo = "ready!"; $userInfoL->update;

  if (!-f $zpic) {
	$top->messageBox(-icon  => 'warning', -message => "Sorry, error zooming $dpic!",
					 -title => "Crop file", -type => 'OK');
	return 0;
  }

  # open window
  my $cropW = $top->Toplevel();
  $cropW->title("Crop picture (lossless)");
  $cropW->iconimage($mapiviicon) if $mapiviicon;

  my $cropFL = $cropW->Frame()->pack(-side => "left", -anchor => 'w');
  my $cropFR = $cropW->Frame()->pack(-side => "left", -anchor => 'n');

  my ($zpicx, $zpicy) = getSize($zpic);
  my $fc = $cropFL->Frame()->pack();
  $pc = $fc->Canvas(-width  => $zpicx,
					-height => $zpicy,
					-relief => 'sunken',
					-bd     => $config{Borderwidth})->pack(-side => "left", -padx => 3);

  # store some values in the canvas hash
  $pc->{m_aspect} = "[x:y]";
  $pc->{m_wo}     = $wo;
  $pc->{m_ho}     = $ho;

  my $fF = $cropFR->Frame(-bd => $config{Borderwidth}, -relief => 'groove' )->pack(-anchor => 'w', -padx => 3, -pady => 3, -expand => 0, -fill => 'x');
  $fF->Label(-text => "Help")->pack(-expand => 0, -fill => 'x');
  my $rotext = $fF->ROText(-wrap => "word", -bg => $config{ColorBG},
						   -bd => "0", -width => 26, -height => 3)->pack(-expand => 0, -fill => 'x', -anchor => 'w');
  $rotext->insert('end', "Use left mouse button to move and to adjuste the crop frame");
  $fF->Checkbutton(-variable => \$config{CropGrid},
						 -anchor   => 'w',
						 -text     => 'display 1/3 crop grid',
						 -command  => sub { drawFrame($pc); },
						)->pack(-anchor => 'w');

  my $iF = $cropFR->Frame(-bd => $config{Borderwidth}, -relief => 'groove' )->pack(-anchor => 'w', -padx => 3, -pady => 3, -expand => 0, -fill => 'x');
  $iF->Label(-text => "Info")->pack(-expand => 0, -fill => 'x');
  $iF->Label(-text => "File: ".basename($dpic), -bg => $config{ColorBG})->pack(-anchor => 'w');
  $iF->Label(-text => "old size: ${wo} x ${ho}", -bg => $config{ColorBG})->pack(-anchor => 'w');
  my $lf = $iF->Frame()->pack(-anchor => 'w');
  $lf->Label(-text => "new size:",    -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w');
  $lf->Label(-textvariable => \$pc->{m_w},  -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w');
  $lf->Label(-text => 'x',            -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w');
  $lf->Label(-textvariable => \$pc->{m_h},  -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w');
  my $caF = $iF->Frame()->pack(-anchor => 'w');
  $caF->Label(-text => "crop area:",   -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w');
  $caF->Label(-textvariable => \$pc->{m_xyxy}, -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w');


  my $cropRect;
  my @cropRectCoords;

  #$pc->bind('<Any-Enter>' => sub { $pc->Tk::focus });

  bindForResize($pc);

  my $zpicP = $cropFL->Photo(-file => "$zpic", -gamma => $config{Gamma}) if (-f $zpic);
  if (!$zpicP) {
	$top->messageBox(-icon  => 'warning', -message => "Error displaying $zpic!",
					 -title => "Crop file", -type => 'OK');
	return 0;
  }

  # insert pic
  my $id = $pc->createImage(0, 0, -image => $zpicP, -anchor => "nw", -tags =>"PIC") if $zpicP;

  my ($px1, $py1, $px2, $py2) = $pc->bbox($id);
  print "cropDialog: x1 $px1 x2 $px2 y1 $py1 y2 $py2 $wo $ho\n" if $verbose;

  if (($px1 == $px2) or ($py1 == $py2)) {
	$top->messageBox(-icon  => 'warning', -message => "Error displaying $zpic!",
					 -title => "Crop file", -type => 'OK');
	return 0;
  }
  # calculate the x and y zoom factor
  my $xz = $wo/($px2-$px1);
  my $yz = $ho/($py2-$py1);
  # store info in canvas widget
  $pc->{m_xzoom} = $xz;
  $pc->{m_yzoom} = $yz;

  $pc->{m_step} = 16;   # resolution/step width for lossless crop must be 16 or 8, depends on picture encoding

  plusMinusEntry($iF, \$pc->{m_y1}, \$pc->{m_step}, 0, $ho, \&drawFrame, $pc, 'h');
  my $iF1 = $iF->Frame()->pack();
  my $iF11 = $iF1->Frame()->pack(-side => 'left');
  my $iF12 = $iF1->Frame()->pack(-side => 'left');
  plusMinusEntry($iF11, \$pc->{m_x1}, \$pc->{m_step}, 0, $wo, \&drawFrame, $pc, 'w');
  plusMinusEntry($iF12, \$pc->{m_x2}, \$pc->{m_step}, 0, $wo, \&drawFrame, $pc, 'w');
  plusMinusEntry($iF, \$pc->{m_y2}, \$pc->{m_step}, 0, $ho, \&drawFrame, $pc, 'h');

  my $stepF = $iF->Frame()->pack(-anchor => 'w');
  $stepF->Label(-text => "step width")->pack(-side => 'left', -anchor => 'w');
  $stepF->Radiobutton(-variable => \$pc->{m_step},
					  -anchor   => 'w',
					  -text     => "1",
					  -value    =>  1,
					 )->pack(-side => 'left', -anchor => 'w');
  $stepF->Radiobutton(-variable => \$pc->{m_step},
					  -anchor   => 'w',
					  -text     => "8",
					  -value    =>  8,
					 )->pack(-side => 'left', -anchor => 'w');
  $stepF->Radiobutton(-variable => \$pc->{m_step},
					  -anchor   => 'w',
					  -text     => "16",
					  -value    =>  16,
					 )->pack(-side => 'left', -anchor => 'w');

  my $aF = $cropFR->Frame(-bd => $config{Borderwidth}, -relief => 'groove' )->pack(-anchor => 'w', -padx => 3, -pady => 3, -expand => 0, -fill => 'x');
  $aF->Label(-text => "Aspect ratio")->pack(-expand => 0, -fill => 'x');
  my $aspF = $aF->Frame()->pack(-anchor => 'w');
  $aspF->Label(-text => "actual aspect ratio:",  -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w');
  $aspF->Label(-textvariable => \$pc->{m_aspect}, -width => 8, -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w');
  my $dummy;
  $aF->Optionmenu(-variable => \$config{CropAspect}, -options => [
  ['X:Y (any aspect ratio)' => 0],
  ['3:2 (e.g. 10x15)' => 3/2],
  ['4:3' => 4/3],
  ['5:4 (PAL)' => 5/4],
  ['7:5 (e.g. 13x18)' => 7/5],
  ['16:9' => 16/9],
  ['1:1' => 1/1], ], -textvariable => \$dummy)->pack(-side => 'top', -anchor => 'w');

#   my $portLandB =
# 	$aF->Button(-text => "portrait/landscape",
# 				-command => sub {
# 				  my $tmp = $$wr;
# 				  $$wr = $$hr;
# 				  $$hr = $tmp;
# 				  if ($$wr+$$xr > $wo) {
# 					$$wr = $wo - $$xr;
# 					($$wr, $$hr) = calcAspectSize($$wr, $$hr);
# 				  }
# 				  if ($$hr+$$yr > $ho) {
# 					$$hr = $ho - $$yr;
# 					($$wr, $$hr) = calcAspectSize($$wr, $$hr);
# 				  }
# 				  $x2 = $$xr + $$wr;
# 				  $y2 = $$yr + $$hr;
# 				  #$xyxy = sprintf "%d,%d - %d,%d", $$xr, $$yr, ($$xr + $$wr), ($$yr + $$hr);
# 				  #$aspect = getAspectRatio($$wr, $$hr);
# 				  drawFrame($pc, $$xr, $$yr, $$wr, $$hr, $xz, $yz);
# 				})->pack(-fill => 'x', -padx => 3, -pady => 3);
#   $balloon->attach($portLandB, -msg => "Switch crop frame between portrait and landscape mode");

  buttonBackup($cropFR, 'top');
  buttonComment($cropFR, 'top');

  if ($nr > 1) {
	$cropFR->Checkbutton(-variable => \$$doforallr,
						 -anchor   => 'w',
						 -text     => "use this setting for all pics"
						)->pack(-anchor => 'w');
  }

  my $ButF =
	$cropFR->Frame()->pack(-fill =>'x', -expand => 1, -padx => 0, -pady => 2);

  my $OKB =
	$ButF->Button(-text => 'OK',
				  -command => sub {
					$$xr = $pc->{m_x1};
					$$yr = $pc->{m_y1};
					$$wr = $pc->{m_x2} - $pc->{m_x1};
					$$hr = $pc->{m_y2} - $pc->{m_y1};
					$cropW->withdraw();
					$rc = 1;
					$cropW->destroy();
				  })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  my $Xbut =
	$ButF->Button(-text => 'Cancel',
				  -command => sub { $rc = 0;
									$cropW->withdraw();
									$cropW->destroy();
								  })->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 3, -pady => 3);

  $cropW->bind('<Control-q>',  sub { $Xbut->invoke; });
  $cropW->bind('<Key-Escape>', sub { $Xbut->invoke; });

  # first popup the window then draw the frame!
  $cropW->Popup;
  $cropW->update;
  my $distx = int($zpicx/10);
  my $disty = int($zpicy/10);
  drawFrame($pc, $distx, $disty, ($zpicx-$distx), ($zpicy-$disty));

  $cropW->waitWindow;

  # clean up
  $zpicP->delete;
  removeFile($zpic);

  return $rc;
}

##############################################################
# plusMinusEntry
##############################################################
sub plusMinusEntry {
  my ($widget, $value, $step, $min, $max, $callback, $cb_para1, $cb_para2) = @_;
  $$value = 0 unless (defined $$value);
  my $frame = $widget->Frame(-relief => 'sunken')->pack();
  $frame->Label(-textvariable => $value, -bg => $config{ColorBG}, -width => 6)->pack(-side => 'left', -anchor => 'w');
  my $r_frame = $frame->Frame()->pack(-side => 'left', -padx => 0, -pady => 0);
  $r_frame->Button(-bitmap => "plusbut", -padx => 0, -pady => 0, -command => sub {
				   $$value += $$step;
				   $$value = $min if ($$value < $min);
				   $$value = $max if ($$value > $max);
				   $callback->($cb_para1, $cb_para2);
				 })->pack(-anchor => 'w', -padx => 0, -pady => 0);
  $r_frame->Button(-bitmap => "minusbut", -padx => 0, -pady => 0, -command => sub {
				   $$value -= $$step;
				   $$value = $min if ($$value < $min);
				   $$value = $max if ($$value > $max);
				   $callback->($cb_para1, $cb_para2);
				 })->pack(-anchor => 'w', -padx => 0, -pady => 0);
}

##############################################################
# normalizeCoords - assign coordinates to allowed values (stepwidth)
##############################################################
sub normalizeCoords {
  my $canvas = shift;
  foreach my $coord (qw(m_x1 m_x2 m_y1 m_y2)) {
	# assign it to the step width
	$canvas->{$coord} = sprintf "%.0f", ($canvas->{$coord}/$canvas->{m_step});
	$canvas->{$coord} *= $canvas->{m_step};
	# check lower bound
	$canvas->{$coord} = 0 if ($canvas->{$coord} < 0);
  }

  # check upper bound
  foreach my $coord (qw(m_x1 m_x2)) {
	$canvas->{$coord} = $canvas->{m_wo} if ($canvas->{$coord} > $canvas->{m_wo});
  }
  foreach my $coord (qw(m_y1 m_y2)) {
	$canvas->{$coord} = $canvas->{m_ho} if ($canvas->{$coord} > $canvas->{m_ho});
  }
}

##############################################################
# drawFrame
##############################################################
sub drawFrame {

	my $canvas = shift;
	my @coords;
	my $direction = 'h';

	if (@_ == 4) { # canvas coordinates are given
	  @coords = @_;
	  $canvas->{m_x1} = int($coords[0] * $canvas->{m_xzoom});
	  $canvas->{m_y1} = int($coords[1] * $canvas->{m_yzoom});
	  $canvas->{m_x2} = int($coords[2] * $canvas->{m_xzoom});
	  $canvas->{m_y2} = int($coords[3] * $canvas->{m_yzoom});
	  normalizeCoords($canvas);
	}
	elsif (@_ == 0) { # use the real coordinates
	  normalizeCoords($canvas);
	  $coords[0] = int($canvas->{m_x1} / $canvas->{m_xzoom});
	  $coords[1] = int($canvas->{m_y1} / $canvas->{m_yzoom});
	  $coords[2] = int($canvas->{m_x2} / $canvas->{m_xzoom});
	  $coords[3] = int($canvas->{m_y2} / $canvas->{m_yzoom});
	}
	elsif (@_ == 1) { # optional direction h or w
	  $direction = shift;
	  normalizeCoords($canvas);
	}
	else {
	  warn "drawFrame:: error wrong number of args ".scalar @_."\n";
	  return;
	}

	my $w = $canvas->{m_x2} - $canvas->{m_x1};
	my $h = $canvas->{m_y2} - $canvas->{m_y1};
	($w, $h) = calcAspectSize($w, $h, $direction);
	#($w, $h) = calcAspectSize($w, $h);
	$canvas->{m_x2} = $canvas->{m_x1} + $w;
	$canvas->{m_y2} = $canvas->{m_y1} + $h;
	$canvas->{m_xyxy} = $canvas->{m_x1}.",".$canvas->{m_y1}." - ".$canvas->{m_x2}.",".$canvas->{m_y2};
	$canvas->{m_w}    = $w;
	$canvas->{m_h}    = $h;
	$canvas->{m_aspect} = getAspectRatio($w, $h);

	$coords[0] = int($canvas->{m_x1} / $canvas->{m_xzoom});
	$coords[1] = int($canvas->{m_y1} / $canvas->{m_yzoom});
	$coords[2] = int($canvas->{m_x2} / $canvas->{m_xzoom});
	$coords[3] = int($canvas->{m_y2} / $canvas->{m_yzoom});

	$canvas->delete('withtag', 'RECT');
	$canvas->createRectangle(@coords, -tags => ['RECT'], -outline => 'red');

    # draw 1/3 grid - divide the crop frame in nine rectangles
    draw_grid($canvas, @coords);

	#my $rect = $canvas->find('withtag', 'RECT');
	#$canvas->coords( $rect => @coords );
	$canvas->raise('RECT');
	# black dashed line
#	$canvas->createRectangle( @coords,
#							  -tags => ['RECT'],
#							  -outline => "black",
#							  -dash => [6,4,2,4],
#							  );
	# white dashed line
#	$canvas->createRectangle( @coords,
#							  -tags => ['RECT'],
#							  -outline => "white",
#							  -dash => [2,6,2,4],
#							  );
}

##############################################################
##############################################################
sub draw_grid {
    my $canvas = shift;
	my @coords = @_;
    # draw 1/3 grid - divide the crop frame in nine rectangles
	$canvas->delete('withtag', 'GRID');
	if ($config{CropGrid}) {
      my $grid_dist_h = round(($coords[3] - $coords[1])/3);
      my $grid_dist_w = round(($coords[2] - $coords[0])/3);
	  $canvas->createLine($coords[0],$coords[1] + $grid_dist_h,  $coords[2],$coords[1] + $grid_dist_h,   -dash => [6,4,2,4],-tags => ['GRID'], -width => 1, -fill => '#ccc');
	  $canvas->createLine($coords[0],$coords[1] + 2*$grid_dist_h,$coords[2],$coords[1] + 2*$grid_dist_h, -dash => [6,4,2,4],-tags => ['GRID'], -fill => '#ccc');
	  $canvas->createLine($coords[0] + $grid_dist_w,  $coords[1],$coords[0] + $grid_dist_w,$coords[3],   -dash => [6,4,2,4],-tags => ['GRID'], -fill => '#ccc');
	  $canvas->createLine($coords[0] + 2*$grid_dist_w,$coords[1],$coords[0] + 2*$grid_dist_w,$coords[3], -dash => [6,4,2,4],-tags => ['GRID'], -fill => '#ccc');
	}

	$canvas->delete('withtag', 'FRAME');

	# draw a pseudo transparent box around the crop frame
	$canvas->createRectangle( 1, 1, $coords[0], $canvas->height-1,
							  -tags => ['FRAME'],
							  -outline => undef,
							  -fill => 'black',
							  -stipple => 'transp',
							  );
	$canvas->createRectangle( $coords[0], 1, $canvas->width-1, $coords[1],
							  -tags => ['FRAME'],
							  -outline => undef,
							  -fill => 'black',
							  -stipple => 'transp',
							  );
	$canvas->createRectangle( $coords[2], $coords[1], $canvas->width-1, $canvas->height-1,
							  -tags => ['FRAME'],
							  -outline => undef,
							  -fill => 'black',
							  -stipple => 'transp',
							  );
	$canvas->createRectangle( $coords[0], $coords[3], $coords[2], $canvas->height-1,
							  -tags => ['FRAME'],
							  -outline => undef,
							  -fill => 'black',
							  -stipple => 'transp',
							  );
}

##############################################################
# cropPic - cut a rect out of the pic
#           needs a geometry (e.g. 200x200+33+66)
#           overwrites the given file!!!
#           returns true if it worked
##############################################################
sub cropPic {
  my $dpic = shift; return 0 if (!-f $dpic);  # pic will be overwritten!!!
  my $w   = shift;                          # width
  my $h  = shift;                           # height
  my $x   = shift;                          # x offset
  my $y   = shift;                          # y offset
  my $qua = shift;                          # quality

  my ($pw, $ph) = getSize($dpic);
  #return 1 if (($pw <= $w) and ($ph <= $h));
  # if the requested size is bigger than the pic we adapt to the real pic size
  $w = $pw if ($w > $pw);
  $h = $ph if ($h > $ph);

  my $geo = "${w}x${h}+${x}+${y}";

  my $command = "";

  # try to use lossless cropping for JPEGs if available
  if (is_a_JPEG($dpic) and checkExternProgs("crop", "jpegtran")) {
	# check if jpegtran supports lossless cropping
	my $usage = `jpegtran -? 2>&1`;
	if ($usage =~ m/.*-crop.*/) {
	  $command = "jpegtran -copy all -crop $geo -outfile \"$dpic\" \"$dpic\"";
      print "$dpic: cropping lossless using jpegtran\n" if $verbose;
	}
  }

  # the fallback solution
  if ($command eq "") {
	$command = "mogrify -crop $geo -quality $qua \"$dpic\"";
    print "$dpic: cropping lossy using mogrify (reason: not a JPEG or wrong jpegtran version\n"; # if $verbose;
  }

  if ((system $command) != 0) {
	warn "$command failed: $!";
	return 0;
  }
  else {
	return 1;
  }
}

##############################################################
# mycopy
##############################################################
sub mycopy {
  my $from      = shift;
  my $to        = shift;
  my $overwrite = shift; # OVERWRITE = overwrite without asking ASK_OVERWRITE = ask before overwrite

  if (!-f $from) {
	$top->messageBox(-icon  => 'warning', -message => "file $from not found!",
					 -title => "Copy file",   -type => 'OK');
	return 0;
  }

  return 1 if ($from eq $to); # no need to copy a file on itself

  # if target exists and ask overwrite modus on
  if ((-f $to) and ($overwrite == ASK_OVERWRITE)) {
	my $rc =
	$top->messageBox(-icon  => 'warning', -message => "file $to exist. Ok to overwrite?",
					 -title => 'Copy file',   -type => 'OKCancel');
	return 0 if ($rc !~ m/Ok/i);
  }

  if (!copy ($from, $to)) {
	$top->messageBox(-icon  => 'warning', -message => "Could not copy $from to $to: $!",
					 -title => 'Copy file',   -type => 'OK');
	return 0;
  }
  return 1;
}

##############################################################
# mylink
##############################################################
sub mylink {
  my $old       = shift;
  my $new       = shift;
  my $overwrite = shift; # 1 = overwrite without asking 0 = ask before overwrite

  return 0 if $EvilOS; # sorry, no links on non-UNIX system, use Linux instead ;)

  if (!-f $old) {
	$top->messageBox(-icon  => 'warning', -message => "file $old not found!",
					 -title => "Link file",   -type => 'OK');
	return 0;
  }

  if ((-f $new) and !$overwrite) {
	my $rc =
	$top->messageBox(-icon  => 'warning', -message => "file $new exist. Ok to overwrite?",
					 -title => "Link file",   -type => 'OKCancel');
	return 0 if ($rc !~ m/Ok/i);
  }

  if (!symlink ("$old", "$new")) {
	$top->messageBox(-icon  => 'warning', -message => "Could not link $old to $new: $!",
					 -title => "Link file",   -type => 'OK');
	return 0;
  }
  return 1;
}

##############################################################
# checkLinks - check if there are links, count them and ask
#              whether to proceed
##############################################################
sub checkLinks {
  my $lb       = shift; # listbox ref
  my @list     = @_;

  my $selected = @list;

  return 1 unless ($config{CheckForLinks});

  if (@list < 1) {
	warn "checkLinks: uops, list is empty. Aborting!";
	return 0;
  }

  my $dpic;
  my $links = 0;
  foreach $dpic (@list) {
	if (-l $dpic) {
	  $links++;
	}
  }
  if ($links > 0) {
	my $rc = $top->messageBox(-message => "$links of $selected selected pictures are links.\nDo you really want to change them?",
							  -icon => 'question', -title => "Work on linked files?", -type => 'OKCancel');
	if ($rc eq "Ok") {
	  return 1;
	}
	else {
	  return 0;
	}
  }
  return 1; # no links, Ok to continue ...
}

##############################################################
# getBitPix - calculate picture compression in bit per pixel
##############################################################
sub getBitPix {

  my $dpic = shift;

  return $quickSortHashBitsPixel{$dpic} if ($quickSortSwitch and defined $quickSortHashBitsPixel{$dpic});

  my $b = getFileSize($dpic, NO_FORMAT); # in Bytes
  $b *= 8;                               # Bytes * 8 = bits
  my $p = getPixels($dpic);
  # avoid division by zero
  if ($p == 0) {
	  $p = 1;
	  $b = 0;
  }

  $quickSortHashBitsPixel{$dpic} = ($b/$p) if $quickSortSwitch;

  return ($b/$p);
}

##############################################################
# getPixels - get the number of pixels of a picture
##############################################################
sub getPixels {

  my $dpic = shift;

  return $quickSortHashPixel{$dpic} if ($quickSortSwitch and defined $quickSortHashPixel{$dpic});

  my $x = 0;
  my $y = 0;
  $x = $searchDB{$dpic}{PIXX} if $searchDB{$dpic}{PIXX};
  $y = $searchDB{$dpic}{PIXY} if $searchDB{$dpic}{PIXY};
  
  $quickSortHashPixel{$dpic} = int($x*$y) if $quickSortSwitch;

  return int($x*$y);
}

##############################################################
# getSize - get the image size of a picture
##############################################################
sub getSize {

  my $dpic = shift;
  my $meta = shift; # optional, the Image::MetaData::JPEG object of $dpic if available

  if ((!defined $dpic) or ($dpic eq "")) {
	warn "getSize: Sorry, but there is no file!";
	return (0, 0);
  }
  if (!-f $dpic) {
	warn "Sorry, but \"$dpic\" is no file!";
	return (0, 0);
  }

  my $w = 0;
  my $h = 0;
  if (is_a_JPEG($dpic)) {
	$meta = getMetaData($dpic, "SOF", 'FASTREADONLY') unless (defined($meta));
	($w, $h) = $meta->get_dimensions() if $meta;
  }
  else {
	my $info = image_info($dpic);
	if (my $error = $info->{error}) {
	  warn "getSize: Can't parse image info: $error\n";
	}
	($w, $h) = dim($info);
  }
  $w = 0 unless (defined $w);
  $h = 0 unless (defined $h);
  return ($w, $h);
}

##############################################################
# is_a_JPEG - returns true (1) if the given file is a JPEG/JFIF
##############################################################
sub is_a_JPEG($) {
  my $dpic = shift;
  return 0 unless ($dpic);
  return 0 unless (-f $dpic);
  my @c;

  # open file and read the first 3 bytes
  return 0 unless (open FILE,"<$dpic");
  for my $i (0 .. 2) {
	read(FILE, $c[$i], 1);
  }
  close FILE;

  # JPEG JFIF files start with 0xFF 0xD8 0xFF
  # todo: this check is necessary but not sufficent
  if ( (ord($c[0]) == 0xFF) && (ord($c[1]) == 0xD8) && (ord($c[2]) == 0xFF) ) {
	return 1;
  }
  else {
	return 0;
  }
}

##############################################################
# makeConfigDir
##############################################################
sub makeConfigDir {

  if (!-d $configdir) {
	# ask the user for permission to create a configdir
	my $rc = $top->messageBox(-icon => 'question',
							  -message => "MaPiVi would like to create a folder \"$configdir\" in your home folder to store the configuration of Mapivi and some button and background pictures.",
							  -title => "Mapivi installation", -type => 'OKCancel');
	return if ($rc !~ m/Ok/i);
  }

  # make config dir
  if (!-d $maprogsdir) {
	if ( !mkdir $maprogsdir, 0700 ) { # 0700 = only for the user
	  $top->messageBox(-icon => 'warning', -message => "Error making $maprogsdir: $!",
					   -title => "Mapivi installation", -type => 'OK');
	  return;
	}
  }

  if (!-d $configdir) {
	if ( !mkdir $configdir, 0700 ) {
	  $top->messageBox(-icon => 'warning', -message => "Error making configdir $configdir: $!",
					   -title => "Mapivi installation", -type => 'OK');
	  return;
	}
  }

  if (!-d $trashdir) {
	if ( !mkdir $trashdir, 0755 ) {
	  $top->messageBox(-icon => 'warning', -message => "Error making trashdir $trashdir: $!",
					   -title => "Mapivi installation", -type => 'OK');
	  return;
	}
  }

  if (!-d "$trashdir/$thumbdirname") {
	if ( !mkdir "$trashdir/$thumbdirname", 0755 ) {
	  $top->messageBox(-icon => 'warning', -message => "Error making trashthumbdir $trashdir/$thumbdirname: $!",
					   -title => "Mapivi installation", -type => 'OK');
	  return;
	}
  }

  if (!-d $plugindir) {
	if ( !mkdir "$plugindir", 0755 ) {
	  $top->messageBox(-icon => 'warning', -message => "Error making PlugIn dir $plugindir: $!",
					   -title => "Mapivi installation", -type => 'OK');
	  return;
	}
  }

}

##############################################################
# copyConfigPics
##############################################################
sub copyConfigPics {

  print "sub copyConfigPics ...\n" if $verbose;
  return if (!-d $configdir);

  # try to find the pictures in the actual dir and in the dir where mapivi is located
  my $searchdir;
  my @pics;
  my @searchDirList = ("$actdir/pics", dirname($0)."/pics");
  foreach $searchdir (@searchDirList) {
	print "searching $searchdir ...\n" if $verbose;
	next if (!-d $searchdir);
	@pics = getFiles($searchdir); # mapivi should be startet as mapivi or mapivi .
	                              # so $actdir points to the dir where mapivi is stored

	last if (@pics > 0);
  }

  if (@pics <= 0) {
	print "Mapivi Warning:\nCould not find any pictures!\nPlease stop Mapivi, change to the folder where Mapivi is installed and restart Mapivi\n";
	#todo $config{NrOfRuns}-- if ($rc =~ m/Ok/i);
	return;
  }

  # copy the pictures to the config dir
  foreach (@pics) {
	if (-f "$configdir/$_") {
	  my $rc = $top->Dialog(-text => "I found a button/icon picture \"$_\" in the mapivi config folder (seem like there was another mapivi version installed before). Ok to overwrite?",
							 -title => "Mapivi installation",
                             -width => 40,
                             -buttons => ['OK', 'Cancel', "Cancel all"])->Show();
	  next if ($rc eq 'Cancel');
	  last if ($rc eq "Cancel all");
	}
	mycopy ("$searchdir/$_", "$configdir/$_", OVERWRITE);
  }

}

##############################################################
# copyOtherStuff - this will copy some mapivi files to
#                  the config dir (all optional)
##############################################################
sub copyOtherStuff {

  return if (!-d $configdir);

  my @files = qw/Changes.txt License.txt Tips.txt FAQ/;
  my $dir   = dirname($0);

  # copy the files to the config dir
  foreach (@files) {
	if (-f "$dir/$_") {
	  mycopy ("$dir/$_", "$configdir/$_", OVERWRITE);
	}
  }
}

##############################################################
# copyPlugIns
##############################################################
sub copyPlugIns {

  return if (!-d $plugindir);

  # try to find the PlugIns in the actual dir and in the dir where mapivi is located
  my $searchdir = dirname($0)."/PlugIns";
  my @plugs;
  my @searchDirList = ("$actdir/PlugIns", dirname($0)."/PlugIns");
  foreach $searchdir (@searchDirList) {
	print "searching $searchdir ...\n" if $verbose;
	next if (!-d $searchdir);
	@plugs = getFiles($searchdir); # mapivi should be startet as mapivi or mapivi .
                                     # so $actdir points to the dir where mapivi is stored

	last if (@plugs > 0);
  }

  if (@plugs <= 0) {
	print "Mapivi Warning:\nCould not find any PlugIns! Please stop Mapivi, change to the folder where Mapivi is installed and restart Mapivi\n";
	# todo $config{NrOfRuns}-- if ($rc =~ m/Ok/i);
	return;
  }

  # copy the PlugIns to the plugin dir
  foreach (@plugs) {
	if (-f "$plugindir/$_") {
	  my $rc = $top->messageBox(-icon => 'question', -message => "I found a PlugIn\n   $_\nin the mapivi PlugIn folder (seem like there was another mapivi version installed before).\n\nOk to overwrite?",
								-title => "Mapivi installation", -type => 'OKCancel');
	  next if ($rc !~ m/Ok/i);
	}

	if (!copy ("$searchdir/$_", "$plugindir/$_")) {
		$top->messageBox(-icon => 'warning', -message => "Could not copy $_ to $plugindir: $!",
						 -title => "Mapivi installation", -type => 'OK');
	  }
  }
}

##############################################################
# checkGeometry
##############################################################
sub checkGeometry($) {
  my $geoRef = shift;
  my ($w, $h, $x, $y) = splitGeometry($$geoRef);
  my $screenx = $top->screenwidth;
  my $screeny = $top->screenheight;
  my $tw = $top->reqwidth;
  my $th = $top->reqheight;
  print "checkGeometry: geo = $w ($tw) x $h ($th) + $x + $y  ($screenx x $screeny)\n" if $verbose;
  if ((($w + $x) > $screenx) or (($h + $y) > $screeny)) {
	warn "MaPiVi: window is out of screen, resizing!\n";
	$screenx -= 20;
	$screeny -= 80;
	$$geoRef = "${screenx}x${screeny}+0+0";
  }
  else { warn "geo ok" if $verbose; }
}

##############################################################
# splitGeometry - returns width, height, x, y of the geomtry
##############################################################
sub splitGeometry {
  my $geo  = shift;
  my @tmp  = split /x/, $geo;
  my $w    = $tmp[0];
  @tmp     = split /\+/, $tmp[1];
  return ($w, $tmp[0], $tmp[1], $tmp[2]);
}

##############################################################
# checkAdjusterGeometry
##############################################################
sub checkAdjusterGeometry {
  my $geoRef  = shift;
  my $adj1Ref = shift;
  my $adj2Ref = shift;
  my $letterWidth = $top->fontMeasure($nrofL->cget(-font), "0");
  if ($letterWidth < 8) {warn "letterWidth $letterWidth < 8!!!\n"; $letterWidth = 8; }
  my $x1 = $$adj1Ref * $letterWidth;
  my $x2 = $$adj2Ref * $letterWidth;
  my $wx;
  ($wx, undef, undef, undef) = splitGeometry($$geoRef);
  print "$x1 + $x2 letter: $letterWidth windowW: $wx?\n" if $verbose;
  if (($x1 + $x2 + 120) > $wx) {  # add x for scrollbars and safety
	warn "Adjuster need to much place, changing back to minimum!";
	$$adj1Ref = 10;
	$$adj2Ref = 10;
  }
  else { warn "Adjuster ok" if $verbose; }
}

##############################################################
# checkSystem
##############################################################
sub checkSystem {

  # UNIX and Windows have different PATH separators und suffixes
  my $sep    = ":";
  $sep       = ";"    if $EvilOS;
  my $suffix = "";
  $suffix    = ".exe" if $EvilOS;

  # check if the external programs listet in the global hash %exprogs are available
  my @path  = split /$sep/, $ENV{PATH};

  my ($dir, $prog);
  foreach $dir (@path) {
	foreach $prog (keys %exprogs) {
	  next if ($exprogs{$prog} > 0);  # already found it somewhere else
	  if (-x "$dir/$prog$suffix") {
		$exprogs{$prog}++;
		#print "      $prog in $dir found!\n";
	  }
	}
  }
}

##############################################################
# checkExternProgs - checks if the external programs needed
#                    for a certain function exist
##############################################################
sub checkExternProgs {
  my $sub         = shift; # name of the calling sub
  my @neededProgs = @_;    # list of needed external programs

  my @missingProgs = missingProgs($sub, @neededProgs);
  if (@missingProgs > 0) {
	my $msg = "";
	$msg .= explainMissingProg($sub, $_) foreach (@missingProgs);
	$top->messageBox(-icon    => 'warning',
					 -message => $msg,
					 -title   => "Extern program(s) not available",
					 -type => 'OK');
	return 0; # if just one prog is missing we better abort
  }
  return 1; # everything seems to be there
}

##############################################################
# missingProgs - given a list of required external programs,
#                return a list of those that are missing
##############################################################
sub missingProgs {
  my $sub         = shift; # name of the calling sub
  my @neededProgs = @_;    # list of needed external programs

  my @missingProgs;

  if (@neededProgs <= 0) {
	warn "missingProgs called from sub $sub with no progs to check!";
  } else {
	foreach (@neededProgs) {
	  if (!defined $exprogs{$_}) {
	    warn "missingProgs called from sub $sub with program $_, which is not in the exprogs hash!";
	    push @missingProgs, $_;
	  } elsif ($exprogs{$_} < 1) {
	    push @missingProgs, $_;
	  }
	}
  }
  return @missingProgs
}

##############################################################
# explainMissingProg - returns info about a missing program
##############################################################
sub explainMissingProg {
  my $sub         = shift;
  my $missingProg = shift;

  my $com = "";
  my $res = "";
  if (defined $exprogscom{$missingProg}) {
    $com = "$missingProg is needed to ".$exprogscom{$missingProg}."\n";
  }
  if (defined $exprogsres{$missingProg}) {
    $res = "$missingProg resource: ".$exprogsres{$missingProg}."\n";
  }

  return "Sorry, but to run $sub you need the external program $missingProg. I could not find $missingProg in your PATH.\n${com}${res}Aborting.";

}

##############################################################
# hlistEntryRename - rename the entrypath of an hlist entry
##############################################################
sub hlistEntryRename($$$) {
  my ($hlist, $old, $new ) = @_;
  return 0 unless ($hlist->info('exists', $old));
  return 0 if ($hlist->info('exists', $new));
  hlistCopy($hlist, $old, $new);
  $hlist->delete('entry', $old) if ($hlist->info('exists', $new));
  return 1;
}

##############################################################
# hlistCopy - copy an item of a hlist to another position
##############################################################
sub hlistCopy {
  my($hl, $from_entry, $to_entry) = @_;
  if ($hl->info('exists', $to_entry)) {
	return;
  }
  my @entry_args;
  foreach ($hl->entryconfigure($from_entry)) {
	push @entry_args, $_->[0] => $_->[4] if defined $_->[4];
  }
  my $next = $hl->info('next', $from_entry);

  if ($next) {$hl->add($to_entry, @entry_args, -before => $next);}
  else       {$hl->add($to_entry, @entry_args);}

  foreach my $col (1 .. $hl->cget(-columns)-1) {
	my @item_args;
	foreach ($hl->itemConfigure($from_entry, $col)) {
	  push @item_args, $_->[0] => $_->[4] if defined $_->[4];
	}
	$hl->itemCreate($to_entry, $col, @item_args);
  }
}

##############################################################
# startStopClock - starts and stops the clock, display
#                  and remove the clock label
##############################################################
sub startStopClock {
  if ($config{ShowClock}) {
	$clocktimer = $top->repeat(5000, \&showTime) if !$clocktimer; # 5000ms = 5 seconds
	$clockL->pack(-side => "left");
	showTime();
  }
  else {
	$clocktimer->cancel if $clocktimer;
	$time = "";
	$clockL->packForget() if (Exists($clockL));
  }
}

##############################################################
# getDateTime - returns the actual local time as a string
##############################################################
sub getDateTime {
  my (undef,$m,$h,$d,$M,$y,undef,undef,undef,undef) = localtime(time());
  $y += 1900;
  $M++;
  my $datetime = sprintf "%04d%02d%02d-%02d%02d", $y, $M, $d, $h, $m;
  return $datetime;
}

##############################################################
# showTime - calculate actual time and display it
##############################################################
sub showTime {
  return unless (Exists($clockL));
  my (undef,$m,$h,$d,$M,$y,$wd,undef, undef,undef) = localtime(time());
  my @workday = qw/Sun Mon Tue Wed Thu Fri Sat/;
  $y += 1900;
  $M++;
  $time = sprintf "%02d:%02d", $h, $m;
  $date = sprintf "%3s, %02d.%02d.%04d", $workday[$wd], $d, $M, $y;
  $clockL->update;
}

my $htmlW; # global make-html window widget
my $htmlInfo;
##############################################################
# makeHTML - build HTML web pages from the selected pictures
##############################################################
sub makeHTML {

  if (Exists($htmlW)) {
	$htmlW->deiconify;
	$htmlW->raise;
	return;
  }

  my $lb = shift;
  my @sellist = $lb->info('selection');
  return unless checkSelection($lb, 1, 0, \@sellist);

  my $selected = @sellist;
  my ($pic);

  # open make html window
  $htmlW = $lb->Toplevel();
  $htmlW->title("Build web pages");
  $htmlW->iconimage($mapiviicon) if $mapiviicon;

  $htmlInfo = "Build HTML web pages of $selected selected pictures";
  $htmlW->Label(-textvariable =>\$htmlInfo,-bg => $config{ColorBG}
				  )->pack(-side => 'top',-fill => 'x',-padx => 3,-pady => 3);

  my $w = 30;

  my $l1 = labeledEntry($htmlW, 'top', $w, "Title of Gallery",              \$config{HTMLGalleryTitle});
  my $l2 = labeledEntry($htmlW, 'top', $w, "Link to gallery index page",    \$config{HTMLGalleryIndex});
  my $l3 = labeledEntry($htmlW, 'top', $w, "Link to homepage",              \$config{HTMLHomepage});
  my $l4 = labeledEntry($htmlW, 'top', $w, "HTML footer",                   \$config{HTMLFooter});
  my $l5 = labeledEntryButton($htmlW,'top',$w,"HTML target folder",'Set',\$config{HTMLTargetDir},1);
  my $l6 = labeledEntryButton($htmlW,'top',$w,"HTML template file",'Set',   \$config{HTMLTemplate});

  $balloon->attach($l1, -msg => "The content of this entry will be\ninserted in the <!-- mapivi-galtitle --> field.");
  $balloon->attach($l2, -msg => "The content of this entry will be\ninserted in the <!-- mapivi-gallery-index --> field.");
  $balloon->attach($l3, -msg => "The content of this entry will be\ninserted in the <!-- mapivi-home --> field.");
  $balloon->attach($l4, -msg => "The content of this entry will be\ninserted in the <!-- mapivi-footer --> field.\nIt may contain a link to your homepage\nand your email address.");
  $balloon->attach($l5, -msg => "Mapivi will save the generated\npages and pictures in this folder.");
  $balloon->attach($l6, -msg => "This is the used HTML template.\nThere are some example templates\nin the Mapivi package.");


  #labeledEntry($htmlW, 'top', $w, "Background of picture",          \$config{HTMLBGcolor});

  my $picF;
  $htmlW->Checkbutton(-variable => \$config{HTMLnoPicChange},
					   -anchor => 'w',
					   -text => "Leave pictures untouched (just copy them)",
					  -command => sub {
						  my $state = 'normal';
						  $state = "disabled" if ($config{HTMLnoPicChange});
						  setChildState($picF, $state);
					  })->pack(-anchor => 'w');

  $picF  = $htmlW->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3);
  $picF->Label(-text =>"HTML pictures",-bg => $config{ColorBG}, -anchor => 'w'
				  )->pack(-side => 'top',-fill => 'x',-padx => 3,-pady => 3);

  #my $picF2 = $picF->Frame ()->pack(-expand => 1, -fill => 'x', -padx => 0, -pady => 0);

  my $sS = labeledScale($picF, 'top', $w, "Size (pixel)", \$config{HTMLPicSize}, 100, 2000, 1);
  $balloon->attach($sS, -msg => "This is the length of the longest side.\nWith a value of 500 a 1000x800 picture will be resized to 500x400.");

  my $qS = labeledScale($picF, 'top', $w, "Quality (%)", \$config{HTMLPicQuality}, 10, 100, 1);
  qualityBalloon($qS);

  my $shS = labeledScale($picF, 'top', $w, "Sharpness (radius)", \$config{HTMLPicSharpen}, 0, 10, 0.1);
  $balloon->attach($shS, -msg => "The higher the value, the slower the conversion\n0 means no sharping.\n(suggestion: between 0 and 4)");

  my $cof = $picF->Frame()->pack(-anchor => 'w');

  $cof->Checkbutton(-variable => \$config{HTMLPicCopyright},
					   -anchor => 'w',
					   -text => "Add some decorations (border, copyright)")->pack(-side => "left", -anchor => 'w');

  $cof->Button(-text => "Options",
			   -anchor => 'w',
			   -command => sub {decorationDialog($selected,0);})->pack(-side => "left", -anchor => 'w');

  $picF->Checkbutton(-variable => \$config{HTMLPicEXIF},
					   -anchor => 'w',
					   -text => "Leave EXIF info in HTML pictures")->pack(-anchor => 'w');

  labeledScale($htmlW, 'top', $w, "Number of thumbnail columns", \$config{HTMLcols}, 1, 10, 1);

  $htmlW->Checkbutton(-variable => \$config{HTMLaddComment},
					   -anchor => 'w',
					   -text => "Show JPEG comments")->pack(-anchor => 'w');
  $htmlW->Checkbutton(-variable => \$config{HTMLaddEXIF},
					   -anchor => 'w',
					   -text => "Show EXIF infos")->pack(-anchor => 'w');
  $htmlW->Checkbutton(-variable => \$config{HTMLaddIPTC},
					   -anchor => 'w',
					   -text => "Show IPTC infos")->pack(-anchor => 'w');

  my $ButF =
	$htmlW->Frame()->pack(-fill =>'x',-padx => 3,-pady => 3);

  my $OKB = 
  $ButF->Button(-text => "Make HTML",
				-command => sub {
				  return if ( !checkHTMLSettings() );
				  return if ( !makeHTMLSubdirs($config{HTMLTargetDir}) );
				  $lb->update;
				  #my @pics ;
				  #foreach (@sellist){
					#push @pics, basename($_);
				  #}
				  # because the building of web galleries should also work
				  # within the search dialog we can't throw away the path here
				  cleanHTMLDirs($config{HTMLTargetDir}, @sellist);

				  return if ( !makeHTMLPics  (\%config, @sellist) );
				  $lb->update;
				  return if ( !copyHTMLThumbs($config{HTMLTargetDir}, @sellist) );
				  my $table = makeHTMLIndex (\%config, @sellist);
				  makeHTMLPages ($table, \%config, @sellist);

				  $htmlInfo = "make web pages - Ready!"; $htmlW->update;
				  $htmlW->messageBox(-icon    => 'info',
									 -message => "Finished building web pages and pictures!",
									 -title => "make HTML", -type => 'OK');
				  # bring the make html dialog window in front
				  $htmlW->deiconify;
				  $htmlW->raise;
				  }
				 )->pack(-side => 'left',-expand => 1,-fill => 'x',-padx => 3,-pady => 3);

  $ButF->Button(-text => "Close",
				-command => sub {
					$htmlW->withdraw();
					$htmlW->destroy();
				  }
				 )->pack(-side => 'left',-expand => 1,-fill => 'x',-padx => 3,-pady => 3);


  $htmlW->bind('<Key-Escape>', sub { $htmlW->destroy; } );
  my $state = 'normal';
  $state = "disabled" if ($config{HTMLnoPicChange});
  setChildState($picF, $state);
  $OKB->focus;
  $htmlW->Popup;
  $htmlW->waitWindow;
}

##############################################################
# checkHTMLSettings
##############################################################
sub checkHTMLSettings {

  my $targetDir = $config{HTMLTargetDir};
  print "checkHTMLSettings: $targetDir\n" if $verbose;

  if (!-d $targetDir) {
	  my $rc = $htmlW->messageBox(-icon => 'question', -message => "$targetDir does not exists!\nShould I create it?!",
								-title => "check HTML settings", -type => 'OKCancel');
	  if ($rc !~ m/Ok/i) {
		return 0;
	  }
	  if ( !mkdir "$targetDir", 0755 ) {
		$htmlW->messageBox(-icon => 'warning', -message => "can not create $targetDir: $!",
						 -title => 'Error', -type => 'OK');
		return 0;
	  }
	}
  return 1;
}

##############################################################
# copyHTMLThumbs
##############################################################
sub copyHTMLThumbs {

  my $targetDir = shift;
  my @pics       = @_;
  my ($sthumb, $tthumb);

  # copy the pictures to the config dir
  foreach my $dpic (@pics) {
	my $pic = basename($dpic);
	$sthumb = getThumbFileName($dpic);
	$tthumb = "$targetDir/$HTMLThumbDir/$pic";

	if (!-f $sthumb) {
	  $htmlW->messageBox(-icon => 'warning', -message => "$sthumb not found! Stopping!",
								-title => "copy thumbs", -type => 'OK');
	  return 0;
	}

	if (!aNewerThanb($sthumb,$tthumb)) {
	    print "skip thumb $pic (it is up to date)\n" if $verbose;
	    next;
	}
	else {
	    print "copy thumb $pic\n" if $verbose;
	}

	$htmlInfo = "copy thumb $pic for HTML page ..."; $htmlW->update;
	mycopy("$sthumb", "$tthumb", OVERWRITE);
  }
  return 1;
}

##############################################################
# makeHTMLSubdirs
##############################################################
sub makeHTMLSubdirs {

  my $tdir = shift;

  # make pic and thumb dir
  foreach my $dir ($HTMLPicDir, $HTMLThumbDir) {
	my $sdir = "$tdir/$dir";
	if (!-d $sdir) {
	  if ( !mkdir "$sdir", 0755 ) {
		$htmlW->messageBox(-icon => 'warning', -message => "makeThumbSubdirs: can not create $sdir: $!",
						 -title => 'Error', -type => 'OK');
		return 0;
	  }
	}
  }
  return 1;
}


##############################################################
# makeHTMLPics
##############################################################
sub makeHTMLPics {

  my $tmpconfR = shift;
  my @pics     = @_;
  my ($pic, $dpic, $tpic, $command);

  my $targetDir = $tmpconfR->{'HTMLTargetDir'};
  my $i      = 0;
  my $nrpics = @pics;

  foreach $dpic (@pics) {
	$i++;
	$pic  = basename($dpic);
	$tpic = "$targetDir/$HTMLPicDir/$pic";
	if (!-f $dpic) {
	  warn "makeHTMLPics: $dpic does not exist!";
	  return 0;
	}
	if (!aNewerThanb($dpic,$tpic)) {
	    warn "makeHTMLPics: $tpic is up to date - skipping\n" if $verbose;
	    next;
	}
	else {
	    warn "makeHTMLPics: converting $pic\n" if $verbose;
	}

	# just copy the pics ...
	if ($tmpconfR->{'HTMLnoPicChange'}) {
		$htmlInfo = "copy $pic ($i/$nrpics) for HTML page ..."; $htmlW->update;
		mycopy("$dpic", "$tpic", OVERWRITE);
	}
	# ... or convert them
	else {
		# adding -size XxY speeds up the convertion! (Dan Eble)
		$command = " convert -size \"$tmpconfR->{'HTMLPicSize'}x$tmpconfR->{'HTMLPicSize'}\" -geometry \"$tmpconfR->{'HTMLPicSize'}x$tmpconfR->{'HTMLPicSize'}>\" -quality $tmpconfR->{'HTMLPicQuality'} ";
		if ($tmpconfR->{HTMLPicSharpen} > 0) {  # ! Sharpen is the most time consuming option, when building thumbnails!
			$command .= "-sharpen $tmpconfR->{'HTMLPicSharpen'} " # the higher the value the slower the conversion
			}

		if ($tmpconfR->{HTMLPicCopyright} > 0) {
			$command .= makeDrawOptions($dpic);
		}

		$command .= " \"$dpic\" \"$tpic\" ";

		$htmlInfo = "converting $pic ($i/$nrpics) for HTML page ..."; $htmlW->update;

		#(system "$command") == 0 or warn "$command failed: $!";
		execute($command);

		addDropShadow($tpic);

		if ($tmpconfR->{HTMLPicEXIF}) {
			# copy the EXIF header from the original pic to the html pic
			copyEXIF( $dpic, $tpic );
		}
		else {
			# remove the EXIF header and thumb from the HTML pic
		  my $errors = "";
		  removeEXIF($tpic, 'all', \$errors);
		}
	}
  }
  return 1;
}

##############################################################
# makeHTMLIndex
##############################################################
sub makeHTMLIndex {

  my $tmpconfR  = shift;
  my @pics     = @_;
  my $targetDir = $tmpconfR->{'HTMLTargetDir'};
  my ($pic, $dpic, $opic, $picNoSuffix, $lthumb, $htmlfile, $title, $size, $table, $tx, $ty);

  $table = "<table class=\"darkbox\">\n";
  my $i = 0;
  $htmlInfo = "building HTML thumbnail index ..."; $htmlW->update;

  foreach $opic (@pics) {
	$i++;
	$pic     = basename($opic);
	if ( $i % $tmpconfR->{HTMLcols} == 1 or $tmpconfR->{HTMLcols} == 1 ) { # start new table row (modulo)
	  $table .= "<tr>\n";
	}
	#$lpic     = "$HTMLPicDir/$pic";
	$dpic     = "$targetDir/$HTMLPicDir/$pic";
	$lthumb   = "$HTMLThumbDir/$pic";
	$size     = getFileSize($dpic, FORMAT);
	($tx, $ty)= getSize("$targetDir/$lthumb");
	$picNoSuffix = $pic;
	# cut off trailing ".jpg"
	$picNoSuffix =~ s/\..*$//i;        # this is the name of the picture without .jpg suffix
	$title = getIPTCObjectName($opic);
	$title = "$picNoSuffix" if ($title eq "");
	$title .= " ($size)";
	# replace (german) umlaute by corresponding HTML-tags
	$title    =~ s/([$umlauteHTML])/$umlauteHTML{$1}/g;
	$htmlfile = ($i == 1) ? "index.html" : "$picNoSuffix.html";
	$table .= "<td>\n";
	$table .= "<a href=\"$htmlfile\">\n";
	$table .= "   <img src=\"$lthumb\" alt=\"$pic\" title=\"$title\" width=\"$tx\" height=\"$ty\" vspace=\"1\" border=\"0\" />\n";
	$table .= "</a>\n";
	$table .= "</td>\n";
	if ( $i % $tmpconfR->{HTMLcols} == 0 ) { # end table row (modulo)
	  $table .= "</tr>\n";
	}
  }
  $table .= "</table>\n";
  return $table;
}


##############################################################
# createReplacementHashForPic
##############################################################
sub createReplacementHashForPic {
  my $tmpconfR  = shift;
  my $opic = shift;

  my $pic = basename($opic);
  my $targetDir = $tmpconfR->{'HTMLTargetDir'};
  my $dpic = "$targetDir/$HTMLPicDir/$pic";
  my $tpic = "$targetDir/$HTMLThumbDir/$pic";
  my $picNoSuffix = $pic;
  $picNoSuffix =~ s/\..*$//i;

  my $size = getFileSize($dpic, FORMAT);
  my ($w, $h) = getSize($dpic);
  my ($thumbw, $thumbh)= getSize($tpic);

  my $title = getIPTCObjectName($opic);
  $title = $picNoSuffix if ($title eq "");

  my $IPTCheadline = getIPTCHeadline($opic);
  my $headline = $IPTCheadline;
  $headline = $title if ($headline eq "");

  my $com = "";
  if ($tmpconfR->{'HTMLaddComment'}) {
      # only the first comment is copied by jhead, so we use the comment(s) of the original picture
      $com = getComment($opic, 3); # allows big comments (up to 1000 chars)
      $com =~ s/\n/<br>/g;         # replace newline with the corresponding html tag
  }

  my $IPTCcaption = getIPTCCaption($opic);
  $IPTCcaption =~ s/\n/<br>/g; # replace newline with the corresponding html tag

  # caption comes from either the IPTC caption or the JPEG comment
  my $caption = $IPTCcaption;
  $caption = $com if ($caption eq "");

  my $byline = getIPTCByLine($opic);
  my $bylinetitle = getIPTCByLineTitle($opic);
  $bylinetitle   .= ": " if ($bylinetitle ne "");
  $byline         = $bylinetitle.$byline if ($byline ne "");

  my $location = getIPTCSublocation($opic);
  my $city  = ""; $city  = getIPTCCity($opic);
  if ($city ne "") {
      $location .= ", " if ($location ne "");
      $location .= $city;
  }

  my $province = ""; $province = getIPTCProvince($opic);
  my $country  = ""; $country  = getIPTCAttr($opic, "Country/PrimaryLocationName");#getIPTCCountryCode($opic);

  if ($country ne "") {
      $province .= ", " if ($province ne "");
      $province .= $country;
  }

  if ($province ne "") {
      if ($location ne "") {
	  $location .= " ($province)";
      } else {
	  $location  = $province;
      }
  }

  my $exif = "";
  $exif = getShortEXIF($opic, NO_WRAP) if ($tmpconfR->{'HTMLaddEXIF'});
  $exif =~ s/\[t\]//g; # remove thumbnail indicator [t]
  $exif =~ s/\[s\]//g; # remove saved exif indicator [s]

  my $iptc = "";
  $iptc = getShortIPTC($opic, LONG) if ($tmpconfR->{'HTMLaddIPTC'});

  # Escape special HTML characters, except in file names
  # and in purely numeric values (e.g. width). (by Dan Eble)
  foreach ($pic, $byline, $caption, $com, $exif, $size, $headline, $iptc,
	   $IPTCcaption, $IPTCheadline, $location, $time, $title) {
      $_ =~ s/([$htmlChars])/$htmlChars{$1}/g;
  }

  my %replace;
  $replace{'<!-- mapivi-alt -->'}           = $pic;
  $replace{'<!-- mapivi-byline -->'}        = $byline;
  $replace{'<!-- mapivi-caption -->'}       = $caption;
  $replace{'<!-- mapivi-comment -->'}       = $com;
  $replace{'<!-- mapivi-exif -->'}          = $exif;
  $replace{'<!-- mapivi-file-no-suffix -->'}= $picNoSuffix;
  $replace{'<!-- mapivi-filesize-kB -->'}   = $size;
  $replace{'<!-- mapivi-headline -->'}      = $headline;
  $replace{'<!-- mapivi-height -->'}        = $h;
  $replace{'<!-- mapivi-iptc -->'}          = $iptc;
  $replace{'<!-- mapivi-iptc-caption -->'}  = $IPTCcaption;
  $replace{'<!-- mapivi-iptc-headline -->'} = $IPTCheadline;
  $replace{'<!-- mapivi-location -->'}      = $location;
  $replace{'<!-- mapivi-pic -->'}           = "$HTMLPicDir/$pic";
  $replace{'<!-- mapivi-thumb-height -->'}  = $thumbh;
  $replace{'<!-- mapivi-thumb-pic -->'}     = "$HTMLThumbDir/$pic";
  $replace{'<!-- mapivi-thumb-width -->'}   = $thumbw;
  $replace{'<!-- mapivi-time -->'}          = $time;
  $replace{'<!-- mapivi-title -->'}         = $title;
  $replace{'<!-- mapivi-width -->'}         = $w;
  return %replace;
}

##############################################################
# makeHTMLPages
##############################################################
sub makeHTMLPages {

  my $table     = shift;
  my $tmpconfR  = shift;
  my @pics      = @_;
  my $targetDir = $tmpconfR->{'HTMLTargetDir'};
  my ($pic, $htmlpage, $page, $next, $prev, $galtitle, %bigrep, $maxwidth, $maxheight);

  my $sum = @pics;

  $maxwidth = 0;
  $maxheight = 0;

  $galtitle = $tmpconfR->{HTMLGalleryTitle};
  $galtitle =~ s/ /&nbsp;/g; # replace space by html tag non-breakable space

  my $index = 0;
  foreach my $dpic (@pics) {
	$pic = basename($dpic);
    $htmlInfo = "extracting data from $pic ..."; $htmlW->update;

    my %replace = createReplacementHashForPic($tmpconfR, $dpic);

	if ($replace{'<!-- mapivi-height -->'} > $maxheight) {
	    $maxheight = $replace{'<!-- mapivi-height -->'};
	}

	if ($replace{'<!-- mapivi-width -->'} > $maxwidth) {
	    $maxwidth = $replace{'<!-- mapivi-width -->'};
	}

	# Next and previous pages wrap around from end to beginning.
	my $previndex = ($index - 1) % $sum;
	my $nextindex = ($index + 1) % $sum;

	# File names for previous, current, and next page.
	# The first is "index.html" to simplify the URL of the album.
	$prev = $previndex ? basename($pics[$previndex]) : "index.html";
	$htmlpage = $index ? basename($pics[$index])     : "index.html";
	$next = $nextindex ? basename($pics[$nextindex]) : "index.html";

	# change extensions to ".html"
	foreach ($prev, $htmlpage, $next) {
	  $_ =~ s/\..*$/\.html/i;
	}
	$replace{'<!-- mapivi-pic-index -->'}     = $index+1;
	$replace{'<!-- mapivi-next -->'}          = $next;
	$replace{'<!-- mapivi-this -->'}          = $htmlpage;
	$replace{'<!-- mapivi-prev -->'}          = $prev;

	$bigrep{$pic} = \%replace;
	$index++;
    }

  my ($s,$m,$ho,$d,$mo,$y) = localtime(time());
  $y += 1900; $mo++;			# do some adjustments
  # build up the date time string
  my $date     = sprintf "%02d.%02d.%04d", $d, $mo, $y;
  my $time     = sprintf "%02d:%02d", $ho, $m;
  my $datetime = sprintf "%02d.%02d.%04d %02d:%02d", $d, $mo, $y, $ho, $m;

  my %globalReplace;
  $globalReplace{'<!-- mapivi-date -->'}	= $date;
  $globalReplace{'<!-- mapivi-datetime -->'}	= $datetime;
  $globalReplace{'<!-- mapivi-footer -->'}	= $tmpconfR->{HTMLFooter};
  $globalReplace{'<!-- mapivi-gallery-index -->'}= $tmpconfR->{HTMLGalleryIndex};
  $globalReplace{'<!-- mapivi-galtitle -->'}	= $galtitle;
  $globalReplace{'<!-- mapivi-home -->'}	= $tmpconfR->{HTMLHomepage};
  $globalReplace{'<!-- mapivi-info -->'}	= $mapiviInfo;
  $globalReplace{'<!-- mapivi-max-height -->'}	= $maxheight;
  $globalReplace{'<!-- mapivi-max-index -->'}	= $sum;
  $globalReplace{'<!-- mapivi-max-width -->'}	= $maxwidth;
  $globalReplace{'<!-- mapivi-thumbtable -->'}	= $table;

  foreach my $dpic (@pics) {
	$pic = basename($dpic);
    $htmlpage = $bigrep{$pic}{'<!-- mapivi-this -->'};
	print "xxx pic=$pic html=$htmlpage ($dpic)\n";
    $htmlInfo = "building page $htmlpage ..."; $htmlW->update;

    $page = openTemplate($tmpconfR->{HTMLTemplate});

    # do global substitutions first so that they will not have
    # to be replaced for each expansion of <mapivi:foreachpic>
    $page = doSubstitutions($page, \%globalReplace);

    my $re;
    my @left = ('(','');
    my @right = (')','');

    $_ = $page;

    # find the text inside of <mapivi:foreachpic> sections
    ($re=$_)=~s/((<mapivi:foreachpic>)|(<\/mapivi:foreachpic>)|.)/$right[!$3]\Q$1\E$left[!$2]/gs;
    my @inside = (eval{/$re/},$@!~/unmatched/i);

    # find the text outside of <mapivi:foreachpic> sections
    ($re=$_)=~s/((<mapivi:foreachpic>)|(<\/mapivi:foreachpic>)|.)/$right[!$2]\Q$1\E$left[!$3]/gs;
    $re = "(" . $re . ")";
    my @outside = (eval{/$re/},$@!~/unmatched/i);

    # if the <mapivi:foreachpic> sections were parsed without error,
    # process the templates inside the tags
    if ($inside[-1] && $outside[-1] && ($#inside+1 == $#outside)) {
	$page = "";
	for (0..$#inside-1)
	{
	    $page .= $outside[$_] . substituteForEachPic($tmpconfR, $inside[$_], \%bigrep, @pics);
	}
	$page .= $outside[-2];
    }

    $page = doSubstitutions($page, $bigrep{$pic});
	writePage("$targetDir/$htmlpage", $page);
	$top->update;
  }

}

##############################################################
# doSubstitutions
# Input: the pageContent string (from template), followed by hash of
# substitutions to make
##############################################################
sub doSubstitutions {
  my ($pageContent, $replaceR )= @_;
  my($tag, $replacement);
  while (($tag, $replacement) = each(%$replaceR)) {
	warn "doSubstitutions: tag not defined" unless defined $tag;
	warn "doSubstitutions: $tag replacement not defined" unless defined $replacement;
	$pageContent =~ s/$tag/$replacement/g;
  }
  # replace (german) umlaute by corresponding html-tags
  $pageContent =~ s/([$umlauteHTML])/$umlauteHTML{$1}/g;
  return $pageContent;
}

##############################################################
# substituteForEachPic
##############################################################
sub substituteForEachPic {
  my $tmpconfR = shift;
  my $template = shift;
  my $bigrepR = shift;
  my @pics = @_;

  my $result = "";

  my $pic;
  foreach my $dpic (@pics) {
	  $pic = basename($dpic);
      $result .= doSubstitutions($template, $$bigrepR{$pic});
  }

  return $result;
}

##############################################################
# openTemplate - open, read and return template
##############################################################
sub openTemplate {

  my $template = shift;
  my $file;
  if (!open ($file, $template)) {
	die ("cannot open template $template for reading: ($!)");
  }

  my $pageContent = (join '', <$file>);

  close ($file) || bail ("can't close template: ($!)");

  return $pageContent;
}

##############################################################
# writePage - input path of page to render, not including $root
##############################################################
sub writePage {
    # Spits out a page of HTML.
    my($file, $pageContent) = @_;

	my $outfile;
    open ($outfile, ">$file") or die "Couldn't open $file: $!";
    print $outfile $pageContent;
    close($outfile);
}

##############################################################
# cleanHTMLDirs - delete all files which are not needed anymore
##############################################################
sub cleanHTMLDirs {

  my $targetDir = shift;
  my @dpics     = @_;
  my @picsAct;
  my @toDelete;
  my $rc;
  my $pictures;

  # clean html files
  my @htmlfiles = grep {m/.*\.html$/i} getFiles($targetDir);
  if (@htmlfiles >= 1) {
	$rc = $htmlW->messageBox(-icon => 'question',
							 -message => scalar @htmlfiles." HTML pages should be deleted in $targetDir.\nOk, to delete?",
							 -title => "clean up HTML folders",
							 -type => 'OKCancel');
	if ($rc eq "Ok") {
	  foreach (@htmlfiles) {
		removeFile("$targetDir/$_");
	  }
	}
  }

  # clean pictures and thumbs
  foreach my $dir ("$targetDir/$HTMLPicDir", "$targetDir/$HTMLThumbDir") {

	@picsAct = getPics($dir, JUST_FILE); # no sort needed

	my @pics;

	# now we need the pics list without path
	push @pics, basename($_) foreach (@dpics);

	@toDelete = diffList(\@picsAct, \@pics);

	next if (@toDelete < 1);

	# choose the right word depending on the dir
	$pictures = "pictures";
	$pictures = "thumbnails" if ($dir =~ m/$HTMLThumbDir$/);

	$rc = $htmlW->messageBox(-icon => 'question',
						   -message => scalar @toDelete." $pictures should be deleted in\n$dir\nOk, to delete?",
						   -title => "clean up HTML folders",
						   -type => 'OKCancel');
	if ($rc !~ m/Ok/i) {
	  next;
	}

	foreach (@toDelete) {
	  removeFile ("$dir/$_");
	}
  }
}

##############################################################
# compareLists
##############################################################
sub compareLists {
  my ($first, $second) = @_;
  no warnings;  # silence spurious -w undef complaints
  return 0 unless @$first == @$second;
  for ( 0 .. $#{@$first}) {
	return 0 if $first->[$_] ne $second->[$_];
  }
  return 1;
}

##############################################################
# diffList  - returns a list containing all elements of list1
#                   which are not in list2 (removes the elements of list2 from list1)
##############################################################
sub diffList {

  my $list1Ref = shift;  # reference to first list
  my $list2Ref = shift;  # reference to second list
  
  return () unless (@{$list1Ref});
  return (@{$list1Ref}) unless (@{$list2Ref});
  
  # build a hash
  my %d;
  $d{$_}++ foreach (@{$list1Ref});
  
  # delete all elements in hash, which are in list2
  foreach (@{$list2Ref}) {
	delete $d{$_} if (exists $d{$_});
  }

  return (keys %d);
}

##############################################################
# listIntersection  - returns a list containing all elements
#                     of list1 which are also in list2
##############################################################
sub listIntersection {

  my $list1Ref = shift;  # reference to first list
  my $list2Ref = shift;  # reference to second list

  my (@intersection, %count, $element);
  foreach $element (@{$list1Ref}, @{$list2Ref}) { $count{$element}++ }
  foreach $element (keys %count) {
	push @intersection, $element if ($count{$element} > 1);
  }

  return @intersection;
}

##############################################################
# dirDiffWindow
##############################################################
sub dirDiffWindow {

  if (Exists($ddw)) {
	$ddw->deiconify;
	$ddw->raise;
	$ddw->focus;
	return;
  }
  # open window
  $ddw = $top->Toplevel();
  $ddw->withdraw;
  $ddw->title("Compare two folders");
  $ddw->iconimage($mapiviicon) if $mapiviicon;

  my $f1  =	$ddw->Frame(-relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3);
  my $f1a =	$f1->Frame()->pack(-side => "left", -fill => 'x', -expand => 1, -padx => 0, -pady => 0);
  my $f1b =	$f1->Frame()->pack(-side => "left", -fill => "y", -padx => 0, -pady => 0);
  my $f2  =	$ddw->Frame()->pack(-fill => 'x', -padx => 2, -pady => 3);
  my $f2a =	$f2->Frame(-relief => 'groove')->pack(-side => "left", -fill => "y", -expand => 0, -padx => 1, -pady => 0);
  my $f2b =	$f2->Frame(-relief => 'groove')->pack(-side => "left", -fill => "both", -expand => 1, -padx => 1, -pady => 0);
  #my $f3 =	$ddw->Frame()->pack(-fill => 'x', -padx => 3, -pady => 3);

  my $ddlb;
  $ddw->Label(-textvariable => \$ddw->{label}, -anchor => 'w', -bg => $config{ColorBG})->pack(-padx => 3, -anchor => 'w');
  $ddw->{label} = 'Choose folders to compare and press the "Compare" button.';

  labeledEntryButton($f1a,'top',12,"folder A",'Set',\$config{dirDiffDirA},1);
  labeledEntryButton($f1a,'top',12,"folder B",'Set',\$config{dirDiffDirB},1);

  $ddlb = $ddw->Scrolled("HList",
						 -header     => 1,
						 -separator  => ';',  # todo here we hope that ; will never be in a folder or file name
						 -pady       => 0,
						 -columns    => 12,
						 -scrollbars => 'osoe',
						 -selectmode => "extended",
						 -background => $config{ColorBG}, #8fa8bf
						 -width      => 40,
						 -height     => 20,
						)->pack(-expand => 1, -fill => "both");

  bindMouseWheel($ddlb);

  $balloon->attach($ddlb, -msg => "left click  : select\nmiddle click: open picture in new window\nright click : open context menu");

  my $col = 0;
  $ddlb->header('create', $col, -text => 'Differences', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
  $ddlb->{diffcol} = $col; $col++;
  $ddlb->header('create', $col, -text => 'Name', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
  $ddlb->{namecol} = $col; $col++;
  $ddlb->header('create', $col, -text => 'Thumbnail A', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
  $ddlb->{thumbAcol} = $col; $col++;
  $ddlb->header('create', $col, -text => 'Thumbnail B', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
  $ddlb->{thumbBcol} = $col; $col++;
  $ddlb->header('create', $col, -text => 'Size A', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
  $ddlb->{sizeAcol} = $col; $col++;
  $ddlb->header('create', $col, -text => 'Size B', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
  $ddlb->{sizeBcol} = $col; $col++;
  $ddlb->header('create', $col, -text => 'IPTC A', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
  $ddlb->{iptcAcol} = $col; $col++;
  $ddlb->header('create', $col, -text => 'IPTC B', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
  $ddlb->{iptcBcol} = $col; $col++;
  $ddlb->header('create', $col, -text => 'EXIF A', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
  $ddlb->{exifAcol} = $col; $col++;
  $ddlb->header('create', $col, -text => 'EXIF B', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
  $ddlb->{exifBcol} = $col; $col++;
  $ddlb->header('create', $col, -text => 'Comments A', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
  $ddlb->{comAcol} = $col; $col++;
  $ddlb->header('create', $col, -text => 'Comments B', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
  $ddlb->{comBcol} = $col; $col++;

  my $progress = 0;

  $f1b->Button(-text => "Compare",
			  -command => sub {
				# check both dirs first
				foreach ($config{dirDiffDirA}, $config{dirDiffDirB}) {
				  unless (-d $_) {
					$ddw->messageBox(-icon => 'warning', -message => "Folder \"$_\" is not valid!",
									 -title => 'Error', -type => 'OK');
					return;
				  }
				}
				if ($config{dirDiffDirA} eq $config{dirDiffDirB}) {
					$ddw->messageBox(-icon => 'warning', -message => "Please choose two different folders!",
									 -title => 'Error', -type => 'OK');
					return;
				}

				$ddw->Busy;

				$ddlb->delete("all"); # clear listbox

				my (@onlyInDirA, @onlyInDirB, @intersec);
				dirDiff($config{dirDiffDirA}, $config{dirDiffDirB}, \@onlyInDirA, \@onlyInDirB, \@intersec);

				$ddw->{label} = "found ".scalar @onlyInDirA." unique pictures in dir A, ".scalar @onlyInDirB." unique pictures in dir B and ".scalar @intersec." matching pictures";
				$ddw->update;
				my $pics = @onlyInDirA +  @onlyInDirB + @intersec;
				my $pic;
				my $last_time;
				my $i = 0;
				foreach $pic (sort @onlyInDirA) {
				  my $dpic   = $config{dirDiffDirA}."/$pic";
				  ddInsertPic($ddlb, $dpic, "", "only in dir A");
				  $i++;
				  # show progress and found pics every 0.5 seconds - idea from Slaven
				  if (!defined $last_time || Tk::timeofday()-$last_time > 0.5) {
					$progress = int($i/$pics*100); $ddw->update;
					$last_time = Tk::timeofday();
				  }
				}
				foreach $pic (sort @onlyInDirB) {
				  my $dpic   = $config{dirDiffDirB}."/$pic";
				  ddInsertPic($ddlb, "", $dpic, "only in dir B");
				  $i++;
				  # show progress and found pics every 0.5 seconds - idea from Slaven
				  if (!defined $last_time || Tk::timeofday()-$last_time > 0.5) {
					$progress = int($i/$pics*100); $ddw->update;
					$last_time = Tk::timeofday();
				  }
				}
				my $inter = 0;
				foreach $pic (sort @intersec) {
				  my $dpicA   = $config{dirDiffDirA}."/$pic";
				  my $dpicB   = $config{dirDiffDirB}."/$pic";
				  my $differences = "";
				  if (compareTwoPics($dpicA, $dpicB, \$differences)) {
					ddInsertPic($ddlb, $dpicA, $dpicB, $differences);
					$inter++;
				  }
				  $i++;
				  # show progress and found pics every 0.5 seconds - idea from Slaven
				  if (!defined $last_time || Tk::timeofday()-$last_time > 0.5) {
					$progress = int($i/$pics*100); $ddw->update;
					$last_time = Tk::timeofday();
				  }
				}

				$progress = 100;
				$ddw->{label} = "found ".scalar @onlyInDirA." unique pictures in dir A, ".scalar @onlyInDirB." unique pictures in dir B and ".scalar @intersec." matching pictures ($inter of them differ).";

				$ddw->Unbusy;

			  })->pack(-fill => "y", -side => "left");

  $f1b->Button(-text => "Close",
			  -command => sub {
				$ddw->destroy;
			  })->pack(-fill => "y", -side => "left");

  $f2a->Label(-text => "compare by ", -anchor => 'w', -bg => $config{ColorBG})->pack(-side => "left", -padx => 3);
  $f2a->Checkbutton(-variable => \$config{dirDiffSize}, -text => "files size")->pack(-side => "left");
  $f2a->Checkbutton(-variable => \$config{dirDiffPixel}, -text => "pixel size")->pack(-side => "left");
  $f2a->Checkbutton(-variable => \$config{dirDiffComment}, -text => "comment")->pack(-side => "left");
  $f2a->Checkbutton(-variable => \$config{dirDiffEXIF}, -text => "EXIF")->pack(-side => "left");
  $f2a->Checkbutton(-variable => \$config{dirDiffIPTC}, -text => "IPTC")->pack(-side => "left");

  $f2b->Button(-text => "Copy A->B",
			  -command => sub {
				return unless ($ddlb->info('children'));
				my @sellist = $ddlb->info('selection');
				return unless (@sellist);
				my $i  = 0;	my $rc = 1;	my $n  = 0;
				foreach (@sellist) {
				  my $pic = $ddlb->itemCget($_, $ddlb->{namecol}, -text);
				  $i++;
				  $ddw->{label} = "copy ($i/".scalar @sellist.") ... "; $ddw->update;
				  my $dpic      = $config{dirDiffDirA}."/$pic";
				  next unless (-f $dpic);
				  my $tpic      = $config{dirDiffDirB}."/$pic";
				  # if the pic exists, ask if the user wants to overwrite it
				  $rc = overwritePic($tpic, $dpic, (scalar(@sellist) - $i + 1)) if ($rc != 2);
				  next if ($rc ==  0);
				  last if ($rc == -1);
				  if (mycopy ($dpic, $tpic, OVERWRITE)) {       # copy pic
					$n++;
					my $thumbpic  = getThumbFileName($dpic);
					my $thumbtpic = getThumbFileName($tpic);
					if ((-d dirname($thumbtpic)) and (-f $thumbpic)) {
					  mycopy ($thumbpic,$thumbtpic, OVERWRITE)  # copy thumbnail
					}
					$ddlb->delete("entry", $_);             # remove entry from list box
				  }

				}								# foreach - end
				$ddw->{label} = "ready! ($n/".scalar @sellist." copied)"; $ddw->update;
			  })->pack(-fill => 'x', -side => "left", -padx => 2, -pady => 2);

  $f2b->Button(-text => "Copy A<-B",
			  -command => sub {
				return unless ($ddlb->info('children'));
				my @sellist = $ddlb->info('selection');
				return unless (@sellist);
				my $i  = 0;	my $rc = 1;	my $n  = 0;
				foreach (@sellist) {
				  my $pic = $ddlb->itemCget($_, $ddlb->{namecol}, -text);
				  $i++;
				  $ddw->{label} = "copy ($i/".scalar @sellist.") ... "; $ddw->update;
				  my $dpic      = $config{dirDiffDirB}."/$pic";
				  next unless (-f $dpic);
				  my $tpic      = $config{dirDiffDirA}."/$pic";
				  # if the pic exists, ask if the user wants to overwrite it
				  $rc = overwritePic($tpic, $dpic, (scalar(@sellist) - $i + 1)) if ($rc != 2);
				  next if ($rc ==  0);
				  last if ($rc == -1);
				  if (mycopy ($dpic, $tpic, OVERWRITE)) {       # copy pic
					$n++;
					my $thumbpic  = getThumbFileName($dpic);
					my $thumbtpic = getThumbFileName($tpic);
					if ((-d dirname($thumbtpic)) and (-f $thumbpic)) {
					  mycopy ($thumbpic, $thumbtpic, OVERWRITE)  # copy thumbnail
					}
					$ddlb->delete("entry", $_);             # remove entry from list box
				  }

				}								# foreach - end
				$ddw->{label} = "ready! ($n/".scalar @sellist." copied)"; $ddw->update;

			  })->pack(-fill => 'x', -side => "left", -padx => 2, -pady => 2);

  $f2b->Button(-text => "Delete A",
			  -command => sub {
				return unless ($ddlb->info('children'));
				my @sellist = $ddlb->info('selection');
				return unless (@sellist);
				my $rc = $ddw->messageBox(-message => "Really delete ".scalar @sellist." pictures in folder ".$config{dirDiffDirA}."?",
					   -icon => 'question', -title => "Really delete?", -type => 'OKCancel');
				return unless ($rc =~ m/Ok/i);

				my $i  = 0; my $n  = 0;
				foreach (@sellist) {
				  my $pic = $ddlb->itemCget($_, $ddlb->{namecol}, -text);
				  $i++;
				  $ddw->{label} = "deleting ($i/".scalar @sellist.") ... "; $ddw->update;
				  my $dpic = $config{dirDiffDirA}."/$pic";
				  unless (-f $dpic) { print "$dpic not found!\n"; next;}
				  if (move ($dpic, $trashdir)) {       # move pic to trash
					$n++;
					my $tpic = "$trashdir/$pic";
					# change the location info in the search database
					$searchDB{$tpic} = $searchDB{$dpic};
					delete $searchDB{$dpic};
					deleteCachedPics($dpic);
					# todo move thumbnail?
					# todo deleting the entry is wrong, if picture exists in both dirs
					$ddlb->delete("entry", $_); # remove entry from list box
				  }
				}								# foreach - end
				$ddw->{label} = "ready! ($n/".scalar @sellist." deleted)"; $ddw->update;
			  })->pack(-fill => 'x', -side => "left", -padx => 2, -pady => 2);

  $f2b->Button(-text => "Delete B",
			  -command => sub {
				return unless ($ddlb->info('children'));
				my @sellist = $ddlb->info('selection');
				return unless (@sellist);
				my $rc = $ddw->messageBox(-message => "Really delete ".scalar @sellist." pictures in folder ".$config{dirDiffDirB}."?",
					   -icon => 'question', -title => "Really delete?", -type => 'OKCancel');
				return unless ($rc =~ m/Ok/i);

				my $i  = 0; my $n  = 0;
				foreach (@sellist) {
				  my $pic = $ddlb->itemCget($_, $ddlb->{namecol}, -text);
				  $i++;
				  $ddw->{label} = "deleting ($i/".scalar @sellist.") ... "; $ddw->update;
				  my $dpic = $config{dirDiffDirB}."/$pic";
				  unless (-f $dpic) { print "$dpic not found!\n"; next;}
				  if (move ($dpic, $trashdir)) {       # move pic to trash
					$n++;
					my $tpic = "$trashdir/$pic";
					# change the location info in the search database
					$searchDB{$tpic} = $searchDB{$dpic};
					delete $searchDB{$dpic};
					deleteCachedPics($dpic);
					# todo move thumbnail?
					# todo deleting the entry is wrong, if picture exists in both dirs
					$ddlb->delete("entry", $_); # remove entry from list box
				  }
				}								# foreach - end
				$ddw->{label} = "ready! ($n/".scalar @sellist." deleted)"; $ddw->update;
			  })->pack(-fill => 'x', -side => "left", -padx => 2, -pady => 2);

  $f2b->Label(-text => "progress: ", -anchor => 'w', -bg => $config{ColorBG})->pack(-side => "left", -padx => 3);

  my $progBar =
  $f2b->ProgressBar(-takefocus => 0,
					 -borderwidth => 1,
					 -relief => 'sunken',
					 -length => 100,
					 -height => 5,
					 -padx => 0,
					 -pady => 0,
					 -variable => \$progress,
					 -colors => [0 => $config{ColorProgress}],
					 -resolution => 1,
					 -blocks => 10,
					 -anchor => 'w',
					 -from => 0,
					 -to => 100,
					)->pack(-side => 'left', -expand => 1, -fill => "both", -padx => 3, -pady => 3);

  my $ws = 0.7;
  my $w = int($ws * $ddw->screenwidth);
  my $h = int($ws * $ddw->screenheight);
  my $x = int(((1 - $ws) * $ddw->screenwidth)/3);
  my $y = int(((1 - $ws) * $ddw->screenheight)/3);
  #print "geo==${w}x${h}+${x}+${y}\n";
  $ddw->geometry("${w}x${h}+${x}+${y}");
  $ddw->Popup;
  $ddw->waitWindow;
}

##############################################################
# compareTwoPics
##############################################################
sub compareTwoPics {

  my $dpicA  = shift;
  my $dpicB  = shift;
  my $diff   = shift; # Ref to differences
  my $rc = 0;  # 0 = no difference 1 = pics are different

  if ($config{dirDiffSize} and (-s $dpicA != -s $dpicB)) {
	my $diff_bytes = getFileSize($dpicB, NO_FORMAT) - getFileSize($dpicA, NO_FORMAT);
	my $sign = '-';
	$sign = '+' if ($diff_bytes > 0);
	if (abs($diff_bytes) > 1024) {
	  $diff_bytes = computeUnit(abs($diff_bytes));
	} else {
	  $diff_bytes = abs($diff_bytes).'B';
	}
	$$diff .= "file size ($sign$diff_bytes)\n";
	$rc = 1;
  }

  if ($config{dirDiffComment} and (getComment($dpicA, LONG) ne getComment($dpicB, LONG))) {
	$$diff .= "comment\n";
	$rc = 1;
  }

  if ($config{dirDiffEXIF} and (getShortEXIF($dpicA, NO_WRAP) ne getShortEXIF($dpicB, NO_WRAP))) {
	$$diff .= "EXIF\n";
	$rc = 1;
  }

  if ($config{dirDiffIPTC} and (getIPTC($dpicA, SHORT) ne getIPTC($dpicB, SHORT))) {
	$$diff .= "IPTC\n";
	$rc = 1;
  }

  if ($config{dirDiffPixel}) {
	my ($wa, $ha) = getSize($dpicA);
	my ($wb, $hb) = getSize($dpicB);
	if (($wa != $wb) or ($ha != $hb)) {
	  $$diff .= "pixel size\n";
	  $rc = 1;
	}
  }

  return $rc;
}

##############################################################
# ddInsertPic - insert a row in the dir diff list
##############################################################
sub ddInsertPic {

  my $lb     = shift;
  my $dpicA  = shift;   # the dir A pic, empty string if non
  my $dpicB  = shift;   # the dir B pic, empty string if non
  my $reason = shift;   # the difference

  if ((!-f $dpicA) and (!-f $dpicB)) { warn "both pics are missing!"; return; }

  my @childs = $lb->info('children');
  my $count = 0;
  $count = @childs if (@childs);

  # create new row
  $lb->add($count);

  my (%ddthumbs, $sizeA, $sizeB, $comA, $comB, $exifA, $exifB, $iptcA, $iptcB);

  if (-f $dpicA) {
	$comA  = getComment($dpicA, SHORT);
	$exifA = getShortEXIF($dpicA, WRAP);
	$iptcA = getShortIPTC($dpicA, SHORT);
	$sizeA = getAllFileInfo($dpicA);
	my $thumbA = getThumbFileName($dpicA);
 	if (-f $thumbA) {
	  $ddthumbs{$thumbA} = $lb->Photo(-file => $thumbA, -gamma => $config{Gamma});
	  if (defined $ddthumbs{$thumbA}) {
		$lb->itemCreate($count, $lb->{thumbAcol}, -image => $ddthumbs{$thumbA}, -itemtype => "image");
	  }
	}
  }

  if (-f $dpicB) {
	$comB  = getComment($dpicB, SHORT);
	$exifB = getShortEXIF($dpicB, WRAP);
	$iptcB = getShortIPTC($dpicB, SHORT);
	$sizeB = getAllFileInfo($dpicB);
	my $thumbB = getThumbFileName($dpicB);
	if (-f $thumbB) {
	  $ddthumbs{$thumbB} = $lb->Photo(-file => $thumbB, -gamma => $config{Gamma});
	  if (defined $ddthumbs{$thumbB}) {
		$lb->itemCreate($count, $lb->{thumbBcol}, -image => $ddthumbs{$thumbB}, -itemtype => "image");
	  }
	}
  }
  my $pic;
  if (-f $dpicA) { $pic = basename($dpicA); } else { $pic  = basename($dpicB); }

  $lb->itemCreate($count, $lb->{diffcol},  -text => $reason, -style => $comS);
  $lb->itemCreate($count, $lb->{namecol},  -text => $pic,    -style => $fileS);
  $lb->itemCreate($count, $lb->{sizeAcol}, -text => $sizeA,  -style => $comS);
  $lb->itemCreate($count, $lb->{sizeBcol}, -text => $sizeB,  -style => $exifS);
  $lb->itemCreate($count, $lb->{comAcol},  -text => $comA,   -style => $comS);
  $lb->itemCreate($count, $lb->{comBcol},  -text => $comB,   -style => $exifS);
  $lb->itemCreate($count, $lb->{exifAcol}, -text => $exifA,  -style => $comS);
  $lb->itemCreate($count, $lb->{exifBcol}, -text => $exifB,  -style => $exifS);
  $lb->itemCreate($count, $lb->{iptcAcol}, -text => $iptcA,  -style => $comS);
  $lb->itemCreate($count, $lb->{iptcBcol}, -text => $iptcB,  -style => $exifS);

}

##############################################################
# dirDiff
##############################################################
sub dirDiff {

  my $dir1  = shift;
  my $dir2  = shift;
  my $only1 = shift; # ref to array
  my $only2 = shift; # ref to array
  my $inter = shift; # ref to array

  return unless (-d $dir1);
  return unless (-d $dir2);

  my $tmp = $config{CheckForNonJPEGs}; # save the option to a temp variable
  $config{CheckForNonJPEGs} = 0;       # switch the option off

  my @pics1 = getPics($dir1, JUST_FILE); # no sort needed
  my @pics2 = getPics($dir2, JUST_FILE); # no sort needed

  $config{CheckForNonJPEGs} = $tmp;    # restore the option

  @{$only1}   = diffList(\@pics1, \@pics2);
  @{$only2}   = diffList(\@pics2, \@pics1);
  @{$inter}   = listIntersection(\@pics2, \@pics1);
}

##############################################################
# showkeys - show the key bindings
##############################################################
sub showkeys {

  my $file;
  # open the file mapivi
  if (!open($file, "<$0")) {
	warn "could not open $0 for read access!: $!";
	return;
  }
  my @lines = <$file>;  # read the complete file into the array lines
  close $file;

  my @keys;
  foreach my $line (@lines) {
	$line =~ s/\s+$//;   # cut trailing whitespace
	$line =~ s/^\s+//;   # cut leading whitespace
	# look for lines containing "key-desc"
	if ($line =~ m/.*key-desc.*/) {
	  push @keys, $line;
	}
  }

  my $text;
  # sort the keys alphabetical
  foreach (sort { uc($a) cmp uc($b); } @keys) {
	my @a = split /,/, $_;
	if (@a != 3) { print "showKeys: suspicious line: $_\n"; next; }
	chomp($a[2]);
	$text .= sprintf "%-13s ... %s\n",$a[1], $a[2];
  }

  my $title = "Keys shortcuts for mapivi $version";

  showText($title, $text, NO_WAIT, $mapiviiconfile);
}

##############################################################
# buildDatabase - scans through all sub folders of
#                        the actual dir an collects JPEG files
#                        let the user select in which dirs
#                        mapivi should build/refresh thumbnails
##############################################################
sub buildDatabase {

  my $mydir = getRightDir();
  my $rc = checkDialog( 'Add pictures to database in all sub folders',
						'MaPiVi will create a list of all sub folders of folder "'.basename($mydir).'" containing JPEG files.
You are then able to select folders from the list.',
						\$config{SearchDBOnlyNew},
						"add only new pictures",
						"",
						'OK', 'Cancel');
  return if ($rc ne 'OK');

  my $tmp = $config{CheckForNonJPEGs}; # save the option to a temp variable
  $config{CheckForNonJPEGs} = 0;       # switch the option off

  $userinfo = "searching sub folders ..."; $userInfoL->update;
  my @dirlist;
  my %nr_of_pics_in_dir;
  my @pictestlist;
  my $pic_count = 0;
  my $pw = progressWinInit($top, "Collect sub folders");
  my $break = 0;
  find(sub {
		 if (progressWinCheck($pw)) { $break = 1; $File::Find::prune = 1; }
		 progressWinUpdate($pw, "collecting folders, found ".scalar @dirlist." ...", 0, 0);
		 # search in dirs, but not in .thumbs/ .xvpics/ etc.
		 if (-d and ($_ ne $thumbdirname) and ($_ ne ".xvpics") and ($_ ne $exifdirname)) {
		   @pictestlist = getPics($File::Find::name, JUST_FILE);  # no sorting needed
		   if (@pictestlist > 0) {
			 $pic_count += scalar @pictestlist;
             $nr_of_pics_in_dir{$File::Find::name} = scalar @pictestlist;
			 push @dirlist, $File::Find::name;
			 $userinfo = "found ".scalar @dirlist." sub folders ..."; $userInfoL->update;
		   }
		 }
	   }, $mydir);
  progressWinEnd($pw);
  if ($break) {
	$userinfo = "user break while counting folders";
	return;
  }

  $config{CheckForNonJPEGs} = $tmp;    # restore the option

  $userinfo = "found ".@dirlist." sub folders with $pic_count JPEGs"; $userInfoL->update;

  @dirlist = sort @dirlist;

  my @sellist;
  return if (!mySelListBoxDialog("Select folders",
								 "Found ".scalar @dirlist." folders with $pic_count JPEG pictures.\nThe database will be updated with the pictures of the selected folders.",
                                 MULTIPLE,
								 "add to database", \@sellist, @dirlist));
                                 
  # copy the selected elements into the @sel_dirs list
  my @sel_dirs;
  $pic_count = 0;
  foreach (@sellist) {
    push @sel_dirs, $dirlist[$_]; 
    $pic_count += $nr_of_pics_in_dir{$dirlist[$_]}
  }

  my ($dir, $dirshort, @dpics, $pic, $dpic, $com, $exif, $iptcL);

  $tmp = $config{CheckForNonJPEGs}; # save the option to a temp variable
  $config{CheckForNonJPEGs} = 0;    # switch the option off

  $pw = progressWinInit($top, "building search database");
  my $i = 0;
  my $new = 0;
  foreach $dir (@sel_dirs) {
	last if progressWinCheck($pw);

	$dirshort = cutString($dir, -40, "...");
	print "build database recursive in $dir\n" if $verbose;
	@dpics = getPics($dir, WITH_PATH); # no sorting needed

	foreach (@dpics) {
	  last if progressWinCheck($pw);
	  $i++;
	  progressWinUpdate($pw, "adding picture ($i/$pic_count) in folder $dirshort", $i, $pic_count);
	  next if ($config{SearchDBOnlyNew} and exists $searchDB{$_});
	  addToSearchDB($_);
	  $new++;
	}
  }
  progressWinEnd($pw);
  $config{CheckForNonJPEGs} = $tmp;    # restore the option
  $userinfo = "database updated (scanned $i pictures, $new added)"; $userInfoL->update;
  check_new_keywords();
}

##############################################################
# cleanDatabase - remove all database entries of non existing
#                 files
##############################################################
sub cleanDatabase {

  my $count       = 0;
  my $pics;
  my $ignoreText  = "";
  my $ignoreCount = 0;
  my $keys        = keys %searchDB;
  my %ignorePaths = qw(
					 /mnt/cdrom/ 1
					);

  # try to get the saved ignore paths
  if (-f "$configdir/ignorePaths") {
	my $hashRef = retrieve("$configdir/ignorePaths");
	warn "could not retrieve ignorePaths" unless defined $hashRef;
	%ignorePaths = %{$hashRef};
  }

  my $rc = editHashDialog('Edit ignore paths',
						  'This function will remove all invalid and outdated entries from the search database.
When cleaning the database, all entries without an corresponding file will be removed.
It is possible to exclude entries from cleaning depending on their path.
This could be done e.g. for pictures on removable media like CDROMs or DVDs.
Please add or remove paths from this list according to your file system.
A typical entry for a linux system could be /mnt/cdrom',
						  \%ignorePaths,
						  'Clean database',
						  'Cancel',
						  1 );
  return if ($rc ne 'OK');

  nstore(\%ignorePaths, "$configdir/ignorePaths") or warn "could not store ignorePaths";

  $userinfo = "cleaning database - please wait ..."; $userInfoL->update;
  my $pw    = progressWinInit($top, "cleaning search database");
  my $i     = 0;

  # loop through all database entries
  foreach my $pic (sort keys %searchDB) {
	last if progressWinCheck($pw);
	$i++;
	progressWinUpdate($pw, "checking ($i/$keys) ...", $i, $keys);

	# if the pic path matches a path of @ignorePaths we skip the entry
	# this can be used to leave pictures in the database which are
	# located on removable media like CDs
	my $ignore = 0;
	foreach my $ipath (keys %ignorePaths) {
	  if ($pic =~ m/^$ipath/) {
		$ignore = 1;
		$ignoreCount++;
		$ignoreText .= "(ignoring $pic)\n";
		last;
	  }
	}
	next if $ignore;

	# delete the picture from the database if it does not exists
	if (!-f $pic) {
	  delete $searchDB{$pic};
	  $pics .= "$pic\n";
	  $count++;
	}
  }
  progressWinEnd($pw);

  $userinfo = "cleaning database - ready"; $userInfoL->update;

  my $text = "clean picture info database:\n\n";
  if ($count > 0) {
	$text .= "Removed $count entries of non existing pictures:\n\n$pics";
  }
  else {
	$text .= "Nothing to clean - database is up to date!\n\n";
  }

  $keys       = keys %searchDB;
  my $size       = getFileSize("$configdir/SearchDataBase", FORMAT);

  $text .= "There are $keys entries in the database (file size: $size)\n\n";

  $text .= "The following $ignoreCount entries have been ignored, because their path\nmatches a entry in the \%ignorePaths hash:\n\n$ignoreText" if ($ignoreText ne "");

  showText("Clean database", $text, WAIT);
}


##############################################################
# cleanDatabaseFolder - clean the database in one folder
##############################################################
sub cleanDatabaseFolder {
  my $directory = shift;
  $userinfo = "updating database - please wait ..."; $userInfoL->update;
  my $pw    = progressWinInit($top, "updating search database");
  my $i     = 0;
  my $keys        = keys %searchDB;

  # loop through all database entries
  foreach my $pic (sort keys %searchDB) {
	last if progressWinCheck($pw);
	$i++;
	progressWinUpdate($pw, "checking ($i/$keys) ...", $i, $keys);

	# if the pic path matches the given path
	# delete the picture from the database if it does not exists
        if (($pic =~ m/^$directory/) and (!-f $pic)) {
	  #print "deleting pic $pic from DB\n";
	  delete $searchDB{$pic};
	  #$pics .= "$pic\n";
	  #$count++;
       }
  }
  progressWinEnd($pw);

  $userinfo = "database updated!"; $userInfoL->update;

}

##############################################################
# editEntryHistory
##############################################################
sub editEntryHistory {

  my $buttext = "Remove";
  my $text    = "The left list shows all used entry fields, if you select one, the right listbox will show you all elements, that have been typed into this entry field. Select one or multiple element from the right listbox and press the $buttext button to delete them.";

  my $rc;

  # open window
  my $ew = $top->Toplevel();
  $ew->title("Edit entry history");
  $ew->iconimage($mapiviicon) if $mapiviicon;

  my $height = ($text =~ tr/\n//);
  $height += 2;
  $height = 10 if ($height > 10); # not to big, we have scrollbars
  my $rotext = $ew->Scrolled("ROText",
							 -scrollbars => 'osoe',
							 -wrap => 'word',
							 -tabs => '4',
							 -width => 110,
							 -height => $height,
							 -relief => "flat",
							 -bg => $config{ColorBG},
							 -bd => "0"
							)->pack(-expand => "0", -padx => 3, -pady => 3,-anchor => 'w');
  $rotext->insert('end', $text);

  my $size = getFileSize($file_Entry_values, FORMAT);
  my $info = "File size of $file_Entry_values: $size";

  my $lbf = $ew->Frame()->pack(-fill =>'x');

  my $listBox =
	  $lbf->Scrolled('Listbox',
					-scrollbars => 'osoe',
					-selectmode => 'single',
					-exportselection => 0,
					-width => 30,
					-height => 25,
				   )->pack(-side => 'left', -expand => 1, -fill =>'both', -padx => 3, -pady => 3);
  bindMouseWheel($listBox);

  my @ekeys = sort keys %entryHistory;
  $listBox->insert('end', @ekeys);

  my $lbfr = $lbf->Frame()->pack(-side => 'left', -expand => 1, -fill =>'both');
  my $listBox2 =
	  $lbfr->Scrolled('Listbox',
					-scrollbars => 'osoe',
					-selectmode => 'extended',
					-exportselection => 0,
					#-width => 80,
					-height => 25,
				   )->pack(-side => 'top', -expand => 1, -fill =>'both', -padx => 3, -pady => 3);
  bindMouseWheel($listBox2);

  $listBox->bind('<ButtonPress-1>', sub {
				   my @sel = $listBox->curselection();
				   my $key = $ekeys[$sel[0]];
				   my @list = @{$entryHistory{$key}};
				   $listBox2->delete(0, 'end');
				   $listBox2->insert('end', @list);
				   });

  my $labF = $ew->Frame()->pack(-anchor => 'w', -padx => 3, -pady => 3);
  $labF->Label(-textvariable => \$info, -bg => $config{ColorBG})->pack(-side => "left");

  $lbfr->Button(-text => $buttext,
				-command => sub {
				  my @sel = $listBox->curselection();
				  my $key = $ekeys[$sel[0]];
				  foreach (reverse $listBox2->curselection()) {
					my $path = $listBox2->get($_);
					#print "deleting key $key element $_ ".${$entryHistory{$key}}[$_]."\n";
					splice @{$entryHistory{$key}}, $_, 1;  # remove it from list
					$listBox2->delete($_);
				  }
				}
			 )->pack(-expand => 1, -fill =>'x', -anchor => 'w', -padx => 3, -pady => 3);


  my $ButF = $ew->Frame()->pack(-fill =>'x');

  my $OKB =	$ButF->Button(-text => 'OK',
						  -command => sub { $rc = 'OK'; }
						 )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $OKB->bind('<Return>', sub { $OKB->invoke; } );

  $OKB->focus;
  $ew->Popup(-popover => 'cursor');
  repositionWindow($ew);
  $ew->waitVariable(\$rc);
  $ew->withdraw;
  $ew->destroy;
}

##############################################################
# database_info - show infos and statistics about search database
##############################################################
sub database_info {

  # first create a  chronological statistic (number of pics for each month)
  my %chrono_hash;
  my $pic_count = 0;
  my $error_count = 0;
  my $i = 0;
  my $keys = keys %searchDB;

  my $pw = progressWinInit($top, "Calculating statistic (chronological distribution)");
  foreach my $dpic (keys %searchDB) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "adding picture ($i/$keys) ...", $i, $keys);
    if ($searchDB{$dpic}{TIME}) {
	  my ($s,$m,$h,$d,$mo,$y) = localtime $searchDB{$dpic}{TIME};
	  $y += 1900; $mo++;			# do some adjustments
	  my $key = sprintf "%04d%02d", $y, $mo; # key = yyyymm
	  $chrono_hash{$key}++;
	  $pic_count++;
    }
    else {
	  $error_count++;
    }
  }
  progressWinEnd($pw);
  #print "found $error_count pictures without date info.\n" if ($error_count > 0);
  #print "found $pic_count pictures with date info.\n";
  
  # fill up empty months in hash with zero
  my @chrono_list;
  foreach (sort keys %chrono_hash) { push @chrono_list, $_; }
  my $first_ymonth = $chrono_list[0];
  my $last_ymonth = $chrono_list[-1];
  my $first_month = substr($first_ymonth, 4 , 2);
  my $last_month = substr($last_ymonth, 4 , 2);
  my $first_year = substr($first_ymonth, 0 , 4);
  my $last_year = substr($last_ymonth, 0 , 4);
  
  for my $year ($first_year .. $last_year) {
    for my $month (1 .. 12) {
      next if (($year == $first_year) and ($month < $first_month));
      last if (($year == $last_year) and ($month > $last_month));
      my $yyyymm = sprintf "%04d%02d", $year, $month;
      if ($chrono_hash{$yyyymm}) {
        #print "$yyyymm is defined\n";
      }
      else {
        #print "$yyyymm is not defined\n";
        $chrono_hash{$yyyymm} = 0;
      }
    }  
  }
    
  my $month_nr = keys %chrono_hash;
  #print "found $month_nr differnt month; max. pics $max_pics_per_month in month $max_month. first: $first_ymonth ($first_year $first_month) last: $last_ymonth ($last_year $last_month)\n";
  
  # open window
  my $win = $top->Toplevel();
  $win->title("Database Information - Timeline (Chronological Picture Distribution)");
  $win->iconimage($mapiviicon) if $mapiviicon;

  # canvas size
  #my $h = int(0.3 * $win->screenheight);
  #my $w = int(0.9 * $win->screenwidth);
  my $w = 0; my $h = 0; my $h_scale_factor =1;
  my $month_w = $w/$month_nr;

  my $butF = $win->Frame()->pack(-expand => 0, -fill => 'y');

  my $canvas = $win->Scrolled('Canvas',
			    -scrollbars => 'osoe',
                #-width  => $w,
			    #-height => $h+26,
                -width  => 10,
			    -height => 10,
			    -relief => 'sunken',
              )->pack(-side => 'top', -expand => 1, -fill => 'both', -padx => 3, -pady => 3);
  $canvas->configure(-scrollregion => [0, 0, 10, 10]);

  $butF->Button(-text => ' -- ', -command => sub {
                 $w = $canvas->Subwidget("scrolled")->width - $ScW; # $ScW = scrollbar width
                 $month_w = $w/$month_nr if ($month_w < 1);
                 $month_w -= 5;
                 $month_w = 1 if ($month_w < 1);
                 database_info_update($canvas, \%chrono_hash, $month_w);
                })->pack(-side => 'left', -padx => 3, -pady => 3);
  $butF->Button(-text => '  -  ', -command => sub {
                 $w = $canvas->Subwidget("scrolled")->width - $ScW; # $ScW = scrollbar width
                 $month_w = $w/$month_nr if ($month_w < 1);
                 $month_w--;
                 $month_w = 1 if ($month_w < 1);
                 database_info_update($canvas, \%chrono_hash, $month_w);
                })->pack(-side => 'left', -padx => 3, -pady => 3);
  $butF->Button(-text => ' + ', -command => sub {
                 $w = $canvas->Subwidget("scrolled")->width - $ScW; # $ScW = scrollbar width
                 $month_w = $w/$month_nr if ($month_w < 1);
                 $month_w++;
                 database_info_update($canvas, \%chrono_hash, $month_w);
                })->pack(-side => 'left', -padx => 3, -pady => 3);
  $butF->Button(-text => '++', -command => sub {
                 $w = $canvas->Subwidget("scrolled")->width - $ScW; # $ScW = scrollbar width
                 $month_w = $w/$month_nr if ($month_w < 1);
                 $month_w += 5;
                 database_info_update($canvas, \%chrono_hash, $month_w);
                })->pack(-side => 'left', -padx => 3, -pady => 3);
  $butF->Button(-text => 'minimum', -command => sub {
                 $month_w = 1;
                 database_info_update($canvas, \%chrono_hash, $month_w);
                })->pack(-side => 'left', -padx => 3, -pady => 3);
  $butF->Button(-text => 'medium', -command => sub {
                 $month_w = 16;
                 database_info_update($canvas, \%chrono_hash, $month_w);
                })->pack(-side => 'left', -padx => 3, -pady => 3);
  $butF->Button(-text => 'large', -command => sub {
                 $month_w = 36;
                 database_info_update($canvas, \%chrono_hash, $month_w);
                })->pack(-side => 'left', -padx => 3, -pady => 3);
  $butF->Button(-text => 'fit', -command => sub {
                 $win->update;
                 #$w = $canvas->Subwidget("scrolled")->width;
                 #$h = $canvas->Subwidget("scrolled")->height;
                 #$month_w = $w/$month_nr;
                 $month_w = 0;
                 database_info_update($canvas, \%chrono_hash, $month_w);
                })->pack(-side => 'left', -padx => 3, -pady => 3);

  $butF->Button(-text => 'Info', -command => sub {
my $text = "Chronological distribution of pictures per month in the search database.\nThis chart uses the picture EXIF date when available.\n$pic_count pictures with and $error_count pictures without date info in database.\nIf you click on a box the pictures of that month will be shown.\nSome information will appear, if mouse hovers above a box.";
 showText("Information", $text, NO_WAIT);
})->pack(-side => 'left', -padx => 3, -pady => 3);

  my $msg = '';
  $balloon->attach($canvas,
		   -postcommand => sub {
		        my @curr = $canvas->find('withtag', 'current');
	            my @tags = $canvas->gettags($curr[0]);
                my $yyyymm = '';
	            foreach (@tags) {
	              next if ($_ eq 'current');
	              $yyyymm = $_;
                }
                return if (length($yyyymm) != 6);
                my $act_month = substr($yyyymm, 4 , 2);
                my $act_year  = substr($yyyymm, 0 , 4);
                $msg = "$act_month/$act_year: $chrono_hash{$yyyymm} pictures";
		   },
               -balloonposition => "mouse",
	           -msg => \$msg);

  $canvas->CanvasBind( '<B1-ButtonRelease>' =>
      sub {
	        my @curr = $canvas->find('withtag', 'current');
	        my @tags = $canvas->gettags($curr[0]);
            my $yyyymm = '';
	        foreach (@tags) {
	          next if ($_ eq 'current');
	          $yyyymm = $_;
            }
            return if (length($yyyymm) != 6);
            my $act_month = substr($yyyymm, 4 , 2);
            my $act_year  = substr($yyyymm, 0 , 4);
            my $rc = $win->messageBox(-icon => 'question',
                                     -title => "Show $chrono_hash{$yyyymm} pictures from $act_month/$act_year?", 
                                     -message => "Press OK to display $chrono_hash{$yyyymm} pictures from $act_month/$act_year.",
                                     -type => 'OKCancel');
            return if ($rc !~ m/Ok/i);
            my @list;
			my $start_time = buildUnixTime(sprintf "01.%02d.%04d", $act_month, $act_year);
            my $next_month = $act_month + 1;
            my $next_year= $act_year;
            if ($next_month > 12) { $next_month = 1; $next_year++; }
			my $end_time   = buildUnixTime(sprintf "01.%02d.%04d", $next_month, $next_year) - 1;
			#print "xxx-start: $start_time .. end: $end_time act:$act_month, $act_year next: $next_month, $next_year\n";
            my $i = 0;
            my $db_keys = keys %searchDB;
            my $pw = progressWinInit($win, "Searching pictures database");
            foreach my $dpic (keys %searchDB) {
              last if progressWinCheck($pw);
              $i++;
              progressWinUpdate($pw, "searching ($i/$db_keys) ...", $i, $db_keys);
              my $time = $searchDB{$dpic}{TIME};
              next unless (defined $time);
              next if ($time < $start_time);
			  next if ($time > $end_time);
              push @list, $dpic;
            }
            progressWinEnd($pw);
			sortPics('exifdate', 1, \@list);
			showThumbList(\@list, "$act_month/$act_year");
      });

  $butF->Button(-text => "Close",
	           -command => sub { $win->destroy(); }
		)->pack(-side => 'left',-expand => 0,-fill => 'x',-padx => 3,-pady => 3);
        
  $win->bind('<Key-Escape>', sub { $win->destroy; } );
  $win->Popup;
  my $ww = int(0.8 * $top->screenwidth);
  my $wh = int(0.3 * $top->screenheight);
  $win->geometry("${ww}x${wh}+10+10");
  $win->update;
  database_info_update($canvas, \%chrono_hash, $month_w);
}

##############################################################
# database_info_update - draw diagram
##############################################################
sub database_info_update {

  my $canvas = shift;
  #my $w = shift;
  #my $h = shift;
  my $chrono_hash = shift;
  #my $pic_count = shift;
  #my $error_count = shift;
  my $month_w = shift;
  #my $month_nr = shift;
  #my $h_scale_factor = shift;
  
  my $month_nr = keys %{$chrono_hash};
  my $w = $canvas->Subwidget("scrolled")->width - $ScW; # $ScW = scrollbar width
  my $h = $canvas->Subwidget("scrolled")->height - $ScW;

  # search the maximum number of pictures per month
  my $max_pics_per_month = 0;
  foreach (keys %{$chrono_hash}) {
    if ($chrono_hash->{$_} > $max_pics_per_month) {
      $max_pics_per_month = $chrono_hash->{$_};
    }
  }
  my $axis_h = 30; # height for x axis and month and year numbers
  my $h_scale_factor = $max_pics_per_month/($h - $axis_h);

  $month_w = $w/$month_nr if ($month_w == 0);
  
  $canvas->delete('all');
  #$canvas->configure(-scrollregion => [0, 0, $month_nr*$month_w-10, $h+26]);
  $canvas->configure(-scrollregion => [0, 0, $month_nr*$month_w, $h]);

  my $x = 2; my $step = 0;
  foreach my $yyyymm (sort keys %{$chrono_hash}) {
    my $act_month = substr($yyyymm, 4 , 2);
    my $act_year  = substr($yyyymm, 0 , 4);
    # draw a box for each month
    my $id = $canvas->createRectangle( $x, $h-$axis_h, int($x+$month_w-1), $h-$axis_h-int($chrono_hash->{$yyyymm}/$h_scale_factor),
                    -fill => $config{ColorActBG},
                    -outline => $config{ColorSel},
                    -tags => $yyyymm,
		    -width => 1,
		);
        
    # mark month border
    $canvas->createLine( $x, $h-$axis_h, $x, $h-int(0.5*$axis_h), -fill => $config{ColorFG});
    # mark year border
    if ($act_month eq '01') {
      $canvas->createLine( $x, $h-$axis_h, $x, $h, -fill => $config{ColorFG});
    }
    # write month if more then 16 pixel available
    if ($month_w >= 16) {
      $canvas->createText($x+int($month_w/2), $h-$axis_h+6, -font => $small_font, -text => $act_month, -anchor => 'n', -justify => 'center', -fill => $config{ColorFG});
    }
    # write number of pics if enough space
    if ($month_w > length($chrono_hash->{$yyyymm})*8) {
        my $h = $h-$axis_h-int($chrono_hash->{$yyyymm}/$h_scale_factor);
        $h = 14 if ($h < 14);
        $canvas->createText($x+int($month_w/2), $h, -font => $small_font, -text => $chrono_hash->{$yyyymm}, -anchor => 's', -justify => 'center', -fill => $config{ColorFG});
    
    }
    # write year
    if ($act_month eq '07') {
      $canvas->createText($x, $h, -font => $small_font, -text => $act_year, -anchor => 's', -justify => 'center', -fill => $config{ColorFG});
    }
    $step++;
    $x = int($month_w * $step);
  }

  # draw x axis
  $canvas->createLine( 0, $h-$axis_h, $month_nr*$month_w, $h-$axis_h, -fill => $config{ColorFG});
}

##############################################################
# keyword_browse -  browse picture collection by keywords (tagclouds) 
##############################################################
sub keyword_browse {

  # list of keywords to constraint the browsing/searching
  my @search_keys;
  # list of keywords to exclude from browsing/searching
  my @exclude_keys; 
  # get stored values
  if ($config{KeywordExclude}) {
    @exclude_keys = split / /, $config{KeywordExclude};
  }
    
  # open window
  my $win = $top->Toplevel();
  $win->title('Keyword browser (tag cloud)');
  $win->iconimage($mapiviicon) if $mapiviicon;
  
  my $cc;
  
  my $butF  = $win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
  my $butF2 = $win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
  my $butF3 = $win->Frame(-relief => 'groove');
  
  if ($config{KeywordMore}) {
    $butF3->pack(-after => $butF2, -expand => 0, -fill => 'x', -padx => 4, -pady => 3);
  }
  else { $butF3->packForget(); }

  my $add_mode = 1;
  my $label = '';
  my $hb = $butF->Button(-text => 'home',
                -command => sub {
                  # reset search_keys
                  @search_keys = ();
                  $label = '';
                  show_keywords($win, \@search_keys, \@exclude_keys);
                })->pack(-side => 'left', -padx => 3);
  $balloon->attach($hb, -msg => "Restart\nShow all keywords");

  my $bb = $butF->Button(-text => 'back',
                -command => sub {
                  return unless (@search_keys);
                  # remove last element of array  search_keys
                  pop @search_keys;
                  $label = '';
                  $label .= "$_ " foreach (@search_keys);
                  show_keywords($win, \@search_keys, \@exclude_keys);
                })->pack(-side => 'left', -padx => 3);
  $balloon->attach($bb, -msg => "Go back\nRemove last keyword from list");

  $butF->Label(-textvariable => \$label,
				)->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 1, -pady => 1);
  my $addB = $butF->Checkbutton(-text => 'add mode', -variable => \$add_mode)->pack(-side => 'left');
  $balloon->attach($addB, -msg => 'If add mode is enabled, keywords will be added
and the search is narrowed to pictures
containing all displayed keywords.
If add mode is disabled, each click on a keyword
will start a new search for just this keyword.');

  my $Xbut = $butF->Button(-text => 'Close',
						   -command => sub {
                             # store excluded keywords for next session
						     $config{KeywordExclude} = '';
						     $config{KeywordExclude} .= "$_ " foreach (@exclude_keys);
                             # clode window
							 $win->destroy();
						   })->pack(-side => 'right', -padx => 3);
  $balloon->attach($Xbut, -msg => 'Close window (key: ESC)');
  $win->bind('<Control-q>',  sub { $Xbut->invoke; });
  $win->bind('<Key-Escape>', sub { $Xbut->invoke; });

  $butF2->Button(-text => 'show',
                -command => sub {
                  my @list = get_pics_with_keywords(\@search_keys, \@exclude_keys);
                  showThumbList(\@list, $label);
                })->pack(-side => 'left', -padx => 3);
  my $lab2 = $butF2->Label(-textvariable => \$win->{label2},
				)->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 3, -pady => 1);
  $balloon->attach($lab2, -msg => "x pictures\nx = number of pictures with the selected keywords\ny/z keywords\n = number of displayed keywords\nz = number of all matching keywords");

  my $more_button;
  $more_button = $butF2->Checkbutton(-variable => \$config{KeywordMore},
                      -text => 'more options',
                      -command => sub {
                        if ($config{KeywordMore}) {
                          $butF3->pack(-after => $butF2, -expand => 0, -fill => 'x', -padx => 4, -pady => 3);
                        }
                        else { $butF3->packForget(); }
                      })->pack(-side => 'right', -padx => 5);
  $balloon->attach($more_button, -msg => 'Click here to see some more options');
 
  my $label_ex = ''; $label_ex .= "$_ " foreach (@exclude_keys);
  my $butF3i = $butF3->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
  my $ceb = $butF3i->Button(-text => 'clear',
                -command => sub {
                  # reset exclude_keys
                  @exclude_keys = ();
                  $label_ex = '';
                  show_keywords($win, \@search_keys, \@exclude_keys);
                })->pack(-side => 'left', -padx => 3);
  $balloon->attach($ceb, -msg => "Clear all keywords from exclude list");
  $butF3i->Label(-text => 'Excluded:',
				)->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 1, -pady => 1);
  $butF3i->Label(-textvariable => \$label_ex,
				)->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 1, -pady => 1);
  $butF3->Label(-text => 'Right click to select a keyword, left click to exclude it')->pack(-anchor => 'w', -padx => 3);

  my $lib = $butF3->Checkbutton(-variable => \$config{KeywordLimit},
                      -text => 'Limit to 100 keywords',
                      -command => sub {show_keywords($win, \@search_keys, \@exclude_keys);}
                      )->pack(-anchor => 'w', -padx => 3);             
  $balloon->attach($lib, -msg => 'Limit to a maximum of the 100 most popular keywords.');

  my $butF3j = $butF3->Frame()->pack(-fill =>'x', -padx => 0, -pady => 0);
  my $dab = $butF3j->Checkbutton(-variable => \$config{KeywordDate},
                      -text => 'Limit by date between  ',
                      -command => sub {show_keywords($win, \@search_keys, \@exclude_keys);}
                      )->pack(-side => 'left', -anchor => 'sw', -pady => 0);             
  $balloon->attach($dab, -msg => "Limit to a date range.\nThe first scale is the first day of the selected year\nthe second scale is the last day of the selected year.\nIf both scales show e.g. 2008 only keywords from pictures taken\nbetween 2008-01-01 and 2008-12-31 are shown.\nThe EXIF date is used for this function.");

  my ($first, $last) = get_date_limits();

  my (undef,undef,undef,undef,undef,$start) = localtime $config{KeywordStart};
  $start += 1900;
  my (undef,undef,undef,undef,undef,$end) = localtime $config{KeywordEnd};
  $end += 1900;

  $butF3j->Scale(-variable => \$start,
         -from => $first,
		 -to => $last,
		 -resolution => 1,
		 -sliderlength => 20,
		 -orient => 'horizontal',
		 -showvalue => 1,
		 -width => 15,
		 -command => sub {
             $end = $start if ($end < $start);
             $win->{LAST_RESCALE_TIMER_MH}->cancel if ($win->{LAST_RESCALE_TIMER_MH});
             # after 500 msec we recalculate the keywords this gives better responsiveness
             $win->{LAST_RESCALE_TIMER_MH} = $win->after(500, sub {
		        # sec,min,hour,day,mon,year (day = 1-31 month = 0-11)
		        $config{KeywordStart} = timelocal(0,0,0,1,0,$start);
		        $config{KeywordEnd} = timelocal(0,0,0,31,11,$end);
                show_keywords($win, \@search_keys, \@exclude_keys) if $config{KeywordDate};
              });
             })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 0);
  $butF3j->Scale(-variable => \$end,
		 -from => $first,
		 -to => $last,
		 -resolution => 1,
		 -sliderlength => 30,
		 -orient => 'horizontal',
		 -showvalue => 1,
		 -width => 15,
		 -command => sub {
		     $start = $end if ($start > $end);
             $win->{LAST_RESCALE_TIMER_MH}->cancel if ($win->{LAST_RESCALE_TIMER_MH});
             # after 500 msec we recalculate the keywords this gives better responsiveness
             $win->{LAST_RESCALE_TIMER_MH} = $win->after(500, sub {
		        # sec,min,hour,day,mon,year (day = 1-31 month = 0-11)
		        $config{KeywordStart} = timelocal(0,0,0,1,0,$start);
		        $config{KeywordEnd} = timelocal(0,0,0,31,11,$end);
                show_keywords($win, \@search_keys, \@exclude_keys) if $config{KeywordDate};
              });
		 })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 0);

  my $butF3k = $butF3->Frame()->pack(-fill =>'x', -padx => 0, -pady => 0);
  my $rab = $butF3k->Checkbutton(-variable => \$config{KeywordRating},
                      -text => 'Limit by rating between',
                      -command => sub {show_keywords($win, \@search_keys, \@exclude_keys);}
                      )->pack(-side => 'left', -anchor => 'sw', -pady => 3);             
  $balloon->attach($rab, -msg => "Limit to a rating range.\nIf the first scale shows e.g. 2 and the second scale shows 4\nonly keywords from pictures with a rating of 2, 3 or 4 are shown.\nThe IPTC urgency is used for this function.\nNote: 1 is the highest (best) rating, 8 the lowest.");

  $butF3k->Scale(-variable => \$config{KeywordRatingA},
         -from => 1,
		 -to => 8,
		 -resolution => 1,
		 -sliderlength => 20,
		 -orient => 'horizontal',
		 -showvalue => 1,
		 -width => 15,
		 -command => sub {
             $config{KeywordRatingB} = $config{KeywordRatingA} if ($config{KeywordRatingB} < $config{KeywordRatingA});
             $win->{LAST_RESCALE_TIMER_MH}->cancel if ($win->{LAST_RESCALE_TIMER_MH});
             # after 500 msec we recalculate the keywords this gives better responsiveness
             $win->{LAST_RESCALE_TIMER_MH} = $win->after(500, sub {
                 show_keywords($win, \@search_keys, \@exclude_keys) if $config{KeywordRating};
              });
             })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 0);
  $butF3k->Scale(-variable => \$config{KeywordRatingB},
		 -from => 1,
		 -to => 8,
		 -resolution => 1,
		 -sliderlength => 30,
		 -orient => 'horizontal',
		 -showvalue => 1,
		 -width => 15,
		 -command => sub {
		     $config{KeywordRatingA} = $config{KeywordRatingB} if ($config{KeywordRatingA} > $config{KeywordRatingB});
             $win->{LAST_RESCALE_TIMER_MH}->cancel if ($win->{LAST_RESCALE_TIMER_MH});
             # after 500 msec we recalculate the keywords this gives better responsiveness
             $win->{LAST_RESCALE_TIMER_MH} = $win->after(500, sub {
                show_keywords($win, \@search_keys, \@exclude_keys) if $config{KeywordRating};
              });
		 })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 0);

         $cc = $win->Scrolled('Canvas',
						-scrollbars => 'osoe',
						-width  => 700,
						-height => 400,
						-relief => 'sunken'
        )->pack(-expand => 1, -fill => 'both', -padx => 1, -pady => 1);
  $cc->configure(-scrollregion => [0, 0, 700, 400]);
  $win->{canvas} = $cc;

  $win->Popup(-popover => 'cursor');

  show_keywords($win, \@search_keys, \@exclude_keys);

  # reaction for clicking on a keyword (tag)
  $cc->CanvasBind('<Button-1>'  => sub {
    my @curr = $cc->find('withtag', 'current');
    my @tags = $cc->gettags($curr[0]);
    foreach (@tags) {
      next if ($_ eq 'current');
      if ($add_mode) {
        # add new keyword to list, if it is not already there
        push @search_keys, $_ unless (isInList($_, \@search_keys));
      }
      else {
        # clear list and add just the new selected keyword
        @search_keys = ();
        push @search_keys, $_;
      }
    }
    $label = '';
    $label .= "$_ " foreach (@search_keys);
    show_keywords($win, \@search_keys, \@exclude_keys);
  });

  # reaction for right clicking on a keyword (tag)
  $cc->CanvasBind('<Button-3>'  => sub {
    my @curr = $cc->find('withtag', 'current');
    my @tags = $cc->gettags($curr[0]);
    foreach (@tags) {
      next if ($_ eq 'current');
      push @exclude_keys, $_ unless (isInList($_, \@exclude_keys));
    }
    $label_ex = '';
    $label_ex .= "$_ " foreach (@exclude_keys);
    show_keywords($win, \@search_keys, \@exclude_keys);
  });

 # wait for the close button
 $win->waitWindow;
}

##############################################################
# get_date_limits - get the first and the last year from database
##############################################################
sub get_date_limits {
    my $first = 99999999999;
    my $last  = 0;
    foreach my $dpic (keys %searchDB) {
	  if ($searchDB{$dpic}{TIME}) {
	    $last  = $searchDB{$dpic}{TIME} if ($searchDB{$dpic}{TIME} > $last);
	    $first = $searchDB{$dpic}{TIME} if ($searchDB{$dpic}{TIME} < $first);
	  }
    }
    # from UNIX time to calendar years
    (undef,undef,undef,undef,undef,$last) = localtime $last;
    $last += 1900;
    (undef,undef,undef,undef,undef,$first) = localtime $first;
    $first += 1900;
    return ($first, $last);
}

##############################################################
# show_keywords - add keyword cloud to a canvas
##############################################################
sub show_keywords {
  my $win = shift; # canvas
  my $search_keys = shift; # list reference for keywords which must be contained
  my $exclude_keys = shift; # list reference for keywords which must not be contained

  $win->Busy;

  # get the keywords according to the search keyword list ($search_keys)
  my ($count, %keyword_hash) = get_keywords($search_keys, $exclude_keys);
  my $all_keys = keys %keyword_hash;
  
  my $cc = $win->{canvas};
  
  # clear canvas
  $cc->delete('all');

  # limit the number of keywords to the 100 most popular keywords
  # todo 100 should not be a fixed value 
  my $max_keys = 100;
  my $key_count = 0;
  if (($config{KeywordLimit}) and ((keys %keyword_hash) > $max_keys)) {
    my %new_hash;
    # sort hash by size of value (number of pictures with this keyword)
    foreach my $key (sort {$keyword_hash{$b} <=> $keyword_hash{$a}} keys %keyword_hash) {
      # copy the first 100 to a new hash
      $new_hash{$key} = $keyword_hash{$key};
      $key_count++;
      last if ($key_count >= $max_keys);
    }
    # empty the original hash
    undef %keyword_hash;
    # copy the shortened hash back
    %keyword_hash = %new_hash;
  }

  $win->{label2} = "$count pictures (".keys(%keyword_hash)."/$all_keys keywords)";

  if (keys %keyword_hash > 0) {
    # find max an min numbers
    my $min = 9999999; my $max = 0;
    foreach (keys %keyword_hash) {
	  $min = $keyword_hash{$_} if ($keyword_hash{$_} < $min);
	  $max = $keyword_hash{$_} if ($keyword_hash{$_} > $max);
    }
    
    # to have a nice size distribution we need the log function
    my $diff = 1;
    $diff = log($max - $min) if ($max != $min); # log(1) = 0! log(0) = -infinite
    #print "max $max min $min diff $diff\n";
    $diff = 0.1 if ($diff == 0); # prevent division by zero
    
    # maximum and minimum font size for tag cloud
    my $font_min = 9;
    my $font_max = 20;
    my $font_middle = int(($font_max-$font_min)/2 + $font_min);
    
    # h and v space between tags/keywords
    my $x_space = 5;
    my $y_space = 3;
    
    my $x_max = 0;
    my $x = $x_space;
    my $y = $y_space + int($font_max/2);
    # sort keywords alphabetical
    foreach my $key (sort keys %keyword_hash) {
	my $size = $font_middle;

	# to have a nice size distribution we need the log function
	$size = int(log($keyword_hash{$key} - $min + 1)/$diff * ($font_max-$font_min) + $font_min) if ($max != $min);
	#printf "%-20s %5d %2.2f size: %2d", $key, $keyword_hash{$key}, log($keyword_hash{$key})/$diff, $size;
	# safety check
	$size = $font_max if ($size > $font_max);
	$size = $font_min if ($size < $font_min);
	#print " $size\n";
	
	# bold style for the bigger fonts
	my $style = 'normal';
	$style = 'bold' if ($size >= $font_middle);
	my $font = $top->Font(-family => $config{PropFontFamily}, -size => $size, -weight => $style);
	
	# the more often a keyword is used there brighter it is displayed 
	my $color_percent = 100;
	$color_percent = int(log($keyword_hash{$key} - $min + 1)/$diff * 100) if ($max != $min);
	my $color = $win->Darken('blue', $color_percent);
	
	# add the keyword (tag) to the canvas
	my $id = $cc->createText($x, $y, -text => $key, -fill => $color, -font => $font, -anchor => 'w', -tags => [$key]);
	
	# get the needed canvas space
	my ($x1, $y1, $x2, $y2) = $cc->bbox($id);
	
	# calculate next coordinates
	$x += ($x2 - $x1) + $x_space;
    # todo: replace 600 by windo width
	if ($x > 600) { $x_max = $x if ($x > $x_max); $x = $x_space; $y += ($font_max + $y_space); }
    }  
    # adjust the canvas scrollbars to the used space
    $cc->configure(-scrollregion => [0, 0, $x_max, ($y + int($font_max/2) + $y_space)]);
  }
  else {
    # adjust the canvas scrollbars to the used space
    $cc->configure(-scrollregion => [0, 0, 0, 0]);
  }

  $win->Unbusy;
}

##############################################################
# get_keywords - get all keywords from the searchDB (may be restriced by a keyword list ($search_keys))
##############################################################
sub get_keywords {
  my $search_keys = shift; # list reference for included keywords
  my $exclude_keys = shift; # list reference for excluded keywords
  my %keyword_hash;
  my $count = 0;
  
  #my $start_date = timelocal(0,0,0,1,11,2003); # sec,min,hour,day,mon,year (day = 1-31 month = 0-11)
  #my $end_date   = timelocal(0,0,0,1,11,2004); # sec,min,hour,day,mon,year (day = 1-31 month = 0-11)
  
  # build keyword/tag hash
  #stopWatchStart();
  # loop through all pictures in the DB
  foreach my $dpic (keys %searchDB) {
    # skip if no keywords info in picture
    next unless (defined $searchDB{$dpic}{KEYS});

    if ($config{KeywordDate}) {
      next if (defined $searchDB{$dpic}{TIME} and ($searchDB{$dpic}{TIME} < $config{KeywordStart}));
      next if (defined $searchDB{$dpic}{TIME} and ($searchDB{$dpic}{TIME} > $config{KeywordEnd}));
    }

    if ($config{KeywordRating}) {
      next unless (defined $searchDB{$dpic}{URG}); # ignore pictures withour rating/urgency
      next if (defined $searchDB{$dpic}{URG} and ($searchDB{$dpic}{URG} < $config{KeywordRatingA}));
      next if (defined $searchDB{$dpic}{URG} and ($searchDB{$dpic}{URG} > $config{KeywordRatingB}));
    }
    
    # check if any items of the exclude_keys list are contained in this keyword string
    my $wrong = 0;
    foreach (@{$exclude_keys}) {
      $wrong++ if ($searchDB{$dpic}{KEYS} =~ m/$_/);
      last if ($wrong > 0);
    }
    next if ($wrong > 0);

    # check if all items of the search_keys list are contained in this keyword string
    $wrong = 0;
    foreach (@{$search_keys}) {
      $wrong++ unless ($searchDB{$dpic}{KEYS} =~ m/$_/);
      last if ($wrong > 0);
    }
    next if ($wrong > 0);
    
    # count number of pictures matching all keywords of the search keyword list
    $count++;

    # the keywords are stored as a space separated string so we need to split up    
    my @keys = split / /, $searchDB{$dpic}{KEYS};
    foreach my $key (@keys) {
      # hierarchical keywords are joined by an period "."    todo this may cause problems ("Mr. X, "Louis XIV.", "Dr. Miller")
      my @subkeys = split /\./, $key;
      foreach (@subkeys) {
        # add keyword to hash and count how often it was found
        if (defined $keyword_hash{$_}) {
          $keyword_hash{$_}++;
        }
        else {
          $keyword_hash{$_} = 1;
        }
      }
    }      
  }

  #stopWatchStop('building keyword hash');
  #print "done\nFound ".keys(%keyword_hash)." different keywords in $count pictures (database: ".keys(%searchDB).").\n";
  #foreach (sort {$keyword_hash{$b} <=> $keyword_hash{$a}} keys %keyword_hash) {
   #printf "%5d %-s\n", $keyword_hash{$_}, $_;
  #}

  return ($count, %keyword_hash);
}  

##############################################################
# search_by_location
##############################################################
sub search_by_location {

  if (Exists($locw)) {
    $locw->deiconify;
	$locw->raise;
	$locw->focus;
	return;
  }

  my $lb = shift; # thumbnail widget e.g. $picLB
  
  # open window
  $locw = $top->Toplevel();
  $locw->withdraw;
  $locw->title('Locations');
  $locw->iconimage($mapiviicon) if $mapiviicon;

 
  my $locXBut = $locw->Button(-text => "Close",
						  -command => sub {
                              $config{LocGeometry} = $locw->geometry;
							  $locw->destroy;
						  })->pack(-fill => 'x');

  my $rotext = $locw->Scrolled("ROText",
							 -scrollbars => 'osoe',
							 -wrap => 'word',
							 -width => 40,
							 -height => 4,
							 -relief => 'flat',
							 -bd => 0
							)->pack(-expand => 0, -fill => 'x', -padx => 3, -pady => 3);
  $rotext->insert('end', "Information:\nDouble click on any location to see pictures.\nThe location information is gathered from the IPTC tags Country, Province/State, City and SubLocation");
  
  my $tree;
  my $af = $locw->Frame()->pack(-fill =>'x', -padx => 2, -pady => 1);
  my $add_but = $af->Button(-text => 'Add',
						  -command => sub {
	  my @locs = $tree->info('selection');
	  return unless checkSelection($locw, 1, 1, \@locs, 'location');
      my @loc  = split(/%/, $locs[0]);
      my @sellist = getSelection($lb);
      return unless checkSelection($locw, 1, 0, \@sellist, 'picture');
	  my $pics_with_location = check_locations(\@sellist);
	  if ($pics_with_location > 0) {
	  	my $rc = $locw->messageBox(-message => "$pics_with_location of the ".scalar @sellist." selected pictures have a location info. This information will be overwritten. Please press Ok to continue.",
					   -icon => 'question', -title => "Ovewrwrite location?", -type => 'OKCancel');
	    return if ($rc !~ m/Ok/i);
	  }
	  my $location;
	  $location .= "$_ " foreach (@loc);
      $userinfo = "adding ${location}to ".scalar @sellist." pictures ..."; $userInfoL->update;
	  my $errors = '';
	  my $count  = 0;
      # add location info to selected pictures
	  foreach my $dpic (@sellist) {
	    my $meta = getMetaData($dpic, 'APP13');
	    my $iptc = $meta->get_app13_data('TEXTUAL', 'IPTC');
        if ($iptc->{error}) {
          #warn "IPTC segment of $file has errors!";
	      $errors .= "$dpic: IPTC segment has errors!\n";
        }
        else {
	      if (defined $loc[0] and $loc[0] ne '[empty]') {
			$iptc->{'Country/PrimaryLocationName'} = $loc[0];
		  } else {
		    undef $iptc->{'Country/PrimaryLocationName'};
		  } 
	      if (defined $loc[1] and $loc[1] ne '[empty]') {
			$iptc->{'Province/State'} = $loc[1];
		  } else {
		    undef $iptc->{'Province/State'};
		  } 
	      if (defined $loc[2] and $loc[2] ne '[empty]') {
			$iptc->{'City'} = $loc[2];
		  } else {
		    undef $iptc->{'City'};
		  } 
	      if (defined $loc[3] and $loc[3] ne '[empty]') {
			$iptc->{'SubLocation'} = $loc[3];
		  } else {
		    undef $iptc->{'SubLocation'};
		  } 
	      $meta->set_app13_data($iptc, $config{LocationMode}, 'IPTC');
	      if (!$meta->save()) {
	        $errors .= "$dpic: writing of location failed!\n";
	      }
		  else {
		  	updateOneRow($dpic, $lb);
	        showImageInfoCanvas($dpic) if ($dpic eq $actpic);
			$count++;
		  }
        }
      }
      $userinfo = "added ${location}to $count of ".scalar @sellist." pictures."; $userInfoL->update;
	  
	  if ($errors ne '') {
	    $errors = "These errors occured while adding the location info to ".scalar @sellist." pictures.\n\n$errors";
        showText("Errors while adding location", $errors, NO_WAIT);
	  } 
	  })->pack(-side => 'left');
  $balloon->attach($add_but, -msg => "Add selected location to all selected pictures.\nMapivi will ask before overwriting existing location information.");

    $af->Radiobutton(-text => 'Update', -variable => \$config{LocationMode}, -value => 'UPDATE')->pack(-side => 'left');
    $af->Radiobutton(-text => 'Replace', -variable => \$config{LocationMode}, -value => 'REPLACE')->pack(-side => 'left');
  $balloon->attach($af, -msg => "In Update mode non-selected location info won't be overwritten.\nIn Replace mode all four locations (Country/State/City/Sublocation)\nwill be overwritten.\nExample: If you select just a country (USA) and add this location\nto a picture with existing location (e.g. City = New York)\nIn Update mode the City information will be preserved\nwhile in Replace mode City will be deleted");

  $tree = $locw->Scrolled('Tree',
							 -separator  => '%',
							 -scrollbars => 'osoe',
							 -selectmode => 'extended',
							 -exportselection => 0,
							 -width      => 25,
							 -height     => 25,
							 )->pack(-expand => 1, -fill =>'both', -padx => 1, -pady => 1);
  #$locw->{tree} = $tree;

  bindMouseWheel($tree->Subwidget("scrolled"));
  #$balloon->attach($tree, -msg => "Double click on a location to see pictures from there.");

  # get all location info from the database (IPTC tags: country, state, city and sublocation)
  $top->Busy;
  $userinfo = "getting locations from database ..."; $userInfoL->update;
  my %loc_hash = get_locations();
  $userinfo = "ready!"; $userInfoL->update;
  $top->Unbusy;
  
  $tree->bind("<Double-Button-1>", sub {
	  my @locs = $tree->info('selection');
	  return unless checkSelection($locw, 1, 0, \@locs);
      my @loc  = split(/%/, $locs[0]);
	  my @list;
	  my $nr_of_locations = @loc;
	  if ($nr_of_locations == 1) {
	    foreach my $state (sort keys %{$loc_hash{$loc[0]}}) {
	      foreach my $city (sort keys %{$loc_hash{$loc[0]}{$state}}) {
            foreach my $subloc (sort keys %{$loc_hash{$loc[0]}{$state}{$city}}) {
		      push @list, sort keys %{$loc_hash{$loc[0]}{$state}{$city}{$subloc}};
			}
		  }
		}
	  }
	  elsif ($nr_of_locations == 2) {
	    foreach my $city (sort keys %{$loc_hash{$loc[0]}{$loc[1]}}) {
          foreach my $subloc (sort keys %{$loc_hash{$loc[0]}{$loc[1]}{$city}}) {
		    push @list, sort keys %{$loc_hash{$loc[0]}{$loc[1]}{$city}{$subloc}};
		  }
		}
	  }
	  elsif ($nr_of_locations == 3) {
        foreach my $subloc (sort keys %{$loc_hash{$loc[0]}{$loc[1]}{$loc[2]}}) {
		  push @list, sort keys %{$loc_hash{$loc[0]}{$loc[1]}{$loc[2]}{$subloc}};
		}
	  }
	  elsif ($nr_of_locations == 4) {
        @list = sort keys %{$loc_hash{$loc[0]}{$loc[1]}{$loc[2]}{$loc[3]}};
	  }
	  else {
	    warn "Wrong number of locations: $nr_of_locations";
		return;
	  }
	  my $title = 'Location: ';
	  $title .= "$_ " foreach (@loc);
      showThumbList(\@list, $title);
  });

  #addTreeMenu($keytree, \@prekeys);

  # insert the hash in the tree
  foreach my $country (sort keys %loc_hash) {
    my $pics = 0;
    foreach my $state (sort keys %{$loc_hash{$country}}) {
      foreach my $city (sort keys %{$loc_hash{$country}{$state}}) {
        foreach my $subloc (sort keys %{$loc_hash{$country}{$state}{$city}}) {
          $pics += keys %{$loc_hash{$country}{$state}{$city}{$subloc}};
        }
      }
    }
	$tree->add($country, -text => "$country [$pics]");
    foreach my $state (sort keys %{$loc_hash{$country}}) {
      my $pics = 0;
      foreach my $city (sort keys %{$loc_hash{$country}{$state}}) {
        foreach my $subloc (sort keys %{$loc_hash{$country}{$state}{$city}}) {
          $pics += keys %{$loc_hash{$country}{$state}{$city}{$subloc}};
        }
      }
	  $tree->add("$country%$state", -text => "$state [$pics]");
      foreach my $city (sort keys %{$loc_hash{$country}{$state}}) {
        my $pics = 0;
        foreach my $subloc (sort keys %{$loc_hash{$country}{$state}{$city}}) {
          $pics += keys %{$loc_hash{$country}{$state}{$city}{$subloc}};
        }
	    $tree->add("$country%$state%$city", -text => "$city [$pics]");
        foreach my $subloc (sort keys %{$loc_hash{$country}{$state}{$city}}) {
          my $pics = keys %{$loc_hash{$country}{$state}{$city}{$subloc}};
	      $tree->add("$country%$state%$city%$subloc", -text => "$subloc [$pics]");
        }
      }
    }
  }

  # add plus/minus buttons to colapse tree
  $tree->autosetmode;

  # close tree for the first 4 levels
  foreach ($tree->info('children')) {
	$tree->close($_);
    foreach ($tree->info('children', $_)) {
	  $tree->close($_);
      foreach ($tree->info('children', $_)) {
        $tree->close($_);
         foreach ($tree->info('children', $_)) {
          $tree->close($_);
         }
      }
    }
  }

  $locw->bind('<Key-q>',      sub { $locXBut->invoke; });
  $locw->bind('<Key-Escape>', sub { $locXBut->invoke; });
  # invoke $but when the window is closed by the window manager (x-button)
  $locw->protocol("WM_DELETE_WINDOW" => sub { $locXBut->invoke; });

  $locw->Popup;
  checkGeometry(\$config{LocGeometry});
  $locw->geometry($config{LocGeometry});
  $locw->waitWindow;
}

##############################################################
# get_locations - get all locations from the searchDB as hash
##############################################################
sub get_locations {
  my %location_hash;
  
  # build location hash
  # loop through all pictures in the DB
  foreach my $dpic (keys %searchDB) {

    my $country = '[empty]';
    my $state   = '[empty]';
    my $city    = '[empty]';
    my $subloc  = '[empty]';

    if (defined $searchDB{$dpic}{IPTC}) {
      my $iptc = $searchDB{$dpic}{IPTC};
      if ($iptc =~ m|Country\.: (.*)\n|) {
        $country = $1;
      }
      if ($iptc =~ m|Provinc\.: (.*)\n|) {
        $state = $1;
      }
      if ($iptc =~ m|City\s*: (.*)\n|) {
        $city = $1;
      }
      if ($iptc =~ m|SubLoca\.: (.*)\n|) {
        $subloc = $1;
      }
    }
    $location_hash{$country}{$state}{$city}{$subloc}{$dpic}++;
  }

  return %location_hash;
}  

##############################################################
# check_locations - check if the given list of pictures has any location info
# returns the number of pictures with locations
##############################################################
sub check_locations {
  my $pic_list = shift; # list reference

  my $count = 0;  
  # loop through all pictures of the list
  foreach my $dpic (@$pic_list) {
    if (defined $searchDB{$dpic}{IPTC}) {
      my $iptc = $searchDB{$dpic}{IPTC};
      if (($iptc =~ m|Country\.:.*\n|) or ($iptc =~ m|Provinc\.:.*\n|) or ($iptc =~ m|City\s*:.*\n|) or ($iptc =~ m|SubLoca\.:.*\n|)) {
	    $count++;
      }
    }
  }
  return $count;
}  

##############################################################
# get_pics_with_keywords - returns a list of pictures with the
#                          given keywords (source: searchDB)
##############################################################
sub get_pics_with_keywords {

  my $search_keys = shift; # list reference
  my $exclude_keys = shift; # list reference for keywords which must not be contained
  my @pic_list;
  
  # build keyword/tag hash
  #stopWatchStart();
  foreach my $dpic (keys %searchDB) {
    # skip if no keywords in picture
    next unless (defined $searchDB{$dpic}{KEYS});

    if ($config{KeywordDate}) {
      next if (defined $searchDB{$dpic}{TIME} and ($searchDB{$dpic}{TIME} < $config{KeywordStart}));
      next if (defined $searchDB{$dpic}{TIME} and ($searchDB{$dpic}{TIME} > $config{KeywordEnd}));
    }
    
    if ($config{KeywordRating}) {
      next unless (defined $searchDB{$dpic}{URG}); # ignore pictures withour rating/urgency
      next if (defined $searchDB{$dpic}{URG} and ($searchDB{$dpic}{URG} < $config{KeywordRatingA}));
      next if (defined $searchDB{$dpic}{URG} and ($searchDB{$dpic}{URG} > $config{KeywordRatingB}));
    }

    # check if any items of the exclude_keys list are contained in this keyword string
    my $wrong = 0;
    foreach (@{$exclude_keys}) {
      $wrong++ if ($searchDB{$dpic}{KEYS} =~ m/$_/);
      last if ($wrong > 0);
    }
    next if ($wrong > 0);

    # check if all items of the search_keys list are contained in this keyword string
    $wrong = 0;
    foreach (@{$search_keys}) {
      $wrong++ unless ($searchDB{$dpic}{KEYS} =~ m/$_/);
      last if ($wrong > 0);
    }
    next if ($wrong > 0);
    
    # collect matching pics in a list
    push @pic_list, $dpic;
  }

  #stopWatchStop('collecting pics');
  #print "done\nFound ".scalar @pic_list." pictures\n";

  return @pic_list;
}

##############################################################
# editDatabase
##############################################################
sub editDatabase {

  my $buttext = "Remove picture(s) from database";
  my $text    = "This list shows all pictures of the search database.\nYou may select any number of pictures and remove them with the \"$buttext\" button.\nThe pictures won't be deleted, only the entry in the database is removed.\nIt's recommended to call the function \"clean database\" first, because it will remove all invalid entries for you.";

  my $rc;

  # open window
  my $ew = $top->Toplevel();
  $ew->title("Edit search database");
  $ew->iconimage($mapiviicon) if $mapiviicon;

  my $height = ($text =~ tr/\n//);
  $height += 2;
  $height = 10 if ($height > 10); # not to big, we have scrollbars
  my $rotext = $ew->Scrolled("ROText",
							 -scrollbars => 'osoe',
							 -wrap => 'word',
							 -tabs => '4',
							 -width => 110,
							 -height => $height,
							 -relief => "flat",
							 -bg => $config{ColorBG},
							 -bd => "0"
							)->pack(-expand => "0", -padx => 3, -pady => 3,-anchor => 'w');
  $rotext->insert('end', $text);

  my $size = getFileSize("$configdir/SearchDataBase", FORMAT);
  my $keys = keys %searchDB;
  my ($first, $last) = get_date_limits();
  my $info = "$keys pictures in the database between the years $first and $last (file size: $size)";
  my $listBoxY = $keys;
  $listBoxY = 25 if ($listBoxY > 25); # not higher than 30 entries

  my $listBox =
	  $ew->Scrolled('Listbox',
					-scrollbars => 'osoe',
					-selectmode => 'extended',
					-exportselection => 0,
					#-width => 80,
					-height => $listBoxY,
				   )->pack(-expand => 1, -fill =>'both', -padx => 3, -pady => 3);
  bindMouseWheel($listBox);

  $listBox->insert('end', (sort keys %searchDB));

  my $labF = $ew->Frame()->pack(-anchor => 'w', -padx => 3, -pady => 3);
  $labF->Label(-textvariable => \$info, -bg => $config{ColorBG})->pack(-side => "left");

  $ew->Button(-text => $buttext,
				-command => sub {
				  foreach (reverse $listBox->curselection()) {
					my $path = $listBox->get($_);
					delete $searchDB{$path};       # delete key from hash
					$listBox->delete($_);
				  }
				  $keys = keys %searchDB; # display the ne wnumber of database entries
				  $info = "$keys entries in the database";
				}
			 )->pack(-anchor => 'w', -padx => 3, -pady => 3);

  my $filter;
  my $ef = $ew->Frame()->pack(-fill => 'x', -padx => 3, -pady => 3);

  $ef->Label(-text   => "Show only keys matching:",
			 -anchor => 'w',
			 -bg => $config{ColorBG},
			)->pack(-side => "left", -padx => 3);
  my $entry = $ef->Entry(-textvariable => \$filter,
						 -width => 20,
						)->pack(-fill => 'x', -padx => 3, -pady => 3);
  $entry->bind('<Return>', sub {
				 return if (!defined $filter);
				 $listBox->delete(0, 'end');
				 $keys = keys %searchDB; # display the ne wnumber of database entries
				 if ($filter eq "") {
				   $listBox->insert('end', (sort keys %searchDB));
				   $info = "$keys entries in the database (all visible)";
				 }
				 else {
				   my $count = 0;
				   $filter = makePattern($filter); # create a windows like pattern
				   foreach (sort keys %searchDB) {
					 if ($_ =~ m!$filter!i) {
					   $listBox->insert('end', $_);
					   $count++;
					 }
				   }
				   $info = "$keys entries in the database ($count visible)";
				 }
			   } );

  my $ButF =
	$ew->Frame()->pack(-fill =>'x');

  my $OKB =
	$ButF->Button(-text => 'OK',
					-command => sub { $rc = 'OK'; }
				 )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $OKB->bind('<Return>', sub { $OKB->invoke; } );

  $OKB->focus;
  $ew->Popup(-popover => 'cursor');
  repositionWindow($ew);
  $ew->waitVariable(\$rc);
  $ew->withdraw;
  $ew->destroy;
}


##############################################################
# checkDatabase - check the comment and iptc fields of all
#                 database entries for problematic (non-ASCII) chars
#                 will e.g. complain about the copyright sign
##############################################################
sub checkDatabase {

  my ($com, $iptc, $keys, $text);
  my $i = 0;
  foreach my $dpic (sort keys %searchDB) {
	$i++;

	$com  = $searchDB{$dpic}{COM};
	$iptc = $searchDB{$dpic}{IPTC};
	$keys = $searchDB{$dpic}{KEYS};

	if ((defined $com) and ($com =~ m/[^\x00-\x7f]/)) {
	  $text .= "comment      of $dpic\n";
	}

	if ((defined $iptc) and ($iptc =~ m/[^\x00-\x7f]/)) {
	  $text .= "IPTC         of $dpic\n";
	}

	if ((defined $keys) and ($keys =~ m/[^\x00-\x7f]/)) {
	  $text .= "IPTC keyword of $dpic\n";
	}
  }

  $text = "Check finished.\nFound these problematic (non-ASCII) chars in $i pictures:\n\n$text";
  showText("Check database", $text, WAIT);
}

##############################################################
# searchDupName - search duplicate pics in the database by
#                 same file name
##############################################################
sub searchDupsName {
  my %pics;  # hash of all file names key: file name or size value: directory+pic
  my $dpics         = shift; # ref to hash of all file names key: file name value: list of dirs+pic containing this pic
  my $ignore_links  = shift;
  my $filter        = shift;
  my $ignore_filter = shift;

  undef %$dpics;
  #$userinfo = "searching duplicates by file name ..."; $userInfoL->update;
  # loop through all database entries
  foreach my $dpic (sort keys %searchDB) {
	next if (($filter ne '') and ($dpic !~ m!$filter!i));
	next if (($ignore_filter ne '') and ($dpic =~ m!$ignore_filter!i));
    next if ($ignore_links and -l $dpic);
	my $pic = basename($dpic);
	# new entry
	if (!defined $pics{$pic}) {
	  $pics{$pic} = $dpic;
	}
	# duplicate found
	else {
	  # if not defined in the dups hash, add first dir (was saved before)
	  if (!defined $$dpics{$pic}) {
		$$dpics{$pic} = [$pics{$pic}];
	  }
	  # and add the actual dir and pic
	  push @{$$dpics{$pic}}, $dpic;
	}
  }
}

##############################################################
# searchDupSize - search duplicate pics in the database by
#                 same file size
##############################################################
sub searchDupsSize {
  my %pics;  # hash of all file names key: file name or size value: directory+pic
  my $dpics         = shift; # ref to hash of all file names key: file size value: list of dirs+pic containing this pic
  my $ignore_links  = shift;
  my $filter        = shift;
  my $ignore_filter = shift;
  
  undef %$dpics;
  #$userinfo = "searching duplicates by file size ..."; $userInfoL->update;
  # loop through all database entries
  foreach my $dpic (sort keys %searchDB) {
	next if (($filter ne '') and ($dpic !~ m!$filter!i));
	next if (($ignore_filter ne '') and ($dpic =~ m!$ignore_filter!i));
	next if ($ignore_links and -l $dpic);
    next if (!defined $searchDB{$dpic}{SIZE});
	my $size = $searchDB{$dpic}{SIZE}; # size in Bytes
	# new entry
	if (!defined $pics{$size}) {
	  $pics{$size} = $dpic;
	}
	# duplicate found
	else {
	  # if not defined in the dups hash, add first dir (was saved before)
	  if (!defined $$dpics{$size}) {
		$$dpics{$size} = [$pics{$size}];
	  }
	  # and add the actual dir and pic
	  push @{$$dpics{$size}}, $dpic;
	}
  }
}

##############################################################
# searchDupDate - search duplicate pics in the database by
#                 same EXIF creation date
##############################################################
sub searchDupsDate {
  my %pics;  # hash of all file names key: file name or date     value: directory+pic
  my $dpics         = shift; # ref to hash of all file names key: file date     value: list of dirs+pic containing this pic
  my $ignore_links  = shift;
  my $filter        = shift;
  my $ignore_filter = shift;
  undef %$dpics;
  #$userinfo = "searching duplicates by file size ..."; $userInfoL->update;
  # loop through all database entries
  foreach my $dpic (sort keys %searchDB) {
	next if (($filter ne '') and ($dpic !~ m!$filter!i));
	next if (($ignore_filter ne '') and ($dpic =~ m!$ignore_filter!i));
	next if ($ignore_links and -l $dpic);
    #next if (-l $dpic);
	unless (defined $searchDB{$dpic}{TIME}) {
	  print "$dpic has no EXIF date/time!\n";
	  next;
	}
	my $date = $searchDB{$dpic}{TIME}; # EXIF creation date/time
	# new entry
	if (!defined $pics{$date}) {
	  $pics{$date} = $dpic;
	}
	# duplicate found
	else {
	  # if not defined in the dups hash, add first dir (was saved before)
	  if (!defined $$dpics{$date}) {
		$$dpics{$date} = [$pics{$date}];
	  }
	  # and add the actual dir and pic
	  push @{$$dpics{$date}}, $dpic;
	}
  }
}

##############################################################
# findDups - find duplicate pics in the database
##############################################################
sub findDups {

  if (Exists($dupw)) {
	$dupw->deiconify;
	$dupw->raise;
	$dupw->focus;
	return;
  }

  my %dup_thumbs; # hash to store all thumbnails displayed in the duplicate window 
  my $pic;
  my $dir;

  my %dpics; # hash of all file names key: file name or size value: list of dirs+pic containing this pic

  my $searchForDups = "Name";
  my $ignore_links = 0;
  my $filter = '';
  my $ignore_filter = '';

  # open window
  $dupw = $top->Toplevel();
  $dupw->title("Duplicate pictures");
  $dupw->iconimage($mapiviicon) if $mapiviicon;

  my $subF = $dupw->Frame()->pack(-fill => 'x', -expand => 0, -pady => 1);
  my $subF2 = $dupw->Frame()->pack(-fill => 'x', -expand => 0, -pady => 1);

  my $dbsize   = getFileSize("$configdir/SearchDataBase", FORMAT);
  my $progress = 0;
  my $progBar =
  $subF->ProgressBar(-takefocus => 0,
					 -borderwidth => 1,
					 -relief => 'sunken',
					 -length => 100,
					 -padx => 0,
					 -pady => 0,
					 -variable => \$progress,
					 -colors => [0 => $config{ColorProgress}],
					 -resolution => 1,
					 -blocks => 10,
					 -anchor => 'w',
					 -from => 0,
					 -to => 100,
					)->pack(-side => 'left', -fill => 'both', -expand => 0, -padx => 2, -pady => 0);

  my $stop = 0;
  my $stopB = $subF->Button(-text => "Stop",
							-command => sub { $stop = 1; }
						   )->pack(-side => 'left', -anchor => 'w', -expand => 0,-padx => 1,-pady => 1);
  my $stopImg = $top->Photo(-file => "$configdir/StopPic.gif") if (-f "$configdir/StopPic.gif");
  $stopB->configure(-image => $stopImg, -borderwidth => 0) if $stopImg;
  $stopB->configure(-state => "disabled");

  my $label = "";
  $subF->Label(-textvariable => \$label, -justify => "left",-bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w', -padx => 2);

  my $filter_entry = labeledEntry($subF2, 'left', 7, "Include", \$filter, 15);
  $balloon->attach($filter_entry, -msg => "Enter a part of the file or path name to filter for.\nExample: If you enter \"photos/2008\" only duplicates\nfrom the folder ...photos/2008... will be shown.");

  my $ignore_filter_entry = labeledEntry($subF2, 'left', 6, "Ignore", \$ignore_filter, 15);
  $balloon->attach($ignore_filter_entry, -msg => "Enter a part of the file or path name to ignore.\nExample: If you enter \"photos/2008\" no duplicates\nfrom the folder ...photos/2008... will be shown.");

  my $duplb = makeThumbListbox($dupw);

  $subF->Button(-text => "Search",
				-command => sub {
                  $stop = 0;
				  # clean up
				  $duplb->delete("all");
				  $label = 'cleaning up ...';
                  $duplb->update;
				  # clean up memory - delete all found thumbnail photo objects
				  delete_thumb_objects(\%dup_thumbs);
				  
				  $label = 'searching duplicates in database ...';
                  $duplb->update;
                  my $filterP = makePattern($filter); # create a windows like pattern
                  my $ignore_filterP = makePattern($ignore_filter); # create a windows like pattern

				  if ($searchForDups eq 'Name') {
					searchDupsName(\%dpics, $ignore_links, $filterP, $ignore_filterP);
				  } elsif ($searchForDups eq 'Size') {
					searchDupsSize(\%dpics, $ignore_links, $filterP, $ignore_filterP);
				  } elsif ($searchForDups eq 'Date') {
					searchDupsDate(\%dpics, $ignore_links, $filterP, $ignore_filterP);
				  } elsif ($searchForDups eq 'Cancel') {
					return;
				  } else {
					warn "wrong searchForDups: $searchForDups\n";
					return;
				  }

				  my $keys  = keys %dpics;
				  $label    = " $keys duplicates are found in the database (file size: $dbsize).";

				  my $last_time;
				  my $pcount = 0; # pic count = keys %dpics
				  my $dcount = 0; # dir count (if each pic has one duplicate this number is $pcount * 2)

                  my $style1 = $duplb->ItemStyle('text', -anchor=>'nw', -foreground=>'black', -background=>'gray90');
                  my $style2 = $duplb->ItemStyle('text', -anchor=>'nw', -foreground=>'black', -background=>'gray80');
				  
				  # save global styles to restore them later
				  my $comS_save  = $comS;
				  my $exifS_save = $exifS;
				  my $iptcS_save = $iptcS;
				  my $fileS_save = $fileS;
				  my $dirS_save  = $dirS;

				  $_ = $style2 foreach ($fileS, $exifS, $iptcS, $comS, $dirS);

				  $stopB->configure(-state => 'normal');

				  # insert duplicates in hlist
				  foreach my $item (sort keys %dpics) {
					last if $stop;
					$pcount++;
					foreach my $dpic (@{$dpics{$item}}) {
					  last if $stop;
					  #$dir =~ s!^([a-z]:)/!$1\\!i if $EvilOS; # replace E:/ with E:\ else Win will fire an error message that E: is not mounted
                      insertPic($duplb, $dpic, \%dup_thumbs);
					  
					  $dcount++;
					  # show progress and found pics every 0.3 seconds - idea from Slaven
					  if (!defined $last_time || Tk::timeofday()-$last_time > 0.3) {
						$progress = int($pcount/$keys*100);
						$label    = " displaying duplicates $progress% ($pcount/$keys)";
						$duplb->update();
						$last_time = Tk::timeofday();
					  }
					}
                    # toggle style of name col
                    if ($fileS == $style2) {
					  $_ = $style1 foreach ($fileS, $exifS, $iptcS, $comS, $dirS);
					} else {
					  $_ = $style2 foreach ($fileS, $exifS, $iptcS, $comS, $dirS);
					};
				  }
				  # reset gloabal style
				  $fileS = $fileS_save;
				  $exifS = $exifS_save;
				  $iptcS = $iptcS_save;
				  $comS  = $comS_save;
				  $dirS  = $dirS_save;
				  
				  $progress = 100 if ($pcount >= $keys); # sometimes there is a little gap
				  $stopB->configure(-state => "disabled");
				  $label = " found $pcount duplicates in $dcount files.";
				  $duplb->update();

				})->pack(-side => "left", -anchor => 'w', -fill => "both", -padx => 1,-pady => 1);

  $subF->Label(-text => "duplicates by same ", -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w', -fill => "both");

  $subF->Optionmenu(-variable => \$searchForDups, -textvariable => \$searchForDups, -options => [ 
  ['file name' => 'Name'],
  ['creation date' => 'Date'],
  ['file size' => 'Size'], ])->pack(-side => "left", -anchor => 'w', -fill => "both");

  $subF->Checkbutton(-text => 'ignore links', -variable => \$ignore_links)->pack(-side => "left", -anchor => 'w', -fill => "both", -padx => 1,-pady => 1);
  my $Xbut = $subF->Button(-text => "Close",
						   -command => sub {
							 $dupw->withdraw();
							 $dupw->destroy();
							 # clean up memory - delete all found thumbnail photo objects
				             delete_thumb_objects(\%dup_thumbs);
						   }
						  )->pack(-side => "left", -anchor => 'w', -fill => "both", -expand => 1, -padx => 1,-pady => 1);

  # the context menu
  my $menu = $dupw->Menu(-title => "Duplicate pictures menu");

  ############# open pic
  $menu->command(-label => "open picture in new window", -accelerator => "Middle Mouse Button",
				 -command => sub {
				   my @pics = $duplb->info('children');
				   return unless (@pics);
				   my @sellist = $duplb->info('selection');
				   if (@sellist != 1) {
					 $dupw->messageBox(-icon => 'warning', -message => "Please select exactly one picture!",
									   -title => "Wrong selection", -type => 'OK');
					 return;
				   }
				   my $dpic = $sellist[0];
				   my $dir  = dirname($dpic);
				   if (!-d $dir) {
					 $dupw->messageBox(-icon => 'warning', -message => "Sorry, but the folder\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.",
									   -title => "folder not found", -type => 'OK');
					 return;
				   }
				   $dupw->Busy;
				   showPicInOwnWin($dpic);
				   $dupw->Unbusy;
				 });

  ############# open dir
  $menu->command(-label => "open folder and show picture", -command => sub {
				   my @pics = $duplb->info('children');
				   return unless (@pics);
				   my @sellist = $duplb->info('selection');
				   if (@sellist != 1) {
					 $dupw->messageBox(-icon => 'warning', -message => "Please select exactly one picture!",
									   -title => "Wrong selection", -type => 'OK');
					 return;
				   }
				   my $dpic = $sellist[0];
				   my $dir  = dirname($dpic);
				   if (!-d $dir) {
					 $dupw->messageBox(-icon => 'warning', -message => "Sorry, but the folder\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.",
									   -title => "folder not found", -type => 'OK');
					 return;
				   }
				   $top->deiconify;
				   $top->raise;
				   $top->focus;
				   openDirPost($dir) if ($dir ne $actdir);
				   showPic($dpic);
				 });

  ############# ignore dir
  $menu->command(-label => "ignore folder ...", -command => sub {
				   my @pics = $duplb->info('children');
				   return unless (@pics);
				   my @sellist = $duplb->info('selection');
				   if (@sellist != 1) {
					 $dupw->messageBox(-icon => 'warning', -message => "Please select exactly one picture!",
									   -title => "Wrong selection", -type => 'OK');
					 return;
				   }
				   my $ignoredir = dirname($sellist[0]);
				   my $rc = myEntryDialog("Ignore folder", "Ignore all folders matching this pattern:", \$ignoredir);
				   return if ($rc ne 'OK' or $ignoredir eq "");
				   my $count = 0;
				   foreach my $i (@pics) {
					 next unless ($duplb->info("exists", $i));
					 my $dir = dirname($i);
					 if ($dir =~ m!$ignoredir!) {
					   $count++;
					   $label = "removing $dir ($count) ...";
					   #print "$dir remove $i $ignoredir\n";
					   $duplb->delete("entry", $i);
					 }
				   }
				   $label = "removed $count folders.";
				 });

  ############# select all
  $menu->command(-label => "selected all", -command => sub {
				   my @pics = $duplb->info('children');
				   return unless (@pics);
				   $duplb->selectionSet($pics[0], $pics[-1]); # 'end' does not work with HList
				 } );

  $menu->separator;

  ############# delete to trash
  $menu->command(-label => "delete picture to trash", -command => sub {
				   deletePics($duplb, TRASH);
                   $label = "pictures deleted";
				 } );

  ############# copy
  $menu->command(-label => "copy selected pictures ...", -command => sub {
				   copyPicsDialog(COPY, $duplb);
				   $label = "ready! (pictures copied)"; $dupw->update;
				 } );

  ############# move
  $menu->command(-label => "move selected pictures ...", -command => sub {
				   movePicsDialog($duplb);
				   $label = "ready! (pictures moved)"; $dupw->update;
				 } );

  # mouse and button bindings
  addCommonKeyBindings($duplb, $duplb);

  $duplb->bind('<ButtonPress-3>',   sub {
				 $menu->Popup(-popover => "cursor", -popanchor => "nw");
			   } );

  $duplb->bind('<ButtonRelease-2>', sub {
          return unless ($duplb->info('children'));
          my $dpic = getNearestItem($duplb);
		  my $dir = dirname($dpic);
		  if (!-d $dir) {
 		   $dupw->messageBox(-icon => 'warning', -message => "Sorry, but the folder\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.",
		    -title => "folder not found", -type => 'OK');
		    return;
		  }
          $dupw->Busy;
		  showPicInOwnWin($dpic);
          $dupw->Unbusy;
		  } );

  $dupw->bind('<Control-q>',  sub { $Xbut->invoke; });
  $dupw->bind('<Key-Escape>', sub { $Xbut->invoke; });

  my $w = int(0.8 * $dupw->screenwidth);
  my $h = int(0.8 * $dupw->screenheight);
  $dupw->geometry("${w}x${h}+10+10");
  $duplb->update();

  $dupw->waitWindow;
}

##############################################################
# editHashDialog - let the user add or remove keys from a hash
##############################################################
sub editHashDialog {

  my $title   = shift;
  my $text    = shift;
  my $hr      = shift; # hash reference
  my $okB     = shift; # Ok button text
  my $cancelB = shift; # Cancel button text ("" means no Cancel button)
  my $addB    = shift; # bool - show a path entry and a Add Path button

  my $entry   = "";
  my $rc;

  # open window
  my $ew = $top->Toplevel();
  $ew->title($title);
  $ew->iconimage($mapiviicon) if $mapiviicon;

  my $height = ($text =~ tr/\n//);
  $height += 2;
  $height = 10 if ($height > 10); # not to big, we have scrollbars
  my $rotext = $ew->Scrolled("ROText",
							 -scrollbars => 'osoe',
							 -wrap => 'word',
							 -tabs => '4',
							 -width => 80,
							 -height => $height,
							 -relief => "flat",
							 -bg => $config{ColorBG},
							 -bd => "0"
							)->pack(-expand => "0", -padx => 3, -pady => 3);
  $rotext->insert('end', $text);

  my $keys = keys %{$hr};
  my $listBoxY = $keys;
  $listBoxY = 30 if ($listBoxY > 30); # not higher than 30 entries

  my $listBox =
	  $ew->Scrolled('Listbox',
					-scrollbars => 'osoe',
					-selectmode => 'extended',
					-exportselection => 0,
					-width => 80,
					-height => $listBoxY,
				   )->pack(-expand => 1, -fill =>'both', -padx => 3, -pady => 3);

  $listBox->insert('end', (sort keys %{$hr}));

  my $labF = $ew->Frame()->pack(-anchor => 'w', -padx => 3, -pady => 3);
  $labF->Label(-textvariable => \$keys,     -bg => $config{ColorBG})->pack(-side => "left");
  $labF->Label(-text         => " entries", -bg => $config{ColorBG})->pack(-side => "left");

  $ew->Button(-text => "Remove marked",
				-command => sub {
				  foreach (reverse $listBox->curselection()) {
					my $path = $listBox->get($_);
					delete $$hr{$path};       # delete key from hash
					$listBox->delete($_);
				  }
				  # refresh listbox
				  #$listBox->delete(0, 'end');
				  #$listBox->insert('end', (sort keys %{$hr}));
				  $keys = keys %{$hr}; # display the ne wnumber of database entries
				}
				 )->pack(-anchor => 'w', -padx => 3, -pady => 3);

  if ($addB) {
	my $entryF = $ew->Frame()->pack(-fill =>'x');
	$entryF->Entry(-textvariable => \$entry,
				   -width => 40)->pack(-side => "left", -fill => 'x', -padx => 3, -pady => 3);

	$entryF->Button(-text => "Add path",
					-command => sub {
					  $$hr{"$entry"} = 1;
					  $listBox->delete(0, 'end');
					  $listBox->insert('end', (sort keys %{$hr}));
					})->pack(-side => 'left', -padx => 3, -pady => 3);
  }

  my $ButF =
	$ew->Frame()->pack(-fill =>'x');

  my $OKB =
	$ButF->Button(-text => $okB,
					-command => sub {
					  $rc = 'OK',
					})->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $OKB->bind('<Return>', sub { $OKB->invoke; } );

  if ($cancelB ne "") {
	$ButF->Button(-text => $cancelB,
				  -command => sub {
					$rc = 'Cancel';
				  })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  }

  $OKB->focus;
  $ew->Popup(-popover => 'cursor');
  repositionWindow($ew);
  $ew->waitVariable(\$rc);
  $ew->withdraw;
  $ew->destroy;
  return $rc;
}

##############################################################
# checkDateFormat - check if date string matches dd.mm.yyyy
#                   and day is between 1..31 and month 1..12
##############################################################
sub checkDateFormat($) {
  my $date = shift;
  my $rc   = 0;
  if ($date =~ /^(\d\d)\.(\d\d)\.(\d\d\d\d)$/) { # check format
	if ($1 >= 1 and $1 <= 31) {                  # check day range
	  if ($2 >= 1 and $2 <= 12) {                # check month range
		if ($3 >= 1901 and $3 <= 2038) {         # check year range, 1901 and 2038 are save boundaries for 32 bit systems
	      # check for valid dates (e.g. 31.02.2000 is invalid)
          eval { timelocal(0, 0, 0, $1, $2-1, $3-1900); };
	      $rc = 1 unless ($@);
		}
	  }
	}
  }
  return $rc;
}

##############################################################
# checkNumberFormat - check if the argument is a number
##############################################################
sub checkNumberFormat($) {
  my $nr = shift;
  my $rc = 0;
  if ($nr =~ /^\d+$/) { # check format
	  if ($nr >= 0 and $nr <= 99999) {               # check range
		  $rc = 1;
	  }
  }
  return $rc;
}

##############################################################
# buildUnixTime - dd.mm.yyyy to UNIX date/time
##############################################################
sub buildUnixTime {
  my $date_str = shift;
  my $time;
  if ($date_str =~ m/(\d\d)\.(\d\d)\.(\d\d\d\d)/) {
	my $mon  = $2;
	my $year = $3;
	$mon--;
	$year -= 1900;
	# check for valid dates (e.g. 31.02.2000 is invalid)
    eval { timelocal(0, 0, 0, $1, $mon, $year); };
	if ($@) {
		warn "buildUnixTime: $date_str is invalid, date does not exists.\n";
	    $time = 0;
	}
	else { # valid
	  $time = timelocal(0, 0, 0, $1, $mon, $year);
	}
  }
  else {
	warn "buildUnixTime: wrong string format $date_str, should be dd.mm.yyyy\n";
	$time = 0;
  }
  return $time;
}

##############################################################
# buildDateTime - UNIX date/time to dd.mm.yyyy hh:mm:ss
##############################################################
sub buildDateTime {
  my $ctime = shift;
  my ($s,$m,$h,$d,$mo,$y) = localtime $ctime;
  $y += 1900; $mo++;			# do some adjustments
  # build up the date time string, similar to the EXIF format
  return sprintf "%02d.%02d.%04d %02d:%02d:%02d", $d, $mo, $y, $h, $m, $s;
}

##############################################################
# buildEXIFDateTime - UNIX date/time to yyyy:mm:dd  hh:mm:ss
##############################################################
sub buildEXIFDateTime {
  my $ctime = shift;
  my ($s,$m,$h,$d,$mo,$y) = localtime $ctime;
  $y += 1900; $mo++;			# do some adjustments
  # build up the date time string, similar to the EXIF format
  return sprintf "%04d:%02d:%02d %02d:%02d:%02d", $y, $mo, $d, $h, $m, $s;
}

##############################################################
# searchFileName
##############################################################
sub searchFileName {
	my $lb = shift;
	my @sellist = $lb->info('selection');
	return unless checkSelection($lb, 1, 1, \@sellist);

	my $fileName = basename($sellist[0]);

	#resetAllSearchOptions(); # todo: write this sub
	$config{SearchPattern} = $fileName;
	$config{SearchName} = 1;
	searchMetaInfo();
}

##############################################################
# searchMetaInfo
##############################################################
sub searchMetaInfo {

  use bytes;
  use locale;

  if (Exists($sw)) {
	$sw->deiconify;
	$sw->raise;
	$sw->focus;
	$sw->{entry}->focus;
	$sw->{entry}->selectionRange(0,'end'); # select all
	return;
  }

  my $start_dir  = getRightDir();
  my $pattern    = $config{SearchPattern};
  my $exclude    = $config{SearchExPattern};
  my $pat        = "";
  my $exl        = "";
  my $OKB;
  my $keys       = keys %searchDB;
  my $size       = getFileSize("$configdir/SearchDataBase", FORMAT);
  my $stop       = 0;
  my $stopB;

  if (!$config{SaveDatabase}) {
	my $rc =
	  $top->messageBox(-message => "The save database to file option is off. The search will only cover the folders visited during this session.\nShould I switch the save option on?\nYou can change this option also in the options dialog.",
					   -icon => 'question', -title => "Switch save option", -type => 'OKCancel');
	$config{SaveDatabase} = 1 if ($rc =~ m/Ok/i);

  }

  # open window
  $sw = $top->Toplevel();
  $sw->withdraw;
  $sw->title("Search picture database");
  $sw->iconimage($mapiviicon) if $mapiviicon;

  #$sw->Label(-text => "Search in the picture database for a pattern:", -justify => "left",-bg => $config{ColorBG})->pack(-anchor => 'w');

  my $topF  = $sw->Frame()->pack(-fill => 'x', -expand => 0, -pady => 1);
  my $leftF = $topF->Frame()->pack(-fill => 'x', -side => 'left', -padx => 3, -pady => 3);
  my $pf1 =	$leftF->Frame()->pack(-fill => 'x', -padx => 3, -pady => 3);
  $pf1->Label(-text => "Search pattern", -width => 15, -anchor => 'w', -bg => $config{ColorBG})->pack(-side => "left", -padx => 3);
  $sw->{entry} = $pf1->Entry(-textvariable => \$pattern, -width => 25)->pack(-side => "left", -fill => 'x', -expand => "1", -padx => 1);

  my $pf2 =	$leftF->Frame()->pack(-fill => 'x', -padx => 3, -pady => 3);
  $pf2->Label(-text => "Exclude pattern", -width => 15, -anchor => 'w', -bg => $config{ColorBG})->pack(-side => "left", -padx => 3);
  my $exentry = $pf2->Entry(-textvariable => \$exclude, -width => 25)->pack(-side => "left", -fill => 'x', -expand => "1", -padx => 1);
  #$pf2->Button(-text => "clear", -command => sub {$exclude = "";})->pack(-side => "left", -padx => 3, -pady => 0);

  $balloon->attach($sw->{entry}, -msg => 'Use * for zero or more chars, ? for exactly one char.
Use \* to search for the star sign (*) and \? to search for a questionmark (?) itself.
To search for a backslash (\) use two backslashes (\\\).

Examples:
"I * home"        will match e.g. "I go home", "I run home" but also "I do not go home"
"Tr?ck"           will match "Trick" or "Track"
"who\?"           will match "who?"
"\*\* Party \*\*" will match "** Party **"');
  $balloon->attach($exentry, -msg => 'Enter the patterns to exclude here.
Separate them with one space.
All patterns will be joined by or.
Hint:
Use an empty search pattern and the exlude pattern "?*"
to search for pictures without comments, EXIF or IPTC infos.');

  $sw->{entry}->bind('<Return>', sub { $OKB->invoke; } );
  $exentry->bind('<Return>', sub { $OKB->invoke; } );

  $sw->{entry}->focus;
  $sw->{entry}->selectionRange(0,'end'); # select all

  # what to search: keywords, IPTC, comments, ...
  my $f1 = $topF->Frame(-relief => 'groove', -bd => $config{Borderwidth})->pack(-side => "left", -anchor => "n", -fill =>'both',-padx => 3,-pady => 5);

  # different search options
  my $f0 = $leftF->Frame()->pack(-anchor => 'w', -padx => 0,-pady => 0);

  # local search + more options
  my $locSF = $leftF->Frame(-relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 5);
  $locSF->Checkbutton(-variable => \$config{SearchOnlyInDir}, -text => "local search in")->pack(-side => 'left', -anchor => 'w', -padx => 4, -padx => 2);
  $locSF->Label(-textvariable => \$start_dir)->pack(-side => 'left', -anchor => 'w', -padx => 4, -padx => 2);
  setFileButton($locSF,'left','Set','Select folder to search in',\$start_dir, 1);
  $balloon->attach($locSF, -msg =>
'When this option is enabled, the search will only take place
in folders matching the displayed string.
When the option is disabled a global search will take place.');

  my ($addMF, $addF);
  $locSF->Checkbutton(-variable => \$config{SearchMore},
                      -text => 'more options',
                      -command => sub {
                        if ($config{SearchMore}) {
                          $addF->pack(-in => $addMF, -side => 'left', -expand => 0);# if (!ismapped($addF));
                        }
                        else {
                          $addF->packForget();# if (ismapped($addF));
                        }
                      })->pack(-side => 'right', -padx => 5);


  my $ButF = $f0->Frame(-relief => 'groove', -bd => $config{Borderwidth})->pack(-side => "left", -anchor => "n", -expand => 1, -fill =>'both',-padx => 3,-pady => 0);
  $balloon->attach($f1, -msg => "Search in JPEG comments, EXIF info,\nIPTC info, IPTC keywords, file name and/or in folder name");
  my $f2 = $f0->Frame(-relief => 'groove', -bd => $config{Borderwidth})->pack(-side => "left", -anchor => "n", -fill =>'both',-padx => 3,-pady => 0);
  my $f3 = $f0->Frame(-relief => 'groove', -bd => $config{Borderwidth})->pack(-side => "left", -anchor => "n", -fill =>'both',-padx => 3,-pady => 0);
  my $f4 = $f0->Frame(-relief => 'groove', -bd => $config{Borderwidth})->pack(-side => "left", -anchor => "n", -fill =>'both',-padx => 3,-pady => 0);

  $f1->Checkbutton(-variable => \$config{SearchKeys}, -text => "Keywords")->pack(-anchor => 'w');
  $f1->Checkbutton(-variable => \$config{SearchIptc}, -text => "IPTC info")->pack(-anchor => 'w');
  $f1->Checkbutton(-variable => \$config{SearchCom},  -text => "comments")->pack(-anchor => 'w');
  $f1->Checkbutton(-variable => \$config{SearchExif}, -text => "EXIF info")->pack(-anchor => 'w');
  $f1->Checkbutton(-variable => \$config{SearchName}, -text => "file name")->pack(-anchor => 'w');
  $f1->Checkbutton(-variable => \$config{SearchDir},  -text => "folder name")->pack(-anchor => 'w');
  my $sep = $f1->Checkbutton(-variable => \$config{SearchJoin}, -text => "join fields")->pack(-anchor => "nw");
  $balloon->attach($sep, -msg =>
"If this option is selected all selected fields (keywords, IPTC,
comments, ...) of a picture will be joined before the search
starts, so it's e.g. possible to find a picture with keyword
\"Tom\" and the comment \"at the beach\".
If it is not selected, a all-search for \"Tom\" and \"Tim\"
will only match, if all patterns are in one field
(e.g. Tom and Tim are both in the keywords).");

  my $sc1 = $f2->Checkbutton(-variable => \$config{SearchCase}, -text => "case sensitive")->pack(-anchor => "nw");
  $balloon->attach($sc1, -msg => "Toggle between case sensitive/insensitive searching");

  my $sw1 = $f2->Checkbutton(-variable => \$config{SearchWord}, -text => "complete word")->pack(-anchor => "nw");
  $balloon->attach($sw1, -msg => "search only for complete words, not for parts");

  my $stf = $f2->Frame()->pack(-anchor => 'w');
  $stf->Label(-text => "match", -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w');
  my $st1 = $stf->Optionmenu(-variable => \$config{SearchType}, -textvariable => \$config{SearchType}, -options => [qw(exactly all any)] )->pack(-side => "left", -anchor => 'w');
  $balloon->attach($st1, -msg => 'Match search pattern exactly, match all words or
try to match any of the given words.
e.g. "Tim Tom" with search type
match exactly will find all pictures containing exactly this string    (string-search)
match all     will find this but also "Tom Tim" or "Tim and Tom"       (and-search)
match any     will find all pictures containing "Tim" or "Tom" or both (or-search)');

  my $urgF = $f3->Frame()->pack(-anchor=>'w', -padx => 0, -pady => 0);
  $urgF->Checkbutton(-variable => \$config{SearchUrgencyOn}, -text => 'urgency')->pack(-side => 'left', -anchor => 'w');
  $urgF->Optionmenu(-variable => \$config{SearchUrgencyRel}, -textvariable => \$config{SearchUrgencyRel}, -options => [ qw(= <= >=) ] )->pack(-side => 'left', -anchor => 'w');
  # 0 must be first, because it's the default
  my $dummy;
  $urgF->Optionmenu(-variable => \$config{SearchUrgency}, -options => [ ["0 None" => 0], ["1 High" => 1], 2,3,4,["5 Normal" => 5],6,7, ["8 Low" => 8], ], -textvariable => \$dummy)->pack(-side => 'left', -anchor => 'w');
  # todo search for empty urgency tags: , [Empty => ""]
  $balloon->attach($urgF, -msg => "Search only for pictures with this IPTC urgency.\nYou can use the urgency flag to set the priority\nof the picture (1 = high to 8 = low).");
  #$f3->Checkbutton(-variable => \$config{SearchUrgencyIg}, -text => "ignore pictures without urgency")->pack(-anchor => 'nw');

  my $popF = $f3->Frame()->pack(-anchor=>'w', -padx => 0, -pady => 0);
  $popF->Checkbutton(-variable => \$config{SearchPopOn}, -text => 'viewed ')->pack(-side => 'left', -anchor => 'w');
  $popF->Optionmenu(-variable => \$config{SearchPopRel}, -textvariable => \$config{SearchPopRel}, -options => [ qw(= <= >=) ] )->pack(-side => 'left', -anchor => 'w');
  my $popE = $popF->Entry(-textvariable => \$config{SearchPop}, -width => 10, -validate => 'focus', -validatecommand => sub { checkNumberFormat($_[0]); }, -invalidcommand  => sub {$config{SearchPop} = 5; $sw->messageBox(-icon => 'warning', -message => 'Please enter a natural number (0,1,2,3,...) in the viewed field', -title => 'Wrong format', -type => 'OK');})->pack(-side => 'left', -fill => 'x', -expand => 1, -padx => 1);

  $balloon->attach($popF, -msg => "Search only for pictures with have been viewed\nthis numer of times.");

  my $justCount = 0;
  my $countOp = $f3->Checkbutton(-variable => \$justCount, -text => 'just count pictures')->pack(-anchor => 'nw');
  $balloon->attach($countOp, -msg => "Just count the matching pictures, do not display them.\nWith this option the search is much faster.");

  $f4->Checkbutton(-variable => \$config{SearchDate}, -text => 'search by EXIF date', -width => 19, -anchor => 'w')->pack(-anchor => 'w');
  my $datetext = 'Please use date format: dd.mm.yyyy
and check if you entered a valid date.
dd   (day)   is between 01 and 31
mm   (month) is between 01 and 12
yyyy (year)  is between 1901 and 2038
Example      25.02.2008';

  my $fromF = $f4->Frame()->pack(-anchor => 'w');
  $fromF->Button(-text => 'from', -anchor => 'w', -width => 4, -command => sub { setFromTo(); } )->pack(-side => 'left', -anchor => 'w', -padx => 3);
  my $fromdate = $fromF->Entry(
    -textvariable => \$config{SearchDateStart},
    -width => 11,
  	-validate => 'focus',
    -validatecommand => sub { checkDateFormat($_[0]); },
    -invalidcommand  => sub {
							$config{SearchDateStart} = "01.01.2004";
							$sw->messageBox(-icon => 'warning', -message => $datetext, -title => 'Wrong date format', -type => 'OK');
}
)->pack(-side => 'left', -padx => 3);
  my $toF = $f4->Frame()->pack(-anchor => 'w');
  $toF->Button(-text => 'to', -anchor => 'w', -width => 4, -command => sub { setFromTo(); } )->pack(-side => 'left', -anchor => 'w', -padx => 3);
  my $todate = $toF->Entry(
    -textvariable => \$config{SearchDateEnd},
    -width => 11,
	-validate => 'focus',
    -validatecommand => sub { checkDateFormat($_[0]); },
    -invalidcommand  => sub {
							$config{SearchDateEnd} = "01.01.2009";
							$sw->messageBox(-icon => 'warning', -message => $datetext, -title => 'Wrong date format', -type => 'OK');
}
)->pack(-side => 'left', -padx => 3);

  $balloon->attach($fromdate, -msg => "Search only for pictures with a creation date\nwith or after this date.\nFormat: dd.mm.yyyy (example: 21.12.2001)");
  $balloon->attach($todate,  -msg => "Search only for pictures with a creation date\nbefore or with this date.\nFormat: dd.mm.yyyy (example: 31.01.2008)");

  $addMF = $sw->Frame()->pack(-fill => 'x', -expand => 0, -pady => 0, -padx => 3);
  # this empty frame is needed, else the frame won't shrink after removing the other content
  my $empty_frame = $addMF->Frame()->pack();
  $addF = $addMF->Frame();
  
  # pixel size
  my $pixF = $addF->Frame()->pack(-anchor=>'w', -padx => 0, -pady => 0);
  $pixF->Checkbutton(-variable => \$config{SearchPixelOn}, -text => 'pixel size')->pack(-side => 'left', -anchor => 'w');
  $pixF->Optionmenu(-variable => \$config{SearchPixelRel}, -textvariable => \$config{SearchPixelRel}, -options => [ qw(= <= >=) ] )->pack(-side => 'left', -anchor => 'w');
  $pixF->Entry(-width => 8,-textvariable => \$config{SearchPixel})->pack(-side => 'top', -anchor => 'w', -padx => 8);
  
  if ($config{SearchMore}) {
     $addF->pack(-in => $addMF, -side => 'left', -expand => 0);# if (!ismapped($addF));
  }
  else {
    $addF->packForget();# if (ismapped($addF));
  }

  my $label = "$keys pictures are stored in the database (size: $size).";
  my $subF = $sw->Frame()->pack(-fill => 'x', -expand => 0, -pady => 1);
  my $progress = 0;
  my $progBar =
  my $progB = 
  $subF->ProgressBar(-takefocus => 0,
					 -borderwidth => 1,
					  -relief => 'sunken',
					  -length => 100,
					  -padx => 0,
					  -pady => 0,
					  -variable => \$progress,
					  -colors => [0 => $config{ColorProgress}],
 					  -resolution => 1,
					  -blocks => 10,
					  -anchor => 'w',
					  -from => 0,
					  -to => 100,
					 )->pack(-side => 'left', -fill => 'both', -expand => 0, -padx => 8, -pady => 0);
  $balloon->attach($progB, -msg => 'Displays the search progress');

  $subF->Label(-textvariable => \$label, -justify => 'left',-bg => $config{ColorBG})->pack(-side => 'left', -anchor => 'w', -padx => 8);

  my $findLB = makeThumbListbox($sw);

  $balloon->attach($findLB, -msg => "left click  : select\nmiddle click: open picture in new window\nright click : open context menu");

  addCommonKeyBindings($findLB, $findLB);
  
  $findLB->bind('<Key-d>', sub {
    my @sellist = getSelection($findLB);
    return unless checkSelection($sw, 1, 0, \@sellist);
    show_multiple_pics(\@sellist, 0);
   } );

  $findLB->bind('<Key-Delete>',        sub { deletePics($findLB, TRASH); } );
  $findLB->bind('<Shift-Delete>',      sub { deletePics($findLB, REMOVE); } );

  # the context menu
  my $menu = $sw->Menu(-title => 'Search menu');

  ############# select all
  $menu->command(-label       => 'selected all',
				 -command     => sub {selectAll($findLB);},
				 -accelerator => '<Ctrl-a>' );

  $menu->separator;

  ############# file operations
  addFileActionsMenu($menu, $findLB);

  $menu->separator;

  ############# remove pictures from searchDB
  $menu->command(-label => "remove pictures from search database", -command => sub {
     my @sellist = getSelection($findLB);
     return unless checkSelection($top, 1, 0, \@sellist);
     my $rc = $sw->messageBox(-icon => 'question',
                              -message => "Please press OK to remove the ".scalar @sellist." selected picture(s) from the search data base.\nThe picture file(s) won't be deleted. They may be added to the search database again anytime.",
-title => "Remove ".scalar @sellist." picture(s) from search database?", -type => 'OKCancel');
     return if ($rc !~ m/Ok/i);
     foreach (@sellist) {
	delete $searchDB{$_};
     }
    });

  ############# open pic
  $menu->command(-label => 'show pictures in new window', -accelerator => '<d>', -command => sub {
     my @sellist = getSelection($findLB);
     return unless checkSelection($sw, 1, 0, \@sellist);
     show_multiple_pics(\@sellist, 0);
    });

  ############# open dir
  $menu->command(-label => "open picture in main window", -accelerator => '<m>', -command => sub {
				   my @pics = $findLB->info('children');
				   return unless (@pics);
				   my @sellist = $findLB->info('selection');
                                   return unless checkSelection($sw, 1, 1, \@sellist);
				   my $dpic = $sellist[0];
				   my $dir  = dirname($dpic);
				   my $pic  =  basename($dpic);
				   if (!-d $dir) {
					 $sw->messageBox(-icon => 'warning', -message => "Sorry, but the folder\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.",
									   -title => 'folder not found', -type => 'OK');
					 return;
				   }
				   $top->deiconify;
				   $top->raise;
				   $top->focus;
				   openDirPost($dir) if ($dir ne $actdir);
				   showPic($dpic);
				 });

# key-desc,m,show picture in main window (from search window)
  $findLB->bind('<Key-m>',      sub { 
				   my @sellist = $findLB->info('selection');
                   return unless checkSelection($sw, 1, 1, \@sellist);
				   my $dpic = $sellist[0];
				   my $dir  = dirname($dpic);
				   my $pic  =  basename($dpic);
				   if (!-d $dir) {
					 $sw->messageBox(-icon => 'warning', -message => "Sorry, but the folder\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.", -title => 'folder not found', -type => 'OK');
					 return;
				   }
				   $top->deiconify;
				   $top->raise;
				   $top->focus;
				   openDirPost($dir) if ($dir ne $actdir);
				   showPic($dpic);
				 });

  ############# open in external viewer
  $menu->command(-label => 'open pictures in external viewer', -command => sub {
				   openPicInViewer($findLB); }, -accelerator => '<v>');

  $menu->separator;

  ############# display IPTC
  $menu->command(-label => 'show IPTC', -command => sub {
				   displayIPTCData($findLB); }, -accelerator => '<i>');

  ############# edit IPTC
  $menu->command(-label => 'edit IPTC ...', -command => sub {
				   editIPTC($findLB); }, -accelerator => '<Ctrl-i>');

  addRatingMenu($menu, $findLB);

  $menu->command(-label => 'add/remove keywords ...', -command => sub { editIPTCKeywords($findLB); }, -accelerator => '<Ctrl-k>');
  $menu->command(-label => 'add/remove categories ...', -command => sub { editIPTCCategories($findLB); } , -accelerator => '<Ctrl-t>');


  $menu->separator;

  ############# add comment
  $menu->command(-label => 'add comment ...', -command => sub {
				   addComment($findLB); }, -accelerator => '<a>');

  ############# edit comment
  $menu->command(-label => 'edit comment ...', -command => sub {
				   editComment($findLB); }, -accelerator => '<e>');

  ############# search/replace comment
  $menu->command(-label => 'search/replace comment ...', -command => sub {
				   replaceComment($findLB); }, );

  $menu->separator;

  ############# sort
  my $sort_menu = $menu->cascade(-label => 'sort by ...');
  $menu->separator;

  $menu->command(-label => 'add to light table', -command => sub {light_table_add_from_lb($findLB);}, -accelerator => '<Ctrl-l>');

  $sort_menu->command(-label => 'file name', -command => sub {
				   my @pics = $findLB->info('children');
				   $findLB->delete('all');
				   delete_thumb_objects(\%searchthumbs);
				   sortPics('name', 0, \@pics);
				   foreach (@pics) {
					 insertPic($findLB, $_, \%searchthumbs);
				   }
				 }, );
  $sort_menu->command(-label => 'urgency', -command => sub {
				   my @pics = $findLB->info('children');
				   $findLB->delete('all');
				   delete_thumb_objects(\%searchthumbs);
				   sortPics('urgency', 0, \@pics);
				   foreach (@pics) {
					 insertPic($findLB, $_, \%searchthumbs);
				   }
				 }, );
  $sort_menu->command(-label => 'file date', -command => sub {
				   my @pics = $findLB->info('children');
				   $findLB->delete('all');
				   delete_thumb_objects(\%searchthumbs);
				   sortPics('date', 0, \@pics);
				   foreach (@pics) {
					 insertPic($findLB, $_, \%searchthumbs);
				   }
				 }, );
  $sort_menu->command(-label => 'EXIF date', -command => sub {
				   my @pics = $findLB->info('children');
				   $findLB->delete('all');
				   delete_thumb_objects(\%searchthumbs);
				   sortPics('exifdate', 0, \@pics);
				   foreach (@pics) {
					 insertPic($findLB, $_, \%searchthumbs);
				   }
				 }, );



  # mouse and button bindings
  $findLB->bind('<ButtonPress-3>',   sub {
				 $menu->Popup(-popover => 'cursor', -popanchor => 'nw');
			   } );

  $findLB->bind('<ButtonRelease-2>', sub {
                  return unless ($findLB->info('children'));
                  my $dpic = getNearestItem($findLB);
		  my $dir = dirname($dpic);
		  if (!-d $dir) {
		    $sw->messageBox(-icon => 'warning', -message => "Sorry, but the folder\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.",-title => 'folder not found', -type => 'OK');
		    return;
	          }
                  $sw->Busy;
	          showPicInOwnWin($dpic);
                  $sw->Unbusy;
		  } );

  my $SButF = $ButF->Frame(-bd => 0)->pack(-side => 'top', -anchor => 'n', -expand => 1, -fill =>'both',-padx => 0,-pady => 0);

  $OKB =
	$SButF->Button(-text => 'Search',
				  -command => sub {
                    my $searchStart = Tk::timeofday();
					my $count = 0;
					my ($thumb, $thumbP, $last_time, $start_time, $end_time);

					if (($config{SearchCom}  == 0 and
						 $config{SearchName} == 0 and
						 $config{SearchDir}  == 0 and
						 $config{SearchExif} == 0 and
						 $config{SearchKeys} == 0 and
						 $config{SearchIptc} == 0)) {
					   $sw->messageBox(-icon => 'warning',
                                       -message => 'Please select at least on field (keywords, comments, ...) to search in.',
									   -title => 'No search field selected', -type => 'OK');
                       return;
                    }

                    unless (checkNumberFormat($config{SearchPop})) {
                      $config{SearchPop} = 5;
                      $sw->messageBox(-icon => 'warning',
                         -message => 'Please enter a natural number (0,1,2,3,...) in the viewed field',
                         -title => 'Wrong format', -type => 'OK');
                      return;
                    }

					# store the patterns before we process them
					$config{SearchPattern}   = $pattern;
					$config{SearchExPattern} = $exclude;

					# replace (german) umlaute by corresponding letters
					$pattern =~ s/([$umlaute])/$umlaute{$1}/g if ($config{ConvertUmlaut});
					$exclude =~ s/([$umlaute])/$umlaute{$1}/g if ($config{ConvertUmlaut});

					$label = "searching pattern in $keys pictures."; $sw->update;

					$pat = makePattern($pattern);# support windows like search patterns
					$exl = makePattern($exclude);# support windows like search patterns

					if ($config{SearchWord}) {
					  $pat = "\\b$pat";
					  $pat =~ s/\s+/\\b \\b/g;   # replace one or more whitespaces with \b \b the word boundary
					  $pat .= '\\b';
					}

					if ($config{SearchType} eq 'any') { # or-function "Tim Tom" -> "Tim|Tom"
					  $pat =~ s/\s+/|/g;         # replace one or more whitespaces with |
					}
					elsif ($config{SearchType} eq 'all') {
					  $pat = '(?=.*'.$pat;       # and-function with look-ahead
					  $pat =~ s/\s+/)(?=.*/g;    # replace one or more whitespaces with )(?=.*
					  $pat .= ')';               # "Tom Tim" is now: "(?=.*Tom)(?=.*Tim)"
					}
					else {                       # do nothing (normal string search)
					}

					#my $qrpat; # todo, but seems not to work with and searches
					#if ($config{SearchCase}) { $qrpat = qr/'$pat'2/io; } else { $qrpat = qr/'$pat'/o; }
					#print "pat = $pat qrpat = $qrpat\n";

                    # the exclude patterns are always combined with or
					$exl =~ s/ /|/g;           # or-function "Tim Tom" -> "Tim|Tom"

					print "searchMetaInfo: pattern: $pattern -> -$pat-\n" if $verbose;
					print "searchMetaInfo: exclude pattern: $exclude -> -$exl-\n" if $verbose;

					if ($config{SearchDate}) {
					  if (!checkDateFormat($config{SearchDateStart})) {
						$sw->messageBox(-icon => 'warning', -message => $datetext, -title => 'Wrong from-date', -type => 'OK');
						return;
					  }
					  if (!checkDateFormat($config{SearchDateEnd})) {
						$sw->messageBox(-icon => 'warning', -message => $datetext, -title => 'Wrong to-date', -type => 'OK');
						return;
					  }
					  $start_time = buildUnixTime($config{SearchDateStart});
					  $end_time   = buildUnixTime($config{SearchDateEnd});
					  #print "$start_time .. $end_time\n";
					  if ($end_time < $start_time) {
                        $sw->messageBox(-icon => 'warning',
                           -message => 'Search from date must be before search to date',
                           -title => 'Wrong search date', -type => 'OK');
                        return;
					    }
					  }

					$findLB->delete('all'); # clear listbox
					$sw->Busy;

					my $case = 'i'; $case = '' if $config{SearchCase};

					$stopB->configure(-state => 'normal'); $stopB->update();

                    my $i = 0;

					####################################################
					# loop through all database entries
					foreach my $dpic (sort keys %searchDB) {
					  last if $stop;
                      $i++;

	                  # show progress and found pics every 0.5 seconds - idea from Slaven
                      if (!defined $last_time || Tk::timeofday()-$last_time > 0.5) {
                        $progress = int($i/$keys*100); $sw->update;
                        $last_time = Tk::timeofday();
                      }

					  if ($config{SearchOnlyInDir}) { # search only in subdirs of actual/selected dir
						next unless ($dpic =~ m/^$start_dir/);
					  }

					  if ($config{SearchUrgencyOn}) { # ignore pics without a urgency setting
						  next unless (defined($searchDB{$dpic}{URG}));
                      }

                      # fill in the POP key if it's missing (will cost about 6 Bytes per picture in the searchDB
					  $searchDB{$dpic}{POP} = 0 unless (defined $searchDB{$dpic}{POP});

					  my $urg  = $searchDB{$dpic}{URG};
					  my $time = $searchDB{$dpic}{TIME};

					  # skip if wrong urgency
					  if ($config{SearchUrgencyOn} and (defined $urg)) {
						  if ($config{SearchUrgencyRel} eq '=') { # equal
							  next if ($urg != $config{SearchUrgency});
						  }
						  else { # handle bigger and lower
							  $urg = 9 if ($urg == 0); # urgency 0 means none, which is less than 8 (low)
							  if ($config{SearchUrgencyRel} eq '>=') { # bigger
								  next if ($urg < $config{SearchUrgency});
							  }
							  if ($config{SearchUrgencyRel} eq '<=') { # lower
								  next if ($urg > $config{SearchUrgency});
							  }
						  }
					  }

					  # skip if wrong pixel sum size
					  if ($config{SearchPixelOn}) {
					    next unless (defined $searchDB{$dpic}{PIXX});
					    next unless (defined $searchDB{$dpic}{PIXY});
					    my $pixy = $searchDB{$dpic}{PIXX} * $searchDB{$dpic}{PIXY};
						if ($config{SearchPixelRel} eq '=') { # equal
						  next if ($pixy != $config{SearchPixel});
						}
						else { # handle bigger and lower
						  if ($config{SearchPixelRel} eq '>=') { # bigger
							  next if ($pixy < $config{SearchPixel});
						  }
						  if ($config{SearchPixelRel} eq '<=') { # lower
							  next if ($pixy > $config{SearchPixel});
						  }
						}
					  }

					  # skip if wrong numer of views (popularity)
					  if ($config{SearchPopOn}) {
						  if ($config{SearchPopRel} eq '=') { # equal
							  next if ($searchDB{$dpic}{POP} != $config{SearchPop});
						  }
						  else { # handle bigger and lower
							  if ($config{SearchPopRel} eq '>=') { # bigger
								  next if ($searchDB{$dpic}{POP} < $config{SearchPop});
							  }
							  if ($config{SearchPopRel} eq '<=') { # lower
								  next if ($searchDB{$dpic}{POP} > $config{SearchPop});
							  }
						  }
					  }

					  # skip if wrong date
					  if ($config{SearchDate} and defined($time)) {
						  next if ($time < $start_time);
						  next if ($time > $end_time);
					  }

					  my $com  = $searchDB{$dpic}{COM};
					  my $exif = $searchDB{$dpic}{EXIF};
					  my $iptc = $searchDB{$dpic}{IPTC};
					  my $keys = $searchDB{$dpic}{KEYS};

                      # replace newlines with space
                      $com  =~ s/\n/ /g if (defined $com);
                      $exif =~ s/\n/ /g if (defined $exif);
                      $iptc =~ s/\n/ /g if (defined $iptc);

                      my $allMeta = '';
                      if ($config{SearchJoin}) {        # join all selected meta info with a space
                        $allMeta  = $com                if ($config{SearchCom}  and $com);
                        $allMeta .= ' '.$exif           if ($config{SearchExif} and $exif);
                        $allMeta .= ' '.$iptc           if ($config{SearchIptc} and $iptc);
                        $allMeta .= ' '.$keys           if ($config{SearchKeys} and $keys);
                        $allMeta .= ' '.basename($dpic) if ($config{SearchName});
                        $allMeta .= ' '.dirname($dpic)  if ($config{SearchDir});
                        $allMeta  =~ s/\n/ /g;           # replace newlines with space
                      }

					  if ((($config{SearchJoin} and ($allMeta ne '') and ($allMeta =~ m/(?$case).*$pat.*/) ) ) or
                         (($config{SearchCom}  and (defined $com)    and ($com  =~ m/(?$case).*$pat.*/)) or
						  ($config{SearchExif} and (defined $exif)   and ($exif =~ m/(?$case).*$pat.*/)) or
						  ($config{SearchIptc} and (defined $iptc)   and ($iptc =~ m/(?$case).*$pat.*/)) or
						  ($config{SearchKeys} and (defined $keys)   and ($keys =~ m/(?$case).*$pat.*/)) or
						  ($config{SearchKeys} and (!defined $keys)  and ($pat eq '')) or # empty keywords
						  ($config{SearchName} and (basename($dpic)             =~ m/(?$case).*$pat.*/)) or
						  ($config{SearchDir}  and (dirname($dpic)              =~ m/(?$case).*$pat.*/)))) {

                        # skip if exclude pattern matches
					    if ((defined $exl) and ($exl ne '')) {
                          next if ((($config{SearchJoin} and ($allMeta ne "") and ($allMeta =~ m/(?$case).*$exl.*/ )) ) or
                                   (($config{SearchCom}  and (defined $com)   and ($com  =~ m/(?$case).*$exl.*/)) or
	  					            ($config{SearchExif} and (defined $exif)  and ($exif =~ m/(?$case).*$exl.*/)) or
						            ($config{SearchIptc} and (defined $iptc)  and ($iptc =~ m/(?$case).*$exl.*/)) or
						            ($config{SearchKeys} and (defined $keys)  and ($keys =~ m/(?$case).*$exl.*/)) or
						            ($config{SearchName} and (basename($dpic)            =~ m/(?$case).*$exl.*/)) or
						            ($config{SearchDir}  and (dirname($dpic)             =~ m/(?$case).*$exl.*/))));
                        }

                        unless ($justCount) {
						  insertPic($findLB, $dpic, \%searchthumbs);
                        }
						$count++;
						$label = "found pattern in $count pictures.";
					  }

					} # foreach
					####################################################

					$stopB->configure(-state => "disabled");
                    $progress = 100;  $findLB->update;
                    my $searchDuration = sprintf "%.2f", (Tk::timeofday() - $searchStart);

					if ($count == 0) {
					  my $msg = "Found no pictures containing \"$pattern\"";
					  $msg .= " with urgency ".$config{SearchUrgencyRel}." ".$config{SearchUrgency} if ($config{SearchUrgencyOn});
					  $msg .= " with pixel size ".$config{SearchPixelRel}." ".$config{SearchPixel} if ($config{SearchPixelOn});
					  $msg .= " with views ".$config{SearchPopRel}." ".$config{SearchPop} if ($config{SearchPopOn});
					  $msg .= " dated between ".$config{"SearchDateStart"}." and ".$config{"SearchDateEnd"} if ($config{"SearchDate"} != 0);
					  $msg .= " in folders matching $start_dir" if ($config{"SearchOnlyInDir"} != 0);

					  $msg .= " in the database.";

					  $sw->messageBox(-icon => 'warning', -message =>  $msg,
									  -title => "Pattern not found", -type => 'OK');
					  $label  = "pattern not found (duration: $searchDuration sec).";
					  $sw->Unbusy;
					  $stop = 0;
					  return;
					}

					$sw->Unbusy;
					$label = "Search finished: found $count pictures (duration: $searchDuration sec).";
					$stop  = 0;
				  })->pack(-side => 'left', -anchor => 'w', -expand => 1,-fill => 'x',-padx => 1,-pady => 1);

  $stopB = $SButF->Button(-text => "Stop",
						 -command => sub { $stop = 1; }
						 )->pack(-side => 'left', -anchor => 'w', -expand => 0,-padx => 1,-pady => 1);
  my $stopImg = $top->Photo(-file => "$configdir/StopPic.gif") if (-f "$configdir/StopPic.gif");
  $stopB->configure(-image => $stopImg, -borderwidth => 0) if $stopImg;
  $stopB->configure(-state => "disabled");

  # would be usefull here, but needs to much space
  #$ButF->Button(-text => "Clean database ...",
	#			-command => sub {cleanDatabase();})->pack(-side => 'top', -anchor => 'w', -expand => 1,-fill => 'x',-padx => 1,-pady => 1);

  my $Xbut =
  $ButF->Button(-text => "Close",
				-command => sub {
                  $stop = 1;
                  $config{SearchGeometry} = $sw->geometry;
				  $sw->withdraw;
				  delete_thumb_objects(\%searchthumbs);
				  $sw->destroy;
				}
			   )->pack(-side => 'top', -anchor => 'w', -expand => 1,-fill => 'x',-padx => 1,-pady => 1);
         
  $sw->bind('<Control-q>',  sub { $Xbut->invoke; });
  $sw->bind('<Key-Escape>', sub { $Xbut->invoke; });
  $sw->bind('<H>',          sub { showHistogram($findLB); });

  $sw->Popup;
  checkGeometry(\$config{SearchGeometry});
  $sw->geometry($config{SearchGeometry});
  $sw->waitWindow;
}

##############################################################
# delete_thumb_objects
##############################################################
sub delete_thumb_objects {
    
	my $thumbs = shift; # hash ref to store the thumbnails

	# clean up memory - delete all found thumbnail photo objects
	foreach (keys %searchthumbs) {
		print "searchMetaInfo: deleting thumb $_\n" if $verbose;
		$$thumbs{$_}->delete if (defined $$thumbs{$_});
		delete $$thumbs{$_};
	}
}

##############################################################
# insertPic
##############################################################
sub insertPic($$$) {
  my $lb     = shift;
  my $dpic   = shift;
  my $thumbs = shift; # hash ref to store the thumbnails
  
  my $thumb = getThumbFileName($dpic);

  # create new row
  $lb->add($dpic);
  my $pic  = basename($dpic);

  if (-f $thumb) {
	$$thumbs{$thumb} = $lb->Photo(-file => $thumb, -gamma => $config{Gamma});
	if (defined $$thumbs{$thumb}) {
	  $lb->itemCreate($dpic, $lb->{thumbcol}, -image => $$thumbs{$thumb}, -itemtype => "imagetext", -text => getThumbCaption($dpic), -style => $thumbS);
	}
  }
  else {
	$lb->itemCreate($dpic, $lb->{thumbcol}, -itemtype => "imagetext", -text => $pic, -style => $thumbS);
	print "insertPic: no thumb for $dpic ($thumb)\n" if $verbose;
  }

  my $dir  = dirname($dpic);
  my $iptc;
  $iptc    = displayIPTC($dpic); 

  my $com  = formatString($searchDB{$dpic}{COM},  30, $config{LineLimit});  # format the comment   for the list
  my $exif = formatString($searchDB{$dpic}{EXIF}, 30, $config{LineLimit});  # format the EXIF info for the list
  $iptc    = formatString($iptc, 30, $config{LineLimit});  # format the IPTC info for the list

  my $size = basename($dpic)."\n\n";
  $size   .= int($searchDB{$dpic}{SIZE}/1024)."kB\n" if (defined $searchDB{$dpic}{SIZE});
  $size   .= $searchDB{$dpic}{PIXX}.'x'.$searchDB{$dpic}{PIXY}."\n" if (defined $searchDB{$dpic}{PIXX});
  $size   .= buildDateTime($searchDB{$dpic}{MOD}) if (defined $searchDB{$dpic}{MOD});
  $size   .= "\nviewed ".$searchDB{$dpic}{POP}." times" if (defined $searchDB{$dpic}{POP});

  $lb->itemCreate($dpic, $lb->{filecol}, -text => $size, -style => $fileS);
  $lb->itemCreate($dpic, $lb->{iptccol}, -text => $iptc, -style => $iptcS);
  $lb->itemCreate($dpic, $lb->{comcol},  -text => $com,  -style => $comS);
  $lb->itemCreate($dpic, $lb->{exifcol}, -text => $exif, -style => $exifS);
  $lb->itemCreate($dpic, $lb->{dircol},  -text => $dir,  -style => $dirS);
}

##############################################################
# makePattern - create a regex from windows like search patterns
#               * for zero or more chars
#               ? for exactly one char
#               \* to search for the star sign (*)
#               \? to search for a questionmark (?)
#               . for a point (.)
##############################################################
sub makePattern {
  my $pattern = shift;

  $pattern =~ s/\(/\\(/g;     # replace ( with \(
  $pattern =~ s/\)/\\)/g;     # replace ) with \)

  $pattern =~ s/\[/\\[/g;     # replace ( with \(
  $pattern =~ s/\]/\\]/g;     # replace ) with \)

  $pattern =~ s/\{/\\{/g;     # replace ( with \(
  $pattern =~ s/\}/\\}/g;     # replace ) with \)

  $pattern =~ s/\./\\./g;     # replace . with \.   (a point)
  $pattern =~ s/\\\*/\377/g;  # replace \* with \377 (\377 is an unlikly char)
  $pattern =~ s/\*/.*/g;      # replace * with .*   (zero or more chars)
  $pattern =~ s/\377/\\*/g;   # replace \377 with \*   (the star iteself)
  $pattern =~ s/\\\?/\377/g;  # replace \? with \377
  $pattern =~ s/\?/.{1}/g;    # replace ? with .{1} (one char) must be after { -> \{
  $pattern =~ s/\377/\\?/g;   # replace \377 with \?   (the questionmark iteself)
  $pattern =~ s/\+/\\+/g;     # replace + with \+

  $pattern =~ s/\^/\\^/g;     # replace ^ with \^
  $pattern =~ s/\$/\\\$/g;     # replace $ with \$
  $pattern =~ s/\|/\\|/g;     # replace | with \|

  #print "makePattern: $pattern\n";
  return $pattern;
}

##############################################################
# getMemoryUsage - get the actual memory usage of mapivi in Bytes
##############################################################
sub getMemoryUsage {
  my $size = 0;
  my $t = new Proc::ProcessTable;

  foreach my $p (@{$t->table}) {
	#if ($p->{pid} == $$) { # todo this would be the better way, but $p->{pid} is 0 on solaris
	if ($p->{fname} eq "mapivi") {
	  $size = $p->{size};
	  last;
	}
  }
  return $size;
}


##############################################################
# xmp_show - show XMP info using Image::ExifTool
##############################################################
sub xmp_show {

  unless ($exiftoolAvail) {
	$top->messageBox(-icon  => 'info', -message => "Sorry, but the Perl module Image::ExifTool is not available.\nPlease install it and restart Mapivi.",
			   -title => "Image::ExifTool not available", -type => 'OK');
    return;
  }

  my $lb = shift;
  my @sellist = getSelection($lb);
  return unless checkSelection($lb, 1, 0, \@sellist);
  my $selected = scalar @sellist;
  $userinfo = "extracting XMP information of $selected pictures"; $userInfoL->update;

  my $exifTool = new Image::ExifTool;
  my $i = 0;
  my $pw = progressWinInit($lb, "Extracting XMP information");
  foreach my $dpic (@sellist) {
	last if progressWinCheck($pw);
	$i++;
	progressWinUpdate($pw, "Extracting XMP ($i/$selected) ...", $i, $selected);
    my $xmp = '';
    my $info = $exifTool->ImageInfo($dpic, 'XMP:*');
    foreach (sort keys %$info) {
      my $val = $$info{$_};
      if (ref $val eq 'ARRAY') {
        $val = join(', ', @$val);
      } elsif (ref $val eq 'SCALAR') {
        $val = '(Binary data)';
      }
      $xmp .= sprintf("%-24s : %s\n", $_, $val);
    }
    $xmp = 'No XMP data found.' if ($xmp eq '');
    showText("XMP data of $dpic", $xmp, NO_WAIT);
  }
  progressWinEnd($pw);
  $userinfo = "ready! ($i of $selected)"; $userInfoL->update;
}

##############################################################
# xmp_add_keyword - add XMP keyword using Image::ExifTool
##############################################################
sub xmp_add_keyword {

  unless ($exiftoolAvail) {
	$top->messageBox(-icon  => 'info', -message => "Sorry, but the Perl module Image::ExifTool is not available.\nPlease install it and restart Mapivi.",
			   -title => "Image::ExifTool not available", -type => 'OK');
    return;
  }

  my $lb = shift;
  my @sellist = getSelection($lb);
  return unless checkSelection($lb, 1, 0, \@sellist);
  my $selected = scalar @sellist;

  my $keyword = '';
  my $rc = myEntryDialog('Add XMP keyword', "Please enter a new keyword to add to the $selected pictures", \$keyword);
  return if (($rc ne 'OK') or ($keyword eq ''));

  $userinfo = "adding XMP keyword to $selected pictures"; $userInfoL->update;

  my $exifTool = new Image::ExifTool;
  my $i = 0;
  my $error = '';
  my $pw = progressWinInit($lb, 'Adding XMP keyword');
  foreach my $dpic (@sellist) {
	last if progressWinCheck($pw);
	$i++;
	progressWinUpdate($pw, "Adding XMP keyword ($i/$selected) ...", $i, $selected);
    my $info = $exifTool->ImageInfo($dpic, 'XMP:*');
    # get exsisting keywords
    my @keywords = $exifTool->GetValue('Subject');
    # add new keyword to list
    push @keywords, $keyword;
    # remove double entries and sort alphabetical
    uniqueArray(\@keywords);
    # add XMP keywords
    $exifTool->SetNewValue('XMP-dc:Subject' => \@keywords);
    #$exifTool->SetNewValue('XMP-dc:Title' => 'Mapivi can write XMP!');
    #$exifTool->SetNewValue('XMP:Urgency' => 3);

    my $rc = $exifTool->WriteInfo($dpic);

    if ($rc != 1) {
      if ($rc == 2) {
        $error .= "$dpic written, but no changes made\n";
      }
      else {
        $error .= "Error writing $dpic: $rc\n";
        # retrieve error and warning messages
        $error .= sprintf "error: %s\n", $exifTool->GetValue('Error') if $exifTool->GetValue('Error');
        $error .= sprintf "warning: %s\n", $exifTool->GetValue('Warning') if $exifTool->GetValue('Warning');
      }
    }

  }
  progressWinEnd($pw);
  $userinfo = "ready! ($i of $selected)"; $userInfoL->update;
  showText("Errors while adding XMP keywords", $error, NO_WAIT) if ($error ne '');
}

##############################################################
# xmp_add_title - add XMP title using Image::ExifTool
##############################################################
sub xmp_add_title {

  unless ($exiftoolAvail) {
	$top->messageBox(-icon  => 'info', -message => "Sorry, but the Perl module Image::ExifTool is not available.\nPlease install it and restart Mapivi.",
			   -title => "Image::ExifTool not available", -type => 'OK');
    return;
  }

  my $lb = shift;
  my @sellist = getSelection($lb);
  return unless checkSelection($lb, 1, 0, \@sellist);
  my $selected = scalar @sellist;

  my $item = '';
  my $rc = myEntryDialog('Add XMP title', "Please enter a new title to add to the $selected picture(s)", \$item);
  return if ($rc ne 'OK');

  $userinfo = "adding XMP title to $selected picture(s)"; $userInfoL->update;

  my $exifTool = new Image::ExifTool;
  my $i = 0;
  my $error = '';
  my $pw = progressWinInit($lb, 'Adding XMP title');
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "Adding XMP title ($i/$selected) ...", $i, $selected);
    my $info = $exifTool->ImageInfo($dpic, 'XMP:*');
    # add XMP title
    $exifTool->SetNewValue('XMP-dc:Title' => $item);

    my $rc = $exifTool->WriteInfo($dpic);

    if ($rc != 1) {
      if ($rc == 2) {
        $error .= "$dpic written, but no changes made\n";
      }
      else {
        $error .= "Error writing $dpic: $rc\n";
        # retrieve error and warning messages
        $error .= sprintf "error: %s\n", $exifTool->GetValue('Error') if $exifTool->GetValue('Error');
        $error .= sprintf "warning: %s\n", $exifTool->GetValue('Warning') if $exifTool->GetValue('Warning');
      }
    }

  }
  progressWinEnd($pw);
  $userinfo = "ready! ($i of $selected)"; $userInfoL->update;
  showText("Errors while adding XMP title", $error, NO_WAIT) if ($error ne '');
}

##############################################################
# xmp_edit_title - edit XMP title using Image::ExifTool
##############################################################
sub xmp_edit_title {

  unless ($exiftoolAvail) {
	$top->messageBox(-icon  => 'info', -message => "Sorry, but the Perl module Image::ExifTool is not available.\nPlease install it and restart Mapivi.",
			   -title => "Image::ExifTool not available", -type => 'OK');
    return;
  }

  my $lb = shift;
  my @sellist = getSelection($lb);
  return unless checkSelection($lb, 1, 0, \@sellist);
  my $selected = scalar @sellist;

  $userinfo = "adding XMP title to $selected picture(s)"; $userInfoL->update;

  my $exifTool = new Image::ExifTool;
  my $i = 0;
  my $error = '';
  my $pw = progressWinInit($lb, 'Adding XMP title');
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    my $item = '';
    my $info = $exifTool->ImageInfo($dpic, 'XMP:*');
    $item = $$info{Title} unless (ref $$info{Title} eq 'SCALAR');
    my $rc = myEntryDialog('Edit XMP title', "Please edit title of $dpic", \$item);
    next if ($rc ne 'OK');
    progressWinUpdate($pw, "Edit XMP title ($i/$selected) ...", $i, $selected);
    # add XMP title
    $exifTool->SetNewValue('XMP-dc:Title' => $item);

    $rc = $exifTool->WriteInfo($dpic);

    if ($rc != 1) {
      if ($rc == 2) {
        $error .= "$dpic written, but no changes made\n";
      }
      else {
        $error .= "Error writing $dpic: $rc\n";
        # retrieve error and warning messages
        $error .= sprintf "error: %s\n", $exifTool->GetValue('Error') if $exifTool->GetValue('Error');
        $error .= sprintf "warning: %s\n", $exifTool->GetValue('Warning') if $exifTool->GetValue('Warning');
      }
    }

  }
  progressWinEnd($pw);
  $userinfo = "ready! ($i of $selected)"; $userInfoL->update;
  showText("Errors while adding XMP title", $error, NO_WAIT) if ($error ne '');
}

##############################################################
# checkTrash
##############################################################
sub checkTrash {

  my @files = getFiles($trashdir);
  my $sum = 0;
  foreach (@files) {
	$sum += getFileSize("$trashdir/$_", NO_FORMAT); # get size in Bytes
  }

  my $msum = sprintf "%.1f", $sum/(1024*1024); # size in MB

  return if ($msum < $config{MaxTrashSize});

  my $dialog = $top->Dialog(-title => "Trash full!",
							-text => "The trash contains $msum MB in ".scalar @files." files!",
							-buttons => ["Do nothing", "Show trash in main window", "Empty trash ..."]);
  my $rc = $dialog->Show();
  if ($rc eq "Do nothing") {
	$top->focusForce;
	return;
  }
  elsif ($rc eq "Show trash in main window") {
	openDirPost($trashdir);
	$top->focusForce;
	return;
  }
  elsif ($rc eq "Empty trash ...") {
	emptyTrash();
  }
  else {
	warn "this should never be reached!";
  }

  $top->focusForce;
}

##############################################################
# emptyTrash - remove all files from the trash
##############################################################
sub emptyTrash {
  my @files = getFiles($trashdir);

  # open window
  my $win = $top->Toplevel();
  $win->title('Empty trash?');
  $win->iconimage($mapiviicon) if $mapiviicon;
  my $w = int($top->screenwidth * 0.5);
  my $h = int($top->screenheight * 0.90);
  $win->geometry("${w}x${h}+0+0"); 

  my $text = "loading ...";

  $win->Label(-textvariable => \$text)->pack(-expand => 0, -fill => 'x');
  my $tlb = $win->Scrolled("HList",
						   -header     => 1,
						   -separator  => ';',  # todo here we hope that ; will never be in a folder or file name
						   -pady       => 0,
						   -columns    => 4,
						   -scrollbars => 'osoe',
						   -selectmode => 'extended',
						   -background => $config{ColorBG}, #8fa8bf
						   -width      => 80,
						   -height     => 30,
						  )->pack(-expand => 1, -fill => "both");

  bindMouseWheel($tlb);
  $tlb->header('create', 0, -text => 'Thumbnail', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
  $tlb->header('create', 1, -text => 'Name',      -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
  $tlb->header('create', 2, -text => 'Size',      -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
  $tlb->header('create', 3, -text => 'Original folder',      -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});


  my $butF = $win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);

  $butF->Button(-text => 'Empty trash',
				-command => sub {
				  my @sellist = $tlb->info('selection');
				  print "sel: $_\n" foreach (@sellist);
				  foreach (@files) {
					removeFile("$trashdir/$_");
				  }
				  updateThumbsPlus() if ($actdir eq $trashdir);
				  $win->destroy;
				})->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $butF->Button(-text => 'Remove selected',
				-command => sub {
				  my @sellist = $tlb->info('selection');
				  foreach (@sellist) {
				    removeFile($_);
	                            $tlb->delete('entry', $_);
				  }
				  #updateThumbsPlus() if ($actdir eq $trashdir);
				  #$win->destroy;
				})->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $butF->Button(-text => 'Restore selected',
				-command => sub {
				  my @sellist = $tlb->info('selection');
                  my $error = '';
				  foreach my $dpic (@sellist) {
                    # if original dir (odir) is defined and not unknown and the folder exists, we move the picture back
                    if ($searchDB{$dpic}{odir} and
                       ($searchDB{$dpic}{odir} ne 'unknown') and
                       ( -d $searchDB{$dpic}{odir})) {
                      my @list; # we need a dummy list here with one element
                      push @list, $dpic;
                      #print "moving $dpic to $searchDB{$dpic}{odir}\n";
                      movePics($searchDB{$dpic}{odir}, $tlb, @list);
	                  #$tlb->delete('entry', $dpic) unless (-f $dpic);
                    }
                    else {
                      $error .= "Could not restore $dpic (no folder information available)\n";
                    }
				  }
                if ($error ne '') {
		          $error = "Errors while restoring selected pictures:\n$error";
		          showText("Errors", $error, NO_WAIT);
                }
				#updateThumbsPlus() if ($actdir eq $trashdir);
				#$win->destroy;
				})->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

        my $Xbut = $butF->Button(-text => 'Close',
						   -command => sub {
							 $win->destroy();
						   })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $win->bind('<Control-q>',  sub { $Xbut->invoke; });
  $win->bind('<Key-Escape>', sub { $Xbut->invoke; });
  $win->bind('<Control-a>',  sub { selectAll($tlb); } );
  $win->bind('<ButtonPress-2>', sub {
              return if (!$tlb->info('children'));
              my $dpic = getNearestItem($tlb);
              showPicInOwnWin($dpic); });

  $win->Popup(-popover => 'cursor');
  repositionWindow($win);

  my $sum = 0;
  my %thumbs;
  foreach my $pic (sort { uc($a) cmp uc($b); } @files) {
	my $dpic = "$trashdir/$pic";
	$sum  += getFileSize($dpic, NO_FORMAT); # get size in Bytes
	my $size  = getFileSize($dpic, FORMAT);
	my $thumb = getThumbFileName($dpic);
	my $odir = 'unknown';
        $odir = $searchDB{$dpic}{odir} if ($searchDB{$dpic}{odir});

	$tlb->add($dpic);
	if (-f $thumb) {
	  $thumbs{$thumb} = $top->Photo(-file => $thumb, -gamma => $config{Gamma});
	  if (defined $thumbs{$thumb}) {
		$tlb->itemCreate($dpic, 0, -image => $thumbs{$thumb}, -itemtype => 'imagetext', -style => $thumbS);
	  }
	}

	$tlb->itemCreate($dpic, 1, -text => $pic,  -style => $comS);
	$tlb->itemCreate($dpic, 2, -text => $size, -style => $iptcS);
	$tlb->itemCreate($dpic, 3, -text => $odir, -style => $comS);
  }

  my $msum = sprintf "%.1f", $sum/(1024*1024); # size in MB

  $text = "Please press \"Empty trash\" to delete all files ($msum MB in ".scalar @files." files) from the trash.\nThere is no undelete!\n\n(Trash folder: $trashdir)";

  $win->waitWindow;
  foreach (keys %thumbs) { $thumbs{$_}->delete if (defined $thumbs{$_}); } # free memory
}

##############################################################
# setFromTo - dialog to set search from and search to date
##############################################################
sub setFromTo {

  # open window
  my $win = $top->Toplevel();
  $win->title('Set from/to search dates');
  $win->iconimage($mapiviicon) if $mapiviicon;

  my @fdate = split /\./, $config{SearchDateStart};
  my $from_day   = $fdate[0];
  my $from_month = $fdate[1];
  my $from_year  = $fdate[2];

  my @tdate = split /\./, $config{SearchDateEnd};
  my $to_day   = $tdate[0];
  my $to_month = $tdate[1];
  my $to_year  = $tdate[2];

  # ranges
  my (@day, @month, @year);
  push @day,   sprintf "%02d",$_ for ( 1 .. 31);
  push @month, sprintf "%02d",$_ for ( 1 .. 12);
  push @year,  sprintf "%4d", $_ for ( 1990 .. 2020);
  # it is still possible to add other year numbers in the search window itself!
  
  my $f1 = $win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
  $f1->Label(-text => 'from', -width => 4)->pack(-side => "left", -anchor => 'w');
  $f1->Optionmenu(-variable => \$from_day, -textvariable => \$from_day, -options => \@day)->pack(-side => "left", -anchor => 'w');
  $f1->Optionmenu(-variable => \$from_month, -textvariable => \$from_month, -options => \@month)->pack(-side => "left", -anchor => 'w');
  $f1->Optionmenu(-variable => \$from_year, -textvariable => \$from_year, -options => \@year)->pack(-side => "left", -anchor => 'w');
  $f1->Button(-text => 'today', -command => sub {
  my (undef,undef,undef,$d,$M,$y,undef,undef,undef,undef) = localtime(time());
  $y += 1900;
  $M++;
  $from_day   = sprintf "%02d", $d;
  $from_month = sprintf "%02d", $M;
  $from_year  = sprintf "%4d",  $y;})->pack(-side => "left", -anchor => 'w');
  
  my $f2 = $win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
  $f2->Label(-text => 'to', -width => 4)->pack(-side => "left", -anchor => 'w');
  $f2->Optionmenu(-variable => \$to_day, -textvariable => \$to_day, -options => \@day)->pack(-side => "left", -anchor => 'w');
  $f2->Optionmenu(-variable => \$to_month, -textvariable => \$to_month, -options => \@month)->pack(-side => "left", -anchor => 'w');
  $f2->Optionmenu(-variable => \$to_year, -textvariable => \$to_year, -options => \@year)->pack(-side => "left", -anchor => 'w');
  $f2->Button(-text => 'today', -command => sub {
  my (undef,undef,undef,$d,$M,$y,undef,undef,undef,undef) = localtime(time());
  $y += 1900;
  $M++;
  $to_day   = sprintf "%02d", $d;
  $to_month = sprintf "%02d", $M;
  $to_year  = sprintf "%4d",  $y;})->pack(-side => "left", -anchor => 'w');

  my $butF = $win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
 
  my $OKB = 
  $butF->Button(-text => 'OK',
				-command => sub {
				$config{SearchDateStart} = "$from_day.$from_month.$from_year";
				$config{SearchDateEnd}   = "$to_day.$to_month.$to_year";
				$win->destroy;
				})->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  my $Xbut = $butF->Button(-text => 'Cancel',
						   -command => sub {
							 $win->destroy();
						   })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $win->bind('<Control-q>',  sub { $Xbut->invoke; });
  $win->bind('<Key-Escape>', sub { $Xbut->invoke; });
  $win->bind('<Control-x>',  sub { $OKB->invoke;  });

  $win->Popup(-popover => 'cursor');
  repositionWindow($win);
  $win->waitWindow;
}

##############################################################
# showFile
##############################################################
sub showFile {
  my $file = shift;
  return if (!-f $file);

  my $fileH;
  if (!open($fileH, "<$file")) {
	warn "Sorry, I couldn't open the file $file: $!";
	return;
  }

  my $buffer;
  read $fileH, $buffer, 32768;
  close($fileH);
  $buffer =~ s/\r//g;
  showText(basename($file), $buffer, WAIT) if ($buffer ne "");
}

##############################################################
# showText
##############################################################
sub showText {

  my $title     = shift;
  my $text      = shift;
  my $wait      = shift; # WAIT = wait for the window to close or NO_WAIT
  my $thumbnail = shift; # optional

  my $icon;

  $text = " " if ((!defined $text) or ($text eq ""));
  # open window
  my $win = $top->Toplevel();
  $win->withdraw;
  $win->title($title);
  $win->iconname($title);
  $win->iconimage($mapiviicon) if $mapiviicon;

  my $xBut =
  $win->Button(-text => "Close",
			   -command => sub {
				 $icon->delete if $icon;
				 $win->withdraw();
				 $win->destroy();
			   },
			  )->pack(-fill => 'x');

  # 50 ways to leave your window ;)
  $win->bind('<Key-Escape>'          , sub {$xBut->invoke;});
  $win->bind('<Key-q>'               , sub {$xBut->invoke;});
  $win->protocol("WM_DELETE_WINDOW" => sub {$xBut->invoke;} );

  my $f  = $win->Frame()->pack(-fill => 'both', -expand => "1");
  my $fl = $f->Frame()->pack(-anchor => "n", -side => "left");
  my $fr = $f->Frame()->pack(-anchor => "n", -side => "left", -fill => 'both', -expand => "1");
  if ((defined $thumbnail) and (-f $thumbnail)) {
	$icon = $win->Photo(-file => $thumbnail, -gamma => $config{Gamma});
	if ($icon) {
	  $fl->Label(-image => $icon, -bg => $config{ColorBG}, -relief => "sunken",
			   )->pack(-padx => 1, -pady => 2);
	}
  }

  # determine the height of the textbox by counting the number of lines
  my $height = ($text =~ tr/\n//);
  $height   += 3;
  $height    = 50 if ($height > 50); # not to big, we have scrollbars
  my $rotext = $fr->Scrolled("ROText",
							-scrollbars => 'oe',
							-wrap => 'word',
							-tabs => '4',
							-width => 90,
							-height => $height,
						   )->pack(-fill => 'both', -expand => "1");

  $rotext->insert('end', $text);
  bindMouseWheel($rotext);

  $xBut->focus;
  $win->Popup;
  repositionWindow($win);
  $win->waitWindow if ($wait == WAIT);
}

##############################################################
# exportFilelist
##############################################################
sub exportFilelist {

  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);

  my ($pic, $dpic);
  my $addPath   = 0;
  my $useQuotes = 0;

  # open window
  my $myDiag = $top->Toplevel();
  $myDiag->title("Export file list");
  $myDiag->iconimage($mapiviicon) if $mapiviicon;

  $myDiag->Label(-text => "Write a filelist containing the ".scalar @sellist." selected pictures",
				 -bg => $config{ColorBG}
				  )->pack(-fill => 'x', -padx => 3, -pady => 3);

  labeledEntryButton($myDiag,'top',37,"path/name of file list",'Set',\$config{PicListFile});

  $myDiag->Checkbutton(-variable => \$addPath, -text => "add the complete path to every file")->pack(-anchor=>'w');
  $myDiag->Checkbutton(-variable => \$useQuotes, -text => "add quotes around each file")->pack(-anchor=>'w');

  my $ButF =
	$myDiag->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);

  my $OKB =
	$ButF->Button(-text => 'OK',
				  -command => sub {
					if (-f $config{PicListFile}) {
					  my $rc =
						$myDiag->messageBox(-icon  => 'warning', -message => "file $config{'PicListFile'} exist. Ok to overwrite?",
											-title => "Export file list",   -type => 'OKCancel');
					  return if ($rc !~ m/Ok/i);
					}
					my $exfile;
					if (!open($exfile, ">$config{'PicListFile'}")) {
					  warn "exportFilelist: Couldn't open $config{'PicListFile'}: $!";
					  return;
					}


					foreach $dpic (@sellist) {
					  $pic      = basename($dpic);
					  print $exfile "\""       if $useQuotes;
					  print $exfile "$actdir/" if $addPath;
					  print $exfile "$pic";
					  print $exfile "\""       if $useQuotes;
					  print $exfile ", ";
					}
					close $exfile;
					$myDiag->withdraw();
					$myDiag->destroy();
				  })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  #$balloon->attach($OKB, -msg => "You can press Control-x to close the dialog");

  $ButF->Button(-text => 'Cancel',
				-command => sub {
					$myDiag->withdraw();
					$myDiag->destroy();
				  })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $myDiag->Popup(-popover => 'cursor');
  repositionWindow($myDiag);
  $myDiag->waitWindow;

  $userinfo = "ready!"; $userInfoL->update;
}

##############################################################
# GIMPedit
##############################################################
sub GIMPedit {

  my @sellist  = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);
  return unless askSelection(\@sellist, 10, "GIMP");

  my ($pic, $dpic, $i, $exifthumb);

  if ($EvilOS) {
	return if (!checkExternProgs("GIMPedit", "gimp-win-remote"));
  }
  else {
	  if (!checkExternProgs("GIMPedit", "gimp")){
		  $dpic  = $sellist[0];
		  $pic   = basename($dpic);
		  my $rc = $top->messageBox(-icon    => "question",
									-message => "Should Mapivi start a new GIMP with the first selected picture ($pic)?\nEXIF info will not be saved!\nUse Edit->EXIF info->save first!",
									-title => "Open picture with GIMP", -type => 'OKCancel');
		  return if ($rc !~ m/Ok/i);
		  my $command = "gimp \"$dpic\" 2>&1 1>/dev/null &";
		  (system "$command") == 0 or warn "$command failed: $!";
		  return;
	  }
  }

  EXIFsave() if $config{saveEXIFforEdit};

  $i = 0;
  foreach $dpic (@sellist) {
	$i++;
	$userinfo  = "opening picture in GIMP ($i/".scalar @sellist.")"; $userInfoL->update;

	# check if file is a link and get the real target
	next if (!getRealFile(\$dpic));

	my $command = "gimp \"$dpic\" ";
	#$command    = "gimp-win-remote \"$dpic\" " if $EvilOS;   # GIMP <= 2.0
	$command    = "gimp-win-remote gimp-2.2.exe \"$dpic\" " if $EvilOS; # GIMP > 2.0
	$command .= "2>&1 1>/dev/null &" if (!$EvilOS);
	(system "$command") == 0 or warn "$command failed: $!";
	#execute($command); # does not work for Windows
  }

  $top->after(800, sub { $userinfo = "ready!"; $userInfoL->update; });
}

##############################################################
# getSelection - get the selected items from a Canvas or a HList
##############################################################
sub getSelection {
  my $widget = shift;

  my @sellist;

  if (ref($widget) eq 'Tk::Canvas') {
	  my @sel = $widget->find('withtag', 'THUMBSELECT_MH');
	  foreach my $id (@sel) { push @sellist, get_path_from_id($id); }
	}
  else {
	  @sellist  = $widget->info('selection');
	}

  return @sellist;
}

##############################################################
# openPicInViewer
##############################################################
sub openPicInViewer {

  my $lb = shift;    # the reference to the active listbox widget
  my @sellist = getSelection($lb);
  return unless checkSelection($top, 1, 0, \@sellist);

  my $maxnr = 20;
  if (!$config{ExtViewerMulti} and (@sellist > $maxnr)) {
	my $rc = $lb->messageBox(-icon    => "question",
							  -message => "You have selected more than $maxnr pictures.\nPlease confirm to start ".scalar @sellist." pictures viewer processes.\nPlease press Ok to continue.",
						  -title => "Start a lot of viewers?", -type => 'OKCancel');
	return if ($rc !~ m/Ok/i);
  }

  my ($dpic, $i, $exifthumb, $piclist);

  $i = 0;
  foreach $dpic (@sellist) {
	$i++;
	$userinfo = "opening picture in viewer ($i/".scalar @sellist.")"; $userInfoL->update;

	increasePicPopularity($dpic);
	updateOneRow($dpic, $lb) if (($config{trackPopularity}) and (ref($lb) ne 'Tk::Canvas'));

	$dpic =~ s/\//\\/g if $EvilOS; # windows needs backslashes

	if ($config{ExtViewerMulti}) {
	  $piclist .= "\"$dpic\" ";
	}
	else {
	  my $command = $config{ExtViewer}." \"$dpic\" ";

	  # instead of the & for UNIX windows needs a "start" in front of the application to run in the background
	  if ($EvilOS) {
		$command = "start $command";
	  }
	  else {
		$command .= "2>&1 1>/dev/null &";
	  }
	  (system "$command") == 0 or warn "$command failed: $!";
	  #execute($command); this is no good choice, because it waits for the viewer to finish
	}
  }

  if ($config{ExtViewerMulti}) {
	my $command = $config{ExtViewer}." $piclist";
	# instead of the & for UNIX windows needs a "start" in front of the application to run in the background
	if ($EvilOS) {
	  $command = "start $command";
	}
	else {
	  $command .= "2>&1 1>/dev/null &";
	}
	(system "$command") == 0 or warn "$command failed: $!";
  }

  $top->after(800, sub { $userinfo = "ready!"; $userInfoL->update; });
}

##############################################################
# setBackground - set the current picture as desktop background
##############################################################
sub setBackground {

  my @sellist  = $picLB->info('selection');
  if (@sellist != 1) {
	  $top->messageBox(-icon => 'warning', -message => "Please select exactly one picture.",
					   -title => "set desktop background", -type => 'OK');
	  return;
  }

  my $dpic   = $sellist[0];
  my $pic    = basename($dpic);
  $userinfo  = "setting $pic as desktop background ..."; $userInfoL->update;

  # check if file is a link and get the real target
  next if (!getRealFile(\$dpic));

  my $command = $config{ExtBGApp}." \"$dpic\" ";
  execute($command);

  $userinfo = "ready!"; $userInfoL->update;
}

##############################################################
# identifyPic - display the output of identify
##############################################################
sub identifyPic {

  return if (!checkExternProgs("identifyPic", "identify"));

  my @sellist  = $picLB->info('selection');
  if (@sellist != 1) {
	$top->messageBox(-icon  => 'warning', -message => "Please select exactly one picture.",
					 -title => "Show picture infos", -type => 'OK');
	  return;
  }

  my $dpic   = $sellist[0];
  my $pic    = basename($dpic);
  my $thumb  = getThumbFileName($dpic);
  $userinfo  = "getting infos about $pic ..."; $userInfoL->update;

  # check if file is a link and get the real target
  next if (!getRealFile(\$dpic));

  my $command = "identify -verbose \"$dpic\" ";
  my $buffer = `$command`;
  showText("Information about $pic", $buffer, NO_WAIT, $thumb);

  $userinfo = "ready!"; $userInfoL->update;
}

##############################################################
# showSegments
##############################################################
sub showSegments {

  my @sellist  = $picLB->info('selection');
  if (@sellist != 1) {
	$top->messageBox(-icon  => 'warning', -message => "Please select exactly one picture.",
					 -title => "Show segments", -type => 'OK');
	  return;
  }

  my $dpic   = $sellist[0];
  my $pic    = basename($dpic);
  my $thumb  = getThumbFileName($dpic);

  # check if file is a link and get the real target
  next if (!getRealFile(\$dpic));

  my $meta = getMetaData($dpic); # get all segments
  return unless ($meta);

  my $segments = $meta->{segments};
  my $win = $top->Toplevel();
  $win->withdraw;
  $win->title("JPEG segments of $pic");
  $win->iconimage($mapiviicon) if $mapiviicon;
  my $xBut = $win->Button(-text => "Close", -command =>
						  sub { $win->destroy(); })->pack(-fill => 'x');

  foreach (@$segments) {
	my $segInfo = $_->get_description();
	my $segname = $_->{name};
	my $title   = sprintf "%-16s %8s Bytes",$segname,$_->size();
	$win->Button(-text => $title, -anchor => "nw",
				 -command => sub {
				   showText("Segment $segname of $pic", $segInfo, NO_WAIT);
				 })->pack(-fill => 'x');
  }
  $xBut->focus;
  $win->Popup;

}

##############################################################
# showHistogram - display the histogram of a picture
##############################################################
sub showHistogram($) {

  return if (!checkExternProgs("showHistogram", "convert"));

  my $lb = shift;
  my @sellist  = $lb->info('selection');
  if (@sellist != 1) {
	  $lb->messageBox(-icon  => 'warning', -message => "Please select exactly one picture.",
					  -title => "Show picture histogram", -type => 'OK');
	  return;
  }

  my $dpic   = $sellist[0];
  my $pic    = basename($dpic);
  my $thumb  = getThumbFileName($dpic);
  $userinfo  = "building histogram of $pic ..."; $userInfoL->update;

  # check if file is a link and get the real target
  next if (!getRealFile(\$dpic));

  my $hist = getHistogram($lb, $dpic);

  if (($hist eq "") or (!-f $hist)) {
	$userinfo  = "Error building histogram of $pic!"; $userInfoL->update;
	return;
  }

  $userinfo = "ready!"; $userInfoL->update;

  my $but = "Save histogram";
  my $rc  = myPicDialog("Histogram", "Histogram of $pic", $but, $thumb, $hist);

  if ($rc eq $but) {
	my $file = $lb->FileSelect(-title => "Save histogram of $pic (GIF format)",
								-directory => $actdir,
								-initialfile => basename($hist),
								-create => 1,
								-width => 30, -height => 30)->Show;

	if ((defined $file) and ($file ne "")) {
	  if (mycopy($hist, $file, ASK_OVERWRITE)) { # ask before overwrite
		$userinfo = "histogram saved!";
	  }
	  else {
		$userinfo = "error while saving histogram";
	  }
	}
  }

  removeFile($hist);

}

##############################################################
# getHistogram - generate a histogram of the given picture
#                returns the path and file to the histogram
#                file or "" if no success
##############################################################
sub getHistogram($$) {

  my $widget = shift;
  my $dpic   = shift;
  my $rc = "";
  return $rc unless (-f $dpic);
  my $pic    = basename($dpic);
  # temp PNM or GIF file in the trash directory
  my $hist    = "$trashdir/histogram.pnm"; # exchange pnm with gif if needed
  if (-f $hist) {
	my $urc = $top->messageBox(-icon => 'question',
							   -message => "Histgram file $hist exists already.\nShould I overwrite it?",
							   -title => "Overwrite?", -type => 'OKCancel');
	return $rc if ($urc !~ m/Ok/i);
  }

  # with the -comment "" option the file size of the histogram shrinks from ~1MB to ~5kB
  # because convert saves the complete color table in the comment (at least when GIF format is used)
  my $command = "convert \"$dpic\" HISTOGRAM:- | convert -comment \"\" - \"$hist\" ";

  $widget->Busy;
  execute($command);
  $widget->Unbusy;

  $rc = $hist if (-f $hist);

  return $rc;
}

##############################################################
# showHistogram2 - display the histogram of a picture with builtin histogram function
##############################################################
sub showHistogram2($) {

  return if (!checkExternProgs("showHistogram", "convert"));

  my $lb = shift;
  my @sellist  = $lb->info('selection');
  if (@sellist != 1) {
	  $lb->messageBox(-icon  => 'warning', -message => "Please select exactly one picture.",
					  -title => "Show picture histogram", -type => 'OK');
	  return;
  }

  my $dpic   = $sellist[0];
  my $pic    = basename($dpic);
  my $thumb  = getThumbFileName($dpic);
  $userinfo  = "building histogram of $pic ..."; $userInfoL->update;

  # check if file is a link and get the real target
  next if (!getRealFile(\$dpic));
  
  buildHistogram($dpic);
}

##############################################################
# buildHistogram 
##############################################################
sub buildHistogram {
  my $dpic  = shift;
  my $photo = $top->Photo(-file => $dpic); # no gamma correction here!

  my (@red, @green, @blue);
  foreach (0 .. 255) { $red[$_]   = 0; }
  foreach (0 .. 255) { $green[$_] = 0; }
  foreach (0 .. 255) { $blue[$_]  = 0; }

  my $w = $photo->width;
  my $h = $photo->height;
  
  # if the picture is to big, it will take very long, so we shrink them first.
  # some color information may be lost this way!
  my $subsample = int($w*$h/500000);
  print "$dpic: subsample: $subsample\n" if $verbose;
  if ($subsample > 1) {
    my $zoomed = $top->Photo;
	$zoomed->blank;
	$zoomed->copy($photo, -zoom => 1);
	$photo->delete;
	$photo = undef;
    $photo = $top->Photo;
    $photo->copy($zoomed, -subsample => $subsample);
	$zoomed->delete;
	$zoomed = undef;
    $w = $photo->width;
	$h = $photo->height;
    print "$dpic new size: $w x $h\n" if $verbose;
  }

  if ($w <= 0 or $h <= 0) { warn "buildHistogram: wrong size: $w $h\n"; return; }

  #stopWatchStart();

  my $pw = progressWinInit($top, "Calculating histogram of ".$w*$h." pixels");
  # get and add rgb values of each pixel
  foreach my $x (0 .. $w-1) {
	last if progressWinCheck($pw);
	progressWinUpdate($pw, "calculating column ($x/$w) ...", $x, $w);
	foreach my $y (0 .. $h-1) {
			  my @rgb = $photo->get($x,$y);
			  $red[$rgb[0]]++;
			  $green[$rgb[1]]++;
			  $blue[$rgb[2]]++;
			}
  }
  progressWinEnd($pw);

  # find the maximal value
  my $max = 0;
  foreach (0 .. 255) { $max = $red[$_]   if ($red[$_]    > $max);
					   $max = $green[$_] if ($green[$_] > $max);
					   $max = $blue[$_]  if ($blue[$_]  > $max); };

  # open window
  my $win = $top->Toplevel();
  $win->title("Histogram of $dpic");
  $win->iconimage($mapiviicon) if $mapiviicon;

  $h = 255; # height is now the height of the canvas
  my $canvas = $win->Canvas(-width  => 256,
							-height => $h+1,
							-background => 'black',
							-relief => 'sunken',
							-bd => $config{Borderwidth})->pack(-side => 'top', -padx => 3, -pady => 3);

  # draw a line for red, green and blue
  foreach my $x (0 .. 255) {
	$canvas->createLine( $x, $h, $x, $h-int($h*$red[$x]/$max),   -fill => 'red');
	$canvas->createLine( $x, $h, $x, $h-int($h*$green[$x]/$max), -fill => 'green', -stipple => 'transp2');
	$canvas->createLine( $x, $h, $x, $h-int($h*$blue[$x]/$max),  -fill => 'blue', -stipple => 'transp3');
  }

  $win->Button(-text => "Close",
			   -command => sub {
				 $win->destroy();
			   }
			  )->pack(-side => 'top',-expand => 1,-fill => 'x',-padx => 3,-pady => 3);
  $win->bind('<Key-Escape>', sub { $win->destroy; } );
  $win->Popup;

  #stopWatchStop("Histogram of $dpic");
}

##############################################################
# checkSelection
##############################################################
sub checkSelection {
  my $win     = shift;
  my $min     = shift;
  my $max     = shift; # use 0 for any number
  my $listref = shift;
  my $itemkind = shift; # optional string, e.g. "picture" or "keyword", ...
  $itemkind = '' unless defined $itemkind;
  
  my $plural = '';
  $plural    = 's' if ($min > 1);
  
  if (($min == $max) and (@$listref != $min)) {
	$win->messageBox(-icon  => 'warning', -message => "Please select exactly $min $itemkind item$plural!",
					 -title => "Wrong selection", -type => 'OK');
	return 0;
  }

  if (@$listref < $min) {
	$win->messageBox(-icon  => 'warning', -message => "Please select at least $min $itemkind item$plural!",
					 -title => "Wrong selection", -type => 'OK');
	return 0;
  }

  if (($max != 0) and (@$listref > $max)) {
	$win->messageBox(-icon  => 'warning', -message => "Please select not more than $max $itemkind items!",
					 -title => "Wrong selection", -type => 'OK');
	return 0;
  }

  return 1;
}

##############################################################
# askSelection
##############################################################
sub askSelection {
  my $listRef = shift;
  my $max     = shift;
  my $text    = shift;

  # ask only for more than $max pictures
  return 1 if (@{$listRef} < $max);

  my $rc = $top->messageBox(-icon => "question",
							-message => "You have selected ".scalar @{$listRef}." pictures. This function will open an $text window for each selected picture.\nPlease press Ok to continue.",
							-title => "Show $text of ".scalar @{$listRef}." pictures",
							-type => 'OKCancel');
  if ($rc =~ m/Ok/i) {
	return 1;
  }

  return 0;
}

##############################################################
# indexPrint - generate indexPrints/montages of the selected
#              pictures
##############################################################
my $indexW; # index dialog window
my $indexPicsT;
my $indexNrT;
my $sizeT;
sub indexPrint {

  return if (!checkExternProgs("indexPrint", "montage"));

  if (Exists($indexW)) {
	$indexW->deiconify;
	$indexW->raise;
	return;
  }

  my $pic_list_ref = shift;
  #foreach (@$pic_list_ref) { print "list::: $_\n"; }
  my @sellist = @$pic_list_ref;
  return unless checkSelection($top, 1, 0, \@sellist);

  my $index = $sellist[0];
  $index    = dirname($sellist[0]).'/'.findNewName($index);

  if (-f $index) { # just for safety, we don't want to overwrite something
	warn "$index exists: aborting - this should never happen!!!\n";
	return;
  }

  # get size of first pic
  my ($pic0x, $pic0y) = getSize($sellist[0]);

  # open window
  $indexW = $top->Toplevel();
  #$indexW->grab();
  $indexW->title("montage/index prints of ".scalar @sellist." pictures");
  $indexW->iconimage($mapiviicon) if $mapiviicon;

  my $w = 26;
  labeledEntry($indexW, 'top', $w, "file name of index print", \$index);
  labeledEntry2($indexW, 'top', 20, 4, "Columns (x)",\$config{indexCols}, "Rows (y)",\$config{indexRows});
  labeledEntry2($indexW, 'top', 20, 4, "x distance", \$config{indexDisX}, "y distance",        \$config{indexDisY});
  my $sizeF = $indexW->Frame(-relief => "raised")->pack(-expand => 1, -fill => 'x', -padx => 3);
  labeledEntry2($sizeF, 'top', 20, 4, "Picture width", \$config{indexPicX}, "Picture height",    \$config{indexPicY});
  $sizeF->Button(-text => "insert picture size (${pic0x}x$pic0y)", -command => sub { $config{indexPicX} = $pic0x; $config{indexPicY} = $pic0y; })->pack(-anchor => 'e', -padx => 3, -pady => 3);
  labeledEntryColor($indexW,'top',$w,"Background color",'Set',\$config{indexBG});

  my $lF = $indexW->Frame(-relief => "raised")->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  $lF->Checkbutton(-variable => \$config{indexLabel}, -text => "add a label to each picture")->pack(-anchor=>'w');
  my $labstr =
  labeledEntry($lF, 'top', $w, "label string",       \$config{indexLabelStr});
  $balloon->attach($labstr, -msg => "%b   file size\n%c   comment\n%d   folder\n%e   filename extention\n%f   filename\n%h   height\n%i   input filename\n%l   label\n%m   magick\n%n   number of scenes\n%o   output filename\n%p   page number\n%q   quantum depth\n%s   scene number\n%t   top of filename\n%u   unique temporary filename\n%w   width\n%x   x resolution\n%y   y resolution");

  my $fss = labeledScale($lF, 'top', $w, "label font size", \$config{indexFontSize}, 0, 50, 1);
  $balloon->attach($fss, -msg => "The font size of the labels.\nIf you set this to 0, montage will\ntry to choose a appropriate size.");

  my $ibF = $indexW->Frame(-relief => "raised")->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  $ibF->Checkbutton(-variable => \$config{indexInnerBorder}, -text => "add a border around each picture")->pack(-anchor=>'w');
  labeledScale($ibF, 'top', $w, "Border width", \$config{indexInnerBorderWidth}, 1, 1000, 1);
  labeledEntryColor($ibF, 'top', $w, "Border color",'Set',\$config{indexInnerBorderColor});

  my $obF = $indexW->Frame(-relief => "raised")->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  $obF->Checkbutton(-variable => \$config{indexBorder}, -text => "add a border around the index print")->pack(-anchor=>'w');
  labeledScale($obF, 'top', $w, "Border width", \$config{indexBorderWidth}, 1, 1000, 1);
  labeledEntryColor($obF, 'top', $w, "Border color",'Set',\$config{indexBorderColor});

  my $qS = labeledScale($indexW, 'top', $w, "Quality of index picture", \$config{PicQuality}, 10, 100, 1);
  qualityBalloon($qS);

  buttonComment($indexW, 'top');

  calcIndexInfo( scalar @sellist );

  my $f = $indexW->Frame(-bd => $config{Borderwidth}, -relief => 'groove',)->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  $f->Label(-textvar => \$indexPicsT, -bg => $config{ColorBG})->pack(-anchor => 'w');
  $f->Label(-textvar => \$indexNrT,   -bg => $config{ColorBG})->pack(-anchor => 'w');
  $f->Label(-textvar => \$sizeT,      -bg => $config{ColorBG})->pack(-anchor => 'w');
  $f->Button(-text => "update info", -command => sub { calcIndexInfo(scalar @sellist); } )->pack();

  my $ButF = $indexW->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);

  my $OKB;
  $OKB =
	$ButF->Button(-text => 'OK',
					-command => sub {
					  my $nr = calcIndexInfo( scalar @sellist ); # we need the nr of index prints here
					  if ($nr == 1) {
						# just one index print, we leave the name
						if (-f $index) {
						  my $rc =
							$indexW->messageBox(-icon  => 'warning', -message => "file $index exist. Please press Ok to overwrite.",
												-title => "File exists!", -type => 'OKCancel');
						  return if ($rc !~ m/Ok/i);
						}
					  }
					  else {
						# there is more than one index print, montage will name them xxx01.jpg ...
						$index =~ /(.*)(\.jp(g|eg))/i; # split (we need base name and suffix)
						$index = "$1-%02d$2";
						for (1 .. $nr) {
						  my $name = sprintf "%s-%02d%s", $1, $_, $2;
						  if (-f $name) {
							my $rc =
							  $indexW->messageBox(-icon  => 'warning', -message => "file $name exist. Please press Ok to overwrite.",
												  -title => "File exists!", -type => 'OKCancel');
							return if ($rc !~ m/Ok/i);
						  }
						}
					  }

					  $indexW->destroy(); # close index window

					  $userinfo  = "building index prints of ".scalar @sellist." pictures ..."; $userInfoL->update;
					  my $command = "montage ";
					  if ($config{indexInnerBorder}) {
						$command .= "-bordercolor \"".$config{indexInnerBorderColor}."\" ";
						$command .= "-border ".$config{indexInnerBorderWidth}.'x'.$config{indexInnerBorderWidth}." ";
                      }
					  $command .= "-label \"$config{'indexLabelStr'}\" " if $config{indexLabel};
					  $command .= "-font \"-*-courier-medium-r-*-*-".$config{indexFontSize}."-*-*-*-*-*-iso8859-*\" " if ($config{indexLabel} and ($config{indexFontSize} > 0));
					  #$command .= "-pointsize ".$config{indexFontSize}." " if $config{indexLabel};
					  $command .= "-background \"$config{'indexBG'}\" -tile $config{'indexCols'}x$config{'indexRows'} -filter Lanczos -geometry $config{'indexPicX'}x$config{'indexPicY'}+$config{'indexDisX'}+$config{'indexDisY'} ";

					  my $pic;
					  # add the selected pictures to $command
					  foreach my $dpic (@sellist) {
						$command .= "\"$dpic\" ";
					  }

					  # if there is a second process step (border) we use the lossless MIFF format
					  my $tmpfile = "$trashdir/indexTmpFile.miff";
					  if (-f $tmpfile) { warn "tmp file $tmpfile exists! Mapivi tries to remove it"; return unless removeFile($tmpfile); }
					  if ($config{indexBorder}) {
						$command   .= "\"$tmpfile\"";
					  }
					  else {
						$command   .= "-quality ".$config{PicQuality}." ";
						$command   .= "\"$index\"";
					  }
					  print "$command\n" if $verbose;
					  $top->Busy;
					  if ($EvilOS) {
						(system $command) == 0 or warn "execute: $command failed: $!";
					  }
					  else {
						execute($command);
					  }
					  # for win32 we need to wait for this process to finish

					  if ($config{indexBorder}) {
						$command = "convert -bordercolor \"".$config{indexBorderColor}."\" ";
						$command .= "-border ".$config{indexBorderWidth}.'x'.$config{indexBorderWidth}." ";
						$command .= "-quality ".$config{PicQuality}." ";
						$command .= "\"$tmpfile\" ";
						$command .= "\"$index\"";
						print "$command\n" if $verbose;
					    if ($EvilOS) { # do not use bgrun for windows
						  (system $command) == 0 or warn "execute: $command failed: $!";
					    }
					    else {
						  execute($command);
					    }
					  }

					  $top->Unbusy;
					  removeFile($tmpfile) if (-f $tmpfile);
					  if ($config{AddMapiviComment}) {
						addCommentToPic("Picture made with Mapivi ($mapiviURL)", $index, NO_TOUCH);
					  }
					  $userinfo = "ready!"; $userInfoL->update;
					  if ($nr == 1) {
						# for one index we insert it in the listbox
						generateOneThumb($index);
						# insert index in listbox
						addOneRow($picLB, $index, 1, $sellist[0]);
					  }
					  else {
						# for several index we need a (slower) update
						updateThumbs();
					  }
					  showPic($index);
					})->pack(-side => 'left',-expand => 1,-fill => 'x',-padx => 3,-pady => 3);


  $ButF->Button(-text => 'Cancel',
				-command => sub {
				  $indexW->destroy();
				}
				 )->pack(-side => 'left',-expand => 1,-fill => 'x',-padx => 3,-pady => 3);

  $indexW->bind('<Key-Escape>', sub {$indexW->destroy;});
  $indexW->Popup;
  $indexW->waitWindow;
}

##############################################################
# calcIndexInfo
##############################################################
sub calcIndexInfo {

  my $nrOfSel = shift;
  my $indexPics = $config{indexRows} * $config{indexCols};
  $indexPicsT = "One index print holds $indexPics pictures.";

  my $indexNr = int($nrOfSel/$indexPics);
  $indexNr++ if (($nrOfSel % $indexPics) != 0);
  $indexNrT = "With $nrOfSel pictures this results in $indexNr index pictures.";

  my $sizex  = $config{indexCols} * ($config{indexPicX} + (2*$config{indexDisX}));
  my $sizey  = $config{indexRows} * ($config{indexPicY} + (2*$config{indexDisY}));
  if ($config{indexBorder}) {
    $sizex = $sizex + 2 * $config{indexBorderWidth};
    $sizey = $sizey + 2 * $config{indexBorderWidth};
  }
  if ($config{indexInnerBorder}) {
    $sizex = $sizex + $config{indexCols} * 2 * $config{indexInnerBorderWidth};
    $sizey = $sizey + $config{indexRows} * 2 * $config{indexInnerBorderWidth};
  }
  $sizeT  = "One index will be ca. ${sizex}x${sizey} pixels.";
  return ($indexNr);
}

##############################################################
# fisher_yates_shuffle - shuffle an array randomly
##############################################################
sub fisher_yates_shuffle {
  my $deck = shift;  # $deck is a reference to an array
  my $i = @$deck;
  while ($i--) {
	my $j = int rand ($i+1);
	@$deck[$i,$j] = @$deck[$j,$i];
  }
}

##############################################################
# reloadPic
##############################################################
sub reloadPic {
  deleteCachedPics($actpic); # we need to reread the picture, so we should remove it from the cachedPics list first
  showPic($actpic);          # display the picture
}

##############################################################
# zoom100 - zoom the actual pic to 100%
##############################################################
sub zoom100 {
  return if (!$actpic);
  $userinfo = "loading ".basename($actpic)." ..."; $userInfoL->update;
  deleteCachedPics($actpic);        # we need to reread the picture, so we should clear the cachedPics list first
  my $t = $config{AutoZoom};  # save auto zoom value
  $config{AutoZoom} = 0;      # stop auto zoom
  showPic($actpic);           # display the picture without auto zoom
  $config{AutoZoom} = $t;     # reset autozoom to the saved value
}

##############################################################
# fitPicture - (re)zoom the actual picture to fit into the canvas
##############################################################
sub fitPicture {
	return unless (-f $actpic);
	deleteCachedPics($actpic);
	my $autoZoomSave = $config{AutoZoom}; # save actual autoZoom value
	$config{AutoZoom} = 1;                # enable auto zoom
	showPic($actpic);
	$config{AutoZoom} = $autoZoomSave;    # restore old autoZoom value
}

##############################################################
# slideshow - start/stop slideshow
##############################################################
sub slideshow {
  my $last_time;

  if ($slideshow) {
	$userinfo = "slideshow started"; $userInfoL->update;
	$top->after(500); # just a litte delay to show the message above

	until ($slideshow == 0) {
	  if (!defined $last_time || Tk::timeofday()-$last_time > $config{SlideShowTime}) {
		my @savedselection = $picLB->info('selection');
		showPic(nextSelectedPic($actpic));
		$userinfo = basename($actpic)." (slideshow: ".$config{SlideShowTime}."sec)"; $userInfoL->update;
		$last_time = Tk::timeofday();
		$picLB->selectionClear();
		reselect($picLB, @savedselection);
	  }
	  DoOneEvent(); # stay responsive
	  last if (!$slideshow);
	}
  }
  $userinfo = "slideshow stopped"; $userInfoL->update;
}

##############################################################
# getWindows - get a list of toplevel children of the given widget
##############################################################
sub getWindows {
  my $w = shift;
  my @winlist;
  # get all childs of $w
  my @childs = $w->children;

  # search for toplevels and build list
  foreach my $widget (@childs) {
	if (ref($widget) eq "Tk::Toplevel") {
	  push @winlist, $widget;
	}
  }
  return @winlist;
}

##############################################################
# clearAndInsert - clear the given listbox and insert the list
##############################################################
sub clearAndInsert {

  my $listBox = shift;
  return if (!Exists($listBox));
  my @list    = @_;

  # clear listbox
  $listBox->delete(0, 'end');

  foreach (@list) {
	$listBox->insert('end', $_->cget(-title));
  }
}

my $winW;
##############################################################
# showWindowList
##############################################################
sub showWindowList {

  if (Exists($winW)) {
	$winW->deiconify;
	$winW->raise;
	return;
  }

  my @winlist = getWindows($top);

  if (@winlist <= 0) {
	$top->messageBox(-icon  => 'info', -message => "There are no open windows in the moment!",
					 -title => "No windows", -type => 'OK');
	return;
  }

  # open window
  $winW = $top->Toplevel();
  $winW->title("MaPiVi window list");
  $winW->iconimage($mapiviicon) if $mapiviicon;

  $winW->Label(-text => "Sub windows of MaPiVi", -relief => "sunken" )->pack(-fill => 'x', -padx => 3, -pady => 3);

  my $listBoxY = @winlist + 1;
  $listBoxY = 30 if ($listBoxY > 30); # not higher than 30 entries

  my $listBox =
	$winW->Scrolled('Listbox',
					-scrollbars => 'osoe',
					-selectmode => 'extended',
					-exportselection => 0,
					-width => 80,
					-height => $listBoxY,
				   )->pack(-expand => 1, -fill =>'both');
  bindMouseWheel($listBox);

  $listBox->bind('<Double-Button-1>', sub {
				   my @sellist = $listBox->curselection();
				   foreach (@sellist) {
					 $winlist[$_]->deiconify;
					 $winlist[$_]->raise;
					 $winlist[$_]->update;
				   }
				   @winlist = getWindows($top);
				  clearAndInsert($listBox, @winlist);
				 } );

  clearAndInsert($listBox, @winlist);

  my $ButF =
	$winW->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);

  $ButF->Button(-text => "Update",
				-command => sub {
				  @winlist = getWindows($top);
				  clearAndInsert($listBox, @winlist);
				})->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $ButF->Button(-text => "Iconify",
				-command => sub {
				  my @sellist = $listBox->curselection();
				  foreach (@sellist) {
					$winlist[$_]->iconify;
				  }
				  @winlist = getWindows($top);
				  clearAndInsert($listBox, @winlist);
				})->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $ButF->Button(-text => "Close",
				-command => sub {
				  my @sellist = $listBox->curselection();
				  foreach (@sellist) {
					$winlist[$_]->destroy() if (Exists($winlist[$_]));
				  }
				  return if (!Exists($winW)); # own win closed - finished
				  @winlist = getWindows($top);
				  clearAndInsert($listBox, @winlist);
				})->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $ButF->Button(-text => "Show",
				-command => sub {
				  my @sellist = $listBox->curselection();
				  foreach (@sellist) {
					$winlist[$_]->deiconify;
					$winlist[$_]->raise;
					$winlist[$_]->update;
				  }
				  @winlist = getWindows($top);
				  clearAndInsert($listBox, @winlist);
				})->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $ButF->Button(-text => 'Cancel',
				-command => sub {
				  $winW->destroy();
				}
			   )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $winW->bind('<Key-Escape>', sub {$winW->destroy;});
  $winW->bind('<Key-q>'     , sub {$winW->destroy;});

  $winW->Popup;
  $winW->waitWindow;
}

##############################################################
# toggle - toggle the value of a boolean variable reference
##############################################################
sub toggle {
  my $varRef = shift;
  if ($$varRef == 1) {
	$$varRef = 0;
  }
  elsif ($$varRef == 0) {
	$$varRef = 1;
  }
  else {
	warn "toggle: Reference has unexpected value: $$varRef\n";
  }
}

##############################################################
# execute
##############################################################
sub execute {
  my $string = shift; # command to execute
  my $actexe;         # file handle to Tk::IO object (background process)

  print "execute: $string\n" if $verbose;

  if (!$EvilOS) { # running on a "good" OS like Linux we can use background processes :)
	# init a background process
	$actexe = Tk::IO->new(-linecommand  => sub { nop(); },
						  -childcommand => sub { print "execute: child com\n" if $verbose; } );

	# start the background process
	$actexe->exec($string);

	# the busy call made some problems with jhead and the autorot option
	# while it was enabled the $actexe->wait call sometimes never returned
	#$top->Busy;
	# waiting for current process to finish
	$actexe->wait();
	#$top->Unbusy;
  }
  # we run on a evil OS like windows - no threading :(
  # Tk::IO is supposed to run under windows, but it does not with mine
  else {
	#$top->Busy;
	#(system "$string") == 0 or warn "execute: $string failed: $!";
	#$top->Unbusy;
	bgRun($string);
  }
}

##############################################################
# findApp - find Windows-App-Name for Win32::Process
#           from Uwe Steffen
##############################################################

sub findApp
{
   my ($cmd)=@_;
   $cmd =~ /^\s*(\w+)/;
   my $cmdName=$1.".exe";
   #print "cmdName:",$cmdName,"\n";
   if (defined($winapps{$cmdName}))
   {
     return $winapps{$cmdName};
   }
   my @path=split (/;/,$ENV{PATH});
   foreach my $dir (@path)
   {
     my $test=$dir."/$cmdName";
     #print "Test: $test \n";
     if ( -x $test )
     {
       $winapps{$cmdName}=$test;
       return $test;
     }
   }
}

##############################################################
# bgRun - run a process in background
#         from Uwe Steffen
##############################################################
sub bgRun {
  my ($cmd) = @_;

  if (!$EvilOS) {
	warn "bgRun should not be called for non Windows systems!";
	return 0;
  }

  if (Win32ProcAvail) {
	my ($dir,$pid,$proc);
	my ($bInherit) = 0;
	my ($flags)    = Win32::Process::CREATE_NO_WINDOW()    |
	                 Win32::Process::IDLE_PRIORITY_CLASS() |
					 Win32::Process::DETACHED_PROCESS();

	if ( $cmd =~ /^(\w+:[\w\\.]+)/) {
	  print "Process with full path: ",$cmd," APP:", $1,"\n" if $verbose;
	  $pid = Win32::Process::Create($proc, $1, $cmd, $bInherit, $flags, "."  );
	} else {
	  print "Process without full path: ",$cmd," APP:", findApp($cmd),"\n" if $verbose;
	  $pid = Win32::Process::Create($proc, findApp($cmd), $cmd, $bInherit, $flags, "."  );
	}

	if ($pid) {
	  $proc->Wait(15000);
	  print "bgRun: timeout\n";
	  return 1;
	} else {
	  warn "Could not start $cmd.\n";
	  warn "Error: " . Win32::FormatMessage(Win32::GetLastError());
	  return 0;
	}
  } else { # Win32::Process module not available
	$top->Busy;
	(system "$cmd") == 0 or warn "bgRun: $cmd failed: $!";
	$top->Unbusy;
  }
}

##############################################################
# cleanThumbDB - remove all old thumbnails in the thumbDB
##############################################################
sub cleanThumbDB {

  # todo create dialog window and make e.g. the $days an adjustable option
  my $days = 30;
  my $thumbDB = "$configdir/thumbDB";
  my $thumbDB_quote = $thumbDB;
  $thumbDB_quote =~ s|\\|\\\\|g;    # replace backslash with double backslashe \ -> \\ (quoting)
  my @thumbs;
  my $rc = $top->messageBox(-icon  => "question",
							-message => "This function will display all stored thumbnails in the thumbnail data base which have no corresponding picture and are older than $days days. You may then select which of then to delete. Please press Ok to proceed.",
							-title => "Clean thumbnail database", -type => 'OKCancel');
  return if ($rc !~ m/Ok/i);

  $userinfo = "searching outdated thumbnails ..."; $userInfoL->update;
  find(sub {
		 #print "dir: $File::Find::name\n";
		 if (-f and (-M >= $days)) {
		   my $orig = $File::Find::name;
           # cut off the first path part (the path to the thumbdb) the rest is the real part.
		   $orig =~ s|^$thumbDB_quote||;
		   unless (-f $orig) {
			 print "file: $File::Find::name -> $orig\n" if $verbose;
			 push @thumbs, $File::Find::name;
		   }
		 }
	   }, $thumbDB);

  # todo: ignore /mnt/cdrom (%ignorePaths) ...

  $userinfo = "found ".@thumbs." outdated thumbnails ..."; $userInfoL->update;
  if (@thumbs > 0) {
	my @sel_list;
	# user may select which to delete
	if (mySelListBoxDialog("Really delete?",
						   "Please select which of these ".scalar @thumbs." thumbnails to delete.",
                           MULTIPLE,
						   'OK', \@sel_list, @thumbs)) {
      foreach (@sel_list) {
        print "removing $thumbs[$_]\n" if $verbose;
        removeFile($thumbs[$_]); 
      }
	}
    $userinfo = "ready!"; $userInfoL->update;
  }
  else {
    $top->messageBox(-icon  => "info",
					 -message => "Found no outdated thumbnails in $thumbDB. Seems like your thumbnails are up to date.",
					 -title => "Thumbnail database is up to date", -type => 'OK');
  }
  return;
  # todo: remove empty dirs in $thumbDB ...
}

##############################################################
# cleanDir - remove all dirs and files added by mapivi from
#            the given dir
##############################################################
sub cleanDir {

  my $dir = shift;
  print "dir = $dir actdir = $actdir\n" if $verbose;
  return unless ((defined $dir) or (-d $dir));
  my $rc;
  if (($cleanDirLevel == 0) or (!$cleanDirNoAsk)) {
	my $dia = $top->DialogBox(-title => "Clean folder ".basename($dir)."?",
							  -buttons => ['OK', 'Cancel']);
	$dia->add("Label", -text => "Remove all sub folders and files from\n$dir\nwhich were created from MaPiVi\nContinue?", -bg => $config{ColorBG}, -justify => "left")->pack;
	$dia->add("Checkbutton", -text => "Continue without asking again", -variable => \$cleanDirNoAsk)->pack;
	$rc  = $dia->Show();
	return if ($rc ne 'OK');
  }

  my ($subdir, @fileDirList);
  my @subdirs = ("$dir/$thumbdirname", "$dir/$exifdirname");
  foreach $subdir (@subdirs) {
	if (-d $subdir) {
	  @fileDirList = readDir($subdir);
	  unless ($cleanDirNoAsk) {
		$rc = $top->messageBox(-icon    => 'question',
							   -message => "There are ".scalar @fileDirList." files in the sub folder\n".basename($subdir)."\nRemove?",
							   -title => "Remove sub folder?",
							   -type    => 'OKCancel');
		next if ($rc !~ m/Ok/i);
	  }
	  $userinfo = "cleaning $subdir ..."; $userInfoL->update;
	  foreach (@fileDirList) {
		if (-f "$subdir/$_") {
		  removeFile("$subdir/$_")
		}
		else {
		  $top->messageBox(-icon => 'warning', -message => "There is a non file in $subdir: $_!",
						   -title => 'Warning', -type => 'OK') if ($_ ne "..");
		}
	  }
	  if (! rmdir($subdir)) {
		  $top->messageBox(-icon => 'warning', -message => "Could not remove $subdir: $_!",
						   -title => 'Error', -type => 'OK');
		}
	}
  }

  my @dirs = getDirs($dir);
  return if (@dirs == 0);
  my %dirh;
  # copy the list into a hash
  foreach (@dirs) { $dirh{$_} = 1; }
  # sort some special dirs out
  foreach ($thumbdirname, $exifdirname, ".xvpics") {
	if (defined $dirh{$_}) {
	  delete $dirh{$_};
	}
  }
  # are there some other dirs?
  my $nr = keys %dirh;
  if (($nr > 0) and (!$cleanDirNoAsk)) {
	$rc = $top->messageBox(-icon    => 'question',
						   -message => "There are $nr sub folders in\n$dir\n, should I clean them too?",
						   -title => "Clean sub folders?",
						   -type    => 'OKCancel');
	return if ($rc !~ m/Ok/i);
  }

  # recursive call of cleanDir()
  foreach (sort keys %dirh) {
	$cleanDirLevel++;
	cleanDir ("$dir/$_");
	$cleanDirLevel--;
  }
  if ($cleanDirLevel == 0) {
	$userinfo = "ready"; $userInfoL->update;
  }
}

##############################################################
# isInList - check if a string is element of a list reference
##############################################################
sub isInList {
  my $e       = shift;
  my $listRef = shift;
  my $found = 0;

  foreach (@$listRef) {
	if ($e eq $_) {
	  $found = 1;
	  last;
	}
  }

  return $found;
}

##############################################################
# screenshot
##############################################################
sub screenshot {

  if (Exists($scsw)) {
	$scsw->deiconify;
	$scsw->raise;
	return;
  }

  return if (!checkExternProgs("screenshot", "xwd"));
  return if (!checkExternProgs("screenshot", "convert"));

  # open window
  $scsw = $top->Toplevel();
  $scsw->title("Make screenshot");
  $scsw->iconimage($mapiviicon) if $mapiviicon;

  my $root    = "";
  my $frame   = "-frame";
  my $tmpfile = "$trashdir/screenshot.jpg";
  $tmpfile    = "$trashdir/".findNewName($tmpfile);
  my $file    = "$actdir/screenshot.jpg";
  $file       = "$actdir/".findNewName($file);
  my $hideMapivi = 0;
  my $showPic    = 1;
  my $ifB;

  my $f1 = $scsw->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-fill => 'x',-padx => 3,-pady => 3);
  $f1->Radiobutton(-text => "single window (select window with mouse click after pressing OK)", -variable => \$root, -value => "",
					 -command => sub { $ifB->configure(-state => 'normal');}
					)->pack(-anchor => 'w');
  $f1->Radiobutton(-text => "complete desktop", -variable => \$root, -value => "-root",
					 -command => sub { $frame = ""; $ifB->configure(-state => "disabled");}
					)->pack(-anchor => 'w');

  my $f2 = $scsw->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-fill => 'x',-padx => 3,-pady => 3);
  $ifB =
	$f2->Checkbutton(-variable => \$frame, -onvalue => "-frame", -offvalue => "",
						 -anchor   => 'w',
						 -text     => "include window border"
						)->pack(-anchor => 'w');

  $f2->Checkbutton(-variable => \$hideMapivi,
					   -anchor   => 'w',
					   -text     => "hide Mapivi window"
					  )->pack(-anchor => 'w');

  $f2->Checkbutton(-variable => \$showPic,
					   -anchor   => 'w',
					   -text     => "show screenshot in Mapivi when finished"
					  )->pack(-anchor => 'w');

  buttonComment($f2, 'top');

  labeledEntryButton($scsw,'top',23,"file name",'Set',\$file);

  my $qS = labeledScale($scsw, 'top', 23, "Quality of picture (%)", \$config{PicQuality}, 10, 100, 1);
  qualityBalloon($qS);

  my $ButF =
	$scsw->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);

  my $OKB =
	$ButF->Button(-text => 'OK',
				  -command => sub {
					if (-f $file) {
					  my $rc = $scsw->messageBox(-icon  => 'warning',
												 -message => "file\n\"$file\"\nexist.\nOk to overwrite?",
												 -title => "Screenshot", -type => 'OKCancel');
					  return if ($rc !~ m/Ok/i);
					}
					if (-f $tmpfile) {
					  my $rc = $scsw->messageBox(-icon  => 'warning',
												 -message => "file $tmpfile exist. Ok to overwrite?",
												 -title => "Screenshot", -type => 'OKCancel');
					  return if ($rc !~ m/Ok/i);
					}

					$top->iconify() if $hideMapivi;
					$scsw->withdraw();
					$scsw->destroy();
					$top->update if (!$hideMapivi);
					# call external command jpegtran and rotate to the temp file
					my $command = "xwd $frame $root -out \"$tmpfile\" ";
					#(system "$command") == 0 or warn "screenshot: $! ($command)";
					execute($command);
					$top->deiconify if $hideMapivi;
					if (!-f $tmpfile) { warn "nothing to convert!"; return; }
					$command = "convert -quality ".$config{PicQuality}." \"$tmpfile\" \"$file\"";
					$userinfo = "converting to JPEG format ..."; $userInfoL->update;
					$top->Busy;
					#(system "$command") == 0 or warn "convert: $! ($command)";
					execute($command);
					$top->Unbusy;
					removeFile($tmpfile);
					if ($config{AddMapiviComment}) {
					  addCommentToPic("Screenshot made with Mapivi ($mapiviURL)", $file, NO_TOUCH);
					}
					$userinfo = "ready!"; $userInfoL->update;
					if ($showPic) {
					  my $dir = dirname($file);
					  if ($actdir ne $dir) {
						openDirPost($dir);
					  }
					  else {
						updateThumbs();
					  }
					  showPic($file);
					}
				  })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $balloon->attach($OKB, -msg =>
				   'In "single window" mode the mouse cursor will turn into a cross after pressing OK.
Just make a left mouse click on the desired window.
In "desktop" mode the screenshot will be taken immediatelly after pressing the OK button.
There may be two beeps in both modes if sound is enabled.');

  $ButF->Button(-text => 'Cancel',
				-command => sub {
				  $scsw->withdraw();
				  $scsw->destroy();
				})->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $scsw->Popup;
  $scsw->waitWindow;
}

##############################################################
# dragFromPicLB - drag pictures from the thumb table
##############################################################
sub dragFromPicLB {
  my($token) = @_;

  my $w = $token->parent;	# $w is the $picLB hlist
  my $e = $w->XEvent;
  $w->update;
  my @sellist = $w->info('selection');

  return if (@sellist < 1);

  if ($EvilOS) {
      $userinfo = "copy or move ";
  } else {
      $userinfo = "copy, link, or move ";
  }

  # only one picture selected
  if (@sellist == 1) {
	#my $tokentext = $w->itemCget($sellist[0], 1, -text);
	my $tokentext = $sellist[0];
	# Configure the dnd token to show the listbox entry
	if (!$w->info("exists", $sellist[0])) {
	  print "dragFromPicLB: item not available\n";
	  return;
	}
	if ($dragAndDropIcon1) {
	  $token->configure(-image => $dragAndDropIcon1);
	}
	else {
	  $token->configure(-text => "  $tokentext");
	}
	$userinfo .= $tokentext; $userInfoL->update;
  }
  # more than one pictures selected
  else {
	if ($dragAndDropIcon2) {
	  $token->configure(-image => $dragAndDropIcon2);
	}
	else {
	  $token->configure(-text => "  ".scalar @sellist." pictures");
	}
	$userinfo .= scalar @sellist." pictures"; $userInfoL->update;
  }
  # Show the token
  my($X, $Y) = ($e->X, $e->Y);
  $token->MoveToplevelWindow($X, $Y);
  $token->raise;
  $token->deiconify;
  $token->FindSite($X, $Y, $e);
  Tk->break;					# stop default binding of this event
}

##############################################################
# dropToDirTree - drop pictures on the dirtree (copy or move)
##############################################################
sub dropToDirTree {

	$token->withdraw;
	$userinfo = ""; $userInfoL->update;
	my @sellist  = $picLB->info('selection');
	my $targetdir = getNearestItem($dirtree);
	my $details;

	return if (@sellist < 1);

	my $dirtreeNoScroll = $dirtree->Subwidget("scrolled");
	return unless ($top->containing($top->pointerxy) eq $dirtreeNoScroll);

	$targetdir  =~ s/\/\//\//g;	# replace all // with /

	foreach my $dpic (@sellist) {
		warn "$dpic n.a." unless ($picLB->info("exists", $dpic));
		my $pic   = basename($dpic);
		my $size  = getFileSize($dpic, FORMAT);
		$details .= sprintf "%-30s %20s\n", $pic, $size;
	}

	my $text = "Should I ";

	if ($EvilOS) {
		$text .= "copy or move ";
	} else {
		$text .= "copy, link, or move ";
	}

	if (@sellist == 1) {
		$text .= "this picture";
	} else {
		$text .= "these ".scalar @sellist." pictures";
	}
	$text .= " to $targetdir?\n\n$details";

	my $rc = 'Cancel';
	if ($EvilOS) {
		$rc = myButtonDialog("Copy/Move", $text, undef, "Copy", "Move", 'Cancel');
	} else {
		$rc = myButtonDialog("Copy/Link/Move", $text, undef,
							 "Copy", "Link", "Move", 'Cancel');
	}

	if ($rc eq 'Cancel') {
		return;
	} elsif ($rc eq "Copy") {
		dirSave($targetdir);
		copyPics($targetdir, COPY, $picLB, @sellist);

	} elsif ($rc eq "Link") {
		dirSave($targetdir);
		linkPics($targetdir, @sellist);

	} elsif ($rc eq "Move") {
		dirSave($targetdir);
		movePics($targetdir, $picLB, @sellist);

	} else {
		warn "unexpected rc: $rc";
		return;
	}

}

##############################################################
#dragAndDropExtern - todo
##############################################################
sub dragAndDropExtern {
    my($widget, $selection) = @_;

    my $filename;
    eval {
	  if ($^O eq 'MSWin32') {
		$filename = $widget->SelectionGet(-selection => $selection, 'STRING');
	  } else {
	    $filename = $widget->SelectionGet(-selection => $selection, 'FILE_NAME');
	  }
    };
    return if (!defined $filename);

	#print "drop extern received: $filename\n";
	$top->messageBox(-icon    => 'warning',
					 -message => "drop extern received: $filename",
					 -title   => "Drag and drop", -type => 'OK');

	unless (-f $filename or -d $filename) { print "$filename is no dir and no file\n"; return; }

	my $dir = $filename;
	if (-f $filename) {
	  return if ($filename !~ /(.*)(\.jp(g|eg))/i);
	  $dir = dirname($filename);
	}
	print "drag: dir = $dir\n";
	return unless (-d $dir);
	openDirPost($dir);
	if (-f $filename) {
	  showPic($filename);
	}
}

##############################################################
# checkWriteable
##############################################################
sub checkWriteable($) {

  my $dpic  = shift;
  my $pic   = basename($dpic);
  my $dir   = dirname($dpic);
  my $thumb = getThumbFileName($dpic);

  return 0 if (! -f $dpic);  # no file

  return 1 if (-w $dpic);    # OK, file is writable

  if (!-w $dpic) {
	my $message = "The picture $pic is write proteced!\nShould I try to overwrite the write protection?";
	my $rc = myButtonDialog("$pic is write protected", $message, $thumb, 'OK', 'Cancel');

	if ($rc eq 'OK') {
	  my $mode = (lstat $dpic)[2];  # get the actual access mode
	  $mode = $mode | 0200;         # set user write (+uw)
	  return (chmod($mode, $dpic)); # try to change the mode
	}
	else {
	  return 0;               # file is left write protected
	}
  }
}

##############################################################
# checkWriteableMulti
##############################################################
sub checkWriteableMulti {

  my @dpics = @_;

  my @protected = ();

  foreach (@dpics) {
	if ((-f $_) and (!-w $_)) {
	  push @protected, $_;
	}
  }

  return "" unless (@protected); # nothing to do

  my $text = "The following pictures are write protected:\n\n";
  foreach (@protected) {
	$text .= "$_\n";
  }
  $text .= "\nShould I try to overwrite the write protection?";

  my $rc = myButtonDialog(scalar @protected." pictures are write protected", $text, undef, 'OK', 'Cancel', 'Cancel All');

  if ($rc eq 'OK') {
	foreach (@protected) {
	  my $mode = (lstat $_)[2];  # get the actual access mode
	  $mode = $mode | 0200;      # set user write (+uw)
	  chmod($mode, $_);          # try to change the mode
	}
  }
  return $rc;
}

##############################################################
# bindMouseWheel - this won't be needed with Tk >= 804.025
##############################################################
sub bindMouseWheel {

  return if ($Tk::VERSION >= 804);
  print "activating mouse wheel\n" if $verbose;

  my($w) = @_;

  if ($^O eq 'MSWin32')
  {
    $w->bind('<MouseWheel>' =>
    [ sub { $_[0]->yview('scroll', -($_[1] / 120) * 3, 'units') },
    Ev('D') ]);
  }
  else
  {
    # Support for mousewheels on Linux commonly comes through
    # mapping the wheel to buttons 4 and 5.  If you have a
    # mousewheel ensure that the mouse protocol is set to
    # "IMPS/2" in your /etc/X11/XF86Config (or XF86Config-4)
    # file:
    #
    # Section "InputDevice"
    #     Identifier  "Mouse0"
    #     Driver      "mouse"
    #     Option      "Device" "/dev/mouse"
    #     Option      "Protocol" "IMPS/2"
    #     Option      "Emulate3Buttons" "off"
    #     Option      "ZAxisMapping" "4 5"
    # EndSection

    $w->bind('<4>' => sub {
      $_[0]->yview('scroll', -3, 'units') unless $Tk::strictMotif;
    });

    $w->bind('<5>' => sub {
      $_[0]->yview('scroll', +3, 'units') unless $Tk::strictMotif;
    });
  }

} # end BindMouseWheel

##############################################################
# diffPics - create a new picture containing the difference
#            between two pictures
##############################################################
sub diffPics {

  return if (!checkExternProgs("diffPics", "composite"));

  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 2, 2, \@sellist);

  my $dpicA    = $sellist[0];
  my $dpicB    = $sellist[1];
  my $dpicDiff = $dpicA;
  $dpicDiff    =~ s/(.*)(\.jp(g|eg))/$1-diff$2/i;   # pic.jpg -> pic-diff.jpg

  $dpicDiff    = dirname($dpicA).'/'.findNewName($dpicDiff); # pic-diff.jpg -> pic-diff-03.jpg

  $userinfo = "creating difference picture ..."; $userInfoL->update;
  #my $command = "composite -compose difference \"$dpicA\" \"$dpicB\" \"$dpicDiff\"";
  my $command = "convert \"$dpicA\" \"$dpicB\" -compose difference -composite -normalize \"$dpicDiff\"";
  print "diffPics: $command\n" if $verbose;
  $top->Busy;
  execute($command);
  $top->Unbusy;
  $userinfo = "ready! (difference picture created)"; $userInfoL->update;
  generateOneThumb($dpicDiff);
  # insert diff pic in listbox
  addOneRow($picLB, $dpicDiff, 1, $dpicA);
  #updateThumbs();
  showPic($dpicDiff);
}

##############################################################
# interpolatePics
##############################################################
sub interpolatePics {

  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);
  my $selected = @sellist;
  my ($pic, $dpic, $dirtpic, $i);

  return if (!interpolateDialog(scalar @sellist));

  return if (!checkExternProgs("interpolatePics", "jpegpixi"));

  $userinfo = "interpolating $selected pictures"; $userInfoL->update;

  # check if some files are links
  return if (!checkLinks($picLB, @sellist));

  my $pw = progressWinInit($top, "Interpolate pictures");
  $i = 0;
  foreach $dpic (@sellist) {
	last if progressWinCheck($pw);
	$i++;
	progressWinUpdate($pw, "interpolating ($i/$selected) ...", $i, $selected);
	$pic      = basename($dpic);
	$dirtpic  = "$dpic"."-cjpg"; # temporary file

	next if (!checkWriteable($dpic));
	next if (!makeBackup($dpic));

	# check if temp file exists
	next if (!checkTempFile($dirtpic));

	# call external command jpegpixi
	my $command = "jpegpixi -m ".$config{DeadPixelMethod}." \"$dpic\" \"$dirtpic\" ".$config{DeadPixelStr};
	execute($command);

	# now overwrite the original pic with the temp file and delete the temp file
	next if (!overwrite("$dpic", "$dirtpic"));

	if ($config{AddMapiviComment}) {
		$command =~ s/\"//g;
		$command = "Picture processed by Mapivi ($mapiviURL):\n".$command;
		addCommentToPic($command, $dpic, NO_TOUCH);
	}

	updateOneRow($dpic, $picLB);

	deleteCachedPics($dpic);
	showPic($dpic) if ($dpic eq $actpic); # redisplay the picture if it is the actual one
  }
  progressWinEnd($pw);
  reselect($picLB, @sellist);
  $userinfo = "ready! ($i of $selected interpolated)"; $userInfoL->update;
  generateThumbs(ASK, SHOW);
}

##############################################################
# interpolateDialog
##############################################################
sub interpolateDialog {

  if (Exists($interpW)) {
	$interpW->deiconify;
	$interpW->raise;
	return;
  }

  my $pics  = shift;
  if (!defined($pics)) {
	$pics = "";
  }
  else {
	$pics = "$pics ";
  }
  my $rc   = 0;
  my $deadpixels = $config{DeadPixelStr};
  my $method     = $config{DeadPixelMethod};

  # open window
  $interpW = $top->Toplevel();
  $interpW->title("Interploate pictures");
  $interpW->iconimage($mapiviicon) if $mapiviicon;

  $interpW->Label(-text => "Remove dead pixels from ${pics}pictures with Jpegpixi", -bg => $config{ColorBG})->pack(-anchor => 'w', -padx => 3, -pady => 3);

  $interpW->Label(-text => "This function should be called as first step when processing pictures\n(e.g. it must be called before rotating the pictures).", -bg => $config{ColorBG}, -justify => "left")->pack(-anchor => 'w', -padx => 3, -pady => 3);

  my $infotext = "Some Infos about Jpegpixi from the author (see: http://www.zero-based.org/software/jpegpixi/):

\"Jpegpixi is short for JPEG Pixel Interpolator. The intent of the program is to interpolate pixels (single pixels, dots, stripes) in JPEG images. This is useful to correct images from a digital camera with CCD defects. For example, if one pixel is always bright green, this pixel can be interpolated with jpegpixi.

Jpegpixi is unique in that it tries to preserve the quality of the JPEG image as much as possible. Usual graphics programs decode JPEG images when they are loaded, and re-encode them when they are saved, which results in an overall loss of quality. Jpegpixi, on the other hand, only decodes the DCT blocks (typically 88, 168, or 1616 pixel areas) which contain pixels to be interpolated, and when it re-encodes them, it uses exactly the same parameters with which the image has originally been encoded. These blocks are therefore only minimally disturbed, and other blocks remain pixel-by-pixel identical to the original image.

Usage: jpegpixi [OPTION]... SOURCE DEST [[D:]X,Y[,S]|[,SX,SY]]...

Pixel block specification:
  D     can be `V' or `v' (vertical 1D interpolation),
               `H' or `h' (horizontal 1D interpolation),
               `2'        (2D interpolation) [default];
  X,Y   specifies the top left corner of the pixel block to be interpolated;
  S     specifies the size of the block [default: 1];
  SX,SY specifies separate sizes for the X and Y direction.\"

The part: [OPTION] and [[D:]X,Y[,S]|[,SX,SY]]...
may be changed in this dialog, the rest (jpegpixi ... SOURCE DEST) will be done by MaPiVi.

Example:
If there are two dead pixels at the coordinates x=832 y=344 and x=1024 y=872 in your pictures, each of them 2 pixels wide and high, you should enter this string: \"832,344,2 1024,872,2\".
";

  my $metF = $interpW->Frame()->pack(-fill =>'x', -padx => 0, -pady => 0);
  $metF->Label(-text => "Interpolation method", -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w', -padx => 3, -pady => 3);

  my $methB = $metF->Optionmenu(-textvariable => \$method, -options => [qw(average linear quadratic cubic)] )->pack(-side => "left", -anchor => 'w', -padx => 3, -pady => 0);

  $interpW->Label(-text => "Pixel block specification", -bg => $config{ColorBG})->pack(-anchor => 'w', -padx => 3, -pady => 3);

  my $entry = $interpW->Entry(-textvariable => \$deadpixels,
							  -width => 70,
							 )->pack(-fill => 'x', -expand => "1", -padx => 3, -pady => 3);
  $entry->xview('end');
  $entry->icursor('end');

  buttonBackup($interpW, 'top');
  buttonComment($interpW, 'top');

  my $ButF = $interpW->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);

  my $OKB =	$ButF->Button(-text => 'OK',
						  -command => sub {
							$interpW->withdraw();
							$interpW->destroy();
							$config{DeadPixelMethod} = $method;
							$config{DeadPixelStr}    = $deadpixels;
							$rc = 1;
						  })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $ButF->Button(-text => "Help",
				  -command => sub {
					showText("Infos about Jpegpixi", $infotext, NO_WAIT);
				  })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  my $Xbut = $ButF->Button(-text => 'Cancel',
						   -command => sub { $rc = 0;
											 $interpW->withdraw();
											 $interpW->destroy();
										   })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $interpW->bind('<Key-q>',      sub { $Xbut->invoke; });
  $interpW->bind('<Key-Escape>', sub { $Xbut->invoke; });

  $interpW->Popup;
  $interpW->waitWindow;

  return $rc;
}

##############################################################
# fuzzyBorder - add a fuzzy border to the selected pics
##############################################################
sub fuzzyBorder {

  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);
  my $selected = @sellist;
  my ($dpic, $i);

  return if (!fuzzyBorderDialog());

  my $bw = $config{FuzzyBorderWidth};

  my $frame = "$trashdir/framePic.miff"; # we need MIFF or PNG because of the alpha channel
  removeFile($frame);

  return if (!checkExternProgs("fuzzyBorder", "convert", "composite"));

  $userinfo = "adding fuzzy border to $selected pictures"; $userInfoL->update;

  # check if some files are links
  return if (!checkLinks($picLB, @sellist));

  my $pw = progressWinInit($top, "Adding fuzzy border");
  $i = 0;
  foreach $dpic (@sellist) {
	last if progressWinCheck($pw);
	progressWinUpdate($pw, "creating border ($i/$selected) ...", $i, $selected);

	next if (!checkWriteable($dpic));
	next if (!makeBackup($dpic));

	# get size of pic
	my ($x, $y) = getSize($dpic);

	# create an empty picture with a fuzzy frame
	my $command = "convert -size ${x}x${y} xc:none -fill ".$config{FuzzyBorderColor}." ";
	#$command .= "-draw \'rectangle 0,0 $x,$bw\' ";            # upper
	#$command .= "-draw \'rectangle 0,".($y-$bw)." $x,$y\' ";  # lower
	#$command .= "-draw \'rectangle 0,0 $bw,$y\' ";   # left
	#$command .= "-draw \'rectangle ".($x-$bw).",0 $x,$y\' ";  # right border
    # windows needs " instead of '
	$command .= "-draw \"rectangle 0,0 $x,$bw\" ";            # upper
	$command .= "-draw \"rectangle 0,".($y-$bw)." $x,$y\" ";  # lower
	$command .= "-draw \"rectangle 0,0 $bw,$y\" ";   # left
	$command .= "-draw \"rectangle ".($x-$bw).",0 $x,$y\" ";  # right border
	$command .= "-blur 0x".$config{FuzzyBorderBlur}." \"$frame\" ";
	if (!$EvilOS) {
      execute($command);
    }
    else { # else we run in a timeout
      (system "$command") == 0 or warn "fuzzy frame: $command failed: $!";
    }

	unless (-f $frame) {
	  warn "fuzzyBorder: could not create fuzzy border, skipping $dpic!\n";
	  next;
	}

	progressWinUpdate($pw, "adding border ($i/$selected) ...", $i, $selected);

	# compose the frame on top of the picture
	$command = "composite -quality ".$config{PicQuality}." -compose Atop \"$frame\" \"$dpic\" \"$dpic\" ";
	if (!$EvilOS) {
      execute($command);
    }
    else { # else we run in a timeout
      (system "$command") == 0 or warn "fuzzy frame: $command failed: $!";
    }

	$i++;
	progressWinUpdate($pw, "adding border ($i/$selected) ...", $i, $selected);

	if ($config{AddMapiviComment}) {
		$command =~ s/\"//g;
		$command = "Picture processed by Mapivi ($mapiviURL):\n".$command;
		addCommentToPic($command, $dpic, NO_TOUCH);
	}
	updateOneRow($dpic, $picLB);

	deleteCachedPics($dpic);
	showPic($dpic) if ($dpic eq $actpic); # redisplay the picture if it is the actual one
  }
  progressWinEnd($pw);
  removeFile($frame);
  reselect($picLB, @sellist);
  $userinfo = "ready! (added fuzzy border to $i of $selected)"; $userInfoL->update;
  generateThumbs(ASK, SHOW);
}

##############################################################
# fuzzyBorderDialog
##############################################################
sub fuzzyBorderDialog {

  if (Exists($fuzzybw)) {
	$fuzzybw->deiconify;
	$fuzzybw->raise;
	return;
  }

  my $rc   = 0;

  # open window
  $fuzzybw = $top->Toplevel();
  $fuzzybw->title("Fuzzy border");
  $fuzzybw->iconimage($mapiviicon) if $mapiviicon;

  my $bS = labeledScale($fuzzybw, 'top', 23, "Border width (pixel)", \$config{FuzzyBorderWidth}, 1, 200, 1);
  my $fS = labeledScale($fuzzybw, 'top', 23, "Blur radius (pixel)", \$config{FuzzyBorderBlur}, 1, 200, 1);
  my $cB = labeledEntryColor($fuzzybw,'top',23,"Border color",'Set',\$config{FuzzyBorderColor});

  my $qS = labeledScale($fuzzybw, 'top', 23, "Quality of picture (%)", \$config{PicQuality}, 10, 100, 1);
  qualityBalloon($qS);
 
  buttonBackup($fuzzybw, 'top');
  buttonComment($fuzzybw, 'top');

  my $ButF = $fuzzybw->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);

  my $OKB =	$ButF->Button(-text => 'OK',
						  -command => sub {
							$fuzzybw->withdraw();
							$fuzzybw->destroy();
							$rc = 1;
						  })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  my $Xbut = $ButF->Button(-text => 'Cancel',
						   -command => sub { $rc = 0;
											 $fuzzybw->withdraw();
											 $fuzzybw->destroy();
										   })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $fuzzybw->bind('<Key-q>',      sub { $Xbut->invoke; });
  $fuzzybw->bind('<Key-Escape>', sub { $Xbut->invoke; });

  $fuzzybw->Popup;
  $fuzzybw->waitWindow;

  return $rc;
}

##############################################################
# losslessBorder - add a frame to the selected pics without
#                  recompressing the picture
##############################################################
sub losslessBorder {

  my $mode = shift;   # PIXEL, ASPECT_RATIO, RELATIVE (%)

  # check if jpegtran supports lossless dropping
  my $usage = `jpegtran -? 2>&1`;
  if ($usage !~ m/.*-drop.*/) {
	  $top->messageBox(-icon  => 'warning', -message => "Sorry, but your version of jpegtran does not support lossless dropping!\nTry to get jpegtran with the lossless drop patch from http://jpegclub.org.",
					   -title => "Wrong jpegtran version", -type => 'OK');
	  return;
  }

  return if (!checkExternProgs("losslessBorder", "convert"));

  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);
  my $selected = @sellist;
  my ($dpic, $i);
  my $aspectdelta = 1 + ($config{AspectSloppyFactor} / 100);  # delta factor for aspect ratio
  my $info = '';

  my $bix = 0; # inner width X
  my $biy = 0; # inner width Y
  my $bwx = 0; # complete width X
  my $bwy = 0; # complete width Y

  if ($mode == PIXEL) {
    my ($w, $h) = getSize($sellist[0]); # get size of first picture
    return if (!losslessBorderDialogPixel($w, $h));
    $bix = $config{llBorderWidthIX}; # inner width X
    $biy = $config{llBorderWidthIY}; # inner width Y
    $bwx = $config{llBorderWidthX};  # complete width X
    $bwy = $config{llBorderWidthY};  # complete width Y
    # no frame width-> nothing to do.
    return if ($bwx == 0 and $bwy == 0);
  }
  elsif ($mode == ASPECT_RATIO) {
    return if (!losslessBorderDialogAspect());
  }
  elsif ($mode == RELATIVE) {
    return if (!losslessBorderDialogRelative());
  }
  else {
    warn "Sorry mode $mode is not supported!";
    return;
  }

  my $frame = "$trashdir/framePic.jpg";
  if (-f $frame) {
	warn "file $frame exists! Please delete it first!";
	return;
  }

  $userinfo = "adding lossless border to $selected pictures"; $userInfoL->update;

  # check if some files are links
  return if (!checkLinks($picLB, @sellist));

  my $pw = progressWinInit($top, "Adding lossless border");
  $i = 0;
  foreach $dpic (@sellist) {
	last if progressWinCheck($pw);
	$i++;
	progressWinUpdate($pw, "adding border ($i/$selected) ...", $i, $selected);

	if ($mode == ASPECT_RATIO) {
      # get size of dpic
      my ($w, $h) = getSize($dpic);
      my $n = $config{AspectBorderN};
      my $m = $config{AspectBorderM};

      # skip pictures which have (nearly) the right aspect ratio (either n/m or m/n)
      # and be a little bit sloppy about this (aspectdelta)      
      if (((($w/$h) <= ($n/$m)*$aspectdelta) and (($w/$h) >= ($n/$m)/$aspectdelta)) or
         ((($w/$h) <= ($m/$n)*$aspectdelta) and (($w/$h) >= ($m/$n)/$aspectdelta))) {
         $info .= "$dpic has correct aspect ratio - skipping\n";
         next;
      }

      if ($w > $h) { # landscape picture
        if ($w > $h*$n/$m) { # panorama picture (too wide)
          $bwx = 0;
          $bwy = int(($w*$m/$n -$h)/2);
        }
        elsif ($w < $h*$n/$m) { # too narrow
          $bwx = int(($h*$n/$m -$w)/2);
          $bwy = 0;
        }
        else { # already right aspect ratio
          next;
        }
      }
      else { # portrait and square picture
        if ($w > $h*$m/$n) { # panorama picture (too small)
          $bwx = 0;
          $bwy = int(($w*$n/$m -$h)/2);
        }
        elsif ($w < $h*$m/$n){ # too tall
          $bwx = int(($h*$m/$n -$w)/2);
          $bwy = 0;
        }
        else { # already right aspect ratio
          $info .= "$dpic has correct aspect ratio - skipping\n";
          next;
        }
      }
      # we need 16 pixel steps for the complete border width
      $bwx = sprintf("%.0f", $bwx / 16) * 16; # int() does not round!
      $bwy = sprintf("%.0f", $bwy / 16) * 16;

    }

    # add a border relative to the picture size
	if ($mode == RELATIVE) {
      # get size of dpic
      my ($w, $h) = getSize($dpic);
      
      # we need 16 pixel steps for the complete border width
      $bwx = sprintf("%.0f",($config{RelativeBorderX}  * $w / (100 * 16))) * 16; # int() does not round!
      $bwy = sprintf("%.0f",($config{RelativeBorderY}  * $h / (100 * 16))) * 16;

      if (($bwx == 0) and ($bwy == 0)) {
         $info .= "$dpic border would be 0 pixel - skipping\n";
         next;
      }

      $bix = sprintf("%.0f",($config{RelativeBorderIX} * $w / 100));
      $biy = sprintf("%.0f",($config{RelativeBorderIY} * $h / 100));

      # correction: add at least one pixel
      #$bwx = 1 if ($config{RelativeBorderX}  > 0 and $bwx == 0);
      #$bwy = 1 if ($config{RelativeBorderY}  > 0 and $bwy == 0);
      $bix = 1 if ($config{RelativeBorderIX} > 0 and ($bix == 0));
      $biy = 1 if ($config{RelativeBorderIY} > 0 and ($biy == 0));
      
      if ($config{RelativeBorderEqual}) {
        $bix = $biy if ($biy > $bix);
        $biy = $bix;
        $bwx = $bwy if ($bwy > $bwx);
        $bwy = $bwx;
      }
    }

	next if (!checkWriteable($dpic));
	next if (!makeBackup($dpic));
	
    # approach 1:
	# create an empty picture with a frame
    # this is the better approach as a new background is generated, but something with the color resolution(?) is wrong
    # because when the other picture is dropped on this one jpegtran changes the whole picture to grayscale
	#my $command = "convert -size ${cx}x${cy} xc:\"".$config{llBorderColor}."\" -fill \"".$config{llBorderColorI}."\" ";
	#$command .= "-draw \'rectangle $r1,$r1 $rx2,$ry2\' -quality 95 \"$frame\" ";

    # approach 2:
    # add a lossy frame to the original picture
    # not the fastes way, but it works
    my $box = $bwx - $bix; # outer border width
    my $boy = $bwy - $biy; # outer border width

	#print "losslessBorder: bwx $bwx bwy $bwy box $box boy $boy bix $bix biy $biy\n";

	my $command = "convert ";
	$command .= "-bordercolor \"".$config{llBorderColorI}."\" -border ${bix}x${biy} " if (($bix > 0) or ($biy > 0));
	$command .= "-bordercolor \"".$config{llBorderColor}."\" -border ${box}x${boy} -quality 95 \"$dpic\" \"$frame\" ";
	execute($command);

	unless (-f $frame) {
	  $info .= "$dpic: could not create lossless border - skipping\n";
	  next;
	}

	progressWinUpdate($pw, "adding border ($i/$selected) ...", $i, $selected);

	# drop the picture lossless! on top of the frame
    # no recompression of the picture!
	$command = "jpegtran -copy all -drop +${bwx}+${bwy} \"$dpic\" -outfile \"$dpic\" \"$frame\" ";
	execute($command);

	if ($config{AddMapiviComment}) {
		$command =~ s/\"//g;
		$command = "Picture processed by Mapivi ($mapiviURL):\n".$command;
		addCommentToPic($command, $dpic, NO_TOUCH);
	}
	updateOneRow($dpic, $picLB);

	deleteCachedPics($dpic);
	showPic($dpic) if ($dpic eq $actpic); # redisplay the picture if it is the actual one
  }
  progressWinEnd($pw);
  removeFile($frame);
  reselect($picLB, @sellist);
  $userinfo = "ready! (added lossless border to $i of $selected)"; $userInfoL->update;
  if ($info ne '') {
	showText('Add Border Information', $info, NO_WAIT);
  }

  generateThumbs(ASK, SHOW);
}

##############################################################
# losslessBorderDialogPixel
##############################################################
sub losslessBorderDialogPixel {

  my $w = shift;  # pixel size of first selcted picture for preview
  my $h = shift;

  if (Exists($ll_b_w)) {
	$ll_b_w->deiconify;
	$ll_b_w->raise;
	return;
  }

  my $rc = 0;

  # open window
  $ll_b_w = $top->Toplevel();
  $ll_b_w->title("Add lossless border");
  $ll_b_w->iconimage($mapiviicon) if $mapiviicon;

  my $fb  = $ll_b_w->Frame(-relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3);
  $balloon->attach($fb, -msg => "This is the overall width of the border in x- and y-direction.\nAs JPEGs are organized in 8 or 16 pixel blocks only 16 pixel-steps are allowed.\nUse the add-border function if you need other sizes.");
  my $fbi = $ll_b_w->Frame(-relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3);
  $balloon->attach($fbi, -msg => "This is the width of the inner border in x- and y-direction.\nSet to 0 for no inner border.");
  labeledScale($fb, 'top', 35, "Complete border width x-direction", \$config{llBorderWidthX}, 0, 1000, 16);
  labeledScale($fb, 'top', 35, "Complete border width y-direction", \$config{llBorderWidthY}, 0, 1000, 16);
  labeledEntryColor($fb,'top',35,"Border color",'Set',\$config{llBorderColor});
  labeledScale($fbi, 'top', 35, "Inner border width x-direction", \$config{llBorderWidthIX}, 0, 1000, 1);
  labeledScale($fbi, 'top', 35, "Inner border width y-direction", \$config{llBorderWidthIY}, 0, 1000, 1);
  labeledEntryColor($fbi,'top',35,"Inner border color",'Set',\$config{llBorderColorI});

  buttonBackup($ll_b_w, 'top');
  buttonComment($ll_b_w, 'top');

  my $preF = $ll_b_w->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
  $preF->Label(-text => 'Preset ')->pack(-side => 'left');
  $preF->Button(-text => '1 B/W',
                -command => sub {$config{llBorderWidthX}  = 100;
                                 $config{llBorderWidthY}  = 100;
                                 $config{llBorderColor}   = 'black';
                                 $config{llBorderWidthIX} = 2;
                                 $config{llBorderWidthIY} = 2;
                                 $config{llBorderColorI}  = 'white'; })->pack(-side => 'left');
  $preF->Button(-text => '2 W/B',
                -command => sub {$config{llBorderWidthX}  = 100;
                                 $config{llBorderWidthY}  = 100;
                                 $config{llBorderColor}   = 'white';
                                 $config{llBorderWidthIX} = 2;
                                 $config{llBorderWidthIY} = 2;
                                 $config{llBorderColorI}  = 'black'; })->pack(-side => 'left');
  $preF->Button(-text => '3 P W/B',
                -command => sub {$config{llBorderWidthX}  = 0;
                                 $config{llBorderWidthY}  = 100;
                                 $config{llBorderColor}   = 'white';
                                 $config{llBorderWidthIX} = 0;
                                 $config{llBorderWidthIY} = 2;
                                 $config{llBorderColorI}  = 'black'; })->pack(-side => 'left');
  $preF->Button(-text => '4 P B/W',
                -command => sub {$config{llBorderWidthX}  = 0;
                                 $config{llBorderWidthY}  = 100;
                                 $config{llBorderColor}   = 'black';
                                 $config{llBorderWidthIX} = 0;
                                 $config{llBorderWidthIY} = 2;
                                 $config{llBorderColorI}  = 'white'; })->pack(-side => 'left');

  my $ButF = $ll_b_w->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);

  my $OKB =	$ButF->Button(-text => 'OK',
						  -command => sub {
						    # some checks
						    if (($config{llBorderWidthIX} > $config{llBorderWidthX}) or
						        ($config{llBorderWidthIY} > $config{llBorderWidthY})) {
	                            $ll_b_w->messageBox(-icon => 'warning',
					              -message => 'The inner border must be smaller than the complete border.',
					              -title => 'Lossess border - Error', -type => 'OK');
						        return;
						    }
							$ll_b_w->withdraw();
							$ll_b_w->destroy();
							$rc = 1;
						  })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $ButF->Button(-text => 'Preview',
	    -command => sub {
		    # some checks
			    if (($config{llBorderWidthIX} > $config{llBorderWidthX}) or
			        ($config{llBorderWidthIY} > $config{llBorderWidthY})) {
                           $ll_b_w->messageBox(-icon => 'warning',
			              -message => 'The inner border must be smaller than the complete border.',
			              -title => 'Lossess border - Error', -type => 'OK');
				        return;
					    }
                       border_preview($w, $h, $config{llBorderWidthX}, $config{llBorderWidthY}, $config{llBorderColor}, $config{llBorderWidthIX}, $config{llBorderWidthIY}, $config{llBorderColorI});
					  })->pack(-side => 'left', -padx => 3, -pady => 3);

  $ButF->Button(-text => 'Help',
				-command => sub {
                 showText('Help for lossless border',
                 "This function can be used to add a border to a JPEG without losing quality due to recompressing.\n\nHow it works:\nIt will first create a background with the border and then drop the original picture on top of it. The picture is not recompressed and thus every pixel stays exactly the same. The tool jpegtran with the lossless drop patch is used for this task. See http://jpegclub.org.\n\nYou can check this by adding a border to a picture (don't forget to save the original picture by selecting \"Create Backup\") then you crop the border away and compare the original and the processed picture using the Mapivi function \"build difference picture\". If the resulting difference picture is complety black no pixel was changed.\nYou may check this again with a lossy border to see the differences.", 
                 NO_WAIT);
				})->pack(-side => 'left', -expand => 0, -padx => 3, -pady => 3);

  my $Xbut = $ButF->Button(-text => 'Cancel',
						   -command => sub { $rc = 0;
											 $ll_b_w->withdraw();
											 $ll_b_w->destroy();
										   })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $ll_b_w->bind('<Key-q>',      sub { $Xbut->invoke; });
  $ll_b_w->bind('<Key-Escape>', sub { $Xbut->invoke; });

  $ll_b_w->Popup;
  $ll_b_w->waitWindow;

  return $rc;
}

##############################################################
# border_preview - quick preview in correct proportions, but
#                  without rescaling the real picture (would
#                  take too much time).
##############################################################
sub border_preview {

  my $w = shift; # picture size
  my $h = shift;
  my $bx = shift; # complete border size
  my $by = shift;
  my $bc = shift; # border color
  my $bix = shift; # inner border size
  my $biy = shift;
  my $bic = shift; # inner border color
  my $c; # Canvas

  unless (Exists($bpw)) {
    # open window
    $bpw = $top->Toplevel();
    $bpw->title('Border Preview');
    $bpw->iconimage($mapiviicon) if $mapiviicon;

    my $fa = $bpw->Frame(-relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3);

    $bpw->{c} = $fa->Canvas(-width  => 100,
                     -height => 100,
		     -background => 'gray',
		     -relief => 'sunken',
		     )->pack(-padx => 3, -pady => 3);

    my $Xbut = $bpw->Button(-text => 'Close',
	                    -command => sub { $bpw->withdraw();
				  	      $bpw->destroy();
 		   })->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  }

  $bpw->deiconify;
  $bpw->raise;

  my $wc = $w + 2 * $bx; # complete width
  my $hc = $h + 2 * $by; # complete height
  
  # clear canvas
  $bpw->{c}->delete('all');

  my $per = 0.8; # preview canvas should be 80% of the min screen size
  my $preview_size = int($per * $top->screenwidth);
  $preview_size = int($per * $top->screenheight) if ($top->screenheight < $top->screenwidth);

  my $max_side = $wc; $max_side = $hc if ($hc > $wc); # longest side
  if ($max_side == 0) { warn "border_preview: Error max_side = $max_side"; return; }
  
  my $scale = $preview_size / $max_side;
  
  $scale = 1 if ($scale > 1); # we don't want to magnify small pictures

  $bpw->{c}->configure(-width  => sprintf("%.0f",($wc*$scale)),
                -height => sprintf("%.0f",($hc*$scale)),);


  # outer border
  $bpw->{c}->createRectangle( 0, 0, sprintf("%.0f",($wc*$scale)), sprintf("%.0f",($hc*$scale)),
		       -fill => $bc,
                       -width => 0,
	             );

  # inner border
  if (($bix > 0) or ($biy > 0)) {
    $bpw->{c}->createRectangle( sprintf("%.0f",(($bx-$bix)*$scale)), sprintf("%.0f",(($by-$biy)*$scale)), sprintf("%.0f",(($bx+$w+$bix)*$scale)), sprintf("%.0f",(($by+$h+$biy)*$scale)),
		       -fill => $bic,
                       -width => 0,
	             );
  }

  # picture
  $bpw->{c}->createRectangle( sprintf("%.0f",($bx*$scale)), sprintf("%.0f",($by*$scale)), sprintf("%.0f",(($bx+$w)*$scale)), sprintf("%.0f",(($by+$h)*$scale)),
		       -fill => 'gray50',
                       -width => 0,
	             );

  my $font = $top->Font(-family => $config{FontFamily}, -size => 40, -weight => 'bold');
  $bpw->{c}->createText(int(($bx+$w/2)*$scale), int(($by+$h/2)*$scale), -text => 'Picture', -fill => 'black', -font => $font, -anchor => 'c');

}

##############################################################
# losslessBorderDialogRelative
##############################################################
sub losslessBorderDialogRelative {

  if (Exists($ll_r_w)) {
	$ll_r_w->deiconify;
	$ll_r_w->raise;
	return;
  }

  my $rc   = 0;

  # open window
  $ll_r_w = $top->Toplevel();
  $ll_r_w->title("Add relative border (lossless)");
  $ll_r_w->iconimage($mapiviicon) if $mapiviicon;

  my $fb  = $ll_r_w->Frame(-relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3);
  $balloon->attach($fb, -msg => "This is the overall width of the border in x- and y-direction.\nAs JPEGs are organized in 8 or 16 pixel blocks only 16 pixel-steps are allowed.\nUse the add-border function if you need other sizes.");
  my $fbi = $ll_r_w->Frame(-relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3);
  $balloon->attach($fbi, -msg => "This is the width of the inner border in x- and y-direction.\nSet to 0 for no inner border.");
  labeledScale($fb, 'top', 37, "Complete border width x-direction (%)", \$config{RelativeBorderX}, 0, 100, 0.1);
  labeledScale($fb, 'top', 37, "Complete border width y-direction (%)", \$config{RelativeBorderY}, 0, 100, 0.1);
  labeledEntryColor($fb,'top',37,"Border color",'Set',\$config{llBorderColor});
  labeledScale($fbi, 'top', 37, "Inner border width x-direction (%)", \$config{RelativeBorderIX}, 0, 100, 0.01);
  labeledScale($fbi, 'top', 37, "Inner border width y-direction (%)", \$config{RelativeBorderIY}, 0, 100, 0.01);
  labeledEntryColor($fbi,'top',37,"Inner border color",'Set',\$config{llBorderColorI});

  $ll_r_w->Checkbutton(-text => 'Symmetric border (biggest wins)', -variable => \$config{RelativeBorderEqual})->pack(-anchor => 'w', -padx => 5, -pady => 5);

  buttonBackup($ll_r_w, 'top');
  buttonComment($ll_r_w, 'top');

  my $ButF = $ll_r_w->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);

  my $OKB =	$ButF->Button(-text => 'OK',
						  -command => sub {
						    # some checks
						    if (($config{RelativeBorderIX} > $config{RelativeBorderX}) or
						        ($config{RelativeBorderIY} > $config{RelativeBorderY})) {
	                            $ll_r_w->messageBox(-icon => 'warning',
					              -message => 'The inner border must be smaller than the complete border.',
					              -title => 'Lossess border - Error', -type => 'OK');
						        return;
						    }
							$ll_r_w->withdraw();
							$ll_r_w->destroy();
							$rc = 1;
						  })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $ButF->Button(-text => 'Help',
				-command => sub {
                 showText('Help for relative border (lossless)',
                 "This function can be used to add a border to a JPEG without losing quality due to recompressing.\nThe actual border width in pixel will be calculated depending on the picture size. As JPEGs are organized in 8 or 16 pixel blocks the complete border width will be in 16 pixel-steps.\nThe inner border may be have any width, set it to 0 to have just one frame. If the inner border is bigger than 0, then it will be at least one pixel.\n\nHow it works:\nIt will first create a background with the border and then drop the original picture on top of it. The picture is not recompressed and thus every pixel stays exactly the same. The tool jpegtran with the lossless drop patch is used for this task. See http://jpegclub.org.\n\nYou can check this by adding a border to a picture (don't forget to save the original picture by selecting \"Create Backup\") then you crop the border away and compare the original and the processed picture using the Mapivi function \"build difference picture\". If the resulting difference picture is complety black no pixel was changed.\nYou may check this again with a lossy border to see the differences.", 
                 NO_WAIT);
				})->pack(-side => 'left', -expand => 0, -padx => 3, -pady => 3);

  my $Xbut = $ButF->Button(-text => 'Cancel',
						   -command => sub { $rc = 0;
											 $ll_r_w->withdraw();
											 $ll_r_w->destroy();
										   })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $ll_r_w->bind('<Key-q>',      sub { $Xbut->invoke; });
  $ll_r_w->bind('<Key-Escape>', sub { $Xbut->invoke; });

  $ll_r_w->Popup;
  $ll_r_w->waitWindow;

  return $rc;
}

##############################################################
# losslessBorderDialogAspect
##############################################################
sub losslessBorderDialogAspect {

  if (Exists($ll_a_w)) {
	$ll_a_w->deiconify;
	$ll_a_w->raise;
	return;
  }

  my $rc   = 0;

  # open window
  $ll_a_w = $top->Toplevel();
  $ll_a_w->title("Add border to aspect ratio (lossless)");
  $ll_a_w->iconimage($mapiviicon) if $mapiviicon;
  
  my $oF = $ll_a_w->Frame(-relief => 'groove')->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  $oF->Label(-text => 'Aspect ratio ')->pack(-side => 'left', -padx => 3, -pady => 3);
  $oF->Entry(-textvariable => \$config{AspectBorderN}, -width => 5, -justify => 'right')->pack(-side => 'left', -padx => 3, -pady => 3);
  $oF->Label(-text => ':')->pack(-side => 'left', -padx => 3, -pady => 3);
  $oF->Entry(-textvariable => \$config{AspectBorderM}, -width => 5)->pack(-side => 'left', -padx => 3, -pady => 3);
  #labeledEntry($oF,'left',17,': Aspect ratio M',\$config{AspectBorderM});

  my $aF = $ll_a_w->Frame(-relief => 'groove')->pack(-padx => 3, -pady => 3);
  $aF->Label(-text => 'Presets')->pack();
  $aF->Button(-text => "3:2 (e.g. 10x15)", -anchor => 'w',
			  -command => sub { $config{AspectBorderN} = 3; $config{AspectBorderM} = 2; }
			 )->pack(-anchor => 'w', -fill => 'x', -padx => 3, -pady => 3);
  $aF->Button(-text => "4:3", -anchor => 'w',
			  -command => sub { $config{AspectBorderN} = 4; $config{AspectBorderM} = 3; }
			 )->pack(-anchor => 'w', -fill => 'x', -padx => 3, -pady => 3);  
  $aF->Button(-text => "5:4 (PAL)", -anchor => 'w',
			  -command => sub { $config{AspectBorderN} = 5; $config{AspectBorderM} = 4; }
			 )->pack(-anchor => 'w', -fill => 'x', -padx => 3, -pady => 3); 
  $aF->Button(-text => "7:5 (e.g. 13x18)", -anchor => 'w',
			  -command => sub { $config{AspectBorderN} = 7; $config{AspectBorderM} = 5; }
			 )->pack(-anchor => 'w', -fill => 'x', -padx => 3, -pady => 3);
  $aF->Button(-text => "16:9", -anchor => 'w',
			  -command => sub { $config{AspectBorderN} = 16; $config{AspectBorderM} = 9; }
			 )->pack(-anchor => 'w', -fill => 'x', -padx => 3, -pady => 3);
  $aF->Button(-text => "1:1", -anchor => 'w',
			  -command => sub { $config{AspectBorderN} = 1; $config{AspectBorderM} = 1; }
			 )->pack(-anchor => 'w', -fill => 'x', -padx => 3, -pady => 3);

  labeledEntryColor($ll_a_w,'top',12,'Border color','Set',\$config{llBorderColor});

  buttonBackup($ll_a_w, 'top');
  buttonComment($ll_a_w, 'top');

  my $ButF = $ll_a_w->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);

  my $OKB =	$ButF->Button(-text => 'OK',
						  -command => sub {
						    # some checks
						    if (($config{AspectBorderM} !~ m|^\d+$|) or  # must be an integer
						        ($config{AspectBorderN} !~ m|^\d+$|)) {
	                            $ll_a_w->messageBox(-icon => 'warning',
					              -message => 'Aspect ratio must be a natural number',
					              -title => 'Aspect ratio border - Error', -type => 'OK');
						        return;
						    }
						    if (($config{AspectBorderM} <= 0) or
						        ($config{AspectBorderN} <= 0)) {
	                            $ll_a_w->messageBox(-icon => 'warning',
					              -message => 'Aspect ratio must be positive and bigger than 0',
					              -title => 'Aspect ratio border - Error', -type => 'OK');
						        return;
						    }
							$ll_a_w->withdraw();
							$ll_a_w->destroy();
							$rc = 1;
						  })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $ButF->Button(-text => 'Help',
				-command => sub {
                 showText('Help for lossless aspect ratio border',
                 "This function can be used to add a border to a JPEG to fit the selected aspect ratio without losing quality due to recompressing.\nAs JPEGs are organized in 8 or 16 pixel blocks the complete border width will be in 16 pixel-steps. Thus the resulting picture will not always match the selected aspect ratio.\n\nHow it works:\nIt will first create a background with the border and then drop the original picture on top of it. The picture is not recompressed and thus every pixel stays exactly the same. The tool jpegtran with the lossless drop patch is used for this task. See http://jpegclub.org.\n\nYou can check this by adding a border to a picture (don't forget to save the original picture by selecting \"Create Backup\") then you crop the border away and compare the original and the processed picture using the Mapivi function \"build difference picture\". If the resulting difference picture is complety black no pixel was changed.\nYou may check this again with a lossy border to see the differences.", 
                 NO_WAIT);
				})->pack(-side => 'left', -expand => 0, -padx => 3, -pady => 3);

  my $Xbut = $ButF->Button(-text => 'Cancel',
						   -command => sub { $rc = 0;
											 $ll_a_w->withdraw();
											 $ll_a_w->destroy();
										   })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $ll_a_w->bind('<Key-q>',      sub { $Xbut->invoke; });
  $ll_a_w->bind('<Key-Escape>', sub { $Xbut->invoke; });

  $ll_a_w->Popup;
  $ll_a_w->waitWindow;

  return $rc;
}

##############################################################
# losslessWatermark - add a watermark to the selected pics
#                     without recompressing the whole picture
##############################################################
sub losslessWatermark {

  # check if jpegtran supports lossless dropping
  my $usage = `jpegtran -? 2>&1`;
  if ($usage !~ m/.*-drop.*/) {
	  $top->messageBox(-icon  => 'warning', -message => "Sorry, but your version of jpegtran does not support lossless dropping!\nTry to get jpegtran with the lossless drop patch from http://jpegclub.org.",
					   -title => "Wrong jpegtran version", -type => 'OK');
	  return;
  }

  # todo:
  # 1. Select a part of the picture with e.g. the crop dialog
  # 2. Select a font and size and enter a text
  # 3. crop the selected part out of the picture
  # 4. add the text to the crop:
  #    convert crop.jpg -pointsize 120 -fill white -gravity center
  #            -annotate 0 'Mapivi' -quality 95 crop2.jpg
  # 5. lossless drop the crop at the same position

  # benefit: as color sampling is from original picture there should
  #          be no problem with lossless drop

  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist);
  my $selected = @sellist;
  my ($dpic, $i);

  return if (!losslessWatermarkDialog());

  my $wmx = $config{llWatermarkX}; # X position
  my $wmy = $config{llWatermarkY}; # Y position
  my $file = $config{llWatermarkFile}; # the picture to add

  # get size of watermark pic
  my ($wmw, $wmh) = getSize($file);

  $userinfo = "adding lossless watermark to $selected pictures"; $userInfoL->update;

  # check if some files are links
  return if (!checkLinks($picLB, @sellist));

  my $error = '';
  my $pw = progressWinInit($top, "Adding lossless watermark");
  $i = 0;
  foreach $dpic (@sellist) {
	last if progressWinCheck($pw);
	progressWinUpdate($pw, "adding watermark ($i/$selected) ...", $i, $selected);

	next if (!checkWriteable($dpic));
	next if (!makeBackup($dpic));

    # todo: either just drop a existing pic or
    # 1. crop a part of the picture -> cropPic($dpic,$w,$h,$x,$y,95);
    # 2. write a text on this crop -> convert crop.jpg -pointsize 50 -gravity south -stroke '#000C' -strokewidth 2 -annotate 0 'Martin' -stroke none -fill white -annotate 0 'Martin' crop-text.jpg
    # 3. drop it back on the same position
 
    # get size of pic
    my ($w, $h) = getSize($dpic);

    if (($wmx + $wmw > $w) or ($wmy + $wmh > $h)) {
      $error .= "$dpic: watermark out of picture - skipped\n";
      next;
    }

	# drop the watermark lossless! on top of the picture
    # no recompression of the picture!
    my $position = '';
    if ($wmx >= 0) { $position = "+"; }
    $position .= $wmx;
    if ($wmy >= 0) { $position .= "+"; }
    $position .= $wmy;
    
    # todo: still unclear what the -trim and -perfect switch does
	#my $command = "jpegtran -copy all -trim -perfect -drop $position \"$file\" -outfile \"$dpic\" \"$dpic\" ";
	my $command = "jpegtran -copy all -drop $position \"$file\" -outfile \"$dpic\" \"$dpic\" ";
	execute($command);

	$i++;
	progressWinUpdate($pw, "adding watermark ($i/$selected) ...", $i, $selected);

	if ($config{AddMapiviComment}) {
		$command =~ s/\"//g;
		$command = "Picture processed by Mapivi ($mapiviURL):\n".$command;
		addCommentToPic($command, $dpic, NO_TOUCH);
	}
	updateOneRow($dpic, $picLB);

	deleteCachedPics($dpic);
	showPic($dpic) if ($dpic eq $actpic); # redisplay the picture if it is the actual one
  }
  progressWinEnd($pw);
  if ($error ne '') {
    $error = "Some pictures caused errors:\n\n".$error;
	showText('Watermark errors', $error, NO_WAIT);
  }
  reselect($picLB, @sellist);
  $userinfo = "ready! (added lossless watermark to $i of $selected)"; $userInfoL->update;
  generateThumbs(ASK, SHOW);
}

##############################################################
# losslessWatermarkDialog
##############################################################
sub losslessWatermarkDialog {

  if (Exists($ll_w_w)) {
	$ll_w_w->deiconify;
	$ll_w_w->raise;
	return;
  }

  my $rc   = 0;

  # open window
  $ll_w_w = $top->Toplevel();
  $ll_w_w->title("Add lossless watermark");
  $ll_w_w->iconimage($mapiviicon) if $mapiviicon;

  #$balloon->attach($fb, -msg => "This is the overall width of the border in x- and y-direction.\nAs JPEGs are organized in 8 or 16 pixel blocks only 16 pixel-steps are allowed.\nUse the add-border function if you need other sizes.");

  labeledEntry($ll_w_w,'top',35,"x-position",\$config{llWatermarkX});
  labeledEntry($ll_w_w,'top',35,"y-position",\$config{llWatermarkY});
  labeledEntryButton($ll_w_w,'top',35,"Watermark picture (JPEG)",'Set', \$config{llWatermarkFile});

  buttonBackup($ll_w_w, 'top');
  buttonComment($ll_w_w, 'top');

  my $ButF = $ll_w_w->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);

  my $OKB =	$ButF->Button(-text => 'OK',
						  -command => sub {
						    # some checks
						    unless (-f $config{llWatermarkFile}) {
						      $ll_w_w->messageBox(-icon => 'warning',
					              -message => 'The watermark picture could not be found.',
					              -title => 'File not found', -type => 'OK');
                              return;
						    }
						    unless (is_a_JPEG($config{llWatermarkFile})) {
						      $ll_w_w->messageBox(-icon => 'warning',
					              -message => 'The watermark picture is no JPEG.',
					              -title => 'File not found', -type => 'OK');
                              return;
						    }
							$ll_w_w->withdraw();
							$ll_w_w->destroy();
							$rc = 1;
						  })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  # todo
  $ButF->Button(-text => 'Help',
				-command => sub {
                 showText('Help for lossless watermark',
                 "This function can be used to add a watermark (small graphic) to a JPEG without losing quality due to recompressing.\n\nHow it works:\nIt will drop the rectangular small watermark picture on top of the original picture. The picture is not recompressed and thus every pixel stays exactly the same. Both pictures must have the same JPEG sampling factors!\nThe tool jpegtran with the lossless drop patch is used for this task. See http://jpegclub.org.\n\nYou can check this by adding a watermark to a picture (don't forget to save the original picture by selecting \"Create Backup\") then you compare the original and the processed picture using the Mapivi function \"build difference picture\". If the resulting difference picture is complety black (except where the watermark was added) no pixel was changed.", 
                 NO_WAIT);
				})->pack(-side => 'left', -expand => 0, -padx => 3, -pady => 3);

  my $Xbut = $ButF->Button(-text => 'Cancel',
						   -command => sub { $rc = 0;
											 $ll_w_w->withdraw();
											 $ll_w_w->destroy();
										   })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $ll_w_w->bind('<Key-q>',      sub { $Xbut->invoke; });
  $ll_w_w->bind('<Key-Escape>', sub { $Xbut->invoke; });

  $ll_w_w->Popup;
  $ll_w_w->waitWindow;

  return $rc;
}

##############################################################
# importWizard
##############################################################
sub importWizard {

  if (Exists($wizW)) {
	$wizW->deiconify;
	$wizW->raise;
	return;
  }

  my $pics = shift;
  my $rc   = 0;

  # open window
  $wizW = $top->Toplevel();
  $wizW->title("Import pictures wizard");
  $wizW->iconimage($mapiviicon) if $mapiviicon;

  my $i_text = $wizW->Scrolled("ROText",
							-scrollbars => 'osoe',
							-wrap => 'word',
							-width => 70,
							-height => 5,
							-relief => "flat",
							-bd => 0
						   )->pack(-fill => 'both', -expand => "0", -padx => 3, -pady => 3);
  $i_text->insert('end', "Import pictures from a removable device like e.g. a camera or a card reader connected via e.g. USB.\nThe selected actions will take place in the displayed order.\nMapivi is rather paranoid when importing pictures to be on the safe side.\nIf there are any errors during import (like a mismatch in the number of files or file size) you will be asked how to proceed.");


  my ($s,$m,$ho,$d,$mo,$y) = localtime(time());
  # do some adjustments
  $y += 1900; $mo++;
  # build up the date string for the dir structure (e.g. "2007/10/29")
  my $date = sprintf "%04d/%02d/%02d", $y, $mo, $d;

  my $w  = 32;
  my $w2 = $w - 3;


  labeledEntryButton($wizW,'top',$w,"Source folder",'Set',\$config{ImportSource}, 1);
  $wizW->Checkbutton(-variable => \$config{ImportSubdirs},
					 -anchor   => 'w',
					 -text     => "Import from all sub folders, too"
					)->pack(-side => 'top', -anchor => 'w', -padx => 3, -pady => 3);
  labeledEntryButton($wizW,'top',$w,"Target folder (fix part)",'Set',\$config{ImportTargetFix}, 1);
  my $varF = $wizW->Frame()->pack(-anchor => 'w', -fill => 'x');
  labeledEntry($varF,"left",$w,"Target folder (variable part)",\$config{ImportTargetVar});
  $varF->Button(-text => 'Set' , -command => sub {$config{ImportTargetVar} = $date;})->pack(-side => "right", -padx => 3, -pady => 3);
  $varF->Label(-text => "actual date:",
			   -anchor   => "e",
			   -bg => $config{ColorBG})->pack(-side => "right", -anchor => 'w', -padx => 3, -pady => 3);

  my $moreF = $wizW->Frame(-relief => 'groove');
  
  my $more_button;

  $more_button = $wizW->Checkbutton(-variable => \$config{ImportMore},
                      -anchor => 'w',
                      -text => 'more options',
                      -command => sub {
                        if ($config{ImportMore}) {
                          $moreF->pack(-after => $more_button, -fill => 'x', -expand => 0, -padx => 4, -pady => 3);
                        }
                        else { $moreF->packForget(); }
                      })->pack(-padx => 3, -anchor => 'w');

  if ($config{ImportMore}) {
    $moreF->pack(-after => $more_button, -expand => 0, -fill => 'x', -padx => 4, -pady => 3);
  }
  else { $moreF->packForget(); }


  my $dpF = $moreF->Frame()->pack(-anchor => 'w', -fill => 'x');
  my $dpC = $dpF->Checkbutton(-variable => \$config{ImportDeadPixel},
							  -anchor   => 'w',
							  -text     => "Interpolate dead pixels"
							 )->pack(-side => "left", -anchor => 'w', -padx => 3, -pady => 3);
  my $dpB = $dpF->Button(-text    => 'Set',
						 -command => sub {
						   interpolateDialog();
						   $wizW->raise;
						 })->pack(-side => "right", -anchor => 'w', -padx => 3, -pady => 3);
  if (missingProgs("Interpolate dead pixels", "jpegpixi")) {
	$config{ImportDeadPixel} = 0; # disabled if jpegpixi is not available
	$dpC->configure(-state => "disabled");
	$dpB->configure(-state => "disabled");
	$dpC->configure(-disabledforeground => 'gray30');
	$dpB->configure(-disabledforeground => 'gray30');
	$balloon->attach($dpF, -msg => explainMissingProg("Interpolate dead pixels", "jpegpixi"));
  }

  my $rot = $wizW->Checkbutton(-variable => \$config{ImportRotate},
			       -anchor   => 'w',
			       -text     => "Automatic rotation (lossless)"
			       )->pack(-anchor => 'w', -padx => 3, -pady => 3);
  if (missingProgs("Automatic rotation", "jhead") > 0) {
	$config{ImportRotate} = 0;  # disabled if jhead is not available
	$rot->configure(-state => "disabled");
	$rot->configure(-disabledforeground => 'gray30');
	$balloon->attach($rot, -msg => explainMissingProg("Automatic rotation", "jhead"));
  }

  my $comF = $moreF->Frame()->pack(-anchor => 'w', -fill => 'x');
  $comF->Checkbutton(-variable => \$config{NameComment},
					 -anchor   => 'w',
					 -text     => "Add original file name to comment ("
					)->pack(-side => "left", -anchor => 'w', -padx => 3, -pady => 3);
  $comF->Checkbutton(-variable => \$config{NameComRmSuffix},
					 -anchor   => 'w',
					 -text     => "remove file suffix )"
					)->pack(-side => "left", -anchor => 'w', -padx => 0, -pady => 3);

  my $acomF = $moreF->Frame()->pack(-anchor => 'w', -fill => 'x');
  $acomF->Checkbutton(-variable => \$config{ImportAddCom},
					  -anchor   => 'w',
					  -text     => '',
					 )->pack(-side => 'left', -anchor => 'w', -padx => 3, -pady => 3);
  labeledEntry($acomF,"left",$w,"Add this comment to each picture",\$config{ImportAddComment});
  

  my $iptcF = $moreF->Frame()->pack(-anchor => 'w', -fill => 'x');
  $iptcF->Checkbutton(-variable => \$config{ImportAddIPTC},
					  -anchor   => 'w',
					  -text     => '',
					 )->pack(-side => 'left', -anchor => 'w', -padx => 3, -pady => 3);
  labeledEntryButton($iptcF,'top',$w,"Add IPTC info to each picture",'Set',\$config{ImportIPTCTempl});

  my $lockB = $moreF->Checkbutton(-variable => \$config{ImportMarkLocked},
							  -anchor   => 'w',
							  -text     => "Add high rating to locked pictures"
							 )->pack(-anchor => 'w', -padx => 3, -pady => 3);
  $balloon->attach($lockB, -msg => "Some digital cameras allow to lock pictures.\nThis feature can be used to mark important pictures already in the camera.\nIf this function is enabled Mapivi will add a high rating to all locked pictures\n(files with write protection).");

  $moreF->Checkbutton(-variable => \$config{ImportDeleteCameraJunk},
					 -anchor   => 'w',
					 -text     => "Delete camera junk files in target folder after copy (e.g. *.CTG)"
					)->pack(-anchor => 'w', -padx => 3, -pady => 3);


  my $renF = $wizW->Frame()->pack(-anchor => 'w', -fill => 'x');
  $renF->Checkbutton(-variable => \$config{ImportRename},
					 -anchor   => 'w',
					 -text     => "Smart Rename with this pattern:"
					)->pack(-side => "left", -anchor => 'w', -padx => 2, -pady => 3);
  $renF->Label(-textvariable => \$config{FileNameFormat},
			   -bg => $config{ColorBG},
			   -anchor   => 'w',
			   #-width    => ($w2-2),
			   )->pack(-side => "left", -anchor => 'w', -padx => 3, -pady => 3);
  $renF->Button(-text    => 'Set',
				-command => sub {
				  getRenameFormat();
				})->pack(-side => "right", -anchor => 'w', -padx => 3, -pady => 3);

  $wizW->Checkbutton(-variable => \$config{ImportDelete},
					 -anchor   => 'w',
					 -text     => "Delete files in source folder after copy"
					)->pack(-anchor => 'w', -padx => 3, -pady => 3);


  $wizW->Checkbutton(-variable => \$config{ImportShowPics},
					 -anchor   => 'w',
					 -text     => "Show pictures when import finished"
					)->pack(-anchor => 'w', -padx => 3, -pady => 3);

  my $ButF = $wizW->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);

  my $OKB =	$ButF->Button(-text => 'OK',
						  -command => sub {
							$wizW->withdraw();
							$wizW->destroy();
							$rc = 1;
						  })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  my $Xbut = $ButF->Button(-text => 'Cancel',
						   -command => sub { $rc = 0;
											 $wizW->withdraw();
											 $wizW->destroy();
										   })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $wizW->bind('<Key-Escape>', sub { $Xbut->invoke; });

  $wizW->Popup;
  $wizW->waitWindow;

  return if ($rc != 1);

  $rc = importPictures();
  openDirPost($config{ImportTargetFix}."/".$config{ImportTargetVar}) if $config{ImportShowPics};
  if ($rc) {
	$userinfo = "import finished successfully!";
  }
  else {
	$userinfo = "import finished with errors!";
  }
  $userInfoL->update;

}

my $printW;
##############################################################
# copyToPrint -  copy pics to print folders
#                (e.g. 2_times_5x7/ or 1_times_13x18/)
##############################################################
sub copyToPrint {

  my $lb = shift;    # the reference to the active listbox widget
  my @sellist = getSelection($lb);
  return unless checkSelection($top, 1, 0, \@sellist);

  if (Exists($printW)) {
	$printW->deiconify;
	$printW->raise;
	return;
  }

  my $pics  = shift;
  my $rc   = 0;

  # open window
  $printW = $lb->Toplevel();
  $printW->title("copy pictures to print folder");
  $printW->iconimage($mapiviicon) if $mapiviicon;

  $printW->Label(-text => "Copy ".scalar @sellist." pictures to a according print folder.", -bg => $config{ColorBG}, -justify => "left")->pack(-anchor => 'w', -padx => 3, -pady => 3);

  my $w  = 32;
  my $w2 = $w - 3;

  my $times    = 1;
  my $timesStr = "times";
  my $size     = "10x15";

  labeledEntryButton($printW,'top',$w,"Print base folder",'Set',\$config{PrintBaseDir}, 1);

  my $sf = $printW->Frame()->pack();
  $sf->Label(-text => "numer, string and size", -width => $w, -bg => $config{ColorBG}, -justify => "left")->pack(-side => "left");

  $sf->Optionmenu(-textvariable => \$config{PrintTimes},
				  -options => [qw(1 2 3 4 5 6 7 8 9 10)],
				  -command => sub { $config{PrintVarDir} = $config{PrintTimes}.$config{PrintTimesStr}.$config{PrintSize}; },
				 )->pack(-side => "left", -anchor => 'w');
  $sf->Optionmenu(-textvariable => \$config{PrintTimesStr},
				  -options => [qw(times mal - x _x_ _times_ _mal_ _prints_in_ _Abzuege_in_)],
				  -command => sub { $config{PrintVarDir} = $config{PrintTimes}.$config{PrintTimesStr}.$config{PrintSize}; },
				 )->pack(-side => "left", -anchor => 'w');
  $sf->Optionmenu(-textvariable => \$config{PrintSize},
				  -options => [qw(4x6 5x7 8x10 11x14 9x13 10x15 13x18 18x27 30x40 50x70)],
				  -command => sub { $config{PrintVarDir} = $config{PrintTimes}.$config{PrintTimesStr}.$config{PrintSize}; },
				 )->pack(-side => "left", -anchor => 'w');


  labeledEntry($printW,'top',$w,"folder",\$config{PrintVarDir});


  my $ButF = $printW->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);

  my $OKB =	$ButF->Button(-text => 'OK',
						  -command => sub {
							$printW->withdraw();
							$printW->destroy();
							$rc = 1;
						  })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  my $Xbut = $ButF->Button(-text => 'Cancel',
						   -command => sub { $rc = 0;
											 $printW->withdraw();
											 $printW->destroy();
										   })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $printW->bind('<Key-Escape>', sub { $Xbut->invoke; });

  $printW->Popup;
  $printW->waitWindow;

  return if ($rc != 1);

  if (!-d $config{PrintBaseDir}) {
	my $rc = $top->messageBox(-icon  => 'question',
				-message => $config{PrintBaseDir}." does not exist. Should I create it?",
				-title => "Create print base folder?", -type => 'OKCancel');
	return if ($rc !~ m/Ok/i);

	eval { mkpath($config{PrintBaseDir}, 0, 0755) }; # 0 = no output, 0755 = access rights
	if ($@) {
	  warn "Couldn't create ",$config{PrintBaseDir},": $@";
	  return;
	}
  }

  my $printdir = $config{PrintBaseDir}."/".$config{PrintVarDir};
  print "copy pics to $printdir\n" if $verbose;
  makeDir($printdir, NO_ASK); # do not ask

  my $pw = progressWinInit($top, "Copy to print");
  my $i = 0;
  foreach my $spic (@sellist) {
	last if progressWinCheck($pw);
	$i++;
	my $pic  = basename($spic);
	my $tpic = "$printdir/$pic";
	progressWinUpdate($pw, "copy ($i/".scalar @sellist.") ...", $i, scalar @sellist);
	if (!mycopy($spic, $tpic, ASK_OVERWRITE)) { # ask before overwrite
	  warn "error in copy $pic!\n";
	}
  }
  progressWinEnd($pw);

  $userinfo = "copy finished! ($i/".scalar @sellist.")"; $userInfoL->update;
}

##############################################################
# importPictures
##############################################################
sub importPictures {

  my $source = $config{ImportSource};

  ##### check source dir
  $userinfo = "checking folders ..."; $userInfoL->update;
  if (!-d $source) {
	$top->messageBox(-icon => 'warning',
					 -message => "Sorry, but the source folder\n$source\ndoes not exists!\nPlease check, if the device is mounted.",
					 -title => "Import pictures - Error", -type => 'OK');
	return 0;
  }

  my @sdirs;               # all dirs to process

  # add the sub dirs
  if ($config{ImportSubdirs}) {
	push @sdirs, getDirsRecursive($source);
  }

  push @sdirs, $source unless isInList($source, \@sdirs);  # the source dir is the minimum

  # the target dir
  my $tdir = $config{ImportTargetFix}."/".$config{ImportTargetVar};

  ##### check if target is available, create it if not
  makeDir($tdir, ASK) if (!-d $tdir);

  ##### check if target is now available
  if (!-d $tdir) {
	warn "$tdir not created!!!";
	return 0;
  }

  #### get the IPTC template only once, before starting loop
  my $iptc;
  if ($config{ImportAddIPTC}) {
	if (defined $config{ImportIPTCTempl} and -f $config{ImportIPTCTempl}) {
	  $iptc = retrieve($config{ImportIPTCTempl});
	  unless (defined $iptc) {
		$top->messageBox(-icon => 'warning',
						 -message => "Sorry, but Mapivi could not retrieve IPTC template $config{ImportIPTCTempl}!\nPlease check, if the file is available.",
						 -title => "Import pictures - Error", -type => 'OK');
		return 0;
	  }
	}
	else {
		$top->messageBox(-icon => 'warning',
						 -message => "Sorry, but Mapivi could not find the IPTC template $config{ImportIPTCTempl}!\nPlease check, if the file is available.",
						 -title => "Import pictures - Error", -type => 'OK');
	  return 0;
	}
  }

  # open log window
  if (Exists($impW)) {
	$impW->deiconify;
	$impW->raise;
	return 0;
  }

  # open window
  $impW = $top->Toplevel();
  $impW->title("Import pictures log");
  $impW->iconimage($mapiviicon) if $mapiviicon;

  my ($s,$m,$ho,$d,$mo,$y) = localtime(time());
  my $time = sprintf "%02d:%02d:%02d", $ho, $m, $s;

  my $butF = $impW->Frame()->pack(-expand => 1, -fill =>'x');
  $butF->Button(-text => "Close",
				-command => sub {
				  $impW->withdraw();
				  $impW->destroy();
				},
			   )->pack(-expand => 1, -side => "left", -fill => 'x');
  my $stop = 0;
  my $stopB = $butF->Button(-text => "Stop",
							-command => sub { $stop = 1; }
						   )->pack(-side => 'left', -anchor => 'w', -expand => 0,-padx => 1,-pady => 1);
  my $stopImg = $top->Photo(-file => "$configdir/StopPic.gif") if (-f "$configdir/StopPic.gif");
  $stopB->configure(-image => $stopImg, -borderwidth => 0) if $stopImg;
  $stopB->configure(-state => "disabled");

  my $dcount = 0; # progress of dirs
  my $pcount = 0; # progress of pics
  my $rating_count = 0; # counter for locked pictures with successfull added rating
  my $progF  = $impW->Frame()->pack(-expand => 1, -fill =>'x');
  $progF->Label(-text => "progress folders ", -bg => $config{ColorBG})->pack(-side => "left");
  $progF->ProgressBar(-takefocus => 0,
					  -borderwidth => 1,
					  -relief => 'sunken',
					  -length => 100,
					  -padx => 0,
					  -pady => 0,
					  -variable => \$dcount,
					  -colors => [0 => $config{ColorProgress}],
 					  -resolution => 1,
					  -blocks => scalar @sdirs,
					  -anchor => 'w',
					  -from => 0,
					  -to => scalar @sdirs,
					 )->pack(-side => "left", -fill => 'x', -expand => 1, -padx => 2, -pady => 3);
  $progF->Label(-text => " pictures ", -bg => $config{ColorBG})->pack(-side => "left");
  my $picProg =
	$progF->ProgressBar(-takefocus => 0,
						-borderwidth => 1,
						-relief => 'sunken',
						-length => 100,
						-padx => 0,
						-pady => 0,
						-variable => \$pcount,
						-colors => [0 => $config{ColorProgress}],
						-resolution => 1,
						-anchor => 'w',
						-from => 0,
						-to => 100,
					   )->pack(-side => "left", -fill => 'x', -expand => 1, -padx => 2, -pady => 3);

  my $rotext = $impW->Scrolled("ROText",
							   -scrollbars => 'oe',
							   -wrap => 'word',
							   -tabs => '4',
							   -width => 90,
							   -height => 30,
							  )->pack(-fill => "both", -expand => 1, -padx => 1, -pady => 1);

  $rotext->tagConfigure("R",-foreground => "brown4");
  $rotext->tagConfigure("G",-foreground => "DeepSkyBlue4");
  $rotext->tagConfigure("B",-foreground => "blue4");
  $impW->Popup;

  $rotext->insert('end', "$time starting import ...\n", "B"); $impW->update;

  $stopB->configure(-state => 'normal');
  foreach $source (@sdirs) {
	last if $stop;
	$dcount++;
	$rotext->insert('end', "in folder ($dcount/".scalar @sdirs.") $source ...\n", "G"); $impW->update;
	##### get and check files to import
	my @importfiles = getFiles($source);

	print "In dir $source are ".@importfiles." files\n" if $verbose;

	if (@importfiles <= 0) {
	  $rotext->insert('end', "   no pictures in this folder - skipping\n", "R"); $rotext->see('end');
	  next;
	}

	$picProg->configure(-to => scalar @importfiles, -blocks => scalar @importfiles);

	##### copy all files from source to target
	$pcount = 0;
	my $sum = 0; # the sum of all files copied in MegaBytes
	my $startTime = Tk::timeofday();
	foreach my $file (@importfiles) {
	  last if $stop;
	  $pcount++;
	  my $size = getFileSize("$source/$file", NO_FORMAT)/(1024*1024); # get size in MegaBytes
	  my $sizeF = sprintf "%.2f", $size;
	  $rotext->insert('end', "   ($pcount/".scalar @importfiles.") copy $file ($sizeF MB)\n");
	  $rotext->see('end');
	  $impW->update;
	  mycopy("$source/$file", "$tdir/$file", ASK_OVERWRITE);
      if ($config{ImportMarkLocked}) {
        # if source file is write protected
        if (!-w "$source/$file") {
          # add rating 1 to target file
	      my $meta = getMetaData("$tdir/$file", 'APP13');
	      my $iptc = $meta->get_app13_data('TEXTUAL', 'IPTC');
          if ($iptc->{error}) {
            warn "IPTC segment of $file has errors!";
	        $rotext->insert('end', "         locked picture, but IPTC segment has errors!\n");
          }
          else {
	        $iptc->{Urgency} = 1;
	        $meta->set_app13_data($iptc, 'REPLACE', 'IPTC');
	        if (!$meta->save()) {
	          $rotext->insert('end', "         locked picture, but writing of rating failed!\n");
	        }
            else {
	          $rotext->insert('end', "         locked picture, setting rating to 1!\n");
              $rating_count++;
            }
          }
	      $rotext->see('end');
        }
      }
	  $sum += $size if (-f "$tdir/$file");
	}
	my $duration = Tk::timeofday() - $startTime;      # in seconds
	my $rate     = $sum/$duration if ($duration > 0); # MegaBytes/second
	my $string   = sprintf "The transfer of %.2f MB took %.2f seconds; transferrate %.2f MB/s\n", $sum, $duration, $rate;
	$rotext->insert('end', $string); $rotext->see('end');
	

	##### check if the copy was successfull
	my $filediff = 0;
	my $sizediff = 0;
	# check if every source file is in the target dir and if the file size is the same
	foreach (@importfiles) {
	  $filediff++ if (!-f "$tdir/$_");
	  $sizediff++ if (getFileSize("$tdir/$_", NO_FORMAT) != getFileSize("$source/$_", NO_FORMAT));
	}

	if (($filediff > 0) or ($sizediff > 0)) {
      my $rating_info = "";
      $rating_info = "$rating_count locked pictures found and rating added. This will increase the file size and may explain the difference.\n";
	  my $rc = $top->messageBox(-icon  => 'question',
								-message => "Not all files in the source and target folder are eqal.\n$filediff files are missing and $sizediff files have another size.\n${rating_info}Should I continue?",
								-title => "Continue importing pictures?", -type => 'OKCancel');
	  return 0 if ($rc !~ m/Ok/i);
	}

	##### get the imported JPEG pictures (from the source dir!!!)
	# no questions about NON-JPEGS while importing please!
	my $tmp = $config{CheckForNonJPEGs};
	$config{CheckForNonJPEGs} = 0;
	my @piclist = getPics($source, JUST_FILE); # no sort needed
	$config{CheckForNonJPEGs} = $tmp;

	##### process JPEGS
	if ($config{ImportDeadPixel} or $config{ImportRotate} or $config{ImportRename} or $config{NameComment} or $config{ImportAddCom} or $config{ImportAddIPTC}) {
	  my $command = "";
	  my @renamed;
	  $pcount = 0;

	  foreach (@piclist) {
		last if $stop;
		$pcount++;
		my $pic  = $_;
		my $dpic = "$tdir/$pic";
		$rotext->insert('end', "   ($pcount/".scalar @piclist.") $pic ", "G"); $rotext->see('end');
		if (!-f $dpic) {
		  $rotext->insert('end', "   *** $dpic is missing - skipping! ***", "R"); $rotext->see('end');
		  warn "importPictures: $dpic is missing - skipping!\n";
		  next;
		}
		my $tmppic  = "$dpic"."-cjpg"; # temporary file

		##############################################################
		##### interpolate dead pixels
		if ($config{ImportDeadPixel}) {
		  if (checkWriteable($dpic)) {
			# check if temp file exists
			if (checkTempFile($tmppic)) {
			  $rotext->insert('end', "interpolating, "); $rotext->see('end');
			  # call external command jpegpixi
			  $command = "jpegpixi -m ".$config{DeadPixelMethod}." \"$dpic\" \"$tmppic\" ".$config{DeadPixelStr};
			  print "command = $command\n" if $verbose;
			  execute($command);
			  # now overwrite the original pic with the temp file and delete the temp file
			  overwrite("$dpic", "$tmppic");
			} else {
			  warn "importPictures: problem with temppic ($tmppic)";
			}
		  } else {
			warn "importPictures: picture $pic is not writeable";
		  }
		}

		##############################################################
		##### auto rotate pics
		if ($config{ImportRotate}) {
		  $rotext->insert('end', "rotating, "); $rotext->see('end');
		  $command = "jhead -autorot \"$dpic\" ";
		  print "command = $command\n" if $verbose;
		  execute($command);
		}

		##############################################################
		##### add file name to comment
		if ($config{NameComment}) {
		  $rotext->insert('end', "adding name to comment, "); $rotext->see('end');
		  my $com = $pic;
		  if (($config{NameComRmSuffix}) and ($pic =~ /(.*)(\.jp(g|eg))/i)) {
			$com = $1;			# just the file name without .jp(e)g suffix
		  }

		  # add the filename as comment
		  addCommentToPic($com, $dpic, NO_TOUCH) if ($com ne "");
		}

		##############################################################
		##### add IPTC template to picture
		if ($config{ImportAddIPTC} and defined $config{ImportIPTCTempl} and -f $config{ImportIPTCTempl}) {
		  $rotext->insert('end', "adding IPTC, "); $rotext->see('end');

		  # add IPTC to pic
		  my $meta = getMetaData($dpic, 'APP13');

		  if (defined $meta) {
			# todo, we could also use UPDATE or REPLACE here
			$meta->set_app13_data($iptc, 'ADD', 'IPTC');
			# make the SupplementalCategories and Keywords unique and sorted
			uniqueIPTC($meta);
			$meta->save();
		  }
		}

		##############################################################
		##### add comment to picture
		if ($config{ImportAddCom} and defined $config{ImportAddComment} and $config{ImportAddComment} ne '') {
		  $rotext->insert('end', "adding comment, "); $rotext->see('end');

		  # add comment to pic
		  addCommentToPic($config{ImportAddComment}, $dpic, NO_TOUCH);
		}

		##############################################################
		##### smart rename pics
		if ($config{ImportRename}) {
		  $rotext->insert('end', "renaming "); $rotext->see('end');
		  my $newname = "";
		  my $doForAll = 1;		# use the file date, if there is no EXIF date without asking
		  my $rc = applyRenameFormat($dpic, $config{FileNameFormat}, \$newname, \$doForAll);
		  $newname = findNewName("$tdir/$newname");
		  if (($rc ne "Skip this picture") and ($rc ne "Cancel all")) {
			if (-f "$tdir/$newname") { # just a safety check
			  warn "$newname already exists - skipping\n";
			  next;
			}
			print "renaming from $pic to $newname\n" if $verbose;
			# rename the picture
			if (!rename ($dpic, "$tdir/$newname")) {
			  # rename failed
			  $top->messageBox(-icon => 'warning', -message => "Could not rename $pic to $newname: $!",
							   -title => 'Error', -type => 'OK');
			}
			else {
			  # todo: rename raw pics as option (but how to handle renameSmartFix?
			  push @renamed, "$tdir/$newname";
			}
		  }
		}
		$rotext->insert('end', "\n"); $rotext->see('end');
		$rotext->update;
	  }							# foreach pics end

	  my $errors = "";
	  renameSmartFix(\$errors, @renamed) if $config{ImportRename};

	}

	$stopB->configure(-state => "disabled");

 	##############################################################
	##### delete worthless camera state files

	if ($config{ImportDeleteCameraJunk}) {
	  my @junkfiles = grep {m/.*\.($cameraJunkSuffixes)$/i} @importfiles;
	  $pcount = 0;
	  $stopB->configure(-state => 'normal');
	  foreach (@junkfiles) {
	    last if $stop;
	    $pcount++;
	    $rotext->insert('end', "   ($pcount/".scalar @junkfiles.") deleting $_\n"); $rotext->see('end'); $rotext->update;
	    removeFile("$tdir/$_");
	  }
	  $stopB->configure(-state => "disabled");
	}

	##############################################################
	##### delete imported pics

	if ($config{ImportDelete}) {
	  # check if everything is alright
	  if (($filediff > 0) or ($sizediff > 0)) {
		my $rc = $top->messageBox(-icon  => 'question',
								  -message => "There have been some warnings while importing.\nShould I continue and delete the ".scalar @importfiles." files in the source folder?",
								  -title => "Continue?", -type => 'OKCancel');
		return 0 if ($rc !~ m/Ok/i);
	  }

	  $pcount = 0;
	  $stopB->configure(-state => 'normal');
	  # remove the pics on the source dir
	  foreach (@importfiles) {
		last if $stop;
		$pcount++;
		$rotext->insert('end', "   ($pcount/".scalar @importfiles.") deleting $_\n"); $rotext->see('end'); $rotext->update;
		removeFile("$source/$_");
	  }
	}
  }    # foreach dirs end


  $stopB->configure(-state => "disabled");

  ($s,$m,$ho,$d,$mo,$y) = localtime(time());
  $time = sprintf "%02d:%02d:%02d", $ho, $m, $s;
  $rotext->insert('end', "$time import finished!\n", "B"); $rotext->see('end'); $rotext->update;
  return 1;
}

##############################################################
# dock_keyword_dialog
##############################################################
sub dock_keyword_dialog {
  # only if dock is selected
  return unless ($config{KeywordDialogDock});
  # and the keyword dialog is open
  return unless (Exists($keyw));
  
  # get coordinates of main window
  my $geo = $top->geometry;
  my ($tw, $th, $tx, $ty) = splitGeometry($geo);
  # take the border and menubar into account
  my $rootx = $top->rootx;
  my $borderx = $rootx-$tx; 

  # get coordinates of keyword window
  $geo = $keyw->geometry;
  my ($w, $h, $x, $y) = splitGeometry($geo);
  if ($config{KeywordDialogDockL}) {
    # move keyword window to left side of main window 
    $x = $tx - $w - 2*$borderx;
  }
  else {
    # move keyword window to right side of main window 
    $x = $tx + $tw + 2*$borderx;
  }
  $h = $th + 4*$borderx + 3;
  $keyw->geometry("${w}x${h}+${x}+${ty}");
}

##############################################################
# setChildState - changes the state of a widget and
#                 all his descendants (if possible)
##############################################################
sub setChildState {

	my $widget = shift;
	my $state  = shift;

	$widget->Walk( sub {
		print "changing widget ",ref($_[0])," to state $state\n" if $verbose;
		eval { $_[0]->configure(-state => $state); }
	});
}

##############################################################
# progressWinInit
##############################################################
sub progressWinInit($$) {
  my $widget = shift;
  my $title  = shift;
  # open window
  my $pw = $widget->Toplevel();
  $pw->withdraw;
  $pw->title("Mapivi: $title");
  $pw->iconimage($mapiviicon) if $mapiviicon;
  $pw->iconname("Mapivi progress");

  # init the values
  $pw->{stop}    = 0;
  $pw->{percent} = 0;
  $pw->{label}   = "";
  $pw->{label2}  = "0% done";
  $pw->{start_time} = Tk::timeofday();

  $pw->Label(-textvariable => \$pw->{label}, -width => 80, -anchor => 'w', -bg => $config{ColorBG})->pack(-padx => 3, -pady => 10);
  $pw->Label(-textvariable => \$pw->{label2}, -anchor => 'w', -bg => $config{ColorBG})->pack(-padx => 3, -pady => 10);

  $pw->{progbar} =
	$pw->ProgressBar(-takefocus => 0,
					 -borderwidth => 1,
					 -relief => 'sunken',
					 #-width => (2*$config{FontSize}), # try to guess the height of the labels
					 #-length => 30,
					 -padx => 0,
					 -pady => 0,
					 -variable => \$pw->{percent},
					 -colors => [0 => $config{ColorProgress}],
					 -resolution => 1,
					 -blocks => 10,
					 -anchor => 'w',
					 -from => 0,
					 -to => 100,
					)->pack(-fill => 'both', -expand => 0, -padx => 3, -pady => 10);
  $pw->Button(-text => 'Cancel',
			  -command => sub {
				$pw->{stop}  = 1;
				$pw->{label} = "stopping ...";
				$pw->update();
			  })->pack(-fill => 'x', -expand => 1, -padx => 3, -pady => 10);
  centerWindow($pw);
  $pw->deiconify;
  $pw->raise;
  return $pw;
}

##############################################################
# progressWinCheck
##############################################################
sub progressWinCheck($) {
  my $pw = shift;
  warn "pw->stop undefined!" unless defined($pw->{stop});
  return ($pw->{stop});
}

##############################################################
# progressWinUpdate
##############################################################
sub progressWinUpdate($$$$) {
  my $pw     = shift;
  # show progress and found pics every 0.3 seconds - idea from Slaven
  return unless (!defined $pw->{last_time} || Tk::timeofday()-$pw->{last_time} > 0.3);

  my $string = shift;
  my $index  = shift;
  my $total  = shift;

  $pw->{label} = $string;

  if ($total > 0) {
    my $add_str    = '';
    my $percent    = int(($index/$total)*100);
    my $min        = 0;
    my $sec        = int(Tk::timeofday() - $pw->{start_time});
    # try to estimate the time to go, after 3% are finished and 10 seconds are over
    if (($percent > 3) and ($sec > 5)) {
	  my $to_go = int($sec * $total / $index) - $sec; # time to go in seconds
      my $totalt = $to_go + $sec;
	  my $tgmin   = 0;
	  my $total_min = 0;
	  if ($to_go > 59) { $tgmin = int($to_go / 60); $to_go = $to_go % 60; } # modulo
	  if ($totalt > 59) { $total_min = int($totalt / 60); $totalt = $totalt % 60; } # modulo
	  $add_str  = sprintf "\n\nEstimated time to go %d:%02d, estimated total time %d:%02d",$tgmin, $to_go, $total_min, $totalt;
    }
    if ($sec > 59) { $min = int($sec / 60); $sec = $sec % 60; } # modulo
    $pw->{label2}  = sprintf "%d%% done, time elapsed %d:%02d%s", $percent, $min, $sec, $add_str;
    $pw->{percent} = $percent;
    $pw->iconname("$percent% done");
  }
  else {
    $pw->{label2} = '';
  }
  $pw->update();
  $pw->{last_time} = Tk::timeofday() if ($total > 0);
}

##############################################################
# progressWinEnd
##############################################################
sub progressWinEnd($) {
  my $pw = shift;
  if (Exists($pw)) {
	$pw->withdraw;
	$pw->destroy;
  }
}

##############################################################
# fullscreen
##############################################################  
sub fullscreen {
  my $win        = shift;
  my $fullscreen = shift;

  # Mai 2007: $win->attributes(-fullscreen => 1); should also work with 804.027_500 but it doesn't (at least not under windows)
  
  if ($fullscreen) {
	#saveOffsets($win);
	#my $screenw = $top->screenwidth - 10;
	#my $screenh = $top->screenheight - 30;
	#$geo = "${screenw}x${screenh}+0+0";
	print "fullscreen: full \n" if $verbose;
	# this should also work:
	$win->packPropagate(0);
	$win->FullScreen;

  } else {
	#my ($w, $h) = getSize($dpic);
	$win->packPropagate(1);
	#$geo = "${w}x${h}+${picwinx}+${picwiny}";
	print "fullscreen: normal \n" if $verbose;
  }
  #$win->geometry($geo);
  $win->update;
  $win->overrideredirect($config{Overrideredirect});	# no window decoration, but also no key input possible?!
  $win->focusForce;

}

##############################################################
# topFullScreen - toggle the main window to fullscreen and back
##############################################################
sub topFullScreen {

  if ($topFullScreen == 0) {
	# save layout and geometry
	%topFullSceenConf = %config;
	$topFullSceenConf{Geometry} = $top->geometry; # save the actual geometry
  }

  toggle(\$topFullScreen);

  # remove/add the window border
  topToggleBorder() if $config{ToggleBorder};

  if ($topFullScreen) {			# switch to fullscreen
	#unset geometry
	#$top->geometry("");
	#$top->geometry("+0+0");
	#$config{ShowMenu}         = 0;
	#$config{ShowInfoFrame}    = 0;
	#$config{ShowCommentField} = 0;
	#$config{ShowEXIFField}    = 0;
	#$config{Layout}           = 4 ;
	#layout(1);
	#$mainF->configure(-bg => $config{ColorBGCanvas});
	#$mainF->configure(-fg => $config{ColorBGCanvas});
	#$mainF->configure(-highlightcolor => $config{ColorBGCanvas});
	#$mainF->configure(-highlightbackground => $config{ColorBGCanvas});
	$top->withdraw;
	my $w = $top->screenwidth;	# - 20;
	my $h = $top->screenheight;	# - 80;
	$top->geometry("${w}x${h}+0+0");
	#$top->GeometryRequest($w,$h);
    $top->deiconify;
	#$top->overrideredirect(1);
	$top->packPropagate(0); 
    $top->Post(0,0);
    $top->update; 
	if ($config{ToggleBorder}) {
		$top->grabGlobal;
	}
  } else {						# reset from fullscreen mode
	#$top->withdraw;
	$mainF->configure(-bg => $config{ColorBGCanvas});
	$top->geometry($topFullSceenConf{Geometry});
	#$config{ShowMenu}         = $topFullSceenConf{ShowMenu};
	#$config{ShowInfoFrame}    = $topFullSceenConf{ShowInfoFrame};
	#$config{ShowCommentField} = $topFullSceenConf{ShowCommentField};
	#$config{ShowEXIFField}    = $topFullSceenConf{ShowEXIFField};
	#$config{Layout}           = $topFullSceenConf{Layout};
	#$top->deiconify;
	#layout(1);
  }
  $top->focusForce;
  # the canvas size has changed, so we need to rezoom all cached pics
  deleteCachedPics();
  fitPicture();
  #$top->deiconify;
  #$top->focus;
}

##############################################################
# topToggleBorder
##############################################################
sub topToggleBorder {

  return unless $config{ToggleBorder};

  print "fullscreen: $topFullScreen\n" if $verbose;
  $top->overrideredirect($topFullScreen); # toggle window decoration on/off

  if ($topFullScreen) {			# switch to fullscreen
	# rebind the Esc-key to escape from fullscreen
	$top->bind('<Key-Escape>', sub { topFullScreen(); Tk->break; } );
	# grab the focus to receive all keys - this is a bit dangerous
	$top->bind('<Enter>',      sub { $top->focusForce; $top->grabGlobal; });
	$top->bind('<Leave>',      sub { $top->grabRelease; });
  }
  else {
    # rebind Esc-key to the old binding
	#$top->bind('<Key-Alt_L>',  sub { Tk->break; } );
	$top->bind('<Key-Escape>', sub { $top->iconify; Tk->break; } );
	$top->bind('<Enter>',      sub { Tk->break; });
	$top->bind('<Leave>',      sub { Tk->break; });
	$top->grabRelease;
  }
}

##############################################################
# mapiviUpdate - called if the mapivi version number changed
#                between two starts of mapivi (introduced with
#                version 0.7.3)
##############################################################
sub mapiviUpdate {

  my $ver = 'unknown';
  $ver = $config{Version} if ((defined $config{Version}) and ($config{Version} ne '000'));
  print "Mapivi up/downgrade from version $ver to version $version detected\n"
}

##############################################################
# beep - play a beep sound (bell)
##############################################################
sub beep {
  print "\a"; # this is a beep
  # if this won't work, try this:
  #print "\007";
}

##############################################################
# round
##############################################################
sub round {
  # int() does not round!
  return sprintf "%d", shift;
}

##############################################################
# about - display some infos about the application
##############################################################
sub about {

  my $title = "About Mapivi $version";

  my @date = split / /, '$Date: 2008/02/21 20:53:27 $ ';
  my @datum = split /\//, $date[1];
  my $nrs = $config{NrOfRuns};

  my $about = << "EOA";

 Mapivi - Martin\'s Picture Viewer and Manager

 Open-source and cross-platform picture manager with IPTC, EXIF and Comment support.

      Mapivi Version: $version
 Date of last change: $datum[2].$datum[1].$datum[0]

              Author: Martin Herrmann
               email: Martin-Herrmann\@gmx.de
                 www: $mapiviURL
            download: http://sourceforge.net/projects/mapivi

 You have used Mapivi $nrs times
EOA

  $about .= '
 Mapivi is free software, if you want you may make a donation,
 see http://herrmanns-stern.de/software/donations.shtml
 Your donation of any amount will encourage me to continue the
 development.';

  $about .= "\n\n I am always happy to receive some feedback about Mapivi!\n";

  showText($title, $about, WAIT, $mapiviiconfile);
}

##############################################################
# systemInfo - show some infos about the system to the user
##############################################################
sub systemInfo {

  my $sec = time() - $^T;
  my $min = 0;
  my $hou = 0;
  my $day = 0;

  # some modula calculations
  if ($sec > 59) { $min = int($sec / 60); $sec = $sec % 60; } # modulo
  if ($min > 59) { $hou = int($min / 60); $min = $min % 60; }
  if ($hou > 24) { $day = int($hou / 24); $hou = $hou % 24; }
  my $uptime = sprintf "%d day(s) %02d:%02d:%02d", $day, $hou, $min, $sec;

  my $perlversion = sprintf "%vd",$^V;

  my $string = << "EOA";
   Mapivi config dir: $configdir

        Perl version: $perlversion
     Perl/Tk version: $Tk::VERSION
      Tcl/Tk version: $Tk::version
  Tcl/Tk patch level: $Tk::patchLevel
    Tk::JPEG version: $Tk::JPEG::VERSION
    MetaData version: $Image::MetaData::JPEG::VERSION
     Perl executable: $^X
         System (OS): $^O
    Process ID (PID): $$
       Running since: $uptime


EOA

  my $procTabAvail = (eval "require Proc::ProcessTable")  ? 1 : 0 ;

  my $mem = int(getMemoryUsage()/(1024*1024))."MB" if $procTabAvail;
  $string .= "        memory usage: ".$mem."\n"     if $procTabAvail;

  $string .= "             OS type: ".$ENV{OS}."\n"   if ($ENV{OS});
  $string .= "                  OS: ".$ENV{PC_OS}."\n"   if ($ENV{PC_OS});
  $string .= "             OS type: ".$ENV{OSTYPE}."\n"   if ($ENV{OSTYPE});
  $string .= "         System name: ".$ENV{HOSTNAME}."\n" if ($ENV{HOSTNAME});
  $string .= "         System name: ".$ENV{COMPUTERNAME}."\n" if ($ENV{COMPUTERNAME});
  $string .= "         System type: ".$ENV{HOSTTYPE}."\n" if ($ENV{HOSTTYPE});
  $string .= "     # of processors: ".$ENV{NUMBER_OF_PROCESSORS}."\n" if ($ENV{NUMBER_OF_PROCESSORS});
  $string .= "           Processor: ".$ENV{CPU}."\n"      if ($ENV{CPU});
  $string .= "           Processor: ".$ENV{PROCESSOR_ARCHITECTURE}."\n" if ($ENV{PROCESSOR_ARCHITECTURE});
  $string .= "      Processor type: ".$ENV{PROCESSOR_IDENTIFIER}."\n"   if ($ENV{PROCESSOR_IDENTIFIER});
  $string .= "      Processor type: ".$ENV{MACHTYPE}."\n"      if ($ENV{MACHTYPE});
  $string .= "      Processor rev.: ".$ENV{PROCESSOR_REVISION}."\n"   if ($ENV{PROCESSOR_REVISION});

  $string .= "Here is a list of all external programs used by Mapivi.\nSome of them are needed, some are optional.\n\n";

  foreach my $prog (sort keys %exprogs) {
	if ($exprogs{$prog}) {
	  $string .= "     ";
	}
	else {
	  $string .= " not ";
	}
	$string .= sprintf("available: %-12s - %s\n", $prog, $exprogscom{$prog});
  }
  showText("System Information", $string, WAIT, $mapiviiconfile);
}

##############################################################
# gratulation
##############################################################
sub gratulation {

  my $nr = $config{NrOfRuns};
  my $text = <<"EOT";

Gratulation!!!

You\'ve started MaPiVi $nr times!

You are a real MaPiVi Power User!

I would be really glad to receive an email about this event.

Mapivi is free software, but if you wish you may make a donation,
please go to http://herrmanns-stern.de/software/donations.shtml
Your donation of any amount will encourage me to continue the
development of Mapivi.
Maybe you could also tell me on which hardware and operating system you are using MaPiVi?
I would like to add this information on the supported systems section of the README file.

Martin Herrmann (author of Mapivi)

email: Martin-Herrmann\@gmx.de
EOT

  showText("MaPiVi start nr. $nr", $text, NO_WAIT);
}

##############################################################
# showCopyright
##############################################################
sub showCopyright {
print <<EOCopyright;

    Mapivi $version - Martin's Picture Viewer and Organizer
    Copyright (C) 2002 - 2008  Martin Herrmann
    Mapivi comes with ABSOLUTELY NO WARRANTY.
    This is free software, and you are welcome to redistribute
    it under certain conditions.

EOCopyright
# in front of EOCopyright no blanks are allowed!
}

# Tell Emacs that this is really a perl script
# Local Variables:
# mode:perl
# End:
