#!/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.pl

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

# to check the code against Perl coding standards
# install Perl::Critic module
# execute: "perlcritic -5 mapivi.pl" or: "perlcritic -4 -profile test/perlcriticrc mapivi.pl"
# instead of -5 (list only most severe warnings) you may also use -4, -3, -2, or -1 (list all warnings),  see also "perldoc Perl::Critic" or "perlcritic -man"

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

Feel free to redistribute.  Enjoy!

=head1 USAGE

mapivi [-i ] [file|folder]

to display a certain picture use:

mapivi picture.jpg

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

to view a folder containing pictures use:

mapivi ~/pics/

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

to start mapivi with the import wizard

mapivi -i

=head1 KEYS

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

=over 4

=item Space, Page-Down

Show the next picture in folder

=item BackSpace, Page-Up

Show the previous picture in folder

=item Escape

Iconify Mapivi (Boss-Key :)

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

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

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

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

=item q

Quit Mapivi

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

=back

=head1 MOUSE

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

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

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

=cut

##############################################################
# load basic modules
use Env;
use File::Spec;
# determine full path to mapivi script or executable, should be done before e.g. a chdir() takes place
my $mapivi_file = File::Spec->rel2abs($0);

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

my $home = get_home_path();
die lang('Mapivi can not find a home directory') if (!-d $home);

# this path is used for user specific data, like the search database, the keyword tree, the configuration, trash, etc.
my $user_data_path = get_user_data_path($home);

my $conf_file         = "$user_data_path/mapivi_conf";     # the configuration file
my $configFile        = "$user_data_path/mapivirc";        # the old configuration file
my $trashdir          = "$user_data_path/trash";           # the Mapivi trashcan
my $iptcdir           = "$user_data_path/IPTC_templates";  # the IPTC templates folder
my $plugin_user_path  = "$user_data_path/PlugIns";         # the mapivi plugin user dir
my $file_Entry_values = "$user_data_path/Entry_values";    # needed to store completions for Tk::MatchEntry
my $thumbDB           = "$user_data_path/thumbDB";         # path to thumbnail database (when thumbnails are stored in a central place)
my $searchDBfile      = "$user_data_path/SearchDataBase";  # path to the search database file
my $collectionsFile   = "$user_data_path/slideshows";      # path to picture collections/slideshows file

# this path is used for Mapivi icons, languages, plugins, html templates etc.
# for Debian and Ubuntu we use /usr/share/mapivi, other UNIX distributions may need other paths
my $program_data_path = '/usr/share/mapivi';
if ($EvilOS) { # in Windows we store the programm data in the same folder as mapivi
  $program_data_path = dirname($mapivi_file);
  $program_data_path =~ s!\\!\/!g;     # replace Windows path delimiter with UNIX style \ -> /
}

my $icon_path       = "$program_data_path/icons";     # the icon dir
my $thumbExample    = "$icon_path/EmptyThumb.jpg";
my $lang_path       = "$program_data_path/languages"; # the localization / languages dir
my $plugin_sys_path = "$program_data_path/PlugIns";   # the mapivi plugin system dir
my $logo            = "$program_data_path/pics/logo.jpg";

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

##############################################################
# load optional module (as soon as possible)
my $splashAvail = (eval {require Tk::Splash})  ? 1 : 0 ;
my $splash;
if ($splashAvail and -f $logo) {
  # Splash->Show parameters: $image, $width, $height, $title, $overrideredirect
  $splash = Tk::Splash->Show($logo, undef, undef, '', 1);
}

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

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

# set version
my $version  = '1.2';
# get version and date from subversion (SVN)
# this works only if you enable subversion's keyword substitution on your machine for this file:
# svn propset svn:keywords "Rev Date" mapivi.pl
my @svnversion   = split / /, '$Rev: 356 $';
my $svnrevision  = '';
$svnrevision     = "($svnversion[1])" if defined $svnversion[1];
my @svndate      = split / /, '$Date: 2016-11-06 18:02:25 +0100 (So, 06. Nov 2016) $';
my $version_date = '2012-03-23';
$version_date    = $svndate[1] if defined $svndate[1];
$main::VERSION   = $version;
my $mapiviURL    = "http://mapivi.de.vu";
my $mapiviInfo   = "<a href=\"$mapiviURL\" title=\"".lang("Gallery produced by mapivi")." $version\">mapivi</a>";

showCopyright();

##############################################################
# load modules
#use Encode qw(is_utf8 encode decode);
use Encode;
#use encoding "utf8"
#use utf8;
use Getopt::Std;
our($opt_i, $opt_v);
$Getopt::Std::STANDARD_HELP_VERSION = 1;
use File::Copy;
use File::Find;
use File::Path;  # for rmtree, mkpath
use Text::Wrap;
use List::Util qw/max min/; # core module since Perl 5.8.0 
use Tk 800.025; # minimum version >= 800.025
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 Storable qw(nstore retrieve dclone);
use Tk::Adjuster;
use Tk::DragDrop;
use Tk::DropSite;
use Tk::Compound; # for icons in the menues
use MIME::Base64; # for get_encode_file(); a workaround for Tk::Photo which can't handle non-ASCII characters

# for debugging
# use Data::Dumper;  # and then in the code e.g. print Dumper(\%conf);

##############################################################
# load mapivi specific modules
# the mapivi specific modules may be located in the same dir as mapivi itself, so we add this path to @INC
use FindBin;
use lib "$FindBin::RealBin";
# load mapivi specific modules
use Tk::MhConfig qw(configuration_edit configuration_store configuration_restore);

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

##############################################################
# load non standard modules, they may be located below the mapivi program folder 
use Image::ExifTool;
use Image::Info qw(image_info dim);
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 langf("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);


##############################################################
# load optional modules

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

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

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

#use constant Win32DriveInfoAvail => eval { require Win32::DriveInfo; 1 };

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

use constant ProcBackgroundAvail => eval { require Proc::Background; 1 };

# 2009-12-22: the next lines may be used to enable the Gtk2 FileChooserDialog
# this works in a small example, but here mapivi dies with a X Window System error
#my $gtk2_avail = (eval {require Gtk2})  ? 1 : 0 ;
my $gtk2_avail = 0;
Gtk2->init if ($gtk2_avail);

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

##############################################################
# constants
use constant WITH_PATH => 1;
use constant JUST_FILE => 0;
use constant LONG      => 1;
use constant SHORT     => 0;
use constant MICRO     => 2;
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 OVERWRITEALL => 2;
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 MOVE       => 1;
use constant RENAME     => 2;
use constant BACKUP     => 3;
use constant TRASH      => 0;
use constant REMOVE     => 1;
use constant OK         => 1;
use constant CANCEL     => 0;
use constant CANCELALL  => -1;
use constant ADD        => 1;
use constant RESET      => 0;
use constant PIXEL      => 0;
use constant ASPECT_RATIO => 1;
use constant RELATIVE   => 2;
use constant SINGLE     => 0;
use constant MULTIPLE   => 1;
use constant UPDATE     => 1;
use constant FOLDER        => 0;  # value for $act_modus
use constant LOCATION      => 1;  # value for $act_modus
use constant DATE          => 2;  # value for $act_modus
use constant KEYWORDCLOUD  => 3;  # value for $act_modus
use constant KEYWORD       => 4;  # value for $act_modus
use constant SEARCH        => 5;  # value for $act_modus
use constant COLLECTION    => 6;  # value for $act_modus
use constant NO_CHECK_JPEG => 0;
use constant CHECK_JPEG    => 1;
use constant OPEN          => 1;  # tree collapse (fold)
use constant CLOSE         => 0;  # tree unfold
use constant FLAG_RESET    => 0b00000000;
use constant FLAG_RED      => 0b00000001;
use constant FLAG_GREEN    => 0b00000010;
use constant FLAG_BLUE     => 0b00000100;
use constant START         => 0;
use constant SETTINGS      => 1;
use constant FIT           => 0; # pic zoom
use constant FILL          => 1; # pic zoom
use constant NORMAL        => 0; # window size
use constant FULLSCREEN    => 1; # window fullscreen

##############################################################
# globals (yes, I know there are to many globals, I'm working on it ...)
my @dirHist;             # folder history - stores the last folders visited
my @cachedPics;          # a list of all cached pictures
my @savedselection;
my @savedselection2;

# search database: hash to store all the data of all pictures in the visited folders (comments, EXIF, IPTC)
my %searchDB;
# location hash, will be filled on demand and should only be accessed from function get_locations
my %locations;
# flag indicating that the %locations hash needs to be filled (updated) from the %searchDB
my $locations_need_update = 1;
# date/time hash, will be filled on demand and should only be accessed from function get_dates
my %dates;
# flag indicating that the %dates hash needs to be filled (updated) from the %searchDB
my $dates_need_update = 1;

# folder checklist: hash to store properties of folders (key: dir value: hash SORT, META, PRIO, COMM)
my %dirProperties;
# hash to store all loaded photo objects (real size or zoomed) key = path/file name, value = photo object
my %photos;
# hash to store all loaded thumbnail photo objects key = path/file name, value = photo object
my %thumbs;
my %searchthumbs;# hash containing all thumbnails of the search dialog, for memory clean up
my %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});
}

# hash of all slideshows
# is stored on exit and retrieved on start
# A slideshow (collection, album) is a manual sorted list of pictures,
# like a music playlist 
# Perl data structure: hash of hash of scalars and lists (HoHoL :)
# key1=Folder, key2=Slideshow key3=file, picturelist,
my %slideshows = (
  'Vacation' => {
    '2013-Paris' => {
      'file' => 'C:/_data/Bilder/temp/slideshow-paris.gqv',
      'pics' => ['C:/_data/Bilder/test/a.png', 'C:/_data/Bilder/test/b.png', 'C:/_data/Bilder/test/c.jpg', 'C:/_data/Bilder/test/d.jpg'],
    },
    '2014-Berlin' => {
      'file' => undef,
      'pics' => ['C:/_data/Bilder/test/a.png', 'C:/_data/Bilder/test/b.png', 'C:/_data/Bilder/test/c.jpg', 'C:/_data/Bilder/test/d.jpg'],
    },
  },
  'Family' => {
    'Simpsons' => {
      'file' => 'C:/_data/Bilder/temp/slideshowSimpson.gqv',
      'pics' => ['C:/_data/Bilder/test/a.png', 'C:/_data/Bilder/test/b.png', 'C:/_data/Bilder/test/c.jpg', 'C:/_data/Bilder/test/d.jpg'],
    },
    'Einsteins' => {
      'file' => 'C:/_data/Bilder/temp/slideshow-OneStone.gqv',
      'pics' => ['C:/_data/Bilder/test/a.png', 'C:/_data/Bilder/test/b.png', 'C:/_data/Bilder/test/c.jpg', 'C:/_data/Bilder/test/d.jpg'],
    },
  },
  'BestOf' => {
    '2014' => {
      'file' => 'C:/_data/Bilder/temp/slideshowSimpson.gqv',
      'pics' => ['C:/_data/Bilder/test/a.png', 'C:/_data/Bilder/test/b.png', 'C:/_data/Bilder/test/c.jpg', 'C:/_data/Bilder/test/d.jpg'],
    },
  },
  'Other' => { },
);
  # hash of hash example
  #my %modules = (
  #'Carp' => { 'version' => $Carp::VERSION,
  #            'license' => 'Perl Artistic License or GNU GPL' },
  #'File::Basename' => { 'version' => $File::Basename::VERSION,

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

my $actpic          = ''; # the path and file name of the actual picture
my $act_modus       = FOLDER; # FOLDER, LOCATION, DATE, KEYWORDCLOUD, KEYWORD, SEARCH or COLLECTION
my $actdir          = ''; # the actual folder - valid if $act_modus == FOLDER
my @act_location    = (); # the actual location (Country, Privince/State, City, Sublocation) - valid if $act_modus == LOCATION
my @act_date        = (); # the actual location (Year, Month, Day, Hour, Minute) - valid if $act_modus == DATE
my @act_keywords    = (); # the actual keywords (any number) - valid if $act_modus == KEYWORDCLOUD
my @act_keywords_ex = (); # the actual exclude keywords (any number) - valid if $act_modus == KEYWORDCLOUD
my @act_collection  = (); # the actual collection (folder and name of %slideshows) - valid if $act_modus == COLLECTION; todo: hierarchy still unclear
my $widthheight     = '';
my $loadtime        = '';
my $size            = '';
my $zoomFactorStr   = '';
my $nrof            = '';
my $userinfo        = '';
my $otherFiles      = '';
my $proccount       = 0;
my $nrToConvert     = 0;
my $maxCommentLength = 2**16 - 3; # a comment block may have max 64kB
my $global_log = "Mapivi $version log file:";

# file suffixes
my @video_suffix = qw(.avi .mp4 .mpg .mpeg .mov);
my @xmp_suffix = qw(.XMP);
my @wav_suffix = qw(.WAV);
my @raw_suffix = qw(.NEF .CRW .CR2 .DNG .NRW); # update also sub getPics()!!
my @raw_suffix_lc; # lower case raw suffixes
push @raw_suffix_lc, lc($_) foreach (@raw_suffix);
# picture formats supported by Tk::Photo (standard Tk distribution)
# xbm works, but takes ages (who needs xbm???) and tiff doesn't work
# xcf works for thumbs, but makes problems with layers
my $nonJPEGsuffixes = "gif|png|xpm|bmp";    
my $cameraJunkSuffixes = "ctg"; # uninteresting files created by cameras

my $copyright_year  = (localtime(time()))[5] + 1900; # the actual year, for the copyright notice
my $HTMLPicDir      = "pics";   # this is the name of the subdir for pics when building html pages
my $HTMLThumbDir    = "thumbs"; # this is the name of the subdir for thumbs when building HTML pages
my $slideshow       = 0;   # start/stop flag for slideshow
my $showPicInAction = 0;   # bool = 1 while loading picture
my %winapps;                # used for sub findApp()

my $clocktimer;
my $time;               # used to show the clock or memory usage in the top bar
my $date;               # the date is shown as balloon info 
my $clockL;             # clock/memory label widget
my $scsw;
my $wizW;
my $impW;
my $interpW;
my $fuzzybw;            # fuzzy border dialod window
my $ll_b_w;             # lossless border dialog window
my $ll_r_w;             # lossless relative border dialog window
my $ll_a_w;             # lossless aspect ratio border dialog window
my $ll_w_w;             # lossless drop picture (watermark) dialog window
my $bpw;                # border preview window
my $indexW;             # montage /index print dialog window
my $passportW;          # passport print dialog 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 $ddw;                # dirDiffWindow widget
my $catw;               # the IPTC categories window, see editIPTCCategories()
my $locw;               # the location window, see search_by_location()
my $keycw;              # the comment keywords window, see editCommentKeywords()
my $dupw;               # the duplicate search window, see sub finddups()
my $filterW;            # the filter window
my $menubar;            # handle for menubar of main window
my $balloon;            # balloon handle
my $dirMenu;            # context menu for dirs
my $thumbMenu;          # context menu for thumbnails
my $picMenu;            # context menu for picture
my $copyCommentSource;  # global variable of sub copyComment()
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 $cleanDirNoAsk = 0;  # needed in sub cleanDir()
my $cleanDirLevel = 0;  # needed in sub cleanDir()
#my $loc_search = 1;     # location window: search or add location on double click
# 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("$user_data_path/categories") if (-f "$user_data_path/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("$user_data_path/keywords") if (-f "$user_data_path/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;
# hot keywords, list of keywords which are often used, maintained by the user
my %hot_keywords = ('Family/Einstein/Pauline' => 1, 'Family/Planck/Max' => 1, 'Family/Planck/Johann' => 1);
# try to get the saved hot keywords
if (-f "$user_data_path/keywords_hot") {
  my $hashRef = retrieve("$user_data_path/keywords_hot");
  warn langf("could not retrieve %s",'keywords_hot') unless defined $hashRef;
  %hot_keywords = %{$hashRef};
}

# add mapivi program path to PATH
# this allows to locate external programs like jpegtran in the mapivi folder
# which makes packaging easier
$ENV{PATH} .= ";$FindBin::Bin";

# external programs used by mapivi
my %exprogs = qw/convert 0 composite 0 jhead 0 jpegtran 0 mogrify 0 montage 0 xwd 0 identify 0 thunderbird 0 mozilla-thunderbird 0 exiftool 0/;
# short comment about the usage of the external programs
my %exprogscom = (
           'convert'        => lang('Build thumbnails'),
           'composite'      => lang('Combine pictures e.g. thumbnails with a background'),
           'jhead'          => lang('Handle EXIF infos and embedded thumbnail pictures'),
           'jpegtran'       => lang('Do lossless rotation of pictures'),
           'mogrify'        => lang('Change the size/quality of pictures'),
           'montage'        => lang("Combine pictures to e.g. index prints"),
           'xwd'            => lang("Make a screenshot of a window or desktop"),
           'identify'       => lang("Describe the format and characteristics of a picture"),
           'thunderbird'    => lang("Send pictures via email"),
           'mozilla-thunderbird' => lang("Send pictures via email"),
           'exiftool'       => lang("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",
           "mogrify"        => "Image Magick http://www.imagemagick.org",
           "montage"        => "Image Magick http://www.imagemagick.org",
           "identify"       => "Image Magick http://www.imagemagick.org",
           "thunderbird"    => "http://www.mozilla.org/projects/thunderbird/",
           "mozilla-thunderbird" => "http://www.mozilla.org/projects/thunderbird/",
           "exiftool"       => "http://owl.phy.queensu.ca/~phil/exiftool/",	
          );

# hash to replace (german) umlaute by corresponding letters
my %umlaute = qw(ä ae Ä Ae ö oe Ö Oe ü ue Ü Ue ß ss);
my $umlaute = join '', keys(%umlaute);

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

# hash to replace (german) umlaute by corresponding HTML-tags
my %umlauteHTML = qw(ä &auml; Ä &Auml; ö &ouml; Ö &Ouml; ü &uuml; Ü &Uuml; ß &szlig;);
my $umlauteHTML = join '', keys(%umlauteHTML);

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

# mapivi configuration hash / tool options
my %conf;
my @conf_tab_order; # defines the order of the tabs in the configuration_edit dialog
configuration_set_default();

# preset for channel mixer for black and white conversion
# 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],
);

# old config hash -> new solution see configuration_set_default()
# insert here all default configurations
# these configurations will be overwritten by $configFile
# at startup
my %config = (
              "Geometry"        => "790x560+1+1", # fit on a 800x600 screen
              "SearchGeometry"  => "790x560+1+1", # fit on a 800x600 screen
              "KeyGeometry"     => "250x500+50+50", # fit on a 800x600 screen
              "LocGeometry"     => "250x500+50+50", # fit on a 800x600 screen
              "LtwGeometry"     => "700x500+10+10", # fit on a 800x600 screen
              "FontSize"        => 12,
              "FontFamily"      => "itc avant garde",
              "PropFontSize"    => 12,
              "PropFontFamily"  => "helvetica",
              "ColorSel"        => "gray40",
              "ColorSelBut"     => "red4",
              "ColorSelFG"      => "gray85",
              "ColorName"       => "gray85",
              "ColorComm"       => "gray85",
              "ColorIPTC"       => "gray85",
              "ColorEXIF"       => "gray85",
              "ColorFile"       => "gray85",
              "ColorDir"        => "gray85",
              "ColorThumbBG"    => "gray60",
              "ColorProgress"   => "gray85",
              "ColorPicker"     => "#efefef", # last color selected with color picker
              "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)
              "ThumbCapt"       => "none", # thumbnail caption
              "ThumbCaptFontSize" => 10,
              "ShowNavFrame"    => 1,  # boolean (1 = show naviagtion frame, 0 = hide)
              "ShowInfoFrame"   => 1,  # boolean (1 = show info frame, 0 = hide)
              "ShowThumbFrame"  => 1,  # boolean (1 = show thumb frame, 0 = hide)
              "ShowPicFrame"    => 1,  # boolean (1 = show pic frame, 0 = hide)
              "ShowComment"     => 1,  # boolean (1 = show comment, 0 = hide comment in thumbnail view)
              "ShowCommentField"=> 0,  # boolean (1 = show comment, 0 = hide comment in picture view)
              "ShowIPTCFrame"   => 0,  # boolean (1 = show IPTC headline, caption, 0 = hide IPTC frame in picture view)
              "ShowEXIF"        => 1,  # boolean (1 = show EXIF, 0 = hide EXIF in thumbnail 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)
              "PicQuality"      => 95, # quality of jpg picture (in %)
              "PicSharpen"      => 5,  # sharpness of picture
              "PicBlur"         => 0,  # blur the pictur
              "PicGamma"        => 1.0,# gamma value of picture
              "PicBrightness"   => 100,# Brightnes of picture (in %)
              "PicSaturation"   => 100,# Saturation of picture (in %)
              "PicHue"          => 100,# Hue of picture (in %)
              "PicStrip"        => 0,  # boolean (1 = strip all meta info when resizing pic)
              "ThumbQuality"    => 85, # quality of thumbnail jpg picture
              "SortBy"          => "name",
              "SortReverse"     => 0,
              "LastDir"         => $home,
              "FileNameFormat"   => "%y%m%d-%h%M%s", # the actual file name format when renaming
              "FileNameFormatDef"=> "%y%m%d-%h%M%s", # the default file name format when renaming
              "ThumbSharpen"    => 1,
              "ThumbSize"       => 100,
              "ThumbBorder"     => 4,
              "HTMLaddComment"  => 1,
              "HTMLaddEXIF"     => 1,
              "HTMLaddIPTC"     => 1,
              "HTMLcols"        => 2,
              "HTMLTargetDir"   => $home,
              "HTMLGalleryIndex"=> "../galleries.html",
              "HTMLGalleryTitle"=> "My gallery",
              "HTMLHomepage"    => "../../index.shtml",
              "HTMLTemplate"    => "$program_data_path/html/light.html",
              "HTMLFooter"      => "&copy; <a href=\"http://herrmanns-stern.de\">Martin Herrmann</a> <a href=\"mailto:Martin-Herrmann\@gmx.de\">&lt;Martin-Herrmann\@gmx.de&gt;</a>",
              "HTMLBGcolor"     => "white",
              "HTMLPicSize"     => 600,
              "HTMLPicSharpen"  => 1,
              "HTMLPicCopyright"=> 0,   # bool - add a visible copyright info into the picture
              "HTMLPicQuality"  => 80,  # quality of html jpg pictures
              "HTMLPicEXIF"     => 1,   # bool - 1 = copy the EXIF infos to the converted HTML pics
              "HTMLnoPicChange" => 0,   # bool - 1 = no pic changes (no resize etc ...)
              "AutoZoom"        => 1,   # boolean - zoom big pictures to fill the canvas
              "UseEXIFThumb"    => 0,   # boolean - use EXIF Thumbnails if available
              "AskGenerateThumb"=> 1,   # ask before generating thumbnails
              "AskDeleteThumb"  => 1,   # ask before deleting thumbnails
              "AskMakeDir"      => 1,   # ask before makeing a directory (e.g. .thumbs or .exif)
              "MaxTrashSize"    => 50,  # MB - a warning will appear if the trash contains more than this
              "BitsPixel"       => 0,   # boolean - show bits per pixel info
              "AspectRatio"     => 1,   # boolean - show image aspect ratio e.g. 4:3 or 3:2
              "NameComment"     => 0,   # boolean - 1 = add file name to comment, when importing pics
              "NameComRmSuffix" => 1,   # boolean - 1 = remove file suffix when adding filename to comment
              "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",
              "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
              "IPTCoverwrite"   => 0,   # overwrite IPTC attributes, when editing multiple pictures
              "IPTCmergeCatKey" => 1,   # merge categories and keywords, when editing multiple pictures
              "IPTCdateEXIF"    => 0,   # use EXIF date as creation date
              "IPTCtimeEXIF"    => 0,   # use EXIF time as creation time
              "IPTCbylineEXIF"  => 0,   # use EXIF owner as ByLine
              "IPTCaddMapivi"   => 0,   # add Mapivi infos to IPTC
              "IPTC_action"     => 'UPDATE', # ADD UPDATE or REPLACE
              "CheckForNonJPEGs"=> 0,   # check if there are non JPEGs in the dir and ask to convert them
              "ShowPicInfo"     => 1,   # show a balloon info box with EXIF, comment, ... for the actual picture
              "SearchPattern"   => '',  # the search pattern
              "SearchExPattern" => '',  # the search exclude pattern
              "SearchCom"       => 1,   # search in the picture comments
              "SearchExif"      => 1,   # search in the picture EXIF info
              "SearchIptc"      => 1,   # search in the picture IPTC info
              "SearchKeys"      => 1,   # search in the picture keywords
              "SearchName"      => 1,   # search in the picture file name
              "SearchDir"       => 1,   # search in the picture path
              "SearchCase"      => 0,   # search case sensitive
              "SearchWord"      => 0,   # 1 = search only complete words 0 = match also parts
              "SearchType"      => 'exactly', # search type: "exactly", "all" or "any"
              "SearchOnlyInDir" => 0,   # search only in dirs matching the actual/selected dir
              "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.2012",   # 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"   => "$program_data_path/icons/MapiviIcon.gif",
              "CopyTextOrLogo"  => "text",
              "BorderWidth1x"   => 10,      # border 1 width in x direction
              "BorderWidth1y"   => 10,      # border 1 width in y direction
              "BorderColor1"    => "white", # border 1 color
              "BorderWidth2x"   => 0,       # border 2 width in x direction
              "BorderWidth2y"   => 0,       # border 2 width in y direction
              "BorderColor2"    => "black", # border 2 color
              "BorderWidth3x"   => 0,       # border 3 width in x direction
              "BorderWidth3y"   => 0,       # border 3 width in y direction
              "BorderColor3"    => "white", # border 3 color
              "BorderWidth4x"   => 0,       # border 4 width in x direction
              "BorderWidth4y"   => 0,       # border 4 width in y direction
              "BorderColor4"    => "gray80",# border 4 color
              "BorderAdd"       => 0,   # bool - add a border
              "DropShadow"      => 0,   # bool - add a drop shadow
              "DropShadowWidth" => 5,   # the width of the drop shadow
              "DropShadowBlur"  => 3,   # the blur sigma factor of the drop shadow
              "DropShadowBGColor" => "white",  # the background color of the drop shadow
              "jpegtranTrim"    => 0,   # bool - use the -trim switch of jpegtran
              "SlideShowTime"   => 4,   # pause between picture loading im sec
              "CropAspect"      => 3/2, # 0 for no aspect ratio, 3/2 for 3:2 1 for 1:1 4/3 for 4:3
              "CropGrid"        => 1,   # bool show 1/3 crop grid
              "AspectSloppyFactor" => 2.0, # delta factor for aspect ratio calculation in %
              "FilterDeco"      => 0,   # add a border or a text to the pictures when filtering
              "FilterPrevSize"  => 200, # filter preview size (100% zoom crop of the picture)
              "EXIFshowApp"     => 1,   # show App*-Info and MakerNotes and ColorComponents in EXIF info
              "Layout"          => 0,   # layout of the dir, thumb and picture frame
              "Layout0dirX"     => 25,  # default percentual width of the different layouts
              "Layout0thumbX"   => 30,  # ""
              "Layout1dirX"     => 20,  # ""
              "Layout3thumbX"   => 20,  # ""
              "Layout5dirX"     => 20,  # ""
              "CommentHeight"   => 2,   # height of the comment text frame above the picture
              "Gamma"           => 1.0, # the gamma value, when displaying pictures
              "ShowFileDate"    => 0,   # show the file date in the size coloumn
              "Unsharp"         => 0,   # bool unsharp mask operation on/off
              "UnsharpRadius"   => 0,   # unsharp mask radius (blur)
              "UnsharpSigma"    => 1.0, # unsharp mask sigma (blur)
              "UnsharpAmount"   => 1.0, # unsharp mask amount
              "UnsharpThreshold"=> 0.05,# unsharp mask threshold
              "ResizeFilter"    => "Lanczos",
              "RenameBackup"    => 1,   # bool, if 1 a backup file will be renamed if the file is renamed
              "ThumbMaxLimit"   => 200, # maximum number of displayed thumbnails
              "Level"           => 0,   # level a picture
              "LevelBlack"      => 8,   # level a picture black point (%)
              "LevelWhite"      => 92,  # level a picture white point (%)
              "LevelGamma"      => 1.0, # level a picture mid point (gamma value)
              "indexBorder"     => 0,   # bool add a border around the index print
              "indexBorderWidth"=> 50,
              "indexBorderColor"=> 'white',
              "indexInnerBorder"     => 0,   # bool add a border around the each picture
              "indexInnerBorderWidth"=> 2,
              "indexInnerBorderColor"=> 'black',
              "indexFontSize"   => 10,  # the font size of the index labels (0 = automatic)
              "CheckForLinks"   => 1,   # bool - check if a file is a link before processing it
              "ColorAdj"        => 0,   # bool - do some color adjustments when filtering a pic
              "LineLimit"       => 8,   # max nr of lines in the thumbnail table e.g. for comments
              "LineLength"      => 30,  # length of one line in the thumbnail table e.g. for comments
              "ExtBGApp"        => "wmsetbg -a", # name of external app to set desktop background (with options) 
              "ConvertUmlaut"   => 1,   # convert german umlaute (e.g. ä -> ae etc.)
              "onlyASCII"       => 1,   # convert Umlaute and remove non printable (non-ASCII) chars
              "ImportSource"    => "/mnt/usb/DCIM/DIMG",
              "ImportSubdirs"   => 0,  # bool - import also from all subdirs
              "ImportTargetFix" => "$home/pictures",
              "ImportTargetVar" => "2012/02/14_Birthday_Sam",
              "ImportRotate"    => 1,
              "ImportRename"    => 1,
              "ImportDeleteCameraJunk" => 0,
              "ImportDelete"    => 1,
              "ImportShowPics"  => 1,
              "ImportAddCom"    => 0,
              "ImportAddComment"=> "(c) $copyright_year Martin Herrmann",
              "ImportAddIPTC"   => 0, # bool
              "ImportAddIPTCDateTime" => 0, # bool
              "ImportAddIPTCByLine" => 0, # bool
              "ImportIPTCTempl" => 'template.iptc2',
              "ImportMore"      => 0,  # bool - show additional import options in wizard 
              "ImportMarkLocked"=> 0,  # bool - add a high rating to locked (= write protected) pictures during import
              "Borderwidth"     => 1,  # border width of GUI elements (widgets)
              "PrintBaseDir"    => "$home/pictures/print",
              "PrintVarDir"     => "3_times_13x18",
              "PrintTimes"      => "1",
              "PrintTimesStr"   => "times",
              "PrintSize"       => "10x15",
              "CenterThumb"     => 0,    # move the thumbnails up or down, so that the next e.g. previous thumb is also visible
              "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"     => "2012:03: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,
              "FuzzyBorderRelative"=> 1,  # 1 = Border width in %, 0 = Absolute in pixels
              "FuzzyBorderWidth"=> 10,    # % or pixels depending on FuzzyBorderRelative
              "FuzzyBorderBlur" => 10,
              "FuzzyBorderColor"=> 'black',
              "ShowInfoInCanvas"=> 1,
              "llBorderWidthX"  => 16,
              "llBorderWidthY"  => 16,
              "llBorderWidthIX" => 1,
              "llBorderWidthIY" => 1,
              "llBorderColor"   => 'white',
              "llBorderColorI"  => 'black',
              "supportOtherPictureFormats" => 0,
              "CategoriesAll"   => 2,     # category mode 0= last, 1=all, 2=join
              "KeywordsAll"     => 2,     #  keyword mode 0= last, 1=all, 2=join
              "Version"         => '000',
              "ShowUnfinishedDirs" => 1,
              "ShowFinishedDirs" => 1,
              "trackPopularity" => 1,
              "ChannelRed"      => 100,
              "ChannelGreen"    => 100,
              "ChannelBlue"     => 100,
              "ChannelDeco"     => 0,
              "ChannelBright"   => 1,
              'SlideShowDir'    => $home, # settings for slideshows
              'relative_path'   => 1,     # settings for xnview slideshows
              'xnview_loop'     => 1,     # settings for xnview slideshows
              'xnview_fullscreen' => 1,   # settings for xnview slideshows
              'xnview_filename' => 0,     # settings for xnview slideshows
              'xnview_random'   => 0,     # settings for xnview slideshows
              'xnview_mouse'    => 0,     # settings for xnview slideshows
              'xnview_title'    => 0,     # settings for xnview slideshows
              'PicWinBalloon'   => 1,     # boolean -1 show balloon info in pic window
              'IPTCProfessional'=> 1,     # boolean - 1 = professional IPTC, 0 = simple dialog
              'CheckNewKeywords'=> 1,
              'KeywordMore'     => 0,     # boolean 1 = show more options in keyword search window
              'KeywordExclude'  => '',    # space separated list of keywords to exclude
              'KeywordLimit'    => 0,     # boolean 1 = limit number of displayed keywords
              'KeywordDate'     => 0,     # boolean 1 = limit to a date range
              'KeywordStart'    => 1070254800, # start date (UNIX time)
              'KeywordEnd'      => 1170254800, # end date (UNIX time)
              'UrgencyChangeWarning' => 1, # boolean 1 = show a warning when urgency changed
              'ActPic'          => '',     # the last picture shown
              'SelectLastPic'   => 1,      # Select last shown pic after startup
              'AutoImport'      => 1,      # boolean = 1 start import at Mapivi wizard if memory card is inserted (ImportSource)
              'llWatermarkX'    => 16,     # lossless watermark x position
              'llWatermarkY'    => -16,    # lossless watermark y position
              'llWatermarkFile' => "$icon_path/EmptyThumb.jpg", # lossless watermark file name
              'AspectBorderN'   => 3,      # lossless aspect ratio border
              'AspectBorderM'   => 2,      # lossless aspect ratio border
              'RelativeBorderX' => 10,     # lossless relative border
              'RelativeBorderY' => 10,     # lossless relative border
              'RelativeBorderIX' => 0.1,   # lossless relative border
              'RelativeBorderIY' => 0.1,   # lossless relative border
              'RelativeBorderEqual'=> 1,   # boolean lossless relative border
              'XMP_file_operations'=> 1,   # boolean XMP sidecar files follow picture file operations
              'WAV_file_operations'=> 1,   # boolean WAV audio files follow picture file operations
              'RAW_file_operations'=> 0,   # boolean RAW files follow picture file operations
              'LocationMode'       => 'UPDATE', # UPDATE or REPLACE - mode for writing IPTC location info
              'AskDeleteHighRating'=> 1,   # boolean - ask before deleting high rated pictures
              'AskDeleteHighRatingLevel'=> 3,   # Urgency  (Rating) - ask before deleting high rated pictures
              'Language'                => 'en', # language localization, needs a corresponding translation file e.g. mapivi-lang-de for german (de)
              'ColorCloud'              => 'red', # color of the most prominent keywords in the keyword cloud
             );

# some platform specific default settings
# for windows
#if ($EvilOS) {
#  $config{ExtViewer} = 'C:\Program Files\IrfanView\iview_32.exe';
#  $config{ExtEdior}  = 'gimp-win-remote gimp-2.2.exe';
#}
# for Mac OS X
#if ($MacOSX) {
#  $config{ExtViewer}         = "macosx-preview";
#  $config{ExtViewerMulti}    = 1;
#}

my @IPTCAttributes = (
            "Urgency",
            "Keywords",
            "Headline",
            "Caption/Abstract",
            "Country/PrimaryLocationName",
            "Country/PrimaryLocationCode",
            "Province/State",
            "City",
            "SubLocation",
            "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' => lang("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' => lang("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' => lang("The Caption field is the text that accompanies the photo, containing the who, what, when, where and why information (max. 2000 chars)"),
                'CaptionWriter' => lang("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' => lang("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' => lang("Identifies the location within a city. Examples: Capitol Hill, Maple Leaf Gardens, Strandgateparken (max. 32 chars)"),
                'City' => lang("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' => lang("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' => lang("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' => lang("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' => lang("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' => lang("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' => lang("The Headline field lists keywords to aid in a more detailed search for a photo. Example: Lindbergh Lands In Paris (max. 256 chars)"),
                'SpecialInstructions' => lang("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' => lang("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' => lang("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' => lang("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' => lang("The Supplemental Categories field lists codes that aid in a more detailed search for a photo."),
                'OriginalTransmissionReference' => lang("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' => lang("Priority 0 meaning None, 1 meaning High to 8 meaning Low"),
                'CopyrightNotice' => lang("Contains any necessary copyright notice. (max. 128 chars)"),
                'ExpirationTime' => lang("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' => lang("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' => lang("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' => lang("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' => lang("Identifies objectdata that recurs often and predictably. Enables users to immediately find or recall such an object. Example: EUROWEATHER"),
                'EditStatus' => lang("Status of the objectdata, according to the practice of the provider. Examples: Lead, CORRECTION (max. 64 chars)"),
                'Writer/Editor' => lang("Identification of the name of the person involved in the writing, editing or correcting the objectdata or caption/abstract. (max. 32 chars)"),
                'LanguageIdentifier' => lang("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' => lang("Where: a = morning, p = evening, b = both. Virtually only used in North America. (1 char)"),
                'Contact' => lang("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 (old configuration)
readConfig($configFile, \%config) if (-d $user_data_path);

# get the configurations from file  (new configuration)
{
  my ($ok, $err) = configuration_restore($conf_file, \%conf);
  warn $err if (not $ok);
}
$actpic = $config{ActPic};

# todo: generate a template from all lang() and langf() calls within mapivi
my %messages;
# Warning: no lang() or langf() call before the language_load call! (They will be useless)
language_load($config{Language});

# Warning! The keys of the %statistic_data_longnames hash have to be same as in the %searchDB hash!!!
my %statistic_data_longnames = (
'COM' => lang("comment"),
'EXIF' => lang("EXIF data"),
'IPTC' => lang("IPTC data"),
'URG' => lang("rating"),
'KEYS' => lang("keywords"),
);

# used as '[empty]' string in IPTC location info
my $empty_str = '['.lang("empty").']';
# At startup the menu should always be visible
$config{ShowMenu}   = 1;
# I consider it safer to reset this option after a restart, else the user may lose an orignial picture
$config{MakeBackup} = 1;

# check at startup if a new Mapivi version is available
check_version($version);

# 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, 4,7, 5,9, 1,2, 3,7, 2,5, 3,8, 4,11, 1,3, 2,7, 1,4, 2,9, 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;
# store session start time
$top->{sessioninfo}{starttime} = time();
# store name in top hash (used in Tk::MhConfig.pm)
$top->{tool_name} = 'Mapivi';

# process Gtk2 events if Gtk2 is available
if ($gtk2_avail) {
  $top->repeat(10, sub{
    Gtk2->main_iteration while Gtk2->events_pending;
  });
}  

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

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

my $dragAndDrop1 = "$program_data_path/icons/MiniPic.jpg";
my $dragAndDrop2 = "$program_data_path/icons/MiniPicMulti.jpg";
my $dragAndDropIcon1;
$dragAndDropIcon1 = $top->Photo(-file => $dragAndDrop1) if (-f $dragAndDrop1);
my $dragAndDropIcon2;
$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 $svnrevision");
$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", $conf{color_hl_bg}{value}, 'userDefault');
$top->optionAdd("*background",          $conf{color_bg}{value},    'userDefault');
$top->optionAdd("*activeBackground",    $conf{color_act_bg}{value},'userDefault');

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

for (qw(foreground)) {
  $top->optionAdd("*$_", $conf{color_fg}{value}, 'userDefault');
}
$top->optionAdd('*Button.foreground' => $conf{color_fg}{value});
$top->optionAdd('*Button.padY' => 0);
$top->optionAdd('*Radiobutton.padY' => 0);
$top->optionAdd('*ROText.foreground' => $conf{color_fg}{value});
$top->optionAdd('*Optionmenu.foreground' => $conf{color_fg}{value});
$top->optionAdd('*DirTree.foreground' => $conf{color_fg}{value});
$top->optionAdd('*HList.foreground' => $conf{color_fg}{value});

# must be after the *foreground and *background optionAdd call
$top->optionAdd("*Menu.background", $conf{color_menu_bg}{value}, 'userDefault');
$top->optionAdd("*Menu.foreground", $conf{color_menu_fg}{value}, 'userDefault');

for (qw(Scale Scrollbar Adjuster)) {
  $top->optionAdd("*$_.troughColor", $conf{color_entry}{value}, 'userDefault');
}

$top->optionAdd("*ProgressBar.troughColor", $conf{color_bg}{value}, 'userDefault');

$top->optionAdd("*Label.background", $conf{color_bg}{value}, 'userDefault');

for (qw(Entry NumEntry Listbox KListbox K2Listbox TixHList HList Text
        BrowseEntry.Entry NoteBook)) {
  $top->optionAdd("*$_.background", $conf{color_entry}{value}, '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);
my $font_big = $top->Font(-family => $config{FontFamily}, -size => 20);

$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: navigation frame ($nav_F), thumbnails ($thumbF) and picture ($mainF)
my $subF   = $top->Frame();

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

my $dirtree; # is defined in add_nav_frame()

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

my $iptcF = $mainF->Frame(-relief => 'raised');

my $nrofL = $infoF->Label(-justify => 'left', -textvariable => \$nrof, -relief => 'sunken', -anchor => 'w', -foreground => $conf{color_menu_fg}{value})->pack(-side => 'left', -expand => 0, -fill => 'y');

$balloon->attach($nrofL, -msg => lang("x/y (z, s) = first selected picture is number x\nfrom y pictures in the actual folder\nz pictures are selected\ns is the file size of all selected pictures"));

my $dirtreedir;

my $actdirF = $thumbF->Frame()->pack(-expand => 1, -fill => 'x', -padx => 2, -pady => 1);

if ($conf{filter_pics_button}{value}) {
  $actdirF->{Filter} = $actdirF->Checkbutton(-variable => \$conf{filter_pics}{value})->pack(-side => 'left', -anchor=>'w', -padx => 0);
  $actdirF->{Filter}->configure(-textvariable => \$actdirF->{Filter}->{excluded_pics});
  $actdirF->{Filter}->{excluded_pics} = 0;
  $balloon->attach($actdirF->{Filter}, -postcommand => sub {$actdirF->{Filter}->{msg} = lang("If enabled this function will filter the pictures using a keyword list.\nPictures containing the following keywords are not shown:\n$conf{filter_pics_keywords}{value}\nUse the right mouse button over the check button to edit this list.\nThe displayed number (currently $actdirF->{Filter}->{excluded_pics}) indicates the number of excluded pictures.")}, -msg => \$actdirF->{Filter}->{msg});
  $actdirF->{Filter}->bind('<ButtonPress-3>',   sub {
    my $exclude_keys = $conf{filter_pics_keywords}{value};
    my $rc = myEntryDialog(lang("Edit keywords"), lang("Please edit the list of keywords to exclude.\nSeparate different keywords with a space."), \$exclude_keys);
    if ($rc eq 'OK') {
      $conf{filter_pics_keywords}{value} = $exclude_keys;
    }
  });
}
else {
  # if the button is not enabled we should not filter
  $conf{filter_pics}{value} = 0;
}

my $act_nav_label = '';
my $act_nav_L = $actdirF->Label(-textvariable => \$act_nav_label, -width => 10, -anchor => 'e', -relief => 'sunken', -bd => $config{Borderwidth}, -foreground => $conf{color_menu_fg}{value})->pack(-side => 'left', -expand => 1, -fill => 'x');
$balloon->attach($act_nav_L, -msg => lang("Actual view as chosen in the navigation frame.\nClick opens folder selection dialog."));
$act_nav_L->bind('<ButtonPress-1>', sub { openDir(); } ); 

# add three folder check buttons to mark the folder state (sorted, meta-info, prio/ratings) 
$actdirF->{folder_check_buttons} = $actdirF->Frame()->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 2, -pady => 1);

my $otherFilesL = $actdirF->{folder_check_buttons}->Button(-textvariable => \$otherFiles, -command => sub {showNonJPEGS();}, -relief => 'sunken', -bd => $config{Borderwidth}, -foreground => $conf{color_menu_fg}{value}, -padx => 1, -pady => 0)->pack(-side => 'left');
$balloon->attach($otherFilesL, -msg => lang('Number of hidden files in actual folder')."\n".lang('Click to see hidden files'));

my $dirPropSORT = 0;
my $dirPropMETA = 0;
my $dirPropPRIO = 0;
$actdirF->{cbSORT} = $actdirF->{folder_check_buttons}->Checkbutton(-variable => \$dirPropSORT, -command => sub { $dirProperties{$actdir}{SORT} = $dirPropSORT; })->pack(-side => 'left', -anchor=>'w', -padx => 0);
$actdirF->{cbMETA} = $actdirF->{folder_check_buttons}->Checkbutton(-variable => \$dirPropMETA, -command => sub { $dirProperties{$actdir}{META} = $dirPropMETA; })->pack(-side => 'left', -anchor=>'w', -padx => 0);
$actdirF->{cbPRIO} = $actdirF->{folder_check_buttons}->Checkbutton(-variable => \$dirPropPRIO, -command => sub { $dirProperties{$actdir}{PRIO} = $dirPropPRIO; })->pack(-side => 'left', -anchor=>'w', -padx => 0);
{
  my $common_info = lang("\n\nThis button is intended to be used as\npersonal markers for the folder status.\nSee also Menu: ").lang("File")."->".lang("Folder checklist ...");
  $balloon->attach($actdirF->{cbSORT}, -msg => langf("You may use this marker e.g. to\nmark this folder as sorted out.%s",$common_info));
  $balloon->attach($actdirF->{cbMETA}, -msg => langf("You may use this marker e.g. to\nmark this folder, if all meta information is added.%s",$common_info));
  $balloon->attach($actdirF->{cbPRIO}, -msg => langf("You may use this marker e.g. to\nmark this folder, if all pictures are rated.%s",$common_info));
}

my %mapivi_icons = define_icons();
my $picLB;

# main canvas used to show pictures
my $c = $mainF->Scrolled('Canvas',
                         -scrollbars  => 'osoe',
                         -width       => 2000,
                         -height      => 2000,
                         -relief      => 'flat',
                         -borderwidth => 0,
                         -highlightthickness => 0,
                         -bg          => $conf{color_bg_canvas}{value},
                        );

$c->configure(-scrollregion => [0, 0, 100, 100]);
# some canvas settings
$c->{thumb_distance} = 5;   # in pixels
$c->{thumb_size} = $config{'ThumbSize'}; # in pixels

my $whL = $infoF->Label(-textvariable => \$widthheight, -relief => 'sunken', -foreground => $conf{color_menu_fg}{value})->pack(-side => 'left', -expand => 0, -fill => 'y');
$balloon->attach($whL, -msg => lang("Width and height of actual picture in pixels"));

my $sizeL = $infoF->Label(-textvariable => \$size, -relief => 'sunken', -foreground => $conf{color_menu_fg}{value})->pack(-side => 'left', -fill => 'y');
$balloon->attach($sizeL, -msg => lang("File size of actual picture in kByte"));

# zoom info
my $zoomL = $infoF->Label(-textvariable => \$zoomFactorStr, -relief => 'sunken', -foreground => $conf{color_menu_fg}{value})->pack(-side => 'left', -fill => 'y');
$balloon->attach($zoomL, -msg => lang("Zoom factor of actual picture"));

# picture rating
my $rating_but;
{
  my $rating = 3;
  $rating_but = rating_button($infoF, sub {setIPTCurgency($picLB, $rating);}, lang("Rating (IPTC urgency) of actual picture\nTo change click on stars or use keys Ctrl-5 .. -1 or Ctrl-F1, -F2, ... -F8"), 'left', 'y', \$rating);
}
  
# log info
my $userInfoL = $infoF->Label(-textvariable => \$userinfo, -relief => 'sunken', -foreground => $conf{color_menu_fg}{value})->pack(-side => 'left', -fill => 'both', -expand => 1);
$balloon->attach($userInfoL, -msg => lang("Mapivi log information\nHint: Click to see complete log history."));
$userInfoL->bind('<ButtonPress-1>', sub { showText(lang("Mapivi log"), $global_log, NO_WAIT); } );

# color picker
my $colorPickerInfo = $infoF->Label(-text => ' ', -background => $config{ColorPicker}, -relief => 'sunken')->pack(-side => 'left', -fill => 'both', -expand => 0);
$balloon->attach($colorPickerInfo, -msg => lang("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} = $conf{color_bg}{value};
  $colorPickerInfo->configure(-background => $config{ColorPicker}); });

# thumbnail generator
my $nrTCL = $infoF->Label(-textvariable => \$nrToConvert, -relief => 'sunken', -foreground => $conf{color_menu_fg}{value})->pack(-side => 'left', -expand => 0, -fill => 'y');
$balloon->attach($nrTCL, -msg => lang("Number of thumbnails to generate/refresh"));

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

# clock or memory usage label
$clockL = $infoF->Label(-textvariable => \$time, -relief => 'sunken', -foreground => $conf{color_menu_fg}{value})->pack(-side => 'left', -fill => 'y');
$balloon->attach($clockL, -msg => \$date);
$clockL->bind('<ButtonPress-1>', sub { toggle(\$conf{clock_or_memory}{value}); showTimeOrMemory(); } );

# show thumbnails button
my $thumbscanvasbut = $infoF->Button(-image => $mapivi_icons{'Image'}, -command => sub {my @pics = $picLB->info('children');show_canvas_thumbs($c, \@pics);})->pack(-side => 'left', -fill => 'both', -expand => 0);
$balloon->attach($thumbscanvasbut, -msg => lang('Show thumbnails in picture frame'));

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

$picLB = makeThumbListbox($thumbF);
focus_on_enter($picLB);

# IPTC headline and caption edit box
my $titleF = $iptcF->Frame()->pack(-fill => 'both', -expand => 1);
my $capF   = $iptcF->Frame()->pack(-fill => 'both', -expand => 1);
my $titleText;
my $captionText;
$titleF->Label(-text => 'Headline')->pack(-side => 'left', -fill => 'both');
$titleText = $titleF->Scrolled('Text',
                               -scrollbars => '',
                               -wrap => 'word',
                               -width => 20,
                               -height => 1,
                              )->pack(-side => 'left', -fill => 'both', -expand => 1);
$capF->Label(-text => 'Caption ')->pack(-side => 'left', -fill => 'both');
$captionText = $capF->Scrolled('Text',
                               -scrollbars => 'oe',
                               -wrap => 'word',
                               -width => 20,
                               -height => $config{CommentHeight},
                              )->pack(-side => 'left', -fill => 'both', -expand => 1);
{
  my $common_text = lang("Add or edit text and then save it by pressing the save button.\nPress F4 to show or hide this box.");
  $balloon->attach($titleText, -msg => lang("IPTC headline (title) of displayed picture.\n").$common_text);
  $balloon->attach($captionText, -msg => lang("IPTC caption of displayed picture.\n").$common_text);
}

my $saveB = $capF->Button(-image => compound_menu($top, lang('Save'), 'media-floppy.png', 0),
                           -command => sub {
                                         my $title = $titleText->get(0.1, 'end');
                                         $title =~ s/\n+$//; # cut off trailing newline(s)
                                         my $caption = $captionText->get(0.1, 'end');
                                         $caption =~ s/\n+$//; # cut off trailing newline(s)
                                         my $iptc = { 'Headline' => $title,
                                                      'Caption/Abstract' => $caption };
                                         my @list; 
                                         my @sellist = getSelection($picLB);
                                         if (!isInList($actpic, \@sellist)) {
                                           my $selp = langf("%d pic(s)", scalar(@sellist));
                                           my $actp = lang('actual');
                                           my $cancel = lang('Cancel');
                                           my $rc = $top->Dialog( -text => langf("The selection (%s) does not contain the actual picture (%s).",$selp, basename($actpic))."\n".lang("Add headline and caption to:"),
                                                                  -title => lang("Add to selection or to actual picture?"),
                                                                  -width => 50,
                                                                  -buttons => [$selp, $actp, $cancel])->Show();
                                           return if ($rc eq $cancel);
                                           @list = @sellist if ($rc eq $selp);
                                           @list = ($actpic) if ($rc eq $actp); 
                                         } elsif (scalar(@sellist) > 1) {
                                           my $selp = scalar(@sellist).' selected';
                                           my $actp = 'actual';
                                           my $cancel = 'Cancel';
                                           my $rc = $top->Dialog( -text => lang('Add headline and caption to:'),
                                                                  -title => lang('Add to selection or to actual picture?'),
                                                                  -width => 50,
                                                                  -buttons => [$selp, $actp, $cancel])->Show();
                                           return if ($rc eq $cancel);
                                           @list = @sellist if ($rc eq $selp);
                                           @list = ($actpic) if ($rc eq $actp); 
                                         } else {
                                           @list = ($actpic); 
                                         }
                                         applyIPTC($picLB, $iptc, \@list);
                                     }
                           )->pack(-side => 'left', -fill => 'both');
$balloon->attach($saveB, -msg => lang("Save the IPTC headline and caption to the file and database.\nPlease press this button after adding or editing."));
#$captionText->Subwidget("scrolled")->bindtags([]);
#$captionText->Subwidget("scrolled")->bind('<Key-a>', sub {});
#->Subwidget("scrolled")

# item styles for the thumbnail view
my $thumbCaptionFont = $top->Font(-family => $config{FontFamily}, -size   => $config{ThumbCaptFontSize});
# if changes are made here, other places may need an update too (see e.g. line containg "my $fileS2")
my $thumbS =  $picLB->ItemStyle('imagetext', -anchor => 'w', -textanchor => 's', -foreground=>$conf{color_fg}{value},   -background=>$conf{color_bg}{value}, -font => $thumbCaptionFont);
my $fileS  =  $picLB->ItemStyle('image', -anchor=>'w', -foreground=>$config{ColorFile}, -background=>$conf{color_bg}{value});
my $iptcS  =  $picLB->ItemStyle('text', -anchor=>'nw', -foreground=>$config{ColorIPTC}, -background=>$conf{color_bg}{value});
my $comS   =  $picLB->ItemStyle('text', -anchor=>'nw', -foreground=>$config{ColorComm}, -background=>$conf{color_bg2}{value});
my $exifS  =  $picLB->ItemStyle('text', -anchor=>'nw', -foreground=>$config{ColorEXIF}, -background=>$conf{color_bg2}{value});
my $dirS   =  $picLB->ItemStyle('text', -anchor=>'nw', -foreground=>$config{ColorDir},  -background=>$conf{color_bg2}{value});

toggleHeaders();

# mouse and button bindings
# key-desc,double click,show picture in own window
$picLB->bind('<Double-Button-1>', sub {
               return if (!$picLB->info('children'));
               showPicInOwnWin(getNearestItem($picLB)); } ); # 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"; } );

# this has to be done after the %keywords and %hot_keywords have been read in
add_nav_frame($nav_F);

# Drag-and-drop
# Define the source for drags.
# Picture drags are started while pressing left mouse button and moving the mouse
my $token;
# key-desc,LeftBut,(LeftMouseButton) drag and drop pictures to a folder
$token = $picLB->DragDrop
  (-event     => '<B1-Motion>',                # drawback: no selection by dragging possible, but intuitive
  #(-event     => '<Shift-Control-B1-Motion>', # drawback: difficult to use
   -sitetypes => 'Local',
   -startcommand => sub { dragFromPicLB($token) },
  );
# Define the target for picture drops.
$dirtree->DropSite
  (-droptypes     => 'Local',
   -dropcommand   => sub { dropToDirTree(); },
  );

# keyword tree drag and drop
{
  my $keyword_token;
  # key-desc,LeftBut,(LeftMouseButton) drag and drop keywords to picture
  # drag from keyword tree
  $keyword_token = $nav_F->{key_frame}->{tree}->DragDrop
    (-event     => '<B1-Motion>',
     -sitetypes => 'Local',
     -startcommand => sub { drag_keyword($nav_F->{key_frame}->{tree}, $keyword_token) },
    );
  # keyword clipboard (hotlist) drag and drop
  $keyword_token = $nav_F->{key_frame}->{hot}->DragDrop
    (-event     => '<B1-Motion>',
     -sitetypes => 'Local',
     -startcommand => sub { drag_keyword($nav_F->{key_frame}->{hot}, $keyword_token); },
    );
  # Define the targets for keyword drops
  # drop to canvas - actual picture
  $c->DropSite
    (-droptypes     => 'Local',
     -dropcommand   => sub { print "drop site canvas tree\n"; drop_keyword($c, $keyword_token); },
    );
  # # drop to picLB - selected pictures in thumbnail list
  $picLB->DropSite
    (-droptypes     => 'Local',
     -dropcommand   => sub { drop_keyword($picLB, $keyword_token); },
    );
  # drop to the keyword hotlist
  $nav_F->{key_frame}->{hot}->DropSite
    (-droptypes     => 'Local',
     -dropcommand   => sub { drop_keyword($nav_F->{key_frame}->{hot}, $keyword_token); },
    );
}

$picLB->bind('<ButtonPress-1>', sub {
  # save button press coordinates to distinguish picture selection from picture dragging
  ($picLB->{lastx}, $picLB->{lasty}) = ($Tk::event->x(), $Tk::event->y());
  #print "press: $picLB->{lastx}, $picLB->{lasty}\n";
  # if mouse is pressed over an already selected item it may be a drag, so we ignore the press
  #my @selection = $picLB->info('selection');
  #if (isInList(getNearestItem($picLB), \@selection)) {
  #  print "pic is in list ignoring press\n";
  #  Tk->break;
  #  return;
  #}
  # saved here for undo function
  @savedselection2 = @savedselection;
  @savedselection = $picLB->info('selection');
} );
$picLB->bind('<ButtonRelease-1>', sub { showSelectedPic(); } );
$picLB->bind('<ButtonPress-3>', sub {
               if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off
               $thumbMenu->Popup(-popover => 'cursor', -popanchor => 'nw');
             } );
# key-desc,Return,display the selected picture
$picLB->bind('<Key-Return>', sub { showSelectedPic(); } );
$c->CanvasBind('<ButtonPress-3>', sub {
                 if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off
                 $picMenu->Popup(-popover => "cursor", -popanchor => "nw");
               } );
# we can't bind all keys to the complete window ($top) as we have e.g. the IPTC Caption entry which should get all key events
addWindowKeyBindings($dirtree, $picLB);
addWindowKeyBindings($nav_F->{loc_frame}, $picLB);
addWindowKeyBindings($nav_F->{date_frame}, $picLB);
addWindowKeyBindings($nav_F->{key_frame}, $picLB);
addWindowKeyBindings($nav_F->{cloud_frame}, $picLB);
addWindowKeyBindings($nav_F->{search_frame}, $picLB);
addWindowKeyBindings($picLB, $picLB);
addWindowKeyBindings($c, $picLB);
# 2011-03-30: attempt to remove problem that mapivi sometimes doesn't respond to key input in fullscreen- or only-picture-mode
# but this doesn't solve the problem, binding to $mainF doesn't help either
#addWindowKeyBindings($c->Subwidget('canvas'), $picLB); 
addCommonKeyBindings($dirtree, $picLB);
addCommonKeyBindings($nav_F->{loc_frame}, $picLB);
addCommonKeyBindings($nav_F->{date_frame}, $picLB);
addCommonKeyBindings($nav_F->{key_frame}, $picLB);
addCommonKeyBindings($nav_F->{cloud_frame}, $picLB);
addCommonKeyBindings($nav_F->{search_frame}, $picLB);
addCommonKeyBindings($picLB,   $picLB);
addCommonKeyBindings($c,       $picLB);
$c->CanvasBind('<ButtonPress-2>', sub {
    return unless defined $actpic;
    return unless (-f $actpic);
    log_it("Opening $actpic in new window");
    showPicInOwnWin($actpic);
} );
# key-desc,d,display picture in own window
$picLB->bind('<Key-d>',             sub {
  my @sellist = getSelection($picLB);
  return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));
  show_multiple_pics(\@sellist, 0);
} );
$dirtree->bind('<Key-d>',             sub {
                 my $dir = getRightDir();
                 my @list = getPics($dir, WITH_PATH, NO_CHECK_JPEG);
                 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, NO_CHECK_JPEG);
                 sortPics($config{SortBy}, $config{SortReverse}, \@list);
                 showThumbList(\@list, $dir); });

# window resize event
#~ $top->bind("<Expose>" => sub { print "top:Expose\n"; });
#~ $top->bind("<Configure>" => sub {
  #~ print "top:Configure\n";
  # only if dock is selected
  #return unless ($config{KeywordDialogDock});
  # and the keyword dialog is open
  #return unless (Exists($keyw));
  #dock_keyword_dialog();
#});
# just a test for autosave (2012-01):
#$top->bind("<FocusIn>" => sub { print "top:FocusIn\n"; });
#$top->bind("<FocusOut>" => sub { print "top:FocusOut\n"; });

# support drag and drop from extern
# this enables dropping pictures and folders on the mapivi window
# 2009-10-22: Drag and drops from extern to Mapivi works under Windows XP but crashes under Ubuntu
# so it is now diabled for non-windows systems
if ($EvilOS) {
  $dirtree->DropSite
    (#-entercommand => sub { print "DragAndDrop - Entercommand\n";},
     -dropcommand => [\&dragAndDropExtern, $dirtree],
     -droptypes => 'Win32'
    );
  $picLB->DropSite
    (-dropcommand => [\&dragAndDropExtern, $picLB],
     -droptypes => 'Win32'
    );
  $c->DropSite
    (-dropcommand => [\&dragAndDropExtern, $c],
     -droptypes => 'Win32'
    );
}
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;
#}

##############################################################
# fill the conf hash with default values
##############################################################
sub configuration_set_default {

  # this defines the order of the tabs in the configuration_edit dialog:
  @conf_tab_order = qw(Main Metadata Thumbnails Tools Files Colors Extra);
  # if an option should not been shown in the edit dialog use 'tab' => 'no'

  # HINT!!!!!!
  # when you change something here it may be overwritten with the content of the user setting
  # so you may need to delete $conf_file ($user_data_path/mapivi_conf) first!
  # or press the reset all options button in the options window
  %conf = (
  
  # Main tab #########
  'folder_preview'
  => { 'value' => 1,
       'kind' => 'bool',
	'long' => lang('Folder preview'),
	'tab' => 'Main',
       'frame' => lang('Navigation'),
	'info' => lang('Shows an animated folder preview using a thumbnail slideshow'),
	'ord' => 2},

  'show_canvas_thumbs'
  => { 'value' => 1,
       'kind' => 'bool',
	'long' => lang('Show thumbnails in picture frame'),
	'tab' => 'Main',
       'frame' => lang('Navigation'),
	'info' => lang('Shows thumbnails in picture frame in square layout'),
	'ord' => 4},

  'filter_pics_button'
  => { 'value' => 0,
       'kind' => 'bool',
	     'long' => 'Filter Pictures Button',
	     'tab' => 'Main',
       'frame' => 'Navigation',
	     'info' => lang('Show filter by keywords button in thumbnail frame (needs restart).'),
	     'ord' => 6},

  'show_clock'
  => { 'value' => 1,
       'kind' => 'bool',
	     'long' => lang('Display a clock in the status bar'),
	     'tab' => 'Main',
       'frame' => 'Display',
	     'ord' => 7},

  'show_coordinates'
  => { 'value' => 0,
       'kind' => 'bool',
	     'long' => "Display the coordinates of the mouse cursor in the status bar",
	     'tab' => 'Main',
       'frame' => 'Display',
	     'ord' => 8},

  'check_version_online'
  => { 'value' => 1,
       'kind' => 'bool',
	     'long' => lang('Check for Mapivi updates'),
	     'tab' => 'Main',
       'frame' => 'Behavior',
	     'info' => lang("Check at startup if a new Mapivi version is available.\nNeeds a internet connection."),
	     'ord' => 10},

  'show_statistic'
  => { 'value' => 0,
       'kind' => 'bool',
	     'long' => lang('Show database statistic on exit'),
	     'tab' => 'Main',
       'frame' => 'Behavior',
	     'info' => lang("Show a statistic about the search database when Mapivi is closed."),
	     'ord' => 15},

  # Metadata tab #########
  'xmp_rating'
  => { 'value' => 1,
       'kind' => 'bool',
       'long' => 'Store rating in XMP',
       'tab' => 'Metadata',
       'info' => lang("Store picture rating not only in IPTC urgency, but also in XMP rating tag")."\n".convert_iptc_to_xmp_text(),
       'ord' => 2},

  'exif_plus'
  => { 'value' => 1,
       'kind' => 'bool',
       'long' => 'Display additional EXIF data',
       'tab' => 'Metadata',
       'info' => lang("Display detailed EXIF data like contrast, artist, white balance, focus distance, picture number, lens, ..."),
       'ord' => 4},

  'add_tool_info'
  => { 'value' => 0,
       'kind' => 'bool',
       'long' => 'Add tool information to processed pictures as JPEG comment',
       'tab' => 'Metadata',
       'info' => langf("If this is enabled Mapivi will add a JPEG comment\nto pictures which are created or processed by Mapivi.\nExample comment: \"Picture lossless cropped by Mapivi $version\""),
       'ord' => 6},

  # Thumbnails tab #########
 
  # Tools tab #########
  'external_pic_viewer'
  => { 'value' => 'display',
       'kind' => 'file',
	     'long' => 'Picture viewer',
	     'tab' => 'Tools',
       'frame' => 'Picture viewer',
	     'info' => lang("Enter the command to start the external picture viewer here.\nYou may also add options.\nExamles: \"gqview -f\", \"gthumb --fullscreen\", \"C:\\Program Files\\IrfanView\\iview_32.exe\""),
	     'ord' => 2},

  'external_pic_viewer_multi'
  => { 'value' => 0,
       'kind' => 'bool',
	     'long' => 'Viewer can handle multiple files',
	     'tab' => 'Tools',
       'frame' => 'Picture viewer',
	     'info' => 'If the external picture 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".',
	     'ord' => 3},
       
  'external_pic_editor'
  => { 'value' => 'gimp-remote',
       'kind' => 'file',
	     'long' => 'Picture editor',
	     'tab' => 'Tools',
	     'info' => lang("Enter the command to start the external picture editor here.\nYou may also add options.\nExamples: \"gimp-remote\" for UNIX\n, \"gimp-win-remote gimp-2.6.exe\" for Windows and GIMP > 2.0\n, \"gimp-win-remote\" for Windows and GIMP <= 2.0"),
	     'ord' => 4},

  'external_raw_editor'
  => { 'value' => 'darktable',
       'kind' => 'file',
	     'long' => 'RAW editor',
	     'tab' => 'Tools',
	     'info' => lang("Enter the command to start the external RAW picture editor here.\nYou may also add options.\nExamples: \"darktable\" for UNIX.\nLeave field empty if the picture editor should be used for all kind of pictures."),
	     'ord' => 6},

  'external_mail_tool'
  => { 'value' => 'thunderbird',
       'kind' => 'file',
	     'long' => 'Mail tool',
	     'tab' => 'Tools',
	     'info' => lang("Enter the command to start the external mail tool here.\nExamles: \"thunderbird\", \"mozilla-thunderbird\", \"evolution\", \"icedove\", or\n\"C:\\Program Files\\Microsoft Office\\OFFICE11\\OUTLOOK.EXE\""),
	     'ord' => 7},
       
  'web_browser'
  => { 'value' => 'firefox',
       'kind' => 'file',
	     'long' => 'External web browser',
	     'tab' => 'Tools',
	     'info' => lang("Enter the command to start the external web browser here.\nExamples: \"firefox\""),
	     'ord' => 8},

  'video_player'
  => { 'value' => 'vlc',
       'kind' => 'file',
	     'long' => 'Video player',
	     'tab' => 'Tools',
	     'info' => lang("Enter the command to start an external video player.\nExamples: \"vlc\""),
	     'ord' => 10},

  # Files tab #########
  'media_folder_path'
  => { 'value' => '/media',
       'kind' => 'dir',
	     'long' => 'Path to base folder for removable devices',
	     'tab' => 'Files',
	     'info' => lang("Enter the path to the folder used by the OS to mount removable devices,\nlike USB sticks or external HDD etc.\nFor Ubuntu use \"/media\"."),
	     'ord' => 2},

  # Colors tab #########
  'color_fg'
  => { 'value' => 'gray85',
       'kind' => 'color',
	     'long' => 'Font color',
	     'tab' => 'Colors',
	     'ord' => 1},
  'color_bg'
  => { 'value' => 'gray30',
       'kind' => 'color',
	     'long' => 'Background color',
	     'tab' => 'Colors',
	     'ord' => 2},
  'color_bg2'
  => { 'value' => 'gray30',
       'kind' => 'color',
	     'long' => 'Background color 2',
	     'tab' => 'Colors',
	     'ord' => 3},
  'color_bg_canvas'
  => { 'value' => 'gray30',
       'kind' => 'color',
	     'long' => 'Canvas background color',
	     'tab' => 'Colors',
	     'ord' => 4},
  'color_menu_bg'
  => { 'value' => 'gray40',
       'kind' => 'color',
	     'long' => 'Menu background color',
	     'tab' => 'Colors',
	     'ord' => 10},
  'color_hl_bg'
  => { 'value' => 'gray60',
       'kind' => 'color',
	     'long' => 'Highlight background color',
	     'tab' => 'Colors',
	     'ord' => 15},
  'color_act_bg'
  => { 'value' => 'gray60',
       'kind' => 'color',
	     'long' => 'Active background color',
	     'tab' => 'Colors',
	     'ord' => 15},
  'color_menu_fg'
  => { 'value' => 'gray90',
       'kind' => 'color',
	     'long' => 'Menu font color',
	     'tab' => 'Colors',
	     'ord' => 20},
  'color_entry'
  => { 'value' => 'gray60',
       'kind' => 'color',
	     'long' => 'Entry color',
	     'tab' => 'Colors',
	     'ord' => 30},

  # Extra tab #########
  'origs_folder_name'
  => { 'value' => 'originals',
       'kind' => 'string',
	     'long' => 'Folder name for originals',
	     'tab' => 'Extra',
	     'info' => lang("Name of sub folder to store original pictures"),
	     'ord' => 8},

  # no tab - options not shown in the configuration editor #########
  'filter_pics'
  => { 'value' => 0,
       'kind' => 'bool',
	     'long' => 'Filter Pictures',
	     'tab' => 'no',
	     'info' => lang("If enabled this function will filter the pictures using a keyword list.")},


  'filter_pics_keywords'
  => { 'value' => "Person.Family Bird Flower",
       'kind' => 'string',
	     'tab' => 'no',
	     'info' => lang("filter pics by exclude keyword list (space separated string)"),
	     },

  'import_source'
  => { 'value' => "/mnt/usb/DCIM/DIMG",
       'kind' => 'dir',
	     'long' => lang('Import source'),
	     'tab' => 'no',
	     'info' => lang("Path to picture import folder")},

  'iptc_geometry'
  => { 'value' => '800x600+1+1',
       'kind' => 'string',
       'long' => 'IPTC dialog window geometry',
       'tab' => 'no'},

  'search_rating_on'
  => { 'value' => 0,
       'kind' => 'bool',
	     'long' => lang('Search rating constraint on/off'),
	     'tab' => lang('no')},

  'search_rating_max'
  => { 'value' => 1,
       'kind' => 'int',
	     'long' => lang('Search rating constraint maximum (also used for navigation rating)'),
	     'tab' => 'no'},

  'search_rating_min'
  => { 'value' => 4,
       'kind' => 'int',
	     'long' => lang('Search rating constraint minimum (also used for navigation rating)'),
	     'tab' => 'no'},

  'nav_rating_on'
  => { 'value' => 0,
       'kind' => 'bool',
	     'long' => lang('Navigation rating constraint on/off'),
	     'tab' => 'no'},

  'search_format_on'
  => { 'value' => 0,
       'kind' => 'bool',
	     'long' => lang('Search for pictures with a certain aspect ratio on/off'),
	     'tab' => 'no'},

  'search_format'
  => { 'value' => 'landscape',
       'kind' => 'string',
	     'long' => lang('Search for pictures with a certain aspect ratio'),
	     'tab' => 'no'},

  'search_format_pano'
  => { 'value' => 0,
       'kind' => 'bool',
	     'long' => lang('Search for pictures with a certain aspect ratio of 2 >= 1 (panorama format)'),
	     'tab' => 'no'},

  'logo_text'
  => { 'value' => 'Mapivi',
       'kind' => 'string',
	     'tab' => 'no'},

  'logo_font'
  => { 'value' => 'Times_New-Roman',
       'kind' => 'string',
	     'tab' => 'no'},
       
  'logo_font_size'
  => { 'value' => 72,
       'kind' => 'int',
	     'tab' => 'no'},

  'logo_font_color'
  => { 'value' => 'black',
       'kind' => 'string',
	     'tab' => 'no'},

  'logo_shadow'
  => { 'value' => 1,
       'kind' => 'bool',
	     'tab' => 'no'},

  'logo_shadow_color'
  => { 'value' => 'gray50',
       'kind' => 'string',
	     'tab' => 'no'},

  'slideshow_random'
  => { 'value' => 1,
       'kind' => 'bool',
	     'tab' => 'no'},
       
  'slideshow_number_limit'
  => { 'value' => 0,
       'kind' => 'bool',
	     'tab' => 'no'},
       
  'slideshow_number'
  => { 'value' => 2,
       'kind' => 'int',
	     'tab' => 'no'},

       'slideshow_keywords_exclude'
  => { 'value' => 'dog cat landscape',
       'kind' => 'string',
	     'tab' => 'no'},

  'slideshow_keywords_include'
  => { 'value' => 'portrait',
       'kind' => 'string',
	     'tab' => 'no'},

  'slideshow_folders_exclude'
  => { 'value' => 'originals backup',
       'kind' => 'string',
	     'tab' => 'no'},
       
  'slideshow_pop_exclude'
  => { 'value' => 1,
       'kind' => 'bool',
	     'tab' => 'no'},

  'slideshow_pop_level'
  => { 'value' => 10,
       'kind' => 'int',
	     'tab' => 'no'},
       
  'slideshow_norating_exclude'
  => { 'value' => 0,
       'kind' => 'bool',
	     'tab' => 'no'},

  'slideshow_rating_exclude'
  => { 'value' => 1,
       'kind' => 'bool',
	     'tab' => 'no'},

  'slideshow_rating_level'
  => { 'value' => 4,
       'kind' => 'int',
	     'tab' => 'no'},

  'zoom_fit_fill'
  => { 'value' => FIT,
       'kind' => 'int',
	     'tab' => 'no'},
       
  'show_micro_meta'
  => { 'value' => 1,
       'kind' => 'bool',
	     'tab' => 'no'},

  'font_size_big'
  => { 'value' => 24,
       'kind' => 'int',
	     'tab' => 'no'},

  'animation' # move picture on canvas in show_multiple_pics()
  => { 'value' => 1,
       'kind' => 'bool',
	     'tab' => 'no'},

  'animation_steps'
  => { 'value' => 20,
       'kind' => 'int',
	     'tab' => 'no'},

  'animation_duration'
  => { 'value' => 0.25,
       'kind' => 'float',
	     'tab' => 'no'},
       
  'import_rotate_deg'   # rotate pics when importing by this value
  => { 'value' => 'auto',
       'kind' => 'string',
	     'tab' => 'no'},
       
  'import_iptc_headline'   # add IPTC headline when importing pics
  => { 'value' => 0,
       'kind' => 'bool',
	     'tab' => 'no'},
       
  'import_iptc_headline_content' # IPTC headline string
  => { 'value' => 'Event Headline',
       'kind' => 'string',
	     'tab' => 'no'},

  'clock_or_memory'   # show 0=clock or 1=memory usage in top bar
  => { 'value' => 0,
       'kind' => 'bool',
	     'tab' => 'no'},
       
);

  # some platform specific default settings
  # for windows
  if ($EvilOS) {
    $conf{external_pic_viewer}{value} = 'C:\Program Files\IrfanView\iview_32.exe';
    $conf{external_pic_editor}{value} = 'gimp-win-remote gimp-2.6.exe';
    $conf{web_browser}{tab} = 'no'; # not needed because we use "start"
  }
  # for Mac OS X
  if ($MacOSX) {
    $conf{external_pic_viewer}{value} = 'macosx-preview';
    $conf{external_pic_viewer_multi}{value} = 1;
  }
}

##############################################################
# search and return a list of existing languages (e.g. ('de', 'en', 'fr'))
# in the given directory
##############################################################
sub languages_find {
  my $path = shift;
  my @languages;
  foreach my $file (getFiles($path)) {
    # check if the filename matches mapivi-lang-XX (XX is in ISO 639-1 format, see e.g. http://en.wikipedia.org/wiki/Iso_639-1  or  http://de.wiktionary.org/wiki/Hilfe:Sprachcodes) 
    if ($file =~ m|^mapivi-lang-(.+)$|) {
      # store the language
      push @languages, $1;
    }
  }
  return @languages;
}

##############################################################
# the language files can be edited with any text editor and
# define the hash %messages. In this hash the keys are the
# English strings as written in the mapivi.pl code to be translated
# and the values are the translated strings 
##############################################################
sub language_load {
  my $fh;
  my $language = shift;
  # special treatment for en = english
  if ($language eq 'en') {
    # as Mapivi is written in english we need no language file and reset the messages hash
    undef %messages;
    return;
  }
  my $file = "$lang_path/mapivi-lang-$language";
  #use utf8;
  if (!open($fh, '<', $file)) {
    warn langf("Open language file: Couldn't open $file: $!");
    return;
  }
  my @lines = <$fh>;
  close($file);
  # execute language file to define %messages hash
  # executing code is always dangerous, but we trust it here.
  # "no critic" disables perlcritic for this line
  eval "@lines"; ## no critic (ProhibitStringyEval);
  warn langf("Failed to evaluate language file $file:\n$@\n") if ($@);
  return;
}

##############################################################
# check at startup if a new Mapivi version is available
# this is done by trying to open a text file on the mapivi web page and comparing the version number
##############################################################
# todo: this could maybe also be used to track the number of users/session???
sub check_version {
  return if (not $conf{check_version_online}{value});
  my $version = shift;
  use LWP::Simple;
  my $actual_version = get('http://mapivi.sourceforge.net/actual_version.txt');
  if (defined $actual_version) {
    if ($actual_version+0 > $version+0) { # force numeric context (+0)
      print langf("    A newer version of Mapivi is available (V%s), see http://mapivi.sourceforge.net/\n", $actual_version);
    }
    elsif ($actual_version+0 == $version+0) { # force numeric context (+0)
      print langf("    Mapivi %s is up-to-date!\n", $version);
    }
  }
  else {
    print lang("    Could not check actual Mapivi version. No internet connection.\n");
  }
}

##############################################################
# Scan Mapivi code for lang() and langf() calls
##############################################################
sub language_scan {

  my $file;
  # open the file mapivi
  if (!open($file, '<', $0)) {
    warn langf("Could not open $0 for read access!: $!");
    return;
  }
  my @lines = <$file>;  # read the complete file into the array lines
  close $file;

  # make a copy of the existing messages to find out unused (outdated) messages
  my %tmp_messages = %{ dclone(\%messages) };
  
  my $found = "%messages = (\n";
  my $not_found = "%messages = (\n";
  #my @messages;
  my $line_nr = 0;
  foreach my $line (@lines) {
    $line_nr++;
    $line =~ s/\s+$//;   # cut trailing whitespace
    $line =~ s/^\s+//;   # cut leading whitespace
    # look for lines containing "lang()"  .*? -> the question mark switches to ungreedy matching
    if ($line =~ m/.*lang\(["'](.*?)["']\).*/) {
      #push @messages, $line;
      print langf("Found: $line\n   $1\n");
      if (exists $messages{$1}) {
        print langf("   Found in hash: $messages{$1}\n");
        $found .= "\"$1\" => \"$messages{$1}\",\t\t\t# line $line_nr\n";
        # delete each key in the temp hash when it is used at least once
        delete $tmp_messages{$1} if (exists $tmp_messages{$1});
      }
      else {
        print lang("   Not found in hash\n");
        $not_found .= "\"$1\" => \"\",\t\t\t# line $line_nr\n";
      }
    }
  }

  my $unused = "%messages = (\n";
  foreach (keys %tmp_messages) {
    $unused .= "\"$_\" => \"$tmp_messages{$_}\",\n";
  }
  showText(langf("Existing and used tranlations in language: $config{Language}"), $found, NO_WAIT);
  showText(langf("Missing translations for language: $config{Language}"), $not_found, NO_WAIT);
  showText(langf("Existing but unused translations in language: $config{Language}"), $unused, NO_WAIT);
  return;
}

##############################################################
# Return a language dependent version of $msg.
# based on M()  from Msg.pm from Slaven Rezic (BBBike)
##############################################################
sub lang {
  my $msg = shift;
  $msg = $messages{$msg} if (exists $messages{$msg});
  return $msg;
}

##############################################################
# Return a language dependent version of $msg.
# based on Mfmt() from  Msg.pm from Slaven Rezic (BBBike)
##############################################################
sub langf {
  return sprintf lang(shift), @_;
}

##############################################################
##############################################################
sub log_it {
  my $text = shift;
  # do not store picture coordinates
  if ($text !~ m/^coordinates: .*/) {
    my $time_stamp = getDateTimeISOString(time());
    # save to global log
    $global_log .= "\n$time_stamp: $text";
    # show in log window if it is opened
    if (Exists($top->{log_box})) {
      $top->{log_box}->insert('end', "\n$time_stamp: $text"); # insert new text at end after timestamp
      $top->{log_box}->see('end');
    }
  }
  if (Exists($userInfoL)) {
    $userinfo = $text;
  }
  else { # fallback solution during startup, the userInfoL label may not be available
    print "log_it: $text\n";
  }
  return;
}

##############################################################
# find the users home directory
##############################################################
sub get_home_path {
  my $home = glob("~");
  if ($EvilOS) {
    $home = $ENV{"USERPROFILE"};
    $home = $ENV{HOME} if ((not -d $home) and (defined $ENV{HOME}));
    $home = $ENV{HOMEDRIVE}.$ENV{HOMEPATH} if ((not -d $home) and (defined $ENV{HOMEDRIVE} and defined $ENV{HOMEPATH}));
    $home = "C:/" if (!-d $home);
    $home =~ s!\\!\/!g;     # replace Windows path delimiter with UNIX style \ -> /
  }
  return $home;
}

##############################################################
# determine the path to store the user data
##############################################################
sub get_user_data_path {
  my $home = shift;
  my $user_data_path = "$home/.mapivi";
  if ($EvilOS and defined $ENV{APPDATA}) {
    # for windows we use this path
    $user_data_path = $ENV{APPDATA}."/Mapivi";
  }

  # if the environment variable MAPIVIUSERDATAPATH is set to an existing folder
  # Mapivi will use this folder to store all configuration files
  # This feature may e.g. be used to separate private and business pictures or to keep different keyword trees
  # usage in Linux with bash shell:
  # set the env variable:   export MAPIVIUSERDATAPATH=/home/username/.mapivi-private
  # to check the variable: echo $MAPIVIUSERDATAPATH
  # usage in Windows with DOS box:
  # set the env variable:   set MAPIVIUSERDATAPATH=C:\temp\mapivi-office
  # to check the variable: echo %MAPIVIUSERDATAPATH%
  if (defined $ENV{MAPIVIUSERDATAPATH} and $ENV{MAPIVIUSERDATAPATH} ne '') {
    if (-d $ENV{MAPIVIUSERDATAPATH}) {
      $user_data_path = $ENV{MAPIVIUSERDATAPATH};
      print langf("  Mapivi info: Using folder:\n  \"$user_data_path\"\n  as set in environment variable MAPIVIUSERDATAPATH.\n");
    }
    else {
      print langf("  Mapivi info: Environment variable MAPIVIUSERDATAPATH is set to\n  \"$ENV{MAPIVIUSERDATAPATH}\".\n  This folder does not exist, please create it before starting Mapivi.\n  Mapivi will now use the default folder:\n  \"$user_data_path\".\n");
    }
  }
  $user_data_path =~ s!\\!\/!g;     # replace Windows path delimiter with UNIX style \ -> /
  return $user_data_path;
}

##############################################################
# stillBusy - block some keys, untill loading of pictures is finished
##############################################################
sub stillBusy {
  if ($showPicInAction) {
    beep();
    log_it(lang('Busy (loading pic), please retry later'));
    return 1;
  }
  return 0;
}

##############################################################
# show short information in borderless window
# window will close itself after given time
##############################################################
sub info_window {
  my $w = shift; # parent widget ref
  my $text = shift; # text to display in window
  my $timeout = shift; # optional, time in ms
  return if not $w;
  eval { $w->ismapped }; # check if widget is available w/o causing error message
  return if ($@);
  return if ((not defined $text) or ($text eq ''));
  $timeout = 1000 if (not $timeout); # default timeout is 1 second
  # open info window
  my $win = $w->Toplevel(-bg => 'gray');
  $win->Label(-text => $text, -fg => 'black', -bg => 'white', -bd => 2)->pack(-side => 'top', -padx => 2, -pady => 2);
  # no window decoration/border
  $win->overrideredirect(1);
  # center window above widget
  $win->Popup(-popover => $w, -overanchor => 'c', -popanchor => 'c');
  # close window after $timeout msec 
  my $timer;
  $timer = $w->after($timeout, sub {
                                 $win->destroy() if Exists($win);
                                 $timer->cancel if ($timer);
                               });
  return;
}

##############################################################
##############################################################
sub folder_preview_start {
  return if (not $conf{folder_preview}{value});
  my $top = shift; # parent widget ref
  my $folder = shift; # folder with pictures to preview
  return unless -d $folder;
  my @pics = getPics($folder, WITH_PATH, NO_CHECK_JPEG);
  filter_pics(\@pics, $conf{filter_pics_keywords}{value});
  return unless (@pics);
  # show best rated pictures first
  sortPics('urgency', 0, \@pics);
  # open preview window
  my $win = $top->Toplevel();
  $win->Label(-text => scalar @pics." ".lang('Pictures'))->pack(-side => 'top', -padx => 0, -pady => 0);
  $win->{CANVAS} = $win->Canvas(-width  => $config{ThumbSize},
                            -height => $config{ThumbSize})->pack(-side => 'top', -padx => 0, -pady => 0);
  # no window decoration/border
  $win->overrideredirect(1);
  # store window reference in top for cancel function
  $top->{FOLDER_PREVIEW_WIN} = $win;
  $win->{FOLDER_PREVIEW_PICS} = \@pics;
  $win->{PIC_INDEX} = 0; # start with index 0 in list
  $win->Popup(-popover => 'cursor');
  # move window 100 pixels to the right
  my $geo = $win->geometry;
  my ($w, $h, $x, $y) = splitGeometry($geo);
  $x += 100;
  $win->geometry($w . 'x' . $h . "+" . $x . "+" . $y);
  # preview first picture/thumbnail
  folder_preview_next($win);
  my $update_period = 500; #[msec]
  # after $update_period msec show next thumbnail ..
  $top->{FOLDER_PREVIEW_TIMER} = $top->repeat($update_period, sub {
                                   folder_preview_next($win);
                               });
  return;
}

##############################################################
##############################################################
sub folder_preview_next {
  my $win = shift;
  my @pics = @{$win->{FOLDER_PREVIEW_PICS}};
  my $index = $win->{PIC_INDEX};
  my $dpic = $pics[$index];
  if (-f $dpic) {
    my $thumb = getThumbFileName($dpic);
    if (-f $thumb) {
      my $photo = $top->Photo(-file => $thumb, -gamma => $config{Gamma});
      $win->{CANVAS}->createImage(0,0, -image => $photo, -anchor => 'nw');
    }
  }
  $index++;
  # repeat when finished with all pictures
  $index = 0 if ($index >= @pics);
  $win->{PIC_INDEX} = $index;
  return;
}

##############################################################
##############################################################
sub folder_preview_cancel {
  # todo: delete photo object after usage!!!
  # but this doesn't work - gives an "error: image image457 doesn't exists ,..."
  #if (defined $folder_preview_photo) { $folder_preview_photo->delete; print "cancel:: folder_preview_photo defined \n";}
  $top->{FOLDER_PREVIEW_WIN}->destroy() if Exists($top->{FOLDER_PREVIEW_WIN});
  $top->{FOLDER_PREVIEW_TIMER}->cancel if ($top->{FOLDER_PREVIEW_TIMER});
  return;
}

##############################################################
##############################################################
sub add_nav_frame {

  my $w = shift;
  # rating constraint frame 
  # Warning: must be defined in front of the NoteBook, else it won't be visible!!!!
  my $r_frame = $w->Frame(-bd => 0)->pack(-expand => 1, -side => 'bottom', -fill =>'x', -padx => 0, -pady => 0);
  $w->{rating_frame} = add_rating_constraint($r_frame);

  # navigation frame
  my $nav_tab =
      $w->NoteBook(-width => 40,
                   -background => $conf{color_bg}{value}, # background of active page (including its tab)
                   -inactivebackground => $conf{color_entry}{value}, # tabs of inactive pages
                   -backpagecolor => $conf{color_bg}{value}, # background behind notebook
                   -tabpadx => 0, -tabpady => 0
                   )->pack(-expand => 1, -fill => 'both', -padx => 3, -pady => 3);
  $w->{nav_tab} = $nav_tab;

  ####################
  # folder navigation
  $w->{dir_frame} = $nav_tab->add('dir', -image => $mapivi_icons{'Folder'}, -raisecmd => sub {
    $w->{rating_frame}->packForget if ($w->{rating_frame}->ismapped);
    $r_frame->configure(-height => 0);
    log_it(lang("Navigation by folders"));});
  $dirtree = add_dir_tree($w->{dir_frame});
  focus_on_enter($dirtree);
  
  # folder preview with thumbnail animation - attached to the dirtree
  $balloon->attach($dirtree, -balloonposition => 'mouse',
  -motioncommand => sub {folder_preview_cancel(); return 0;}, 
  -cancelcommand => sub {folder_preview_cancel(); return 0;},
  -postcommand => sub {my $folder = getNearestItem($dirtree); folder_preview_start($top, $folder); return 0;}, -msg => "Nav dirtree balloon");
  
  ####################
  # keyword tree navigation + add + edit
  $w->{key_frame} = $nav_tab->add('key', -image => $mapivi_icons{'Keyword'}, -raisecmd => sub {
    $w->{rating_frame}->pack(-in => $r_frame, -fill =>'x', -padx => 3, -pady => 1) if (!$w->{rating_frame}->ismapped);
    log_it(lang('Navigation by keyword'));});
  add_key_tree($w->{key_frame}, $picLB);

  ####################
  # keyword cloud navigation
  $w->{cloud_frame} = $nav_tab->add('cloud', -image => $mapivi_icons{'Keyword-Cloud'}, -raisecmd => sub {
    $w->{rating_frame}->pack(-in => $r_frame, -fill =>'x', -padx => 3, -pady => 1) if (!$w->{rating_frame}->ismapped);
    log_it(lang('Navigation by keyword cloud'));
    add_key_cloud($w->{cloud_frame}, $picLB) unless (Exists($w->{cloud_frame}->{canvas}));});

  ####################
  # picture searching
  $w->{search_frame} = $nav_tab->add('search', -image => $mapivi_icons{'Search'}, -raisecmd => sub {
    $w->{rating_frame}->pack(-in => $r_frame, -fill =>'x', -padx => 3, -pady => 1) if (!$w->{rating_frame}->ismapped);
    log_it(lang('Picture search'));
    my $keys = keys %searchDB;
    $w->{search_frame}->{labelw}->configure(-text => langf("%d pictures in database", $keys));});
  add_search_frame($w->{search_frame});
  
  ####################
  # location navigation + add
  $w->{loc_frame} = $nav_tab->add('loc', -image => $mapivi_icons{'Location'},
               -raisecmd => sub {
    $w->{rating_frame}->pack(-in => $r_frame, -fill =>'x', -padx => 3, -pady => 1) if (!$w->{rating_frame}->ismapped);
    log_it(lang('Navigation by location'));
    if (!$w->{loc_frame}->{tree}->info('children')){
      # get all location info from the database (IPTC tags: country, state, city and sublocation) including pictures
      my %loc_hash = get_locations(UPDATE);
      insert_in_tree(LOCATION, $w->{loc_frame}->{tree}, \%loc_hash);
    }
  });
  add_location_tree($w->{loc_frame}, $picLB);

  ####################
  # date navigation
  $w->{date_frame} = $nav_tab->add('date', -image => $mapivi_icons{'Date'},
               -raisecmd => sub {
    $w->{rating_frame}->pack(-in => $r_frame, -fill =>'x', -padx => 3, -pady => 1) if (!$w->{rating_frame}->ismapped);
    log_it(lang('Navigation by date'));
    if (!$w->{date_frame}->{tree}->info('children')){
      # get all dates from the database, if not already done
      my %date_hash = get_dates(UPDATE);
      insert_in_tree(DATE, $w->{date_frame}->{tree}, \%date_hash);
    }
  });
  add_date_tree($w->{date_frame}, $picLB);

  ####################
  # picture collections / slideshow navigation
  $w->{collection_frame} = $nav_tab->add('collection', -image => $mapivi_icons{'Image'},
               -raisecmd => sub {
    $w->{rating_frame}->packForget if ($w->{rating_frame}->ismapped);
    log_it(lang('Navigation by picture collection'));
    if (!$w->{collection_frame}->{tree}->info('children')){
      insert_collections_in_tree($w->{collection_frame}->{tree}, \%slideshows);
    }
  });
  add_collection_tree($w->{collection_frame}, $picLB);

  # Set the initial folder
  exists &Tk::DirTree::chdir ? $dirtree->chdir($actdir) : $dirtree->set_dir($actdir);
  $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 space key
  $dtr->bind('<Key-space>', sub { Tk->break; });
}

##############################################################
# define some icons 
##############################################################
sub define_icons {
  # mapping of icon names to file names
  my %files = (
    'Folder' => 'folder-big.png',
    'Keyword' => 'dialog-password-big.png',  #'preferences-desktop-font-big.png',
    'Location' => 'internet-web-browser-big.png',
    'Keyword-Cloud' => 'weather-overcast-big.png',
    'Date' => 'office-calendar-big.png',
    'Search' => 'system-search-big.png',
    'Update' => 'view-refresh-big.png',
    'UpdateS' => 'view-refresh.png',
    'Back' => 'go-previous.png',
    'GoPrevious' => 'go-previous-big.png',
    'GoFirst' => 'go-first-big.png',
    'GoLast' => 'go-last-big.png',
    'GoUp' => 'go-up-big.png',
    'GoTop' => 'go-top-big.png',
    'GoBottom' => 'go-bottom-big.png',
    'MediaStop' => 'media-playback-stop-big.png',
    'Clear' => 'edit-clear.png',
    'Show' => 'edit-redo.png',
    'Rating1' => 'rating-1.png',
    'Rating2' => 'rating-2.png',
    'Rating3' => 'rating-3.png',
    'Rating4' => 'rating-4.png',
    'Rating5' => 'rating-5.png',
    'Rating6' => 'rating-6.png',
    'Rating7' => 'rating-7.png',
    'Rating8' => 'rating-8.png',
    'Rating0' => 'rating-0.png',
    'Stop' => 'process-stop.png',
    'Help' => 'help-browser22.png',
    'Plus' => 'list-add.png',
    'PlusBig' => 'list-add-big.png',
    'Minus' => 'list-remove.png',
    'Frame-bw' => 'frame-bw.png',
    'Frame-wb' => 'frame-wb.png',
    'Frame-bwp' => 'frame-bwp.png',
    'Frame-wbp' => 'frame-wbp.png',
    'EmptyThumb' => 'EmptyThumb.jpg',
    'Preferences' => 'preferences-system.png',
    'FlagRed' => 'media-record16-red.png',
    'FlagGreen' => 'media-record16-green.png',
    'FlagBlue' => 'media-record16-blue.png',
    'Image' => 'image-x-generic22.png',
    'Editor' => 'accessories-text-editor22.png',
    'Trash' => 'user-trash22.png',
    'Save' => 'media-floppy-big.png',
    #'Fullscreen' => 'view-fullscreen-big.png',
    #'Slideshow' => 'x-office-presentation-big.png',
  );
  my %icons;
  my $error = '';
  foreach my $name (keys %files) {
    my $icon_file = "$icon_path/$files{$name}";
    if (-f $icon_file) {
      $icons{$name} = $top->Photo(-file => $icon_file);
    }
    else {
      $error .= langf("File %s used as %s icon is missing.\n", $icon_file, $name);
    }
  }
  if ($error ne '') {
    print langf("Errors during Mapivi startup:\n%s\n\nPlease copy the needed icons to %s and restart Mapivi.\n", $error, $icon_path);
    die;
  }
  return %icons;
}

##############################################################
# makeThumbListbox - create a scrolled HList for thumbnail display
##############################################################
sub makeThumbListbox {
  my $widget = shift;
  my $lb = $widget->Scrolled('HList',
                             -header     => 1,
                             -separator  => ';', # todo here we hope that ; will never be in a folder or file name
                             -pady       => 0,
                             -columns    => 6,
                             -scrollbars => 'osoe',
                             -selectmode => 'extended',
                             -background => $conf{color_bg}{value},
                             -width      => 30,
                             -height     => 200,
                            )->pack(-expand => 1, -fill => 'both');
  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 => $conf{color_entry}{value});
    my $sizeH = $lb->ResizeButton(-text => lang('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 => $conf{color_entry}{value});
    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 => $conf{color_entry}{value});
    my $comH = $lb->ResizeButton(-text => lang('Comments'),
                                 -relief => 'flat', -pady => 0,-anchor => 'w',
                                 -widget => \$lb, -column => $colNr);
    $lb->{comcol} = $colNr;
    $lb->header('create', $colNr++, -itemtype => 'window', -widget => $comH, -headerbackground => $conf{color_entry}{value});
    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 => $conf{color_entry}{value});
    my $dirH = $lb->ResizeButton(-text => lang('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 => $conf{color_entry}{value});
  }
  else { # no resizeAvail
    $lb->{thumbcol} = $colNr;
    $lb->header('create', $colNr++, -text => 'Thumbnail', -headerbackground => $conf{color_entry}{value});
    #$lb->{namecol} = $colNr;
    #$lb->header('create', $colNr++, -text => 'Name',      -headerbackground => $conf{color_entry}{value});
    $lb->{filecol} = $colNr;
    $lb->header('create', $colNr++, -text => lang('File'),      -headerbackground => $conf{color_entry}{value});
    $lb->{iptccol} = $colNr;
    $lb->header('create', $colNr++, -text => 'IPTC',      -headerbackground => $conf{color_entry}{value});
    $lb->{comcol} = $colNr;
    $lb->header('create', $colNr++, -text => lang('Comments'),   -headerbackground => $conf{color_entry}{value});
    $lb->{exifcol} = $colNr;
    $lb->header('create', $colNr++, -text => 'EXIF',      -headerbackground => $conf{color_entry}{value});
    $lb->{dircol} = $colNr;
    $lb->header('create', $colNr,   -text => lang('Folder'), -headerbackground => $conf{color_entry}{value});
  }
  return $lb;
}

##############################################################
# addWindowKeyBindings - add key shortcuts to a widget
##############################################################
sub addWindowKeyBindings {
  my $bind_w = shift; # widget to bind keys to
  my $lb_w = shift; # thumbnail listbox to use
  # key-desc,b,show backup or original picture (if available)
  $bind_w->bind('<Key-b>', sub { showBackup(); });
  # key-desc,w,show window list
  $bind_w->bind('<Key-w>', sub { showWindowList(); });
  #$bind_w->bind('<Control-r>', sub { rebuildThumbs(); } );
  # key-desc,Ctrl-s,advanced search in database
  $bind_w->bind('<Control-s>', sub { searchMetaInfo(); } );
  # key-desc,Ctrl-f,find pictures (advanced search in database)
  $bind_w->bind('<Control-f>', sub { searchMetaInfo(); } );
  # key-desc,k,search by keyword (tag cloud)
  $bind_w->bind('<Key-k>', sub { keyword_browse(); } );
  # key-desc,o,open a new folder
  $bind_w->bind('<Key-o>', sub { openDir(); } );
  # key-desc,h,show hot folders
  $bind_w->bind('<Key-h>', sub { $dirMenu->Popup(-popover => "cursor", -popanchor => "nw"); } );

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

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

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

  # key-desc,F01,toggle show menu bar
  $bind_w->bind('<Key-F1>', sub { toggle(\$config{ShowMenu}); showHideFrames(); } );
  # key-desc,F02,toggle show status bar
  $bind_w->bind('<Key-F2>', sub { toggle(\$config{ShowInfoFrame}); showHideFrames(); } );
  # key-desc,F03,toggle overlay information (EXIF, IPTC, ...) 
  $bind_w->bind('<Key-F3>', sub { toggle(\$config{ShowInfoInCanvas}); showImageInfoCanvas($actpic); } );
  # key-desc,F04,toggle show comment box
  $bind_w->bind('<Key-F4>', sub { toggle(\$config{ShowIPTCFrame}); showHideFrames(); } );

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

  # key-desc,Delete,delete selected pictures to trash
  $bind_w->bind('<Key-Delete>',        sub { deletePics($lb_w, TRASH); } );
  # key-desc,Shift-Delete,remove selected pictures
  $bind_w->bind('<Shift-Delete>',      sub { deletePics($lb_w, REMOVE); } );
  # key-desc,Ctrl-q,quit mapivi
  $bind_w->bind('<Control-q>',             sub { quitMain(); } );
  # key-desc,Ctrl-r,smart rename selected pictures (e.g to EXIF date)
  $bind_w->bind('<Control-r>',             sub { renameSmart($lb_w); } );
  # key-desc,F12,quit mapivi
  $bind_w->bind('<Key-F12>',           sub { quitMain(); } );
  # show picture, EXIF, Comment and IPTC info
  # key-desc,c,display JPEG comment
  $bind_w->bind('<Key-c>',             sub { showComment(); } );
  # key-desc,Ctrl-t,display embedded EXIF thumbnail
  $bind_w->bind('<Control-t>',             sub { showEXIFThumb(); } );
  # key-desc,Ctrl-v,toggle verbose output
  $bind_w->bind('<Control-v>',             sub { toggle(\$verbose); log_it("verbose switched to $verbose");} );
  # key-desc,Ctrl-c,crop (lossless)
  $bind_w->bind('<Control-c>',             sub { crop($lb_w); } );
  # key-desc,Ctrl-b,add border and/or copyright
  $bind_w->bind('<Control-b>',             sub { losslessBorder(PIXEL); } );
  # key-desc,Ctrl-d,change EXIF date/time
  $bind_w->bind('<Control-d>',             sub { setEXIFDate(); } );
  # key-desc,Q,change size/quality
  $bind_w->bind('<Q>',             sub { changeSizeQuality(); } );
  # key-desc,Ctrl-o,open options dialog
  $bind_w->bind('<Control-o>',             sub { options_edit(); } );
  # key-desc,Ctrl-m,move pictures to originals sub folder
  $bind_w->bind('<Control-m>',             sub { copy_move_to_origs($lb_w, MOVE); } );
  # key-desc,Ctrl-e,edit picture in external edior (e.g. GIMP)
  $bind_w->bind('<Control-e>', sub { edit_pic($lb_w); } );
  # key-desc,H,display picture histogram
  $bind_w->bind('<H>',         sub { showHistogram($lb_w); });
  # key-desc,9,rotate picture(s) 90 degrees clockwise
  $bind_w->bind('<Key-9>',             sub { rotate(90);  });
  # key-desc,8,rotate picture(s) 180 degrees clockwise
  $bind_w->bind('<Key-8>',             sub { rotate(180); });
  # key-desc,7,rotate picture(s) 270 degrees clockwise
  $bind_w->bind('<Key-7>',             sub { rotate(270); });
  # key-desc,0,auto rotate picture(s) (EXIF orientation)
  $bind_w->bind('<Key-0>',             sub { rotate("auto"); });


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

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

  # key-desc,Ctrl-g,set GPS coordinates
  $bind_w->bind('<Control-g>', sub { gps_set($lb_w); } );

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

  # key-desc,-,zoom out or faster slideshow
  $bind_w->bind('<Key-minus>',  sub {
             if ($slideshow) {
               $config{SlideShowTime}-- if ($config{SlideShowTime} >= 1);
               log_it("slideshow time: ".$config{SlideShowTime}." sec");
             }
             else {
               zoomStep(-1);
             }
           } );
  # key-desc,+,zoom in or slideshow slower
  $bind_w->bind('<Key-plus>',   sub {
             if ($slideshow) {
               $config{SlideShowTime}++ if ($config{SlideShowTime} < 30);
               log_it("slideshow time: ".$config{SlideShowTime}." sec"); 
             }
             else {
               zoomStep(1);
             }
           });
  # key-desc,Ctrl-h,display picture in original size (100% zoom)
  $bind_w->bind('<Control-h>',         sub { zoom100(); });
  # key-desc,z,display picture in original size (100% zoom)
  $bind_w->bind('<Key-z>',             sub { zoom100(); });
  # key-desc,Alt-1,display picture in original size (100% zoom)
  $bind_w->bind('<Alt-Key-1>',             sub { zoom100(); });
  # key-desc,f,fit picture in canvas (auto zoom)
  $bind_w->bind('<Key-f>',             sub { $conf{zoom_fit_fill}{value} = FIT; fitPicture(); });
  # key-desc,Alt-3,fit picture in canvas (auto zoom)
  $bind_w->bind('<Alt-Key-3>',             sub { $conf{zoom_fit_fill}{value} = FIT; fitPicture(); });
  # key-desc,Alt-2,fill picture in canvas (auto zoom)
  $bind_w->bind('<Alt-Key-2>',             sub { $conf{zoom_fit_fill}{value} = FILL; fitPicture(); });
}

##############################################################
# addCommonKeyBindings - add key shortcuts to a widget
##############################################################
sub addCommonKeyBindings {
  my $bind_w = shift; # widget to bind keys to
  my $lb_w   = shift; # thumbnail listbox to use
  # key-desc,a,add JPEG comment
  $bind_w->bind('<Key-a>',             sub { addComment($lb_w); } );
  # key-desc,j,edit JPEG comment
  $bind_w->bind('<Key-j>',             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,e,display embedded EXIF data
  $bind_w->bind('<Key-e>',             sub { displayEXIFData($lb_w); } );
  # key-desc,x,display embedded XMP data
  $bind_w->bind('<Key-x>',             sub { xmp_show($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,Alt-c,copy EXIF and IPTC data
  $bind_w->bind('<Alt-c>',             sub { copyIPTC(); copyEXIFData(); } );
  # key-desc,Alt-v,paste IPTC data
  $bind_w->bind('<Alt-v>',             sub { pasteIPTC(); } );
  # 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,l,add selected thumbnails to collection (light table)
  $bind_w->bind('<Key-l>',             sub { light_table_add_from_lb($lb_w); } );
  # key-desc,Ctrl-t,Show thumbnails in picture frame
  $bind_w->bind('<Key-t>',             sub { my @pics = $picLB->info('children'); show_canvas_thumbs($c, \@pics);} );
  # these buttons fit to the rating with IPTC urgency
  # 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); } );
  # additional rating buttons 1 = 1 star to 5 = 5 stars
  # these buttons fit to the rating with stars
  # key-desc,5, set 5 star rating (IPTC urgency to 1 - high)
  $bind_w->bind('<Key-5>',        sub { setIPTCurgency($lb_w, 1); } );
  # key-desc,4, set 4 star rating (IPTC urgency to 2)
  $bind_w->bind('<Key-4>',        sub { setIPTCurgency($lb_w, 2); } );
  # key-desc,3, set 3 star rating (IPTC urgency to 3)
  $bind_w->bind('<Key-3>',        sub { setIPTCurgency($lb_w, 3); } );
  # key-desc,2, set 2 star rating (IPTC urgency to 4)
  $bind_w->bind('<Key-2>',        sub { setIPTCurgency($lb_w, 4); } );
  # key-desc,1, set 1 star rating (IPTC urgency to 5 - normal)
  $bind_w->bind('<Key-1>',        sub { setIPTCurgency($lb_w, 5); } );
  # key-desc,R, toggle red flag
  $bind_w->bind('<Key-R>',    sub { flag_toggle($lb_w, FLAG_RED); } );
  # key-desc,G, toggle green flag
  $bind_w->bind('<Key-G>',    sub { flag_toggle($lb_w, FLAG_GREEN); } );
  # key-desc,B, toggle blue flag
  $bind_w->bind('<Key-B>',    sub { flag_toggle($lb_w, FLAG_BLUE); } );
}

##############################################################
##############################################################
sub session_info {
  my $pics_nr = keys(%searchDB);
  my $start_nr = $top->{sessioninfo}{startpics};
  my $diff = $pics_nr - $start_nr;
  my $start_time = localtime($top->{sessioninfo}{starttime});
  my $duration = time() - $top->{sessioninfo}{starttime};
  #print "start of session $start_nr\nNow: $pics_nr\n";
  log_it("Session: Start: $start_time; Pics in database: $pics_nr, at start: $start_nr, diff: $diff");
}

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

  print lang("Sub startup ...\n") if $verbose;
  $picLB->focus;
  
  if ($config{NrOfRuns} == 0) {
    print lang("First run ...\n") if $verbose;
    make_mapivi_folders();
  }
  $config{NrOfRuns}++;
  gratulation() if (($config{NrOfRuns} % 1000 == 0) and ($config{NrOfRuns} > 0)); # modulo

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

  checkSystem();

  startStopClock();

  # try to get the saved database (meta info hash)
  if ($config{SaveDatabase} and -f $searchDBfile) {
    my $hashRef = retrieve($searchDBfile);
    if (defined $hashRef) {
      %searchDB = %{$hashRef};
    }
    else {
      warn langf("Could not retrieve %s","searchDB ($searchDBfile)");
    }
  }
  # store number of pictures in DB at session start
  $top->{sessioninfo}{startpics} = keys(%searchDB);

  # try to get the saved hotlist folders
  if (-f "$user_data_path/hotlist") {
    my $hashRef = retrieve("$user_data_path/hotlist");
    if (defined $hashRef) {
      %dirHotlist = %{$hashRef};
    }
    else {
      warn langf("Could not retrieve %s","hotlist");
    }
  }

  # try to get the saved folder properties
  if (-f "$user_data_path/dirProperties") {
    my $hashRef = retrieve("$user_data_path/dirProperties");
    if (defined $hashRef) {
      %dirProperties = %{$hashRef};
    }
    else {
      warn langf("Could not retrieve %s","dirProperties");
    }
  }
  # add additional folder properties (may be usefull when merging two Mapivi installations)
  if (-f "$user_data_path/dirProperties.add") {
    my $hashRef = retrieve("$user_data_path/dirProperties.add");
    if (defined $hashRef) {
      print lang("Found additional dirProperties. Merging information ...\n");
      foreach my $dir (keys %{$hashRef}) {
        foreach my $key (keys %{$hashRef->{$dir}}) {
          $dirProperties{$dir}{$key} = $hashRef->{$dir}->{$key};
        }
        #$dirProperties{$dir} = dclone($hashRef->$dir);
        print "  adding $dir\n";
      }
      print lang("Merging finished. Added ".keys(%{$hashRef})." folders.\nYou may now delete or rename $user_data_path/dirProperties.add\nto prevent merging during the next start of Mapivi\n");
    }
  }

  # try to get the saved ignore keywords
  if (-f "$user_data_path/keywords_ignore") {
    my $hashRef = retrieve("$user_data_path/keywords_ignore");
    if (defined $hashRef) {
      %ignore_keywords = %{$hashRef};
    }
    else {
      warn langf("Could not retrieve %s","keywords_ignore");
    }
  }

  # try to get the saved slideshows
  if (-f "$user_data_path/slideshows") {
    my $hashRef = retrieve("$user_data_path/slideshows");
    if (defined $hashRef) {
      %slideshows = %{$hashRef};
    }
    else {
      warn langf("Could not retrieve %s","slideshows");
    }
  }

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

  updateDirMenu();
  layout(0);
  
  # remove splash screen
  $splash->Destroy if $splash;

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

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

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

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

  $top->update();
  # display the number of pics in the database in the canvas
  log_it($top->{sessioninfo}{startpics}.' '.lang("pictures"));
  #show_text_in_canvas($c, $top->{sessioninfo}{startpics}."\n".lang("pictures"));
}

##############################################################
##############################################################
sub show_text_in_canvas {
  my $c = shift; # canvas widget ref
  my $text = shift;
  my $font = $c->Font(-family => $config{FontFamily}, -size => 50, -weight => 'bold');
  my $id = $c->createText( int($c->width/2),  int($c->height/2), -font => $font, -text => $text, 
                            -anchor => 'c', -justify => 'center', -fill => $conf{color_fg}{value}, -tags => ['TEXT']); 
  my ($x1, $y1, undef, undef) = $c->bbox($id);
  if (($x1 < 0) or ($y1 < 0)) {
    # delete text if it doesn't fit into the canas
    $c->delete('withtag', 'TEXT');
    # and log it instead, after replacing all newlines with spaces
    $text  =~ s/\n/ /g; 
    log_it($text);
  }
}

##############################################################
# testSuite - some tests for mapivi
# idea: start with the pictures which are currently shown -
# independend of navigation kind. Copy all of them to a 
# temp folder in the trash dir.
# then call separated test functions which do some tests on this
# set of pictures. Before the next test function is called the
# pictures are restored so that all functions get the same setup
# independend of the calling order by test_prepare().
##############################################################
sub testSuite {
  # set original file list - should not be changed during test suite!
  my @childs = $picLB->info('children');
  if (@childs < 2) {
    $top->messageBox(-icon => 'error', -message => lang('Test suite must be started in a folder with at least two picture!'),
                     -title => lang('Test suite'), -type => 'OK');
    return;
  }
  if (@childs > 30) {
    my $rc = $top->messageBox(-icon => 'question', -message => "Folder contains ".scalar(@childs)." files.\nIt is recommended to use between 2 and 30 files.\nMore files is Ok, but takes more time. Continue?",
                              -title => lang('Many files?'), -type => 'OKCancel');
    return unless ($rc =~ m/Ok/i);
  }
  # store first folder to open after tests are finished
  my $startdir = dirname($childs[0]);

  my $rc = $top->messageBox(-icon => 'question', -message => langf("Start some internal tests 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 => lang('Start test  suite?'), -type => 'OKCancel');
  return unless ($rc =~ m/Ok/i);

  # store and reset some configurations which may require user interaction
  # reset at end ...
  my $tmp_AskDeleteHighRatingLevel = $config{AskDeleteHighRatingLevel};
  $config{AskDeleteHighRatingLevel} = 0;
  
  # preparation
  # set up temp folders
  my $dir0 = "$trashdir/testdir0";
  my $dir1 = "$trashdir/testdir1";
  my $dir2 = "$trashdir/testdir2";
  # cleanup if folder is already there
  print "testSuite: removing temp $dir0\n";
  rmtree($dir0, 0, 1) if (-d $dir0); # dir, 0 = no message for each file, 1 = skip write protected files
  unless (makeDir($dir0, NO_ASK)) { print "testSuite: could not create $dir0\n"; }
  # check if everything worked
  unless (-d $dir0) { warn "testSuite: *** $dir0 not found! Stopping test suite!\n"; return; }
  print "testSuite: temp dir created\n";
  # test initial copy actdir -> dir0
  print "testSuite: testing copy all\n";
  selectAll($picLB);
  copyPics($dir0, COPY, $picLB, @childs);
  openDirPost($dir0);
  my $test_nr = 0;
  
  return if (not test_prepare(\@childs,$dir0,$dir1,$dir2,\$test_nr));
  test_selection($dir1);

  return if (not test_prepare(\@childs,$dir0,$dir1,$dir2,\$test_nr));
  test_copy($dir1, $dir2);
  
  return if (not test_prepare(\@childs,$dir0,$dir1,$dir2,\$test_nr));
  test_move($dir1, $dir2);

  return if (not test_prepare(\@childs,$dir0,$dir1,$dir2,\$test_nr));
  test_backup($dir1);

  if (not $EvilOS) {
    return if (not test_prepare(\@childs,$dir0,$dir1,$dir2,\$test_nr));
    test_link($dir1, $dir2);
  }

  return if (not test_prepare(\@childs,$dir0,$dir1,$dir2,\$test_nr));
  test_comment($dir1);
  
  return if (not test_prepare(\@childs,$dir0,$dir1,$dir2,\$test_nr));
  test_rotate($dir1);

  return if (not test_prepare(\@childs,$dir0,$dir1,$dir2,\$test_nr));
  test_exif($dir1);

  ##################################################
  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 ($dir0, $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
  }
  # restore configurations
  $config{AskDeleteHighRatingLevel} = $tmp_AskDeleteHighRatingLevel;
}

##############################################################
##############################################################
sub test_prepare {
  my $childs = shift; # array ref
  my ($dir0, $dir1, $dir2, $test_nr) = @_;
  $$test_nr++;
  openDirPost($dir0);
  # cleanup if folders are already there
  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"; } }
  # check if everything worked
  foreach ($dir1, $dir2) { unless (-d $_) { warn "testSuite: *** $_ not found! Stopping test suite!\n"; return 0; } }
  print "testSuite: temp dirs created\n";
  # test initial copy actdir -> dir0
  print "testSuite: prepare pics testing. Test # $$test_nr\n";
  selectAll($picLB);
  copyPics($dir1, COPY, $picLB, @$childs);
  openDirPost($dir1);
  return 1;
}

##############################################################
##############################################################
sub test_selection {
  my @childs = $picLB->info('children');
  # 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);
}

##############################################################
##############################################################
sub test_copy {
  my ($dir1, $dir2) = @_;
  my @childs1 = $picLB->info('children');

  # copy first pic dir1 -> dir2
  print "testSuite: testing copy first\n";
  selectThumb($picLB, $childs1[0]);
  my @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 $childs1[0] ne $childs2[0]\n";
  }

  # copy last pic dir1 -> dir2
  print "testSuite: testing copy last\n";
  openDirPost($dir1);
  @childs1 = $picLB->info('children');
  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 2) {
    warn "testSuite: *** copy error ".scalar @childs2." ne 2\n";
  }
  if (basename($childs1[-1]) ne basename($childs2[-1])) {
    warn "testSuite: *** copy error $childs1[-1] ne $childs2[-1]\n";
  }

  # test copy all dir1 -> dir2
  openDirPost($dir1);
  #my @childs1rest = $picLB->info('children');
  my @childs1rest = @childs1;
  # remove first and last from list, else we get an overwrite requester to the user
  shift @childs1rest;
  pop @childs1rest;
  print "testSuite: testing copy all\n";
  selectAll($picLB);
  copyPics($dir2, COPY, $picLB, @childs1rest);
  openDirPost($dir2);
  @childs2 = $picLB->info('children');
  if (@childs1 != @childs2) {
    warn "testSuite: *** copy error ".scalar @childs1." ne ".scalar @childs2."\n";
  }
  foreach my $i (0 .. $#childs1) {
    # todo this will fail, if files are sorted by file date (copy date)
    if (basename($childs2[$i]) ne basename($childs1[$i])) {
      warn "testSuite: *** copy error $childs2[$i] ne $childs1[$i]\n";
    }
  }
}

##############################################################
##############################################################
sub test_move {
  my ($dir1, $dir2) = @_;
  my @childs1 = $picLB->info('children');

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

##############################################################
##############################################################
sub test_backup {
  my $dir1 = shift;
  # prepare: we should have no backup files (*-bak.jpg) before we start
  # as this gives a warning when there is no backup we first have to create one
  my @childs1 = $picLB->info('children');
  copyPics($dir1, BACKUP, $picLB, $childs1[0]);
  selectBak();
  deletePics($picLB, TRASH);

  @childs1 = $picLB->info('children');
  my $nr = scalar(@childs1);
  if ($nr <= 0) {
    warn "testSuite: *** backup error after deleting backup files nothing left!\n";
    return;
  }

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

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

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

##############################################################
##############################################################
sub test_comment {
  my $dir1 = shift;
  # test comments first pic
  print "testSuite: testing comment single\n";
  my $testcom = "xxxcccxxx1234ABC";
  my @childs1 = $picLB->info('children');
  selectThumb($picLB, $childs1[0]);
  my @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, $childs1[-1]);
  removeAllComments(NO_ASK);
  warn "testSuite: *** remove comment error\n" if (scalar getComments($childs1[-1]) != 0);
  selectAll($picLB);
  my %comNr; # hash: key:dpic value:nr of comments
  foreach (@childs1) {
    my @com = getComments($_);
    $comNr{$_} = scalar @com;
  }
  joinComments(NO_ASK);
  foreach (@childs1) {
    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);
  }
}

##############################################################
##############################################################
sub test_rotate {
  my $dir1 = shift;
  my @childs1 = $picLB->info('children');
  print "testSuite: testing rotate single\n";
  selectThumb($picLB, $childs1[0]);
  rotate(90);
  rotate(270);
  my $size = getFileSize($childs1[0]);
  rotate(90);
  rotate(270);
  warn "testSuite: *** rotate single file mismatch!\n" if ($size != getFileSize($childs1[0]));
}

##############################################################
##############################################################
sub test_exif {
  my $dir1 = shift;
  my @childs1 = $picLB->info('children');
  print "testSuite: testing EXIF date set/get\n";
  selectThumb($picLB, $childs1[0]);
  my $testdate = '2099:11:30 23:59:59';
  my $errorstr = '';
  setEXIFDatePic($childs1[0],$testdate,\$errorstr);
  my $datetime = getEXIFDate($childs1[0]);
  #print "EXIF date of $childs1[0]: $testdate -> $datetime\n";
  warn "testSuite: *** set EXIF date $testdate != $datetime!\n" if ($testdate ne $datetime);
}

##############################################################
# 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 actual pic - skipping!\n" if $verbose;
      next;
    }
    my $dpic = shift @cachedPics;       # get the oldest
    print "checkCachedPics: removing old $dpic list:$#cachedPics\n" if $verbose;
    $c->delete('withtag', $dpic);           # remove it from the canvas
    $photos{$dpic}->delete if $photos{$dpic}; # delete the photo object
    delete $photos{$dpic};                    # delete the hash item
  }
  #printlist(@cachedPics);
  # just for safety
  warn "*** checkCachedPics: photos hash contains more than MaxCachedPics pics (".scalar @cachedPics."(".scalar(keys(%photos)).") > ".$config{MaxCachedPics}.")" if (keys %photos > $config{MaxCachedPics});
}


##############################################################
# renameCachedPic - rename a list item
##############################################################
sub renameCachedPic {
  my $old = shift;
  my $new = shift;
  return unless (defined $photos{$old});
  # open new photo object
  $photos{$new} = $top->Photo;
  $photos{$new}->blank;
  $photos{$new}->copy($photos{$old});
  $c->delete('withtag', $old);   # remove it from the canvas
  $photos{$old}->delete if $photos{$old}; # delete the photo object
  delete $photos{$old};                    # delete the hash item
  my $xoffset = 0; my $yoffset = 0;
  $xoffset = int(($c->width  - $photos{$new}->width) /2) if ($c->width  > $photos{$new}->width);
  $yoffset = int(($c->height - $photos{$new}->height)/2) if ($c->height > $photos{$new}->height);
  # hide all items on the canvas
  canvasHide();
  # insert pic
  my $id = $c->createImage($xoffset, $yoffset, -image => $photos{$new}, -tag => ["pic", $new], -anchor => "nw");
  bindItem($id);
  for my $t ( 0 .. $#cachedPics ) {
    if ($cachedPics[$t] eq $old) {
      $cachedPics[$t] = $new;           # rename list item
    }
  }
  print "renameCachedPic: $old -> $new\n" if $verbose;
  checkCachedPics();
}

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

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

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

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

##############################################################
# showSelectedPic - displays the original picture of the
#                   selected thumbnail
##############################################################
sub showSelectedPic {
  return if (stillBusy()); # block, until last picture is loaded
  my @sellist = $picLB->info('selection');
  # show index number in window
  showNrOf();
  return unless ($picLB->info('children'));
  return if (@sellist > 1);
  showPic($sellist[0]);
}

##############################################################
# showNrOf
##############################################################
sub showNrOf {
  my @pics    = $picLB->info('children');
  my @sellist = $picLB->info('selection');
  my $index   = 0;
  my $size    = 0;
  my $sizeStr = '';
  if (@sellist >= 1) {  # selection available
    foreach (@pics) {
      $index++;
      last if ($_ eq $sellist[0]);
    }
  }
  if (@sellist >= 2) {  # more than one selected
    foreach (@sellist) {
      $size += getFileSize($_, NO_FORMAT);
    }
    $sizeStr = computeUnit($size) if $size;
    $sizeStr = ", $sizeStr" if ($sizeStr ne '');
  }
  # show index number in window
  $nrof = "$index/".@pics." (".@sellist."$sizeStr)";
}

##############################################################
# computeUnit - do a byte to kB or MB conversion
##############################################################
sub computeUnit {
    my $size = shift;
    my $sizeStr;
    $size = int($size/1024);                   # KiloByte
    if ($size > 1024) {                        # MegaByte
      if ($size > 1024*1024) {                 # GigaByte
        if ($size < (1024*1024*100)) {              # less than 100GB
            $size    = int($size*10/(1024*1024))/10;  # e.g. 6.9GB or 23.4GB
        }
        else {
            $size    = int($size/(1024*1024));        # e.g. 104GB
        }
        $sizeStr = "${size}GB";
      }
      else {
        if ($size < (1024*100)) {              # less than 100MB
            $size    = int($size*10/1024)/10;  # e.g. 6.9MB or 23.4MB
        }
        else {
            $size    = int($size/1024);        # e.g. 104MB
        }
        $sizeStr = "${size}MB";
      }
    }
    else {
        $sizeStr = "${size}kB";
    }
    return $sizeStr;
}

##############################################################
##############################################################
sub string_changed {
  my ($old, $new) = @_;
  my $change = 0;
  # changed is true if ...
  # a) old and new are defined and new is not empty and not equal
  # b) old is undefined and new is defined and not empty
  if ((defined $new) and ($new ne '')) {
    if (defined $old) {
      if ($old ne $new) {
        $change = 1;
      }    
    }
    else { # old not defined
      #if ($new ne '') {
        $change = 1;
      #}
    }
  }
  return $change;
}

##############################################################
# check_IPTC_edit - check if the user added or edited the IPTC
# headline or caption of the actual pic and ask to save it
##############################################################
sub check_IPTC_edit {
  my $dpic = shift;
  # prevent question at startup
  return if (not $config{ShowPic});
  # we need a picture to compare
  return unless defined $dpic;
  return unless -f $dpic;
  # function is only relevant when caption frame is visible
  return unless $iptcF->ismapped;
  my $change = 0;
  my $headline_new = $titleText->get(0.1, 'end');
  my $headline = getIPTCHeadline($dpic);
  $headline_new =~ s/\n+$// if (defined $headline_new); # cut off trailing newline(s)
  $change = string_changed($headline, $headline_new);
  # only if no change has been detected so far we also check the caption
  if (not $change) {
    my $caption_new = $captionText->get(0.1, 'end');
    my $caption = getIPTCCaption($dpic);
    $caption_new =~ s/\n+$// if (defined $caption_new); # cut off trailing newline(s)
    $caption     =~ s/\n+$// if (defined $caption); # cut off trailing newline(s)
    $change = string_changed($caption, $caption_new);
  }
  if ($change) {
    my $rc = $top->messageBox(-icon => 'question',
                              -message => langf("Headline/caption of %s have been changed.\nShould Mapivi save the changes?", $dpic),
                              -title => lang("Save changes?"),
                              -type => 'YesNo');
    $saveB->Invoke if ($rc =~ m/Yes/i);
  }
  return;
}

##############################################################
# showPic - displays a picture in the main window canvas
##############################################################
sub showPic {
  # check if the user added or edited the IPTC caption of the actual pic and ask to save it 
  # Warning:  must be called before $actpic is set to new picture ($dpic)
  check_IPTC_edit($actpic);
  my $dpic = shift;
  my @pics = $picLB->info('children');
  return if ((!defined $dpic) or (!@pics));
  if (@pics < 1) {
    warn lang("Error: No pictures in listbox") if $verbose;
    log_it(lang("Error: No pictures in listbox"));
    return;
  }
  $actpic = $dpic;
  return if ((!defined $actpic) or ($actpic eq ''));
  setTitle();
  my $pic = basename($dpic);
  # select thumb in list even if picture is not shown (see "ShowPic" below)
  selectThumb($picLB, $dpic);
  return if (!$config{ShowPic});
  # show EXIF info and comment
  showImageInfo($dpic);
  # we are still not able to display RAW pictures (nefextract may be a solution for NEFs, see also extract_jpeg())
  return if ($dpic =~ m/.*\.(nef)|(raw)$/i);
  # do not show a picture if the frame is very small
  if ($dpic =~ m/.*\.(tif)|(tiff)|(xbm)$/i) {
    log_it("$pic ".lang("Not displayed (unsupported picture format)"));
    return;
  }
  # do not show a picture if there is no picture frame
  if (!$config{ShowPicFrame}) {
    log_it("$pic ".lang("Not displayed - no picture frame (hint: try F9 or F11)"));
    return;
  }
  # do not show a picture if the frame is very small
  if ($mainF->width < 200) {
    log_it("$pic ".lang("Not displayed (picture frame too small)"));
    return;
  }
  $showPicInAction = 1;
  # remove thumbnails from canvas, if any
  clear_canvas_thumbs($c);
  my $do_center = 0; # flag to center picture (do only when loading or resizing)
  $balloon->detach($c); # clear the balloon info for the actual pic (right frame of main window)
  log_it(langf("Loading %s ...", $pic));
  my @ids = $c->find('withtag', $dpic);
  my $id;
  if (@ids > 0) { # pic is already loaded
    print "showPic: using cached pic $dpic\n" if $verbose;
    $id = $ids[0];
    # hide all items on the canvas
    canvasHide();
    # make hidden picture visible again
    $c->itemconfigure($id, -state => 'normal');
    $top->update();
  }
  else {
    print langf("showPic: loading %s\n",$dpic) if $verbose;
    if (-f $dpic) { # load pic
      $top->Busy();
      #if ($dpic =~ m/.*\.avi$/i) {
        # hide all items on the canvas
        #canvasHide();
        # load thumbnail
        #my $thumb = getThumbFileName($dpic);
        #$photos{$dpic} = $top->Photo(-file => $thumb, -gamma => $config{Gamma}) if -f $thumb;
        #my $command = "vlc \"$dpic\" ";
        #execute($command);        
      #}
      #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
      eval { $photos{$dpic} = $top->Photo(-file => $dpic, -gamma => $config{Gamma}); }; 
      # error handling
      if ($@) {
        log_it("Error loading $pic");
        print "Error loading $pic: \"$@\"\n";
        $showPicInAction = 0;
        $top->Unbusy();
        return;
      }
      # 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 in canvas
        $id = $c->createImage($xoffset, $yoffset, -image => $photos{$dpic}, -tag => ['pic',$dpic], -anchor => 'nw');
        $do_center = 1; # set flag to center picture
        bindItem($id);
        addToCachedPics($dpic);
      }
      else {
        log_it(langf("showPic: error loading %s!",$actpic));
        warn langf("showPic: error loading %s!",$actpic) if $verbose;
      }
      $top->Unbusy();
      addToCachedPics($dpic);
    }
    else {
      canvasHide();
      warn langf("showPic: error %s not available!", $actpic) 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'));
  }
  log_it($pic);
  # adjust the canvas scrollbars, only if the canvas contains a picture
  if ($c->bbox("all") and $photos{$dpic}) {
    $c->configure(-scrollregion => [ $c->bbox("all") ]);
    # move canvas view to upper left corner for small pictures
    #$c->xviewMoveto(0) if ($c->Width  > $photos{$dpic}->width);
    #$c->yviewMoveto(0) if ($c->Height > $photos{$dpic}->height);  
    # center canvas over big pictures only the first time (new picture)
    canvas_center($c, $photos{$dpic}->width, $photos{$dpic}->height) if $do_center;
  }
  $top->Unbusy();
  $showPicInAction = 0;
}

##############################################################
# center canvas scrollbars over big pictures
##############################################################
sub canvas_center {
  my ($c, $pic_w, $pic_h) = @_; # canvas widet, picture width (pixels), picture height (pixels)
  $c->xviewMoveto(($pic_w - $c->width) /($pic_w*2)) if ($c->width  < $pic_w);
  $c->yviewMoveto(($pic_h - $c->height)/($pic_h*2)) if ($c->height < $pic_h);
}

##############################################################
# 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 $svnrevision";
  # just a little gag
  my (undef,undef,undef,$d,$m,$y) = getDateTime(time());
  $title .= langf(" - Happy new year $y!") if ($d == 1 and $m == 1);
  $top->title($title);
  log_it(basename($actpic));
}

##############################################################
# increasePicPopularity
##############################################################
sub increasePicPopularity {
  return unless ($config{trackPopularity});
  my $dpic = shift;
  if (defined $searchDB{$dpic}{POP}) {
    $searchDB{$dpic}{POP}++;
  }
  else {
    $searchDB{$dpic}{POP} = 1;
  }
  print langf("$dpic has been shown $searchDB{$dpic}{POP} times.\n") if $verbose;
}

##############################################################
# showMostPopularPics - display the Top 100 of the best rated pics
##############################################################
sub showMostPopularPics {
  # open window
  my $win = $top->Toplevel();
  window_size($win, 80);
  $win->title(lang('Best rated pictures - TOP 100'));
  $win->iconimage($mapiviicon) if $mapiviicon;
  my $text = lang('Searching ...');
  my $butF = $win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
  my $Xbut = $butF->Button(-text => lang('Close'),
                           -command => sub {
                             $win->destroy();
                           })->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 3, -pady => 3);
  $butF->Label(-textvariable => \$text)->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  my $tlb = makeThumbListbox($win);
  # key bindings
  bind_exit_keys_to_button($win, $Xbut);
  $win->bind('<Control-a>',  sub { selectAll($tlb); } );
  $win->bind('<ButtonPress-2>', sub {
               return if (!$tlb->info('children'));
               my $dpic = getNearestItem($tlb);
               showPicInOwnWin($dpic); });
  $win->bind('<Key-d>', sub {
              my @sellist = getSelection($tlb);
              return unless checkSelection($win, 1, 0, \@sellist, lang("picture(s)"));
              show_multiple_pics(\@sellist, 0);
   } );
  # show picture in main window and in lighttable
  $win->bind('<Key-m>', sub { open_pic_in_main($tlb); });
  $win->bind('<Key-l>', sub { light_table_add_from_lb($tlb); } );
  $win->Popup(-popover => 'cursor');
  repositionWindow($win);
  my @populatity_list = sort {
      my $urga = 0;
      $urga = $searchDB{$a}{URG} if (defined $searchDB{$a}{URG});
      $urga = 9 if ($urga == 0);
      my $urgb = 0;
      $urgb = $searchDB{$b}{URG} if (defined $searchDB{$b}{URG});
      $urgb = 9 if ($urgb == 0);
      my $popa = 0;
      $popa = $searchDB{$a}{POP} if (defined $searchDB{$a}{POP});
      my $popb = 0;
      $popb = $searchDB{$b}{POP} if (defined $searchDB{$b}{POP});
      $urga <=> $urgb || $popb <=> $popa;
  } keys %searchDB;
  $text = lang('Loading ...');
  $win->update();
  my %thumbs;
  foreach my $nr (0 .. 99) {
    my $dpic = $populatity_list[$nr];
    insertPic($tlb, $dpic, \%thumbs);
  }
  $text = lang('Ready');
  $win->waitWindow;
  # clean up memory - delete all found thumbnail photo objects
  delete_thumb_objects(\%thumbs);
}

##############################################################
# resize window to x% of screensize and center it on screen
# (center does not work, at least on windows)
##############################################################
sub window_size {
  my $win = shift;
  my $size = shift; # in percent of screensize;
  $size = $size/100;
  my $w = int($size * $win->screenwidth);
  my $h = int($size * $win->screenheight);
  my $x = int(($win->screenwidth - $w)/2); 
  my $y = int(($win->screenheight - $h)/2); 
  $win->geometry("${w}x${h}+${x}+${y}");
}

##############################################################
# slideshow_all_pics - show all pictures of the search database
# in a slideshow
# pictures may be filtered based on rating and keywords
##############################################################
sub slideshow_all_pics {
  my $set_or_start = shift;
  if ($set_or_start == SETTINGS) {
    # GUI to edit several filters stored in %conf hash
    my $ok = picture_filter(lang("Filter all accessible pictures of your database to create a slideshow.")); 
    return if (not $ok);
  }
  my @include_keys = split / /, $conf{slideshow_keywords_include}{value};
  my @exclude_keys = split / /, $conf{slideshow_keywords_exclude}{value};
  my @exclude_folders = split / /, $conf{slideshow_folders_exclude}{value};
  my @pic_list;
  log_it("Scanning database ...");
  my $i = 0;
  my $pw = progressWinInit($top, 'Filtering pictures ...');
  my $pic_total = scalar(keys(%searchDB));
  my %removed_by;
  my $total = 0;
  # build keyword/tag hash
  #foreach my $dpic (keys %searchDB) {
  while (my ($dpic, undef) = each %searchDB) {
    last if progressWinCheck($pw);
    $total = scalar @pic_list;
    $i++;
    progressWinUpdate($pw, "scanning ($i/$pic_total), found $total ...", $i, $pic_total);
    # exclude non-JPEGS by file suffix (this is much faster than using is_a_JPEG())
    if ($dpic !~ m/.*\.jp(g|eg)$/i) {
      $removed_by{filesuffix}++;
      next;
    }
    # exclude pics from certain folders
    if (string_contains(dirname($dpic), \@exclude_folders)) {
      $removed_by{folder}++;
      next;
    }
    # include only pictures with certain keywords
    if (@include_keys) {
      if ((not defined $searchDB{$dpic}{KEYS}) or
           ($searchDB{$dpic}{KEYS} eq '') or 
	   (string_contains_nor($searchDB{$dpic}{KEYS}, \@include_keys))) {
        $removed_by{keyword}++;
        next;
      }
    }
    # don't show pictures with a low rating (but show pictures without rating)
    if ($conf{slideshow_rating_exclude}{value} and
        defined $searchDB{$dpic}{URG} and $searchDB{$dpic}{URG} >= $conf{slideshow_rating_level}{value}) {
      $removed_by{rating}++;
      next;
    }
    # don't show pictures without rating
    if ($conf{slideshow_norating_exclude}{value} and not defined $searchDB{$dpic}{URG}) {
      $removed_by{norating}++;
      next;
    }
    # don't show pictures which have been shown more than n times
    if ($conf{slideshow_pop_exclude}{value} and
        defined $searchDB{$dpic}{POP} and $searchDB{$dpic}{POP} >= $conf{slideshow_pop_level}{value}) {
      $removed_by{popularity}++;
      next;
    }
    # exclude pictures with certain keywords
    if (@exclude_keys) {
      if (string_contains($searchDB{$dpic}{KEYS}, \@exclude_keys)) {
        $removed_by{keyword}++;
        next;
      }
    }
    # exclude non-existing pictures (e.g. pictures stored on unconnected external media)
    if (not -f $dpic) {
      $removed_by{availability}++;
      next;
    }
    # collect matching pics in a list
    push @pic_list, $dpic;
    last if ($conf{slideshow_number_limit}{value} and (scalar(@pic_list) >= $conf{slideshow_number}{value}));
  }
  progressWinEnd($pw);
  log_it("Found $total pictures, $removed_by{keyword} removed due to keyword match.");
  foreach my $reason (keys(%removed_by)) {
    printf "%6d pictures removed by %s\n", $removed_by{$reason}, $reason;
  }
  if ($conf{slideshow_random}{value}) {
    # shuffle randomly
    fisher_yates_shuffle(\@pic_list);
  }
  else { # sort by name
    @pic_list = sort { uc(basename($a)) cmp uc(basename($b)) } @pic_list;
  }
  show_multiple_pics(\@pic_list, 0, NORMAL, SHOW);
}

##############################################################
# set some picture filter options (e.g. for the slideshow)
##############################################################
sub picture_filter {
  my $info_text = shift;
  my $ok = 0;
  my $w = 30;
  # open window
  my $win = $top->Toplevel();
  $win->title(lang('Picture filter settings'));
  $win->iconimage($mapiviicon) if $mapiviicon;
  $win->Label(-text => $info_text, -anchor => 'w')->pack(-anchor => 'w');
  # window frames
  my $excf = $win->Frame(-bd => 1, -relief => 'raised')->pack(-fill => 'both', -padx => 6, -pady => 6);
  $excf->Label(-text => lang('Exclude pictures ...'))->pack(-anchor=>'w', -padx => 3, -pady => 3);
  my $incf = $win->Frame(-bd => 1, -relief => 'raised')->pack(-fill => 'both', -padx => 6, -pady => 6);
  $incf->Label(-text => lang('Include pictures ...'))->pack(-anchor=>'w', -padx => 3, -pady => 3);
  my $sortf = $win->Frame(-bd => 1, -relief => 'raised')->pack(-fill => 'both', -padx => 6, -pady => 6);
  $sortf->Label(-text => lang('Sort pictures ...'))->pack(-anchor=>'w', -padx => 3, -pady => 3);
  my $limitf = $win->Frame(-bd => 1, -relief => 'raised')->pack(-fill => 'both', -padx => 6, -pady => 6);
  $limitf->Label(-text => lang('Limit number of pictures ...'))->pack(-anchor=>'w', -padx => 3, -pady => 3);
  # exclude by rating
  $excf->Checkbutton(-variable => \$conf{slideshow_rating_exclude}{value}, -text => lang('with rating lower than'))->pack(-anchor=>'w', -padx => 3, -pady => 3);
  $excf->Scale(-variable => \$conf{slideshow_rating_level}{value},
              -from => 1,
              -to => 8,
              -resolution => 1,
              -orient => 'horizontal',
              -showvalue => 1,
            )->pack(-expand => 1, -fill => 'x', -padx => 6, -pady => 6);
  $excf->Checkbutton(-variable => \$conf{slideshow_norating_exclude}{value}, -text => lang('without rating'))->pack(-anchor=>'w', -padx => 3, -pady => 3);
  # exclude by popularity
  $excf->Checkbutton(-variable => \$conf{slideshow_pop_exclude}{value}, -text => lang('shown more often than'))->pack(-anchor=>'w', -padx => 3, -pady => 3);
  $excf->Scale(-variable => \$conf{slideshow_pop_level}{value},
              -from => 1,
              -to => 200,
              -resolution => 1,
              -orient => 'horizontal',
              -showvalue => 1,
            )->pack(-expand => 1, -fill => 'x', -padx => 6, -pady => 6);
  # exclude by keywords
  $excf->Label(-text => lang('matching one of these keywords (space separated, case insensitive)'), -anchor => 'w')->pack(-anchor => 'w', -padx => 3, -pady => 3);
  $excf->Entry(-textvariable => \$conf{slideshow_keywords_exclude}{value}, -width => $w)->pack(-fill => 'x', -padx => 3, -pady => 3);
  # exclude by folders
  $excf->Label(-text => lang('in folders matching (space separated, case insensitive)'), -anchor => 'w')->pack(-anchor => 'w', -padx => 3, -pady => 3);
  $excf->Entry(-textvariable => \$conf{slideshow_folders_exclude}{value}, -width => $w)->pack(-fill => 'x', -padx => 3, -pady => 3);
  # include by keywords
  $incf->Label(-text => lang('matching one of these keywords (space separated, case insensitive)'), -anchor => 'w')->pack(-anchor => 'w', -padx => 3, -pady => 3);
  $incf->Entry(-textvariable => \$conf{slideshow_keywords_include}{value}, -width => $w)->pack(-fill => 'x', -padx => 3, -pady => 3);
  # sort random or by filename
  $sortf->Checkbutton(-variable => \$conf{slideshow_random}{value}, -text => lang('by random order'))->pack(-anchor=>'w', -padx => 3, -pady => 3);
  # limit amount of pictures (low number will speed up time to scan database, but not all pictures are considered)
  $limitf->Checkbutton(-variable => \$conf{slideshow_number_limit}{value}, -text => lang('use limit'))->pack(-anchor=>'w', -padx => 3, -pady => 3);
  $limitf->Scale(-variable => \$conf{slideshow_number}{value},
              -from => 2,
              -to => scalar(keys(%searchDB)),
              -resolution => 1,
              -orient => 'horizontal',
              -showvalue => 1,
            )->pack(-expand => 1, -fill => 'x', -padx => 6, -pady => 6);

  my $but_frame = $win->Frame()->pack(-fill =>'x');
  my $ok_but = $but_frame->Button(-text => lang('OK'),
                         -command => sub {
                             $ok = 1;
                             $win->withdraw();
                             $win->destroy();
                         })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 2, -pady => 3);
  my $x_but = $but_frame->Button(-text => lang('Cancel'),
                         -command => sub {
                             $ok = 0;
                             $win->withdraw();
                             $win->destroy();
                         })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 2, -pady => 3);
  $win->Popup(-popover => 'cursor');
  repositionWindow($win);
  $win->waitWindow;
  return $ok;
}

##############################################################
# check if any items of the list are contained in the string
# case insensitive!
##############################################################
sub string_contains {
  my $string = shift;
  my $list_ref = shift;
  my $match = 0;
  if (defined $string) {
    foreach (@$list_ref) {
      if ($string =~ m/$_/i) {
        $match = 1;
        last;
      }
    }
  }
  return $match;
}

##############################################################
# check if any items of the list are not contained in the string
# case insensitive! (this is equivalent to an AND-Search!)
##############################################################
sub string_contains_not {
  my $string = shift;
  my $list_ref = shift;
  my $match = 0;
  if (defined $string) {
    foreach (@$list_ref) {
      if (not ($string =~ m/$_/i)) {
        $match = 1;
        last;
      }
    }
  }
  return $match;
}

##############################################################
# check if any items of the list are not contained in the string
# case insensitive! (this is equivalent to a NOR-Search!)
##############################################################
sub string_contains_nor {
  my $string = shift;
  my $list_ref = shift; # include keyword list
  my $match = 0;
  if (defined $string) {
    # or-function "Tim, Tom" -> "Tim|Tom"
    my $pattern = '';
    foreach (@$list_ref) {
      $pattern .= $_.'|';
    }
    # remove last "|" again
    $pattern = substr($pattern, 0, length($pattern)-1); 
    if (not ($string =~ m/$pattern/i)) {
      $match = 1;
    }
  }
  return $match;
}

##############################################################
# exif_histogram - display a histogram of some EXIF data
##############################################################
sub exif_histogram {
  my $lb = shift;
  my @pics;
  # if a listbox reference is given we try to get the selected pictures from there
  if (defined $lb and Exists($lb)) {
    @pics = getSelection($lb);
  }
  # else we use all pictures of the search database
  if (!@pics or (scalar @pics < 1)) {
    @pics = keys %searchDB;
  }
  # open window
  my $win = $top->Toplevel();
  $win->title(lang('EXIF histograms'));
  $win->iconimage($mapiviicon) if $mapiviicon;
  my $text = langf("Collecting EXIF data in ".scalar @pics." pictures ...");
  my $c_w = 800;
  my $c_h = 600;
  my $border = 20;
  $win->Label(-textvariable => \$text)->pack(-expand => 0, -fill => 'x');
  my $canvas = $win->Canvas(-width  => $c_w,
                            -height => $c_h,
                            -background => $conf{color_bg}{value},
                            -relief => 'sunken',)->pack(-side => 'top', -padx => 3, -pady => 3);
  my %balloon_hash;
  $balloon->attach($canvas, -balloonposition => "mouse",  -msg => \%balloon_hash );
  my $butF = $win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
  my $Xbut = $butF->Button(-text => lang('Close'),
                           -command => sub {
                             $win->destroy();
                           })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  bind_exit_keys_to_button($win, $Xbut);
  $win->Popup(-popover => 'cursor');
  repositionWindow($win);
  my %histogram;
  my %histogram_long = (
      'focal_distance35' => lang('Focal distance in 35mm (mm)'),
      'focal_distance' => lang('Focal distance (mm)'),
      'aperture' => lang('Aperture (F)'),
      'iso' => lang('Film speed (ISO)'),
      'exposure_time' => lang('Exposure time (1/s)'),
	  );
  $win->Busy;
  #my %aperture;
  foreach my $dpic (@pics) {
    next unless exists $searchDB{$dpic};
    next unless exists $searchDB{$dpic}{EXIF};
    my $exif = $searchDB{$dpic}{EXIF};
    # Focal distance - the EXIF info should look like this: ... 105mm ... with no brackets 
    if ($exif =~ m|.*[^\(](\d+)mm[^\)].*|) {
      $histogram{focal_distance}{$1}++;
    }
    if ($exif =~ m|.*\((\d+)mm\).*|) {
      $histogram{focal_distance35}{$1}++;
    }
    # Aperture - the EXIF info should look like this: ... F2.8 ... 
    if ($exif =~ m|.* F(\d+\.\d) .*|) {
      $histogram{aperture}{$1}++;
    }
    # ISO - the EXIF info should look like this: ... ISO400 ... 
    if ($exif =~ m|.* ISO(\d+) .*|) {
      $histogram{iso}{$1}++;
    }
    # exposure time - the EXIF info should look like this: ... 1/125s ... 
    if ($exif =~ m|.* (\d+)\/(\d+)s .*|) {
      $histogram{exposure_time}{$2}++ if ($1 == 1);
    }
  }
#  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;
  $text = lang('Printing histogram ...');
  $win->update();
  #my $font = $win->Font(-family => $config{FontFamily}, -size => $config{FontSize});
  $c_w -= 2*$border;
  $c_h -= 2*$border;
  my $size_min = 3;
  my $nr_of_diagrams = keys %histogram;
  # diagram height
  my $d_h = ($c_h - ($nr_of_diagrams - 1)*$border)/$nr_of_diagrams ;
  # bottom line of next diagram
  my $y = 0;
  foreach my $kind (sort keys %histogram) {
    $y = $y + $border + $d_h;
    # determine maximum values of this hash
    my $max_value = 0;
    my $max_key = 0;
    my $sum = 0;
    foreach (keys %{$histogram{$kind}}) {
      $max_value = $histogram{$kind}{$_} if ($histogram{$kind}{$_} > $max_value);
      $max_key   = $_	if ($_ > $max_key);
      $sum      += $histogram{$kind}{$_};
    }
    draw_coordinate_system($canvas, $border, $y-$d_h, $c_w, $d_h);
    foreach (sort {$a <=> $b} keys %{$histogram{$kind}}) {
      my $x = $_/$max_key*$c_w + $border;
      $x = sqrt($_/$max_key)*$c_w + $border if ($kind eq 'exposure_time');;
      my $h = $histogram{$kind}{$_}/$max_value*$d_h;
      $h = $size_min if ($h < $size_min); # minimum height 
      $canvas->createLine( $x, $y, $x, $y-$h, -fill => 'red', -width => $size_min, -tags => "$_/$histogram{$kind}{$_}");
      my $procent = sprintf "%2.2f%%", $histogram{$kind}{$_}/$sum*100;
      $balloon_hash{"$_/$histogram{$kind}{$_}"} = langf("$histogram_long{$kind}: ${_}  $histogram{$kind}{$_} pictures ($procent)\nFound this information type in $sum pictures.");
    }
    # diagram title
    $canvas->createText($border + $c_w/2, $y-$d_h, -font => $font, -fill => $conf{color_fg}{value}, -text => $histogram_long{$kind}, -anchor => 'n',);
  }
  $win->Unbusy;
  $text = langf("EXIF histogram of ".scalar @pics." pictures. (Hint: Stop mouse pointer above a line to see details.)");
  $win->waitWindow;
}

##############################################################
##############################################################
sub draw_coordinate_system {
  my ($c, $x, $y, $w, $h) = @_;
  
  # y-axis
  $c->createLine($x, $y+$h, $x, $y-8,
				  -fill => $conf{color_fg}{value},
				  -tags    => 'coordinate system',
				  -arrow => 'last',
				  -arrowshape => [6,6,3],
				  -width => 1,
				 );
  # x-axis			 
  $c->createLine($x, $y+$h, $x+$w+8, $y+$h,
				  -fill => $conf{color_fg}{value},
				  -tags    => 'coordinate system',
				  -arrow => 'last',
				  -arrowshape => [6,6,3],
				  -width => 1,
				 );

}

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

##############################################################
# stopWatchStop
##############################################################
sub stopWatchStop {
  my $text = '';
  $text = shift;
  printf langf("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 available!" if $verbose;
    return;
  }
  $lb->selectionSet($index);
  $lb->anchorSet($index);
  $lb->see($index);
  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);
  }
  $lb->update;
  showNrOf();
}

##############################################################
# selectAll
##############################################################
sub selectAll {
  my $lb = shift;
  my @item = $lb->info('children');
  return unless (@item);
  $lb->selectionSet($item[0], $item[-1]); # Hlist doesn't work with 'end' or 'all'
  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 \ -> /
  if (defined $thumbDBhash{$dir}) {
    return $thumbDBhash{$dir}."/$pic";
  }
  # the default place for thumbnails is always a sub folder called ".thumbs" in the actual folder
  my $thumbdir = "$dir/$thumbdirname";
  # central thumbDB
  if (($config{CentralThumbDB})            or # config option set to central thumbdir
   (!-d $dir)                               or # if the folder is not mounted/available
   ((-d $thumbdir) and (!-w $thumbdir))     or # or .thumbdir exists but is write protected
   (-f "$dir/.nothumbs")                    or # or file .nothumbs is found
   ((!-w $dir) and (!-d $thumbdir))) {         # or dir is write protected but there is no .thumbdir
    $dir = cut_device_letter($dir);
    $thumbdir =  "$thumbDB/$dir";
    $thumbdir =~ s/\/+/\//g;    # replace multiple slashes with one             // -> /
  }
  $thumbDBhash{$dir} = $thumbdir; # store for quicker response
  return "$thumbdir/$pic";
}

##############################################################
# get rid of the device names (C:\ d:/ etc.) in Windows paths
##############################################################
sub cut_device_letter {
  my $dir = shift;
  if ($EvilOS) {
    # in windows we have to get rid of the device names (C:\ d:/ etc.) because they may change between sessions and we can't use them inside a path
    print "cut_device_letter: $dir " if $verbose;
    $dir =~ s!^[a-z]:/!!i;                   # for slash
    $dir =~ s!^[a-z]:\\!!i;                  # for backslash
    print "-> $dir\n" if $verbose;
  }
  return $dir;
}

##############################################################
# generateThumbs - generate thumbnails for each picture
#                  remove outdated thumbs in folder $actdir (global variable!)
##############################################################
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 $nrofprocs = 0;
  my @pics;
  if ((defined $getpics) and ($getpics == 1)) {
    @pics = getPics($actdir, WITH_PATH, NO_CHECK_JPEG);
    # 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 0 if (@pics <= 0);
  $nrToConvert = 0;
  # count first
  foreach my $lpic (@pics) {
    my $dpic = $lpic;
    next if (!getRealFile(\$dpic));
    my $thumb = getThumbFileName($lpic);
    if (aNewerThanb($dpic, $thumb)) {
      $nrToConvert++;			# count the nr of thumbs to generate/refresh
    }
  }
  return 0 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 0 if ($rc ne 'OK');
  }
  my $prefix = thumbnail_prefix(\%config);
  # generate thumbs
  my $generated_thumbs = 0;
  foreach my $lpic (@pics) {
    my $dpic = $lpic;
    next if (!getRealFile(\$dpic));
    my $pic   = basename($dpic);
    my $thumb = getThumbFileName($lpic);
    next if (!aNewerThanb($dpic, $thumb));
    if (-z $dpic) {	# file is empty (size zero)
      log_it("Generating thumbnails: $pic is an empty file. Skipping.");
      next;
    }
    removeFile($thumb);
    my $thumbdir = dirname($thumb);
    next if (!makeDir($thumbdir, $ask));
    if (!-w $thumbdir) {
      log_it("Thumb folder $thumbdir is not writeable, so mapivi is not able to generate thumbnails");
      next;
    }
    # try to get the embedded thumbnail when option is selected and for all RAW pictures
    if ($config{UseEXIFThumb} or is_raw_file($dpic)) {
      my $errors = '';
      extractThumb($dpic, $thumb, \$errors);
      # resize/process according thumbnail options
      if (-f $thumb) {
        # especially for RAW files we need both "JPEG:" statements so we can't use thumbnail_postfix here
        my $com = "$prefix JPEG:\"$thumb\" JPEG:\"$thumb\" ";
        execute($com);
      }
    }
    # 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);
      next; # thumbnail finished, do next pic in loop
    }
    my $string = thumbnail_postfix($prefix, $dpic, $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, $lpic, $show]);
      #$hiresstart = [gettimeofday];  # hires - measure the loading time
      $fh->exec($string);
      proccount(1);				# count processes
      $nrofprocs = proccount();
      if ($nrofprocs >= $config{MaxProcs}) {
        # waiting for current process to finish
        $fh->wait();
      }
    }
    else { # we run on a evil OS like windows - no threading :(
      proccount(1);				# count processes
      (system "$string") == 0 or warn "$string failed: $!";
      updateOneThumb($thumb, $lpic, $show);
    }
    $generated_thumbs++;
  }
  return $generated_thumbs;
}

##############################################################
# generateOneThumb
##############################################################
sub generateOneThumb {
  my $dpic   = shift;
  my $thumb  = getThumbFileName($dpic);
  my $prefix = thumbnail_prefix(\%config);
  my $string = thumbnail_postfix($prefix, $dpic, $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";
  return if (!-d $dir);
  # clean thumb and exif dir
  foreach my $subdir ($thumbdir, $exifdir) {
    if (-d $subdir) {
      my @subpics = getPics($subdir, JUST_FILE, NO_CHECK_JPEG); # no sort needed
      foreach my $pic (@subpics) {
        if (!-f "$dir/$pic") {
          removeFile("$subdir/$pic");
        }
      }
    }
  }
}

##############################################################
# thumbnail_prefix - build up the command string for the
#                     generation of thumbnails depending on
#                     the settings in the given config hash
##############################################################
sub thumbnail_prefix {
  my $conf = shift;
  my $pre  = '';
  $pre = " montage -thumbnail \"$conf->{'ThumbSize'}x$conf->{'ThumbSize'}>+$conf->{'ThumbBorder'}+$conf->{'ThumbBorder'}\" -quality $conf->{'ThumbQuality'} -background \"$conf->{'ColorThumbBG'}\" ";
  #$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;
}

##############################################################
# build the second part of the image magick command line
# this is only separated from the first part (thumbnail_prefix)
# due to performance reasons (prefix is generic and has to be
# called just once, while postfix is specific for each file)
##############################################################
sub thumbnail_postfix {
  my ($prefix, $dpic, $thumb) = @_;
  # thumbnail is always in JPEG format, but the suffix of the picture is not changed
  my $string = "$prefix \"$dpic\"";
  # for avi videos or animated GIFs we generate just one thumbnail from the first frame
  $string .= "[0]" if (($dpic =~ /.*\.avi$/i) or ($dpic =~ /.*\.gif$/i)); 
  $string .= " JPEG:\"$thumb\" ";
  return $string;
}

##############################################################
# 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(lang('Picture collection'));
  $ltw->iconimage($mapiviicon) if $mapiviicon;
  $ltw->bind('<Key-Escape>', sub {light_table_close();});
  $ltw->bind('<Key-q>',      sub {light_table_close();});
  $ltw->bind('<Control-a>',  sub {light_table_select_all();});
  $ltw->bind('<Key-F11>',    sub {fullscreen($ltw);});
  # call quitMain when the window is closed by the window manager
  $ltw->protocol("WM_DELETE_WINDOW" => sub { light_table_close(); });
  if ($EvilOS) {
    $ltw->DropSite
      (-dropcommand => [\&light_table_dragAndDropExtern, $ltw],
       -droptypes => 'Win32'
      );
  }
  # bool flag: if true we ask the user for confirmation before closing
  $ltw->{unsafed_changes} = 0;
  # status bars
  my $collection_frame = $ltw->Frame()->pack(-anchor => 'w', -fill => 'x', -expand => 0, -pady => 1);
  $collection_frame->Label(-text => lang('Collection').':')->pack(-side => 'left', -padx => 2, -pady => 2);
  $collection_frame->Label(-textvariable => \$ltw->{folder})->pack(-side => 'left', -padx => 2, -pady => 2);
  $collection_frame->Label(-textvariable => \$ltw->{collection})->pack(-side => 'left', -padx => 2, -pady => 2);
  $collection_frame->Label(-text => ', '.lang('File').':')->pack(-side => 'left', -padx => 2, -pady => 2);
  $collection_frame->Label(-textvariable => \$ltw->{file})->pack(-side => 'left', -padx => 2, -pady => 2);
  $collection_frame->Label(-text => ', '.lang('Unsaved').':')->pack(-side => 'left', -padx => 2, -pady => 2);
  $collection_frame->Label(-textvariable => \$ltw->{unsafed_changes})->pack(-side => 'left', -padx => 2, -pady => 2);
  my $status_frame = $ltw->Frame()->pack(-anchor => 'w', -fill => 'x', -expand => 0, -pady => 1);
  $status_frame->Label(-textvariable => \$ltw->{label})->pack(-side => 'left', -padx => 2, -pady => 2);
  # main canvas
  $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 => 2, -pady => 2);
  $ltw->{canvas} = $ltw->{frame}->Subwidget('canvas');
  # add menu  
  $ltw->{menu} = $ltw->Menu;
  $ltw->configure(-menu => $ltw->{menu});
  my $file_menu = $ltw->{menu}->cascade(-label => lang('Slideshow'));
  $file_menu->cget(-menu)->configure(-title => lang('Slideshow menu'));

  $file_menu->command(-label => lang('Open ...'), -command  => sub { collection_open(RESET); });
  $file_menu->separator;
  $file_menu->command(-label => lang('Show slideshow'), -command  => sub { show_multiple_pics($ltw->{canvas}->{thumb_list}, 0); });
  $file_menu->command(-label => lang('Show slideshow, start from selected picture'), -command  => sub {
    my @sel = $ltw->{canvas}->find('withtag', 'THUMBSELECT_MH');
    return unless checkSelection($ltw, 1, 0, \@sel, lang("picture(s)"));
    my $dpic  = get_path_from_id($ltw->{canvas},$sel[0]);
    my $index = index_in_list($dpic, $ltw->{canvas}->{thumb_list});
    show_multiple_pics($ltw->{canvas}->{thumb_list}, $index); });
  
  $file_menu->command(-label => lang('Show selected pictures'), -command  => sub { light_table_show_sel_pics($ltw, $ltw->{canvas}->{thumb_list}); });
  $file_menu->command(-label => lang('Open selected pictures in external viewer'), -command  => sub { openPicInViewer($ltw->{canvas}); }, -accelerator => '<v>');
  $file_menu->separator;
  $file_menu->command(-label => lang('Save'), -command  => sub {
      if ((defined $ltw->{folder} and $ltw->{folder} ne '') and (defined $ltw->{collection} and $ltw->{collection} ne '')) {
          light_table_save();
      }
      else {
        light_table_save_as();
      }
  });
  $file_menu->command(-label => lang('Save as ...'), -command  => sub { light_table_save_as(); });
  $file_menu->separator;
  $file_menu->command(-label => lang('Import from file ...'), -command  => sub { light_table_open(RESET); });
  $file_menu->command(-label => lang('Add from file ...'), -command  => sub { light_table_open(ADD); });
  $file_menu->command(-label => lang('Export to file'), -command  => sub {
      if ((defined $ltw->{file}) and (-f $ltw->{file})) {
          light_table_save_to_file($ltw->{file});
      }
      else {
        light_table_save_to_file_as();
      }
  });
  $file_menu->command(-label => lang('Export to file as ...'), -command  => sub { light_table_save_to_file_as(); });
  $file_menu->separator;
  $file_menu->command(-label => lang('Clear'), -command  => sub { undef @{$ltw->{canvas}->{thumb_list}}; light_table_clear(); light_table_reset_collection();});
  $file_menu->command(-label => lang('Update'), -command  => sub { light_table_reorder($ltw->{canvas}, $ltw->{canvas}->{thumb_list}); light_table_update_selection();});
  $file_menu->command(-label => lang('Reload thumbnails'), -command  => sub { light_table_reload(); });
  $file_menu->separator;
  $file_menu->command(-label => lang('Close'), -command  => sub { light_table_close(); });
  my $sort_menu = $ltw->{menu}->cascade(-label => lang('Sort'));
  $sort_menu->command(-label => lang('File name (A - Z)'),
                      -command  => sub {
                          $ltw->Busy;
                          sortPics('name', 0, $ltw->{canvas}->{thumb_list});	
                          $ltw->{unsafed_changes} = 1; # set dirty bit
                          $ltw->Unbusy;
                          light_table_reorder($ltw->{canvas}, $ltw->{canvas}->{thumb_list});
                          light_table_update_selection();
                      });
  $sort_menu->command(-label => lang('File name (Z - A)'),
                      -command  => sub {
                          $ltw->Busy;
                          sortPics('name', 1, $ltw->{canvas}->{thumb_list});	
                          $ltw->{unsafed_changes} = 1; # set dirty bit
                          $ltw->Unbusy;
                          light_table_reorder($ltw->{canvas}, $ltw->{canvas}->{thumb_list});
                          light_table_update_selection();
                      });
  $sort_menu->separator;
  $sort_menu->command(-label => lang('Date (new first)'),
                      -command  => sub {
                          $ltw->Busy;
                          sortPics('exifdate', 0, $ltw->{canvas}->{thumb_list});	
                          $ltw->{unsafed_changes} = 1; # set dirty bit
                          $ltw->Unbusy;
                          light_table_reorder($ltw->{canvas}, $ltw->{canvas}->{thumb_list});
                          light_table_update_selection();
                      });
  $sort_menu->command(-label => lang('Date (old first)'),
                      -command  => sub {
                          $ltw->Busy;
                          sortPics('exifdate', 1, $ltw->{canvas}->{thumb_list});	
                          $ltw->{unsafed_changes} = 1; # set dirty bit
                          $ltw->Unbusy;
                          light_table_reorder($ltw->{canvas}, $ltw->{canvas}->{thumb_list});
                          light_table_update_selection();
                      });
  $sort_menu->separator;
  $sort_menu->command(-label => lang('Rating (high first)'),
                      -command  => sub {
                          $ltw->Busy;
                          sortPics('urgency', 0, $ltw->{canvas}->{thumb_list});	
                          $ltw->{unsafed_changes} = 1; # set dirty bit
                          $ltw->Unbusy;
                          light_table_reorder($ltw->{canvas}, $ltw->{canvas}->{thumb_list});
                          light_table_update_selection();
                      });
  $sort_menu->command(-label => lang('Rating (low first)'),
                      -command  => sub {
                          $ltw->Busy;
                          sortPics('urgency', 1, $ltw->{canvas}->{thumb_list});	
                          $ltw->{unsafed_changes} = 1; # set dirty bit
                          $ltw->Unbusy;
                          light_table_reorder($ltw->{canvas}, $ltw->{canvas}->{thumb_list});
                          light_table_update_selection();
                      });
  my $opt_menu = $ltw->{menu}->cascade(-label => lang("Options"));
  $ltw->{show_balloon} = 1; # todo: move to config hash
  $ltw->{show_status}  = 1; # todo: move to config hash
  $opt_menu->checkbutton(-label => lang("Show picture info"), -variable => \$ltw->{show_balloon}, -command => sub { light_table_balloon();});

  # window resize event
  $ltw->bind("<Configure>" => sub {
    # get canvas size
    my $cw = $ltw->{canvas}->width;
    my $ch = $ltw->{canvas}->height;
    # compare with last size
    if (defined $ltw->{LAST_CANVAS_WIDTH} and defined $ltw->{LAST_CANVAS_HEIGHT}) {
      # if the canvas size didn't change we need no reorder
      return if (($cw == $ltw->{LAST_CANVAS_WIDTH}) and ($ch == $ltw->{LAST_CANVAS_HEIGHT}));
    }
    # store new size
    $ltw->{LAST_CANVAS_WIDTH} = $cw;
    $ltw->{LAST_CANVAS_HEIGHT} = $ch;
    # 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($ltw->{canvas}, $ltw->{canvas}->{thumb_list});
                                     light_table_update_selection();
                                 });
  });
  my $context_menu = $ltw->Menu(-title => lang("Context Menu"));
  $ltw->bind('<ButtonPress-3>', sub {
                 $context_menu->Popup(-popover => "cursor", -popanchor => "nw");
               } );
  $ltw->bind('<Key-Delete>', sub { light_table_delete(); });
  $ltw->bind('<Key-d>', sub { light_table_show_sel_pics($ltw, $ltw->{canvas}->{thumb_list}); });
  $ltw->bind('<Key-v>', sub { openPicInViewer($ltw->{canvas}); });
  $context_menu->command(-image => compound_menu($top, lang('move selected to top'), 'go-first.png'), -command => sub { light_table_shift('top'); });
  $context_menu->command(-image => compound_menu($top, lang('move selected to bottom'), 'go-last.png'), -command => sub { light_table_shift('bottom'); });
  $context_menu->command(-label => lang('remove selected from collection'),
                         -accelerator => "<Delete>",
                         -command => sub { light_table_delete(); });

  $context_menu->separator; # ----------------------- #
  $context_menu->command(-label => lang('Select all'), -command => sub { light_table_select_all(); }, -accelerator => '<Ctrl-a>');
  $context_menu->command(-label => lang('Select to end'), -command => sub { light_table_select_to_end(); });
  
  $context_menu->separator; # ----------------------- #
  addFileActionsMenu($context_menu, $ltw->{canvas});
  $context_menu->command(-label => lang('copy and rename selected'),
                         -command => sub { light_table_copy_rename(); });
  $context_menu->command(-image => compound_menu($top, lang('Copy to print ...'), 'printer.png'), -command => sub { copyToPrint($ltw->{canvas}); });
  
  $context_menu->separator; # ----------------------- #
  $context_menu->command(-image => compound_menu($top, lang('Crop (lossless) ...'), 'edit-cut.png'), -command => sub { crop($ltw->{canvas}); }, -accelerator => "<Ctrl-c>");
  $context_menu->command(-label => lang('Collage/index print ...'),
                         -command => sub { my @pics = selection_get_sort($ltw->{canvas}, $ltw->{canvas}->{thumb_list}); indexPrint(\@pics); });
                         
  $context_menu->separator; # ----------------------- #
  $context_menu->command(-image => compound_menu($top, lang('Open pictures in new window'), 'image-x-generic.png'),
                         -command => sub { light_table_show_sel_pics($ltw, $ltw->{canvas}->{thumb_list});}, -accelerator => '<d>');
  $context_menu->command(-image => compound_menu($top, lang('Open pictures in external viewer'), 'image-x-generic.png'),
                         -command => sub { openPicInViewer($ltw->{canvas}); });
  $ltw->{canvas}->{thumb_distance} = 5;   # store values also in canvas
  $ltw->{canvas}->{thumb_size}     = 108; # for light_table_reorder
  $ltw->Popup;
  checkGeometry(\$config{LtwGeometry});
  $ltw->geometry($config{LtwGeometry});
}

##############################################################
##############################################################
sub collection_open {
  my @collections;
  foreach my $folder (keys %slideshows) {
    # safety check: neither $folder nor $collection must contain string " - "
    # as this is used as delimiter
    warn "folder \"$folder\" contains delimiter string!" if ($folder =~ m/.* - .*/);
    foreach my $collection (keys %{$slideshows{$folder}}) {
      warn "collection \"$collection\" contains delimiter string!" if ($folder =~ m/.* - .*/);
      push @collections, "$folder - $collection";
    }
  }
  @collections = sort @collections;
  my $title = 'Open collection';
  my $text = 'Please select collection to open';
  my @sellist;
  return 0 unless (mySelListBoxDialog($title, $text, SINGLE, 'OK', \@sellist, @collections));
  if ($sellist[0]) {
    my $fold_col = $collections[$sellist[0]] ;
    my @tmp = split / - /, $fold_col;         
    my $folder = $tmp[0];
    my $collection = $tmp[1];
    if (exists $slideshows{$folder}{$collection}) {
      my $pics = $slideshows{$folder}{$collection}{pics};
      #my $file = $slideshows{$folder}{$collection}{file};
      light_table_edit($pics, $folder, $collection);
      log_it("Open collection: $folder $collection");
    } else {
      log_it("Error in open collection: $folder $collection does not exists!");
    }
  }
}

##############################################################
##############################################################
sub light_table_show_sel_pics {
  my $widget = shift;
  my $picture_list_ref = shift;
  my @pics = selection_get_sort($widget->{canvas}, $picture_list_ref);
  return unless checkSelection($widget, 1, 0, \@pics, lang("picture(s)"));
  show_multiple_pics(\@pics, 0);
}

##############################################################
# light_table_open
##############################################################
sub light_table_open {
  my $mode = shift; # must be ADD or RESET
  my $filei = shift; # optional slideshow file
  my ($ok, $errors, $info, $doubles_count, $doubles, $file) = light_table_open_int($mode, $filei);
  my $text = '';
  $text .= "These $doubles_count pictures are already in the slideshow and have been skipped:\n$doubles\n\n" if ($doubles_count > 0);
  $text .= "Errors while reading $file:\n$errors" if ($errors ne '');
  $text .= "\nInformation while reading $file:\n$info" if ($info ne '');
  showText("Information and Errors", $text, NO_WAIT);
  if ($ok and $mode == RESET) {
    $ltw->title(lang('Collection').': '.basename($file));
    $ltw->{file} = $file;
  }
}

##############################################################
# light_table_reopen - same as light_table_open, but shows only
# errors and does not change the slideshow file name
##############################################################
sub light_table_reopen {
  my $mode = shift; # must be ADD or RESET
  my $filei = shift; # optional slideshow file
  my ($ok, $errors, $info, $doubles_count, $doubles, $file) = light_table_open_int($mode, $filei);
  if ($$errors ne '') {
    my $text = '';
    $text .= "These $doubles_count pictures are already in the slideshow and have been skipped:\n$doubles\n\n" if ($doubles_count > 0);
    $text .= "Errors while reading $file:\n$$errors" if ($$errors ne '');
    $text .= "\nInformation while reading $file:\n$$info" if ($$info ne '');
    showText("Information and Errors", $text, NO_WAIT);
  }
}

##############################################################
# light_table_open_int
##############################################################
sub light_table_open_int {
  my $mode = shift; # must be ADD or RESET
  my $file = shift; # optional slideshow file
  my $doubles = '';
  my $doubles_count = 0;
  my $text = 'Open';
  $text = 'Add to' if ($mode == ADD);
  # open file requester only when needed
  if (!defined $file or !-f $file) {
    my $types = [ ['gqview slideshow', '.gqv',], ['XnView slideshow', '.sld',], ['All Files', '*',], ];
    $file = $ltw->getOpenFile(-title => "$text slideshow", -defaultextension => 'gqv', -initialdir => $config{SlideShowDir}, -filetypes => $types);
  }
  return (0, 'No valid file', '', $doubles_count, $doubles, $file) if ((!defined $file) or ($file eq '') or (!-f $file));
  unless (-T $file) {
    $ltw->messageBox(-icon => 'warning',
    -message => 'Please select a valid slideshow (ASCII) file.',
    -title => 'Wrong file type',
    -type => 'OK');
    return (0, 'Wrong file type', '', $doubles_count, $doubles, $file);
  }
  $config{SlideShowDir} = dirname($file) if (-d dirname($file));

  my ($ok, $errors, $info, $pics) = read_slideshow_from_file($file);

  if ($mode == RESET) {
    # reset list and clean up canvas
    undef @{$ltw->{canvas}->{thumb_list}};
    light_table_clear();
  }
  my @pics_valid;
  foreach my $dpic (@$pics) {
    if (isInList($dpic, $ltw->{canvas}->{thumb_list})) {
      $doubles .= "$dpic\n";
      $doubles_count++;
    }
    else {
      push @pics_valid, $dpic;
    }
  }
  # add pics to end of thumb list
  push @{$ltw->{canvas}->{thumb_list}}, @pics_valid;
  # add new pictures to collection (light table)
  light_table_add_list(\@pics_valid);
  $ltw->{label} = scalar(@{$ltw->{canvas}->{thumb_list}}).' '.lang('pictures');
  return (1, $errors, $info, $doubles_count, $doubles, $file);
}

##############################################################
##############################################################
sub read_slideshow_from_file {
  my $file = shift;
  my $fh;
  my @pics;
  my $info = '';
  my $error = '';
  if (!open($fh, '<', $file)) {
    warn "read_slideshow_from_file: Couldn't open $file: $!";
    return (0, "Couldn't open $file: $!", $info, \@pics);
  }
  my $pic_number = 0;
  my $not_found = 0;
  my $double = 0;
  while (<$fh>) {
    chomp; # no newline
    if ($_ =~ m|\"(.*)\"|) { # match just quoted lines 
      $pic_number++;
      my $dpic;
      # $dpic may also have a relative path!
      $dpic = File::Spec->rel2abs($1, dirname($file));
      # replace Windows path delimiter with UNIX style \ -> /
      $dpic =~ s!\\!\/!g;
      if (-f $dpic) {
        if (isInList($dpic, \@pics)) {
		  $double++;
		  $info .= "info: $dpic is already in list\n";
		}
		else {
          push @pics, $dpic;
        }
      }
      else {
        $not_found++;
        $error .= "error: $dpic not found! (number: $pic_number)\n";
      }
    }
    else { $info .= "info: ignoring line \"$_\"\n"; }
  }
  $info .= basename($file)." references $pic_number pictures, ";
  $info .= "$not_found could not be found, " if ($not_found);
  $info .= "$double were already in list, " if ($double);
  $info .= "using ".scalar(@pics)." pictures.\n";
  close $fh;
  return (1, $error, $info, \@pics);
}

##############################################################
# light_table_reload - save slideshow to temp file and open it again
# can be used to reload updated thumbnails
##############################################################
sub light_table_reload {
  my $datetime = getDateTimeShortString(time());
  my $file =  "$trashdir/slideshow-$datetime.gqv";
  if (light_table_save_to_file_int($file)) {
    # todo: $ltw->{file} is set to $file, so the original slideshow file name is lost!!!
    light_table_reopen(RESET, $file);
  }
}

##############################################################
# light_table_save_to_file_as
##############################################################
sub light_table_save_to_file_as {
    my $types = [ ['gqview slideshow', '.gqv',], ['Slideshow file', '.sld',], ['All Files', '*',], ];
    my $file = $ltw->getSaveFile(-title => "Save slideshow as, use .gqv (gqview) or .sld (XnView) suffix", -defaultextension => 'gqv', -initialfile => "slideshow.gqv", -initialdir => $config{SlideShowDir}, -filetypes => $types);
    return 0 if ((!defined $file) or ($file eq ''));
    $config{SlideShowDir} = dirname($file) if (-d dirname($file));
    my ($basename,$dir,$suffix) = fileparse($file, '\.[^.]*'); # suffix = . and not-.  (one dot and zero or more non-dots)
    my $ok = 0;
    if ($suffix eq '.sld') {
      $ok = set_sld_options();
    }
    elsif ($suffix eq '.gqv') {
      $ok = set_gqv_options();
    }
    else {
      $ltw->messageBox(-icon => 'error', -message => "Sorry, but the slideshow suffix $suffix is not supported.",
                     -title => "Wrong file suffix", -type => 'OK');
    }
    return 0 if (not $ok);
    light_table_save_to_file($file);
    return 1;
}

##############################################################
# set some options for XnView slideshow (suffix: .sld)
##############################################################
sub set_sld_options {
  my $ok = 0;
  # open window
  my $win = $ltw->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 => lang('OK'),
                         -command => sub {
                             $ok = 1;
                             $win->withdraw();
                             $win->destroy();
                         })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 2, -pady => 3);
  my $xBut = $but_frame->Button(-text => lang('Cancel'),
                         -command => sub {
                             $ok = 0;
                             $win->withdraw();
                             $win->destroy();
                         })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 2, -pady => 3);
  bind_exit_keys_to_button($win, $xBut);
  $win->Popup(-popover => 'cursor');
  repositionWindow($win);
  $win->waitWindow;
  return $ok;
}

##############################################################
# set some options for gqview slideshow (suffix: .gqv)
##############################################################
sub set_gqv_options {
    $config{relative_path} = 0; # gqview only supports absolut paths
    return 1;
}

##############################################################
# light_table_save - save slideshow to slideshows hash
##############################################################
sub light_table_save {
  # save slideshow to %slideshows hash
  #use Data::Dumper;  # and then in the code e.g. print Dumper(\%conf);
  #print "--------- before ----------\n";
  #print Dumper(%slideshows);
  # we need a local copy
  my @pics = @{$ltw->{canvas}->{thumb_list}};
  $slideshows{$ltw->{folder}}{$ltw->{collection}}{pics} = \@pics;
  #print "--------- after ----------\n";
  #print Dumper(%slideshows);
  # and save slideshow hash to file
  save_slideshows();
  log_it("wrote collection: $ltw->{folder}: $ltw->{collection}");
  $ltw->{label} = lang("wrote collection: ").$ltw->{folder}.' '.$ltw->{collection};
  $ltw->title(lang('Collection').': '.$ltw->{folder}.' '.$ltw->{collection});
  $ltw->{unsafed_changes} = 0; # reset dirty bit
}

##############################################################
# light_table_save_as - get folder and collection name
##############################################################
sub light_table_save_as {
  # todo:improve folder/collection selection by providing one dialog and
  # displaying all available collections
  # check if user selected folder and or collection in tree of main window
  my ($ok, $folder, $collection) = get_selected_collection($nav_F->{collection_frame}->{tree}, 0);
  if ($ok == 0) { # no selection
    $folder = 'folder';
    $collection = 'collection';
  }
  if ($ok == 1) { # only folder selection
    $collection = 'collection';
  } # hint: $ok == 2 means folder and collection are selected
  
  my $rc = myEntryDialog(lang('Save collection'), lang('Please enter folder name'), \$folder);
  return if (($rc ne 'OK') or ($folder eq ''));
  $rc = myEntryDialog(lang('Save collection'), langf("Please enter collection name in folder %s",$folder), \$collection);
  return if (($rc ne 'OK') or ($collection eq ''));
  if (exists $slideshows{$folder}{$collection}) {
    my $rc = $ltw->messageBox(-icon => 'question', -message => langf("Collection %s %s exists. Overwrite this collection?", $folder, $collection), -title => lang('Overwrite collection?'), -type => 'OKCancel');
    return if ($rc !~ m/Ok/i);
  }
  $ltw->{folder} = $folder;
  $ltw->{collection} = $collection;
  light_table_save();
}

##############################################################
# light_table_save_to_file
##############################################################
sub light_table_save_to_file {
  my $file = shift;
  if (light_table_save_to_file_int($file)) {
    log_it("wrote collection: $file");
    $ltw->{label} = lang("wrote collection: ").basename($file);
    $ltw->title(lang('Collection').': '.basename($file));
    $ltw->{file} = $file;
    print "collection saved to file, but not to hash!\n";
  }
  else {
    log_it("Error writing collection: $file");
    $ltw->{label} = "Error writing collection: ".basename($file);
  }
}

##############################################################
# light_table_save_to_file_int
##############################################################
sub light_table_save_to_file_int {
  my $file = shift;
  print "writing slideshow to $file\n" if $verbose;
  my $fh;
  my ($basename,$dir,$suffix) = fileparse($file, '\.[^.]*'); # suffix = . and not-.  (one dot and zero or more non-dots)
  my $header;
  if ($suffix eq '.sld') {
    $header = '# Slide Show Sequence
View = 1
CenterWindow = 0
ReadErrors = 1
BackgroundColor = 0';
  }
  elsif ($suffix eq '.gqv') {
    $header = "#GQView collection\n#Created with Mapivi version $version\n";
  }
  if (!open($fh, '>', $file)) {
    $ltw->messageBox(-icon => 'error', -message => "Error writing slideshow file:\ncould not open $file for write access!: $!",
                     -title => "Error writing file", -type => 'OK');
    print "could not open $file for write access!: $!\n" if $verbose;
    return 0;
  }
  print $fh "$header\n";
  if ($suffix eq '.sld') {
    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 (@{$ltw->{canvas}->{thumb_list}}) {
    my $rel = $dpic;
    if ($config{relative_path}) {
      $rel = File::Spec->abs2rel($dpic, dirname($file));
    }
    print $fh "\"$rel\"\n";
    print "\"$rel\"\n" if $verbose;
  }
  if ($suffix eq '.gqv') {
    print $fh "#end\n";
  }
  close $fh;
  $ltw->{unsafed_changes} = 0; # reset dirty bit
  return 1;
}

##############################################################
# light_table_close
##############################################################
sub light_table_close {
  my $ask = shift;
  if ($ltw->{unsafed_changes}) {
      my $rc = $ltw->messageBox(-icon => 'question',
                                -message => lang("Collection will not be saved automatically.\nAll changes will be lost.\nReally close collection?"),
                                -title => lang("Close collection?"), -type => 'YesNo');
      return 0 unless ($rc =~ m/Yes/i);
  }
  undef @{$ltw->{canvas}->{thumb_list}};
  light_table_clear();
  $config{LtwGeometry} = $ltw->geometry;
  $ltw->destroy();
  return 1;
}

##############################################################
# light_table_clear
##############################################################
sub light_table_clear {
  $ltw->{canvas}->delete('all');
  # delete all photo objects (thumbnnails)
  foreach my $dpic (keys %{$ltw->{canvas}->{thumbs}}) {
    # delete defined photo object
    delete_photo_object($ltw->{canvas}->{thumbs}->{$dpic});
    # delete hash entry
    delete $ltw->{canvas}->{thumbs}->{$dpic};
  }
  $ltw->{label} = scalar @{$ltw->{canvas}->{thumb_list}}.' '.lang('pictures');
  $ltw->title(lang('Picture collection'));
  $ltw->{unsafed_changes} = 0; # reset dirty bit
}

##############################################################
# light_table_reset_collection
##############################################################
sub light_table_reset_collection {
  $ltw->{folder} = '';
  $ltw->{collection} = '';
}

##############################################################
# light_table_add_from_lb
##############################################################
sub light_table_add_from_lb {
  my $lb = shift;
  my @sellist = getSelection($lb);
  light_table_add(\@sellist);
}

##############################################################
# light_table_add
##############################################################
sub light_table_add {
  my $list_ref = shift;
  return unless checkSelection($top, 1, 0, $list_ref, lang("picture(s)"));
  # 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, $ltw->{canvas}->{thumb_list})) {
          $error .= "$dpic\n";
          $error_count++;
      }
      else {
          push @list, $dpic;
          log_it(lang("added to collection: ").$dpic);
          $ltw->{unsafed_changes} = 1; # set dirty bit
      }
  }
  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 @{$ltw->{canvas}->{thumb_list}}, @list;
  # add selected pictures to light table
  light_table_add_list(\@list);
}

##############################################################
# light_table_edit
##############################################################
sub light_table_edit {
  my $list_ref = shift;
  my $folder = shift; # optional slideshow folder (not file folder)
  my $collection = shift; # optional slideshow name (not file name)
  if (Exists($ltw)) {
    my $rc = $top->messageBox(-icon => 'question', -message => langf("Close current collection and open %s %s?",$folder, $collection), -title => lang('Close collection?'), -type => 'OKCancel');
    return if ($rc !~ m/Ok/i);
  }
  # open light table window if needed
  light_table_open_window() unless (Exists($ltw));
  undef @{$ltw->{canvas}->{thumb_list}};
  light_table_clear();
  # store folder and collection name
  $ltw->{folder} = $folder if (defined $folder);
  $ltw->{collection} = $collection if (defined $collection);
  $ltw->{unsafed_changes} = 0; # clear dirty bit
  $ltw->{file} = $slideshows{$folder}{$collection}{file} if (defined $slideshows{$folder}{$collection}{file});
  # copy collection pics to slideshow list
  @{$ltw->{canvas}->{thumb_list}} = @$list_ref;
  # add selected pictures to light table
  light_table_add_list($list_ref);
}

##############################################################
# light_table_add_list
##############################################################
sub light_table_add_list {
  my $list_ref = shift; # list of JPEG pics with full path
  return if (@$list_ref < 1); # no pics to add
  # get thumb size info from first thumbnail in list (this may be wrong, as others may be bigger)
  my ($tw, $th) = getSize(getThumbFileName($$list_ref[0]));
  if ($tw > 1) {
    $ltw->{canvas}->{thumb_size} = $tw;
  }
  my $i = 0;
  my $pw = 0;
  $pw = progressWinInit($ltw, "Add pictures to collection")if (@$list_ref > 1);;
  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 $pw;
    if (-f $thumb) {
      # save all thumb photo objects in canvas hash to delete them later
      $ltw->{canvas}->{thumbs}->{$dpic} = $ltw->Photo(-file => $thumb);    }
    else {
      # reminder: when we delete this photo object later, we should not delete the empty thumb object!
      $ltw->{canvas}->{thumbs}->{$dpic} = $mapivi_icons{'EmptyThumb'};
    }
    if ($ltw->{canvas}->{thumbs}->{$dpic}) {
      # create image on canvas
      # all mapivi thumb tags contain _MH!!!
      # this is needed to extract the dpic from the id in get_path_from_id()
      my $id = $ltw->{canvas}->createImage(0, 0,
      -image => $ltw->{canvas}->{thumbs}->{$dpic},
      -tag => ['THUMB_MH', '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 { my @sel = selection_get_sort($ltw->{canvas}, $ltw->{canvas}->{thumb_list}); show_multiple_pics(\@sel, 0); });
    }
  }
  progressWinEnd($pw) if $pw;
  light_table_reorder($ltw->{canvas}, $ltw->{canvas}->{thumb_list});
  light_table_update_selection();
  $ltw->{canvas}->yviewMoveto(1);
  $ltw->{label} = scalar @{$ltw->{canvas}->{thumb_list}}.' pictures';
}

##############################################################
# show_canvas_thumbs
# shows a list of thumbnails in the canvas (tag: THUMB_MH)
# stores photo objects in $c->{thumbs}
##############################################################
sub show_canvas_thumbs {
  return if (not $conf{show_canvas_thumbs}{value});
  my $c = shift; # canvas widget
  my $list_ref = shift; # list of JPEG pics with full path
  return if (@$list_ref < 1); # no pics to add
  # remove all thumbnails from canvas
  clear_canvas_thumbs($c);
  # hide all picture items on the canvas
  canvasHide();
  # clear image info
  showImageInfo();
  # clear canvas info
  #showImageInfoCanvas();
  # get thumb size info from first thumbnail in list (todo: this may be wrong, as others may be bigger)
  my ($tw, $th) = getSize(getThumbFileName($$list_ref[0]));
  if ($tw > 1) {
    $c->{thumb_size} = $tw;
  }
  my $i = 0;
  my $pw = progressWinInit($c, "Add pictures to canvas");
  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 canvas hash to delete them later
      $c->{thumbs}->{$dpic} = $c->Photo(-file => $thumb);
    }
    else {
      $c->{thumbs}->{$dpic} = $mapivi_icons{'EmptyThumb'};
    }
    add_canvas_thumb($c, $dpic, 0, 0);
  }
  light_table_reorder($c, $list_ref);
  add_canvas_ratings($c); # has to be called after light_table_reorder()!
  canvas_update_selection($c);
  progressWinEnd($pw);
  $c->yviewMoveto(0);
}

##############################################################
# Hint: has to be called after light_table_reorder()!
##############################################################
sub add_canvas_ratings {
  my $c = shift; # canvas
  my @ids = $c->find('withtag', 'THUMB_MH');
  foreach my $id (@ids) {
    my $dpic = get_path_from_id($c, $id);
    my $stars = iptc_rating_stars_nr($searchDB{$dpic}{URG});
    if ($stars) {
      my $size = 7; my $offset = $size+1;
      my ($x, $y, $x1, $y1) = $c->coords($id);
      # add rating as circles
      for (1 .. $stars) {
        $c->createOval( $x+1, $y+1, $x+$size, $y+$size,
            -tags => ['STAR', 'STAR'.$dpic],
            -outline => 'sienna1',
            -fill => 'sienna2',
            -width => 2,
         );
         $x += $offset;
      }
    }
  }
}  

##############################################################
# add one thumbnail to the canvas
##############################################################
sub add_canvas_thumb {
  my ($c, $dpic, $x, $y) = @_;
  if ($c->{thumbs}->{$dpic}) {
    my $id = $c->createImage($x, $y,
    -image => $c->{thumbs}->{$dpic},
    # we add THUMB_MH to the file name to avoid problems with other
    # picture items on the canvas, see also checkCachedPics() 
    -tag => ['THUMB_MH', 'THUMB_MH'.$dpic],
    -anchor => 'nw');
    
    # add bindings
    $c->bind($id,'<Double-ButtonPress-1>',
      sub { #clear_canvas_thumbs($c); # is already called within showPic()!
            showPic($dpic);});
    $c->bind($id,'<ButtonPress-1>',
      sub { $picLB->selectionClear();
            $picLB->selectionSet($dpic);
            $picLB->anchorSet($dpic);
            $picLB->see($dpic);
            canvas_update_selection($c);
            showNrOf();
            log_it(lang('Double click to display').' '.basename($dpic));});
    $c->bind($id,'<Control-ButtonPress-1>',
      sub { if ($picLB->selectionIncludes($dpic)) {
              $picLB->selectionClear($dpic);
            } else {
              $picLB->selectionSet($dpic);
            }
            $picLB->anchorSet($dpic);
            $picLB->see($dpic);
            canvas_update_selection($c);
            showNrOf(); });
    $c->bind($id,'<Shift-ButtonPress-1>',
      sub { my $anchor = $picLB->info('anchor');
            if ((defined $anchor) and ($anchor ne '')) {
              $picLB->selectionSet($anchor, $dpic);
              $picLB->see($dpic);
              canvas_update_selection($c);
              showNrOf();
            }});
  }
  else {
    warn "add_canvas_thumb: Found no thumbnail for $dpic!";
  }
}

##############################################################
# clear_canvas_thumbs
# remove all canvas items with tag 'THUMB_MH' and free
# the canvas local photo objects stored in $c->{thumbs}
##############################################################
sub clear_canvas_thumbs {
  return if (not $conf{show_canvas_thumbs}{value});
  my $c = shift; # canvas widget
  my @ids = $c->find('withtag', 'THUMB_MH');
  foreach my $id (@ids) {
    $c->delete('withtag', $id);
  }
  $c->delete('withtag', 'MARK');
  $c->delete('withtag', 'STAR');
  my @thumb_objects = keys %{$c->{thumbs}};
  foreach my $dpic (@thumb_objects) {
    # delete photo object
    delete_photo_object($c->{thumbs}->{$dpic});
    # delete hash entry
    delete $c->{thumbs}->{$dpic};			
  }
  if (scalar(@ids) != scalar(@thumb_objects)) {
    warn "clear_canvas_thumbs: Warning: ".scalar(@ids)." canvas thumbs and ".scalar(@thumb_objects)." photo objects are not equal";
  }
  canvas_update_selection($c);
}

##############################################################
# canvas_update_selection - draw a mark on each selected
#                           thumbnail
##############################################################
sub canvas_update_selection {
  my $c = shift; # canvas widget
  # first we remove all selection markers
  $c->delete('withtag', 'MARK');
  # find all selected thumbs from picLB
  my @sel = getSelection($picLB);
  return if (not @sel);
  # draw a mark on all selected pictures
  foreach my $dpic (@sel) {
    my ($x, $y) = $c->coords('THUMB_MH'.$dpic);
    if (defined $x) {
      $c->createRectangle( $x, $y, $x+$c->{thumb_size}, $y+$c->{thumb_size},
            -tags => ['MARK'],
            #-fill => 'yellow2'
            -outline => 'yellow2',
            -width => 2
            );
    }
  }
}

##############################################################
# 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 ($current) = $ltw->{canvas}->find('withtag', 'current');
      my $dpic = get_path_from_id($ltw->{canvas},$current);
      $msg = makeBalloonMsg($dpic);
    },
    -balloonposition => 'mouse',
    -msg => \$msg);
  }
  else {
    $balloon->detach($ltw->{canvas});
  }
}

##############################################################
# light_table_reorder
##############################################################
sub light_table_reorder {
  my $c = shift; # canvas widget
  my $pic_list = shift; # list reference, thumbnails will be sorted using this list
  return if (not defined $pic_list);
  return if (scalar(@$pic_list) <= 1);
  $c->update;
  #$c->Busy; # resizing the window does not work under windows if Busy is used
  my $dis    = $c->{thumb_size} + $c->{thumb_distance};
  # get canvas size
  my $cx     = $c->width;
  my $cy     = $c->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(@$pic_list / $c_cols);
  $all_rows++ if ((@$pic_list % $c_cols) != 0);
  # adjust scrollbar
  $c->configure(-scrollregion => [0, 0, $c_cols*$dis + $c->{thumb_distance}, $all_rows*$dis + $c->{thumb_distance}]);
  my $index = 0;
  foreach my $dpic (@$pic_list) {
    my ($id) = $c->find('withtag', 'THUMB_MH'.$dpic);
    if (not defined $id) {
      warn "light_table_reorder: Found no item for $dpic (index:$index)!";
    }
    my $row = int ($index / $c_cols);
    my $col = $index % $c_cols;       # modulo
    # we move the thumbs by tag which is the THUMB_MH+path+file name
    # this excludes the possibility to have a pic twice in the list :-(
    $c->coords('THUMB_MH'.$dpic, $col*$dis+$c->{thumb_distance}, $row*$dis+$c->{thumb_distance});
    $index++;
  }
}

##############################################################
# get_path_from_id
# assumes that the item has a tag "THUMB_MH/path/to/file"
# and returns /path/to/file or empty string
##############################################################
sub get_path_from_id {
  my $c = shift; # canvas
  my $id = shift; # id of canvas item
  my @tags = $c->gettags($id);
  my $dpic = '';
  foreach (@tags) {
    next if ($_ eq 'current');
    next if ($_ =~ m/.*_MH$/); # all mapivi thumb tags are ending with _MH
    $dpic = $_;                # so this must be the THUMB_MH+path+file name
  }
  if ($dpic eq '') {
    print "get_path_from_id: Error could not find path from item: ";
    print "$_ " foreach (@tags);
    print "\n";
  }
  if ($dpic =~ m/^THUMB_MH(.*)/) {
    $dpic = $1; # cut off THUMB_MH prefix
  }
  else {
    print "get_path_from_id: Error contains no THUMB_MH prefix: $dpic\n";
    $dpic = '';
  }
  return $dpic;
}

##############################################################
# light_table_copy_rename
##############################################################
sub light_table_copy_rename {
  # find all selected thumbs
  my @sel = selection_get_sort($ltw->{canvas}, $ltw->{canvas}->{thumb_list});
  #my @sel = $ltw->{canvas}->find('withtag', 'THUMBSELECT_MH');
  return unless checkSelection($top, 1, 0, \@sel, lang("picture(s)"));
  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;
  my $overwrite = OVERWRITE;
  #my $digits = 3;
  # idea from Yann Michel
  my $digits = int(log(@sel)/log(10))+1; # calculate the needed digits dynamically
  my $pw = progressWinInit($ltw, "Copy and rename pictures");
  foreach my $dpic (@sel) {
    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);
    $overwrite = overwritePic($tpic, $dpic, (scalar(@sel) - $i + 1)) if ($overwrite != OVERWRITEALL);
    next if ($overwrite == CANCEL);
    last if ($overwrite == CANCELALL);
    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->{canvas}->{thumb_size} + $ltw->{canvas}->{thumb_distance};
  $dis = 1 if ($dis == 0); # avoid division by zero
  # drop position in cols/rows
  my $col = sprintf "%0d", ($x / $dis); # round
  my $row = sprintf "%0d", ($y / $dis);
  print "drop at x=$x y=$y col=$col row=$row\n" if $verbose;
  # 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 $max_index = scalar(@{$ltw->{canvas}->{thumb_list}}) - 1; 
  if ($to_index > $max_index) {
    #print "to_index $to_index is bigger than max_index $max_index - reducing\n";
    $to_index = $max_index;
  }
  #my $to_dpic  = ${$ltw->{canvas}->{thumb_list}}[$to_index];
  # find all selected thumbs
  my @sel = $ltw->{canvas}->find('withtag', 'THUMBSELECT_MH');
  my @sel_dpics;
  my @old_order = @{$ltw->{canvas}->{thumb_list}};
  # remove selected pics from the pic list
  foreach my $id (@sel) {
      my $dpic  = get_path_from_id($ltw->{canvas}, $id);
      my $index = index_in_list($dpic, $ltw->{canvas}->{thumb_list});
      #print "drop: removing index $index ($dpic)\n";
      # remove this pic from the list
      push @sel_dpics, splice @{$ltw->{canvas}->{thumb_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 new position
      splice @{$ltw->{canvas}->{thumb_list}}, $to_index, 0, $dpic;
  }
  # set dirty bit only if order of pics really changed (compare lists by joining them to strings)
  if ("@old_order" ne "@{$ltw->{canvas}->{thumb_list}}") {
    $ltw->{unsafed_changes} = 1;
  }
  light_table_reorder($ltw->{canvas}, $ltw->{canvas}->{thumb_list});
  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" if $verbose;
      $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
  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)) {
    # delete existing tag 
    $ltw->{canvas}->dtag('current', 'THUMBSELECT_MH');
  }
  else {
    # add tag
    $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" if $verbose;
    return;
  }
  if (@sel > 1) {
    print "error ".scalar @sel." anchors found! - removing anchors\n" if $verbose;
    remove_tag_from_all('ANCHOR_MH');
    return;
  }
  my $start_id = $sel[0];
  my $start_dpic = get_path_from_id($ltw->{canvas},$start_id);
  my $start_index = index_in_list($start_dpic, $ltw->{canvas}->{thumb_list});
  @sel = $ltw->{canvas}->find('withtag', 'current');
  my $end_id = $sel[0];
  my $end_dpic = get_path_from_id($ltw->{canvas},$end_id);
  my $end_index = index_in_list($end_dpic, $ltw->{canvas}->{thumb_list});
  print "light_table_select_range: select from $start_dpic ($start_index) to $end_dpic ($end_index)\n" if $verbose;
  # 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', 'THUMB_MH'.${$ltw->{canvas}->{thumb_list}}[$_]);
  }
  light_table_update_selection();
}

##############################################################
# light_table_select_to end - select range of thumbnail from
# selected (must be just one!) to the last
##############################################################
sub light_table_select_to_end {
  my @pics_sel = getSelection($ltw->{canvas}); # or $ltw->{canvas} ???
  return unless checkSelection($ltw, 1, 1, \@pics_sel, lang("picture(s)"));
  my $start_dpic = $pics_sel[0];
  my $start = 0;
  foreach my $dpic (@{$ltw->{canvas}->{thumb_list}}) {
    # skip through list until we see the selected start picture
    # then start tagging with select tag to end of list
    $start = 1 if ($dpic eq $start_dpic);
    if ($start) {
      $ltw->{canvas}->addtag('THUMBSELECT_MH', 'withtag', 'THUMB_MH'.$dpic);
    }
  }
  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');
  return if (not @sel);
  # draw a frame around all selected pictures
  foreach my $thumb (@sel) {
    my ($x, $y) = $ltw->{canvas}->coords($thumb);
    $ltw->{canvas}->createRectangle( $x, $y, $x+$ltw->{canvas}->{thumb_size}+1, $y+$ltw->{canvas}->{thumb_size}+1,
            -tags => ['FRAME'],
            -outline => 'yellow2', #$config{ColorSelBut},
            -width => 2,
         );
  }
  # add the filename if just one thumbnail is selected
  my $picture = '';
  if (@sel == 1) {
    my $dpic = get_path_from_id($ltw->{canvas},$sel[0]);
    $picture = ' ('.basename($dpic).')';
  }
  $ltw->{label} = scalar @{$ltw->{canvas}->{thumb_list}}.' pictures, '.scalar @sel.' selected'.$picture;
}

##############################################################
# 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($ltw->{canvas},$id);
    my $index = index_in_list($dpic, $ltw->{canvas}->{thumb_list});
    # remove this pic from the list
    splice @{$ltw->{canvas}->{thumb_list}}, $index, 1;
    # delete item from canvas
    $ltw->{canvas}->delete($id);
    # delete defined photo object
    delete_photo_object($ltw->{canvas}->{thumbs}->{$dpic});
    # delete hash entry
    delete $ltw->{canvas}->{thumbs}->{$dpic};			
  }
  $ltw->{unsafed_changes} = 1; # set dirty bit
  light_table_reorder($ltw->{canvas}, $ltw->{canvas}->{thumb_list});
  light_table_update_selection();
}

##############################################################
# delete photo object, exception: EmptyThumb object
##############################################################
sub delete_photo_object {
  my $object = shift;
  if (defined $object) {
    # delete photo object
    # exception: EmptyThumb photo object, because we still need this
    if ($object != $mapivi_icons{'EmptyThumb'}) {
      $object->delete;
    }
  }
}

##############################################################
# 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($ltw->{canvas},$id);
    my $index = index_in_list($dpic, $ltw->{canvas}->{thumb_list});
    # remove this pic from the list and add it to @shift_pics
    push @shift_pics, splice @{$ltw->{canvas}->{thumb_list}}, $index, 1;
  }
  if ($where eq 'top') {
    unshift @{$ltw->{canvas}->{thumb_list}}, @shift_pics; # add them at the start of the list
  }
  elsif ($where eq 'bottom') {
    push @{$ltw->{canvas}->{thumb_list}}, @shift_pics; # add them to the end of the list
  }
  else {
    warn "light_table_shift: should not be reached where = $where";
  }
  $ltw->{unsafed_changes} = 1; # set dirty bit
  light_table_reorder($ltw->{canvas}, $ltw->{canvas}->{thumb_list});
  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($ltw->{canvas},$id);
      $ltw->{canvas}->addtag('THUMBSELECT_MH', 'withtag', 'THUMB_MH'.$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->{canvas}->{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" if $verbose;
      $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" if $verbose;
      $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(-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));
    }
    # update thumbnails shown in picture frame / canvas (if enabled)
    if ($conf{show_canvas_thumbs}{value}) {
      my @ids = $c->find('withtag', 'THUMB_MH'.$dpic);
      if (@ids) {
        # store coordinates
        my ($x,$y,undef,undef) = $c->coords($ids[0]);
        # delete outdated thumbnail
        $c->delete('withtag', $ids[0]);
        # create and add new thumb
        $c->{thumbs}->{$dpic} = $c->Photo(-file => $thumb);
        add_canvas_thumb($c, $dpic, $x, $y);
      }
    }
  }
}

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

##############################################################
# smart_update - reread actual directory, add new and remove
#                deleted pics, without reloading the existing
#                thumbnails; the goal is to have a faster
#                update for large folders
##############################################################
sub smart_update {
  log_it(lang("Smart update"));
  $top->update;
  my @act_pics;
  my $rc = get_pics_by_modus(\@act_pics);
  return $rc if ($rc != 1);
  
  # 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, lang("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();
  log_it("ready! removed $removed_pics and added $new_pics picture(s)");
  generateThumbs(ASK, SHOW);
}

##############################################################
# 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 {
  log_it(lang('Loading thumbnails ...'));
  $top->update;
  checkCachedPics();
  canvasHide();
  # delete all photo objects (thumbnnails)
  foreach (keys %thumbs) {
    print "updateThumbs: deleting thumbnail object of $_\n" if $verbose;
    # delete defined photo object
    delete_photo_object($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()) {
    log_it(lang('Loading thumbnails ...').' '.lang('Ready!'));
    generateThumbs(ASK, SHOW);
  }
  else {
    log_it(lang("user abord (not all pictures are loaded!)"));
  }
  showNrOf();
  check_new_keywords();
}

##############################################################
# 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
  # -> the memory is available
  $picLB->delete('all');
  if ($verbose) {
    my @check = $top->imageNames;
    print " there are ".scalar @check." pics left\n";
  }
  my @pics;
  my $rc = get_pics_by_modus(\@pics);
  return $rc if ($rc != 1);
  # if we have many pictures we ask first if the user wants to see them all
  my $cut_after = 0;
  if (@pics > $config{ThumbMaxLimit}) {
    my $cancel = lang('Cancel');
    my $all = lang('All');
    my $some = langf("Only %d", $config{ThumbMaxLimit});
    my $rc = $top->Dialog(-text => langf("Show %d pictures?", scalar(@pics)),
                          -title => lang("Show all pictures?"),
                          -width => 40,
                          -buttons => [$all, $some, $cancel])->Show();
    return 0 if ($rc eq $cancel);
    $cut_after = 1 if ($rc eq $some);
  }
  sortPics($config{SortBy}, $config{SortReverse}, \@pics);
  if ($cut_after) {
    cut_list(\@pics, $config{ThumbMaxLimit});
  }
  # remove .thumbs subdir etc.
  cleanOneDir($actdir) if (($act_modus == FOLDER) and (@pics == 0));
  $rc = showThumbsInList($picLB, \@pics);
  show_canvas_thumbs($c, \@pics);
  set_act_nav_label();
  return $rc;
}

##############################################################
##############################################################
sub set_act_nav_label {

  $actdirF->{folder_check_buttons}->packForget if ($actdirF->{folder_check_buttons}->ismapped);

  if ($act_modus == FOLDER) {
    $act_nav_label = lang("Folder").": $actdir";
    $actdirF->{folder_check_buttons}->pack(-in => $actdirF, -side => 'left', -expand => 0, -fill => 'x', -padx => 2, -pady => 1) unless ($actdirF->{folder_check_buttons}->ismapped);
  }
  elsif ($act_modus == LOCATION) {
    $act_nav_label = lang("Location").": ";
    $act_nav_label .= "$_ " foreach (@act_location);
  }
  elsif ($act_modus == DATE) {
    $act_nav_label = lang("Date").": ";
    $act_nav_label .= "$_ " foreach (@act_date);
  }
  elsif ($act_modus == KEYWORDCLOUD) {
    $act_nav_label = lang("Keywordcloud").": ";
    $act_nav_label .= "$_ " foreach (@act_keywords);
  }
  elsif ($act_modus == KEYWORD) {
    $act_nav_label = lang("Keyword").": ";
    $act_nav_label .= "$_ " foreach (@act_keywords);
  }
  elsif ($act_modus == SEARCH) {
    $act_nav_label = lang("Search").": $config{SearchPattern}";
  }
  elsif ($act_modus == COLLECTION) {
    $act_nav_label = lang("Collection").": ";
    $act_nav_label .= "$_ " foreach (@act_collection);
  }
  else {
    $act_nav_label = lang("Unknown navigation modus!");
  }
  $act_nav_label =~ s/\s+$//;   # remove trailing whitespace
  
  if (($act_modus != FOLDER) and $conf{nav_rating_on}{value}) {
    $act_nav_label .= ", ".lang("Rating").": ".iptc_rating_stars_urg($conf{search_rating_max}{value})." - ".iptc_rating_stars_urg($conf{search_rating_min}{value});
  }
}

my @navigation_history;
##############################################################
##############################################################
sub navigation_history_save {

  my $hash = {};
  $hash->{modus} = $act_modus;
  $hash->{folder} = $actdir;
  $hash->{location} = join(" ", @act_location);
  $hash->{date} = join(" ", @act_date);
  $hash->{keywords} = join(" ", @act_keywords);
  $hash->{exkeywords} = join(" ", @act_keywords_ex);
  $hash->{search} = $config{SearchPattern};
  
  push @navigation_history, $hash;
  print "navigation_history_save: ".scalar @navigation_history." history entries\n";
  
  foreach my $href (@navigation_history) {
    print "modus: $href->{modus} folder: $href->{folder} keys: $href->{keywords} date: $href->{date} loc: $href->{location} search: $href->{search}\n";
  }
}

##############################################################
##############################################################
sub get_pics_by_modus {
  my $pics = shift;  # list reference
  
  #navigation_history_save();
  
  if ($act_modus == FOLDER) {
    @$pics = getPics($actdir, WITH_PATH, $config{CheckForNonJPEGs});
  }
  elsif ($act_modus == LOCATION) {
    @$pics = get_pics_by(LOCATION, \@act_location);
  }
  elsif ($act_modus == DATE) {
    @$pics = get_pics_by(DATE, \@act_date);
  }
  elsif ($act_modus == KEYWORDCLOUD) {
    @$pics = get_pics_with_keywords(\@act_keywords, \@act_keywords_ex);
  }
  elsif ($act_modus == KEYWORD) {
    @$pics = get_pics_with_keywords(\@act_keywords, \@act_keywords_ex);
  }
  elsif ($act_modus == SEARCH) {
    @$pics = get_pics_by_searching($config{SearchPattern}, '');
  }
  elsif ($act_modus == COLLECTION) {
    # print "act collection: $_\n" foreach (@act_collection);
    # index 0 = folder, 1 = collection 
    @$pics = @{$slideshows{$act_collection[0]}{$act_collection[1]}{pics}};
  }
  else {
    warn "showThumbs called with unknown modus: $act_modus";
    return 0;
  }
  $actdirF->{Filter}->{excluded_pics} = 0; # reset filter display
  if ($conf{filter_pics}{value}) {
    $actdirF->{Filter}->{excluded_pics} = filter_pics($pics, $conf{filter_pics_keywords}{value});
  }
  return 1;
}

##############################################################
# 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
  my $pw = progressWinInit($lb, lang('Load pictures'));
  foreach my $dpic (@$listR) {
    last if progressWinCheck($pw);
    $n++;
    # debug helper: print "xxx loading picture ($n/$nr)\n";
    progressWinUpdate($pw, lang('loading picture')." ($n/$nr) ...", $n, $nr);
    addOneRow($lb, $dpic, 1);
  }
  progressWinEnd($pw);
  if (($lb == $picLB) and ($n != $nr)) {
    log_it("user abord at $n of $nr");
    #$lb->after(1000); # just a little delay to show the message above
    return 0;
  }
  return 1;
}

##############################################################
# Source: http://newsgroups.derkeiler.com/Archive/Comp/comp.lang.perl.tk/2006-02/msg00050.html
##############################################################
sub get_encode_file {
  my $filename = shift;
  # todo: should not die here!!!!!!
  open my $filehandle, '<', $filename or die "Can't open $filename. $!\n";
  local $/;
  return encode_base64(<$filehandle>);
}

##############################################################
# 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 (-f $thumb) {
    # Source: http://newsgroups.derkeiler.com/Archive/Comp/comp.lang.perl.tk/2006-02/msg00050.html
    # Some of the Tk modules (like Photo) do their own file IO and just
    # cannot deal with non-ASCII characters in file names (on Windows,
    # at least, I don't have as much experience with Linux, OSX, et al.)

    # I have been bitten by this before and haven't really found a good
    # solution. A kind of clunky work-around I have employed in the past
    # is to use the standard perl IO functions to load the file into
    # memory, base64 encode it and then feed it to the module as data.

    # Extra work, but it side steps the problem without resorting to
    # measures which may be beyond your control. (Like requiring all
    # file names to use only ASCII characters.)
    if ($EvilOS) {
      $thumbP = $lb->Photo(-format => 'jpeg', -data => get_encode_file($thumb), -gamma => $config{Gamma});
    }
    else {
      $thumbP = $lb->Photo(-format => 'jpeg', -file => $thumb, -gamma => $config{Gamma});
    }
    $thumbs{$dpic} = $thumbP;	# save all thumb photo objects in global hash %thumbs to delete them when changing the dir
  }

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

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

  my $image;
  if ((defined $thumbP) and $with_thumb) {
    $image = $thumbP;
  } else {
    $image = $mapivi_icons{'EmptyThumb'};
  }

  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}, -itemtype => "image", -image => $rating_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);
}

##############################################################
##############################################################
sub get_rating_and_size {
  my $dpic = shift;
  my $lb = shift;
  my $star_icon = iptc_rating_star_icons($dpic);
  my $file_info = getAllFileInfo($dpic);
  # use Tk::Compound to display a picture above a text, both aligned to the left side
  my $compound = $lb->Compound;
  # next line display the rating stars as small icons
  $compound->Line(-anchor => 'w');
  $compound->Image(-image => $mapivi_icons{$star_icon});
  # next line: text
  $compound->Line(-anchor => 'w');
  $compound->Text(-text => $file_info, -justify => 'left');
  # flags (optional)
  if (defined $searchDB{$dpic}{FLAG}) {
    my $flag = $searchDB{$dpic}{FLAG};
    if ($flag != 0) {
      $compound->Line(-anchor => 'w');
      $compound->Image(-image => $mapivi_icons{'FlagRed'})   if ($flag & FLAG_RED);
      $compound->Image(-image => $mapivi_icons{'FlagGreen'}) if ($flag & FLAG_GREEN);
      $compound->Image(-image => $mapivi_icons{'FlagBlue'})  if ($flag & FLAG_BLUE);
    }
  }
  return $compound;
}

##############################################################
# 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 - create string with rating/urgency number
##############################################################
sub displayUrgency {
  my $urg = shift;
  return '' unless (defined $urg);
  return "Rating: $urg\n";
} 

##############################################################
# iptc_rating_stars_urg - convert the IPTC urgency number into a
# rating string with zero to five stars (*) and the urgency in parenthesis
##############################################################
sub iptc_rating_stars_urg {
  my $urgency = shift;
  my $stars = iptc_rating_stars($urgency);
  $urgency = '-' if ($urgency eq '');
  return "$stars ($urgency)";
} 

##############################################################
# iptc_rating_stars - convert the IPTC urgency number into a
# rating string with zero to five stars (*)
##############################################################
sub iptc_rating_stars {
  my $urgency = shift;
  return '' unless (defined $urgency);
  return '' if ($urgency <= 0);
  my $stars = '';
  for (my $x = 5; $x >= $urgency; $x -= 1) {
    $stars .= '*';
  }
  return $stars;
}

##############################################################
# iptc_rating_stars_nr - convert the IPTC urgency number into 
# the number of rating stars
##############################################################
sub iptc_rating_stars_nr {
  my $urgency = shift;
  return 0 unless (defined $urgency);
  return 0 if ($urgency <= 0);
  return 0 if ($urgency > 5);
  # todo: should we also handle 6,7,8 -> 2/3, 1/2, 1/3?
  return (6 - $urgency);
} 

##############################################################
# iptc_rating_stars_icons - convert the rating into a icon file name
##############################################################
sub iptc_rating_star_icons {
  my $dpic = shift;
  return 'Rating0' unless (defined $dpic);
  my $urg  = $searchDB{$dpic}{URG};
  return 'Rating0' unless (defined $urg);
  return 'Rating0' if (($urg <= 0) or ($urg > 8));
  return "Rating$urg";
}

##############################################################
##############################################################
sub rating_button {
  my ($widget, $callback, $info, $side, $fill, $rating) = @_; 
  my $frame = $widget->Frame(-relief => 'sunken')->pack(-side => $side, -fill => $fill);
  $balloon->attach($frame, -msg => $info);
  my $label;
  # mapping of IPTC urgency to 5 star rating string
  my %urg2star = (
    1 => '5 stars',
    2 => '4 stars',
    3 => '3 stars',
    4 => '2 stars',
    5 => '1 star',
    6 => '2/3 star',
    7 => '1/2 star',
    8 => '1/3 star',
    0 => '0 stars',
  );
  my @menuorder = (1,2,3,4,5,6,7,8,0);
  my $menu = $widget->Menu(-title => 'Rating');
  foreach my $urg (@menuorder) {
    $menu->command(-image => compound_menu($widget, $urg2star{$urg}, "rating-$urg.png"),
                   -command => sub {$$rating = $urg; $label->configure(-image => $mapivi_icons{"Rating$urg"}); &$callback();});
  }
  $label = $frame->Label(-image => $mapivi_icons{"Rating$$rating"}, -bd => 0)->pack(-side => 'left', -fill => 'y');
  $label->bind('<ButtonPress-1>', sub { $menu->Popup(-popover => 'cursor', -popanchor => 'n'); } );
  return $label;
}

##############################################################
##############################################################
sub rating_button_min_max {
  my ($widget, $ratingA, $ratingB, $callback) = @_; 
  my ($butA, $butB);
  # todo: fails is rating is 0!!!
  $butA = rating_button($widget, sub {
    $$ratingB = $$ratingA if ($$ratingB != 0 and (($$ratingB < $$ratingA) or ($$ratingA == 0)));
    $butB->configure(-image => $mapivi_icons{'Rating'.$$ratingB}); &$callback() if $callback
    }, "Rating Max", 'left', 'x', $ratingA);
  $widget->Label(-text => '-')->pack(-side => 'left');
  $butB = rating_button($widget, sub {
    $$ratingA = $$ratingB if ($$ratingA == 0 or ($$ratingB > 0 and ($$ratingA > $$ratingB)));
    $butA->configure(-image => $mapivi_icons{'Rating'.$$ratingA}); &$callback() if $callback
    }, "Rating Min", 'left', 'x', $ratingB);
  return ($butA, $butB);
}

##############################################################
# 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;
  }
  print "addToSearchDB $dpic\n" if $verbose;
  # 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;
  }
  my ($com, $exif, $ctime, $mtime, $iptc, $urgency, $size, $x, $y, $keys, @keys, $pop, $flag);
  # $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});
  $flag   = $searchDB{$dpic}{FLAG} if (defined $searchDB{$dpic}{FLAG});
  # handling of non-printables is already done in getIPTC and getIPTCkeywords
  # todo: It is needed here too, but why?
  $iptc =~ tr/\n -~//cd; # remove all non-printable chars, but not newline
  foreach (@keys) {
    $_ =~ tr/ -~//cd; # remove all non-printable chars (Picasa adds one to each keyword)
  }
  # build a space separated string from the keyword list
  # todo find a better separator, so that keywords with spaces can be supported better
  foreach (@keys) { $keys .= "$_ "; }
  # check if the pictures contain new keywords
  if ($config{CheckNewKeywords}) {
    foreach (@keys) {
      # store all keywords in a hash and count them
      if (defined $new_keywords{$_}) {
        $new_keywords{$_}++;
      }
      else {
        $new_keywords{$_} = 1;
      }
    }
  }
  # try to get the EXIF date from the short EXIF info format: "dd.mm.yyyy hh:mm:ss"
  # there may be [t] or [s] in front of the date!
  undef $ctime;
  if (defined($exif)) {
    my $year; my $mon; my $day; my $hour; my $min; my $sec;
    # support three different date formats
    # dd.mm.yyyy hh:mm:ss
    if ($exif =~ m/(\d\d)\.(\d\d)\.(\d\d\d\d)\s(\d\d):(\d\d):(\d\d)/) {
      $day  = $1;
      $mon  = $2;
      $year = $3;
      $hour = $4;
      $min  = $5;
      $sec  = $6;
    }
    # mm/dd/yyyy hh:mm:ss
    if ($exif =~ m/(\d\d)\/(\d\d)\/(\d\d\d\d)\s(\d\d):(\d\d):(\d\d)/) {
      $mon  = $1;
      $day  = $2;
      $year = $3;
      $hour = $4;
      $min  = $5;
      $sec  = $6;
    }
    # yyyy-mm-dd hh:mm:ss
    if ($exif =~ m/(\d\d\d\d)-(\d\d)-(\d\d)\s(\d\d):(\d\d):(\d\d)/) {
      $year = $1;
      $mon  = $2;
      $day  = $3;
      $hour = $4;
      $min  = $5;
      $sec  = $6;
    }
    $mon--;
    if (defined $year) {
      # todo: this may be dangerous or at least wrong!
      if ($year > $copyright_year) {  # fix wrong dates
        print "Mapivi warning: $dpic: EXIF year: $year is in the future, correcting to $copyright_year\n";
        $year = $copyright_year;
      }
      #$year -= 1900;
      if ($mon >= 0 and $mon <= 11) {
        # calculate the time as value in seconds since the Epoch (Midnight, January 1, 1970)
        $ctime = timelocal($sec,$min,$hour,$day,$mon,$year);
        #warn "using exifdate for $dpic: $ctime\n" if $verbose;

        # optional checks
        #my ($s,$m,$h,$d,$mo,$y) = localtime $ctime;
        #$y += 1900; $mo++;			# do some adjustments
        # build up the date time string, sim#lar to the EXIF format
        #my $date1 = sprintf "%04d:%02d:%02d %02d:%02d:%02d", $y, $mo, $d, $h, $m, $s;
        #my $date2 = "$3:$2:$1 $4:$5:$6";
        #print "$date2 $date $dpic\n" if ($date1 ne $date2);
      }
    }
    #else { print "mon = $mon $3:$2:$1 $4:$5:$6\n";}
  }
  #else { print "no exif date: $exif" if $verbose; }
  # if there is no exif time available use the file modification date
  unless (defined $ctime) {
    $ctime = (lstat $dpic)[9]; # 9 is the modification date time
    #warn "using filedate for $dpic: $ctime\n" if $verbose;
  }
  # replace all newlines with space before adding to the database
  #$com  =~ s/\n/ /g if (defined $com);
  #$exif =~ s/\n/ /g if (defined $exif);
  #$iptc =~ s/\n/ /g if (defined $iptc);
  # maybe there was something defined before, so we better overwrite it with ''
  $com  = '' unless (defined $com);
  $exif = '' unless (defined $exif);
  $iptc = '' unless (defined $iptc);
  $iptc =~ s/urgency\s*:\s*\d*\s*//i; # remove urgency from the IPTC field
  $iptc =~ s/keywords\s*:\s*.*\n*//i;  # remove keywords from the IPTC field
  $urgency = getIPTCurgency($dpic, $meta);
  $urgency = undef if ($urgency == 9);
  delete $searchDB{$dpic};  # clear hash item first
  #print "adding: IPTC: $iptc\n";
  #print "adding: Keys: $keys\n";
  #print "adding: URG : $urgency\n";
  $searchDB{$dpic}{COM}  = $com;   # save (complete!) comment
  $searchDB{$dpic}{EXIF} = $exif;  # save short EXIF info
  $searchDB{$dpic}{SIZE} = $size;  # save file size in Bytes
  $searchDB{$dpic}{PIXX} = $x;     # save pixel size (x = width)
  $searchDB{$dpic}{PIXY} = $y;     # save pixel size (y = height)
  $searchDB{$dpic}{TIME} = $ctime; # save EXIF/file creation time
  $searchDB{$dpic}{MOD}  = $mtime; # save file modification time
  $searchDB{$dpic}{IPTC} = $iptc;  # save complete IPTC info, but without urgency and keywords
  $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)
  $searchDB{$dpic}{FLAG} = $flag;  # save flag markers
  #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 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;
}

##############################################################
# check is file is a raw picture file based on file suffix
##############################################################
sub is_raw_file {
  my $file = shift;
  my $is_raw = 0;
  if (-f $file) {
    my ($basename,$dir,$suffix) = fileparse($file, '\.[^.]*'); # suffix = . and not-.  (one dot and zero or more non-dots)
    $is_raw = 1 if (isInList(lc($suffix), \@raw_suffix_lc));
  }
  return $is_raw;  
}

##############################################################
# check if the given file has a RAW file with same name
# and in same folder
##############################################################
sub has_raw_file {
  my $basename = shift; # the basename is the complete path with filename but without suffix
  my $rc = 0;
  foreach my $raw_suffix (@raw_suffix) {
    # check for different suffix and suffix in lower case
    if ((-f $basename.$raw_suffix) or (-f $basename.lc($raw_suffix))) {
      $rc = 1;
      last;
    }
  }  
  return $rc;
}

##############################################################
# return true if a copy of the given file in the origs folder
# with either the same name or the "-bak" suffix exists
# the second return value is the file name if found, else
# it is undef
##############################################################
sub has_orig_file {
  my ($pic,$dir,$suffix) = @_;
  my $rc = 0;
  my $file = undef;
  my $orig = $dir.$conf{origs_folder_name}{value}.'/'.$pic.$suffix;
  if (-f $orig) {
    $rc = 1;
    $file = $orig;
  }
  else {
    my $origbak = buildBackupName($orig);
    if (-f $origbak) {
      $rc = 1;
      $file = $origbak;
    }
  }
  return ($rc, $file);
}

##############################################################
# getAllFileInfo
##############################################################
sub getAllFileInfo {
  my $dpic = shift;
  my $bpic = buildBackupName($dpic);
  my $size = '';
  my $w    = 0;
  my $h    = 0;
  my ($pic,$dir,$suffix) = fileparse($dpic, '\.[^.]*'); # suffix = . and not-.  (one dot and zero or more non-dots)
  my $basename = "$dir/$pic";
  $size         = basename($dpic)."\n";
  $size        .= int($searchDB{$dpic}{SIZE}/1024).'kB' if $searchDB{$dpic}{SIZE};
  $size        .= '[bak]' if (-f $bpic);             # show that there is a backup file
  $size        .= '[orig]' if (has_orig_file($pic,$dir,$suffix));  # show that there is a original file
  $size        .= '[raw]' if (has_raw_file($basename));  # show that there is a raw file
  $size        .= '[XMP]' if ((-f $basename.'.xmp') or (-f $basename.'.XMP'));  # show that there is a XMP sidecar file
  $size        .= '[WAV]' if ((-f $basename.'.wav') or (-f $basename.'.WAV'));  # show that there is a WAV audio file
  $size .= "\n".date_iso_to_relative(getDateTimeISOString($searchDB{$dpic}{MOD})) if ($config{ShowFileDate} and defined $searchDB{$dpic}{MOD});
  $w = $searchDB{$dpic}{PIXX} if $searchDB{$dpic}{PIXX};
  $h = $searchDB{$dpic}{PIXY} if $searchDB{$dpic}{PIXY};
  # MP = MegaPixel
  my $p         = sprintf "%.2f", ($w*$h/1000000); 
  $size        .= "\n${w}x$h (${p}MP)";
  if ($config{BitsPixel}) {
    my $bitPix = getBitPix($dpic);
    $bitPix = sprintf "%.2f", $bitPix;
    $size    .= "\n${bitPix}b/p";
  }
  $size .= "\n".getAspectRatio($w, $h) if ($config{AspectRatio} and ($w > 0) and ($h > 0));
  if (-l $dpic) { $size .= "\n(Link)"; }
  $size .= " Viewed ".$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, lang("picture(s)"));
  my $rc = $top->messageBox(-icon => 'question', -message => langf("Please press Ok to remove all IPTC info of the %d selected pictures. There is no undo!", scalar @sellist),
                            -title => lang('Remove all IPTC info?'), -type => 'OKCancel');
  return if ($rc !~ m/Ok/i);
  my $errors = '';
  my $i      = 0;
  my $pw     = progressWinInit($top, "Remove IPTC info");
  foreach my $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);
    if ($dpic eq $actpic) {
	    showImageInfo($dpic);
      #showImageInfoCanvas($dpic);
	  }
  }
  progressWinEnd($pw);
  log_it("ready! (removed IPTC info of $i/".scalar @sellist.")");
  showText("Errors while removing IPTC infos", $errors, NO_WAIT) if ($errors ne '');
  return;
}

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

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

  my $dotlen = length($dot);

  my $out = $str;

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

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

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

  return $out;
}

##############################################################
# formatString - cuts and formats a string to
#                a width of $linelenght chars and a length of
#                $line_nr_limit lines.
#                this function wont work as expected with
#                comments containing a lot of nearly empty lines
##############################################################
sub formatString {
  my $string        = shift;
  my $linelenght    = shift;
  my $line_nr_limit = shift;  # use -1 if there should be no line nr limit
  return '' if ((!defined $string) or ($string eq ''));
  local($Text::Wrap::columns) = $linelenght+1;
  local($Text::Wrap::huge)  = 'overflow';
  # sanitize  and wrap string
  $string =~ s/\r//g;			       # cut \r (carriage return)
  $string =~ tr[\200-\377][\000-\177]; # remove the eight bit
  $string =~ tr/\n -~//cd; # remove non-printable characters (but not \n)
  $string = wrap('','',$string);
  # limit the number of lines (cut off the rest)
  if ($line_nr_limit > 0) {
    # split up in an array of single lines
    my @l = split /\n/, $string;         
    my $max = $line_nr_limit;
    $max = @l if (@l < $max);
    $string = '';
    # rebuild string by using the first $max lines
    for ( 0 .. ($max - 1)) {
      $string .= sprintf "%s\n", $l[$_];
    }
    $string =~ s/\n+$//;                 # cut off trailing newline(s)
  }
  return $string;
}

##############################################################
##############################################################
sub get_list_size {
  my $list_ref = shift;
  my $size = 0;
  my $size_str = '';
  foreach my $dpic (@{$list_ref}) {
    $size += getFileSize($dpic, NO_FORMAT);
  }
  $size_str = computeUnit($size) if $size;
  return $size_str;
}

##############################################################
# getFileSize - get the size in kB of a file, even if it is a link
##############################################################
sub getFileSize {
  my $dpic   = shift;
  my $format = shift;   # NO_FORMAT = return size unformated in Bytes (integer) FORMAT = with "kB" added (string)
  my $size   = '';
  return $quickSortHashSize{$dpic} if ($quickSortSwitch and defined $quickSortHashSize{$dpic});
  if (!-f $dpic) {
    warn "getFileSize: $dpic is no file!";
    if ((defined $format) and ($format == NO_FORMAT)) {
      return 0;
    }
    else {
      return '';
    }
  }
  if (-l $dpic) {
    $size = (lstat (getLinkTarget($dpic)))[7];
  }
  else {
    $size = (lstat $dpic)[7];
  }
  if ((defined $format) and ($format == FORMAT)) {
    $size = int($size/1024).'kB' if $size;
  }
  $quickSortHashSize{$dpic} = $size if $quickSortSwitch;
  return $size;
}

##############################################################
# makeDir - create the directory for storing the
#           thumbnail pictures or EXIF infos
##############################################################
sub makeDir {
  my $dir  = shift;
  my $ask  = shift; # ASK = ask before creating a dir, NO_ASK
  return 1 if (-d $dir);
  if ( ($ask == ASK) and $config{AskMakeDir} ) {
    my $rc    = checkDialog("Create new folder?",
                         "Mapivi would like to create this folder:\n$dir\nContinue?",
                         \$config{AskMakeDir},
                         "ask every time",
                         '',
                         'OK', 'Cancel');
    return if ($rc ne 'OK');
  }
  # 0755 = rwxr.xr.x
  eval { mkpath($dir, 0, oct(755)) }; # 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 {
      log_it("number $2 is out of range!");
    }
   }
   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);
      log_it("selected ".scalar @pics." pictures matching \"$goto\"");
    }
    else {
      log_it("string $goto was not found in the picture names");
    }
  }
}

##############################################################
# showImageInfo - display infos and comment of given image
#                 if available
##############################################################
sub showImageInfo {
  my $dpic = shift;
  if ((not defined $dpic) or (not -f $dpic)) {
    $widthheight  = '';
    $size         = '';
    #$exif         = '';
    $rating_but->configure(-image => $mapivi_icons{Rating0});
    $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{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
    }
    update_IPTC_frame_content($dpic);
    my $star_icon = iptc_rating_star_icons($dpic);
    $rating_but->configure(-image => $mapivi_icons{$star_icon});
    $size = getFileSize($dpic, FORMAT);
  }
  setTitle();
  # also update the canvas text 
  showImageInfoCanvas($dpic); # if ($dpic eq $actpic);
}

##############################################################
# update or clear IPTC Headline and Caption entry in picture frame
##############################################################
sub update_IPTC_frame_content {
  my $dpic = shift; # optional
  if (($config{ShowIPTCFrame}) and (defined $titleText)) {
    $titleText->delete( 0.1, 'end');        # remove old headline
    $captionText->delete( 0.1, 'end');      # remove old caption
    if ((defined $dpic) and (-f $dpic)) {
      my $headline = getIPTCHeadline($dpic);
      $titleText->insert('end', $headline);   # insert new headline
      my $caption = getIPTCCaption($dpic);
      $captionText->insert('end', $caption);   # insert new caption
    }
  }
  return;
}

##############################################################
# showImageInfoCanvas - display infos on the canvas
##############################################################
# ToDo: check if either showImageInfo could call showImageInfoCanvas or other way round 
#       and fix all calls correspondingly
sub showImageInfoCanvas {
  my $dpic = shift;
  $c->delete('withtag', 'TEXT'); # remove picture info text
  $c->delete('withtag', 'GPS');  # remove GPS button
  update_IPTC_frame_content($dpic);
  return 0 unless (defined $dpic);
  return 0 unless (-f $dpic);
  if ($config{ShowPicInfo}) {
    # update balloon info for displayed picture
    my $balloonmsg = makeBalloonMsg($dpic);
    # bind the balloon to the canvas
    $balloon->attach($c->Subwidget('canvas'), -balloonposition => 'mouse',  -msg => {'pic' => $balloonmsg} );
  }
  return 1 unless ($config{ShowInfoInCanvas});
  GPS_button($c, $dpic);
  my $info = lang('File').': '.basename($dpic)."\n";
  $info   .= lang('Path').': '.dirname($dpic)."\n\n";
  my $meta = getMetaData($dpic, "COM|APP13|APP1|SOF", 'FASTREADONLY');
  my $exif = formatString(date_iso_to_relative(getShortEXIF($dpic, NO_WRAP, $meta)), 80, -1);
  my $comm = formatString(getComment($dpic, LONG, $meta), 80, -1);
  my $iptc = formatString(getIPTC($dpic, LONG, $meta), 80, -1);
  my $xmp  = formatString(xmp_get($dpic), 80, -1);
  #my $iptcE= formatString(iptc_get($dpic), 80, -1); # iptc extracted by ExifTool
  #my $exifE= formatString(exif_get($dpic), 80, -1); # exif extracted by ExifTool
  $info   .= "EXIF:\n$exif\n"         if ($exif ne '');
  $info   .= "\nIPTC:\n$iptc\n"       if ($iptc ne '');
  $info   .= "\nXMP:\n$xmp\n"         if ($xmp ne '');
  #$info   .= "\nIPTC (from ExifTool):\n$iptcE\n" if ($iptcE ne '');
  #$info   .= "\nEXIF (from ExifTool):\n$exifE\n" if ($exifE ne '');
  $info   .= "\nComment:\n$comm"      if ($comm ne '');
  return 1 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']);
  my $id = $c->createText( 4, 4, -font => $font, -text => $info, -anchor => 'nw',
                          -fill => $conf{color_fg}{value}, -tags => ['TEXT']);
  my ($x1, $y1, $x2, $y2) = $c->bbox($id);
  $c->createText( 4, $y2+4, -font => $small_font, -text => lang("F3: show/hide overlay text"),
                 -anchor => 'nw', -fill => 'gray60', -tags => ['TEXT']);
  return 1;
}

##############################################################
# display any text with shadow on any canvas
# based on showImageInfoCanvas
# uses TEXT, METAINFO and SHADOW as tags 
##############################################################
sub show_text_on_canvas {
  my $c = shift; # canvas widget
  my $text = shift;
  $c->delete('withtag', 'TEXT'); # remove picture info text
  if ($conf{show_micro_meta}{value}) {
    return 1 if (not defined $text or $text eq '');
    # show image info on canvas white font with black shadow (shadow offset = 1 pixel)
    $c->createText( 5, 5, -font => $font, -text => $text, -anchor => 'nw',
                   -fill => 'black', -tags => ['TEXT','SHADOW']);
    my $id = $c->createText( 4, 4, -font => $font, -text => $text, -anchor => 'nw',
                            -fill => 'gray60', -tags => ['TEXT','METAINFO']); # old fill: $conf{color_fg}{value}
    # change font size to fill window width                        
    adapt_font_size($c, 'METAINFO', 'SHADOW');
    # add info text (always in small size)
    my ($x1, $y1, $x2, $y2) = $c->bbox($id);
    $c->createText( 4, $y2+4, -font => $small_font, -text => lang("F3: show/hide overlay text"),
                   -anchor => 'nw', -fill => 'gray60', -tags => ['TEXT']);
  }
  return 1;
}

##############################################################
##############################################################
sub adapt_font_size {
  my $c = shift; # canvas widget
  my $tag = shift; # tag of text item on canvas
  my $tag2 = shift; # tag of shadow text item on canvas
  my $font_size_min = 10;
  my $font_size = $font_size_min;
  my $quit = 0; # flag to exit loop
  $top->update;
  my $c_w = $c->width;
  return if (not defined $c_w);
  my @ids = $c->find('withtag', $tag);
  return if (not @ids);
  # assumption: there is just one canvas element with this tag
  my $border = 3; #0.1 * $c->Width; # keep a 10% border around the text
  for my $i (1..10) { # max 10 iterations to avoid endless loops
    my ($x1, $y1, $x2, $y2) = $c->bbox($ids[0]);
    last if (not defined ($x1));
    # calc distance between right text border and right canvas corner
    my $distance = $c_w - $border - $x2;
    #print "adapt_FontSize: $i $font_size distance: $distance canvas:$c_w x2:$x2\n";
    # Flux Capacitor ;-)
    if ($distance > 100) { # a lot of space -> increase font size
      $font_size = round($font_size*1.2);
    }
    elsif ($distance > 50) { # some space left
      $font_size += 1;
    }
    elsif ($distance < -100) { # text is much too wide
      $font_size = round($font_size*0.8);
    }
    elsif ($distance < 0) { # text is a litte too wide
      $font_size -= 1;
    }
    else {
      # size if fine, leave loop
      last;
    }
    # minimum and maximum font sizes
    if ($font_size < $font_size_min) {
      $font_size = $font_size_min;
      #print "  reached minimum font size\n";
      $quit = 1; # leave loop after font change
    }
    if ($font_size > $conf{font_size_big}{value}) {
      $font_size   = $conf{font_size_big}{value};
      #print "  reached maximum font size\n";
      $quit = 1; # leave loop after font change
    }
    # make and apply new font
    $font_big = $top->Font(-family => $config{'FontFamily'}, -size => $font_size);
    $c->itemconfigure($ids[0], -font => $font_big);
    # update also shadow text
    my @ids2 = $c->find('withtag', $tag2);
    $c->itemconfigure($ids2[0], -font => $font_big) if (@ids2);
    $c->update;
    last if ($quit);
  }
  return 1;
}

##############################################################
# returns string with very short picture meta info
# only EXIF and IPTC
# todo: maybe add some selected XMP values later
##############################################################
sub get_meta_micro {
  my $dpic = shift;
  my $meta = getMetaData($dpic, "COM|APP13|APP1|SOF", 'FASTREADONLY');
  my $micro = formatString(date_iso_to_relative(getMicroEXIF($dpic, $meta)), 80, -1);
  $micro .= "\n" if ($micro ne '');
  $micro .= formatString(getIPTC($dpic, MICRO, $meta), 80, -1);
  return $micro;
}

##############################################################
# adds a GPS button on the given canvas depending
# on the existence of EXIF GPS coordinates in the given picture
##############################################################
sub GPS_button {
  my $c = shift; # canvas widget
  my $dpic = shift; # displayed picture
  # get GPS info from picture
  my ($lat, $lon, $lat_ref, $lon_ref) = gps_get($dpic);
  # add GPS button if both coordinates are available
  if (defined $lat and defined $lon) { 
    $lat *= -1 if (defined $lat_ref and $lat_ref eq 'South');
    $lon *= -1 if (defined $lon_ref and $lon_ref eq 'West');
    # add GPS button in the upper right corner of the canvas
    $c->createImage(($c->width - 20), 10, -image => $mapivi_icons{'Location'},
                     -tag => ['GPS'], -anchor => 'ne');
    $c->bind(+'GPS', '<ButtonPress-1>', sub {
      #web_browser_open('http://maps.google.com/maps?q='."$lat,$lon");
      # due to the & in the open street web address we need additional quotes "
      web_browser_open('http://www.openstreetmap.org/"?mlat='.$lat.'&mlon='.$lon.'"');
    });
    $c->bind(+'GPS', '<Enter>', sub {
      $c->configure(-cursor => 'hand2');
      # workaround because balloon doesn't work
      log_it('click here to display GPS position ('.$lat.', '.$lon.') in web browser'); 
    });
    $c->bind(+'GPS', '<Leave>', sub {
      $c->configure(-cursor => 'arrow');
      # workaround because balloon doesn't work
      log_it('');
    });
    # 2010-10 doesn't work, reason unclear:
    #$balloon->attach($c->Subwidget('canvas'), -balloonposition => 'mouse',  -msg => {'GPS' => 'click here to display GPS position in web browser'} );
  }
}

##############################################################
##############################################################
sub web_browser_open {
  my $url = shift;
  my $command = "$conf{web_browser}{value} $url";
  # instead of the & for UNIX windows needs a "start" in front of the application to run in the background
  if ($EvilOS) {
    $command = "start $url";
  }
  else {
    $command .= " 2>&1 1>/dev/null &";
  }
  log_it("Open $url in browser ...");
  $top->Busy;
  (system "$command") == 0 or warn "$command failed: $!";
  log_it("Ready! ($url opened)");
  $top->Unbusy;
}

##############################################################
# 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)."%";
        if ($verbose) {
          my $wz = $photos{$dpic}->width;        
          print "showZoomInfo: id=$id z = $z zoomFactorStr = $zoomFactorStr x1:$x1 x2:$x2 w:$width wz:$wz\n";
        }
        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(lang('Non-JPEG pictures'));

  $myDiag->Label(-text => "There are ".scalar @pics." non-JPEG pictures in folder ".basename($dir).".\nShould I convert these pictures to JPEG format?\n(After convertion these pictures will be visible in Mapivi.)")->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 => lang('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 => lang("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);

  my $xBut = ButF->Button(-text => lang('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);
  bind_exit_keys_to_button($myDiag, $xBut);

  $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;
    }
    log_it("converting $_ to JPEG $tpic ...");
    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 folder
# todo: rename to show_hidden_files and show the diff between
#       files in folder and actually displayed pictures
##############################################################
sub showNonJPEGS {
  my @files = getFiles($actdir);
  # put just the files not matching jpg, jpeg, JPG or JPEG in the file list
  my @nonjpeg = sort(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);

  if (@nonjpeg) {
    # open window
    my $myDiag = $top->Toplevel();
    $myDiag->title(lang('Hidden files'));
    $myDiag->iconimage($mapiviicon) if $mapiviicon;
    $myDiag->Label(-anchor => 'w', -justify => 'left', -text => lang('List of hidden files in folder ').$actdir)->pack(-fill => 'x', -padx => 3, -pady => 3);
    my $listBoxY = @nonjpeg;
    $listBoxY = 30 if ($listBoxY > 30); # maximum 30 entries
    my $listBox =
        $myDiag->Scrolled('Listbox',
                          -scrollbars => 'osoe',
                          -selectmode => 'extended',
                          -exportselection => 0,
                          -width => 80,
                          -height => $listBoxY,
                          )->pack(-expand => 1, -fill =>'both', -padx => 3, -pady => 3);

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

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

    my $ubutF = $myDiag->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
    $ubutF->Button(-text => lang('Select all'),
                    -command => sub {
                         $listBox->selectionSet(0, 'end');
                      })->pack(-side => 'left', -padx => 3, -pady => 3);
    $ubutF->Button(-text => lang('Select videos'),
                    -command => sub {
                        $listBox->selectionClear(0, 'end');
                        my @list = $listBox->get(0, 'end');
                        my $index = 0;
                        foreach my $file (@list) {
                          print "check file: $file\n";
                          if (is_a_video($file)) {
                            $listBox->selectionSet($index);
                          }
                          $index++;
                        }
                      })->pack(-side => 'left', -padx => 3, -pady => 3);
    $ubutF->Button(-text => lang('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 $playB = $ButF->Button(-text => lang('Play video'),
                      -command => sub {
                        my @sellist = $listBox->curselection();
                        return unless checkSelection($myDiag, 1, 0, \@sellist, lang("video(s)"));
                        my $command = $conf{video_player}{value}.' ';
                        foreach my $file (@sellist) {
                          $command .= '"'.$actdir.'/'.$nonjpeg[$file].'" ';
                        }
                        print "video command: - $command -\n";
                        execute($command);        
                      })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
                      $balloon->attach($playB, -msg => lang("Play selected videos with ").$conf{video_player}{value}.lang("\nTool can be changed in Options->Tools."));


    my $editB = $ButF->Button(-text => lang('Edit picture'),
                      -command => sub {
                        my @sellist = $listBox->curselection();
                        return unless checkSelection($myDiag, 1, 0, \@sellist, lang("picture(s)"));
                        my @piclist;
                        foreach my $file (@sellist) {
                          push @piclist, $actdir.'/'.$nonjpeg[$file];
                        }
                        edit_pic($myDiag, @piclist);        
                      })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
                      $balloon->attach($editB, -msg => lang("Edit selected pictures with ").$conf{external_pic_editor}{value}.lang("\nTool can be changed in Options->Tools."));
    $myDiag->bind('<Control-e>', sub { $editB->Invoke; } );
    
    $ButF->Button(-text => lang('Delete'),
                      -command => sub {
                        my @sellist = $listBox->curselection();
                        my $rc = myButtonDialog("Really delete?",
                            "Press Ok to delete these ".scalar @sellist." files in $actdir.\nThere is no undelete!",
                         undef, 'OK', 'Cancel');
                        if ($rc eq 'OK') {
                          foreach my $file (@sellist) {
                            log_it("removing $nonjpeg[$file]");
                            removeFile($actdir.'/'.$nonjpeg[$file]);
                          }
                          # reread files and update lists
                          @files = getFiles($actdir);
                          @nonjpeg = sort(grep {!m/.*\.jp(g|eg)$/i} @files);
                          $listBox->delete(0, 'end'); # clear all
                          $listBox->insert('end', @nonjpeg); # insert new list
                        }
                      })->pack(-side => 'left', -expand => 0, -padx => 3, -pady => 3);

    my $XB = $ButF->Button(-text => lang('Close'),
                  -command => sub { $myDiag->destroy(); }
                   )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
    $XB->bind('<Return>', sub { $XB->Invoke; } );

    $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});
    }
    $XB->focus;
    $myDiag->waitWindow();
  }
}

##############################################################
# 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;  # bool: WITH_PATH or JUST_FILE
  my $check_for_non_jpegs = shift; # bool: CHECK_JPEG or NO_CHECK_JPEG 
  my @other;
  my @files = getFiles($dir);
  # are there non-JPEG pictures in this directory?
  if ($check_for_non_jpegs == CHECK_JPEG) {
    @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
    }
  }
  my @pics;
  if ($config{supportOtherPictureFormats}) { # add "|(avi)" below to include AVI videos 
    # see also @raw_suffix at top of this file! .NEF .CRW .CR2 .DNG .NRW
    # 2016-10: GIMP *.xcf works fine for e.g. thumbnail generation, but commands like
    # ImageMagick -rotate destroy the GIMP file (file size -> 0kB). Thus dangerous!
    @pics = grep {m/.*\.(jp(g|eg))|(crw)|(cr2)|(dng)|(nrw)|(gif)|(xpm)|(ppm)|(xbm)|(ti(f|ff))|(svg)|(png)|(bmp)|(nef)|(raw)$/i} @files;
  }
  else {
    # put just the files matching jpg, jpeg, JPG or JPEG in the file list
    @pics = 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 - @pics;
    $otherFiles = '' if ($otherFiles == 0);
  }
  $dir =~ s|/*$||;                        # remove trailing slashes
  if ($with_path == WITH_PATH) {
    foreach (@pics) { $_ = "$dir/$_"; }  # add the path to each file
  }
  return @pics;
}

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

  # todo: check if this causes problems in light table (no sorting possible?)
  if ($act_modus == COLLECTION) {
    #print "mode = COLLECTION: skipping sortPics()!\n";
    return;
  }
  
  print "sortby = $sortby\n" if $verbose;

  my $str = langf("Sorting %d pictures by %s",scalar(@$pics),$sortby);
  $str   .= ' '.lang('(reverse)') if $sortreverse;
  log_it("$str ...");

  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 'flag') {
    @$pics = sort { getFlag($b) <=> getFlag($a) ||
	    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;
  }
}

##############################################################
# get FLAG info from database, retun 0 if no flag is set
##############################################################
sub getFlag {
	my $dpic = shift;
	my $flag = 0;
	$flag = $searchDB{$dpic}{FLAG} if (defined $searchDB{$dpic}{FLAG});
	return $flag;
}

##############################################################
# 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 = getDateTimeDINString($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});
  if (!defined($er)) {
    my $meta = getMetaData($dpic, 'APP1$', 'FASTREADONLY') ;
    $er = $meta->get_Exif_data('ALL', 'TEXTUAL');
    if (!defined($er)) {
      warn "$dpic has no exif info" if $verbose;
      return '';
    }
  }
  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') ;
    if (defined $meta) {
      $er = $meta->get_Exif_data('ALL', "TEXTUAL");
      if (! defined $er) {
        warn "$dpic has no exif info";
        return;
      }
    }
    else {
      warn "$dpic has no meta data" unless (defined $er);
      return;
    }
  }

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

  # store result for quick access
  $quickSortHash{$dpic} = "$maker $model" if $quickSortSwitch;
  
  return if ($maker eq '' and $model eq ''); # return undef
  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") if (defined $meta);
    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 sorted dir list of the given dir
##############################################################
sub getDirs {
  my $dir = shift;
  my @fileDirList = readDir($dir);
  my @dirList;
  foreach (@fileDirList) {
    next if (($_ eq '.') or ($_ eq '..'));
    my $item = Encode::encode('iso-8859-1', "$dir/$_");
    #my $d2 = Encode::encode('iso-8859-1', $d);
    #print "getDirs: encoded: $item";
    #if (-d $item) { print " is a dir\n"; }
    #else  { print " is not a dir\n"; }
    push @dirList, $item if (-d $item);
  }
  @dirList = sort { uc($a) cmp uc($b) } @dirList;
  return @dirList;
}

##############################################################
# getDirsRecursive - returns all subdirs of the given dir
#                    $dir is also included in list
#                    mapivi and gimp subdirs are skipped
#                    dirs starting with "." are skipped
##############################################################
sub getDirsRecursive {
  my $dir = shift;
  my @dirs;
  find(sub {
         if (-d and ($_ !~ m|^\.|) and ($_ ne $thumbdirname) and ($_ ne $exifdirname)) {
           push @dirs, $File::Find::name;
         }
       }, $dir);
  return @dirs;
}

##############################################################
# readDir - reads the contents of the given directory
##############################################################
sub readDir {
  my $dir = shift;
  $dir = Encode::encode('iso-8859-1', $dir);
  if (! -d $dir) {
    warn "readDir: $dir is no dir!: $!" unless (($dir =~ m/.*$thumbdirname$/));
    return 0;
  }
  my @fileDirList;
  # open the directory
  if (!opendir ACTDIR, $dir) {
    warn "Can't open folder $dir: $!";
    return 0;
  }
  # show no files starting with a '.', but '..'
  @fileDirList = grep /^(\.\.)|^[^\.]+.*$/, readdir ACTDIR;
  closedir ACTDIR;
  return @fileDirList;
}

##############################################################
# quitMain
##############################################################
sub quitMain {
  log_it(lang('Saving for exit').' ...');
  $top->update();
  my $ok = saveAllConfig();
  return 0 if (not $ok);
  diff_database_statistic() if $conf{show_statistic}{value};
  freeMem();
  exit;
}

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

##############################################################
# saveAllConfig
##############################################################
sub saveAllConfig {
  # check if the light table window is still open and ask to save it.
  if (Exists($ltw)) {
    my $ok = light_table_close();
    return 0 if (not $ok);
  }
  log_it("saving configuration ...");
  $config{Geometry} = $top->geometry;
  saveAdjusterPos();
  $config{LastDir} = $actdir if (-d $actdir);
  $config{ActPic}  = $actpic;
  # we don't want to start in full screen mode
  # so if we've been in fullscreen mode, we save the settings from before the fullscreen switch
  if ((defined $top->{my_fullscreen_flag}) and ($top->{my_fullscreen_flag} == 1)) {
    print "saveAllConfig called in full screen mode\n" if $verbose;
    $config{Geometry} = $top->{my_last_geometry};
  }
  else { print "saveAllConfig called in normal screen mode\n" if $verbose; }
  log_it("saving options to $configFile ...");
  # old config
  saveConfig($configFile, \%config);
  # new config
  my ($ok, $err) = configuration_store($conf_file, \%conf);
  if (not $ok) {
    log_it($err);
    warn $err;
  }
  if ($config{SaveDatabase}) {
    log_it("saving search database ...");
    nstore(\%searchDB,  $searchDBfile) or warn "could not store searchDB in file $user_data_path/SearchDataBase: $!";
  }
  log_it("saving dir folder hotlist ...");
  nstore(\%dirHotlist, "$user_data_path/hotlist") or warn "could not store $user_data_path/hotlist: $!";
  my $datetime = getDateTimeShortString(time());
  # save a copy of the old hash in the trash # todo: remove very old backups
  log_it("saving dir check list ...");
  mycopy("$user_data_path/dirProperties", "$trashdir/dirProperties-$datetime", OVERWRITE) if (-f "$user_data_path/dirProperties");
  nstore(\%dirProperties, "$user_data_path/dirProperties") or warn "could not store $user_data_path/dirProperties: $!";
  nstore(\%ignore_keywords, "$user_data_path/keywords_ignore") or warn "could not store $user_data_path/keywords_ignore: $!";
  nstore(\%hot_keywords, "$user_data_path/keywords_hot") or warn "could not store $user_data_path/keywords_hot: $!";
  save_slideshows();
  if (MatchEntryAvail) {
    log_it("saving entry values ...");
    nstore(\%entryHistory, $file_Entry_values) or warn "could not store $file_Entry_values: $!";
  }
  # save the mode of the trees (opened, closed branches)
  if ($nav_F->{key_frame}) {
    saveTreeMode($nav_F->{key_frame}->{tree});
    if (defined $nav_F->{key_frame}->{tree}->{m_mode}) {
      nstore($nav_F->{key_frame}->{tree}->{m_mode}, "$user_data_path/keywordMode") or warn "could not store $user_data_path/keywordMode: $!";
    }
  }
  log_it("saving categories ...");
  saveArrayToFile("$user_data_path/categories", \@precats);
  log_it("saving keywords ...");
  saveArrayToFile("$user_data_path/keywords",   \@prekeys);
  log_it(lang('Ready!'));
  return 1;
}

##############################################################
# persist slideshows hash to a file
##############################################################
sub save_slideshows {
  #nstore(\%slideshows, "$user_data_path/slideshows") or warn "could not store $user_data_path/slideshows: $!";
  my $ok;
  my $result = eval { nstore( \%slideshows, $collectionsFile ) };
  if( $@ )
        { $ok = 0; warn "Serious error from Storable: $@"; }
  elsif( not defined $result )
        { $ok = 0; warn "I/O error from Storable: $!"; }
  else { $ok = 1; }
  return $ok;
}

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

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

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

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

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

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

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

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

  return $comment;
}

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

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

  return @coms;
}

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

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

  my $exif = '';

  return $exif unless is_a_JPEG($dpic);

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

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

  return unless (defined($meta));

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

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

  # check for thumbnail add a [t] if there is one
  $exif .= '[t] ' if (defined $er->{ROOT_DATA}->{ThumbnailData});

  my $datestr = '';
  $datestr    = getEXIFDate($dpic, $er);
  if ($datestr ne '') {
    if (my ($y, $M, $d, $h, $m, $s) = $datestr =~ m/(\d\d\d\d):(\d\d):(\d\d) (\d\d):(\d\d):(\d\d)/) {
      #$exif   .= "$d.$M.$y $h:$m:$s ";  # german date format
      #$exif   .= "$M/$d/$y $h:$m:$s ";   # american date format
      $exif   .= "$y-$M-$d $h:$m:$s ";   # ISO 8601 date format
      $exif   .= "\n" if ($wrap and $exif ne '');
    }
    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');

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

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

  my $iso = get_ISO_value($dpic, $er, $meta, $make);
  $exif .= "ISO$iso " if ($iso ne '');

  $exif .= "\n" if ($wrap and $exif ne '');

  my $exposureStr = get_EXIF_exposure($er, $meta, $make);
  $exif .= $exposureStr.' ' if ($exposureStr ne '');

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

  if ($conf{exif_plus}{value}) { # show contrast sharpness saturation metering white balance lens
    my $exifplus = get_EXIF_plus($dpic);
    $exifplus = formatString($exifplus, 80, -1) if ($wrap);
    $exif .= $exifplus if ($exifplus ne '');
  }

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

  my ($lat, $lon, $latRef, $lonRef) = gps_get($dpic);
  if (defined $lat and defined $lon) { 
    $latRef = '?' if (!defined $latRef);
    $lonRef = '?' if (!defined $lonRef);
    #  %.1s truncates string, while %1s does not
    $exif .=  sprintf(" GPS: %.4f%.1s %.4f%.1s",$lat, $latRef, $lon, $lonRef); 
  }

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

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

##############################################################
# geMicroEXIF - returns a string containing only the most
#               relevant EXIF-Data
##############################################################
sub getMicroEXIF {
  my $dpic = shift;
  my $meta = shift; # optional
  my $exif = '';
  return $exif unless is_a_JPEG($dpic);
  $meta = getMetaData($dpic, 'APP1$', 'FASTREADONLY') unless (defined($meta));
  return unless (defined($meta));
  my $er = $meta->get_Exif_data('ALL', 'TEXTUAL'); # er = exif hash ref todo: use IMAGE_DATA instead of ALL?
  return $exif unless (defined $er);

  # Some cameras store settings in Maker Notes, so it is important to know the maker of the camera.
  my $make = '';
  $make = ${$er->{IFD0_DATA}->{Make}}[0] if (defined $er->{IFD0_DATA}->{Make});
  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   .= "$y-$M-$d $h:$m:$s ";   # ISO 8601 date format
    }
    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 ";
  }

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

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

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

  my $iso = get_ISO_value($dpic, $er, $meta, $make);
  $exif .= "ISO$iso " if ($iso ne '');

  my $exposureStr = get_EXIF_exposure($er, $meta, $make);
  $exif .= $exposureStr.' ' if ($exposureStr ne '');

  my $exmod = getEXIFModel($dpic, $er);
  $exif .= "$exmod" if (defined $exmod);

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

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

##############################################################
##############################################################
sub get_EXIF_exposure {
  my ($er, $meta, $make) = @_;

  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 its no Canon we look in the ExposureProgram tag
  if (($exposureStr eq '') and (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];
    $exposureStr = $ExposureProgram[$prog] if ($prog > 0);
  }
  
  # if there is also nothing defined, we take the ExposureMode tag
  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);
    }
  }

  return $exposureStr;
}
##############################################################
# returns additional EXIF information using exiftool: contrast,
# sharpness, saturation, metering, white balance, Metering,
# focus dist, DOF, ...
##############################################################
sub get_EXIF_plus {
  my ($dpic) = shift;
  my $exifplus = '';

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

  # what to get and in which order
  my @items = qw(MeteringMode WhiteBalance Contrast Sharpness Saturation ColorSpace FocusDistance DOF LensID ShutterCount);
  # how to label
  my %itemlabel = ( # labels to display
		'MeteringMode' => 'Metering:',
        'WhiteBalance' => 'WB:',
        'Sharpness' => 'Sharp:',
        'Contrast' => 'Contrast:',
        'Saturation' => 'Sat:',
        'FocusDistance' => 'Dist:',
        'DOF' => 'DOF:',
        'ShutterCount' => '#', );
  
  my $exifTool = new Image::ExifTool;
  my $info = $exifTool->ImageInfo($dpic, '*:*');
  foreach my $item (@items) {
	if (defined $$info{$item}) {
	  if (defined $itemlabel{$item}) { $exifplus .= $itemlabel{$item}; }
      $exifplus .= $$info{$item}." ";
    }
  } 
  return $exifplus;
}

##############################################################
##############################################################
sub get_ISO_value {
  my ($dpic, $er, $meta, $make) = @_;
  my $iso = '';
  
  if (defined $er->{SUBIFD_DATA}->{ISOSpeedRatings}) {
    $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}) {
      $iso = calc($er->{SUBIFD_DATA}->{ExposureIndex});
    }
    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_int = $makernote->{CameraSettings}[16];
            if ($iso_int == 15) {
              $iso = '-Auto';
            }
            elsif (16 <= $iso_int and $iso_int <= 19) {
              $iso = (50 * (1 << ($iso_int - 16)));
            }
          }
        }
        elsif (exists $makernote->{ISOSetting}) {
          $iso = ${$makernote->{ISOSetting}}[1];
        }
      }
    }
  }
  
  # if nothing helps we use exiftool 
  if ((!defined $iso) or ($iso eq '')) {
    my $exifTool = new Image::ExifTool;
    my $info = $exifTool->ImageInfo($dpic, '*:ISO');  # 'Nikon:ISO'
    $iso = $$info{ISO} if defined $$info{ISO};
  }
  # 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)
  # but Mapivi won't modify the users pictures without asking that's why this is commented out
  #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";
    #  }
    #}
  return $iso;
}

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

  return $exif unless is_a_JPEG($dpic);

  my $pic = basename($dpic);

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

  #return unless ($verbose);

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

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

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

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

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

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

  my $selected = @sellist;

  log_it("displaying EXIF data of $selected pictures");

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

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

    my $title = "EXIF info of ".basename($dpic);
    
    my $exif = "EXIF info of $dpic\n";

    my $exifs = date_iso_to_relative(getShortEXIF($dpic, NO_WRAP));
    $exif .= "compact EXIF info:\n$exifs\n\n" if ($exifs ne '');
    
    $exif .= "\ndetailed EXIF info (from Image::ExifTool):\n";
    $exif .= exif_get($dpic); # exif extracted by ExifTool
    
    $exif .= "\ndetailed EXIF info (from Image::Info):\n";
    my $ii = getImageInfo($dpic);
    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, getThumbFileName($dpic));
  }
  progressWinEnd($pw);
  log_it("ready! ($i of $selected displayed)");
}
 
##############################################################
# date_iso_to_relative
# input: any strings (also multiline strings with newline)
# output: same string, but contained iso date string (format: yyyy-mm-dd)
# is replaced with relative date string (e.g. "today" or "yesterday")
# if found and applicable
##############################################################
sub date_iso_to_relative {
  my $string = shift;
  return $string if (not defined $string);
  # $1 = pre string
  # $2 = years
  # $3 = months
  # $4 = days
  # $5 = post string
  # regex modifier /s = treat newline like any char (.)
  if ($string =~m/(.*)(\d\d\d\d)-(\d\d)-(\d\d)(.*)/s) {
    my $relative = undef;
    #print "date_iso_to_relative: found ISO date $4.$3.$2 \n";
    # todo: make a sub from the next 3 statements, it is used quite often in mapivi
    my (undef,undef,undef,$d,$m,$y) = getDateTime(time());
    if ($y == $2 and $m == $3 and $d == $4) {
      $relative = 'today';
    }
    else {
      # get yesterdays date
      my ($ny,$nm,$nd) = date_relative($y,$m,$d,-1);
      if ($ny == $2 and $nm == $3 and $nd == $4) {
        $relative = 'yesterday';
      }
    }
    if (defined $relative) {
      $string = $1.$relative.$5;
    }
  }
  return $string;
}

##############################################################
# adds or subtracts $relative_days from given date and returns new date
##############################################################
sub date_relative {
  my ($y,$m,$d,$relative_days) = @_;
  my $ctime = timelocal(12,12,12,$d,($m-1),$y);
  my $seconds = 24 * $relative_days * 60 * 60;
  my (undef,undef,undef,$nd,$nm,$ny) = getDateTime($ctime + $seconds);
  #print "date_relative $y-$m-$d -> $ny-$nm-$nd\n";
  return ($ny,$nm,$nd);
}

##############################################################
# removeEXIFData - remove all EXIF data in all selected pictures
##############################################################
sub removeEXIFData {
  my $mode = shift;  # 'all' or 'thumb'
  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, lang("picture(s)"));
  my $selected = @sellist;
  my $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);
  log_it("removing EXIF data of $selected pictures");
  my $i = 0;
  my $errors = '';
  my $pw = progressWinInit($top, "Remove EXIF data");
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "Remove EXIF data ($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 (!removeEXIF($dpic, $mode, \$errors));
    # touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time
    touch(getThumbFileName($dpic));
    updateOneRow($dpic, $picLB);
    showImageInfo($dpic) if ($dpic eq $actpic);
  }
  progressWinEnd($pw);
  log_it("ready! ($i of $selected infos removed)");
  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, lang("picture(s)"));
  my $selected = @sellist;
  my $rc = $top->messageBox(-icon    => 'question',
                            -message => "Extract embedded EXIF thumbnails of $selected selected pictures and write them to a (new created) subfolder \"EXIFThumbs/\" in the current folder.\nShould I continue?",
                            -title => "Question",
                            -type => 'OKCancel');
  return if ($rc !~ m/Ok/i);
  log_it("extracting embedded EXIF thumbnails of $selected pictures");
  if (!-d "$actdir/EXIFThumbs") {
    if ( !mkdir "$actdir/EXIFThumbs", oct(755)) {
      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);
  log_it("ready! ($i of $selected thumbs extracted)");
  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 $count = 0;
  if (!$config{setEXIFDateAskAgain}) {
    my $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};
  my $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');
  log_it("changing the date and time of $selected pictures");
  my $i = 0;
  my $errors = '';
  my $pw = progressWinInit($top, "Changing EXIF date and time");
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "Changing EXIF date and time ($i/$selected) ...", $i, $selected);
    # 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;
          }
          $datetime = getDateTimeEXIFString($ctime);
        } else {
          $errors .= "Wrong month in EXIF date in $dpic\n";
          next;
        }
      } else {
        $errors .= "No EXIF date in $dpic\n";
        next;
      }
    } else {
      warn "setEXIFDate: wrong value: ", $config{EXIFAbsRel};
      return 0; # should not happen
    }
    print "set EXIF datetime: $datetime to $dpic\n" if $verbose;
    next if (not setEXIFDatePic($dpic,$datetime,\$errors));
    $count++;
    # touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time
    touch(getThumbFileName($dpic));
    updateOneRow($dpic, $picLB);
    showImageInfo($dpic) if ($dpic eq $actpic);
  }
  progressWinEnd($pw);
  log_it("ready! ($i/$selected)");
  showText("Errors while adjusting EXIF date", $errors, NO_WAIT) if ($errors ne '');
}

##############################################################
# setEXIFDatePic - set the date/time in the EXIF header for a single picture
##############################################################
sub setEXIFDatePic {
  my $dpic = shift;      # file to process
  my $datetime = shift;  # format: yyyy:mm:dd hh:mm:ss
  my $errors = shift;    # string ref
  my $meta = getMetaData($dpic, 'APP1$');
  if (not defined $meta) {
    $$errors .= "No meta info available: $dpic\n";
    return 0;
  }
  #date time format: 2007:04:04 11:12:13
  my $hash = $meta->set_Exif_data({'DateTime'          => $datetime,
                                   'DateTimeOriginal'  => $datetime,
                                   'DateTimeDigitized' => $datetime}, 'IMAGE_DATA', 'ADD');
  if (keys %$hash) {
    $$errors .= "DateTime record rejeced: $dpic\n";
    return 0;
  }
  unless ($meta->save()) {
    $$errors .= "Save failed $dpic\n";
    return 0;
  }
  return 1;
}

##############################################################
# setEXIFDate - set the year in the EXIF header from file name
##############################################################
sub setEXIFDate_from_file_name {
  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));
  my $selected = @sellist;
  my $count = 0;
  my $rc = $top->messageBox(-icon => 'warning', -message => "This function will extract the year from the file name and set the EXIF date to January, 1st of this year and the time to 12:00:00 in ".scalar @sellist." pictures.\nThe file name must start with the four year digits, else the picture is ignored.\nExample: The EXIF date of a picture named 2009_pic2.jpg will be set to 2009:01:01 12:00:00.\nOk to continue?",
                     -title => "Warning", -type => 'OKCancel');
  return if ($rc !~ m/Ok/i);
  if (!$config{setEXIFDateAskAgain}) {
    my $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');
  }
  log_it("changing the date and time of $selected pictures");
  my $i = 0;
  my $errors = '';
  my $pw = progressWinInit($top, "Changing EXIF date and time");
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "Changing EXIF date and time ($i/$selected) ...", $i, $selected);
    my $pic = basename($dpic);
    # check if file is a link and get the real target
    next if (!getRealFile(\$dpic));
    next if (!checkWriteable($dpic));
    if ($pic =~ m|^(\d\d\d\d).*|) { 
      my $datetime = "$1:01:01 12:00:00";
      print "set EXIF datetime: $datetime to $dpic\n"; # if $verbose;
      next if (not setEXIFDatePic($dpic,$datetime,\$errors));
      $count++;
      # touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time
      touch(getThumbFileName($dpic));
      updateOneRow($dpic, $picLB);
      showImageInfo($dpic) if ($dpic eq $actpic);
    }
    else {
      $errors .= "$pic doesn't start with 4 digits. Skipping.\n";
    }
  }
  progressWinEnd($pw);
  log_it("ready! ($i/$selected)");
  showText("Errors while adjusting EXIF date", $errors, NO_WAIT) if ($errors ne '');
}

##############################################################
# remap_abs_rel
##############################################################
sub remap_abs_rel {
  my $tf = shift;
  my $af = shift;
  my $rf = shift;
  
  if ($config{EXIFAbsRel} eq 'abs') {
    $rf->packForget if ($rf->ismapped);
    $af->pack(-in => $tf, -fill => 'both', -padx => 3, -pady => 3) unless ($af->ismapped);
  }
  else {
    $af->packForget if ($af->ismapped);
    $rf->pack(-in => $tf, -fill => 'both', -padx => 3, -pady => 3) unless ($rf->ismapped);
  }
}

##############################################################
# setEXIFDateDialog - get the date/time info from the user
#                     returns 'OK' or 'Cancel'
##############################################################
sub setEXIFDateDialog {
  my $datetime  = shift; # var ref date time string (absolute)
  my $rc = 'Cancel';
  # open window
  my $dtw = $top->Toplevel();
  $dtw->title('Set EXIF date and time');
  $dtw->iconimage($mapiviicon) if $mapiviicon;
  $dtw->Label(-text => "You may set the date and time to an absolute or relative value")->pack(-anchor => 'w');
  # frame for the absolute/relative radio buttons
  my $arf = $dtw->Frame(-bd => 1, -relief => 'raised')->pack(-fill => 'both', -padx => 3, -pady => 3);
  # frame for the time/date adjustment
  my $tf  = $dtw->Frame(-bd => 1, -relief => 'raised')->pack(-fill => 'both', -padx => 3, -pady => 3);
  my $af  = $tf->Frame();
  my $rf  = $tf->Frame();
  $arf->Radiobutton(-text => "use absolute value", -variable => \$config{EXIFAbsRel}, -value => 'abs', -command => sub { remap_abs_rel($tf, $af, $rf); })->pack(-anchor => 'w', -side => 'left');
  $arf->Radiobutton(-text => "use relative value", -variable => \$config{EXIFAbsRel}, -value => 'rel', -command => sub {remap_abs_rel($tf, $af, $rf); })->pack(-anchor => 'w', -side => 'left');
  remap_abs_rel($tf, $af, $rf);
  ######### absolute
  $af->Label(-text => "Please enter the new date and time to store\nin the selected pictures\n(please use the format: yyyy:mm:dd-hh:mm:ss\nexample: 2009:11:21-11:07:59)", -justify => 'left')->pack(-anchor => 'w');
  my $entry = $af->Entry(-textvariable => \$$datetime,
                         -width => 40,
                        )->pack(-fill => 'x', -padx => 3, -pady => 3);
  # todo that's not enough to switch when focusIn
  #$entry->bind('<FocusIn>', sub { $config{EXIFAbsRel} = 'abs'; $af->update(); } );
  $entry->selectionRange(0,'end');      # select all
  $entry->icursor('end');
  $entry->xview('end');
  ######### relative
  $rf->Radiobutton(-text => "+ (add time)", -variable => \$config{EXIFPlusMin}, -value => "+")->pack(-anchor => 'w');
  $rf->Radiobutton(-text => "- (subtract time)", -variable => \$config{EXIFPlusMin}, -value => "-", -command => sub {$config{EXIFAbsRel} = 'rel'})->pack(-anchor => 'w');
  labeledScale($rf, 'top', 8, 'years',   \$config{EXIFyears}, 0, 100, 1);
  labeledScale($rf, 'top', 8, 'days',    \$config{EXIFdays},  0, 365, 1);
  labeledScale($rf, 'top', 8, 'hours',   \$config{EXIFhours}, 0,  24, 1);
  labeledScale($rf, 'top', 8, 'minutes', \$config{EXIFmin},   0,  59, 1);
  labeledScale($rf, 'top', 8, 'seconds', \$config{EXIFsec},   0,  59, 1);
  my $OKB;
  $entry->bind('<Return>', sub { $OKB->Invoke; } );
  $entry->focus;
  my $ButF = $dtw->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
  $OKB = $ButF->Button(-text => lang('OK'),
                       -command => sub {
                         $rc = 'OK';
                         $dtw->destroy();
                       })->pack(-side => 'left', -expand => 1, -fill => 'x',
                                -padx => 3, -pady => 3);
  my $XBut = $ButF->Button(-text => lang('Cancel'),
                           -command => sub {
                             $rc = 'Cancel';
                             $dtw->destroy();
                           }
                          )->pack(-side => 'left', -expand => 1, -fill => 'x',
                                  -padx => 3, -pady => 3);
  bind_exit_keys_to_button($dtw, $XBut);
  $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, lang("picture(s)"));
  return unless askSelection(\@sellist, 10, "EXIF thumbnail");

  if (!-d $trashdir) { # we need the trash dir for the temp files
    $top->messageBox(-icon => 'warning', -message => "Trash folder $trashdir not found!\nPlease create this folder (shell: mkdir $trashdir) and retry.\n\nAborting.",
                     -title => "No trash folder", -type => 'OK');
    return;
  }

  my $pw = progressWinInit($top, "Show EXIF thumbnail");
  my $i = 0;
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "Show EXIF thumbnail ($i/".scalar @sellist.") ...", $i, scalar @sellist);
    my $pic       = basename($dpic);
    my $exifthumb = "$trashdir/EXIFthumb-$pic";

    if (-f $exifthumb) {
      $top->messageBox(-icon => 'warning', -message => "There is something wrong, $exifthumb already exists.\nPlease delete it first.\nSkipping!",
                       -title => 'Warning', -type => 'OK');
      next;
    }

    my $errors = '';
    extractThumb($dpic, $exifthumb, \$errors);

    if (!-f $exifthumb) {
      $noThumbIn .= "$pic\n";
      next;
    }

    showPicInOwnWin($exifthumb); # show the thumb

    # remove the thumb
    removeFile($exifthumb);
  }
  progressWinEnd($pw);
  showText("No EXIF thumbnail",
           "Sorry, there seems to be no embedded EXIF thumbnail in the following pictures:\n\n$noThumbIn"
           ,NO_WAIT) if ($noThumbIn ne '');
  log_it("ready! ($i of ".scalar @sellist." thumbs)");
}

{ # encapsulate data structure with access methods
  my $copyEXIFDataSource; # local variable for copy/pasteEXIFdata source
  ##############################################################
  # copyEXIFData - copy the EXIF info from one picture to others
  ##############################################################
  sub copyEXIFData {
    my @sellist = $picLB->info('selection');
    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
    log_it(lang("Copy meta information from ").basename($copyEXIFDataSource));
    return;						# that's all for now ;-)
  }
  ##############################################################
  # pasteEXIFData - paste the EXIF info from one picture to others
  ##############################################################
  sub pasteEXIFData {
    my @sellist = $picLB->info('selection');
    my $selected = @sellist;
    my $errors = '';
    my $i = 0;
    return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));
    if ((not defined $copyEXIFDataSource) or (not -f $copyEXIFDataSource)) {
      $top->messageBox(-icon => 'warning', -message => "Please select a source picture (the picture from which the EXIF info should be copied) first by using EXIF info->copy from!",
                       -title => 'Error', -type => 'OK');
      return;
    }
    # get EXIF info and thumbnail for dialog
    my $exif = getShortEXIF($copyEXIFDataSource, WRAP);
    my $EXIFthumb = '';  # temp file holding the embedded EXIF thumbnail
    $EXIFthumb = "$user_data_path/".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');
    log_it("transfering EXIF infos from ".basename($copyEXIFDataSource)." to $selected pictures");
    my $pw = progressWinInit($picLB, 'Copy EXIF data');
    foreach my $dpic (@sellist) {
      last if progressWinCheck($pw);
      $i++;
      progressWinUpdate($pw, "transfering EXIF info ($i/$selected) ...", $i, $selected);
      # 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);
      #showImageInfoCanvas($dpic) if ($dpic eq $actpic);
      # touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time
      touch(getThumbFileName($dpic));
    }
    progressWinEnd($pw);
    log_it("ready! ($i/$selected copied)");
    showText('Errors while copying EXIF infos', $errors, NO_WAIT) if ($errors ne '');
  }
  ##############################################################
  # copyThumbnail
  ##############################################################
  sub copyThumbnail {
    my @sellist  = $picLB->info('selection');
    my $selected = @sellist;
    return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));
    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');
    log_it("transfering thumbnail to $selected pictures");
    my $errors = '';
    my $i = 0;
    my $pw = progressWinInit($top, "Copy thumbnail");
    foreach my $dpic (@sellist) {
      last if progressWinCheck($pw);
      $i++;
      progressWinUpdate($pw, "transfering thumbnail ($i/$selected) ...", $i, $selected);
      # 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(getThumbFileName($dpic));
    }
    progressWinEnd($pw);
    log_it("ready! ($i/$selected thumbnails transfered)");
    showText("Errors while transfering thumbnails", $errors, NO_WAIT) if ($errors ne '');
  }
} # end encapsulation

##############################################################
# 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 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, lang("picture(s)"));
  # make EXIF subdir
  return if (!makeDir("$actdir/$exifdirname", ASK));
  my $errors = '';
  my $i = 0;
  my $pw = progressWinInit($top, "Save EXIF infos");
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "Saving EXIF info ($i/".scalar @sellist.") ...", $i, scalar @sellist);
    my $pic      = basename($dpic);
    my $exiffile = "$actdir/$exifdirname/$pic";
    # check if file is a link and get the real target
    next if (!getRealFile(\$dpic));
    my $meta = getMetaData($dpic, '^APP1$', 'FASTREADONLY');
    unless (defined $meta) {
      $errors .= "Could not get EXIF info of $pic!\n";
      next;
    }
    my $seg = extract_app1_Exif_segment($meta);
    unless (defined $seg) {
      $errors .= "Could not get EXIF segment of $pic!\n";
      next;
    }
    unless (nstore($seg, $exiffile)) {
      $errors .= "could not store EXIF segment in file $exiffile: $!\n";
      next;
    }
    updateOneRow($dpic, $picLB); # display the new exif info (flag [s] is now set)
    showImageInfo($dpic) if ($dpic eq $actpic);
  }
  progressWinEnd($pw);
  log_it("ready! ($i/".scalar @sellist." saved)");
  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, lang("picture(s)"));
  if (!-d "$actdir/$exifdirname") {
      $top->messageBox(-icon => 'warning', -message => "Found no saved EXIF infos in this folder!",
                       -title => "No EXIF infos", -type => 'OK');
      return;
    }
  # message for one picture
  my $message = "Restore saved EXIF infos to ".basename($sellist[0]).".\nThe actual EXIF infos of this picture will be lost!\nOk to continue?";
  # message for more than one picture
  if (@sellist > 1) {
    $message = "Restore saved EXIF infos\nto the ".scalar @sellist." pictures.\nThe actual EXIF infos of this picture will be lost!\nOk to continue?"
  }
  return if (myButtonDialog("Restore EXIF data", "$message", undef, 'OK', 'Cancel') ne 'OK');
  my $errors = '';
  my $i      = 0;
  my $pw     = progressWinInit($top, "Restore EXIF info");
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "Restore EXIF info ($i/".scalar @sellist.") ...", $i, scalar @sellist);
    my $pic       = basename($dpic);
    my $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(getThumbFileName($dpic));
  }
  progressWinEnd($pw);
  log_it("ready! ($i/".scalar @sellist."restored)");
  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, lang("picture(s)"));

  if (!-d "$actdir/$exifdirname") {
      $top->messageBox(-icon => 'warning', -message => "Sorry, but there are no saved EXIF infos in this folder!",
                       -title => "no EXIF infos", -type => 'OK');
      return;
    }
  my $rc = $top->messageBox(-icon => 'warning', -message => "Remove the saved EXIF infos and the embedded thumbnails of ".scalar @sellist." pictures.\nOk to continue?",
                     -title => "Warning", -type => 'OKCancel');
  return if ($rc !~ m/Ok/i);
  my $i = 0;
  my $pw = progressWinInit($top, "Remove saved EXIF infos");
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "Removing saved EXIF info ($i/".scalar @sellist.") ...", $i, scalar @sellist);
    my $pic       = basename($dpic);
    my $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);
  log_it("ready! ($i/".scalar @sellist." exif removed)");
}

##############################################################
# copyComment - copy the comment from one picture to others
##############################################################
sub copyComment {
  my $direction = shift;  #  "from" or "to"
  if (!defined $direction) {
    warn "copyComment: Missing a direction, should be \"from\" or \"to\"!";
    return;
  }
  my @sellist  = $picLB->info('selection');
  my $selected = @sellist;
  my $i = 0;
  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
    log_it("copy source set to ".basename($copyCommentSource));
    return;						# that's all for now ;-)
  }
  elsif ($direction eq 'to') {
    return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));
    if ((!defined $copyCommentSource) or (!-f $copyCommentSource)) {
      $top->messageBox(-icon => 'warning', -message => "Please select a source picture (the picture from which comments should be taken) first, and than choose comments->copy from!",
                       -title => 'Error', -type => 'OK');
      return;
    }
    my $com   = getComment($copyCommentSource, SHORT);
    my $thumb = getThumbFileName($copyCommentSource);
    my $message = "Add 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');
    log_it("transfering comments to $selected pictures");
    my $pw = progressWinInit($top, "Transfer comments");
    foreach my $dpic (@sellist) {
      last if progressWinCheck($pw);
      $i++;
      progressWinUpdate($pw, "transfering comments ($i/$selected) ...", $i, $selected);
      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(getThumbFileName($dpic));
    } # foreach end
    progressWinEnd($pw);
  }
  else {
    warn "copyComment: Wrong direction ($direction), should be \"from\" or \"to\"!";
    return;
  }
  log_it("ready! ($i of $selected copied)");
}

##############################################################
# 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, lang("picture(s)"));
  return unless askSelection(\@sellist, 10, "IPTC info");
  my $i = 0;
  my $pw = progressWinInit($lb, "Display IPTC data");
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    my $iptc = '';
    progressWinUpdate($pw, "displaying IPTC data ($i/".scalar @sellist.") ...", $i, scalar @sellist);
    my $pic = basename($dpic);
    # check if file is a link and get the real target
    next if (!getRealFile(\$dpic));
    my $title = "IPTC/IIM information of $pic";
    $iptc = getIPTC($dpic, LONG);
    if ($iptc eq '') {
      $iptc = "Found no IPTC/IIM information in \"$pic\"\n";
    }
    showText($title, $iptc, NO_WAIT, getThumbFileName($dpic));
  }
  progressWinEnd($pw);
  if ($lb == $picLB) {
    log_it("ready! ($i/".scalar @sellist." IPTC displayed)");
  }
}

##############################################################
# saveIPTC - save IPTC info hash as template to a file
##############################################################
sub saveIPTC {
  my $lb = shift;
  my @sellist = getSelection($lb);
  return unless checkSelection($lb, 1, 1, \@sellist, lang("picture(s)"));
  my $dpic = $sellist[0];
  my ($ok, $iptc) = get_IPTC_info($dpic);
  if (not $ok) {
    $top->messageBox(-icon => 'warning', -message => "Could not open IPTC segment of $dpic!",
                     -title => "Save IPTC info", -type => 'OK');
    return;
  }
  if (!-d $iptcdir) {
    if ( !mkdir $iptcdir, oct(755) ) {
      $top->messageBox(-icon => 'warning', -message => "Error making IPTC template folder $iptcdir: $!",
                       -title => "Save IPTC template", -type => 'OK');
      return;
    }
  }
  my $types = [ ['IPTC Template', '.iptc2',], ['All Files', '*',], ];
  my $file = $top->getSaveFile(-title => 'Save IPTC template (please use the .iptc2 suffix)', -defaultextension => 'iptc2', -initialfile => "template.iptc2", -initialdir => $iptcdir, -filetypes => $types);
  return if ((!defined $file) or ($file eq ''));
  my $rc = nstore($iptc, $file) or warn "could not store IPTC in file $file: $!";
  log_it("IPTC template saved ($rc)");
}

{ # encapsulate data structure with access methods
  my $iptcCopySource; # local variable to store path and picture name for copyIPTC/pasteIPTC
  ##############################################################
  # 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;
    }
    $iptcCopySource = $sellist[0];
    log_it("IPTC copy from $iptcCopySource");
  }
  ##############################################################
  # pasteIPTC
  ##############################################################
  sub pasteIPTC {
    my @sellist = $picLB->info('selection');
    return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));
    if (not defined $iptcCopySource or not -f $iptcCopySource) {
      $top->messageBox(-icon => 'warning', -message => "Please select a copy source picture first.",
                       -title => "Paste IPTC info", -type => 'OK');
      return;
    }
    # get IPTC info from source picture (set by copyIPTC)
    my $meta = getMetaData($iptcCopySource, 'APP13');
    my $iptcCopy = $meta->get_app13_data('TEXTUAL', 'IPTC');
    unless (defined $iptcCopy) {
      $top->messageBox(-icon => 'warning', -message => "There is no IPTC info in source picture $iptcCopySource! Stopping.",
                       -title => "Paste IPTC info", -type => 'OK');
      return;
    }
    applyIPTC($picLB, $iptcCopy, \@sellist);
    my $sel_pics = scalar(@sellist);
    log_it(langf("Meta information from %s added to %d picture(s).",basename($iptcCopySource),$sel_pics));
  }
}

##############################################################
# mergeIPTC - merge a IPTC info hash template to a file
##############################################################
sub mergeIPTC {
  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));
  my $types = [ ['IPTC Template', '.iptc2',], ['All Files', '*',], ];
  my $file = $top->getOpenFile(-title => 'Merge IPTC template', -defaultextension => 'iptc2', -initialdir => $iptcdir, -filetypes => $types);
  return if ((!defined $file) or ($file eq '') or (!-f $file));
  my $iptc = retrieve($file);
  unless (defined $iptc) {
    warn langf("Could not retrieve %s",$file);
    return;
  }
  applyIPTC($picLB, $iptc, \@sellist);
}

##############################################################
# applyIPTC - apply a IPTC info hash to a list of pics
##############################################################
sub applyIPTC {
  my $lb      = shift; # reference to listbox widget
  my $iptc    = shift; # reference to an IPTC hash as provided by Image::MetaData::JPEG
  my $piclist = shift; # picture list reference
  my $errors = '';
  my $pw = 0;
  $pw = progressWinInit($lb, 'Apply IPTC template') if (@$piclist > 1);
  my $i = 0;
  foreach my $dpic (@$piclist) {
    last if ($pw and progressWinCheck($pw));
    $i++;
    progressWinUpdate($pw, "applying IPTC template ($i/".scalar @$piclist.") ...", $i, scalar @$piclist) if $pw;
    my ($ok, $error) = applyIPTCint($dpic, $iptc);
    if ($ok) {
      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 .= $error;
    }
  }
  progressWinEnd($pw) if $pw;
  log_it("ready! ($i of ".scalar @$piclist." processed)");
  showText('Errors while applying IPTC infos', $errors, NO_WAIT) if ($errors ne '');
}

##############################################################
##############################################################
sub applyIPTCint {
  my $dpic = shift;
  my $iptc = shift; # reference to an IPTC hash as provided by Image::MetaData::JPEG
  my $error = '';
  if (not checkWriteable($dpic)) {
    $error .= "File $dpic is not writable! Skipping.\n";
    return (0, $error); 
  }
  my $meta = getMetaData($dpic, 'APP13');
  if (not defined $meta) {
    $error .= "Could not get IPTC info of $dpic!";
    return (0, $error);
  }
  # 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 (not $meta->save()) {
    $error .= "Saving IPTC info failed for $dpic\n";
    return (0, $error);
  }
  return (1, $error);
}

##############################################################
# uniqueArray
##############################################################
sub uniqueArray {
    my $listR = shift;
    my %d;   # build a hash
    foreach (@{$listR}) { $d{$_} = 1; }
    @{$listR} = (sort { uc($a) cmp uc($b); } keys %d);
}

##############################################################
# uniqueIPTC - remove double entries from SupplementalCategories
#              and Keywords and sort them alphabetically
#              !Function will not save IPTC!
##############################################################
sub uniqueIPTC {
    my $meta = shift;
    my $iptc = $meta->get_app13_data('TEXTUAL', 'IPTC');
    
    # replace (german) umlaute by corresponding letters and
    # replace all non-printable chars, but not newline etc.
    if ($config{onlyASCII}) {
      foreach my $key (keys %{$iptc}) {
        if (${$iptc->{$key}}[0]) {
		  # test some encodings
          #my $utf8code = Encode::decode('utf8',${$iptc->{$key}}[0]);
          #my $isocode  = Encode::decode('iso-8859-1',${$iptc->{$key}}[0]);
		  #if ($utf8code =~ m/Ö/) {
		  #  print "Found Ö in utf8code $utf8code ${$iptc->{$key}}[0]\n";
	      #}
		  #if ($isocode =~ m/Ö/) {
		  #  print "Found Ö in isocode $isocode ${$iptc->{$key}}[0]\n";
	      #}
		  # end test encodings
          ${$iptc->{$key}}[0] =~ s/([$umlaute])/$umlaute{$1}/g;
          ${$iptc->{$key}}[0] =~ tr/\n\t\r\f -~//cd;
        }
      }
    }

    my %d;   # build a hash
    foreach (@{$iptc->{SupplementalCategory}}) {
      $_ =~ tr/ -~//cd; # replace all non-printable chars
      $d{$_} = 1;
    }
    @{$iptc->{SupplementalCategory}} = (sort { uc($a) cmp uc($b); } keys %d);

    %d = (); # completely empty %d
    foreach (@{$iptc->{Keywords}}) {
      $_ =~ tr/ -~//cd; # replace all non-printable chars (Picasa adds one to each keyword)
      $d{$_} = 1;
    }
    @{$iptc->{Keywords}} = (sort { uc($a) cmp uc($b); } keys %d);

    $meta->set_app13_data($iptc, 'REPLACE', 'IPTC');
}

##############################################################
# editIPTCCategories
##############################################################
sub editIPTCCategories {

  my $lb = shift;
  if (Exists($catw)) {
    $catw->deiconify;
    $catw->raise;
    $catw->focus;
    return;
  }

  # open window
  $catw = $lb->Toplevel();
  $catw->withdraw;
  $catw->title('Categories');
  $catw->iconimage($mapiviicon) if $mapiviicon;

  my $cattree;

  my $XBut = $catw->Button(-text => lang('Close'),
                           -command => sub {
                               saveTreeMode($cattree);
                               nstore($cattree->{m_mode}, "$user_data_path/categoryMode") or warn "could not store $user_data_path/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 => lang('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 => lang('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);
  $balloon->attach($cattree, -msg => "Double click on a category to add it to the selected pictures.\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 "$user_data_path/categoryMode") {
    my $hashRef = retrieve("$user_data_path/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);
  bind_exit_keys_to_button($catw, $XBut);
  $catw->Popup;
  $catw->waitWindow;
}

##############################################################
# format given keyword list (reference) according to the configured format (all, joined, or last)
# return formated list
##############################################################
sub keyword_format {
  my $keys = shift; # list reference
  my $warning = shift; # string reference
  my @keylist;
  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 "keyword_format: \$config{KeywordsAll} has wrong value: $config{KeywordsAll} should never be reached!";
    }
    push @keylist, @items;
  }
  return @keylist;
}                 

##############################################################
# 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 => lang('Close'),
                          -command => sub {
                              saveTreeMode($keytree);
                              nstore($keytree->{m_mode}, "$user_data_path/keywordMode") or warn "could not store $user_data_path/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, lang("keyword(s)"));
                      my @sellist = $lb->info('selection');
                      return unless checkSelection($keycw, 1, 0, \@sellist, lang("keyword(s)"));
                      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");

  $keytree = $keycw->Scrolled('Tree',
                             -separator  => '/',
                             -scrollbars => 'osoe',
                             -selectmode => 'extended',
                             -exportselection => 0,
                             -width      => 25,
                             -height     => 25,
                             )->pack(-expand => 1, -fill =>'both', -padx => 4, -pady => 2);
  $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 "$user_data_path/keywordMode") {
    my $hashRef = retrieve("$user_data_path/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);
  bind_exit_keys_to_button($keycw, $XBut);
  $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 $hot     = shift; # the hotlist widget (optional, if available the additional menu entry "add to clipboard" will be shown)
  my $menu = $tree->Menu(-title => lang('Tree edit menu'));
  if (defined $hot and Exists($hot)) {
    $menu->command(-label => lang('add to clipboard'), -command => sub {
      my @keys = $tree->info('selection');
      return unless checkSelection($tree, 1, 0, \@keys);
      add_keyword_to_hotlist($hot, \@keys);
    });
    $menu->separator;
  }
  $menu->command(-label => lang('add new item'), -command => sub {
    my @keys = $tree->info('selection');
    return unless checkSelection($tree, 1, 1, \@keys);
    my $item = '';
    my $parent = '';
    $parent = $keys[0] if (@keys);
    if ($parent !~ m/.*\/.*/) {
      $parent = '';
    }
    else {
      # cut of last element
      $parent  = $1 if ($parent =~ m/(.*\/).*/);
      $parent .= '/' if (($parent ne '') and ($parent !~ m/.*\/$/));
    }
    my $rc = myEntryDialog(lang('New item'),
    langf("Please enter the new item (below %s)",$parent),
    \$item);
    return if ($rc ne 'OK');
    return if ($item eq '');

    # avoid slash and backslash
    if (($item =~ m|.*\/.*|) or ($item =~ m|.*\\.*|)) {
      $tree->messageBox(-icon  => 'info',
      -message => 'Sorry, but the slash (/) and the backslash (\) are not allowed.',
      -title => 'Wrong character', -type => 'OK');
      return;
    }

    # avoid double entries
    if (isInList($parent.$item, $listRef)) {
      $tree->messageBox(-icon  => 'info',
      -message => "Sorry, but $parent$item is already in the list.",
      -title => 'Double entry', -type => 'OK');
      return;
    }

    push @{$listRef}, $parent.$item;
    insertTreeList($tree, @{$listRef});
    # show new keywords
    filter_tree_open($tree, '', $item);
  });

  $menu->command(-label => lang('add new sub item'), -command => sub {
    my @keys = $tree->info('selection');
    return unless checkSelection($tree, 1, 1, \@keys);
    my $item = '';
    my $parent = $keys[0];
    my $rc = myEntryDialog(lang('New sub item'),
    langf("Please enter the new sub item (below %s)",$parent),
    \$item);
    return if ($rc ne 'OK');
    return if ($item eq '');
    # avoid slash and backslash
    if (($item =~ m|.*\/.*|) or ($item =~ m|.*\\.*|)) {
      $tree->messageBox(-icon  => 'info',
      -message => 'Sorry, but the slash (/) and the backslash (\) are not allowed.',
      -title => 'Wrong character', -type => 'OK');
      return;
    }
    $parent .= '/' if (($parent ne '') and ($parent !~ m/.*\/$/));
    # avoid double entries
    if (isInList($parent.$item, $listRef)) {
      $tree->messageBox(-icon  => 'info',
      -message => "Sorry, but $parent$item is already in the list.",
      -title => 'Double entry', -type => 'OK');
      return;
    }
    push @{$listRef}, $parent.$item;
    insertTreeList($tree, @{$listRef});
    # show new keywords
    filter_tree_open($tree, '', $item);
  });

  $menu->separator;
  $menu->command(-label => lang('rename or move 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
    foreach my $t (0 .. @{$listRef}-1) {
      # find index and change list entry
      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 => lang('delete item(s)'), -command => sub {
    my @keys = $tree->info('selection');
    return unless checkSelection($tree, 1, 0, \@keys);
    for my $t (reverse 0 .. (scalar @{$listRef} - 1) ) {
      foreach my $key (@keys) {
        if ($$listRef[$t] =~ m/^$key.*/) {
          print "  trow out: $$listRef[$t] ($t) key = $key\n" if $verbose;
          splice @{$listRef}, $t, 1;  # remove it from list
        }
      }
    }
    insertTreeList($tree, @{$listRef});
  });

  $menu->separator;
  $menu->command(-label => lang('search for item(s)'), -command => sub {
    my @keys = $tree->info('selection');
    return unless checkSelection($tree, 1, 0, \@keys);
    my @keywords;
    # here we consider all selected keywords for the search
    foreach (@keys) {
      push @keywords, split(/\//, $_);
    }
    my @keywords_ex;
    my @list = get_pics_with_keywords(\@keywords, \@keywords_ex);
    my $title = 'Keywords: '; $title .= "$_ " foreach (@keywords);
    showThumbList(\@list, $title);
  });
  
  $menu->separator;
  $menu->command(-label => lang('collapse all'), -command => sub { tree_fold(CLOSE, $tree); });
  $menu->command(-label => lang('collapse to first sub level'), -command => sub {
    my @keys = $tree->info('selection');
    return unless checkSelection($tree, 1, 0, \@keys);
    for my $key (@keys) {
      my @childs = $tree->child_entries($key, 1); # path, depth
      foreach my $child (@childs) {
        $tree->close($child);
      }
    }
  });
  $menu->command(-label => lang('expand all'), -command => sub { tree_fold(OPEN, $tree); });
  #$menu->command(-label => lang("expand item(s)"), -command => sub {
  #  my @keys = $tree->info('selection');
  #  return unless checkSelection($tree, 1, 0, \@keys);
  #  for my $key (@keys) {
  #    print "expand: $key\n";
  #    my @childs = $tree->child_entries($key, 1); # path, depth
  #    foreach my $child (@childs) {
  #      print "  child: $child\n";
  #      $tree->open($child);
  #    }
  #  }
  #});
  
  $tree->bind('<ButtonPress-3>',   sub {
    $menu->Popup(-popover => 'cursor', -popanchor => 'nw');
  } );
}

##############################################################
##############################################################
sub add_keyword_to_hotlist {
  my ($hot, $keys) = @_;
  foreach my $key (@{$keys}) {
    $hot_keywords{$key}++;
  }
  $hot->delete(0, 'end');
  $hot->insert('end', (sort keys %hot_keywords));
  return;
}

##############################################################
# 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 status) 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;
  print "saveTreeMode: Error no widget\n" unless Exists($tree);
  my %mode;
  %mode = %{$tree->{m_mode}} if (defined $tree->{m_mode});
  # save mode (open, close) of existing items for the first 3 levels
  foreach ($tree->info('children')) {
    $mode{$_} = $tree->getmode($_);
    foreach ($tree->info('children', $_)) {
      $mode{$_} = $tree->getmode($_);
      foreach ($tree->info('children', $_)) {
        $mode{$_} = $tree->getmode($_);
      }
    }
  }
  $tree->{m_mode} = \%mode;
}

##############################################################
# removeIPTCItem
##############################################################
sub removeIPTCItem {
    my $dpic = shift;
    my $kind = shift;
    my $item = shift;

    if (($kind ne 'Keywords') and ($kind ne 'SupplementalCategory')) {
        warn "removeIPTCItem: $kind is wrong kind";
        return;
    }

    print "removeIPTCItem: kind:$kind item:$item pic:$dpic\n" if $verbose;

    my $meta = getMetaData($dpic, 'APP13');
    unless (defined $meta) {
        print "removeIPTCItem: Could not create IPTC info for $dpic!\n";
        return;
    }

    my $iptc = $meta->get_app13_data('TEXTUAL', 'IPTC');

    my %d;   # build a hash
    foreach (@{$iptc->{$kind}}) { $d{$_} = 1; }
    return unless (defined $d{$item});
    delete $d{$item}; # remove item from list
    @{$iptc->{$kind}} = (sort { uc($a) cmp uc($b); } keys %d);
    $meta->set_app13_data($iptc, 'REPLACE', 'IPTC');

    if ($meta->save()) {
        my $dirthumb = getThumbFileName($dpic);
        # touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time
        touch($dirthumb);
    }
    else {
        print "removeIPTCItem: save failed for $dpic\n";
    }
}

#my %get_encoding_name_from_tag = (
#  "0x1b0x250x47" => "UTF8",

# stolen from Image::ExifTool (thanks to Phil Harvey)
#------------------------------------------------------------------------------
# Print conversion for CodedCharacterSet
# Inputs: 0) value
sub PrintCodedCharset {
  my $val = shift;
  return $iptcCharset{$val} if $iptcCharset{$val};
  $val =~ s/(.)/ $1/g;
  $val =~ s/ \x1b/, ESC/g;
  $val =~ s/^,? //;
  return $val;
}

##############################################################
# getIPTC - returns all IPTC-Data of the given picture
##############################################################
sub getIPTC {
  # the pic with complete path
  my $dpic = shift;
  # bool, if = LONG  a better complete readable output,
  #       if = SHORT a compact but complete IPTC info for e.g. the search database
  #       if = MICRO compact, only values no key names
  my $format = shift;
  my $meta   = shift; # optional, the Image::MetaData::JPEG object of $pic if available
  my $iptc = '';
  my $indent = ''; # space to indent multi key values
  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) {
            my $shortkey = $key;
            $shortkey = substr($shortkey, 0, 13)."." if (length($shortkey) > 14);
            $iptc .= sprintf "%-14s: ", $shortkey;
            #$iptc .= sprintf "%-31s: ", $key;
            $indent = "\n                ";
            #$indent = "\n                                 ";
          } elsif ($format == MICRO) { # show only content, no key names
            $indent = " ";
          } else {
            my $shortkey = $key;
            $shortkey =~ s/SupplementalCategory/SuppCategories/;
            $shortkey = substr($shortkey, 0, 7)."." if (length($shortkey) > 8);
            $iptc .= sprintf "%-8s: ", $shortkey;
            $indent = " ";
          }
          # add IPTC value
          for (@{$hashref->{$key}}) {
            # show rating/urgency using stars (*) at least in MICRO output
            # todo : could make sense also for the other outputs, but check consequences first
            # e.g. on IPTC values of search db!!!
            if (($format == MICRO) and ($key eq 'Urgency')) {
              $iptc .= iptc_rating_stars_urg($_).$indent;
            }
            else {
              $iptc .= "$_$indent";
            }
          }
          $iptc =~ s/$indent$//; # remove last indent (newline/space after last value) 
          $iptc .= "\n"; # newline for each defined IPTC attribute
        }
      }
      # add Coded Character Set info
      my $hash_1 = $seg->get_app13_data('TEXTUAL', 'IPTC_1');
      if (defined $hash_1->{'CodedCharacterSet'}) {
        my $encoding = PrintCodedCharset(${$hash_1->{'CodedCharacterSet'}}[0]);
        if (($format == LONG)) {
          $iptc .= sprintf "%-31s: ", 'CodedCharacterSet';
        } elsif ($format == MICRO) { # show only content, no key names
        } else {
          $iptc .= 'CCharSet: ';
        }
        $iptc .= "$encoding\n";
        #print "found Coded character set in $dpic: [$encoding][${$hash_1->{'CodedCharacterSet'}}[0]]\n";
      }
    }
  }
  $iptc =~ s/\s+$//;		 # cut trailing whitespace
  $iptc =~ tr/\n -~//cd; # remove all non-printable chars, but not newline
  return $iptc;
}

##############################################################
# getShortIPTC - get just one attribute of the IPTC comment
#                I decided to use the caption/abstract, but
#                I am not sure if this is the best attribute
#                here?
#                if there is no file or no IPTC info in the file
#                an empty string is returned
##############################################################
sub getShortIPTC {
  my $dpic = shift;
  # optional, if set to LONG the complete contents of the @iptcs attributes
  # (see below) will be returned
  # else (SHORT) it will be cut to fit in the hlist
  my $format = shift; # LONG or SHORT

  return '' unless (-f $dpic);

  my $info = getIPTC($dpic, SHORT);

  $info = formatString($info, $config{LineLength}, $config{LineLimit}) if ((defined $format) and ($format == SHORT));

  return $info;
}

##############################################################
# getImageInfo - returns a hash containing the image info
##############################################################
sub getImageInfo {

  my $pic = shift;
  if (!-f $pic) {
    return '';
  }
  my $ii = image_info($pic);
  if (!$ii) {
    return '';
  }

  if ($ii->{Errno} and $ii->{Errno} ne "0") {
    return '';
  }
  return $ii;
}

##############################################################
# getNearestItem - finds the nearest item to the mouse pointer
#                  in a listbox
##############################################################
sub getNearestItem {
   my($LB) = @_;
   my ($X,$Y) = $LB->pointerxy();
   my $y = $LB->rooty();
   my $yy = $Y - $y;
   return ($LB->nearest($yy));
}

##############################################################
# processARGV - handels the command line arguments (if any)
##############################################################
sub processARGV {
  getopts('iv'); # sets $opt_i if switch -i is found - import pictures
  #getopts('v'); # sets $opt_v if switch -v is found - verbose logging
  #getopts('h'); # sets $opt_h if switch -h is found - help
  $verbose = 1 if ($opt_v);
  my $nr = @ARGV;
  if ($nr < 1) { # no arguments - open the last dir
    $actdir = $config{LastDir};
    dirSave($actdir);
    return;
  }
  if ($nr > 1) { # too many arguments
    print "Mapivi error: to many command line options\n";
    printUsage();
    exit;
  }
  #if ($opt_h) { # -h flag -> help
   # printUsage();
   # exit;
  #}
  my $item = abs_path($ARGV[0]);
  #print "processARGV: -e $item = ", -e $item, "\n";
  $item = Encode::encode('iso-8859-1', $item);
  #print "processARGV: item: $item  item2: $item2\n";
  #print "processARGV: -e $item = ", -e $item, "\n";
  if (-f $item) {
    $actpic  = $item;
    $actdir  = dirname($item);
  }
  elsif (-d $item) {
    $actdir  = $item;
  }
  else {
    printUsage();
    exit;
  }
  dirSave($actdir);
}

##############################################################
# re-read all meta information from picture files
##############################################################
sub reread_pics {
    my $lb = shift;
    my @sellist = $lb->info('selection');
    # check selection args: widget, min, max, listref, itemkind (e.g. "picture")
    return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));
    $lb->Busy;
    log_it("Reading meta-info of ".scalar @sellist." files ...");
    foreach my $dpic (@sellist) {
      updateOneRow($dpic, $lb);
    }
    $lb->Unbusy;
    log_it("ready! (re-read ".scalar @sellist." files)");
}

##############################################################
# open_pic_folder - open the folder containing the selected pictures
##############################################################
sub open_pic_folder {
    my $lb = shift;
    my @sellist = $lb->info('selection');
    # check selection args: widget, min, max, listref, itemkind (e.g. "picture")
    return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));
    my %folders;
    # check for all possible folders
    foreach my $dpic (@sellist) {
      $folders{dirname($dpic)}++;
    }
    my $folder;
    # all selected pictures are located in the same folder
    if (scalar keys %folders == 1) {
      $folder = $_ foreach (keys %folders);
    }
    # picture from different folders have been selected
    else {
      # todo: let the user choose which folder to open
      # take the folder of the first pic
      $folder = dirname($sellist[0]);
      my $rc = $top->messageBox(-icon  => 'question', -message => "The selected pictures are stored in ".scalar(keys(%folders))." different folders. Proceed with first folder: $folder?",
                       -title => "Proceed?", -type => 'OKCancel');
      return if ($rc !~ m/Ok/i);
    }
    openDirPost($folder);
}

##############################################################
# openDir - let the user select a new dir and open it
#           with a dir dialog
##############################################################
sub openDir {
  my $dir = dirDialog($actdir);
  openDirPost($dir);
}

##############################################################
# openDirPost - things to do when opening a new dir
##############################################################
sub openDirPost {
  my $dir = shift;
  $dir = Encode::encode('iso-8859-1', $dir);
  $dir =~ s|\\|/|g;    # perl likes slashes (/ = UNIX style) instead of backslash (\ = Windows style)
  $dir =~ s/\/\//\//g; # replace all double slashes (//)  with single slashes (/)
  return unless (defined $dir);
  return unless (-d $dir);
  $actdir = $dir;
  my $path = cutString($dir, -22, '..');
  log_it(lang('Opening')." $path ...");
  $actpic = ''; # reset var $actpic - needed to get a correct window title
  setDirProperties();
  dirSave($dir);
  clearLabels();
  clear_canvas_thumbs($c);
  showImageInfoCanvas();
  setTitle();
  $commentText->delete( 0.1, 'end') if ($config{ShowCommentField} and defined $commentText);
  # update_IPTC_frame_content(''); # now included in showImageInfoCanvas
  $dirtree->configure(-directory => $actdir);
  # Set the folder
  exists &Tk::DirTree::chdir ? $dirtree->chdir($actdir) : $dirtree->set_dir($actdir);
  selectDirInTree($actdir);
  # switch display modus to folder
  $act_modus = FOLDER;
  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});
}

##############################################################
# showDirProperties
##############################################################
sub showDirProperties {

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

  # open window
  $dpw = $top->Toplevel();
  $dpw->withdraw;
  $dpw->title(lang('Folder Checklist'));
  $dpw->iconimage($mapiviicon) if $mapiviicon;

  my $topf = $dpw->Frame()->pack();
  my $topf2 = $dpw->Frame()->pack();
  my $window_label = '...';
  
  my $dplb = $dpw->Scrolled("HList",
                            -header     => 1,
                            -separator  => ';',  # todo here we hope that ; will never be in a folder or file name
                            -pady       => 1,
                            -columns    => 5,
                            -scrollbars => 'osoe',
                            #-selectmode => "dragdrop", todo
                            -selectmode => "extended",
                            -background => $conf{color_bg}{value}, #8fa8bf
                            -width      => 40,
                            -height     => 60,
                            )->pack(-expand => 1, -fill => 'both');
  my $count = 0;
  $dplb->{dircol} = $count;
  $dplb->header('create', $count++, -text => lang('Folder'), -headerbackground => $conf{color_entry}{value});
  $dplb->{sortcol} = $count;
  $dplb->header('create', $count++, -text => lang('1 Sort'), -headerbackground => $conf{color_entry}{value});
  $dplb->{metacol} = $count;
  $dplb->header('create', $count++, -text => lang('2 Meta'), -headerbackground => $conf{color_entry}{value});
  $dplb->{priocol} = $count;
  $dplb->header('create', $count++, -text => lang('3 Rating'), -headerbackground => $conf{color_entry}{value});
  $dplb->{commcol} = $count;
  $dplb->header('create', $count++, -text => lang('Comment'), -headerbackground => $conf{color_entry}{value});

  my $Xbut = $topf->Button(-text => lang("Close"),
                          -command => sub { $dpw->withdraw; $dpw->destroy; }
                          )->pack(-side => 'left', -expand => 0,-fill => 'x',-padx => 3,-pady => 3);

  my $upd_but = $topf->Button(-text => lang("Update"),
                              -command => sub {
                                my @dirs = $dplb->info('selection');
                                my $last = $dirs[-1];
                                $dplb->delete("all");
                                insertDirProperties($dplb, \$window_label);
                                reselect($dplb, @dirs);
                                $dplb->see($last) if ($dplb->info("exists", $last));;
                              })->pack(-side => 'left', -expand => 0,-padx => 3,-pady => 3);

  $topf->Checkbutton(-text => lang("Show unfinished"),
                     -variable => \$config{ShowUnfinishedDirs},
                     -command => sub { $upd_but->Invoke; },
                     )->pack(-side => 'left', -expand => 0,-fill => 'x',-padx => 3,-pady => 3);
  $topf->Checkbutton(-text => lang("Show finished"),
                     -variable => \$config{ShowFinishedDirs},
                     -command => sub { $upd_but->Invoke; },
                     )->pack(-side => 'left', -expand => 0,-fill => 'x',-padx => 3,-pady => 3);
  $topf->Button(-image => $mapivi_icons{Help},  -pady => 0,  -padx => 0,
        -command => sub {
            showText("Help for Folder Checklist", "The purpose of this list is to give an overview about all picture folders.\nThe green folders are finshed (all three merkers are set), the blue folders are unfinsihed, the red folders are missing (may have been deleted or renamed).\n\nDouble click on any folder to open it in the main window or use the context menu to set or reset any markers.", NO_WAIT);
      })->pack(-expand => 0, -side => 'left', -fill => 'x', -padx => 3, -pady => 3);

  $topf2->Label(-textvariable => \$window_label)->pack(-side => 'left', -expand => 0,-fill => 'x',-padx => 3,-pady => 3);

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

  $dpmenu->command(-label => lang("Open folder"),
                   -command => sub {
                       my @dirs  = $dplb->info('selection');
                       return unless checkSelection($dpw, 1, 1, \@dirs);
                       if (-d $dirs[0]) {
                         openDirPost($dirs[0]);
                         # show main window
                                         $top->deiconify;
                                         $top->raise;
                       } else {
                         $dplb->messageBox(-icon => 'info', -message => "Sorry, but this folder is currently not available!", -title => "Folder not available", -type => 'OK');
                       }
                      } );
  $dpmenu->command(-label => lang("Add all sub folders to 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 => lang("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 => lang("Edit folder 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 => lang("1 Sort"));
  my $meta_menu = $dpmenu->cascade(-label => lang("2 Meta"));
  my $prio_menu = $dpmenu->cascade(-label => lang("3 Rating"));
  my $all_menu  = $dpmenu->cascade(-label => lang("All"));
  $sort_menu->command(-label => lang("set"),   -command => sub { setProperty($dplb, 'SORT', 1); } );
  $sort_menu->command(-label => lang("reset"), -command => sub { setProperty($dplb, 'SORT', 0); } );
  $meta_menu->command(-label => lang("set"),   -command => sub { setProperty($dplb, 'META', 1); } );
  $meta_menu->command(-label => lang("reset"), -command => sub { setProperty($dplb, 'META', 0); } );
  $prio_menu->command(-label => lang("set"),   -command => sub { setProperty($dplb, 'PRIO', 1); } );
  $prio_menu->command(-label => lang("reset"), -command => sub { setProperty($dplb, 'PRIO', 0); } );
  $all_menu->command( -label => lang("set"),   -command => sub { setProperty($dplb, 'ALL', 1); } );
  $all_menu->command( -label => lang("reset"), -command => sub { setProperty($dplb, 'ALL', 0); } );


  $dplb->bind('<ButtonPress-3>',   sub {
               $dpmenu->Popup(-popover => "cursor", -popanchor => "nw");
           } );
  $dplb->bind('<Double-Button-1>',   sub {
      my @dirs  = $dplb->info('selection');
      return unless checkSelection($dpw, 1, 1, \@dirs);
      if (-d $dirs[0]) {
        openDirPost($dirs[0]);
        # show main window
        $top->deiconify;
        $top->raise;
      } else {
        $dplb->messageBox(-icon => 'info', -message => "Sorry, but this folder is currently not available!", -title => "Folder not available", -type => 'OK');
      }
  } );
  bind_exit_keys_to_button($dpw, $Xbut);
  $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, \$window_label);
  $dpw->waitWindow;
  return;
}

##############################################################
# insertDirProperties
##############################################################
sub insertDirProperties {
  my $lb = shift;
  my $labelref = shift;
  # todo: for a bright background we should use #009 #090 #900 
  my $normal_S    = $lb->ItemStyle('text', -anchor=>'nw', -foreground=>'#88F', -background=>$conf{color_bg}{value});
  my $finished_S  = $lb->ItemStyle('text', -anchor=>'nw', -foreground=>'#8F8', -background=>$conf{color_bg}{value});
  my $not_avail_S = $lb->ItemStyle('text', -anchor=>'nw', -foreground=>'#F88', -background=>$conf{color_bg}{value});
  my $last_time;
  my $finished = 0;
  my $unfinished = 0;
  foreach my $dir (sort { uc($a) cmp uc($b); } keys %dirProperties) {
      my $style = $normal_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) {
        $style = $finished_S;
        $finished++;
      }
      else {
        $unfinished++;
      }
      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();
      }
  }
  # total number of folders
  my $total = keys %dirProperties;
  my $percent_finished = $finished/$total*100;
  my $percent_unfinished = $unfinished/$total*100;
  $$labelref = langf("%d (%2.1f%%) finished and %d (%2.1f%%) unfinished folders", $finished, $percent_finished, $unfinished, $percent_unfinished);
}

##############################################################
# showDirSizes
##############################################################
sub showDirSizes {
  if (Exists($dsw)) {
      $dsw->deiconify;
      $dsw->raise;
      $dsw->focus;
      return;
  }
  my @dirs = @_; # just one dir at the moment, because the dir tree is configured to single selection
  # will contain all dirs
  my @alldirs;
  my $break = 0;
  my $pw = progressWinInit($top, lang("Calculate folder size"));
  foreach my $dir (@dirs) {
    progressWinUpdate($pw, "Collecting folders below $dir ...", 0, scalar @dirs);
    # the selected folder should also been shown
    push @alldirs, $dir; 
    # thumbnail folders and folders starting with "." are skipped
    push @alldirs, getDirsRecursive($dir);
  }
  my %dirsize;
  my %files;
  my $max       = 0;
  my $allsize   = 0;
  my $dirCount  = 0;
  my $i  = 0;
  foreach my $dir (@alldirs) {
    if (progressWinCheck($pw)) {
      $break = 1;
      last;
    }
    $i++;
    progressWinUpdate($pw, "in folder $dir ($i/".scalar @alldirs.") ...", $i, scalar @alldirs);
    my $dirsize = 0;
    $dirCount++;
    # get non-empty files only
    my @files = getFiles($dir);
    foreach my $file (@files) {
      $dirsize += getFileSize("$dir/$file", NO_FORMAT);
    }
    $dirsize{$dir} = $dirsize;
    # thumbnail folders like (.thumbs) are already excluded, see above
    $files{$dir} = scalar(@files);
    $max = $dirsize if ($dirsize > $max);
    $allsize += $dirsize;
  }
  progressWinEnd($pw);
  return if ($break);
  # open window
  $dsw = $top->Toplevel();
  $dsw->title(lang('Folder Sizes'));
  $dsw->iconimage($mapiviicon) if $mapiviicon;
  my $label = "Starting soon";
  my $Xbut = $dsw->Button(-text => lang('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;
  my $file_total = 0;
  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 $filestr = sprintf "%5s", $files{$dir}; $filestr .= ' '.lang('files');
      my $text = sprintf "%6s", computeUnit($dirsize{$dir});
      $dc->createText( $x+1,   $y+1, -text => $filestr, -anchor => 'nw');
      $dc->createText( $x+80,  $y+1, -text => $text, -anchor => 'nw');
      $dc->createText( $x+130, $y+1, -text => $dir,  -anchor => 'nw');
      $y += $height;
      $file_total += $files{$dir};
  }
  $max = computeUnit($max);
  $allsize = computeUnit($allsize);
  $label = scalar(@alldirs)." folders, total: $file_total files with $allsize, biggest folder size: $max";
  $dsw->waitWindow;
}

##############################################################
# setProperty
##############################################################
sub setProperty {
  my $lb    = shift;
  my $prop  = shift;
  my $value = shift;
  my @dirs  = $lb->info('selection');
  return unless checkSelection($dpw, 1, 0, \@dirs);
  if ((!defined $value) or ($value < 0) or ($value > 1)) {
    warn "wrong value $value";
    return;
  }
  if ((!defined $prop) or (($prop ne 'SORT') and ($prop ne 'META') and ($prop ne 'PRIO') and ($prop ne 'ALL'))) {
    warn "wrong property $prop";
    return;
  }
  foreach my $dir (@dirs) {
    # set property to given value
    unless ($prop eq 'ALL') {
      $dirProperties{$dir}{$prop} = $value;
    }
    else {
      $dirProperties{$dir}{SORT} = $value;
      $dirProperties{$dir}{META} = $value;
      $dirProperties{$dir}{PRIO} = $value;
    }
    # show changed property
    my $style = $iptcS;
    $style = $exifS if (defined $dirProperties{$dir}{SORT} and
        defined $dirProperties{$dir}{META} and
        defined $dirProperties{$dir}{PRIO} and
        $dirProperties{$dir}{SORT} == 1 and
        $dirProperties{$dir}{META} == 1 and
        $dirProperties{$dir}{PRIO} == 1);
    $lb->itemConfigure($dir, $lb->{dircol},  -text => $dir,                       -style => $style);
    $lb->itemConfigure($dir, $lb->{sortcol}, -text => $dirProperties{$dir}{SORT}, -style => $comS);
    $lb->itemConfigure($dir, $lb->{metacol}, -text => $dirProperties{$dir}{META}, -style => $iptcS);
    $lb->itemConfigure($dir, $lb->{priocol}, -text => $dirProperties{$dir}{PRIO}, -style => $comS);
    $lb->itemConfigure($dir, $lb->{commcol}, -text => $dirProperties{$dir}{COMM}, -style => $iptcS);
  }
}

##############################################################
# selectDirInTree
##############################################################
sub selectDirInTree {
  my $dir = shift;
  $dir = Encode::encode('iso-8859-1', $dir);
  $dir =~ s/\//\\/g if $EvilOS; # windows needs backslashes
  $dirtree->selectionClear();
  if ($dirtree->info('exists', $dir)) {
    $dirtree->selectionSet($dir);
    $dirtree->show('entry', $dir);
  }
  else {
    print "selectDirInTree: neither dir $dir does not exists!\n"; # debugging
  }
}

##############################################################
# 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 = '';
  $rating_but->configure(-image => $mapivi_icons{Rating0});
}

##############################################################
# dirDialog - open a window and a dir tree
##############################################################
sub dirDialog {
  my $dir = shift;
  $dir = Encode::encode('iso-8859-1', $dir);
  if ($EvilOS) {
    if ($win32FOAvail) {
      print "FileOp is available!\n" if $verbose;
      # this is untested!!! todo
      $dir = BrowseForFolder("Choose folder", "CSIDL_DESKTOP");
    }
    else { # windows, but no win32 FileOp available
      print "FileOp is not available!\n" if $verbose;
      $dir = $top->chooseDirectory(-title => "Select folder", -initialdir => $dir);
    }
    # At least under Windows XP both encodings seem to work: 'iso-8859-1'  'windows-1252'
    # todo: the correct encoding should be determined using:
    # I18N::Langinfo->import(qw(langinfo CODESET));
    # $codeset = langinfo(CODESET()); # note the ()
    $dir = Encode::encode('windows-1252', $dir);
    $dir = '' unless (defined $dir);
    $dir = '' unless (-d $dir);
    $dir =~ s|\\|/|g; # perl likes slashes (UNIX style) instead of backslash (Windows style)
  } else { # non windows system
    # code based on Tk::chooseDirectory
    my $t = $top->Toplevel;
    $t->withdraw;
    $t->title('Open folder ...');
    $t->iconimage($mapiviicon) if $mapiviicon;
    my $ok = 0;					# flag: "1" means OK, "0" means cancelled
    # Create Frame widget before the DirTree widget, so it's always visible
    # if the window gets resized.
    my $f = $t->Frame->pack(-fill => 'x', -side => "bottom");
    my $d;
    my $mkdB = $t->Button(-text => lang('Make new folder'),
                          -command => sub {
                            my $new_dir = makeNewDir($dir, $d); 
                            if (-d $new_dir) {
                              $d->see($new_dir)
                            }
                          })->pack(-fill => 'x');
    $balloon->attach($mkdB, -msg => "The new folder will be created in the selected folder.\nPlease select a folder in the tree.");
    $d = $t->Scrolled('DirTree',
                      -scrollbars => 'osoe',
                      -showhidden => $config{ShowHiddenDirs},
                      -selectmode => 'browse',
                      -exportselection => 1,
                      -browsecmd => sub {
                        # this function will show all subdirs when pressing on the + sign
                        $dir = shift;
                        $dir = Encode::encode('iso-8859-1', $dir);
                        return if (@_ >= 1);
                        if (!-d $dir) { print "dirDialog: $dir does not exists!\n"; return; }
                        $t->Busy;
                        my @dirs = getDirs($dir);
                        $t->Unbusy;
                        return if (@dirs < 1);
                        $t->Busy;
                        my $lastdir = $dir.'/'.$dirs[-1];
                        if ($d->info('exists', $lastdir)) {
                          $d->see($lastdir) if (-d $lastdir);
                        }
                        $t->Unbusy;
                      },
                      # With this version of -command a double-click will
                      # select the folder
                      -command   => sub { $ok = 1; $t->destroy; },
                      # With this version of -command a double-click will
                      # open a folder. Selection is only possible with
                      # the Ok button.
                      #-command   => sub { $d->opencmd($_[0]) },
                     )->pack(-fill => 'both', -expand => 1);
    # Set the initial folder
    exists &Tk::DirTree::chdir ? $d->chdir($dir) : $d->set_dir($dir);
    $f->Button(-text => lang('Ok'),
               -command => sub { $ok = 1; $t->destroy; })->pack(-side => 'left',-fill => 'x', -expand => 1);
    $f->Button(-text => lang('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);
  }
  #print "dirDialog: \"$dir\"\n";
  return $dir;
}

##############################################################
# printUsage - show the user how to use mapivi
##############################################################
sub printUsage {
    print "\nUsage: mapivi [-i] [file|folder]\n";
    print "\n               -i start with import wizard\n";
}

##############################################################
# touch - set the modification date of the given file to the
#         actual date and time
##############################################################
sub touch {
  my $file   = shift;
  my $now    = time;
  utime($now, $now, $file);
}

##############################################################
# addComment - add a comment to all selected pics in the given
#              listbox
##############################################################
sub addComment {
  my $lb = shift;    # the reference to the active listbox widget
  my @sellist = $lb->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));
  log_it("adding comments to ".scalar @sellist." pictures");
  # 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");
  my $i = 0;
  foreach my $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);
  log_it("ready! ($i of ".scalar @sellist." commented)");
}

##############################################################
# black and white conversion preview
# takes one picture as input, scales it to $config{FilterPrevSize}
# and converts it to different black and white versions
# therefore all entries of %channel_mixer are used.
# Each converted picture is then displayed in a new window.
##############################################################
sub grayscale_preview {
  my $dpic = shift;
  return unless -f $dpic;
  # 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;
  }
  my ($pic,$dir,$suffix) = fileparse($dpic, '\.[^.]*'); # suffix = . and not-.  (one dot and zero or more non-dots)
  my $preview_start_pic = $trashdir.'/'.$pic.'-start';
  return if (!mycopy($dpic, $preview_start_pic, OVERWRITE));
  return if (!resizePic($preview_start_pic, $config{FilterPrevSize}, $config{FilterPrevSize}, 80));
  # save actual values
  my $red   = $config{ChannelRed};
  my $green = $config{ChannelGreen};
  my $blue  = $config{ChannelBlue};
  my $versions = scalar(keys(%channel_mixer));
  my $message = langf("Converting %s using all %d presets. Press %s to stop.\n",$pic,$versions,lang("Cancel"));
  my $pw = progressWinInit($top, lang('Black and white preview'));
  my $i = 0;
  foreach my $key (sort keys %channel_mixer) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, $message.langf("Converting to %s (%d/%d) ...",$key,$i,$versions),$i,$versions);
    my $key_no_whitespace = $key;
    $key_no_whitespace =~ s/\s+//g;
    my $preview_pic = $trashdir.'/'.$pic.'_'.$key_no_whitespace.$suffix;
    last if (!mycopy($preview_start_pic, $preview_pic, OVERWRITE));
    # grayscalePicInt is controlled by $config{ChannelRed|Green|Blue} 
    $config{ChannelRed}   = @{$channel_mixer{$key}}[0];
    $config{ChannelGreen} = @{$channel_mixer{$key}}[1];
    $config{ChannelBlue}  = @{$channel_mixer{$key}}[2];
    grayscalePicInt($preview_pic, PREVIEW);
    showPicInOwnWin($preview_pic);
  }
  # restore old values
  $config{ChannelRed}   = $red;
  $config{ChannelGreen} = $green;
  $config{ChannelBlue}  = $blue;
  progressWinEnd($pw);
}

##############################################################
# 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;
  }
  my @sellist = $lb->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));
  # check if some files are links
  return if (!checkLinks($lb, @sellist));
  my $rc = 0;
  # open window
  my $win = $top->Toplevel();
  $win->title(lang('Convert to black and white'));
  $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, lang("Red channel (%)"), \$config{ChannelRed}, -100, 200, 1);
  labeledScale($win, 'top', $w, lang("Green channel (%)"), \$config{ChannelGreen}, -100, 200, 1);
  labeledScale($win, 'top', $w, lang("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;
  my $update_button =
  $win->Button(-text => lang("Update"),
  -command => sub {
    $win->Busy;
    $win->{label} = lang("Processing preview ...");
    $win->update;
    return if (!mycopy($preview_start_pic, $preview_pic, OVERWRITE));
    grayscalePicInt($preview_pic, PREVIEW);
    $preview_photo = $win->Photo(-file => $preview_pic, -gamma => $config{Gamma});
    if (not $win->{photo}) {
      $win->{photo} = $picF->Label(-image => $preview_photo, -relief => 'sunken',
      )->pack(-padx => 3, -pady => 3);
    }
    else {
      $win->{photo}->configure(-image => $preview_photo);
    }
    $win->{label} = lang("Preview finished");
    $win->Unbusy;
  })->pack();
  $presetF->Label(-text => lang('Presets'))->pack();
  my $preset_list = $presetF->Scrolled('Listbox',
        -scrollbars => 'osoe',
        -selectmode => 'single',
        -exportselection => 0,
        -width      => 20,
        -height     => 10,
  )->pack(-expand => 1, -fill =>'both', -padx => 2, -pady => 2);
  $preset_list->insert('end', (sort keys %channel_mixer));
  $preset_list->bind('<Button-1>', sub {
    my ($preset) = $preset_list->curselection();
    my $key = $preset_list->get($preset);
    $config{ChannelRed}   = @{$channel_mixer{$key}}[0];
    $config{ChannelGreen} = @{$channel_mixer{$key}}[1];
    $config{ChannelBlue}  = @{$channel_mixer{$key}}[2];
    $update_button->invoke();
  } );
  $win->Checkbutton(-variable => \$config{ChannelBright}, -text => lang("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 => lang("Add border or text (not visible in preview)"))->pack(-side => 'left', -anchor => 'w', -fill => 'x', -expand => 1);
                      $decoF->Button(-text => lang("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, lang("Quality (%)"), \$config{PicQuality}, 10, 100, 1);
  qualityBalloon($qs);
  $win->Label(-text => langf("Convert %d picture(s) to black and white.\nPress OK to continue.",scalar(@sellist)))->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 => lang('Cancel'),
                    -command => sub {
                      $win->withdraw();
                      $win->destroy();
    })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 2, -pady => 3);
  $win->Popup(-popover => 'cursor');
  repositionWindow($win);
  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));
  $update_button->invoke();
  $win->waitWindow;
  $preview_photo->delete if $preview_photo;
  grayscale_pics($lb, \@sellist) if ($rc);
  return;
}

##############################################################
# convert a list of pictures to black and white
##############################################################
sub grayscale_pics {
  my $lb = shift;    # the reference to the active listbox widget
  my $pic_list = shift; # array ref
  log_it("converting ".scalar @$pic_list." picture(s) to black and white");
  my $pw = progressWinInit($lb, lang('Convert to black and white'));
  my $i = 0;
  foreach my $dpic (@$pic_list) {
    last if progressWinCheck($pw);
    progressWinUpdate($pw, "converting ($i/".scalar @$pic_list.") this may take a while ...", $i, scalar @$pic_list);
    next if (!checkWriteable($dpic));
    next if (!makeBackup($dpic));
    grayscalePicInt($dpic, NO_PREVIEW);
    $i++;
    progressWinUpdate($pw, "converting ($i/".scalar @$pic_list.") ...", $i, scalar @$pic_list);
    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, @$pic_list);
  log_it("ready! ($i of ".scalar @$pic_list." converted)");
  generateThumbs(ASK, SHOW);
}

##############################################################
# grayscalePicInt - $dpic will be overwritten!
##############################################################
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
  # reselect does not work for the light table
  return if (ref($lb) eq 'Tk::Canvas');
  return unless (-f $dpic);
  # check if listbox entry exists
  unless ($lb->info('exists', $dpic)) {
    #warn "entry $dpic not found in listbox!";
    return;
  }
  my $meta = addToSearchDB($dpic);  # save meta data of picture into the search data base
  my $com     = $searchDB{$dpic}{COM};
  my $exif    = date_iso_to_relative($searchDB{$dpic}{EXIF});
  my $iptc    = displayIPTC($dpic); 
  $com     = formatString($com,  $config{LineLength}, $config{LineLimit}); # format the comment for the list
  $iptc    = formatString($iptc, $config{LineLength}, $config{LineLimit}); # format the IPTC info for the list
  my $rating_size = get_rating_and_size($dpic, $lb);
  # update the metainfo in the listbox
  $lb->itemConfigure($dpic, $lb->{thumbcol}, -text => getThumbCaption($dpic)) if (defined $lb->{thumbcol});
  $lb->itemConfigure($dpic, $lb->{comcol},   -text => $com)  if (defined $lb->{comcol});
  $lb->itemConfigure($dpic, $lb->{exifcol},  -text => $exif) if (defined $lb->{exifcol});
  $lb->itemConfigure($dpic, $lb->{iptccol},  -text => $iptc) if (defined $lb->{iptccol});
  #$lb->itemConfigure($dpic, $lb->{filecol},  -text => $size) if (defined $lb->{filecol});
  $lb->itemConfigure($dpic, $lb->{filecol}, -itemtype => "image", -image => $rating_size, -style => $fileS) 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, lang("picture(s)"));
  log_it("replacing comments in ".scalar @sellist." pictures");
  # 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;
  my $i = 0;
  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});
    my $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");
    foreach my $dpic (@sellist) {
      last if progressWinCheck($pw);
      $i++;
      progressWinUpdate($pw, "replacing comments ($i/".scalar @sellist.") ...", $i, scalar @sellist);
      my $pic      = basename($dpic);
      print "replaceComment: pic:$pic\n" if $verbose;
      next if (!checkWriteable($dpic));
      my $meta = getMetaData($dpic, "COM");
      unless ($meta) {
        $nocom .= "$dpic\n";
        next;
      }
      my @com = getComments($dpic, $meta); # get all comments from the file
      unless (@com) {
        $nocom .= "$dpic\n";
        next;
      }
      my $replace = 0;
      for my $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(getThumbFileName($dpic));
          updateOneRow($dpic, $lb);
        }
        $countFiles++;
      } else {
        $nostr .= "$dpic\n";
      }
    }
    progressWinEnd($pw);
    # short the strings for better output
    my $stextd = cutString($stext, 20, "..");
    my $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);
  }
  log_it("ready! ($i of ".scalar @sellist." pictures processed)");
}

##############################################################
# nameToComment - add the filename as comment to all selected
#                 pictures
##############################################################
sub nameToComment {
  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));
  my $selected = @sellist;
  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 => $conf{color_bg}{value}, -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');
  log_it("adding filename as comment of $selected pictures");
  # check if some files are links
  return if (!checkLinks($picLB, @sellist));
  my $pw = progressWinInit($top, "Adding file name as comment");
  my $i = 0;
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "Adding file name ($i/$selected) ...", $i, $selected);
    my $pic      = basename($dpic);
    my $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(getThumbFileName($dpic));
    updateOneRow($dpic, $picLB);
    showImageInfo($dpic) if ($dpic eq $actpic);
  }
  progressWinEnd($pw);
  log_it("ready! ($i of $selected processed)");
}

##############################################################
# showComment - show the comment of all selected pictures
##############################################################
sub showComment {
  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));
  return unless askSelection(\@sellist, 10, "comment");
  my $selected = @sellist;
  my $nocomment = '';
  log_it("displaying JPEG comments of $selected pictures");
  my $pw = progressWinInit($top, "Display comments");
  my $i = 0;
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "displaying comment ($i/$selected) ...", $i, $selected);
    my $pic = basename($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";
    }
    my $plural;
    (@comments > 1) ? ($plural = "s") : ($plural = '');
    if ($comment ne '') {
      showText("$pic contains ".scalar @comments." comment$plural", $comment, NO_WAIT, getThumbFileName($dpic));
    }
    else {
      $nocomment .= "$pic\n";
    }
  }
  progressWinEnd($pw);
  if ($nocomment ne '') {
    showText("no comments", "no comments in:\n$nocomment", NO_WAIT);
  }
  log_it("ready! ($i of $selected displayed)");
}

my %logo; # hash to hold all logo data

# todo: just a workaround until settings are saved to the Mapivi configuration
##############################################################
##############################################################
sub logo_set_defaults {
  my $logo = shift; # hash ref
  $$logo{text} = $conf{logo_text}{value};
  $$logo{size_x} = 500;
  $$logo{size_y} = 100;
  $$logo{color_bg} = 'white';
  $$logo{font_size} = $conf{logo_font_size}{value};
  $$logo{offset_x} = 25;
  $$logo{offset_y} = 65;
  $$logo{shadow} = $conf{logo_shadow}{value};
  $$logo{offset_shadow} = 5;
  $$logo{font} = $conf{logo_font}{value};
  $$logo{outfile} = "$actdir/logo.jpg";
  $$logo{color_font} = $conf{logo_font_color}{value};
  $$logo{color_shadow} = $conf{logo_shadow_color}{value};
}

##############################################################
##############################################################
sub logo_save_defaults {
  my $logo = shift; # hash ref
  # we don't save all, but the most important settings
  $conf{logo_text}{value} = $$logo{text};
  $conf{logo_font_size}{value} = $$logo{font_size};
  $conf{logo_shadow}{value} = $$logo{shadow};
  $conf{logo_font}{value} = $$logo{font};
  $$logo{outfile} = "$actdir/logo.jpg";
  $conf{logo_font_color}{value} = $$logo{color_font};
  $conf{logo_shadow_color}{value} = $$logo{color_shadow};
}

##############################################################
#  generate a text logo using image magick - dialog window
##############################################################
sub logo_generate_win {
# open window
  my $win = $top->Toplevel();
  $win->title('Generate Text Logo');
  $win->iconimage($mapiviicon) if $mapiviicon;
  my $preview_button;
  my @imfonts = getImageMagickFonts();
  logo_set_defaults(\%logo) if (not defined $logo{text});
  # set font to a valid value (in this case the first font in the list)
  # if font is not available
  $logo{font} = $imfonts[0] if (not isInList($logo{font}, \@imfonts));
  
  # text frame
  my $textf = $win->Frame(-bd => 1, -relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 6);
  my $eframe = labeledEntry($textf, 'top', 19, "Logo text", \$logo{text});
  $eframe->{entry}->bind('<Key-Return>', sub {
    $logo{size_x} = int($logo{font_size}*(length($logo{text})*0.7)+1) + $logo{offset_x};
    $preview_button->Invoke();
  });
  
  # font frame
  my $fontf = $win->Frame(-bd => 1, -relief => 'groove')->pack(-expand => 0, -fill => 'x', -padx => 3, -pady => 3);
  my $ff = $fontf->Frame()->pack(-fill => 'x', -padx => 6, -pady =>3);
  $ff->Label(-text => 'Font', -width  => 19, -anchor => 'w')->pack(-side => 'left');
  $ff->Button(-textvariable => \$logo{font}, -command => sub {
	  my ($ok, $font) = image_magick_select_font();
    if ($ok) {
      $logo{font} = $font;
      $preview_button->Invoke();
    }
  })->pack(-expand => 0, -side => 'left', -fill => 'x');
  labeledScale($fontf, 'top', 19, 'Font size (point)', \$logo{font_size}, 6, 300, 1, sub {
	  $logo{offset_x} = int($logo{font_size}*0.2); 
	  $logo{offset_y} = int($logo{font_size}*0.9); 
	  $logo{size_x} = int($logo{font_size}*(length($logo{text})*0.7)+1) + $logo{offset_x};
	  $logo{size_y} = int($logo{font_size}*1.3); 
	  $logo{offset_shadow} = int($logo{font_size}*0.06);});
  labeledEntryColor($fontf,'top',19,"Font color",'Set',\$logo{color_font});
  my $bgce = labeledEntryColor($fontf,'top',19,"Background color",'Set',\$logo{color_bg});
  $balloon->attach($bgce, -msg => "Select logo background color.\nHint: Enter string \"none\" to get a transparent background.\nTransparent colors are not supported by JPEG, but e.g. by PNG pictures.");
  
  # file name
  labeledEntry($win, 'top', 19, "Logo file", \$logo{outfile});

  # shadow frame
  #my $shadf = $win->Frame(-bd => 1, -relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3);
  # shadow options frame (optinal)
  my $shadfopt = $win->Frame(-bd => 1, -relief => 'groove');
  my $show_shadfopt = 0;
  my $show_shadfoptb;
  $show_shadfoptb = $win->Checkbutton(-text => "Show shadow settings", -variable => \$show_shadfopt,  
                                     -command => sub {
                        if ($show_shadfopt) {
                          $shadfopt->pack(-after => $show_shadfoptb, -fill => 'x', -padx => 3, -pady => 3);
                        }
                        else { $shadfopt->packForget(); }})->pack(-anchor => 'w');
  $shadfopt->Checkbutton(-text => "Add a shadow", -variable => \$logo{shadow})->pack(-anchor => 'w');
  labeledScale($shadfopt, 'top', 19, 'Shadow offset (pixel)', \$logo{offset_shadow}, 0, 100, 1);
  labeledEntryColor($shadfopt,'top',19,"Shadow color",'Set',\$logo{color_shadow});
  # position frame
  my $posf = $win->Frame(-bd => 1, -relief => 'groove');
  my $show_pos = 0;
  my $show_posb;
  $show_posb = $win->Checkbutton(-text => "Show size/position settings", -variable => \$show_pos,  
                                     -command => sub {
                        if ($show_pos) {
                          $posf->pack(-after => $show_posb,-fill => 'x', -padx => 3, -pady => 3);
                        }
                        else { $posf->packForget(); }})->pack(-anchor => 'w');
  my $maxsize = 3000;
  labeledScale($posf, 'top', 19, 'Logo width (pixel)', \$logo{size_x}, 10, $maxsize, 1);
  labeledScale($posf, 'top', 19, 'Logo height (pixel)', \$logo{size_y}, 10, $maxsize, 1);
  my $xs = labeledScale($posf, 'top', 19, 'offset x', \$logo{offset_x}, 0, $maxsize/2, 1);
  $balloon->attach($xs, -msg => "Offset from first letter to left side of logo in pixel");
  my $ys = labeledScale($posf, 'top', 19, 'offset y', \$logo{offset_y}, 0, $maxsize/2, 1);
  $balloon->attach($ys, -msg => "Offset of text baseline from top of logo in pixel");
  
  # preview frame
  my $c; # canvas widget
  my $pf = $win->Frame()->pack(-expand => 1, -fill => 'both', -padx => 3);
  $preview_button = $pf->Button(-image => $mapivi_icons{'Update'},
              -command => sub {
              $c->delete('all');
              my $outfile = $logo{outfile}; # save file name ...
              $logo{outfile} = "$trashdir/logoXYZ554.jpg"; # will be overwritten
              logo_generate(\%logo);
              if (-f $logo{outfile}) {
                $win->{preview} = $win->Photo(-file => $logo{outfile});
                if ($win->{preview}) { 
                  # insert pic
                  $c->createImage(0,0, -image => $win->{preview}, -anchor => 'nw');
                  my ($w, $h) = getSize($logo{outfile});
                  $c->configure(-scrollregion => [0, 0, $w, $h]);
                }
                else {
                  print "Could not create photo object from $logo{outfile}\n";
                }
              }
              else {
                print "Logo preview file $logo{outfile} not available.\n";
              }
              $logo{outfile} = $outfile; # ... restore file name
              })->pack(-side => 'left');
  $c = $pf->Scrolled("Canvas", -width => 600, -height => 250, -scrollbars => 'osoe')->pack(-expand => 1, -fill => 'both', -side => 'left');
  
  # button frame
  my $butF1 = $win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
  # OK Button
  $butF1->Button(-text => lang('Ok'),
                -command => sub { 
			if (-f $logo{outfile}) {
        my $rc = $win->Dialog( -title => "File exists",
                               -text => "$logo{outfile} already exists!",
                               -buttons => ['Overwrite', 'Cancel'])->Show();
			  return if ($rc ne 'Overwrite');
      }
			logo_generate(\%logo);
      log_it("Logo generated");
      deleteCachedPics($logo{outfile}); # force reloading
      my $dir = dirname($logo{outfile});
      if ($actdir ne $dir) {
        openDirPost($dir);
      }
      else {
        updateThumbs();
      }
      showPic($logo{outfile});
      # clean up preview photo object (free mem)
      $win->{preview}->delete if ($win->{preview});
      logo_save_defaults(\%logo);
      # close window
			$win->destroy();
                })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  my $Xbut = $butF1->Button(-text => lang('Cancel'),
                -command => sub { 
                  # clean up preview photo object (free mem)
                  $win->{preview}->delete if ($win->{preview});
                  $win->destroy();
                })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  bind_exit_keys_to_button($win, $Xbut);
  $win->Popup();
  $preview_button->Invoke();
  #repositionWindow($win);
  $win->waitWindow;
}

##############################################################
#  generate a text logo using image magick - overwrites outfile without warning!!! so better check before!
##############################################################
sub logo_generate {
  my $logo = shift; # hash ref
  my $font_coords = "+".($$logo{offset_x}+0)."+".($$logo{offset_y}+0);  # force numeric context (+0)
  my $shadow_coords = "+".($$logo{offset_x}+$$logo{offset_shadow})."+".($$logo{offset_y}+$$logo{offset_shadow});
  my $command = "convert -size $$logo{size_x}x$$logo{size_y} xc:\"$$logo{color_bg}\" -font \"$$logo{font}\" ";
  $command .= "-pointsize $$logo{font_size} ";
  # shadow
  $command .= "-fill \"$$logo{color_shadow}\" -annotate $shadow_coords \"$$logo{text}\" -blur 0x4 " if ($$logo{shadow});
  # text
  $command .= "-fill \"$$logo{color_font}\" -annotate $font_coords \"$$logo{text}\" ";
  # outfile
  $command .= "\"$$logo{outfile}\"";
  print "com=$command\n" if $verbose;
  execute($command);
  my $comment = "Logo generated by Mapivi $version ($mapiviURL):\n".$command;
  addCommentToPic($comment, $logo{outfile}, NO_TOUCH);
}

##############################################################
# 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;
  return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));
  log_it("adding decorations to $selected pictures");
  # check if some files are links
  return if (!checkLinks($picLB, @sellist));
  return if (!decorationDialog($selected,1));
  my $pw = progressWinInit($top, "Adding decoration");
  my $i = 0;
  foreach my $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));
    my $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);
  log_it("ready! ($i of $selected)");
  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+5).",".($y+5);
      my $geo2 = "$x,$y";
      print "drawoptions: x = $x y = $y geo1 = $geo1 geo2 = $geo2\n" if $verbose;

      $command .= "-font \"$config{CopyFontFamily}\" -pointsize $config{CopyFontSize} ";
      $command .= "-fill \"$config{CopyFontColBG}\" -annotate $geo1 \"$config{Copyright}\" " if $config{CopyFontShadow};
      $command .= "-fill \"$config{CopyFontColFG}\" -annotate $geo2 \"$config{Copyright}\" ";
      
      print "com=$command\n";
    }
    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 $dpic = shift;
  my ($pic,$dir,$suffix) = fileparse($dpic, '\.[^.]*'); # suffix = . and not-.  (one dot and zero or more non-dots)
  my $bpic = "${dir}${pic}-bak$suffix";
  return $bpic;
}
##############################################################
# 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 bpic in listbox with thumbnail after dpic
    addOneRow($picLB, $bpic, 1, $dpic);
  }
  return 1;
}

##############################################################
##############################################################
sub get_image_magick_version {
  # get ImageMagick version
  if (`convert 2>&1` =~ m/.*ImageMagick (\d+)\.(\d+)\.(\d+).*/) {
    return (1,$1,$2,$3);
  }
  return 0;
}  

##############################################################
##############################################################
sub image_magick_select_font {
  # open window
  my $win = $top->Toplevel();
  $win->title('Select Font');
  $win->iconimage($mapiviicon) if $mapiviicon;
  my @imfonts = getImageMagickFonts();
  my $w = 300;
  my $h = 26;
  $win->Label(-text => 'Click on font to select')->pack(-padx => 3, -pady => 3);
  my $c = $win->Scrolled("Canvas", -width => $w+20, -height => 600, -scrollbars => 'osoe')->pack(-expand => 1, -fill => 'both');
  $c->configure(-cursor => "hand2");
  $win->Popup;
  my %logo; # data structure
  $logo{size_x} = $w;
  $logo{size_y} = $h;
  $logo{font_size} = int($h*4/5);
  $logo{offset_x} = 2;
  $logo{offset_y} = int($h*0.8);
  $logo{shadow} = 0;
  $logo{offset_shadow} = 5;
  $logo{color_font} = 'black';
  $logo{color_shadow} = 'gray20';
  
  my $y = 0;
  my %pics; # hash to store all photo object  todo: delete after usage
  my $pw = progressWinInit($win, 'Building font preview ...');
  my $i = 0;
  my $ok = 0;
  my $sel_font = '';
  foreach my $font (@imfonts) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "Font: $font ($i/".scalar @imfonts.") ...", $i, scalar @imfonts);
    $logo{text} = $font;
    $logo{font} = $font;
    $logo{outfile} = "$trashdir/$font.jpg";
    if (not -f $logo{outfile}) {
      logo_generate(\%logo);
    }
    $pics{$font} = $win->Photo(-file => $logo{outfile}) if (-f $logo{outfile});
    if ($pics{$font}) {
      my $id = $c->createImage(0, $y, -image => $pics{$font}, -anchor => "nw", -tags => "$font");
      my ($x1, $y1, $x2, $y2) = $c->bbox($id);
      $c->configure(-scrollregion => [0, 0, $x2, $y2]);
      $c->bind(+"$font", '<ButtonPress-1>', sub { $sel_font = $font; $ok = 1; $win->destroy;});
      $y += $h+1;
    }
  }
  progressWinEnd($pw);
  $win->waitWindow();
  return ($ok, $sel_font);
}

##############################################################
# getImageMagickFonts - get the font families supported by IM
##############################################################
sub getImageMagickFonts {

  return if (!checkExternProgs('getImageMagickFonts', 'identify'));
  my ($ok, $im1, $im2, $im3) = get_image_magick_version();
  if (not $ok) {
    warn "Could not get Image Magick version number!\n";
    return;
  }
  # the API changed with version 6.3.5-7
  my $fonts;
  if ($im1*100+$im2*10+$im3 <= 635) {
    print "old image magick version <= 635 $im1.$im2.$im3\n" if $verbose;
    $fonts = `identify -list type`;
  } else {
    print "new image magick version > 635 $im1.$im2.$im3\n" if $verbose;
    $fonts = `identify -list font`;
  }
  my %families;

  my @lines = split(/\n/, $fonts);
  foreach my $line (@lines) {
    #print "line = $line\n";
    # \s = whitespace \S = non-whitespece  \d = number
    if ($line =~ m |(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\d+)|) {
      $families{$2} = 1;
    }
    if ($line =~ m |Font: (\S+)|) {
      $families{$1} = 1;
    }
  }
  my @font_families = sort keys(%families);
  #print "font_families: $_\n" foreach (@font_families);
  return @font_families;
}

my $decoW;
##############################################################
# decorationDialog
##############################################################
sub decorationDialog {

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

  my $pics  = shift;
  my $QandB = shift; # bool - show Quality-Scale and Backup-Checkbutton
  my $rc   = 0;
  my $max  = 1000;

  #my @fontFamilies = sort $top->fontFamilies;
  my @fontFamilies = getImageMagickFonts();

  # open window
  $decoW = $top->Toplevel();
  $decoW->title('Add border/copyright/shadow');
  $decoW->iconimage($mapiviicon) if $mapiviicon;

  my $addF = $decoW->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-anchor => 'w', -fill => 'x', -padx => 5, -pady => 3);

  $addF->Label(-text => "Process $pics pictures", -bg => $conf{color_bg}{value})->pack(-side => 'left', -anchor => 'w', -fill => 'x', -padx => 5, -pady => 3);

  $addF->Label(-text => "Add ", -bg => $conf{color_bg}{value})->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 => $conf{color_bg}{value}, # background of active page (including its tab)
                       -inactivebackground => $conf{color_entry}{value}, # tabs of inactive pages
                       -backpagecolor => $conf{color_bg}{value}, # 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, lang("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 => $conf{color_bg}{value})->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 => $conf{color_bg}{value})->pack(-side => 'left');
  my $fontL  = $fontF2->Label(-textvariable => \$config{Copyright}, -bg => $conf{color_bg}{value})->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 => $conf{color_bg}{value})->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 => $conf{color_bg}{value})->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 => $conf{color_bg}{value})->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 => $conf{color_bg}{value})->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 => $conf{color_bg}{value})->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 => $conf{color_bg}{value})->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 => $conf{color_bg}{value})->pack(-anchor => 'w', -padx => 3);
  $dF->Label(-text => "(conversion may take some time)", -bg => $conf{color_bg}{value})->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 => lang('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 => lang('Cancel'),
                           -command => sub { $rc = 0;
                                             $decoW->withdraw();
                                             $decoW->destroy();
                                           })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  bind_exit_keys_to_button($decoW, $Xbut);
  $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();
}

##############################################################
##############################################################
sub get_IPTC_info {
  my $dpic = shift;
  my $ok = 0; # default return value is false 
  my $iptc = {}; # hash reference
  # get IPTC data
  my $meta = getMetaData($dpic, 'APP13');
  if ($meta) {
    $ok = 1;
    if (defined $meta->get_app13_data('TEXTUAL', 'IPTC')) {
      $iptc = $meta->get_app13_data('TEXTUAL', 'IPTC');
      warn "IPTC segment of $dpic has errors!" if ($iptc->{error});
    }
  }
  else {
    warn "get_IPTC_info: got no meta info of $dpic\n";
  }
  print "get_IPTC_info $dpic\n" if $verbose;
  return ($ok, $iptc, $meta);
}

##############################################################
# get_IPTC_intersection
##############################################################
sub get_IPTC_intersection {
  my $lb = shift;
  my $pic_list = shift; # pictures to intersect, array ref
  # use the IPTC info of the first picture as master
  my $first_pic = @{$pic_list}[0];
  my ($ok, $iptc_i) = get_IPTC_info($first_pic);
  return $iptc_i if not $ok;
  my $i = 0;
  my $pw;
  # show a progressbar only if there are more than 5 pictures selected
  $pw = progressWinInit($lb, 'Analyzing IPTC data ...') if (@{$pic_list} > 5);
  foreach my $dpic (@{$pic_list}) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "Collecting common data ($i/".scalar @{$pic_list}.") ...", $i, scalar @{$pic_list});
    next if ($dpic eq $first_pic); # the first pic is already processed above as master
    my ($ok, $iptc) = get_IPTC_info($dpic);
    next if not $ok;
    
    # compare each key from the master
    foreach my $key (keys %{$iptc_i}) {
      my $ref = ref($iptc_i->{$key});
      my $nr = scalar @{$iptc_i->{$key}};
      # if key doesn't exists in one of the pictures we remove this key
      unless (exists $iptc->{$key}) {
        delete $iptc_i->{$key};
        next;
      }
      # get the intersection of the key content (this works for single elements and lists)
      my @intersection = listIntersection($iptc_i->{$key}, $iptc->{$key});
      # if there is something left we take the intersection
      if (@intersection) {
        $iptc_i->{$key} = \@intersection;
      }
      # else we remove the key
      else {
        delete $iptc_i->{$key};
      }
    }
  }
  progressWinEnd($pw);
  return $iptc_i;
}

##############################################################
# 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, lang("picture(s)"));
  # check if some files are links
  return if (!checkLinks($lb, @sellist));
  # init with the first picture in list
  my $dpic = $sellist[0];
  my $pic = basename($dpic);
  # take the first picture as master for the IPTC data
  my ($ok, $iptcm) = get_IPTC_info($dpic); # $iptcm = IPTC master,  hash reference
  if (not $ok) {
    log_it("Could not open IPTC segment of $pic");
    return;
  }
  # handle several pictures: the IPTC dialog should just show common elements
  if (@sellist > 1) {
    $iptcm = get_IPTC_intersection($lb, \@sellist, $iptcm);
  }
  
  my @keywords_common = ();
  my @suppcats_common = ();
  foreach (@{$iptcm->{Keywords}}) {
    $_ =~ tr/ -~//cd; # remove non-printables (Picasa adds one to each keyword)
  }
  ${$iptcm->{Caption}}[0] =~ tr/\n\t\r\f -~//cd if (${$iptcm->{Caption}}[0]); # replace all non-printable chars, but not newline etc.

  # these are the common items (e.g. common keywords of all selected pictures)
  @keywords_common = @{$iptcm->{Keywords}} if (exists $iptcm->{Keywords});
  @suppcats_common = @{$iptcm->{SupplementalCategory}} if (exists $iptcm->{SupplementalCategory});

  my $rc = iptcDialog($iptcm, $pic, scalar @sellist);
  return if ($rc ne 'OK');

  # after user interaction in the dialog
  my @keywords_master = ();
  @keywords_master = @{$iptcm->{Keywords}} if (exists $iptcm->{Keywords});
  my @suppcats_master = ();
  @suppcats_master = @{$iptcm->{SupplementalCategory}} if (exists $iptcm->{SupplementalCategory});

  # to remove keywords and categories we need to figure out what has been removed by the user
  my @keywords_removed = diffList(\@keywords_common, \@keywords_master);
  my @suppcats_removed = diffList(\@suppcats_common, \@suppcats_master);
  
  my $IPTC_action = $config{IPTC_action};
  # if we edit a single picture we always use the replace mode
  $IPTC_action = 'REPLACE' if (@sellist == 1);

  my $errors = '';
  my $i = 0;
  my $pw = progressWinInit($lb, "Writing IPTC info");
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "Writing IPTC info ($i/".scalar @sellist.") ...", $i, scalar @sellist);
    # check if file is a link and get the real target
    next if (!getRealFile(\$dpic));
    next if (!checkWriteable($dpic));

    my $meta = getMetaData($dpic, 'APP1'); # APP1 includes EXIF and IPTC (APP13)
    my $er   = $meta->get_Exif_data('ALL', 'TEXTUAL');

    my $iptc;
    # copy (clone) master iptc hash to picture iptc hash
    $iptc = dclone($iptcm);

    if (($config{IPTCdateEXIF}) or ($config{IPTCtimeEXIF})) {
      my $date = getEXIFDate($dpic, $er); # date format YYYY:MM:DD HH:mm:SS
      my ($ok, $IPTCdate, $IPTCtime) = EXIFtoIPTCdatetime($date);
      if ($ok) {
        # 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 = getEXIFowner($er);
        if ($owner ne '') {
          print "*** Writing \"$owner\" to $dpic\n" if $verbose;
          ${$iptc->{ByLine}}[0] = $owner;
        }
      }
    }

    if ($config{IPTCaddMapivi}) {
          ${$iptc->{OriginatingProgram}}[0] = 'Mapivi';
          ${$iptc->{ProgramVersion}}[0] = $version;
    }
        
    # make some corrections for keywords and supp cats
    # according to the documentation of Image::MetaData::JPEG this should not be needed
    if ((@sellist > 1) and (($IPTC_action eq 'UPDATE') or ($IPTC_action eq 'ADD'))) {
       # todo problem is still, that removed elements (where nothing is left, e.g. a headline) are not removed in Update mode
       my $seg = $meta->retrieve_app13_segment(undef, 'IPTC'); # todo should be possible without segement
       if ($seg) {
         my $hashref = $seg->get_app13_data('TEXTUAL', 'IPTC');
       
         my @keywords;
         # take the original items and add the items from the dialog (master)
         push @keywords, @{$hashref->{Keywords}} if (defined($hashref->{Keywords}));
         push @keywords, @keywords_master;
         # then remove items which have been removed in the dialog
         @keywords = diffList(\@keywords, \@keywords_removed);
         #@keywords = ('') unless (@keywords);
         $iptc->{Keywords} = \@keywords;
       
         my @suppcats;
         # take the original items and add the items from the dialog (master)
         push @suppcats, @{$hashref->{SupplementalCategory}} if (defined($hashref->{SupplementalCategory}));
         push @suppcats, @suppcats_master;
         # then remove items which have been removed in the dialog
         @suppcats = diffList(\@suppcats, \@suppcats_removed);
         $iptc->{SupplementalCategory} = \@suppcats;
       }
    }
    
    $meta->set_app13_data($iptc, $IPTC_action, 'IPTC');
    uniqueIPTC($meta);
    if ($meta->save()) { # success
      # if urgency / rating is not equal 0 we also modify the XMP rating tag
      if (exists $iptcm->{Urgency} and ${$iptcm->{Urgency}}[0] != 0) {
        xmp_set_rating($dpic, ${$iptcm->{Urgency}}[0]) if $conf{xmp_rating}{value};
      }
    }
    else { $errors .= "save failed for $dpic\n"; }

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

    updateOneRow($dpic, $lb);
    if ($dpic eq $actpic) {
      showImageInfoCanvas($dpic);
      # update_IPTC_frame_content($dpic);
    }
  }
  progressWinEnd($pw);
  log_it("ready! ($i/".scalar @sellist." written)");
  showText("Errors while editing IPTC info", $errors, NO_WAIT) if ($errors ne '');
}

##############################################################
# returns EXIF owner, or artist, or user comment, or empty string
# input: EXIF data of meta data
# here is how to get $er:
#  my $meta = getMetaData($dpic, 'APP1'); # APP1 includes EXIF and IPTC (APP13)
#  my $er = $meta->get_Exif_data('ALL', 'TEXTUAL');
##############################################################
sub getEXIFowner {
  my $er = shift;
  my $owner = '';
  if (defined $er->{SUBIFD_DATA}->{OwnerName}) {
    $owner = join('', @{$er->{SUBIFD_DATA}->{OwnerName}});
  }
  elsif (defined $er->{IFD0_DATA}->{Artist}) {
    $owner = join('', @{$er->{IFD0_DATA}->{Artist}});
  }
  elsif (defined $er->{SUBIFD_DATA}->{UserComment}) {
    $owner = join('', @{$er->{SUBIFD_DATA}->{UserComment}});
  }
  else { }
  if ($owner ne '') {
    $owner =~ tr/ -~//cd;          # remove non-printable characters (but not \n)
    $owner =~ s/ASCII//g;			     # cut 'ASCII'
    $owner =~ s/^\s+//;			       # cut leading white
    $owner =~ s/\s+$//;			       # cut trailing white
  }
  return $owner;
}

##############################################################
# convert EXIT date/time to IPTC format
##############################################################
sub EXIFtoIPTCdatetime {
  my $date = shift; # EXIF date
  my ($IPTCdate, $IPTCtime);
  my $ok = 0;
  if (my ($y, $M, $d, $h, $m, $s) = $date =~ m/(\d\d\d\d):(\d\d):(\d\d) (\d\d):(\d\d):(\d\d)/) {
    $ok = 1;
    my $time = timelocal($s,$m,$h,$d,($M-1),($y-1900));
    my $diff = ((localtime($time))[2] - (gmtime($time))[2]);
    # RJW: Correct timezone calculation in case of migration over
    # 24 hour border
    if ( $diff > 12 ) {
        $diff -= 24;
    } elsif ( $diff < -12 ) {
        $diff += 24;
    }
    my $GMToffset = sprintf("%+03d00", $diff);
    $IPTCdate = $y.$M.$d;
    $IPTCtime = $h.$m.$s.$GMToffset;
  }
  return ($ok, $IPTCdate, $IPTCtime);
}

##############################################################
# 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, lang("picture(s)"));
  # check if some files are links
  return if (!checkLinks($lb, @sellist));
  $urgency = '' if ($urgency == 9); # 9 is used to clear the urgency flag
  my $msg     = "Writing IPTC urgence $urgency";
  $msg     = "Deleting IPTC urgence flag" if ($urgency eq '');
  my $errors = '';
  my $i = 0;
  my $pw;
  $pw = progressWinInit($lb, $msg) if (@sellist > 1);
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "$msg ($i/".scalar @sellist.") ...", $i, scalar @sellist);
    my $pic = basename($dpic);
    # check if file is a link and get the real target
    next if (!getRealFile(\$dpic));
    next if (!checkWriteable($dpic));
    my $ok = set_IPTC_urgency_file($dpic, $urgency, \$errors);
    if ($ok) { # urgency changed successfully!
      # set also XMP rating, if option is set
      xmp_set_rating($dpic, $urgency) if $conf{xmp_rating}{value};
      print "saved IPTC urgency $urgency to $pic\n" if $verbose;
      # touch the thumbnail pic (set actual time stamp), to suppress rebuilding
      touch(getThumbFileName($dpic));
      updateOneRow($dpic, $lb);
      if ($dpic eq $actpic) {
        #showImageInfoCanvas($dpic);
        showImageInfo($dpic);
      }
    }
  }
  progressWinEnd($pw);
  $msg     = "Urgency $urgency written to";
  $msg     = "Removed urgency flag in" if ($urgency eq '');
  log_it("ready! $msg $i of ".scalar @sellist." pictures");
  showText("Errors and infos while saving IPTC urgency", $errors, NO_WAIT) if ($errors ne '');
}

##############################################################
##############################################################
sub set_IPTC_urgency_file {
  my $dpic = shift;
  my $urgency = shift;
  my $errors = shift; # reference to string, errors will be added
  my ($ok, $iptc, $meta) = get_IPTC_info($dpic);
  if (not $ok) {
    $$errors .= "Could not open IPTC segment of $dpic\n";
    return 0;
  }
  if ($config{UrgencyChangeWarning} and (defined $iptc->{Urgency}) and (${$iptc->{Urgency}}[0] ne $urgency)) {
    $$errors .=  "Info: Rating (Urgency) changed from ".iptc_rating_stars_urg(${$iptc->{"Urgency"}}[0])." to ".iptc_rating_stars_urg($urgency)." $dpic\n";
  }
  $iptc->{Urgency} = $urgency;
  $meta->set_app13_data($iptc, 'REPLACE', 'IPTC');
  if (!$meta->save()) {
    $$errors .= "save failed for $dpic\n";
  	return 0;
  }
  return 1;
}

##############################################################
# getIPTCurgencyDB - get the urgency flag of a given file from
#                    the search database
#                    returns 9 if there is no file or no urgency
##############################################################
sub getIPTCurgencyDB {

  my $dpic    = shift;
  my $urgency = 9;
  $urgency = $searchDB{$dpic}{URG} if (defined $searchDB{$dpic}{URG});
  return $urgency;
}


##############################################################
# getIPTCurgency - get the urgency flag of a given file
#                  returns 9 if there is no file or no urgency
##############################################################
sub getIPTCurgency {

  my $dpic    = shift;
  my $meta    = shift; # optional, the Image::MetaData::JPEG object of $dpic if available
  my $urgency = 9;

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

  return 9 unless (-f $dpic);
  $meta = getMetaData($dpic, "APP13", 'FASTREADONLY') unless (defined($meta));
  return 9 unless ($meta);
  my $seg = $meta->retrieve_app13_segment(undef, 'IPTC'); # todo should be possible without segement
  return 9 unless ($seg);
  my $hashref = $seg->get_app13_data("TEXTUAL", 'IPTC');

  if (defined($hashref->{Urgency})) {
    $urgency = ${$hashref->{Urgency}}[0];
    $urgency = 8 if ($urgency =~ /l/i);
    $urgency = 1 if ($urgency =~ /h/i);
    $urgency = 9 if ($urgency !~ /\d/);
    $urgency = 9 if ( ($urgency > 9) or ($urgency < 0) );
  }

  $quickSortHash{$dpic} = $urgency if $quickSortSwitch;
  print "getIPTCurgency: -$urgency- $dpic\n" if $verbose;
  return $urgency;
}

##############################################################
# getIPTCkeywords - get the keywords of a given file
#                   returns empty list if there is no file or
#                   no keyword
##############################################################
sub getIPTCkeywords {

  my $dpic    = shift;
  my $meta    = shift; # optional, the Image::MetaData::JPEG object of $dpic if available
  my @keywords = ();

  return @keywords unless (-f $dpic);
  $meta = getMetaData($dpic, 'APP13', 'FASTREADONLY') unless (defined($meta));
  return @keywords unless ($meta);
  my $seg = $meta->retrieve_app13_segment(undef, 'IPTC'); # todo should be possible without segement
  return @keywords unless ($seg);
  my $hashref = $seg->get_app13_data('TEXTUAL', 'IPTC');

  if (defined($hashref->{Keywords})) {
    @keywords = @{$hashref->{Keywords}};
  }
  
  foreach (@keywords) {
    # translate it to a string if it is non-printing
    #my $key = $_;
    #$key =~ s/[\000-\037\177-\377]/sprintf "\\%02x",ord($&)/e;
    #print "key = -$key-\n";
    $_ =~ tr/ -~//cd; # replace all non-printable chars (Picasa adds one to each keyword)
  }

  return @keywords;
}

##############################################################
# getIPTCByLine -  get the by-line info of a given file
##############################################################
sub getIPTCByLine {

  my $dpic    = shift;
  my $byline  = '';

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

  return $byline unless (-f $dpic);

  my $meta = getMetaData($dpic, "APP13", 'FASTREADONLY');
  return $byline unless ($meta);
  my $seg = $meta->retrieve_app13_segment(undef, 'IPTC'); # todo should be possible without segement
  return $byline unless ($seg);
  my $hashref = $seg->get_app13_data("TEXTUAL", 'IPTC');

  $byline = ${$hashref->{ByLine}}[0] if (defined($hashref->{ByLine}));

  $quickSortHash{$dpic} = $byline if $quickSortSwitch;
  print "getIPTCByLine: $byline ($dpic)\n" if $verbose;
  return $byline;
}

##############################################################
# getIPTCAttr -  get an IPTC attribute of a given file
#                returns empty string if attribute is not defined
##############################################################
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;
  $t->geometry($conf{iptc_geometry}{value});
  # we use a pane to support small screen resolutions, the user is still able to scroll e.g. to the buttons at the bottom of the window
  my $pane = $t->Scrolled('Pane', -scrollbars => 'osoe')->pack(-expand => 1, -fill => 'both');

  my $notebook =
    $pane->NoteBook(-background => $conf{color_bg}{value}, # background of active page (including its tab)
                 -inactivebackground => $conf{color_entry}{value}, # tabs of inactive pages
                 -backpagecolor => $conf{color_bg}{value}, # background behind notebook
                )->pack(-expand => 1,
                        -fill => 'both',
                        -padx => 5, -pady => 5);

  my $aN  = $notebook->add('stan', -label => 'Standard');
  my $bN  = $notebook->add('misc', -label => 'Misc');
  my $cN  = $notebook->add('opt',  -label => 'Options');

  $notebook->raise($config{IPTCLastPad});

  my $w = 11;
  my $ent;
  ####### Standart IPTC tags  #############
  # left and right frame on standard tab
  my $aF = $aN->Frame(-bd => 0)->pack(-side => 'left', -expand => 1, -fill => 'both', -padx => 3, -pady => 0);
  my $bF = $aN->Frame(-bd => 0)->pack(-side => 'left', -expand => 1, -fill => 'both', -padx => 3, -pady => 0);
  
  my @alist = ('Headline', 'ObjectName');
  foreach (@alist) {
      $ent = labeledEntry($aF,'top',$w,$_,\${$iptc->{$_}}[0], 5);
      if (defined $iptcHelp{$_}) {
          $balloon->attach($ent, -msg => formatString($_.":\n".$iptcHelp{$_}, 80, -1)) if (Exists $ent);
      }
  }
  push @tag_list, @alist; # add already displayed elements to the list
  
  ####### Caption  #############
  my $capF = $aF->Frame(-bd => 0)->pack(-anchor=>'w', -expand => 1, -fill => 'both', -padx => 3, -pady => 3);
  $capF->Label(-text => 'Caption/Abstract', -bg => $conf{color_bg}{value})->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 => $conf{color_bg}{value}, -width => 15, -anchor => 'w')->pack(-side => 'left', -anchor => 'w', -padx => 2, -pady => 2);
  $oF->Optionmenu(-variable => \${$iptc->{Urgency}}[0], -textvariable => \${$iptc->{Urgency}}[0], -options => [0,1,2,3,4,5,6,7,8])->pack(-side => 'left', -anchor => 'w', -padx => 0);
  push @tag_list, 'Urgency'; # add already displayed elements to the list

  if ($config{IPTCProfessional}) {
    ####### Writer/Editor and Credit  #############
    labeledDoubleEntry($aF, 'top', $w, 'Writer/Editor', 'Credit',
                       \${$iptc->{'Writer/Editor'}}[0],
                       formatString("Writer/Editor:\n".$iptcHelp{'Writer/Editor'}, 80, -1),
                       \${$iptc->{'Credit'}}[0],
                       formatString("Credit:\n".$iptcHelp{'Credit'}, 80, -1));
    push @tag_list, ('Writer/Editor', 'Credit'); # add already displayed elements to the list
  }
  
  ####### BylineTitle and Byline  #############
  # !!! todo byline and bylinetitle are repeatable use e.g. .= "$_, " for @{$iptc->{$_}};
  labeledDoubleEntry($aF, 'top', $w, 'ByLineTitle', 'Name',
                     \${$iptc->{ByLineTitle}}[0],
                     formatString("ByLineTitle:\n".$iptcHelp{'ByLineTitle'}, 80, -1),
                     \${$iptc->{ByLine}}[0],
                     formatString("ByLine:\n".$iptcHelp{'ByLine'}, 80, -1));
  push @tag_list, ('ByLineTitle', 'ByLine'); # add already displayed elements to the list

  ####### EditStatus etc. ##############
  if ($config{IPTCProfessional}) {
    @alist = ('EditStatus', 'SpecialInstructions', 'Contact', 'Source', 'CopyrightNotice');
    foreach (@alist) {
        $ent = labeledEntry($aF,'top',$w,$_,\${$iptc->{$_}}[0]);
        if (defined $iptcHelp{$_}) {
            # todo this cuts very long desc because of config{LineLimit}
            $balloon->attach($ent, -msg => formatString($_.":\n".$iptcHelp{$_}, 80, -1)) if (Exists $ent);
        }
    }
    push @tag_list, @alist; # add already displayed elements to the list
  }
  
  ####### Location ##############
  my $locF = $aF->Frame(-relief => 'raised')->pack(-anchor=>'w', -padx => 3, -pady => 3, -fill => 'x');
  $locF->Label(-text => 'Location')->pack(-anchor => 'w', -padx => 2, -pady => 2);
  labeledDoubleEntry($locF, 'top', $w, 'Country', 'Code',
                     \${$iptc->{'Country/PrimaryLocationName'}}[0],
                     formatString("Country/PrimaryLocationName:\n".$iptcHelp{'Country/PrimaryLocationName'}, 80, -1),
                     \${$iptc->{'Country/PrimaryLocationCode'}}[0],
                     formatString("Country/PrimaryLocationCode:\n".$iptcHelp{'Country/PrimaryLocationCode'}, 80, -1));
  labeledDoubleEntry($locF, 'top', $w, 'Province/State', 'City',
                     \${$iptc->{'Province/State'}}[0],
                     formatString("Province/State:\n".$iptcHelp{'Province/State'}, 80, -1),
                     \${$iptc->{'City'}}[0],
                     formatString("City:\n".$iptcHelp{'City'}, 80, -1) );
  $ent = labeledEntry($locF,'top',$w,'SubLocation',\${$iptc->{'SubLocation'}}[0]);
  if (defined $iptcHelp{'SubLocation'}) {
    # todo this cuts very long desc because of config{LineLimit}
    $balloon->attach($ent, -msg => formatString("SubLocation:\n".$iptcHelp{'SubLocation'}, 80, -1)) if (Exists $ent);
  }
  push @tag_list, ('SubLocation', 'City', 'Province/State', 'Country/PrimaryLocationName', 'Country/PrimaryLocationCode');

  #######  Date and Time ############
  if ($config{IPTCProfessional}) {
    @alist = ('ReleaseDate', 'ReleaseTime', 'DateCreated', 'TimeCreated');
    my $dateF = $aF->Frame(-bd => $config{Borderwidth}, -relief => 'raised')->pack(-anchor=>'w', -padx => 3, -pady => 3, -fill => 'x');
    $dateF->Label(-text => 'Date and time')->pack(-anchor => 'w', -padx => 2, -pady => 2);
    labeledDoubleEntry($dateF, 'top', $w, 'Date created', 'Time',
                       \${$iptc->{DateCreated}}[0],
                       formatString("DateCreated:\n".$iptcHelp{'DateCreated'}, 80, -1),
                       \${$iptc->{TimeCreated}}[0],
                       formatString("TimeCreated:\n".$iptcHelp{'TimeCreated'}, 80, -1));

    labeledDoubleEntry($dateF, 'top', $w, 'Date released', 'Time',
                       \${$iptc->{ReleaseDate}}[0],
                       formatString("ReleaseDate:\n".$iptcHelp{'ReleaseDate'}, 80, -1),
                       \${$iptc->{ReleaseTime}}[0],
                       formatString("ReleaseTime:\n".$iptcHelp{'ReleaseTime'}, 80, -1));
    push @tag_list, @alist; # add already displayed elements to the list
  }
  
  #######  Keywords ############
  my $keyword_frame = $bF->Frame(-bd => 0)->pack(-expand => 1, -fill => 'both', -padx => 0, -pady => 0);
  # get the keywords (list ref)
  doubleList($keyword_frame, \@prekeys, \@{$iptc->{Keywords}}, 'keywords');
  push @tag_list, 'Keywords';
  
  #######  Categories ##########
  my $category_frame;
  if ($config{IPTCProfessional} == 1) {
    $category_frame = $bF->Frame(-bd => 0)->pack(-expand => 1, -fill => 'both', -padx => 0, -pady => 0);
    $ent = labeledEntry($category_frame,'top',$w,'Category',\${$iptc->{Category}}[0]);
    if (defined $iptcHelp{Category}) {
      $balloon->attach($ent, -msg => formatString("Category:\n".$iptcHelp{Category}, 80, -1)); # todo
    }
    # supp categories ###
    doubleList($category_frame, \@precats, \@{$iptc->{SupplementalCategory}}, 'supplemental categories');
    push @tag_list, ('Category', 'SupplementalCategory');
  }
  
  ####### Misc #################
  my $p = $bN->Scrolled("Pane", -scrollbars => "oe", -height => 300)->pack(-fill => 'both', -expand => 1);

  # build a frame, a label and an entry for every tag which is not yet displayed
  foreach (@IPTCAttributes) {
    next if (isInList($_, \@tag_list));
    $ent = labeledEntry($p,'top',40,$_,\${$iptc->{$_}}[0]);
    if (defined $iptcHelp{$_}) {
        $balloon->attach($ent, -msg => formatString($_.":\n".$iptcHelp{$_}, 80, -1)); # todo
      }
  }

  ###### bottom frame

  my $exf = $pane->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 $umlautB = $exf->Checkbutton(-variable => \$config{onlyASCII}, -text => 'Use only ASCII')->pack(-side => 'left', -anchor => 'w', -padx => 3, -pady => 1);
  $balloon->attach($umlautB, -msg => "Remove non-ASCII chars and convert german umlaute (e.g. ä -> ae)\nNon-ASCII chars like umlaute often cause problems in other tools,\nso it's saver to remove or convert them to plain ASCII where possible.");

  my $optF = $cN->Frame()->pack();
  $optF->Label(-text => 'IPTC dialog layout')->pack(-anchor => 'w');
  $optF->Radiobutton(-text => 'Simple', -variable => \$config{IPTCProfessional}, -value => 0)->pack(-anchor => 'w');
  $optF->Radiobutton(-text => 'Professional without Category', -variable => \$config{IPTCProfessional}, -value => 2)->pack(-anchor => 'w');
  $optF->Radiobutton(-text => 'Professional with Category', -variable => \$config{IPTCProfessional}, -value => 1)->pack(-anchor => 'w');
  $cN->Label(-text => 'Note: According to the IPTC standard Categories are deprecated.')->pack();
  $cN->Label(-text => 'Please choose IPTC dialog layout, close dialog and open it again to see changes.')->pack();

  my $f = $pane->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 => lang('Add'), -variable => \$config{IPTC_action}, -value => 'ADD')->pack(-side => 'left', -anchor => 'w');
    $rf->Radiobutton(-text => lang('Update'), -variable => \$config{IPTC_action}, -value => 'UPDATE')->pack(-side => 'left', -anchor => 'w');
    $rf->Radiobutton(-text => lang('Replace'), -variable => \$config{IPTC_action}, -value => 'REPLACE')->pack(-side => 'left', -anchor => 'w');
    $balloon->attach($rf, -msg =>
'Add:     new records are added and nothing is deleted; however, if you
         try to add a non-repeatable record which is already present,
         the newly supplied value ejects (replaces) the pre-existing value.
Update:  new records replace those characterised by the same tags,
         but the others are preserved. This makes it possible to modify
         some repeatable IPTC records without deleting the other tags.
Replace: all records present in the IPTC sub folder are deleted
         before inserting the new ones.');

  }

  my $okb =
    $f->Button(-text => lang('OK'), -command =>
             sub {
               # get the caption
               ${$iptc->{'Caption/Abstract'}}[0] = $caption->get(0.1, 'end');
               ${$iptc->{'Caption/Abstract'}}[0] =~ s/\s+$//;	# remove trailing whitespace
               $config{IPTCLastPad} = $notebook->raised();
               if (Exists $keyword_frame) {
                 saveTreeMode($keyword_frame->{m_tree});  # todo
                 nstore($keyword_frame->{m_tree}->{m_mode}, "$user_data_path/keywordMode") or warn "could not store $user_data_path/keywordMode: $!";
               }
               if (Exists $category_frame) {
                 saveTreeMode($category_frame->{m_tree}); # todo
                 nstore($category_frame->{m_tree}->{m_mode}, "$user_data_path/categoryMode") or warn "could not store $user_data_path/categoryMode: $!";
               }
               $conf{iptc_geometry}{value} = $t->geometry; # save window size
               $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 => lang('Cancel'), -command =>
                        sub {
                          $config{IPTCLastPad} = $notebook->raised();
                          $conf{iptc_geometry}{value} = $t->geometry; # save window size
                          $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)");
  bind_exit_keys_to_button($t, $Xbut);
  $t->waitWindow;
  return $rc;
}

##############################################################
# doubleList - mega widget containing two listboxes, an entry
#              and some buttons
##############################################################
sub doubleList {

  my $widget = shift; # mother widget
  my $l1     = shift; # predefined list ref
  my $l2     = shift; # real list ref
  my $name   = shift;

  # build a frame for the keywords/categories
  my $f = $widget->Frame(-bd => $config{Borderwidth}, -relief => 'raised')->pack(-expand => 1, -fill => 'both', -anchor=>'w', -padx => 3, -pady => 3);
  $f->Label(-text => $name, -bg => $conf{color_bg}{value})->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 => $conf{color_bg}{value})->pack(-anchor=>'w', -padx => 2, -pady => 2);
  my $catLB2;
  my $category = '';
  my $fcent = $fc1->Entry(-textvariable => \$category,
              -width => 20)->pack(-fill => 'x', -padx => 2, -pady => 2);
  $fcent->bind('<Return>',
               sub {
                 return if ($category eq '');
                 # check if keyword/category is allready in list
                 return if isInList($category, $l2);
                 push @$l2, $category;
                 $category = '';
                 @$l2 = sort { uc($a) cmp uc($b) } @$l2;
                 $catLB2->delete(0, 'end');
                 $catLB2->insert('end', @$l2);
               });

  my $tree = $fc1->Scrolled('Tree',
                           -separator  => '/',
                           -scrollbars => 'osoe',
                           -selectmode => 'extended',
                           -exportselection => 0,
                           -width      => 26,
                           -height     => 14,
                          )->pack(-expand => 1, -fill => 'both', -padx => 2, -pady => 2);
  $widget->{m_tree} = $tree;
  $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 "$user_data_path/keywordMode") {
    $modeRef = retrieve("$user_data_path/keywordMode");
  }
  if ($name eq 'supplemental categories' and -f "$user_data_path/categoryMode") {
    $modeRef = retrieve("$user_data_path/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 => $conf{color_bg}{value})->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 => $conf{color_bg}{value})->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);
  $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, lang("picture(s)"));
  my $selected = @sellist;
  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);
  }
  log_it("removing comments ...");
  # check if some files are links
  return if (!checkLinks($picLB, @sellist));
  my $pw = progressWinInit($top, "Remove all comments");
  my $i = 0;
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "removing all comments ($i/$selected) ...", $i, $selected);
    my $pic      = basename($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(getThumbFileName($dpic));
    updateOneRow($dpic, $picLB);
    showImageInfo($dpic) if ($dpic eq $actpic);
  }
  progressWinEnd($pw);
  log_it("ready! (removed comments in $i of $selected pictures)");
}

##############################################################
# 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, lang("picture(s)"));
  my $selected = @sellist;
  log_it("editing comments from $selected pictures");
  # check if some files are links
  return if (!checkLinks($lb, @sellist));
  my $pw = progressWinInit($lb, "Edit comments");
  my $i = 0;
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "editing comment ($i/$selected) ...", $i, $selected);
    my $pic      = basename($dpic);
    my $dirthumb = getThumbFileName($dpic);
    next if (!checkWriteable($dpic));
    # check if file is a link and get the real target
    next if (!getRealFile(\$dpic));
    my @comsellist = ();
    my $text = '';
    my @comments = getComments($dpic);
    if (@comments <= 0) {
      next;						# no comment -> no edit
    } elsif (@comments == 1) {
      $text = $comments[0]; # one comment -> select the first
      $comsellist[0] = 0;
    } else {
      # more than one comment, let the user select one comment to edit
      my $nr = @comments;
      my @shortComments;
      foreach (@comments) { push @shortComments, cutString($_, 80, "..."); }
      next if (!mySelListBoxDialog("Edit comment of $pic",
                                   "Please select one of the $nr comments to edit",
                                   SINGLE,
                                   "Edit", \@comsellist, @shortComments));
      if (@comsellist != 1) {
        $top->messageBox(-icon => 'warning', -message => "Please select just one comment.", -title => "Wrong selection", -type => 'OK');
        next;
      }
      $text = $comments[$comsellist[0]];
    }
    my $rc = myTextDialog("Edit comment", "Please edit comment of $pic", \$text, $dirthumb);
    next if ($rc ne 'OK');
    # replace (german) umlaute by corresponding letters
    $text =~ s/([$umlaute])/$umlaute{$1}/g if ($config{ConvertUmlaut});
    $config{Comment} = $text; # save changed comment to global config hash
    my $meta = getMetaData($dpic, "COM");
    next unless ($meta);
    $meta->set_comment($comsellist[0], $text);
    unless ($meta->save()) { warn "editComment: save $pic failed!"; }
    # touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time
    touch($dirthumb);
    updateOneRow($dpic, $lb);
    showImageInfo($dpic) if ($dpic eq $actpic);
  }
  progressWinEnd($pw);
  log_it("ready! ($i of $selected edited)");
}

##############################################################
# 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, lang("picture(s)"));
  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); 
  }
  log_it("joining comments from ".scalar @sellist." pictures");
  # check if some files are links
  return if (!checkLinks($picLB, @sellist));
  my $pw = progressWinInit($top, "Join comments");
  my $i  = 0;
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "joining comments ($i/".scalar @sellist.") ...", $i, scalar @sellist);
    my $pic = basename($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);
    my $nr = $meta->get_number_of_comments();
    next if ($nr <= 1); # no or just one comment -> no join
    my $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(getThumbFileName($dpic));
    updateOneRow($dpic, $picLB);
  }
  progressWinEnd($pw);
  log_it("ready! ($i of ".scalar @sellist." joined)");
}

##############################################################
# checkTempFile - check if temp file exists
#                 returns 0 if it exists
#                 returns 1 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, lang("picture(s)"));
  my $selected = @sellist;
  my $doForAll = 0;
  my @removedComments;

  log_it("removing comments from $selected pictures");

  # 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 my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "removing comment ($i/$selected) ...", $i, $selected);
    my $pic = basename($dpic);
    next if (!checkWriteable($dpic));

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

    my @comments = getComments($dpic);
    next if (@comments <= 0);

    # let the user select the comments to delete
    my @comsellist = ();

    # normal modus - let the user select what to remove
    if (!$doForAll) {
      my @shortComments;
      foreach (@comments) { push @shortComments, cutString($_, 80, "..."); }
      next if (!mySelListBoxDialog("Remove comments",
                                   "Please select comment(s) to remove from $pic",
                                   MULTIPLE,
                                   "Remove", \@comsellist, @shortComments));
    }
    # comment remove wizard mode :) - we choose the right comment to delete
    else {
      for (0 .. $#comments) {                          # search in all comments
        if ($comments[$_] eq $removedComments[-1]) {   # for the magic comment
          $comsellist[0] = $_;                         # remember the index
          last;
        }
      }
    }

    if ( (@comsellist == 1) and ($doForAll == 0) ) {    # if just one comment is removed
      push @removedComments, $comments[$comsellist[0]]; # remember the removed comments
      if (@removedComments >= 2) {                      # when we collected at least two ...
        if ($removedComments[-1] eq $removedComments[-2]) {  # and they are the same ...
          if ($i < @sellist) {                               # and there is still some work to be done ...
            my $com = $removedComments[-1];
            $com    = substr($com, 0, 100)."..." if (length($com) > 103);
            my $rc  = $top->messageBox(-icon => 'question', -message => "You've selected the same comment two times. Should I remove this comment:\n-------------\n$com\n-------------\nfrom the rest (".(@sellist - $i).") of the selected pictures?",
                                      -title => "Comment remove wizard", -type => 'OKCancel');
            $doForAll = 1 if ($rc =~ m/Ok/i);
          }
        }
      }
    }

    # this can only happen in wizard mode (for pictures not containing the comment to remove)
    next if (@comsellist == 0);

    my $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(getThumbFileName($dpic));

    updateOneRow($dpic, $picLB);
    showImageInfo($dpic) if ($dpic eq $actpic);
  }
  progressWinEnd($pw);
  log_it("ready! (removed comments in $j of $selected pictures)");
}

##############################################################
# 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, lang("picture(s)"));
  my $selected = @sellist;
  return if (!checkExternProgs("rotate", "jpegtran"));
  my $deg = shift; # 90, 180, 270, auto, clear, horizontal or vertical
  if ($deg eq "auto") {
    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") {
    return if (!checkExternProgs("clear 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 {  }
  
  my $errors = '';
  log_it("rotating $selected pictures");
  # check if some files are links
  return if (!checkLinks($picLB, @sellist));
  my $pw = progressWinInit($top, "rotate pictures");
  my $i = 0;
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    my ($ok, $error) = rotate_pic($dpic, $deg);
    $errors .= $error;
    progressWinUpdate($pw, "rotating ($i/$selected) ...", $i, $selected);
    updateOneRow($dpic, $picLB);
    deleteCachedPics($dpic);
    showPic($dpic) if ($ok and ($dpic eq $actpic)); # redisplay the picture if it is the actual one
  }
  progressWinEnd($pw);
  reselect($picLB, @sellist);
  log_it("ready! ($i of $selected rotated)");
  showText("Errors while rotating pictures", $errors, NO_WAIT) if ($errors ne '');
  generateThumbs(ASK, SHOW);
}

##############################################################
# rotate a single pic by 90, 180, 270, degree or
# auto, clear, flip horizontal or flip vertical
# !!!!!! WARNING !!!!!!!
# assumes that external progs are already checked!
# (checkExternProgs("rotate", "jpegtran")) , ... jhead
# see also rotate()
##############################################################
sub rotate_pic {
  my $dpic = shift;
  my $deg = shift;
  my @allowed_args = qw(90 180 270 auto clear horizontal vertical); 
  my $valid = 0;
  foreach (@allowed_args) {
    if ($deg eq $_) {
      $valid = 1; last;
    }
  }
  if (not $valid) {
    return (0, "rotate_pic called with invalid argument. Must be one of ".join(", ", @allowed_args)."\n");
  }
  my $pic = basename($dpic);
  my $dirtpic = dirname($dpic)."/$pic"."-cjpg"; # temporary file
  if (not checkWriteable($dpic)) {
    return (0, "File $dpic is not writable! Exit rotate.\n");
  }
  # check if temp file exists
  if (-f $dirtpic) {
    return (0, "Temp file $dirtpic exists! Please delete first. Exit rotate.\n");
  }
  my $transform = "-rotate $deg";
  if (($deg eq 'horizontal') or ($deg eq 'vertical')) {
    $transform = "-flip $deg";
  }
  my $command = '';
  if ($deg eq 'auto') { # auto
    if (is_a_JPEG($dpic)) {
      # call external command jhead and auto rotate the file directly
      $command = "jhead -autorot \"$dpic\" ";
    }
    else {
      return (0, "auto rotation is only supported for JPEGs ($dpic)\n");
    }
  }
  elsif ($deg eq 'clear') { # clear
    if (is_a_JPEG($dpic)) {
      # call external command jhead and clear the rotation flag of the file directly
      $command = "jhead -norot \"$dpic\" ";
    }
    else {
      return (0, "clear rotation is only supported for JPEGs ($dpic)\n");
    }
  }
  else {
    if (is_a_JPEG($dpic)) {
      my $trim   = '';
      $trim = "-trim " if $config{jpegtranTrim};
      # 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\" ";
    }
  }
  if ($command ne '') {
    execute($command);
    # now overwrite the original pic with the temp file and delete the temp file
    # (only needed for jpegtran; not needed for jhead and mogrify)
    if ($command =~ m/jpegtran .*/) {
      rotateThumb($dirtpic, $transform) if ($config{RotateThumb});
      if (not overwrite($dpic, $dirtpic)) {
        return (0, "Could not overwrite $dpic!\n");
      }
    }
  }
  else {
    return (0, "rotate_pic: Found no command for $dpic\n");
  }
  return (1, '');
}

##############################################################
# 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 - extract embedded thumbnail picture and save
# it into a file
##############################################################
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
  # extract information from an embedded thumbnail image using ExifTool
  my $exifTool = new Image::ExifTool;
  my $info = $exifTool->ImageInfo($dpic, 'thumbnailimage');
  if ($info) {
    my $thumbInfo = $exifTool->ImageInfo($$info{ThumbnailImage});
    if (defined $thumbInfo and defined ${$$info{ThumbnailImage}}) {
      my $thumbfile;
      if (open($thumbfile,'>',$dthumb)) {
        binmode $thumbfile;
        print $thumbfile ${$$info{ThumbnailImage}};
        close $thumbfile;
      }
      else {
        $$errors .= "Couldn't open thumb $dthumb for write access\n";
      }
    }
    else {
      $$errors .= "No thumbnail in $dpic info block\n";
    }
  }
  else {
    $$errors .= "No thumbnail 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;
}

##############################################################
# 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;
  return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));
  log_it("(re)building EXIF thumbnail in $selected pictures");
  my $i = 0;
  my $pw = progressWinInit($top, "(Re)build EXIF thumbnail");
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    progressWinUpdate($pw, "(Re)building EXIF thumbnail ($i/$selected) ...", $i, $selected);
    $i++;
    my $pic      = basename($dpic);
    my $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(getThumbFileName($dpic));
    updateOneRow($dpic, $picLB);
    showImageInfo($dpic) if ($dpic eq $actpic);
  }
  progressWinEnd($pw);
  log_it("ready! ($i/$selected EXIF thumbnails (re)builded)");
}

##############################################################
# 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;
  # reselect does not work for the light table
  return if (ref($lb) eq 'Tk::Canvas');
  foreach (@_) { $lb->selectionSet($_) if ($lb->info("exists", $_)); }
  showNrOf() if ($lb == $picLB);
}

##############################################################
# after moving or deleting pictures we try to select the picture
# after the last selected file
##############################################################
sub select_next {
  my $lb = shift;
  my $select = shift; # name of picture to select
  if (not $select) {
    # when the last picture has been deleted there is no next picture
    # so we simply select the last picture which is available
    my @childs = $lb->info('children');
    $select = $childs[-1];
  }
  if ($lb->info("exists", $select)) {
    if ($lb == $picLB) {
      showPic($select);
    }
    else { # just select it
      selectThumb($lb, $select);
    }
  }
}

##############################################################
# 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, lang("picture(s)"));
  my $selected = @sellist;
  log_it("rotating $selected pictures");
  # 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");
  my $i = 0;
  foreach my $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));
    my $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);
    addProcessInfoToPicComment($command, $dpic);
    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);
  log_it("ready! ($i of $selected rotated)");
  generateThumbs(ASK, SHOW);
}

my $rotw;
##############################################################
# rotateDialog
##############################################################
sub rotateDialog {
  my $deg      = shift; # reference
  my $col      = shift; # reference
  my $doforall = shift; # reference
  my $pic      = shift; # the preview pic
  my $nr       = shift; # the number of pics
  my $preview_size = 400;
  if (Exists($rotw)) {
    $rotw->deiconify;
    $rotw->raise;
    return;
  }
  my $orig = "$trashdir/".basename($pic);
  my $new  = "$trashdir/x-".basename($orig);
  unless (mycopy($pic, $orig, OVERWRITE)) {
    warn "rotateDialog: copy error $pic -> $orig ($new)\ncopy";
    return 0;
  }
  my ($w, $h) = getSize($orig);
  if ($w > $preview_size or $h > $preview_size) {
    log_it("rotate: resizing preview picture ...");
    my $command = "mogrify -geometry ${preview_size}x${preview_size} -quality 80 \"$orig\"";
    $top->Busy;
    execute($command);
    $top->Unbusy;
    log_it(lang('Ready!'));
  }
  return 0 unless (-f $orig);
  # open window
  $rotw = $top->Toplevel();
  $rotw->title("Rotate picture");
  $rotw->iconimage($mapiviicon) if $mapiviicon;
  my $rc = 0;
  my $preview;
  $preview = $rotw->Photo(-file => "$orig", -gamma => $config{Gamma}) if (-f $orig);
  my $fc = $rotw->Frame()->pack();
  my $prevC;
  $prevC = $fc->Scrolled('Canvas',
                              -scrollbars => 'osoe',
                              -width  => $preview_size,
                              -height => $preview_size,
                              -relief => 'sunken',
                              -bd => $config{Borderwidth})->pack(-side => 'left', -padx => 3, -pady => 3,-anchor => 'w') if $preview;
  my $horizont = 0;
  my $vertical = 0;
  $fc->Scale(-variable => \$horizont,
             -length => $preview_size,
             -from => 0,
             -to => $preview_size,
             -resolution => 1,
             -sliderlength => 10,
             -orient => 'vertical',
             -width => 10,
             -bd => 1,
             -showvalue => 0,
             -relief => 'groove',
             -command => sub {
               drawHorizont($prevC, $horizont, $vertical);
             } )->pack(-side => 'left', -padx => 3,-pady => 3);
  $rotw->Scale(-variable => \$vertical,
               -length => $preview_size,
               -from => 0,
               -to => $preview_size,
               -resolution => 1,
               -sliderlength => 10,
               -orient => 'horizontal',
               -width => 10,
               -bd => 1,
               -showvalue => 0,
               -relief => 'groove',
               -command => sub {
                 drawHorizont($prevC, $horizont, $vertical);
               } )->pack(-anchor => 'w', -padx => 3,-pady => 3);
  $prevC->createImage(0, 0, -image => $preview, -tag => "image", -anchor => "nw");
  my $f1 = $rotw->Frame()->pack(-anchor => 'w');
  my $auto = 0;
  $f1->Checkbutton(-text => "auto update", -variable => \$auto)->pack(-side => 'left', -expand => 1, -fill => 'x');
  $f1->Button(-text => "--", -command => sub {
                $$deg--;
                rotUpdate($prevC, $preview, $orig, $new, $deg, $col) if $auto;
              })->pack(-side => 'left', -expand => 1, -fill => 'x');
  $f1->Button(-text => "-", -command => sub {
                $$deg -= 0.1;
                rotUpdate($prevC, $preview, $orig, $new, $deg, $col) if $auto;
              })->pack(-side => 'left', -expand => 1, -fill => 'x');
  $f1->Label(-textvariable => $deg, -relief => 'sunken', -width => 5)->pack(-side => 'left', );
  $f1->Button(-text => "+", -command => sub {
                $$deg += 0.1;
                rotUpdate($prevC, $preview, $orig, $new, $deg, $col) if $auto;
              })->pack(-side => 'left', -expand => 1, -fill => 'x');
  $f1->Button(-text => "++", -command => sub {
                $$deg++;
                rotUpdate($prevC, $preview, $orig, $new, $deg, $col) if $auto;
              })->pack(-side => 'left', -expand => 1, -fill => 'x');
  labeledScale($rotw, 'top', 26, "Angle (degrees, clockwise)", $deg, 0, 359.9, 0.1);
  my $qS = labeledScale($rotw, 'top', 26, lang("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 => lang('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 => lang('Cancel'),
                           -command => sub {
                             $rc = 0;
                             $rotw->withdraw();
                             $rotw->destroy();
                           }
                          )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  bind_exit_keys_to_button($rotw, $XBut);
  $rotw->Popup;
  $rotw->waitWindow;
  # clean up
  $preview->delete;
  removeFile($orig);
  removeFile($new);
  return $rc;
}

##############################################################
# bind Ctrl-q and ESC key and window close button to invoke
# given window exit button (e.g. "Cancel" button) 
##############################################################
sub bind_exit_keys_to_button {
  my $w = shift; # widget / window
  my $button = shift; # Exit button (e.g. Cancel) to invoke on quit
  # check arguments
  if (ref($w) ne 'Tk::Toplevel') {
    warn "bind_exit_keys_to_button called with wrong argument w: ".ref($w);
    return 0;
  }
  if (ref($button) ne 'Tk::Button') {
    warn "bind_exit_keys_to_button called with wrong argument button: ".ref($button);
    return 0;
  }
  $w->bind('<Control-q>', sub { $button->Invoke; });
  $w->bind('<Key-Escape>', sub { $button->Invoke; });
  $w->protocol("WM_DELETE_WINDOW" => sub { $button->Invoke; });
  return 1;
}
  
##############################################################
# 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 ($id) = $prevC->find('withtag', 'image');
  my ($x1, $y1, $x2, $y2) = $prevC->bbox($id);
  $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) {
    my $file = Encode::encode('iso-8859-1', $$dirfileR);
    warn "getRealFile: $$dirfileR ($file) is no file!";
    return 0;
  }
  if (-l $$dirfileR) {
    my $linktargetfile = getLinkTarget($$dirfileR);
    if ($linktargetfile eq '') {
      warn "error in getLinkTarget! ($$dirfileR)";
      return 0;
    }
    else {
      $$dirfileR = $linktargetfile;
      return 1;
    }
  }
  else {      # no link, change nothing, return true
    return 1;
  }
}

##############################################################
# getLinkTarget - returns the file a link is pointing to
#                 input (folder, link) or (dirlink) where
#                 dirlink consists of folder and link
#                 works with relative and absolute links
##############################################################
sub getLinkTarget {
  my ($dir, $link);
  if (@_ == 2) {
    $dir  = shift;
    $link = shift;
  }
  elsif (@_ == 1) {
    $dir  = dirname($_[0]);
    $link = basename($_[0]);
  }
  else {
    warn "getLinkTarget: wrong # of parameters!";
    return '';
  }
  # change first to the start dir (to handle relative links)
  return '' if !changeDir($dir);
  my $linktargetfile = readlink $link;
  my $linktargetdir  = dirname  $linktargetfile;
  # change to link target, this should now work for relative and absolute links
  return '' if !changeDir($linktargetdir);
  # get the current dir
  my $cwd = cwd();
  $linktargetfile = $cwd.'/'.basename($linktargetfile);
  return $linktargetfile;
}

##############################################################
# overwrite - takes two files a and b, deletes a and moves b
#             to a
#             the file names 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'
##############################################################
# ToDo: should return true or false instead of Ok/Cancel
sub myEntryDialog {
  my $title = shift;
  my $text = shift;
  my $varRef = shift;
  my $thumbnail = shift; # optional
  my $icon;
  my $rc = 'Cancel';
  # open window
  my $myDiag = $top->Toplevel();
  $myDiag->title($title);
  $myDiag->iconimage($mapiviicon) if $mapiviicon;
  my $f = $myDiag->Frame()->pack(-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 => $conf{color_bg}{value}, -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 = 30 if ($height > 30); # not to big, we have scrollbars
  my $rotext = $f->Scrolled('ROText',
                            -scrollbars => 'osoe',
                            -wrap => 'word',
                            -tabs => '4',
                            -width => 80,
                            -height => $height,
                            -relief => 'flat',
                            -bg => $conf{color_bg}{value},
                            -bd => 0
                           )->pack(-side => 'right', -fill => 'both', -expand => 1, -padx => 3, -pady => 3);
  $rotext->insert('end', $text);
  my $OKB;
  my $entry =
    $myDiag->Entry(-textvariable => \$$varRef,
           -width => 40,
          )->pack(-fill => 'x', -padx => 3, -pady => 3);
  if ($$varRef =~ /(.*)(\.jp(g|eg))/i) {  # if it is a jpeg image name
    $entry->selectionRange(0,length($1)); # select only the part before the suffix
    $entry->icursor(length($1));
  }
  else {
    $entry->selectionRange(0,'end');      # else select all
    $entry->icursor('end');
  }
  $entry->xview('end');
  $entry->bind('<Return>', sub { $OKB->Invoke; } );
  $entry->focus;
  my $ButF = $myDiag->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
  $OKB = $ButF->Button(-text => lang('OK'),
               -command => sub {
             $rc = 'OK';
             $myDiag->destroy;
               })->pack(-side => 'left', -expand => 1, -fill => 'x',
                -padx => 3, -pady => 3);
  my $XBut = $ButF->Button(-text => lang('Cancel'),
               -command => sub {
                 $rc = 'Cancel';
                 $myDiag->destroy;
               }
              )->pack(-side => 'left', -expand => 1, -fill => 'x',
                  -padx => 3, -pady => 3);
  bind_exit_keys_to_button($myDiag, $XBut);
  $myDiag->Popup;
  repositionWindow($myDiag);
  $myDiag->waitWindow();
  $icon->delete if $icon;
  return $rc;
}

##############################################################
# myFontDialog - dialog to select a font family
##############################################################
sub myFontDialog {

  my $widget    = shift;
  my $title     = shift;
  #my $text      = shift;
  my $varRef    = shift;
  my $size      = shift;
  my $rc        = 0;

  # open window
  my $myDiag = $widget->Toplevel();
  $myDiag->title($title);
  $myDiag->iconimage($mapiviicon) if $mapiviicon;

  my $listBox = $myDiag->Scrolled('Listbox',
                  -scrollbars => 'osoe',
                  -selectmode => 'single',
                  -exportselection => 0,
                  -width => 30,
                  #-height => 40,
                 )->pack(-side => 'left', -anchor => 'w', -expand => 1, -fill =>'y', -padx => 3, -pady => 3);

  my $f = $myDiag->Frame()->pack(-side => 'left', -expand => 1, -anchor => 'w', -fill =>'both');

  my @fontFamilies = sort $top->fontFamilies;
  shift @fontFamilies unless ($fontFamilies[0]);
  $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 => $conf{color_bg}{value}, -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 => lang('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 => lang('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 => lang('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 => lang('Cancel'),
               -command => sub {
                 $rc = 0;
                 $myDiag->destroy;
               }
              )->pack(-side => 'left', -expand => 1, -fill => 'x',
                  -padx => 3, -pady => 3);

  bind_exit_keys_to_button($myDiag, $XBut);
  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 => $conf{color_bg}{value},
                                 -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 => $conf{color_bg}{value}, -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 => $conf{color_bg}{value}, -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 => 90,
                            -height => $height,
                            -relief => 'flat',
                            -bg => $conf{color_bg}{value},
                            -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 => $conf{color_bg}{value},
                    )->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 => $conf{color_bg}{value},
                            -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 => $conf{color_bg}{value}
                  )->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 => $conf{color_bg}{value}, -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);
  $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 "$user_data_path/keywordMode") {
    my $hashRef = retrieve("$user_data_path/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 => lang('OK'),
                    -command => sub {
                      $$varRef = $entry->get(0.1, 'end');
                      trimComment($varRef);
                      my $len = length($$varRef);
                      if ($len >= $maxCommentLength) {
                        $top->messageBox(-icon => 'warning', -message => "Sorry your comment is too long ($len characters).\nJPEG-Comments may only be up to 64K.\nPlease shorten your comment.",
                       -title => "Comment to long", -type => 'OK');
                        return;
                      }
                      $rc = 'OK';
                      saveTreeMode($keytree);
                      nstore($keytree->{m_mode}, "$user_data_path/keywordMode") or warn "could not store $user_data_path/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 => lang("Insert ..."), -bg => $conf{color_bg}{value},
                  )->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 3, -pady => 3);

  my $crb =
  $topButF->Button(-text => lang('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 => lang('File name'),
                -command => sub {
                  $entry->insert("insert", basename($actpic));
                })->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 3, -pady => 3);
  $topButF->Button(-text => lang('Last comment'),
                -command => sub {
                  $entry->insert("insert", $config{Comment});
                })->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 3, -pady => 1);
  $topButF->Button(-text => lang("File ..."),
                -command => sub {
                  my $file = $myDiag->getOpenFile(-title => 'Add comment from file', -initialdir => $actdir);

                  return if ((!defined $file) or ($file eq '') or (!-f $file));
                  my $fileH;
                  if (!open($fileH, '<', $file)) {
                    warn "Sorry, I couldn't open the file $file: $!";
                    return;
                  }

                  my $buffer;
                  read $fileH, $buffer, 32768; # <- todo!!!
                  close($fileH);
                  $entry->insert("insert", $buffer);
                 })->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 3, -pady => 3);
  $ButF->Button(-text => lang('Cancel'),
                -command => sub {
                  $rc = 'Cancel';
                  saveTreeMode($keytree);
                  nstore($keytree->{m_mode}, "$user_data_path/keywordMode") or warn "could not store $user_data_path/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 => $conf{color_bg}{value}
                  )->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 => $conf{color_bg}{value}
                  )->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 => $conf{color_bg}{value}
                  )->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 => lang('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 => lang("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 => lang('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 '
  return;
}

##############################################################
# mySelListBoxDialog - let the user select some items of the
#                      given list
##############################################################
sub mySelListBoxDialog {
  my $title   = shift;
  my $text    = shift;
  my $mode    = shift;  #SINGLE (one selection) or MULTIPLE (several selections)
  my $OKBut   = shift;
  my $sellist = shift; # output list (list reference) - the list with the selected items
  my @list    = @_;    # input list - the list to choose from
  my $rc      = 0;
  # open window
  my $myDiag = $top->Toplevel();
  $myDiag->title($title);
  $myDiag->iconimage($mapiviicon) if $mapiviicon;
  $myDiag->Label(-anchor => 'w', -justify => 'left', -text => $text, -bg => $conf{color_bg}{value})->pack(-fill => 'x', -padx => 3, -pady => 3);
  my $listBoxY = @list;
  $listBoxY = 30 if ($listBoxY > 30); # maximum 30 entries
  my $listBox =
      $myDiag->Scrolled('Listbox',
                        -scrollbars => 'osoe',
                        -selectmode => 'extended',
                        -exportselection => 0,
                        -width => 80,
                        -height => $listBoxY,
                        )->pack(-expand => 1, -fill =>'both', -padx => 3, -pady => 3);
  $listBox->configure(-selectmode => 'single') if ($mode == SINGLE);
  $listBox->insert('end', @list);
  $listBox->bind('<Double-Button-1>', sub {
                      @$sellist = $listBox->curselection();
                      $rc = 1;
                    } );
  # select all|none make only sense if multiple selection is possible
  if ($mode == MULTIPLE) {
    my $ubutF = $myDiag->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
    $ubutF->Button(-text => lang('Select all'),
                    -command => sub {
                         $listBox->selectionSet(0, 'end');
                      })->pack(-side => 'left', -padx => 3, -pady => 3);
    $ubutF->Button(-text => lang('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; } );
  my $xBut = $ButF->Button(-text => lang('Cancel'),
                -command => sub { $rc = 0; }
                 )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  bind_exit_keys_to_button($myDiag, $xBut);
  $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 => lang("Folder Menu"));
  return;
}

##############################################################
# updateDirMenu
##############################################################
sub updateDirMenu {
  return if (!defined($dirMenu));
  # get number of items
  my $end = $dirMenu->index('end');
  # first call to function - build up menu fixed part
  # less than 12 menu items (separators count too!)
  if ($end < 12) { 
    $dirMenu->command(-image => compound_menu($top, lang('Open folder ...'), 'folder.png'),
              -command => sub {
              my $dir = getRightDir();
              openDirPost($dir);}, -accelerator => "double click");
    $dirMenu->command(-image => compound_menu($top, lang('Preview folder'), ''),
            -command => sub {
            my $dir = getRightDir();
            my @list = getPics($dir, WITH_PATH, NO_CHECK_JPEG);
            sortPics($config{SortBy}, $config{SortReverse}, \@list);
            showThumbList(\@list, $dir); }, -accelerator => "middle click");
    $dirMenu->command(-image => compound_menu($top, lang('Copy pictures to folder'), ''),
            -command => sub { copy_or_move_pics_to_folder(COPY); });
    $dirMenu->command(-image => compound_menu($top, lang('Move pictures to folder'), ''),
            -command => sub { copy_or_move_pics_to_folder(MOVE); });
    $dirMenu->command(-image => compound_menu($top, lang('Search in folder ...'), 'system-search.png'),
            -command => sub {
            my $tmp = $config{SearchOnlyInDir}; # save search mode
            $config{SearchOnlyInDir} = 1;       # set to local search
            searchMetaInfo();
            $config{SearchOnlyInDir} = $tmp;    # restore search mode
            });
    my $dir_size = $dirMenu->cascade(-image => compound_menu($top, lang('Folder size'), ''));
    $dir_size->cget(-menu)->configure(-title => lang('Folder size'));
    $dir_size->command(-label => lang("Calculate folder size"), -command => sub { calcDirSize(); } );
    $dir_size->command(-label => lang("Display folder sizes (graphic)"),
             -command => sub { showDirSizes(getRightDir()); } );

    $dirMenu->separator;
    $dirMenu->command(-image => compound_menu($top, lang('Rename folder ...'), ''),
            -command => sub { renameDir(); });
    $dirMenu->command(-image => compound_menu($top, lang('New folder ...'), 'folder-new.png'),
            -command => sub {
            my $dir = getRightDir();
            if (!-d $dir) { warn "dir $dir is no dir"; return; }
            makeNewDir($dir, $dirtree); });
     $dirMenu->command(-image => compound_menu($top, lang('Delete folder ...'), ''),
            -command => sub { deleteDir(); });

    $dirMenu->separator;
    my $dir_hot = $dirMenu->cascade(-image => compound_menu($top, lang('Folder list'), 'emblem-favorite.png'));
    $dir_hot->cget(-menu)->configure(-title => lang('Folder list'));
    $dir_hot->command(-label => lang("Add actual folder"),
            -command => sub {
            my $dir = getRightDir();
            my $max = 0;
            foreach (sort {$dirHotlist{$b} <=> $dirHotlist{$a}} keys %dirHotlist) {
                $max = $dirHotlist{$_};
                last;
            }
            $dirHotlist{$dir} = $max;
            log_it("added $dir to list!");
            updateDirMenu();
            });
    $dir_hot->command(-label => lang("Remove actual folder"), -command => sub {
    my $dir = getRightDir();
    delete $dirHotlist{$dir} if (defined($dirHotlist{$dir}));
    log_it("removed $dir from list!");
    updateDirMenu();
    });
  }
  else {
    # clear dir menu index 13 to end (dynamic part)
    $dirMenu->delete(13, 'end');
  }

  # add the dynamic part
  # add the 12 most wanted hotlist folders :)
  my @dirlist;
  foreach (sort {$dirHotlist{$b} <=> $dirHotlist{$a}} keys %dirHotlist) {
    # remove deleted dirs
    if (!-d $_) {
      delete $dirHotlist{$_};
      next; # skip
    }
    next if ($_ eq $trashdir);
    push @dirlist, $_;
    last if (@dirlist > 11);
  }

  foreach (sort @dirlist) {
    my $dir = $_; # we need a local copy
    # this will add the number of accesses of the folder
    #$dirMenu->command(-label => "$_", -command => sub { openDirPost($dir); }, -accelerator => "($dirHotlist{$_})");
    $dirMenu->command(-label => "$_", -command => sub { openDirPost($dir); });
  }

  $dirMenu->separator;

  # add the last used folders
  foreach (reverse @dirHist) {
    next if (!-d $_);
    my $dir = $_; # we need a local copy
    $dirMenu->command(-label => "$dir", -command => sub { openDirPost($dir); });
  }
}

##############################################################
# createThumbMenu
##############################################################
sub createThumbMenu {
  $thumbMenu =
    $top->Menu(-title => lang("Thumbnail Menu"));
  addSelectMenu($thumbMenu);
  $thumbMenu->separator;
  addFileActionsMenu($thumbMenu, $picLB);
  $thumbMenu->separator;
  addPicProcessing($thumbMenu, $picLB);
  $thumbMenu->separator;
  addMetaInfoMenu($thumbMenu);
  $thumbMenu->separator;
  $thumbMenu->command(-image => compound_menu($top, lang('Open this folder'), 'folder.png'), -command => sub { open_pic_folder($picLB); }, -accelerator => '<m>' );
  $thumbMenu->command(-image => compound_menu($top, lang('Reload pictures'), 'view-refresh.png'), -command => \&updateThumbsPlus, -accelerator => '<u>');
  $thumbMenu->command(-image => compound_menu($top, lang('Reload picture meta information'), 'view-refresh.png'), -command => sub { reread_pics($picLB); });
  $thumbMenu->command(-label => lang("Rebuild thumbnails ..."), -command => \&rebuildThumbs); #, -accelerator => "<Ctrl-r>");
  $thumbMenu->command(-label => lang("Add to collection"), -command => sub {light_table_add_from_lb($picLB);}, -accelerator => "<l>");
  $thumbMenu->command(-image => compound_menu($top, lang('Show GPS position in map'), 'internet-web-browser.png'), -command => sub { gps_map_open($picLB); } );
}

##############################################################
# createPicMenu
##############################################################
sub createPicMenu {
  $picMenu = $top->Menu(-title => lang('Picture Menu'));
  $picMenu->command(-label => lang('Reload picture'),  -command => \&reloadPic, -accelerator => '<U>' );
  $picMenu->command(-label => lang('Show thumbnails in picture frame'),  -command => sub { my @pics = $picLB->info('children'); show_canvas_thumbs($c, \@pics);}, -accelerator => '<t>' );
  $picMenu->command(-image => compound_menu($top, lang('Open pictures in new window'), 'image-x-generic.png'),  -command => sub {showPicInOwnWin($actpic);}, -accelerator => '<d>' );
  $picMenu->separator;
  addPicProcessing($picMenu, $picLB);
  $picMenu->separator;
  addZoomMenu($picMenu);
  $picMenu->separator;
  add_window_layout_menu($picMenu);
  $picMenu->separator;
  $picMenu->command(-image => compound_menu($top, lang('Options ...'), 'preferences-system.png'),  -command => \&options_edit, -accelerator => "<Ctrl-o>");
  $picMenu->command(-image => compound_menu($top, lang('Other options ...'), 'preferences-system.png'),  -command => \&options);
  $picMenu->command(-image => compound_menu($top, lang('Fullscreen'), 'view-fullscreen.png'),  -command => sub { fullscreen($top); } );
}

##############################################################
# compoud_menu
##############################################################
sub compound_menu {
  my $w         = shift;
  my $text      = shift;
  my $icon_name = shift;
  my $space     = shift;  # optional
  $space        = 19 unless defined $space;

  my $compound_image = $w->Compound();
  if (-f "$icon_path/$icon_name") {
    $compound_image->Image(-image => $top->Photo(-file => "$icon_path/$icon_name", -gamma => $config{Gamma}));
    $compound_image->Space(-width => 3);
  }
  else {
    $compound_image->Space(-width => $space);
    print "Mapivi info: icon $icon_path/$icon_name not found.\n" if ($icon_name ne '');
  }
  $compound_image->Text(-text => $text, -foreground => $conf{color_menu_fg}{value} );
  return $compound_image;
} 

##############################################################
# createMenubar
##############################################################
sub createMenubar {

  $menubar = $top->Menu;
  my $file_menu = $menubar->cascade(-label => lang("File")); # use "~File" for key shortcut
  $file_menu->cget(-menu)->configure(-title => "File menu");
  my $edit_menu = $menubar->cascade(-label => lang("Edit"));
  $edit_menu->cget(-menu)->configure(-title => "Edit menu");
  my $view_menu = $menubar->cascade(-label => lang("View"));
  $view_menu->cget(-menu)->configure(-title => "View menu");
  my $sort_menu = $menubar->cascade(-label => lang('Sort'));
  $sort_menu->cget(-menu)->configure(-title => "Sort menu");
  my $find_menu = $menubar->cascade(-label => lang("Search"));
  $find_menu->cget(-menu)->configure(-title => "Search menu");
  my $opti_menu = $menubar->cascade(-label => lang("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 => lang("Help"));
  $help_menu->cget(-menu)->configure(-title => "Help menu");


  #my $icon = ;
  $file_menu->command(-image => compound_menu($top, lang('Open folder ...'), 'folder.png'), -command => \&openDir, -accelerator => "<o>");
  #$file_menu->command(-image => compound_menu($top, 'open umlaut folder ...', ''),   -command => sub { openDirPost("/home/herrmann/tmp/dirb/subdirä"); } );
  $file_menu->command(-image => compound_menu($top, lang('Preview folder'), ''), -command => sub {
                      my $dir = getRightDir();
                      my @list = getPics($dir, WITH_PATH, NO_CHECK_JPEG);
                      sortPics($config{SortBy}, $config{SortReverse}, \@list);
                      showThumbList(\@list, $dir); }, -accelerator => "middle click");

  $file_menu->command(-image => compound_menu($top, lang('Search in folder ...'), ''), -command => sub {
                      my $tmp = $config{SearchOnlyInDir}; # save search mode
                      $config{SearchOnlyInDir} = 1;       # set to local search
                      searchMetaInfo();
                      $config{SearchOnlyInDir} = $tmp;    # restore search mode
                    });
  my $dir_size  = $file_menu->cascade(-image => compound_menu($top, lang('Folder size'), ''));
  $dir_size->command(-label => lang("Calculate folder size"), -command => sub { calcDirSize(); } );
  $dir_size->command(-label => lang("Display folder sizes (graphic)"), -command => sub { showDirSizes(getRightDir()); } );

  $file_menu->separator;
  $file_menu->command(-image => compound_menu($top, lang('Rename folder ...'), ''), -command => \&renameDir);
  $file_menu->command(-image => compound_menu($top, lang('New folder ...'), 'folder-new.png'),    -command => sub { 
      my $dir = getRightDir();
      if (!-d $dir) { warn "dir $dir is no dir"; return; }
      makeNewDir($dir, $dirtree); } );
  $file_menu->command(-image => compound_menu($top, lang('Delete folder ...'), ''), -command => \&deleteDir);

  $file_menu->command(-image => compound_menu($top, lang('Hot folders ...'), ''),  -command => sub {
                        $dirMenu->Popup(-popover => "cursor", -popanchor => "nw");
                        }, , -accelerator => "<h>");

  $file_menu->separator;
  addFileActionsMenu($file_menu, $picLB);

  $file_menu->separator;
  #my $trash_menu = $file_menu->cascade(-image => compound_menu($top, lang('Trash'), 'user-trash.png'));
  $file_menu->command(-image => compound_menu($top, lang('Empty trash ...'), 'user-trash.png'), -command => \&emptyTrash);
  #$trash_menu->command(-label => lang("Open trash in main window"), -command => [\&openDirPost, $trashdir]);
  $file_menu->command(-image => compound_menu($top, lang('Folder checklist ...'), ''), -command => sub { showDirProperties(); } );
  $file_menu->command(-image => compound_menu($top, lang('Import wizard ...'), 'camera-photo.png'), -command => \&importWizard);

  $file_menu->separator;
  $file_menu->command(-image => compound_menu($top, lang('Picture collection').' ...', ''), -command => \&light_table_open_window);
  $file_menu->command(-image => compound_menu($top, lang('Convert non-JPEG pictures ...'), ''), -command => \&convertNonJPEGS);
  $file_menu->command(-image => compound_menu($top, lang('Reload pictures'), 'view-refresh.png'), -accelerator => "<u>",
                      -command => \&updateThumbsPlus);
  $file_menu->command(-image => compound_menu($top, lang('Smart update'), 'view-refresh.png'), -command => sub { smart_update(); }, -accelerator => "<F5>");
  $file_menu->command(-image => compound_menu($top, lang("Rebuild thumbnails ..."), ''), -command => \&rebuildThumbs); #, -accelerator => "<Ctrl-r>");
  $file_menu->command(-image => compound_menu($top, lang('Build thumbnails ...'), ''), -command => \&buildThumbsRecursive);
  $file_menu->separator;
  $file_menu->command(-image => compound_menu($top, lang('Iconify'), 'user-desktop.png'), -accelerator => "<ESC>",   -command => sub { $top->iconify; });
  $file_menu->command(-image => compound_menu($top, lang('Quit'), 'system-log-out.png'), -accelerator => "<Ctrl-q>",   -command => \&quitMain);


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

  addPicProcessing($edit_menu, $picLB);
  $edit_menu->separator;

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

  $view_menu->command(-image => compound_menu($top, lang('Next'), 'go-next.png'), -command => sub {
                        return if (stillBusy()); # block, until last picture is loaded
                        if ($slideshow == 1) {
                          $slideshow = 0; slideshow();
                        }		# switch slideshow off
                        showPic(nextPic($actpic));
                      }, -accelerator => "<Space>");
  $view_menu->command(-image => compound_menu($top, lang('Previous'), 'go-previous.png'), -command => sub {
                        return if (stillBusy()); # block, until last picture is loaded
                        if ($slideshow == 1) {
                          $slideshow = 0; slideshow();
                        }		# switch slideshow off
                        showPic(prevPic($actpic));},
                      -accelerator => "<BackSpace>");

  $view_menu->separator;

  $view_menu->command(-image => compound_menu($top, lang('First'), 'go-first.png'), -command => sub {
                        return if (stillBusy()); # block, until last picture is loaded
                        if ($slideshow == 1) { $slideshow = 0; slideshow(); }		# switch slideshow off
                        my @childs = $picLB->info('children');
                        return unless (@childs);
                        showPic($childs[0]); },
                      -accelerator => "<Home>");
  $view_menu->command(-image => compound_menu($top, lang('Last'), 'go-last.png'), -command => sub {
                        return if (stillBusy()); # block, until last picture is loaded
                        if ($slideshow == 1) {
                          $slideshow = 0; slideshow();
                        }		# switch slideshow off
                        my @childs = $picLB->info('children');
                        return unless (@childs);
                        showPic($childs[-1]);
                      },
                      -accelerator => "<End>");

  $view_menu->separator;

  $view_menu->command(-image => compound_menu($top, lang('go to/select ...'), ''), -command => sub { gotoPic($picLB); });

  $view_menu->separator;

  addZoomMenu($view_menu);
  $view_menu->separator;

  $view_menu->command(-image => compound_menu($top, lang('Open pictures in new window'), 'image-x-generic.png'), -command => sub {  my @sellist = getSelection($picLB);
  return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));
  show_multiple_pics(\@sellist, 0);
}, -accelerator => "<d>");
  $view_menu->command(-image => compound_menu($top, lang('Open pictures in external viewer'), 'image-x-generic.png'), -command => sub{openPicInViewer($picLB);}, -accelerator => "<v>");
  $view_menu->command(-label => lang("Picture information"), -command => \&identifyPic);
  $view_menu->command(-label => lang("Histogram (ImageMagick)"), -command => sub { showHistogram($picLB); } );
  $view_menu->command(-label => lang("Histogram (Mapivi)"), -command => sub { showHistogram2($picLB); } );
  $view_menu->command(-label => lang("Show JPEG segments"), -command => \&showSegments);

  $view_menu->command(-image => compound_menu($top, lang('Start/stop slideshow'), 'media-playback-start.png'), -command => sub {
                        if ($slideshow == 0) {
                          $slideshow = 1;
                        } else {
                          $slideshow = 0;
                        }
                        slideshow();
                      }, -accelerator => "<s>");
  $view_menu->command(-label => lang("Picture as desktop background"),
                      -command => \&setBackground);
 
  $view_menu->separator;
  add_window_layout_menu($view_menu);
  $view_menu->command(-label => lang("Fullscreen"), -command => sub { fullscreen($top); }, -accelerator => "<F11>");

  $view_menu->separator;
  my $thumb_menu = $view_menu->cascade(-label => lang("Thumbnail table"));
  $thumb_menu->cget(-menu)->configure(-title => lang("Thumbnail table"));

  my $caption_menu = $thumb_menu->cascade(-label => lang("Thumbnail caption"));
  $caption_menu->cget(-menu)->configure(-title => "Thumbnail caption ...");
  $caption_menu->radiobutton(-label => lang("None"), -variable => \$config{ThumbCapt},  -value => "none", -command => sub { updateThumbsPlus(); });

  $caption_menu->radiobutton(-label => lang("File name without suffix"), -variable => \$config{ThumbCapt},  -value => "filename", -command => sub { updateThumbsPlus(); });

  $caption_menu->radiobutton(-label => lang("File name with suffix"), -variable => \$config{ThumbCapt},  -value => "filenameSuffix", -command => sub { updateThumbsPlus(); });

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

  $thumb_menu->separator;

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


  $sort_menu->radiobutton(-label => lang("File name"), -variable => \$config{SortBy},  -value => "name", -command => sub { updateThumbsPlus(); });
  $sort_menu->radiobutton(-label => lang("File date"), -variable => \$config{SortBy},  -value => "date", -command => \&updateThumbsPlus);
  $sort_menu->radiobutton(-label => lang("File size"), -variable => \$config{SortBy},  -value => "size", -command => \&updateThumbsPlus);
  $sort_menu->separator;
  $sort_menu->radiobutton(-label => lang("IPTC urgency/rating"), -variable => \$config{SortBy},  -value => "urgency", -command => \&updateThumbsPlus);
  $sort_menu->radiobutton(-label => lang("IPTC by-line"), -variable => \$config{SortBy},  -value => "byline", -command => \&updateThumbsPlus);
  $sort_menu->separator;
  $sort_menu->radiobutton(-label => lang("Flags"), -variable => \$config{SortBy},  -value => "flag", -command => \&updateThumbsPlus);
  $sort_menu->radiobutton(-label => lang("Number of views"), -variable => \$config{SortBy},  -value => "popularity", -command => \&updateThumbsPlus);
  $sort_menu->radiobutton(-label => lang("Number of pixels"), -variable => \$config{SortBy},  -value => "pixel", -command => \&updateThumbsPlus);
  $sort_menu->radiobutton(-label => lang("Number of bits per pixels (b/p)"), -variable => \$config{SortBy},  -value => "bitpix", -command => \&updateThumbsPlus) if ($config{BitsPixel});
  $sort_menu->separator;
  $sort_menu->radiobutton(-label => lang("EXIF date"), -variable => \$config{SortBy},  -value => "exifdate", -command => \&updateThumbsPlus);
  $sort_menu->radiobutton(-label => lang("EXIF aperture"), -variable => \$config{SortBy},  -value => "aperture", -command => \&updateThumbsPlus);
  $sort_menu->radiobutton(-label => lang("EXIF exposure time"), -variable => \$config{SortBy},  -value => "exposuretime", -command => \&updateThumbsPlus);
  $sort_menu->radiobutton(-label => lang("EXIF camera maker/model"), -variable => \$config{SortBy},  -value => "model", -command => \&updateThumbsPlus);
  $sort_menu->radiobutton(-label => lang("EXIF artist"), -variable => \$config{SortBy},  -value => "artist", -command => \&updateThumbsPlus);
  $sort_menu->separator;
  $sort_menu->radiobutton(-label => lang("Sort randomly"), -variable => \$config{SortBy},  -value => "random", -command => \&updateThumbsPlus);
  $sort_menu->separator;
  $sort_menu->checkbutton(-label => lang("Sort reverse"), -variable => \$config{SortReverse}, -command => \&updateThumbsPlus);

  $find_menu->command(-image => compound_menu($top, lang('Search ...'), 'system-search.png'), -command => sub { $config{Layout} = 1 ; layout(1); $act_modus = SEARCH; $nav_F->{nav_tab}->raise('search');});
  $find_menu->command(-image => compound_menu($top, lang('Advanced search ...'), 'system-search.png'), -command => \&searchMetaInfo, -accelerator => '<Ctrl-f>');
  $find_menu->command(-image => compound_menu($top, lang('Search by keywords (tag cloud) ...'), 'weather-overcast.png'), -command => \&keyword_browse, -accelerator => '<k>');
  $find_menu->command(-image => compound_menu($top, lang('Search by timeline ...'), 'x-office-calendar.png'), -command => \&database_info);
  $find_menu->command(-image => compound_menu($top, lang('Search by location ...'), 'applications-internet.png'), -command => sub { search_by_location($picLB); } );
  $find_menu->command(-image => compound_menu($top, lang('Search duplicates ...'), ''), -command => \&findDups);
  #$find_menu->command(-label => "check for new keywords ...", -command => \&check_new_keywords);
  $find_menu->separator;
  my $find_special_menu = $find_menu->cascade(-image => compound_menu($top, lang('Special searches'), ''));

  $find_menu->command(-image => compound_menu($top, lang('Slideshow all pictures with filter').' '.lang("Settings"), ''), -command => sub {slideshow_all_pics(SETTINGS);});
  $find_menu->command(-image => compound_menu($top, lang('Slideshow all pictures with filter').' '.lang("Start"), ''), -command => sub {slideshow_all_pics(START);});
  $find_special_menu->command(-label => lang("TOP 100 (best rated)"), -command => \&showMostPopularPics);
  $find_special_menu->command(-label => lang("EXIF histogram"), -command => \&exif_histogram);
  $find_special_menu->command(-image => compound_menu($top, lang('Search for file name ...'), 'edit-find.png'),  -command => sub { searchFileName($picLB);});
  $find_special_menu->command(-image => compound_menu($top, lang('Search for date/time'), 'edit-find.png'),  -command => sub { search_by_date_time($picLB);});
  $find_menu->separator;
  $find_menu->command(-image => compound_menu($top, lang('Add to database ...'), 'list-add.png'), -command => \&buildDatabase);
  $find_menu->command(-image => compound_menu($top, lang('Clean database ...'), 'edit-clear.png'), -command => \&cleanDatabase);
  $find_menu->command(-image => compound_menu($top, lang('Check database ...'), ''), -command => \&checkDatabase);
  $find_menu->command(-image => compound_menu($top, lang('Edit database ...'), 'accessories-text-editor.png'), -command => \&editDatabase);
  $find_menu->command(-image => compound_menu($top, lang('Database information ...'), 'dialog-information.png'), -command => \&diff_database_statistic);

  $opti_menu->command(-image => compound_menu($top, lang('Options ...'), 'preferences-system.png'), -command => \&options_edit, -accelerator => "<Ctrl-o>");
  $opti_menu->command(-image => compound_menu($top, lang('Other options ...'), 'preferences-system.png'), -command => \&options);
  $opti_menu->command(-image => compound_menu($top, lang("Save options"), 'media-floppy.png'), -command => \&saveAllConfig);

  $extr_menu->command(-label => lang("Export filelist ..."), -command => \&exportFilelist);
  $extr_menu->command(-label => lang("Compare folders")." ...", -command => sub { dirDiffWindow(); } );
  $extr_menu->command(-label => lang("Compare pictures"), -command => \&diffPics);
  $extr_menu->separator;
  $extr_menu->command(-label => lang("HDR ..."), -command => \&hdr_pic);
  #$extr_menu->command(-label => lang("Fuzzy border ..."), -command => \&fuzzyBorder);
  $extr_menu->command(-label => lang("Drop picture (lossless) ..."), -command => \&losslessWatermark);
  $extr_menu->command(-label => lang("Generate logo ..."), -command => \&logo_generate_win);
  $extr_menu->command(-label => lang("Make screenshot ..."), -command => \&screenshot);
  $extr_menu->separator;
  $extr_menu->command(-label => lang("Build thumbnails ..."), -command => \&buildThumbsRecursive);
  $extr_menu->command(-label => lang("Clean thumbnails ..."), -command => sub { cleanThumbDB(); } );
  $extr_menu->command(-label => lang("Clean folder ..."), -command => sub { cleanDir($actdir); } );
  $extr_menu->command(-label => lang("Edit entry history ..."), -command => sub { editEntryHistory(); } );
  $extr_menu->command(-label => lang("Session info"), -command => sub { session_info(); } );
  $extr_menu->separator;
  $extr_menu->command(-label => lang("Mapivi test suite"), -command => \&testSuite);
  $extr_menu->command(-label => lang("Translation scan"), -command => \&language_scan);
  # mh 2011-04-29 this takes too long (some minutes for 12 drive letters)
  #if (Win32DriveInfoAvail) {
  #  $extr_menu->command(-label => "dirtree drive letter test",  -command => sub{$dirtree->configure(-directory => "$_:") foreach (Win32::DriveInfo::DrivesInUse());});
  #} 

  #$extr_menu->command(-label => "test menu",                     -command => sub {my @list; push @list, "Hund/Katze/Maus"; add_new_keywords(\@list); });
  my $xmp_menu = $extr_menu->cascade(-label => "XMP ...");
  $xmp_menu->command(-label => lang("Copy IPTC urgency to XMP rating"),    -command => sub { rating_iptc_to_xmp(); } );
  $xmp_menu->command(-label => lang("Copy XMP rating to IPTC urgency"),    -command => sub { rating_xmp_to_iptc(); } );
  $xmp_menu->command(-label => lang("Copy XMP keywords to IPTC"),    -command => sub { keywords_xmp_to_iptc_folder(); } );

  makePlugInsMenu($plug_menu, $plugin_sys_path);  # add system wide plugins to the menu
  $plug_menu->separator;
  makePlugInsMenu($plug_menu, $plugin_user_path); # add user specific plugins to the menu

  $help_menu->command(-image => compound_menu($top, lang('About'), 'dialog-information.png'), -command => \&about);
  $help_menu->command(-image => compound_menu($top, lang('Keys'), 'input-keyboard.png'), -command => \&showkeys);
  $help_menu->command(-image => compound_menu($top, lang('System information'), 'utilities-system-monitor.png'), -command => \&systemInfo);
  foreach my $file (qw(License Changes Tips FAQ)) {
    $help_menu->command(-image => compound_menu($top, $file, 'help-browser.png'), -command => [\&showFile, "$program_data_path/docs/${file}.txt"]) if (-f "$program_data_path/docs/${file}.txt");
  }
  $help_menu->command(-image => compound_menu($top, lang('Mapivi Home'), 'dialog-information.png'), -command => sub {web_browser_open($mapiviURL);} );
  $top->configure(-menu => $menubar) if $config{ShowMenu};
}

##############################################################
##############################################################
sub add_window_layout_menu {
  my $menu = shift;
  my $layout_menu = $menu->cascade(-label => lang("Window layout"));
  $layout_menu->cget(-menu)->configure(-title => lang("Window layout"));

  $layout_menu->command(-label => lang('Toggle layout'), -command => sub { $config{Layout}++; layout(1); }, -accelerator => '<Ctrl-l>');
  $layout_menu->separator;
  $layout_menu->command(-image => compound_menu($top, lang("3 columns: Navigation Thumbnails Picture"), 'layout-ntp.png'), -command => sub { $config{Layout} = 0 ; layout(1); }, -accelerator => "<F6>");
  $layout_menu->command(-image => compound_menu($top, lang("2 columns: Navigation Thumbnails"), 'layout-nt.png'), -command => sub { $config{Layout} = 1 ; layout(1); }, -accelerator => "<F7>");
  $layout_menu->command(-image => compound_menu($top, lang("1 column:  Thumbnails"), 'layout-t.png'), -command => sub { $config{Layout} = 2 ; layout(1); }, -accelerator => "<F8>");
  $layout_menu->command(-image => compound_menu($top, lang("2 columns: Thumbnails Picture"), 'layout-tp.png'), -command => sub { $config{Layout} = 3 ; layout(1); }, -accelerator => "<F9>");
  $layout_menu->command(-image => compound_menu($top, lang("1 column:  Picture"), 'layout-p.png'), -command => sub { $config{Layout} = 4 ; layout(1); }, -accelerator => "<F10>");
  $layout_menu->command(-image => compound_menu($top, lang("2 columns: Navigation Picture"), 'layout-tp.png'), -command => sub { $config{Layout} = 5 ; layout(1); });

  $layout_menu->separator;
  $layout_menu->checkbutton(-label => lang("Menu bar"), -variable => \$config{ShowMenu}, -command => sub { showHideFrames(); }, -accelerator => "<F1>");
  $layout_menu->checkbutton(-label => lang("Status bar"), -variable => \$config{ShowInfoFrame}, -command => sub { showHideFrames(); }, -accelerator => "<F2>");
  $layout_menu->checkbutton(-label => lang("Picture metadata overlay"), -variable => \$config{ShowInfoInCanvas}, -command => sub { showImageInfoCanvas($actpic); }, -accelerator => "<F3>");
  $layout_menu->checkbutton(-label => lang("IPTC box"), -variable => \$config{ShowIPTCFrame}, -command => sub { showHideFrames(); }, -accelerator => "<F4>");
  $layout_menu->checkbutton(-label => lang("Comment box"), -variable => \$config{ShowCommentField}, -command => sub { showHideFrames(); });
  $layout_menu->checkbutton(-label => lang("Display coordinates"), -variable => \$conf{show_coordinates}{value});
}

##############################################################
# addPicProcessing
##############################################################
sub addPicProcessing {
  my $menu = shift;
  my $widget = shift; # listbox or canvas
  my $rot_menu = $menu->cascade(-image => compound_menu($top, lang('Rotate ...'), 'transform-rotate.png'));
  $rot_menu->cget(-menu)->configure(-title => "rotation menu");
  $rot_menu->command(-label => lang("Rotate 90 - right (lossless)"), -command => sub { rotate(90); }, -accelerator => "<9>");
  $rot_menu->command(-label => lang("Rotate 180        (lossless)"), -command => sub { rotate(180); }, -accelerator => "<8>");
  $rot_menu->command(-label => lang("Rotate 270 - left (lossless)"), -command => sub { rotate(270); }, -accelerator => "<7>");
  $rot_menu->command(-label => lang("Flip horizontal   (lossless)"), -command => sub { rotate("horizontal"); });
  $rot_menu->command(-label => lang("Flip vertical     (lossless)"), -command => sub { rotate("vertical"); });
  $rot_menu->command(-label => lang("Auto rotate       (lossless)"), -command => sub { rotate("auto"); }, -accelerator => "<0>");
  $rot_menu->command(-label => lang("Clear rotate flag"), -command => sub { rotate("clear"); });
  $rot_menu->command(-label => lang("Rotate ..."), -command => [\&rotateAny]);

  $menu->command(-image => compound_menu($top, lang('Change size/quality ...'), 'transform-scale.png'), -command => \&changeSizeQuality, -accelerator => "<Q>" );
  $menu->command(-image => compound_menu($top, lang('Crop (lossless) ...'), 'edit-cut.png'),     -command => sub { crop($widget); }, -accelerator => "<Ctrl-c>");
  $menu->command(-image => compound_menu($top, lang('Image processing ...'), 'camera-photo.png'), -command => \&filterPic);
  $menu->command(-image => compound_menu($top, lang('Image processing extern'), 'applications-graphics.png'), -command => sub { edit_pic($widget); }, -accelerator => "<Ctrl-e>");
	$menu->command(-image => compound_menu($top, lang('Collage/index print ...'), 'image-x-generic.png'), -command => sub { my @pics = getSelection($widget); indexPrint(\@pics); });
	$menu->command(-image => compound_menu($top, lang('Passport print ...'), 'image-x-generic.png'), -command => sub { passport_print($widget); });
  
  $menu->command(-image => compound_menu($top, lang("Convert to black and white"), 'image-x-generic-bw.png'), -command => sub { grayscalePic($widget); } );
  $menu->command(-image => compound_menu($top, lang("Black and white preview"), 'image-x-generic-bw.png'),
                -command => sub { my @list = getSelection($widget); return unless checkSelection($top, 1, 1, \@list, lang("picture(s)")); grayscale_preview($list[0]); });
  
  my $border_menu = $menu->cascade(-image => compound_menu($top, lang('Add border ...'), 'image-x-generic.png'));
  $border_menu->cget(-menu)->configure(-title => lang('Border menu'));
  $border_menu->command(-image => compound_menu($top, lang('Add border (lossless) ...'), 'image-x-generic.png'), -command => sub { losslessBorder(PIXEL); }, -accelerator => "<Ctrl-b>");
  $border_menu->command(-image => compound_menu($top, lang('Add border aspect ratio (lossless) ...'), 'image-x-generic.png'), -command => sub { losslessBorder(ASPECT_RATIO); } );
  $border_menu->command(-image => compound_menu($top, lang('Add relative border (lossless) ...'), 'image-x-generic.png'), -command => sub { losslessBorder(RELATIVE); } );
  $border_menu->command(-image => compound_menu($top, lang('Add border or copyright (lossy) ...'), 'image-x-generic.png'), -command => \&addDecoration);
  $border_menu->command(-image => compound_menu($top, lang("Fuzzy border (lossy) ..."), 'image-x-generic.png'), -command => \&fuzzyBorder);
  
  $menu->command(-image => compound_menu($top, lang('Extract JPEG preview from raw'), 'image-x-generic.png'), -command => sub { extract_jpeg($widget); });
}


##############################################################
# addFileActionsMenu
##############################################################
sub addFileActionsMenu {
  my $menu = shift;
  my $lb   = shift;
  my $fop_menu = $menu->cascade(-image => compound_menu($top, lang('File operations ...'), ''));
  $fop_menu->command(-image => compound_menu($top, lang('Copy to ...'), 'edit-copy.png'),    -command => sub { copyPicsDialog(COPY, $lb); } );
  $fop_menu->command(-image => compound_menu($top, langf("Copy to \"%s\" folder", $conf{origs_folder_name}{value}), ''), -command => sub { copy_move_to_origs($lb, COPY); });
  $fop_menu->command(-image => compound_menu($top, lang('Copy to print ...'), 'printer.png'), -command => sub { copyToPrint($lb); }, -accelerator => "<Ctrl-p>");
  $fop_menu->command(-image => compound_menu($top, lang('Link to ...'), ''), -command => sub { linkPicsDialog($lb); }) if (!$EvilOS);
  $fop_menu->command(-image => compound_menu($top, lang('Move to ...'), ''), -command => sub { movePicsDialog($lb); } );
  $fop_menu->command(-image => compound_menu($top, langf("Move to \"%s\" folder", $conf{origs_folder_name}{value}), ''), -command => sub { copy_move_to_origs($lb, MOVE); }, -accelerator => "<Ctrl-m>" );
  $fop_menu->command(-image => compound_menu($top, lang('Rename ...'), ''), -command => sub { renamePic($lb); }, -accelerator => "<r>");
  $fop_menu->command(-image => compound_menu($top, lang('Smart rename ...'), ''), -command => sub { renameSmart($lb); }, -accelerator => "<Ctrl-r>");
  $fop_menu->separator;
  $fop_menu->command(-image => compound_menu($top, lang('Email to ...'), 'mail-message-new.png'),    -command => sub { sendTo($lb); } );
  $fop_menu->command(-image => compound_menu($top, lang('Convert ...'), ''), -command => sub { convertPics($lb); } );
  $fop_menu->command(-image => compound_menu($top, lang('Make backup'), ''), -command => sub { copyPicsDialog(BACKUP, $lb); } );
  $fop_menu->command(-image => compound_menu($top, lang('Make HTML ...'), 'applications-internet.png'),  -command => sub { makeHTML($lb); });
  $fop_menu->separator;
  $fop_menu->command(-image => compound_menu($top, lang('Delete to trash'), 'user-trash.png'),  -accelerator => "<Delete>",
                      -command => sub { deletePics($lb, TRASH); } );
  $fop_menu->command(-image => compound_menu($top, lang('Delete ...'), ''), -accelerator => "<Shift-Delete>", -command => sub { deletePics($lb, REMOVE); } );
}

##############################################################
# addSelectMenu
##############################################################
sub addSelectMenu {
  my $menu = shift;
  my $sel_menu = $menu->cascade(-image => compound_menu($top, lang('Select ...'), ''));
  $sel_menu->command(-label => lang("Select all"),  -accelerator => "<Ctrl-a>", -command => sub {selectAll($picLB);} );
  $sel_menu->command(-label => lang("Select all backups"),                      -command => \&selectBak );
  $sel_menu->command(-label => lang("Invert selection"),                        -command => \&selectInv );
  $sel_menu->command(-label => lang("Redo selection"),                          -command => sub { $picLB->selectionClear(); reselect($picLB, @savedselection2); } );
}

##############################################################
# addZoomMenu
##############################################################
sub addZoomMenu {
  my $menu = shift;
  $menu->checkbutton(-label => lang("Auto zoom (fit picture)"), -variable => \$config{AutoZoom});
  my $zoom_menu = $menu->cascade(-label => lang("Zoom ..."));
  $zoom_menu->cget(-menu)->configure(-title => lang("Zoom menu"));
  $zoom_menu->command(-label   => lang("fit"),
                      -command => sub { $conf{zoom_fit_fill}{value} = FIT; fitPicture(); },
                      -accelerator => "<Alt-3> or <f>");
  $zoom_menu->command(-label   => lang("fill"),
                      -command => sub { $conf{zoom_fit_fill}{value} = FILL; fitPicture(); },
                      -accelerator => "<Alt-2>");
  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 => "<Alt-1> or <z>");
    }
  }
}

##############################################################
# the flags (red, green, blue) are used to mark pictures e.g.
# for further processing. They are not stored in the picture,
# but in the search database as bits 
##############################################################
sub flag_toggle {
  my $lb = shift;
  my $flag = shift;
  return unless (defined($flag));
  return if (($flag < 0) or ($flag > 8)); 
  my @sellist = getSelection($lb);
  return unless checkSelection($lb, 1, 0, \@sellist, lang("picture(s)"));
  my $pw = progressWinInit($top, lang("Set / reset flags"));
  my $picnr = 0;
  foreach my $dpic (@sellist) {
    last if (progressWinCheck($pw));
    $picnr++;
    progressWinUpdate($pw, "Processing picture $picnr/".scalar(@sellist), $picnr, scalar(@sellist));
    # init flag if it does not exists
    if (not exists $searchDB{$dpic}{FLAG}) {
      $searchDB{$dpic}{FLAG} = FLAG_RESET;
    }
    if ($flag == FLAG_RESET) {
      $searchDB{$dpic}{FLAG} = FLAG_RESET;
    }
    else {
      $searchDB{$dpic}{FLAG} ^= $flag; # binary XOR = toggle flag
    }
    updateOneRow($dpic, $lb);
    # currently (2011-08) not needed, because the flags are
    # only shown in the thumbnail table
    #if ($dpic eq $actpic) {
    #  showImageInfoCanvas($dpic);
    #  showImageInfo($dpic);
    #}
  }
  progressWinEnd($pw);
  log_it(langf("Ready! Flag %d toggled in %d pictures.",$flag, scalar(@sellist)));
}
 
##############################################################
# mark all selected pictures which are used in a picture collection
# with the given flag color 
##############################################################
sub flag_set_collection {
  my $lb = shift;
  my $flag = shift;
  return unless (defined($flag));
  return if (($flag < 1) or ($flag > 8)); 
  my @sellist = getSelection($lb);
  return unless checkSelection($lb, 1, 0, \@sellist, lang("picture(s)"));
  my $slideshow_pics = build_slideshow_pic_hash();
  my $marked_pics = 0;
  my $pw = progressWinInit($top, lang("Set / reset flags"));
  my $picnr = 0;
  foreach my $dpic (@sellist) {
    last if (progressWinCheck($pw));
    $picnr++;
    progressWinUpdate($pw, "Processing picture $picnr/".scalar(@sellist), $picnr, scalar(@sellist));
    if (defined $$slideshow_pics{$dpic}) {
      print "$dpic is used in a slideshow!\n";
      $searchDB{$dpic}{FLAG} |= $flag; # binary OR = set flag
      updateOneRow($dpic, $lb);
      $marked_pics++;
    }
  }
  progressWinEnd($pw);
  log_it(langf("Ready! %d of the %d selected pictures are used in a collection and are now marked with a flag.",$marked_pics, scalar(@sellist)));
}
 
##############################################################
# addMetaInfoMenu
##############################################################
sub addMetaInfoMenu {
  my $menu = shift;
  my $flag_menu = $menu->cascade(-image => compound_menu($top, lang("Flags"), 'media-record16-red.png'));
  $flag_menu->cget(-menu)->configure(-title => lang("Flags"));
  $flag_menu->command(-image => compound_menu($top, lang('Red flag'), 'media-record16-red.png'), -command => sub { flag_toggle($picLB, FLAG_RED); }, -accelerator => "<R>");
  $flag_menu->command(-image => compound_menu($top, lang('Green flag'), 'media-record16-green.png'), -command => sub { flag_toggle($picLB, FLAG_GREEN); }, -accelerator => "<G>");
  $flag_menu->command(-image => compound_menu($top, lang('Blue flag'), 'media-record16-blue.png'), -command => sub { flag_toggle($picLB, FLAG_BLUE); }, -accelerator => "<B>");
  $flag_menu->separator;
  $flag_menu->command(-image => compound_menu($top, lang('Flag pictures used in collections'), 'media-record16-green.png'), -command => sub { flag_set_collection($picLB, FLAG_GREEN); });
  $flag_menu->separator;
  $flag_menu->command(-image => compound_menu($top, lang('Reset all flags'), ''), -command => sub { flag_toggle($picLB, FLAG_RESET); });
  my $iptc_menu = $menu->cascade(-image => compound_menu($top, 'IPTC', ''));
  $iptc_menu->cget(-menu)->configure(-title => "IPTC/IIM information");
  $iptc_menu->command(-image => compound_menu($top, lang('Show'), ''), -command => sub { displayIPTCData($picLB); }, -accelerator => "<i>");
  $iptc_menu->command(-image => compound_menu($top, lang('Edit ...'), 'accessories-text-editor.png'),   -command => sub { editIPTC($picLB); }, -accelerator => "<Ctrl-i>");
  $iptc_menu->command(-image => compound_menu($top, lang('Set location from GPS ...'), 'internet-web-browser.png'),   -command => sub { gps_to_location($picLB); });
  $iptc_menu->command(-image => compound_menu($top, lang('Remove ...'), ''), -command => \&removeIPTC);
  $iptc_menu->separator;
  $iptc_menu->command(-image => compound_menu($top, lang('Copy from ...'), 'edit-copy.png'), -command => \&copyIPTC);
  $iptc_menu->command(-image => compound_menu($top, lang('Copy to ...'), 'edit-paste.png'),   -command => \&pasteIPTC);
  $iptc_menu->separator;
  $iptc_menu->command(-image => compound_menu($top, lang('Add/remove categories ...'), ''), -command => sub { editIPTCCategories($picLB); });
  $iptc_menu->separator;
  $iptc_menu->command(-image => compound_menu($top, lang('Save template ...'), ''),  -command => sub { saveIPTC($picLB); } );
  $iptc_menu->command(-image => compound_menu($top, lang('Merge template ...'), ''), -command => \&mergeIPTC);
  $iptc_menu->separator;
  addRatingMenu($iptc_menu, $picLB);
  addRatingMenu($menu, $picLB);
  my $xmp_menu = $menu->cascade(-image => compound_menu($top, 'XMP', ''));
  $xmp_menu->cget(-menu)->configure(-title => 'XMP information');
  $xmp_menu->command(-image => compound_menu($top, 'show all XMP information', ''), -command => sub { xmp_show($picLB); }, -accelerator => "<x>");
  $xmp_menu->command(-image => compound_menu($top, 'add title ...', ''), -command => sub { xmp_add_title($picLB); });
  $xmp_menu->command(-image => compound_menu($top, 'edit title ...', ''), -command => sub { xmp_edit_title($picLB); });
  $xmp_menu->command(-image => compound_menu($top, 'add keyword ...', ''), -command => sub { xmp_add_keyword($picLB); });
  $xmp_menu->command(-image => compound_menu($top, 'copy XMP keywords to IPTC ...', ''), -command => sub { keywords_xmp_to_iptc($picLB); });
  $xmp_menu->command(-image => compound_menu($top, 'Remove ...', ''), -command => sub { xmp_remove($picLB); });
  $xmp_menu->separator;
  $xmp_menu->command(-image => compound_menu($top, 'PNG: show info', ''), -command => sub { png_show($picLB); });
  my $exif_menu = $menu->cascade(-image => compound_menu($top, 'EXIF', ''));
  $exif_menu->cget(-menu)->configure(-title => "EXIF information");
  $exif_menu->command(-image => compound_menu($top, lang('show info'), ''), -command => sub { displayEXIFData($picLB); }, -accelerator => "<e>");
  $exif_menu->command(-image => compound_menu($top, lang('show GPS position in map'), 'internet-web-browser.png'), -command => sub { gps_map_open($picLB); } );
  $exif_menu->command(-image => compound_menu($top, lang('show thumbnail'), ''), -command => \&showEXIFThumb,   -accelerator => "<Ctrl-t>");
  $exif_menu->command(-image => compound_menu($top, lang('save thumbnail ...'), ''), -command => \&getEXIFThumb);
  $exif_menu->command(-image => compound_menu($top, lang('(re)build thumbnail ...'), ''), -command => \&buildEXIFThumb);
  $exif_menu->separator;
  $exif_menu->command(-image => compound_menu($top, lang('Copy from ...'), 'edit-copy.png'), -command => \&copyEXIFData);
  $exif_menu->command(-image => compound_menu($top, lang('Copy to ...'), 'edit-paste.png'), -command => \&pasteEXIFData);
  $exif_menu->command(-image => compound_menu($top, lang('Copy thumbnail to ...'), ''), -command => \&copyThumbnail);
  $exif_menu->separator;
  $exif_menu->command(-image => compound_menu($top, lang('save'), ''), -command => \&EXIFsave);
  $exif_menu->command(-image => compound_menu($top, lang('restore ...'), ''), -command => \&EXIFrestore);
  $exif_menu->command(-image => compound_menu($top, lang('remove saved info ...'), ''), -command => \&EXIFremoveSaved);
  $exif_menu->separator;
  $exif_menu->command(-image => compound_menu($top, lang('set date/time ...'), 'accessories-text-editor.png'), -command => \&setEXIFDate, -accelerator => "<Ctrl-d>");
  $exif_menu->command(-image => compound_menu($top, lang('set GPS position ...'), 'accessories-text-editor.png'), -command => sub {gps_set($picLB);}, -accelerator => "<Ctrl-g>");
  $exif_menu->command(-image => compound_menu($top, lang('set year from file name ...'), 'accessories-text-editor.png'), -command => \&setEXIFDate_from_file_name);
  $exif_menu->separator;
  $exif_menu->command(-image => compound_menu($top, lang('remove thumbnail ...'), ''), -command => [\&removeEXIFData, "thumb"]);
  $exif_menu->command(-image => compound_menu($top, lang('remove all ...'), ''), -command => [\&removeEXIFData, "all"]);
  my $comm_menu = $menu->cascade(-image => compound_menu($top, lang('Comments'), ''));
  $comm_menu->cget(-menu)->configure(-title => "Comment menu");
  $comm_menu->command(-label => "show ...",    -command => \&showComment, -accelerator => "<c>");
  $comm_menu->separator;
  $comm_menu->command(-label => "add ...",    -command => sub{ addComment($picLB);  }, -accelerator => "<a>");
  $comm_menu->command(-image => compound_menu($top, lang('Edit ...'), 'accessories-text-editor.png'),   -command => sub{ editComment($picLB); }, -accelerator => "<j>");
  $comm_menu->command(-label => "join ...", -command => sub { joinComments(ASK); } );
  $comm_menu->command(-label => "search/replace ...", -command => sub{ replaceComment($picLB); } );
  $comm_menu->command(-label => 'add/remove keywords ...', -command => sub { editCommentKeywords($picLB); } );
  $comm_menu->separator;
  $comm_menu->command(-label => "remove ...", -command => \&removeComment);
  $comm_menu->command(-label => "remove all ...",  -command => sub { removeAllComments(ASK); } );
  $comm_menu->separator;
  $comm_menu->command(-image => compound_menu($top, lang('Copy from ...'), 'edit-copy.png'),  -command => [\&copyComment, "from"]);
  $comm_menu->command(-image => compound_menu($top, lang('Copy to ...'), 'edit-paste.png'),  -command => [\&copyComment, "to"]);
  $comm_menu->separator;
  $comm_menu->command(-label => "add filename as comment ...",  -command => [\&nameToComment, "to"]);
}

##############################################################
# addRatingMenu
##############################################################
sub addRatingMenu {
  my $menu   = shift;
  my $widget = shift;  # e.g. $picLB
  my $iptc_urge = $menu->cascade(-image => compound_menu($top, lang('Rating'), ''));
  $iptc_urge->cget(-menu)->configure(-title => lang('Rating'));
  $iptc_urge->command(-image => compound_menu($top, '5   '.lang('stars'), 'rating-1.png'), -command => sub {setIPTCurgency($widget, 1);}, -accelerator => "<5>");
  $iptc_urge->command(-image => compound_menu($top, '4   '.lang('stars'), 'rating-2.png'), -command => sub {setIPTCurgency($widget, 2);}, -accelerator => "<4>");
  $iptc_urge->command(-image => compound_menu($top, '3   '.lang('stars'), 'rating-3.png'), -command => sub {setIPTCurgency($widget, 3);}, -accelerator => "<3>");
  $iptc_urge->command(-image => compound_menu($top, '2   '.lang('stars'), 'rating-4.png'), -command => sub {setIPTCurgency($widget, 4);}, -accelerator => "<2>");
  $iptc_urge->command(-image => compound_menu($top, '1   '.lang('star'),  'rating-5.png'), -command => sub {setIPTCurgency($widget, 5);}, -accelerator => "<1>");
  $iptc_urge->command(-image => compound_menu($top, '2/3 '.lang('star'),  'rating-6.png'), -command => sub {setIPTCurgency($widget, 6);}, -accelerator => "<Ctrl-F6>");
  $iptc_urge->command(-image => compound_menu($top, '1/2 '.lang('star'),  'rating-7.png'), -command => sub {setIPTCurgency($widget, 7);}, -accelerator => "<Ctrl-F7>");
  $iptc_urge->command(-image => compound_menu($top, '1/3 '.lang('star'),  'rating-8.png'), -command => sub {setIPTCurgency($widget, 8);}, -accelerator => "<Ctrl-F8>");
  $iptc_urge->command(-image => compound_menu($top, '0   '.lang('stars'), 'rating-0.png'),-command => sub {setIPTCurgency($widget, 0);}, -accelerator => "<Ctrl-F9>");
  $iptc_urge->command(-image => compound_menu($top, lang('Remove rating'), 'rating-0.png'),-command => sub {setIPTCurgency($widget, 9);}, -accelerator => "<Ctrl-F10>");

}

##############################################################
# makePlugInsMenu
##############################################################
sub makePlugInsMenu {

  my $menu = shift;
  my $dir = shift;
  log_it("Adding PlugIns from $dir");
  return if (not -d $dir);
  my @plugins = getFiles($dir);
  my $file;
  
  foreach my $plugin (@plugins) {
    if ($plugin =~ m/.*\.txt$/) { # process just the descriptions
      if (!open($file, '<', "$dir/$plugin")) {
        warn "read PlugIn description: 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);
        # example line:
        # filelist-plugin.pl + write file list + 0 + this plugin will write a file list
        if ($_ =~ m|(.+)\s\+\s(.+)\s\+\s(\d)\s\+\s(.*)|) { # "\s\+\s" = " + "
          $prog = $1;
          $menuitem = $2;
          $update = $3;
          $desc = $4;
        }
        else {
          warn "warning: PlugIn $plugin has wrong line format!\n";
          next;
        }
        if (length($menuitem) > 50) {
          warn "warning: PlugIn $plugin: menu entry is too long \"$menuitem\" (max. 50 chars allowed)!\n";
          next;
        }
        print "PlugIn: -$prog-$menuitem-$update-$desc-\n" if $verbose;

        if (!-f "$dir/$prog") { # look for the corresponding plugin
          warn "warning: PlugIn $prog for description $plugin not fount in $dir\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 = "\"$dir/$prog\" ";
                         foreach (@sellist) {
                           $command .= "\"$_\" ";
                         }
                         print "com = $command\n" if $verbose;
                         my $buffer = `$command`; # execute command
                         showText("Output of PlugIn $menuitem", $buffer, NO_WAIT) if ($buffer ne '');
                         updateThumbsPlus() if $update;
                       });
        #$balloon->attach($item, -msg => "$desc"); # does not work :(
        log_it("  Added PlugIn \"$menuitem\" ($prog)");
      }
      close $file;
    }
  }
}
##############################################################
# toggleHeaders - adjusts the width of the columns to zero
#                 or the width needed ('')
##############################################################
sub toggleHeaders {

  my @col = ($conf{color_bg}{value}, $conf{color_bg2}{value});
  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 $files = 0;
  my $dirs  = 0;
  my $break = 0;
  my $pw = progressWinInit($top, lang("Calculate folder size"));
  find(sub {
         if (progressWinCheck($pw)) { $break = 1; $File::Find::prune = 1; }
         # we don't know how long it will take, so we set total to zero
         progressWinUpdate($pw, "size $size Bytes", 0, 0);
         $files++ if -f;
         $dirs++ if -d;
         $size += -s;
       },$dir);
  progressWinEnd($pw);
  $dirs--; # we don't want to include the basedir
  my $msg = lang("Calculation finished.");
  if ($break) { $msg = lang("Warning: The calculation wasn't finished!\nReal size may be bigger than displayed."); }
  my $unitSize = computeUnit($size);
  # add thousands separators (split every 3 digits and add a separator (dot))
  my $sep = '.';
  $size =~ s/(?<=\d)(?=(?:\d{3})+\b)/$sep/g;
  showText(langf("Folder size of %s", basename($dir)), langf("%s\nThe folder size of \"%s\" including thumbnails is\n\n%s    (%s Bytes)\n\n%d file(s)\n%d folder(s)", $msg, $dir, $unitSize, $size, $files, $dirs), NO_WAIT);
}

##############################################################
# buildThumbsRecursive - scans through all sub folders of
#                        the actual dir an collects JPEG files
#                        let the user select in which dirs
#                        mapivi should build/refresh thumbnails
##############################################################
sub buildThumbsRecursive {

  my $basedir = getRightDir();
  log_it("Updating thumbnails ...");
  my $rc = $top->messageBox(-icon => 'question', -message => "Mapivi will first scan through all sub folders of $basedir and collect all folders containing pictures.\nThen you are able to select in which folders mapivi should build/refresh thumbnails.",
                   -title => "Build thumbnails in all sub folders", -type => 'OKCancel');
  return if ($rc !~ m/Ok/i);
  my ($ok, $dirlist, $pic_count, $nr_of_pics_in_dir) = get_subdirs($basedir);
  return if (not $ok);
  my @tmplist;
  return if (!mySelListBoxDialog(lang("Select folders"),
                                 "Found ".scalar @{$dirlist}." folders with $pic_count JPEG pictures.\nThumbnails will be created/updated only in the selected folders.",
                                 MULTIPLE,
                                 "build thumbnails", \@tmplist, @{$dirlist}));
  return if (not @tmplist); # return if nothing is selected
  # copy the selected elements into the @sel_dirs list
  my @sel_dirs;
  my $sel_pic_count = 0;
  foreach (@tmplist) {
    push @sel_dirs, $$dirlist[$_]; 
    # add number of pics in selected folders
    $sel_pic_count += $$nr_of_pics_in_dir{$$dirlist[$_]}
  }
  my $rebuild = 0;
  $rc = myButtonDialog('Update or rebuild thumbnails?', "Please select if you want to update or rebuild $sel_pic_count 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 $i = 0;
  my $actdir_save = $actdir;
  my $pw = progressWinInit($top, "build/refresh thumbnails");
  foreach my $dir (@sel_dirs) {
    last if progressWinCheck($pw);
    $i++;
    my $dirshort = cutString($dir, -40, "...");
    progressWinUpdate($pw, "processing ($i/".scalar @sel_dirs.") $dirshort", $i, scalar @sel_dirs);
    log_it("  Updating thumbnails in $dirshort ...");
    # to rebuild we simply remove all thumbnails and then call generateThumbs() 
    if ($rebuild) {
      my $thumbdir = dirname(getThumbFileName("$dir/dummy.jpg"));
      my @thumbs   = getPics($thumbdir, WITH_PATH, NO_CHECK_JPEG);
      #print "buildThumbsRecursive: removing ".scalar @thumbs." thumbs in $dirshort...\n";
      foreach (@thumbs) {
        #print "buildThumbsRecursive: remove $_\n";
        if ( unlink($_) != 1) { # unlink returns the number of successfull removed files
          warn "buildThumbsRecursive: could not remove $_";
        }
      }
    }
    $actdir = $dir; # needed for generateThumbs()
    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);
  $actdir = $actdir_save;
  log_it("  Thumbnails are now up to date!");
}

##############################################################
# find all sub folders of basedir containing pictures
##############################################################
sub get_subdirs {
  my $basedir = shift;
  log_it("searching sub folders of $basedir ...");
  my @dirlist;
  # no questions about NON-JPEGS while searching please!
  my $pic_count = 0;
  my %nr_of_pics_in_dir;
  my $break = 0;
  my $pw = progressWinInit($top, "Collect sub folders");
  find(sub {
         if (progressWinCheck($pw)) { $break = 1; $File::Find::prune = 1; }
         # process just dirs containing pictures, but not .thumbs/ .xvpics/ etc. dirs
         if (-d and ($_ ne $thumbdirname) and ($_ ne ".xvpics") and ($_ ne $exifdirname)) {
           progressWinUpdate($pw, "collecting folders (may take some time), found ".scalar @dirlist." ...", 0, 0);
           my @pictestlist = getPics($File::Find::name, JUST_FILE, NO_CHECK_JPEG); # no sort needed
           if (@pictestlist > 0) {
             $pic_count += scalar @pictestlist;
             $nr_of_pics_in_dir{$File::Find::name} = scalar @pictestlist;
             push @dirlist, $File::Find::name;
           }
         }
       }, $basedir);
  progressWinEnd($pw);
  if ($break) {
    log_it("  user break while counting sub folders");
    return (0, \@dirlist, $pic_count);
  }
  log_it("  found ".@dirlist." sub folders with $pic_count pictures in $basedir.");
  return (1, \@dirlist, $pic_count, \%nr_of_pics_in_dir);
}

##############################################################
# keywords_xmp_to_iptc_folder - scans through all sub folders of
# the actual dir and copy the XMP 
# keywords (Subject and HierarchicalSubject) 
# to the IPTC keywords
##############################################################
sub keywords_xmp_to_iptc_folder {
  my $basedir = getRightDir();
  log_it(lang("Copy keywords XMP to IPTC ..."));
  my $rc = $top->messageBox(-icon => 'question', -message => langf("Mapivi will first scan through all sub folders of %s and collect all folders containing pictures.", $basedir)."\n".lang("Then you are able to select in which folders Mapivi should copy XMP keywords (Subject and HierachicalSubject) to IPTC keywords."),
                   -title => lang("Copy keywords XMP to IPTC ..."), -type => 'OKCancel');
  return if ($rc !~ m/Ok/i);
  my ($ok, $dirlist, $pic_count, $nr_of_pics_in_dir) = get_subdirs($basedir);
  return if (not $ok);
  my @tmplist;
  return if (!mySelListBoxDialog(lang("Select folders"),
                                 langf("Found %d folders with %d pictures.",scalar(@{$dirlist}),$pic_count)."\n".lang("IPTC tags will be set only in the selected folders."),
                                 MULTIPLE,
                                 lang("copy keywords"), \@tmplist, @{$dirlist}));
  return if (not @tmplist); # return if nothing is selected
  # copy the selected elements into the @sel_dirs list
  my @sel_dirs;
  my $sel_pic_count = 0;
  foreach (@tmplist) {
    push @sel_dirs, $$dirlist[$_]; 
    # add number of pics in selected folders
    $sel_pic_count += $$nr_of_pics_in_dir{$$dirlist[$_]}
  }
  my $i = 0;
  my $copy_count = 0;
  my $pw = progressWinInit($top, lang("copy keywords in folders"));
  foreach my $dir (@sel_dirs) {
    last if progressWinCheck($pw);
    $i++;
    my $dirshort = cutString($dir, -40, "...");
    progressWinUpdate($pw, langf("processing folder (%d/%d) %s",$i,$sel_pic_count,$dirshort),$i,$sel_pic_count);
    log_it(langf("  Copy keywords in %s ...", $dirshort));
    my @pics = getPics($dir, WITH_PATH, NO_CHECK_JPEG);
    my ($ok, $folder_copy_count) = keywords_xmp_to_iptc_int($top, \@pics);
    $copy_count += $folder_copy_count;
    last if (not $ok);
  }
  progressWinEnd($pw);
  log_it(langf("  Copied XMP to IPTC keywords in %d pictures finished.", $copy_count));
}

##############################################################
# keywords_xmp_to_iptc - copy the XMP 
# keywords (Subject and HierarchicalSubject) of the selected pics
# to the IPTC keywords
##############################################################
sub keywords_xmp_to_iptc {
  my $lb = shift;	# the reference to the active listbox widget
  my @sellist = getSelection($lb);
  return unless checkSelection($lb, 1, 0, \@sellist, lang("picture(s)"));
  my ($ok, $copy_count) = keywords_xmp_to_iptc_int($lb, \@sellist);
  log_it(langf("  Copied XMP to IPTC keywords in %d pictures finished.", $copy_count));
}
  
##############################################################
# keywords_xmp_to_iptc_int - copy the XMP 
# keywords (Subject and HierarchicalSubject) of all pics in list
# to the IPTC keywords
##############################################################
sub keywords_xmp_to_iptc_int {
  my $w = shift; # widget
  my $pics = shift; # ref to pic list
  my $pic_nr = scalar(@$pics);
  my $i = 0;
  my $ok = 1;
  my $copy_count = 0;
  my $pw = progressWinInit($w, lang("copy keywords"));
  foreach my $dpic (@$pics) {
    if (progressWinCheck($pw)) { $ok = 0; last; }
    $i++;
    progressWinUpdate($pw, langf("processing picture (%d/%d)",$i,$pic_nr),$i,$pic_nr);
    # get XMP info (hash ref)
    my $xmp = exiftool_get($dpic, "XMP:*");
    #print "$dpic: \"".exiftool_tostring($xmp)."\"\n" if (defined $xmp);
    my @keys;
    # $xmp_keywords is a string. Example: "Nature|Animal|Dog Nature|Plant|Rose"
    # at least when filled in with bibble
    my $xmp_keywords = $$xmp{HierarchicalSubject};
    if (defined $xmp_keywords) {
      # replace hierarchical delimiter "|" with "/"
      $xmp_keywords =~ s/\|/\//g;
      # split keywords at whitespace
      push @keys, split /\s/, $xmp_keywords;
    }
    # get XMP Subject (non-hierarchical keywords?)
    $xmp_keywords = $$xmp{Subject};
    if (defined $xmp_keywords) {
      # replace hierarchical delimiter "." with "/"
      $xmp_keywords =~ s/\./\//g;
      # split keywords at comma with optional whitespace
      push @keys, split /\,\s*/, $xmp_keywords;
    }
    # if there are some XMP keywords, add them to IPTC
    if (@keys) {
      my @pic; push @pic, $dpic;
      add_keywords_to_pics($picLB, \@keys, \@pic);
      $copy_count++;
    }
  }
  progressWinEnd($pw);
  return ($ok, $copy_count);
}

##############################################################
# rating_xmp_to_iptc - scans through all sub folders of
#                   the actual dir and copy the XMP Rating
#                   to the IPTC urgency tag
##############################################################
sub rating_xmp_to_iptc {
  my $basedir = getRightDir();
  log_it(lang("Copy ratings XMP to IPTC ..."));
  my $rc = $top->messageBox(-icon => 'question', -message => langf("Mapivi will first scan through all sub folders of %s and collect all folders containing pictures.", $basedir)."\n".lang("Then you are able to select in which folders Mapivi should copy the XMP rating to IPTC urgency."),
                   -title => lang("Copy ratings XMP to IPTC ..."), -type => 'OKCancel');
  return if ($rc !~ m/Ok/i);
  my ($ok, $dirlist, $pic_count, $nr_of_pics_in_dir) = get_subdirs($basedir);
  return if (not $ok);
  my @tmplist;
  return if (!mySelListBoxDialog(lang("Select folders"),
                                 langf("Found %d folders with %d pictures.",scalar(@{$dirlist}),$pic_count)."\n".lang("IPTC tags will be set only in the selected folders."),
                                 MULTIPLE,
                                 lang("copy rating"), \@tmplist, @{$dirlist}));
  return if (not @tmplist); # return if nothing is selected
  # copy the selected elements into the @sel_dirs list
  my @sel_dirs;
  my $sel_pic_count = 0;
  foreach (@tmplist) {
    push @sel_dirs, $$dirlist[$_]; 
    # add number of pics in selected folders
    $sel_pic_count += $$nr_of_pics_in_dir{$$dirlist[$_]}
  }
  # let the user select if mapivi should overwrite existing ratings
  my $overwrite = 0;
  my $but_cancel = lang("Cancel");
  my $but_over = lang("Overwrite");
  my $but_no_over = lang("No overwrite");
  $rc = myButtonDialog(lang('Overwrite IPTC ratings?'), lang("Overwrite existing IPTC rating with XMP rating?\nHint: If no XMP rating is defined, the IPTC rating is not changed.\n").convert_xmp_to_iptc_text(), undef, $but_over, $but_no_over, $but_cancel);
  if    ($rc eq $but_cancel)  { log_it(lang("action canceled by user")); return; }
  elsif ($rc eq $but_over)    { $overwrite = 1; }
  elsif ($rc eq $but_no_over) { $overwrite = 0; }
  else { warn "rating_xmp_to_iptc: Error wrong rc: $rc"; return; }
  my $i = 0;
  my $copycount = 0;
  my $error = '';
  my $pw = progressWinInit($top, lang("copy rating"));
  foreach my $dir (@sel_dirs) {
    last if progressWinCheck($pw);
    my $dirshort = cutString($dir, -40, "...");
    log_it(langf("  Copy ratings in %s ...", $dirshort));
    my @pics = getPics($dir, WITH_PATH, NO_CHECK_JPEG);
    foreach my $dpic (@pics) {
      last if progressWinCheck($pw);
      $i++;
      progressWinUpdate($pw, langf("processing picture (%d/%d) %s",$i,$sel_pic_count,$dirshort), $i, $sel_pic_count);
      # get XMP rating
	  my $xmp = exiftool_get($dpic, "XMP-xmp:*");
	  my $xmp_rating = $$xmp{Rating};
      if (defined $xmp_rating) {
	    if ($overwrite == 0) {
		  # get IPTC rating only when user wants no overwritting
		  my $urgency = $searchDB{$dpic}{URG};
          if (defined $urgency) {
		    $error .= "info: $dpic has already a IPTC rating of $urgency (XMP: $xmp_rating)\n";
            next;
          }
        }		  
        my $ok = set_IPTC_urgency_file($dpic, convert_xmp_to_iptc($xmp_rating), \$error);
		if ($ok) {
          $copycount++;
          # touch the thumbnail pic (set actual time stamp), to suppress rebuilding
          touch(getThumbFileName($dpic));
          if ($dpic eq $actpic) {
            #showImageInfoCanvas($dpic);
            showImageInfo($dpic);
          }
		}
      }
    }
  }
  progressWinEnd($pw);
  showText(lang('Copy rating XMP to IPTC errors and infos'), $error, NO_WAIT) if ($error);
  log_it(langf("  Copy of %d XMP ratings to IPTC finished.",$copycount));
}

##############################################################
# rating_iptc_to_xmp - scans through all sub folders of
#                   the actual dir and copy the IPTC urgency
#                   to the XMP Rating tag
##############################################################
sub rating_iptc_to_xmp {
  my $basedir = getRightDir();
  log_it(lang("Copy ratings IPTC to XMP ..."));
  my $rc = $top->messageBox(-icon => 'question', -message => langf("Mapivi will first scan through all sub folders of %s and collect all folders containing pictures.", $basedir)."\n".lang("Then you are able to select in which folders Mapivi should copy the IPTC urgency to XMP rating."),
                   -title => lang("Copy ratings IPTC to XMP ..."), -type => 'OKCancel');
  return if ($rc !~ m/Ok/i);
  my ($ok, $dirlist, $pic_count, $nr_of_pics_in_dir) = get_subdirs($basedir);
  return if (not $ok);
  my @tmplist;
  return if (!mySelListBoxDialog(lang("Select folders"),
                                 langf("Found %d folders with %d pictures.",scalar(@{$dirlist}),$pic_count)."\n".lang("XMP tags will be set only in the selected folders."),
                                 MULTIPLE,
                                 lang("copy rating"), \@tmplist, @{$dirlist}));
  return if (not @tmplist); # return if nothing is selected
  # copy the selected elements into the @sel_dirs list
  my @sel_dirs;
  my $sel_pic_count = 0;
  foreach (@tmplist) {
    push @sel_dirs, $$dirlist[$_]; 
    # add number of pics in selected folders
    $sel_pic_count += $$nr_of_pics_in_dir{$$dirlist[$_]}
  }
  # let the user select if mapivi should overwrite existing ratings
  my $overwrite = 0;
  my $but_cancel = lang("Cancel");
  my $but_over = lang("Overwrite");
  my $but_no_over = lang("No overwrite");
  $rc = myButtonDialog(lang('Overwrite XMP ratings?'), lang("Overwrite existing XMP ratings with IPTC ratings?\nHint: If no IPTC rating is defined, the XMP rating is not changed.\n").convert_iptc_to_xmp_text(), undef, $but_over, $but_no_over, $but_cancel);
  if    ($rc eq $but_cancel)  { log_it(lang("action canceled by user")); return; }
  elsif ($rc eq $but_over)    { $overwrite = 1; }
  elsif ($rc eq $but_no_over) { $overwrite = 0; }
  else { warn "rating_iptc_to_xmp: Error wrong rc: $rc"; return; }
  my $i = 0;
  my $copycount = 0;
  my $error = '';
  my $pw = progressWinInit($top, lang("copy rating"));
  foreach my $dir (@sel_dirs) {
    last if progressWinCheck($pw);
    my $dirshort = cutString($dir, -40, "...");
    log_it(langf("  Copy ratings in %s ...", $dirshort));
    my @pics = getPics($dir, WITH_PATH, NO_CHECK_JPEG);
    foreach my $dpic (@pics) {
      last if progressWinCheck($pw);
      $i++;
      progressWinUpdate($pw, langf("processing picture (%d/%d) %s",$i,$sel_pic_count,$dirshort), $i, $sel_pic_count);
      # get IPTC rating
	  my $urgency = $searchDB{$dpic}{URG};
      if (defined $urgency) {
	    if ($overwrite == 0) {
		  # get XMP rating only when user wants no overwritting
	      my $xmp  = exiftool_get($dpic, "XMP-xmp:*");
          my $xmp_rating = $$xmp{Rating};
          if (defined $xmp_rating) {
		    $error .= "info: $dpic has already a XMP rating of $xmp_rating (IPTC: $urgency)\n";
            next;
          }
        }		  
        $error .= xmp_set_rating($dpic, $urgency);
        $copycount++;
        # touch the thumbnail pic (set actual time stamp), to suppress rebuilding
        touch(getThumbFileName($dpic));
        if ($dpic eq $actpic) {
          #showImageInfoCanvas($dpic);
          showImageInfo($dpic);
        }
      }
    }
  }
  progressWinEnd($pw);
  showText(lang('Copy rating IPTC to XMP errors and infos'), $error, NO_WAIT) if ($error);
  log_it(langf("  Copy of %d IPTC ratings to XMP finished.",$copycount));
}

##############################################################
# rebuildThumbs
##############################################################
sub rebuildThumbs {
  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));
  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');
  }
  log_it("Rebuild thumbnails ...");
  my $thumb;
  my $i = 0;
  my $removed =  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 {
        $removed++;
        # delete was successfull, so we insert the defaultthumb
        $picLB->itemConfigure($dpic, $picLB->{thumbcol}, -image => $mapivi_icons{'EmptyThumb'}, -itemtype => "imagetext");
      }
    }
  }
  progressWinEnd($pw);
  log_it("Removed $removed thumbnails, starting generation in background ...");
  my $starttime = Tk::timeofday();
  my $generated_thumbs = generateThumbs(ASK, SHOW);
  my $time = sprintf("%.1f",Tk::timeofday()-$starttime);
  log_it("Rebuild $generated_thumbs thumbnails in $time seconds ... Ready!");
}

##############################################################
# 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 = getSelection($lb);
  return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));
  my $targetdir;
  if ($mode == BACKUP) {
    $targetdir = $actdir;
  } elsif ($mode == COPY) {
    $targetdir = getDirDialog(lang("Select target folder"));
  } else {
    warn "copyPicsDialog: error wrong mode: $mode";
    return;
  }
  return if ($targetdir eq '');
  copyPics($targetdir, $mode, $lb, @sellist);
}


##############################################################
# copy or move selected pictures to selected folder
##############################################################
sub copy_or_move_pics_to_folder {
  my $kind = shift; # COPY or MOVE
  my $lb = $picLB;
  my @sellist = getSelection($lb);
  return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));
  my $targetdir = getSelectedDir();
  if (defined $targetdir and -d $targetdir) {
    if ($kind == COPY) {
      copyPics($targetdir, COPY, $lb, @sellist);
    }
    elsif ($kind == MOVE) {
      movePics($targetdir, $lb, @sellist)
    }
    else {
      warn "copy_or_move_pics_to_folder called with wrong kind: $kind";  
    }
  }
  else {
    log_it(lang("No folder selected. Please select a folder in the navigation frame first."));
  }
  return;
}

##############################################################
# 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 or canvas widget
  my @sellist   = @_;
  return unless (-d $targetdir);
  # check if target folder is writable
  # hint: -w 	File or directory is writable by this (effective) user or group 
  #       -W 	File or directory is writable by this real user or group 
  if (not -w $targetdir) {
    showText('Error while copying', "Folder $targetdir is not writable!", NO_WAIT);
    return;
  }
  return if (@sellist < 1);
  makeDir(dirname(getThumbFileName("$targetdir/dummy.jpg")), ASK);
  my $string = 'copy';
  my $errors = '';
  my $i  = 0;
  my $overwrite = OVERWRITE;
  my $n  = 0;	# count successfull copied pictures
  my $pw = progressWinInit($lb, "Copy pictures");
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    my $pic       = basename($dpic);
    $i++;
    my $tpic      = "$targetdir/$pic";
    my $thumbpic  = getThumbFileName($dpic);
    my $thumbtpic = getThumbFileName($tpic);
    if ($mode == BACKUP) {
      $string   = 'backup';
      $tpic      = buildBackupName($dpic);
      $thumbtpic = buildBackupName(getThumbFileName($dpic));
      print "copyPics: duplicate mode $tpic\n" if $verbose;
    }
    progressWinUpdate($pw, "$string picture ($i/".scalar @sellist.") ...", $i, scalar @sellist);
    $overwrite = overwritePic($tpic, $dpic, (scalar(@sellist) - $i + 1)) if ($overwrite != OVERWRITEALL);
    next if ($overwrite == CANCEL);
    last if ($overwrite == CANCELALL);
    # if the copy is successfull
    if (mycopy($dpic, $tpic, OVERWRITE)) {
      $n++;
      # copy the thumbnail picture
      if ((-d dirname($thumbtpic)) and (-f $thumbpic)) {
        mycopy($thumbpic, $thumbtpic, OVERWRITE)
      }
      # copy XMP, WAV, RAW files
      do_other_files($lb, COPY, $dpic, $tpic, \$errors);
      # copy meta info in search database
      $searchDB{$tpic} = $searchDB{$dpic};
      if (($mode == BACKUP) and (ref($lb) ne 'Tk::Canvas')) {
        hlistCopy($lb, $dpic, $tpic); # insert and show the backup in the listbox
        $lb->itemConfigure($tpic, $lb->{thumbcol}, -text => getThumbCaption($tpic));
        my $rating_size = get_rating_and_size($tpic, $lb);
        $lb->itemConfigure($tpic, $lb->{filecol}, -itemtype => 'image', -image => $rating_size, -style => $fileS);
        #$lb->itemConfigure($tpic, $lb->{filecol},  -text => getAllFileInfo($tpic));
      }
    }
  }								# foreach - end
  progressWinEnd($pw);
  log_it("ready! ($n/".scalar @sellist." copied)");
  if ($errors ne '') {
    $errors = "These errors occured while copying ".scalar @sellist." selected pictures:\n$errors";
    showText('Error while copying', $errors, NO_WAIT);
  }
  reselect($lb, @sellist);
}

##############################################################
# do_other_files - rename, copy, move XMP, WAV and RAW files
##############################################################
sub do_other_files {
  my $lb = shift; # the reference to the active listbox or canvas widget
  my $action = shift;  # COPY, MOVE or RENAME
  my $dpic = shift;
  my $ndpic = shift;
  my $error_ref = shift; # reference to error string to add warnings etc.
  return unless ($action == RENAME or $action == COPY or $action == MOVE);
  my @suffixes;
  # we have to support upper and lower case XMP suffix
  push @suffixes, @xmp_suffix if $config{XMP_file_operations};
  push @suffixes, @wav_suffix if $config{WAV_file_operations};
  push @suffixes, @raw_suffix if $config{RAW_file_operations};
  return unless (@suffixes); # return if no other file types have to be considered
  my @lc_suffixes;
  push @lc_suffixes, lc($_) foreach (@suffixes);
  push @suffixes, @lc_suffixes; # add lower case suffixes 
  @suffixes = reverse @suffixes; # lower case first (better for Windows)
  #print "do_other_files: $action - suffixes: $_\n" foreach (@suffixes);
  my ($name,$dir,$fsuffix) = fileparse($dpic, '\.[^.]*'); # suffix = . and not-.  (one dot and zero or more non-dots)
  my $dpic_no_suffix = $dir.$name;
  my ($nname,$ndir,undef) = fileparse($ndpic, '\.[^.]*'); # suffix = . and not-.  (one dot and zero or more non-dots)
  my $ndpic_no_suffix = $ndir.$nname;
  foreach my $suffix (@suffixes) {
    # handle pic01.xmp and pic01.jpg.xmp
    if ((-f $dpic_no_suffix.$suffix) or (-f $dpic_no_suffix.$fsuffix.$suffix)) {
      my ($s_file, $t_file);
      if (-f $dpic_no_suffix.$suffix) {
        $s_file = $dpic_no_suffix.$suffix;
        $t_file = "$ndpic_no_suffix$suffix";
      }
      elsif (-f $dpic_no_suffix.$fsuffix.$suffix) {
        $s_file = $dpic_no_suffix.$fsuffix.$suffix;
        $t_file = "$ndpic_no_suffix$fsuffix$suffix";
      }
      if (-f $t_file) {
        $$error_ref .= "$suffix file $t_file exists, file not ";
        $$error_ref .= "renamed!\n" if $action == RENAME;
        $$error_ref .= "copyed!\n"  if $action == COPY;
        $$error_ref .= "moved!\n"   if $action == MOVE;
      }
      else { ### RENAME ###
        if ($action == RENAME) {
          if (rename($s_file, $t_file)) {
            if (defined $lb) {
              # change entry path
              hlistEntryRename($lb, $s_file, $t_file);
              # change name
              $lb->itemConfigure($t_file, $lb->{thumbcol}, -text => getThumbCaption($t_file));
              my $rating_size = get_rating_and_size($t_file, $lb);
              $lb->itemConfigure($t_file, $lb->{filecol}, -itemtype => 'image', -image => $rating_size, -style => $fileS);
            }
          }
        }
        elsif ($action == MOVE) {   ### MOVE ###
          if (move($s_file, $ndir)) {
            # on success remove file from listbox
            $lb->delete('entry', $s_file) if (defined $lb and $lb->info('exists', $s_file));
          }
        }
        elsif ($action == COPY) { ### COPY ###
          mycopy ($s_file, $t_file, ASK_OVERWRITE);
        }
        # todo: when move and rename we should update the list box
        # eg.g with $lb->delete('entry', $dpic) if ($lb->info('exists', $dpic));
        # or updateThumbsPlus(); showNrOf(); ar the end ...
      }
    }
  }
}

##############################################################
# delete_XMP_file - delete XMP file if any
##############################################################
sub delete_XMP_file {
  # XMP files follow picture file operations if this option is set to 1
  return unless $config{XMP_file_operations};
  my $dpic = shift;
  my ($name,$dir,$suffix) = fileparse($dpic, '\.[^.]*'); # suffix = . and not-.  (one dot and zero or more non-dots)
  my $dpic_no_suffix = "$dir/$name";
  my $xmp_file = '';
  # we have to support upper and lower case XMP suffix
  if ((-f $dpic_no_suffix.'.xmp')) {
      $xmp_file = $dpic_no_suffix.'.xmp';
  } 
  elsif ((-f $dpic_no_suffix.'.XMP')) {
      $xmp_file = $dpic_no_suffix.'.XMP';
  }
  else {
  }
  if ($xmp_file ne '') {
    print "remove $xmp_file\n" if $verbose;
    removeFile($xmp_file);
  }
  return;
}

##############################################################
# linkPicsDialog - link the selected pictures to a choosen dir
##############################################################
sub linkPicsDialog {
  my $widget = shift;
  if ($EvilOS) {
    $top->messageBox(-icon => 'warning', -message => "Sorry, but this OS does not support symbolic links.",
                     -title => 'Error', -type => 'OK');
    return;
  }
  my @sellist = getSelection($widget);
  return unless checkSelection($widget, 1, 0, \@sellist, lang("picture(s)"));
  my $targetdir = getDirDialog("Link pictures to");
  return if ($targetdir eq '');
  linkPics($targetdir, @sellist);
  return;
}

##############################################################
# 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 $i  = 0;
  my $overwrite = OVERWRITE;
  my $n  = 0;					# count successfull copied pictures
  my $pw = progressWinInit($top, "Link pictures");
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    my $pic       = basename($dpic);
    $i++;
    progressWinUpdate($pw, "linking ($i/".scalar @sellist.") ...", $i, scalar @sellist);
    my $tpic      = "$targetdir/$pic";
    # Do not link to a link.  Always link to the original image.
    next if (!getRealFile(\$dpic));
    my $thumbpic  = getThumbFileName($dpic);
    my $thumbtpic = getThumbFileName($tpic);
    $overwrite = overwritePic($tpic, $dpic, (scalar(@sellist) - $i + 1)) if ($overwrite != OVERWRITEALL);
    next if ($overwrite == CANCEL);
    last if ($overwrite == CANCELALL);
    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)
      }
    }
  }								# foreach - end
  progressWinEnd($pw);
  log_it("ready! ($n/".scalar @sellist." linked)");
  reselect($picLB, @sellist);
  return;
}

##############################################################
# getDirDialog - let the user select a dir
##############################################################
sub getDirDialog {
  my $title   = shift;
  my $text    = "Please choose a target folder from the list below or open the folder browser\nby either double clicking the first item or by clicking the OK button without a selection.\n\nFolders from favorite list and recently visited folders:";
  my $browser = "Open folder browser";
  my @list;
  # put the "Open folder browser" item at the first position
  push @list, $browser;
  push @list, ''; # add empty line as separator
  # add the actual selected folder
  my $selected_dir = getSelectedDir();
  if (defined $selected_dir and -d $selected_dir) {
    push @list, $selected_dir;
    push @list, ''; # add empty line as separator
  }    
  # add max 4 media folders (e.g. USB-Sticks, USB-HDD, ...) to the list
  push @list, get_media_folders(4);
  # add max 15 often accessed folders
  push @list, getHotlists(15);  
  push @list, ''; # add empty line as separator
  # add the last used folders
  foreach (reverse @dirHist) {
    next if (not -d $_);
    push @list, $_;
  }
  my @sellist;
  return '' unless (mySelListBoxDialog($title, $text, SINGLE, 'OK', \@sellist, @list));
  my $dir = '';
  $dir = $list[$sellist[0]] if $sellist[0];
  if (($dir eq '') or ($dir eq $browser)) {
    my $dsdir = dirDialog($actdir);
    if (defined $dsdir) {
      $dir = $dsdir;
    }
  }
  $dir  =~ s/\/\//\//g;              # replace all // with /
  if (-d $dir) { dirSave($dir); }
  else         { $dir = ''; }
  return $dir;
}

##############################################################
# returns a list of folders below media_folder_name
# list is trunkated to max_entries 
##############################################################
sub get_media_folders {
  my $max_entries = shift;
  my $media_base_folder = $conf{media_folder_path}{value};
  my @folders;
  if (-d $media_base_folder) {
    @folders = getDirs($media_base_folder);
    if (@folders > $max_entries) {
      @folders = splice(@folders,0,$max_entries);
    }
  }
  return @folders;
}

##############################################################
##############################################################
sub getHotlists {
  my $max_entries = shift;
  my @list;
  # sort dirs hash by numerical value reverse (number of accesses)
  # %dirHotlist contains folders used as target in open dir, copy, link, move, ... operations
  foreach (sort { $dirHotlist{$b} <=> $dirHotlist{$a} } keys %dirHotlist) {
    next if (not -d $_); # skip non existing dirs
    next if ($_ eq $trashdir); # skip the trash
    push @list, $_; # add to list
    last if (@list > $max_entries); # max_entries should be enough
  }
  # remove duplicates and sort folder list alphabetical
  my %saw;
  @saw{@list} = ();
  @list = ();
  @list = sort keys %saw;
  return @list;
}

##############################################################
# copy_move_to_origs - copy or move the selected pictures to a sub folder
# called e.g. "originals" (folder name can be changed by user)
# see $conf{origs_folder_name}{value}
# If folder does not exists, it will be created
##############################################################
sub copy_move_to_origs {
  my $lb = shift;	# the reference to the active listbox widget
  my $operation = shift; # either COPY or MOVE
  my $origs = $conf{origs_folder_name}{value};
  my $operation_text = '';
  # check if operation argument is valid and set text string
  if ($operation == COPY) {
    $operation_text = langf("Copy to \"%s\" folder", $origs);
  } elsif ($operation == MOVE) {
    $operation_text = langf("Move to \"%s\" folder", $origs);
  } else {
    warn "copy_move_to_origs: unsupported operation: $operation";
    return;
  }
  if (($operation == MOVE) and (ref($lb) eq 'Tk::Canvas')) {
    warn "copy_move_to_origs: Move operation not allowed in Canvas widget (light table)";
    return;
  }
  my $i = 0;
  my $errors = '';
  my $success = 0;
  my $overwrite = OVERWRITE;
  my @sellist = getSelection($lb);
  return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));
  # picture to select after deletion (has to be defined before we manipulate the listbox!)
  # we try to select the picture which is shown after the last picture of the current selection  
  my $select_after;
  $select_after = $lb->info('next', $sellist[-1]) if ($operation == MOVE);
  
  foreach my $dpic (@sellist) {
    $i++;
    my $dir = dirname($dpic);
    my $pic = basename($dpic);
    my $targetfile = $dir.'/'.$origs.'/'.$pic;
    if ($dir =~ m/.*\/$origs$/) {
      $errors .= "Picture $dpic is already located in $origs folder, skipping!\n";
      next;
    }
    if (-d $dir) {
      my $origsdir = "$dir/$origs";
      # if origs folder does not exists, create it
      if (!-d $origsdir) {
        if (!mkdir $origsdir, oct(750)) {
          $errors .= $operation_text." ($dpic): ";
          $errors .= langf("Error making folder %s: %s\n", $origsdir, $!);
          $errors .= lang("Operation cancelled\n");
          last; # cancel function (don't copy or move any further files)
        }
      }
      if (-d $origsdir) {
        if (-f $targetfile) {
          # if the pic exists, ask if the user wants to overwrite it
          $overwrite = overwritePic($targetfile, $dpic, (scalar(@sellist) - $i + 1)) if ($overwrite != OVERWRITEALL);
          next if ($overwrite == CANCEL);
          last if ($overwrite == CANCELALL);
        }
        my $ok;
        if ($operation == MOVE) {
          $ok = move($dpic, $origsdir);
        }
        elsif ($operation == COPY) {
          $ok = copy($dpic, $origsdir);
          updateOneRow($dpic, $picLB) if ($ok and $lb == $picLB);
        }
        if ($ok) {
          $success++; # count nr of successfull moves
          # add the location info in the search database
          $searchDB{$targetfile} = $searchDB{$dpic};
          copy_thumbnail($dpic, $origsdir, \$errors);
          if ($operation == MOVE) {
            delete $searchDB{$dpic};
            rename_slideshow_pic($dpic, $targetfile);
            deleteCachedPics($dpic);
            delete_thumbnail($dpic);
          }
        }
        else {
          $errors .= $operation_text.": Could not process $dpic to $origsdir: $!\n";
        }
      }
    }
    else { # no source folder: should never happen
      $errors .= "Warning: Could not move picture $dpic to $origs; Folder $dir does not exist!\n";
      $errors .= lang("Operation cancelled\n");
      last; # cancel function (don't copy or move any further files)
    }    
  } # foreach end
  # clean up, user info, reselection
  if ($errors ne '') {
    $errors = $operation_text.". These errors occured while processing ".scalar @sellist." selected pictures:\n$errors";
    showText($operation_text.'Errors during operation', $errors, NO_WAIT);
  }
  if ($success == 0) { # nothing happend, no update needed
    log_it($operation_text." - ".lang("Ready!")." (nothing changed)");
    return;
  }
  if ($operation == MOVE) {
    my @pics = $lb->info('children');
    if (($#pics > $#sellist) and ($success != 0)) { # if just some pictures were selected
      foreach my $dpic (@sellist) {
        $lb->delete('entry', $dpic) if ($lb->info('exists', $dpic));
        reloadPic() if (($lb == $picLB) and ($dpic eq $actpic));
      }
    }
    else { # all pictures were moved
      updateThumbsPlus() if ($lb == $picLB);
    }
    showNrOf() if ($lb == $picLB);
    # after deletion we select the picture after the last selected file
    select_next($lb, $select_after);
  }
  log_it($operation_text." - ".lang("Ready!")." ".langf("Processed %d/%d picture(s).", $success, scalar(@sellist)));
}

##############################################################
##############################################################
sub copy_thumbnail {
  my $dpic = shift;  # path and name to the picture which thumbnail should be copies
  my $target_dir = shift; # target folder (without /.thumbs!)
  my $errors = shift; # reference to error string to concatenate
  my $target_thumb_dir = dirname(getThumbFileName("$target_dir/dummy.jpg"));
  # make target thumbdir if needed
  return if (not makeDir($target_thumb_dir, NO_ASK));
  my $dpic_thumb = getThumbFileName($dpic);
  if ((-d dirname($target_thumb_dir)) and (-f $dpic_thumb)) {
    if (not copy($dpic_thumb, $target_thumb_dir)) {
      $$errors .= "Could not copy thumbnail $dpic_thumb to $target_thumb_dir: $!";
    }
  }
  else {
    $$errors .= "No thumbnail $dpic_thumb or no folder $target_thumb_dir!";
  }
  return 
}

##############################################################
##############################################################
sub delete_thumbnail {
  my $dpic = shift;  # path and name to the picture which thumbnail should be deleted
  my $errors = shift; # reference to error string to concatenate
  my $dpic_thumb = getThumbFileName($dpic);
  if (unlink($dpic_thumb) != 1) { # unlink returns the number of successfull removed files)
    $$errors .= "Could not remove thumbnail $dpic_thumb: $!";
  }
  return 
}

##############################################################
# movePicsDialog - move the selected pictures to a choosen dir
##############################################################
sub movePicsDialog {
  my $lb = shift;	# the reference to the active listbox widget
  if (ref($lb) eq 'Tk::Canvas') {
    warn "movePicsDialog: Move operation not supported in Canvas widget (light table)";
    return;
  }
  my @sellist = getSelection($lb);
  return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));
  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
  if (ref($lb) eq 'Tk::Canvas') {
    warn "movePics: Move operation not supported in Canvas widget (light table)";
    return;
  }
  my @sellist   = @_;
  return unless (-d $targetdir);
  # check if target folder is writable
  # hint: -w 	File or directory is writable by this (effective) user or group 
  #       -W 	File or directory is writable by this real user or group 
  if (not -w $targetdir) {
    showText('Error while moving', "Folder $targetdir is not writable!", NO_WAIT);
    return;
  }
  return if (@sellist < 1);
  # picture to select after move (has to be defined before we manipulate the listbox!)
  # we try to select the picture which is shown after the last picture of the current selection  
  my $select_after = $lb->info('next', $sellist[-1]);
  makeDir(dirname(getThumbFileName("$targetdir/dummy.jpg")), ASK);
  my $i = 0;
  my $overwrite = OVERWRITE;
  my $changed = 0;
  my $errors = '';
  my $pw = progressWinInit($lb, "Move pictures");
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    my $pic = basename($dpic);
    next if ($targetdir eq dirname($dpic));
    $i++;
    progressWinUpdate($pw, "moving ($i/".scalar @sellist.") ...", $i, scalar @sellist);
    my $tpic = "$targetdir/$pic";
    my $thumbpic  = getThumbFileName($dpic);
    my $thumbtpic = getThumbFileName($tpic);
    $overwrite = overwritePic($tpic, $dpic, (scalar(@sellist) - $i + 1)) if ($overwrite != OVERWRITEALL);
    next if ($overwrite == CANCEL);
    last if ($overwrite == CANCELALL);
    # move picture
    if (!move($dpic, $tpic)) {
      $errors .= "Could not move $dpic to $tpic: $!";
    } else {
      $changed++;				# count nr of successfull moves
      # only if move was successfull, we also move the thumbnail
      if ((-d dirname($thumbtpic)) and (-f $thumbpic)) {
        if (!move($thumbpic, $thumbtpic)) {
          $errors .= "Could not move thumbnail $thumbpic to $thumbtpic: $!";
        }
      }
      # move XMP, WAV, RAW files
      do_other_files($lb, MOVE, $dpic, $tpic, \$errors);
      rename_slideshow_pic($dpic, $tpic);
      $searchDB{$tpic} = $searchDB{$dpic}; # copy meta info in search database
      delete $searchDB{$dpic};             # delete meta info of moved pic in search database
    }
  }
  progressWinEnd($pw);
  if ($errors ne '') {
    $errors = "These errors occured while moving ".scalar @sellist." selected pictures:\n$errors";
    showText('Error while moving', $errors, NO_WAIT);
  }
  if ($changed == 0) {      # nothing happend, no update needed
    log_it("ready! (nothing moved)");
    return;
  }
  my @pics = $lb->info('children');
  if ($#pics > $#sellist) { # if not all pictures were selected
    foreach my $dpic (@sellist) {
      $lb->delete('entry', $dpic) if ($lb->info('exists', $dpic));
      reloadPic() if (($lb == $picLB) and ($dpic eq $actpic));
    }
  }
  else { # all pictures were moved
    updateThumbsPlus() if ($lb == $picLB);
  }
  showNrOf() if ($lb == $picLB);
  # select the picture after the last selected file
  select_next($lb, $select_after);
  log_it("ready! ($changed/".scalar @sellist." moved)");
}

##############################################################
# 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 $oldinfo  = getAllFileInfo($old);
  
  my $newdir   = dirname($new);
  my $newpic   = basename($new);
  my $newthumb = getThumbFileName($new);
  my $newinfo  = getAllFileInfo($new);
  # open window
  my $oww = $top->Toplevel();
  $oww->title(lang("Overwrite").'?');
  $oww->iconimage($mapiviicon) if $mapiviicon;
  $oww->Label(-anchor => 'w', -text => langf("\"%s\" exists. Do you want to overwrite it?",$oldpic),
              -bg => $conf{color_bg}{value})->pack;
  my $nF = $oww->Frame()->pack(-anchor => 'w', -padx => 3, -pady => 3);
  my $ca = $oww->Canvas(-bd => 0, -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 => 5, -fill => 'red');
  $ca->createLine(50,50,70,20, -width => 5, -fill => 'red');
  $ca->createLine(50,50,30,20, -width => 5, -fill => 'red');
  my $newP;
  my $oldP; 
  $newP = $oww->Photo(-file => $newthumb, -gamma => $config{Gamma}) if (-f $newthumb);
  $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 => lang("this file")."\n$newdir\n$newinfo",
             -bg => $conf{color_bg}{value})->pack(-padx => 3, -side => 'left');
  $oF->Label(-justify => 'left', -text => lang("will overwrite this file")."\n$olddir\n$oldinfo",
             -bg => $conf{color_bg}{value})->pack(-padx => 3, -side => 'left');
  $oww->Label(-anchor => 'w', -text => langf("%d files to go ...",$nr),
              -bg => $conf{color_bg}{value})->pack if ($nr > 1);
  my $bF = $oww->Frame()->pack(-padx => 3, -pady => 3, -fill => 'x', -expand => 1);
  $bF->Button(-text => lang("Overwrite"), -command => sub { $rc = OVERWRITE; })->pack(-side => 'left',
                                                                        -fill => 'x', -expand => 1);
  $bF->Button(-text => lang("Overwrite all"),
              -command => sub { $rc = OVERWRITEALL; })->pack(-side => 'left', -fill => 'x', -expand => 1) if ($nr > 1);
  my $Xbut = 
  $bF->Button(-text => lang('Cancel'), -command => sub { $rc = CANCEL; })->pack(-side => 'left',
                                                                        -fill => 'x', -expand => 1);
  my $XbutAll = undef;
  $XbutAll = $bF->Button(-text => lang("Cancel all"),
              -command => sub { $rc = CANCELALL; })->pack(-side => 'left', -fill => 'x', -expand => 1) if ($nr > 1);
  $oww->bind('<Key-Escape>', sub { if (($nr > 1) and (Tk::Exists($XbutAll))) { $XbutAll->Invoke; } else { $Xbut->Invoke; } });
  $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 = getSelection($lb);
  return unless checkSelection($lb, 1, 0, \@sellist, lang("picture(s)"));
  # check if some files are links
  return if (!checkLinks($lb, @sellist));
  my $mail_tool = $conf{external_mail_tool}{value};
  if ($mail_tool =~ m/thunderbird/i) {
  }
  elsif ($mail_tool =~ m/evolution/i) {
  }
  elsif ($mail_tool =~ m/icedove/i) {
  }
  elsif ($mail_tool =~ m/outlook/i) {
    if (@sellist > 1) {
      my $dpic = $sellist[0];
      my $pic = basename($dpic);
      $lb->messageBox(-icon    => 'warning',
                     -message => "Sorry, but the commando line of Outlook supports only one attachment. Only the first picture ($pic) will be added to the email, the rest is ignored.",
                     -title   => 'Too many attachments',
                     -type    => 'OK');
      # clear list and add only the first pic
      @sellist = ();
      push @sellist, $dpic;
    }
  }
  else {
    $lb->messageBox(-icon    => 'warning',
                     -message => "Sorry, the selected mail tool ($mail_tool) is not supported! Please try to find the command line syntax to send a mail with attachment and send this info to Martin-Herrmann\@gmx.de.",
                     -title   => 'External mail tool not yet supported',
                     -type    => 'OK');
    return;
  }
  if (($mail_tool !~ m/outlook/i) and ((system "$mail_tool --version") != 0)) {
    $lb->messageBox(-icon    => 'warning',
                     -message => "Sorry, no mail tool ($mail_tool) found! Please use Ctrl-o (Options->$conf{external_mail_tool}{tab}->$conf{external_mail_tool}{long}) to select the right tool.",
                     -title   => 'External mail tool not available',
                     -type    => 'OK');
    return;
  }
  # open dialog window
  my $myDiag = $top->Toplevel();
  $myDiag->title("Change size/quality before sending");
  $myDiag->iconimage($mapiviicon) if $mapiviicon;
  my $file_size = get_list_size(\@sellist);
  $myDiag->Label(-text =>"The selected picture(s) have a file size of $file_size.\nChange the size and/or quality of the ".scalar @sellist." selected picture(s) before sending via email?",
                 -bg => $conf{color_bg}{value}
                )->pack(-anchor => 'w',-padx => 3,-pady => 3);
  $myDiag->Checkbutton(-variable => \$config{MailPicNoChange},
                       -text => "leave pictures untouched",
                       -command => sub {
                         foreach my $w (qw(sq sl)) {set_child_normal($myDiag->{$w}, !$config{MailPicNoChange});}
                       })->pack(-anchor => 'w');
  # quality scale
  $myDiag->{sq} = labeledScale($myDiag, 'top', 24, lang("Quality (%)"), \$config{MailPicQuality}, 10, 100, 1);
  qualityBalloon($myDiag->{sq});
  # pixel size scale
  $myDiag->{sl} = labeledScale($myDiag, 'top', 24, "Maximum length (pixels)", \$config{MailPicMaxLength}, 10, 2000, 1);
  foreach my $w (qw(sq sl)) {set_child_normal($myDiag->{$w}, !$config{MailPicNoChange});}
  my $ButF =
    $myDiag->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
  my $OKB =
    $ButF->Button(-text => lang('OK'),
                  -command => sub {
                    $myDiag->destroy();
                    log_it("sending ".scalar @sellist." pictures via email");
                    unless ($config{MailPicNoChange}) {
                      # copy to trash
                      log_it("send to: copy pictures to temp folder");
                      foreach my $dpic (@sellist) {
                        mycopy($dpic, $trashdir, OVERWRITE);
                      }
                      # exchange the folder from original to trash
                      foreach (@sellist) {
                        $_ = "$trashdir/".basename($_);
                      }
                      # resize
                      foreach my $dpic (@sellist) {
                        log_it("send to: resizing pictures ".basename($dpic));
                        my $command = "mogrify";
                        $command .= " -geometry \"".$config{MailPicMaxLength}.'x'.$config{MailPicMaxLength}.">\"";
                        $command .= " -quality ".$config{MailPicQuality}." \"$dpic\"";
                        print "changeSizeQuality: com = $command\n" if $verbose;
                        execute($command);
                      }
                    }
                    # the email subject & caption
                    my ($subject, $caption) = email_subject_caption("Pictures", "Text", \@sellist);
                    my $attachments = email_attachments($mail_tool, \@sellist);

# /usr/bin/evolution mailto:Martin-Herrmann@gmx.de?attach=file:///home/pic1.jpg\&attach=file:///home/pic2.jpg\&subject=My%20Pictures\&body=Text%20for%20description &
# for Outlook under WinXP use:
# "C:\Program Files\Microsoft Office\OFFICE11\OUTLOOK.EXE" /c ipm.note /a C:\path\to\picture.jpg

                    log_it("send to: starting email client ...");
                    my $command = "\"$mail_tool\" ";
                    if (($mail_tool =~ m/thunderbird/i) or ($mail_tool =~ m/icedove/i)) {
                      $command .= "-compose \"subject=\'$subject\',attachment=\'$attachments\',body=\'$caption\'\"";
                    }
                    elsif ($mail_tool =~ m/evolution/i) {
                      #$command .= "\"mailto:Receiver?attach=\'$attachments\'\\&subject=Pictures\\&body=Text\"";
                      $command .= "\"mailto:Receiver?attach=$attachments\&subject=$subject\&body=\'$caption\'\"" ;
                    }
                    elsif ($mail_tool =~ m/outlook/i) {
                      if (ProcBackgroundAvail) {
                        $command =~ s!\/!\\!g;  # replace UNIX path delimiter with Windows style / -> \
                        my $dpic = $sellist[0];
                        $dpic =~ s!\/!\\!g;     # replace UNIX path delimiter with Windows style / -> \
                        # no quotes around mail tool and pic when using Proc::Background!
                        Proc::Background->new($mail_tool, "/c", "ipm.note", "/a", $dpic);
                        log_it(lang('Ready!'));
                      }
                      else {
                        log_it("Perl module Proc::Background not available: Can't start email client");
                        print "Perl module Proc::Background not available: Can't start email client\n";
                      }
                      return;
                    }
                    else {
                       # this case is already handled adove.
                    }
                    $command .= " &" unless ($EvilOS);
                    print "command = $command\n";# if $verbose;
                    #execute($command);
                    # starting Outlook with system is a real nightmare
                    (system "$command") == 0 or warn "$command failed: $!";
                    log_it(lang('Ready!'));
                  })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $ButF->Button(-text => lang("Default"),
                -command => sub {
                  $config{MailPicNoChange} = 0;
                  $config{MailPicQuality} = 80;
                  $config{MailPicMaxLength} = 1000;
                  foreach my $w (qw(sq sl)) {set_child_normal($myDiag->{$w}, !$config{MailPicNoChange});}
                })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  $OKB->bind('<Return>', sub { $OKB->Invoke; } );
  $ButF->Button(-text => lang('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);
}

##############################################################
# try to find a subject and text for the email by searching
# IPTC headline, object name and caption of the pictures
##############################################################
sub email_subject_caption {
  my ($subject, $caption, $piclist) = @_;
  foreach my $dpic (@{$piclist}) {
    # use the headline or the ObjectName of the first picture as email subject
    my $sub = getIPTCHeadline($dpic);
    my $obj = getIPTCObjectName($dpic);
    # scip 
    next if ($sub eq '' and $obj eq '');
    if ($sub ne '') {
      $subject = $sub;
    }
    else {
      $subject = $obj;
    }
    # use the caption of this picture for the email text
    # we shouldn't mix it with captions from other pictures
    my $cap = getIPTCCaption($dpic);
    $caption = $cap if ($cap ne '');
    last; # finished
  }
  return ($subject, $caption);
}

##############################################################
# /usr/bin/evolution mailto:Martin-Herrmann@gmx.de?attach=file:///home/pic1.jpg\&attach=file:///home/pic2.jpg\&subject=My%20Pictures\&body=Text%20for%20description &
##############################################################
sub email_attachments {
  my ($mail_tool, $piclist) = @_;
  my $attach = '';
  # outlook is only able to handle one attachment
  if ($mail_tool =~ m/outlook/i) {
    $$piclist[0] =~ s!\/!\\!g;     # replace UNIX path delimiter with Windows style / -> \
    $attach = " /a \"$$piclist[0]\" ";
  }
  else { # all other mail tools
    foreach my $dpic (@{$piclist}) {
      if ($attach eq '') { # the first attachment
        $attach = "file://$dpic";    
      } else {  # additional attachments
        if ($mail_tool =~ m/evolution/i) {
          $attach .= "\&attach=file://$dpic";  
        }
        else { # thunderbird, icedove etc.
          $attach .= ",file://$dpic"; 
        }
      }
    }
  }
  return $attach;
}

##############################################################
# convertPics - convert selected pics to another format
##############################################################
sub convertPics {
  my $lb = shift;				# the reference to the active listbox widget
  my @sellist = getSelection($lb);
  return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));
  return if (!checkExternProgs("convertPics", "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 => $conf{color_bg}{value}
                )->pack(-anchor => 'w',-padx => 3,-pady => 3);
  my $notebook =
    $win->NoteBook(-width => 500,
                  -background => $conf{color_bg}{value}, # background of active page (including its tab)
                  -inactivebackground => $conf{color_entry}{value}, # tabs of inactive pages
                  -backpagecolor => $conf{color_bg}{value}, # 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, lang("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 => lang('OK'),
                  -command => sub {
                    $win->destroy();
                    #my $format = $notebook->raised();
                    print "format = $format\n";
                    log_it("converting ".scalar @sellist." $format pictures");
                    my $i = 0;
                    my $pw = progressWinInit($top, "Convert pictures");
                    foreach my $dpic (@sellist) {
                        last if progressWinCheck($pw);
                        progressWinUpdate($pw, "convert picture ($i/".scalar @sellist.") ...", $i, scalar @sellist);
                        $i++;
                        my $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);
                        }
                        log_it("convert picture ".basename($dpic));
                        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);
                    log_it(lang('Ready!'));
                })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  $OKB->bind('<Return>', sub { $OKB->Invoke; } );
  my $xBut = $ButF->Button(-text => lang('Cancel'),
                -command => sub { $win->destroy(); }
               )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  bind_exit_keys_to_button($win, $xBut);
  $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;
  if (ref($lb) eq 'Tk::Canvas') {
    warn "renamePic: Rename operation not supported in Canvas widget (light table)";
    return;
  }
  my @sellist = getSelection($lb);
  my @resellist = @sellist;
  return unless checkSelection($lb, 1, 0, \@sellist, lang("picture(s)"));
  my $i = 0;
  my $errors = '';
  my $pw = progressWinInit($lb, "Rename pictures");
  foreach my $dpic (@sellist){
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "renaming picture ($i/".scalar @sellist.") ...", $i, scalar @sellist);
    my $pic     = basename($dpic);
    my $dir     = dirname($dpic);
    my $thumb   = getThumbFileName($dpic);
    my $newname = $pic;
    next if (!checkWriteable($dpic));
    my $rc = myEntryDialog("Rename picture", "Please enter a new name for file\n$pic\n(in $dir)", \$newname, getThumbFileName($dpic));
    next if (($rc ne 'OK') or ($newname eq '') or ($newname eq $pic));
    # check for correct JPEG suffix
    if (is_a_JPEG($dpic) and ($newname !~ /(.*)(\.jp(g|eg))/i)) {
      $newname =~ /(.*)\.(.*)/;
      my $correct = "$1.jpg";
      my $rc = $lb->messageBox(-icon => 'question', -message => "$newname has not a correct JPEG suffix.\nShould I change it to $correct?",
                       -title => "Change suffix?", -type => 'OKCancel');
      if ($rc eq 'Ok') {
        $newname = "$correct";
      }
    }
    my $ndpic = "$dir/$newname";
    # check if new file name already exists
    if (-f $ndpic) {
      my $rc = $lb->Dialog( -title => "File exists",
                             -text => "$newname already exists!",
                             -buttons => ['Overwrite', 'Cancel'])->Show();
      next if ($rc ne 'Overwrite'); # skip this file
    }
    if (!rename ($dpic, $ndpic)) {
      $errors .= "Could not rename $pic to $newname: $!";
      next;
    }
    # correct the searchDB
    $searchDB{$ndpic} = $searchDB{$dpic}; # copy meta info in search database
    delete $searchDB{$dpic};              # delete meta info of renamed pic in search database
    renameCachedPic($dpic, $ndpic);
    rename_slideshow_pic($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));
    my $rating_size = get_rating_and_size($ndpic, $lb);
    $lb->itemConfigure($ndpic, $lb->{filecol}, -itemtype => 'image', -image => $rating_size, -style => $fileS);
    # rename thumbnail
    if (-f $thumb) {
      if (!rename ($thumb, dirname($thumb)."/$newname")) {
        $errors .= "Could not rename thumbnail $pic to $newname: $!";
      }
    }
    # rename XMP, WAV, RAW files
    do_other_files($lb, RENAME, $dpic, $ndpic, \$errors);
    # rename exif info file, if any
    if (-f "$dir/$exifdirname/$pic") {
      if (!rename ("$actdir/$exifdirname/$pic", "$actdir/$exifdirname/$newname")) {
        $errors .= "Could not rename exif info file $pic to $newname: $!";
      }
    }
    # rename backup file, if any
    renameBackup($lb, $dpic, $newname, ASK);
  }
  if ($errors ne '') {
    $errors = "These errors occured while renaming ".scalar @sellist." selected pictures:\n$errors";
    showText('Error while renaming', $errors, NO_WAIT);
  }
  progressWinEnd($pw);
  reselect($lb, @resellist);
  if ($lb == $picLB) {
      setTitle();
      log_it("ready! ($i/".scalar @sellist." renamed)");
  }
}

##############################################################
# 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]);
  my ($yes, $opic) = has_orig_file(fileparse($sellist[0], '\.[^.]*'));
  if (-f $bpic) {
    showPicInOwnWin($bpic);
  }
  elsif ($yes) {
    showPicInOwnWin($opic);
  }
  else {
    log_it('Sorry, no backup and no original found.');
  }
}

##############################################################
# 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);
    # correct the searchDB - copy meta info in search database
    $searchDB{$new_bak_name} = $searchDB{$bpic};
    delete $searchDB{$bpic};
    # change the displayed name
    if ($lb->info("exists", $new_bak_name)) {
      $lb->itemConfigure($new_bak_name, $lb->{thumbcol}, -text => getThumbCaption($new_bak_name));
      my $rating_size = get_rating_and_size($new_bak_name, $lb);
      $lb->itemConfigure($new_bak_name, $lb->{filecol}, -itemtype => 'image', -image => $rating_size, -style => $fileS);
    }
    # 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(lang('Enter file name format'),
                         'Please enter the file name format

%f  = file name (without suffix)
%F  = file name substring (%Fn-m use old file name from char n to m)
%y  = year      (yyyy)              
%m  = month     (mm)                
%d  = day       (dd)                
%h  = hour      (hh)                
%M  = Minute    (MM)                
%s  = second    (ss)                
%pO = IPTC Object name
%po = IPTC Object name with spaces replaced by underscore ("_")
%pH = IPTC Headline
%ph = IPTC Headline with spaces replaced by underscore ("_")
%xa = EXIF aperture
%xe = EXIF exposure time
%xm = EXIF camera model	
%xr = EXIF artist
%iw = image width
%ih = image height

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

"%F4-7" will rename PIC0001.jpg to file name substring from
4th char up to 7th char e.g 0001.jpg

If you select 3 pictures and enter "flower" as file name format,
the pics will be renamed to "flower-001.jpg", "flower-002.jpg" and
"flower-003.jpg".

The file suffix will always be added.

Leave the format line below empty to use the default format
('.$config{FileNameFormatDef}.').', \$format);

  return 'Cancel' if ($rc ne 'OK');

  if ($format eq '') {
    $format = $config{FileNameFormatDef};
  }

  if ($format =~ m/.*\/.*/) {
    $top->messageBox(-icon  => 'warning', -message => "Sorry, but a / is not allowed in a file name.",
                     -title => 'Error',   -type    => 'OK');

    return 'Cancel';
  }
  $config{FileNameFormat} = $format; # save back to the config
  return $rc;
}

##############################################################
# renameSmart - rename the selected pictures using e.g. the EXIF date
##############################################################
sub renameSmart {
  my $lb = shift;
  if (ref($lb) eq 'Tk::Canvas') {
    warn "renameSmart: Rename operation not supported in Canvas widget (light table)";
    return;
  }
  my @sellist = getSelection($lb);
  my @resellist = @sellist;
  return unless checkSelection($lb, 1, 0, \@sellist, lang("picture(s)"));
  my $doForAll = 0;
  my $errors   = '';
  my $useFileDate = undef;
  my @renamed;
  my $rc = getRenameFormat();
  return if ($rc ne 'OK');
  my $format = $config{FileNameFormat};
  my $i = 0;
  my $pw = progressWinInit($lb, "smart rename");

  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    my $pic = basename($dpic);
    my $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 = '';
    my $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
    my $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($lb, $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));
      my $rating_size = get_rating_and_size($ndpic, $lb);
      $lb->itemConfigure($ndpic, $lb->{filecol}, -itemtype => 'image', -image => $rating_size, -style => $fileS);
      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));
    my $rating_size = get_rating_and_size($ndpic, $lb);
    $lb->itemConfigure($ndpic, $lb->{filecol}, -itemtype => 'image', -image => $rating_size, -style => $fileS);
    foreach (@resellist) { $_ = $ndpic if ($_ eq $dpic); }
  }

  progressWinEnd($pw);
  reselect($lb, @resellist);
  if ($lb == $picLB) {
      log_it("ready! (renamed $i/".scalar @sellist.")");
      setTitle();
  }
  if ($errors ne '') {
    $errors = "These errors occured while renaming ".scalar @sellist." selected pictures:\n$errors";
    showText("Error while renaming", $errors, NO_WAIT);
  }
  $lb->focusForce;
}

##############################################################
# renamePicInt - rename a pic, the thumb, backup, exif, nonjpeg
#                searchDB and cached pic
##############################################################
sub renamePicInt {
  my $lb = shift; # listbox reference
  my $dpic   = shift;
  my $ndpic  = shift;
  my $errors = shift; # ref to error string
  my $pic  = basename($dpic);
  my $dir  = dirname($dpic);
  my $npic = basename($ndpic);
  my $rc = 0;

  if (!rename ($dpic, $ndpic)) {
    # rename failed
    $$errors .= "Could not rename $pic to $npic: $!\n";
    $rc = 0;
  }
  else {
    # rename worked
    # rename the thumbnail
    my $thumbdir = dirname(getThumbFileName($dpic));
    if (!rename ("$thumbdir/$pic", "$thumbdir/$npic")) {
      $$errors .= "Could not rename thumbnail $pic to $npic: $!\n";
    }
    # rename exif info file, if any
    if (-f "$dir/$exifdirname/$pic") {
      if (!rename ("$dir/$exifdirname/$pic", "$dir/$exifdirname/$npic")) {
        $$errors .= "Could not rename exif info file $pic to $npic: $!\n";
      }
    }
    
    # rename the XMP, WAV, RAW sidecar files, if any
    do_other_files($lb, RENAME, $dpic, $ndpic, \$errors);

    # rename backup file, if any
    renameBackup($picLB, $dpic, $npic);

    # rename non-JPEG file, if any
    renameNonJPEG($dpic, $npic);

    # correct the searchDB
    $searchDB{$ndpic} = $searchDB{$dpic}; # copy meta info in search database
    delete $searchDB{$dpic};               # delete meta info of renamed pic in search database

    renameCachedPic($dpic, $ndpic);
    rename_slideshow_pic($dpic, $ndpic);
    $actpic = $ndpic if (($dpic eq $actpic) and (-f $ndpic));
    $rc = 1;
  }
  return $rc;
}

##############################################################
# renameSmartFix - fix the renaming of renameSmart by adding
#                  "-001" to the first pic of a set
#                  e.g. pic1.jpg     and pic1-002.jpg will be renamed to
#                       pic1-001.jpg and pic1-002.jpg
# see also: findNewName()
# todo: this really is an ugly solution - fix it
##############################################################
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-002.jpg
  foreach my $dpic (@piclist) {
    if ($dpic =~ m/(.*)-002\.(.*)$/i) {   # e.g. file-002.jpg
      my $pic  = "$1.$2";
      my $npic = "$1-001.$2";
      # if there is a file named file.jpg
      if (defined $hash{$pic}) {
        # and no file named file-001.jpg
        unless (defined $hash{$npic}) {
          print "renameSmartFix: rename $pic to $npic\n" if $verbose;
          # we rename file.jpg to file-001.jpg
          if (renamePicInt(undef, $pic, $npic, $errors)) {
            $renamed{$pic} = $npic;
          }
        }
      }
    }
  }
  return \%renamed;
}

##############################################################
# applyRenameFormat
##############################################################
sub applyRenameFormat {
  my $dpic     = shift;
  my $format   = shift;           # e.g. %y%m%d-%h%M%s
  my $newname  = shift;           # reference to string
  my $doForAll = shift;           # reference to bool
  my $pic      = basename($dpic);
  $$newname = $format;
  # replace %f with the file name
  if (($format =~ m/\%f/) and ($pic =~ /(.*)\.(.*)/)) {
    my $name = $1;     # $1 makes some problems in s///
    $$newname =~ s/%f/$name/g;
  }
  # idea from Thierry Daucourt
  # replace %F with the file name substring
  if ($format =~ m/\%F(\d+)\-(\d+)/) {
    my $begin = $1 - 1; # we start with index 1, not 0
    my $end   = $2 - 1;
    if ($pic =~ /(.*)\.(.*)/) {
      my $name = $1;
      #print "begin: $begin end: $end length ($name): ",length($name),"\n";
      # some safety checks
      if (($begin <= $end) and
          ($end < length($name)) and
          ($begin >= 0)) { 
        $name = substr($name, $begin, $end - $begin + 1);
      }
      $$newname =~ s/\%F(\d+)\-(\d+)/$name/g;
    }
  }
  # get the date and replace it, only when needed (it is needed when one of the placeholders %y %m %d %h %M or %s is used)
  if ($format =~ m/(\%y|\%m|\%d|\%h|\%M|\%s)/) {
    my $datestr = '';
    $datestr = getEXIFDate($dpic);
    if ($datestr eq '') {
      $datestr  = getFileDate($dpic, NO_FORMAT);
      $datestr  = getDateTimeEXIFString($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;
  }
  # use iptc data if required
  # thanks to Alexander Zangerl for the patch
  if ($format =~ m/\%p(h|o|H|O)/) {
    # retrieve headline or objectname
    my $what=$1;
    my $attr=($what =~ /h/i? 
    getIPTCHeadline($dpic):
    getIPTCObjectName($dpic)); 
    $attr =~ s/ /_/g if ($what =~ /(h|o)/); # get rid of the spaces if asked
    $$newname =~ s/%p(h|o|H|O)/$attr/g;
  }
  print "applyRenameFormat: $pic -> -$$newname- (format: $format)\n" if $verbose;
  return 'OK';
}

##############################################################
# findNewName - find a unused name by adding a number
#               e.g.  name-002.jpg
#               input: filename with dir! with or without suffix
#               output: new filename - no dir!!!
# hint: in file sets which would end in the same name this
#       function will rename only the second and folling files
# see also: renameSmartFix() - set set the name of the first file        
##############################################################
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 ( 2 .. 999 ) {                           # three digits
    if (-f  "$dir/$new$suffix") {
      $new = sprintf "%s-%03d", $base, $_;     # three digits
    } else {
      last;
    }
  }
  print "findNewName: $pic -> $new$suffix\n" if $verbose;
  return "$new$suffix";
}

##############################################################
#  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(lang('New IPTC keywords'));
  $win->iconimage($mapiviicon) if $mapiviicon;

  my $text = '...';

  $win->Label(-textvariable => \$text)->pack(-expand => 0, -fill => 'x');
  my $tlb = $win->Scrolled("HList",
                           -header     => 1,
                           -separator  => ';',  # todo here we hope that ; will never be in a folder or file name
                           -pady       => 0,
                           -columns    => 2,
                           -scrollbars => 'osoe',
                           -selectmode => 'extended',
                           -width      => 80,
                           -height     => 30,
                          )->pack(-expand => 1, -fill => 'both');

  $tlb->header('create', 0, -text => lang('Keyword'), -headerbackground => $conf{color_entry}{value});
  $tlb->header('create', 1, -text => lang('Quantity'), -headerbackground => $conf{color_entry}{value});

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

  $butF1->Button(-text => lang('Select all'), -command => sub { selectAll($tlb); })->pack(-side => 'left', -padx => 3, -pady => 3);
  $butF1->Button(-text => lang('Select none'), -command => sub { $tlb->selectionClear(); })->pack(-side => 'left', -padx => 3, -pady => 3);
  my $ab = $butF2->Button(-text => lang('Add'),
                -command => sub {
                  my @sellist = getSelection($tlb);
                  return unless checkSelection($win, 1, 0, \@sellist, lang("keyword(s)"));
                  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);
  $balloon->attach($ab, -msg => lang('Add selected keywords to keyword catalog'));
  my $ib = $butF2->Button(-text => lang('Ignore'),
                -command => sub {
                  my @sellist = getSelection($tlb);
                  return unless checkSelection($win, 1, 0, \@sellist, lang("keyword(s)"));
                  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);
  $balloon->attach($ib, -msg => lang('Ignore selected keywords'));

  $butF3->Checkbutton(-variable => \$config{CheckNewKeywords},
                   -text => lang("Check for new keywords"))->pack(-side => 'left', -anchor => 'w');

  my $Xbut = $butF3->Button(-text => lang('Ask later'),
                -command => sub { $win->destroy();
                })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  bind_exit_keys_to_button($win, $Xbut);
  $win->bind('<Control-a>',  sub { selectAll($tlb); } );
  $win->Popup(-popover => 'cursor');
  repositionWindow($win);
  my $nr = show_new_keywords($tlb);
  $text = langf("Found %d new IPTC keywords, please choose how to proceed.", $nr);
  $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 = '';
    # convert / separator to .
    $key =~ s|\/|\.|g;
    # 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($nav_F->{key_frame})) {
    insertTreeList($nav_F->{key_frame}->{tree}, @prekeys);
  }
}

##############################################################
# check if we accidentially remove pictures with a high rating
##############################################################
sub preserve_high_rated_pics {
  my $preserve = 0;
  my $sellist = shift;
  my %high_rated_pics;
  foreach my $dpic (@$sellist) {
    if (defined $searchDB{$dpic}{URG}) {
      if (($searchDB{$dpic}{URG} > 0) and ($searchDB{$dpic}{URG} <= $config{AskDeleteHighRatingLevel})) {
        $high_rated_pics{$dpic} = $searchDB{$dpic}{URG}; 
      }
    }
  }
  if (keys(%high_rated_pics) > 0) {
    $preserve = 1;
    # open window
    my $win = $top->Toplevel();
    $win->title(lang('Delete high rated pictures?'));
    $win->iconimage($mapiviicon) if $mapiviicon;
    my $w = int($top->screenwidth * 0.5);
    my $h = int($top->screenheight * 0.5);
    $win->geometry("${w}x${h}+0+0"); 

    my $text = lang("loading ...");

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

    $tlb->header('create', 0, -text => lang('Thumbnail'), -headerbackground => $conf{color_entry}{value});
    $tlb->header('create', 1, -text => lang('Name'), -headerbackground => $conf{color_entry}{value});
    $tlb->header('create', 2, -text => lang('Rating'), -headerbackground => $conf{color_entry}{value});
    $tlb->header('create', 3, -text => lang('Folder'), -headerbackground => $conf{color_entry}{value});

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

    $butF->Button(-text => lang('Delete'),
    -command => sub { $preserve = 0; $win->destroy;
    })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
    
    my $Xbut = $butF->Button(-text => lang('Cancel'),
    -command => sub { $win->destroy();
    })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
    bind_exit_keys_to_button($win, $Xbut);
    $win->bind('<ButtonPress-2>', sub {
      return if (!$tlb->info('children'));
      showPicInOwnWin(getNearestItem($tlb));
    });
    $win->bind('<Key-d>', sub {
      return if (!$tlb->info('children'));
      showPicInOwnWin(getNearestItem($tlb));
    });

    $win->Popup();

    my %thumbs;
    # add all pictures with thumbnails, name and rating ...
    foreach my $dpic (sort keys(%high_rated_pics)) {
      my $name = basename($dpic);
      my $dir = dirname($dpic);
      my $thumb = getThumbFileName($dpic);
      my $urg = iptc_rating_stars($searchDB{$dpic}{URG})." ($high_rated_pics{$dpic})";
      
      $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 => $name, -style => $comS);
      $tlb->itemCreate($dpic, 2, -text => $urg, -style => $iptcS);
      $tlb->itemCreate($dpic, 3, -text => $dir, -style => $comS);

    }
    # display the dialog text
    $text = langf("%d of the %d selected pictures have a rating higher or equal to %d.",scalar(keys(%high_rated_pics)), scalar(@$sellist), $config{AskDeleteHighRatingLevel})."\n".langf("Please confirm to delete %d pictures.",scalar(@$sellist))."\n".lang("Use <d> or middle mouse button to view a picture.");
    $win->waitWindow;
    foreach (keys %thumbs) { $thumbs{$_}->delete if (defined $thumbs{$_}); } # free memory
  }
  return $preserve;
}

##############################################################
# reverse slideshow hash for fast checks if a picture is in a (or several) slideshows
# key1 = dpic, key2 = folder, key3 = slideshows name, value = index (starts with 0)
# base: %slideshow hash
# if performance issues occure, the %slideshow_pics hash could be stored and updated only when needed
##############################################################
sub build_slideshow_pic_hash {
  my %slideshow_pics; 
  foreach my $folder (keys %slideshows) {
    foreach my $collection (keys %{$slideshows{$folder}}) {
      my $index = 0;
      foreach my $dpic (@{$slideshows{$folder}{$collection}{pics}}) {
        #print "build_slideshow_pic_hash: $index: $dpic \n";
        $slideshow_pics{$dpic}{$folder}{$collection} = $index;
        $index++;
      }
    }
  }
  return \%slideshow_pics;
}

##############################################################
# check if a picture rename or move action affects any collections
# and renames the picture in the colletions
# todo: this approach is not able to handle several instances
#       of a picture in one slideshow
##############################################################
sub rename_slideshow_pic {
  my $old_name = shift;
  my $new_name = shift;
  my $slideshow_pics = build_slideshow_pic_hash();
  if (defined $$slideshow_pics{$old_name}) {
    print "$old_name is used in a slideshow:\n";
    foreach my $folder (keys %{$slideshow_pics->{$old_name}}) {
      foreach my $collection (keys %{$slideshow_pics->{$old_name}->{$folder}}) {
        my $index = $slideshow_pics->{$old_name}->{$folder}->{$collection};
        print "  in collection: $folder $collection with index $index\n";
	      if ($slideshows{$folder}{$collection}{pics}[$index] eq $old_name) {
          print "    found pic as index $index - replacing it with $new_name\n";
          log_it(basename($old_name)." is used in collection $folder $collection. -> Fixed.");
          $slideshows{$folder}{$collection}{pics}[$index] = $new_name; 
        }
        else {
          print "    Error: pic $old_name with index $index not found!!!\n";
        }
      }
    }    
  }
}

##############################################################
# check if we accidentially remove pictures which are used in
# slideshows
# function derived from preserve_high_rated_pics()
##############################################################
sub preserve_slideshow_pics {
  my $preserve = 0;
  my $sellist = shift;
  my %used_pics;
  my $slideshow_pics = build_slideshow_pic_hash();
  foreach my $dpic (@$sellist) {
    #print "preserve_slideshow_pics: checking for $dpic\n";
    if (defined $$slideshow_pics{$dpic}) {
      #print "$dpic is used in a slideshow!\n";
      $used_pics{$dpic} = 1; 
    }
  }
  if (keys(%used_pics) > 0) {
    $preserve = 1;
    # open window
    my $win = $top->Toplevel();
    $win->title(lang('Delete pictures used in collections?'));
    $win->iconimage($mapiviicon) if $mapiviicon;
    my $w = int($top->screenwidth * 0.5);
    my $h = int($top->screenheight * 0.5);
    $win->geometry("${w}x${h}+0+0"); 

    my $text = lang("loading ...");

    $win->Label(-textvariable => \$text)->pack(-expand => 0, -fill => 'x');
    my $tlb = $win->Scrolled('HList',
                            -header     => 1,
                            -separator  => ';',  # todo here we hope that ; will never be in a folder or file name
                            -pady       => 0,
                            -columns    => 6,
                            -scrollbars => 'osoe',
                            -selectmode => 'none',
                            #-background => $conf{color_bg}{value}, #8fa8bf
                            -width      => 80,
                            #-height     => 30,
    )->pack(-expand => 1, -fill => 'both');

    $tlb->header('create', 0, -text => lang('Thumbnail'), -headerbackground => $conf{color_entry}{value});
    $tlb->header('create', 1, -text => lang('Name'), -headerbackground => $conf{color_entry}{value});
    $tlb->header('create', 2, -text => lang('Collection folder'), -headerbackground => $conf{color_entry}{value});
    $tlb->header('create', 3, -text => lang('Collection'), -headerbackground => $conf{color_entry}{value});
    $tlb->header('create', 4, -text => lang('#'), -headerbackground => $conf{color_entry}{value});
    $tlb->header('create', 5, -text => lang('File folder'), -headerbackground => $conf{color_entry}{value});

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

    $butF->Button(-text => lang('Delete'),
    -command => sub { $preserve = 0; $win->destroy;
    })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
    
    my $Xbut = $butF->Button(-text => lang('Cancel'),
    -command => sub { $win->destroy();
    })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
    bind_exit_keys_to_button($win, $Xbut);
    $win->bind('<ButtonPress-2>', sub {
      return if (!$tlb->info('children'));
      showPicInOwnWin(getNearestItem($tlb));
    });
    $win->bind('<Key-d>', sub {
      return if (!$tlb->info('children'));
      showPicInOwnWin(getNearestItem($tlb));
    });
    # key l to open corresponding picture collection
    $win->bind('<Key-l>', sub {
      return if (!$tlb->info('children'));
      my $dpic = getNearestItem($tlb);
      # warning: pic may be part of several collections
      # thus collection folder and name may be multiline strings
      my $cfolders = $tlb->itemCget($dpic, 2, -text);
      my $collections = $tlb->itemCget($dpic, 3, -text);
      my @folders = split(/\n/, $cfolders);
      my @names = split(/\n/, $collections);
      my $folder = $folders[0];
      my $collection = $names[0];
      if (@folders > 1) {
        my @sel_list;
        return if (!mySelListBoxDialog(lang("Select collection to open"),
                                 langf("Picture is used in %d collections.\nPlease select which one to open.",scalar @names),
                                 SINGLE,
                                 lang("Open collection"), \@sel_list, @names));
        return if (not @sel_list); # return if nothing is selected
        foreach (@sel_list) {
          $folder = $folders[$_];
          $collection = $names[$_];
        }
      }
      if (exists $slideshows{$folder}{$collection}) {
        my $pics = $slideshows{$folder}{$collection}{pics};
        light_table_edit($pics, $folder, $collection);
      } else {
        warn "Warning: collection $folder $collection does not exist! Should not happen!";
      }
      #print "key l pressed: $dpic $cfolder $collection\n";
    });

    $win->Popup();

    my %thumbs;
    # add all pictures with thumbnails, name and rating ...
    foreach my $dpic (sort keys(%used_pics)) {
      my $name = basename($dpic);
      my $dir = dirname($dpic);
      my $thumb = getThumbFileName($dpic);
      my @collectionfolders;
      my @collectionnames;
      my @collectionindex;
      # list all collections using this picture
      foreach my $folder (keys %{$slideshow_pics->{$dpic}}) {
        foreach my $collection (keys %{$slideshow_pics->{$dpic}->{$folder}}) {
          # add 1 to make the index readable
          my $index = $$slideshow_pics{$dpic}{$folder}{$collection} + 1;
          push @collectionfolders, $folder;
          push @collectionnames, $collection;
          push @collectionindex, $index;
        }
      }
      my $cfolders = join "\n", @collectionfolders;
      my $cnames   = join "\n", @collectionnames;
      my $cindex   = join "\n", @collectionindex;
      $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 => $name, -style => $comS);
      $tlb->itemCreate($dpic, 2, -text => $cfolders, -style => $iptcS);
      $tlb->itemCreate($dpic, 3, -text => $cnames, -style => $comS);
      $tlb->itemCreate($dpic, 4, -text => $cindex, -style => $comS);
      $tlb->itemCreate($dpic, 5, -text => $dir, -style => $comS);
    }
    # display the dialog text
    $text = langf("%d of the %d selected pictures are used in a collection.", scalar(keys(%used_pics)), scalar(@$sellist))."\n".langf("Please confirm to delete %d pictures.",scalar(@$sellist))."\n".lang("Use <d> or middle mouse button to view a picture.")." ".lang("Use <l> to open collection.");
    $win->waitWindow;
    foreach (keys %thumbs) { $thumbs{$_}->delete if (defined $thumbs{$_}); } # free memory
  }
  return $preserve;
}

##############################################################
# deletePics - deletes selected pictures
#              mode: TRASH or REMOVE
#                    TRASH = move to $trashdir
#                    REMOVE    = remove
##############################################################
sub deletePics {
  my $lb   = shift; # the reference to the active listbox widget
  my $mode = shift; # constant TRASH or REMOVE
  if (ref($lb) eq 'Tk::Canvas') {
    warn "deletePics: Delete operation not supported in Canvas widget (light table)";
    return;
  }
  my @sellist = getSelection($lb);
  return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));
  my @childs = $lb->info('children');
  my $all = 0; $all = 1 if (@childs == @sellist); # all pics are selected
  my $str = '';
  my @dummylist     = ();
  my $changed       = 0;
  my $update        = 0;
  # build the show and the delete list
  foreach my $dpic (@sellist) {
    my $pic     = basename($dpic);
    my $size    = getFileSize($dpic, FORMAT);
    $str    .= sprintf "%-40s %10s\n", $pic, $size;
  }
  # picture to select after deletion (has to be defined before we manipulate the listbox!)
  # we try to select the picture which is shown after the last picture of the current selection  
  my $select_after = $lb->info('next', $sellist[-1]);
  if ($mode == REMOVE) {  # remove mode
    my $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;
  }
  # check if we accidentially remove pictures with a high rating
  if ($config{AskDeleteHighRating}) {
    return if preserve_high_rated_pics(\@sellist);
  }
  # check if some pics are used in slideshows
  return if preserve_slideshow_pics(\@sellist);
  my $errors = '';
  my $i = 0;
  my $pw;
  $pw = progressWinInit($lb, "Delete pictures") if (@sellist > 1);
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    my $pic      = basename($dpic);
    my $bakpic   = $dpic;
    $bakpic   =~ s/(.*)(\.jp(g|eg))/$1-bak$2/i;
    my $thumb    = getThumbFileName($dpic);
    my $bakthumb = $thumb;
    $bakthumb =~ s/(.*)(\.jp(g|eg))/$1-bak$2/i;
    progressWinUpdate($pw, "deleting ($i/".scalar @sellist.") ...", $i, scalar @sellist);
    if ($mode == REMOVE) {
      if ( removeFile($dpic) ) {
        $changed++;
        #delete $searchDB{$dpic}; # line is moved to removeFile()
        deleteCachedPics($dpic);
        delete_XMP_file($dpic);
        $lb->delete('entry', $dpic) unless $all;
      }
    } else { # $mode == TRASH - move picture to trash
      if (move($dpic, $trashdir)) {
        $changed++; # count nr of successfull moves
        my $tpic         = "$trashdir/$pic";
        # change the location info in the search database
        $searchDB{$tpic} = $searchDB{$dpic};
        $searchDB{$tpic}{odir} = dirname($dpic);
        delete $searchDB{$dpic};
        deleteCachedPics($dpic);
        $lb->delete('entry', $dpic) unless $all;
        # only if move was successfull, we also move the thumbnail
        if ((-d "$trashdir/$thumbdirname") and (-f $thumb)) {
          if (!move("$thumb", "$trashdir/$thumbdirname")) {
            $errors .= "Could not move thumbnail \"$thumb\" to $trashdir/$thumbdirname: $!\n";
          }
        }
        do_other_files($lb, MOVE, $dpic, $tpic, \$errors);
      } else {
        $errors .= "Could not move picture \"$pic\" to $trashdir: $!\n";
      }
    }
    # if file is removed and a backup file exists and is not in the delete list,
    # we offer to rename the backup to the original name
    # todo this should be done in one dialog for all files at the end
    if ((!-f $dpic) and (-f $bakpic) and !isInList($bakpic, \@sellist)) {
      my $age = getAgeOfFile($bakpic);
      $age = " (which is $age old)" unless ($age eq '');
      my $bakname = basename($bakpic);
      my $rc = myButtonDialog(lang('Restore backup?'),
                           langf("Picture \"%s\" has a backup file%s.\nShould I rename the backup \"%s\" to \"%s\"?", $pic, $age, $bakname, $pic),
                           $bakthumb,
                           lang('Rename'), lang('Cancel'), lang('Cancel all'));
      last if ($rc eq lang('Cancel all'));
      if ($rc eq lang('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));
            my $rating_size = get_rating_and_size($dpic, $lb);
            $lb->itemConfigure($dpic, $lb->{filecol}, -itemtype => 'image', -image => $rating_size, -style => $fileS);
          }
          else {
            $update++;
          }
        }
      }
    }
    if (!-f $dpic) {
      # ask to delete non-JPEG file, if any
      foreach my $suf (split /\|/, $nonJPEGsuffixes) {
        my $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 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);
  log_it(langf("Deleted %d of %d pictures", $changed, scalar(@sellist)));
  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");
    }
  }
  # select the picture after the last selected file
  select_next($lb, $select_after);
  $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 = (lang("days"),  lang("hours"), lang("minutes"));
  my $str = '';
  my $count = 0;
  for my $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 ".lang("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);
	     # todo: test this change!
	     if ($x1) {
		     $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;
		     log_it("Color picker: $config{ColorPicker}");
		     $colorPickerInfo->configure(-background => $config{ColorPicker});
		     $c->configure(-cursor => "crosshair");
	     }
           });
  $c->bind($id, '<Enter>'  => sub {
             $c->configure(-cursor => "crosshair");
           });
  $c->bind($id, '<Leave>'  => sub {
             $c->configure(-cursor => "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 $conf{show_coordinates}{value};
         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);
         my $right_border = $width  - $x;
         my $lower_border = $height - $y;
         log_it("coordinates: $x, $y (-$right_border, -$lower_border)");
       });
}

##############################################################
# changeDir
##############################################################
sub changeDir {
  my $newDir = shift;
  return 0 unless defined $newDir;
  if ( !chdir $newDir ) {
    my $dialog = $top->Dialog(-title => "Changing to $newDir folder failed",
                              -text => "Can't change to $newDir folder: $!",
                              -buttons => ['OK']);
    $dialog->Show();
    warn "Can't change to $newDir folder: $!";
    return 0;
  }
  return 1;
}

##############################################################
# getCorners - get the visible corners of an canvas
##############################################################
sub getCorners {
  my $c              = shift;
  my(@xview)         = $c->xview;
  my(@yview)         = $c->yview;
  my(@scrollregion)  = @{$c->cget(-scrollregion)};
  ($xview[0] * ($scrollregion[2]-$scrollregion[0]) + $scrollregion[0],
   $yview[0] * ($scrollregion[3]-$scrollregion[1]) + $scrollregion[1],
   $xview[1] * ($scrollregion[2]-$scrollregion[0]) + $scrollregion[0],
   $yview[1] * ($scrollregion[3]-$scrollregion[1]) + $scrollregion[1],
  );
}

##############################################################
# find best zoom and subsample value to fit or fill
# a picture into an available pixel area (e.g. canvas)
##############################################################
sub zoom_fit {
  my $dpic = shift;	# the picture including dir (e.g. /home/herrmann/pic001.jpg)
  my $w = shift;		# the available canvas width
  my $h = shift;		# the available canvas height
  my $zoom = 0;
  my $subsample = 0;
  my $string = '100%';
  if ((-f $dpic) and (defined $w) and (defined $h) and ($w > 1) and ($h > 1)) {
    my ($pic_w, $pic_h) = getSize($dpic);
    my $w_factor = $pic_w/($w - 6); # the offset (6) is needed, maybe because of the border?
    my $h_factor = $pic_h/($h - 6);
    my $max;
    if ( $conf{zoom_fit_fill}{value} == FIT) {
      $max = max($w_factor, $h_factor); # find the biggest zoom factor
    }
    else { # or FILL
      $max = min($w_factor, $h_factor); 
    }
    if ($max > 1) {
      # search for a zoom/subsample pair which will zoom the pic at least to the needed factor 1/$max
      my $i;
      for ($i = 0; $i < (@frac - 2); $i += 2) {
        if (($frac[$i]/$frac[$i+1]) < (1/$max)) {
          last;
        }
      }
      $zoom = $frac[$i];
      $subsample = $frac[$i+1];
      $string = int(1/($subsample/$zoom) * 100).'%';
    }
  }
  return ($zoom, $subsample, $string);
}

##############################################################
##############################################################
sub zoom_photo_object {
  my $photo = shift; # reference to a photo object
  my $zoom = shift;
  my $subsample = shift;
  if ($zoom != $subsample) { # if the values are the same there is nothing to do
    # open new photo object
    my $zoomed = $top->Photo;
    $zoomed->blank;
    # if $zoom is 1 we can skip the zoom step, else we should first zoom and then subsample.
    # This is slower, but delivers much better quality.
    # Tk::Photo seems to subsample first and zoom afterwards if -zoom and -subsamle is used
    # in one command which will produce ugly block artefacts
    if ($zoom == 1) {
      # this will speed up the zooming of some zoom facors (e.g. 16%, 20%, 25%, 50%) up to 10 times!!!
      $zoomed->copy($$photo, -subsample => $subsample); 
      $$photo->delete;
      $$photo = undef;
      $$photo = $top->Photo;
      $$photo->copy($zoomed); # then subsample it
    }
    else {
      # slower, but better quality
      $zoomed->copy($$photo, -zoom => $zoom); # first zoom pciture ...
      $$photo->delete;
      $$photo = undef;
      $$photo = $top->Photo;
      $$photo->copy($zoomed, -subsample => $subsample); # ... then subsample it
    }
    $$photo->configure(-gamma => $config{Gamma});
    $zoomed->delete;
    $zoomed = undef;
  }
  return 1;
}

##############################################################
# autozoom - zooms the given photo object to fit into the
# available pixel area
##############################################################
sub autoZoom {
  if (!$config{AutoZoom}) {
    return '100%';
  }
  my $photo     = shift;		# reference to a photo object
  my $dpic      = shift;		# the file including dir (e.g. /home/herrmann/pic001.jpg)
  my $cw        = shift;		# the available width
  my $ch        = shift;		# the available height
  my ($zoom, $subsample, $zoom_string) = zoom_fit($dpic, $cw, $ch);
  log_it(langf("zooming to %s ...", $zoom_string));
  zoom_photo_object($photo, $zoom, $subsample);
  return $zoom_string;
}

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

##############################################################
# 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;
  log_it(langf("zooming to %s ...", int($zoom/$subsample*100)."%"));
  $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}->delete;
  $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, (state=hidden it will be shown in showPic() later)
  my $id = $c->createImage($xoffset, $yoffset, -image => $photos{$dpic}, -anchor => 'nw', -tag => ['pic', $dpic], -state => 'hidden');
  bindItem($id);
  addToCachedPics($dpic);
  $top->Unbusy;
  showPic($dpic);
}

##############################################################
# zoom100 - zoom the actual pic to 100%
##############################################################
sub zoom100 {
  return if (!$actpic);
  log_it("loading ".basename($actpic)." ...");
  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
  return;
}

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

##############################################################
# layout - change the layout of mapivi main window
##############################################################
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 = lang("3 columns: Navigation Thumbnails Picture");
    $config{ShowNavFrame}    = 1;
    $config{ShowThumbFrame} = 1;
    $config{ShowPicFrame}   = 1;
  }
  elsif ($config{Layout} == 1) {
    $info = lang("2 columns: Navigation Thumbnails");
    $config{ShowNavFrame}    = 1;
    $config{ShowThumbFrame} = 1;
    $config{ShowPicFrame}   = 0;
  }
  elsif ($config{Layout} == 2) {
    $info = lang("1 column:  Thumbnails");
    $config{ShowNavFrame}    = 0;
    $config{ShowThumbFrame} = 1;
    $config{ShowPicFrame}   = 0;
  }
  elsif ($config{Layout} == 3) {
    $info = lang("2 columns: Thumbnails Picture");
    $config{ShowNavFrame}    = 0;
    $config{ShowThumbFrame} = 1;
    $config{ShowPicFrame}   = 1;
  }
  elsif ($config{Layout} == 4) {
    $info = lang("1 column:  Picture");
    $config{ShowNavFrame}    = 0;
    $config{ShowThumbFrame} = 0;
    $config{ShowPicFrame}   = 1;
  }
  elsif ($config{Layout} == 5) {
    $info = lang("2 columns: Navigation Picture");
    $config{ShowNavFrame}    = 1;
    $config{ShowThumbFrame} = 0;
    $config{ShowPicFrame}   = 1;
  }
  else {
    warn "error: toggle = ".$config{Layout}.", this should never happen!";
    $config{Layout} = 0;
    return;
  }
  if ($info ne '') { log_it(lang("Window layout")." ".$info); }
  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 nav=".$config{ShowNavFrame}." thumb=".$config{ShowThumbFrame}." pic=".$config{ShowPicFrame}."\n" if $verbose;
    $dirS->configure(-width => $dirXnew)   if ($dirS->ismapped());
    $thuS->configure(-width => $thumbXnew) if ($thuS->ismapped());
    $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 = getDateTimeShortString(time());
    # save a copy of the old config in the trash # todo: remove very old backups
    warn "saving a backup of the config in the trash ($trashdir)\n";
    mycopy($rcfile, $trashdir."/".basename($rcfile)."-$datetime", OVERWRITE);
  }
  return 1;
}

##############################################################
# saveConfig - save the configuration from hash to file
##############################################################
sub saveConfig {
  my $rcfile = shift;
  my $config = shift;
  my $value;
  print "saveConfig: writing $rcfile\n" if $verbose;
  my $file;
  if (!open($file, '>', $rcfile)) {
    warn "saveConfig: Couldn't open $rcfile: $!";
    return 0;
  }
  print $file "\n# Configuration file for mapivi $version\n\n";
  print $file "# last update: ", scalar localtime, "\n\n";
  print $file "# This file will be overwritten each time you quit mapivi\n";
  #print $file "# or call the \"Save config\" menu item.\n\n";
  foreach (sort keys %{$config}) {
    $value = $$config{$_};
    $value =~ s/\n/<br>/g; # replace newline by "<br>"
    print $file $_," = ", $value,"\n";
  }
  close $file;
  return 1;
}

##############################################################
# readArrayFromFile - read an array from a file
##############################################################
sub readArrayFromFile {

  my $file = shift;
  my @list;

  if (!$file) {
    warn "readArrayFromFile: no file!";   return;
  }

  return () if (!-f $file);

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

  while (<$fileH>) {
    chomp;						# no newline
    s/^#.*//;               	# no comments (lines starting with #)
    s/^\s+//;					# no leading white
    s/\s+$//;					# no trailing white
    next unless length;			# anything left?
    push @list, $_;
  }

  close $fileH;

  return @list;
}

##############################################################
# saveArrayToFile - save a array to a file
##############################################################
sub saveArrayToFile {

  my $file    = shift;
  my $listref = shift;
  my $value;

  my $fileH;
  if (!open($fileH, '>', $file)) {
    warn "saveArrayToFile: Couldn't open $file: $!";
    return 0;
  }

  foreach (@$listref) {
    print $fileH "$_\n";
  }

  close $fileH;
  return 1;
}

##############################################################
# showPicInOwnWin - displays a picture in a separate window
#                   a mouse click on the picture will close
#                   the window
##############################################################
sub showPicInOwnWin {

  my $dpic = shift;
  #if ((!defined $dpic) or ($dpic eq '') or (!-f $dpic)) {
    # no picture given, take selection from main window
   # my @sellist = $picLB->info('selection');
    #return unless checkSelection($top, 1, 0, \@sellist);
    #$dpic = $sellist[0]; # simply take the first if there are more selected
    #$lb = $picLB;
  #}
  return unless -f $dpic;
  my @list;
  push @list, $dpic;
  show_multiple_pics(\@list, 0);
}

##############################################################
# show_multiple_pics - displays several pictures in a separate
# window a mouse click on the picture will close the window
##############################################################
sub show_multiple_pics { 
  my $pic_list  = shift;  # reference to a picture list, each with full path
  my $index     = shift;  # start index number, first pic is index = 0
  my $start_fullscreen = shift; # optional, NORMAL or FULLSCREEN
  my $start_slideshow = shift; # optional, SHOW or NO_SHOW
  unless (defined $pic_list) { warn "pic list undef"; return; }
  unless (ref($pic_list) eq 'ARRAY') {warn "pic list is no array reference"; return; }
  if (@{$pic_list} < 1) {warn "pic list is empty"; return; }
  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 $canvasw = 0.8*$top->screenwidth;
  my $canvash = 0.8*$top->screenheight;
  my $rc = load_zoom_pic($dpic, \$photo, \$zoomFactor, $canvasw, $canvash);
  return unless ($rc);
  # open window
  my $win = $top->Toplevel(-bg => 'black');
  $win->{pic_list} = $pic_list;
  $win->{index}    = $index;
  $win->{photo}    = $photo;
  $win->{slideshow} = 0;
  $win->title(sprintf "(%d/%d) %s %s", ($index+1), scalar @{$pic_list}, $pic, $zoomFactor);
  $win->iconname($pic);
  # use the picture thumbnail as window icon
  my $iconfile  = getThumbFileName($dpic);
  $win->{iconPhoto} = $win->Photo(-file => $iconfile) if (-f $iconfile);
  $win->idletasks if $EvilOS; # this line is crucial (at least on windows)
  $win->iconimage($win->{iconPhoto}) if $win->{iconPhoto};
  $win->{canvas} = $win->Canvas(-width  => $canvasw, 
                    -height => $canvash,
                    -relief => 'sunken',
                    -bd     => $config{Borderwidth})->pack(-expand => 1, -side => 'top', -padx => 0, -pady => 0, -fill => 'both');
  # remove all default binding for the canvas (e.g. scroll with cursor and page up/down keys)
  $win->{canvas}->bindtags(undef);
  fullscreen($win) if (defined $start_fullscreen and $start_fullscreen == FULLSCREEN);
  # insert pic in canvas and center it
  my $xoffset = 0; my $yoffset = 0;
  $xoffset = int(($canvasw  - $win->{photo}->width) /2);
  $yoffset = int(($canvash - $win->{photo}->height)/2);
  $win->{canvas}->createImage($xoffset, $yoffset, -image => $win->{photo}, -tag => ['pic',$dpic], -anchor => 'nw');
  #canvas_center($win->{canvas}, $win->{photo}->width, $win->{photo}->height);

  $win->{balloonmsg} = makeBalloonMsg($dpic).$balloon_addon;
  if ($config{PicWinBalloon}) {
    $balloon->attach($win->{canvas}, -balloonposition => "mouse", -msg => \$win->{balloonmsg});
  }
  # show text and enlarge font size to fit window
  show_text_on_canvas($win->{canvas}, get_meta_micro($dpic));

  # the context menu
  my $menu = $win->Menu(-title => "Menu");
  $win->{menu} = $menu;
  $menu->checkbutton(-label => "Balloon popup info",
                     -variable => \$config{PicWinBalloon},
                     -command => sub {
                     if ($config{PicWinBalloon}) {
                       $balloon->attach($win->{canvas}, -balloonposition => "mouse", -msg => \$win->{balloonmsg});
                     } else {
                       $balloon->detach($win->{canvas});
                     }
                     });
  if (scalar(@{$pic_list}) > 1) {
    $menu->separator;
    $menu->command(-label => lang("Next picture"), -command => sub { next_prev_pic($win, 1); }, -accelerator => "<Space>");
    $menu->command(-label => lang("Previous picture"), -command => sub { next_prev_pic($win, -1); }, -accelerator => "<BackSpace>"); 
    $menu->separator;
    $menu->checkbutton(-label => lang('Slideshow'), -variable => \$win->{slideshow},
                      -command => sub { slideshow_pic($win); }, -accelerator => "<s>");
    $menu->checkbutton(-label => lang('Slideshow animation'), -variable => \$conf{animation}{value});
  }
  $menu->command(-label => lang('Fullscreen'), -command => sub { fullscreen($win); }, -accelerator => "<F11>");
  $menu->separator;
  $menu->command(-label => lang('Add to collection'), -command => sub {
      my $dpic = @{$win->{pic_list}}[$win->{index}];
      my @list;
      push @list, $dpic;
      light_table_add(\@list); });
  $menu->command(-label => lang('Open this folder'), -command => sub {
      my $dpic = @{$win->{pic_list}}[$win->{index}];
      my $dir = dirname($dpic);
      if (-d $dir) {
        openDirPost($dir) if ($dir ne $actdir);
        showPic($dpic); 
      } });   
  $menu->separator;
  
  # Warning: The Close menu entry must always be the last item to be called by $menu->invoke('last');
  $menu->command(-label => lang('Close'), -command => sub {
                             $win->{menu}->unpost(); # close menu
                             $win->{slideshow} = 0; # stop slideshow
                             $win->grabRelease();
                             $win->withdraw(); # close window
                             $win->{photo}->delete; # free photo memory
                             $win->{iconPhoto}->delete if $win->{iconPhoto};
                             $win->destroy();
                             }, -accelerator => '<ESC>');
  
  # mouse and button bindings
  $win->bind('<ButtonPress-3>', sub { $menu->Popup(-popover => 'cursor', -popanchor => 'nw'); } );
  $win->bind('<ButtonPress-2>', sub { $menu->invoke('last'); });
  $win->bind('<Key-q>',      sub { $menu->invoke('last'); });
  $win->bind('<Key-Escape>', sub { $menu->invoke('last'); });
  # invoke $win->{but} when the window is closed by the window manager (x-button)
  $win->protocol('WM_DELETE_WINDOW' => sub { $menu->invoke('last'); });
  # key-desc,F03,toggle overlay information (EXIF, IPTC, ...) 
  $win->bind('<Key-F3>', sub { toggle(\$conf{show_micro_meta}{value}); show_text_on_canvas($win->{canvas}, get_meta_micro(@{$win->{pic_list}}[$win->{index}]));} );
  # next picture keys
  foreach my $key ('<Key-Right>', '<Key-Down>', '<Key-space>', '<Key-Next>') {
    $win->bind($key, sub { $win->{slideshow} = 0; next_prev_pic($win, 1); });
  }
  # previous picture keys
  foreach my $key ('<Key-Left>', '<Key-Up>', '<Key-BackSpace>', '<Key-Prior>') {
    $win->bind($key, sub { $win->{slideshow} = 0; next_prev_pic($win, -1); });
  }
  # 10 pictures for/back
  $win->bind('<Shift-Next>',  sub { $win->{slideshow} = 0; next_prev_pic($win, 10); });
  $win->bind('<Shift-Prior>', sub { $win->{slideshow} = 0; next_prev_pic($win, -10); });
  
  # keys End and Pos1 to jump to first and last pic
  $win->bind('<Key-End>',  sub { $win->{slideshow} = 0; next_prev_pic($win, (scalar(@{$win->{pic_list}})-$win->{index}-1)); });
  $win->bind('<Key-Home>', sub { $win->{slideshow} = 0; next_prev_pic($win, -1*$win->{index}); });
  
  # s - start / stop slideshow
  $win->bind('<Key-s>', sub {
    return if (scalar(@{$pic_list}) <= 1);
    toggle(\$win->{slideshow});
    slideshow_pic($win);
  });
  # faster / slower slideshow
  $win->bind('<Key-minus>',  sub {
     if ($win->{slideshow}) {
       $config{SlideShowTime}-- if ($config{SlideShowTime} >= 1);
       info_window($win, $config{SlideShowTime}." ".lang("second(s)")); 
       log_it("slideshow time: ".$config{SlideShowTime}." sec");
     }
   } );
  # key-desc,+,zoom in or slideshow slower
  $win->bind('<Key-plus>',   sub {
     if ($win->{slideshow}) {
       $config{SlideShowTime}++ if ($config{SlideShowTime} < 300);
       info_window($win, $config{SlideShowTime}." ".lang("second(s)")); 
       log_it("slideshow time: ".$config{SlideShowTime}." sec"); 
     }
   });
  # bind mousewheel
  if ($Tk::VERSION >= 804) {
    if ($^O eq 'MSWin32')
    {
      $win->bind('<MouseWheel>' =>
      [ sub { if ($_[1] < 0) {next_prev_pic($win, 1);} else {next_prev_pic($win, -1);}  },
      Ev('D') ]);
    }
    else
    {
      $win->bind('<4>' => sub {
        next_prev_pic($win, -1) unless $Tk::strictMotif;
      });
      $win->bind('<5>' => sub {
        next_prev_pic($win, 1) unless $Tk::strictMotif;
      });
    }
  }  
# key-desc,F11,toggle fullscreen mode when displaying picture in own window
  $win->bind('<Key-F11>', sub { fullscreen($win);});
  $win->{canvas}->focusForce if (Exists($win->{canvas}));
  if (defined $start_slideshow and $start_slideshow == SHOW) {
    $win->{slideshow} = 1;
    slideshow_pic($win);
  }
  log_it(lang('Ready!'));
}

##############################################################
# slideshow_pic: slideshow all pics, to be used in sub show_multiple_pics()
##############################################################
sub slideshow_pic {
  my $win = shift;
  return unless $win;
  my $last_time;
  info_window($win, lang("Slideshow Start")) if ($win->{slideshow});
  until ($win->{slideshow} == 0) {
    return unless $win;
    if (!defined $last_time || Tk::timeofday()-$last_time > $config{SlideShowTime}) {
      next_prev_pic($win, 1);
      $last_time = Tk::timeofday();
    }
    DoOneEvent(); # stay responsive
    last if (!$win->{slideshow});
  }
  info_window($win, lang("Slideshow End")) if (not $win->{slideshow});
}

##############################################################
# next_prev_pic: switch to next or previous pic in list, to be used in sub show_multiple_pics()
##############################################################
sub next_prev_pic {
  my $win  = shift;
  my $step = shift; # int: e.g. 1 for next pic or -1 for previous pic, but 10 or 100 are also valid
  return if ($step == 0); # no need to do anything
  my $total_pics = scalar @{$win->{pic_list}};
  return if ($total_pics <= 1);
  return unless $win;
  return unless $win->{canvas};
  $win->{canvas}->Busy; # we can't use $win here else the cursor won't change
  $win->{index} += $step;
  # underflow - go back to last pic
  $win->{index} = $total_pics - 1 if ($win->{index} < 0);
  # overflow - go back to first pic
  $win->{index} = 0 if ($win->{index} > $total_pics - 1);
  my $dpic = @{$win->{pic_list}}[$win->{index}];
  my $pic  = basename($dpic);
  $win->title(sprintf "(%d/%d) loading %s ...", ($win->{index}+1), $total_pics, $pic);
  $win->update();
  my $zoomFactor;
  # store actual photo object to release memory later
  my $photo_last = $win->{photo};
  my @photo_last_ids = $win->{canvas}->find('withtag', 'pic');
  my $photo_last_id = $photo_last_ids[0];

  my $rc = load_zoom_pic($dpic, \$win->{photo}, \$zoomFactor, $win->{canvas}->width, $win->{canvas}->height);
  # close window on error
  $win->{menu}->Invoke('last') unless ($rc);
  $win->title(sprintf "(%d/%d) %s %s", ($win->{index}+1), $total_pics, $pic, $zoomFactor);#, $slideshow);
  
  # update icon
  $win->iconname($pic);

  # insert new pic in canvas and center it
  my $x_to = 0; my $y_to = 0;
  $x_to = int(($win->{canvas}->width  - $win->{photo}->width) /2);
  $y_to = int(($win->{canvas}->height - $win->{photo}->height)/2);
  my $x_from = $x_to;
  # forward animation from bottom to center
  my $y_from = $win->{canvas}->height;
  # backward animation from top to center  
  $y_from = 0 - $win->{photo}->height if ($step < 0);
  # no animation -> place picture in target position
  $y_from = $y_to if (not $conf{animation}{value}); 
  # load picture on canvas
  my $photo_id = $win->{canvas}->createImage($x_from, $y_from, -image => $win->{photo}, -tag => ['pic',$dpic], -anchor => 'nw');
  # move picture if animation is selected
  if ($conf{animation}{value}) {
    move_items_on_canvas($win->{canvas}, $photo_id, $photo_last_id, $x_from, $y_from, $x_to, $y_to);
  }
  # remove last picture
  $win->{canvas}->delete($photo_last_id);
  # free memory of last photo object
  $photo_last->delete if (defined $photo_last);
  # show picture meta info (EXIF, IPTC, ...)
  show_text_on_canvas($win->{canvas}, get_meta_micro($dpic));
  $win->{balloonmsg} = makeBalloonMsg($dpic);
  $win->{canvas}->Unbusy;
  return;
}  

##############################################################
# move two items (works at least for images) synchonous 
# on a canvas from a start to an end position in some steps
# the coordinates belong to the first item
##############################################################
sub move_items_on_canvas {
  my $canvas = shift;
  my $item = shift; # ID of canvas item
  my $item2 = shift; # ID of canvas item
  my ($x_from, $y_from, $x_to, $y_to) = @_;
  my $steps = $conf{animation_steps}{value}; # animation in n steps
  my $x_step = ($x_from - $x_to)/$steps;
  my $y_step = ($y_from - $y_to)/$steps;
  $canvas->Busy;
  my $starttime = Tk::timeofday();
  for my $step (1 .. $steps) {
    my ($x1, $y1) = $canvas->coords($item);
    $canvas->coords($item, $x1-$x_step, $y1-$y_step);
    my ($x2, $y2) = $canvas->coords($item2);
    $canvas->coords($item2, $x2-$x_step, $y2-$y_step);
    # hint: $canvas->move does not work here
    $canvas->update;
  }
  $canvas->Unbusy;
  my $duration = Tk::timeofday() - $starttime;
  print "duration = $duration\n" if $verbose;
  if ($duration < 0.7*$conf{animation_duration}{value} or $duration > 1.3*$conf{animation_duration}{value}) {
    print "adapting steps from $steps " if $verbose;
    $steps = round($conf{animation_duration}{value}/$duration*$steps) if ($duration > 0);
    # some safety borders
    $steps = 1 if ($steps < 1);
    $steps = 200 if ($steps > 200);    
    print "to $steps\n" if $verbose;
    $conf{animation_steps}{value} = $steps;
  }
  return;
}

##############################################################
# 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)
    my $w = shift; # picture target width
    my $h = shift; # picture target height
    if (!-f $dpic) {
    #$top->messageBox(-icon => 'warning', -message => "load_zoom_pic: Error no file $dpic",
     #                -title => 'Error', -type => 'OK');
    log_it("Error no file: $dpic!");
    return 0;
  }
  log_it("opening $dpic in new window ...");
  $$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');
    log_it("Error no photo: $dpic!");
    return 0;
  }
  increasePicPopularity($dpic);
  if ($config{trackPopularity}) {
    updateOneRow($dpic, $picLB); # update popularity (viewed x times) info
    $picLB->update;
  }
  $$zoomFactor = autoZoom(\$$photo, $dpic, $w, $h);
  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) {
    log_it("$title: no pictures");
    return;
  }
  my $nr = @$thumbs;  # total number
  log_it("displaying $nr thumbs in new window ...");
  #stopWatchStart();
  # open window
  my $win = $top->Toplevel(-bg => "black");
  $win->withdraw;
  $win->title("$title - $nr pictures");
  # set the icon
  $win->iconname("Pictures");
  $win->iconimage($mapiviicon) if $mapiviicon;
  my $topFrame = $win->Frame()->pack(-fill => 'both');
  my %tphotos;      # local hash to store the thumbnail photo objects
  $topFrame->Button(-text => "Close",
                    -command => sub { cleanUpAndClose($win, \%tphotos); })->pack(-side => 'left');
  $win->{label} = "$nr pictures, 0 selected";
  $topFrame->Label(-textvariable => \$win->{label})->pack(-side => 'left');
  my $cols    = 6;
  $cols    = $nr if ($nr < $cols);
  my $maxrows = int($win->screenheight/($config{ThumbSize} + 20));
  # todo for 10 pics there should be 2 rows but the window is not high enough
  my $rows    = int($nr/$cols) + 1;
  $rows    = $maxrows if ($rows > $maxrows);
  print "tiler: nr:$nr col:$cols row:$rows maxrows:$maxrows\n" if $verbose;
  my $tiler = $win->Scrolled("Tiler",
                             -columns    => $cols,
                             -rows       => $rows,
                             -scrollbars => 'oe',
                           )->pack(-fill => 'both', -expand => 1);
  # 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
  # todo: check if open_pic_in_main() could be used here too
  $menu->command(-label => "open picture in main window", -accelerator => '<m>', -command => sub {
                   my @sel;
                   # get the selection
                   foreach (@a) { push @sel, $_->{dpic} if $_->{selected}; }
                                   return unless checkSelection($win, 1, 1, \@sel);
                   my $dpic = $sel[0];
                   my $dir  = dirname($dpic);
                   my $pic  =  basename($dpic);
                   if (!-d $dir) {
                     $win->messageBox(-icon => 'warning', -message => "Sorry, but the folder\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.",
                                      -title => 'folder not found', -type => 'OK');
                     return;
                   }
                   $top->deiconify;
                   $top->raise;
                   $top->focus;
                   openDirPost($dir) if ($dir ne $actdir);
                   showPic($dpic);
                 });


  ############# add to collection (light table)
  $menu->command(-label => lang("Add to collection"), -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 $pw = progressWinInit($win, "copy pictures");
                   my $i  = 0;
                   my $overwrite = OVERWRITE;
                   my $n  = 0;					# count successfull copied pictures
                   foreach my $dpic (@sel) {
                     last if progressWinCheck($pw);
                     my $pic       = basename($dpic);
                     $i++;
                     progressWinUpdate($pw, "copy picture ($i/".scalar @sel.") ...", $i, scalar @sel);
                     my $tpic      = "$targetdir/$pic";
                     # if the pic exists, ask if the user wants to overwrite it
                     $overwrite = overwritePic($tpic, $dpic, (scalar(@sel) - $i + 1)) if ($overwrite != OVERWRITEALL);
                     next if ($overwrite == CANCEL);
                     last if ($overwrite == CANCELALL);
                     if (mycopy($dpic, $tpic, OVERWRITE)) {
                       $n++;
                       my $thumbpic  = getThumbFileName($dpic);
                       my $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} = $mapivi_icons{'EmptyThumb'};
      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");
  log_it(lang('Ready!'));
}

##############################################################
# cleanUpAndClose - for showThumbList
##############################################################
sub cleanUpAndClose {
  my $win = shift;
  my $hashref = shift;
  $win->withdraw;
  foreach (keys %{$hashref}) {
    delete_photo_object($$hashref{$_});  
  }
  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);
  }
  log_it("deleted $deleted pictures");

  # 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       = date_iso_to_relative(getShortEXIF($dpic, NO_WRAP));
  if ($exif ne '') {
      $exif = formatString($exif, 80, -1);
      $exif = "\nEXIF: ".$exif;
  }
  my $iptc       = getIPTC($dpic, SHORT);
  $iptc = formatString($iptc, 80, -1);  # needed for many joined keywords
  if ($iptc ne '') {
    $iptc = "\n\n".$iptc; # if IPTC is not empty, add a little distance
  }
  my $comment = getComment($dpic, LONG);
  # show only the first 800 chars of the comment, else the balloon box is too full
  $comment = cutString($comment, 797, "...");
  $comment = formatString($comment, 80, -1);
  if ($comment ne '') {
    $comment = "\n\n".$comment; # if comment is not empty, add a little distance
  }
  if (-l $dpic) {
    $linktarget  = "\nLink: links to: ".readlink($dpic);
  }
  return "File: $pic\nDir:  $dir\nSize: $fsize (${w}x$h)\nDate: $fdate $linktarget$exif$iptc$comment";
}

##############################################################
##############################################################
sub options_edit {
  my @add_colors;
  push @add_colors, $config{ColorPicker};
  configuration_edit($top,
                    \%conf,
                    \@conf_tab_order,
                    undef, # apply-button callback
                    sub{configuration_set_default()}, # reset options button callback
                    \@add_colors,
                    $conf{color_entry}{value},
                    $mapiviicon);
}

##############################################################
# 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 => $conf{color_bg}{value}, # background of active page (including its tab)
                  -inactivebackground => $conf{color_entry}{value}, # tabs of inactive pages
                  -backpagecolor => $conf{color_bg}{value}, # background behind notebook
                 )->pack(-expand => 1,
                         -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 $langF = $aF->Frame()->pack(-anchor => 'w', -fill => 'x');  
  $langF->Label(-text => 'Language (needs restart) ')->pack(-side => 'left', -anchor => 'w');
  my @lang = languages_find($lang_path);
  # add english to the top of the list
  unshift @lang, 'en';
  $langF->Optionmenu(-variable => \$tmpconf{Language},
                     -options => \@lang)->pack(-side => 'left', -anchor => 'w');
  
  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.");
  $aF->Checkbutton(-variable => \$tmpconf{ShowHiddenDirs},
                   -text => 'Show hidden folders (starting with a dot ".")')->pack(-anchor => 'w');
  $aF->Checkbutton(-variable => \$tmpconf{AskGenerateThumb}, -text =>
                   "Ask before generating thumbnails")->pack(-anchor => 'w');
  $aF->Checkbutton(-variable => \$tmpconf{AskDeleteThumb}, -text =>
                   "Ask before deleting thumbnails")->pack(-anchor => 'w');
  $aF->Checkbutton(-variable => \$tmpconf{AskMakeDir},
                   -text => "Ask before making a folder (e.g. $thumbdirname)")->pack(-anchor => 'w');
  $aF->Checkbutton(-variable => \$tmpconf{WarnBeforeResize},
                   -text => "Warn me before using change size/quality")->pack(-anchor => 'w');
  my $cfnjB =
    $aF->Checkbutton(-variable => \$tmpconf{CheckForNonJPEGs},
                     -text => "Check for non-JPEG pictures")->pack(-anchor => 'w');
  $balloon->attach($cfnjB, -msg =>
                   "If this is enabled and there are some non-JPEGs
Mapivi will ask the user if they should be converted
to JPEGs. After the conversion the images can be
displayed by Mapivi. The originals (non-JPEGs) may
be left untouched or deleted.");
  $aF->Checkbutton(-variable => \$tmpconf{BitsPixel}, -text =>
                   "Calculate and show picture compression in bit per pixel")->pack(-anchor => 'w');
  $aF->Checkbutton(-variable => \$tmpconf{AspectRatio}, -text =>
                   "Calculate and show image aspect ratio (e.g. 4:3 or 3:2)")->pack(-anchor => 'w');
  $aF->Checkbutton(-variable => \$tmpconf{ShowFileDate}, -text =>
                   "Show file date in the size column")->pack(-anchor => 'w');
  $aF->Checkbutton(-variable => \$tmpconf{RenameBackup}, -text =>
                   "Rename backup file, if the file is renamed")->pack(-anchor => 'w');
  $aF->Checkbutton(-variable => \$tmpconf{WAV_file_operations}, -text =>
                   "WAV audio files follow picture file operations (copy, move, rename, delete *.wav file)")->pack(-anchor => 'w');
  $aF->Checkbutton(-variable => \$tmpconf{XMP_file_operations}, -text =>
                   "XMP sidecar files follow picture file operations (copy, move, rename, delete *.xmp file)")->pack(-anchor => 'w');
  $aF->Checkbutton(-variable => \$tmpconf{RAW_file_operations}, -text =>
                   "RAW (nef, crw, cr2) files follow picture file operations (copy, move, rename, delete *.nef, *.crw or *.cr2 file)")->pack(-anchor => 'w');

  my $trb = 
    $aF->Checkbutton(-variable => \$tmpconf{jpegtranTrim},
                     -text => "use the -trim switch when doing lossless rotation")->pack(-anchor => 'w');
  $balloon->attach($trb, -msg =>
                   "The rotation operates rather oddly if the image dimensions are not a
multiple of the iMCU size (usually 8 or 16 pixels), because they can
only transform complete blocks in the desired way. jpegtran's default
behavior when transforming an odd-size image is designed to preserve
exact reversibility and mathematical consistency of the transformation
set.
For practical use, you may prefer to discard any untransformable
edge pixels using the -trim switch rather than having a
strange-looking strip along the right and/or bottom edges of a
transformed image.");

  $aF->Checkbutton(-variable => \$tmpconf{AskDeleteHighRating}, -text =>
                   "Ask before deleting pictures with a high rating (see also below)")->pack(-anchor => 'w');
  my $aFadhr = labeledScale($aF, 'top', $w, "Ask before deleting with this rating", \$tmpconf{AskDeleteHighRatingLevel}, 1, 7, 1);
  $balloon->attach($aFadhr, -msg => 'Mapivi will ask before pictures with a high rating are deleted.
The function may be activated using the checkbutton above.
Please adjust the rating interval using this slider.
Example: With a value of 3 Mapivi will ask for a confirmation
         before deleting pictures with a rating of 1, 2 or 3.');

  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, "Number of displayed thumbnails", \$tmpconf{ThumbMaxLimit}, 10, 10000, 10);

  $balloon->attach($aFtp, -msg => "If more pictures than this limit have to be displayed\nMapivi will ask how to proceed."); 

  my $aFst = labeledScale($aF, 'top', $w, "Maximum size of trash (MB)", \$tmpconf{MaxTrashSize}, 1, 1000, 100);
  $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 $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 $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 $prefix = thumbnail_prefix(\%tmpconf);
                        my $com = thumbnail_postfix($prefix, $thumbExample, $thumb);
                        execute($com);
                        if (-f $thumb) {
                          my $prev = $top->Photo(-file => $thumb, -gamma => $config{Gamma});
                          $previewB->configure(-image => $prev) if $prev;
                        }
                      })->pack();
      $balloon->attach($previewB, -msg => "Press here to update the thumbnail\nwith the choosen options");
    }
  }

  $previewB->Invoke if (Exists($previewB));

  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, lang("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 status bar on the upper side")->pack(-anchor => 'w');
  $cF->Checkbutton(-variable => \$tmpconf{ShowNavFrame},
                             -text => "Show navigation frame 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 $aFc =	$cF->Checkbutton(-variable => \$tmpconf{ShowCommentField},
                             -text => "Display comment info in picture view")->pack(-anchor => 'w');
  $balloon->attach($aFc, -msg => "show/hide the textfield containing the picture comments\nand the buttons to add, edit and remove a comment.\nThis field is usually located above the actual picture");

  my $aFic = $cF->Checkbutton(-variable => \$tmpconf{ShowIPTCFrame},
                             -text => "Display IPTC box in picture view")->pack(-anchor => 'w');
  $balloon->attach($aFic, -msg => "show/hide the box containing the picture IPTC headline and caption\nand a button to store it.\nThis field is usually located above the actual picture");

  my $aFp =	$cF->Checkbutton(-variable => \$tmpconf{ShowPicInfo},
                             -text => "Show picture info as a balloon on the actual picture")->pack(-anchor => 'w');
  $balloon->attach($aFp, -msg => "if this is enabled and you move and hold your mouse pointer\nover the actual picture (right frame of the main window)\na balloon info box (with EXIF, comment, size, ...) will appear");

  my $aIc =	$cF->Checkbutton(-variable => \$tmpconf{ShowInfoInCanvas},
                             -text => "Overlay 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{ShowCoordinates},
  #                 -text => "Display the coordinates of the mouse cursor in the status bar")->pack(-anchor => 'w');

  my $fontF = $cF->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  $balloon->attach($fontF, -msg => "Font for the main window and nearly all dialogs.\nIt's recommeded to choose a fixed font.");
  my $fontL = $fontF->Label(-text => "Font family: ", -bg => $conf{color_bg}{value})->pack(-side => 'left');
  $fontF->Label(-textvariable => \$tmpconf{FontFamily}, -bg => $conf{color_bg}{value})->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 => $conf{color_bg}{value})->pack(-side => 'left');
  $fontF->Scale(
             -variable => \$tmpconf{FontSize},
             -from => 5,
             -to => 20,
             -resolution => 1,
             -sliderlength => 30,
             -orient => 'horizontal',
             -showvalue => 0,
             -width => 15,
             -bd => $config{Borderwidth},
             -command => sub {
                     $ow->Busy;
                     my $font = $top->Font(-family => $tmpconf{FontFamily},
                                           -size   => $tmpconf{FontSize});
                     $fontL->configure(-font => $font);
                     $fontL->update();
                     $ow->Unbusy;
                     })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  $fontF->Label(-textvariable => \$tmpconf{FontSize})->pack(-side => 'left');

  my $propFontF = $cF->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  $balloon->attach($propFontF, -msg => "Please choose a propotional font here which is available in different sizes.\nIt will be used in the keyword browser (tag cloud).");
  my $propFontL = $propFontF->Label(-text => "Proportional font family: ", -bg => $conf{color_bg}{value})->pack(-side => 'left');
  $propFontF->Label(-textvariable => \$tmpconf{PropFontFamily}, -bg => $conf{color_bg}{value})->pack(-side => 'left');

  $propFontF->Button(-text => 'Set',
                 -command => sub {
                    my $font = $tmpconf{PropFontFamily};
                    my $rc = myFontDialog($ow, 'Select font family', \$font, $tmpconf{PropFontSize});
                    return unless $rc;
                    $tmpconf{PropFontFamily} = $font;
                    $ow->Busy;
                    my $font2 = $top->Font(-family => $tmpconf{PropFontFamily},
                                          -size   => $tmpconf{PropFontSize});
                    $propFontL->configure(-font => $font2);
                    $propFontL->update();
                    $ow->Unbusy;
                })->pack(-side => 'left');

  $propFontF->Label(-text => " Font size: ", -bg => $conf{color_bg}{value})->pack(-side => 'left');
  $propFontF->Scale(
             -variable => \$tmpconf{PropFontSize},
             -from => 5,
             -to => 30,
             -resolution => 1,
             -sliderlength => 30,
             -orient => 'horizontal',
             -showvalue => 0,
             -width => 15,
             -bd => $config{Borderwidth},
             -command => sub {
                     $ow->Busy;
                     my $font = $top->Font(-family => $tmpconf{PropFontFamily},
                                           -size   => $tmpconf{PropFontSize});
                     $propFontL->configure(-font => $font);
                     $propFontL->update();
                     $ow->Unbusy;
                     })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  $propFontF->Label(-textvariable => \$tmpconf{PropFontSize})->pack(-side => 'left');


  my $tfontF = $cF->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  my $tfontL = $tfontF->Label(-text => "Thumbnail font size:", -bg => $conf{color_bg}{value})->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{ColorFG}       = "black";
$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{ColorFG}       = "black";
$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{ColorFG}       = "black";
$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{ColorFG}       = "black";
$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{ColorFG}       = "black";
$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');

$presets->Button(-text => 'dark room',
                  -command => sub {
$tmpconf{ColorBG}       = "gray30";
$tmpconf{ColorFG}       = "gray85";
$tmpconf{ColorMenuBG}   = "gray40";
$tmpconf{ColorMenuFG}   = "gray90";
$tmpconf{ColorBG2}      = "gray30";
$tmpconf{ColorBGCanvas} = "gray30";
$tmpconf{ColorHlBG}     = "gray60";
$tmpconf{ColorActBG}    = "gray60";
$tmpconf{ColorEntry}    = "gray60";
$tmpconf{ColorSel}      = "gray40";
$tmpconf{ColorSelBut}   = "red4";
$tmpconf{ColorSelFG}    = "gray85";
$tmpconf{ColorName}     = "gray85";
$tmpconf{ColorComm}     = "gray85";
$tmpconf{ColorIPTC}     = "gray85";
$tmpconf{ColorEXIF}     = "gray85";
$tmpconf{ColorFile}     = "gray85";
$tmpconf{ColorDir}      = "gray85";
$tmpconf{ColorThumbBG}  = "gray60";
                  })->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,"Foreground color: progress bar",'Set',\$tmpconf{ColorProgress});
  labeledEntryColor($eF,'top',$w,"Font color: keyword cloud",'Set',\$tmpconf{ColorCloud});
  #labeledEntryColor($eF,'top',$w,"Font color",'Set',\$tmpconf{ColorFG});
  #labeledEntryColor($eF,'top',$w,"Font color: menu",'Set',\$tmpconf{ColorMenuFG});
  labeledEntryColor($eF,'top',$w,"Font color: name",'Set',\$tmpconf{ColorName});
  labeledEntryColor($eF,'top',$w,"Font color: comment",'Set',\$tmpconf{ColorComm});
  labeledEntryColor($eF,'top',$w,"Font color: IPTC",'Set',\$tmpconf{ColorIPTC});
  labeledEntryColor($eF,'top',$w,"Font color: EXIF",'Set',\$tmpconf{ColorEXIF});
  labeledEntryColor($eF,'top',$w,"Font color: size",'Set',\$tmpconf{ColorFile});
  labeledEntryColor($eF,'top',$w,"Font color: folder",'Set',\$tmpconf{ColorDir});

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

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

  my $trackB =
  $dF->Checkbutton(-variable => \$tmpconf{trackPopularity},
                   -text => "Track popularity of pictures (how often viewed in Mapivi)")->pack(-anchor => 'w');
  $balloon->attach($trackB, -msg => "If this is enabled Mapivi will increase a counter\neverytime a picture is viewed with Mapivi.\nThe counter value is not saved in the picture\njust in the Mapivi database.");

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

  #my $addMapB = 
  #$dF->Checkbutton(-variable => \$tmpconf{AddMapiviComment},
  #                 -text => "add a comment to pictures created/processed by mapivi")->pack(-anchor => 'w');
  #$balloon->attach($addMapB, -msg => "If this is enabled Mapivi will add a JPEG comment\nto each created or processed picture.");

  $dF->Checkbutton(-variable => \$tmpconf{EXIFshowApp},
                   -text => "show App*-Info and MakerNotes and ColorComponents in EXIF info")->pack(-anchor => 'w');

  my $ctcb =
  $dF->Checkbutton(-variable => \$tmpconf{CenterThumb},
                   -text => "center selected thumbnail")->pack(-anchor => 'w');
  $balloon->attach($ctcb, -msg => "center the selected thumbnail,\nto show at least the next\nand the previous thumbnail");

  $dF->Checkbutton(-variable => \$tmpconf{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 ($thumbDB),\nif disabled thumbnails will be stored\ndecentral in sub folders (.thumbs).");

  my $tbb =
  $dF->Checkbutton(-variable => \$tmpconf{ToggleBorder},
                   -text => "Remove the window border in fullscreen mode (experimental)")->pack(-anchor => 'w');
  $balloon->attach($tbb, -msg => "Enable a real fullscreen mode,\nbut may not work as expected on all\noperating systems and window managers.\nTry it, switch to fullscreen (key: F11),\nif it works it's fine, if not just disable it again.");

  my $fblfb =
  $dF->Checkbutton(-variable => \$tmpconf{SlowButMoreFeatures},
                   -text => "enable some time intensive features (needs restart)")->pack(-anchor => 'w');
  $balloon->attach($fblfb, -msg => "If this is selected, you will get e.g. some\nmore zoom levels.\nThis may slow down Mapivi a bit, so this option\nis only recommended for faster computers.");

  $dF->Checkbutton(-variable => \$tmpconf{CheckNewKeywords},
                   -text => "Check for new keywords and ask to add them to my catalog")->pack(-anchor => 'w');

  $dF->Checkbutton(-variable => \$tmpconf{UrgencyChangeWarning},
                   -text => "Show a warning when a rating/urgency has been changed")->pack(-anchor => 'w');

  $dF->Checkbutton(-variable => \$tmpconf{AutoImport},
                   -text => "Start import wizard at Mapivi startup if source folder is available")->pack(-anchor => 'w');

  $dF->Checkbutton(-variable => \$tmpconf{SelectLastPic},
                   -text => "Select last shown picture after Mapivi startup")->pack(-anchor => 'w');

  my $opfb = $dF->Checkbutton(-variable => \$tmpconf{supportOtherPictureFormats},
                   -text => "Show also other picture formats than just JPEG. Danger! (experimental feature)")->pack(-anchor => 'w');
  $balloon->attach($opfb, -msg => "If this is selected, Mapivi will also show other picture formats (e.g. GIF and PNG),\nat least as thumbnails. But adding IPTC and other meta information is not possible.\nThis feature is not tested, so use it on your own risk.");

  my $aspS = labeledScale($dF, 'top', $w, "Delta factor for aspect ratio (%)", \$tmpconf{AspectSloppyFactor}, 0, 5, 0.1);
  $balloon->attach($aspS, -msg => "Adjust the accuracy of the aspect ratio display (rightmost column size).\nThis is the delta factor in percent when calculating the aspect ratio.\nFor example a picture with size 304x200 will still be displayed as a 3:2 picture,\nif the factor is equal or bigger than 1.4%.\nUse 0.0% if you need really exact values.\n3.0% is acceptable for me.");

  labeledScale($dF, 'top', $w, "preview size in filter dialog (pixel)", \$tmpconf{FilterPrevSize}, 50, 500, 5);
  labeledScale($dF, 'top', $w, "Comment text box height (lines)", \$tmpconf{CommentHeight}, 1, 50, 1);
  labeledScale($dF, 'top', $w, "Gamma value, when displaying pictures", \$tmpconf{Gamma}, 0.1, 10.0, 0.01);
  labeledScale($dF, 'top', $w, "Maximum number of lines of a IPTC info/comment", \$tmpconf{LineLimit}, 1, 20, 1);
  labeledScale($dF, 'top', $w, "Maximum length of a comment line", \$tmpconf{LineLength}, 5, 80, 1);

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

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

  my $OKB = $butF->Button(-text => lang('OK'),
                -command => sub {
                  %config = %{ dclone(\%tmpconf) };
                  applyConfig();
                  $example->delete if $example;
                  $config{OptionsLastPad} = $notebook->raised();
                  $ow->destroy();
                }
               )->pack(-side=>'left', -expand => 1, -fill =>'x');

  # bind ctrl-x to OK button
  $ow->bind('<Control-x>', sub { $OKB->Invoke; });

  $butF->Button(-text => lang('Apply'),
                -command => sub {
                  %config = %{ dclone(\%tmpconf) };
                  $previewB->Invoke() if (Exists($previewB));
                  applyConfig();
                }
               )->pack(-side=>'left', -expand => 1, -fill =>'x');

  my $Xbut = $butF->Button(-text => lang('Cancel'),
                           -command => sub {
                             $example->delete if $example;
                             $config{OptionsLastPad} = $notebook->raised();
                             $ow->destroy();
                           }
                          )->pack(-side=>'left', -expand => 1, -fill =>'x');
  bind_exit_keys_to_button($ow, $Xbut);
  $ow->Popup;
}

##############################################################
# applyConfig
##############################################################
sub applyConfig {
  language_load($config{Language});
  $progressBar->configure(-blocks => $config{MaxProcs},
                          -to     => $config{MaxProcs});
  $dirtree->configure(-showhidden => $config{ShowHiddenDirs});
  $comS->configure( -foreground=>$config{ColorComm}, -background=>$conf{color_bg2}{value});
  $iptcS->configure(-foreground=>$config{ColorIPTC}, -background=>$conf{color_bg}{value});
  $exifS->configure(-foreground=>$config{ColorEXIF}, -background=>$conf{color_bg2}{value});
  $fileS->configure(-foreground=>$config{ColorFile}, -background=>$conf{color_bg}{value});
  $dirS->configure( -foreground=>$config{ColorDir},  -background=>$conf{color_bg2}{value});
  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 => $conf{color_bg}{value});
  # we don't try to color everything, just a few widgets to give a visual feedback
  $top->configure    (-bg => $conf{color_bg}{value});
  $dirtree->configure(-bg => $conf{color_bg}{value},
                      -selectbackground => $config{ColorSel});
  $c->configure      (-bg => $conf{color_bg_canvas}{value});
  $menubar->configure(-bg => $conf{color_bg}{value});
  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 => $conf{color_bg}{value});
    }
  }
  # don't know if this is very appropriate
  $top->optionAdd('*selectBackground',    $config{ColorSel},   'userDefault');
  $top->optionAdd("*highlightColor",      $config{ColorSel},   'userDefault');
  $top->optionAdd("*highlightBackground", $conf{color_hl_bg}{value},  'userDefault');
  $top->optionAdd("*background",          $conf{color_bg}{value},    'userDefault');
  $top->optionAdd("*activeBackground",    $conf{color_act_bg}{value}, '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();
}

##############################################################
# 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, $iptcF, $comF, $mainF, $thumbA, $thumbF, $dirA, $nav_F, $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{ShowNavFrame}) {
    $nav_F->pack(-side => 'left', -anchor=>'w', -padx => 0, -pady => 0, -expand => 1, -fill => 'both');
    $dirA->packAfter($nav_F, -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{ShowCommentField}) {
    $comF->pack(-fill => 'x',-expand => 1, -anchor=>'w', -padx => 0, -pady => 0) ;
  }
  if ($config{ShowIPTCFrame}) {
    $iptcF->pack(-fill => 'x',-expand => 1, -anchor=>'w', -padx => 0, -pady => 0) ;
    update_IPTC_frame_content($actpic);
  }
  $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 => \$conf{add_tool_info}{value},
                                   -anchor   => 'w',
                                   -text     => lang('Add comment')
                                   )->pack(-side => $side, -anchor => 'w', -padx => 3, -pady => 3);
    #$balloon->attach($but, -msg => lang("Add a comment to pictures created or processed with Mapivi"));
    $balloon->attach($but, -msg => $conf{add_tool_info}{info});
}

##############################################################
# buttonBackup
##############################################################
sub buttonBackup {
    my $widget = shift;
    my $side   = shift;
    my $but = $widget->Checkbutton(-variable => \$config{MakeBackup},
                                   -anchor   => 'w',
                                   -text     => lang('Create backup')
                                   )->pack(-side => $side, -anchor => 'w', -padx => 3, -pady => 3);
    $balloon->attach($but, -msg => lang("Create a backup of the original picture in the same folder named name-bak.jpg"));
}

##############################################################
# labeledEntryButton - build a frame containing a labeled entry
#                      and a button with a file selector
##############################################################
sub labeledEntryButton {
  # input values
  my ($parentWidget, $position, $width, $label, $buttext, $varRef, $dir) = @_;
  my $frame = labeledEntry($parentWidget, $position, $width, $label, $varRef);
  setFileButton($frame,'right',$buttext,$label,$varRef, $dir);
  return $frame;
}

##############################################################
# labeledEntryColor - build a frame containing a labeled entry
#                     and a button with a color selector
##############################################################
sub labeledEntryColor {
  # input values
  my ($parentWidget, $position, $width, $label, $buttext, $varRef) = @_;
  my $frame = labeledEntry($parentWidget, $position, $width, $label, $varRef);
  $frame->{button} = 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');

  if (MatchEntryAvail) {
    # set the choice list to an empty list, if it's undefined
    $entryHistory{$label} = [] unless (defined $entryHistory{$label});

    $frame->{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($frame->{entry}, $entryHistory{$label}, $varRef); },
                                -tabcmd     => sub { addItemToList($frame->{entry}, $entryHistory{$label}, $varRef); },
                                -width      => $width2,
                               )->pack(-side => $int_pos, -expand => 1, -fill => 'x', -padx => 0);
  }
  else {
    $frame->{entry} = $frame->Entry(-textvariable => $varRef,
                           -width        => $width2,
                          )->pack(-side => $int_pos, -expand => 1, -fill => 'x', -padx => 0);
  }
  $frame->{entry}->xview('end');
  $frame->{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 => $conf{color_bg}{value},
               )->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 => $conf{color_bg}{value},
               )->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, $callback) = @_;
  my $frame =
    $parentWidget->Frame(-bd => 0)->pack(-side => $position, -fill => 'x', -padx => 3, -pady => 3);
  $frame->Label(-text   => $label,
                -width  => $width,
                -anchor => 'w',
                -bg => $conf{color_bg}{value},
               )->pack(-side => 'left', -padx => 3);
  $frame->{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);
  if ($callback) {
    $frame->{scale}->configure(-command => sub { &$callback; });
  }
  $frame->Label(-textvariable => $varRef,
                -width  => 5,
                -anchor => "e",
                -bd => $config{Borderwidth},
                -relief => 'sunken',
                -bg => $conf{color_bg}{value},
               )->pack(-side => 'left', -padx => 1);
  return ($frame);
}

##############################################################
# select folder: use Gtk2::FileChooserDialog if available
##############################################################
sub folder_dialog {
  my ($w, $title, $initdir) = @_;
  my $dir;
  if ($gtk2_avail) {
    # 3.argument is action: open, save, select-folder or create-folder
    my $chooser = Gtk2::FileChooserDialog->new ($title, undef, "select-folder",
                                          'gtk-cancel' => 'cancel',
                                          'gtk-open' => 'ok');
    $chooser->set_default_response ('ok');
    $chooser->set_current_folder($initdir) if -d $initdir;

    if ('ok' eq $chooser->run ()) {
      print "chose ".$chooser->get_filename()."\n";
      $dir = $chooser->get_filename();
    }
    $chooser->destroy;
  }
  else {
    my $choosendir = $w->chooseDirectory(-title => $title, -initialdir => $initdir);
    if ((defined $choosendir) and ( -d $choosendir )) {
      $dir = $choosendir;
    }
  }
  return $dir;
}

##############################################################
# 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 ((defined $dir) and ($dir == 1)) {
                            #my $dir = $parentWidget->chooseDirectory(-title => $fileselLabel, -initialdir => $$varRef);
                            my $dir = folder_dialog($parentWidget, $fileselLabel, $$varRef);
                            if ((defined $dir) and ( -d $dir )) {
                              $$varRef = $dir;
                            }
                          }
                          else {
                            my $file = $parentWidget->getOpenFile(-title => $fileselLabel, -initialdir => dirname($$varRef));
                            if ((defined $file) and (-f $file)) {
                              $$varRef = $file;
                            }
                          }
                        },
                       )->pack(-side => $position);
}

##############################################################
# setColorButton - open a color selector and set the color
##############################################################
sub setColorButton {
  # input values
  my ($parentWidget, $position, $butlabel, $varRef) = @_;
  my $ccbut;
  $ccbut = $parentWidget->Button(-text => $butlabel,
                                -pady => 0,
                -bg => $$varRef,
                -command => sub {
                  my $rc = color_chooser();
                  if (defined $rc) {
                    $ccbut->configure(-bg => $rc);
                    $$varRef = $rc;

                                # this is needed when updating the button
                                if ($$varRef eq 'black') {
                                  $ccbut->configure(-fg => 'white');
                                }
                                else {
                                  $ccbut->configure(-fg => 'black');
                                }
                              }
                })->pack(-side => $position, -pady => 0, -padx => 1);

  # this is needed when drawing the button
  if ($$varRef eq 'black') {
    $ccbut->configure(-fg => 'white');
  }
  else {
    $ccbut->configure(-fg => 'black');
  }
  return $ccbut;
}

##############################################################
# 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 ;)
  bind_exit_keys_to_button($win, $xBut);
  $xBut->focus;
  $win->Popup;
  $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  = lang("newfolder");
  my $rc      = myEntryDialog(lang("New folder ..."), langf("Enter name of new folder in %s",$path),\$newDir);
  return if ($rc ne 'OK' or $newDir eq '');
  if (-d "$path/$newDir") {
    $top->messageBox(-icon => 'warning', -message => "$newDir already exists!",
                     -title => lang('Error'), -type => 'OK');
    return 0;
  }
  if (!mkdir "$path/$newDir", oct(750)) {
    $top->messageBox(-icon => 'warning', -message => langf("Error making folder %s/%s: %s", $path, $newDir, $!),
                     -title => lang('Error'), -type => 'OK');
    return 0;
  }
  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");
  return "$path/$newDir";
}

##############################################################
# getSelectedDir - get the selected folder
# return value is either undefined, empty sting or a folder
##############################################################
sub getSelectedDir {
    my $dir = '';
    # if the dir tree is visible, try to get the selected dir
    if ($dirtree->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             // -> /
        }
    }
    return $dir;
}

##############################################################
# getRightDir - get the selected or the actual dir
##############################################################
sub getRightDir {
    my $dir = getSelectedDir();
    # 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 @subdirs = ("$dir/$thumbdirname", "$dir/$exifdirname");
  foreach my $subdir (@subdirs) {
    if (-d $subdir) {
      my $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 => langf("Folder %s does not exists!",$dir),
    -title => lang('Error'), -type => lang('OK'));
    return;
  }
  my $dirname = basename($dir);
  my $dirs    = 0;
  my $files   = 0;
  # rmdir will only remove empty folders, only if this fails we ask 
  if (not rmdir $dir) { 
	  # get some infos about the dir
	  my $size    = 0;
	  my $timeout = '';
	  my $start_time = Tk::timeofday();
	  log_it(lang("scanning folder ..."));
	  $top->Busy;
	  find(sub {
		# jump out after 5 seconds
		if (Tk::timeofday()-$start_time > 5) {
		  $timeout = lang(" 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;
	  log_it(lang("folder scanned!"));
	  $size = computeUnit($size);
	  # ask only if there are still files and more than 2 folders (. and ..)
	  if (($files > 0) or ($dirs > 2)) {
		my $question = langf("Found%s\n%8d folders and\n%8d files with a total size of\n%8s in \"%s\".\nReally delete?\n", $timeout, $dirs, $files, $size, $dirname);
    $question .= lang("Warning: There is no undelete!");
		my $rc = $top->messageBox(-icon => 'question',
		-message => $question,
		-title => lang("Delete folder?"),
		-type    => 'OKCancel');
		return if ($rc !~ m/Ok/i);
	  }
  }
  print "rmtree: dir = $dir\n" if $verbose;
  rmtree($dir, 0, 1); # dir, 0 = no message for each file, 1 = skip write protected files
  # remove the deleted pics from the search database
  cleanDatabaseFolder($dir);
  my $dirid = $dir;
  $dirid =~ s/\//\\/g if $EvilOS; # windows needs backslashes
  # update dir tree
  $dirtree->delete('entry', $dirid) if ($dirtree->info('exists', $dirid));
  # get parent folder
  my $path = dirname($dir);
  while (!-d $path) {
    $path = dirname($dir);
    last if ($path eq '');
  }
  # open parent dir if we've deleted the actual dir
  openDirPost($path) unless (-d $dir);
  log_it(langf("Ready! Removed folder %s with %d files.",$dirname,$files));
}

##############################################################
# renameDir
##############################################################
sub renameDir {
  my $dir = getRightDir();
  if (!-d $dir) { warn "dir $dir is no dir"; return; }
  my $path   = dirname($dir);
  my $newDir = basename($dir);
  my $rc     = myEntryDialog("Rename folder","Enter new name for folder $dir",\$newDir);
  return if ($rc ne 'OK' or $newDir eq '');
  my $newDir_withpath = "$path/$newDir";
  if (-d $newDir_withpath) {
    $top->messageBox(-icon => 'warning', -message => "$newDir already exists!",
                     -title => lang('Error'), -type => 'OK');
    return;
  }
  if (!rename $dir, "$path/$newDir") {
    $top->messageBox(-icon => 'warning', -message => "error renaming folder $dir to $newDir_withpath: $!",
                     -title => lang('Error'), -type => 'OK');
    return;
  }
  # move the moved pics also in the search database
  renameDatabaseFolder($dir, $newDir_withpath);
  # refresh the dir tree display
  #$path =~ s/\//\\/g if $EvilOS; # windows needs backslashes
  $newDir_withpath =~ s/\//\\/g if $EvilOS; # windows needs backslashes
  exists &Tk::DirTree::chdir ? $dirtree->chdir($newDir_withpath) : $dirtree->set_dir($newDir_withpath);
  $dirtree->Subwidget('scrolled')->configure(-directory => $newDir_withpath);
  #$dirtree->close($path);
  #$dirtree->open($path);
  my $dirid = $dir; $dirid =~ s/\//\\/g if $EvilOS; # windows needs backslashes
  $dirtree->delete('entry', $dirid) if ($dirtree->info('exists', $dirid));
  if ($dirtree->info('exists', $newDir_withpath)) {
    $dirtree->see($newDir_withpath);
    # select the new dir
    $dirtree->selectionSet($newDir_withpath);
  }
  $actdir = $newDir_withpath if (!-d $actdir);
}

##############################################################
# calcSize - calc new picture size
#            considering the aspect ratio and landscape/portait
#            mode
##############################################################
sub calcSize {
  my ($w, $ow, $oh) = @_;
  my $aspect = $ow/$oh;
  my ($nw, $nh);
  if ($ow >= $oh) { # landscape
    $nw  = $w;
    $nh = round($nw/$aspect);
  }
  else {            # portrait
    $nh = $w;
    $nw = round($aspect*$nh);
  }
  return ($nw, $nh);
}

##############################################################
# qualityBalloon
##############################################################
sub qualityBalloon {
  $balloon->attach(shift, -msg => lang("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, lang("picture(s)"));
  my $selected = @sellist;
  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(lang('Resize'));
  $myDiag->iconimage($mapiviicon) if $mapiviicon;

  $myDiag->Label(-text => langf("Change the size and/or quality of %d selected pictures",$selected),
                 -bg => $conf{color_bg}{value}
                )->pack(-anchor => 'w',-padx => 3,-pady => 3);

  my $qS = labeledScale($myDiag, 'top', 18, lang("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 => "100%",
               # -width => 12,
               # -command => sub {
                 # $height  = $origH;
                 # $width   = $origW;
                 # $widthP  = round($width/$origW  * 100);
                 # $heightP = round($height/$origH * 100);
               # })->pack(-side => 'left', -fill =>'x', -padx => 1);
  { # add some relative size buttons
    my @list = ( 100, 50, 33, 25, 10);
    foreach my $size (@list) {
      $csf1->Button(-text => "${size}%",
                   -width => 9,
                   -command => sub {
                     $PixPro           = 'pro';
                     $keepaspect       = 1;
                     if ($size == 100) {
                       $height  = $origH;
                       $width   = $origW;
                       $widthP  = round($width/$origW  * 100);
                       $heightP = round($height/$origH * 100);
                     }
                     else {
                       $widthP           = $size;
                       $heightP          = $size;
                       $width            = round($origW * $widthP/100);
                       $height           = round($origH * $heightP/100);
                     }
                   })->pack(-side => 'left',-fill =>'x', -expand => 1, -padx => 1);
    }
  }
  my $csf2 = $myDiag->Frame()->pack(-fill =>'x',-padx => 3,-pady => 3);
  { # add some absolut size buttons
    my @list = ( 2000, 1500, 1000, 800, 600 );
    foreach my $size (@list) {
      $csf2->Button(-text => "${size}px",
                 -width => 9,
                 -command => sub {
                   $PixPro           = 'pix';
                   $keepaspect       = 1;
                   ($width, $height) = calcSize($size, $origW, $origH);
                   $widthP           = round($width/$origW  * 100);
                   $heightP          = round($height/$origH * 100);
                 })->pack(-side => 'left',-fill =>'x', -expand => 1, -padx => 1);
    }
  }

  my $w = 20;
  $myDiag->Checkbutton(-variable => \$keepaspect,
                       -anchor => 'w',
                       -text => langf("Keep aspect ratio (original size %dx%d)",$origW, $origH))->pack(-anchor => 'w', -padx => 3,-pady => 3);

  my $absoluteF = $myDiag->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-fill =>'x',-padx => 3,-pady => 3);
  $absoluteF->Radiobutton(-text => lang("Absolute size in pixel"), -variable => \$PixPro, -value => 'pix')->pack(-anchor => 'w', -padx => 3,-pady => 3);
  my $labFw  = labeledEntry($absoluteF, 'top', $w, lang("Width"), \$width);
  my $labFh  = labeledEntry($absoluteF, 'top', $w, lang("Height"), \$height);

  my $relativeF = $myDiag->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-fill =>'x',-padx => 3,-pady => 3);
  $relativeF->Radiobutton(-text => lang("Relative size in %"),     -variable => \$PixPro, -value => 'pro')->pack(-anchor => 'w', -padx => 3,-pady => 3);
  my $labFwp = labeledEntry($relativeF, 'top', $w, lang("Width"), \$widthP);
  my $labFhp = labeledEntry($relativeF, 'top', $w, lang("Height"), \$heightP);
  my $labEw  = ($labFw->children)[1];
  my $labEh  = ($labFh->children)[1];
  my $labEwp = ($labFwp->children)[1];
  my $labEhp = ($labFhp->children)[1];
  $labEw->bind('<FocusOut>', sub {
                 if ($keepaspect) {
                   $height = round($width/$aspect); # int() does not round!
                 }
                 $widthP  = round($width/$origW  * 100);
                 $heightP = round($height/$origH * 100);
                 $PixPro  = "pix";
               });
  $labEh->bind('<FocusOut>', sub {
                 if ($keepaspect) {
                   $width = sprintf("%.0f",($aspect*$height));
                 }
                 $widthP  = round($width/$origW  * 100);
                 $heightP = round($height/$origH * 100);
                 $PixPro  = "pix";
               });
  $labEwp->bind('<FocusOut>', sub {
                  if ($keepaspect) {
                    $heightP = $widthP; # int() does not round!
                  }
                  $width  = round($origW * $widthP/100);
                  $height = sprintf("%.0f",($origH * $heightP/100));
                  $PixPro  = "pro";
                });
  $labEhp->bind('<FocusOut>', sub {
                  if ($keepaspect) {
                    $widthP = $heightP;
                  }
                  $width  = round($origW * $widthP/100);
                  $height = sprintf("%.0f",($origH * $heightP/100));
                  $PixPro  = "pro";
                });

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

  $filf->Label(-text => lang("Resize method"), -bg => $conf{color_bg}{value})->pack(-side => 'left', -anchor => 'w');
  my $resfilt = $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');
  $balloon->attach($resfilt, -msg => lang("Recommendation: Lanczos filter for high quality pictures."));

  if ($strip) {
    $myDiag->Checkbutton(-variable => \$config{PicStrip},
           -anchor => 'w',
           -text => lang("Strip all meta information (EXIF, IPTC, ...)"))->pack(-anchor => 'w',-padx => 3,-pady => 3);
  }

  # option to sharpen the image with an unsharp mask operator
  if ($unsharp) {
    my $umF = $myDiag->Frame()->pack(-fill =>'x', -padx => 0);

    my $umcB = $umF->Checkbutton(-variable => \$config{Unsharp},
                     -anchor => 'w',
                         -text => lang("Unsharp mask"))->pack(-side => 'left', -anchor => 'w', -fill => 'x', -expand => 1,-padx => 3,-pady => 3);
    $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 => lang("Options"),
             -anchor => 'w',
             -command => sub { unsharpDialog(); })->pack(-side => 'left', -anchor => 'w', -padx => 3);
  }

  my $sS = labeledScale($myDiag, 'top', 18, lang("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, lang("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 => lang('OK'),
                          -command => sub {
                            $rc = 1;
                            $myDiag->withdraw();
                            $myDiag->destroy();
                          })->pack(-side => 'left',-expand => 1,-fill => 'x',-padx => 3,-pady => 3);

  my $xBut = $ButF->Button(-text => lang('Cancel'),
                -command => sub {
                  $rc = 0;
                  $myDiag->withdraw();
                  $myDiag->destroy();
                }
               )->pack(-side => 'left',-expand => 1,-fill => 'x',-padx => 3,-pady => 3);
  bind_exit_keys_to_button($myDiag, $xBut);
  $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');
  log_it("changing the size/quality of $selected pictures ...");
  my $pw = progressWinInit($top, "changing size/quality");
  my $i = 0;
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    my $pic      = basename($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(getThumbFileName($dpic)) if (($width == $w) and ($height == $h)); # only when the size changed
    addProcessInfoToPicComment($command, $dpic);
    updateOneRow($dpic, $picLB);
    showImageInfo($dpic) if ($dpic eq $actpic);
  } # foreach end
  progressWinEnd($pw);
  log_it("ready! ($i of $selected changed)");
  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, lang("picture(s)"));

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

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

  log_it("image processing: preparing preview ...");

  # 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 "$user_data_path/filters") {
    my $hashRef = retrieve("$user_data_path/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, lang("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 => lang('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 => lang('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 => lang('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 => lang('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 => lang('Preview'),
                -command => sub {$thumbPreviewB->Invoke();}
               )->pack(-side => 'left',-expand => 1,-fill => 'x',-padx => 3,-pady => 3);

  my $OKB =
    $ButF->Button(-text => lang('OK'),
                    -command => sub {
                      # save the filter settings
                      nstore(\%filters, "$user_data_path/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);
                      log_it("ready! ($nr of ".scalar @sellist." processed)");
                      generateThumbs(ASK, SHOW);
                      $filterW->destroy;
                    })->pack(-side => 'left',-expand => 1,-fill => 'x',-padx => 3,-pady => 3);

  my $Xbut =
  $ButF->Button(-text => lang('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);
  bind_exit_keys_to_button($filterW, $Xbut);
  $OKB->focus;
  $filterW->Popup;
  log_it("image processing: preview ready!");
  $filterW->waitWindow;
  log_it("image processing: cleaning up ...");
  $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);
  log_it("image processing ready!");
}

##############################################################
# 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);
  log_it($info);
  # 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});
  addProcessInfoToPicComment($command, $dpic);
  log_it("image processing ready!");
}

##############################################################
# removeFile - delete a file
##############################################################
sub removeFile {
  my $file = shift;
  return 1 if (!-f $file);
  if ( unlink($file) != 1) { # unlink returns the number of successful 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 = getSelection($lb);
  return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));
  my ($w, $h, $x, $y);
  my $i          = 0;
  my $doforall   = 0;
  my $askDifSize = 1;
  my $first      = $sellist[0];
  my ($wm, $hm) = getSize($first);
  my $pw;
  $pw = progressWinInit($lb, 'Crop pictures') if (@sellist > 1);
  foreach my $dpic (@sellist) {
    if ($pw) {last if progressWinCheck($pw)};
    $i++;
    progressWinUpdate($pw, "cropping picture ($i/".scalar @sellist.") ...", $i, scalar @sellist) if ($pw);
    my $pic = basename($dpic);
    # check if file is a link and get the real target
    next if (!getRealFile(\$dpic));
    next if (!checkWriteable($dpic));
    my ($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) {
      # adjust size according to aspect ratio
      ($w, $h) = calcAspectSize($wo, $ho, $config{CropAspect});
      $x  = 0;
      $y  = 0;
      last if (!cropDialog($dpic, \$x, \$y, \$w, \$h, $wo, $ho, \$doforall, scalar @sellist));
      print "cropDialog returned $pic x:$x y:$y w:$w  h:$h" if $verbose;
    }
    # save crop frame offset before adjusting too small pics
    my $xsave = $x;	my $ysave = $y;
    if (($x + $w) > $wo) { # crop frame outside the picture
      $x = $wo - $w;
      if ($x < 0) {
        $top->messageBox(-icon  => 'warning', -message => "Skipping picture $pic!\nThe width ($wo) is too small for the crop frame ($w).",
                         -title => "Picture too small", -type => 'OK');
        # restore crop frame offset after adjusting to small pics
        $x = $xsave; $y = $ysave;
        next;
      }
    }
    if (($y + $h) > $ho) { # crop frame outside the picture
      $y = $ho - $h;
      if ($y < 0) {
        $top->messageBox(-icon  => 'warning', -message => "Skipping picture $pic!\nThe height ($ho) is too small for the crop frame ($h).",
                         -title => "Picture too small", -type => 'OK');
        # restore crop frame offset after adjusting to small pics
        $x = $xsave; $y = $ysave;
        next;
      }
    }
    printf "cropping $pic %4dx%4d+%4d+%4d\n", $w, $h, $x, $y if $verbose;
    next if (!makeBackup($dpic));
    # crop the picture
    $top->Busy;
    cropPic($dpic,$w,$h,$x,$y,95);
    $top->Unbusy;
    # check if crop has the right size
    # due to the 8 pixel blocks, sometimes the size is too big (a few pixels)
    my ($nw, $nh) = getSize($dpic);
    if (($nw > $w) or ($nh > $h)) {
      # but a recrop will help ...
      $top->Busy;
      cropPic($dpic,$w,$h,0,0,95);
      $top->Unbusy;
      print "recropping $pic w:$nw > $w h: $nh > $h n" if $verbose;
    }
    # restore crop frame offset after adjusting to small pics
    $x = $xsave; $y = $ysave;
    addCommentToPic("Picture lossless cropped by Mapivi $version ($mapiviURL)", $dpic, NO_TOUCH) if ($conf{add_tool_info}{value});
    updateOneRow($dpic, $lb);
    deleteCachedPics($dpic);
    showPic($dpic) if ($dpic eq $actpic); # redisplay the picture if it is the actual one
  } # foreach end
  progressWinEnd($pw) if ($pw);
  reselect($lb, @sellist);
  log_it("ready! ($i of ".scalar @sellist." cropped)");
  generateThumbs(ASK, SHOW);
}

##############################################################
# calcAspectSize
# return new picture width and height according to the given
# aspect ratio and master direction
##############################################################
sub calcAspectSize {
  my $w  = shift;				# width
  my $h  = shift;				# height
  my $aspect = shift;   # aspect ratio e.g. 3/2 or 4/3; use 0 for no aspect ratio
  my $m  = shift;				# (optional) master ('w' if the width is the master or "h" for height)
  # calculate new size
  if ($aspect != 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 / $aspect); # int() does not round!
        } else {				     # portait image
          $h = sprintf "%.0f", ($w * $aspect);
        }
      } else {                       # height is master
        if ($w >= $h) {			     # landscape image
          $w = sprintf "%.0f", ($h * $aspect);
        } else {				     # portait image
          $w = sprintf "%.0f", ($h / $aspect); # round
        }
      }
    } else {                         # no master defined
      if ($w >= $h) {			     # landscape image
        if (($h != 0) and ($w/$h >= $aspect)) { # too wide
          $w = sprintf "%.0f", ($h * $aspect); # round
        } else {				     # too high
          $h = sprintf "%.0f", ($w / $aspect); # round
        }
      } else {					     # portait image
        if (($h != 0) and ($w/$h >= 1/$aspect)) { # too wide
          $w = sprintf "%.0f", ($h / $aspect); # round
        } else {				     # too high
          $h = sprintf "%.0f", ($w * $aspect); # round
        }
      }
    }
  }
  return ($w, $h);
}

##############################################################
# setNewAspect
##############################################################
sub setNewAspect {
  my $c = shift;
  my $aspect = shift;
  my $w = $c->{m_x2} - $c->{m_x1};
  my $h = $c->{m_y2} - $c->{m_y1};
  ($w, $h) = calcAspectSize($w, $h, $aspect);
  $c->{m_x2} = $c->{m_x1} + $w;
  $c->{m_y2} = $c->{m_y1} + $h;
  $c->{m_aspect} = getAspectRatio($w, $h);
  drawFrame($c);
}

##############################################################
# bindForResize
# based on code from Jason Tiller and Ala Qumsieh posted in the Perl/TK (ptk; comp.lang.perl.tk) list in 2003
##############################################################
sub bindForResize {
   my $canvas = shift;
   # Drag requests:
   # 0 = No drag requested in this direction.
   # 1 = Drag top (for y) or left (for x) edge of rectangle.
   # -1 = Drag bottom (for y) or right (for x) edge of rectangle.
   my ( $dx, $dy ) = ( 0, 0 );

   # Drag mode: NO_ACTIVE_MODE, MOVE_MODE, or RESIZE_MODE.
   use constant M_NO_ACTIVE_MODE => 0;
   use constant M_MOVE_MODE => 1;
   use constant M_RESIZE_MODE => 2;
   my $mode = M_NO_ACTIVE_MODE;

   # How close to the edge we have to be to initiate a resize (instead
   # of a move) drag.  Expressed in percentage of overall
   # height/width.
   my $resize_within = 0.05; # Within 5% of edge to resize.

   # Initial location of mouse pointer.
   my ($oldx, $oldy) = (0) x 2;

   # ID of rectangle that we're resizing.
   my $rect;

   # Bind left-mouse clicks (<1>) over any widget with a 'RECT' tag to
   # do...
   $canvas->CanvasBind('<1>' =>
      sub {
         my ( $x, $y ) = ( $Tk::event->x, $Tk::event->y );
         my ( $x0, $y0, $x1, $y1 ) = $canvas->coords( 'RECT' );
         return if ((not defined $x0) or
                    (not defined $y0) or
                    (not defined $x1) or
                    (not defined $y1) or
                    ($x < $x0) or
                    ($x > $x1) or
                    ($y < $y0) or
                    ($y > $y1));

         #my ( $x0, $y0, $x1, $y1 ) = $canvas->coords( 'RECT' );

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

         # Determine if the user wants to size in the x direction.  If
         # the user clicks within $resize_within of the edge, then he
         # wants to resize.
          $dx = 0;
          if(    $x < ( $x0 + $resize_within * $width ) ) { $dx =  1; }
          elsif( $x > ( $x1 - $resize_within * $width ) ) { $dx = -1; }

          # Do the same for the y direction.
          $dy = 0;
          if(    $y < ( $y0 + $resize_within * $width ) ) { $dy =  1; }
          elsif( $y > ( $y1 - $resize_within * $width ) ) { $dy = -1; }

         # If resizing in either direction, set resize mode.
         $mode = ( $dx || $dy ) ? M_RESIZE_MODE : M_MOVE_MODE;
         my $id = $canvas->find( qw|withtag RECT| );
         ( $oldx, $oldy, $rect ) = ( $x, $y, $id );

         return;
      }
   );

   # Bind motion with the left mouse button down (<B1-Motion>) over a
   # widget with a 'RECT' tag to do...
   $canvas->CanvasBind('<B1-Motion>' =>
      sub {
         my ( $x, $y ) = ( $Tk::event->x, $Tk::event->y );
         #print "B1 Motion: $x $y\n";
         if( $mode == M_RESIZE_MODE ) {
            #print "M_RESIZE_MODE\n";
            # Get coordinates of resizing rectangle. 
            my ( $x0, $y0, $x1, $y1 ) = $canvas->coords( 'RECT' );

            # Resize logic.  If we're moving the left border, then
            # change the coordinates of the left edge ($x0) to be the
            # current mouse position's x position ($x), else set the
            # rectangle's right edge.
            if    ( $dx ==  1 ) { $x0 = $x; }
            elsif ( $dx == -1 ) { $x1 = $x; }

            if    ( $dy ==  1 ) { $y0 = $y; }
            elsif ( $dy == -1 ) { $y1 = $y; }

            $x0 = 0 if ($x0 < 0);
            $x1 = $canvas->width if ($x1 > $canvas->width);
            $y0 = 0 if ($y0 < 0);
            $y1 = $canvas->height if ($y1 > $canvas->height);
            # Set the coordinates of the resizing rectangle.
            $canvas->coords( 'RECT', $x0, $y0, $x1, $y1 );
            draw_grid($canvas, $x0, $y0, $x1, $y1);
         } else {
            #print "M_MOVE_MODE\n";
            my ( $x0, $y0, $x1, $y1 ) = $canvas->coords( 'RECT' );
            return if ((not defined $x0) or
                      (not defined $y0) or
                      (not defined $x1) or
                      (not defined $y1) or
                      ($x < $x0) or
                      ($x > $x1) or
                      ($y < $y0) or
                      ($y > $y1));
            # Move the rectangle under mouse pointer relative to its
            # old position.
            $canvas->move( $canvas->find( 'withtag', 'RECT' ),
                           $x - $oldx,
                           $y - $oldy );
            draw_grid($canvas, $canvas->coords( 'RECT' ));
            # Update "old" coordinates.
            ( $oldx, $oldy ) = ( $x, $y );
         }
      }
   );

   # Set to false when we've changed the cursor.  Tells us we want to
   # reset the cursor when we leave a rectangle.
   my $cursor_is_normal = 1;

   # Maps cursor position to cursor shape.
   # 0 = middle of shape, 1 = left/top edge, 2 = right/bottom edge.
   # [$x][$y]
   my @cursors = (
      # [ (0,0),    (0,1),        (0,2) ]
      [    'fleur', 'top_side', 'bottom_side' ],
      # [ (1,0),       (1,1),             (1,2) ]
      [    'left_side', 'top_left_corner', 'bottom_left_corner' ],
      # [ (2,0),        (2,1),              (2,2) ]
      [    'right_side', 'top_right_corner', 'bottom_right_corner' ]
   );
   my @old_cursors = ( 3, 3 ); # ( x, y )

   $canvas->CanvasBind( '<B1-ButtonRelease>' =>
      sub {
         my @coords = $canvas->coords( 'RECT' );
         $mode = M_NO_ACTIVE_MODE;
         $canvas->configure( -cursor => 'left_ptr' );
         @old_cursors = ( 3, 3 );
         $cursor_is_normal = 1;
         drawFrame($canvas, @coords);
         $canvas->raise($rect);
      }
   );

   # Update the mouse cursor based on where the pointer is on the
   # canvas.  If it's not over a rectangle, set it to the default
   # ('left_ptr').  If it's over a rectangle, set to a target cursor
   # if the pointer is in the drag region (center) else to a resize
   # cursor.
   $canvas->CanvasBind( '<Motion>' =>
      sub {
         #print "CanvasBind Motion\n";
         #my $id = $canvas->find( qw|withtag current| );
         #my @tags = $canvas->gettags($id);
         #for (0 .. $#tags) { print "$_ $tags[$_]\n"; }
         # Bail if we're not over a rectangle.
         my ( $x, $y ) = ( $Tk::event->x, $Tk::event->y );
         my ( $x0, $y0, $x1, $y1 ) = $canvas->coords( 'RECT' );
         if ( (not defined $x0) or
              (not defined $y0) or
              (not defined $x1) or
              (not defined $y1) or
              ($x < $x0) or
              ($x > $x1) or
              ($y < $y0) or
              ($y > $y1)) {
            unless( $cursor_is_normal ) {
               $canvas->configure( -cursor => 'left_ptr' );
               @old_cursors = ( 3, 3 );
               $cursor_is_normal = 1;
            }
            return;
         }
         # Don't update the cursor once we've started a drag or resize
         # operation.
         return unless $mode == M_NO_ACTIVE_MODE;
         my( $width, $height ) = ( $x1 - $x0, $y1 - $y0 );
         # Now figure out where we are in the widget.
         my ( $px, $py ) = ( 0, 0 );
         # Determine if the user wants to size in the x direction.  If
         # the user clicks within $resize_within of the edge, then he
         # wants to resize.
         if(    $x > ( $x1 - $resize_within * $width ) ) { $px = 2; }
         elsif( $x < ( $x0 + $resize_within * $width ) ) { $px = 1; }
         # Do the same for the y direction.
         if( $y > ( $y1 - $resize_within * $width ) ) { $py = 2; }
         if( $y < ( $y0 + $resize_within * $width ) ) { $py = 1; }
         # Don't update cursor unless it's changed.
         return if ( $px == $old_cursors[0] and $py == $old_cursors[1] );
         $canvas->configure( -cursor => $cursors[$px][$py] );
         @old_cursors = ( $px, $py );
         $cursor_is_normal = 0;
       }
    );
  return;
}

##############################################################
# generate a zommed preview picture e.g. for cropDialog
##############################################################
sub make_preview_pic {
  my ($dpic, $zpicP, $zpicx, $zpicy) = @_; # References to preview picture: photo object, x-size, y-size
  $$zpicP = undef;
  my $sc_w = $top->screenwidth;
  my $sc_h = $top->screenheight;
  # if the picture is already available and zoomed to a usefull size we use it to save some time
  if (exists $photos{$dpic}) {
    $$zpicx = $photos{$dpic}->width;
    $$zpicy = $photos{$dpic}->height;
    if (($$zpicx > 0.25*$sc_w) and ($$zpicx < 0.9*$sc_w) and ($$zpicy > 0.25*$sc_h) and ($$zpicy < 0.9*$sc_h)) {
      log_it("using preview picture ...");
      $$zpicP = $photos{$dpic};
      #print "using preview picture ...\n";
    }
  }
  # if this didn't work we zoom a new preview picture 
  if (!defined $$zpicP) {
    log_it("creating preview picture ...");
    my $zpic = "$trashdir/".basename($dpic);
    if (!mycopy($dpic, $zpic, OVERWRITE)) {
      warn "copy error";
      return 0;
    }
    my $per = 0.75;				# preview pic should be 75% of the min screen size
    my $cropPreviewSize = int($per * $sc_w);
    $cropPreviewSize = int($per * $sc_h) if ($sc_h < $sc_w);
    # 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;

    if (!-f $zpic) {
      $top->messageBox(-icon  => 'warning', -message => "Sorry, error zooming preview picture $dpic!",
                       -title => "Generating preview picture", -type => 'OK');
      return 0;
    }
    ($$zpicx, $$zpicy) = getSize($zpic);

    $$zpicP = $top->Photo(-file => $zpic, -gamma => $config{Gamma}) if (-f $zpic);
    if (!$zpicP) {
      $top->messageBox(-icon  => 'warning', -message => "Error displaying zoomed preview picture $zpic!",
                       -title => "Generating preview picture", -type => 'OK');
      return 0;
    }
  }
  log_it(lang('Ready!'));
  return 1;
}

##############################################################
# 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;
  my ($zpicP, $zpicx, $zpicy); # preview picture: photo object, x-size, y-size
  return unless make_preview_pic($dpic, \$zpicP, \$zpicx, \$zpicy);

  # open window
  my $cropW = $top->Toplevel();
  $cropW->title(lang('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 $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 => lang('Help'))->pack(-expand => 0, -fill => 'x');
  my $rotext = $fF->ROText(-wrap => "word", -bg => $conf{color_bg}{value},
                           -bd => 0, -width => 26, -height => 5)->pack(-expand => 0, -fill => 'x', -anchor => 'w');
  $rotext->insert('end', lang('Use left mouse button to move and adjust the crop 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 => $conf{color_bg}{value})->pack(-anchor => 'w');
  $iF->Label(-text => "old size: ${wo} x ${ho}", -bg => $conf{color_bg}{value})->pack(-anchor => 'w');
  my $lf = $iF->Frame()->pack(-anchor => 'w');
  $lf->Label(-text => "new size:",    -bg => $conf{color_bg}{value})->pack(-side => 'left', -anchor => 'w');
  $lf->Label(-textvariable => \$pc->{m_w},  -bg => $conf{color_bg}{value})->pack(-side => 'left', -anchor => 'w');
  $lf->Label(-text => 'x',            -bg => $conf{color_bg}{value})->pack(-side => 'left', -anchor => 'w');
  $lf->Label(-textvariable => \$pc->{m_h},  -bg => $conf{color_bg}{value})->pack(-side => 'left', -anchor => 'w');
  my $caF = $iF->Frame()->pack(-anchor => 'w');
  $caF->Label(-text => "crop area:",   -bg => $conf{color_bg}{value})->pack(-side => 'left', -anchor => 'w');
  $caF->Label(-textvariable => \$pc->{m_xyxy}, -bg => $conf{color_bg}{value})->pack(-side => 'left', -anchor => 'w');

  my $cropRect;
  my @cropRectCoords;
  #$pc->bind('<Any-Enter>' => sub { $pc->Tk::focus });
  bindForResize($pc);
  # insert pic
  my $id;
  $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 zoomed preview of $dpic!",
                     -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', -padx => 5, -pady => 5);
  my $iF12 = $iF1->Frame()->pack(-side => 'left', -padx => 5, -pady => 5);
  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 => lang("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 => lang("Aspect ratio"))->pack(-expand => 0, -fill => 'x');
  my $aspF = $aF->Frame()->pack(-anchor => 'w');
  $aspF->Label(-text => lang("Actual aspect ratio:"),  -bg => $conf{color_bg}{value})->pack(-side => 'left', -anchor => 'w');
  $aspF->Label(-textvariable => \$pc->{m_aspect}, -width => 8, -bg => $conf{color_bg}{value})->pack(-side => 'left', -anchor => 'w');
  #my $dummy;
  my $aspectm = $aF->Optionmenu(-options => [
  ['X:Y (any aspect ratio)' => 0],
  ['3:2 (e.g. 10x15)' => 3/2],
  ['4:3' => 4/3],
  ['5:4 (PAL)' => 5/4],
  ['7:5 (e.g. 13x18)' => 7/5],
  ['9:7 (e.g. 4,5x3,5)' => 9/7],
  ['16:9' => 16/9],
  ['5:2' => 5/2],
  ['1:1' => 1/1], ], -textvariable => \$config{CropAspect},
  -command => sub { setNewAspect($pc, $config{CropAspect}); } )->pack(-side => 'top', -anchor => 'w');
  $aspectm->configure(-variable => \$config{CropAspect});
  #['1:1' => 1/1], ], -textvariable => \$dummy)->pack(-side => 'top', -anchor => 'w');

  $cropFR->Checkbutton(-variable => \$config{CropGrid},
                         -anchor   => 'w',
                         -text     => lang('Display 1/3 crop grid'),
                         -command  => sub { drawFrame($pc); },
                        )->pack(-anchor => 'w', -padx => 5, -pady => 3);

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

  if ($nr > 1) {
    $cropFR->Checkbutton(-variable => \$$doforallr,
                         -anchor   => 'w',
                         -text     => lang("Use setting for all pictures")
                        )->pack(-anchor => 'w');
  }

  my $ButF =
    $cropFR->Frame()->pack(-fill =>'x', -expand => 1, -padx => 0, -pady => 2);

  my $OKB =
    $ButF->Button(-text => lang('OK'),
                  -command => sub {
                    $$xr = $pc->{m_x1};
                    $$yr = $pc->{m_y1};
                    $$wr = $pc->{m_x2} - $pc->{m_x1};
                    $$hr = $pc->{m_y2} - $pc->{m_y1};
                    $cropW->withdraw();
                    $rc = 1;
                    $cropW->destroy();
                  })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  my $Xbut =
    $ButF->Button(-text => lang('Cancel'),
                  -command => sub { $rc = 0;
                                    $cropW->withdraw();
                                    $cropW->destroy();
                                  })->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 3, -pady => 3);
  bind_exit_keys_to_button($cropW, $Xbut);
  # first popup the window then draw the frame!
  $cropW->Popup;
  $cropW->update;
  my $distx = int($zpicx/10);
  my $disty = int($zpicy/10);
  drawFrame($pc, $distx, $disty, ($zpicx-$distx), ($zpicy-$disty));

  $cropW->waitWindow;

  # clean up (unless it is a existing pic used in showPhoto())
  $zpicP->delete unless (exists $photos{$dpic});
  #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 => $conf{color_bg}{value}, -width => 6)->pack(-side => 'left', -anchor => 'w');
  $frame->Button(-image => $mapivi_icons{Minus}, -padx => 0, -pady => 0, -command => sub {
                   $$value -= $$step;
                   $$value = $min if ($$value < $min);
                   $$value = $max if ($$value > $max);
                   $callback->($cb_para1, $cb_para2);
                 })->pack(-side => 'left', -anchor => 'w', -padx => 0, -pady => 0);
  $frame->Button(-image => $mapivi_icons{Plus}, -padx => 0, -pady => 0, -command => sub {
                   $$value += $$step;
                   $$value = $min if ($$value < $min);
                   $$value = $max if ($$value > $max);
                   $callback->($cb_para1, $cb_para2);
                 })->pack(-side => 'left', -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};
    # adjust size according to aspect ratio
    ($w, $h) = calcAspectSize($w, $h, $config{CropAspect}, $direction);
    #($w, $h) = calcAspectSize($w, $h);
    $canvas->{m_x2} = $canvas->{m_x1} + $w;
    $canvas->{m_y2} = $canvas->{m_y1} + $h;
    $canvas->{m_xyxy} = $canvas->{m_x1}.",".$canvas->{m_y1}." - ".$canvas->{m_x2}.",".$canvas->{m_y2};
    $canvas->{m_w}    = $w;
    $canvas->{m_h}    = $h;
    $canvas->{m_aspect} = getAspectRatio($w, $h);
    $coords[0] = int($canvas->{m_x1} / $canvas->{m_xzoom});
    $coords[1] = int($canvas->{m_y1} / $canvas->{m_yzoom});
    $coords[2] = int($canvas->{m_x2} / $canvas->{m_xzoom});
    $coords[3] = int($canvas->{m_y2} / $canvas->{m_yzoom});
    $canvas->delete('withtag', 'RECT');
    $canvas->createRectangle(@coords, -tags => ['RECT'], -outline => 'red');
    # draw 1/3 grid - divide the crop frame in nine rectangles
    draw_grid($canvas, @coords);
    $canvas->raise('RECT');
}

##############################################################
##############################################################
sub draw_grid {
    my $canvas = shift;
    my @coords = @_;
    # draw 1/3 grid - divide the crop frame in nine rectangles
    $canvas->delete('withtag', 'GRID');
    if ($config{CropGrid}) {
      my $grid_dist_h = round(($coords[3] - $coords[1])/3);
      my $grid_dist_w = round(($coords[2] - $coords[0])/3);
      $canvas->createLine($coords[0],$coords[1] + $grid_dist_h,  $coords[2],$coords[1] + $grid_dist_h,   -dash => [6,4,2,4],-tags => ['GRID'], -width => 1, -fill => '#ccc');
      $canvas->createLine($coords[0],$coords[1] + 2*$grid_dist_h,$coords[2],$coords[1] + 2*$grid_dist_h, -dash => [6,4,2,4],-tags => ['GRID'], -fill => '#ccc');
      $canvas->createLine($coords[0] + $grid_dist_w,  $coords[1],$coords[0] + $grid_dist_w,$coords[3],   -dash => [6,4,2,4],-tags => ['GRID'], -fill => '#ccc');
      $canvas->createLine($coords[0] + 2*$grid_dist_w,$coords[1],$coords[0] + 2*$grid_dist_w,$coords[3], -dash => [6,4,2,4],-tags => ['GRID'], -fill => '#ccc');
    }
    $canvas->delete('withtag', 'FRAME');
    # draw a pseudo transparent box around the crop frame
    $canvas->createRectangle( 1, 1, $coords[0], $canvas->height-1,
                              -tags => ['FRAME'],
                              -outline => undef,
                              -fill => 'black',
                              -stipple => 'transp',
                              );
    $canvas->createRectangle( $coords[0], 1, $canvas->width-1, $coords[1],
                              -tags => ['FRAME'],
                              -outline => undef,
                              -fill => 'black',
                              -stipple => 'transp',
                              );
    $canvas->createRectangle( $coords[2], $coords[1], $canvas->width-1, $canvas->height-1,
                              -tags => ['FRAME'],
                              -outline => undef,
                              -fill => 'black',
                              -stipple => 'transp',
                              );
    $canvas->createRectangle( $coords[0], $coords[3], $coords[2], $canvas->height-1,
                              -tags => ['FRAME'],
                              -outline => undef,
                              -fill => 'black',
                              -stipple => 'transp',
                              );
}

##############################################################
# cropPic - cut a rect out of the pic
#           needs a geometry (e.g. 200x200+33+66)
#           overwrites the given file!!!
#           returns true if it worked
##############################################################
sub cropPic {
  my $dpic = shift; return 0 if (!-f $dpic);  # pic will be overwritten!!!
  my $w   = shift;                          # width
  my $h  = shift;                           # height
  my $x   = shift;                          # x offset
  my $y   = shift;                          # y offset
  my $qua = shift;                          # quality
  my ($pw, $ph) = getSize($dpic);
  #return 1 if (($pw <= $w) and ($ph <= $h));
  # if the requested size is bigger than the pic we adapt to the real pic size
  $w = $pw if ($w > $pw);
  $h = $ph if ($h > $ph);
  my $geo = "${w}x${h}+${x}+${y}";
  my $command = '';
  # try to use fast lossless cropping for JPEGs if available
  if (is_a_JPEG($dpic) and checkExternProgs('crop', 'jpegtran')) {
    # check if jpegtran supports lossless cropping
    my $usage = `jpegtran -? 2>&1`;
    if ($usage =~ m/.*-crop.*/) {
      $command = "jpegtran -copy all -crop $geo -outfile \"$dpic\" \"$dpic\"";
      print "$dpic: cropping lossless using jpegtran\n" if $verbose;
    }
  }
  # the fallback solution
  if ($command eq '') {
    $command = "mogrify -crop $geo -quality $qua \"$dpic\"";
    print "$dpic: cropping lossy using mogrify (reason: not a JPEG or wrong jpegtran version)\n"; # if $verbose;
  }
  if ((system $command) != 0) {
    warn "$command failed: $!";
    return 0;
  }
  else {
    return 1;
  }
}

##############################################################
# mycopy
##############################################################
sub mycopy {
  my $from      = shift;
  my $to        = shift;
  my $overwrite = shift; # OVERWRITE = overwrite without asking ASK_OVERWRITE = ask before overwrite
  if (!-f $from) {
    $top->messageBox(-icon  => 'warning', -message => "file $from not found!",
                     -title => "Copy file",   -type => 'OK');
    return 0;
  }
  return 1 if ($from eq $to); # no need to copy a file on itself
  # if target exists and ask overwrite modus on
  if ((-f $to) and ($overwrite == ASK_OVERWRITE)) {
    my $rc =
    $top->messageBox(-icon  => 'warning', -message => "file $to exist. Ok to overwrite?",
                     -title => 'Copy file',   -type => 'OKCancel');
    return 0 if ($rc !~ m/Ok/i);
  }
  if (!copy($from, $to)) {
    $top->messageBox(-icon  => 'warning', -message => "Could not copy $from to $to: $!",
                     -title => 'Copy file',   -type => 'OK');
    return 0;
  }
  return 1;
}

##############################################################
# mylink
##############################################################
sub mylink {
  my $old       = shift;
  my $new       = shift;
  my $overwrite = shift; # 1 = overwrite without asking 0 = ask before overwrite
  return 0 if $EvilOS; # sorry, no links on non-UNIX system, use Linux instead ;)
  if (!-f $old) {
    $top->messageBox(-icon  => 'warning', -message => "file $old not found!",
                     -title => "Link file",   -type => 'OK');
    return 0;
  }
  if ((-f $new) and !$overwrite) {
    my $rc =
    $top->messageBox(-icon  => 'warning', -message => "file $new exist. Ok to overwrite?",
                     -title => "Link file",   -type => 'OKCancel');
    return 0 if ($rc !~ m/Ok/i);
  }
  if (!symlink ("$old", "$new")) {
    $top->messageBox(-icon  => 'warning', -message => "Could not link $old to $new: $!",
                     -title => "Link file",   -type => 'OK');
    return 0;
  }
  return 1;
}

##############################################################
# checkLinks - check if there are links, count them and ask
#              whether to proceed
##############################################################
sub checkLinks {
  my $lb       = shift; # listbox ref
  my @list     = @_;
  my $selected = @list;
  return 1 unless ($config{CheckForLinks});
  if (@list < 1) {
    warn "checkLinks: uops, list is empty. Aborting!";
    return 0;
  }
  my $links = 0;
  foreach my $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 = 0;
  if (defined $searchDB{$dpic}{SIZE}) {
    $b = $searchDB{$dpic}{SIZE};
  }
  else {
    $b = getFileSize($dpic, NO_FORMAT); # in Bytes
  }
  $b *= 8;                              # Bytes * 8 = bits
  my $p = getPixels($dpic);
  # avoid division by zero
  if ($p == 0) {
      $p = 1;
      $b = 0;
  }
  $quickSortHashBitsPixel{$dpic} = ($b/$p) if $quickSortSwitch;
  return ($b/$p);
}

##############################################################
# getPixels - get the number of pixels of a picture
##############################################################
sub getPixels {
  my $dpic = shift;
  return $quickSortHashPixel{$dpic} if ($quickSortSwitch and defined $quickSortHashPixel{$dpic});
  my $x = 0;
  my $y = 0;
  $x = $searchDB{$dpic}{PIXX} if $searchDB{$dpic}{PIXX};
  $y = $searchDB{$dpic}{PIXY} if $searchDB{$dpic}{PIXY};
  $quickSortHashPixel{$dpic} = int($x*$y) if $quickSortSwitch;
  return int($x*$y);
}

##############################################################
# getSize - get the image width and height
# returns 0,0 if no file or size available
##############################################################
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);
  }
  # remove non-digit chars, sometimes sizes like "48.000px" are returned
  if (defined $w) { $w =~ s|[a-z]||g; } else { $w = 0; }
  if (defined $h) { $h =~ s|[a-z]||g; } else { $h = 0; }
  #$w =~ s|[a-z]||g;
  #$h =~ s|[a-z]||g;
  #$w = 0 unless (defined $w);
  #$h = 0 unless (defined $h);
  return (int($w), int($h));
}

##############################################################
# is_a_JPEG - returns true (1) if the given file is a JPEG/JFIF
##############################################################
sub is_a_JPEG {
  my $dpic = shift;
  return 0 if (not defined $dpic);
  return 0 if (not -f $dpic);
  my @c;
  my $fh;
  # open file and read the first 3 bytes
  return 0 unless (open $fh,'<', $dpic);
  for my $i (0 .. 2) {
    read($fh, $c[$i], 1);
  }
  close $fh;

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

##############################################################
##############################################################
sub is_a_slideshow_file {
  my $file = shift;
  return 0 if (not defined $file);
  return 0 if (not -f $file);
  # match *.sld file name pattern
  return 1 if ($file =~ m/.*\.sld/); 
  return 1 if ($file =~ m/.*\.gqv/); 
  return 0;
}

##############################################################
# argument needs no path!
##############################################################
sub is_a_video {
  my $file = shift;
  return 0 if (not defined $file);
  return 0 if ($file eq '');
  return 1 if ($file =~ m/.*\.mov/i); 
  return 1 if ($file =~ m/.*\.mp4/i);
  return 1 if ($file =~ m/.*\.mpg/i); 
  return 1 if ($file =~ m/.*\.mkv/i); 
  return 1 if ($file =~ m/.*\.avi/i); 
  return 1 if ($file =~ m/.*\.ts/i); 
  return 0;
}

##############################################################
# make_mapivi_folders
##############################################################
sub make_mapivi_folders {
  if (!-d $user_data_path) {
    # ask the user for permission to create a configdir
    my $rc = $top->messageBox(-icon => 'question',
                              -message => "Mapivi would like to create the folder \"$user_data_path\" to store user specific data, like the search database, keyword tree, configuration, trash, etc. Please press Ok to create folder.",
                              -title => "Mapivi installation", -type => 'OKCancel');
    if ($rc =~ m/Ok/i) {
      if ( !mkdir $user_data_path, oct(700) ) {  # 0700 = only for the user
        $top->messageBox(-icon => 'warning', -message => "Error making folder $user_data_path: $!",
                         -title => "Mapivi installation", -type => 'OK');
        return;
      }
    }
    else {
      return;
    }
  }
  # make trash folder
  if (!-d $trashdir) {
    if ( !mkdir $trashdir, oct(755) ) {
      $top->messageBox(-icon => 'warning', -message => "Error making trashdir $trashdir: $!",
                       -title => "Mapivi installation", -type => 'OK');
      return;
    }
    else {
      if (!-d "$trashdir/$thumbdirname") {
        if ( !mkdir "$trashdir/$thumbdirname", oct(755) ) {
          $top->messageBox(-icon => 'warning', -message => "Error making trashthumbdir $trashdir/$thumbdirname: $!",
                           -title => "Mapivi installation", -type => 'OK');
          return;
        }
      }
    }
  }
}

##############################################################
# 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 { print "checkGeometry: window geometry ok\n" 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};
  foreach my $dir (@path) {
    foreach my $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";
      }
      # Windows may also have a .bat suffix
      elsif ($EvilOS) {
        if (-x "$dir/$prog.bat") {
          $exprogs{$prog}++;
        }
      }
    }
  }
}

##############################################################
# 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
# -> after this the entry is accessable via the new path
# e.g. old: /home/user/pic1.jpg  -> new: /home/user/myPic.jpg
# Hint: this function does not change the displayed name!
##############################################################
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 ($conf{show_clock}{value}) {
	# 1000ms = 1 second
    $clocktimer = $top->repeat(1000, \&showTimeOrMemory) if !$clocktimer;
    $clockL->pack(-side => 'left');
    showTimeOrMemory();
  }
  else {
    $clocktimer->cancel if $clocktimer;
    $time = ''; $date = '';
    $clockL->packForget() if (Exists($clockL));
  }
}

##############################################################
# showTimeOrMemory - calculate actual time or memory usage and
# display it in clockL label
##############################################################
sub showTimeOrMemory {
  return unless (Exists($clockL));
  if ($conf{clock_or_memory}{value}) {
    my $procTabAvail = (eval {require Proc::ProcessTable})  ? 1 : 0 ;
    $time = 'n.a.';
    $time = int(getMemoryUsage()/(1024*1024))."MB" if $procTabAvail;
    $date = "Memory usage of Mapivi.\nClick to show clock.";  
  }
  else {
	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\nClick to show memory.", $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 = getSelection($lb);
  return unless checkSelection($lb, 1, 0, \@sellist, lang("picture(s)"));
  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 => $conf{color_bg}{value}
                  )->pack(-side => 'top',-fill => 'x',-padx => 3,-pady => 3);
  my $w = 30;
  my $l1 = labeledEntry($htmlW, 'top', $w, "Title of Gallery",              \$config{HTMLGalleryTitle});
  my $l2 = labeledEntry($htmlW, 'top', $w, "Link to gallery index page",    \$config{HTMLGalleryIndex});
  my $l3 = labeledEntry($htmlW, 'top', $w, "Link to homepage",              \$config{HTMLHomepage});
  my $l4 = labeledEntry($htmlW, 'top', $w, "HTML footer",                   \$config{HTMLFooter});
  my $l5 = labeledEntryButton($htmlW,'top',$w,"HTML target folder",'Set',\$config{HTMLTargetDir},1);
  my $l6 = labeledEntryButton($htmlW,'top',$w,"HTML template file",'Set',   \$config{HTMLTemplate});
  $balloon->attach($l1, -msg => "The content of this entry will be\ninserted in the <!-- mapivi-galtitle --> field.");
  $balloon->attach($l2, -msg => "The content of this entry will be\ninserted in the <!-- mapivi-gallery-index --> field.");
  $balloon->attach($l3, -msg => "The content of this entry will be\ninserted in the <!-- mapivi-home --> field.");
  $balloon->attach($l4, -msg => "The content of this entry will be\ninserted in the <!-- mapivi-footer --> field.\nIt may contain a link to your homepage\nand your email address.");
  $balloon->attach($l5, -msg => "Mapivi will save the generated\npages and pictures in this folder.");
  $balloon->attach($l6, -msg => "This is the used HTML template.\nThere are some example templates\nin the Mapivi package.");
  #labeledEntry($htmlW, 'top', $w, "Background of picture",          \$config{HTMLBGcolor});
  my $picF;
  $htmlW->Checkbutton(-variable => \$config{HTMLnoPicChange},
                       -anchor => 'w',
                       -text => "Leave pictures untouched (just copy them)",
                      -command => sub {
                          my $state = 'normal';
                          $state = 'disabled' if ($config{HTMLnoPicChange});
                          setChildState($picF, $state);
                      })->pack(-anchor => 'w');
  $picF  = $htmlW->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3);
  $picF->Label(-text =>"HTML pictures",-bg => $conf{color_bg}{value}, -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, lang("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", oct(755) ) {
        $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, oct(755) ) {
        $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 $targetDir = $tmpconfR->{'HTMLTargetDir'};
  my $i      = 0;
  my $nrpics = @pics;
  foreach my $dpic (@pics) {
    $i++;
    my $pic  = basename($dpic);
    my $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)
        my $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 $table = "<table class=\"darkbox\">\n";
  my $i = 0;
  $htmlInfo = "building HTML thumbnail index ..."; $htmlW->update;
  foreach my $opic (@pics) {
    $i++;
    my $pic     = basename($opic);
    if ( $i % $tmpconfR->{HTMLcols} == 1 or $tmpconfR->{HTMLcols} == 1 ) { # start new table row (modulo)
      $table .= "<tr>\n";
    }
    #$lpic     = "$HTMLPicDir/$pic";
    my $dpic     = "$targetDir/$HTMLPicDir/$pic";
    my $lthumb   = "$HTMLThumbDir/$pic";
    my $size     = getFileSize($dpic, FORMAT);
    my ($tx, $ty)= getSize("$targetDir/$lthumb");
    my $picNoSuffix = $pic;
    # cut off trailing ".jpg"
    $picNoSuffix =~ s/\..*$//i;        # this is the name of the picture without .jpg suffix
    my $title = getIPTCObjectName($opic);
    $title = "$picNoSuffix" if ($title eq '');
    $title .= " ($size)";
    # replace (german) umlaute by corresponding HTML-tags
    $title    =~ s/([$umlauteHTML])/$umlauteHTML{$1}/g;
    my $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) = getDateTime($time);
  # 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;

  my $first_page;
  foreach my $dpic (@pics) {
    $pic = basename($dpic);
    $htmlpage = $bigrep{$pic}{'<!-- mapivi-this -->'};
    print "xxx pic=$pic html=$htmlpage ($dpic)\n" if $verbose;
    $htmlInfo = "building page $htmlpage ..."; $htmlW->update;

    $page = openTemplate($tmpconfR->{HTMLTemplate});
    last if (!defined $page); # jump out

    # 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);
    $first_page = "$targetDir/$htmlpage" if (!defined $first_page);
    $top->update;
  }
  
  if (defined $first_page and -f $first_page) {
    web_browser_open($first_page); 
  }
}

##############################################################
# 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)) {
    $htmlW->messageBox(-icon => 'error', -message => "cannot open template $template for reading: $!",
                         -title => 'Error', -type => 'OK');
    print "openTemplate: cannot open template $template for reading: ($!)\n";
    return;
  }

  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;
    #  todo: Mapivi should not die here
    open($outfile, '>', $file) or die "Couldn't open $file: $!";
    print $outfile $pageContent;
    close($outfile);
}

##############################################################
# cleanHTMLDirs - delete all files which are not needed anymore
##############################################################
sub cleanHTMLDirs {

  my $targetDir = shift;
  my @dpics     = @_;
  my @picsAct;
  my @toDelete;
  my $rc;
  my $pictures;

  # clean html files
  my @htmlfiles = grep {m/.*\.html$/i} getFiles($targetDir);
  if (@htmlfiles >= 1) {
    $rc = $htmlW->messageBox(-icon => 'question',
                             -message => scalar @htmlfiles." HTML pages should be deleted in $targetDir.\nOk, to delete?",
                             -title => "clean up HTML folders",
                             -type => 'OKCancel');
    if ($rc eq 'Ok') {
      foreach (@htmlfiles) {
        removeFile("$targetDir/$_");
      }
    }
  }

  # clean pictures and thumbs
  foreach my $dir ("$targetDir/$HTMLPicDir", "$targetDir/$HTMLThumbDir") {

    @picsAct = getPics($dir, JUST_FILE, NO_CHECK_JPEG); # no sort needed

    my @pics;

    # now we need the pics list without path
    push @pics, basename($_) foreach (@dpics);

    @toDelete = diffList(\@picsAct, \@pics);

    next if (@toDelete < 1);

    # choose the right word depending on the dir
    $pictures = "pictures";
    $pictures = "thumbnails" if ($dir =~ m/$HTMLThumbDir$/);

    $rc = $htmlW->messageBox(-icon => 'question',
                           -message => scalar @toDelete." $pictures should be deleted in\n$dir\nOk, to delete?",
                           -title => "clean up HTML folders",
                           -type => 'OKCancel');
    if ($rc !~ m/Ok/i) {
      next;
    }

    foreach (@toDelete) {
      removeFile ("$dir/$_");
    }
  }
}

##############################################################
# function test for cut_list()
##############################################################
#sub cut_list_test {
#  for (0 .. 10) {
#    my @list = ('a', 'b', 'c', 'd', 'e', 'f', 'g', 'h');
#    cut_list(\@list, $_);
#    if (@list != $_) {
#      print "Error test case $_: "; print "$_, " foreach @list; print "\n";
#    }
#    else {
#      print "test $_ ok!\n";
#    }
#  }
#}

##############################################################
# cut_list - operates directly on referenced list
##############################################################
sub cut_list {
  my ($list, $nr) = @_;
  #print "nr = $nr list elements: ".scalar(@$list)."\n";
  # nothing to do
  return if ($nr < 0);
  if ($nr == 0) { @$list = (); return; }
  return if ($nr > scalar @$list);
  # if there are less elements to remove than elements to preserve we pop from the end
  if ((scalar @$list - $nr) < $nr) {
    #print "  poping ...\n";
    pop @$list for (scalar $nr .. @$list-1);
  }
  else { # else we build a new list from the start
    #print "  pushing ...\n";
    my @new;
    push @new, $$list[$_] for (0 .. $nr-1);
    @$list = ();
    @$list = @new;
  }
  #print "nr = $nr list elements: ".scalar(@$list)."\n";
}

##############################################################
# diffList  - returns a list containing all elements of list1
#                   which are not in list2 (removes the elements of list2 from list1)
##############################################################
sub diffList {

  my $list1Ref = shift;  # reference to first list
  my $list2Ref = shift;  # reference to second list
  
  return () unless (@{$list1Ref});
  return (@{$list1Ref}) unless (@{$list2Ref});
  
  # build a hash
  my %d;
  $d{$_}++ foreach (@{$list1Ref});
  
  # delete all elements in hash, which are in list2
  foreach (@{$list2Ref}) {
    delete $d{$_} if (exists $d{$_});
  }

  return (keys %d);
}

##############################################################
# listIntersection  - returns a list containing all elements
#                     of list1 which are also in list2
##############################################################
sub listIntersection {

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

  my (@intersection, %count);
  foreach my $element (@{$list1Ref}, @{$list2Ref}) {
    $count{$element}++;
  }
  foreach my $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(lang("Compare folders"));
  $ddw->iconimage($mapiviicon) if $mapiviicon;

  my $f1  =	$ddw->Frame()->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()->pack(-side => 'top', -fill => 'y', -expand => 0, -padx => 3, -pady => 3, -anchor => 'w');
  my $f2b =	$f2->Frame()->pack(-side => 'top', -fill => 'both', -expand => 1, -padx => 3, -pady => 3, -anchor => 'w');

  my $ddlb;
  $ddw->Label(-textvariable => \$ddw->{label}, -anchor => 'w', -bg => $conf{color_bg}{value})->pack(-padx => 3, -anchor => 'w');
  $ddw->{label} = 'Choose folders to compare and press the "Compare" button.';

  my $dir_a_entry = labeledEntryButton($f1a,'top',15,lang("Folder")." A",'Set',\$config{dirDiffDirA},1);
  my $dir_b_entry = labeledEntryButton($f1a,'top',15,lang("Folder")." B",'Set',\$config{dirDiffDirB},1);
  
  my $entry_menu = $ddw->Menu(-title => lang("Entry Menu"));
  $entry_menu->command(-label => "A: Use current folder", -command => sub { $config{dirDiffDirA} = $actdir; });
  $entry_menu->command(-label => "A: Use B folder", -command => sub { $config{dirDiffDirA} = $config{dirDiffDirB}; });
  $entry_menu->command(-label => "B: Use current folder", -command => sub { $config{dirDiffDirB} = $actdir; });
  $entry_menu->command(-label => "B: Use A folder", -command => sub { $config{dirDiffDirB} = $config{dirDiffDirA}; });

  $ddlb = $ddw->Scrolled("HList",
                         -header     => 1,
                         -separator  => ';',  # todo here we hope that ; will never be in a folder or file name
                         -pady       => 0,
                         -columns    => 12,
                         -scrollbars => 'osoe',
                         -selectmode => "extended",
                         -background => $conf{color_bg}{value}, #8fa8bf
                         -width      => 40,
                         -height     => 20,
                        )->pack(-expand => 1, -fill => 'both');
  # key-i opens IPTC data of both pictures
  $ddlb->bind('<Key-i>', sub {
    return unless ($ddlb->info('children'));
    my @sellist = $ddlb->info('selection');
    return unless (@sellist);
    foreach (@sellist) {
      my $pic = $ddlb->itemCget($_, $ddlb->{namecol}, -text);
      foreach my $dir (qw(dirDiffDirA dirDiffDirB)) {
        my $dpic = $config{$dir}."/$pic";
        my $title = "IPTC/IIM info of $pic";
        my $iptc  = "File: $dpic\n".getIPTC($dpic, LONG);
        if ($iptc eq '') {
          $iptc = "Found no IPTC/IIM info in \"$dpic\"\n";
        }
        showText($title, $iptc, NO_WAIT);
      }
    }
 } );

  $balloon->attach($ddlb, -msg => "left click  : select\nmiddle click: Open picture in new window\nright click : open context menu\nkey i       : show IPTC info");

  my $col = 0;
  $ddlb->header('create', $col, -text => 'Differences', -headerbackground => $conf{color_entry}{value});
  $ddlb->{diffcol} = $col; $col++;
  $ddlb->header('create', $col, -text => 'Name', -headerbackground => $conf{color_entry}{value});
  $ddlb->{namecol} = $col; $col++;
  $ddlb->header('create', $col, -text => 'Thumbnail A', -headerbackground => $conf{color_entry}{value});
  $ddlb->{thumbAcol} = $col; $col++;
  $ddlb->header('create', $col, -text => 'Thumbnail B', -headerbackground => $conf{color_entry}{value});
  $ddlb->{thumbBcol} = $col; $col++;
  $ddlb->header('create', $col, -text => 'Size A', -headerbackground => $conf{color_entry}{value});
  $ddlb->{sizeAcol} = $col; $col++;
  $ddlb->header('create', $col, -text => 'Size B', -headerbackground => $conf{color_entry}{value});
  $ddlb->{sizeBcol} = $col; $col++;
  $ddlb->header('create', $col, -text => 'IPTC A', -headerbackground => $conf{color_entry}{value});
  $ddlb->{iptcAcol} = $col; $col++;
  $ddlb->header('create', $col, -text => 'IPTC B', -headerbackground => $conf{color_entry}{value});
  $ddlb->{iptcBcol} = $col; $col++;
  $ddlb->header('create', $col, -text => 'EXIF A', -headerbackground => $conf{color_entry}{value});
  $ddlb->{exifAcol} = $col; $col++;
  $ddlb->header('create', $col, -text => 'EXIF B', -headerbackground => $conf{color_entry}{value});
  $ddlb->{exifBcol} = $col; $col++;
  $ddlb->header('create', $col, -text => 'Comments A', -headerbackground => $conf{color_entry}{value});
  $ddlb->{comAcol} = $col; $col++;
  $ddlb->header('create', $col, -text => 'Comments B', -headerbackground => $conf{color_entry}{value});
  $ddlb->{comBcol} = $col; $col++;

  my $progress = 0;

  $f1b->Button(-image => $mapivi_icons{Preferences}, #-text => "Set",
              -command => sub {
                  $entry_menu->Popup(-popover => 'cursor', -popanchor => 'nw');
              })->pack(-fill => 'y', -side => 'left');

  $f1b->Button(-text => lang("Compare"),
              -command => sub {
                # check both dirs first
                foreach ($config{dirDiffDirA}, $config{dirDiffDirB}) {
                  unless (-d $_) {
                    $ddw->messageBox(-icon => 'warning', -message => langf("Folder \"%s\" is not valid!",$_),
                                     -title => lang('Error'), -type => 'OK');
                    return;
                  }
                }
                if ($config{dirDiffDirA} eq $config{dirDiffDirB}) {
                    $ddw->messageBox(-icon => 'warning', -message => lang("Please choose two different folders!"),
                                     -title => lang('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} = langf("Found %d unique pictures in A, %d unique pictures in B and %d matching pictures",scalar @onlyInDirA,scalar @onlyInDirB,scalar @intersec);
                $ddw->update;
                my $pics = @onlyInDirA +  @onlyInDirB + @intersec;
                my $last_time;
                my $i = 0;
                foreach my $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 my $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 my $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} .= langf(" (%d of them differ)",$inter);
                $ddw->Unbusy;
              })->pack(-fill => 'y', -side => 'left');

  $f1b->Button(-text => lang("Close"),
              -command => sub {
                $ddw->destroy;
              })->pack(-fill => 'y', -side => 'left');

  $f2a->Label(-text => lang("Compare by "), -anchor => 'w', -bg => $conf{color_bg}{value})->pack(-side => 'left', -padx => 3);
  $f2a->Checkbutton(-variable => \$config{dirDiffSize}, -text => lang("File size"))->pack(-side => 'left');
  $f2a->Checkbutton(-variable => \$config{dirDiffPixel}, -text => lang("Number of pixels"))->pack(-side => 'left');
  $f2a->Checkbutton(-variable => \$config{dirDiffComment}, -text => lang("Comments"))->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 => lang("Copy A->B"),
              -command => sub {
                return unless ($ddlb->info('children'));
                my @sellist = $ddlb->info('selection');
                return unless (@sellist);
                my $i  = 0;	my $overwrite = OVERWRITE;	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
                  $overwrite = overwritePic($tpic, $dpic, (scalar(@sellist) - $i + 1)) if ($overwrite != OVERWRITEALL);
                  next if ($overwrite == CANCEL);
                  last if ($overwrite == CANCELALL);
                  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 => lang("Copy A<-B"),
              -command => sub {
                return unless ($ddlb->info('children'));
                my @sellist = $ddlb->info('selection');
                return unless (@sellist);
                my $i  = 0;	my $overwrite = OVERWRITE;	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
                  $overwrite = overwritePic($tpic, $dpic, (scalar(@sellist) - $i + 1)) if ($overwrite != OVERWRITEALL);
                  next if ($overwrite == CANCEL);
                  last if ($overwrite == CANCELALL);
                  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 => lang("Delete A"),
              -command => sub {
                return unless ($ddlb->info('children'));
                my @sellist = $ddlb->info('selection');
                return unless (@sellist);
                my $rc = $ddw->messageBox(-message => "Really delete ".scalar @sellist." pictures in folder ".$config{dirDiffDirA}."?",
                       -icon => 'question', -title => "Really delete?", -type => 'OKCancel');
                return unless ($rc =~ m/Ok/i);

                my $i  = 0; my $n  = 0;
                foreach (@sellist) {
                  my $pic = $ddlb->itemCget($_, $ddlb->{namecol}, -text);
                  $i++;
                  $ddw->{label} = "deleting ($i/".scalar @sellist.") ... "; $ddw->update;
                  my $dpic = $config{dirDiffDirA}."/$pic";
                  unless (-f $dpic) { print "$dpic not found!\n"; next;}
                  if (move($dpic, $trashdir)) {       # move pic to trash
                    $n++;
                    my $tpic = "$trashdir/$pic";
                    # change the location info in the search database
                    $searchDB{$tpic} = $searchDB{$dpic};
                    delete $searchDB{$dpic};
                    deleteCachedPics($dpic);
                    # todo move thumbnail?
                    # todo deleting the entry is wrong, if picture exists in both dirs
                    $ddlb->delete("entry", $_); # remove entry from list box
                  }
                }								# foreach - end
                $ddw->{label} = "ready! ($n/".scalar @sellist." deleted)"; $ddw->update;
              })->pack(-fill => 'x', -side => 'left', -padx => 2, -pady => 2);

  $f2b->Button(-text => lang("Delete B"),
              -command => sub {
                return unless ($ddlb->info('children'));
                my @sellist = $ddlb->info('selection');
                return unless (@sellist);
                my $rc = $ddw->messageBox(-message => "Really delete ".scalar @sellist." pictures in folder ".$config{dirDiffDirB}."?",
                       -icon => 'question', -title => "Really delete?", -type => 'OKCancel');
                return unless ($rc =~ m/Ok/i);

                my $i  = 0; my $n  = 0;
                foreach (@sellist) {
                  my $pic = $ddlb->itemCget($_, $ddlb->{namecol}, -text);
                  $i++;
                  $ddw->{label} = "deleting ($i/".scalar @sellist.") ... "; $ddw->update;
                  my $dpic = $config{dirDiffDirB}."/$pic";
                  unless (-f $dpic) { print "$dpic not found!\n"; next;}
                  if (move($dpic, $trashdir)) {       # move pic to trash
                    $n++;
                    my $tpic = "$trashdir/$pic";
                    # change the location info in the search database
                    $searchDB{$tpic} = $searchDB{$dpic};
                    delete $searchDB{$dpic};
                    deleteCachedPics($dpic);
                    # todo move thumbnail?
                    # todo deleting the entry is wrong, if picture exists in both dirs
                    $ddlb->delete("entry", $_); # remove entry from list box
                  }
                }								# foreach - end
                $ddw->{label} = "ready! ($n/".scalar @sellist." deleted)"; $ddw->update;
              })->pack(-fill => 'x', -side => 'left', -padx => 2, -pady => 2);

  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 => 'y', -padx => 3, -pady => 3, -anchor => 'w');
  $balloon->attach($progBar, -msg => lang("Compare progress"));

  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, $rating_sizeA, $rating_sizeB, $comA, $comB, $exifA, $exifB, $iptcA, $iptcB);
  
  if (-f $dpicA) {
    $comA  = getComment($dpicA, SHORT);
    $exifA = getShortEXIF($dpicA, WRAP);
    $iptcA = getShortIPTC($dpicA, SHORT);
    $rating_sizeA = get_rating_and_size($dpicA, $lb);
    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);
    $rating_sizeB = get_rating_and_size($dpicB, $lb);
    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 => $comS);
  $lb->itemCreate($count, $lb->{sizeAcol}, -itemtype => "image", -image => $rating_sizeA,  -style => $fileS);
  $lb->itemCreate($count, $lb->{sizeBcol}, -itemtype => "image", -image => $rating_sizeB,  -style => $fileS);
  $lb->itemCreate($count, $lb->{comAcol},  -text => $comA,   -style => $comS);
  $lb->itemCreate($count, $lb->{comBcol},  -text => $comB,   -style => $comS);
  $lb->itemCreate($count, $lb->{exifAcol}, -text => $exifA,  -style => $exifS);
  $lb->itemCreate($count, $lb->{exifBcol}, -text => $exifB,  -style => $exifS);
  $lb->itemCreate($count, $lb->{iptcAcol}, -text => $iptcA,  -style => $iptcS);
  $lb->itemCreate($count, $lb->{iptcBcol}, -text => $iptcB,  -style => $iptcS);
  
}

##############################################################
# 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 @pics1 = getPics($dir1, JUST_FILE, NO_CHECK_JPEG); # no sort needed
  my @pics2 = getPics($dir2, JUST_FILE, NO_CHECK_JPEG); # no sort needed

  @{$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 = lang("Key shortcuts");

  showText($title, $text, NO_WAIT);
}

##############################################################
# buildDatabase - scans through all sub folders of
#                        the actual dir an collects JPEG files
#                        let the user select in which dirs
#                        mapivi should build/refresh thumbnails
##############################################################
sub buildDatabase {
  my $mydir = getRightDir();
  my $rc = checkDialog( 'Add pictures to database in all sub folders',
                        'Mapivi will create a list of all sub folders of folder "'.basename($mydir).'" containing pictures.
You are then able to select folders from the list.',
                        \$config{SearchDBOnlyNew},
                        "add only new pictures",
                        '',
                        'OK', 'Cancel');
  return if ($rc ne 'OK');
  log_it("searching sub folders ...");
  my ($ok, $dirlist, $pic_count, $nr_of_pics_in_dir) = get_subdirs($mydir);
  log_it("Found ".scalar @{$dirlist}." folders with $pic_count pictures.");
  return if (not $ok);
  @{$dirlist} = sort @{$dirlist};
  my @sellist;
  if (scalar @{$dirlist} == 1) { # no sub folder found -> no selection needed
    push @sellist, 0; # just add index number 0 to list
  }
  else {
    return if (!mySelListBoxDialog(lang("Select folders"),
                                 "Found ".scalar @{$dirlist}." folders with $pic_count JPEG pictures.\nThe database will be updated with the pictures of the selected folders.",
                                 MULTIPLE,
                                 "add to database", \@sellist, @{$dirlist}));
  }
  return if (not @sellist); # return if nothing is selected                               
  # copy the selected elements into the @sel_dirs list
  my @sel_dirs;
  my $sel_pic_count = 0;
  foreach (@sellist) { # sellist contains just the index numbers of the selected items
    push @sel_dirs, $$dirlist[$_]; 
    # add number of pics in selected folders
    $sel_pic_count += $$nr_of_pics_in_dir{$$dirlist[$_]}
  }
  my $pw = progressWinInit($top, "add to database");
  my $i = 0;
  my $new = 0;
  foreach my $dir (@sel_dirs) {
    last if progressWinCheck($pw);
    my $dirshort = cutString($dir, -40, "...");
    print "build database recursive in $dir\n" if $verbose;
    my @dpics = getPics($dir, WITH_PATH, NO_CHECK_JPEG); # no sorting needed
    foreach (@dpics) {
      last if progressWinCheck($pw);
      $i++;
      progressWinUpdate($pw, "Adding metadata of picture ($i/$sel_pic_count) to database.\nProcessing folder $dirshort", $i, $sel_pic_count);
      next if ($config{SearchDBOnlyNew} and exists $searchDB{$_});
      addToSearchDB($_);
      $new++;
    }
  }
  progressWinEnd($pw);
  log_it("database updated (scanned $i pictures, $new added)");
  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 "$user_data_path/ignorePaths") {
    my $hashRef = retrieve("$user_data_path/ignorePaths");
    warn "could not retrieve ignorePaths" unless defined $hashRef;
    %ignorePaths = %{$hashRef};
  }
  my $rc = editHashDialog(lang('Clean database'),
                          '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,
                          lang('Start cleaning'),
                          lang('Cancel'),
                          1 );
  return if ($rc ne 'OK');
  nstore(\%ignorePaths, "$user_data_path/ignorePaths") or warn "could not store ignorePaths";
  log_it("cleaning database - please wait ...");
  my $pw    = progressWinInit($top, lang("Cleaning database"));
  my $i     = 0;
  # loop through all database entries
  foreach my $pic (sort keys %searchDB) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, lang("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 .= '('.lang('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);
  log_it(lang("Cleaning database - ready"));
  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($searchDBfile, 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(lang("Clean database"), $text, WAIT);
}

##############################################################
# cleanDatabaseFolder - clean the database in one folder
##############################################################
sub cleanDatabaseFolder {
  my $directory = shift;
  log_it("updating database - please wait ...");
  my $pw = progressWinInit($top, "updating search database");
  my $i = 0;
  my $keys = keys %searchDB;
  # loop through all database entries
  foreach my $pic (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)) {
      delete $searchDB{$pic};
    }
  }
  progressWinEnd($pw);
  log_it("database updated!");
}

##############################################################
# renameDatabaseFolder - rename a folder in  the database
##############################################################
sub renameDatabaseFolder {
  my $olddir = shift;
  my $newdir = shift;
  log_it("updating database - please wait ...");
  my $pw = progressWinInit($top, "updating search database");
  my $i = 0;
  my $moved = 0; my $deleted = 0;
  my $keys = keys %searchDB;
  # loop through all database entries
  foreach my $dpic (keys %searchDB) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "checking ($i/$keys) ...", $i, $keys);
    # if the pic path matches the old path
    if ($dpic =~ m/^$olddir/) {
      my $ndpic = $newdir.'/'.basename($dpic);
      if (-f $ndpic) {
        # add existing info to new hash entry
        $searchDB{$ndpic} = $searchDB{$dpic};
        # and update the path info
        $searchDB{$ndpic}{odir} = $newdir;
        $moved++;
      }
      # delete the picture from the database
      delete $searchDB{$dpic};
      $deleted++;
    }
  }
  progressWinEnd($pw);
  log_it("Database updated! Moved $moved pictures.");
  # safety check
  warn "renameDatabaseFolder: Moved $moved and deleted $deleted pictures. Both numbers should be the same!" if ($deleted > $moved);
}
##############################################################
# diff_database_statistic
##############################################################
sub diff_database_statistic {
  log_it("generating database statistics ...");
  my $statistic_file = "$user_data_path/database_statistic";
  my $statistics_last;
  my $ok = 0;
  if (-f $statistic_file) {
    my $hashRef = retrieve($statistic_file);
    if (defined $hashRef) {
      $ok = 1;
      $statistics_last = $hashRef;
    }
    else {
      warn "could not retrieve $statistic_file";
    }
  }
  my $statistics = database_statistic(keys(%statistic_data_longnames));
  my $keys = keys %searchDB;
  if ($ok) {
    my $info = get_database_info().".\n\n";
    foreach my $data_kind (sort keys %$statistics) {
      $info .= sprintf "%30s: %6d (%03.1f%%)\n",
                lang("pictures with ").$statistic_data_longnames{$data_kind},
                $$statistics{$data_kind}, $$statistics{$data_kind}/$keys*100;
    }
    # retrieve the number of database entries at last check
    my $keys_last = $$statistics_last{'Nr_of_entries'};
    if (defined $keys_last) {
      $info .= "\n".lang("Changes to last database statistic");
      my $age = getAgeOfFile($statistic_file);
      $info .= langf(", which was %s ago", $age) if ($age ne '');
      $info .= ":\n";
      my $keys_diff = $keys-$keys_last;
      my $sign = ''; $sign = '+' if ($keys_diff > 0); 
      my $diff_info = '';
      $diff_info = sprintf "%30s: %s%d\n", lang("pictures"), $sign, $keys_diff if ($keys_diff != 0);
      foreach my $data_kind (sort keys %$statistics) {
        my $diff = $$statistics{$data_kind}-$$statistics_last{$data_kind};
        if ($diff != 0) {
          my $sign = ''; $sign = '+' if ($diff > 0); 
          $diff_info .= sprintf "%30s: %s%d\n", lang("pictures with ").$statistic_data_longnames{$data_kind}, $sign, $diff;
        }
      }
      if ($diff_info ne '') {
        $info .= $diff_info;
      }
      else {
        $info .= lang("No changes since last call."); 
      }
    }
    showText(lang("Database Statistics"), $info, WAIT);
  }
  # store the actual number of database entries
  $$statistics{'Nr_of_entries'} = $keys;
  nstore($statistics, $statistic_file) or warn "could not store $statistic_file: $!";
  log_it("database statistics finished!");
}

##############################################################
##############################################################
sub database_statistic {
  my @keys = @_; #  
  my $i = 0;
  my %statistics;
  # Warning! The keys names in @keys have to be same as in the %searchDB hash!!!
  my $pw = progressWinInit($top, "generating database statistics");
  my $keys = keys %searchDB;
  # loop through all database entries and count pics with these kinds of metadata:
  foreach my $dpic (keys %searchDB) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "analyzing pictures ($i/$keys) ...", $i, $keys);
    foreach my $data_kind (@keys) {
      my $data = $searchDB{$dpic}{$data_kind};
      if (defined $data and ($data ne '')) {
        $statistics{$data_kind}++;
      }
    }
  }
  progressWinEnd($pw);
  return \%statistics;
}

##############################################################
# 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 => $conf{color_bg}{value},
                             -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);

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

  $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 => $conf{color_bg}{value})->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 (undef,undef,undef,undef,$mo,$y) = getDateTime($searchDB{$dpic}{TIME});
      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 (or the number of pictures above the box or on the month below 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 ($current) = $canvas->find('withtag', 'current');
                my @tags = $canvas->gettags($current);
                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 ($current) = $canvas->find('withtag', 'current');
            my @tags = $canvas->gettags($current);
            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);
            return if ($chrono_hash{$yyyymm} == 0);
            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 => $conf{color_act_bg}{value},
                    -outline => $config{ColorSel},
                    -tags => $yyyymm,
            -width => 1,
        );
        
    # mark month border
    $canvas->createLine( $x, $h-$axis_h, $x, $h-int(0.5*$axis_h), -fill => $conf{color_fg}{value});
    # mark year border
    if ($act_month eq '01') {
      $canvas->createLine( $x, $h-$axis_h, $x, $h, -fill => $conf{color_fg}{value});
    }
    # 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 => $conf{color_fg}{value}, -tags => $yyyymm);
    }
    # write number of pics if enough space and number of pics bigger than 0
    if (($month_w > length($chrono_hash->{$yyyymm})*8) and ($chrono_hash->{$yyyymm} > 0)) {
        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 => $conf{color_fg}{value}, -tags => $yyyymm);
    
    }
    # write year
    if ($act_month eq '07') {
      $canvas->createText($x, $h, -font => $small_font, -text => $act_year, -anchor => 's', -justify => 'center', -fill => $conf{color_fg}{value});
    }
    $step++;
    $x = int($month_w * $step);
  }

  # draw x axis
  $canvas->createLine( 0, $h-$axis_h, $month_nr*$month_w, $h-$axis_h, -fill => $conf{color_fg}{value});
}

##############################################################
# keyword_browse -  browse picture collection by keywords (tagclouds) 
##############################################################
sub keyword_browse {
  # list of keywords to constraint the browsing/searching
  my @search_keys;
  # list of keywords to exclude from browsing/searching
  my @exclude_keys; 
  # get stored values
  if ($config{KeywordExclude}) {
    @exclude_keys = split / /, $config{KeywordExclude};
  }
  # open window
  my $win = $top->Toplevel();
  $win->title('Keyword browser (tag cloud)');
  $win->iconimage($mapiviicon) if $mapiviicon;
  my $cc;
  my $butF  = $win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
  my $butF2 = $win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
  my $butF3 = $win->Frame(-relief => 'groove');
  if ($config{KeywordMore}) {
    $butF3->pack(-after => $butF2, -expand => 0, -fill => 'x', -padx => 4, -pady => 3);
  }
  else { $butF3->packForget(); }
  my $add_mode = 1;
  my $label = '';
  my $hb = $butF->Button(-text => 'home',
                -command => sub {
                  # reset search_keys
                  @search_keys = ();
                  $label = '';
                  show_keywords($win, \@search_keys, \@exclude_keys);
                })->pack(-side => 'left', -padx => 3);
  $balloon->attach($hb, -msg => "Restart\nShow all keywords");
  my $bb = $butF->Button(-text => 'back',
                -command => sub {
                  return unless (@search_keys);
                  # remove last element of array  search_keys
                  pop @search_keys;
                  $label = '';
                  $label .= "$_ " foreach (@search_keys);
                  show_keywords($win, \@search_keys, \@exclude_keys);
                })->pack(-side => 'left', -padx => 3);
  $balloon->attach($bb, -msg => "Go back\nRemove last keyword from list");
  $butF->Label(-textvariable => \$label,
                )->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 1, -pady => 1);
  my $addB = $butF->Checkbutton(-text => 'add mode', -variable => \$add_mode)->pack(-side => 'left');
  $balloon->attach($addB, -msg => 'If add mode is enabled, keywords will be added
and the search is narrowed to pictures
containing all displayed keywords.
If add mode is disabled, each click on a keyword
will start a new search for just this keyword.');

  my $Xbut = $butF->Button(-text => lang('Close'),
                           -command => sub {
                             # store excluded keywords for next session
                             $config{KeywordExclude} = '';
                             $config{KeywordExclude} .= "$_ " foreach (@exclude_keys);
                             # clode window
                             $win->destroy();
                           })->pack(-side => 'right', -padx => 3);
  $balloon->attach($Xbut, -msg => 'Close window (key: ESC)');
  bind_exit_keys_to_button($win, $Xbut);
  $butF2->Button(-text => lang('Show'),
                -command => sub {
                  my @list = get_pics_with_keywords(\@search_keys, \@exclude_keys);
                  showThumbList(\@list, $label);
                })->pack(-side => 'left', -padx => 3);
  $butF2->Button(-text => 'show m',
                -command => sub {
                  $act_modus = KEYWORDCLOUD;
                  @act_keywords    = @search_keys;
                  @act_keywords_ex = @exclude_keys;
                  showThumbs();
                })->pack(-side => 'left', -padx => 3);
  my $lab2 = $butF2->Label(-textvariable => \$win->{label2}, -anchor => 'w'
                )->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 3, -pady => 1);
  $balloon->attach($lab2, -msg => "x pictures (y/z keywords)\nx = number of pictures with the selected keywords\ny = number of displayed keywords\nz = number of all matching keywords");

  my $more_button;
  $more_button = $butF2->Checkbutton(-variable => \$config{KeywordMore},
                      -text => 'more options',
                      -command => sub {
                        if ($config{KeywordMore}) {
                          $butF3->pack(-after => $butF2, -expand => 0, -fill => 'x', -padx => 4, -pady => 3);
                        }
                        else { $butF3->packForget(); }
                      })->pack(-side => 'right', -padx => 5);
  $balloon->attach($more_button, -msg => 'Click here to see some more options');
 
  my $label_ex = ''; $label_ex .= "$_ " foreach (@exclude_keys);
  my $butF3i = $butF3->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
  my $ceb = $butF3i->Button(-text => 'clear',
                -command => sub {
                  # reset exclude_keys
                  @exclude_keys = ();
                  $label_ex = '';
                  show_keywords($win, \@search_keys, \@exclude_keys);
                })->pack(-side => 'left', -padx => 3);
  $balloon->attach($ceb, -msg => "Clear all keywords from exclude list");
  $butF3i->Label(-text => 'Excluded:',
                )->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 1, -pady => 1);
  $butF3i->Label(-textvariable => \$label_ex,
                )->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 1, -pady => 1);
  $butF3->Label(-text => 'Right click to select a keyword, left click to exclude it')->pack(-anchor => 'w', -padx => 3);

  my $lib = $butF3->Checkbutton(-variable => \$config{KeywordLimit},
                      -text => 'Limit to 100 keywords',
                      -command => sub {show_keywords($win, \@search_keys, \@exclude_keys);}
                      )->pack(-anchor => 'w', -padx => 3);             
  $balloon->attach($lib, -msg => 'Limit to a maximum of the 100 most popular keywords.');

  my $butF3j = $butF3->Frame()->pack(-fill =>'x', -padx => 0, -pady => 0);
  my $dab = $butF3j->Checkbutton(-variable => \$config{KeywordDate},
                      -text => 'Limit by date between  ',
                      -command => sub {show_keywords($win, \@search_keys, \@exclude_keys);}
                      )->pack(-side => 'left', -anchor => 'sw', -pady => 0);             
  $balloon->attach($dab, -msg => "Limit to a date range.\nThe first scale is the first day of the selected year\nthe second scale is the last day of the selected year.\nIf both scales show e.g. 2009 only keywords from pictures taken\nbetween 2009-01-01 and 2009-12-31 are shown.\nThe EXIF date is used for this function.");

  # get date limits (absolute limits) from searchDB
  my ($first, $last) = get_date_limits();

  # get the actual selected limits from the configuration hash
  my (undef,undef,undef,undef,undef,$start) = getDateTime($config{KeywordStart});
  my (undef,undef,undef,undef,undef,$end) = getDateTime($config{KeywordEnd});

  $butF3j->Scale(-variable => \$start,
         -from => $first,
         -to => $last,
         -resolution => 1,
         -sliderlength => 30,
         -orient => 'horizontal',
         -showvalue => 1,
         -width => 15,
         -command => sub {
             $end = $start if ($end < $start);
             $win->{LAST_RESCALE_TIMER_MH}->cancel if ($win->{LAST_RESCALE_TIMER_MH});
             # after 500 msec we recalculate the keywords this gives better responsiveness
             $win->{LAST_RESCALE_TIMER_MH} = $win->after(500, sub {
                # sec,min,hour,day,mon,year (day = 1-31 month = 0-11)
                $config{KeywordStart} = timelocal(0,0,0,1,0,$start);
                $config{KeywordEnd} = timelocal(0,0,0,31,11,$end);
                show_keywords($win, \@search_keys, \@exclude_keys) if $config{KeywordDate};
              });
             })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 0);
  $butF3j->Scale(-variable => \$end,
         -from => $first,
         -to => $last,
         -resolution => 1,
         -sliderlength => 30,
         -orient => 'horizontal',
         -showvalue => 1,
         -width => 15,
         -command => sub {
             $start = $end if ($start > $end);
             $win->{LAST_RESCALE_TIMER_MH}->cancel if ($win->{LAST_RESCALE_TIMER_MH});
             # after 500 msec we recalculate the keywords this gives better responsiveness
             $win->{LAST_RESCALE_TIMER_MH} = $win->after(500, sub {
                # sec,min,hour,day,mon,year (day = 1-31 month = 0-11)
                $config{KeywordStart} = timelocal(0,0,0,1,0,$start);
                $config{KeywordEnd} = timelocal(0,0,0,31,11,$end);
                show_keywords($win, \@search_keys, \@exclude_keys) if $config{KeywordDate};
              });
         })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 0);

  my $butF3k = $butF3->Frame()->pack(-fill =>'x', -padx => 0, -pady => 0);
  my $rab = $butF3k->Checkbutton(-variable => \$conf{nav_rating_on}{value},
                      -text => 'Limit by rating between',
                      -command => sub {show_keywords($win, \@search_keys, \@exclude_keys);}
                      )->pack(-side => 'left', -anchor => 'sw', -pady => 3);             
  $balloon->attach($rab, -msg => "Limit to a rating range.\nIf the first scale shows e.g. 2 and the second scale shows 4\nonly keywords from pictures with a rating of 2, 3 or 4 are shown.\nThe IPTC urgency is used for this function.\nNote: 1 is the highest (best) rating, 8 the lowest.");

  rating_button_min_max($butF3k, \$conf{search_rating_max}{value}, \$conf{search_rating_min}{value},
        sub {
             $win->{LAST_RESCALE_TIMER_MH}->cancel if ($win->{LAST_RESCALE_TIMER_MH});
             # after 500 msec we recalculate the keywords this gives better responsiveness
             $win->{LAST_RESCALE_TIMER_MH} = $win->after(500, sub {
               show_keywords($win, \@search_keys, \@exclude_keys) if $conf{nav_rating_on}{value};
             });
            });
         $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 ($current) = $cc->find('withtag', 'current');
    my @tags = $cc->gettags($current);
    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 ($current) = $cc->find('withtag', 'current');
    my @tags = $cc->gettags($current);
    foreach (@tags) {
      next if ($_ eq 'current');
      push @exclude_keys, $_ unless (isInList($_, \@exclude_keys));
    }
    $label_ex = '';
    $label_ex .= "$_ " foreach (@exclude_keys);
    show_keywords($win, \@search_keys, \@exclude_keys);
  });
 # wait for the close button
 $win->waitWindow;
}

##############################################################
# get_date_limits - get the first and the last year from database
##############################################################
sub get_date_limits {
    my $first = 99999999999;
    my $last  = 0;
    # using each instead of keys (about 1.5 times faster)
    # http://stackoverflow.com/questions/22841830
    # Pros:
    # This uses very little memory as every time each is called it only
    # returns a pair of (key, value) element.
    # Cons:
    # You can't order the output by key.
    # The iterator it uses belongs to %h. If the code inside the loop calls
    # something that does keys %h, values %h or each %h, then the loop won't
    # work properly, because %h only has 1 iterator
    while (my ($dpic, undef) = each %searchDB) {
      my $time = $searchDB{$dpic}{TIME};
      if ($time) {
        $last  = $time if ($time > $last);
        $first = $time if ($time < $first);
      }
    }
    # from UNIX time to calendar years
    (undef,undef,undef,undef,undef,$last) = getDateTime($last);
    (undef,undef,undef,undef,undef,$first) = getDateTime($first);
    return ($first, $last);
}

##############################################################
# show_keywords - add keyword cloud to a canvas
##############################################################
sub show_keywords {
  my $win = shift; # canvas
  my $search_keys = shift; # list reference for keywords which must be contained
  my $exclude_keys = shift; # list reference for keywords which must not be contained
  $win->Busy;
  # get the keywords according to the search keyword list ($search_keys)
  my ($count, %keyword_hash) = get_keywords($search_keys, $exclude_keys);
  my $all_keys = keys %keyword_hash;
  # we expect, that the window widget has an element called canvas
  my $cc = $win->{canvas};
  # clear canvas
  $cc->delete('all');
  $win->update;
  my $cc_width = $cc->width;
  my $win_width = $win->width;
  # 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;
  }
  if ($config{KeywordLimit}) {
    $win->{label2} = langf("%d pictures, %d/%d keywords", $count, scalar(keys(%keyword_hash)),$all_keys);
  }
  else {
    $win->{label2} = langf("%d pictures, %d keywords", $count, scalar(keys(%keyword_hash)));
  }
  if (keys %keyword_hash > 0) {
    # find max an min numbers
    my $min = 9999999; my $max = 0;
    foreach (keys %keyword_hash) {
      $min = $keyword_hash{$_} if ($keyword_hash{$_} < $min);
      $max = $keyword_hash{$_} if ($keyword_hash{$_} > $max);
    }
    # to have a nice size distribution we need the log function
    my $diff = 1;
    $diff = log($max - $min) if ($max != $min); # log(1) = 0! log(0) = -infinite
    #print "max $max min $min diff $diff\n";
    $diff = 0.1 if ($diff == 0); # prevent division by zero
    # maximum and minimum font size for tag cloud
    my $font_min = 7;
    my $font_max = 18;
    my $font_middle = int(($font_max-$font_min)/2 + $font_min);
    # h and v space between tags/keywords
    my $x_space = 5;
    my $y_space = 3;
    my $x_max = 0;
    my $x = $x_space;
    my $y = $y_space + int($font_max/2);
    # sort keywords alphabetical
    foreach my $key (sort keys %keyword_hash) {
      my $size = $font_middle;
      # to have a nice size distribution we need the log function
      $size = int(log($keyword_hash{$key} - $min + 1)/$diff * ($font_max-$font_min) + $font_min) if ($max != $min);
      #printf "%-20s %5d %2.2f size: %2d", $key, $keyword_hash{$key}, log($keyword_hash{$key})/$diff, $size;
      # safety check
      $size = $font_max if ($size > $font_max);
      $size = $font_min if ($size < $font_min);
      #print " $size\n";
    
      # bold style for the bigger fonts
      my $style = 'normal';
      $style = 'bold' if ($size >= $font_middle);
      my $font = $top->Font(-family => $config{PropFontFamily}, -size => $size, -weight => $style);
    
      # the more often a keyword is used there brighter it is displayed 
      my $color_percent = 100;
      $color_percent = int(log($keyword_hash{$key} - $min + 1)/$diff * 100) if ($max != $min);
      my $color = $win->Darken($config{ColorCloud}, $color_percent); # '#5D7298'
    
      # 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 used canvas space
      my ($x1, $y1, $x2, $y2) = $cc->bbox($id);
    
      # calculate next coordinates
      $x += ($x2 - $x1) + $x_space;
      # if we are over the right border we move the last keyword to the next line
      if ($x > $cc_width) {
        $x = $x_space;
        $y += ($font_max + $y_space);
        # move text
        $cc->coords($id, $x, $y);
        # get the used canvas space again
        my ($x1, $y1, $x2, $y2) = $cc->bbox($id);
        # calculate next coordinates
        $x += ($x2 - $x1) + $x_space;
        # if we are now over the right border we have to increase the scrollregion
        $x_max = $x if ($x > $x_max);
      }
    }
    # adjust the canvas scrollbars to the used space
    $cc->configure(-scrollregion => [0, 0, $x_max, ($y + int($font_max/2) + $y_space)]);
  }
  else {
    # adjust the canvas scrollbars to the used space
    $cc->configure(-scrollregion => [0, 0, 0, 0]);
  }
  $win->Unbusy;
  return;
}

##############################################################
# returns true is the urgency urg is between min and max
# function considers special cases like undefined urgency and 
# max and min values of 0
##############################################################
sub rating_valid {
  my ($urg, $max, $min) = @_;  # all in IPTC scale (1 = best, 8 = lowest, 0 = no rating)
  my $ok = 0;
  if (not defined $urg) {
    if ($min == 0) {
      $ok = 1; # valid if urgency is undefined and min = 0
    }
  }
  else { # urgency is defined
    if (($max > 0) and ($urg >= $max)) {
      if (($min == 0) or (($min > 0) and ($urg <= $min))) {
        $ok = 1; # normal case: urgency is between min and max if min is defined, else below max is enough
      }
    }
  }
  return $ok;
}

##############################################################
# get_keywords - get all keywords from the searchDB (may be restriced by a keyword list ($search_keys))
##############################################################
sub get_keywords {
  my $search_keys = shift; # list reference for included keywords
  my $exclude_keys = shift; # list reference for excluded keywords
  my %keyword_hash;
  my $count = 0;
  # build keyword/tag hash
  # loop through all pictures in the DB
  foreach my $dpic (keys %searchDB) {
    # skip if no keywords info in picture
    next unless (defined $searchDB{$dpic}{KEYS});
    if ($config{KeywordDate}) {
      next if (defined $searchDB{$dpic}{TIME} and ($searchDB{$dpic}{TIME} < $config{KeywordStart}));
      next if (defined $searchDB{$dpic}{TIME} and ($searchDB{$dpic}{TIME} > $config{KeywordEnd}));
    }
    if ($conf{nav_rating_on}{value}) {
      next if (not rating_valid($searchDB{$dpic}{URG}, $conf{search_rating_max}{value}, $conf{search_rating_min}{value}));
    }
    # check if any items of the exclude_keys list are contained in this keyword string
    next if (string_contains($searchDB{$dpic}{KEYS}, $exclude_keys));
    # check if all items of the search_keys list are contained in this keyword string
    next if (string_contains_not($searchDB{$dpic}{KEYS}, $search_keys));
    #count number of pictures matching all keywords of the search keyword list
    $count++;
    # the keywords are stored as a space separated string so we need to split up    
    my @keys = split / /, $searchDB{$dpic}{KEYS};
    foreach my $key (@keys) {
      # hierarchical keywords are joined by an period "."    todo this may cause problems ("Mr. X, "Louis XIV.", "Dr. Miller")
      my @subkeys = split /\./, $key;
      foreach (@subkeys) {
        # add keyword to hash and count how often it was found
        if (defined $keyword_hash{$_}) {
          $keyword_hash{$_}++;
        }
        else {
          $keyword_hash{$_} = 1;
        }
      }
    }      
  }
  return ($count, %keyword_hash);
}  

##############################################################
# search_by_location
##############################################################
sub search_by_location {
  if (Exists($locw)) {
    $locw->deiconify;
    $locw->raise;
    $locw->focus;
    return;
  }
  my $lb = shift; # thumbnail widget e.g. $picLB
  # open window
  $locw = $top->Toplevel();
  $locw->withdraw;
  $locw->title('Locations');
  $locw->iconimage($mapiviicon) if $mapiviicon;
  my $locXBut = $locw->Button(-text => "Close",
                          -command => sub {
                              $config{LocGeometry} = $locw->geometry;
                              $locw->destroy;
                          })->pack(-fill => 'x');
  add_location_tree($locw, $lb);
  # get all location info from the database (IPTC tags: country, state, city and sublocation)
  $top->Busy;
  my %loc_hash = get_locations(UPDATE);
  $top->Unbusy;
  insert_in_tree(LOCATION, $locw->{tree}, \%loc_hash);
  bind_exit_keys_to_button($locw, $locXBut);
  $locw->Popup;
  checkGeometry(\$config{LocGeometry});
  $locw->geometry($config{LocGeometry});
  $locw->waitWindow;
  return;
}

##############################################################
##############################################################
sub add_date_tree {
  my $w  = shift;
  my $lb = shift;
  my $tree;
  
  my $af = $w->Frame()->pack(-fill =>'x', -padx => 2, -pady => 1);

  $tree = $w->Scrolled('Tree',
                     -separator  => '%',
                     -scrollbars => 'osoe',
                     -selectmode => 'single',
                     -exportselection => 0,
                     -width      => 25,
                     -height     => 5,
                     )->pack(-expand => 1, -fill =>'both', -padx => 1, -pady => 1);
  $w->{tree} = $tree;

  my $aaf = $w->Frame()->pack(-fill =>'x', -padx => 2, -pady => 1);
  my $update_but = $aaf->Button(-image => $mapivi_icons{'Update'}, 
                          -command => sub {
      # get all date/time info from the database (EXIF tag: creation date/time)
     $top->Busy;
     my %date_hash = get_dates(UPDATE);
     insert_in_tree(DATE, $tree, \%date_hash);
     $top->Unbusy;
      })->pack(-side => 'left');
  $balloon->attach($update_but, -msg => "Update date/time info from database.");

  $aaf->Button(-image => $mapivi_icons{Help}, #-text => '?',
        -command => sub {
            showText("Help for date/time navigation", "Double click on any date/time in the tree to see pictures of that date/time in the main window. Smallest time frame is one hour.\nUse the middle mouse button or the key <d> to see a preview in a new window.\nThe date/time information is gathered either from the EXIF creation date (when available) or the file creation date of all pictures in the database.\nThe number in square bracket represents the number of pictures for that date/time. If a rating constraint is selected it is applied when the pictures are shown. The number in square brackets are not affected by the rating constraint.\n", NO_WAIT);
      })->pack(-side => 'left');
  
  focus_on_enter($tree->Subwidget("scrolled"));

  $tree->bind("<Double-Button-1>", sub {
      my @date = $tree->info('selection');
      return unless checkSelection($w, 1, 0, \@date, lang("date"));
      @act_date = split(/%/, $date[0]);
      # switch display modus to date navigation ...
      $act_modus = DATE;
      # ... and show pictures of the selected date
      updateThumbs();
  });

  $tree->bind("<Button-2>", sub {
      $tree->selectionClear();
      $tree->selectionSet(getNearestItem($tree));
      showThumbsByDate($w, $tree);
  });
  
  $tree->bind('<Key-d>', sub { showThumbsByDate($w, $tree); });
}

##############################################################
# add a collection (slideshow) tree to the given widget
##############################################################
sub add_collection_tree {
  my $w  = shift;
  my $lb = shift;
  my $tree;
  
  my $af = $w->Frame()->pack(-fill =>'x', -padx => 2, -pady => 1);

  $tree = $w->Scrolled('Tree',
                     -separator  => '%',
                     -scrollbars => 'osoe',
                     -selectmode => 'single',
                     -exportselection => 0,
                     -width      => 25,
                     -height     => 5,
                     )->pack(-expand => 1, -fill =>'both', -padx => 1, -pady => 1);
  $w->{tree} = $tree;

  # add some buttons
  my $aaf = $w->Frame()->pack(-fill =>'x', -padx => 2, -pady => 1);
  my $update_but = $aaf->Button(-image => $mapivi_icons{'Update'}, 
                          -command => sub {
     # save open/close info of tree (one one level deep needed!)
     my %mode;
     foreach ($tree->info('children')) {
       $mode{$_} = $tree->getmode($_);
     }    
     $top->Busy;
     # get all collections
     insert_collections_in_tree($tree, \%slideshows);
     # reset mode to the the old setting on first level
     foreach ($tree->info('children')) {
       $tree->close($_) if ((defined $mode{$_}) and ($mode{$_} eq 'open'));
       $tree->open($_)  if ((defined $mode{$_}) and ($mode{$_} eq 'close'));
     }
     log_it("Collections are up-to-date!");
     $top->Unbusy;
  })->pack(-side => 'left');
  $balloon->attach($update_but, -msg => lang('Update collections'));

  my $addB = $aaf->Button(-image => $mapivi_icons{PlusBig},
        -command => sub {
            my ($ok, $folder, $collection) = get_selected_collection($tree, 0);
            if ($ok == 0) { # nothing selected -> create folder
              my $newfolder = 'new folder';
              my $rc = myEntryDialog("New folder", "Please enter a name for a new collection folder", \$newfolder);
              return if (($rc ne 'OK') or ($newfolder eq ''));
              if (exists $slideshows{$newfolder}) {
                log_it("Folder $newfolder exists, please retry with another name.");
                return;
              }
              $slideshows{$newfolder} = { };
              log_it("Created new folder $newfolder.");
            }
            elsif ($ok >= 1) { # folder or collection selected
              my $collection = 'new collection';
              my $rc = myEntryDialog("New collection", "Please enter a name for a new picture collection in $folder", \$collection);
              return if (($rc ne 'OK') or ($collection eq ''));
              if (exists $slideshows{$folder}{$collection}) {
                log_it("Collection $folder $collection exists, please retry with another name.");
                return;
              }
              $slideshows{$folder}{$collection}{pics} = [];
              $slideshows{$folder}{$collection}{file} = '';
              log_it("Created new collection $folder $collection.");
            }
            else {
              warn "add_collection_tree: should never happen: ok = $ok";
            }
            $top->Busy;
            insert_collections_in_tree($tree, \%slideshows);
            $top->Unbusy;
      })->pack(-side => 'left');
  $balloon->attach($addB, -msg => lang('Add folder or collection'));

  my $editB = $aaf->Button(-image => $mapivi_icons{Editor},
        -command => sub {
            my ($ok, $folder, $collection) = get_selected_collection($tree, 1);
            if ($ok == 2) {
              my $pics = $slideshows{$folder}{$collection}{pics};
              my $file = $slideshows{$folder}{$collection}{file};
              light_table_edit($pics, $folder, $collection);
              log_it("Edit collection: $folder $collection");              
            } else {
              log_it("Please select a collection in the tree to edit first.");
            }
      })->pack(-side => 'left');
  $balloon->attach($editB, -msg => lang('Edit collection'));

  my $saveB = $aaf->Button(-image => $mapivi_icons{Save},
        -command => sub {
              if (save_slideshows()) {
                log_it(lang('Collections saved successfully!'));
              } else {
                log_it(lang('Error saving collections! (see console for further information)'));
              }
      })->pack(-side => 'left');
  $balloon->attach($saveB, -msg => lang('Save all collections'));

  my $delB = $aaf->Button(-image => $mapivi_icons{Trash},
        -command => sub {
            my ($ok, $folder, $collection) = get_selected_collection($tree, 1);
            if (not $ok) {
              log_it("Please select a collection in the tree first.");
            }
            if ($ok == 1) { # delete folder
              my $folder_collections = scalar(keys(%{$slideshows{$folder}}));
              my $rc = $w->messageBox(-message => "Delete folder $folder containing $folder_collections collections?",
                 -icon => 'question', -title => lang('Delete folder').'?', -type => 'OKCancel');
              if ($rc =~ m/Ok/i) {
                # delete hash entry
                delete $slideshows{$folder};
                log_it("Deleted folder $folder.");   
              }
            }
            elsif ($ok == 2) { # delete collection
              my $rc = $w->messageBox(-message => "Delete collection $folder $collection?",
                 -icon => 'question', -title => lang('Delete collection').'?', -type => 'OKCancel');
              if ($rc =~ m/Ok/i) {
                # delete hash entry
                delete $slideshows{$folder}{$collection};
                log_it("Deleted collection: $folder $collection.");
              }
            }
            $top->Busy;
            insert_collections_in_tree($tree, \%slideshows);
            $top->Unbusy;
      })->pack(-side => 'left');
  $balloon->attach($delB, -msg => lang('Delete collection'));

  my $helpB = $aaf->Button(-image => $mapivi_icons{Help},
        -command => sub {
            showText("Help for collection navigation", "Double click on any collection in the tree to see pictures of that collection in the main window.", NO_WAIT);
      })->pack(-side => 'right');
  $balloon->attach($helpB, -msg => lang('Help'));
  
  focus_on_enter($tree->Subwidget("scrolled"));

  $tree->bind("<Double-Button-1>", sub {
      my ($ok, $folder, $collection) = get_selected_collection($tree, 1);
      return if (not $ok);
      # user clicked on folder
      if ($ok == 1) {
        # open/close folder (toggle)
        my $mode = $tree->getmode($folder);
        if ($mode eq 'open') {
          $tree->open($folder);
        }
        elsif ($mode eq 'close') {
          $tree->close($folder);
        }
        else {} # mode may also return "none" (for empty folders)
      }
      else { # user clicked on collection -> open it
        # switch display modus to collection navigation ...
        $act_modus = COLLECTION;
        @act_collection = ($folder, $collection);
        # ... and show pictures of the selected date
        updateThumbs();
      }
  });

  $tree->bind("<Button-2>", sub {
      $tree->selectionClear();
      $tree->selectionSet(getNearestItem($tree));
      print "add_collection_tree: not yet\n";
      #showThumbsByDate($w, $tree);
  });
  
  $tree->bind('<Key-d>', sub {
    print "add_collection_tree: not yet\n";
    #showThumbsByDate($w, $tree);
  });
  
  # add a context popup menu
  my $menu = $tree->Menu(-title => lang("Collection menu"));
  $tree->bind('<ButtonPress-3>',   sub { $menu->Popup(-popover => 'cursor', -popanchor => 'nw'); } );
  $menu->command(-label => lang('Rename ...'), -command => sub {
            my ($ok, $folder, $collection) = get_selected_collection($tree, 1);
            if ($ok == 1) { # rename folder
              my $newfolder = $folder;
              my $rc = myEntryDialog("Rename folder", "Please enter new name for collection folder $folder", \$newfolder);
              return if (($rc ne 'OK') or ($newfolder eq ''));
              if (exists $slideshows{$newfolder}) {
                log_it("Folder $newfolder exists, please retry with another name.");
                return;
              }
              $slideshows{$newfolder} = delete $slideshows{$folder};
              log_it("Renamed folder $folder to $newfolder.");
            }
            elsif ($ok == 2) { # rename collection
              my $newcollection = $collection;
              my $rc = myEntryDialog("Rename collection", "Please enter new name for collection $collection", \$newcollection);
              return if (($rc ne 'OK') or ($newcollection eq ''));
              if (exists $slideshows{$folder}{$newcollection}) {
                log_it("Collection $folder $newcollection exists, please retry with another name.");
                return;
              }
              $slideshows{$folder}{$newcollection} = delete $slideshows{$folder}{$collection};
              log_it("Renamed collection $collection to $newcollection.");
            }
            else {
              warn "add_collection_tree: should never happen: ok = $ok";
            }
            $top->Busy;
            insert_collections_in_tree($tree, \%slideshows);
            $top->Unbusy;
  });
}

##############################################################
##############################################################
sub get_selected_collection {
  my $tree = shift;
  my $min_select = shift; # minimum number of selected elements
  my @sel = $tree->info('selection');
  my $ok = 0; # 0 = no selection, 1 = folder selection, 2 = collection selection
  my $folder = undef; # collection folder
  my $collection = undef; # collection name
  return ($ok, $folder, $collection) if (not @sel);
  if (checkSelection($tree, $min_select, 0, \@sel, lang('collection'))) {
    my @path = split(/%/, $sel[0]);
    # user selected a folder
    if (scalar(@path) == 1) {
      $ok = 1;
      $folder = $path[0];
    }
    # user selected a collection, not a folder
    elsif (scalar(@path) == 2) {
      $ok = 2;
      $folder = $path[0];
      $collection = $path[1];
    }
    else {
      print "get_selected_collection: unclear selection: ".scalar(@path)."\n";
    }
  }
  return ($ok, $folder, $collection);
}

##############################################################
# get selection from date tree and display thumbnails in new window
##############################################################
sub showThumbsByDate {
  my $w = shift;
  my $tree = shift;
  my @dates = $tree->info('selection');
  return unless checkSelection($w, 1, 0, \@dates, lang("date"));
  my @date = split(/%/, $dates[0]);
  my @list = get_pics_by(DATE, \@date);
  my $title = 'Date: '; $title .= "$_ " foreach (@date);
  showThumbList(\@list, $title);
}

##############################################################
# get selection from location tree and display thumbnails in new window
##############################################################
sub showThumbsByLocation {
  my $w = shift;
  my @locs = $w->{tree}->info('selection');
  return unless checkSelection($w, 1, 0, \@locs, lang("location(s)"));
  my @loc = split(/%/, $locs[0]);
  my @list = get_pics_by(LOCATION, \@loc);
  my $title = 'Location: '; $title .= "$_ " foreach (@loc);
  showThumbList(\@list, $title);
}

##############################################################
##############################################################
sub add_location_tree {
  my $locw = shift;
  my $lb   = shift;
  
  my $af = $locw->Frame(-bd => 1, -relief => 'raised')->pack(-fill =>'x', -padx => 2, -pady => 1);
  my $update_replace_but;
  # search or add location button
  $locw->{SearchMode} = 1;
  #$af->Label(-text => 'Mode:')->pack(-expand => 0, -side => 'left', -fill => 'x');
  $af->Radiobutton(-image => compound_menu($top, 'Search', 'system-search.png'), -variable => \$locw->{SearchMode}, -value => 1, -indicatoron => 0, -command => sub { cursor_search_add($locw->{SearchMode}, $locw->{tree}); return unless Exists($update_replace_but); my $state = 'normal'; $state = 'disabled' if ($locw->{SearchMode}); $update_replace_but->configure(-state => $state); })->pack(-expand => 1, -side => 'left', -fill => 'x', -padx => 2, -pady => 2);
  #
  $af->Radiobutton(-image => compound_menu($top, lang('Add'), 'list-add.png'), -variable => \$locw->{SearchMode}, -value => 0, -indicatoron => 0, -command => sub { cursor_search_add($locw->{SearchMode}, $locw->{tree}); return unless Exists($update_replace_but); my $state = 'normal'; $state = 'disabled' if ($locw->{SearchMode}); $update_replace_but->configure(-state => $state); })->pack(-expand => 1, -side => 'left', -fill => 'x', -padx => 2, -pady => 2);

  $balloon->attach($af, -msg => "Search or Add mode\nChoose if a double click on a location will search\nfor the location or add it to the selected pictures");
      
  # update or replace location button
  $update_replace_but = $af->Optionmenu(-variable => \$config{LocationMode},
                                      -textvariable => \$config{LocationMode},
                                      -options => [ ['Update' => 'UPDATE'],['Replace' => 'REPLACE'], ],)->pack(-expand => 0, -side => 'left', -fill => 'x', -padx => 2, -pady => 2);
  $balloon->attach($update_replace_but, -msg => "Location Add Mode:\nIf Replace is selected all four locations (Country/State/City/Sublocation)\nwill be overwritten.\nIf Update is selected only the selected location will be updated.\nExample: If you select just a country (USA) and add this\nto a picture with existing location (e.g. City = New York)\nIn Update mode the City information will be preserved\nwhile in Replace mode New York will be deleted");
  $locw->{tree} = $locw->Scrolled('Tree',
                             -separator  => '%',
                             -scrollbars => 'osoe',
                             -selectmode => 'single',
                             -exportselection => 0,
                             -width      => 25,
                             -height     => 5,
                             )->pack(-expand => 1, -fill =>'both', -padx => 1, -pady => 1);
  
  # add a filter entry to show only selected locations in the tree
  add_tree_filter($locw, $locw->{tree}, LOCATION, undef);

  my $aaf = $locw->Frame()->pack(-fill =>'x', -padx => 2, -pady => 1);
  my $update_loc_but = $aaf->Button(-image => $mapivi_icons{'Update'}, -foreground => $conf{color_fg}{value},
                          -command => sub {
      # get all location info from the database (IPTC tags: country, state, city and sublocation)
     $top->Busy;
     my %loc_hash = get_locations(UPDATE); # UPDATE = reread from database
     insert_in_tree(LOCATION, $locw->{tree}, \%loc_hash);
     $top->Unbusy;
      })->pack(-side => 'left');
  $balloon->attach($update_loc_but, -msg => 'Update locations from database');

  $aaf->Button(-image => $mapivi_icons{Help}, #-text => '?',
        -command => sub {
            showText("Help for location navigation", "The location tree may be used in two ways: Either to search for pictures from a selected location (Search mode) or to add location information to pictures (Add mode).\nIn Search mode the mouse pointer looks like a hand in Add mode the mouse pointer looks like a plus sign.\nSearch mode: Double click on any location in the tree to see pictures of that location in the main window.\nAdd mode: Double click on any location in the tree to add this location information to all selected pictures.\nMapivi will ask before overwriting existing location information.\nGeneral: Use the middle mouse button or the key <d> to see a preview of all pictures from the selected location in a new window.\nThe location information is gathered from the IPTC tags Country, Province/State, City and SubLocation of all pictures in the database.\n", NO_WAIT);
      })->pack(-side => 'left');

  # set cursor to either search or add to inform the user about the mode
  cursor_search_add($locw->{SearchMode}, $locw->{tree});
  # enable/disable update/replace button
  { my $state = 'normal'; $state = 'disabled' if ($locw->{SearchMode}); $update_replace_but->configure(-state => $state); }
  
  focus_on_enter($locw->{tree}->Subwidget("scrolled"));
  #$balloon->attach($locw->{tree}, -msg => "Double click on a location to see pictures from there.");

  $locw->{tree}->bind("<Double-Button-1>", sub {
      # search mode
      if ($locw->{SearchMode}) {
        my @locs = $locw->{tree}->info('selection');
        return unless checkSelection($locw, 1, 0, \@locs, lang("location(s)"));
        @act_location = split(/%/, $locs[0]);
        # switch display modus to location
        $act_modus = LOCATION;
        updateThumbs();
      }
      # add mode
      else {
        $lb = $picLB unless Exists($lb);
        my @locs = $locw->{tree}->info('selection');
        return unless checkSelection($locw, 1, 1, \@locs, lang("location(s)"));
        my @loc  = split(/%/, $locs[0]);
        my @sellist = getSelection($lb);
        return unless checkSelection($locw, 1, 0, \@sellist, lang("picture(s)"));
        # check before overwriting
        return if (not allow_location_overwrite($locw, \@sellist));
        my $location;
        $location .= "$_ " foreach (@loc);
        my $nr = scalar @sellist;
        log_it("adding ${location}to $nr pictures ...");
        my $errors = '';
        my $count  = 0;
        my $i = 0;
        my $pw = 0;
        $pw = progressWinInit($locw, "Adding location") if ($nr > 5);
        # add location info to selected pictures
        foreach my $dpic (@sellist) {
          last if ($pw and progressWinCheck($pw));
          $i++;
          progressWinUpdate($pw, "Adding location information ($i/$nr) ...", $i, $nr) if $pw;
          my ($ok, $iptc, $meta) = get_IPTC_info($dpic);
          if (not $ok) {
            $errors .= "Could not open IPTC segment of $dpic\n";;
            next;
          }
          else {
            if (defined $loc[0] and $loc[0] ne $empty_str) {
              $iptc->{'Country/PrimaryLocationName'} = $loc[0];
            } else {
              undef $iptc->{'Country/PrimaryLocationName'};
            } 
            if (defined $loc[1] and $loc[1] ne $empty_str) {
              $iptc->{'Province/State'} = $loc[1];
            } else {
              undef $iptc->{'Province/State'};
            } 
            if (defined $loc[2] and $loc[2] ne $empty_str) {
              $iptc->{'City'} = $loc[2];
            } else {
              undef $iptc->{'City'};
            } 
            if (defined $loc[3] and $loc[3] ne $empty_str) {
              $iptc->{'SubLocation'} = $loc[3];
            } else {
              undef $iptc->{'SubLocation'};
            }
            
            $meta->set_app13_data($iptc, $config{LocationMode}, 'IPTC');
            if (!$meta->save()) {
              $errors .= "$dpic: writing of location failed!\n";
            }
            else {
              # touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time
              touch(getThumbFileName($dpic));
              updateOneRow($dpic, $lb);
              showImageInfoCanvas($dpic) if ($dpic eq $actpic);
              $count++;
            }
          }
        }
        progressWinEnd($pw) if $pw;
        log_it("added ${location}to $count of ".scalar @sellist." pictures.");
      
        if ($errors ne '') {
          $errors = "These errors occured while adding the location info to ".scalar @sellist." pictures.\n\n$errors";
          showText("Errors while adding location", $errors, NO_WAIT);
        } 
      }
  });

  $locw->{tree}->bind("<Button-2>", sub {
      $locw->{tree}->selectionClear();
      $locw->{tree}->selectionSet(getNearestItem($locw->{tree}));
      showThumbsByLocation($locw);
  });
  $locw->{tree}->bind('<Key-d>',  sub { showThumbsByLocation($locw); });
  return;
}

##############################################################
##############################################################
sub filter_locations {
  my ($treew, $filter) = @_;
  my %loc_hash = get_locations();
  if ($filter eq '') { # clear filter, show all
    insert_in_tree(LOCATION, $treew, \%loc_hash);
  }
  else {
    my $ac=0;my $bc=0;my $cc=0;my $dc=0;
    my %loc_filter;  # filtered location hash
    foreach my $a (keys %loc_hash) {
      $ac++;
      # country match, add all entries below
      if ($a =~ m|$filter|i) {
        $loc_filter{$a} = $loc_hash{$a};
        next;
      }
      foreach my $b (keys %{$loc_hash{$a}}) {
        $bc++;
        # state match, add all entries below
        if ($b =~ m|$filter|i) {
          $loc_filter{$a}{$b} = $loc_hash{$a}{$b};
          next;
        }
        foreach my $c (keys %{$loc_hash{$a}{$b}}) {
          $cc++;
          # city match, add all entries below
          if ($c =~ m|$filter|i) {
            $loc_filter{$a}{$b}{$c} = $loc_hash{$a}{$b}{$c};
            next;
          }
          foreach my $d (keys %{$loc_hash{$a}{$b}{$c}}) {
            $dc++;
            # sublocation match, add all entries below
            if ($d =~ m|$filter|i) {
              $loc_filter{$a}{$b}{$c}{$d} = $loc_hash{$a}{$b}{$c}{$d};
            }
          }
        }
      }
    }
    insert_in_tree(LOCATION, $treew, \%loc_filter);
    # unfold tree in all levels (show all findings)
    tree_fold(OPEN, $treew);
    print "filter_locations: $ac $bc $cc $dc locations scanned\n";
  }
  return;  
}

##############################################################
# set the mouse cursor in widget either to add-mode (plus) or search-mode (hand)
##############################################################
sub cursor_search_add {
  my $search = shift;
  my $w = shift;
  return unless Exists($w);
  my $cursor = 'plus';
  $cursor = 'hand2' if $search; # 'target'
  $w->configure(-cursor => $cursor);
}

##############################################################
##############################################################
sub add_keywords_to_pics {
  my ($lb, $keys, $pics) = @_;
  if (scalar @{$keys} < 1) { print "add_keywords_to_pics: no keys\n"; return; }
  if (scalar @{$pics} < 1) { print "add_keywords_to_pics: no pics\n"; return; }
  my $warning = '';
  # format given keyword list according to the configured format (all, joined, or last)
  my @keylist = keyword_format($keys, \$warning);
  if (@keylist) {
      my $iptc = { Keywords => \@keylist };
      applyIPTC($lb, $iptc, $pics);
  }
  if ($warning ne '') {
      $warning = "IPTC keywords are limited to 64 characters. Please shorten keyword.\n$warning";
      showText("Warnings while adding keywords", $warning, NO_WAIT);
  }
  return;
}

##############################################################
##############################################################
sub add_key_tree {
  my $keyw = shift;
  my $lb   = shift;
  my $af = $keyw->Frame()->pack(-expand => 0, -fill => 'x', -padx => 2, -pady => 1);
  #my $mode_frame = $af->Frame(-bd => 1, -relief => 'raised')->pack(-expand => 1, -side => 'left', -fill => 'x');


  $keyw->{SearchMode} = 1;
  #$mode_frame->Label(-text => 'Mode:')->pack(-expand => 1, -side => 'left', -fill => 'x');
  
  $af->Radiobutton(-image => compound_menu($keyw, lang('Search'), 'system-search.png'), -variable => \$keyw->{SearchMode}, -value => 1, -indicatoron => 0, -command => sub { cursor_search_add($keyw->{SearchMode}, $keyw->{tree}); cursor_search_add($keyw->{SearchMode}, $keyw->{hot}); })->pack(-expand => 1, -side => 'left', -fill => 'x', -padx => 2, -pady => 2);
  $af->Radiobutton(-image => compound_menu($keyw, lang('Add'), 'list-add.png'), -variable => \$keyw->{SearchMode}, -value => 0, -indicatoron => 0, -command => sub { cursor_search_add($keyw->{SearchMode}, $keyw->{tree}); cursor_search_add($keyw->{SearchMode}, $keyw->{hot}); })->pack(-expand => 1, -side => 'left', -fill => 'x', -padx => 2, -pady => 2);

  $balloon->attach($af, -msg => lang('Search')." or ".lang('Add')." mode\nChoose if a double click on a keyword will search\nfor the keyword or add it to the selected pictures");

$af->Button(-image => $mapivi_icons{Help},  -pady => 0,  -padx => 0,
        -command => sub {
            showText("Help for Navigate by Keywords", "The keyword tree below can be used in three ways:\n1. Search for pictures with a keyword (\"Search mode\", mouse cursor in hand shape)\n2. Add keywords to pictures (\"Add mode\", mouse cursor is a plus sign)\n3. Edit keyword tree\n\nDouble click on a keyword to either search for pictures or to add it to the selected pictures.\n\nTo edit the keywords, use the right mouse button and open the context menu.\n\nUse the middle mouse button (or key d) to open a new window containing all pictures with the selected keyword.", NO_WAIT);
      })->pack(-expand => 0, -side => 'left', -fill => 'x', -padx => 2, -pady => 2);
  
  my $add_frame = $keyw->Frame(-bd => 1, -relief => 'raised')->pack(-expand => 0, -fill =>'x', -padx => 2, -pady => 1);

  #my $add_frame2 = $add_frame->Frame()->pack(-expand => 0, -fill =>'x', -padx => 2, -pady => 0);

  my $addB =
      $add_frame->Button(-image => compound_menu($top, lang('Attach'), 'media-floppy.png', 0),
                  -command => sub {
                      $lb = $picLB unless Exists($lb);
                      # get the selcted keywords from the tree
                      my @keys = $keyw->{tree}->info('selection');
                      # and add the selected keywords from the hotlist
                      foreach ($keyw->{hot}->curselection()) {
                        push @keys, $keyw->{hot}->get($_);
                      }
                      #print "key to add: $_\n" foreach (@keys);
                      return unless checkSelection($keyw, 1, 0, \@keys, lang("keyword(s)"));
                      my @pics = $lb->info('selection');
                      return unless checkSelection($keyw, 1, 0, \@pics, lang("picture(s)"));
                      add_keywords_to_pics($lb, \@keys, \@pics);
                  } )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 2, -pady => 2);
  $balloon->attach($addB, -msg => lang('Add selected keywords to selected pictures'));
  
  my $rmB =
      $add_frame->Button(-image => compound_menu($top, lang('Detach'), 'edit-clear.png'),
                  -command => sub {
                      $lb = $picLB unless Exists($lb);
                      # get the selected keywords from the tree
                      my @keys = $keyw->{tree}->info('selection');
                      # and add the selected keywords from the hotlist
                      foreach ($keyw->{hot}->curselection()) {
                        push @keys, $keyw->{hot}->get($_);
                      }
                      return unless checkSelection($keyw, 1, 0, \@keys, lang("keyword(s)"));
                      my @sellist = $lb->info('selection');
                      return unless checkSelection($keyw, 1, 0, \@sellist, lang("picture(s)"));
                      my $pw = progressWinInit($keyw, "Remove keyword");
                      my $i = 0;
                      my $sum = @sellist;
                      foreach my $dpic (@sellist) {
                          last if progressWinCheck($pw);
                          $i++;
                          progressWinUpdate($pw, "removing keyword ($i/$sum) ...", $i, $sum);
                          foreach my $key (@keys) {
                              last if progressWinCheck($pw);
                              progressWinUpdate($pw, "removing keyword $key ($i/$sum) ...", $i, $sum);
                              my $item;
                              if ($config{KeywordsAll} == 2) { # all, joined
                                  my @items = getAllItems($key);
                                  $item = join('.', @items);
                              }
                              else { # last							  
                                  $item = getLastItem($key);
                              }
                              print "remove key $item ($key) from $dpic\n" if $verbose;
                              removeIPTCItem($dpic, 'Keywords', $item);
                              updateOneRow($dpic, $lb);
                              showImageInfoCanvas($dpic) if ($dpic eq $actpic);
                          }
                      }
                      progressWinEnd($pw);
                  })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 2, -pady => 2);
  $balloon->attach($rmB, -msg => lang("Remove selected keywords from selected pictures"));

  my $add_mode = $add_frame->Optionmenu(-variable => \$config{KeywordsAll}, -textvariable => \$config{KeywordsAll}, -options => [ 
  [lang('Join') => 2],
  [lang('All') => 1],
  [lang('Last') => 0], ],  -pady => 0,  -padx => 0)->pack(-side => 'left', -anchor => 'w', -fill => 'x', -padx => 2, -pady => 2);

  $balloon->attach($add_mode, -msg => "Keyword mode\nExample keyword: Person/Bundy/Kelly\n\"".lang('Join')."\" will add one keyword: \"Person.Bundy.Kelly\"\n\"".lang('All')."\" will add three keywords: \"Person\", \"Bundy\" and \"Kelly\"\n\"".lang('Last')."\" will add one keyword: \"Kelly\"\n\nDefault and recommended mode: \"".lang('Join')."\"\nIf you want to store and retrieve your keyword\nhierarchie from your pictures you should use \"".lang('Join')."\" mode.\nThe keyword mode is also used when removing keywords.");

  # keyword clipboard
  $keyw->{hot} = $keyw->Scrolled('Listbox',
                   -scrollbars => 'osoe',
                   -selectmode => 'extended',
                   -exportselection => 0,
                   -width => 25,
                   -height => 5,
                   )->pack(-expand => 0, -fill =>'both', -padx => 1, -pady => 1);
  # set cursor to either search or add to inform the user about the mode
  cursor_search_add($keyw->{SearchMode}, $keyw->{hot});
  focus_on_enter($keyw->{hot}->Subwidget("scrolled"));
  $keyw->{hot}->insert('end', (sort keys %hot_keywords));
  # if there is a selection in the clipboard we clear the selection in the tree and vice versa to avoid confusion
  $keyw->{hot}->bind('<ButtonRelease-1>', sub { $keyw->{tree}->selectionClear(); $keyw->{tree}->anchorClear();});
  my $hot_menu = $keyw->{hot}->Menu(-title => lang("Keyword clipboard menu"));
  $keyw->{hot}->bind('<ButtonPress-3>',   sub { $hot_menu->Popup(-popover => 'cursor', -popanchor => 'nw'); } );
  $hot_menu->command(-label => lang('Clear keyword clipboard'), -command => sub {
    undef %hot_keywords;
    $keyw->{hot}->delete(0, 'end');
  });
  $hot_menu->command(-label => lang('Remove selected keyword(s) from clipboard'), -command => sub {
    return unless checkSelection($keyw, 1, 0, \@{$keyw->{hot}->curselection()}, lang("keyword(s)"));
    # and add the sected keywords from the clipboard
    foreach ($keyw->{hot}->curselection()) {
      delete $hot_keywords{$keyw->{hot}->get($_)};
    }
    $keyw->{hot}->delete(0, 'end');
    $keyw->{hot}->insert('end', (sort keys %hot_keywords));
    });
  $keyw->{hot}->bind('<Double-Button-1>', sub { double_click($keyw, $lb); });

  $keyw->Adjuster->packAfter($keyw->{hot}, -pady => 3);
  
  # keyword tree
  $keyw->{tree} = $keyw->Scrolled('Tree',
                             -separator  => '/',
                             -scrollbars => 'osoe',
                             -selectmode => 'extended',
                             -exportselection => 0,
                             -width => 25,
                             -height => 15,
                             )->pack(-expand => 1, -fill =>'both', -padx => 1, -pady => 1);
  # set cursor to either search or add to inform the user about the mode
  cursor_search_add($keyw->{SearchMode}, $keyw->{tree});

  # add a filter entry to show only selected keywords in the tree
  add_tree_filter($keyw, $keyw->{tree}, KEYWORD, \@prekeys);
  # if there is a selection in the tree we clear the selection in the hotlist and vice versa to avoid confusion
  $keyw->{tree}->bind('<ButtonRelease-1>', sub { $keyw->{hot}->selectionClear(0, 'end'); });
  
  focus_on_enter($keyw->{tree}->Subwidget("scrolled"));

  # try to get and set the saved mode (opened and closed branches of the tree)
  my $modeRef;
  if (-f "$user_data_path/keywordMode") {
    $modeRef = retrieve("$user_data_path/keywordMode");
  }
  $keyw->{tree}->{m_mode} = $modeRef if (defined $modeRef);  
  
  addTreeMenu($keyw->{tree}, \@prekeys, $keyw->{hot});

  insertTreeList($keyw->{tree}, @prekeys);

  $keyw->{tree}->bind("<Double-Button-1>", sub { double_click($keyw, $lb); });


  # middle mouse button on a keyword opens a new window containing all related pictures
  $keyw->{tree}->bind('<Button-2>', sub {
      $keyw->{tree}->selectionClear();
      $keyw->{tree}->anchorClear();
      $keyw->{tree}->selectionSet(getNearestItem($keyw->{tree}));
      showThumbsByKeyword($keyw); 
  });
  
  # key d on a keyword opens a new window containing all related pictures
  $keyw->{tree}->bind('<Key-d>',  sub { showThumbsByKeyword($keyw); });
}

##############################################################
# sub function for double clicking in the tree or the hotlist
##############################################################
sub double_click {
  my $keyw = shift;
  my $lb = shift;
  #print "keywordtree double click\n";
  # get the selected keywords from the tree
  my @keys = $keyw->{tree}->info('selection');
  # and add the sected keywords from the hotlist
  foreach ($keyw->{hot}->curselection()) {
    push @keys, $keyw->{hot}->get($_);
  }
  return unless checkSelection($keyw, 1, 1, \@keys, lang("keyword(s)"));
  $lb = $picLB unless Exists($lb);
  # search mode
  if ($keyw->{SearchMode}) {
    # check if the user wants to add keywords and forgot to press "Search"
    my @sellist = getSelection($lb);
    if (@sellist > 1) {
      #$keyw->update;
      my $rc = $keyw->messageBox(-icon => 'question', -message => "You've selected several pictures.\nDo you want to switch to \"Add\" mode and add the keyword to the pictures?",
                 -title => "Switch to Add-mode?", -type => 'YesNo');
      $keyw->{SearchMode} = 0 if ($rc =~ m/Yes/i);
    }
  }
  # search-mode
  if ($keyw->{SearchMode}) {
    @act_keywords = split(/\//, $keys[0]);
    # do not exclude some keywords
    undef @act_keywords_ex;
    # switch display modus to location
    $act_modus = KEYWORD;
    updateThumbs();
  }
  # add-mode
  else {
    my @pics = getSelection($lb);
    return unless checkSelection($keyw, 1, 0, \@pics, lang("picture(s)"));
    add_keywords_to_pics($lb, \@keys, \@pics);
  }
}

##############################################################
# get selection from keyword tree and display thumbnails in new window
##############################################################
sub showThumbsByKeyword {
  my $keyw = shift;
  my @keys = $keyw->{tree}->info('selection');
  return unless checkSelection($keyw, 1, 0, \@keys, lang("keyword(s)"));
  my @keywords = split(/\//, $keys[0]);
  my @keywords_ex;
  my @list = get_pics_with_keywords(\@keywords, \@keywords_ex);
  my $title = 'Keywords: '; $title .= "$_ " foreach (@keywords);
  showThumbList(\@list, $title);
}

##############################################################
# add a entry to show only items (keywords/locations) matching
# a filter criteria in the tree
##############################################################
sub add_tree_filter {
  # type = KEYWORD or LOCATION (both defined as constants)
  # @prekeys are only needed for type KEYWORD not for LOCATION
  my ($w, $treew, $type, $prekeys) = @_;
  my $filter = '';
  my $frame = $w->Frame()->pack(-expand => 0, -fill => 'x');
  $w->{entry} = $frame->Entry(
    -textvariable => \$filter,
    -validate => 'key',
    -validatecommand => sub {
      if ($type eq KEYWORD) {
        filter_tree($treew, $_[0], $prekeys);
      }
      elsif ($type eq LOCATION) {
        filter_locations($treew, $_[0]);
      }
      else {
        log_it("error: add_tree_filter called with wrong type: $type");
      }
      return 1;
    },
  )->pack(-side => 'left', -fill => 'x', -expand => 1, -padx => 1);
  $balloon->attach($w->{entry}, -msg => lang("Filter:\nEnter any word or part of it\nto filter tree."));
  $w->{clear} = $frame->Button(
    -image => $mapivi_icons{'Clear'},
    -command => sub {
      $filter = ''; 
      tree_fold(CLOSE, $treew);
      $w->{entry}->focus;
  })->pack(-side => 'left', -expand => 0, -padx => 1);
  $balloon->attach($w->{clear}, -msg => lang("Clear filter and collapse tree"));
  $w->{entry}->focus;
  $w->{entry}->selectionRange(0,'end'); # select all
}

##############################################################
##############################################################
sub filter_tree {
  my ($treew, $filter, $prekeys) = @_;
  if ($filter eq '') { # reset tree
    insertTreeList($treew, @{$prekeys});
  }
  else {
    my @list;
    foreach my $item (@{$prekeys}) {
      if ($item =~ m|$filter|i) {
        my @elements = split /\//, $item;
        my $string = '';
        foreach my $element (@elements) {
          if ($string eq '') {
            $string = "$element";
          }
          else {
            $string .= "/$element";
          }
          if (not isInList($string, \@list)) {
            push @list, $string;
          }
        }
      }
    }
    insertTreeList($treew, @list);
    # open found keywords
    filter_tree_open($treew, '', $filter);
  }
  return;  
}

##############################################################
# open all trees which match the filter criteria
# recursive function
##############################################################
sub filter_tree_open {
  my ($treew, $startkey, $filter) = @_;
  my $open = 0;
  foreach ($treew->info('children', $startkey)) {
    # if any of the childs matches we open the parent
    if (filter_tree_open($treew, $_, $filter)) {
      $treew->open($_);
      $open = 1;
    }
    else {
      $treew->close($_);
    }
    my @path = split (/\//,$_); # get the last item
    if ($path[-1]=~ m|$filter|i) {
      $open = 1;
    }
  }
  return $open;
}

##############################################################
##############################################################
sub add_key_cloud {
  my $w = shift;
  my $lb = shift;
  my @search_keys = ();
  my @exclude_keys = ();
  
  my $add_mode = 1;

  my $keyf   = $w->Frame(-bd => 1, -relief => 'solid')->pack(-expand => 0, -fill => 'x', -padx => 2, -pady => 1);
  my $exkeyf = $w->Frame(-bd => 1, -relief => 'solid')->pack(-expand => 0, -fill => 'x', -padx => 2, -pady => 1);
  my $picf   = $w->Frame(-bd => 1, -relief => 'flat')->pack(-expand => 0, -fill => 'x', -padx => 2, -pady => 1);
  
  # included keywords
  my $label = '';
  my $af = $keyf->Frame()->pack(-expand => 0, -fill => 'x', -padx => 0, -pady => 0);
  $w->{Include} = $af->Label(-text => lang('Included'), -anchor => 'w')->pack(-side => 'left', -padx => 2, -pady => 0);
  $balloon->attach($w->{Include}, -msg => lang('Included keywords')."\n".lang('Click on a keyword below to add it to this list'));
  $w->{First} = $af->Button(-image => $mapivi_icons{'Clear'}, 
                          -command => sub {
                  # reset search_keys
                  @search_keys = ();
                  $label = '';
                  show_keywords($w, \@search_keys, \@exclude_keys);
      })->pack(-side => 'right', -padx => 2, -pady => 2);
  $balloon->attach($w->{First}, -msg => lang('Clear list'));
  $w->{Back} = $af->Button(-image => $mapivi_icons{'Back'}, 
                          -command => sub {
                  return unless (@search_keys);
                  # remove last element of array  search_keys
                  pop @search_keys;
                  $label = '';
                  $label .= "$_ " foreach (@search_keys);
                  show_keywords($w, \@search_keys, \@exclude_keys);
      })->pack(-side => 'right', -padx => 2, -pady => 2);
  $balloon->attach($w->{Back}, -msg => lang('Remove last keyword from list'));
  $keyf->Label(-textvariable => \$label, -anchor => 'w',
                )->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 1, -pady => 1);
                
  # excluded keywords
  my $exlabel = '';
  my $bf  = $exkeyf->Frame()->pack(-expand => 0, -fill => 'x', -padx => 0, -pady => 0);
  $w->{Exclude} = $bf->Label(-text => lang('Excluded'), -anchor => 'w')->pack(-side => 'left', -padx => 2, -pady => 0);
  $balloon->attach($w->{Exclude}, -msg => lang('Excluded keywords')."\n".lang('Right click on a keyword below to add it to this list'));
  $w->{exFirst} = $bf->Button(-image => $mapivi_icons{'Clear'}, 
                          -command => sub {
                  # reset search_keys
                  @exclude_keys = ();
                  $exlabel = '';
                  show_keywords($w, \@search_keys, \@exclude_keys);
      })->pack(-side => 'right', -padx => 2, -pady => 2);
  $balloon->attach($w->{exFirst}, -msg => lang('Clear list'));
  $w->{exBack} = $bf->Button(-image => $mapivi_icons{'Back'}, 
                          -command => sub {
                  return unless (@exclude_keys);
                  # remove last element of array  search_keys
                  pop @exclude_keys;
                  $exlabel = '';
                  $exlabel .= "$_ " foreach (@exclude_keys);
                  show_keywords($w, \@search_keys, \@exclude_keys);
      })->pack(-side => 'right', -padx => 2, -pady => 2);
  $balloon->attach($w->{exBack}, -msg => lang('Remove last keyword from list'));
  $exkeyf->Label(-textvariable => \$exlabel, -anchor => 'w',
                )->pack(-side => 'top', -expand => 0, -fill => 'x', -padx => 1, -pady => 1);

  # show button, label and refresh button 
  $w->{Show} = $picf->Button(-text => lang('Show'),#-image => $mapivi_icons{'Show'},
                -command => sub {
                  $act_modus = KEYWORDCLOUD;
                  @act_keywords    = @search_keys;
                  @act_keywords_ex = @exclude_keys;
                  showThumbs();
                })->pack(-side => 'left', -padx => 3, -pady => 2);
  $balloon->attach($w->{Show}, -msg => lang('Show these pictures'));
  # label
  my $lab2 = $picf->Label(-textvariable => \$w->{label2}, -anchor => 'w'
                )->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 3, -pady => 1);
  $balloon->attach($lab2, -msg => "x pictures, y keywords\nx = number of pictures with the selected keywords\ny = number of displayed keywords");
  # Help button
  $w->{Help} = $picf->Button(-image => $mapivi_icons{Help},
                -command => sub {
                showText("Help for keyword cloud", "The box shows all used keywords. The bigger the keyword the more often it is used.\nA right click on any keyword will add it to the include, a left click to the exclude list.\nClick \"".lang('Show')."\" to show pictures containing the include keywords.\nTo restrict the search to pictures with a certain rating use the \"".lang('Rating')."\" button.", NO_WAIT);
                })->pack(-side => 'right', -padx => 3);
  $balloon->attach($w->{Help}, -msg => lang('Help'));
  # Refresh button
  $w->{Refresh} = $picf->Button(-image => $mapivi_icons{'UpdateS'},
                -command => sub {
                  show_keywords($w, \@search_keys, \@exclude_keys);
                })->pack(-side => 'right', -padx => 3);
  $balloon->attach($w->{Refresh}, -msg => lang('Reread keywords from database'));
                
      
  $w->{canvas} = $w->Scrolled('Canvas',
                        -scrollbars => 'osoe',
                        -width  => 70,
                        -height => 40,
                        -relief => 'sunken',
                        -bg => $conf{color_act_bg}{value},
                        -cursor => 'hand2',
        )->pack(-expand => 1, -fill => 'both', -padx => 1, -pady => 1);
  $w->{canvas}->configure(-scrollregion => [0, 0, 700, 400]);
  show_keywords($w, \@search_keys, \@exclude_keys);
  # todo: mouse wheel scrolling doesn't work, mh 2011-05
  #focus_on_enter($w->{canvas}->Subwidget("scrolled"));
  
  # reaction for clicking on a keyword (tag)
  $w->{canvas}->CanvasBind('<Button-1>'  => sub {
    my @curr = $w->{canvas}->find('withtag', 'current');
    my @tags = $w->{canvas}->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($w, \@search_keys, \@exclude_keys);
  });
  
  # reaction for right clicking on a keyword (tag)
  $w->{canvas}->CanvasBind('<Button-3>'  => sub {
    my @curr = $w->{canvas}->find('withtag', 'current');
    my @tags = $w->{canvas}->gettags($curr[0]);
    foreach (@tags) {
      next if ($_ eq 'current');
      push @exclude_keys, $_ unless (isInList($_, \@exclude_keys));
    }
    $exlabel = '';
    $exlabel .= "$_ " foreach (@exclude_keys);
    show_keywords($w, \@search_keys, \@exclude_keys);
  });
}
##############################################################
##############################################################
sub add_search_frame {
  my $w = shift;

  $w->{labelw} = $w->Label(-text => '')->pack(-anchor => 'w');

  # the search pattern
  my $pattern = $config{SearchPattern};
  my $search_text = 'All IPTC infos, EXIF data, JPEG comments, the file names and paths
of all pictures in the database will be searched.
The search is an AND-search and case insensitive.';
  # search box
  my $sf = $w->Frame(-bd => 1, -relief => 'raised')->pack(-expand => 0, -fill => 'x', -padx => 2, -pady => 10);
  $sf->Label(-text => lang('Search'))->pack(-side => 'top', -anchor => 'w', -padx => 2);
  my $af = $sf->Frame()->pack(-expand => 0, -fill => 'x', -padx => 2, -pady => 1);
  $w->{entry} = $af->Entry(-textvariable => \$pattern, -width => 10)->pack(-side => 'left', -fill => 'x', -expand => 1, -padx => 1);
  $balloon->attach($w->{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 **"');
  $w->{entry}->bind('<Return>', sub { $w->{search}->Invoke; } );
  $w->{entry}->focus;
  $w->{entry}->selectionRange(0,'end'); # select all

  $w->{search} =
    $af->Button(-image => $mapivi_icons{Search}, -pady => 0,
                  -command => sub {
                    # clear incremental search labels
                    $w->{incr_label_state} = '';
                    $w->{incr_label_pics} = '';
                    # store the patterns before we process them
                    $config{SearchPattern} = $pattern;
                    $act_modus = SEARCH;
                    updateThumbs();
                    return;
                  })->pack(-side => 'left', -anchor => 'w', -expand => 0,-fill => 'x',-padx => 1,-pady => 1);
  $balloon->attach($w->{search}, -msg => 'Press here to perform a search for the given search pattern.'."\n".$search_text);

  # search while typing - incremental search box
  my $if = $w->Frame(-bd => 1, -relief => 'raised')->pack(-expand => 0, -fill => 'x', -padx => 2, -pady => 10);
  my $pattern2 = '';
  $w->{incr_pic_list_valid} = 0;
  $if->Label(-text => lang("Incremental search"))->pack(-side => 'top', -anchor => 'w', -padx => 2);
  my $incr_search_time_threshold = 500; # in ms
  $w->{entry2} = $if->Entry(-textvariable => \$pattern2,
                            -validate => 'key',
                            -validatecommand => sub {
                              # stop running incremental search
                              $w->{incr_search_running} = 0;
                              # stop timer
                              $w->{incr_timer}->cancel if ($w->{incr_timer}) ;
                              my $pattern = $_[0];
                              # start new timer
                              $w->{incr_timer} = $w->after($incr_search_time_threshold,  sub { search_incremental($w, $pattern); });
                              return 1;
                              },
                            -width => 10)->pack(-side => 'top', -anchor => 'w', -fill => 'x', -expand => 1, -padx => 2);
  $balloon->attach($w->{entry2}, -msg => "Enter any search pattern here.\nThe search will automatically start $incr_search_time_threshold ms after the last keypress.\n$search_text");
  $w->{incr_label_state} = '';
  $w->{incr_label_pics} = '';
  $if->Label(-textvariable => \$w->{incr_label_state})->pack(-side => 'top', -anchor => 'w', -padx => 2);
  $if->Label(-textvariable => \$w->{incr_label_pics})->pack(-side => 'top', -anchor => 'w', -padx => 2);
  # end incremental search
  
  my $bf = $w->Frame()->pack(-anchor => 'sw', -expand => 1, -fill => 'x');
  $bf->Button(-text => lang('Advanced Search'),  -pady => 0,
                  -command => sub {
                    searchMetaInfo()
                  })->pack(-side => 'left', -anchor => 'sw', -padx => 3, -pady => 3);
  $bf->Button(-image => $mapivi_icons{Help}, #-text => '?',
        -command => sub {
            showText("Help for search navigation", "Enter any search string in the entry and press the button to perform a search for the given search pattern in the Mapivi picture database.
$search_text\nUse the \"".lang("Advanced Search")."\" button to perform an expert search.", NO_WAIT);
      })->pack(-side => 'left', -padx => 3, -pady => 3);
}

##############################################################
##############################################################
sub search_incremental {
  my $w = shift;
  my $pattern = shift;
  my $hit_count = 0;
  $w->{incr_label_pics} = '';
  if ((not defined $pattern) or ($pattern eq '')) {
    print "search_incremental: no or empty pattern\n" if $verbose;
    return;
  }
  $w->{incr_search_running} = 1;
  $w->{incr_label_state} = lang('searching').' ...';
  # clean the thumbnail table
  $picLB->delete('all');
  $config{SearchPattern} = $pattern;
  $act_modus = SEARCH;
  set_act_nav_label();
  #log_it("searching pictures  ...");
  my $search_hash;
  # if we've searched throu all pictures we can reuse the result list for the
  # next incremental search, if the new search pattern contains the old pattern
  # this will speed up searches
  if (($w->{incr_pic_list_valid}) and (index($pattern,$w->{incr_pic_list_pattern}) == 0)) {
    #print "using last result (".$w->{incr_pic_list_pattern}." is substr of $pattern)\n";
    $search_hash = \%{$w->{incr_pic_list}};
  } else {
    #print "using searchDB\n";
    $search_hash = \%searchDB;
  }
  # replace (german) umlaute by corresponding letters
  $pattern =~ s/([$umlaute])/$umlaute{$1}/g if ($config{ConvertUmlaut});
  my $pat = makePattern($pattern);# support windows like search patterns
  # if pattern contains a whitespace we add the time-consuming look-ahead
  if ($pat =~ m/.*\s+.*/) { 
    $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 $last_time;
  my $i = 0;
  my $nr = keys %$search_hash;
  foreach my $dpic (keys %$search_hash) {
    last if ($w->{incr_search_running} == 0);
    $i++;
    # show progress every 300 ms
    if (!defined $last_time || Tk::timeofday()-$last_time > 0.3) {
      my $percent = int($i/$nr*100);
      $w->{incr_label_state} = lang('searching')." ($percent\%) ...";
      $last_time = Tk::timeofday();
      $w->update;
    }
    if ($conf{nav_rating_on}{value}) {
      next if (not rating_valid($searchDB{$dpic}{URG}, $conf{search_rating_max}{value}, $conf{search_rating_min}{value}));
    }
    my $meta = $dpic;
    $meta .= ' '.$searchDB{$dpic}{COM}  if (defined $searchDB{$dpic}{COM});
    $meta .= ' '.$searchDB{$dpic}{EXIF} if (defined $searchDB{$dpic}{EXIF});
    $meta .= ' '.$searchDB{$dpic}{IPTC} if (defined $searchDB{$dpic}{IPTC});
    $meta .= ' '.$searchDB{$dpic}{KEYS} if (defined $searchDB{$dpic}{KEYS});
    if ((defined $meta) and ($meta ne '')) {
      # replace newlines with space
      $meta  =~ s/\n/ /g;
      if ($meta =~ m/.*$pat.*/i) {
        # collect matching pics in a list
        $hit_count++;
        $w->{incr_pic_list}{$dpic}++;
        $w->{incr_label_pics} = langf("found %d pictures",$hit_count);
        addOneRow($picLB, $dpic, 1);
      }
    }
  } # foreach
  #print "incr search stop \"$pattern\" - searched $i of $nr pics - found ".scalar(@pic_list)." pictures\n";
  $w->{incr_label_state} = lang('ready');
  $w->{incr_label_pics} = langf("found %d pictures",$hit_count);
  # store actual search pattern 
  $w->{incr_pic_list_pattern} = $pattern;
  # set a flag if the search finished, else delete search results
  if ($i == $nr) {
    $w->{incr_pic_list_valid} = 1;
  }
  else {
    if ($hit_count > 0) {
      $w->{incr_pic_list_valid} = 0;
      undef %{$w->{incr_pic_list}};
    }
  }
  showNrOf();
  return;
}

##############################################################
##############################################################
sub get_database_info {
  my $keys = keys %searchDB;
  my $size = getFileSize($searchDBfile, FORMAT);
  return langf("The database contains %d pictures, database file size is %s", $keys, $size);
}

##############################################################
##############################################################
sub add_rating_constraint {
  my $w = shift;
  my $nav_rating_frame = $w->Frame(-bd => 1, -relief => 'raised');
  my $rab;
  $rab = $nav_rating_frame->Checkbutton(-variable => \$conf{nav_rating_on}{value},
                        -text => lang('Rating'), -indicatoron => 0,
                        -command => sub {
                          if ($conf{nav_rating_on}{value}) {
                            $nav_rating_frame->{subframe}->pack(-after => $rab, -side => 'left', -expand => 1, -fill =>'x', -padx => 0, -pady => 0);# if (!ismapped($addF));
                          }
                          else { $nav_rating_frame->{subframe}->packForget(); } # if (ismapped($addF));
                        #show_keywords($win, \@search_keys, \@exclude_keys);
                        }
                        )->pack(-side => 'left', -fill => 'both', -anchor => 'w', -padx => 1, -pady => 0);             
  $balloon->attach($rab, -msg => "Limit pictures to a rating range.\nIf the first button shows e.g. 4 stars and the second button shows 2 stars\nonly pictures with a rating of 2, 3 or 4 stars are displayed.\nNote: The function is disabled in folder navigation mode.");
  $nav_rating_frame->{subframe} = $nav_rating_frame->Frame();
  if ($conf{nav_rating_on}{value}) {
    $nav_rating_frame->{subframe}->pack(-after => $rab, -side => 'left', -expand => 1, -fill =>'x', -padx => 0, -pady => 0);# if (!ismapped($addF));
  }
  else {
    $nav_rating_frame->{subframe}->packForget();
  }
  rating_button_min_max($nav_rating_frame->{subframe}, \$conf{search_rating_max}{value}, \$conf{search_rating_min}{value});
  return $nav_rating_frame;
}

##############################################################
##############################################################
sub add_dir_tree {
  my $dir_frame = shift;
  my $dirtree;
  $dirtree = $dir_frame->Scrolled('DirTree',
                           -scrollbars => 'osoe',
                           -width => 30,
                           -height => 200,
                           -showhidden => $config{ShowHiddenDirs},
                           -selectmode => 'browse',
                           -exportselection => 1,
                           -browsecmd => sub {
                             # this function will show all subdirs when clicking on the + sign of a dir
                             $dirtreedir = shift;
                             $dirtreedir = Encode::encode('iso-8859-1', $dirtreedir);
                             return if (@_ >= 1);
                             if (!-d $dirtreedir) {
                               log_it("$dirtreedir does not exists!");
                               print "dirtree: $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(-expand => 1, -fill => 'both');
  return $dirtree;
}

##############################################################
##############################################################
sub get_pics_by {
  my $kind = shift; # either LOCATION or DATE
  my $data = shift; # list ref between one and four location names (country, state, city, sublocation) or dates (year, month, day, hour)
  my @list = ();
  my %hash;
  if ($kind == LOCATION) {
    %hash = get_locations();
  }
  elsif ($kind == DATE) {
    %hash = get_dates();
  }
  else {
    warn "Wrong kind: $kind";
  }
  if (@$data == 1) {
    foreach my $a (sort keys %{$hash{$$data[0]}}) {
      foreach my $b (sort keys %{$hash{$$data[0]}{$a}}) {
        foreach my $c (sort keys %{$hash{$$data[0]}{$a}{$b}}) {
          push @list, sort keys %{$hash{$$data[0]}{$a}{$b}{$c}};
        }
      }
    }
  }
  elsif (@$data == 2) {
    foreach my $b (sort keys %{$hash{$$data[0]}{$$data[1]}}) {
      foreach my $c (sort keys %{$hash{$$data[0]}{$$data[1]}{$b}}) {
        push @list, sort keys %{$hash{$$data[0]}{$$data[1]}{$b}{$c}};
      }
    }
  }
  elsif (@$data == 3) {
    foreach my $c (sort keys %{$hash{$$data[0]}{$$data[1]}{$$data[2]}}) {
      push @list, sort keys %{$hash{$$data[0]}{$$data[1]}{$$data[2]}{$c}};
    }
  }
  elsif (@$data == 4) {
    @list = sort keys %{$hash{$$data[0]}{$$data[1]}{$$data[2]}{$$data[3]}};
  }
  else {
    warn "Wrong number of data: @$data";
  }
  
  # remove pictures with wrong rating from list
  if ($conf{nav_rating_on}{value}) {
    my @list2 = ();
    foreach (@list) {
      next if (not rating_valid($searchDB{$_}{URG}, $conf{search_rating_max}{value}, $conf{search_rating_min}{value}));
      # add only pictures which fullfill the rating constraints
      push @list2, $_;
    }
    # reset original list
    @list = ();
    # copy new list to original list
    @list = @list2;
  }
  return @list;
}

##############################################################
##############################################################
sub insert_collections_in_tree {
  my $tree = shift; # tree widget ref
  my $hash = shift; # slideshow hash ref
  $tree->delete('all');
  foreach my $folder (sort keys %$hash) {
    $tree->add($folder, -text => $folder);
    foreach my $collection (sort keys %{$hash->{$folder}}) {
      my $pics = scalar(@{$hash->{$folder}->{$collection}->{pics}});
      $tree->add("$folder%$collection", -text => "$collection [$pics]");
    }
  }
  # add plus/minus buttons to collapse tree
  $tree->autosetmode;
  # collapse tree in all levels
  tree_fold(CLOSE, $tree);
  return;
}

##############################################################
##############################################################
sub insert_in_tree {
  my $kind = shift; # either LOCATION or DATE
  my $tree = shift; # tree widget ref
  my $hash = shift; # location or date hash ref
  $tree->delete('all');
  # insert the 4-level-deep hash in the tree
  foreach my $a (sort keys %$hash) {
    my $pics = 0;
    foreach my $b (sort keys %{$hash->{$a}}) {
      foreach my $c (sort keys %{$hash->{$a}->{$b}}) {
        foreach my $d (sort keys %{$hash->{$a}->{$b}->{$c}}) {
          $pics += keys %{$hash->{$a}->{$b}->{$c}->{$d}};
        }
      }
    }
    $tree->add($a, -text => "$a [$pics]");
    foreach my $b (sort keys %{$hash->{$a}}) {
      my $pics = 0;
      foreach my $c (sort keys %{$hash->{$a}->{$b}}) {
        foreach my $d (sort keys %{$hash->{$a}->{$b}->{$c}}) {
          $pics += keys %{$hash->{$a}->{$b}->{$c}->{$d}};
        }
      }
      my $text = $b;
      $text = "$a-$b" if ($kind == DATE);
      $tree->add("$a%$b", -text => "$text [$pics]");
      foreach my $c (sort keys %{$hash->{$a}->{$b}}) {
        my $pics = 0;
        foreach my $d (sort keys %{$hash->{$a}->{$b}->{$c}}) {
          $pics += keys %{$hash->{$a}->{$b}->{$c}->{$d}};
        }
        my $text = $c;
        $text = "$a-$b-$c" if ($kind == DATE);
        $tree->add("$a%$b%$c", -text => "$text [$pics]");
        foreach my $d (sort keys %{$hash->{$a}->{$b}->{$c}}) {
          my $pics = keys %{$hash->{$a}->{$b}->{$c}->{$d}};
          my $text = $d;
          $text = "$d:00" if ($kind == DATE);
          $tree->add("$a%$b%$c%$d", -text => "$text [$pics]");
        }
      }
    }
  }
  # add plus/minus buttons to collapse tree
  $tree->autosetmode;
  # collapse tree in all levels
  tree_fold(CLOSE, $tree);
  return;
}

##############################################################
# collapse or unfold a tree
##############################################################
sub tree_fold {
  my $what = shift; # OPEN or CLOSE
  my $tree = shift; # tree widget
  my $item = shift; # optional item path e.g. "USA%West Virginia%Canaan", empty = root (all entries)
  foreach ($tree->info('children', $item)) {
    $what ? $tree->open($_) : $tree->close($_);
    if (scalar(@{$tree->info('children')}) >= 1) {
      # if there are still some children call function recursive
      tree_fold($what, $tree, $_);
    }
  }
}

##############################################################
# get_dates - get all date/time info from location hash or if not available from the searchDB
##############################################################
sub get_dates {
  my $mode = shift; # optional: no argument or UPDATE
  log_it(lang('Getting date and time from database ...'));
  my $start = Tk::timeofday();
  if ($dates_need_update or (defined $mode and $mode == UPDATE)) {
    %dates = get_dates_from_DB();
    $dates_need_update = 0;
  }
  my $duration = sprintf "%.2f", (Tk::timeofday() - $start);
  log_it(lang('Ready!').' '.langf("Got date and time in %s seconds.",$duration));
  return %dates;
}

##############################################################
# get_dates_from_DB - get all dates from the searchDB as hash
##############################################################
sub get_dates_from_DB {
  my %date_hash;
  # build date/time hash
  # loop through all pictures in the DB
  #foreach my $dpic (keys %searchDB) {
  while (my ($dpic, undef) = each %searchDB) {
    #my $s = 0; my $m = 0;
    my $h = 0; my $d = 0; my $mo = 0; my $y = 0;
    if ($searchDB{$dpic}{TIME}) {
      (undef,undef,$h,$d,$mo,$y) = getDateTime($searchDB{$dpic}{TIME});
    }
    $mo = sprintf "%02d", $mo;
    $d  = sprintf "%02d", $d;
    $h  = sprintf "%02d", $h;
    #my $key = sprintf "%04d%02d", $y, $mo; # key = yyyymm
    # four levels down to hour should be OK
    $date_hash{$y}{$mo}{$d}{$h}{$dpic}++;
  }
  return %date_hash;
}  

##############################################################
# get_locations - get all locations from location hash or if not available from the searchDB
##############################################################
sub get_locations {
  my $mode = shift; # optional: no argument or UPDATE
  log_it(lang('Getting locations from database ...'));
  my $start = Tk::timeofday();
  if ($locations_need_update or (defined $mode and $mode == UPDATE)) {
    %locations = get_locations_from_DB();
    $locations_need_update = 0;
  }
  my $duration = sprintf "%.2f", (Tk::timeofday() - $start);
  log_it(lang('Ready!').' '.langf("Got locations in %s seconds.",$duration));
  return %locations;
}  

##############################################################
# get_locations_from_DB - get all locations from the searchDB as hash
##############################################################
sub get_locations_from_DB {
  my %location_hash;
  # build location hash
  # loop through all pictures in the DB
  #foreach my $dpic (keys %searchDB) {
  while (my ($dpic, undef) = each %searchDB) {
    my $country = $empty_str;
    my $state   = $empty_str;
    my $city    = $empty_str;
    my $subloc  = $empty_str;
    if (defined $searchDB{$dpic}{IPTC}) {
      # add a newline, else the last match won't work
      my $iptc = $searchDB{$dpic}{IPTC}."\n";
      # Country needs extra treatment, because in the short IPTC info
      # we can't distinguish between LocationName and LocationCode
      # Accoring to @IPTCAttributes Name comes before Code, so when Name is available
      # (and thus $country is no longer $empty_str) we ignore Code
      if (($iptc =~ m|Country\.: (.*)\n|) and ($country eq $empty_str)) {
        $country = $1;
      }
      if ($iptc =~ m|Provinc\.: (.*)\n|) {
        $state = $1;
      }
      if ($iptc =~ m|City\s*: (.*)\n|) {
        $city = $1;
      }
      if ($iptc =~ m|SubLoca\.: (.*)\n|) {
        $subloc = $1;
      }
    }
    $location_hash{$country}{$state}{$city}{$subloc}{$dpic}++;
  }
  return %location_hash;
}  

##############################################################
# returns true if pics have no location info or if they have
# location info and the user agrees to overwrite
##############################################################
sub allow_location_overwrite {
  my $w = shift; # widget
  my $sellist = shift; # list ref
  my $ok = 1;
  my $pics_with_location = check_locations($sellist);
  if ($pics_with_location > 0) {
    $ok = 0;
    my $rc = $w->messageBox(-message => "$pics_with_location of the ".scalar(@$sellist)." selected pictures have a location info. This information will be overwritten. Please press Ok to continue.",
                 -icon => 'question', -title => "Overwrite location?", -type => 'OKCancel');
    $ok = 1 if ($rc =~ m/Ok/i);
  }
  return $ok;
}

##############################################################
# check_locations - check if the given list of pictures has any location info
# returns the number of pictures with locations
##############################################################
sub check_locations {
  my $pic_list = shift; # list reference
  my $count = 0;  
  # loop through all pictures of the list
  foreach my $dpic (@$pic_list) {
    if (defined $searchDB{$dpic}{IPTC}) {
      my $iptc = $searchDB{$dpic}{IPTC};
      if (($iptc =~ m|Country\.:.*\n|) or ($iptc =~ m|Provinc\.:.*\n|) or ($iptc =~ m|City\s*:.*\n|) or ($iptc =~ m|SubLoca\.:.*\n|)) {
        $count++;
      }
    }
  }
  return $count;
}  

##############################################################
# filter the picture list (arg1) by IPTC keywords, 
# the pictures containing exclude keywords (arg2) are removed from the list 
# the number of excluded pics is returned.
##############################################################
sub filter_pics {
  my $pics = shift; # list reference
  my $exclude_keys = shift; # string, space separated list for keywords which must not be contained
  my @exclude_list = split /\s+/, $exclude_keys; # split space separated list 
  my @pic_list;      # list of included pictures
  my $exclude_count = 0;  # number of excluded pictures
  foreach my $dpic (@{$pics}) {
    if (defined $searchDB{$dpic}{KEYS}) {
      # check if any items of the exclude_list are contained in this keyword string
      # exclude pictures with certain keywords
      if (string_contains($searchDB{$dpic}{KEYS}, \@exclude_list)) {
        $exclude_count++;
        next;
      }
    }
    # collect matching pics in a list
    push @pic_list, $dpic;
  }
  @$pics = @pic_list;
  return $exclude_count;
}

##############################################################
# get_pics_with_keywords - returns a list of pictures with the
#                          given keywords (source: searchDB)
##############################################################
sub get_pics_with_keywords {
  my $search_keys = shift; # list reference
  my $exclude_keys = shift; # list reference for keywords which must not be contained
  my @pic_list;
  # build keyword/tag hash
  #foreach my $dpic (keys %searchDB) {
  while (my ($dpic,undef) = each %searchDB) {
    # skip if no keywords in picture
    next unless (defined $searchDB{$dpic}{KEYS});
    if ($config{KeywordDate}) {
	  my $time = $searchDB{$dpic}{TIME};
	  if (defined $time) {
        next if ($time < $config{KeywordStart});
        next if ($time > $config{KeywordEnd});
      }
    }
    if ($conf{nav_rating_on}{value}) {
      next if (not rating_valid($searchDB{$dpic}{URG}, $conf{search_rating_max}{value}, $conf{search_rating_min}{value}));
    }
    # check if any items of the exclude_keys list are contained in this keyword string
    next if (string_contains($searchDB{$dpic}{KEYS}, $exclude_keys));
    # check if all items of the search_keys list are contained in this keyword string
    next if (string_contains_not($searchDB{$dpic}{KEYS}, $search_keys));
    # collect matching pics in a list
    push @pic_list, $dpic;
  }
  return @pic_list;
}

##############################################################
# get_pics_by_searching - returns a list of pictures matching a search pattern (source: searchDB)
##############################################################
sub get_pics_by_searching {
  my $pattern = shift; # search pattern
  my $exclude = shift; # explude pattern
  my @pic_list;
  return @pic_list if ((not defined $pattern) or ($pattern eq ''));
  log_it(lang('Searching pictures  ...'));
  # replace (german) umlaute by corresponding letters
  $pattern =~ s/([$umlaute])/$umlaute{$1}/g if ($config{ConvertUmlaut});
  $exclude =~ s/([$umlaute])/$umlaute{$1}/g if ($config{ConvertUmlaut});
  # cut the pattern to 20 chars to fit into the progressbar dialog
  my $pattern_show = cutString($pattern, 20, '..');
  my $pat = makePattern($pattern);# support windows like search patterns
  my $exl = makePattern($exclude);# support windows like search patterns
  # if pattern contains a whitespace we add the time-consuming look-ahead
  if ($pat =~ m/.*\s+.*/) { 
    $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 $case = 'i'; $case = '' if $config{SearchCase};
  my $i = 0;
  my $found = 0;
  my $nr = keys %searchDB;
  my $pw = progressWinInit($top, lang('Searching'));
  # using each instead of keys (for small mapivi DB (3460 pics, 1,3MB) 1.2-1.5 times faster)
  # http://stackoverflow.com/questions/22841830
  # Pros:
  # This uses very little memory as every time each is called it only
  # returns a pair of (key, value) element.
  # Cons:
  # You can't order the output by key.
  # The iterator it uses belongs to %h. If the code inside the loop calls
  # something that does keys %h, values %h or each %h, then the loop won't
  # work properly, because %h only has 1 iterator
  while (my ($dpic, undef) = each %searchDB) {
    last if progressWinCheck($pw);
    $i++;
    $found = scalar @pic_list;
    progressWinUpdate($pw, langf("Searching for \"%s\" in database (%d/%d) ... Found %d picture(s)",$pattern_show,$i,$nr,$found), $i, $nr);
    if ($conf{nav_rating_on}{value}) {
      next if (not rating_valid($searchDB{$dpic}{URG}, $conf{search_rating_max}{value}, $conf{search_rating_min}{value}));
    }
    my $meta = $dpic;
    $meta .= ' '.$searchDB{$dpic}{COM}  if (defined $searchDB{$dpic}{COM});
    $meta .= ' '.$searchDB{$dpic}{EXIF} if (defined $searchDB{$dpic}{EXIF});
    $meta .= ' '.$searchDB{$dpic}{IPTC} if (defined $searchDB{$dpic}{IPTC});
    $meta .= ' '.$searchDB{$dpic}{KEYS} if (defined $searchDB{$dpic}{KEYS});
    if ((defined $meta) and ($meta ne '')) {
      # replace newlines with space
      $meta  =~ s/\n/ /g;
      if ($meta =~ m/(?$case).*$pat.*/) {
        # collect matching pics in a list
        push @pic_list, $dpic;
      }
    }
  } # while
  progressWinEnd($pw);
  return (sort(@pic_list));
}

##############################################################
# format hash content to a printable string
# considers only one level and assumes for best readability
# that the keys consists of four chars 
##############################################################
sub hash_content {
  my $hash = shift;
  my $text = '';
  my $len_keys = 0;
  my $len_values = 0;
  my $nr_keys = 0;
  foreach my $key (sort keys %$hash) {
    $nr_keys++;
    $len_keys += length($key);
    $text .= "$key: ";
    my $value = $$hash{$key};
    if (defined $value) {
      $len_values += length($value);
      # replace newline by newline+spaces to preserve indentation
      # e.g. for multi line IPTC and EXIF data
      $value =~ s/\n/\n       /g;  
      $text .= "\"$value\"";
    }
    $text .= "\n";
  }
  my $len_total = $len_keys + $len_values;
  my $len_keys_p = sprintf "%.1f",$len_keys/$len_total*100;
  $text .= "\nFound $nr_keys elements in hash. Hash size is $len_total chars (keys: ${len_keys_p}%)\n";
  return $text;
}

##############################################################
# 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.";
  # open window
  my $ew = $top->Toplevel();
  $ew->title("Edit search database");
  $ew->iconimage($mapiviicon) if $mapiviicon;
  my $height = ($text =~ tr/\n//);
  $height += 3;
  $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 => $conf{color_bg}{value},
                             -bd => 0
                            )->pack(-expand => 0, -padx => 3, -pady => 3,-anchor => 'w');
  $rotext->insert('end', $text);
  my $size = getFileSize($searchDBfile, FORMAT);
  my $keys = keys %searchDB;
  my ($first, $last) = get_date_limits();
  my $info = "$keys pictures in the database between the years $first and $last (file size of database: $size)";
  $ew->Label(-text => 'Database items:')->pack();
  my $listBox = $ew->Scrolled('Listbox',
                    -scrollbars => 'osoe',
                    -selectmode => 'extended',
                    -exportselection => 0,
                   )->pack(-expand => 1, -fill =>'both', -padx => 3, -pady => 3);
  $listBox->insert('end', (sort keys %searchDB));
  my $labF = $ew->Frame()->pack(-anchor => 'w', -padx => 3, -pady => 3);
  $labF->Label(-textvariable => \$info, -bg => $conf{color_bg}{value})->pack(-side => 'left');
  my $bf = $ew->Frame()->pack(-fill => 'x', -padx => 3, -pady => 3);
  # remove button
  $bf->Button(-text => $buttext,
                -command => sub {
                  my @sellist = $listBox->curselection();
                  # check selection args: widget, min, max, listref, itemkind (e.g. 'picture')
                  return unless checkSelection($ew, 1, 0, \@sellist, lang("picture(s)"));
                  foreach my $item (reverse @sellist) {
                    my $dpic = $listBox->get($item);
                    delete $searchDB{$dpic};       # delete key from hash
                    $listBox->delete($item);
                  }
                  $keys = keys %searchDB; # display the new number of database entries
                  $info = "$keys entries in the database";
                }
             )->pack(-side => 'left', -anchor => 'w', -padx => 3, -pady => 3);
  my $showBut = 
  $bf->Button(-text => 'Show picture database details',
                -command => sub {
                  my @sellist = $listBox->curselection();
                  # check selection args: widget, min, max, listref, itemkind (e.g. 'picture')
                  return unless checkSelection($ew, 1, 5, \@sellist, lang("picture(s)"));
                  foreach my $item (@sellist) {
                    my $dpic = $listBox->get($item);
                    my $text = hash_content($searchDB{$dpic});
                    my $pic = basename($dpic);
                    my $thumb = getThumbFileName($dpic);
                    showText("Database content of $pic", $text, NO_WAIT, $thumb);
                  }
                }
             )->pack(-side => 'left', -anchor => 'w', -padx => 3, -pady => 3);
  $listBox->bind("<Double-Button-1>", sub { $showBut->Invoke(); });
  $bf->Button(-text => 'Clean database ...',
                -command => sub {
                  $ew->withdraw;
                  $ew->destroy;
                  cleanDatabase();
                }
             )->pack(-side => 'right', -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 => $conf{color_bg}{value},
            )->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 new number 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 $xBut = $ew->Button(-text => lang('Close'),
                    -command => sub { $ew->withdraw; $ew->destroy; }
                 )->pack(-expand => 0, -fill => 'x', -padx => 3, -pady => 3);

  bind_exit_keys_to_button($ew, $xBut);
  $xBut->focus;
  $ew->Popup();
  window_center($ew, 60, 90);
  $ew->waitWindow;
  return;
}

##############################################################
##############################################################
sub window_center {
  my $window = shift; # window widget
  my $w_percent = shift; # window width in percent (0-100%) of screen width
  my $h_percent = shift; # window height in percent of screen height
  # print "widget = --".ref($window)."--\n";
  if ((not defined $window) or (ref($window) ne 'Tk::Toplevel') or
      (not defined $w_percent) or ($w_percent <= 0) or ($w_percent > 100) or
      (not defined $h_percent) or ($h_percent <= 0) or ($h_percent > 100)) {
    print "window_center: called with missing or wrong arguments: $w_percent, $h_percent\n";
    return;
  }
  my $w = int($w_percent/100 * $window->screenwidth);
  my $h = int($h_percent/100 * $window->screenheight);
  my $x = int((1-$w_percent/100)/2);
  my $y = int((1-$h_percent/100)/2);
  $window->geometry("${w}x${h}+${x}+${y}");
  $window->update();
  return;
}

##############################################################
# checkDatabase - check the comment and iptc fields of all
#                 database entries for problematic (non-ASCII) chars
#                 will e.g. complain about the copyright sign
##############################################################
sub checkDatabase {
  my $findings = '';
  my $i = 0;
  my $problems = 0;
  foreach my $dpic (sort keys %searchDB) {
    $i++;
    my $com  = $searchDB{$dpic}{COM};
    my $iptc = $searchDB{$dpic}{IPTC};
    my $keys = $searchDB{$dpic}{KEYS};
    if ((defined $com) and ($com =~ m/[^\x00-\x7f]/)) {
      $findings .= "comment      of $dpic\n";
      $problems++;
    }
    if ((defined $iptc) and ($iptc =~ m/[^\x00-\x7f]/)) {
      $findings .= "IPTC         of $dpic\n";
      $problems++;
    }
    if ((defined $keys) and ($keys =~ m/[^\x00-\x7f]/)) {
      $findings .= "IPTC keyword of $dpic\n";
      $problems++;
    }
  }
  my $text = "Check of IPTC keywords, IPTC data and JPEG comments in $i pictures finished.\nFound $problems problematic (non-ASCII) entries.\n\n$findings";
  showText("Check database", $text, WAIT);
}

##############################################################
# searchDupName - search duplicate pics in the database by
#                 same file name
##############################################################
sub searchDupsName {
  my %pics;  # hash of all file names key: file name or size value: directory+pic
  my $dpics         = shift; # ref to hash of all file names key: file name value: list of dirs+pic containing this pic
  my $ignore_links  = shift;
  my $filter        = shift;
  my $ignore_filter = shift;

  undef %$dpics;
  #log_it("searching duplicates by file name ...");
  # loop through all database entries
  foreach my $dpic (sort keys %searchDB) {
    next if (($filter ne '') and ($dpic !~ m!$filter!i));
    next if (($ignore_filter ne '') and ($dpic =~ m!$ignore_filter!i));
    next if ($ignore_links and -l $dpic);
    my $pic = basename($dpic);
    # new entry
    if (!defined $pics{$pic}) {
      $pics{$pic} = $dpic;
    }
    # duplicate found
    else {
      # if not defined in the dups hash, add first dir (was saved before)
      if (!defined $$dpics{$pic}) {
        $$dpics{$pic} = [$pics{$pic}];
      }
      # and add the actual dir and pic
      push @{$$dpics{$pic}}, $dpic;
    }
  }
}

##############################################################
# searchDupSize - search duplicate pics in the database by
#                 same file size
##############################################################
sub searchDupsSize {
  my %pics;  # hash of all file names key: file name or size value: directory+pic
  my $dpics         = shift; # ref to hash of all file names key: file size value: list of dirs+pic containing this pic
  my $ignore_links  = shift;
  my $filter        = shift;
  my $ignore_filter = shift;
  
  undef %$dpics;
  #log_it("searching duplicates by file size ...");
  # loop through all database entries
  foreach my $dpic (sort keys %searchDB) {
    next if (($filter ne '') and ($dpic !~ m!$filter!i));
    next if (($ignore_filter ne '') and ($dpic =~ m!$ignore_filter!i));
    next if ($ignore_links and -l $dpic);
    next if (!defined $searchDB{$dpic}{SIZE});
    my $size = $searchDB{$dpic}{SIZE}; # size in Bytes
    # new entry
    if (!defined $pics{$size}) {
      $pics{$size} = $dpic;
    }
    # duplicate found
    else {
      # if not defined in the dups hash, add first dir (was saved before)
      if (!defined $$dpics{$size}) {
        $$dpics{$size} = [$pics{$size}];
      }
      # and add the actual dir and pic
      push @{$$dpics{$size}}, $dpic;
    }
  }
}

##############################################################
# searchDupDate - search duplicate pics in the database by
#                 same EXIF creation date
##############################################################
sub searchDupsDate {
  my %pics;  # hash of all file names key: file name or date     value: directory+pic
  my $dpics         = shift; # ref to hash of all file names key: file date     value: list of dirs+pic containing this pic
  my $ignore_links  = shift;
  my $filter        = shift;
  my $ignore_filter = shift;
  undef %$dpics;
  #log_it("searching duplicates by file size ...");
  # loop through all database entries
  foreach my $dpic (sort keys %searchDB) {
    next if (($filter ne '') and ($dpic !~ m!$filter!i));
    next if (($ignore_filter ne '') and ($dpic =~ m!$ignore_filter!i));
    next if ($ignore_links and -l $dpic);
    #next if (-l $dpic);
    unless (defined $searchDB{$dpic}{TIME}) {
      print "$dpic has no EXIF date/time!\n";
      next;
    }
    my $date = $searchDB{$dpic}{TIME}; # EXIF creation date/time
    # new entry
    if (!defined $pics{$date}) {
      $pics{$date} = $dpic;
    }
    # duplicate found
    else {
      # if not defined in the dups hash, add first dir (was saved before)
      if (!defined $$dpics{$date}) {
        $$dpics{$date} = [$pics{$date}];
      }
      # and add the actual dir and pic
      push @{$$dpics{$date}}, $dpic;
    }
  }
}

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

  if (Exists($dupw)) {
    $dupw->deiconify;
    $dupw->raise;
    $dupw->focus;
    return;
  }
  my %dup_thumbs; # hash to store all thumbnails displayed in the duplicate window 
  my $pic;
  my $dir;
  my %dpics; # hash of all file names key: file name or size value: list of dirs+pic containing this pic
  my $searchForDups = 'Name';
  my $ignore_links = 0;
  my $filter = '';
  my $ignore_filter = '';
  # open window
  $dupw = $top->Toplevel();
  $dupw->title('Duplicate pictures');
  $dupw->iconimage($mapiviicon) if $mapiviicon;
  my $subF = $dupw->Frame()->pack(-fill => 'x', -expand => 0, -padx => 3, -pady => 2);
  my $subF2 = $dupw->Frame()->pack(-fill => 'x', -expand => 0, -padx => 3, -pady => 2);
  my $dbsize   = getFileSize($searchDBfile, FORMAT);
  my $label = '';
  $dupw->Label(-textvariable => \$label, -justify => 'left',-bg => $conf{color_bg}{value})->pack(-anchor => 'w', -padx => 1, -pady => 2);
  my $filter_entry = labeledEntry($subF2, 'left', 7, "Include", \$filter, 15);
  $balloon->attach($filter_entry, -msg => "Enter a part of the file or path name to filter for.\nExample: If you enter \"photos/2012\" only duplicates\nfrom the folder ...photos/2012... will be shown.");
  my $ignore_filter_entry = labeledEntry($subF2, 'left', 6, "Ignore", \$ignore_filter, 15);
  $balloon->attach($ignore_filter_entry, -msg => "Enter a part of the file or path name to ignore.\nExample: If you enter \"photos/2012\" no duplicates\nfrom the folder ...photos/2012... will be shown.");
  my $duplb = makeThumbListbox($dupw);

  $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
                  delete_thumb_objects(\%dup_thumbs);
                  $label = 'searching duplicates in database ...';
                  $duplb->update;
                  my $filterP = makePattern($filter); # create a windows like pattern
                  my $ignore_filterP = makePattern($ignore_filter); # create a windows like pattern
                  if ($searchForDups eq 'Name') {
                    searchDupsName(\%dpics, $ignore_links, $filterP, $ignore_filterP);
                  } elsif ($searchForDups eq 'Size') {
                    searchDupsSize(\%dpics, $ignore_links, $filterP, $ignore_filterP);
                  } elsif ($searchForDups eq 'Date') {
                    searchDupsDate(\%dpics, $ignore_links, $filterP, $ignore_filterP);
                  } elsif ($searchForDups eq 'Cancel') {
                    return;
                  } else {
                    warn "wrong searchForDups: $searchForDups\n";
                    return;
                  }
                  my $keys  = keys %dpics;
                  $label    = " $keys duplicates found in the database (file size: $dbsize).";
                  my $pcount = 0; # pic count = keys %dpics
                  my $dcount = 0; # dir count (if each pic has one duplicate this number is $pcount * 2)
                  # to distinguish between sets of duplicates we use a darker background for these rows 
                  my $bg2 = $duplb->Darken($fileS->cget(-background), 120); #  120% darker = 20% brighter
                  # we have to repeat the definition here, a copy does not work (see line containing "my $fileS")
                  my $thumbS2 = $duplb->ItemStyle('imagetext', -anchor => 'w', -textanchor => 's', -foreground=>$conf{color_fg}{value},   -background=>$bg2, -font => $thumbCaptionFont);
                  my $fileS2 = $duplb->ItemStyle('image', -anchor=>'w', -foreground=>$config{ColorFile}, -background=>$bg2);
                  my $iptcS2 = $duplb->ItemStyle('text', -anchor=>'nw', -foreground=>$config{ColorIPTC}, -background=>$bg2);
                  # save global styles to restore them later
                  my $thumbS_save = $thumbS; my $fileS_save = $fileS; my $iptcS_save = $iptcS;
                  # insert duplicates in hlist
                  my $pw = progressWinInit($duplb, "Displaying duplicate pictures");
                  foreach my $item (sort keys %dpics) {
                    last if progressWinCheck($pw);
                    $pcount++;
                    progressWinUpdate($pw, "Inserting duplicate ($pcount/$keys) ...", $pcount, $keys);
                    foreach my $dpic (@{$dpics{$item}}) {
                      last if progressWinCheck($pw);
                      insertPic($duplb, $dpic, \%dup_thumbs);
                      $dcount++;
                    }
                    # toggle style of name col to separate different duplicate sets
                    if ($fileS == $fileS_save) {
                      $thumbS = $thumbS2; $fileS = $fileS2; $iptcS = $iptcS2;
                    } else {
                      $thumbS = $thumbS_save; $fileS = $fileS_save; $iptcS = $iptcS_save;
                    };
                  }
                  progressWinEnd($pw);
                  # reset global style
                  $thumbS = $thumbS_save; $fileS = $fileS_save; $iptcS = $iptcS_save;
                  $label = " found $pcount duplicates with $dcount files.";
                  $duplb->update();
                })->pack(-side => 'left', -anchor => 'w', -fill => 'both');

  $subF->Label(-text => "duplicates by same ", -bg => $conf{color_bg}{value})->pack(-side => 'left', -anchor => 'w', -fill => 'both');

  $subF->Optionmenu(-variable => \$searchForDups, -textvariable => \$searchForDups, -options => [ 
  ['file name' => 'Name'],
  ['creation date and time' => 'Date'],
  ['file size' => 'Size'], ])->pack(-side => 'left', -anchor => 'w', -fill => 'both');

  $subF->Checkbutton(-text => 'ignore links', -variable => \$ignore_links)->pack(-side => 'left', -anchor => 'w', -fill => 'both', -padx => 1,-pady => 1);
  my $Xbut = $subF->Button(-text => lang('Close'),
                           -command => sub {
                             $dupw->withdraw();
                             $dupw->destroy();
                             # clean up memory - delete all found thumbnail photo objects
                             delete_thumb_objects(\%dup_thumbs);
                           }
                          )->pack(-side => 'left', -anchor => 'w', -fill => 'both', -expand => 1);

  # the context menu
  my $menu = $dupw->Menu(-title => "Duplicate pictures menu");

  ############# open pic
  $menu->command(-label => "Open picture in new window", -accelerator => "Middle Mouse Button",
                 -command => sub {
                   my @pics = $duplb->info('children');
                   return unless (@pics);
                   my @sellist = $duplb->info('selection');
                   if (@sellist != 1) {
                     $dupw->messageBox(-icon => 'warning', -message => "Please select exactly one picture!",
                                       -title => "Wrong selection", -type => 'OK');
                     return;
                   }
                   my $dpic = $sellist[0];
                   my $dir  = dirname($dpic);
                   if (!-d $dir) {
                     $dupw->messageBox(-icon => 'warning', -message => "Sorry, but the folder\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.",
                                       -title => "folder not found", -type => 'OK');
                     return;
                   }
                   $dupw->Busy;
                   showPicInOwnWin($dpic);
                   $dupw->Unbusy;
                 });

  ############# open dir
  $menu->command(-label => lang('open folder and show picture'), -accelerator => "<m>", -command => sub { open_pic_in_main($duplb); });

  ############# ignore dir
  $menu->command(-label => "ignore folder ...", -command => sub {
                   my @pics = $duplb->info('children');
                   return unless (@pics);
                   my @sellist = $duplb->info('selection');
                   if (@sellist != 1) {
                     $dupw->messageBox(-icon => 'warning', -message => "Please select exactly one picture!",
                                       -title => "Wrong selection", -type => 'OK');
                     return;
                   }
                   my $ignoredir = dirname($sellist[0]);
                   my $rc = myEntryDialog("Ignore folder", "Ignore all folders matching this pattern:", \$ignoredir);
                   return if ($rc ne 'OK' or $ignoredir eq '');
                   my $count = 0;
                   foreach my $i (@pics) {
                     next unless ($duplb->info("exists", $i));
                     my $dir = dirname($i);
                     if ($dir =~ m!$ignoredir!) {
                       $count++;
                       $label = "removing $dir ($count) ...";
                       #print "$dir remove $i $ignoredir\n";
                       $duplb->delete("entry", $i);
                     }
                   }
                   $label = "removed $count entries by folders.";
                 });

  ############# select all
  $menu->command(-label => lang("Select all"), -command => sub { selectAll($duplb); } );

  $menu->separator;

  ############# delete to trash
  $menu->command(-label => "delete picture to trash", -command => sub {
                   deletePics($duplb, TRASH);
                   $label = "pictures deleted";
                 } );

  ############# copy
  $menu->command(-label => "copy selected pictures ...", -command => sub {
                   copyPicsDialog(COPY, $duplb);
                   $label = "ready! (pictures copied)"; $dupw->update;
                 } );

  ############# move
  $menu->command(-label => "move selected pictures ...", -command => sub {
                   movePicsDialog($duplb);
                   $label = "ready! (pictures moved)"; $dupw->update;
                 } );

  # mouse and button bindings
  addCommonKeyBindings($duplb, $duplb);

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

  $duplb->bind('<ButtonRelease-2>', sub {
          return unless ($duplb->info('children'));
          my $dpic = getNearestItem($duplb);
          my $dir = dirname($dpic);
          if (!-d $dir) {
           $dupw->messageBox(-icon => 'warning', -message => "Sorry, but the folder\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.",
            -title => "folder not found", -type => 'OK');
            return;
          }
          $dupw->Busy;
          showPicInOwnWin($dpic);
          $dupw->Unbusy;
          } );
  bind_exit_keys_to_button($dupw, $Xbut);
  $dupw->bind('<Key-m>', sub { open_pic_in_main($duplb); });
  my $w = int(0.8 * $dupw->screenwidth);
  my $h = int(0.8 * $dupw->screenheight);
  $dupw->geometry("${w}x${h}+10+10");
  $duplb->update();
  $dupw->waitWindow;
}

##############################################################
# editHashDialog - let the user add or remove keys from a hash
##############################################################
sub editHashDialog {

  my $title   = shift;
  my $text    = shift;
  my $hr      = shift; # hash reference
  my $okB     = shift; # Ok button text
  my $cancelB = shift; # Cancel button text ('' means no Cancel button)
  my $addB    = shift; # bool - show a path entry and a Add Path button

  my $entry   = '';
  my $rc;

  # open window
  my $ew = $top->Toplevel();
  $ew->title($title);
  $ew->iconimage($mapiviicon) if $mapiviicon;

  my $height = ($text =~ tr/\n//);
  $height += 2;
  $height = 10 if ($height > 10); # not to big, we have scrollbars
  my $rotext = $ew->Scrolled('ROText',
                             -scrollbars => 'osoe',
                             -wrap => 'word',
                             -tabs => '4',
                             -width => 80,
                             -height => $height,
                             -relief => 'flat',
                             -bg => $conf{color_bg}{value},
                             -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 => $conf{color_bg}{value})->pack(-side => 'left');
  $labF->Label(-text         => " entries", -bg => $conf{color_bg}{value})->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;
}

##############################################################
# getDateTime - returns the actual local time as a string, format yyyymmdd-hhmm
##############################################################
sub getDateTime {
  my $time = shift;
  my ($s,$m,$h,$d,$mo,$y,undef,undef,undef,undef) = localtime($time);
  # do some adjustments
  $y += 1900;
  $mo++;
  return ($s,$m,$h,$d,$mo,$y);
}

##############################################################
# getDateTimeShortString - returns the actual local time as a string, format
# yyyymmdd-hhmm
##############################################################
sub getDateTimeShortString {
  my $time = shift;
  my ($s,$m,$h,$d,$mo,$y) = getDateTime($time);
  return sprintf "%04d%02d%02d-%02d%02d", $y, $mo, $d, $h, $m;
}

##############################################################
# getDateTimeISOString - returns the actual local time as a string,
# ISO 8601 extended format
# yyyy-mm-dd hh:mm:ss
##############################################################
sub getDateTimeISOString {
  my $time = shift;
  my ($s,$m,$h,$d,$mo,$y) = getDateTime($time);
  return sprintf "%04d-%02d-%02d %02d:%02d:%02d", $y, $mo, $d, $h, $m, $s;
}

##############################################################
# getDateTimeDINString - UNIX date/time to DIN 5008 format
# dd.mm.yyyy hh:mm:ss
##############################################################
sub getDateTimeDINString {
  my $time = shift;
  my ($s,$m,$h,$d,$mo,$y) = getDateTime($time);
  return sprintf "%02d.%02d.%04d %02d:%02d:%02d", $d, $mo, $y, $h, $m, $s;
}

##############################################################
# getDateTimeEXIFString - UNIX date/time to EXIF format
# yyyy:mm:dd hh:mm:ss
##############################################################
sub getDateTimeEXIFString {
  my $time = shift;
  my ($s,$m,$h,$d,$mo,$y) = getDateTime($time);
  return sprintf "%04d:%02d:%02d %02d:%02d:%02d", $y, $mo, $d, $h, $m, $s;
}

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

##############################################################
# searchFileName
##############################################################
sub searchFileName {
  my $lb = shift;
  my @sellist = getSelection($lb);
  return unless checkSelection($lb, 1, 1, \@sellist, lang("picture(s)"));
  my $fileName = basename($sellist[0]);
  #resetAllSearchOptions(); # todo: write this sub
  $config{SearchPattern} = $fileName;
  $config{SearchName} = 1;
  searchMetaInfo();
}

##############################################################
# search_by_date_time
##############################################################
sub search_by_date_time {
  my $listbox = shift;
  my @sellist = getSelection($listbox);
  return unless checkSelection($listbox, 1, 1, \@sellist, lang("picture(s)"));
  my $dest_dpic = $sellist[0];
  if ($searchDB{$dest_dpic}{TIME}) {
    my $dest_date_time = $searchDB{$dest_dpic}{TIME};
    my $dest_date_time_str = getDateTimeISOString($dest_date_time);
    # open window
    my %thumbs; # hash to store all thumbnails displayed in the listbox
    my $tlb; # thumb list box
    my $win = $top->Toplevel();
    window_size($win, 80);
    $win->title(lang('Pictures with creation date/time').' '.$dest_date_time_str);
    $win->iconimage($mapiviicon) if $mapiviicon;
    my $text = lang('Searching ...');
    log_it(lang('Searching for pictures with creation date/time: ').$dest_date_time_str);
    my $butF = $win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
    my $Xbut = $butF->Button(-text => lang('Close'),
                           -command => sub {
                             $win->destroy();
                           })->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 3, -pady => 3);
    $butF->Label(-textvariable => \$text)->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
    my $delta_number = 0;
    my $delta_unit = 1;
    $butF->Label(-text => '+/-')->pack(-side => 'left', -padx => 3, -pady => 3);
    my $deltaM = $butF->Optionmenu(-variable => \$delta_number, -textvariable => \$delta_number, -options => [qw(0 1 2 5 10 15 30)] )->pack(-side => 'left', -padx => 3, -pady => 3);
    my $deltaunitM = $butF->Optionmenu(-options => [ [lang('Seconds') => 1], [lang('Minutes') => 60], [lang('Hours') => 3600], [lang('Days') => 86400] ],
                     -textvariable => \$delta_unit)->pack(-side => 'left', -padx => 3, -pady => 3);
    my $updateB = $butF->Button(-image => $mapivi_icons{'Update'},
              -command => sub {
                  clean_listbox($tlb);
                  delete_thumb_objects(\%thumbs);
                  my $delta = $delta_number * $delta_unit;
                  my $found = search_by_date_time_add($tlb, $dest_date_time, $delta, \%thumbs);
                  $text = langf("Found %d pictures (+/-%d seconds)", $found, $delta);
              })->pack(-side => 'left', -padx => 3, -pady => 3);
    $balloon->attach($updateB, -msg => lang('Update search with new time interval'));
          
    $tlb = makeThumbListbox($win);
    # key bindings
    bind_exit_keys_to_button($win, $Xbut);
    $win->bind('<Control-a>',  sub { selectAll($tlb); } );
    $win->bind('<ButtonPress-2>', sub {
               return if (!$tlb->info('children'));
               my $dpic = getNearestItem($tlb);
               showPicInOwnWin($dpic); });
    $win->bind('<Key-d>', sub {
              my @sellist = getSelection($tlb);
              return unless checkSelection($win, 1, 0, \@sellist, lang("picture(s)"));
              show_multiple_pics(\@sellist, 0); });
    # show picture in main window and in lighttable
    $win->bind('<Key-m>', sub { open_pic_in_main($tlb); });
    $win->bind('<Key-l>', sub { light_table_add_from_lb($tlb); } );

    # todo: add context menu
    
    $win->Popup(-popover => 'cursor');
    repositionWindow($win);
    
    my $delta = $delta_number * $delta_unit;
    my $found = search_by_date_time_add($tlb, $dest_date_time, $delta, \%thumbs);
    $text = langf("Found %d pictures", $found);
    $win->waitWindow;
    # clean up memory - delete all found thumbnail photo objects
    delete_thumb_objects(\%thumbs);
  }
  else {
    log_it(lang('Error').': '.basename($dest_dpic).' '.lang('has no creation date/time!'));
  }
}

##############################################################
# get selected pic (must be exaclty one!) from listbox and
# open it in main window
##############################################################
sub open_pic_in_main {
  my $lb = shift;
  my @sellist = getSelection($lb);
  return unless checkSelection($lb, 1, 1, \@sellist, lang("picture(s)"));
  my $dpic = $sellist[0];
  my $dir = dirname($dpic);
  my $pic = basename($dpic);
  if (!-d $dir) {
    $lb->messageBox(-icon => 'warning', -message => "Sorry, but the folder\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.", -title => 'folder not found', -type => 'OK');
    return;
  }
  $top->deiconify;
  $top->raise;
  $top->focus;
  openDirPost($dir) if ($dir ne $actdir);
  showPic($dpic);
}

##############################################################
# deletes all (picture) entries of a listbox
# does not free memory for thumbnails (use delete_thumb_objects)
##############################################################
sub clean_listbox {
  my $lb = shift;
  my @elements = $lb->info('children');
  foreach my $element (@elements) {
    $lb->delete('entry', $element) if ($lb->info('exists', $element));
  }
}

##############################################################
# search for pictures with given creation date/time and
# insert them in the given listbox widget
##############################################################
sub search_by_date_time_add {
  my $lb = shift;
  my $dest_date_time = shift;
  my $delta = shift; # delta time in seconds
  my $thumbs = shift; # hash ref of thumbnail objects
  my $nr_of_pics = 0;
  my $pics = search_by_date_time_int($dest_date_time, $delta);
  if (@$pics) {
    my $i = 0;
    $nr_of_pics = scalar @$pics;
    my $pw = progressWinInit($lb, "Displaying pictures");
    # insert pictures in hlist
    foreach my $dpic (sort @$pics) {
      last if progressWinCheck($pw);
      progressWinUpdate($pw, "Inserting picture ($i/$nr_of_pics) ...", $i, $nr_of_pics);
      insertPic($lb, $dpic, $thumbs);
    }
    progressWinEnd($pw);
    $lb->update();
    log_it("Found $nr_of_pics pictures with identical date/time.");
  }
  else {
    log_it("Warning: Found no pictures with date/time ".getDateTimeISOString($dest_date_time)."!");
  }
  return $nr_of_pics;
}

##############################################################
# search_by_date_time_int
##############################################################
sub search_by_date_time_int {
  my $date_time = shift; 
  my $delta = shift; # delta time in seconds
  print "search_by_date_time_int $date_time, delta=$delta\n" if $verbose;
  my $i = 0;
  my $keys = keys %searchDB;
  my @pics;
  my $pw = progressWinInit($top, "Search pictures with same creation date and time");
  my $timemax = $date_time+$delta;
  my $timemin = $date_time-$delta;
  #foreach my $dpic (keys %searchDB) {
  while (my ($dpic, undef) = each %searchDB) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "Searching pictures ($i/$keys), found ".scalar(@pics)."", $i, $keys);
    my $time = $searchDB{$dpic}{TIME};
    if ($time) {
      if ($time <= $timemax and $time >= $timemin) {
        push @pics, $dpic;
      }
    }
  }
  progressWinEnd($pw);
  return \@pics;
}

##############################################################
# 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 $stop = 0;
  my $stopB;
  if (!$config{SaveDatabase}) {
    my $rc =
      $top->messageBox(-message => "The save database to file option is off. The search will only cover the folders visited during this session.\nShould I switch the save option on?\nYou can change this option also in the options dialog.",
                       -icon => 'question', -title => "Switch save option", -type => 'OKCancel');
    $config{SaveDatabase} = 1 if ($rc =~ m/Ok/i);
  }
  # open window
  $sw = $top->Toplevel();
  $sw->withdraw;
  $sw->title("Search picture database");
  $sw->iconimage($mapiviicon) if $mapiviicon;
  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 => $conf{color_bg}{value})->pack(-side => 'left', -padx => 3);
  # the search pattern
  $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 => $conf{color_bg}{value})->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->bind('<Key-F11>', sub { fullscreen($sw);});
  $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);
  $locSF->Button(-text => 'Set',
                        -command => sub {
                            my $dir = $sw->chooseDirectory(-title => 'Select folder to search in', -initialdir => dirname($start_dir));
			    if (defined $dir and -d $dir) { 
			      $start_dir = $dir;
			      $config{SearchOnlyInDir} = 1;
		            }
                        },
                       )->pack(-side => 'left');
  $balloon->attach($locSF, -msg =>
'When this option is enabled, the search will only take place
in folders matching the displayed string.
When the option is disabled a global search will take place.');
  my ($addMF, $addF);
  $locSF->Checkbutton(-variable => \$config{SearchMore},
                      -text => 'more options',
                      -command => sub {
                        if ($config{SearchMore}) {
                          $addF->pack(-in => $addMF, -side => 'left', -expand => 0);# if (!ismapped($addF));
                        }
                        else {
                          $addF->packForget();# if (ismapped($addF));
                        }
                      })->pack(-side => 'right', -padx => 5);


  my $ButF = $f0->Frame(-relief => 'groove', -bd => $config{Borderwidth})->pack(-side => 'left', -anchor => 'n', -expand => 1, -fill =>'both',-padx => 3,-pady => 0);
  $balloon->attach($f1, -msg => "Search in JPEG comments, EXIF info,\nIPTC info, IPTC keywords, file name and/or in folder name");
  my $f2 = $f0->Frame(-relief => 'groove', -bd => $config{Borderwidth})->pack(-side => 'left', -anchor => 'n', -fill =>'both',-padx => 3,-pady => 0);
  my $f3 = $f0->Frame(-relief => 'groove', -bd => $config{Borderwidth})->pack(-side => 'left', -anchor => 'n', -fill =>'both',-padx => 3,-pady => 0);
  my $f4 = $f0->Frame(-relief => 'groove', -bd => $config{Borderwidth})->pack(-side => 'left', -anchor => 'n', -fill =>'both',-padx => 3,-pady => 0);

  $f1->Checkbutton(-variable => \$config{SearchKeys}, -text => "Keywords")->pack(-anchor => 'w');
  $f1->Checkbutton(-variable => \$config{SearchIptc}, -text => "IPTC info")->pack(-anchor => 'w');
  $f1->Checkbutton(-variable => \$config{SearchCom},  -text => "Comments")->pack(-anchor => 'w');
  $f1->Checkbutton(-variable => \$config{SearchExif}, -text => "EXIF info")->pack(-anchor => 'w');
  $f1->Checkbutton(-variable => \$config{SearchName}, -text => "file name")->pack(-anchor => 'w');
  $f1->Checkbutton(-variable => \$config{SearchDir},  -text => "folder name")->pack(-anchor => 'w');
  my $sep = $f1->Checkbutton(-variable => \$config{SearchJoin}, -text => "join fields")->pack(-anchor => "nw");
  $balloon->attach($sep, -msg =>
"If this option is selected all selected fields (keywords, IPTC,
comments, ...) of a picture will be joined before the search
starts, so it's e.g. possible to find a picture with keyword
\"Tom\" and the comment \"at the beach\".
If it is not selected, a all-search for \"Tom\" and \"Tim\"
will only match, if all patterns are in one field
(e.g. Tom and Tim are both in the keywords).");

  my $sc1 = $f2->Checkbutton(-variable => \$config{SearchCase}, -text => "case sensitive")->pack(-anchor => "nw");
  $balloon->attach($sc1, -msg => "Toggle between case sensitive/insensitive searching");

  my $sw1 = $f2->Checkbutton(-variable => \$config{SearchWord}, -text => "complete word")->pack(-anchor => "nw");
  $balloon->attach($sw1, -msg => "search only for complete words, not for parts");

  my $stf = $f2->Frame()->pack(-anchor => 'w');
  $stf->Label(-text => "match", -bg => $conf{color_bg}{value})->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 => \$conf{search_rating_on}{value}, -text => 'rating')->pack(-side => 'left', -anchor => 'w');
  rating_button_min_max($urgF, \$conf{search_rating_max}{value}, \$conf{search_rating_min}{value});
  # todo search for empty urgency tags: , [Empty => '']
  $balloon->attach($urgF, -msg => "Search only for pictures with a rating\n(IPTC urgency) between min and max.");
  #$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.2012';

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

  $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(-bd => 1, -relief => 'sunken')->pack(-side => 'left', -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 => 'left', -anchor => 'w', -fill => 'both', -padx => 2, -pady => 2);
  $balloon->attach($pixF,  -msg => "Search only for pictures with a certain size.\nEnter the number of total pixels, width multiplicated with height.\nExample: For a 1500x1000 picture enter 1500000.");
  
  # picture format
  my $formatF = $addF->Frame(-bd => 1, -relief => 'sunken')->pack(-side => 'left', -anchor=>'w', -padx => 8, -pady => 0);
  $balloon->attach($formatF,  -msg => "Search only for pictures with a certain aspect ratio.");
  $formatF->Checkbutton(-variable => \$conf{search_format_on}{value}, -text => 'format')->pack(-side => 'left', -anchor => 'w');
  foreach my $form (qw(landscape square portrait)) {
    $formatF->Radiobutton(-text => $form, -variable => \$conf{search_format}{value}, -value => $form)->pack(-side => 'left', -anchor => 'w');
  }
  my $panoB = $formatF->Checkbutton(-variable => \$conf{search_format_pano}{value}, -text => 'panorama')->pack(-side => 'left', -anchor => 'w');
  $balloon->attach($panoB,  -msg => "Search only for pictures with an aspect ratio of 2 greater or equal to 1\n(horizonal or vertical panoramas).");

  if ($config{SearchMore}) {
     $addF->pack(-in => $addMF, -side => 'left', -expand => 0);# if (!ismapped($addF));
  }
  else {
    $addF->packForget();# if (ismapped($addF));
  }

  my $label = get_database_info();
  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 => $conf{color_bg}{value})->pack(-side => 'left', -anchor => 'w', -padx => 8);

  my $findLB = makeThumbListbox($sw);

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

  addCommonKeyBindings($findLB, $findLB);
  
  $findLB->bind('<Key-d>', sub {
    my @sellist = getSelection($findLB);
    return unless checkSelection($sw, 1, 0, \@sellist, lang("picture(s)"));
    show_multiple_pics(\@sellist, 0);
   } );

  $findLB->bind('<Key-Delete>',        sub { deletePics($findLB, TRASH); } );
  $findLB->bind('<Shift-Delete>',      sub { deletePics($findLB, REMOVE); } );

  # the context menu
  my $menu = $sw->Menu(-title => 'Search menu');

  ############# select all
  $menu->command(-label       => lang('Select 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, lang("picture(s)"));
     my $rc = $sw->messageBox(-icon => 'question',
                              -message => "Please press OK to remove the ".scalar @sellist." selected picture(s) from the search data base.\nThe picture file(s) won't be deleted. They may be added to the search database again anytime.",
-title => "Remove ".scalar @sellist." picture(s) from search database?", -type => 'OKCancel');
     return if ($rc !~ m/Ok/i);
     foreach (@sellist) {
    delete $searchDB{$_};
     }
    });

  ############# open pic
  $menu->command(-label => 'show pictures in new window', -accelerator => '<d>', -command => sub {
     my @sellist = getSelection($findLB);
     return unless checkSelection($sw, 1, 0, \@sellist, lang("picture(s)"));
     show_multiple_pics(\@sellist, 0);
    });

  ############# open dir
  $menu->command(-label => "open picture in main window", -accelerator => '<m>', -command => sub {
                   open_pic_in_main($findLB); });

# key-desc,m,show picture in main window (from search window)
  $findLB->bind('<Key-m>', sub { open_pic_in_main($findLB); });

  ############# open in external viewer
  $menu->command(-label => lang('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);

  # todo: is editIPTCCategories still needed?
  $menu->command(-label => 'add/remove categories ...', -command => sub { editIPTCCategories($findLB); } , -accelerator => '<Ctrl-t>');
  $menu->command(-label => 'EXIF histogram', -command => sub { exif_histogram($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 => '<j>');

  ############# search/replace comment
  $menu->command(-label => 'search/replace comment ...', -command => sub {
                   replaceComment($findLB); }, );

  $menu->separator;

  ############# sort
  my $sort_menu = $menu->cascade(-label => 'sort by ...');
  $menu->separator;

  $menu->command(-label => lang("Add to collection"), -command => sub {light_table_add_from_lb($findLB);}, -accelerator => '<l>');

  $sort_menu->command(-label => 'file name', -command => sub {
                   my @pics = $findLB->info('children');
                   $findLB->delete('all');
                   delete_thumb_objects(\%searchthumbs);
                   sortPics('name', 0, \@pics);
                   foreach (@pics) {
                     insertPic($findLB, $_, \%searchthumbs);
                   }
                 }, );
  $sort_menu->command(-label => 'urgency', -command => sub {
                   my @pics = $findLB->info('children');
                   $findLB->delete('all');
                   delete_thumb_objects(\%searchthumbs);
                   sortPics('urgency', 0, \@pics);
                   foreach (@pics) {
                     insertPic($findLB, $_, \%searchthumbs);
                   }
                 }, );
  $sort_menu->command(-label => 'file date', -command => sub {
                   my @pics = $findLB->info('children');
                   $findLB->delete('all');
                   delete_thumb_objects(\%searchthumbs);
                   sortPics('date', 0, \@pics);
                   foreach (@pics) {
                     insertPic($findLB, $_, \%searchthumbs);
                   }
                 }, );
  $sort_menu->command(-label => 'EXIF date', -command => sub {
                   my @pics = $findLB->info('children');
                   $findLB->delete('all');
                   delete_thumb_objects(\%searchthumbs);
                   sortPics('exifdate', 0, \@pics);
                   foreach (@pics) {
                     insertPic($findLB, $_, \%searchthumbs);
                   }
                 }, );



  # mouse and button bindings
  $findLB->bind('<ButtonPress-3>',   sub {
                 $menu->Popup(-popover => 'cursor', -popanchor => 'nw');
               } );

  $findLB->bind('<ButtonRelease-2>', sub {
                  return unless ($findLB->info('children'));
                  my $dpic = getNearestItem($findLB);
          my $dir = dirname($dpic);
          if (!-d $dir) {
            $sw->messageBox(-icon => 'warning', -message => "Sorry, but the folder\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.",-title => 'folder not found', -type => 'OK');
            return;
              }
                  $sw->Busy;
              showPicInOwnWin($dpic);
                  $sw->Unbusy;
          } );

  my $SButF = $ButF->Frame(-bd => 0)->pack(-side => 'top', -anchor => 'n', -expand => 1, -fill =>'both',-padx => 0,-pady => 0);

  $OKB =
    $SButF->Button(-text => 'Search',
                  -command => sub {
                    my $searchStart = Tk::timeofday();
                    my $count = 0;
                    my ($thumb, $thumbP, $last_time, $start_time, $end_time);

                    if (($config{SearchCom}  == 0 and
                         $config{SearchName} == 0 and
                         $config{SearchDir}  == 0 and
                         $config{SearchExif} == 0 and
                         $config{SearchKeys} == 0 and
                         $config{SearchIptc} == 0)) {
                       $sw->messageBox(-icon => 'warning',
                                       -message => 'Please select at least on field (keywords, comments, ...) to search in.',
                                       -title => 'No search field selected', -type => 'OK');
                       return;
                    }

                    unless (checkNumberFormat($config{SearchPop})) {
                      $config{SearchPop} = 5;
                      $sw->messageBox(-icon => 'warning',
                         -message => 'Please enter a natural number (0,1,2,3,...) in the viewed field',
                         -title => 'Wrong format', -type => 'OK');
                      return;
                    }

                    # store the patterns before we process them
                    $config{SearchPattern}   = $pattern;
                    $config{SearchExPattern} = $exclude;

                    # replace (german) umlaute by corresponding letters
                    $pattern =~ s/([$umlaute])/$umlaute{$1}/g if ($config{ConvertUmlaut});
                    $exclude =~ s/([$umlaute])/$umlaute{$1}/g if ($config{ConvertUmlaut});

                    $label = "searching pattern in $keys pictures."; $sw->update;

                    $pat = makePattern($pattern);# support windows like search patterns
                    $exl = makePattern($exclude);# support windows like search patterns

                    if ($config{SearchWord}) {
                      $pat = "\\b$pat";
                      $pat =~ s/\s+/\\b \\b/g;   # replace one or more whitespaces with \b \b the word boundary
                      $pat .= '\\b';
                    }

                    if ($config{SearchType} eq 'any') { # or-function "Tim Tom" -> "Tim|Tom"
                      $pat =~ s/\s+/|/g;         # replace one or more whitespaces with |
                    }
                    elsif ($config{SearchType} eq 'all') {
                      $pat = '(?=.*'.$pat;       # and-function with look-ahead
                      $pat =~ s/\s+/)(?=.*/g;    # replace one or more whitespaces with )(?=.*
                      $pat .= ')';               # "Tom Tim" is now: "(?=.*Tom)(?=.*Tim)"
                    }
                    else {                       # do nothing (normal string search)
                    }

                    #my $qrpat; # todo, but seems not to work with and searches
                    #if ($config{SearchCase}) { $qrpat = qr/'$pat'2/io; } else { $qrpat = qr/'$pat'/o; }
                    #print "pat = $pat qrpat = $qrpat\n";

                    # the exclude patterns are always combined with or
                    $exl =~ s/ /|/g;           # or-function "Tim Tom" -> "Tim|Tom"

                    print "searchMetaInfo: pattern: $pattern -> -$pat-\n" if $verbose;
                    print "searchMetaInfo: exclude pattern: $exclude -> -$exl-\n" if $verbose;

                    if ($config{SearchDate}) {
                      if (!checkDateFormat($config{SearchDateStart})) {
                        $sw->messageBox(-icon => 'warning', -message => $datetext, -title => 'Wrong from-date', -type => 'OK');
                        return;
                      }
                      if (!checkDateFormat($config{SearchDateEnd})) {
                        $sw->messageBox(-icon => 'warning', -message => $datetext, -title => 'Wrong to-date', -type => 'OK');
                        return;
                      }
                      $start_time = buildUnixTime($config{SearchDateStart});
                      $end_time   = buildUnixTime($config{SearchDateEnd});
                      #print "$start_time .. $end_time\n";
                      if ($end_time < $start_time) {
                        $sw->messageBox(-icon => 'warning',
                           -message => 'Search from date must be before search to date',
                           -title => 'Wrong search date', -type => 'OK');
                        return;
                        }
                      }

                    $findLB->delete('all'); # clear listbox
                    $sw->Busy;

                    my $case = 'i'; $case = '' if $config{SearchCase};

                    $stopB->configure(-state => 'normal'); $stopB->update();

                    my $i = 0;

                    ####################################################
                    # loop through all database entries
                    foreach my $dpic (sort keys %searchDB) {
                      last if $stop;
                      $i++;

                      # show progress and found pics every 0.5 seconds - idea from Slaven
                      if (!defined $last_time || Tk::timeofday()-$last_time > 0.3) {
                        $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/);
                      }

                      my $urg  = $searchDB{$dpic}{URG};
                      my $time = $searchDB{$dpic}{TIME};

                      # skip if wrong urgency
                      if ($conf{search_rating_on}{value}) {
                        next if (not rating_valid($urg, $conf{search_rating_max}{value}, $conf{search_rating_min}{value}));
                      }

                      # skip if wrong format / aspect ratio
                      if ($conf{search_format_on}{value}) {
                        next unless (defined $searchDB{$dpic}{PIXX});
                        next unless (defined $searchDB{$dpic}{PIXY});
                        if ($conf{search_format}{value} eq 'landscape') {
                          next if ($searchDB{$dpic}{PIXX} <= $searchDB{$dpic}{PIXY});
                          if ($conf{search_format_pano}{value}) {
                            next if ($searchDB{$dpic}{PIXX} <= 2*$searchDB{$dpic}{PIXY});
                          }
                        }
                        elsif ($conf{search_format}{value} eq 'square') {
                          next if ($searchDB{$dpic}{PIXX} != $searchDB{$dpic}{PIXY});
                          # ignore panorama constraint for square pictures
                        }
                        elsif ($conf{search_format}{value} eq 'portrait') {
                          next if ($searchDB{$dpic}{PIXX} >= $searchDB{$dpic}{PIXY});
                          if ($conf{search_format_pano}{value}) {
                            next if (2*$searchDB{$dpic}{PIXX} >= $searchDB{$dpic}{PIXY});
                          }
                        }
                        else {
                          warn "unsupported search format: $conf{search_format}{value}";
                        }
                      }
                      
                      # 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});
                          }
                        }
                      }

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

                      # skip if wrong numer of views (popularity)
                      if ($config{SearchPopOn}) {
                          if ($config{SearchPopRel} eq '=') { # equal
                              next if ($searchDB{$dpic}{POP} != $config{SearchPop});
                          }
                          else { # handle bigger and lower
                              if ($config{SearchPopRel} eq '>=') { # bigger
                                  next if ($searchDB{$dpic}{POP} < $config{SearchPop});
                              }
                              if ($config{SearchPopRel} eq '<=') { # lower
                                  next if ($searchDB{$dpic}{POP} > $config{SearchPop});
                              }
                          }
                      }

                      # skip if wrong date
                      if ($config{SearchDate} and defined($time)) {
                          next if ($time < $start_time);
                          next if ($time > $end_time);
                      }

                      my $com  = $searchDB{$dpic}{COM};
                      my $exif = $searchDB{$dpic}{EXIF};
                      my $iptc = $searchDB{$dpic}{IPTC};
                      my $keys = $searchDB{$dpic}{KEYS};

                      # replace newlines with space
                      $com  =~ s/\n/ /g if (defined $com);
                      $exif =~ s/\n/ /g if (defined $exif);
                      $iptc =~ s/\n/ /g if (defined $iptc);

                      my $allMeta = '';
                      if ($config{SearchJoin}) {        # join all selected meta info with a space
                        $allMeta  = $com                if ($config{SearchCom}  and $com);
                        $allMeta .= ' '.$exif           if ($config{SearchExif} and $exif);
                        $allMeta .= ' '.$iptc           if ($config{SearchIptc} and $iptc);
                        $allMeta .= ' '.$keys           if ($config{SearchKeys} and $keys);
                        $allMeta .= ' '.basename($dpic) if ($config{SearchName});
                        $allMeta .= ' '.dirname($dpic)  if ($config{SearchDir});
                        $allMeta  =~ s/\n/ /g;           # replace newlines with space
                      }

                      if ((($config{SearchJoin} and ($allMeta ne '') and ($allMeta =~ m/(?$case).*$pat.*/) ) ) or
                         (($config{SearchCom}  and (defined $com)    and ($com  =~ m/(?$case).*$pat.*/)) or
                          ($config{SearchExif} and (defined $exif)   and ($exif =~ m/(?$case).*$pat.*/)) or
                          ($config{SearchIptc} and (defined $iptc)   and ($iptc =~ m/(?$case).*$pat.*/)) or
                          ($config{SearchKeys} and (defined $keys)   and ($keys =~ m/(?$case).*$pat.*/)) or
                          ($config{SearchKeys} and (not defined $keys)  and ($pat eq '')) or # empty keywords
                          ($config{SearchName} and (basename($dpic)             =~ m/(?$case).*$pat.*/)) or
                          ($config{SearchDir}  and (dirname($dpic)              =~ m/(?$case).*$pat.*/)))) {

                        # skip if exclude pattern matches
                        if ((defined $exl) and ($exl ne '')) {
                          next if ((($config{SearchJoin} and ($allMeta ne '') and ($allMeta =~ m/(?$case).*$exl.*/ )) ) or
                                   (($config{SearchCom}  and (defined $com)   and ($com  =~ m/(?$case).*$exl.*/)) or
                                    ($config{SearchExif} and (defined $exif)  and ($exif =~ m/(?$case).*$exl.*/)) or
                                    ($config{SearchIptc} and (defined $iptc)  and ($iptc =~ m/(?$case).*$exl.*/)) or
                                    ($config{SearchKeys} and (defined $keys)  and ($keys =~ m/(?$case).*$exl.*/)) or
                                    ($config{SearchName} and (basename($dpic)            =~ m/(?$case).*$exl.*/)) or
                                    ($config{SearchDir}  and (dirname($dpic)             =~ m/(?$case).*$exl.*/))));
                        }

                        unless ($justCount) {
                          insertPic($findLB, $dpic, \%searchthumbs);
                        }
                        $count++;
                        $label = "found pattern in $count pictures.";
                      }

                    } # foreach
                    ####################################################

                    $stopB->configure(-state => 'disabled');
                    $progress = 100;  $findLB->update;
                    my $searchDuration = sprintf "%.2f", (Tk::timeofday() - $searchStart);

                    if ($count == 0) {
                      my $msg = "Found no pictures containing \"$pattern\"";
                      $msg .= " with rating (urgency) between ".iptc_rating_stars_urg($conf{search_rating_max}{value})." and ".iptc_rating_stars_urg($conf{search_rating_min}{value}) if ($conf{search_rating_on}{value});
                      $msg .= " with pixel size ".$config{SearchPixelRel}." ".$config{SearchPixel} if ($config{SearchPixelOn});
                      my $pano = '';
                      $pano = ' panorama' if ($conf{search_format_pano}{value});
                      $msg .= " in $conf{search_format}{value}$pano format" if ($conf{search_format_on}{value});
                      $msg .= " with views ".$config{SearchPopRel}." ".$config{SearchPop} if ($config{SearchPopOn});
                      $msg .= " dated between ".$config{"SearchDateStart"}." and ".$config{"SearchDateEnd"} if ($config{"SearchDate"} != 0);
                      $msg .= " in folders matching $start_dir" if ($config{"SearchOnlyInDir"} != 0);

                      $msg .= " in the database.";

                      $sw->messageBox(-icon => 'warning', -message => $msg,
                                      -title => "Pattern not found", -type => 'OK');
                      $label = "pattern not found (duration: $searchDuration sec).";
                      $sw->Unbusy;
                      $stop = 0;
                      return;
                    }

                    $sw->Unbusy;
                    my $end_str = "finished";
                    $end_str = "canceled" if $stop;
                    $label = "Search $end_str: found $count pictures (duration: $searchDuration sec).";
                    $stop  = 0;
                  })->pack(-side => 'left', -anchor => 'w', -expand => 1, -fill => 'both',-padx => 1,-pady => 1);

  $stopB = $SButF->Button(-text => "Stop",
                         -command => sub { $stop = 1; }
                         )->pack(-side => 'left', -anchor => 'w', -fill => 'both', -expand => 0,-padx => 1,-pady => 1);
  $stopB->configure(-image => $mapivi_icons{Stop}, -borderwidth => 0);
  $stopB->configure(-state => 'disabled');

  # would be usefull here, but needs to much space
  #$ButF->Button(-text => "Clean database ...",
    #			-command => sub {cleanDatabase();})->pack(-side => 'top', -anchor => 'w', -expand => 1,-fill => 'x',-padx => 1,-pady => 1);

  my $Xbut =
  $ButF->Button(-text => "Close",
                -command => sub {
                  $stop = 1;
                  $config{SearchGeometry} = $sw->geometry;
                  $sw->withdraw;
                  delete_thumb_objects(\%searchthumbs);
                  $sw->destroy;
                }
               )->pack(-side => 'top', -anchor => 'w', -expand => 1,-fill => 'both',-padx => 1,-pady => 1);
         
  bind_exit_keys_to_button($sw, $Xbut);
  $sw->bind('<H>',          sub { showHistogram($findLB); });

  $sw->Popup;
  checkGeometry(\$config{SearchGeometry});
  $sw->geometry($config{SearchGeometry});
  $sw->waitWindow;
  return;
}

##############################################################
# delete_thumb_objects
##############################################################
sub delete_thumb_objects {
  my $thumbs = shift; # hash ref to store the thumbnails
  # clean up memory - delete all found thumbnail photo objects
  foreach (keys %$thumbs) {
    print "delete_thumb_objects: deleting thumb $_\n" if $verbose;
    delete_photo_object($$thumbs{$_});
    delete $$thumbs{$_};
  }
}

##############################################################
# insertPic
# todo: the -stlye for each column should be an optional argument (e.g. for sub findDups()) 
##############################################################
sub insertPic {
  my $lb     = shift;
  my $dpic   = shift;
  my $thumbs = shift; # hash ref to store the thumbnails
  
  my $thumb = getThumbFileName($dpic);

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

  if (-f $thumb) {
    $$thumbs{$thumb} = $lb->Photo(-file => $thumb, -gamma => $config{Gamma});
    if (defined $$thumbs{$thumb}) {
      $lb->itemCreate($dpic, $lb->{thumbcol}, -image => $$thumbs{$thumb}, -itemtype => "imagetext", -text => getThumbCaption($dpic), -style => $thumbS);
    }
  }
  else {
    $lb->itemCreate($dpic, $lb->{thumbcol}, -itemtype => "imagetext", -text => $pic, -style => $thumbS);
    print "insertPic: no thumb for $dpic ($thumb)\n" if $verbose;
  }

  my $dir = dirname($dpic);
  my $iptc;
  $iptc = displayIPTC($dpic); 

  my $com  = formatString($searchDB{$dpic}{COM},  30, $config{LineLimit});  # format the comment   for the list
  my $exif = formatString(date_iso_to_relative($searchDB{$dpic}{EXIF}), 30, $config{LineLimit});  # format the EXIF info for the list
  $iptc    = formatString($iptc, 30, $config{LineLimit});  # format the IPTC info for the list
  my $rating_size = get_rating_and_size($dpic, $lb);

  $lb->itemCreate($dpic, $lb->{filecol}, -itemtype => "image", -image => $rating_size, -style => $fileS) if (defined $lb->{filecol});
  $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 $pid = (defined($_[0])) ? $_[0] : $$;  # $$ = PID of current process
  my $pt = Proc::ProcessTable->new;
  my %info = map { $_->pid => $_ } @{$pt->table};
  return $info{$$}->rss;
}

##############################################################
# png_show - show PNG info using Image::ExifTool
##############################################################
sub png_show {
  my $lb = shift;
  my @sellist = getSelection($lb);
  return unless checkSelection($lb, 1, 0, \@sellist, lang("picture(s)"));
  my $selected = scalar @sellist;
  log_it("extracting PNG information of $selected pictures");

  my $exifTool = new Image::ExifTool;
  my $i = 0;
  my $pw = progressWinInit($lb, "Extracting PNG information");
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "Extracting PNG ($i/$selected) ...", $i, $selected);
    my $xmp = '';
    my $info = $exifTool->ImageInfo($dpic, 'PNG:*');
    foreach (sort keys %$info) {
      my $val = $$info{$_};
      if (ref $val eq 'ARRAY') {
        $val = join(', ', @$val);
      } elsif (ref $val eq 'SCALAR') {
        $val = '(Binary data)';
      }
      $xmp .= sprintf("%-24s : %s\n", $_, $val);
    }
    
    $xmp .= "desc:\n";
    $info = $exifTool->ImageInfo($dpic, 'PNG:Description');
    foreach (sort keys %$info) {
      my $val = $$info{$_};
      if (ref $val eq 'ARRAY') {
        $val = join(', ', @$val);
      } elsif (ref $val eq 'SCALAR') {
        $val = '(Binary data)';
      }
      $xmp .= sprintf("%-24s : %s\n", $_, $val);
    }
    
    $xmp .= "Thumb::URI:\n";
    $info = $exifTool->ImageInfo($dpic, 'PNG:Thumb::URI');
    foreach (sort keys %$info) {
      my $val = $$info{$_};
      if (ref $val eq 'ARRAY') {
        $val = join(', ', @$val);
      } elsif (ref $val eq 'SCALAR') {
        $val = '(Binary data)';
      }
      $xmp .= sprintf("%-24s : %s\n", $_, $val);
    }
    $xmp = 'No PNG data found.' if ($xmp eq '');
    showText("PNG data of $dpic", $xmp, NO_WAIT);
  }
  progressWinEnd($pw);
  log_it(lang('Ready!')." ($i of $selected)");
}

##############################################################
# Extract embedded JPEG from raw file using Image::ExifTool
##############################################################
sub extract_jpeg {
  my $lb = shift;
  my @sellist = getSelection($lb);
  return unless checkSelection($lb, 1, 0, \@sellist, lang("picture(s)"));
  my $selected = scalar @sellist;
  log_it("extracting JPEG (Preview) from $selected pictures");
  my $exifTool = new Image::ExifTool;
  my $i = 0;
  my $errors = '';
  my $extracted = 0;
  my $pw = progressWinInit($lb, "Extracting JPEGs from RAW");
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "Extracting JPEG ($i/$selected) ...", $i, $selected);
    # parts of this code is based on a script from Phil Harvey,
    # see http://u88.n24.queensu.ca/exiftool/forum/index.php/topic,19.0.html
    my $info = $exifTool->ImageInfo($dpic,'JpgFromRaw','PreviewImage');
    my $val = $$info{JpgFromRaw} || $$info{PreviewImage};
    if ($val) {
      my ($basename,$dir,$suffix) = fileparse($dpic, '\.[^.]*'); # suffix = . and not-.  (one dot and zero or more non-dots)
      # JPEG file in same directory
      my $out = $dir.$basename.".jpg";
      if (-f $out) {
        $out = $dir.findNewName($out);
      } 
      my $fh;
      if (open($fh,'>',$out)) {
        if (print $fh $$val and close $fh) {
          $extracted++;
          log_it("  extracted $dpic to $out");
          generateOneThumb($out);
          # insert new pic in listbox after $dpic
          addOneRow($lb, $out, 1, $dpic);
        }
        else {
          $errors .= "Error writing $out\n";
        }
      }
      else {
        $errors .= "Error creating $out\n";
      }
    } else {
      $errors .= "No embedded JPG in $dpic\n";
    }
  }
  progressWinEnd($pw);
  showText("Errors while extracting JPEGs", $errors, NO_WAIT) if ($errors ne '');
  log_it(lang('Ready!')." (extracted $extracted of $selected)");
}

##############################################################
# xmp_show - show XMP info using Image::ExifTool
##############################################################
sub xmp_show {
  my $lb = shift;
  my @sellist = getSelection($lb);
  return unless checkSelection($lb, 1, 0, \@sellist, lang("picture(s)"));
  my $selected = scalar @sellist;
  log_it("extracting XMP information of $selected pictures");
  #my $exifTool = new Image::ExifTool;
  my $i = 0;
  my $pw = progressWinInit($lb, "Extracting XMP information");
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "Extracting XMP ($i/$selected) ...", $i, $selected);
    my $xmp = xmp_get($dpic);
    $xmp = 'No XMP data found.' if ($xmp eq '');
    showText("XMP data of $dpic", $xmp, NO_WAIT);
  }
  progressWinEnd($pw);
  log_it(lang('Ready!')." ($i of $selected)");
}

##############################################################
# xmp_get - returns XMP info as string using Image::ExifTool
##############################################################
sub xmp_get {
  return exiftool_tostring(exiftool_get(shift, "XMP:*"));
}

##############################################################
# iptc_get - returns IPTC info as string using Image::ExifTool
##############################################################
sub iptc_get {
  return exiftool_tostring(exiftool_get(shift, "IPTC:*"));
}

##############################################################
# exif_get - returns EXIF info as string using Image::ExifTool
##############################################################
sub exif_get {
  return exiftool_tostring(exiftool_get(shift, "EXIF:*"));
}

##############################################################
# exiftool_get - returns EXIF info as string using Image::ExifTool
##############################################################
sub exiftool_get {
  my $dpic = shift;
  # e.g. "EXIF:*" for all EXIF information,  "XMP:*" for XMP ...
  # "XMP-xmp:Rating" for rating ...
  my $type = shift; 
  my $exifTool = new Image::ExifTool;
  return $exifTool->ImageInfo($dpic, $type);
}

##############################################################
##############################################################
sub exiftool_tostring {
  my $info = shift;
  my $string = '';
  foreach (sort keys %$info) {
    my $val = $$info{$_};
    if (ref $val eq 'ARRAY') {
      $val = join(', ', @$val);
    } elsif (ref $val eq 'SCALAR') {
      $val = '(Binary data)';
    }
    $string .= sprintf("%-14s: %s\n", $_, $val);
  }
  return $string;
}

##############################################################
# gps_get (taken from photoGalery.pl)
##############################################################
sub gps_get {
  my $dpic = shift;
  my $exifTool = new Image::ExifTool;
  #set a few parameters
  $exifTool->Options(Charset => 'UTF8', CoordFormat => "%.6f");
  my $imgInfo = $exifTool->ImageInfo($dpic,"GPSLatitude","GPSLatitudeRef","GPSLongitude","GPSLongitudeRef","GPSAltitude","GPSAltitudeRef");
  #get individual parameters
  my @tags   = $exifTool->GetRequestedTags();
  my $lat    = Encode::encode("utf8",$exifTool->GetValue($tags[0]));
  my $latRef = Encode::encode("utf8",$exifTool->GetValue($tags[1]));
  my $lon    = Encode::encode("utf8",$exifTool->GetValue($tags[2]));
  my $lonRef = Encode::encode("utf8",$exifTool->GetValue($tags[3]));
  my $alt    = Encode::encode("utf8",$exifTool->GetValue($tags[4]));
  my $altRef = Encode::encode("utf8",$exifTool->GetValue($tags[5]));
  #print "GPS of $dpic:\nlat = $lat latref = $latRef lon = $lon lonRef = $lonRef alt = $alt altRef = $altRef\n" if (defined $lat);
  # strip off " N" or " W" suffixes
  $lat =~ s/ \S$// if defined $lat;
  $lon =~ s/ \S$// if defined $lon;
  return ($lat, $lon, $latRef, $lonRef);
}

##############################################################
##############################################################
sub gps_set {
  my $lb = shift;
  my @sellist = getSelection($lb);
  return unless checkSelection($lb, 1, 0, \@sellist, lang("picture(s)"));
  my $selected = scalar @sellist;
  my ($ok, $lat, $lon, $lat_ref, $lon_ref) = gps_dialog("Enter GPS coordinates for the $selected picture(s).\nFormat: DD.DDDDDD or DD MM.MMM or DD MM SS (D=Degree, M=Minutes, S=Seconds)\nExamples: \"52.2625\" or \"52 15.75\" or \"52 15 45\" (for 52.2625 or 52 15.75' or 52 15' 45'')\n\nNote: Existing GPS coordinates will be overwritten!");
  return if !$ok;
  log_it("adding/overwriting GPS coordinates to $selected pictures");
  my $exifTool = new Image::ExifTool;
  my $i = 0;
  my $success = 0;
  my $error = '';
  my $pw = progressWinInit($lb, 'Adding/overwriting GPS coordinates');
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "Adding/overwriting GPS coordinates ($i/$selected) ...", $i, $selected);
    $exifTool->SetNewValue('GPSLatitude' => $lat);
    $exifTool->SetNewValue('GPSLatitudeRef' => $lat_ref);
    $exifTool->SetNewValue('GPSLongitude' => $lon);
    $exifTool->SetNewValue('GPSLongitudeRef' => $lon_ref);
    my $ok = $exifTool->WriteInfo($dpic);
    $error .= exiftool_get_error($exifTool, $ok, $dpic);
    if ($ok) {
	    showImageInfoCanvas($dpic) if ($dpic eq $actpic);
      updateOneRow($dpic, $lb);
      $success++;
    }
  }
  progressWinEnd($pw);
  log_it(lang('Ready!')." Added GPS coodinates to $success of $selected pictures.");
  showText("Errors while adding/overwriting GPS coordinates", $error, NO_WAIT) if ($error ne '');
}

##############################################################
# get location (county, state, city, ...) from GPS coordinates
# and store them in IPTC
##############################################################
sub gps_to_location {
  my $lb = shift;
  my @sellist = getSelection($lb);
  # note: service may be limited to 1 access per second
  # so we limit to max 100 pictures at once; todo: maybe add a delay with after?
  return unless checkSelection($lb, 1, 100, \@sellist, lang("picture(s)"));
  my $selected = scalar @sellist;
  # check before overwriting
  return if (not allow_location_overwrite($top, \@sellist));
  my $exifTool = new Image::ExifTool;
  my $i = 0;
  my $success = 0;
  my $error = '';
  my $pw = progressWinInit($lb, 'Set location from GPS coordinates');
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "setting GPS coordinates ($i/$selected) ...", $i, $selected);
    my ($lat, $lon, $lat_ref, $lon_ref) = gps_get($dpic);
    if (defined $lat and defined $lon) { 
      $lat *= -1 if (defined $lat_ref and $lat_ref eq 'South');
      $lon *= -1 if (defined $lon_ref and $lon_ref eq 'West');
      #web_browser_open('http://maps.google.com/maps?q='."$lat,$lon");
      # note: service may be limited to 1 access per second
      # note2: we use the Mapivi language setting to get the location in the selected language; todo: should maybe be a separate option
      my $loc_service = 'http://nominatim.openstreetmap.org';
      my $url = $loc_service.'/reverse?format=xml&lat='.$lat.'&lon='.$lon.'&zoom=10&accept-language='.$config{Language}.'&addressdetails=1';
      #print "gps_to_location: \"$url\"\n\n";
      use LWP::Simple;
      my $xml = LWP::Simple::get($url);
      #print "XML = $xml\n\n";
      # --- example output
      #$xml = '<reversegeocode timestamp="Wed, 24 Sep 14 14:54:32 +0000" attribution="Data © OpenStreetMap contributors, ODbL 1.0. http://www.openstreetmap.org/copyright" querystring="format=xml&lat=42.1159&lon=8.683&zoom=10&accept-language=de&addressdetails=1"><result place_id="97903271" osm_type="relation" osm_id="1110949" ref="Vico" lat="42.1661203" lon="8.7957937">Vico, Deux-Sorru, Corse-du-Sud, Korsika, Metropolitanes Frankreich, 20160</result><addressparts><city>Vico</city><county>Corse-du-Sud</county><state>Korsika</state><country>Metropolitanes Frankreich</country><postcode>20160</postcode><country_code>fr</country_code></addressparts></reversegeocode>';
      # --- example end
      if ($xml) {
        $exifTool->ImageInfo($dpic, 'IPTC:*');
        my ($country, $state, $county, $city);
        # depending on the location it could make sense to use the county as province/state value
        # but here we use state and add county in sublocation as addition info        
        # We all know there are better ways to parse XML, but for this case it should be sufficent
        if ($xml =~ m|<country>(.+)</country>|) { $country = $1; $country =~ s/([$umlaute])/$umlaute{$1}/g; $exifTool->SetNewValue('Country-PrimaryLocationName' => $country);}
        if ($xml =~ m|<state>(.+)</state>|)     { $state = $1;     $state =~ s/([$umlaute])/$umlaute{$1}/g; $exifTool->SetNewValue('Province-State' => $state); }
        if ($xml =~ m|<county>(.+)</county>|)   { $county = $1;   $county =~ s/([$umlaute])/$umlaute{$1}/g; $exifTool->SetNewValue('Sub-location' => $county); }
        if ($xml =~ m|<city>(.+)</city>|)       { $city = $1;       $city =~ s/([$umlaute])/$umlaute{$1}/g; $exifTool->SetNewValue('City' => $city); }
        my $ok = $exifTool->WriteInfo($dpic);
        $error .= exiftool_get_error($exifTool, $ok, $dpic);
        if ($ok) {
          showImageInfoCanvas($dpic) if ($dpic eq $actpic);
          updateOneRow($dpic, $lb);
          log_it("added location: $country, $state, $county, $city to $dpic");
          $success++;
        }
      }
      else {
        $error .= "Location service ($loc_service) returned nothing for $dpic\n";
      }
    }
    else {
      $error .= "Found no GPS coordinates in picture $dpic\n";
    } 
  }
  progressWinEnd($pw);
  log_it(lang('Ready!')." Set location info in $success of $selected pictures.");
  showText("Errors while setting location from GPS", $error, NO_WAIT) if ($error ne '');
}
  
##############################################################
# gps_dialog - get GPS coordinates from the user
##############################################################
sub gps_dialog {
  my $text = shift;
  my $lat = 48.778505; my $lat_ref = 'North';
  my $lon = 9.179915;  my $lon_ref = 'East';
  my $rc = 0;
  # open window
  my $win = $top->Toplevel();
  $win->title('Enter GPS coordinates');
  $win->iconimage($mapiviicon) if $mapiviicon;
  # determine the heigt of the textbox by counting the number of lines
  my $height = ($text =~ tr/\n//);
  $height += 2;
  $height = 10 if ($height > 10); # not to big, we have scrollbars
  my $rotext = $win->Scrolled('ROText',
                            -scrollbars => 'osoe',
                            -wrap => 'word',
                            -width => 80,
                            -height => $height,
                            -relief => 'flat',
                            -bg => $conf{color_bg}{value},
                            -bd => 0
                           )->pack(-fill => 'both', -expand => 1, -padx => 3, -pady => 3);
  $rotext->insert('end', $text);
  my $latf = $win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
  $latf->Label(-text=> 'GPS Latitude', -width => 15)->pack(-side => 'left', -padx => 3);
  my $lat_e = $latf->Entry(-textvariable => \$lat, -width => 12)->pack(-side => 'left', -fill => 'x', -padx => 3);
  $latf->Optionmenu(-textvariable => \$lat_ref, -options => [qw(North South)], -width => 8)->pack(-side => 'left', -padx => 3);
  my $lonf = $win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
  $lonf->Label(-text=> 'GPS Longitude', -width => 15)->pack(-side => 'left', -padx => 3);
  $lonf->Entry(-textvariable => \$lon, -width => 12)->pack(-side => 'left', -fill => 'x', -padx => 3);
  $lonf->Optionmenu(-textvariable => \$lon_ref, -options => [qw(East West)], -width => 8)->pack(-side => 'left', -padx => 3);
  $lat_e->selectionRange(0,'end'); #  select all
  #$lat_e->bind('<Return>', sub { $OKB->Invoke; } );
  $lat_e->focus;
  my $ButF = $win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
  my $OKB = $ButF->Button(-text => lang('OK'),
               -command => sub {
             $rc = 1;
             $win->destroy;
               })->pack(-side => 'left', -expand => 1, -fill => 'x',
                -padx => 3, -pady => 3);
  my $XBut = $ButF->Button(-text => lang('Cancel'),
               -command => sub {
                 $rc = 0;
                 $win->destroy;
               }
              )->pack(-side => 'left', -expand => 1, -fill => 'x',
                  -padx => 3, -pady => 3);
  bind_exit_keys_to_button($win, $XBut);
  $win->Popup;
  repositionWindow($win);
  $win->waitWindow();
  return ($rc, $lat, $lon, $lat_ref, $lon_ref);
}

##############################################################
# get the selected picture and show the GPS position of it in a web browser
##############################################################
sub gps_map_open {
    my $lb = shift;
    my @sellist = $lb->info('selection');
    # check selection args: widget, min, max, listref, itemkind (e.g. "picture")
    return unless checkSelection($top, 1, 1, \@sellist, lang("picture(s)"));
    gps_pic_map_open($sellist[0]);
}

##############################################################
# show the GPS position of a single picture in web browser
##############################################################
sub gps_pic_map_open {
  my $dpic = shift;
  return if !defined $dpic;
  return if !-f $dpic;
  my ($lat, $lon, $lat_ref, $lon_ref) = gps_get($dpic);
  if (defined $lat and defined $lon) { 
    $lat *= -1 if (defined $lat_ref and $lat_ref eq 'South');
    $lon *= -1 if (defined $lon_ref and $lon_ref eq 'West');
    web_browser_open('http://maps.google.com/maps?q='."$lat,$lon");
  }
  else {
    $top->messageBox(-icon  => 'error', -message => "Found no GPS coordinates in picture\n$dpic",
                     -title => "No GPS coordinates", -type => 'OK');
  }
}

##############################################################
# returns string explaining how XMP rating is mapped to IPTC
##############################################################
sub convert_iptc_to_xmp_text {
  my $string = lang("IPTC urgency to XMP rating mapping (IPTC -> XMP):")."\n";
  foreach my $iptc (0 .. 8) {
    my $xmp = convert_iptc_to_xmp($iptc);
    $string .= "$iptc -> $xmp\n";
  }
  return $string;
}

##############################################################
# convert IPTC urgency value to XMP rating value
##############################################################
sub convert_iptc_to_xmp {
  my $iptc_urgency = shift;
  $iptc_urgency = 0 if (! $iptc_urgency);
  # 5 = best XMP rating = 5 stars = IPTC urgency 1, 4 = 2, 3 = 3, 2 = 4, 1 = 5, 0 = 6-8
  my $xmp_rating = 6 - $iptc_urgency;
  $xmp_rating = 0 if ($xmp_rating < 0);
  $xmp_rating = - 1 if ($iptc_urgency == 0);
  return $xmp_rating;  
}

##############################################################
# returns string explaining how XMP rating is mapped to IPTC
##############################################################
sub convert_xmp_to_iptc_text {
  my $string = lang("XMP rating to IPTC urgency mapping (XMP -> IPTC):")."\n";
  foreach my $xmp (0 .. 5) {
    my $iptc = convert_xmp_to_iptc($xmp);
    $string .= "$xmp -> $iptc\n";
  }
  return $string;
}

##############################################################
# convert XMP rating value to IPTC urgency value
##############################################################
sub convert_xmp_to_iptc {
  my $xmp = shift;
  $xmp = 0 if (! $xmp);
  # 5 = best XMP rating = 5 stars = IPTC urgency 1, 4 = 2, 3 = 3, 2 = 4, 1 = 5, 0 = 6-8
  my $urgency = 6 - $xmp;
  $urgency = 0 if ($xmp == -1);
  return $urgency;  
}

##############################################################
# xmp_set_rating - set XMP Rating of the given picture to a IPTC urgency using Image::ExifTool
##############################################################
sub xmp_set_rating {
  my ($dpic , $iptc_urgency) = @_;
  my $xmp_rating = convert_iptc_to_xmp($iptc_urgency);
  return xmp_set($dpic, 'Rating', $xmp_rating);
}

##############################################################
# xmp_set - set any XMP single item of the given picture to a value using Image::ExifTool
##############################################################
sub xmp_set {
  my $error = '';
  my ($dpic , $xmp_item, $xmp_value) = @_;
  return $error if (! -f $dpic);
  # todo: support more XMP tags
  return $error if ($xmp_item ne 'Rating'); # we support only Rating at the moment

  log_it("Setting XMP item $xmp_item to $xmp_value in $dpic ...");
  my $exifTool = new Image::ExifTool;
  my $info = $exifTool->ImageInfo($dpic, 'XMP-xmp:*');
  # set XMP item to value
  my ($ok, $et_error) = $exifTool->SetNewValue('XMP-xmp:'.$xmp_item => $xmp_value);
  if ($ok) {
    my $rc = $exifTool->WriteInfo($dpic);
    $error .= exiftool_get_error($exifTool, $rc, $dpic);
  }
  else { # SetNewValue has thtrown an errors
    $error .= $et_error;
  }
  my $log_entry = '';
  $log_entry = 'There have been errors!' if ($error);
  print "Errors = $error\n" if ($error);
  log_it("... ready! $log_entry");
  return $error;
}

##############################################################
# xmp_add_keyword - add XMP keyword using Image::ExifTool
##############################################################
sub xmp_add_keyword {
  my $lb = shift;
  my @sellist = getSelection($lb);
  return unless checkSelection($lb, 1, 0, \@sellist, lang("picture(s)"));
  my $selected = scalar @sellist;
  my $keyword = '';
  my $rc = myEntryDialog('Add XMP keyword', "Please enter a new keyword to add to the $selected pictures.\n(To add hierachical keywords use dot notation, i.e. Person.Simpson.Homer)", \$keyword);
  return if (($rc ne 'OK') or ($keyword eq ''));
  log_it("adding XMP keyword to $selected pictures");
  # detect hierarchical keywords (containing a dot)
  my $getvalue = 'Subject';
  my $setvalue = 'XMP-dc:Subject';
  if ($keyword =~ m|.+\..+|) {
    $keyword =~ s/\./\|/g; # replace all dots with |    
    $getvalue = 'HierarchicalSubject';
    $setvalue = 'XMP:HierarchicalSubject';
  }
  my $exifTool = new Image::ExifTool;
  my $i = 0;
  my $error = '';
  my $pw = progressWinInit($lb, 'Adding XMP keyword');
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "Adding XMP keyword ($i/$selected) ...", $i, $selected);
    my $info = $exifTool->ImageInfo($dpic, 'XMP:*');
    # get exsisting keywords
    my @keywords = $exifTool->GetValue($getvalue);
    # add new keyword to list
    push @keywords, $keyword;
    # remove double entries and sort alphabetical
    uniqueArray(\@keywords);
    # add XMP keywords
    $exifTool->SetNewValue($setvalue => \@keywords);
    #$exifTool->SetNewValue('XMP-dc:Title' => 'Mapivi can write XMP!');
    #$exifTool->SetNewValue('XMP:Urgency' => 3);
    my $ok = $exifTool->WriteInfo($dpic);
    $error .= exiftool_get_error($exifTool, $ok, $dpic);
	  showImageInfoCanvas($dpic) if ($ok and ($dpic eq $actpic));
  }
  progressWinEnd($pw);
  log_it(lang('Ready!')." ($i of $selected)");
  showText("Errors while adding XMP keywords", $error, NO_WAIT) if ($error ne '');
}

##############################################################
# convert exifTool return code into error string
##############################################################
sub exiftool_get_error {
  my $exifTool = shift; # handle
  my $rc = shift; # return code
  my $dpic = shift;
  my $error = '';
  if ($rc != 1) { # error
    if ($rc == 2) {
      $error = "$dpic written, but no changes made\n";
    }
    else {
      $error = "Error writing $dpic: $rc\n";
      # retrieve error and warning messages
      $error .= sprintf "error: %s\n", $exifTool->GetValue('Error') if $exifTool->GetValue('Error');
      $error .= sprintf "warning: %s\n", $exifTool->GetValue('Warning') if $exifTool->GetValue('Warning');
    }
  }
  return $error;
}

##############################################################
# xmp_remove - remove complete XMP section using Image::ExifTool
##############################################################
sub xmp_remove {
  my $lb = shift;
  my @sellist = getSelection($lb);
  return unless checkSelection($lb, 1, 0, \@sellist, lang("picture(s)"));
  my $selected = scalar @sellist;
  my $rc = $top->messageBox(-icon  => 'question', -message => "Really remove all XMP infomation of $selected pictures?",
						-title => "Remove XMP information",   -type => 'OKCancel');
  return if ($rc !~ m/Ok/i);
  log_it("removeing XMP information of $selected pictures");
  my $exifTool = new Image::ExifTool;
  my $i = 0;
  my $error = '';
  my $pw = progressWinInit($lb, 'Remove XMP information');
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "Remove XMP information ($i/$selected) ...", $i, $selected);
    my $info = $exifTool->ImageInfo($dpic, 'XMP:*');
    # remove XMP section
    $exifTool->SetNewValue('XMP:*');
    my $ok = $exifTool->WriteInfo($dpic);
    $error .= exiftool_get_error($exifTool, $ok, $dpic);
	  showImageInfoCanvas($dpic) if ($ok and ($dpic eq $actpic));
  }
  progressWinEnd($pw);
  log_it(lang('Ready!')." ($i of $selected)");
  showText("Errors while removing XMP information", $error, NO_WAIT) if ($error ne '');
}

##############################################################
# xmp_add_title - add XMP title using Image::ExifTool
##############################################################
sub xmp_add_title {
  my $lb = shift;
  my @sellist = getSelection($lb);
  return unless checkSelection($lb, 1, 0, \@sellist, lang("picture(s)"));
  my $selected = scalar @sellist;

  my $item = '';
  my $rc = myEntryDialog('Add XMP title', "Please enter a new title to add to the $selected picture(s)", \$item);
  return if ($rc ne 'OK');

  log_it("adding XMP title to $selected picture(s)");

  my $exifTool = new Image::ExifTool;
  my $i = 0;
  my $error = '';
  my $pw = progressWinInit($lb, 'Adding XMP title');
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "Adding XMP title ($i/$selected) ...", $i, $selected);
    my $info = $exifTool->ImageInfo($dpic, 'XMP:*');
    # add XMP title
    $exifTool->SetNewValue('XMP-dc:Title' => $item);
    my $ok = $exifTool->WriteInfo($dpic);
    $error .= exiftool_get_error($exifTool, $ok, $dpic);
	  showImageInfoCanvas($dpic) if ($ok and ($dpic eq $actpic));
  }
  progressWinEnd($pw);
  log_it(lang('Ready!')." ($i of $selected)");
  showText("Errors while adding XMP title", $error, NO_WAIT) if ($error ne '');
}

##############################################################
# xmp_edit_title - edit XMP title using Image::ExifTool
##############################################################
sub xmp_edit_title {
  my $lb = shift;
  my @sellist = getSelection($lb);
  return unless checkSelection($lb, 1, 0, \@sellist, lang("picture(s)"));
  my $selected = scalar @sellist;

  log_it("adding XMP title to $selected picture(s)");

  my $exifTool = new Image::ExifTool;
  my $i = 0;
  my $error = '';
  my $pw = progressWinInit($lb, 'Adding XMP title');
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    my $item = '';
    my $info = $exifTool->ImageInfo($dpic, 'XMP:*');
    $item = $$info{Title} unless (ref $$info{Title} eq 'SCALAR');
    my $rc = myEntryDialog('Edit XMP title', "Please edit title of $dpic", \$item);
    next if ($rc ne 'OK');
    progressWinUpdate($pw, "Edit XMP title ($i/$selected) ...", $i, $selected);
    # add XMP title
    $exifTool->SetNewValue('XMP-dc:Title' => $item);

    my $ok = $exifTool->WriteInfo($dpic);
    $error .= exiftool_get_error($exifTool, $ok, $dpic);
	  showImageInfoCanvas($dpic) if ($ok and ($dpic eq $actpic));
  }
  progressWinEnd($pw);
  log_it(lang('Ready!')." ($i of $selected)");
  showText("Errors while adding XMP title", $error, NO_WAIT) if ($error ne '');
  return;
}

##############################################################
# checkTrash
##############################################################
sub checkTrash {
  my @files = getFiles($trashdir);
  my $sum = 0;
  foreach (@files) {
    $sum += getFileSize("$trashdir/$_", NO_FORMAT); # get size in Bytes
  }
  my $msum = sprintf "%.1f", $sum/(1024*1024); # size in MB
  return if ($msum < $config{MaxTrashSize});
  my $dialog = $top->Dialog(-title => "Trash full!",
                            -text => "The trash contains $msum MB in ".scalar @files." files!",
                            -buttons => ["Do nothing", "Show trash in main window", "Empty trash ..."]);
  my $rc = $dialog->Show();
  if ($rc eq "Do nothing") {
    $top->focusForce;
    return;
  }
  elsif ($rc eq "Show trash in main window") {
    openDirPost($trashdir);
    $top->focusForce;
    return;
  }
  elsif ($rc eq "Empty trash ...") {
    emptyTrash();
  }
  else {
    warn "this should never be reached!";
  }
  $top->focusForce;
  return;
}

##############################################################
# emptyTrash - remove all files from the trash
##############################################################
sub emptyTrash {
  # open window
  my $win = $top->Toplevel();
  $win->title(lang('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 = lang("loading ...");
  $win->Label(-textvariable => \$text)->pack(-expand => 0, -fill => 'x');
  my $tlb = $win->Scrolled("HList",
                           -header     => 1,
                           -separator  => ';',  # todo here we hope that ; will never be in a folder or file name
                           -pady       => 0,
                           -columns    => 4,
                           -scrollbars => 'osoe',
                           -selectmode => 'extended',
                           -background => $conf{color_bg}{value}, #8fa8bf
                           -width      => 80,
                           -height     => 30,
                          )->pack(-expand => 1, -fill => 'both');
  $tlb->header('create', 0, -text => lang('Thumbnail'), -headerbackground => $conf{color_entry}{value});
  $tlb->header('create', 1, -text => lang('Name'),      -headerbackground => $conf{color_entry}{value});
  $tlb->header('create', 2, -text => lang('Size'),      -headerbackground => $conf{color_entry}{value});
  $tlb->header('create', 3, -text => lang('Original folder'), -headerbackground => $conf{color_entry}{value});

  my $butF = $win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
  $butF->Button(-text => lang('Remove all'),
                -command => sub {
                  my @files = getFiles($trashdir);
                  foreach (@files) {
                    removeFile("$trashdir/$_");
                  }
                  updateThumbsPlus() if ($actdir eq $trashdir);
                  $userinfo = lang("Trash is now empty!");
                  $win->destroy;
                })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  my $rmB = $butF->Button(-text => lang('Remove'),
                -command => sub {
                  my @sellist = getSelection($tlb);
                  return unless checkSelection($win, 1, 0, \@sellist, lang("picture(s)"));
                  foreach (@sellist) {
                    removeFile($_);
                    $tlb->delete('entry', $_);
                  }
                  $text = langf("Removed %d file(s) from trash!", scalar(@sellist));
                })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  $balloon->attach($rmB, -msg => lang("Remove selected files from trash.\nThere is no undo!"));
  my $reB = $butF->Button(-text => lang('Restore'),
                -command => sub {
                  my @sellist = getSelection($tlb);
                  return unless checkSelection($win, 1, 0, \@sellist, lang("picture(s)"));
                  my $error = '';
                  my %changed_dirs;
                  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;
                      $changed_dirs{$searchDB{$dpic}{odir}}++;
                      movePics($searchDB{$dpic}{odir}, $tlb, @list);
                    }
                    else {
                      $error .= langf("Could not restore %s (no folder information available)\n",$dpic);
                    }
                  }
                  foreach my $dir (keys %changed_dirs) {
                    smart_update() if ($actdir eq $dir);  # updateThumbsPlus()
                  }
                  if ($error ne '') {
                    $error = langf("Errors while restoring selected picture(s):\n%s",$error);
                    showText(lang("Errors"), $error, NO_WAIT);
                  }
                  $text = langf("Restored %s file(s) from trash!", scalar(@sellist));
                })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  $balloon->attach($reB, -msg => lang("Restore selected files from trash to original folder."));
  my $Xbut = $butF->Button(-text => lang('Cancel'),
                     -command => sub {
                       $win->destroy();
                     })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  bind_exit_keys_to_button($win, $Xbut);
  $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;
  my @files = getFiles($trashdir);
  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 = langf("Press \"%s\" to delete all files (%d MB in %d files) from the trash.\nWarning: There is no undelete!\n\n(Trash folder: %s)",
                lang("Remove all"), $msum, scalar(@files), $trashdir);
  $win->waitWindow;
  foreach (keys %thumbs) { delete_photo_object($thumbs{$_}); } # free memory
  return;
}

##############################################################
# setFromTo - dialog to set search from and search to date
##############################################################
sub setFromTo {
  # open window
  my $win = $top->Toplevel();
  $win->title('Set from/to search dates');
  $win->iconimage($mapiviicon) if $mapiviicon;
  my @fdate = split /\./, $config{SearchDateStart};
  my $from_day   = $fdate[0];
  my $from_month = $fdate[1];
  my $from_year  = $fdate[2];
  my @tdate = split /\./, $config{SearchDateEnd};
  my $to_day   = $tdate[0];
  my $to_month = $tdate[1];
  my $to_year  = $tdate[2];
  # ranges
  my (@day, @month, @year);
  push @day,   sprintf "%02d",$_ for ( 1 .. 31);
  push @month, sprintf "%02d",$_ for ( 1 .. 12);
  push @year,  sprintf "%4d", $_ for ( 1990 .. 2020);
  # it is still possible to add other year numbers in the search window itself!
  my $f1 = $win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
  $f1->Label(-text => 'from', -width => 4)->pack(-side => 'left', -anchor => 'w');
  $f1->Optionmenu(-variable => \$from_day, -textvariable => \$from_day, -options => \@day)->pack(-side => 'left', -anchor => 'w');
  $f1->Optionmenu(-variable => \$from_month, -textvariable => \$from_month, -options => \@month)->pack(-side => 'left', -anchor => 'w');
  $f1->Optionmenu(-variable => \$from_year, -textvariable => \$from_year, -options => \@year)->pack(-side => 'left', -anchor => 'w');
  $f1->Button(-text => 'today', -command => sub {
    my (undef,undef,undef,$d,$M,$y) = getDateTime(time());
    $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) = getDateTime(time());
    $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 => lang('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 => lang('Cancel'),
                           -command => sub {
                             $win->destroy();
                           })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  bind_exit_keys_to_button($win, $Xbut);
  $win->bind('<Control-x>',  sub { $OKB->Invoke;  });
  $win->Popup(-popover => 'cursor');
  repositionWindow($win);
  $win->waitWindow;
  return;
}

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

##############################################################
# 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 file name
  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 => lang('Close'),  -pady => 0,
               -command => sub {
                 $icon->delete if $icon;
                 $win->withdraw();
                 $win->destroy();
               },
              )->pack(-fill => 'x');
  # 50 ways to leave your window ;)
  bind_exit_keys_to_button($win, $xBut);
  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 => $conf{color_bg}{value}, -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);
  $xBut->focus;
  $win->Popup;
  repositionWindow($win);
  $win->waitWindow if ($wait == WAIT);
  return;
}

##############################################################
# exportFilelist
##############################################################
sub exportFilelist {
  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));
  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 => $conf{color_bg}{value}
                  )->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 => lang('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 my $dpic (@sellist) {
                      my $pic      = basename($dpic);
                      print $exfile "\""       if $useQuotes;
                      print $exfile "$actdir/" if $addPath;
                      print $exfile "$pic";
                      print $exfile "\""       if $useQuotes;
                      print $exfile ", ";
                    }
                    close $exfile;
                    log_it("File list exported!");
                    $myDiag->withdraw();
                    $myDiag->destroy();
                  })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  my $xBut = $ButF->Button(-text => lang('Cancel'),
                -command => sub {
                    $myDiag->withdraw();
                    $myDiag->destroy();
                  })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  bind_exit_keys_to_button($myDiag, $xBut);
  $myDiag->Popup(-popover => 'cursor');
  repositionWindow($myDiag);
  $myDiag->waitWindow;
}

##############################################################
# edit_pic
##############################################################
sub edit_pic {
  my $widget = shift;
  my @sellist = @_; # optional list of pictures (each with path) 
  if (not @sellist) {
    @sellist = getSelection($widget);
    return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));
  }
  # ask before starting many editors
  return unless askSelection(\@sellist, 10, "external editor");
  my $i = 0;
  my $rc = 1;
  foreach my $dpic (@sellist) {
    $i++;
    # normal picture editor
    my $editor = $conf{external_pic_editor}{value};
    # picture editor for RAW pictures
    if (defined $conf{external_raw_editor}{value} and $conf{external_raw_editor}{value} ne '') {
      $editor = $conf{external_raw_editor}{value} if (is_raw_file($dpic));
    }
    log_it(langf("Opening picture in %s (%d/%d).",basename($editor),$i,scalar(@sellist)));
    # check if file is a link and get the real target
    next if (!getRealFile(\$dpic));
    my $command = "$editor \"$dpic\" ";
    $command .= "2>&1 1>/dev/null &" if (!$EvilOS);
    if ((system "$command") != 0) {
     warn "$command failed: $!";
     log_it("$command failed: $!");
     $rc = 0;
     last;
    }
    #execute($command); # does not work for Windows
  }
  $top->after(800, sub { log_it(lang('Ready!')); }) if $rc;
}

##############################################################
# getSelection - get the selected items from a Canvas (e.g. light
# table) or a HList (e.g. thumbnail table in main window)
##############################################################
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($widget,$id); }
  }
  else {
    @sellist  = $widget->info('selection');
  }
  return @sellist;
}

##############################################################
# selection_get_sort - get the selected items from
# the widget (e.g. light_table) in the order as in $pic_list_ref
##############################################################
sub selection_get_sort {
  my $widget = shift;
  my $pic_list_ref = shift;
  my @sel_unsorted = getSelection($widget);
  my @sel_sorted;
  # use the order given in pic_list
  foreach my $dpic (@{$pic_list_ref}) {
    if (isInList($dpic, \@sel_unsorted)) {
      push @sel_sorted, $dpic;
    }
  }
  return @sel_sorted;
}

##############################################################
# openPicInViewer
##############################################################
sub openPicInViewer {

  my $lb = shift;    # the reference to the active listbox widget
  my @sellist = getSelection($lb);
  return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));

  my $maxnr = 20;
  if (!$conf{external_pic_viewer_multi}{value} 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 $piclist;

  my $i = 0;
  foreach my $dpic (@sellist) {
    $i++;
    log_it("opening picture in viewer ($i/".scalar @sellist.")");

    increasePicPopularity($dpic);
    updateOneRow($dpic, $lb) if (($config{trackPopularity}) and (ref($lb) ne 'Tk::Canvas'));

    $dpic =~ s/\//\\/g if $EvilOS; # windows needs backslashes

    if ($conf{external_pic_viewer_multi}{value}) {
      $piclist .= "\"$dpic\" ";
    }
    else {
      my $command = "$conf{external_pic_viewer}{value} $dpic ";
      $command    = "\"$conf{external_pic_viewer}{value}\" \"$dpic\" " if $EvilOS; # windows needs quotes

      # 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 ($conf{external_pic_viewer_multi}{value}) {
    my $command = "$conf{external_pic_viewer}{value} $piclist";
    $command = "\"$conf{external_pic_viewer}{value}\" $piclist" if $EvilOS; # windows needs quotes
    
    # 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 { log_it(lang('Ready!')); });
}

##############################################################
# 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);
  log_it("Setting $pic as desktop background using ".$config{ExtBGApp});
  # check if file is a link and get the real target
  return if (!getRealFile(\$dpic));
  my $command = $config{ExtBGApp}." \"$dpic\" ";
  execute($command);
  log_it($config{ExtBGApp}." ".lang("Ready!"));
}

##############################################################
# 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);
  log_it("getting infos about $pic ...");
  # check if file is a link and get the real target
  return if (!getRealFile(\$dpic));
  my $command = "identify -verbose \"$dpic\" ";
  my $buffer = `$command`;
  showText("Information about $pic", $buffer, NO_WAIT, $thumb);
  log_it(lang('Ready!'));
}

##############################################################
# 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
  return 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);
  log_it("building histogram of $pic ...");
  # 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)) {
    log_it("Error building histogram of $pic!");
    return;
  }
  log_it("Histogram ready!");
  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
        log_it("histogram saved!");
      }
      else {
        log_it("error while saving histogram");
      }
    }
  }
  removeFile($hist);
  return;
}

##############################################################
# 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/$pic-histogram.gif"; # 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);
  (system "$command") == 0 or warn "getHistogram: $command failed: $!";
  $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);
  log_it("building histogram of $pic ...");
  # 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; }
  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 => lang('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;
  return;
}

##############################################################
# checkSelection
##############################################################
sub checkSelection {
  my $win     = shift; # widget used as parent for messageBox
  my $min     = shift;
  my $max     = shift; # use 0 for any number
  my $listref = shift;
  my $itemkind = shift; # optional string, e.g. "picture" or "keyword", ...
  $itemkind = lang('item(s)') unless defined $itemkind;
  my $ok = 0;
  my $message = '';
  if (($min == $max) and ($min != 0) and (@$listref != $min)) {
    $ok = 0;
    $message = langf("Please select exactly %d %s!",$min,$itemkind);
  }
  elsif (@$listref < $min) {
    $ok = 0;
    $message = langf("Please select at least %d %s!",$min,$itemkind);
  }
  elsif (($max != 0) and (@$listref > $max)) {
    $ok = 0;
    $message = langf("Please select not more than %d %s!",$max,$itemkind);
  }
  else {
    $ok = 1;
  }
  if ($ok != 1) {
    $win->messageBox(-icon  => 'warning', -message => $message,
                     -title => lang("Wrong selection"), -type => 'OK');
  }
  return $ok;
}

##############################################################
# 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
##############################################################
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, lang("picture(s)"));
  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(langf("Collage/index print of %d pictures", scalar(@sellist)));
  $indexW->iconimage($mapiviicon) if $mapiviicon;
  my $w = 20;
  $indexW->Label(-text => lang('Generate a picture containing several pictures in a grid layout.'))->pack(-padx => 3, -pady => 3);
  labeledEntry($indexW, 'top', $w, lang('File name'), \$index);
  labeledEntryColor($indexW,'top',$w,lang('Background color'),'Set',\$config{indexBG});
  labeledEntry2($indexW, 'top', $w, 4, lang('Columns'),\$config{indexCols}, lang('Rows'),\$config{indexRows});
  labeledEntry2($indexW, 'top', $w, 4, lang('Distance x in pixels'), \$config{indexDisX}, 'y', \$config{indexDisY});
  my $sbb = $indexW->Button(-text => lang('Symmetric borders'), -command => sub { $config{indexDisX} = $config{indexBorderWidth}; $config{indexDisY} = $config{indexBorderWidth}; })->pack(-side => 'top',-anchor => 'e', -padx => 3, -pady => 3);
  $balloon->attach($sbb, -msg => "This button will set x and y distance to border width.");
  my $sizeF = $indexW->Frame(-relief => "raised")->pack(-expand => 1, -fill => 'x', -padx => 3);
  labeledEntry2($sizeF, 'top', $w, 4, lang('Picture width'), \$config{indexPicX}, lang('Height'), \$config{indexPicY});
  my $sizeF2 = $sizeF->Frame()->pack(-anchor => 'e');
  $sizeF2->Label(-text => lang('Presets'))->pack(-side => 'left',-anchor => 'e', -padx => 3, -pady => 3);
  foreach my $div (1, 2, 4, 10) {
    $sizeF2->Button(-text => int(100/$div).'%', -command => sub { $config{indexPicX} = int($pic0x/$div); $config{indexPicY} = int($pic0y/$div); })->pack(-side => 'left',-anchor => 'e', -padx => 3, -pady => 3);
  }
  #$sizeF2->Button(-text => "50%", -command => sub { $config{indexPicX} = int($pic0x/2); $config{indexPicY} = int($pic0y/2); })->pack(-side => 'left',-anchor => 'e', -padx => 3, -pady => 3);
  my $lF = $indexW->Frame(-relief => "raised")->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  $lF->Checkbutton(-variable => \$config{indexLabel}, -text => lang('Text to each picture'))->pack(-anchor=>'w');
  my $labstr =
  labeledEntry($lF, 'top', $w, "Text", \$config{indexLabelStr});
  $balloon->attach($labstr, -msg => "%b   file size\n%c   comment\n%d   folder\n%e   filename extention\n%f   filename\n%h   height\n%i   input filename\n%l   label\n%m   magick\n%n   number of scenes\n%o   output filename\n%p   page number\n%q   quantum depth\n%s   scene number\n%t   top of filename\n%u   unique temporary filename\n%w   width\n%x   x resolution\n%y   y resolution");

  my $fss = labeledScale($lF, 'top', $w, lang("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 => lang('Border around each picture'))->pack(-anchor=>'w');
  labeledScale($ibF, 'top', $w, lang("Width"), \$config{indexInnerBorderWidth}, 1, 1000, 1);
  labeledEntryColor($ibF, 'top', $w, lang("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 => lang('Border around collage'))->pack(-anchor=>'w');
  labeledScale($obF, 'top', $w, lang("Width"), \$config{indexBorderWidth}, 1, 1000, 1);
  labeledEntryColor($obF, 'top', $w, lang("Color"),'Set',\$config{indexBorderColor});

  my $qS = labeledScale($indexW, 'top', 26, lang('Quality of collage'), \$config{PicQuality}, 10, 100, 1);
  qualityBalloon($qS);
  buttonComment($indexW, 'top');
  calcIndexInfo($indexW, scalar @sellist);
  my $f = $indexW->Frame(-bd => $config{Borderwidth}, -relief => 'groove',)->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  # add 3 labels for user feedback
  $f->Label(-textvar => \$indexW->{Label1})->pack(-anchor => 'w');
  $f->Label(-textvar => \$indexW->{Label2})->pack(-anchor => 'w');
  $f->Label(-textvar => \$indexW->{Label3})->pack(-anchor => 'w');
  $f->Button(-image => $mapivi_icons{'Update'}, -command => sub { calcIndexInfo($indexW, scalar @sellist); } )->pack();
  my $ButF = $indexW->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
  my $OKB;
  $OKB =
    $ButF->Button(-text => lang('OK'),
                    -command => sub {
                      my $nr = calcIndexInfo($indexW, 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
                      log_it("building index prints of ".scalar @sellist." pictures ...");
                      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 ($conf{add_tool_info}{value}) {
                        addCommentToPic("Picture made with Mapivi $version ($mapiviURL)", $index, NO_TOUCH);
                      }
                      log_it(lang('Ready!'));
                      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);


  my $xBut = $ButF->Button(-text => lang('Cancel'),
                -command => sub {
                  $indexW->destroy();
                }
                 )->pack(-side => 'left',-expand => 1,-fill => 'x',-padx => 3,-pady => 3);
  bind_exit_keys_to_button($indexW, $xBut);
  $indexW->Popup;
  $indexW->waitWindow;
  return;
}

##############################################################
##############################################################
sub passport_dialog {
  if (Exists($passportW)) {
    $passportW->deiconify;
    $passportW->raise;
    return;
  }
  # open window
  $passportW = $top->Toplevel();
  $passportW->title(lang("Passport prints"));
  $passportW->iconimage($mapiviicon) if $mapiviicon;

  my ($axp,$ayp) = @_;
  my $ok = 0;
  my $ax = 3.5;
  my $ay = 4.5;
  my $px = 15;
  my $py = 10;
  my $w = 25;
  my $status = '';
  my $pxs = labeledScale($passportW, 'top', $w, lang("Print size x"), \$px, 1, 100, 0.1, sub{ $status = passport_check($axp,$ayp,$ax,$ay,$px,$py); });
  $balloon->attach($pxs, -msg => "Width of photo print in physical units (e.g. cm or inch)");
  my $pys = labeledScale($passportW, 'top', $w, lang("Print size y"), \$py, 1, 100, 0.1, sub{ $status = passport_check($axp,$ayp,$ax,$ay,$px,$py);}); 
  $balloon->attach($pys, -msg => "Height of photo print in physical units (e.g. cm or inch)");
  my $axs = labeledScale($passportW, 'top', $w, lang("Passport picture size x"), \$ax, 1, 50, 0.1, sub{ $status = passport_check($axp,$ayp,$ax,$ay,$px,$py);});
  $balloon->attach($axs, -msg => "Width of passport photo in physical units (e.g. cm or inch)");
  my $ays = labeledScale($passportW, 'top', $w, lang("Passport picture size y"), \$ay, 1, 50, 0.1, sub{ $status = passport_check($axp,$ayp,$ax,$ay,$px,$py);});
  $balloon->attach($ays, -msg => "Height of passport photo in physical units (e.g. cm or inch)");

  $passportW->Label(-textvariable => \$status)->pack(-side => 'top',-expand => 1,-fill => 'x',-padx => 3,-pady => 3);
  
  my $ButF = $passportW->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
  my $OKB;
  $OKB =
    $ButF->Button(-text => lang('OK'),
                    -command => sub {
                      $ok = 1;
                      $passportW->destroy();
                    })->pack(-side => 'left',-expand => 1,-fill => 'x',-padx => 3,-pady => 3);
                    
  my $xBut = $ButF->Button(-text => lang('Cancel'),
                -command => sub {
                  $ok = 0;
                  $passportW->destroy();
                }
                 )->pack(-side => 'left',-expand => 1,-fill => 'x',-padx => 3,-pady => 3);
  bind_exit_keys_to_button($passportW, $xBut);
  $passportW->Popup;
  $passportW->waitWindow;
  print "passport dialog: $ax * $ay $px * $py\n";
  return ($ok, $ax, $ay, $px, $py);
}

##############################################################
##############################################################
sub passport_check {
  my ($axp,$ayp,$ax,$ay,$px,$py) = @_;
  my ($ok,$err,$n,$m,$bxp,$byp) = passport_border($axp,$ayp,$ax,$ay,$px,$py);
  my $check;
  if ($ok) {
    my $nr = $n * $m;
    $check = "OK, print will hold $nr (${n}x${m}) passport pictures. Border $bxp, $byp"; 
  }
  else {
    $check = "Error, $err";
  }
  return $check;
}
##############################################################
# generate a new picture with a certain phyiscal size (e.g. 10x15cm)
# from one input picture. The given picture will be tiled onto
# the given canvas as often as possible (in $n cols and $m rows).
# outer size of print: $px * $py
# inner size of picture: $ax * $ay
# border around inner picture(s): $bx, $by
# all sizes above are in physical units (e.g. cm or inch)
# size in pixels end with a 'p', e.g. $bxp 
##############################################################
sub passport_border {
  #my $dpic = shift;
  my ($axp,$ayp,$ax,$ay,$px,$py) = @_;
  my $err = '';
  if ((not defined $ax) or (not defined $ay) or (not defined $px) or (not defined $py)) {$err = "Some sizes are not defined!"; return (0,$err);}
  if (($ax <= 0) or ($ay <= 0)) {$err = "Passport picture has a size of 0 or less!"; return (0,$err);}
  if ($ax > $px) {$err = "Passport picture width is larger than print!"; return (0,$err);}
  if ($ay > $py) {$err = "Passport picture height is larger than print!"; return (0,$err);}
  my $arat = $ax/$ay;
  my $aratp = $axp/$ayp;
  print "ratio $arat pixel-ratio $aratp\n";
  my $delta = 1/100;
  if (($arat > $aratp*(1+$delta)) or ($arat < $aratp*(1-$delta))) {$err = sprintf("Given ratio of passport picture (%.3f) does not fit to its pixel ratio (%.3f)!",$arat,$aratp); return (0,$err);}
  my $n = int($px/$ax);
  my $m = int($py/$ay);
  my $bx = ($px-$n*$ax)/(2*$n);
  my $by = ($py-$m*$ay)/(2*$m);
  my $bxp = round($axp/$ax*$bx);
  my $byp = round($ayp/$ay*$by);
  print "passport: n:$n, m:$m, bx:$bx = $bxp pixel, by:$by = $byp pixel\n";
  print "error:$err\n";
  return (1,$err,$n,$m,$bxp,$byp);
}

##############################################################
##############################################################
sub passport_print {
  my $widget = shift;
  my @pics = getSelection($widget); 
  return 0 if (!checkExternProgs('passport_print', 'montage'));
  return 0 if not checkSelection($top, 1, 1, \@pics, lang('picture'));
  my $dpic = $pics[0];
  if (not -f $dpic) {log_it("Error: $dpic is no file!"); return 0;}
  my ($axp, $ayp) = getSize($dpic);
  if (($axp == 0) or ($ayp == 0)) {log_it("Error: Picture has a pixel size of 0!"); return 0;}
  my ($ok, $ax, $ay, $px, $py);
  ($ok, $ax, $ay, $px, $py) = passport_dialog($axp,$ayp);
  return 0 if not $ok;
  my ($err,$n,$m,$bxp,$byp);
  ($ok,$err,$n,$m,$bxp,$byp) = passport_border($axp,$ayp,$ax,$ay,$px,$py);
  if (not $ok) {
    log_it("Passport print error: $err");
    return 0;
  }
  my ($basename,$dir,$suffix) = fileparse($dpic, '\.[^.]*'); # suffix = . and not-.  (one dot and zero or more non-dots)
  # Build outfile name
  my $outfile = $dir.$basename.'Passport'.$suffix;
  $outfile = $dir.findNewName($outfile) if (-f $outfile);
  my $command = "montage ";
  $command .= "-bordercolor \"white\" ";
  #$command .= "-border ${bxp}x${byp} ";
  #$command .= "-background \"$config{'indexBG'}\";
  $command .= " -tile ${n}x${m} -geometry ${axp}x${ayp}+${bxp}+${byp} ";
  #my $pic;
  # add the selected pictures to $command
  my $nr = $n*$m;
  foreach (1 .. $nr) {
    $command .= "\"$dpic\" ";
  }
  $command   .= "-quality ".$config{PicQuality}." ";
  $command   .= "\"$outfile\"";
  print "$command\n";# if $verbose;
  $top->Busy;
  log_it("Creating passport print with $n x $m pictures ...");
  if ($EvilOS) {
    (system $command) == 0 or warn "execute: $command failed: $!";
  }
  else {
    execute($command);
  }
  if (-f $outfile) {
    smart_update() if ($widget == $picLB);
    showPic($outfile);
    log_it("Passport print ready!");
  } else {
    log_it("Passport print: no file created; reason unknown (please check console output)!");
  }
  $top->Unbusy;
  return 1;
}

##############################################################
# calcIndexInfo
##############################################################
sub calcIndexInfo {
  my $w = shift; # the window widget, we assume 3 labels with a variable reference to Label1, Label2 and Label3 here
  my $nrOfSel = shift;
  my $indexPics = $config{indexRows} * $config{indexCols};
  $w->{Label1} = langf("One collage holds %d pictures.", $indexPics);
  my $indexNr = int($nrOfSel/$indexPics);
  $indexNr++ if (($nrOfSel % $indexPics) != 0);
  $w->{Label2} = langf("With %d pictures this results in %d collages.", $nrOfSel, $indexNr);
  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};
  }
  $w->{Label3} = langf("Each collage is about %dx%d pixels.", $sizex, $sizey);
  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];
  }
  return;
}

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

##############################################################
# slideshow - start/stop slideshow
##############################################################
sub slideshow {
  my $last_time;
  if ($slideshow) {
    log_it("slideshow started");
    $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));
        log_it(basename($actpic)." (slideshow: ".$config{SlideShowTime}."sec)");
        $last_time = Tk::timeofday();
        $picLB->selectionClear();
        reselect($picLB, @savedselection);
      }
      DoOneEvent(); # stay responsive
      last if (!$slideshow);
    }
  }
  log_it("slideshow stopped");
  return;
}

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

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

##############################################################
# 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});
   print "  adding \"$FindBin::Bin\" to path \"$ENV{PATH}\"\n" if $verbose;
   foreach my $dir (@path)
   {
     my $test=$dir."\\$cmdName";
     #print "Test: $test \n";
     if ( -x $test )
     {
       $winapps{$cmdName}=$test;
       #print "  Success!\n";
       return $test;
     }
   }
   warn "findApp: Could not find application: \"$cmd\" \"$cmdName\"\n";
   return ''; 
}

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

##############################################################
# cleanThumbDB - remove all old thumbnails in the thumbDB
##############################################################
sub cleanThumbDB {

  # todo create dialog window and make e.g. the $days an adjustable option
  my $days = 30;
  my $thumbDB_quote = $thumbDB;
  $thumbDB_quote =~ s|\\|\\\\|g;    # replace backslash with double backslashe \ -> \\ (quoting)
  my @thumbs;
  my $rc = $top->messageBox(-icon  => "question",
                            -message => "This function will display all stored thumbnails in the thumbnail data base which have no corresponding picture and are older than $days days. You may then select which of them to delete. Please press Ok to proceed.",
                            -title => "Clean thumbnail database", -type => 'OKCancel');
  return if ($rc !~ m/Ok/i);

  log_it("searching outdated thumbnails ...");
  find(sub {
         #print "dir: $File::Find::name\n";
         if (-f and (-M >= $days)) {
           my $orig = $File::Find::name;
           # cut off the first path part (the path to the thumbdb) the rest is the real part.
           $orig =~ s|^$thumbDB_quote||;
           unless (-f $orig) {
             print "file: $File::Find::name -> $orig\n" if $verbose;
             push @thumbs, $File::Find::name;
           }
         }
       }, $thumbDB);

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

  log_it("found ".@thumbs." outdated thumbnails ...");
  if (@thumbs > 0) {
    my @sel_list;
    # user may select which to delete
    if (mySelListBoxDialog("Really delete?",
                           "Please select which of these ".scalar @thumbs." thumbnails to delete.",
                           MULTIPLE,
                           'OK', \@sel_list, @thumbs)) {
      foreach (@sel_list) {
        print "removing $thumbs[$_]\n" if $verbose;
        removeFile($thumbs[$_]); 
      }
    }
    log_it(lang('Ready!'));
  }
  else {
    $top->messageBox(-icon  => "info",
                     -message => "Found no outdated thumbnails in $thumbDB. Seems like your thumbnails are up to date.",
                     -title => "Thumbnail database is up to date", -type => 'OK');
  }
  return;
  # todo: remove empty dirs in $thumbDB ...
}

##############################################################
# cleanDir - remove all dirs and files added by mapivi from
#            the given dir
##############################################################
sub cleanDir {
  my $dir = shift;
  print "dir = $dir actdir = $actdir\n" if $verbose;
  return unless ((defined $dir) or (-d $dir));
  my $rc;
  if (($cleanDirLevel == 0) or (not $cleanDirNoAsk)) {
    my $dia = $top->DialogBox(-title => "Clean folder ".basename($dir)."?",
                              -buttons => ['OK', 'Cancel']);
    $dia->add("Label", -text => "Remove all sub folders and files from\n$dir\nwhich were created from Mapivi\nContinue?", -bg => $conf{color_bg}{value}, -justify => 'left')->pack;
    $dia->add("Checkbutton", -text => "Continue without asking again", -variable => \$cleanDirNoAsk)->pack;
    $rc  = $dia->Show();
    return if ($rc ne 'OK');
  }
  my @subdirs = ("$dir/$thumbdirname", "$dir/$exifdirname");
  foreach my $subdir (@subdirs) {
    if (-d $subdir) {
      my @fileDirList = readDir($subdir);
      unless ($cleanDirNoAsk) {
        $rc = $top->messageBox(-icon    => 'question',
        -message => "There are ".scalar @fileDirList." files in the sub folder\n".basename($subdir)."\nRemove?",
        -title => "Remove sub folder?",
        -type    => 'OKCancel');
        next if ($rc !~ m/Ok/i);
      }
      log_it("cleaning $subdir ...");
      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 (not $cleanDirNoAsk)) {
    $rc = $top->messageBox(-icon    => 'question',
                           -message => "There are $nr sub folders in\n$dir\n, should I clean them too?",
                           -title => "Clean sub folders?",
                           -type    => 'OKCancel');
    return if ($rc !~ m/Ok/i);
  }
  # recursive call of cleanDir()
  foreach (sort keys %dirh) {
    $cleanDirLevel++;
    cleanDir ("$dir/$_");
    $cleanDirLevel--;
  }
  if ($cleanDirLevel == 0) {
    log_it(lang('Ready!'));
  }
  return;
}

##############################################################
# 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, lang('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 => lang('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\"";
                    log_it("converting to JPEG format ...");
                    $top->Busy;
                    #(system "$command") == 0 or warn "convert: $! ($command)";
                    execute($command);
                    $top->Unbusy;
                    removeFile($tmpfile);
                    if ($conf{add_tool_info}{value}) {
                      addCommentToPic("Screenshot made with Mapivi $version ($mapiviURL)", $file, NO_TOUCH);
                    }
                    log_it(lang('Ready!'));
                    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.');

  my $xBut = $ButF->Button(-text => lang('Cancel'),
                -command => sub {
                  $scsw->withdraw();
                  $scsw->destroy();
                })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  bind_exit_keys_to_button($scsw, $xBut);
  $scsw->Popup;
  $scsw->waitWindow;
  return;
}

##############################################################
# drag keyword(s) from keyword tree or clipboard to picture(s)
##############################################################
sub drag_keyword {
  my ($w, $token) = @_;
  #my $w = $token->parent;	# $widget
  my $e = $w->XEvent;
  $w->update;
  my @sellist;
  # determine drag source widget
  # source: keyword tree
  if ($w == $nav_F->{key_frame}->{tree}) { #(ref($w) eq 'Tk::Tree') {
    print "drag_keyword: source: tree\n";
    @sellist = $w->info('selection');
  }
  # source: keyword clipboard
  # todo: ->{hot} should be a Tk::Listbox but it shows up as Tk::Frame, clarify why
  elsif ($w == $nav_F->{key_frame}->{hot}) { # (ref($w) eq 'Tk::Frame') {
    print "drag_keyword: source: frame (listbox)\n";
    foreach ($w->curselection()) {
      print "drag_keyword: adding $_: ".$w->get($_)."\n";
      push @sellist, $w->get($_);
    }
  }
  else {
    print "drag_keyword: unknown source widget ref($w)\n";
    return;
  }
  if (@sellist < 1) {
    print "drag_keyword: no selection\n";
    return;
  }
  # check selection
  # 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 keyword
    #if (!$w->info("exists", $sellist[0])) {
    print "drag_keyword: item $tokentext\n";
    #  return;
    #}
    $token->configure(-text => $tokentext);
    # store keyword in token
    $token->{keyword} = $tokentext;
    #log_it($tokentext);
  }
  # more than one pictures selected
  else {
    print "drag_keyword: please select just one keyword\n";
    return; 
    #$token->configure(-text => scalar @sellist." keywords");
  }
  # 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
  return;
}

##############################################################
# drop keywords on actual picture in canvas
##############################################################
sub drop_keyword {
  my ($w, $token) = @_;
  $token->withdraw;
  my (@pics, @keys);
  if (not defined $token->{keyword}) {
    print "drop_keyword: no keyword defined!\n";
    return;
  }
  push @keys, $token->{keyword};
  print "drop_keyword: \"$token->{keyword}\"\n";
  # add keyword to picture(s)
  if (($w == $picLB) or ($w == $c)) {
    # drop on thumbnail list
    if ($w == $picLB) {
      @pics = $picLB->info('selection');
    }
    # drop on canvas (actual picture)
    else {
      push @pics, $actpic;
    }
    print "drop_keyword: $token->{keyword} to picture(s)\n";
    add_keywords_to_pics($picLB, \@keys, \@pics);
  }
  elsif ($w == $nav_F->{key_frame}->{hot}) {
    print "drop_keyword: $token->{keyword} to hotlist\n";
    add_keyword_to_hotlist($nav_F->{key_frame}->{hot}, \@keys);
  }
  else {
    print "drop_keyword: error wrong widget $w\n";
  }
  return;
}

##############################################################
# dragFromPicLB - drag pictures from the thumb table
##############################################################
sub dragFromPicLB {
  my($token) = @_;
  my $w = $token->parent;	# $w is the $picLB hlist
  my @sellist = getSelection($w);
  my $e = $w->XEvent;
  my($x, $y) = ($e->X, $e->Y);
  # compare drag coordinates with press coords to distinguish picture dragging
  my ($mx, $my) = ($Tk::event->x(), $Tk::event->y());
  my $dx = $picLB->{lastx} - $mx; $dx *= -1 if ($dx < 0);
  my $dy = $picLB->{lasty} - $my; $dy *= -1 if ($dy < 0);
  #print "drag: diff $dx $dy  $mx $my last $picLB->{lastx} $picLB->{lasty}\n";
  if ($dx < 20 and $dy < 20) {
    #print "move to small\n";
    Tk->break;					# stop default binding of this event
    return;
  }
  #print "move OK\n";
  $w->update;
  if ($w->{DnDThumbnail}) {
    # clear memory from last drag
    $w->{DnDThumbnail}->delete;  # delete the photo object
    delete $w->{DnDThumbnail};   # delete the hash item
  }
  return unless checkSelection($w, 1, 0, \@sellist, lang("picture(s)"));
  #print "Drag from with ".scalar @sellist." selected pictures\n";
  if ($EvilOS) {
      log_it("copy or move ");
  } else {
      log_it("copy, link, or move ");
  }
  # only one picture selected
  if (@sellist == 1) {
    #my $dpic = $w->itemCget($sellist[0], 1, -text);
    my $dpic = $sellist[0];
    # Configure the dnd token to show the listbox entry
    if (!$w->info("exists", $sellist[0])) {
      print "dragFromPicLB: item not available\n";
      return;
    }
    my $icon = $dragAndDropIcon1;
    my $thumb = getThumbFileName($dpic);
    if (-f $thumb) {
      $w->{DnDThumbnail} = $top->Photo(-file => $thumb, -gamma => $config{Gamma});
      $icon = $w->{DnDThumbnail} if $w->{DnDThumbnail};
    }
    if ($icon) {
      $token->configure(-image => $icon);
    }
    else {
      $token->configure(-text => basname($dpic));
    }
    log_it('Drag and drop '.$dpic);
  }
  # more than one pictures selected
  # todo: generate a stack of the first two selected thumbnails using imagemagick as icon
  #       see e.g. http://www.imagemagick.org/Usage/montage/#index
  else {
    if ($dragAndDropIcon2) {
      $token->configure(-image => $dragAndDropIcon2);
    }
    else {
      $token->configure(-text => "  ".scalar @sellist." pictures");
    }
    log_it('Drag and drop '.scalar @sellist." pictures");
  }
  # Show the token
  $token->MoveToplevelWindow($x, $y);
  $token->raise;
  $token->deiconify;
  $token->FindSite($x, $y, $e);
  #Tk->break;					# stop default binding of this event
  return;
}

##############################################################
# dropToDirTree - drop pictures on the dirtree (copy or move)
##############################################################
sub dropToDirTree {
  $token->withdraw;
  log_it('');
  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;
  }
  return;
}

##############################################################
#dragAndDropExtern - todo
# 2009-08-27: This code works under Windows XP
##############################################################
sub dragAndDropExtern {
  my($widget, $selection) = @_;
  print "dragAndDropExtern\n";
  my $item;
  eval {
    if ($^O eq 'MSWin32') {
      $item = $widget->SelectionGet(-selection => $selection, 'STRING');
    } else {
      $item = $widget->SelectionGet(-selection => $selection, 'FILE_NAME');
    }
  };
  if (!defined $item) {
    log_it("Drag-and-drop: Sorry, filename is not defined!");
    print "dragAndDropExtern: filename is not defined!\n";
    return;
  }
  print "drop extern received: $item\n";
  # $top->messageBox(-icon    => 'warning',
                   # -message => "drop extern received: $item",
                   # -title   => "Drag and drop", -type => 'OK');
  # is the dropped item a file ....
  if (-f $item) {
    if (is_a_JPEG($item)) {
      showPic($item);
    }
    elsif (is_a_slideshow_file($item)) {
      # open collection (light table) window if needed
      light_table_open_window() unless (Exists($ltw));
      # add the pictures from the slideshow file to light table window
      light_table_open(ADD, $item);
    }
    else {
      log_it("Drag-and-drop: Sorry, only JPEG pictures are supported!");
      print "Sorry, only JPEG pictures are supported!\n";
    }
  }
  # ... or a directory?
  elsif (-d $item) {
    openDirPost($item);
  }
  else {
    log_it("Drag-and-drop: Sorry, $item is no dir and no file!");
    print "$item is no dir and no file\n";
  }
  return;
}

##############################################################
# light_table_dragAndDropExtern - todo
# 2009-08-27: This code works under Windows XP
##############################################################
sub light_table_dragAndDropExtern {
  my($widget, $selection) = @_;
  my $item;
  eval {
    if ($^O eq 'MSWin32') {
      $item = $widget->SelectionGet(-selection => $selection, 'STRING');
    } else {
      $item = $widget->SelectionGet(-selection => $selection, 'FILE_NAME');
    }
  };
  if (!defined $item) {
    log_it("Drag-and-drop: Sorry, filename is not defined!");
    print "dragAndDropExtern: filename is not defined!\n";
    return;
  }
  # is the dropped item a file ....
  if (-f $item) {
    if (is_a_JPEG($item)) {
      # open light table window if needed
      light_table_open_window();
      my @list;
      push @list, $item;
      light_table_add(\@list);
    }
    elsif (is_a_slideshow_file($item)) {
      # open light table window if needed
      light_table_open_window();
      # add the pictures from the slideshow file to light table window
      light_table_open(ADD, $item);
    }
    else {
      log_it("Drag-and-drop: Sorry, only JPEG pictures and slideshow files are supported!");
      print "Sorry, only JPEG pictures are supported!\n";
    }
  }
  # ... or a directory? todo
  #elsif (-d $item) {
    # todo: function not yet implemented; should add all pictures of a folder to the light box
    #light_table_add_folder($item);
  #}
  else {
    log_it("Drag-and-drop: Sorry, $item is no file!");
    print "$item is no dir and no file\n";
  }
  return;
}


##############################################################
# 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 | oct(200);         # set user write (+uw)
      return (chmod($mode, $dpic)); # try to change the mode
    }
    else {
      return 0;               # file is still write protected
    }
  }
}

##############################################################
# checkWriteableMulti
##############################################################
sub checkWriteableMulti {
  my @dpics = @_;
  my @protected = ();
  foreach (@dpics) {
    if ((-f $_) and (not -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 | oct(200);  # set user write (+uw)
      chmod($mode, $_);          # try to change the mode
    }
  }
  return $rc;
}

##############################################################
# set input focus on widget if mouse pointer enters the widget area
##############################################################
sub focus_on_enter {
  my $w = shift;
  # in Windows this causes troubles, because it moves the main window
  # in foreground and a sub window to background when the mouse pointer
  # leaves the sub window and touches the main window
  if (not $EvilOS) {
    $w->bind('<Enter>', sub { $w->focus; } );
  }
  return;
}

##############################################################
##############################################################
sub add_mousewheel_zoom {
  my $w = shift; # widget
  if ($EvilOS) {
    $w->CanvasBind('<Control-MouseWheel>' => sub { print "Ctrl-Mousewheel Windows\n"; } );
    #[ sub { $_[0]->yview('scroll', -($_[1] / 120) * 3, 'units') },
    #Ev('D') ]);
  }
  else {
    $w->CanvasBind('<Control-4>' => sub {
      print "Ctrl-Mousewheel Non-Windows up\n";
      #$_[0]->yview('scroll', -3, 'units') unless $Tk::strictMotif;
    });

    $w->CanvasBind('<Control-5>' => sub {
      print "Ctrl-Mousewheel Non-Windows down\n";
      #$_[0]->yview('scroll', +3, 'units') unless $Tk::strictMotif;
    });
  }
  return;
}
  
##############################################################
# 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, lang("picture(s)"));
  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
  log_it("creating difference picture ...");
  #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;
  log_it(lang('Ready!').' '.langf("Created difference picture %s.",basename($dpicDiff)));
  generateOneThumb($dpicDiff);
  # insert diff pic in listbox
  addOneRow($picLB, $dpicDiff, 1, $dpicA);
  #updateThumbs();
  showPic($dpicDiff);
  return;
}

##############################################################
# hdr_pic - generate a High Dynamic Range (HDR) Image from several pictures
# using external program luminance-hdr-cli
# luminance-hdr-cli -a AIS -o hdr.jpg -q 90 Bil1.jpg Bild2.jpg Bild3.jpg
##############################################################
sub hdr_pic {
  my @sellist = $picLB->info('selection');
  return if (!checkExternProgs('hdr_pic', 'luminance-hdr-cli'));
  return unless checkSelection($top, 2, 10, \@sellist, lang('picture(s)'));
  my $selected = @sellist;
  my ($basename,$dir,$suffix) = fileparse($sellist[0], '\.[^.]*'); # suffix = . and not-.  (one dot and zero or more non-dots)
  # Build outfile name
  my $outfile = $dir.$basename.'HDR'.$suffix;
  $outfile = $dir.findNewName($outfile) if (-f $outfile);
  log_it("Buildung a High Dynamic Range (HDR) image from $selected pictures. May take a while ...");
  # check if some files are links
  return if (!checkLinks($picLB, @sellist));
  my $input_files = join( " ", @sellist );
  # align input pictures with AIS, output picture JPEG quality 90%
  # todo: add a dialog to select parameters 
  my $command = "luminance-hdr-cli -a AIS -o $outfile -q 90 $input_files";
  if (not $EvilOS) {
    execute($command);
  }
  else { # else we run in a timeout
    (system "$command") == 0 or warn "High Dynamic Range Picture: $command failed: $!";
  }
  if (-f $outfile) {
    addProcessInfoToPicComment($command, $outfile);
    generateOneThumb($outfile);
    # insert $outfile in listbox
    addOneRow($picLB, $outfile, 1, $sellist[0]);
    showPic($outfile);
    log_it("ready! (Created $outfile from $selected pictures)");
  }
  else {
    log_it("Error: Could not create $outfile!");
  }
  return;
}

##############################################################
# addProcessInfoToPicComment
##############################################################
sub addProcessInfoToPicComment {
  my $info = shift;
  my $dpic = shift;
  if ($conf{add_tool_info}{value}) {
      $info =~ s/\"//g; # remove double quotes
      $info = "Picture processed by Mapivi $version ($mapiviURL):\n".$info;
      addCommentToPic($info, $dpic, NO_TOUCH);
  }
  return;
}

##############################################################
# fuzzyBorder - add a fuzzy border to the selected pics
##############################################################
sub fuzzyBorder {
  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));
  my $selected = @sellist;
  return if (!fuzzyBorderDialog());
  my $frame = "$trashdir/framePic.miff"; # we need MIFF or PNG because of the alpha channel
  removeFile($frame);
  return if (!checkExternProgs("fuzzyBorder", "convert", "composite"));
  log_it(langf("Adding fuzzy border to %d pictures",$selected));
  # check if some files are links
  return if (!checkLinks($picLB, @sellist));
  my $pw = progressWinInit($top, lang("Adding fuzzy border"));
  my $i = 0;
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    progressWinUpdate($pw, lang("creating border")." ($i/$selected) ...", $i, $selected);
    next if (!checkWriteable($dpic));
    next if (!makeBackup($dpic));
    # get size of pic
    my ($x, $y) = getSize($dpic);
    my $min = min($x, $y); # shortest picture side
    my $bw = $config{FuzzyBorderWidth};
    my $blur = $config{FuzzyBorderBlur};
    if ($config{FuzzyBorderRelative}) {
      $bw = round($min*$bw/100);
      $blur = round($min*$blur/100);
    }
    # create an empty picture with a fuzzy frame
    my $command = "convert -size ${x}x${y} xc:none -fill ".$config{FuzzyBorderColor}." ";
    # 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".$blur." \"$frame\" ";
    if (not $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, lang("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 (not $EvilOS) {
      execute($command);
    }
    else { # else we run in a timeout
      (system "$command") == 0 or warn "fuzzy frame: $command failed: $!";
    }
    $i++;
    progressWinUpdate($pw, lang("adding process info")." ($i/$selected) ...", $i, $selected);
    addProcessInfoToPicComment($command, $dpic);
    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);
  log_it(langf("Added fuzzy border to %d of %d pictures.",$i,$selected));
  generateThumbs(ASK, SHOW);
  return;
}

##############################################################
# fuzzyBorderDialog
##############################################################
sub fuzzyBorderDialog {
  if (Exists($fuzzybw)) {
    $fuzzybw->deiconify;
    $fuzzybw->raise;
    return;
  }
  my $rc = 0;
  my $bwf; # border width frame with labeled scale
  my $brf; # blur radius frame with labeled scale
  # open window
  $fuzzybw = $top->Toplevel();
  $fuzzybw->title(lang("Fuzzy border"));
  $fuzzybw->iconimage($mapiviicon) if $mapiviicon;
  $fuzzybw->Radiobutton(-text => lang("use absolute value (pixel)"), -variable => \$config{FuzzyBorderRelative}, -value => 0, -command => sub {
    $config{FuzzyBorderWidth} = 10;
    $config{FuzzyBorderBlur} = 10;
    $bwf->{scale}->configure(-from => 1, -to => 200, -resolution => 1);
    $brf->{scale}->configure(-from => 1, -to => 200, -resolution => 1);})->pack(-anchor => 'w');
  $fuzzybw->Radiobutton(-text => lang("use relative value (%)"), -variable => \$config{FuzzyBorderRelative}, -value => 1,  -command => sub {
    $config{FuzzyBorderWidth} = 1;
    $config{FuzzyBorderBlur} = 1;
    $bwf->{scale}->configure(-from => 0.1, -to => 50, -resolution => 0.1);
    $brf->{scale}->configure(-from => 0.1, -to => 50, -resolution => 0.1);})->pack(-anchor => 'w');
  my $from = 1; my $to = 200; my $res = 1;
  if ($config{FuzzyBorderRelative}) { $from = 0.1; $to = 50; $res = 0.1; }
  $bwf = labeledScale($fuzzybw, 'top', 23, lang("Border width"), \$config{FuzzyBorderWidth}, $from, $to, $res);
  $brf = labeledScale($fuzzybw, 'top', 23, lang("Blur radius"), \$config{FuzzyBorderBlur}, $from, $to, $res);
  labeledEntryColor($fuzzybw,'top',23,lang("Border color"),'Set',\$config{FuzzyBorderColor});
  my $qS = labeledScale($fuzzybw, 'top', 23, lang("Quality of picture (%)"), \$config{PicQuality}, 10, 100, 1);
  qualityBalloon($qS);
  buttonBackup($fuzzybw, 'top');
  buttonComment($fuzzybw, 'top');
  my $presetF = $fuzzybw->Frame()->pack(-anchor => 'w', -padx => 3, -pady => 3);
  $presetF->Label(-text => lang('Presets'))->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  foreach my $preset (0.5,1,2,5) {
    $presetF->Button(-text => $preset.'%',
                     -command => sub {
                       $config{FuzzyBorderRelative} = 1;
                       $config{FuzzyBorderWidth} = $preset;
                       $config{FuzzyBorderBlur} = $preset;
                     })->pack(-side => 'left', -padx => 3, -pady => 3);
  }
  my $ButF = $fuzzybw->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
  my $OKB =	$ButF->Button(-text => lang('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 => lang('Cancel'),
                           -command => sub { $rc = 0;
                                             $fuzzybw->withdraw();
                                             $fuzzybw->destroy();
                                           })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  bind_exit_keys_to_button($fuzzybw, $Xbut);
  $fuzzybw->Popup;
  $fuzzybw->waitWindow;
  return $rc;
}

##############################################################
# losslessBorder - add a frame to the selected pics without
#                  recompressing the picture
##############################################################
sub losslessBorder {
  my $mode = shift;   # PIXEL, ASPECT_RATIO, RELATIVE (%)
  # check if jpegtran supports lossless dropping
  my $usage = `jpegtran -? 2>&1`;
  if ($usage !~ m/.*-drop.*/) {
      $top->messageBox(-icon  => 'warning', -message => "Sorry, but your version of jpegtran does not support lossless dropping!\nTry to get jpegtran with the lossless drop patch from http://jpegclub.org.",
                       -title => "Wrong jpegtran version", -type => 'OK');
      return;
  }

  return if (!checkExternProgs("losslessBorder", "convert"));

  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));
  my $selected = @sellist;
  my $aspectdelta = 1 + ($config{AspectSloppyFactor} / 100);  # delta factor for aspect ratio
  my $info = '';

  my $bix = 0; # inner width X
  my $biy = 0; # inner width Y
  my $bwx = 0; # complete width X
  my $bwy = 0; # complete width Y

  if ($mode == PIXEL) {
    my ($w, $h) = getSize($sellist[0]); # get size of first picture
    return if (!losslessBorderDialogPixel($w, $h));
    $bix = $config{llBorderWidthIX}; # inner width X
    $biy = $config{llBorderWidthIY}; # inner width Y
    $bwx = $config{llBorderWidthX};  # complete width X
    $bwy = $config{llBorderWidthY};  # complete width Y
    # no frame width-> nothing to do.
    return if ($bwx == 0 and $bwy == 0);
  }
  elsif ($mode == ASPECT_RATIO) {
    return if (!losslessBorderDialogAspect());
  }
  elsif ($mode == RELATIVE) {
    return if (!losslessBorderDialogRelative());
  }
  else {
    warn "Sorry mode $mode is not supported!";
    return;
  }

  my $frame = "$trashdir/framePic.jpg";
  if (-f $frame) {
    warn "file $frame exists! Please delete it first!";
    return;
  }

  log_it("adding lossless border to $selected pictures");

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

  my $pw = progressWinInit($top, "Adding lossless border");
  my $i = 0;
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    $i++;
    progressWinUpdate($pw, "adding border ($i/$selected) ...", $i, $selected);

    if ($mode == ASPECT_RATIO) {
      # get size of dpic
      my ($w, $h) = getSize($dpic);
      my $n = $config{AspectBorderN};
      my $m = $config{AspectBorderM};

      # skip pictures which have (nearly) the right aspect ratio (either n/m or m/n)
      # and be a little bit sloppy about this (aspectdelta)      
      if (((($w/$h) <= ($n/$m)*$aspectdelta) and (($w/$h) >= ($n/$m)/$aspectdelta)) or
         ((($w/$h) <= ($m/$n)*$aspectdelta) and (($w/$h) >= ($m/$n)/$aspectdelta))) {
         $info .= "$dpic has correct aspect ratio - skipping\n";
         next;
      }

      if ($w > $h) { # landscape picture
        if ($w > $h*$n/$m) { # panorama picture (too wide)
          $bwx = 0;
          $bwy = int(($w*$m/$n -$h)/2);
        }
        elsif ($w < $h*$n/$m) { # too narrow
          $bwx = int(($h*$n/$m -$w)/2);
          $bwy = 0;
        }
        else { # already right aspect ratio
          next;
        }
      }
      else { # portrait and square picture
        if ($w > $h*$m/$n) { # panorama picture (too small)
          $bwx = 0;
          $bwy = int(($w*$n/$m -$h)/2);
        }
        elsif ($w < $h*$m/$n){ # too tall
          $bwx = int(($h*$m/$n -$w)/2);
          $bwy = 0;
        }
        else { # already right aspect ratio
          $info .= "$dpic has correct aspect ratio - skipping\n";
          next;
        }
      }
      # we need 16 pixel steps for the complete border width
      $bwx = sprintf("%.0f", $bwx / 16) * 16; # int() does not round!
      $bwy = sprintf("%.0f", $bwy / 16) * 16;

    }

    # add a border relative to the picture size
    if ($mode == RELATIVE) {
      # get size of dpic
      my ($w, $h) = getSize($dpic);
      
      # we need 16 pixel steps for the complete border width
      $bwx = sprintf("%.0f",($config{RelativeBorderX}  * $w / (100 * 16))) * 16; # int() does not round!
      $bwy = sprintf("%.0f",($config{RelativeBorderY}  * $h / (100 * 16))) * 16;

      if (($bwx == 0) and ($bwy == 0)) {
         $info .= "$dpic border would be 0 pixel - skipping\n";
         next;
      }

      $bix = sprintf("%.0f",($config{RelativeBorderIX} * $w / 100));
      $biy = sprintf("%.0f",($config{RelativeBorderIY} * $h / 100));

      # correction: add at least one pixel
      #$bwx = 1 if ($config{RelativeBorderX}  > 0 and $bwx == 0);
      #$bwy = 1 if ($config{RelativeBorderY}  > 0 and $bwy == 0);
      $bix = 1 if ($config{RelativeBorderIX} > 0 and ($bix == 0));
      $biy = 1 if ($config{RelativeBorderIY} > 0 and ($biy == 0));
      
      if ($config{RelativeBorderEqual}) {
        $bix = $biy if ($biy > $bix);
        $biy = $bix;
        $bwx = $bwy if ($bwy > $bwx);
        $bwy = $bwx;
      }
    }

    next if (!checkWriteable($dpic));
    next if (!makeBackup($dpic));
    
    # approach 1:
    # create an empty picture with a frame
    # this is the better approach as a new background is generated, but something with the color resolution(?) is wrong
    # because when the other picture is dropped on this one jpegtran changes the whole picture to grayscale
    #my $command = "convert -size ${cx}x${cy} xc:\"".$config{llBorderColor}."\" -fill \"".$config{llBorderColorI}."\" ";
    #$command .= "-draw \'rectangle $r1,$r1 $rx2,$ry2\' -quality 95 \"$frame\" ";

    # approach 2:
    # add a lossy frame to the original picture
    # not the fastes way, but it works
    my $box = $bwx - $bix; # outer border width
    my $boy = $bwy - $biy; # outer border width

    #print "losslessBorder: bwx $bwx bwy $bwy box $box boy $boy bix $bix biy $biy\n";

    my $command = "convert ";
    $command .= "-bordercolor \"".$config{llBorderColorI}."\" -border ${bix}x${biy} " if (($bix > 0) or ($biy > 0));
    $command .= "-bordercolor \"".$config{llBorderColor}."\" -border ${box}x${boy} -quality 95 \"$dpic\" \"$frame\" ";
    execute($command);

    unless (-f $frame) {
      $info .= "$dpic: could not create lossless border - skipping\n";
      next;
    }

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

    # drop the picture lossless! on top of the frame
    # no recompression of the picture!
    $command = "jpegtran -copy all -drop +${bwx}+${bwy} \"$dpic\" -outfile \"$dpic\" \"$frame\" ";
    execute($command);

    addProcessInfoToPicComment($command, $dpic);
    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);
  log_it("ready! (added lossless border to $i of $selected)");
  if ($info ne '') {
    showText('Add Border Information', $info, NO_WAIT);
  }
  generateThumbs(ASK, SHOW);
  return;
}

##############################################################
# losslessBorderDialogPixel
##############################################################
sub losslessBorderDialogPixel {

  my $w = shift;  # pixel size of first selected picture for preview
  my $h = shift;

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

  my $min = min($w, $h); # shortest picture side

  # copy the config values to an hash for easy handling
  my %border;
  $border{out}{x} = $config{llBorderWidthX};
  $border{out}{y} = $config{llBorderWidthY};
  $border{out}{c} = $config{llBorderColor};
  $border{in}{x}  = $config{llBorderWidthIX};
  $border{in}{y}  = $config{llBorderWidthIY};
  $border{in}{c}  = $config{llBorderColorI};

  my $rc = 0;
  my $preview_size = 200;
  my $c; # canvas
  
  # open window
  $ll_b_w = $top->Toplevel();
  $ll_b_w->title(lang("Add lossless border"));
  $ll_b_w->iconimage($mapiviicon) if $mapiviicon;

  my $fb  = $ll_b_w->Frame(-relief => 'groove')->pack(-fill => 'x', -padx => 6, -pady => 6);
  $fb->Label(-text => "Border size and color")->pack(-fill => 'x', -padx => 3, -pady => 3);
  $balloon->attach($fb, -msg => "This is the overall width of the border in x- and y-direction.\nAs JPEGs are organized in 8 or 16 pixel blocks only 16 pixel-steps are allowed.\nUse the add-border function if you need other sizes.");
  labeledScale($fb, 'top', 35, "Overall border width x-direction", \$border{out}{x}, 0, 1000, 16, sub {$border{in}{x} = $border{out}{x} if ($border{in}{x} > $border{out}{x});draw_preview($c, $preview_size, $w, $h, \%border);});
  labeledScale($fb, 'top', 35, "Overall border width y-direction", \$border{out}{y}, 0, 1000, 16, sub {$border{in}{y} = $border{out}{y} if ($border{in}{y} > $border{out}{y});draw_preview($c, $preview_size, $w, $h, \%border);});
  my $bordercolor = labeledEntryColor($fb,'top',35,"Border color",'Set',\$border{out}{c});

  my $fbi = $ll_b_w->Frame(-relief => 'groove')->pack(-fill => 'x', -padx => 6, -pady => 6);
  $fbi->Label(-text => "Inner border (optional) size and color")->pack(-fill => 'x', -padx => 3, -pady => 3);
  $balloon->attach($fbi, -msg => "This is the width of the inner border in x- and y-direction.\nSet to 0 for no inner border.");
  labeledScale($fbi, 'top', 35, "Border width x-direction", \$border{in}{x}, 0, 1000, 1, sub { $border{in}{x} = $border{out}{x} if ($border{in}{x} > $border{out}{x}); draw_preview($c, $preview_size, $w, $h, \%border); });
  labeledScale($fbi, 'top', 35, "Border width y-direction", \$border{in}{y}, 0, 1000, 1, sub {$border{in}{y} = $border{out}{y} if ($border{in}{y} > $border{out}{y}); draw_preview($c, $preview_size, $w, $h, \%border);});
  my $ibordercolor = labeledEntryColor($fbi,'top',35,"Border color",'Set',\$border{in}{c});

  # lower frame with left and right sub frame
  my $lf = $ll_b_w->Frame()->pack(-fill => 'x', -padx => 0, -pady => 0);
  my $lf_left = $lf->Frame()->pack(-side => 'left', -fill => 'x', -padx => 0, -pady => 0);
  my $lf_right = $lf->Frame()->pack(-side => 'right', -fill => 'x', -padx => 0, -pady => 0);
  
  buttonBackup($lf_left, 'top');
  buttonComment($lf_left, 'top');
  
  my $rel_border = sprintf("%.0f",($min*5/100)); # preset border width in %
  # todo: replace preset buttons by a loop canvas buttons and generate icon using draw_preview()
  my $preF = $lf_left->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
  $preF->Label(-text => 'Presets ')->pack(-side => 'left');
  $preF->Button(-image => $mapivi_icons{'Frame-bw'}, #-text => '2 White-Black',
                -command => sub {
    $border{out}{x} = $rel_border;
    $border{out}{y} = $rel_border;
    $border{out}{c} = 'white';
    $border{in}{x}  = 1;
    $border{in}{y}  = 1;
    $border{in}{c}  = 'black';
    $bordercolor->{button}->configure(-bg => $border{out}{c});
    $ibordercolor->{button}->configure(-bg => $border{in}{c});
    draw_preview($c, $preview_size, $w, $h, \%border);
  })->pack(-side => 'left', -padx => 3);

  $preF->Button(-image => $mapivi_icons{'Frame-wb'}, #-text => '1 Black-White',
                -command => sub {
    $border{out}{x} = $rel_border;
    $border{out}{y} = $rel_border;
    $border{out}{c} = 'black';
    $border{in}{x}  = 1;
    $border{in}{y}  = 1;
    $border{in}{c}  = 'white';
    $bordercolor->{button}->configure(-bg => $border{out}{c});
    $ibordercolor->{button}->configure(-bg => $border{in}{c});
    draw_preview($c, $preview_size, $w, $h, \%border);
  })->pack(-side => 'left', -padx => 3);

  $preF->Button(-image => $mapivi_icons{'Frame-wbp'}, #-text => '3 Pano White-Black',
                -command => sub {
    $border{out}{x} = 0;
    $border{out}{y} = $rel_border;
    $border{out}{c} = 'black';
    $border{in}{x}  = 0;
    $border{in}{y}  = 1;
    $border{in}{c}  = 'white';
    $bordercolor->{button}->configure(-bg => $border{out}{c});
    $ibordercolor->{button}->configure(-bg => $border{in}{c});
    draw_preview($c, $preview_size, $w, $h, \%border);
  })->pack(-side => 'left', -padx => 3);

  $preF->Button(-image => $mapivi_icons{'Frame-bwp'}, #-text => '4 Pano Black-White',
                -command => sub {
    $border{out}{x} = 0;
    $border{out}{y} = $rel_border;
    $border{out}{c} = 'white';
    $border{in}{x}  = 0;
    $border{in}{y}  = 1;
    $border{in}{c}  = 'black';
    $bordercolor->{button}->configure(-bg => $border{out}{c});
    $ibordercolor->{button}->configure(-bg => $border{in}{c});
    draw_preview($c, $preview_size, $w, $h, \%border);
  })->pack(-side => 'left', -padx => 3);

  # preview 
  $c = $lf_right->Canvas(-width => $preview_size, -height => $preview_size, -borderwidth => 0, -highlightthickness => 0, -relief => 'flat')->pack();
  # draw preview
  draw_preview($c, $preview_size, $w, $h, \%border);

  my $font = $top->Font(-family => $config{FontFamily}, -size => 10, -weight => 'bold');
  $c->createText(100,100, -text => 'Picture', -fill => 'black', -font => $font, -anchor => 'c');
  
  my $ButF = $ll_b_w->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);

  my $OKB =	$ButF->Button(-text => lang('OK'),
                          -command => sub {
			    $config{llBorderWidthX} = $border{out}{x};
			    $config{llBorderWidthY} = $border{out}{y};
			    $config{llBorderColor} = $border{out}{c};
			    $config{llBorderWidthIX} = $border{in}{x};
			    $config{llBorderWidthIY} = $border{in}{y};
			    $config{llBorderColorI} = $border{in}{c};
                            $ll_b_w->withdraw();
                            $ll_b_w->destroy();
                            $rc = 1;
                          })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $ButF->Button(-text => lang('Preview'),
        -command => sub {
                       border_preview($w, $h, \%border);
                      })->pack(-side => 'left', -padx => 3, -pady => 3);

  $ButF->Button(-text => lang('Help'),
                -command => sub {
                 showText('Help for lossless border',
                 "This function can be used to add a border to a JPEG without losing quality due to recompressing.\n\nHow it works:\nIt will first create a background with the border and then drop the original picture on top of it. The picture is not recompressed and thus every pixel stays exactly the same. The tool jpegtran with the lossless drop patch is used for this task. See http://jpegclub.org.\n\nYou can verify this by adding a border to a picture (don't forget to save the original picture by selecting \"Create Backup\") then you crop the border away and compare the original and the processed picture e.g. using the Mapivi function \"build difference picture\". If the resulting difference picture is complety black no pixel was changed.\nYou may check this again with a lossy border to see the differences.", 
                 NO_WAIT);
                })->pack(-side => 'left', -expand => 0, -padx => 3, -pady => 3);

  my $Xbut = $ButF->Button(-text => lang('Cancel'),
                           -command => sub { $rc = 0;
                                             $ll_b_w->withdraw();
                                             $ll_b_w->destroy();
                                           })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  bind_exit_keys_to_button($ll_b_w, $Xbut);
  $ll_b_w->Popup;
  $ll_b_w->waitWindow;
  return $rc;
}

##############################################################
# border_preview - quick preview in correct proportions, but
#                  without rescaling the real picture (would
#                  take too much time).
##############################################################
sub border_preview {
  my $w = shift; # picture size
  my $h = shift;
  my $b = shift; # border hash ref
  #my $c; # Canvas

  unless (Exists($bpw)) {
    # open window
    $bpw = $top->Toplevel();
    $bpw->title('Border Preview');
    $bpw->iconimage($mapiviicon) if $mapiviicon;

    my $fa = $bpw->Frame(-relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3);

    $bpw->{c} = $fa->Canvas(-width  => 100,
                     -height => 100,
             -background => 'gray',
             -relief => 'sunken',
             )->pack(-padx => 3, -pady => 3);

    my $Xbut = $bpw->Button(-text => lang('Close'),
                        -command => sub { $bpw->withdraw();
                          $bpw->destroy();
           })->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  }

  $bpw->deiconify;
  $bpw->raise;

  my $per = 0.8; # preview canvas should be 80% of the min screen size
  my $preview_size = int($per * $top->screenwidth);
  $preview_size = int($per * $top->screenheight) if ($top->screenheight < $top->screenwidth);
  
  my ($scale, $w_all, $h_all) = calc_preview_scale($preview_size, $w, $h, $$b{out}{x}, $$b{out}{y});
  
  # resize canvas
  $bpw->{c}->configure(-width  => sprintf("%.0f",($w_all*$scale)),
                -height => sprintf("%.0f",($h_all*$scale)),);

  # draw preview
  draw_preview($bpw->{c}, $preview_size, $w, $h, $b);
  return;
}

##############################################################
##############################################################
sub calc_preview_scale {
  my ($preview_size, $w, $h, $bx, $by) = @_; 

  my $w_all = $w + 2 * $bx; # complete width
  my $h_all = $h + 2 * $by; # complete height

  my $max_side = $w_all; $max_side = $h_all if ($h_all > $w_all); # longest side
  if ($max_side == 0) { warn "border_preview: Error max_side = $max_side"; return; }
  
  my $scale = $preview_size / $max_side;
  
  $scale = 1 if ($scale > 1); # we don't want to magnify small pictures
  return ($scale, $w_all, $h_all);
}

##############################################################
##############################################################
sub draw_preview {
  my $c = shift; # canvas widget
  my $preview_size = shift;
  my $w = shift; # picture size
  my $h = shift;
  my $b = shift; # border hash ref
  
  my ($scale, $w_all, $h_all) = calc_preview_scale($preview_size, $w, $h, $$b{out}{x}, $$b{out}{y});

  # clear canvas
  $c->delete('all');
  
  # outer border
  $c->createRectangle( 0, 0, sprintf("%.0f",($w_all*$scale)), sprintf("%.0f",($h_all*$scale)),
               -fill => $$b{out}{c},
                       -width => 0,
                 );

  # calc picture coordinates
  my $px1 = sprintf("%.0f",($$b{out}{x}*$scale));
  my $py1 = sprintf("%.0f",($$b{out}{y}*$scale));
  my $px2 = sprintf("%.0f",(($$b{out}{x}+$w)*$scale));
  my $py2 = sprintf("%.0f",(($$b{out}{y}+$h)*$scale));

# inner border
  if (($$b{in}{x} > 0) or ($$b{in}{y} > 0)) {
    my $ix1 = sprintf("%.0f",(($$b{out}{x}-$$b{in}{x})*$scale));
    my $iy1 = sprintf("%.0f",(($$b{out}{y}-$$b{in}{y})*$scale));
    my $ix2 = sprintf("%.0f",(($$b{out}{x}+$w+$$b{in}{x})*$scale));
    my $iy2 = sprintf("%.0f",(($$b{out}{y}+$h+$$b{in}{y})*$scale));
    # adjust picture coordinates to show at least a one pixel wide inner border,
    # even if scaling should hide it
    $px1++ if (($px1 == $ix1) and ($$b{in}{x} > 0));
    $px2-- if (($px2 == $ix2) and ($$b{in}{x} > 0));
    $py1++ if (($py1 == $iy1) and ($$b{in}{y} > 0));
    $py2-- if (($py2 == $iy2) and ($$b{in}{y} > 0));
    # draw inner frame as block on top of outer frame
    $c->createRectangle( $ix1, $iy1, $ix2, $iy2, -fill => $$b{in}{c}, -width => 0);
  }

  # draw picture as gray block on top of frame blocks
  $c->createRectangle($px1 , $py1, $px2, $py2, -fill => 'gray50', -width => 0);
  
  # picture text
  my $font_size = 50;
  my $font = $top->Font(-family => $config{FontFamily}, -size => $font_size, -weight => 'bold');
  my $id = $c->createText(int(($$b{out}{x}+$w/2)*$scale), int(($$b{out}{y}+$h/2)*$scale), -text => 'Picture', -fill => 'black', -font => $font, -anchor => 'c');
  fit_text($c, $id, $config{FontFamily}, $font_size, 'bold', sprintf("%.0f",($w*$scale)));
  return;
}

##############################################################
# shrink font size until text fits into a certain width, delete text if it doesn't fit with smallest font size
##############################################################
sub fit_text {
  my $c = shift; # canvas widget
  my $id = shift; # canvas id of text
  my $font_fam = shift;
  my $font_size = shift; # start size
  my $weight = shift;
  my $w = shift; # max width to fit into
  # get coordintes of text box to check if the font size fits into the circle
  my ($tx1, $ty1, $tx2, $ty2) = $c->bbox($id);
  while ($tx2 - $tx1 >= $w) {
    # decrease font size until minimum of 8pt
    $font_size -= 2;
    if ($font_size < 8) {
      $c->delete($id); # then delete text
      last;
    }
    my $font = $c->Font(-family => $font_fam, -size => $font_size, -weight => $weight);
    $c->itemconfigure($id, -font => $font);
    # measure new text box size
    ($tx1, $ty1, $tx2, $ty2) = $c->bbox($id);
  }
  return;
}

##############################################################
# losslessBorderDialogRelative
##############################################################
sub losslessBorderDialogRelative {

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

  my $rc   = 0;

  # open window
  $ll_r_w = $top->Toplevel();
  $ll_r_w->title("Add relative border (lossless)");
  $ll_r_w->iconimage($mapiviicon) if $mapiviicon;

  my $fb  = $ll_r_w->Frame(-relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3);
  $balloon->attach($fb, -msg => "This is the overall width of the border in x- and y-direction.\nAs JPEGs are organized in 8 or 16 pixel blocks only 16 pixel-steps are allowed.\nUse the add-border function if you need other sizes.");
  my $fbi = $ll_r_w->Frame(-relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3);
  $balloon->attach($fbi, -msg => "This is the width of the inner border in x- and y-direction.\nSet to 0 for no inner border.");
  labeledScale($fb, 'top', 37, "Complete border width x-direction (%)", \$config{RelativeBorderX}, 0, 100, 0.1);
  labeledScale($fb, 'top', 37, "Complete border width y-direction (%)", \$config{RelativeBorderY}, 0, 100, 0.1);
  labeledEntryColor($fb,'top',37,"Border color",'Set',\$config{llBorderColor});
  labeledScale($fbi, 'top', 37, "Inner border width x-direction (%)", \$config{RelativeBorderIX}, 0, 100, 0.01);
  labeledScale($fbi, 'top', 37, "Inner border width y-direction (%)", \$config{RelativeBorderIY}, 0, 100, 0.01);
  labeledEntryColor($fbi,'top',37,"Inner border color",'Set',\$config{llBorderColorI});

  $ll_r_w->Checkbutton(-text => 'Symmetric border (biggest wins)', -variable => \$config{RelativeBorderEqual})->pack(-anchor => 'w', -padx => 5, -pady => 5);

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

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

  my $OKB =	$ButF->Button(-text => lang('OK'),
                          -command => sub {
                            # some checks
                            if (($config{RelativeBorderIX} > $config{RelativeBorderX}) or
                                ($config{RelativeBorderIY} > $config{RelativeBorderY})) {
                                $ll_r_w->messageBox(-icon => 'warning',
                                  -message => 'The inner border must be smaller than the complete border.',
                                  -title => 'Lossess border - Error', -type => 'OK');
                                return;
                            }
                            $ll_r_w->withdraw();
                            $ll_r_w->destroy();
                            $rc = 1;
                          })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $ButF->Button(-text => lang('Help'),
                -command => sub {
                 showText('Help for relative border (lossless)',
                 "This function can be used to add a border to a JPEG without losing quality due to recompressing.\nThe actual border width in pixel will be calculated depending on the picture size. As JPEGs are organized in 8 or 16 pixel blocks the complete border width will be in 16 pixel-steps.\nThe inner border may be have any width, set it to 0 to have just one frame. If the inner border is bigger than 0, then it will be at least one pixel.\n\nHow it works:\nIt will first create a background with the border and then drop the original picture on top of it. The picture is not recompressed and thus every pixel stays exactly the same. The tool jpegtran with the lossless drop patch is used for this task. See http://jpegclub.org.\n\nYou can check this by adding a border to a picture (don't forget to save the original picture by selecting \"Create Backup\") then you crop the border away and compare the original and the processed picture using the Mapivi function \"build difference picture\". If the resulting difference picture is complety black no pixel was changed.\nYou may check this again with a lossy border to see the differences.", 
                 NO_WAIT);
                })->pack(-side => 'left', -expand => 0, -padx => 3, -pady => 3);

  my $Xbut = $ButF->Button(-text => lang('Cancel'),
                           -command => sub { $rc = 0;
                                             $ll_r_w->withdraw();
                                             $ll_r_w->destroy();
                                           })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  bind_exit_keys_to_button($ll_r_w, $Xbut);
  $ll_r_w->Popup;
  $ll_r_w->waitWindow;
  return $rc;
}

##############################################################
# losslessBorderDialogAspect
##############################################################
sub losslessBorderDialogAspect {

  if (Exists($ll_a_w)) {
    $ll_a_w->deiconify;
    $ll_a_w->raise;
    return;
  }
  my $rc   = 0;
  # open window
  $ll_a_w = $top->Toplevel();
  $ll_a_w->title("Add border to aspect ratio (lossless)");
  $ll_a_w->iconimage($mapiviicon) if $mapiviicon;
  
  my $oF = $ll_a_w->Frame(-relief => 'groove')->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  $oF->Label(-text => 'Aspect ratio ')->pack(-side => 'left', -padx => 3, -pady => 3);
  $oF->Entry(-textvariable => \$config{AspectBorderN}, -width => 5, -justify => 'right')->pack(-side => 'left', -padx => 3, -pady => 3);
  $oF->Label(-text => ':')->pack(-side => 'left', -padx => 3, -pady => 3);
  $oF->Entry(-textvariable => \$config{AspectBorderM}, -width => 5)->pack(-side => 'left', -padx => 3, -pady => 3);
  #labeledEntry($oF,'left',17,': Aspect ratio M',\$config{AspectBorderM});

  my $aF = $ll_a_w->Frame(-relief => 'groove')->pack(-padx => 3, -pady => 3);
  $aF->Label(-text => 'Presets')->pack();
  $aF->Button(-text => "3:2 (e.g. 10x15)", -anchor => 'w',
              -command => sub { $config{AspectBorderN} = 3; $config{AspectBorderM} = 2; }
             )->pack(-anchor => 'w', -fill => 'x', -padx => 3, -pady => 3);
  $aF->Button(-text => "4:3", -anchor => 'w',
              -command => sub { $config{AspectBorderN} = 4; $config{AspectBorderM} = 3; }
             )->pack(-anchor => 'w', -fill => 'x', -padx => 3, -pady => 3);  
  $aF->Button(-text => "5:4 (PAL)", -anchor => 'w',
              -command => sub { $config{AspectBorderN} = 5; $config{AspectBorderM} = 4; }
             )->pack(-anchor => 'w', -fill => 'x', -padx => 3, -pady => 3); 
  $aF->Button(-text => "7:5 (e.g. 13x18)", -anchor => 'w',
              -command => sub { $config{AspectBorderN} = 7; $config{AspectBorderM} = 5; }
             )->pack(-anchor => 'w', -fill => 'x', -padx => 3, -pady => 3);
  $aF->Button(-text => "16:9", -anchor => 'w',
              -command => sub { $config{AspectBorderN} = 16; $config{AspectBorderM} = 9; }
             )->pack(-anchor => 'w', -fill => 'x', -padx => 3, -pady => 3);
  $aF->Button(-text => "1:1", -anchor => 'w',
              -command => sub { $config{AspectBorderN} = 1; $config{AspectBorderM} = 1; }
             )->pack(-anchor => 'w', -fill => 'x', -padx => 3, -pady => 3);

  labeledEntryColor($ll_a_w,'top',12,'Border color','Set',\$config{llBorderColor});

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

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

  my $OKB =	$ButF->Button(-text => lang('OK'),
                          -command => sub {
                            # some checks
                            if (($config{AspectBorderM} !~ m|^\d+$|) or  # must be an integer
                                ($config{AspectBorderN} !~ m|^\d+$|)) {
                                $ll_a_w->messageBox(-icon => 'warning',
                                  -message => 'Aspect ratio must be a natural number',
                                  -title => 'Aspect ratio border - Error', -type => 'OK');
                                return;
                            }
                            if (($config{AspectBorderM} <= 0) or
                                ($config{AspectBorderN} <= 0)) {
                                $ll_a_w->messageBox(-icon => 'warning',
                                  -message => 'Aspect ratio must be positive and bigger than 0',
                                  -title => 'Aspect ratio border - Error', -type => 'OK');
                                return;
                            }
                            $ll_a_w->withdraw();
                            $ll_a_w->destroy();
                            $rc = 1;
                          })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);

  $ButF->Button(-text => lang('Help'),
                -command => sub {
                 showText('Help for lossless aspect ratio border',
                 "This function can be used to add a border to a JPEG to fit the selected aspect ratio without losing quality due to recompressing.\nAs JPEGs are organized in 8 or 16 pixel blocks the complete border width will be in 16 pixel-steps. Thus the resulting picture will not always match the selected aspect ratio.\n\nHow it works:\nIt will first create a background with the border and then drop the original picture on top of it. The picture is not recompressed and thus every pixel stays exactly the same. The tool jpegtran with the lossless drop patch is used for this task. See http://jpegclub.org.\n\nYou can check this by adding a border to a picture (don't forget to save the original picture by selecting \"Create Backup\") then you crop the border away and compare the original and the processed picture using the Mapivi function \"build difference picture\". If the resulting difference picture is complety black no pixel was changed.\nYou may check this again with a lossy border to see the differences.", 
                 NO_WAIT);
                })->pack(-side => 'left', -expand => 0, -padx => 3, -pady => 3);

  my $Xbut = $ButF->Button(-text => lang('Cancel'),
                           -command => sub { $rc = 0;
                                             $ll_a_w->withdraw();
                                             $ll_a_w->destroy();
                                           })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  bind_exit_keys_to_button($ll_a_w, $Xbut);
  $ll_a_w->Popup;
  $ll_a_w->waitWindow;
  return $rc;
}

##############################################################
# losslessWatermark - drop a picture onto the selected pics
#                     without recompressing the whole picture
##############################################################
sub losslessWatermark {
  # check if jpegtran supports lossless dropping
  my $usage = `jpegtran -? 2>&1`;
  if ($usage !~ m/.*-drop.*/) {
      $top->messageBox(-icon  => 'warning', -message => "Sorry, but your version of jpegtran does not support lossless dropping!\nTry to get jpegtran with the lossless drop patch from http://jpegclub.org.",
                       -title => "Wrong jpegtran version", -type => 'OK');
      return;
  }
  # todo:
  # 1. Select a part of the picture with e.g. the crop dialog
  # 2. Select a font and size and enter a text
  # 3. crop the selected part out of the picture
  # 4. add the text to the crop:
  #    convert crop.jpg -pointsize 120 -fill white -gravity center
  #            -annotate 0 'Mapivi' -quality 95 crop2.jpg
  # 5. lossless drop the crop at the same position

  # benefit: as color sampling is from original picture there should
  #          be no problem with lossless drop
  my @sellist = $picLB->info('selection');
  return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));
  my $selected = @sellist;
  return if (!losslessWatermarkDialog($sellist[0]));
  my $wmx = $config{llWatermarkX}; # X position
  my $wmy = $config{llWatermarkY}; # Y position
  my $file = $config{llWatermarkFile}; # the picture to add
  # get size of watermark pic
  my ($wmw, $wmh) = getSize($file);
  log_it("adding lossless watermark to $selected pictures");
  # check if some files are links
  return if (!checkLinks($picLB, @sellist));
  my $error = '';
  my $pw = progressWinInit($top, "Adding lossless watermark");
  my $i = 0;
  foreach my $dpic (@sellist) {
    last if progressWinCheck($pw);
    progressWinUpdate($pw, "adding watermark ($i/$selected) ...", $i, $selected);
    next if (!checkWriteable($dpic));
    next if (!makeBackup($dpic));
    # todo: either just drop a existing pic or
    # 1. crop a part of the picture -> cropPic($dpic,$w,$h,$x,$y,95);
    # 2. write a text on this crop -> convert crop.jpg -pointsize 50 -gravity south -stroke '#000C' -strokewidth 2 -annotate 0 'Martin' -stroke none -fill white -annotate 0 'Martin' crop-text.jpg
    # 3. drop it back on the same position
    # other idea/option: scale the picture to drop to a percentage (e.g. max 5%) of the main picture
    # to avoid big logos on small pictures

    # drop the watermark lossless! on top of the picture
    # no recompression of the picture!
    my ($ok, $drop_error) = drop_pic($file, $dpic, $dpic, $wmx, $wmy);
    $error .= $drop_error." ($dpic)\n" if ($drop_error);
    $i++;
    progressWinUpdate($pw, "adding watermark ($i/$selected) ...", $i, $selected);
    if ($ok) {
      updateOneRow($dpic, $picLB);
      deleteCachedPics($dpic);
      showPic($dpic) if ($dpic eq $actpic); # redisplay the picture if it is the actual one
    }
  }
  progressWinEnd($pw);
  if ($error ne '') {
    $error = "Some pictures caused errors:\n\n".$error;
    showText('Watermark errors', $error, NO_WAIT);
  }
  reselect($picLB, @sellist);
  log_it("ready! (added lossless watermark to $i of $selected)");
  generateThumbs(ASK, SHOW);
  return;
}

##############################################################
# drop a pic on top of another lossless! no recompression of the picture!
##############################################################
sub drop_pic {
  my $top_pic = shift; # picture to drop
  my $bottom_pic = shift; # picture to drop onto
  my $out_pic = shift; # final picture
  my $x = shift; # drop position x
  my $y = shift; # drop position y
  # check arguments
  return (0, 'Drop picture $top_pic does not exists') if (not -f $top_pic);
  return (0, 'Drop picture $top_pic is not in JPEG format') if (not is_a_JPEG($top_pic));
  return (0, 'Picture does not exists') if (not -f $bottom_pic);
  return (0, 'Picture is not in JPEG format') if (not is_a_JPEG($bottom_pic));
  my ($tw, $th) = getSize($top_pic);
  my ($bw, $bh) = getSize($bottom_pic);
  return (0, 'Drop picture $top_pic must be smaller than picture') if (($tw > $bw) or ($th > $bh));
  return (0, 'Drop position must be a positive value') if (($x < 0) or ($y < 0));
  return (0, 'Drop position out of picture (over right border)') if (($x + $tw) > $bw);
  return (0, 'Drop position out of picture (over bottom border)') if (($y + $th) > $bh);
  my $position = '';
  if ($x >= 0) { $position = "+"; }
  $position .= $x;
  if ($y >= 0) { $position .= "+"; }
  $position .= $y;
  # todo: still unclear what the -trim and -perfect switch does
  #my $command = "jpegtran -copy all -trim -perfect -drop $position \"$top_pic\" -outfile \"$out_pic\" \"$bottom_pic\" ";
  my $command = "jpegtran -copy all -drop $position \"$top_pic\" -outfile \"$out_pic\" \"$bottom_pic\" ";
  print "com = $command\n";
  execute($command);
  addProcessInfoToPicComment($command, $out_pic);
  if (-f $out_pic) {
    return (1, '');
  }
  return (0, 'unknown error');
}

##############################################################
# losslessWatermarkDialog
##############################################################
sub losslessWatermarkDialog {
  my $dpic = shift; # used for preview
  if (Exists($ll_w_w)) {
    $ll_w_w->deiconify;
    $ll_w_w->raise;
    return;
  }
  my $rc   = 0;
  # forward references
  my $preview_button;
  my $x_scale;
  my $y_scale;
  my $c; # canvas widget

  # open window
  $ll_w_w = $top->Toplevel();
  $ll_w_w->title("Drop picture (lossless) - ".basename($dpic));
  $ll_w_w->iconimage($mapiviicon) if $mapiviicon;

  # horizontal buttons and slider
  my $horizf = $ll_w_w->Frame()->pack(-fill => 'x', -padx => 3, -pady => 6);
  $preview_button = $horizf->Button(-image => $mapivi_icons{'Update'},
              -command => sub {
                # some checks
                return if (not check_drop_picture($ll_w_w, $config{llWatermarkFile}));
                $ll_w_w->Busy;
                my ($dw, $dh) = getSize($config{llWatermarkFile});
                my ($w, $h) = getSize($dpic);
                $x_scale->configure(-to => $w-$dw);                
                $y_scale->configure(-to => $h-$dh);
                $c->delete('all');
                my $out_file = "$trashdir/dropXYZ554.jpg"; # will be overwritten
                removeFile($out_file);
                my ($ok, $error) = drop_pic($config{llWatermarkFile}, $dpic, $out_file, $config{llWatermarkX}, $config{llWatermarkY});
                if ($ok) {
                  $ll_w_w->{preview} = $ll_w_w->Photo(-file => $out_file);
                  if ($ll_w_w->{preview}) { 
                    # insert pic
                    $c->createImage(0,0, -image => $ll_w_w->{preview}, -anchor => 'nw');
                    my ($w, $h) = getSize($out_file);
                    $c->configure(-scrollregion => [0, 0, $w, $h]);
                  }
                  else {
                    print "Could not create photo object from $out_file\n";
                  }
                }
                else {
                  $ll_w_w->Dialog(-title => 'Error dropping picture',
                                -text => "Could not drop picture using the external tool jpegtran.\n$error\nSee also: help button in drop dialog.",
                                -buttons => ['Ok'])->Show();
                  print "Drop error: $error\n";
                }
                $ll_w_w->Unbusy;
              })->pack(-side => 'left', -padx => 6);
  $balloon->attach($preview_button, -msg => "Update preview");
  my $hlb = $horizf->Button(-image => $mapivi_icons{'GoFirst'}, -command => sub {$config{llWatermarkX} = 0; $preview_button->Invoke;})->pack(-side => 'left');
  $balloon->attach($hlb, -msg => "Align with left border");
  my $hcb = $horizf->Button(-image => $mapivi_icons{'MediaStop'}, -command => sub {
      if (-f $config{llWatermarkFile}) {
        my ($dw, $dh) = getSize($config{llWatermarkFile});
        my ($w, $h) = getSize($dpic);
        $config{llWatermarkX} = int($w/2-$dw/2);
        $preview_button->Invoke; 
      }})->pack(-side => 'left');
  $balloon->attach($hcb, -msg => "Center horizontal");
  my $hrb = $horizf->Button(-image => $mapivi_icons{'GoLast'}, -command => sub {
      if (-f $config{llWatermarkFile}) {
        my ($dw, $dh) = getSize($config{llWatermarkFile});
        my ($w, $h) = getSize($dpic);
        $config{llWatermarkX} = $w-$dw;
        $preview_button->Invoke;
      }})->pack(-side => 'left');
  $balloon->attach($hrb, -msg => "Align with right border");
  $horizf->Label(-textvariable => \$config{llWatermarkX}, -width => 4)->pack(-side => 'left');
  $x_scale = $horizf->Scale(-variable => \$config{llWatermarkX},
             -from => 0,
             -to => 100,
             -resolution => 1,
             -sliderlength => 10,
             -orient => 'horizontal',
             -showvalue => 0,
              )->pack(-side => 'left', -fill => 'x', -expand => 1, -padx => 3,-pady => 3);
  $balloon->attach($x_scale, -msg => "x position from the right border in pixel");
  
  # lower frame with bottons and canvas
  my $canvasf = $ll_w_w->Frame()->pack(-expand => 1, -fill => 'both', -padx => 0);

  # vertical frame with buttons and vertical slider
  my $vertif = $canvasf->Frame()->pack(-expand => 0, -fill => 'y', -side => 'left', -padx => 3);
  my $vtb = $vertif->Button(-image => $mapivi_icons{'GoTop'}, -command => sub {$config{llWatermarkY} = 0; $preview_button->Invoke;})->pack;
  $balloon->attach($vtb, -msg => "Align with top border");
  my $vcb = $vertif->Button(-image => $mapivi_icons{'MediaStop'}, -command => sub {
      if (-f $config{llWatermarkFile}) {
        my ($dw, $dh) = getSize($config{llWatermarkFile});
        my ($w, $h) = getSize($dpic);
        $config{llWatermarkY} = int($h/2-$dh/2);
        $preview_button->Invoke; 
      }})->pack;
  $balloon->attach($vcb, -msg => "Center vertical");
  my $hbb = $vertif->Button(-image => $mapivi_icons{'GoBottom'}, -command => sub {
      if (-f $config{llWatermarkFile}) {
        my ($dw, $dh) = getSize($config{llWatermarkFile});
        my ($w, $h) = getSize($dpic);
        $config{llWatermarkY} = $h-$dh;
        $preview_button->Invoke;
      }})->pack;
  $balloon->attach($hbb, -msg => "Align with bottom border");
  $vertif->Label(-textvariable => \$config{llWatermarkY}, -width => 4)->pack;
  $y_scale = $vertif->Scale(-variable => \$config{llWatermarkY},
             -from => 0,
             -to => 100,
             -resolution => 1,
             -sliderlength => 10,
             -orient => 'vertical',
             -showvalue => 0,
              )->pack(-side => 'top', -fill => 'y', -expand => 1, -padx => 3,-pady => 3);
  $balloon->attach($y_scale, -msg => "y position from the top border in pixel");

  # file selector for drop picture
  labeledEntryButton($ll_w_w,'top',20,"Picture to drop",'Set', \$config{llWatermarkFile});

  # canvas
  $c = $canvasf->Scrolled("Canvas", -width => 600, -height => 400, -scrollbars => 'osoe')->pack(-side => 'left', -expand => 1, -fill => 'both');

  # aux buttons
  buttonBackup($ll_w_w, 'top');
  buttonComment($ll_w_w, 'top');

  # OK + Help + Cancel button
  my $ButF = $ll_w_w->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
  my $OKB =	$ButF->Button(-text => lang('OK'),
                          -command => sub {
                            # some checks
                            return if (not check_drop_picture($ll_w_w, $config{llWatermarkFile}));
                            # clean up preview photo object (free mem)
                            $ll_w_w->{preview}->delete if ($ll_w_w->{preview});
                            $ll_w_w->withdraw();
                            $ll_w_w->destroy();
                            $rc = 1;
                          })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  $ButF->Button(-text => lang('Help'),
                -command => sub {
                 showText('Help for drop picture',
                 "This function can be used to drop a picture (e.g. a small logo) onto another picture without losing quality due to recompression.\nThis can be used to add any label (e.g. name of the photographer, the location or the date) onto a picture.\nTherefore both pictures have to be in JPEG format and must have the same JPEG sampling factors!\n\nThe original picture is not recompressed and thus every pixel stays exactly the same - except where the drop picture is added, of course.\nThe tool jpegtran with the lossless drop patch is used for this function. See http://jpegclub.org.\n\nIf you have troubles with the sampling factors you may crop a part of the picture first, add a text to it and then use this picture as drop file.\n\nYou can check that this function is really lossless by comparing the original and the processed picture using the Mapivi function \"compare pictures\". If the resulting difference picture is complety black (except the region where the picture was dropped) no other pixel was changed.", 
                 NO_WAIT);
                })->pack(-side => 'left', -expand => 0, -padx => 3, -pady => 3);
  my $Xbut = $ButF->Button(-text => lang('Cancel'),
                           -command => sub { $rc = 0;
                                            # clean up preview photo object (free mem)
                                            $ll_w_w->{preview}->delete if ($ll_w_w->{preview});
                                             $ll_w_w->withdraw();
                                             $ll_w_w->destroy();
                                           })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  bind_exit_keys_to_button($ll_w_w, $Xbut);
  $ll_w_w->Popup;
  # show preview
  $preview_button->Invoke; 
  $ll_w_w->waitWindow;
  return $rc;
}

##############################################################
##############################################################
sub check_drop_picture {
  my $window = shift;
  my $file = shift;  
  unless (-f $file) {
    $window->messageBox(-icon => 'error',
        -message => 'The picture to drop could not be found.',
        -title => 'File not found', -type => 'OK');
    return 0;
  }
  unless (is_a_JPEG($file)) {
    $window->messageBox(-icon => 'error',
        -message => "The picture to drop ($file) is not in JPEG format.",
        -title => 'Wrong picture format', -type => 'OK');
    return 0;
  }
  return 1;
}

##############################################################
##############################################################
sub get_valid_parent_folder {
  my $dir = shift;
  return $dir if -d $dir;
  while (File::Spec->splitdir( $dir ) >= 1) {
    $dir = dirname($dir);
    last if -d $dir;
  }
  # fallback solution
  if (!-d $dir) {
    $dir = File::Spec->rootdir();
  }
  return $dir;
}

##############################################################
# importWizard - Dialog window
##############################################################
sub importWizard {
  if (Exists($wizW)) {
    $wizW->deiconify;
    $wizW->raise;
    return;
  }
  my $pics = shift;
  my $rc   = 0;
  # open window
  $wizW = $top->Toplevel();
  $wizW->title(lang('Import pictures wizard'));
  $wizW->iconimage($mapiviicon) if $mapiviicon;
  my $i_text = $wizW->Scrolled('ROText',
                            -scrollbars => 'osoe',
                            -wrap => 'word',
                            -width => 70,
                            -height => 5,
                            -relief => 'flat',
                            -bd => 0
                           )->pack(-fill => 'both', -expand => 0, -padx => 3, -pady => 3);
  $i_text->insert('end', lang("Import pictures from a removable device like e.g. a camera or a card reader connected via e.g. USB.\nThe selected actions will take place in the displayed order.\nMapivi is rather paranoid when importing pictures to be on the safe side.\nIf there are any errors during import (like a mismatch in the number of files or file size) you will be asked how to proceed."));
  my ($s,$m,$ho,$d,$mo,$y) = getDateTime(time());
  # build up the date string for the dir structure (e.g. "2007/10/29")
  my $date = sprintf "%04d/%02d/%02d", $y, $mo, $d;
  my $w  = 32;
  my $w2 = $w - 3;
  $config{ImportSource} = get_valid_parent_folder($config{ImportSource});
  labeledEntryButton($wizW,'top',$w,lang("Source folder / Import from"),lang('Set'),\$config{ImportSource}, 1);
  $wizW->Checkbutton(-variable => \$config{ImportSubdirs},
                     -anchor   => 'w',
                     -text     => lang('Import from all sub folders, too')
                    )->pack(-side => 'top', -anchor => 'w', -padx => 3, -pady => 3);
  labeledEntryButton($wizW,'top',$w,lang('Target folder (fix part)'),lang('Set'),\$config{ImportTargetFix}, 1);
  my $varF = $wizW->Frame()->pack(-anchor => 'w', -fill => 'x');
  labeledEntry($varF,'left',$w,lang("Target folder (variable part)"),\$config{ImportTargetVar});
  $varF->Button(-text => 'Set' , -command => sub {$config{ImportTargetVar} = $date;})->pack(-side => 'right', -padx => 3, -pady => 3);
  $varF->Label(-text => lang('Actual date:'),
               -anchor   => "e",
               -bg => $conf{color_bg}{value})->pack(-side => 'right', -anchor => 'w', -padx => 3, -pady => 3);
  my $moreF = $wizW->Frame(-relief => 'groove');
  my $more_button;
  $more_button = $wizW->Checkbutton(-variable => \$config{ImportMore},
                      -anchor => 'w',
                      -text => lang('More options'),
                      -command => sub {
                        if ($config{ImportMore}) {
                          $moreF->pack(-after => $more_button, -fill => 'x', -expand => 0, -padx => 4, -pady => 3);
                        }
                        else { $moreF->packForget(); }
                      })->pack(-padx => 3, -anchor => 'w');
  if ($config{ImportMore}) {
    $moreF->pack(-after => $more_button, -expand => 0, -fill => 'x', -padx => 4, -pady => 3);
  }
  else { $moreF->packForget(); }

# jjjj  
  my $rotF = $wizW->Frame()->pack(-anchor => 'w', -fill => 'x');  
  my $rot = $rotF->Checkbutton(-variable => \$config{ImportRotate},
                   -anchor   => 'w',
                   -text     => lang('Picture rotation (lossless)')
                   )->pack(-side => 'left', -anchor => 'w', -padx => 3, -pady => 3);
  my @deg = qw(auto horizontal vertical 90 180 270);
  $rotF->Optionmenu(-variable => \$conf{import_rotate_deg}{value},
                     -options => \@deg)->pack(-side => 'left', -anchor => 'w', -padx => 3, -pady => 3);
  if (missingProgs("Automatic rotation", "jhead", "jpegtran") > 0) {
    $config{ImportRotate} = 0;  # disabled if jhead and jpegtran are not available
    $rot->configure(-state => 'disabled');
    $rot->configure(-disabledforeground => 'gray30');
    $balloon->attach($rot, -msg => explainMissingProg('Automatic rotation', 'jhead').explainMissingProg('Automatic rotation', 'jpegtran'));
  }
  my $comF = $moreF->Frame()->pack(-anchor => 'w', -fill => 'x');
  $comF->Checkbutton(-variable => \$config{NameComment},
                     -anchor   => 'w',
                     -text     => lang('Add original file name to comment (')
                    )->pack(-side => 'left', -anchor => 'w', -padx => 3, -pady => 3);
  $comF->Checkbutton(-variable => \$config{NameComRmSuffix},
                     -anchor   => 'w',
                     -text     => lang('remove file suffix )')
                    )->pack(-side => 'left', -anchor => 'w', -padx => 0, -pady => 3);

  my $headF = $moreF->Frame()->pack(-anchor => 'w', -fill => 'x');
  $headF->Checkbutton(-variable => \$conf{import_iptc_headline}{value},
                      -anchor   => 'w',
                      -text     => '',
                     )->pack(-side => 'left', -anchor => 'w', -padx => 3, -pady => 3);
  labeledEntry($headF,'left',$w,lang('Add IPTC headline'),\$conf{import_iptc_headline_content}{value});

  my $acomF = $moreF->Frame()->pack(-anchor => 'w', -fill => 'x');
  $acomF->Checkbutton(-variable => \$config{ImportAddCom},
                      -anchor   => 'w',
                      -text     => '',
                     )->pack(-side => 'left', -anchor => 'w', -padx => 3, -pady => 3);
  labeledEntry($acomF,'left',$w,lang('Add comment to each picture'),\$config{ImportAddComment});
  my $iptcF = $moreF->Frame()->pack(-anchor => 'w', -fill => 'x');
  my $addiptc = $iptcF->Checkbutton(-variable => \$config{ImportAddIPTC},
                      -anchor   => 'w',
                      -text     => '',
                     )->pack(-side => 'left', -anchor => 'w', -padx => 3, -pady => 3);
  $balloon->attach($addiptc, -msg => lang("To generate a IPTC template (*.iptc2) edit IPTC of any (dummy) picture and save the IPTC info via menu: IPTC->").lang("Save template ..."));
  labeledEntryButton($iptcF,'top',$w,lang('Add IPTC info to each picture'),lang('Set'),\$config{ImportIPTCTempl});
  my $addiptcdt = $moreF->Checkbutton(-variable => \$config{ImportAddIPTCDateTime},
                      -anchor   => 'w',
                      -text     => lang('Add EXIF date/time to IPTC'),
                     )->pack(-anchor => 'w', -padx => 3, -pady => 3);
  $balloon->attach($addiptcdt, -msg => lang("Add EXIF date and time to IPTC date / time created tags"));
  my $addiptcow = $moreF->Checkbutton(-variable => \$config{ImportAddIPTCByLine},
                      -anchor   => 'w',
                      -text     => lang('Add EXIF owner to IPTC ByLine'),
                     )->pack(-anchor => 'w', -padx => 3, -pady => 3);
  $balloon->attach($addiptcow, -msg => lang("Add EXIF owner or artist or user comment to IPTC ByLine"));
  my $lockB = $moreF->Checkbutton(-variable => \$config{ImportMarkLocked},
                              -anchor   => 'w',
                              -text     => lang('Add high rating to locked pictures')
                             )->pack(-anchor => 'w', -padx => 3, -pady => 3);
  $balloon->attach($lockB, -msg => lang("Some digital cameras allow to lock pictures.\nThis feature can be used to mark important pictures already in the camera.\nIf this function is enabled Mapivi will add a high rating to all locked pictures\n(files with write protection)."));
  $moreF->Checkbutton(-variable => \$config{ImportDeleteCameraJunk},
                     -anchor   => 'w',
                     -text     => lang('Delete camera junk files in target folder after copy (e.g. *.CTG)')
                    )->pack(-anchor => 'w', -padx => 3, -pady => 3);
  my $renF = $wizW->Frame()->pack(-anchor => 'w', -fill => 'x');
  $renF->Checkbutton(-variable => \$config{ImportRename},
                     -anchor   => 'w',
                     -text     => lang('Smart Rename with this pattern:')
                    )->pack(-side => 'left', -anchor => 'w', -padx => 2, -pady => 3);
  $renF->Label(-textvariable => \$config{FileNameFormat},
               -bg => $conf{color_bg}{value},
               -anchor   => 'w',
               #-width    => ($w2-2),
               )->pack(-side => 'left', -anchor => 'w', -padx => 3, -pady => 3);
  $renF->Button(-text    => lang('Set'),
                -command => sub {
                  getRenameFormat();
                })->pack(-side => 'right', -anchor => 'w', -padx => 3, -pady => 3);
  $wizW->Checkbutton(-variable => \$config{ImportDelete},
                     -anchor   => 'w',
                     -text     => lang("Delete files in source folder after copy")
                    )->pack(-anchor => 'w', -padx => 3, -pady => 3);
  $wizW->Checkbutton(-variable => \$config{ImportShowPics},
                     -anchor   => 'w',
                     -text     => lang("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 => lang('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 => lang('Cancel'),
                           -command => sub { $rc = 0;
                                             $wizW->withdraw();
                                             $wizW->destroy();
                                           })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  bind_exit_keys_to_button($wizW, $Xbut);
  $wizW->Popup;
  $wizW->waitWindow;
  return if ($rc != 1);
  my $ok = importPictures();
  openDirPost($config{ImportTargetFix}."/".$config{ImportTargetVar}) if $config{ImportShowPics};
  if ($ok) {
    log_it(lang("Picture import finished successfully!"));
  }
  else {
    log_it(lang("Picture import finished with errors!"));
  }
  return;
}

my $printW;
##############################################################
# copyToPrint -  copy pics to print folders
#                (e.g. 2_times_5x7/ or 1_times_13x18/)
##############################################################
sub copyToPrint {
  my $lb = shift;    # the reference to the active listbox widget
  my @sellist = getSelection($lb);
  return unless checkSelection($top, 1, 0, \@sellist, lang("picture(s)"));
  if (Exists($printW)) {
    $printW->deiconify;
    $printW->raise;
    return;
  }
  my $pics  = shift;
  my $rc   = 0;
  # open window
  $printW = $lb->Toplevel();
  $printW->title("copy pictures to print folder");
  $printW->iconimage($mapiviicon) if $mapiviicon;
  $printW->Label(-text => "Copy ".scalar @sellist." pictures to a according print folder.", -bg => $conf{color_bg}{value}, -justify => 'left')->pack(-anchor => 'w', -padx => 3, -pady => 3);
  my $w  = 32;
  my $w2 = $w - 3;
  my $times    = 1;
  my $timesStr = "times";
  my $size     = "10x15";
  labeledEntryButton($printW,'top',$w,"Print base folder",'Set',\$config{PrintBaseDir}, 1);
  my $sf = $printW->Frame()->pack();
  $sf->Label(-text => "numer, string and size", -width => $w, -bg => $conf{color_bg}{value}, -justify => 'left')->pack(-side => 'left');
  $sf->Optionmenu(-textvariable => \$config{PrintTimes},
                  -options => [qw(1 2 3 4 5 6 7 8 9 10)],
                  -command => sub { $config{PrintVarDir} = $config{PrintTimes}.$config{PrintTimesStr}.$config{PrintSize}; },
                 )->pack(-side => 'left', -anchor => 'w');
  $sf->Optionmenu(-textvariable => \$config{PrintTimesStr},
                  -options => [qw(times mal - x _x_ _times_ _mal_ _prints_in_ _Abzuege_in_)],
                  -command => sub { $config{PrintVarDir} = $config{PrintTimes}.$config{PrintTimesStr}.$config{PrintSize}; },
                 )->pack(-side => 'left', -anchor => 'w');
  $sf->Optionmenu(-textvariable => \$config{PrintSize},
                  -options => [qw(4x6 5x7 8x10 11x14 9x13 10x15 13x18 18x27 30x40 50x70)],
                  -command => sub { $config{PrintVarDir} = $config{PrintTimes}.$config{PrintTimesStr}.$config{PrintSize}; },
                 )->pack(-side => 'left', -anchor => 'w');
  labeledEntry($printW,'top',$w,"folder",\$config{PrintVarDir});
  my $ButF = $printW->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3);
  my $OKB =	$ButF->Button(-text => lang('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 => lang('Cancel'),
                           -command => sub { $rc = 0;
                                             $printW->withdraw();
                                             $printW->destroy();
                                           })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3);
  bind_exit_keys_to_button($printW, $Xbut);
  $printW->Popup;
  $printW->waitWindow;
  return if ($rc != 1);
  if (!-d $config{PrintBaseDir}) {
    my $rc = $top->messageBox(-icon  => 'question',
                -message => $config{PrintBaseDir}." does not exist. Should I create it?",
                -title => "Create print base folder?", -type => 'OKCancel');
    return if ($rc !~ m/Ok/i);
    eval { mkpath($config{PrintBaseDir}, 0, oct(755)) }; # 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);
  log_it("copy finished! ($i/".scalar @sellist.")");
  return;
}

##############################################################
# importPictures
##############################################################
sub importPictures {
  my $source = $config{ImportSource};
  ##### check source dir
  log_it("checking folders ...");
  if (!-d $source) {
    $top->messageBox(-icon => 'warning',
                     -message => "Sorry, but the source folder\n$source\ndoes not exists!\nPlease check, if the device is mounted.",
                     -title => "Import pictures - Error", -type => 'OK');
    return 0;
  }
  my @sdirs;               # all dirs to process
  # add the sub dirs
  if ($config{ImportSubdirs}) {
    push @sdirs, getDirsRecursive($source);
  }
  push @sdirs, $source unless isInList($source, \@sdirs);  # the source dir is the minimum
  # the target dir
  my $tdir = $config{ImportTargetFix}."/".$config{ImportTargetVar};
  ##### check if target is available, create it if not
  makeDir($tdir, ASK) if (!-d $tdir);
  ##### check if target is now available
  if (!-d $tdir) {
    warn "$tdir not created!!!";
    return 0;
  }
  #### get the IPTC template only once, before starting loop
  my $iptc;
  if ($config{ImportAddIPTC}) {
    if (defined $config{ImportIPTCTempl} and -f $config{ImportIPTCTempl}) {
      $iptc = retrieve($config{ImportIPTCTempl});
      unless (defined $iptc) {
        $top->messageBox(-icon => 'warning',
                         -message => "Sorry, but Mapivi could not retrieve IPTC template $config{ImportIPTCTempl}!\nPlease check, if the file is available.",
                         -title => "Import pictures - Error", -type => 'OK');
        return 0;
      }
    }
    else {
        $top->messageBox(-icon => 'warning',
                         -message => "Sorry, but Mapivi could not find the IPTC template $config{ImportIPTCTempl}!\nPlease check, if the file is available.",
                         -title => "Import pictures - Error", -type => 'OK');
      return 0;
    }
  }
  # open log window
  if (Exists($impW)) {
    $impW->deiconify;
    $impW->raise;
    return 0;
  }
  # open window
  $impW = $top->Toplevel();
  $impW->title(lang("Import pictures report"));
  $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 => lang("Close"),
                -command => sub {
                  $impW->withdraw();
                  $impW->destroy();
                },
               )->pack(-expand => 1, -side => 'left', -fill => 'x');
  my $stop_import = 0;
  my $stop_importB = $butF->Button(-text => lang("Stop"),
                            -command => sub { $stop_import = 1; }
                           )->pack(-side => 'left', -anchor => 'w', -expand => 0,-padx => 1,-pady => 1);
  $stop_importB->configure(-image => $mapivi_icons{Stop}, -borderwidth => 0);
  $stop_importB->configure(-state => 'disabled');
  my $dcount = 0; # progress of dirs
  my $pcount = 0; # progress of pics
  my $rating_count = 0; # counter for locked pictures with successfull added rating
  my $progF  = $impW->Frame()->pack(-expand => 1, -fill =>'x');
  $progF->Label(-text => lang("progress folders "), -bg => $conf{color_bg}{value})->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 => lang(" pictures "), -bg => $conf{color_bg}{value})->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,
                               -bg => 'gray90',
                               -fg => 'black',
                              )->pack(-fill => 'both', -expand => 1, -padx => 1, -pady => 1);
  $rotext->tagConfigure("R",-foreground => "red");
  $rotext->tagConfigure("G",-foreground => "DeepSkyBlue4");
  $rotext->tagConfigure("B",-foreground => "blue4");
  #$impW->Popup;
  $rotext->insert('end', $time.lang(" starting import ...\n"), "B"); $impW->update;
  $stop_importB->configure(-state => 'normal');
  foreach my $source (@sdirs) {
    last if $stop_import;
    $dcount++;
    $rotext->insert('end', lang("in folder ")."($dcount/".scalar @sdirs.") $source ...\n", "G"); $impW->update;
    ##### get and check files to import
    my @importfiles = getFiles($source);
    print "In dir $source are ".@importfiles." files\n" if $verbose;
    if (@importfiles <= 0) {
      $rotext->insert('end', "   ".lang("no pictures - skipping folder\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_import;
      $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.") ".lang("copy")." $file ($sizeF MB)\n");
      $rotext->see('end');
      $impW->update;
      mycopy("$source/$file", "$tdir/$file", ASK_OVERWRITE);
      if ($config{ImportMarkLocked}) {
        # if source file is write protected and a JPEG by file suffix (this is much faster than using is_a_JPEG())
        if ((!-w "$source/$file") and ($file =~ m/.*\.jp(g|eg)$/i)) {
          # add rating 1 to target file
          my $urgency = 1; my $errors = '';
          my $ok = set_IPTC_urgency_file("$tdir/$file", $urgency, \$errors);
          if ($ok) { # urgency changed successfully!
            # set also XMP rating, if option is set
            xmp_set_rating("$tdir/$file", $urgency) if $conf{xmp_rating}{value};
            $rotext->insert('end', "         ".lang("locked picture, setting high rating!\n"));
            $rating_count++;
          }
          else {
            $rotext->insert('end', "         ".lang("locked picture, but writing of rating failed!\n"));
          }
          $rotext->see('end');
        }
      }
      $sum += $size if (-f "$tdir/$file");
    }
    if ($stop_import) {
      $rotext->insert('end', $time.' '.lang("Import aborted by user!")."\n", "R");
    }
    my $duration = Tk::timeofday() - $startTime;      # in seconds
    my $rate = 0;
    $rate = $sum/$duration if ($duration > 0); # MegaBytes/second
    my $string   = langf("The transfer of %d pictures (%.2f MB) took %.2f seconds; transferrate %.2f MB/s\n", $pcount, $sum, $duration, $rate);
    $rotext->insert('end', $string); $rotext->see('end');
    return 0 if ($stop_import);
    ##### 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) {
      if (!-f "$tdir/$_") {
        $filediff++;
      } else {
        $sizediff++ if (getFileSize("$tdir/$_", NO_FORMAT) != getFileSize("$source/$_", NO_FORMAT));
      }
    }
    if (($filediff > 0) or ($sizediff > 0)) {
      my $rinfo = '';
      $rinfo = "$rating_count locked pictures found and rating added. This will increase the file size and may explain the difference.\n" if ($rating_count > 0);
      my $fdinfo = ''; $fdinfo = "$filediff files are missing.\n" if ($filediff > 0);
      my $sdinfo = ''; $sdinfo = "$sizediff files have another size.\n" if ($sizediff > 0);
      my $rc = $top->messageBox(-icon  => 'question',
                                -message => "Not all files in the source and target folder are eqal.\n${fdinfo}${sdinfo}${rinfo}Should I continue to process $pcount imported pictures?",
                                -title => 'Continue importing pictures?', -type => 'OKCancel');
      $impW->raise;
      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 @piclist = getPics($source, JUST_FILE, NO_CHECK_JPEG); # no sort needed
    ##### process JPEGS
    if ($config{ImportRotate} or $config{ImportRename} or $config{NameComment} or $config{ImportAddCom} or $config{ImportAddIPTC} or $config{ImportAddIPTCDateTime} or $config{ImportAddIPTCByLine}) {
      my $command = '';
      my @renamed;
      $pcount = 0;
      foreach (@piclist) {
        last if $stop_import;
        $pcount++;
        my $pic  = $_;
        my $dpic = "$tdir/$pic";
        my $is_a_jpeg = 0; $is_a_jpeg = 1 if ($pic =~ m/.*\.jp(g|eg)$/i);
        $rotext->insert('end', "   ($pcount/".scalar @piclist.") $pic ", "G"); $rotext->see('end');
        if (!-f $dpic) {
          my $info = ''; $info = lang("(maybe already renamed with JPEG file?) ") if (not $is_a_jpeg);
          $rotext->insert('end', "*** ".lang("is missing - skipping!")." $info***\n", "R"); $rotext->see('end');
          warn "importPictures: $dpic is missing - skipping!\n";
          next;
        }
        #my $tmppic  = "$dpic"."-cjpg"; # temporary file
        ##############################################################
        ##### auto rotate pics
        if ($config{ImportRotate}) {
          $rotext->insert('end', lang("rotate, ")); $rotext->see('end');
          print "import rotate $pic: $conf{import_rotate_deg}{value}\n";
          my ($ok, $error) = rotate_pic($dpic, $conf{import_rotate_deg}{value});
          warn "Error while import rotate $pic: $error\n" if (not $ok);
        }
        ##############################################################
        ##### add file name to comment
        if ($config{NameComment} and $is_a_jpeg) {
          $rotext->insert('end', lang("add 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}) and $is_a_jpeg) {
          $rotext->insert('end', lang("add 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 IPTC Headline
        if ($conf{import_iptc_headline}{value} and $is_a_jpeg) {
          if (defined $conf{import_iptc_headline_content}{value}) {
            if ($conf{import_iptc_headline_content}{value} ne '') {
             $rotext->insert('end', lang("add headline, ")); $rotext->see('end');
              my $iptc = { 'Headline' => $conf{import_iptc_headline_content}{value} };
              my ($ok, $error) = applyIPTCint($dpic, $iptc);
              warn "Adding headline to $pic error: $error\n" if (not $ok);
            }
          }
        }

        ##############################################################
        ##### add EXIF date/time to IPTC
        if ($config{ImportAddIPTCDateTime} and $is_a_jpeg) {
          $rotext->insert('end', lang("add EXIF date/time, ")); $rotext->see('end');
          my $meta = getMetaData($dpic, 'APP1'); # APP1 includes EXIF and IPTC (APP13)
          if (defined $meta) {
            my $er = $meta->get_Exif_data('ALL', 'TEXTUAL');
            my $iptc = $meta->get_app13_data('TEXTUAL', 'IPTC');
            my $date = getEXIFDate($dpic, $er); # date format YYYY:MM:DD HH:mm:SS
            my ($ok, $IPTCdate, $IPTCtime) = EXIFtoIPTCdatetime($date);
            if ($ok) {
              # according to IPTC - NAA INFORMATION INTERCHANGE MODEL, Version No. 4, 1999, http://www.iptc.org/IIM/
              ${$iptc->{DateCreated}}[0] = $IPTCdate; # format CCYYMMDD
              ${$iptc->{TimeCreated}}[0] = $IPTCtime; # format HHMMSS+HHMM
              # todo: better use applyIPTCint???
              $meta->set_app13_data($iptc, 'ADD', 'IPTC');
              $meta->save();
            }
            else {
              warn "picture has an unusual EXIF date: \"$date\" ($dpic)\n" if $config{MetadataWarn};
            }
          }
        }
        ##############################################################
        ##### add EXIF owner to IPTC ByLine
        if ($config{ImportAddIPTCByLine} and $is_a_jpeg) {
          $rotext->insert('end', lang("add EXIF owner, ")); $rotext->see('end');
          my $meta = getMetaData($dpic, 'APP1'); # APP1 includes EXIF and IPTC (APP13)
          if (defined $meta) {
            my $er = $meta->get_Exif_data('ALL', 'TEXTUAL');
            my $iptc = $meta->get_app13_data('TEXTUAL', 'IPTC');
            my $owner = getEXIFowner($er);
            if ($owner ne '') {
              ${$iptc->{ByLine}}[0] = $owner;
              $meta->set_app13_data($iptc, 'ADD', 'IPTC');
              $meta->save();
            }
          }
        }
        ##############################################################
        ##### add comment to picture
        if ($config{ImportAddCom} and (defined $config{ImportAddComment}) and
            ($config{ImportAddComment} ne '') and $is_a_jpeg) {
          $rotext->insert('end', lang("add comment, ")); $rotext->see('end');
          # add comment to pic
          addCommentToPic($config{ImportAddComment}, $dpic, NO_TOUCH);
        }
        ##############################################################
        ##### smart rename pics
        my $errors = '';
        if ($config{ImportRename} and $is_a_jpeg) {
          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);
          $rotext->insert('end', langf("rename to %s ",$newname)); $rotext->see('end');
          $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 (!renamePicInt(undef, $dpic, "$tdir/$newname", \$errors)) {
              # rename failed
              $top->messageBox(-icon => 'warning', -message => "Could not rename $pic to $newname: $!",
                               -title => 'Error', -type => 'OK');
            }
            else {
              push @renamed, "$tdir/$newname";
            }
          }
        }
        #$rotext->insert('end', "Error: $errors") if ($errors ne '');   # 2010-02-09: disabled because this gives an error about not beeing able to rename the thumbnail
        $rotext->insert('end', "\n"); $rotext->see('end');
        $rotext->update;
      }							# foreach pics end
      my $errors = '';
      renameSmartFix(\$errors, @renamed) if $config{ImportRename};
      $rotext->insert('end', "Error: $errors\n") if ($errors ne '');
    }
    $stop_importB->configure(-state => 'disabled');
    ##############################################################
    ##### delete worthless camera state files
    if ($config{ImportDeleteCameraJunk}) {
      my @junkfiles = grep {m/.*\.($cameraJunkSuffixes)$/i} @importfiles;
      $pcount = 0;
      $stop_importB->configure(-state => 'normal');
      foreach (@junkfiles) {
        last if $stop_import;
        $pcount++;
        $rotext->insert('end', "   ($pcount/".scalar @junkfiles.") ".lang("deleting")." $_\n"); $rotext->see('end'); $rotext->update;
        removeFile("$tdir/$_");
      }
      $stop_importB->configure(-state => 'disabled');
    }
    ##############################################################
    ##### delete imported pics
    if ($config{ImportDelete}) {
      # check if everything is alright
      if (($filediff > 0) or ($sizediff > 0)) {
        my $rc = $top->messageBox(-icon  => 'question',
                                  -message => "There have been some warnings while importing.\nShould I continue and delete the ".scalar @importfiles." files in the source folder?",
                                  -title => "Continue?", -type => 'OKCancel');
        return 0 if ($rc !~ m/Ok/i);
      }
      $pcount = 0;
      $stop_importB->configure(-state => 'normal');
      # remove the pics on the source dir
      foreach (@importfiles) {
        last if $stop_import;
        $pcount++;
        $rotext->insert('end', "   ($pcount/".scalar @importfiles.") ".lang("deleting")." $_\n"); $rotext->see('end'); $rotext->update;
        removeFile("$source/$_");
      }
    }
  }    # foreach dirs end
  $stop_importB->configure(-state => 'disabled');
  ($s,$m,$ho,$d,$mo,$y) = localtime(time());
  $time = sprintf "%02d:%02d:%02d", $ho, $m, $s;
  my $ok = 0;
  if ($stop_import) {
    $rotext->insert('end', $time.' '.lang("Import aborted by user!")."\n", "R");
  }
  else {
    $rotext->insert('end', $time.' '.lang("Import finished!")."\n", "B");
    $ok = 1;
  }
  $rotext->insert('end', lang("You may now close this window.")."\n", "B");
  $rotext->see('end');
  $rotext->update;
  return $ok;
}

##############################################################
# sets widget to normal if state = true, else to disabled
##############################################################
sub set_child_normal {
  my ($widget, $state) = @_;
  if ($state) {
    setChildState($widget, 'normal');
  }
  else {
    setChildState($widget, 'disabled');
  }
  return;
}

##############################################################
# setChildState - changes the state of a widget and
#                 all his descendants (if possible)
##############################################################
sub setChildState {
  my $widget = shift;
  my $state  = shift; # 'normal' or 'disabled'
  $widget->Walk( sub {
      print "changing widget ",ref($_[0])," to state $state\n" if $verbose;
      eval { $_[0]->configure(-state => $state); }
  });
  return;
}

##############################################################
# 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(lang("Mapivi progress"));

  # init the values
  $pw->{stop}    = 0;
  $pw->{percent} = 0;
  $pw->{label}   = '';
  $pw->{label2}  = lang("0% done\n\n\n");
  $pw->{start_time} = Tk::timeofday();

  $pw->Label(-textvariable => \$pw->{label}, -width => 80, -anchor => 'w', -bg => $conf{color_bg}{value})->pack(-padx => 3, -pady => 10);
  $pw->Label(-textvariable => \$pw->{label2}, -anchor => 'w', -bg => $conf{color_bg}{value})->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 => lang('Cancel'),
              -command => sub {
                $pw->{stop}  = 1;
                $pw->{label} = lang("Try to stop, please wait ...");
                $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;
  return 0 unless (Exists($pw));
  warn "pw->stop undefined!" unless defined($pw->{stop});
  return ($pw->{stop});
}

##############################################################
# progressWinUpdate
##############################################################
sub progressWinUpdate {
  my $pw = shift;
  return unless (Exists($pw));
  # show progress and found pics every 0.3 seconds - idea from Slaven
  return unless (!defined $pw->{last_time} || Tk::timeofday()-$pw->{last_time} > 0.3);

  my $string = shift;
  my $index  = shift;
  my $total  = shift;

  $pw->{label} = $string;

  if ($total > 0) {
    my $add_str    = '';
    my $percent    = int(($index/$total)*100);
    my $min        = 0;
    my $sec        = int(Tk::timeofday() - $pw->{start_time});
    # try to estimate the time to go, after 3% are finished and 10 seconds are over
    if (($percent > 3) and ($sec > 5)) {
      my $to_go = int($sec * $total / $index) - $sec; # time to go in seconds
      my $totalt = $to_go + $sec;
      my $tgmin = 0;
      my $total_min = 0;
      if ($to_go > 59) { $tgmin = int($to_go / 60); $to_go = $to_go % 60; } # modulo
      if ($totalt > 59) { $total_min = int($totalt / 60); $totalt = $totalt % 60; } # modulo
      $add_str = langf("\n\nTotal time about %d:%02d, finished in about %d:%02d", $total_min, $totalt, $tgmin, $to_go);
    }
    if ($sec > 59) { $min = int($sec / 60); $sec = $sec % 60; } # modulo
    $pw->{label2} = langf("%d%% done, time elapsed %d:%02d%s", $percent, $min, $sec, $add_str);
    $pw->{percent} = $percent;
    $pw->iconname(langf("%d%% done", $percent));
  }
  else {
    $pw->{label2} = '';
  }
  $pw->update();
  $pw->{last_time} = Tk::timeofday() if ($total > 0);
  return;
}

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

##############################################################
# fullscreen - toggle any window to fullscreen and back to old
#              size and position
#              all information is stored inside the $win hash
#
# other sources:
# Mai 2007: $win->attributes(-fullscreen => 1); should also work with
# 804.027_500 but it doesn't (at least not under windows)
# see also http://objectmix.com/perl/19715-mainwindow-fullscreen.html
# todo: do we need this, too? http://www.tek-tips.com/faqs.cfm?fid=6265
##############################################################  
sub fullscreen {
  my $win = shift;
  if ((not defined $win->{my_fullscreen_flag}) or ($win->{my_fullscreen_flag} == 0)) {
    print "fullscreen: full \n" if $verbose;
    # save the actual window geometry
    $win->{my_last_geometry} = $win->geometry; 
    # this should also work: (packPropagate must be before Fullscreen call!!!)
    $win->packPropagate(0);
    my $w = $win->screenwidth;	# - 20;
    my $h = $win->screenheight;	# - 80;
    $win->geometry("${w}x${h}+0+0");
    #$win->FullScreen;
    # remove window decoration (has to be after Fullscreen call!!!)
    $win->overrideredirect(1) if $config{ToggleBorder};	
    $win->{my_fullscreen_flag} = 1;
  } else {
    print "fullscreen: normal \n" if $verbose;
    $win->packPropagate(1);
    $win->geometry($win->{my_last_geometry});
    # add window decoration
    $win->overrideredirect(0) if $config{ToggleBorder};	
    $win->{my_fullscreen_flag} = 0;
  }
  $win->update;
  $win->focusForce;
  # info_window() has to be called after update and focusForce!
  if ($win->{my_fullscreen_flag}) {
    info_window($win, lang("Fullscreen On"));
  }
  else {
    info_window($win, lang("Fullscreen Off"));
  }
  return;
}

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

##############################################################
# beep - play a beep sound (bell)
##############################################################
sub beep {
  print "\a"; # this is a beep
  # if this won't work, try this:
  #print "\007";
  return;
}

##############################################################
# round
##############################################################
sub round {
  # int() does not round!
  return sprintf "%d", shift;
}

##############################################################
# about - display some infos about the application
##############################################################
sub about {
  my $title = lang('About Mapivi')." $version $svnrevision";
  my $nrs = $config{NrOfRuns};
  my $about = << "EOA";

Mapivi - Martin\'s Picture Viewer and Manager

EOA
  $about .= lang("Open-source and cross-platform picture manager with IPTC, EXIF and Comment support.");
  $about .= << "EOA";

  
      Mapivi Version: $version
        SVN Revision: $svnrevision
                Date: $version_date
                File: $mapivi_file

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

			
EOA

  $about .= langf("You have used Mapivi %d times.", $nrs);
  $about .= "\n\n".lang("Mapivi is free software.\n");
  $about .= "\n".lang("Thanks to the Tango Desktop Project for the nice icons!")." 
http://tango.freedesktop.org/Tango_Icon_Library\n";
  $about .= "\n".lang("I am always happy to receive some feedback about Mapivi!\n");
  showText($title, $about, WAIT);
  return;
}

##############################################################
# systemInfo - show some infos about the system to the user
##############################################################
sub systemInfo {
  my $sec = time() - $^T;
  my $min = 0;
  my $hou = 0;
  my $day = 0;
  my $line = '------------------------------------';
  # 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 $exiftool_version = 'not available';
  $exiftool_version = $Image::ExifTool::VERSION;
  my $string = << "EOA";
$line
Paths:
    Mapivi user data: $user_data_path
 Mapivi program data: $program_data_path
     Perl executable: $^X

$line
Versions:
        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
    ExifTool version: $exiftool_version

$line
Process:
    Process ID (PID): $$
       Running since: $uptime
	
$line
System:
         System (OS): $^O
EOA

  my $procTabAvail = (eval {require Proc::ProcessTable})  ? 1 : 0 ;
  my $mem = 'n.a.';
  $mem = int(getMemoryUsage()/(1024*1024))."MB" if $procTabAvail;
  $string .= "        memory usage: ".$mem."\n"     if $procTabAvail;
  $string .= "             OS type: ".$ENV{OS}."\n" if ($ENV{OS});
  $string .= "                  OS: ".$ENV{PC_OS}."\n" if ($ENV{PC_OS});
  $string .= "             OS type: ".$ENV{OSTYPE}."\n" if ($ENV{OSTYPE});
  $string .= "         System name: ".$ENV{HOSTNAME}."\n" if ($ENV{HOSTNAME});
  $string .= "         System name: ".$ENV{COMPUTERNAME}."\n" if ($ENV{COMPUTERNAME});
  $string .= "         System type: ".$ENV{HOSTTYPE}."\n" if ($ENV{HOSTTYPE});
  $string .= "     # of processors: ".$ENV{NUMBER_OF_PROCESSORS}."\n" if ($ENV{NUMBER_OF_PROCESSORS});
  $string .= "           Processor: ".$ENV{CPU}."\n" if ($ENV{CPU});
  $string .= "           Processor: ".$ENV{PROCESSOR_ARCHITECTURE}."\n" if ($ENV{PROCESSOR_ARCHITECTURE});
  $string .= "      Processor type: ".$ENV{PROCESSOR_IDENTIFIER}."\n" if ($ENV{PROCESSOR_IDENTIFIER});
  $string .= "      Processor type: ".$ENV{MACHTYPE}."\n" if ($ENV{MACHTYPE});
  $string .= "      Processor rev.: ".$ENV{PROCESSOR_REVISION}."\n" if ($ENV{PROCESSOR_REVISION});
  $string .= "   Screen resolution: ".$top->screenwidth."x".$top->screenheight."\n";
  $string .= "\n".$line."\nOptional Perl modules:\n";
  $string .= "not " if (not MatchEntryAvail);
  $string .= "available: ";
  $string .= "Tk::MatchEntry\n";
  $string .= "not " if (not $resizeAvail);
  $string .= "available: ";
  $string .= "Tk::ResizeButton\n";
  $string .= "not " if (not $splashAvail);
  $string .= "available: ";
  $string .= "Tk::Splash\n";
  $string .= "not " if (not ProcBackgroundAvail);
  $string .= "available: ";
  $string .= "Proc::Background\n";
  $string .= "not " if (not $procTabAvail);
  $string .= "available: ";
  $string .= "Proc::ProcessTable\n";
  $string .= "not " if (not Win32ProcAvail);
  $string .= "available: ";
  $string .= "Win32::Process\n";
  $string .= "\n".$line."\nExternal programs (required or optional):\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);
  return;
}

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

Martin Herrmann (author of Mapivi)

email: Martin-Herrmann\@gmx.de
EOT

  showText("Mapivi start nr. $nr", $text, NO_WAIT);
  return;
}

##############################################################
# showCopyright
##############################################################
sub showCopyright {
  print <<EOCopyright;

    Mapivi $version $svnrevision $version_date - Martin's Picture Viewer and Manager
    Copyright (C) 2002 - 2016  Martin Herrmann
    Mapivi comes with ABSOLUTELY NO WARRANTY.
    This is free software, and you are welcome to redistribute
    it under certain conditions.

EOCopyright
# in front of EOCopyright no blanks are allowed!
  return;
}

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