#!/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  Martin Herrmann
All rights reserved.

Feel free to redistribute.  Enjoy!

=head1 USAGE

mapivi [file|directory]

to display a certain picture use:

mapivi picture.jpg

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

to view a directory containing pictures use:

mapivi ~/pics/

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

=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 directory

=item BackSpace, Page-Up

Show the previous picture in directory

=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 directory, 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

my $EvilOS = 0; # boolean, if we run on Windows  this is 1
my $MacOSX = 0; # boolean, if we run on Mac OS X this is 1
if ($^O =~ m/win/i) {
  $EvilOS = 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 directory:\n$olddir,\n\n1) please create a new directory for the configuration here:\n   $newdir,\n2) copy all directories and files from the old directory to the new one\n3) delete the old directory 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 $splashAvail = (eval "require Tk::Splash")  ? 1 : 0 ;
my $splash;
my $logo = "$configdir/logo.jpg";
if ($splashAvail and -f $logo) {
  # 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.1 $';
my $version     = "0.".$RCSVersion[1];
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 encoding "utf8"
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(store retrieve dclone);
use Tk::Adjuster;
use Tk::DragDrop;
use Tk::DropSite;

# 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);

#use Data::Dumper;
#use Tk::DirSelect;
#use Tk::ColorEditor;

# optional modules

# seems not to work so I comment it out for a test in the future:
#my $win32FOAvail = (eval "require Win32::FileOp")    ? 1 : 0;
my $win32FOAvail = 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;

# 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($$$);

# globals
my @dirHist;             # directory history - stores the last directories 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 directories (comments, EXIF, IPTC)
my %searchDB;
# directory checklist: hash to store properties of directories (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 directory
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 directory
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 $cropPreviewSize = 400; # canvas size in x and y direction of the crop preview
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 dialod 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 $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-remote 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-remote"    => "edit pictures with The GIMP (only UNIX)",
		   "identify"       => "describe the format and characteristics of a picture",
		   "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-remote"    => "The GIMP http://www.gimp.org",
		   "identify"       => "Image Magick http://www.imagemagick.org",
		   "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);

# 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
			  "LtwGeometry"     => "700x500+10+10", # fit on a 800x600 screen
			  "FontSize"        => 12,
			  "FontFamily"      => "itc avant garde",
			  "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"     => "red", # last color selected with color picker
			  "DefaultThumb"    => "/usr/local/share/mapivi/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, # todo add to options dialog
			  "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"=> 1,  # boolean (1 = show comment, 0 = hide comment in picture view)
			  "ShowEXIF"        => 1,  # boolean (1 = show EXIF, 0 = hide EXIF in thumbnail view)
			  "ShowEXIFField"   => 1,  # 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"     => 0,
			  "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"     => 500,
			  "HTMLPicSharpen"  => 1,
			  "HTMLPicCopyright"=> 0,   # bool - add a visible copyright info into the picture
			  "HTMLPicQuality"  => 75,  # 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"       => 1,   # 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" => 1,   # 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"    => 1,   # 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"=> 1,   # 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
			  "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"       => 6,   # 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
			  "ExtBGApp"        => "wmsetbg -a", # name of external app to set desktop background (with options) 
			  "ConvertUmlaut"   => 1,   # convert german umlaute (e.g.  -> ae etc.)
			  "ShowUrgency"     => 1,   # show the rating/IPTC urgency in the status bar
			  "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" => "2006/200602/20060214_Birthday_Sam",
              "ImportDeadPixel" => 1,
              "ImportRotate"    => 1,
              "ImportRename"    => 1,
			  "ImportDeleteCameraJunk" => 0,
              "ImportDelete"    => 1,
              "ImportUnmount"     => 1,
              "ImportMount"     => 1,
              "ImportDevice"    => "/mnt/usb",
              "ImportShowPics"  => 1,
              "ImportAddCom"    => 0,
              "ImportAddComment"=> "(c) $copyright_year Martin Herrmann",
              "ImportAddIPTC"   => 0,
              "ImportIPTCTempl" => 'template.iptc2',
			  "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"     => "2006: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,
			  "winDirRequesterAskAgain" => 1,
			  "FuzzyBorderWidth"=> 10,
			  "FuzzyBorderBlur" => 10,
			  "FuzzyBorderColor"=> "black",
			  "ShowInfoInCanvas"=> 0,
			  "llBorderWidth"   => 16,
			  "llBorderWidthI"  => 1,
			  "llBorderColor"   => "white",
			  "llBorderColorI"  => "black",
			  "supportOtherPictureFormats" => 0,
			  "CategoriesAll"   => 1,
			  "KeywordsAll"     => 1,
			  "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
			  'UrgencyChangeWarning' => 1, # boolean 1 = show a warning when urgency changed
 			 );

# 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);

# 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 $mapiviiconfile = "$configdir/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 ROText 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 $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 directory\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 directory\nClick here to open a simple directory 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 directory");
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 directory");

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 directory");

my $dirPropSORT = 0;
my $dirPropMETA = 0;
my $dirPropPRIO = 0;
$actdirF->{cbSORT} = $actdirF->Checkbutton(-variable => \$dirPropSORT, -command => sub { $dirProperties{$actdir}{SORT} = $dirPropSORT; }, -padx => 0)->pack(-side => 'left', -anchor=>'w');
$actdirF->{cbMETA} = $actdirF->Checkbutton(-variable => \$dirPropMETA, -command => sub { $dirProperties{$actdir}{META} = $dirPropMETA; }, -padx => 0)->pack(-side => 'left', -anchor=>'w');
$actdirF->{cbPRIO} = $actdirF->Checkbutton(-variable => \$dirPropPRIO, -command => sub { $dirProperties{$actdir}{PRIO} = $dirPropPRIO; }, -padx => 0)->pack(-side => 'left', -anchor=>'w');
$balloon->attach($actdirF->{cbSORT}, -msg => "Sort:\nCheck this button, if the pictures\nin this directory 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 directory are added.");
$balloon->attach($actdirF->{cbPRIO}, -msg => "Prio:\nCheck this button, if the pictures in this\ndirectory are rated with a IPTC urgency flag.");

my $dirtree;
$dirtree = $dirF->Scrolled('DirTree',
						   -scrollbars => 'osoe',
#						   -width => $config{AdjusterDir},
						   -width => 30,
						   -height => 200,
						   -showhidden => $config{ShowHiddenDirs},
						   -selectmode => 'browse',
						   #-selectmode => 'extended', # todo: usefull?
						   -exportselection => 1,
						   -browsecmd => sub {
							 # this function will show all subdirs when clicking on the + sign of a dir
							 $dirtreedir = shift;
							 return if (@_ >= 1);
							 if (!-d $dirtreedir) { print "$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 directory
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");

if ($config{ShowUrgency}) {
  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 => "the rating (IPTC urgency) of the actual picture\n0 or - meaning None, 1 meaning High to 8 meaning Low");
  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 directory: $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);

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

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)");

$balloon->attach($progressBar, -msg => "info about the number of background processes\n(generating thumbnail pictures)");



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

# 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");
			 } );

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

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

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

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

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

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

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

# key-desc,F11,fullscreen mode
$top->bind('<Key-F11>', sub { topFullScreen(); });

addCommonKeyBindings($top, $picLB);

# key-desc,Delete,delete selected pictures to trash
$top->bind('<Key-Delete>',        sub { deletePics($picLB, TRASH); } );
# key-desc,Shift-Delete,remove selected pictures
$top->bind('<Shift-Delete>',      sub { deletePics($picLB, REMOVE); } );
# key-desc,q,quit mapivi
$top->bind('<Key-q>',             sub { quitMain(); } );
# key-desc,R,smart rename selected pictures (e.g to EXIF date)
$top->bind('<Key-R>',             sub { renameSmart($picLB); } );
# key-desc,F12,quit mapivi
$top->bind('<Key-F12>',           sub { quitMain(); } );
# show picture, EXIF, Comment and IPTC info
# key-desc,c,display JPEG comment
$top->bind('<Key-c>',             sub { showComment(); } );
# key-desc,t,display embedded EXIF thumbnail
$top->bind('<Key-t>',             sub { showEXIFThumb(); } );
# key-desc,Ctrl-v,toggle verbose output
$top->bind('<Control-v>',             sub { toggle(\$verbose); $userinfo = "verbose switched to $verbose"; $userInfoL->update;
} );
# key-desc,Ctrl-c,crop (lossless)
$top->bind('<Control-c>',             sub { crop($picLB); } );
# key-desc,Ctrl-b,add border and/or copyright
$top->bind('<Control-b>',             sub { addDecoration(); } );
# key-desc,Ctrl-q,change size/quality
$top->bind('<Control-q>',             sub { changeSizeQuality(); } );
# key-desc,Ctrl-o,open options dialog
$top->bind('<Control-o>',             sub { options(); } );

# 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); # todo : get nearset pic instead of first (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); });
# key-desc,Ctrl-e,edit picture in GIMP
$top->bind('<Control-e>', sub { GIMPedit(); } );
# key-desc,Ctrl-f,apply a filter to the picture
$top->bind('<Control-f>', sub { filterPic(); } );
# key-desc,Ctrl-h,display picture in original size (100% zoom)
$top->bind('<Control-h>',         sub { zoom100(); });
# key-desc,H,display picture histogram
$top->bind('<H>',         sub { showHistogram($picLB); });
# key-desc,z,display picture in original size (100% zoom)
$top->bind('<Key-z>',             sub { zoom100(); });
# key-desc,9,rotate picture(s) 90 degrees clockwise
$top->bind('<Key-9>',             sub { rotate(90);  });
# key-desc,8,rotate picture(s) 180 degrees clockwise
$top->bind('<Key-8>',             sub { rotate(180); });
# key-desc,7,rotate picture(s) 270 degrees clockwise
$top->bind('<Key-7>',             sub { rotate(270); });
# key-desc,0,auto rotate picture(s) (EXIF orientation)
$top->bind('<Key-0>',             sub { rotate("auto"); });

# key-desc,f,fit picture in canvas (auto zoom)
$top->bind('<Key-f>',             sub { fitPicture(); });

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

# thumbnail navigation
# key-desc,Space,display the next picture
$top->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
$top->bind('<S>',     sub {
			 return if (stillBusy()); # block, until last picture is loaded
			 if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off
			 my @sellist = $picLB->info('selection');
			 showPic(nextSelectedPic($actpic));
			 reselect($picLB, @sellist);
} );
# key-desc,Page-Down,display the next picture
$top->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
$top->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
$top->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
$top->bind('<Key-Home>',      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]); } );
# key-desc,End,display the last picture
$top->bind('<Key-End>',      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]);
		   });

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

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

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

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

# support drag and drop from extern
# this enables dropping pictures and directories 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 directory 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;
}

##############################################################
# 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 a JPEG comment
  $bind_w->bind('<Key-a>',             sub { addComment($lb_w); } );
  # key-desc,e,edit a 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 - shows the given pic in the canvas
##############################################################
sub startup {

  $picLB->focus;

  if ($config{NrOfRuns} == 0) {
	#whereIsPerl();
	makeConfigDir();
	copyOtherStuff();
  }
  $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 directories
  if (-f "$configdir/hotlist") {
	my $hashRef = retrieve("$configdir/hotlist");
	warn "could not retrieve hotlist" unless defined $hashRef;
	%dirHotlist = %{$hashRef};
  }

  # try to get the saved directory 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();

  showPic($actpic) if (defined $actpic and $actpic ne "");
  selectDirInTree($actdir);

  checkTrash();

  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 directory 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
  }
}

##############################################################
# whereIsPerl - adjust the first line of this program according
#               to the path to perl
#               start mapivi the first time with:
#               > perl mapivi
#               and then just a:
#               > mapivi
#               will do it.
##############################################################
sub whereIsPerl {

  return if $EvilOS;

  # look for perl
  my $rc = `which perl`; # run shell command which
  chomp $rc;
  print "whereIsPerl: which perl: $rc\n" if $verbose;
  if ($rc =~ m/^(no perl)/i) {
	warn "whereIsPerl: no perl found!";
	return;
  }

  unless (-w $0) {
	warn "whereIsPerl: could not open $0 for write access!";
	return;
  }

  my $file;
  # look what's in the first line of this program
  if (!open($file, "<$0")) {
	warn "whereIsPerl: could not open $0 for read access!: $!";
	return;
  }
  my @lines = <$file>;  # read the complete into the array lines
  close $file;

  my $firstline = "#!$rc -w\n"; # this should be the first line

  print "whereIsPerl: first line: --".$lines[0]."--\n" if $verbose; # this is the first line

  if ($lines[0] ne $firstline) { # compare them
	$lines[0] = $firstline;
  } else {
	print "whereIsPerl: nothing to do, first line is ok!" if $verbose;
	return;
  }

  # first line has changed
  if (!open($file, ">$0")) {
	warn "whereIsPerl: could not open $0 for write access!: $!";
	return;
  }
  print $file @lines; # write everything back
  close $file;
}

##############################################################
# 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; # todo this was last. what is right???
	}
	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);
	if ($size > 1024) {                    # MegaByte
		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 Top50 of the most viewed pics
##############################################################
sub showMostPopularPics {

  # open window
  my $win = $top->Toplevel();
  $win->title('Most popular pictures - TOP50');
  $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 directory 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 $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 .. 49) {
	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});
	$tlb->itemCreate($dpic, 2, -text => "$pic\n$path\nViewed $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 directory 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 :(
      # todo added for vinci 
	  #my $thumbdir = dirname($thumb);
	  #print "*** no thumb dir: $thumbdir\n" unless (-d $thumbdir);
	  #my $picdir = dirname($dpic);
	  #print "*** no pic dir: $picdir\n" unless (-d $picdir);
	  #print "*** no source pic: $dpic\n" unless (-f $dpic);
	  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(-label => 'Move selected to top',
						 -command => sub { light_table_shift('top'); });
  $context_menu->command(-label => 'Move selected to bottom',
						 -command => sub { light_table_shift('bottom'); });
  $context_menu->command(-label => 'Delete selected',
						 -accelerator => "<Delete>",
						 -command => sub { light_table_delete(); });
  $context_menu->command(-label => 'Copy and rename selected',
						 -command => sub { light_table_copy_rename(); });
  $context_menu->command(-label => 'montage/index print ...',
						 -command => sub { my @pics = getSelection($ltw->{canvas}); indexPrint(\@pics); });
  $context_menu->command(-label => 'Show in viewer',
						 -command => sub { openPicInViewer($ltw->{canvas}); });
  #$context_menu->command(-label => 'Show in external viewer',
	#					 -command => sub { openPicInViewer($ltw);(); });
  $context_menu->separator;
  #$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.\nReally quit?",
								-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)
	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;
	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);
	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 directories
##############################################################
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 {
    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}); # format the comment for the list
  $iptc    = formatString($iptc, $config{LineLength}); # 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});
  
  # build a string from the keyword list
  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) and ($exif =~ m/(\d\d)\.(\d\d)\.(\d\d\d\d)\s(\d\d):(\d\d):(\d\d)/)) {
	my $mon  = $2;
	my $year = $3;
	$mon--;
	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($6,$5,$4,$1,$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';
  $size        .= '[bak]' if (-f $bpic);             # show that there is a backup file
  my ($basename, $suffix) = getBasenameSuffix($dpic);
  $size        .= '[raw]' if (-f $basename.'.nef');  # show that there is a raw file
  $size        .= '[raw]' if (-f $basename.'.crw');  # show that there is a raw file

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

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

  my $p         = sprintf "%.2f", ($w*$h/1000000); # MP = MegaPixel
  $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
#                $config{LineLimit} lines.
#                this function wont work as expected with
#                comments containing a lot of nearly empty lines
##############################################################
sub formatString {
  my $string     = shift;
  my $linelenght = shift;

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

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

#  $string =~ s/^\s+//;			       # cut leading white
#  $string =~ s/\s+$//;			       # cut trailing white
  $string =~ s/\r//g;			       # cut \r (carriage return)
  # cut long strings and add a ...
#  $string = substr($string, 0, $chars)."..." if (($chars > 0) and (length($string) > ($chars + 3)));
#  $string =~ s/$/ /;			       # add a trailing space
#  $string =~ s/(.{0,$linelenght})\s+/$1\n/g;	# insert a newline every $linelenght chars with withespace
  $string =~ tr[\200-\377][\000-\177]; # remove the eight bit

  $string = wrap("","",$string);
  my @l = split /\n/, $string;         # limit the lines
  my $max = $config{LineLimit};
  $max = @l if (@l < $config{LineLimit});
  $string = "";
  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 directory?",
						 "MaPiVi would like to create this directory:\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{ShowUrgency}) {
	  $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);
  my $comm = formatString(getComment($dpic, LONG, $meta), 80);
  my $iptc = formatString(getIPTC($dpic, SHORT, $meta), 80);
  $info   .= "EXIF:\n$exif\n"         if ($exif ne "");
  $info   .= "--------------------\n" if (($exif ne "") and (($comm ne "") or ($iptc ne "")));
  $info   .= "Comment:\n$comm\n"      if ($comm ne "");
  $info   .= "--------------------\n" if (($comm ne "") and ($iptc ne ""));
  $info   .= "IPTC:\n$iptc"           if ($iptc 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 directory ".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 ".."));
	push @dirList, $_ if (-d "$dir/$_");
  }

  @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;

  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 directory $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);

  # 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{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;
	  store(\%searchDB,  "$configdir/SearchDataBase") or warn "could not store searchDB in file $configdir/SearchDataBase: $!";
  }

  $userinfo = "saving dir hotlist ..."; $userInfoL->update;
  store(\%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");
  store(\%dirProperties, "$configdir/dirProperties") or warn "could not store $configdir/dirProperties: $!";
  store(\%ignore_keywords, "$configdir/keywords_ignore") or warn "could not store $configdir/keywords_ignore: $!";

  if (MatchEntryAvail) {
	$userinfo = "saving entry values ..."; $userInfoL->update;
	store(\%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}) 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 ";
	  $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) {
		$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) subdirectory \"EXIFThumbs/\" in the current directory.\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: 2006: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 "");
}

##############################################################
# 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');


  my $f = $dtw->Frame()->pack;
  my $af = $f->Frame(-bd => 1, -relief => "raised")->pack(-fill => "y", -side => "left"); # absolut
  my $rf = $f->Frame(-bd => 1, -relief => "raised")->pack(-fill => "y", -side => "left"); # relative

  ######### absolute

  $af->Radiobutton(-text => "use absolute value", -variable => \$config{EXIFAbsRel}, -value => "abs")->pack(-anchor => 'w');

  $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: 2006: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 => "use relative value", -variable => \$config{EXIFAbsRel}, -value => "rel")->pack(-anchor => 'w');

  $rf->Radiobutton(-text => "+ (add time)", -variable => \$config{EXIFPlusMin}, -value => "+")->pack(-anchor => 'w');
  $rf->Radiobutton(-text => "- (subtract time)", -variable => \$config{EXIFPlusMin}, -value => "-")->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 directory $trashdir not found!\nPlease create this directory (shell: mkdir $trashdir) and retry.\n\nAborting.",
					 -title => "No trash directory", -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 (store($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 directory!",
					   -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 directory!",
					   -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 directory $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 = store($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 a 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
#              !Function will not save IPTC!
##############################################################
sub uniqueIPTC {
	my $meta = shift;
	my $iptc = $meta->get_app13_data('TEXTUAL', 'IPTC');

	my %d;   # build a hash
	foreach (@{$iptc->{SupplementalCategory}}) { $d{$_} = 1; }
	@{$iptc->{SupplementalCategory}} = (sort { uc($a) cmp uc($b); } keys %d);

	%d = (); # completely empty %d
	foreach (@{$iptc->{Keywords}}) { $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);
							   store($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 => 2);
  # 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);
							  store($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);
						  }
					  }
					  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 => 2);
  $bf->Radiobutton(-text => "all",  -variable => \$config{KeywordsAll}, -value => 1)->pack(-side => 'left');
  $bf->Radiobutton(-text => "join", -variable => \$config{KeywordsAll}, -value => 2)->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 all:  three keywords: Friend, Bundy and Kelly\nmode join: one keyword:    Friend.Bundy.Kelly\nmode last: one keyword:    Kelly");

  $keytree = $keyw->Scrolled('Tree',
							 -separator  => '/',
							 -scrollbars => 'osoe',
							 -selectmode => 'extended',
							 -exportselection => 0,
							 -width      => 25,
							 -height     => 25,
							 )->pack(-expand => 1, -fill =>'both', -padx => 4, -pady => 2);
  $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);
							  store($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, 1, 1, \@keys);
		my $item = "";
		my $parent = $keys[0];
		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 '');
		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 '');
		$parent .= '/' if (($parent ne '') and ($parent !~ m/.*\/$/));
		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", -command => sub {
		my @keys = $tree->info('selection');
		return unless checkSelection($tree, 1, 1, \@keys);

		for my $t (reverse 0 .. $#{@{$listRef}} ) {
			if ($$listRef[$t] =~ m/^$keys[0].*/) {
				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";
	}
}

##############################################################
# 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";
        }
      }
    }
  }

  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}) 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 {

  my $nr = @ARGV;

  if ($nr < 1) { # open the last dir
	$actdir = $config{LastDir};
	dirSave($actdir);
	return;
  }
  if ($nr > 1) {
	print "\nmapivi error: to many command line options\n";
	printUsage();
	exit;
  }

  my $item = abs_path($ARGV[0]);

  if (-f $item) {
	$actpic  = basename($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 directory:",\$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 directory \"$dir\"",
					 -title => "No valid directory", -type => 'OK');
	$rc = myEntryDialog("open dir","Please enter directory:",\$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  =~ 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);
  $dirtree->configure(-directory => $actdir);
  # Set the directory
  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('Directory 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 directory 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 directories",
					 -variable => \$config{ShowUnfinishedDirs}
					 )->pack(-side => 'left', -expand => 0,-fill => 'x',-padx => 1,-pady => 1);
  $topf->Checkbutton(-text => "Show finished directories",
					 -variable => \$config{ShowFinishedDirs}
					 )->pack(-side => 'left', -expand => 0,-fill => 'x',-padx => 1,-pady => 1);

  my $dpmenu = $dpw->Menu(-title => "Directory Checklist Menu");

  $dpmenu->command(-label => "open directory",
				   -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 => "Directory 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 => "Directory 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 $i = 0;
	my $pw = progressWinInit($top, "Collect sub directories");
	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)) {
			   $i++; $i = 0 if ($i > 10);
			   progressWinUpdate($pw, "collecting directories, found  ".scalar @alldirs." ...", $i, 10);
			   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." directories, getting size ...";

	# hash key: directory value: size of dir in Bytes (including all subdirs)
	my %dirsize;
	my $max       = 0;
	#my $allsize   = 0;
	my $dirCount  = 0;
	my $fileCount = 0;
	$i  = 0;
	$pw = progressWinInit($top, "Calculate directory sizes");
	foreach my $dir (@alldirs) {
	  if (progressWinCheck($pw)) {
		$break = 1;
		last;
	  }
	  $i++;
	  progressWinUpdate($pw, "in directory $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('Directory 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;
  $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;

  if ($EvilOS) {
	if  ($win32FOAvail) {
	  print "FileOp is available!\n" if $verbose;
	  # this is untested!!! todo
	  $dir = BrowseForFolder("Choose Directory", "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 directory',
#				  'There is no directory selector available, so please select a file instead of the directory.
#You may use any file, Mapivi will use the directory of that file.
#If the directory is empty, you may create a new file and select this.
#Sorry for that inconvenience!

#Example:
#To use the directory 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 directory 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 directory", -initialdir => $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 directory ...');
	$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 directory',
						  -command => sub { makeNewDir($dir, $d); })->pack(-fill => 'x');
	$balloon->attach($mkdB, -msg => "The new directory will be created underneath the selected directory.\nSo, please select a directory 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;
						return if (@_ >= 1);
						if (!-d $dir) { print "$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 directory
					  -command   => sub { $ok = 1; $t->destroy; },
					  # With this version of -command a double-click will
					  # open a directory. Selection is only possible with
					  # the Ok button.
					  #-command   => sub { $d->opencmd($_[0]) },
					 )->pack(-fill => "both", -expand => 1);
	# Set the initial directory
	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 [file|directory]\n\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}); # format the comment for the list
  $iptc    = formatString($iptc, $config{LineLength}); # format the IPTC info for the list

  # update the metainfo in the listbox
  $lb->itemConfigure($dpic, $lb->{thumbcol}, -text => getThumbCaption($dpic));
  $lb->itemConfigure($dpic, $lb->{comcol},   -text => $com);
  $lb->itemConfigure($dpic, $lb->{exifcol},  -text => $exif);
  $lb->itemConfigure($dpic, $lb->{iptccol},  -text => $iptc);
  $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;
}

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;

  # 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
  if (@sellist == 1) {
	# if we edit just one file, we use the IPTC info as master (no matter if it's empty)
	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');
	}
  }
  my $rc    = iptcDialog($iptcm, $pic, scalar @sellist);
  return if ($rc ne 'OK');

  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 = $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]);
		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/\n -~//cd;              # remove non-printable characters (but not \n)
		  $owner =~ s/\r//g;			       # cut \r (carriage return)
		  $owner =~ s/\n//g;			       # cut \n (newline)
		  $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;
	}
	
	$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);
        showImageInfoCanvas($dpic) if ($dpic eq $actpic);

  }
  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;

	$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;
	  if ($dpic eq $actpic) {
		$urgencyStr   = $urgency; # display new urgency in the status bar
		unless ($urgency eq "") {
		  $urgencyScale = 9 - $urgencyStr;
		  $urgencyScale = 0 if (($urgencyStr < 1) or ($urgencyStr > 8));
		}
	  }
	}

	# touch the thumbnail pic (set actual time stamp), to suppress rebuilding
	touch($dirthumb);

	updateOneRow($dpic, $lb);
  }
  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}};
  }

  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{$_}) {
		  # todo this cuts very long desc because of config{LineLimit}
		  $balloon->attach($ent, -msg => formatString($_.":\n".$iptcHelp{$_}, 80)) 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),
					   \${$iptc->{'Credit'}}[0],
					   formatString("Credit:\n".$iptcHelp{'Credit'}, 80));
    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),
					 \${$iptc->{ByLine}}[0],
					 formatString("ByLine:\n".$iptcHelp{'ByLine'}, 80));
  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)) 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)) if (Exists $ent);
  }
  labeledDoubleEntry($locF, 'top', $w, 'City', 'Province/State',
					 \${$iptc->{'City'}}[0],
					 formatString("City:\n".$iptcHelp{'City'}, 80),
					 \${$iptc->{'Province/State'}}[0],
					 formatString("Province/State:\n".$iptcHelp{'Province/State'}, 80));
  labeledDoubleEntry($locF, 'top', $w, 'Country', 'Code',
					 \${$iptc->{'Country/PrimaryLocationName'}}[0],
					 formatString("Country/PrimaryLocationName:\n".$iptcHelp{'Country/PrimaryLocationName'}, 80),
					 \${$iptc->{'Country/PrimaryLocationCode'}}[0],
					 formatString("Country/PrimaryLocationCode:\n".$iptcHelp{'Country/PrimaryLocationCode'}, 80));
  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),
					   \${$iptc->{TimeCreated}}[0],
					   formatString("TimeCreated:\n".$iptcHelp{'TimeCreated'}, 80));

    labeledDoubleEntry($dateF, 'top', $w, 'Date released', 'Time',
					   \${$iptc->{ReleaseDate}}[0],
					   formatString("ReleaseDate:\n".$iptcHelp{'ReleaseDate'}, 80),
					   \${$iptc->{ReleaseTime}}[0],
					   formatString("ReleaseTime:\n".$iptcHelp{'ReleaseTime'}, 80));
    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}) {
    $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)); # 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)); # 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(-side => 'left', -anchor => 'w');
  $optF->Radiobutton(-text => 'Simple', -variable => \$config{IPTCProfessional}, -value => 0)->pack(-side => 'left', -anchor => 'w');
  $optF->Radiobutton(-text => 'Professional', -variable => \$config{IPTCProfessional}, -value => 1)->pack(-side => 'left', -anchor => 'w');
  $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 subdirectory 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
                 store($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
                 store($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 supplemental 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 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      => 16,
						   -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",
								   "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",
								   "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

  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 > $cropPreviewSize or $h > $cropPreviewSize) {
	$userinfo = "rotate: resizing preview picture ..."; $userInfoL->update;
	my $command = "mogrify -geometry ${cropPreviewSize}x${cropPreviewSize} -quality 70 \"$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  => $cropPreviewSize,
							  -height => $cropPreviewSize,
							  -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 => $cropPreviewSize,
			 -from => 0,
			 -to => $cropPreviewSize,
			 -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 => $cropPreviewSize,
 			   -from => 0,
 			   -to => $cropPreviewSize,
 			   -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 (directory, link) or (dirlink) where
#                 dirlink consists of directory 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; # if $$varRef contains "no-entry" no entry is displayed
  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;

  # if $$varRef contains no-entry we create a entry dialog without a entry :)
  if ($$varRef ne "no-entry") {
	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;
  }
  else {
	$myDiag->bind('<Return>', sub { $OKB->invoke; } );
  }

  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);

  $OKB->focus if ($$varRef eq "no-entry");

  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; # if $$varRef contains "no-entry" no entry is displayed
	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);
					  store($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);
				  store($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 $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);
  bindMouseWheel($listBox);

  $listBox->insert('end', @list);

  $listBox->bind('<Double-Button-1>', sub {
					  @$sellist = $listBox->curselection();
					  $rc = 1;
					} );

  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 => "Directory Menu");
}

##############################################################
# createDirMenu
##############################################################
sub updateDirMenu {

  return if (!defined($dirMenu));

  # clear dir menu
  $dirMenu->delete(0, 'end');

  $dirMenu->command(-label => "open directory ...", -command => sub {
					  my $dir = getRightDir();
					  openDirPost($dir);}, -accelerator => "double click");
  $dirMenu->command(-label => "preview directory ...", -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(-label => "search in directory ...", -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(-label => 'directory size');
  $dir_size->command(-label => "calculate directory size ...", -command => sub { calcDirSize(); } );
  $dir_size->command(-label => "display directory sizes (graphic) ...", -command => sub { showDirSizes(getRightDir()); } );

  $dirMenu->separator;
  $dirMenu->command(-label => "rename directory ...", -command => sub { renameDir(); });
  $dirMenu->command(-label => "new directory ...",    -command => sub {
	  my $dir = getRightDir();
	  if (!-d $dir) { warn "dir $dir is no dir"; return; }
	  makeNewDir($dir, $dirtree); });
  $dirMenu->command(-label => "delete directory ...", -command => sub { deleteDir(); });

  $dirMenu->separator;
  my $dir_hot  = $dirMenu->cascade(-label => 'directory hotlist');
  $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();
					});
  my $i = 0;

  # add the 12 most wanted hotlist directories :)
  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 directory
	#$dirMenu->command(-label => "$_", -command => sub { openDirPost($dir); }, -accelerator => "($dirHotlist{$_})");
	$dirMenu->command(-label => "$_", -command => sub { openDirPost($dir); });
  }

  $dirMenu->separator;

  # add the last used directories
  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(-label => "rescan directory", -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(-label => "show picture in new window",  -command => \&showPicInOwnWin, -accelerator => "<d>" );
  $picMenu->separator;
  addPicProcessing($picMenu);
  $picMenu->separator;
  addZoomMenu($picMenu);
  $picMenu->separator;
  $picMenu->command(-label => "options ...",  -command => \&options, -accelerator => "<Ctrl-o>");
  $picMenu->command(-label => "switch layout",  -command => sub { $config{Layout}++; layout(1); } );
  $picMenu->command(-label => "toggle fullscreen mode",  -command => sub { topFullScreen(); } );
}

##############################################################
# 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");

  $file_menu->command(-label => "open directory ...",   -command => \&openDir, -accelerator => "<o>");
  $file_menu->command(-label => "preview directory ...", -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(-label => "search in directory ...", -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(-label => 'directory size ...');
  $dir_size->command(-label => "calculate directory size ...", -command => sub { calcDirSize(); } );
  $dir_size->command(-label => "display directory sizes (graphic) ...", -command => sub { showDirSizes(getRightDir()); } );

  $file_menu->separator;
  $file_menu->command(-label => "rename directory ...", -command => \&renameDir);
  $file_menu->command(-label => "new directory ...",    -command => sub { 
	  my $dir = getRightDir();
	  if (!-d $dir) { warn "dir $dir is no dir"; return; }
	  makeNewDir($dir, $dirtree); } );
  $file_menu->command(-label => "delete directory ...", -command => \&deleteDir);

  $file_menu->command(-label => "hot directories ...",  -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(-label => "trash");
  $trash_menu->command(-label => "empty trash ...",         -command => \&emptyTrash);
  $trash_menu->command(-label => "open trash in main window", -command => [\&openDirPost, $trashdir]);
  $file_menu->command(-label => "directory checklist ...", -command => sub { showDirProperties(); } );
  $file_menu->command(-label => "import wizard ...",    -command => \&importWizard);

  $file_menu->separator;
  $file_menu->command(-label => "light table (slideshow) ...", -command => \&light_table_open_window);
  $file_menu->command(-label => "convert non-JPEG pictures ...", -command => \&convertNonJPEGS);
  $file_menu->command(-label => "rescan directory", -accelerator => "<u>",
					  -command => \&updateThumbsPlus);
  $file_menu->command(-label => "rebuild thumbs ...", -command => \&rebuildThumbs, -accelerator => "<Ctrl-r>");
  $file_menu->command(-label => "build thumbs ...",    -command => \&buildThumbsRecursive);
  $file_menu->separator;
  $file_menu->command(-label => "iconify", -accelerator => "<ESC>",   -command => sub { $top->iconify; });
  $file_menu->command(-label => "restart",   -command => \&restart) unless ($EvilOS);
  $file_menu->command(-label => "quit", -accelerator => "<q>",   -command => \&quitMain);


  addSelectMenu($edit_menu);
  $edit_menu->separator;

  addPicProcessing($edit_menu);
  $edit_menu->separator;
  $edit_menu->command(-label => "search ...",  -command => \&searchMetaInfo, -accelerator => "<Ctrl-s>");
  $edit_menu->separator;

  # add the comments, EXIF and IPTC menu
  addMetaInfoMenu($edit_menu);

  $view_menu->command(-label => "next", -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(-label => "previous", -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(-label => "first", -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(-label => "last", -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(-label => "go to/select ...", -command => sub { gotoPic($picLB); },
					  -accelerator => "<Ctrl-g>");

  $view_menu->separator;

  addZoomMenu($view_menu);
  $view_menu->separator;
  $view_menu->checkbutton(-variable => \$config{ShowCoordinates}, -label => "display mouse coordinates");
  $view_menu->separator;

  $view_menu->command(-label => "open picture in new window", -command => \&showPicInOwnWin, -accelerator => "<d>");
  $view_menu->command(-label => "open picture in external viewer", -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(-label => "start/stop slideshow", -command => sub {
						if ($slideshow == 0) {
						  $slideshow = 1;
						} else {
						  $slideshow = 0;
						}
						slideshow();
					  }, -accelerator => "<s>");
 $view_menu->command(-label => "smart update",
					  -command => sub { smart_update(); });


  $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(-label => "search ...",             -command => \&searchMetaInfo, -accelerator => "<Ctrl-s>");
  $find_menu->command(-label => "search for file name ...",  -command => sub { searchFileName($picLB);});
  $find_menu->command(-label => "search duplicates ...",  -command => \&findDups);
  $find_menu->separator;
  $find_menu->command(-label => "add to database ...",     -command => \&buildDatabase);
  $find_menu->command(-label => "clean database ...",     -command => \&cleanDatabase);
  $find_menu->command(-label => "check database ...",     -command => \&checkDatabase);
  $find_menu->command(-label => "edit database ...",      -command => \&editDatabase);
  $find_menu->separator;
  $find_menu->command(-label => "browse database by timeline ...", -command => \&database_info);
  $find_menu->command(-label => "browse database by keywords ...", -command => \&keyword_browse);
  #$find_menu->command(-label => "check for new keywords ...", -command => \&check_new_keywords);

  $opti_menu->command(-label => "options ...",  -command => \&options, -accelerator => "<Ctrl-o>");
  $opti_menu->command(-label => "save options",  -command => \&saveAllConfig);
  $opti_menu->separator;
  $opti_menu->checkbutton(-label => "show picture", -variable => \$config{ShowPic},
						  -command => sub { showPic($actpic); });
  $opti_menu->checkbutton(-label => "show menu bar", -variable => \$config{ShowMenu},
						  -command => \&showHideFrames);

  $opti_menu->separator;

  $opti_menu->radiobutton(-label => "thumbnail caption: none", -variable => \$config{ThumbCapt},  -value => "none", -command => sub { updateThumbsPlus(); });

  $opti_menu->radiobutton(-label => "thumbnail caption: file name without suffix", -variable => \$config{ThumbCapt},  -value => "filename", -command => sub { updateThumbsPlus(); });

  $opti_menu->radiobutton(-label => "thumbnail caption: file name with suffix", -variable => \$config{ThumbCapt},  -value => "filenameSuffix", -command => sub { updateThumbsPlus(); });

  $opti_menu->radiobutton(-label => "thumbnail caption: IPTC object name", -variable => \$config{ThumbCapt},  -value => "objectname", -command => sub { updateThumbsPlus(); });

  $opti_menu->separator;

  $opti_menu->checkbutton(-label => "show file info", -variable => \$config{ShowFile},  -command => \&toggleHeaders);
  $opti_menu->checkbutton(-label => "show IPTC/IIM", -variable => \$config{ShowIPTC},  -command => \&toggleHeaders);
  $opti_menu->checkbutton(-label => "show comments", -variable => \$config{ShowComment},  -command => \&toggleHeaders);
  $opti_menu->checkbutton(-label => "show EXIF", -variable => \$config{ShowEXIF},  -command => \&toggleHeaders);
  $opti_menu->checkbutton(-label => "show folder", -variable => \$config{ShowDirectory},  -command => \&toggleHeaders);

  $opti_menu->separator;
  $opti_menu->command(-label => "switch layout", -command => sub { $config{Layout}++; layout(1); }, -accelerator => "<l>");


  $extr_menu->command(-label => "export filelist ...",               -command => \&exportFilelist);
  $extr_menu->command(-label => "diff directories ...",              -command => sub { dirDiffWindow(); } );
  $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 border ...",           -command => \&losslessBorder);
  $extr_menu->command(-label => "build difference picture",          -command => \&diffPics);
  $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 directory ...",               -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);
  $extr_menu->separator;
  $extr_menu->command(-label => "show TOP50 of most popular pictures",   -command => \&showMostPopularPics);

  makePlugInsMenu($plug_menu);

  $help_menu->command(-label => "About",        -command => \&about);
  $help_menu->command(-label => "Keys",         -command => \&showkeys);
  $help_menu->command(-label => "Tips",         -command => sub { showFile("$configdir/Tips.txt") }) if (-f "$configdir/Tips.txt");
  $help_menu->command(-label => "System infos", -command => \&systemInfo);
  $help_menu->command(-label => "License",      -command => [\&showFile, "$configdir/License.txt"]) if (-f "$configdir/License.txt");
  $help_menu->command(-label => "History",      -command => [\&showFile, "$configdir/Changes.txt"]) if (-f "$configdir/Changes.txt");
  $help_menu->command(-label => "FAQ",          -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(-label => "rotate (clockwise) ...");
	$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(-label => "change size/quality ...", -command => \&changeSizeQuality, -accelerator => "<Ctrl-q>" );
    $menu->command(-label => "crop (lossless) ...",     -command => sub { crop($picLB); }, -accelerator => "<Ctrl-c>");
    $menu->command(-label => "image processing ...", -command => \&filterPic, -accelerator => "<Ctrl-f>");
    $menu->command(-label => "make grayscale ...", -command => sub { grayscalePic($picLB); } );
    $menu->command(-label => "add border or copyright ...", -command => \&addDecoration, -accelerator => "<Ctrl-b>");
    $menu->command(-label => "edit in GIMP", -command => \&GIMPedit, -accelerator => "<Ctrl-e>") unless ($exprogs{"gimp-remote"} or $exprogs{"gimp-win-remote"});
}

##############################################################
# addFileActionsMenu
##############################################################
sub addFileActionsMenu {

  my $menu = shift;
  my $lb   = shift;
  my $fop_menu = $menu->cascade(-label => "file operations ...");
  $fop_menu->command(-label => "copy to ...",    -command => sub { copyPicsDialog(COPY, $lb); } );
  $fop_menu->command(-label => "link to ...",    -command => \&linkPicsDialog) if (!$EvilOS);
  $fop_menu->command(-label => "move to ...",    -command => sub { movePicsDialog($lb); } );
  $fop_menu->command(-label => "convert ...",    -command => sub { convertPics($lb); } );
  $fop_menu->command(-label => "copy to print ...", -command => sub { copyToPrint($lb); }, -accelerator => "<Ctrl-p>");
  $fop_menu->command(-label => "rename ...",     -command => sub { renamePic($lb); }, -accelerator => "<r>");
  $fop_menu->command(-label => "smart rename ...", -command => sub { renameSmart($lb); }, -accelerator => "<R>");
  $fop_menu->command(-label => "make backup",    -command => sub { copyPicsDialog(BACKUP, $lb); } );
  $fop_menu->command(-label => "make HTML ...",  -command => sub { makeHTML($lb); });
  $fop_menu->separator;
  $fop_menu->command(-label => "delete to trash",  -accelerator => "<Delete>",
					  -command => sub { deletePics($lb, TRASH); } );
  $fop_menu->command(-label => "delete ...",  -accelerator => "<Shift-Delete>",
						-command => sub { deletePics($lb, REMOVE); } );
}

##############################################################
# addSelectMenu
##############################################################
sub addSelectMenu {

  my $menu = shift;
  my $sel_menu = $menu->cascade(-label => "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(-label => "IPTC/IIM info");
  $iptc_menu->cget(-menu)->configure(-title => "IPTC/IIM menu");

  $iptc_menu->command(-label => "show",       -command => sub { displayIPTCData($picLB); }, -accelerator => "<i>");
  $iptc_menu->command(-label => "edit ...",   -command => sub { editIPTC($picLB); }, -accelerator => "<Ctrl-i>");
  $iptc_menu->command(-label => "remove ...", -command => \&removeIPTC);
  $iptc_menu->separator;
  $iptc_menu->command(-label => "copy from ...", -command => \&copyIPTC);
  $iptc_menu->command(-label => "copy to ...",   -command => \&pasteIPTC);
  $iptc_menu->separator;
  $iptc_menu->command(-label => "add/remove keywords ...", -command => sub { editIPTCKeywords($picLB); }, -accelerator => '<Ctrl-k>');
  $iptc_menu->command(-label => "add/remove categories ...", -command => sub { editIPTCCategories($picLB); } , -accelerator => '<Ctrl-t>');
  $iptc_menu->separator;
  $iptc_menu->command(-label => "save template ...",  -command => \&saveIPTC);
  $iptc_menu->command(-label => "merge template ...", -command => \&mergeIPTC);

  $iptc_menu->separator;
  addRatingMenu($iptc_menu, $picLB);
  addRatingMenu($menu, $picLB);

  my $exif_menu = $menu->cascade(-label => "EXIF info");
  $exif_menu->cget(-menu)->configure(-title => "EXIF menu");
  $exif_menu->command(-label => "show info",      -command => sub { displayEXIFData($picLB); }, -accelerator => "<x>");
  $exif_menu->command(-label => "show thumbnail", -command => \&showEXIFThumb,   -accelerator => "<t>");
  $exif_menu->command(-label => "save thumbnail ...", -command => \&getEXIFThumb);
  $exif_menu->command(-label => "(re)build thumbnail ...", -command => \&buildEXIFThumb);
  $exif_menu->separator;
  $exif_menu->command(-label => "copy from",   -command => [\&copyEXIFData, "from"]);
  $exif_menu->command(-label => "copy to ...", -command => [\&copyEXIFData, "to"]);
  $exif_menu->command(-label => "copy thumbnail to ...", -command => \&copyThumbnail);
  $exif_menu->separator;
  $exif_menu->command(-label => "save",        -command => \&EXIFsave);
  $exif_menu->command(-label => "restore ...", -command => \&EXIFrestore);
  $exif_menu->command(-label => "remove saved info ...", -command => \&EXIFremoveSaved);
  $exif_menu->separator;
  $exif_menu->command(-label => "set date/time ...", -command => \&setEXIFDate);
  $exif_menu->separator;
  $exif_menu->command(-label => "remove thumbnail ...", -command => [\&removeEXIFData, "thumb"]);
  $exif_menu->command(-label => "remove all ...", -command => [\&removeEXIFData, "all"]);

  my $comm_menu = $menu->cascade(-label => "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(-label => "edit ...",   -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(-label => "copy from",  -command => [\&copyComment, "from"]);
  $comm_menu->command(-label => "copy to ...",  -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(-label => "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 directory size");
  find(sub {
		 if (progressWinCheck($pw)) { $break = 1; $File::Find::prune = 1; }
		 # we don't know how long it will take, so we leave the progressbar at 50%
		 progressWinUpdate($pw, "size $size Bytes", 5, 10);
		 $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 directory size of $dir is $unitSize ($size Bytes)",
				   -title => "Directory size", -type => 'OK');
}

##############################################################
# buildThumbsRecursive - scans through all subdirectories 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 directories of $basedir and collect all directories containing JPEG files.\nThen you are able to select in which directories mapivi should build/refresh thumbnails.",
				   -title => "Build thumbnails in all sub directories", -type => 'OKCancel');
  return if ($rc !~ m/Ok/i);

  $userinfo = "searching sub directories ..."; $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 $i = 0;
  my $pw = progressWinInit($top, "Collect sub directories");
  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)) {
		   $i++; $i = 0 if ($i > 10); # restart progressbar every 10 steps; todo
		   progressWinUpdate($pw, "collecting directories, found ".scalar @dirlist." ...", $i, 10);
		   @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 directories";
	return;
  }

  $config{CheckForNonJPEGs} = $tmp;

  $userinfo = "found ".@dirlist." sub directories"; $userInfoL->update;

  my @sellist;
  return if (!mySelListBoxDialog("Select directories",
								 "Found ".scalar @dirlist." directories with $pic_count JPEG pictures.\nThumbnails will be created/updated in the selected directories.",
								 "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;

  $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);
	my $process = "copy";
	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 (mycopy ($dpic, $tpic, OVERWRITE)) {
			$n++;
			if ((-d dirname($thumbtpic)) and (-f $thumbpic)) {
				mycopy ("$thumbpic","$thumbtpic", OVERWRITE)
				}

			$searchDB{$tpic} = $searchDB{$dpic}; # copy meta info in search database

			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;

	reselect($lb, @sellist);
}

##############################################################
# 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 directory from the list below or open the directory browser\nby double clicking the first item or by just pressing OK.\n\nDirectories from the hotlist and recently visited direcories:";
  my $another = "Open directory browser";
  my @list;
  my @sellist;


  # sort dirs hash by numerical value reverse (number of accesses)
  # %dirHotlist contains directories 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 directories
  foreach (reverse @dirHist) {
	next if (!-d $_);
	push @list, $_;
  }

  # remove duplicates and sort directory list alphabetical
  my %saw;
  @saw{@list} = ();
  @list = ();
  @list = sort keys %saw;

  # put the "Open directory browser" item at the first position
  unshift @list, $another;

  return '' unless (mySelListBoxDialog($title, $text, '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 $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")) {
	  $lb->messageBox(-icon => 'warning', -message => "Could not move $dpic to $tpic: $!",
					   -title => 'Error', -type => 'OK');
	} 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")) {
		  $lb->messageBox(-icon => 'warning', -message => "Could not move $thumbpic to $thumbtpic: $!",
						   -title => 'Error', -type => 'OK');
		}
	  }
	  # 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")) {
#			$lb->messageBox(-icon => 'warning', -message => "Could not move $njpic to $targetdir: $!",
#							 -title => 'Error', -type => 'OK');
#		  }
#		}
#	  }
	  $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 ($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);

  return if (!checkExternProgs("sendTo", "thunderbird"));

  # check if some files are links
  return if (!checkLinks($lb, @sellist));

  # 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 directory"; $userInfoL->update;
					  foreach $dpic (@sellist) {
						mycopy($dpic, $trashdir, OVERWRITE);
					  }
					  # exchange the directory 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
					  }
					}

					$userinfo = "send to: starting email client ..."; $userInfoL->update;
					my $command = "thunderbird -compose \"subject=Fotos,attachment=\'$pics\'\"";
					$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 $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)) {
	  $lb->messageBox(-icon => 'warning', -message => "Could not rename $pic to $newname: $!",
					   -title => 'Error', -type => 'OK');
	  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")) {
		$lb->messageBox(-icon => 'warning', -message => "Could not rename thumbnail $pic to $newname: $!",
						 -title => 'Error', -type => 'OK');
	  }
	}

	# rename exif info file, if any
	if (-f "$dir/$exifdirname/$pic") {
	  if (!rename ("$actdir/$exifdirname/$pic", "$actdir/$exifdirname/$newname")) {
		$lb->messageBox(-icon => 'warning', -message => "Could not rename exif info file $pic to $newname: $!",
						 -title => 'Error', -type => 'OK');
	  }
	}

	# rename backup file, if any
	renameBackup($lb, $dpic, $newname, ASK);

  }
  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)

Examples:
"%y%m%d-%h%M%s" will rename all pictures to their internal EXIF
date e.g. 20061231-155959 (the file date will be used, if there
is no EXIF date).

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 to 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 the ".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 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
#                  "-00" to the first pic of a set
#                  e.g. pic1.jpg    and pic1-01.jpg will become
#                       pic1-00.jpg and pic1-01.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-01.jpg
  foreach my $dpic (@piclist) {
	if ($dpic =~ m/(.*)-01\.(.*)$/i) {   # e.g. file-01.jpg
	  my $pic  = "$1.$2";
	  my $npic = "$1-00.$2";
	  # if there is a file named file.jpg
	  if (defined $hash{$pic}) {
		# and no file named file-00.jpg
		unless (defined $hash{$npic}) {
		  print "renameSmartFix: rename $pic to $npic\n" if $verbose;
		  # we rename file.jpg to file-00.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;
	}

	# 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-03.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 .. 99 ) {
	if (-f  "$dir/$new$suffix") {
	  $new = sprintf "%s-%02d", $base, $_;
	} 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 keywords');
  $win->iconimage($mapiviicon) if $mapiviicon;

  my $text = 'Found new 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 directory 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);

  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 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);
  }
}

##############################################################
# openWith
##############################################################
sub openWith {
  # todo
  $top->messageBox(-icon => 'warning', -message => '"Open with ..." is not yet implemented, sorry!',
				   -title => 'Error', -type => 'OK');
}

##############################################################
# 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);
		$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";
		  }
		}
	  } 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 directory failed",
								  -text => "Can't change to $newDir directory: $!",
								  -buttons => ['OK']);
		$dialog->Show();
		warn "Can't change to $newDir directory: $!";
		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 = "directories-thumbnails-picture";
	$config{ShowDirTree}    = 1;
	$config{ShowThumbFrame} = 1;
	$config{ShowPicFrame}   = 1;
  }
  elsif ($config{Layout} == 1) {
	$info = "directories-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 = "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;

  my $fullscreen = 0;

  my $lb = 0;

  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;
  }

  if (!-f $dpic) {
	$top->messageBox(-icon => 'warning', -message => "showPicinOwnWin: Error no file $dpic",
					 -title => 'Error', -type => 'OK');
	return;
  }

  my $pic = basename($dpic);
  $userinfo = "opening $pic in new window ..."; $userInfoL->update;
  my $photo = $top->Photo(-file => $dpic, -gamma => $config{Gamma});
  if (! $photo) {
	$top->messageBox(-icon => 'warning', -message => "showPicinOwnWin: Error no photo $pic!",
					 -title => 'Error', -type => 'OK');
	$userinfo = ""; $userInfoL->update;
	return;
  }

  increasePicPopularity($dpic);
  if (($config{trackPopularity}) and ($lb == $picLB)) {
	  updateOneRow($dpic, $lb); # update popularity (viewed x times) info
	  $lb->update;
  }

  my $zoomFactor = autoZoom(\$photo, $dpic, $top->screenwidth, $top->screenheight);

  # open window
  my $win = $top->Toplevel(-bg => "black");
  #$win->withdraw;
  $win->title("$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);
  $balloonmsg   .= "\n\n(Click on picture to close window)";
  $balloon->attach($but, -balloonposition => "mouse", -msg => \$balloonmsg);

  $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; });

# key-desc,F11,toggle fullscreen mode when displaying picture in own window
  $win->bind('<Key-F11>', sub
			 {
			   $fullscreen = ($fullscreen) ? 0 : 1;
			   fullscreen($win, $fullscreen);
			 });

# key-desc,o,overrideredirect (fullscreen mode - experimental) when displaying picture in own window
  $win->bind('<Key-o>', sub
			 {
			   #print "override=".$config{Overrideredirect}."\n";
			   if ($config{Overrideredirect}) {
				 #print "no frame\n";
				 #fullscreen($win, 1);
				 #$but->bind('<Enter>',sub{$but->focusForce;$but->grabGlobal});
				 #$but->bind('<Leave>',sub{$but->grabRelease});
				 #$win->focusForce;
				 #$win->grabGlobal;
				 $config{Overrideredirect} = 0; # toggle
			   } else {
				 #print "frame\n";
				 #fullscreen($win, 0);
				 #$win->grabRelease();
				 $config{Overrideredirect} = 1; # toggle
			   }
			   #print "override=".$config{Overrideredirect}."\n";
			   fullscreen($win, $fullscreen);
			   $win->bind('<Enter>',sub{$win->focusForce;$win->grabGlobal;});
			   $win->bind('<Leave>',sub{$win->grabRelease});
			 }
			);

  #$win->deiconify;
  #$win->raise;
  fullscreen($win, $fullscreen);
  $but->focusForce if (Exists($but));
  $userinfo = "ready!"; $userInfoL->update;
}

##############################################################
# 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 = 0; $index = shift; # start index number, optional, defaults to first pic (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");
  #$win->withdraw;
  $win->title(sprintf "(%d/%d) %s %s", ($index+1), ($#{@{$pic_list}}+1), $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 {
	$win->Busy;
	$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;
	$win->Unbusy;
  });

  $win->bind('<Key-Prior>', sub {
	$win->Busy;
	$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;
	$win->Unbusy;
	});
  # key-desc,F11,toggle fullscreen mode when displaying picture in own window
  #$win->bind('<Key-F11>', sub
	#		 {
	#		   $fullscreen = ($fullscreen) ? 0 : 1;
	#		   fullscreen($win, $fullscreen);
	#		 });

  #$win->deiconify;
  #$win->raise;
  $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 - todo: will throw a warning if started somewhere else and dpic is not in this lb
	  $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', -expand => 1);

  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));
  my $rows    = int($nr/$cols) + 1;
     $rows    = $maxrows if ($rows > $maxrows);
  print "tiler: nr:$nr col:$cols row:$rows maxroe:$maxrows\n" if $verbose;

  my $tiler = $win->Scrolled("Tiler",
							 -columns    => $cols,
							 -rows       => $rows,
							 -scrollbars => 'oe',
						   )->pack(-fill => 'both', -expand => 1);

  bindMouseWheel($tiler);

  # 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", -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 directory\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.",
									  -title => 'directory 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);
	  $exif = "\nEXIF: ".$exif;
  }
  my $iptc       = getIPTC($dpic, SHORT);
  $iptc = formatString($iptc, 80);  # 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);
  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";
}

##############################################################
# fullscreen
##############################################################
sub fullscreen {
  my $win        = shift;
  #my $dpic       = shift;
  my $fullscreen = shift;

  #my $geo;
  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 olso 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?!
}

##############################################################
# 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;
# }

##############################################################
# systemInfo - show some infos about the system to the user
##############################################################
sub systemInfo {

  my $string = "Here is a list of all external programs used by mapivi:\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);
}

##############################################################
# 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 directories (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 directory (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 the file date in the size column")->pack(-anchor => 'w');
  $aF->Checkbutton(-variable => \$tmpconf{RenameBackup}, -text =>
				   "Rename the backup file, if the file is renamed")->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 thumbnail", \$tmpconf{ThumbMaxLimit}, 10, 1000, 10);
  $balloon->attach($aFtp, -msg => "Each thumbnail eats up a little bit of memory
(about 40kByte), so opening a directory
with a huge number of pictures may be dangerous.
With this option you are able to limit the
memory consumption of the thumbnails.
The remainding thumbnails will be displayed
with the default thumbnail.");

  my $aFst = labeledScale($aF, 'top', $w, "Maximum size of trash (MB)", \$tmpconf{MaxTrashSize}, 1, 250, 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 directory 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 $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);
  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 $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: directory",'Set',\$tmpconf{ColorDir});

  # ###############  advanced notepad  ########################

  $w = 37;
  $dF->Checkbutton(-variable => \$verbose,
				   -text => "verbose: print some debug info to STDOUT")->pack(-anchor => 'w');

  $dF->Checkbutton(-variable => \$tmpconf{trackPopularity},
				   -text => "Track popularity of pictures (how often viewed in Mapivi)")->pack(-anchor => 'w');

  $dF->Checkbutton(-variable => \$tmpconf{CheckForLinks},
				   -text => "Check if a file is a link before processing it")->pack(-anchor => 'w');

  $dF->Checkbutton(-variable => \$tmpconf{AddMapiviComment},
				   -text => "add a comment to pictures created/processed by mapivi")->pack(-anchor => 'w');

  $dF->Checkbutton(-variable => \$tmpconf{EXIFshowApp},
				   -text => "show App*-Info and MakerNotes and ColorComponents in EXIF info")->pack(-anchor => 'w');
  $dF->Checkbutton(-variable => \$tmpconf{ShowUrgency},
				   -text => "show the rating (the IPTC urgency flag) in the status line (needs restart)")->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 directories (.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');

  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 comment", \$tmpconf{LineLimit}, 1, 20, 1);
  labeledScale($dF, 'top', $w, "Maximum length of a comment line", \$tmpconf{LineLength}, 5, 80, 1);
  labeledEntry($dF, 'top', $w, "External picture viewer",\$tmpconf{ExtViewer});
  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".');

  # ###############  button frame  ########################

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

  $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');
  $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, $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) ;
  }

  $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 directory 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,
							-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);

  # 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 directory","Enter name of new directory 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 directory \"$dirname\"\n($dir)?\nThere is no undelete!",
							  -title => "Delete directory?",
							  -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 directory ..."; $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 = "directory scanned!"; $userInfoL->update;
	$size = computeUnit($size);

	my $question = sprintf "There are%s\n%8d directories 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 directory?",
						   -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 directory \"$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 directory","Enter new name for directory $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 renameing directory $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 = sprintf("%.0f",($nw/$aspect)); # int() does not round!
  }
  else {            # portrait
	$nh = $w;
	$nw = sprintf("%.0f",($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  = sprintf("%.0f",($width/$origW  * 100));
				 $heightP = sprintf("%.0f",($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               = sprintf("%.0f",($width/$origW  * 100));
				 $heightP              = sprintf("%.0f",($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            = sprintf("%.0f",($origW * $widthP/100));
				 $height           = sprintf("%.0f",($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           = sprintf("%.0f",($width/$origW  * 100));
				 $heightP          = sprintf("%.0f",($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           = sprintf("%.0f",($width/$origW  * 100));
				 $heightP          = sprintf("%.0f",($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           = sprintf("%.0f",($width/$origW  * 100));
				 $heightP          = sprintf("%.0f",($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           = sprintf("%.0f",($width/$origW  * 100));
				 $heightP          = sprintf("%.0f",($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           = sprintf("%.0f",($width/$origW  * 100));
				 $heightP          = sprintf("%.0f",($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 = sprintf("%.0f",($width/$aspect)); # int() does not round!
				 }
				 $widthP  = sprintf("%.0f",($width/$origW  * 100));
				 $heightP = sprintf("%.0f",($height/$origH * 100));
				 $PixPro  = "pix";
			   });
  $labEh->bind('<FocusOut>', sub {
				 if ($keepaspect) {
				   $width = sprintf("%.0f",($aspect*$height));
				 }
				 $widthP  = sprintf("%.0f",($width/$origW  * 100));
				 $heightP = sprintf("%.0f",($height/$origH * 100));
				 $PixPro  = "pix";
			   });
  $labEwp->bind('<FocusOut>', sub {
				  if ($keepaspect) {
					$heightP = $widthP; # int() does not round!
				  }
				  $width  = sprintf("%.0f",($origW * $widthP/100));
				  $height = sprintf("%.0f",($origH * $heightP/100));
				  $PixPro  = "pro";
				});
  $labEhp->bind('<FocusOut>', sub {
				  if ($keepaspect) {
					$widthP = $heightP;
				  }
				  $width  = sprintf("%.0f",($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
					  store(\%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));
	}

	# save crop frame offset before adjusting to 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});
		}
	  }
	} 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});
		} else {				     # too high
		  $h = sprintf "%.0f", ($w / $config{CropAspect});
		}
	  } else {					     # portait image
		if (($h != 0) and ($w/$h >= 1/$config{CropAspect})) { # too wide
		  $w = sprintf "%.0f", ($h / $config{CropAspect});
		} else {				     # too high
		  $h = sprintf "%.0f", ($w * $config{CropAspect});
		}
	  }
	}
  }
  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
##############################################################
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 NO_ACTIVE_MODE => 0;
#   use constant MOVE_MODE => 1;
   use constant RESIZE_MODE => 1;
   my $mode = 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->bind( 'RECT' => '<1>' =>
      sub {
         my ( $x, $y ) = ( $Tk::event->x, $Tk::event->y );
         my $id = $canvas ->find( qw|withtag current| );
         my ( $x0, $y0, $x1, $y1 ) = $canvas->coords( $id );

         my ( $width, $height ) = ( $x1 - $x0, $y1 - $y0 );

		 #my $rrrrx = $canvas->width * $canvas->{m_xzoom};
		 #my $rrrry = $canvas->height * $canvas->{m_yzoom};

		 #print "canvas $canvas->width,$canvas->height $rrrrx, $rrrry\n";

         # 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 ) ? RESIZE_MODE : MOVE_MODE;
         $mode = RESIZE_MODE;
         ( $oldx, $oldy, $rect ) = ( $x, $y, $id );

         # Create the red-outlined rectangle that shows the resize as
         # it occurs.
#         if( $mode == RESIZE_MODE ) {
            $canvas->createRectangle( $x0, $y0, $x1, $y1,
                                      -outline => 'red',
									  #-dash => [6,4,2,4],
                                      -tags => ['TEMP'] );
            #$canvas->createRectangle( $x0, $y0, $x1, $y1,
             #                         -outline => 'white',
			#						  -dash => [2,6,2,4],
            #                          -tags => ['TEMP'] );
#         }
         return;
      }
   );

   # Bind motion with the left mouse button down (<B1-Motion>) over a
   # widget with a 'RECT' tag to do...
   $canvas->bind( 'RECT' => '<B1-Motion>' =>
      sub {
         my ( $x, $y ) = ( $Tk::event->x, $Tk::event->y );

         if( $mode == RESIZE_MODE ) {
            # Get coordinates of resizing rectangle.  Note that we
            # tagged it with 'TEMP' in the createRectangle call.
            my ( $x0, $y0, $x1, $y1 ) = $canvas->coords( 'TEMP' );

            # 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 temporary resizing rectangle.
            $canvas->coords( 'TEMP', $x0, $y0, $x1, $y1 );
         }
      }
   );

   # 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) ]
      [    'target', '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( 'TEMP' );
         $canvas->delete( 'TEMP' );
         $canvas->coords( $rect => @coords );
         $mode = 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 {
         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.
         if ( (!defined $id) or (!isInList('RECT', \@tags)) ) {
            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 == NO_ACTIVE_MODE;

         my ( $x, $y ) = ( $Tk::event->x, $Tk::event->y );
         my ( $x0, $y0, $x1, $y1 ) = $canvas->coords( $id );
		 return unless (defined $x0 and defined $y0 and defined $x1 and defined $y1);
         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 => 7)->pack(-expand => 0, -fill => 'x', -anchor => 'w');
  $rotext->insert('end', "Use right mouse button to open and drag a crop frame and the left mouse button to adjuste this frame");

  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 });

  $pc->CanvasBind('<3>' => sub {
					my $x = $pc->canvasx($Tk::event->x);
					my $y = $pc->canvasy($Tk::event->y);
					$pc->delete('withtag', 'RECT');
					@cropRectCoords = ($x, $y, $x, $y);

					$cropRect = $pc->createRectangle(@cropRectCoords,
													 -tags => ['RECT'], -outline => 'red',
													);
				  });

  $pc->CanvasBind('<B3-Motion>' => sub {
					@cropRectCoords[2,3] = ($pc->canvasx($Tk::event->x),
											$pc->canvasy($Tk::event->y));
					$pc->coords($cropRect => @cropRectCoords);
				  });

  $pc->CanvasBind( '<B3-ButtonRelease>' =>
				   sub {
					 my @coords = $pc->coords('RECT');
					 drawFrame($pc, @coords);
					 $pc->raise($cropRect);
				   }
				 );

  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');
  $aF->Radiobutton(-text => "X:Y (any aspect ratio)", -variable => \$config{CropAspect}, -value => 0,
				   -command => sub { setNewAspect($pc); }
				  )->pack(-side => 'top', -anchor => 'w');
  $aF->Radiobutton(-text => "3:2 (e.g. 10x15)", -variable => \$config{CropAspect}, -value => 3/2,
				   -command => sub { setNewAspect($pc); }
				  )->pack(-side => 'top', -anchor => 'w');
  $aF->Radiobutton(-text => "4:3", -variable => \$config{CropAspect}, -value => 4/3,
				   -command => sub { setNewAspect($pc); }
				  )->pack(-side => 'top', -anchor => 'w');  
  $aF->Radiobutton(-text => "5:4 (PAL)", -variable => \$config{CropAspect}, -value => 5/4,
				   -command => sub { setNewAspect($pc); }
				  )->pack(-side => 'top', -anchor => 'w'); 
  $aF->Radiobutton(-text => "7:5 (e.g. 13x18)", -variable => \$config{CropAspect}, -value => 7/5,
				   -command => sub { setNewAspect($pc); }
				  )->pack(-side => 'top', -anchor => 'w');
  $aF->Radiobutton(-text => "16:9", -variable => \$config{CropAspect}, -value => 16/9,
				   -command => sub { setNewAspect($pc); }
				  )->pack(-side => 'top', -anchor => 'w');
  $aF->Radiobutton(-text => "1:1", -variable => \$config{CropAspect}, -value => 1/1,
				   -command => sub { setNewAspect($pc); }
				  )->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();
					$cropW->destroy();
					$rc = 1;
				  })->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; });

  $cropW->Popup;
  $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', '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',
							  );
	$canvas->delete('withtag', 'RECT');
	$canvas->createRectangle(@coords, -tags => ['RECT'], -outline => 'red');
	#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],
#							  );
}


##############################################################
# 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 with loss using mogrify\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 = $searchDB{$dpic}{PIXX};
  my $y = $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);
}

##############################################################
# getSuffix - return the file suffix or undef
##############################################################
sub getSuffix {
  my $file   = shift;

  if ($file =~ m/(.*)\.(.*)$/) {
	return $2;
  }
  return undef;
}

##############################################################
# 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 directory \"$configdir\" in your home directory 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 {

  return if (!-d $configdir);

  # try to find the pictures in the actual dir and in the dir where mapivi is located
  my $searchdir = dirname($0)."/pics";
  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) {
	my $rc = $top->messageBox(-icon => 'warning', -message => "Error could not find any pictures! Please stop mapivi, change to the directory where mapivi is installed and restart mapivi",
					 -title => "Mapivi installation", -type => 'OKCancel');
	#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 directory (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) {
	my $rc = $top->messageBox(-icon => 'warning', -message => "Error could not find any PlugIns! Please stop mapivi, change to the directory where mapivi is installed and restart mapivi",
					 -title => "Mapivi installation", -type => 'OKCancel');
	# 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 directory (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 directory",'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 directory.");
  $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 directories",
							 -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 directories",
						   -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
##############################################################
sub diffList {

  my $list1Ref = shift;  # reference to first list
  my $list2Ref = shift;  # reference to second list
  my %d;

  # build a hash
  foreach (@{$list1Ref}) {
	$d{$_} = 1;
  }
  # delete all elements, which are in list2
  foreach (@{$list2Ref}) {
	delete $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 directories");
  $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 directories to compare and press the "Compare" button.';

  labeledEntryButton($f1a,'top',12,"directory A",'Set',\$config{dirDiffDirA},1);
  labeledEntryButton($f1a,'top',12,"directory B",'Set',\$config{dirDiffDirB},1);

  $ddlb = $ddw->Scrolled("HList",
						 -header     => 1,
						 -separator  => ';',  # todo here we hope that ; will never be in a directory 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 => "Directory \"$_\" is not valid!",
									 -title => 'Error', -type => 'OK');
					return;
				  }
				}
				if ($config{dirDiffDirA} eq $config{dirDiffDirB}) {
					$ddw->messageBox(-icon => 'warning', -message => "Please choose two different directories!",
									 -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 directory ".$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 directory ".$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 subdirectories 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 directories',
						'MaPiVi will create a list of all sub directories of directory "'.basename($mydir).'" containing JPEG files.
You are then able to select directories 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 directories ..."; $userInfoL->update;
  my @dirlist;
  my %nr_of_pics_in_dir;
  my @pictestlist;
  my $pic_count = 0;
  my $pw = progressWinInit($top, "Collect sub directories");
  my $i = 0;
  my $break = 0;
  find(sub {
		 if (progressWinCheck($pw)) { $break = 1; $File::Find::prune = 1; }
		 $i++; $i = 0 if ($i > 10);
		 progressWinUpdate($pw, "collecting directories, found  ".scalar @dirlist." ...", $i, 10);
		 # 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 directories ..."; $userInfoL->update;
		   }
		 }
	   }, $mydir);
  progressWinEnd($pw);
  if ($break) {
	$userinfo = "user break while counting directories";
	return;
  }

  $config{CheckForNonJPEGs} = $tmp;    # restore the option

  $userinfo = "found ".@dirlist." sub directories with $pic_count JPEGs"; $userInfoL->update;

  @dirlist = sort @dirlist;

  my @sellist;
  return if (!mySelListBoxDialog("Select directories",
								 "Found ".scalar @dirlist." directories with $pic_count JPEG pictures.\nThe database will be updated with the pictures of the selected directories.",
								 "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");
  $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++;
      # todo $pic_count is not correct if not all directories have been selected
	  progressWinUpdate($pw, "adding picture ($i/$pic_count) in directory $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');

  store(\%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 directory
##############################################################
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');
  $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');
  $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 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');
  $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');
  my $lab2 = $butF2->Label(-textvariable => \$win->{label2},
				)->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 1, -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',
                      -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');
  $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);
  my $lib = $butF3->Checkbutton(-variable => \$config{KeywordLimit},
                      -text => 'Limit to 100 keywords',
                      -command => sub {show_keywords($win, \@search_keys, \@exclude_keys);}
                      )->pack(-anchor => 'w');             
  $balloon->attach($lib, -msg => 'Limit to a maximum of the 100 most popular keywords.');
  $butF3->Label(-text => 'Right click to select a keyword, left click to exclude it')->pack(-anchor => 'w');

  $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;
}

##############################################################
# 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)";

  # find max an min numbers
  my $min = 10000; 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);
  #print "max $max min $min diff $diff\n";

  # 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{FontFamily}, -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;
    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)]);

  $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 keywords which must be contained
  my $exclude_keys = shift; # list reference for keywords which must not be contained
  my %keyword_hash;
  my $count = 0;
  
  # 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});
    
    # 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
      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);
}  

##############################################################
# 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});
    
    # 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 $info = "$keys entries in the database (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 chars
#                 will e.g. complain about the copyright sign
##############################################################
sub checkDatabase {

  my ($com, $iptc, $text);
  my $i = 0;
  foreach my $dpic (sort keys %searchDB) {
	$i++;

	$com  = $searchDB{$dpic}{COM};
	$iptc = $searchDB{$dpic}{IPTC};

	if ($com =~ m/[^\x00-\x7f]/) {
	  $text .= "comment of $dpic\n";
	}

	if ($iptc =~ m/[^\x00-\x7f]/) {
	  $text .= "IPTC    of $dpic\n";
	}
  }

  $text = "Check finished.\nFound these problematic 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;

  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_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;
  
  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 unless ($ignore_links and -f $dpic);
    next if (-l $dpic);
	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;
	}
  }
}

##############################################################
# findDups - find duplicate pics in the database
##############################################################
sub findDups {

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

  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 = '';

  # open window
  $dupw = $top->Toplevel();
  $dupw->title("Duplicate pictures");
  $dupw->iconimage($mapiviicon) if $mapiviicon;

  my %dupthumbs;

  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);

  labeledEntry($subF2, 'left', 33, "Show only path filenames matching", \$filter);

  my  $duplb = $dupw->Scrolled("HList",
							   -header     => 1,
							   -separator  => ';',  # todo here we hope that ; will never be in a directory or file name
							   -pady       => 0,
							   -columns    => 4,
							   -scrollbars => 'osoe',
							   -selectmode => "extended",
							   -background => $config{ColorBG}, #8fa8bf
							   -width      => 40,
							   -height     => 200,
							  )->pack(-fill => "both");

  bindMouseWheel($duplb);

  my $col = 0;
  $duplb->{thumbcol} = $col; # save the colomn numbers in the list box widget ref
  $duplb->header('create', $col++, -text => 'Thumbnail',   -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
  $duplb->{namecol} = $col;
  $duplb->header('create', $col++, -text => 'Name',        -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
  $duplb->{filecol} = $col;
  $duplb->header('create', $col++, -text => 'File info',   -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});
  $duplb->{dircol} = $col;  # save the colomn number of the directory in the list box widget ref
  $duplb->header('create', $col, -text => 'Folder',     -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth});


  $balloon->attach($duplb, -msg => "left click  : select\nmiddle click: open picture in new window\nright click : open context menu");

  $subF->Button(-text => "Search",
				-command => sub {
				  # clean up
				  $duplb->delete("all");
				  $label = 'cleaning up ...';
                                  $duplb->update;
				  # clean up memory - delete all found thumbnail photo objects
				  foreach (keys %dupthumbs) {
					print "findDups: deleting thumb $_\n" if $verbose;
					$dupthumbs{$_}->delete if (defined $dupthumbs{$_});
					delete $dupthumbs{$_};
				  }
				  
				  $label = 'searching duplicates in database ...';
                                  $duplb->update;
                                  my $filterP = makePattern($filter); # create a windows like pattern

				  if ($searchForDups eq 'Name') {
					searchDupsName(\%dpics, $ignore_links, $filterP);
				  } elsif ($searchForDups eq 'Size') {
					searchDupsSize(\%dpics, $ignore_links, $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 ($dpic, $size, $date, $dir, $pic, $thumb);
                  my $style = $iptcS;
				  $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

					  $dir   = dirname($dpic);
					  $pic   = basename($dpic);
					  $thumb = getThumbFileName($dpic);

					  # create new row
					  $duplb->add($dpic);

					  if (-f $thumb) {
						$dupthumbs{$thumb} = $duplb->Photo(-file => $thumb, -gamma => $config{Gamma});
						if (defined $dupthumbs{$thumb}) {
						  $duplb->itemCreate($dpic, $duplb->{thumbcol}, -image => $dupthumbs{$thumb}, -itemtype => 'image');
						}
					  }

					  if ($searchForDups eq "size") {
						$size = $item;
					  } else {
						$size = "n.a."; # default value
						if ((-d $dir) and (-f $dpic)) {
						  $size = getFileSize($dpic, NO_FORMAT); # size in Bytes
						}
					  }

					  $date = "n.a."; # default value
					  if ((-d $dir) and (-f $dpic)) {
						$date = getFileDate($dpic, FORMAT); # date in exif format
					  }

					  $duplb->itemCreate($dpic, $duplb->{namecol}, -text => $pic,                 -style => $style);
					  $duplb->itemCreate($dpic, $duplb->{filecol}, -text => "$size bytes\n$date", -style => $comS);
					  $duplb->itemCreate($dpic, $duplb->{dircol},  -text => $dir,                 -style => $style);
					  $dcount++;
					  # show progress and found pics every 0.5 seconds - idea from Slaven
					  if (!defined $last_time || Tk::timeofday()-$last_time > 0.5) {
						$progress = int($pcount/$keys*100);
						$label    = " displaying duplicates $progress% ($pcount/$keys)";
						$duplb->update();
						$last_time = Tk::timeofday();
					  }
					}
                    # toggle style of name col
                    if ($style == $iptcS) { $style = $comS } else {$style = $iptcS };
				  }
				  $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 file", -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w', -fill => "both");

  $subF->Optionmenu(-options => [qw(Name Size)], -variable => \$searchForDups, -textvariable => \$searchForDups)->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
							 foreach (keys %dupthumbs) {
							   print "findDups: deleting thumb $_\n" if $verbose;
							   $dupthumbs{$_}->delete if (defined $dupthumbs{$_});
							   delete $dupthumbs{$_};
							 }
						   }
						  )->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 directory\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.",
									   -title => "directory not found", -type => 'OK');
					 return;
				   }
				   $dupw->Busy;
				   showPicInOwnWin($dpic);
				   $dupw->Unbusy;
				 });

  ############# open dir
  $menu->command(-label => "open directory 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 directory\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.",
									   -title => "directory 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 directory ...", -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 directory", "Ignore all directories 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 directories.";
				 });

  ############# 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
  $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 directory\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.",
		    -title => "directory 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.7 * $dupw->screenwidth);
  my $h = int(0.7 * $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 directories 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 directories 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], ], -variable => \$config{SearchUrgency}, -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.2006';

  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.2007";
							$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.2006)");

  $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-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", -command => sub {
     my @sellist = getSelection($findLB);
     return unless checkSelection($top, 1, 0, \@sellist);
     show_multiple_pics(\@sellist, 0);
    });

  ############# open dir
  $menu->command(-label => "open picture in main window", -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 directory\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.",
									   -title => "directory 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 - todo
  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");
				   searchThumbsDelete();
				   sortPics("name", 0, \@pics);
				   foreach (@pics) {
					 insertPic($findLB, $_);
				   }
				 }, );
  $sort_menu->command(-label => "urgency", -command => sub {
				   my @pics = $findLB->info('children');
				   $findLB->delete("all");
				   searchThumbsDelete();
				   sortPics("urgency", 0, \@pics);
				   foreach (@pics) {
					 insertPic($findLB, $_);
				   }
				 }, );
  $sort_menu->command(-label => "file date", -command => sub {
				   my @pics = $findLB->info('children');
				   $findLB->delete("all");
				   searchThumbsDelete();
				   sortPics("date", 0, \@pics);
				   foreach (@pics) {
					 insertPic($findLB, $_);
				   }
				 }, );
  $sort_menu->command(-label => "EXIF date", -command => sub {
				   my @pics = $findLB->info('children');
				   $findLB->delete("all");
				   searchThumbsDelete();
				   sortPics("exifdate", 0, \@pics);
				   foreach (@pics) {
					 insertPic($findLB, $_);
				   }
				 }, );



  # 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 directory\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.",-title => "directory 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{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);
                        }
						$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 directories 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;
				  searchThumbsDelete();
				  $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;
}

##############################################################
# searchThumbsDelete
##############################################################
sub searchThumbsDelete {
	# clean up memory - delete all found thumbnail photo objects
	foreach (keys %searchthumbs) {
		print "searchMetaInfo: deleting thumb $_\n" if $verbose;
		$searchthumbs{$_}->delete if (defined $searchthumbs{$_});
		delete $searchthumbs{$_};
	}
}

##############################################################
# insertPic
##############################################################
sub insertPic($$) {
  my $lb    = shift;
  my $dpic  = shift;

  my $thumb = getThumbFileName($dpic);

  # create new row
  $lb->add($dpic);
  my $pic  = basename($dpic);

  if (-f $thumb) {
	$searchthumbs{$thumb} = $lb->Photo(-file => $thumb, -gamma => $config{Gamma});
	if (defined $searchthumbs{$thumb}) {
	  $lb->itemCreate($dpic, $lb->{thumbcol}, -image => $searchthumbs{$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);  # format the comment   for the list
  my $exif = formatString($searchDB{$dpic}{EXIF}, 30);  # format the EXIF info for the list
  $iptc    = formatString($iptc, 30);  # 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;
}

##############################################################
# about - display some infos about the application
##############################################################
sub about {

  my $title = "About Mapivi $version";

  my @date = split / /, '$Date: 2006/10/31 03:20:58 $ ';
  my @datum = split /\//, $date[1];
  my $nrs = $config{NrOfRuns};

  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 $about = << "EOA";

 MaPiVi - Martin\'s Picture Viewer and Organizer

 A JPEG picture viewer with EXIF/IPTC/Comment support.

      Mapivi Version: $version
 Date of last change: $datum[2].$datum[1].$datum[0]
   Mapivi config dir: $configdir

              Author: Martin Herrmann
               email:<Martin-Herrmann\@gmx.de>
                 www: $mapiviURL
            download: http://sourceforge.net/projects/mapivi

 You have used Mapivi $nrs times

        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;
  $about .= "        memory usage: ".$mem."\n"     if $procTabAvail;

  $about .= "             OS type: ".$ENV{OS}."\n"   if ($ENV{OS});
  $about .= "                  OS: ".$ENV{PC_OS}."\n"   if ($ENV{PC_OS});
  $about .= "             OS type: ".$ENV{OSTYPE}."\n"   if ($ENV{OSTYPE});
  $about .= "         System name: ".$ENV{HOSTNAME}."\n" if ($ENV{HOSTNAME});
  $about .= "         System name: ".$ENV{COMPUTERNAME}."\n" if ($ENV{COMPUTERNAME});
  $about .= "         System type: ".$ENV{HOSTTYPE}."\n" if ($ENV{HOSTTYPE});
  $about .= "     # of processors: ".$ENV{NUMBER_OF_PROCESSORS}."\n" if ($ENV{NUMBER_OF_PROCESSORS});
  $about .= "           Processor: ".$ENV{CPU}."\n"      if ($ENV{CPU});
  $about .= "           Processor: ".$ENV{PROCESSOR_ARCHITECTURE}."\n" if ($ENV{PROCESSOR_ARCHITECTURE});
  $about .= "      Processor type: ".$ENV{PROCESSOR_IDENTIFIER}."\n"   if ($ENV{PROCESSOR_IDENTIFIER});
  $about .= "      Processor type: ".$ENV{MACHTYPE}."\n"      if ($ENV{MACHTYPE});
  $about .= "      Processor rev.: ".$ENV{PROCESSOR_REVISION}."\n"   if ($ENV{PROCESSOR_REVISION});

  $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);
}

##############################################################
# 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 me the trash", "Empty trash"]);
  my $rc = $dialog->Show();
  if ($rc eq "Do nothing") {
	$top->focusForce;
	return;
  }
  elsif ($rc eq "Show me the trash") {
	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 directory 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 Ok to delete all files ($msum MB in ".scalar @files." files) in the trash.\nThere is no undelete!\n\nPath: $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 .. 2010);
  # 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-remote")){
		  $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-remote -n      \"$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("Informations 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 $plural = '';
  $plural    = 's' if ($min > 1);

  if (($min == $max) and (@$listref != $min)) {
	$win->messageBox(-icon  => 'warning', -message => "Please select exactly $min item$plural!",
					 -title => "Wrong selection", -type => 'OK');
	return 0;
  }

  if (@$listref < $min) {
	$win->messageBox(-icon  => 'warning', -message => "Please select at least $min 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 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   directory\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 {

  my $days = 30;
  my $thumbDB = "$configdir/thumbDB";
  my @thumbs;
  my $rc = $top->messageBox(-icon  => "question",
							-message => "This function will delete all stored thumbnails in the thumbnail data base which have no corresponding picture and are older than $days days. 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;
		   $orig =~ s/^$thumbDB//;
		   unless (-f $orig) {
			 print "file: $File::Find::name -> $orig\n";
			 push @thumbs, $File::Find::name;
		   }
		 }
	   }, $thumbDB);

  # todo: ignore /mnt/cdrom (%ignorePaths) ...

  $userinfo = "found ".@thumbs." outdated thumbnails ..."; $userInfoL->update;
  if (@thumbs > 0) {
	my @dummylist;
	# todo: use mySelListBoxDialog user may select which to delete
	if (mySelListBoxDialog("Really delete?",
						   "Please press Ok to delete these ".scalar @thumbs." thumbnails.",
						   'OK', \@dummylist, @thumbs)) {
	  foreach (@thumbs) { print "removing $_\n"; removeFile($_); }
	}
  }
  $userinfo = "ready!"; $userInfoL->update;
  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 directory ".basename($dir)."?",
							  -buttons => ['OK', 'Cancel']);
	$dia->add("Label", -text => "Remove all sub directories 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 directory\n".basename($subdir)."\nRemove?",
							   -title => "Remove sub directory?",
							   -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 directories in\n$dir\n, should I clean them too?",
						   -title => "Clean sub directories?",
						   -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 {

  # 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 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);

  return if (!losslessBorderDialog());

  my $bi = $config{llBorderWidthI}; # inner width
  my $bw = $config{llBorderWidth};  # complete width

  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);
	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);

	my $cx = $x + 2 * $bw;
	my $cy = $y + 2 * $bw;

	my $r1  = $bw - $bi;
	my $rx2 = $cx - $bw + $bi - 1;
	my $ry2 = $cy - $bw + $bi - 1;

	print "losslessBorder: pic $x,$y  canvas $cx,$cy  rect $r1,$r1 $rx2,$ry2\n" if $verbose;

	# create an empty picture with a frame
	my $command = "convert -size ${cx}x${cy} xc:\"".$config{llBorderColor}."\" -fill \"".$config{llBorderColorI}."\" ";
	$command .= "-draw \'rectangle $r1,$r1 $rx2,$ry2\' -quality 95 \"$frame\" ";
	execute($command);

	unless (-f $frame) {
	  warn "losslessBorder: could not create lossless border, skipping $dpic!\n";
	  next;
	}

	progressWinUpdate($pw, "adding border ($i/$selected) ...", $i, $selected);

	# drop the picture on top of the frame
	$command = "jpegtran -drop +${bw}+${bw} \"$dpic\" -outfile \"$dpic\" \"$frame\" ";
	execute($command);

	$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 lossless border to $i of $selected)"; $userInfoL->update;
  generateThumbs(ASK, SHOW);
}

##############################################################
# losslessBorderDialog
##############################################################
sub losslessBorderDialog {

  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;

  labeledScale($ll_b_w, 'top', 30, "Border width (pixel)", \$config{llBorderWidth}, 8, 200, 8);
  labeledEntryColor($ll_b_w,'top',30,"Border color",'Set',\$config{llBorderColor});
  labeledScale($ll_b_w, 'top', 30, "Inner border width (pixel)", \$config{llBorderWidthI}, 1, 50, 1);
  labeledEntryColor($ll_b_w,'top',30,"Inner border color",'Set',\$config{llBorderColorI});

  buttonBackup($ll_b_w, 'top');
  buttonComment($ll_b_w, 'top');

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

  my $OKB =	$ButF->Button(-text => 'OK',
						  -command => sub {
							$ll_b_w->withdraw();
							$ll_b_w->destroy();
							$rc = 1;
						  })->pack(-side => 'left', -expand => 1, -fill => 'x', -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;
}

##############################################################
# 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;

  $wizW->Label(-text => "Import pictures from a removable device like e.g. a camera\nor a card reader connected via e.g. USB.\nThe selected actions will take place in the displayed order.", -bg => $config{ColorBG}, -justify => "left")->pack(-anchor => 'w', -padx => 3, -pady => 3);

  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. "2006/10/29")
  my $date = sprintf "%04d/%02d/%02d", $y, $mo, $d;

  my $w  = 32;
  my $w2 = $w - 3;

  if (!$EvilOS && !$MacOSX) {
	my $moF = $wizW->Frame()->pack(-anchor => 'w', -fill => 'x');
	$moF->Checkbutton(-variable => \$config{ImportMount},
					  -anchor   => 'w',
					  #-width    => $w2*2,
					  -text     => "Mount device"
					 )->pack(-side => "left", -anchor => 'w', -padx => 3, -pady => 3);
	$moF->Label(-textvariable => \$config{ImportDevice},
				-anchor   => 'w',
				-bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w', -padx => 3, -pady => 3);
	$moF->Button(-text    => 'Set',
				 -command => sub {
				   mountDialog();
				   $wizW->raise;
				 })->pack(-side => "right", -anchor => 'w', -padx => 3, -pady => 3);
	$moF->Button(-text    => "Mount now",
				 -command => sub {
					 my $command = "mount ".$config{ImportDevice};
					 execute($command);
				 })->pack(-side => "right", -anchor => 'w', -padx => 3, -pady => 3);
  }
  else {
	$config{ImportMount} = 0; # no mount for windows
	# Mac OS X automounts when the device is plugged in.
  }

  labeledEntryButton($wizW,'top',$w,"Source directory",'Set',\$config{ImportSource}, 1);
  $wizW->Checkbutton(-variable => \$config{ImportSubdirs},
					 -anchor   => 'w',
					 -text     => "Import from all sub directories, too"
					)->pack(-side => 'top', -anchor => 'w', -padx => 3, -pady => 3);
  labeledEntryButton($wizW,'top',$w,"Target directory (fix part)",'Set',\$config{ImportTargetFix}, 1);
  my $varF = $wizW->Frame()->pack(-anchor => 'w', -fill => 'x');
  labeledEntry($varF,"left",$w,"Target directory (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 $dpF = $wizW->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 = $wizW->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 = $wizW->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 = $wizW->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 $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 => 3, -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{ImportDeleteCameraJunk},
					 -anchor   => 'w',
					 -text     => "Delete camera junk files in target directory after copy (e.g. *.CTG)"
					)->pack(-anchor => 'w', -padx => 3, -pady => 3);

  $wizW->Checkbutton(-variable => \$config{ImportDelete},
					 -anchor   => 'w',
					 -text     => "Delete files in source directory after copy"
					)->pack(-anchor => 'w', -padx => 3, -pady => 3);

  if (!$EvilOS) {
	my $ejF = $wizW->Frame()->pack(-anchor => 'w', -fill => 'x');
	$ejF->Checkbutton(-variable => \$config{ImportUnmount},
					  -anchor   => 'w',
					  #-width    => $w2*2,
					  -text     => "Unmount device when finished"
					 )->pack(-side => "left", -anchor => 'w', -padx => 3, -pady => 3);
	# It is not necessary to set the mount device in Mac OS X, because
	# the diskutil command can unmount by the name of the source dir.
	if (!$MacOSX) {
	    $ejF->Button(-text    => 'Set',
					 -command => sub {
					   mountDialog();
					   $wizW->raise;
					 })->pack(-side => "right", -anchor => 'w', -padx => 3, -pady => 3);
	  }
  }
  else {
	$config{ImportUnmount} = 0; # no umount for windows
  }

  $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 directories
#                (e.g. 2_times_5x7/ or 1_times_13x18/)
##############################################################
sub copyToPrint {

  my $lb =shift;

  my @sellist = $lb->info('selection');
  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 directory");
  $printW->iconimage($mapiviicon) if $mapiviicon;

  $printW->Label(-text => "Copy ".scalar @sellist." pictures to a according print directory.", -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 directory",'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,"directory",\$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 directory?", -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 {

  ##############################################################
  ##### mount device
  if ($config{ImportMount}) {
	$userinfo = "mounting ".$config{ImportDevice}." ..."; $userInfoL->update;
	my $command = "mount ".$config{ImportDevice};
	execute($command);
  }

  my $source = $config{ImportSource};

  ##### check source dir
  $userinfo = "checking directories ..."; $userInfoL->update;
  if (!-d $source) {
	$top->messageBox(-icon => 'warning',
					 -message => "Sorry, but the source directory\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 $progF  = $impW->Frame()->pack(-expand => 1, -fill =>'x');
  $progF->Label(-text => "progress directories ", -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 directory ($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 directory - 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);
	  $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 $rc = $top->messageBox(-icon  => 'question',
								-message => "Not all files in the source and target directory are eqal.\n$filediff files are missing and $sizediff files have another size.\nShould I continue?",
								-title => "Continue?", -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 directory?",
								  -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");

  ##############################################################
  ##### unmount device
  if ($config{ImportUnmount}) {
	my $command;
	my $mountpoint;
	if ($MacOSX) {
	  $command = "diskutil unmount";
	  $mountpoint = $config{ImportSource};
	} else {
	  # todo: don't know what fits better
	  #$command = "umount";
	  $command = "eject";
	  $mountpoint = $config{ImportDevice};
	}
	$rotext->insert('end', "unmounting $mountpoint\n"); $rotext->see('end'); $rotext->update;
	execute("$command \"$mountpoint\"");
  }

  ($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;
}

##############################################################
# mountDialog
##############################################################
sub mountDialog {

  my $device = $config{ImportDevice};
  my $rc = myEntryDialog('Set mount device',
						 'Please enter the device to mount/unmount, when importing pictures.
(Mapivi will execute the commands "mount" and "umount" with this device.)',
						 \$device);
  if ($rc eq 'OK') {
	$config{ImportDevice} = $device;
  }

}

##############################################################
# 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;

  if ($total == 0) {
	warn "total ($total) is zero!";
	return;
  }

  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
  if (($percent > 3) and ($sec > 10)) {
	  my $to_go = int($sec * $total / $index) - $sec; # time to go in seconds
	  my $min   = 0;
	  if ($to_go > 59) { $min = int($to_go / 60); $to_go = $to_go % 60; } # modulo
	  $add_str  = sprintf ", estimated time to go %d:%02d",$min, $to_go;
  }
  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->{label}   = $string;
  $pw->iconname("$percent% done");
  $pw->update();
  $pw->{last_time} = Tk::timeofday();
}

##############################################################
# progressWinEnd
##############################################################
sub progressWinEnd($) {
  my $pw = shift;
  if (Exists($pw)) {
	$pw->withdraw;
	$pw->destroy;
  }
}

##############################################################
# 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->deiconify;
	if ($config{ToggleBorder}) {
		$top->grabGlobal;
		$top->focusForce;
	}
  } 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);
  }
  # 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";
}

##############################################################
# 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, 2003, 2004, 2005, 2006  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 are no blanks allowed!
}

# Tell Emacs that this is really a perl script
# Local Variables:
# mode:perl
# End:
