diff -Nru mapivi-0.9.1/Changes.txt mapivi-0.9.7/Changes.txt --- mapivi-0.9.1/Changes.txt 2006-10-31 03:18:30.000000000 +0000 +++ mapivi-0.9.7/Changes.txt 2008-02-21 21:02:54.000000000 +0000 @@ -1,3 +1,74 @@ +2008/02 mapivi version 0.9.7 ++ added 2008 copyright info + +2008/02 mapivi version 0.9.6 ++ added location window to search for and to add location informations (based on IPTC tags Country, Province/State, City, Sublocation) ++ revised the import dialog: removed mount/unmount ++ revised the import dialog: moved some options to a foldable frame ++ revised the import dialog: added an option to add a high rating to locked (write-protected) pictures ++ embedded a new Mapivi icon ++ added common key bindings to the dirtree and the picture frame ++ included patch to correct timezone calculation in case of migration over 24 hour border (Thanks Rene!) ++ included patch adding a third IPTC dialog layout (without categories) (Thanks Rene!) ++ show changed IPTC caption in main window if edited in IPTC dialog ++ added an ignore filter in search for duplicates ++ improved search for duplicates window + +2008/02 mapivi version 0.9.5 ++ improved usability in crop dialog (better mouse handling, 1/3-grid) ++ added evolution and mozilla-thunderbird as possible email clients ++ IPTC caption is now editable in main window (key: F4) ++ added support for RAW files (files are moved, copied rename along with their JPEG file) ++ added searching for duplicates by same creation date ++ improved and reordered several menus and added all layouts as menu entries ++ improved usability in change EXIF date/time dialog ++ usage of a proportional font in the keyword search (cloud tag) for better font sizing ++ increased number of maximal shown thumbnails from 1000 to 10000 ++ bug fix in IPTC dialog when editing several pictures with different settings ++ bug fix in search duplicated by file size ++ usage of nstore instead of store enables usage of search database across different OS + +2007/07 mapivi version 0.9.4 ++ Support for XMP sidecar files and WAV files (copy, move, rename them with JPEG file) ++ some experiments with encoded file and folder names (see Encode::encode) ++ replace some non-printable chars in IPTC data ++ Adaptations for keywords added from Picasa ++ improved user feedback (progressbar) when editing IPTC of several pictures ++ some work on fullscreen mode in main window and when pic is displayed in own window (key: F11) ++ new key (m) in search window to show selected picture in main window ++ the options window is smaller to fit on small screens, it may be closed with Ctrl-x (OK) or ESC (Cancel) + +2007/05 mapivi version 0.9.3 ++ when editing IPTC info of multiple pictures the dialog shows all common tags and keywords ++ added several lossless JPEG operations: add border, add relative border, add border aspect ratio, add watermark, ... ++ added icons to all menues (they are stored in configdir/icons) ++ added Image::ExifTool as an optional module ++ if ExifTool is available some XMP operations are supported (see Menu:Edit->XMP info ...) ++ more search options in the cloud tag: date range and rating range ++ keyword window may now be docked to the left or right side of the main window ++ TOP50 of most popular pictures has been replaced by TOP100 of best rated pictures (see special searches) ++ number of digits in the filename in the light box are calculated by the number of pictures (thanks to Yann Michel) ++ some parts of the old filename (e.g. the number) can now be reused in Smart rename (thanks to Thierry Daucourt) ++ better and more checks when adding new keywords to the hierarchy ++ decoration dialog offers the ImageMagick fonts now ++ progress dialog calculates the estimated total time for an operation ++ some experiments with encoded file and folder names (see Encode::encode) ++ renamed directory to folder + +2006/12 mapivi version 0.9.2 ++ new command line option -i to start with import wizard ++ new option to start import wizard at startup when a memory card is inserted ++ modified some default options ++ Mapivi now saves the last selected picture (optional) ++ code cleanup ++ support of three different date formats (yyyy-mm-dd, dd.mm.yyyy, mm/dd/yyyy) see line 6000 ++ check new keywords and categories for unsupported chars (slash and backslash) ++ support to delete multiple keywords/categories from the catalog at once ++ better progress info for tasks with undefined length ++ smart rename adds now a 3 digit number instead of a 2 digit number when needed ++ added some balloon help in the option window ++ some experiments with ExifTool (not yet active) + 2006/10 mapivi version 0.9.1 + several improvements for adding new keywords, e.g. new keywords may now also be ignored - the ignore list is saved in file keywords_ignore + the number of keywords in the keyword browser can be limited to the 100 most popular diff -Nru /tmp/qjJmUhMVAD/mapivi-0.9.1/debian/changelog /tmp/ojLru1ayL6/mapivi-0.9.7/debian/changelog --- mapivi-0.9.1/debian/changelog 2009-04-29 14:12:40.000000000 +0100 +++ mapivi-0.9.7/debian/changelog 2009-04-29 14:12:40.000000000 +0100 @@ -1,3 +1,25 @@ +mapivi (0.9.7-1) unstable; urgency=low + + * New upstream release + * Main upstream changes from 0.9.1 to 0.9.7 + - May now browse pictures by location (from IPTC data) + - Improved the Crop, EXIF date, Search-duplicate and the import dialog + - IPTC caption is now editable in main window + - Some XMP operations are now available (needs ExifTool) + - Added support for RAW, XMP and WAV files (files are moved, copied and + renamed along with their JPEG file) + - Added several lossless JPEG operations, like add border and add + watermark + - Several other improvements and bugfixes + * Removed Debian patch for timezone fix as it is now in upstream + * Added watchfile + * Added icons to /usr/share/mapivi + * Modified mapivi to read from /usr/share rather than copy to user's + homedir, per agreement with upstream + * Removed POD block that appears to have been a comment, not actual POD + + -- Rene Weber Fri, 03 Apr 2009 17:41:58 +0200 + mapivi (0.9.1-1) unstable; urgency=low * Initial release (Closes: #458460) diff -Nru /tmp/qjJmUhMVAD/mapivi-0.9.1/debian/control /tmp/ojLru1ayL6/mapivi-0.9.7/debian/control --- mapivi-0.9.1/debian/control 2009-04-29 14:12:40.000000000 +0100 +++ mapivi-0.9.7/debian/control 2009-04-29 14:12:40.000000000 +0100 @@ -3,15 +3,16 @@ Priority: optional Maintainer: Rene Weber Build-Depends: debhelper (>= 5) -Standards-Version: 3.7.2 +Standards-Version: 3.8.1 Package: mapivi Architecture: all Depends: ${perl:Depends}, perl-tk (>= 1:804.027-7), libimage-metadata-jpeg-perl (>= 0.15-1), libimage-info-perl (>= 1.23-2) -Recommends: libjpeg-progs, imagemagick, jhead +Recommends: libjpeg-progs, imagemagick, jhead, libimage-exiftool-perl Suggests: jpegpixi +Homepage: http://mapivi.sourceforge.net/mapivi.shtml Description: Photo viewer and organizer with emphasis on IPTC fields - Cross-platform (UNIX, Mac OS X and Windows) picture manager and organizer, + Cross-platform (UNIX, Mac OS X, and Windows) picture manager and organizer, Mapivi is a stand alone tool, there is no need for a web server, online access or a database. . diff -Nru /tmp/qjJmUhMVAD/mapivi-0.9.1/debian/copyright /tmp/ojLru1ayL6/mapivi-0.9.7/debian/copyright --- mapivi-0.9.1/debian/copyright 2009-04-29 14:12:40.000000000 +0100 +++ mapivi-0.9.7/debian/copyright 2009-04-29 14:12:40.000000000 +0100 @@ -5,7 +5,7 @@ Upstream Author: Martin Herrmann -Copyright: 2006 Martin Herrmann +Copyright: 2002, 2003, 2004, 2005, 2006, 2007, 2008 Martin Herrmann License: @@ -26,5 +26,5 @@ On Debian systems, the complete text of the GNU General Public License can be found in `/usr/share/common-licenses/GPL-2'. -The Debian packaging is (C) 2007, Rene Weber and +The Debian packaging is (C) 2009, Rene Weber and is licensed under the GPL, see above. diff -Nru /tmp/qjJmUhMVAD/mapivi-0.9.1/debian/menu /tmp/ojLru1ayL6/mapivi-0.9.7/debian/menu --- mapivi-0.9.1/debian/menu 2009-04-29 14:12:40.000000000 +0100 +++ mapivi-0.9.7/debian/menu 2009-04-29 14:12:40.000000000 +0100 @@ -1,2 +1,2 @@ -?package(mapivi):needs="X11" section="Apps/Graphics"\ +?package(mapivi):needs="X11" section="Applications/Graphics"\ title="mapivi" command="/usr/bin/mapivi" diff -Nru /tmp/qjJmUhMVAD/mapivi-0.9.1/debian/patches/01_usrShareMapivi /tmp/ojLru1ayL6/mapivi-0.9.7/debian/patches/01_usrShareMapivi --- mapivi-0.9.1/debian/patches/01_usrShareMapivi 2009-04-29 14:12:40.000000000 +0100 +++ mapivi-0.9.7/debian/patches/01_usrShareMapivi 1970-01-01 01:00:00.000000000 +0100 @@ -1,45 +0,0 @@ ---- mapivi.orig 2005-03-20 14:19:55.000000000 -0500 -+++ mapivi 2005-12-24 08:09:30.000000000 -0500 -@@ -110,6 +110,9 @@ - - =cut - -+# DEBIAN ADDITIONS -+my $usr_datafiles="/usr/share/mapivi"; -+ - my $EvilOS = 0; # boolean, if we run on Windows this is 1 - my $MacOSX = 0; # boolean, if we run on Mac OS X this is 1 - if ($^O =~ m/win/i) { -@@ -17015,9 +17022,9 @@ - return if (!-d $configdir); - - # try to find the pictures in the actual dir and in the dir where mapivi is located -- my $searchdir = dirname($0)."/pics"; -+ my $searchdir = "${usr_datafiles}/pics"; - my @pics; -- my @searchDirList = ("$actdir/pics", dirname($0)."/pics"); -+ my @searchDirList = ("$actdir/pics", "${usr_datafiles}/pics"); - foreach $searchdir (@searchDirList) { - print "searching $searchdir ...\n" if $verbose; - next if (!-d $searchdir); -@@ -17058,7 +17065,7 @@ - return if (!-d $configdir); - - my @files = qw/Changes.txt License.txt Tips.txt FAQ/; -- my $dir = dirname($0); -+ my $dir = $usr_datafiles; - - # copy the files to the config dir - foreach (@files) { -@@ -17076,9 +17083,9 @@ - return if (!-d $plugindir); - - # try to find the PlugIns in the actual dir and in the dir where mapivi is located -- my $searchdir = dirname($0)."/PlugIns"; -+ my $searchdir = "${usr_datafiles}/PlugIns"; - my @plugs; -- my @searchDirList = ("$actdir/PlugIns", dirname($0)."/PlugIns"); -+ my @searchDirList = ("$actdir/PlugIns", "${usr_datafiles}/PlugIns"); - foreach $searchdir (@searchDirList) { - print "searching $searchdir ...\n" if $verbose; - next if (!-d $searchdir); diff -Nru /tmp/qjJmUhMVAD/mapivi-0.9.1/debian/patches/02_whereIsPerl /tmp/ojLru1ayL6/mapivi-0.9.7/debian/patches/02_whereIsPerl --- mapivi-0.9.1/debian/patches/02_whereIsPerl 2009-04-29 14:12:40.000000000 +0100 +++ mapivi-0.9.7/debian/patches/02_whereIsPerl 1970-01-01 01:00:00.000000000 +0100 @@ -1,13 +0,0 @@ ---- mapivi.orig 2005-03-20 14:19:55.000000000 -0500 -+++ mapivi 2005-12-24 08:09:30.000000000 -0500 -@@ -2050,6 +2053,10 @@ - ############################################################## - sub whereIsPerl { - -+ # For this copy of mapivi, you don't need to do any processing under -+ # Debian, /usr/bin/perl is always correct. -+ return if ( -f "/etc/debian_version" ); -+ - return if $EvilOS; - - # look for perl diff -Nru /tmp/qjJmUhMVAD/mapivi-0.9.1/debian/patches/04_tzCorrectGMT /tmp/ojLru1ayL6/mapivi-0.9.7/debian/patches/04_tzCorrectGMT --- mapivi-0.9.1/debian/patches/04_tzCorrectGMT 2009-04-29 14:12:40.000000000 +0100 +++ mapivi-0.9.7/debian/patches/04_tzCorrectGMT 1970-01-01 01:00:00.000000000 +0100 @@ -1,16 +0,0 @@ ---- mapivi.orig 2005-12-26 16:17:45.805810000 -0500 -+++ mapivi 2005-12-26 16:23:09.516022970 -0500 -@@ -8240,6 +8240,13 @@ - if (my ($y, $M, $d, $h, $m, $s) = $date =~ m/(\d\d\d\d):(\d\d):(\d\d) (\d\d):(\d\d):(\d\d)/) { - my $time = timelocal($s,$m,$h,$d,($M-1),($y-1900)); - my $diff = ((localtime($time))[2] - (gmtime($time))[2]); -+ # RJW: Correct timezone calculation in case of migration over -+ # 24 hour border -+ if ( $diff > 12 ) { -+ $diff -= 24; -+ } elsif ( $diff < -12 ) { -+ $diff += 24; -+ } - my $GMToffset = sprintf("%+03d00", $diff); - my $IPTCdate = $y.$M.$d; - my $IPTCtime = $h.$m.$s.$GMToffset; diff -Nru /tmp/qjJmUhMVAD/mapivi-0.9.1/debian/patches/07_usrShareMapivi /tmp/ojLru1ayL6/mapivi-0.9.7/debian/patches/07_usrShareMapivi --- mapivi-0.9.1/debian/patches/07_usrShareMapivi 1970-01-01 01:00:00.000000000 +0100 +++ mapivi-0.9.7/debian/patches/07_usrShareMapivi 2009-04-29 14:12:40.000000000 +0100 @@ -0,0 +1,160 @@ +--- mapivi.orig 2008-02-21 21:53:44.000000000 +0100 ++++ mapivi 2009-03-16 16:50:53.000000000 +0100 +@@ -147,12 +147,13 @@ + } + # for windows we use this path + $maprogsdir = $ENV{APPDATA}."/maprogs" if defined $ENV{APPDATA}; ++my $usrshare = "/usr/share/mapivi"; # where static data is held + my $configdir = "$maprogsdir/mapivi"; # the configuration dir +-my $icon_path = "$configdir/icons"; # the icon dir ++my $icon_path = "$usrshare/icons"; # the icon dir + + my $splashAvail = (eval "require Tk::Splash") ? 1 : 0 ; + my $splash; +-my $logo = "$configdir/logo.jpg"; ++my $logo = "$usrshare/pics/logo.jpg"; + if ($splashAvail and -f $logo) { + # Splash->Show parameters: $image, $width, $height, $title, $overrideredirect + $splash = Tk::Splash->Show($logo, 844, 259, "", 1); +@@ -360,14 +361,14 @@ + my $maxCommentLength = 2**16 - 3; # a comment block may have max 64kB + + my $trashdir = "$configdir/trash"; # the trashcan +-my $plugindir = "$configdir/PlugIns"; # the mapivi plugin dir ++my $plugindir = "$usrshare/PlugIns"; # the mapivi plugin dir + my $iptcdir = "$configdir/IPTC_templates"; # the IPTC templates folder + my $configFile = "$configdir/mapivirc"; # the configuration file + my $file_Entry_values = "$configdir/Entry_values"; + my $exifdirname = ".exif"; # the subdir to store exif infos + my $thumbdirname = ".thumbs"; # the subdir to store thumbnails + my $xvpicsdirname = ".xvpics"; # a subdir from GIMP we usualy ignore +-my $thumbExample = "$configdir/thumbExample.jpg"; ++my $thumbExample = "$usrshare/pics/thumbExample.jpg"; + my $nonJPEGsuffixes = "gif|png|tif|tiff|bmp|ppm|ps"; # xcf works, but makes problems with layers + my $cameraJunkSuffixes = "ctg"; # uninteresting files created by cameras + my $copyright_year = (localtime(time()))[5] + 1900; # the actual year, for the copyright notice +@@ -544,7 +545,7 @@ + "ColorThumbBG" => "azure3", + "ColorProgress" => "#106dba", + "ColorPicker" => "#efefef", # last color selected with color picker +- "DefaultThumb" => "$configdir/EmptyThumb.jpg", ++ "DefaultThumb" => "$usrshare/pics/EmptyThumb.jpg", + "Copyright" => "copyright (c) $copyright_year Herrmann", + "Comment" => "This picture was taken in south africa ...", + "MaxProcs" => 1, +@@ -677,7 +678,7 @@ + "CopyFontColFG" => "white", # foreground color of the embedded copyright info font + "CopyFontColBG" => "black", # background color of the embedded copyright info font + "CopyFontShadow" => 1, # bool - add a shadow to the copyright text +- "CopyrightLogo" => "$configdir/MapiviIcon.gif", ++ "CopyrightLogo" => "$usrshare/pics/MapiviIcon.gif", + "CopyTextOrLogo" => "text", + "BorderWidth1x" => 10, # border 1 width in x direction + "BorderWidth1y" => 10, # border 1 width in y direction +@@ -845,7 +846,7 @@ + 'AutoImport' => 1, # boolean = 1 start import at Mapivi wizard if memory card is inserted (ImportSource) + 'llWatermarkX' => 16, # lossless watermark x position + 'llWatermarkY' => -16, # lossless watermark y position +- 'llWatermarkFile' => "$configdir/EmptyThumb.jpg", # lossless watermark file name ++ 'llWatermarkFile' => "$usrshare/pics/EmptyThumb.jpg", # lossless watermark file name + 'AspectBorderN' => 3, # lossless aspect ratio border + 'AspectBorderM' => 2, # lossless aspect ratio border + 'RelativeBorderX' => 10, # lossless relative border +@@ -1083,14 +1084,14 @@ + dKyyLnF00kjQlkTSR9GqxBKzyS6bEbY0EestAAEBADs= + EOF + my $mapiviicon = $top->Photo(-data => $icon_data); +-my $mapiviiconfile = "$configdir/MapiviIcon.gif"; +-$mapiviiconfile = "$configdir/MapiviIcon32.gif" if $EvilOS; ++my $mapiviiconfile = "$usrshare/pics/MapiviIcon.gif"; ++$mapiviiconfile = "$usrshare/pics/MapiviIcon32.gif" if $EvilOS; + #my $mapiviicon = $top->Photo(-file => $mapiviiconfile) if (-f $mapiviiconfile); + $top->idletasks if $EvilOS; # this line is crucial (at least on windows) + $top->iconimage($mapiviicon) if $mapiviicon; + +-my $dragAndDrop1 = "$configdir/MiniPic.jpg"; +-my $dragAndDrop2 = "$configdir/MiniPicMulti.jpg"; ++my $dragAndDrop1 = "$usrshare/pics/MiniPic.jpg"; ++my $dragAndDrop2 = "$usrshare/pics/MiniPicMulti.jpg"; + my $dragAndDropIcon1 = $top->Photo(-file => $dragAndDrop1) if (-f $dragAndDrop1); + my $dragAndDropIcon2 = $top->Photo(-file => $dragAndDrop2) if (-f $dragAndDrop2); + +@@ -13682,10 +13683,10 @@ + $help_menu->command(-image => compound_menu($top, 'About', 'dialog-information.png'), -command => \&about); + $help_menu->command(-image => compound_menu($top, 'Keys', 'input-keyboard.png'), -command => \&showkeys); + $help_menu->command(-image => compound_menu($top, 'System information', 'utilities-system-monitor.png'), -command => \&systemInfo); +- $help_menu->command(-image => compound_menu($top, 'License', ''), -command => [\&showFile, "$configdir/License.txt"]) if (-f "$configdir/License.txt"); +- $help_menu->command(-image => compound_menu($top, 'History', ''), -command => [\&showFile, "$configdir/Changes.txt"]) if (-f "$configdir/Changes.txt"); +- $help_menu->command(-image => compound_menu($top, 'Tips', 'help-browser.png'), -command => sub { showFile("$configdir/Tips.txt") }) if (-f "$configdir/Tips.txt"); +- $help_menu->command(-image => compound_menu($top, 'FAQ', 'help-browser.png'), -command => [\&showFile, "$configdir/FAQ"]) if (-f "$configdir/FAQ"); ++ $help_menu->command(-image => compound_menu($top, 'License', ''), -command => [\&showFile, "$usrshare/License.txt"]) if (-f "$usrshare/License.txt"); ++ $help_menu->command(-image => compound_menu($top, 'History', ''), -command => [\&showFile, "$usrshare/Changes.txt"]) if (-f "$usrshare/Changes.txt"); ++ $help_menu->command(-image => compound_menu($top, 'Tips', 'help-browser.png'), -command => sub { showFile("$usrshare/Tips.txt") }) if (-f "$usrshare/Tips.txt"); ++ $help_menu->command(-image => compound_menu($top, 'FAQ', 'help-browser.png'), -command => [\&showFile, "$usrshare/FAQ"]) if (-f "$usrshare/FAQ"); + + $top->configure(-menu => $menubar) if $config{ShowMenu}; + } +@@ -16381,7 +16382,7 @@ + my $picName = shift; + my $func = shift; + +- my $pic = "$configdir/$picName"; ++ my $pic = "$usrshare/pics/$picName"; + my $image = $parentWidget->Photo(-file => $pic) if -f $pic; + + if ($image) { +@@ -20396,7 +20397,7 @@ + if (!-d $configdir) { + # ask the user for permission to create a configdir + my $rc = $top->messageBox(-icon => 'question', +- -message => "MaPiVi would like to create a folder \"$configdir\" in your home folder to store the configuration of Mapivi and some button and background pictures.", ++ -message => "MaPiVi would like to create a folder \"$configdir\" in your home folder to store the configuration of Mapivi.", + -title => "Mapivi installation", -type => 'OKCancel'); + return if ($rc !~ m/Ok/i); + } +@@ -20436,7 +20437,9 @@ + + if (!-d $plugindir) { + if ( !mkdir "$plugindir", 0755 ) { +- $top->messageBox(-icon => 'warning', -message => "Error making PlugIn dir $plugindir: $!", ++ # RJW: This will likely not work if $usrshare is /usr/share/mapivi ++ # and the user is not root. ++ $top->messageBox(-icon => 'warning', -message => "Error making PlugIn dir $plugindir (should be created by installer?): $!", + -title => "Mapivi installation", -type => 'OK'); + return; + } +@@ -23741,7 +23744,7 @@ + my $stopB = $subF->Button(-text => "Stop", + -command => sub { $stop = 1; } + )->pack(-side => 'left', -anchor => 'w', -expand => 0,-padx => 1,-pady => 1); +- my $stopImg = $top->Photo(-file => "$configdir/StopPic.gif") if (-f "$configdir/StopPic.gif"); ++ my $stopImg = $top->Photo(-file => "$usrshare/pics/StopPic.gif") if (-f "$usrshare/pics/StopPic.gif"); + $stopB->configure(-image => $stopImg, -borderwidth => 0) if $stopImg; + $stopB->configure(-state => "disabled"); + +@@ -24896,7 +24899,7 @@ + $stopB = $SButF->Button(-text => "Stop", + -command => sub { $stop = 1; } + )->pack(-side => 'left', -anchor => 'w', -expand => 0,-padx => 1,-pady => 1); +- my $stopImg = $top->Photo(-file => "$configdir/StopPic.gif") if (-f "$configdir/StopPic.gif"); ++ my $stopImg = $top->Photo(-file => "$usrshare/pics/StopPic.gif") if (-f "$usrshare/pics/StopPic.gif"); + $stopB->configure(-image => $stopImg, -borderwidth => 0) if $stopImg; + $stopB->configure(-state => "disabled"); + +@@ -28742,7 +28745,7 @@ + my $stopB = $butF->Button(-text => "Stop", + -command => sub { $stop = 1; } + )->pack(-side => 'left', -anchor => 'w', -expand => 0,-padx => 1,-pady => 1); +- my $stopImg = $top->Photo(-file => "$configdir/StopPic.gif") if (-f "$configdir/StopPic.gif"); ++ my $stopImg = $top->Photo(-file => "$usrshare/pics/StopPic.gif") if (-f "$usrshare/pics/StopPic.gif"); + $stopB->configure(-image => $stopImg, -borderwidth => 0) if $stopImg; + $stopB->configure(-state => "disabled"); + +@@ -29425,6 +29428,7 @@ + + my $string = << "EOA"; + Mapivi config dir: $configdir ++ Mapivi static dir: $usrshare + + Perl version: $perlversion + Perl/Tk version: $Tk::VERSION diff -Nru /tmp/qjJmUhMVAD/mapivi-0.9.1/debian/patches/08_removeMousePod /tmp/ojLru1ayL6/mapivi-0.9.7/debian/patches/08_removeMousePod --- mapivi-0.9.1/debian/patches/08_removeMousePod 1970-01-01 01:00:00.000000000 +0100 +++ mapivi-0.9.7/debian/patches/08_removeMousePod 2009-04-29 14:12:40.000000000 +0100 @@ -0,0 +1,40 @@ +--- mapivi.orig 2008-02-21 21:53:44.000000000 +0100 ++++ mapivi 2009-04-03 17:41:00.000000000 +0200 +@@ -8110,37 +8110,6 @@ + } )->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 1, -pady => 1); + $balloon->attach($addB, -msg => "Add the selected keywords to the selected pictures"); + +-=pod +- +- my $rmB = +- $af->Button(-text => "remove", +- -command => sub { +- my @keys = $keytree->info('selection'); +- return unless checkSelection($keycw, 1, 0, \@keys); +- my @sellist = $lb->info('selection'); +- return unless checkSelection($top, 1, 0, \@sellist); +- my $pw = progressWinInit($keycw, "Remove keyword"); +- my $i = 0; +- my $sum = @sellist; +- foreach my $dpic (@sellist) { +- last if progressWinCheck($pw); +- $i++; +- progressWinUpdate($pw, "removing keyword ($i/$sum) ...", $i, $sum); +- foreach my $key (@keys) { +- last if progressWinCheck($pw); +- progressWinUpdate($pw, "removing keyword $key ($i/$sum) ...", $i, $sum); +- my $name = getLastItem($key); +- print "remove key $name ($key) from $dpic\n" if $verbose; +- removeIPTCItem($dpic, 'Keywords', $name); +- updateOneRow($dpic, $lb); +- } +- } +- progressWinEnd($pw); +- })->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 1, -pady => 1); +- $balloon->attach($rmB, -msg => "Remove the selected keywords from the selected pictures"); +- +-=cut +- + $keytree = $keycw->Scrolled('Tree', + -separator => '/', + -scrollbars => 'osoe', diff -Nru /tmp/qjJmUhMVAD/mapivi-0.9.1/debian/patches/DISABLED.01_usrShareMapivi /tmp/ojLru1ayL6/mapivi-0.9.7/debian/patches/DISABLED.01_usrShareMapivi --- mapivi-0.9.1/debian/patches/DISABLED.01_usrShareMapivi 1970-01-01 01:00:00.000000000 +0100 +++ mapivi-0.9.7/debian/patches/DISABLED.01_usrShareMapivi 2009-04-29 14:12:40.000000000 +0100 @@ -0,0 +1,44 @@ +--- mapivi.orig 2008-02-21 21:53:44.000000000 +0100 ++++ mapivi 2009-03-15 13:32:19.000000000 +0100 +@@ -118,6 +118,9 @@ + + =cut + ++# DEBIAN ADDITIONS ++my $usr_datafiles="/usr/share/mapivi"; ++ + # 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 +@@ -20455,7 +20458,7 @@ + # try to find the pictures in the actual dir and in the dir where mapivi is located + my $searchdir; + my @pics; +- my @searchDirList = ("$actdir/pics", dirname($0)."/pics"); ++ my @searchDirList = ("$actdir/pics", "${usr_datafiles}/pics", dirname($0)."/pics"); + foreach $searchdir (@searchDirList) { + print "searching $searchdir ...\n" if $verbose; + next if (!-d $searchdir); +@@ -20495,7 +20498,8 @@ + return if (!-d $configdir); + + my @files = qw/Changes.txt License.txt Tips.txt FAQ/; +- my $dir = dirname($0); ++ # Below was dirname($0), but in Debian, it'll always be in $usr_datafiles ++ my $dir = $usr_datafiles; + + # copy the files to the config dir + foreach (@files) { +@@ -20513,9 +20517,10 @@ + return if (!-d $plugindir); + + # try to find the PlugIns in the actual dir and in the dir where mapivi is located +- my $searchdir = dirname($0)."/PlugIns"; ++ # Below was dirname($0)/PlugIns, but in Debian, it'll always be $usr_datafiles ++ my $searchdir = "${usr_datafiles}/PlugIns"; + my @plugs; +- my @searchDirList = ("$actdir/PlugIns", dirname($0)."/PlugIns"); ++ my @searchDirList = ("$actdir/PlugIns", "${usr_datafiles}/PlugIns", dirname($0)."/PlugIns"); + foreach $searchdir (@searchDirList) { + print "searching $searchdir ...\n" if $verbose; + next if (!-d $searchdir); diff -Nru /tmp/qjJmUhMVAD/mapivi-0.9.1/debian/patches/DISABLED.02_whereIsPerl /tmp/ojLru1ayL6/mapivi-0.9.7/debian/patches/DISABLED.02_whereIsPerl --- mapivi-0.9.1/debian/patches/DISABLED.02_whereIsPerl 1970-01-01 01:00:00.000000000 +0100 +++ mapivi-0.9.7/debian/patches/DISABLED.02_whereIsPerl 2009-04-29 14:12:40.000000000 +0100 @@ -0,0 +1,13 @@ +--- mapivi.orig 2005-03-20 14:19:55.000000000 -0500 ++++ mapivi 2005-12-24 08:09:30.000000000 -0500 +@@ -2050,6 +2053,10 @@ + ############################################################## + sub whereIsPerl { + ++ # For this copy of mapivi, you don't need to do any processing under ++ # Debian, /usr/bin/perl is always correct. ++ return if ( -f "/etc/debian_version" ); ++ + return if $EvilOS; + + # look for perl diff -Nru /tmp/qjJmUhMVAD/mapivi-0.9.1/debian/patches/DISABLED.04_tzCorrectGMT /tmp/ojLru1ayL6/mapivi-0.9.7/debian/patches/DISABLED.04_tzCorrectGMT --- mapivi-0.9.1/debian/patches/DISABLED.04_tzCorrectGMT 1970-01-01 01:00:00.000000000 +0100 +++ mapivi-0.9.7/debian/patches/DISABLED.04_tzCorrectGMT 2009-04-29 14:12:40.000000000 +0100 @@ -0,0 +1,16 @@ +--- mapivi.orig 2005-12-26 16:17:45.805810000 -0500 ++++ mapivi 2005-12-26 16:23:09.516022970 -0500 +@@ -8240,6 +8240,13 @@ + if (my ($y, $M, $d, $h, $m, $s) = $date =~ m/(\d\d\d\d):(\d\d):(\d\d) (\d\d):(\d\d):(\d\d)/) { + my $time = timelocal($s,$m,$h,$d,($M-1),($y-1900)); + my $diff = ((localtime($time))[2] - (gmtime($time))[2]); ++ # RJW: Correct timezone calculation in case of migration over ++ # 24 hour border ++ if ( $diff > 12 ) { ++ $diff -= 24; ++ } elsif ( $diff < -12 ) { ++ $diff += 24; ++ } + my $GMToffset = sprintf("%+03d00", $diff); + my $IPTCdate = $y.$M.$d; + my $IPTCtime = $h.$m.$s.$GMToffset; diff -Nru /tmp/qjJmUhMVAD/mapivi-0.9.1/debian/patches/OLD.01_usrShareMapivi /tmp/ojLru1ayL6/mapivi-0.9.7/debian/patches/OLD.01_usrShareMapivi --- mapivi-0.9.1/debian/patches/OLD.01_usrShareMapivi 1970-01-01 01:00:00.000000000 +0100 +++ mapivi-0.9.7/debian/patches/OLD.01_usrShareMapivi 2009-04-29 14:12:40.000000000 +0100 @@ -0,0 +1,45 @@ +--- mapivi.orig 2005-03-20 14:19:55.000000000 -0500 ++++ mapivi 2005-12-24 08:09:30.000000000 -0500 +@@ -110,6 +110,9 @@ + + =cut + ++# DEBIAN ADDITIONS ++my $usr_datafiles="/usr/share/mapivi"; ++ + my $EvilOS = 0; # boolean, if we run on Windows this is 1 + my $MacOSX = 0; # boolean, if we run on Mac OS X this is 1 + if ($^O =~ m/win/i) { +@@ -17015,9 +17022,9 @@ + return if (!-d $configdir); + + # try to find the pictures in the actual dir and in the dir where mapivi is located +- my $searchdir = dirname($0)."/pics"; ++ my $searchdir = "${usr_datafiles}/pics"; + my @pics; +- my @searchDirList = ("$actdir/pics", dirname($0)."/pics"); ++ my @searchDirList = ("$actdir/pics", "${usr_datafiles}/pics"); + foreach $searchdir (@searchDirList) { + print "searching $searchdir ...\n" if $verbose; + next if (!-d $searchdir); +@@ -17058,7 +17065,7 @@ + return if (!-d $configdir); + + my @files = qw/Changes.txt License.txt Tips.txt FAQ/; +- my $dir = dirname($0); ++ my $dir = $usr_datafiles; + + # copy the files to the config dir + foreach (@files) { +@@ -17076,9 +17083,9 @@ + return if (!-d $plugindir); + + # try to find the PlugIns in the actual dir and in the dir where mapivi is located +- my $searchdir = dirname($0)."/PlugIns"; ++ my $searchdir = "${usr_datafiles}/PlugIns"; + my @plugs; +- my @searchDirList = ("$actdir/PlugIns", dirname($0)."/PlugIns"); ++ my @searchDirList = ("$actdir/PlugIns", "${usr_datafiles}/PlugIns"); + foreach $searchdir (@searchDirList) { + print "searching $searchdir ...\n" if $verbose; + next if (!-d $searchdir); diff -Nru /tmp/qjJmUhMVAD/mapivi-0.9.1/debian/rules /tmp/ojLru1ayL6/mapivi-0.9.7/debian/rules --- mapivi-0.9.1/debian/rules 2009-04-29 14:12:40.000000000 +0100 +++ mapivi-0.9.7/debian/rules 2009-04-29 14:12:40.000000000 +0100 @@ -35,7 +35,7 @@ # Apply patches for PATCHF in debian/patches/[0-9]*; do patch -p 0 < $${PATCHF}; done - rm mapivi.orig + #rm mapivi.orig # Add here commands to compile the package. #$(MAKE) @@ -69,15 +69,16 @@ # reading/displaying. install -p -m 644 Changes.txt Tips.txt FAQ License.txt ${CURDIR}/debian/mapivi/usr/share/mapivi #ln -sv /usr/share/common-licenses/GPL-2 ${CURDIR}/debian/mapivi/usr/share/mapivi/License.txt - cp -rp pics/ PlugIns/ html/ ${CURDIR}/debian/mapivi/usr/share/mapivi - # Correct permissions (previously executeable) of pictures and css + cp -rp icons pics PlugIns html ${CURDIR}/debian/mapivi/usr/share/mapivi/ + # Correct permissions (previously executeable) + chmod 644 ${CURDIR}/debian/mapivi/usr/share/mapivi/icons/* chmod 644 ${CURDIR}/debian/mapivi/usr/share/mapivi/pics/* chmod 644 ${CURDIR}/debian/mapivi/usr/share/mapivi/html/* cp -p mapivi ${CURDIR}/debian/mapivi/usr/bin # Undo patches for PATCHF in debian/patches/[0-9]*; do patch -R -p 0 < $${PATCHF}; done - rm mapivi.orig + #rm mapivi.orig # Build architecture-independent files here. binary-indep: build install diff -Nru /tmp/qjJmUhMVAD/mapivi-0.9.1/debian/watch /tmp/ojLru1ayL6/mapivi-0.9.7/debian/watch --- mapivi-0.9.1/debian/watch 1970-01-01 01:00:00.000000000 +0100 +++ mapivi-0.9.7/debian/watch 2009-04-29 14:12:40.000000000 +0100 @@ -0,0 +1,4 @@ +version=3 + +# watch control file for mapivi +http://sf.net/mapivi/mapivi(\d)(\d)(\d)\.tar\.gz diff -Nru /tmp/qjJmUhMVAD/mapivi-0.9.1/FAQ /tmp/ojLru1ayL6/mapivi-0.9.7/FAQ --- mapivi-0.9.1/FAQ 2006-10-02 02:18:47.000000000 +0100 +++ mapivi-0.9.7/FAQ 2007-05-13 20:52:31.000000000 +0100 @@ -16,7 +16,7 @@ Example: adding a comment of 30 chars to a 1MB picture will increase the file size about 0.03%. -3. How many comments are allowed in a JPEG picture? +3. How many comments are allowed in a JPEG picture? From the wrjpgcom man page: The JPEG standard allows "comment" (COM) blocks to occur @@ -29,6 +29,9 @@ block is 64K, but you can have as many of them as you like in one JPEG file. + However I recommend using IPTC instead of JPEG comments, see + question 25. + 4. How do I work with comments? Simply select a picture to comment and press , enter the @@ -247,18 +250,16 @@ 20. How to use hierarchical keywords and categories? If there is no tree visible in the "edit keywords" or "edit categories" - dialog, follow these steps: - Quit Mapivi, use a file manager or the shell, change to directory - ~/.maprogs/mapivi/ and rename file keywords to keywords.old and file - categories to categories.old - Then restart Mapivi, open menu: Edit->IPTC Info->edit keywords ... and - you will see an example keyword tree. You may edit this tree using the - popup menu (press the right mouse button to open it). - A double click on a keyword will insert it in the IPTC information - of all selected pictures. + dialog press the right mouse button and add some items. + A double click on a keyword will insert it in the IPTC segment + of all selected pictures. + + I recommend using the join mode. In this mode Mapivi will store + your keyword hierarchie in the pictures. You can retrieve the + hierarchie anytime later by simply browsing your pictures. Hint: According to the IPTC standard, supplemental categories are - depricated. Based on that I recommend using just the IPTC + depricated. Based on that I recommend using only IPTC keywords. 21. Is it possible to search for pictures stored on an external media @@ -278,7 +279,7 @@ - As Mapivi will just show the path to the picture (e.g. /media/dvd/pic1.jpg or D:\pic1.jpg) it is recommended to use a CD/DVD folder structure with unambiguous naming e.g. dates like - 2005/200510/20051026_Party/ + 20051026_Party/ this will help you to find the right CD/DVD - If you didn't use Mapivi for deleting the pictures you should select Mapivi menu: Search->clean database ... @@ -286,7 +287,7 @@ - For thumbnails see next question 22. When I find pictures stored on external media (e.g. CD, DVD, - USB-Stick, external HD no thumbnails are shown. + USB-Stick, external hard disk no thumbnails are shown. Can this be changed? Or: Is it possible to show the thumbnails of pictures @@ -298,8 +299,8 @@ 3. Select media root folder (e.g. /media/dvd for UNIX or D:\ for Windows) in Mapivi directory tree 4. Select Mapivi menu: Extra->build thumbs in all sub directories ... - Mapivi will store these thumbnails in a central folder if - the media is not writable. + Mapivi will store these thumbnails automatically in a central + folder if the media is not writable. 23. Does Mapivi store the thumbnails? Where are they stored? @@ -342,7 +343,7 @@ umlaute, accents etc. in IPTC meta information? No, currently there is no support for this in Mapivi. - Anyhow, it’s possible to add and see them in the IPTC dialog, + Anyhow, it is possible to add and see them in the IPTC dialog, but they are not correctly displayed in the thumbnail list and it is not possible to search for words with umlauts, accents etc. I still haven't figured out how to handle this properly in Mapivi @@ -360,7 +361,7 @@ It's not a Mapivi, but a PerlTk bug, thus all PerlTk applications stop with a segmentation fault, when a gnome application is started. -28. Will image quality decrease when adding meta data? +28. Will image quality decrease when adding or editing meta data? Is there a recompression of my picture when I add or change IPTC information? Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/accessories-text-editor.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/accessories-text-editor.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/applications-graphics.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/applications-graphics.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/applications-internet.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/applications-internet.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/camera-photo.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/camera-photo.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/dialog-error.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/dialog-error.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/dialog-information.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/dialog-information.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/edit-copy.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/edit-copy.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/edit-cut.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/edit-cut.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/edit-find.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/edit-find.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/edit-paste.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/edit-paste.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/edit-redo.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/edit-redo.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/emblem-favorite.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/emblem-favorite.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/folder-new.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/folder-new.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/folder.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/folder.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/go-first.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/go-first.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/go-last.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/go-last.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/go-next.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/go-next.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/go-previous.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/go-previous.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/help-browser.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/help-browser.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/image-x-generic-bw.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/image-x-generic-bw.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/image-x-generic.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/image-x-generic.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/input-keyboard.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/input-keyboard.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/list-add.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/list-add.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/list-remove.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/list-remove.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/mail-message-new.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/mail-message-new.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/media-floppy.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/media-floppy.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/media-playback-start.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/media-playback-start.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/preferences-system.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/preferences-system.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/printer.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/printer.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/system-log-out.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/system-log-out.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/system-search.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/system-search.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/transform-rotate.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/transform-rotate.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/transform-scale.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/transform-scale.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/user-desktop.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/user-desktop.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/user-trash.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/user-trash.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/utilities-system-monitor.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/utilities-system-monitor.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/view-fullscreen.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/view-fullscreen.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/view-refresh.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/view-refresh.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/weather-overcast.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/weather-overcast.png differ Binary files /tmp/qjJmUhMVAD/mapivi-0.9.1/icons/x-office-calendar.png and /tmp/ojLru1ayL6/mapivi-0.9.7/icons/x-office-calendar.png differ diff -Nru /tmp/qjJmUhMVAD/mapivi-0.9.1/INSTALL /tmp/ojLru1ayL6/mapivi-0.9.7/INSTALL --- mapivi-0.9.1/INSTALL 2006-09-24 19:40:19.000000000 +0100 +++ mapivi-0.9.7/INSTALL 2008-02-21 20:46:52.000000000 +0000 @@ -10,7 +10,7 @@ Mapivi supports adding, viewing and editing of JPEG meta informations like: EXIF, IPTC/IIM and JPEG comments. -File INSTALL last modified: 24.09.2006 +File INSTALL last modified: 21.02.2008 Mapivi latest version can be found at: http://mapivi.de.vu and http://sourceforge.net/projects/mapivi (download) @@ -60,6 +60,56 @@ o optional: gimp-remote (for UNIX etc.) or gimp-win-remote (for Windows) ########################################################################## +# +# Installation of Perl modules +# +########################################################################## + +To install a Perl module you may either try cpan (a) or for Windows ppm (b) or do a manual (c) install. + +(a) +Cpan will download a module (and all modules it depends on), build and +install it. All you have to do is open a shell and type: + + cpan module_name + +Example to install the Perl module Image::Info: + + cpan Image::Info + +You may need root permissions for this step, try e.g. + + sudo cpan Image::Info + +(b) +ppm is the Perl Package Manager for Windows it will download a +module (and all modules it depends on), build and install it. +All you have to do is open a DOS box (cmd) and type: + + ppm install module_name + +Example to install the Perl module Image::Info: + + ppm install Image::Info + +(c) +For a manual install you must download the Perl module at e.g. +http://search.cpan.org/, unzip and unpack it. +The module can now be built using this sequence of commands: + + perl Makefile.PL + make + make test + +To install the module, run the command below: + + make install + +You may need root permissions for this step, try e.g. + + sudo make install + +########################################################################## # # Installation of Perl distribution for UNIX # @@ -231,12 +281,26 @@ ########################################################################## # -# Installation of Mapivi PlugIns +# Installation of other Mapivi files and PlugIns # ########################################################################## -Plug-Ins are executable applications which are stored in the Mapivi config -sub folder PlugIns (on UNIX: ~/.maprogs/mapivi/PlugIns). +Most of the files provided in the Mapivi Perl package should be copied to +the configuration folder of Mapivi (UNIX: ~/.maprogs/mapivi/PlugIns, +Windows: C:\Documents and Setting\\Application Data\maprogs\mapivi). +Mapivi will run without this step, but it will provide more features and look better if you do! :) + +Copy the files Changes.txt, FAQ, License,txt, Tips.txt to the configuration folder. +Copy all pictures from the subfolder pics (like EmptyThumb.jpg, logo.jpg, MiniPic.jpg, add.gif) +to the configuration folder (no subfolder here). + +Copy the complete icon folder (containing edit-copy.png, folder.png, go-next.png, ...) +to the configuration folder. +Copy the complete PlugIns folder (containing Channel-Separator, Join-RGB, ...) +to the configuration folder. + +Plug-Ins are executable applications which are stored in the Mapivi configuration +sub folder PlugIns (UNIX: ~/.maprogs/mapivi/PlugIns, windows see above and add \PlugIns). They are called by Mapivi with the selected pictures (each with complete path) as arguments. The example PlugIns contained in the Mapivi distributions are written in diff -Nru /tmp/qjJmUhMVAD/mapivi-0.9.1/License.txt /tmp/ojLru1ayL6/mapivi-0.9.7/License.txt --- mapivi-0.9.1/License.txt 2006-02-14 19:29:53.000000000 +0000 +++ mapivi-0.9.7/License.txt 2008-02-21 20:52:31.000000000 +0000 @@ -1,5 +1,5 @@ Mapivi - Martin's Picture Viewer -Copyright (C) 2002, 2003, 2004, 2005, 2006 Martin Herrmann +Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Martin Herrmann Mapivi is free software, if you want you may make a donation, see http://herrmanns-stern.de/software/donations.shtml diff -Nru /tmp/qjJmUhMVAD/mapivi-0.9.1/mapivi /tmp/ojLru1ayL6/mapivi-0.9.7/mapivi --- mapivi-0.9.1/mapivi 2006-10-31 03:21:59.000000000 +0000 +++ mapivi-0.9.7/mapivi 2008-02-21 20:53:44.000000000 +0000 @@ -44,30 +44,34 @@ I would be happy to receive some feedback (e.g. on which os mapivi works), bugfixes, patches or suggestions about mapivi. -Copyright (c) 2002, 2003, 2004, 2005, 2006 Martin Herrmann +Copyright (c) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Martin Herrmann All rights reserved. Feel free to redistribute. Enjoy! =head1 USAGE -mapivi [file|directory] +mapivi [-i ] [file|folder] to display a certain picture use: mapivi picture.jpg -mapivi will generate and display all pictures in the directory +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 directory containing pictures use: +to view a folder containing pictures use: mapivi ~/pics/ -mapivi will generate and display all pictures in the given directory +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: @@ -78,11 +82,11 @@ =item Space, Page-Down -Show the next picture in directory +Show the next picture in folder =item BackSpace, Page-Up -Show the previous picture in directory +Show the previous picture in folder =item Escape @@ -106,7 +110,7 @@ =head1 MOUSE -Try the right mouse button in the thumbnail picture list for a popup menu to copy, move, rename, rotate or delete pictures, to open a new directory, to add or remove comments or to exit MaPiVi. +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. @@ -114,17 +118,15 @@ =cut -my $EvilOS = 0; # boolean, if we run on Windows this is 1 +# 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/win/i) { - $EvilOS = 1; -} if ($^O =~ m/darwin/i) { # Mac OS X is not evil, but unfortunately contains the string "win"! $MacOSX = 1; $EvilOS = 0; } -my $home = glob("~"); +my $home = glob("~"); use Env; if ($EvilOS) { $home = $ENV{HOME} if defined $ENV{HOME}; @@ -138,7 +140,7 @@ if (-d "$maprogsdir/mapivi") { my $olddir = "$maprogsdir/mapivi"; my $newdir = $ENV{APPDATA}."/maprogs/mapivi"; - warn "\nMapivi 0.3.6: Error!\n\nYou still have the old Mapivi config directory:\n$olddir,\n\n1) please create a new directory for the configuration here:\n $newdir,\n2) copy all directories and files from the old directory to the new one\n3) delete the old directory and then\n4) restart Mapivi.\n\nKindly excuse this inconvenience! (will exit in 30 seconds)\n"; + warn "\nMapivi 0.3.6: Error!\n\nYou still have the old Mapivi config folder:\n$olddir,\n\n1) please create a new folder for the configuration here:\n $newdir,\n2) copy all folders and files from the old folder to the new one\n3) delete the old folder and then\n4) restart Mapivi.\n\nKindly excuse this inconvenience! (will exit in 30 seconds)\n"; sleep 30; exit; } @@ -146,6 +148,7 @@ # for windows we use this path $maprogsdir = $ENV{APPDATA}."/maprogs" if defined $ENV{APPDATA}; my $configdir = "$maprogsdir/mapivi"; # the configuration dir +my $icon_path = "$configdir/icons"; # the icon dir my $splashAvail = (eval "require Tk::Splash") ? 1 : 0 ; my $splash; @@ -162,14 +165,20 @@ my $verbose = 0; # boolean (1 = print debug infos, 0 = be quiet) # get version from RCS version -my @RCSVersion = split / /, '$Revision: 9.1 $'; +my @RCSVersion = split / /, '$Revision: 9.7 $'; my $version = "0.".$RCSVersion[1]; +$main::VERSION = $version; my $mapiviInfo = "mapivi"; showCopyright(); #use Encode qw(is_utf8 encode decode); +use Encode; #use encoding "utf8" +#use utf8; +use Getopt::Std; +our($opt_i); +$Getopt::Std::STANDARD_HELP_VERSION = 1; use File::Copy; use File::Find; use File::Path; # for rmtree, mkpath @@ -191,10 +200,12 @@ use Tk::NoteBook; use Tk::FileSelect; use Image::Info qw(image_info dim); -use Storable qw(store retrieve dclone); +use Storable qw(nstore retrieve dclone); use Tk::Adjuster; use Tk::DragDrop; use Tk::DropSite; +use Tk::Compound; # for icons in the menues +#use Image::ExifTool; # this will be used in future to provide a multilanguage mapivi # keywords: i18n, gettext @@ -214,19 +225,18 @@ #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; +#my $win32Avail = (eval "require Win32") ? 1 : 0; #SetChildShowWindow() if ($EvilOS and $win32Avail); -#use Data::Dumper; -#use Tk::DirSelect; -#use Tk::ColorEditor; # optional modules -# seems not to work so I comment it out for a test in the future: +# seems not to work so I comment it out for a future test #my $win32FOAvail = (eval "require Win32::FileOp") ? 1 : 0; my $win32FOAvail = 0; +my $exiftoolAvail = (eval "require Image::ExifTool") ? 1 : 0; + my $resizeAvail = (eval "require Tk::ResizeButton") ? 1 : 0; my $filespecAvail = (eval "require File::Spec") ? 1 : 0; @@ -269,6 +279,14 @@ use constant CANCEL => 0; use constant ADD => 1; use constant RESET => 0; +use constant PIXEL => 0; +use constant ASPECT_RATIO => 1; +use constant RELATIVE => 2; +use constant SINGLE => 0; +use constant MULTIPLE => 1; +use constant COPY => 0; +use constant MOVE => 1; +use constant RENAME => 2; # function prototypes sub progressWinInit($$); @@ -276,7 +294,7 @@ sub progressWinUpdate($$$$); sub progressWinEnd($); sub updateOneRow($$); -sub insertPic($$); +sub insertPic($$$); sub checkDateFormat($); sub checkGeometry($); sub checkTempFile($); @@ -294,16 +312,17 @@ sub getDirDialog($); sub is_a_JPEG($); sub setProperty($$$); +sub formatString($$$); # globals -my @dirHist; # directory history - stores the last directories visited +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 directories (comments, EXIF, IPTC) +# search database: hash to store all the data of all pictures in the visited folders (comments, EXIF, IPTC) my %searchDB; -# directory checklist: hash to store properties of directories (key: dir value: hash SORT, META, PRIO, COMM) +# 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; @@ -325,7 +344,7 @@ my $quickSortSwitch = 0; my $actpic = ""; # the path and file name of the actual picture -my $actdir = ""; # the actual directory +my $actdir = ""; # the actual folder my $widthheight = ""; my $loadtime = ""; my $size = ""; @@ -342,7 +361,7 @@ my $trashdir = "$configdir/trash"; # the trashcan my $plugindir = "$configdir/PlugIns"; # the mapivi plugin dir -my $iptcdir = "$configdir/IPTC_templates"; # the IPTC templates directory +my $iptcdir = "$configdir/IPTC_templates"; # the IPTC templates folder my $configFile = "$configdir/mapivirc"; # the configuration file my $file_Entry_values = "$configdir/Entry_values"; my $exifdirname = ".exif"; # the subdir to store exif infos @@ -354,7 +373,6 @@ my $copyright_year = (localtime(time()))[5] + 1900; # the actual year, for the copyright notice my $HTMLPicDir = "pics"; # this is the name of the subdir for pics when building html pages my $HTMLThumbDir = "thumbs"; # this is the name of the subdir for thumbs when building HTML pages -my $cropPreviewSize = 400; # canvas size in x and y direction of the crop preview my $slideshow = 0; # start/stop flag for slideshow my $showPicInAction = 0; # bool = 1 while loading picture my $mapiviURL = "http://mapivi.de.vu"; @@ -372,7 +390,11 @@ my $impW; my $interpW; my $fuzzybw; # fuzzy border dialod window -my $ll_b_w; # lossless border dialod window +my $ll_b_w; # lossless border dialog window +my $ll_r_w; # lossless relative border dialog window +my $ll_a_w; # lossless aspect ratio border dialog window +my $ll_w_w; # lossless watermark dialog window +my $bpw; # border preview window my $ow; # options window, see sub options() my $sw; # the search window, see searchMetaInfo() my $dpw; # the dir properties window, see showDirProperties() @@ -382,6 +404,7 @@ my $ddw; # dirDiffWindow widget my $catw; # the IPTC categories window, see editIPTCCategories() my $keyw; # the IPTC keywords window, see editIPTCKeywords() +my $locw; # the location window, see search_by_location() my $keycw; # the comment keywords window, see editCommentKeywords() my $dupw; # the duplicate search window, see sub finddups() my $filterW; # the filter window @@ -422,7 +445,7 @@ my %ignore_keywords; # external programs used by mapivi -my %exprogs = qw/convert 0 composite 0 jhead 0 jpegtran 0 jpegpixi 0 mogrify 0 gimp-remote 0 gimp-win-remote 0 montage 0 xwd 0 identify 0 thunderbird 0 exiftool 0/; +my %exprogs = qw/convert 0 composite 0 jhead 0 jpegtran 0 jpegpixi 0 mogrify 0 gimp-remote 0 gimp-win-remote 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" => "build thumbnails", @@ -437,6 +460,7 @@ "xwd" => "make a screenshot of a window or desktop", "identify" => "describe the format and characteristics of a picture", "thunderbird" => "send pictures via email", + "mozilla-thunderbird" => "send pictures via email", "exiftool" => "Read/write meta information in image files", ); # where to find the external programs (resources) @@ -452,6 +476,7 @@ "gimp-win-remote"=> "gimp-win-remote http://sourceforge.net/projects/gimp-win-remote/", "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/", ); @@ -459,6 +484,17 @@ 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(ä ä Ä Ä ö ö Ö Ö ü ü Ü Ü ß ß); my $umlauteHTML = join "", keys(%umlauteHTML); @@ -481,9 +517,12 @@ "Geometry" => "790x560+1+1", # fit on a 800x600 screen "SearchGeometry" => "790x560+1+1", # fit on a 800x600 screen "KeyGeometry" => "250x500+50+50", # fit on a 800x600 screen + "LocGeometry" => "250x500+50+50", # fit on a 800x600 screen "LtwGeometry" => "700x500+10+10", # fit on a 800x600 screen "FontSize" => 12, "FontFamily" => "itc avant garde", + "PropFontSize" => 12, + "PropFontFamily" => "helvetica", "ColorFG" => "black", "ColorBG" => "#efefef", "ColorMenuBG" => "LightGoldenrod3", @@ -504,7 +543,7 @@ "ColorDir" => "black", "ColorThumbBG" => "azure3", "ColorProgress" => "#106dba", - "ColorPicker" => "red", # last color selected with color picker + "ColorPicker" => "#efefef", # last color selected with color picker "DefaultThumb" => "$configdir/EmptyThumb.jpg", "Copyright" => "copyright (c) $copyright_year Herrmann", "Comment" => "This picture was taken in south africa ...", @@ -515,15 +554,16 @@ "ShowThumbs" => 1, # boolean (1 = show thumbs, 0 = show default thumb) "UseDefaultThumb" => 1, # boolean (1 = show def thumb if no thumb is shown, 0 = show nothing at all) "ThumbCapt" => "none", # thumbnail caption - "ThumbCaptFontSize" => 10, # todo add to options dialog + "ThumbCaptFontSize" => 10, "ShowDirTree" => 1, # boolean (1 = show dir tree, 0 = hide) "ShowInfoFrame" => 1, # boolean (1 = show info frame, 0 = hide) "ShowThumbFrame" => 1, # boolean (1 = show thumb frame, 0 = hide) "ShowPicFrame" => 1, # boolean (1 = show pic frame, 0 = hide) "ShowComment" => 1, # boolean (1 = show comment, 0 = hide comment in thumbnail view) - "ShowCommentField"=> 1, # boolean (1 = show comment, 0 = hide comment in picture view) + "ShowCommentField"=> 0, # boolean (1 = show comment, 0 = hide comment in picture view) + "ShowCaptionField"=> 0, # boolean (1 = show IPTC captiob, 0 = hide caption in picture view) "ShowEXIF" => 1, # boolean (1 = show EXIF, 0 = hide EXIF in thumbnail view) - "ShowEXIFField" => 1, # boolean (1 = show EXIF, 0 = hide EXIF in picture view) + "ShowEXIFField" => 0, # boolean (1 = show EXIF, 0 = hide EXIF in picture view) "ShowIPTC" => 1, # boolean (1 = show IPTC, 0 = hide IPTC in thumbnail view) "ShowFile" => 1, # boolean (1 = show Size, 0 = hide Size in thumbnail view) "ShowDirectory" => 1, # boolean (1 = show directory, 0 = hide dir in thumbnail view) @@ -549,7 +589,7 @@ "ThumbBorder" => 4, "HTMLaddComment" => 1, "HTMLaddEXIF" => 1, - "HTMLaddIPTC" => 0, + "HTMLaddIPTC" => 1, "HTMLcols" => 2, "HTMLTargetDir" => $home, "HTMLGalleryIndex"=> "../galleries.html", @@ -558,10 +598,10 @@ "HTMLTemplate" => "$configdir/pagetemplate.html", "HTMLFooter" => "© Martin Herrmann <Martin-Herrmann\@gmx.de>", "HTMLBGcolor" => "white", - "HTMLPicSize" => 500, + "HTMLPicSize" => 600, "HTMLPicSharpen" => 1, "HTMLPicCopyright"=> 0, # bool - add a visible copyright info into the picture - "HTMLPicQuality" => 75, # quality of html jpg pictures + "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 @@ -570,7 +610,7 @@ "AskDeleteThumb" => 1, # ask before deleting thumbnails "AskMakeDir" => 1, # ask before makeing a directory (e.g. .thumbs or .exif) "MaxTrashSize" => 50, # MB - a warning will appear if the trash contains more than this - "BitsPixel" => 1, # boolean - show bits per pixel info + "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 @@ -580,7 +620,7 @@ "MakeBackup" => 1, # make a backup of the original file, before appling a filter "PicListFile" => "$home/filelist", "XMLFile" => "$home/IPTCinfo.xml", - "saveEXIFforEdit" => 1, # save the EXIF info before editing the picture with GIMP (needed for GIMP version 1.3.15 and lower) + "saveEXIFforEdit" => 0, # save the EXIF info before editing the picture with GIMP (needed for GIMP version 1.3.15 and lower) "indexRows" => 2, # indexPrint "indexCols" => 2, # indexPrint "indexPicX" => 500, # indexPrint @@ -591,7 +631,7 @@ "indexLabel" => 1, # indexPrint "indexLabelStr" => "%f (%wx%h, %b)", # indexPrint "WarnBeforeResize"=> 1, # warn before using mogrify in resize - "ShowMoreEXIF" => 1, # show more EXIF infos: contrast sharpness saturation metering wb in thumbnail list ... + "ShowMoreEXIF" => 0, # show more EXIF infos: contrast sharpness saturation metering wb in thumbnail list ... "IPTCoverwrite" => 0, # overwrite IPTC attributes, when editing multiple pictures "IPTCmergeCatKey" => 1, # merge categories and keywords, when editing multiple pictures "IPTCdateEXIF" => 0, # use EXIF date as creation date @@ -599,7 +639,7 @@ "IPTCbylineEXIF" => 0, # use EXIF owner as ByLine "IPTCaddMapivi" => 0, # add Mapivi infos to IPTC "IPTC_action" => 'UPDATE', # ADD UPDATE or REPLACE - "CheckForNonJPEGs"=> 1, # check if there are non JPEGs in the dir and ask to convert them + "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 @@ -659,6 +699,7 @@ "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) @@ -694,33 +735,31 @@ "indexFontSize" => 10, # the font size of the index labels (0 = automatic) "CheckForLinks" => 1, # bool - check if a file is a link before processing it "ColorAdj" => 0, # bool - do some color adjustments when filtering a pic - "LineLimit" => 6, # max nr of lines in the thumbnail table e.g. for comments + "LineLimit" => 8, # max nr of lines in the thumbnail table e.g. for comments "LineLength" => 30, # length of one line in the thumbnail table e.g. for comments "ExtViewer" => 'display', # name of external picture viewer "ExtViewerMulti" => 0, # bool "ExtBGApp" => "wmsetbg -a", # name of external app to set desktop background (with options) "ConvertUmlaut" => 1, # convert german umlaute (e.g. ä -> ae etc.) - "ShowUrgency" => 1, # show the rating/IPTC urgency in the status bar "DeadPixelStr" => "1300,846,3 85,411,3 7,365,3 1529,185,3 1593,201,3 1387,1003,3 1957,1057,3 50,1043,2 615,935,3", # info about the dead pixels of your camera see: http://www.zero-based.org/software/jpegpixi/ "DeadPixelMethod" => "linear", "ShowCoordinates" => 0, "ImportSource" => "/mnt/usb/DCIM/DIMG", "ImportSubdirs" => 0, # bool - import also from all subdirs "ImportTargetFix" => "$home/pictures", - "ImportTargetVar" => "2006/200602/20060214_Birthday_Sam", + "ImportTargetVar" => "2008/02/14_Birthday_Sam", "ImportDeadPixel" => 1, "ImportRotate" => 1, "ImportRename" => 1, "ImportDeleteCameraJunk" => 0, "ImportDelete" => 1, - "ImportUnmount" => 1, - "ImportMount" => 1, - "ImportDevice" => "/mnt/usb", "ImportShowPics" => 1, "ImportAddCom" => 0, "ImportAddComment"=> "(c) $copyright_year Martin Herrmann", "ImportAddIPTC" => 0, "ImportIPTCTempl" => 'template.iptc2', + "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", @@ -732,7 +771,7 @@ "BeepWhenLooping" => 1, # play a beep when looping to the first e.g. last picture "SlowButMoreFeatures" => 0, # enable some features slowing down mapivi "setEXIFDateAskAgain" => 0, # show/don't show ask dialog - "EXIFDateAbs" => "2006:02:20-18:51:45", + "EXIFDateAbs" => "2008:02:20-18:51:45", "EXIFPlusMin" => "+", # used in setEXIFdate "EXIFAbsRel" => "abs", # used in setEXIFdate "EXIFyears" => 0, # used in setEXIFdate @@ -756,18 +795,21 @@ "MailPicNoChange" => 0, "MailPicMaxLength"=> 800, "MailPicQuality" => 75, + "MailTool" => 'mozilla-thunderbird', "winDirRequesterAskAgain" => 1, "FuzzyBorderWidth"=> 10, "FuzzyBorderBlur" => 10, "FuzzyBorderColor"=> "black", - "ShowInfoInCanvas"=> 0, - "llBorderWidth" => 16, - "llBorderWidthI" => 1, + "ShowInfoInCanvas"=> 1, + "llBorderWidthX" => 16, + "llBorderWidthY" => 16, + "llBorderWidthIX" => 1, + "llBorderWidthIY" => 1, "llBorderColor" => "white", "llBorderColorI" => "black", "supportOtherPictureFormats" => 0, - "CategoriesAll" => 1, - "KeywordsAll" => 1, + "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, @@ -791,7 +833,32 @@ 'KeywordMore' => 0, # boolean 1 = show more options in keyword search window 'KeywordExclude' => '', # space separated list of keywords to exclude 'KeywordLimit' => 0, # boolean 1 = limit number of displayed keywords + 'KeywordDate' => 0, # boolean 1 = limit to a date range + 'KeywordStart' => 1070254800, # start date (UNIX time) + 'KeywordEnd' => 1170254800, # end date (UNIX time) + 'KeywordRating' => 0, # boolean 1 = limit to a rating range + 'KeywordRatingA' => 1, # rating range + 'KeywordRatingB' => 3, # rating range 'UrgencyChangeWarning' => 1, # boolean 1 = show a warning when urgency changed + 'ActPic' => '', # the last picture shown + 'SelectLastPic' => 1, # Select last shown pic after startup + 'AutoImport' => 1, # boolean = 1 start import at Mapivi wizard if memory card is inserted (ImportSource) + 'llWatermarkX' => 16, # lossless watermark x position + 'llWatermarkY' => -16, # lossless watermark y position + 'llWatermarkFile' => "$configdir/EmptyThumb.jpg", # lossless watermark file name + 'AspectBorderN' => 3, # lossless aspect ratio border + 'AspectBorderM' => 2, # lossless aspect ratio border + 'RelativeBorderX' => 10, # lossless relative border + 'RelativeBorderY' => 10, # lossless relative border + 'RelativeBorderIX' => 0.1, # lossless relative border + 'RelativeBorderIY' => 0.1, # lossless relative border + 'RelativeBorderEqual'=> 1, # boolean lossless relative border + 'KeywordDialogDock'=> 0, # boolean dock keyword dialog to main window + 'KeywordDialogDockL'=> 1, # boolean dock keyword dialog on left side + 'XMP_file_operations'=> 1, # boolean XMP sidecar files follow picture file operations + 'WAV_file_operations'=> 1, # boolean WAV audio files follow picture file operations + 'RAW_file_operations'=> 0, # boolean RAW files follow picture file operations + 'LocationMode' => 'UPDATE', # UPDATE or REPLACE - mode for writing IPTC location info ); # some platform specific default settings @@ -953,6 +1020,10 @@ # get the configurations from the rc file if the configdir exists readConfig($configFile, \%config) if (-d $configdir); +$actpic = $config{ActPic}; + +# At startup the menu should always be visible +$config{ShowMenu} = 1; # check if this is the first start of a new Mapivi version mapiviUpdate() if (($config{Version} eq '000') or ($version ne $config{Version})); @@ -984,9 +1055,37 @@ $top->geometry($config{Geometry}); # add a window and icon picture +my $icon_data = <Photo(-data => $icon_data); my $mapiviiconfile = "$configdir/MapiviIcon.gif"; $mapiviiconfile = "$configdir/MapiviIcon32.gif" if $EvilOS; -my $mapiviicon = $top->Photo(-file => $mapiviiconfile) if (-f $mapiviiconfile); +#my $mapiviicon = $top->Photo(-file => $mapiviiconfile) if (-f $mapiviiconfile); $top->idletasks if $EvilOS; # this line is crucial (at least on windows) $top->iconimage($mapiviicon) if $mapiviicon; @@ -1093,7 +1192,7 @@ $top->optionAdd("*Label.background", $config{ColorBG}, "userDefault"); -for (qw(Entry NumEntry Listbox KListbox K2Listbox TixHList HList ROText Text +for (qw(Entry NumEntry Listbox KListbox K2Listbox TixHList HList Text BrowseEntry.Entry NoteBook)) { $top->optionAdd("*$_.background", $config{ColorEntry}, "userDefault"); } @@ -1151,7 +1250,7 @@ #createMenubar(); -my $infoF = $top->Frame(-relief => "raised"); +my $infoF = $top->Frame(-relief => 'raised'); # $subF contains the 3 frames: dirtree ($dirF), thumbnails ($thumbF) and picture ($mainF) my $subF = $top->Frame(); @@ -1176,9 +1275,11 @@ my $comF = $mainF->Frame(-relief => "raised"); my $comBF = $comF->Frame()->pack(-side => "left", -expand => 1, -fill => "both", -anchor=>"nw", -padx => 0, -pady => 0); +my $capF = $mainF->Frame(-relief => "raised"); + my $nrofL = $infoF->Label(-justify => "left",-textvariable => \$nrof, -relief => "sunken", -anchor => 'w' )->pack(-side => "left", -expand => 0, -fill => "y"); -$balloon->attach($nrofL, -msg => "x/y (z, s) = first selected picture is number x\nfrom y pictures in the actual directory\nz pictures are selected\ns is the size of all selected pictures"); +$balloon->attach($nrofL, -msg => "x/y (z, s) = first selected picture is number x\nfrom y pictures in the actual folder\nz pictures are selected\ns is the size of all selected pictures"); my $dirtreedir; @@ -1186,46 +1287,45 @@ my $actdirF = $thumbF->Frame()->pack(-expand => 1, -fill => 'x', -padx => 2, -pady => 1); my $actdirL = $actdirF->Label(-textvariable => \$actdir, -width => 10, -anchor => "e", -relief => "sunken", -bd => $config{Borderwidth})->pack(-side => "left", -expand => 1, -fill => 'x'); -$balloon->attach($actdirL, -msg => "actual directory\nClick here to open a simple directory requester."); +$balloon->attach($actdirL, -msg => "actual folder\nClick here to open a simple folder requester."); $actdirL->bind("", sub { getDirAndOpen(); }); my $otherFilesL = $actdirF->Label(-textvariable => \$otherFiles, -relief => "sunken", -bd => $config{Borderwidth})->pack(-side => "left"); -$balloon->attach($otherFilesL, -msg => "number of non-JPEG files in the actual directory"); +$balloon->attach($otherFilesL, -msg => "number of non-JPEG files in the actual folder"); my $otherFilesB = $actdirF->Button(-text => "i", -command => sub {showNonJPEGS();}, -padx => 1, -pady => 0)->pack(-side => "left"); -$balloon->attach($otherFilesB, -msg => "show non-JPEG files in the actual directory"); +$balloon->attach($otherFilesB, -msg => "show non-JPEG files in the actual folder"); my $parentDirB = $actdirF->Button(-text => "..", -command => sub { my $parentdir = dirname($actdir); print "changing to $parentdir (was: $actdir)\n" if $verbose; openDirPost($parentdir); }, -padx => 0, -pady => 0)->pack(-side => "left"); -$balloon->attach($parentDirB, -msg => "open parent directory"); +$balloon->attach($parentDirB, -msg => "open parent folder"); my $dirPropSORT = 0; my $dirPropMETA = 0; my $dirPropPRIO = 0; -$actdirF->{cbSORT} = $actdirF->Checkbutton(-variable => \$dirPropSORT, -command => sub { $dirProperties{$actdir}{SORT} = $dirPropSORT; }, -padx => 0)->pack(-side => 'left', -anchor=>'w'); -$actdirF->{cbMETA} = $actdirF->Checkbutton(-variable => \$dirPropMETA, -command => sub { $dirProperties{$actdir}{META} = $dirPropMETA; }, -padx => 0)->pack(-side => 'left', -anchor=>'w'); -$actdirF->{cbPRIO} = $actdirF->Checkbutton(-variable => \$dirPropPRIO, -command => sub { $dirProperties{$actdir}{PRIO} = $dirPropPRIO; }, -padx => 0)->pack(-side => 'left', -anchor=>'w'); -$balloon->attach($actdirF->{cbSORT}, -msg => "Sort:\nCheck this button, if the pictures\nin this directory are sorted out."); -$balloon->attach($actdirF->{cbMETA}, -msg => "Meta:\nCheck this button, if all needed meta infos\n(comments, IPTC) of the pictures in this directory are added."); -$balloon->attach($actdirF->{cbPRIO}, -msg => "Prio:\nCheck this button, if the pictures in this\ndirectory are rated with a IPTC urgency flag."); +$actdirF->{cbSORT} = $actdirF->Checkbutton(-variable => \$dirPropSORT, -command => sub { $dirProperties{$actdir}{SORT} = $dirPropSORT; })->pack(-side => 'left', -anchor=>'w', -padx => 0); +$actdirF->{cbMETA} = $actdirF->Checkbutton(-variable => \$dirPropMETA, -command => sub { $dirProperties{$actdir}{META} = $dirPropMETA; })->pack(-side => 'left', -anchor=>'w', -padx => 0); +$actdirF->{cbPRIO} = $actdirF->Checkbutton(-variable => \$dirPropPRIO, -command => sub { $dirProperties{$actdir}{PRIO} = $dirPropPRIO; })->pack(-side => 'left', -anchor=>'w', -padx => 0); +$balloon->attach($actdirF->{cbSORT}, -msg => "Sort:\nCheck this button, if the pictures\nin this folder are sorted out."); +$balloon->attach($actdirF->{cbMETA}, -msg => "Meta:\nCheck this button, if all needed meta infos\n(comments, IPTC) of the pictures in this folder are added."); +$balloon->attach($actdirF->{cbPRIO}, -msg => "Prio:\nCheck this button, if the pictures in this\nfolder are rated with a IPTC urgency flag."); my $dirtree; $dirtree = $dirF->Scrolled('DirTree', -scrollbars => 'osoe', -# -width => $config{AdjusterDir}, -width => 30, -height => 200, -showhidden => $config{ShowHiddenDirs}, -selectmode => 'browse', - #-selectmode => 'extended', # todo: usefull? -exportselection => 1, -browsecmd => sub { # this function will show all subdirs when clicking on the + sign of a dir $dirtreedir = shift; + $dirtreedir = Encode::encode('iso-8859-1', $dirtreedir); return if (@_ >= 1); - if (!-d $dirtreedir) { print "$dirtreedir does not exists!\n"; return; } + if (!-d $dirtreedir) { print "dirtree xxx: $dirtreedir does not exists!\n"; return; } $top->Busy; my @dirs = getDirs($dirtreedir); $top->Unbusy; @@ -1241,7 +1341,7 @@ )->pack(-fill => "both", -expand => 1); -# Set the initial directory +# Set the initial folder exists &Tk::DirTree::chdir ? $dirtree->chdir($actdir) : $dirtree->set_dir($actdir); bindMouseWheel($dirtree); @@ -1279,33 +1379,31 @@ my $zoomL = $infoF->Label(-textvariable => \$zoomFactorStr, -relief => "sunken")->pack(-side => "left", -fill => "y"); $balloon->attach($zoomL, -msg => "zoom factor of the actual picture"); -if ($config{ShowUrgency}) { - my $urgF = $infoF->Frame(-relief => "sunken")->pack(-side => "left", -fill => "y"); - my $urgL = $urgF->Label(-textvariable => \$urgencyStr)->pack(-side => "left", -fill => "y"); - $balloon->attach($urgF, -msg => "the rating (IPTC urgency) of the actual picture\n0 or - meaning None, 1 meaning High to 8 meaning Low"); - my $urgAnchor = 's'; $urgAnchor = 'n' if ($Tk::VERSION < 804); # the anchor behavior has changed - my $urgencyBar = - $urgF->ProgressBar(-takefocus => 0, - -borderwidth => 0, - -width => 12, - -length => (2*$config{FontSize}), # try to guess the height of the labels - -padx => 0, - -pady => 0, - -variable => \$urgencyScale, - -colors => [0, $top->Darken($config{ColorSel}, 30), 1, $top->Darken($config{ColorSel}, 40), 2, $top->Darken($config{ColorSel}, 50), 3, $top->Darken($config{ColorSel}, 60), 4, $top->Darken($config{ColorSel}, 70), 5, $top->Darken($config{ColorSel}, 80), 6, $top->Darken($config{ColorSel}, 90), 7, $config{ColorSel} ], - -troughcolor => $config{ColorBG}, - -resolution => 1, - -blocks => 0, - -gap => 0, - -anchor => $urgAnchor, - -from => 0, - -to => 8 - )->pack(-side => 'left', -fill => 'both', -expand => 0, -padx => 0, -pady => 0); -} +my $urgF = $infoF->Frame(-relief => "sunken")->pack(-side => "left", -fill => "y"); +my $urgL = $urgF->Label(-textvariable => \$urgencyStr)->pack(-side => "left", -fill => "y"); +$balloon->attach($urgF, -msg => "Rating (IPTC urgency) of actual picture\n0 or - meaning None, 1 meaning High to 8 meaning Low\nTo change use Ctrl-F1, -F2, ... -F8"); +my $urgAnchor = 's'; $urgAnchor = 'n' if ($Tk::VERSION < 804); # the anchor behavior has changed +my $urgencyBar = + $urgF->ProgressBar(-takefocus => 0, + -borderwidth => 0, + -width => 12, + -length => (2*$config{FontSize}), # try to guess the height of the labels + -padx => 0, + -pady => 0, + -variable => \$urgencyScale, + -colors => [0, $top->Darken($config{ColorSel}, 30), 1, $top->Darken($config{ColorSel}, 40), 2, $top->Darken($config{ColorSel}, 50), 3, $top->Darken($config{ColorSel}, 60), 4, $top->Darken($config{ColorSel}, 70), 5, $top->Darken($config{ColorSel}, 80), 6, $top->Darken($config{ColorSel}, 90), 7, $config{ColorSel} ], + -troughcolor => $config{ColorBG}, + -resolution => 1, + -blocks => 0, + -gap => 0, + -anchor => $urgAnchor, + -from => 0, + -to => 8 + )->pack(-side => 'left', -fill => 'both', -expand => 0, -padx => 0, -pady => 0); my $userInfoL = $infoF->Label(-textvariable => \$userinfo, -relief => "sunken")->pack(-side => "left", -fill => 'both', -expand => 1); my $userInfoMsg; -$balloon->attach($userInfoL, -postcommand => sub { $userInfoMsg = "information about what's going on"; $userInfoMsg .= "\n(actual directory: $actdir)"}, -msg => \$userInfoMsg); +$balloon->attach($userInfoL, -postcommand => sub { $userInfoMsg = "information about what's going on"; $userInfoMsg .= "\n(actual folder: $actdir)"}, -msg => \$userInfoMsg); my $colorPickerInfo = $infoF->Label(-text => ' ', -background => $config{ColorPicker}, -relief => "sunken")->pack(-side => "left", -fill => 'both', -expand => 0); $balloon->attach($colorPickerInfo, -msg => "Color picker: last color picked by clicking\non the picture in the main window.\nPlease click to clear."); @@ -1336,10 +1434,12 @@ -from => 0, -to => $config{MaxProcs} )->pack(-side => 'left', -fill => 'both', -expand => 0, -padx => 0, -pady => 0); +$balloon->attach($progressBar, -msg => "info about the number of background processes\n(generating thumbnail pictures)"); $clockL = $infoF->Label(-textvariable => \$time, -relief => "sunken")->pack(-side => "left", -fill => "y"); $balloon->attach($clockL, -msg => \$date); +# JPEG comment box my $commentText = $comF->Scrolled("ROText", -scrollbars => 'oe', -wrap => 'word', @@ -1357,13 +1457,33 @@ my $remB = makeButton($comBF, "left", "del", "delete.gif", 'removeComment()'); $balloon->attach($remB, -msg => "Remove comment(s)"); -$balloon->attach($progressBar, -msg => "info about the number of background processes\n(generating thumbnail pictures)"); - - - my $picLB = makeThumbListbox($thumbF); $picLB->bind('', sub { $picLB->focus; } ) unless $EvilOS; +# IPTC caption edit box +my $captionText; +$capF->Label(-text => "Caption")->pack(-side => "left", -fill => 'both'); +$captionText = $capF->Scrolled("Text", + -scrollbars => 'oe', + -wrap => 'word', + -width => 20, + -height => $config{CommentHeight}, + )->pack(-side => 'left', -fill => 'both', -expand => "1"); +$balloon->attach($captionText, -msg => "IPTC caption of displayed picture"); + +my $saveB = $capF->Button(-image => compound_menu($top, 'save', 'media-floppy.png', 0), + #-text => "save", + -command => sub { + my $iptc = { "Caption/Abstract" => $captionText->get(0.1, 'end') }; + my @list = ($actpic); + applyIPTC($picLB, $iptc, \@list); + } + )->pack(-side => "left", -fill => 'both'); +$balloon->attach($saveB, -msg => "Save the IPTC caption to the file and database.\nPlease press this button after adding or editing."); +#$captionText->Subwidget("scrolled")->bindtags([]); +#$captionText->Subwidget("scrolled")->bind('', sub {}); +#->Subwidget("scrolled") + # item styles for the thumbnail view my $thumbCaptionFont = $top->Font(-family => $config{FontFamily}, -size => $config{ThumbCaptFontSize}); @@ -1419,98 +1539,29 @@ $thumbMenu->Popup(-popover => "cursor", -popanchor => "nw"); } ); +# key-desc,Return,display the selected picture +$picLB->bind('', sub { showSelectedPic(); } ); + $c->CanvasBind('', sub { if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off $picMenu->Popup(-popover => "cursor", -popanchor => "nw"); } ); -# key-desc,b,show backup picture (if available) -$top->bind('', sub { showBackup(); }); -# key-desc,w,show window list -$top->bind('', sub { showWindowList(); }); -# key-desc,Ctrl-r,rebuild selected thumbnails -$top->bind('', sub { rebuildThumbs(); } ); -# key-desc,Ctrl-s,search database -$top->bind('', sub { searchMetaInfo(); } ); -# key-desc,o,open a new directory -$top->bind('', sub { openDir(); } ); -# key-desc,h,show hot directories -$top->bind('', sub { $dirMenu->Popup(-popover => "cursor", -popanchor => "nw"); } ); - -# key-desc,u,update (reread directory and Image) -$top->bind('', sub { updateThumbsPlus(); } ); -# key-desc,F05,smart update (add new and remove deleted images) -$top->bind('', sub { smart_update(); } ); - -# key-desc,U,update image -$top->bind('', sub { - deleteCachedPics($actpic); - showPic($actpic); - } ); - -# layouts -# key-desc,l,cycle layout of directory thumbnail and picture frame -$top->bind('', sub { $config{Layout}++; layout(1); } ); - -# key-desc,F01,toggle show menu bar -$top->bind('', sub { $config{ShowMenu} = $config{ShowMenu} ? 0 : 1; showHideFrames(); } ); -# key-desc,F02,toggle show status bar -$top->bind('', sub { $config{ShowInfoFrame} = $config{ShowInfoFrame} ? 0 : 1; showHideFrames(); } ); -# key-desc,F03,toggle show EXIF box -$top->bind('', sub { $config{ShowEXIFField} = $config{ShowEXIFField} ? 0 : 1; showHideFrames(); } ); -# key-desc,F04,toggle show comment box -$top->bind('', sub { $config{ShowCommentField} = $config{ShowCommentField} ? 0 : 1; showHideFrames(); } ); - -# key-desc,F06,layout 0: directories-thumbnails-picture (25-30-45) -$top->bind('', sub { $config{Layout} = 0 ; layout(1);} ); -# key-desc,F07,layout 1: directories-thumbnails (20-80-0) -$top->bind('', sub { $config{Layout} = 1 ; layout(1);} ); -# key-desc,F08,layout 2: thumbnails (0-100-0) -$top->bind('', sub { $config{Layout} = 2 ; layout(1);} ); -# key-desc,F09,layout 3: thumbnails-picture (0-50-50) -$top->bind('', sub { $config{Layout} = 3 ; layout(1);} ); -# key-desc,F10,layout 4: picture (0-0-100) -$top->bind('', sub { $config{Layout} = 4 ; layout(1); Tk->break; # stop default binding of this key - } ); - -# key-desc,F11,fullscreen mode -$top->bind('', sub { topFullScreen(); }); - -addCommonKeyBindings($top, $picLB); - -# key-desc,Delete,delete selected pictures to trash -$top->bind('', sub { deletePics($picLB, TRASH); } ); -# key-desc,Shift-Delete,remove selected pictures -$top->bind('', sub { deletePics($picLB, REMOVE); } ); -# key-desc,q,quit mapivi -$top->bind('', sub { quitMain(); } ); -# key-desc,R,smart rename selected pictures (e.g to EXIF date) -$top->bind('', sub { renameSmart($picLB); } ); -# key-desc,F12,quit mapivi -$top->bind('', sub { quitMain(); } ); -# show picture, EXIF, Comment and IPTC info -# key-desc,c,display JPEG comment -$top->bind('', sub { showComment(); } ); -# key-desc,t,display embedded EXIF thumbnail -$top->bind('', sub { showEXIFThumb(); } ); -# key-desc,Ctrl-v,toggle verbose output -$top->bind('', sub { toggle(\$verbose); $userinfo = "verbose switched to $verbose"; $userInfoL->update; -} ); -# key-desc,Ctrl-c,crop (lossless) -$top->bind('', sub { crop($picLB); } ); -# key-desc,Ctrl-b,add border and/or copyright -$top->bind('', sub { addDecoration(); } ); -# key-desc,Ctrl-q,change size/quality -$top->bind('', sub { changeSizeQuality(); } ); -# key-desc,Ctrl-o,open options dialog -$top->bind('', sub { options(); } ); +# we can't bind all keys to the complete window ($top) as we have e.g. the IPTC Caption entry which should get all key events +addWindowKeyBindings($dirtree, $picLB); +addWindowKeyBindings($picLB, $picLB); +addWindowKeyBindings($c, $picLB); + +addCommonKeyBindings($dirtree, $picLB); +addCommonKeyBindings($picLB, $picLB); +addCommonKeyBindings($c, $picLB); # key-desc,d,display picture in own window #$picLB->bind('', sub { showPicInOwnWin(); } ); $picLB->bind('', sub { my @sellist = getSelection($picLB); return unless checkSelection($top, 1, 0, \@sellist); - show_multiple_pics(\@sellist, 0); # todo : get nearset pic instead of first (0) + show_multiple_pics(\@sellist, 0); } ); $dirtree->bind('', sub { my $dir = getRightDir(); @@ -1524,112 +1575,18 @@ my @list = getPics($dir, WITH_PATH); sortPics($config{SortBy}, $config{SortReverse}, \@list); showThumbList(\@list, $dir); }); -# key-desc,Ctrl-e,edit picture in GIMP -$top->bind('', sub { GIMPedit(); } ); -# key-desc,Ctrl-f,apply a filter to the picture -$top->bind('', sub { filterPic(); } ); -# key-desc,Ctrl-h,display picture in original size (100% zoom) -$top->bind('', sub { zoom100(); }); -# key-desc,H,display picture histogram -$top->bind('', sub { showHistogram($picLB); }); -# key-desc,z,display picture in original size (100% zoom) -$top->bind('', sub { zoom100(); }); -# key-desc,9,rotate picture(s) 90 degrees clockwise -$top->bind('', sub { rotate(90); }); -# key-desc,8,rotate picture(s) 180 degrees clockwise -$top->bind('', sub { rotate(180); }); -# key-desc,7,rotate picture(s) 270 degrees clockwise -$top->bind('', sub { rotate(270); }); -# key-desc,0,auto rotate picture(s) (EXIF orientation) -$top->bind('', sub { rotate("auto"); }); - -# key-desc,f,fit picture in canvas (auto zoom) -$top->bind('', sub { fitPicture(); }); - -# key-desc,Escape,iconify the main window/close any other window -$top->bind('', sub { $top->iconify; } ); - -# thumbnail navigation -# key-desc,Space,display the next picture -$top->bind('', sub { - return if (stillBusy()); # block, until last picture is loaded - if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off - showPic(nextPic($actpic)); -} ); -# key-desc,S,display the next selected picture -$top->bind('', sub { - return if (stillBusy()); # block, until last picture is loaded - if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off - my @sellist = $picLB->info('selection'); - showPic(nextSelectedPic($actpic)); - reselect($picLB, @sellist); -} ); -# key-desc,Page-Down,display the next picture -$top->bind('', sub { - return if (stillBusy()); # block, until last picture is loaded - if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off - showPic(nextPic($actpic));} ); -# key-desc,Backspace,display the previous picture -$top->bind('', sub { - return if (stillBusy()); # block, until last picture is loaded - if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off - showPic(prevPic($actpic));} ); -# key-desc,Page-Up,display the previous picture -$top->bind('', sub { - return if (stillBusy()); # block, until last picture is loaded - if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off - showPic(prevPic($actpic));} ); -# key-desc,Home,display the first picture -$top->bind('', sub { - return if (stillBusy()); # block, until last picture is loaded - if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off - my @childs = $picLB->info('children'); - return unless (@childs); - showPic($childs[0]); } ); -# key-desc,End,display the last picture -$top->bind('', sub { - return if (stillBusy()); # block, until last picture is loaded - if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off - my @childs = $picLB->info('children'); - return unless (@childs); - showPic($childs[-1]); - }); - -# key-desc,Ctrl-g,goto picture -$top->bind('', sub { gotoPic($picLB); } ); - -# key-desc,Return,display the selected picture -$picLB->bind('', sub { showSelectedPic(); } ); - -# key-desc,s,start/stop slideshow -$top->bind('', sub { - if ($slideshow == 0) { $slideshow = 1; } else { $slideshow = 0; } - slideshow(); - } ); -# key-desc,-,zoom out or faster slideshow -$top->bind('', sub { - if ($slideshow) { - $config{SlideShowTime}-- if ($config{SlideShowTime} >= 1); - $userinfo = "slideshow time: ".$config{SlideShowTime}." sec"; $userInfoL->update; - } - else { - zoomStep(-1); - } - } ); -# key-desc,+,zoom in or slideshow slower -$top->bind('', sub { - if ($slideshow) { - $config{SlideShowTime}++ if ($config{SlideShowTime} < 30); - $userinfo = "slideshow time: ".$config{SlideShowTime}." sec"; $userInfoL->update; - } - else { - zoomStep(1); - } - }); +# window resize event +$top->bind("" => sub { + # only if dock is selected + return unless ($config{KeywordDialogDock}); + # and the keyword dialog is open + return unless (Exists($keyw)); + dock_keyword_dialog(); +}); # support drag and drop from extern -# this enables dropping pictures and directories on the mapivi window +# this enables dropping pictures and folders on the mapivi window if ($Tk::VERSION < 804) { $top->DropSite (-dropcommand => \&dragAndDropExtern, @@ -1644,6 +1601,7 @@ ); } + startup(); # show all types of images supported by Tk::Image @@ -1681,7 +1639,7 @@ my $lb = $widget->Scrolled('HList', -header => 1, - -separator => ';', # todo here we hope that ; will never be in a directory or file name + -separator => ';', # todo here we hope that ; will never be in a folder or file name -pady => 0, -columns => 6, -scrollbars => 'osoe', @@ -1791,15 +1749,204 @@ } ############################################################## +# addWindowKeyBindings - add key shortcuts to a widget +############################################################## +sub addWindowKeyBindings { + my $bind_w = shift; # widget to bind keys to + my $lb_w = shift; # thumbnail listbox to use + + # key-desc,b,show backup picture (if available) + $bind_w->bind('', sub { showBackup(); }); + # key-desc,w,show window list + $bind_w->bind('', sub { showWindowList(); }); + # key-desc,Ctrl-r,rebuild selected thumbnails + $bind_w->bind('', sub { rebuildThumbs(); } ); + # key-desc,Ctrl-s,search database + $bind_w->bind('', sub { searchMetaInfo(); } ); + # key-desc,k,search by keyword (tag cloud) + $bind_w->bind('', sub { keyword_browse(); } ); + # key-desc,o,open a new folder + $bind_w->bind('', sub { openDir(); } ); + # key-desc,h,show hot folders + $bind_w->bind('', sub { $dirMenu->Popup(-popover => "cursor", -popanchor => "nw"); } ); + + # key-desc,u,update (reread folder and Image) + $bind_w->bind('', sub { updateThumbsPlus(); } ); + # key-desc,F05,smart update (add new and remove deleted images) + $bind_w->bind('', sub { smart_update(); } ); + + # key-desc,U,update image + $bind_w->bind('', sub { + deleteCachedPics($actpic); + showPic($actpic); + } ); + + # layouts + # key-desc,l,cycle layout of folder thumbnail and picture frame + $bind_w->bind('', sub { $config{Layout}++; layout(1); } ); + + # key-desc,F01,toggle show menu bar + $bind_w->bind('', sub { $config{ShowMenu} = $config{ShowMenu} ? 0 : 1; showHideFrames(); } ); + # key-desc,F02,toggle show status bar + $bind_w->bind('', sub { $config{ShowInfoFrame} = $config{ShowInfoFrame} ? 0 : 1; showHideFrames(); } ); + # key-desc,F03,toggle show EXIF box + $bind_w->bind('', sub { $config{ShowEXIFField} = $config{ShowEXIFField} ? 0 : 1; showHideFrames(); } ); + # key-desc,F04,toggle show comment box + $bind_w->bind('', sub { $config{ShowCaptionField} = $config{ShowCaptionField} ? 0 : 1; showHideFrames(); } ); + + # key-desc,F06,layout 0: folders-thumbnails-picture (25-30-45) + $bind_w->bind('', sub { $config{Layout} = 0 ; layout(1);} ); + # key-desc,F07,layout 1: folders-thumbnails (20-80-0) + $bind_w->bind('', sub { $config{Layout} = 1 ; layout(1);} ); + # key-desc,F08,layout 2: thumbnails (0-100-0) + $bind_w->bind('', sub { $config{Layout} = 2 ; layout(1);} ); + # key-desc,F09,layout 3: thumbnails-picture (0-50-50) + $bind_w->bind('', sub { $config{Layout} = 3 ; layout(1);} ); + # key-desc,F10,layout 4: picture (0-0-100) + $bind_w->bind('', sub { $config{Layout} = 4 ; layout(1); Tk->break; # stop default binding of this key + } ); + # key-desc,F11,fullscreen mode + $bind_w->bind('', sub { topFullScreen(); }); + + # key-desc,Delete,delete selected pictures to trash + $bind_w->bind('', sub { deletePics($lb_w, TRASH); } ); + # key-desc,Shift-Delete,remove selected pictures + $bind_w->bind('', sub { deletePics($lb_w, REMOVE); } ); + # key-desc,q,quit mapivi + $bind_w->bind('', sub { quitMain(); } ); + # key-desc,R,smart rename selected pictures (e.g to EXIF date) + $bind_w->bind('', sub { renameSmart($lb_w); } ); + # key-desc,F12,quit mapivi + $bind_w->bind('', sub { quitMain(); } ); + # show picture, EXIF, Comment and IPTC info + # key-desc,c,display JPEG comment + $bind_w->bind('', sub { showComment(); } ); + # key-desc,t,display embedded EXIF thumbnail + $bind_w->bind('', sub { showEXIFThumb(); } ); + # key-desc,Ctrl-v,toggle verbose output + $bind_w->bind('', sub { toggle(\$verbose); $userinfo = "verbose switched to $verbose"; $userInfoL->update; } ); + # key-desc,Ctrl-c,crop (lossless) + $bind_w->bind('', sub { crop($lb_w); } ); + # key-desc,Ctrl-b,add border and/or copyright + $bind_w->bind('', sub { losslessBorder(PIXEL); } ); + # key-desc,Ctrl-q,change size/quality + $bind_w->bind('', sub { changeSizeQuality(); } ); + # key-desc,Ctrl-o,open options dialog + $bind_w->bind('', sub { options(); } ); + # key-desc,Ctrl-e,edit picture in GIMP + $bind_w->bind('', sub { GIMPedit(); } ); + # key-desc,Ctrl-f,apply a filter to the picture + $bind_w->bind('', sub { filterPic(); } ); + # key-desc,H,display picture histogram + $bind_w->bind('', sub { showHistogram($lb_w); }); + # key-desc,9,rotate picture(s) 90 degrees clockwise + $bind_w->bind('', sub { rotate(90); }); + # key-desc,8,rotate picture(s) 180 degrees clockwise + $bind_w->bind('', sub { rotate(180); }); + # key-desc,7,rotate picture(s) 270 degrees clockwise + $bind_w->bind('', sub { rotate(270); }); + # key-desc,0,auto rotate picture(s) (EXIF orientation) + $bind_w->bind('', sub { rotate("auto"); }); + + + # key-desc,Escape,iconify the main window/close any other window + $bind_w->bind('', sub { $top->iconify; } ); + + # thumbnail navigation + # key-desc,Space,display the next picture + $bind_w->bind('', 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('', 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('', 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('', 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('', 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('', 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('', sub { + return if (stillBusy()); # block, until last picture is loaded + if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off + my @childs = $lb_w->info('children'); + return unless (@childs); + showPic($childs[-1]); + }); + + # key-desc,Ctrl-g,goto picture + $bind_w->bind('', sub { gotoPic($lb_w); } ); + + # key-desc,s,start/stop slideshow + $bind_w->bind('', sub { + if ($slideshow == 0) { $slideshow = 1; } else { $slideshow = 0; } + slideshow(); + } ); + + # key-desc,-,zoom out or faster slideshow + $bind_w->bind('', sub { + if ($slideshow) { + $config{SlideShowTime}-- if ($config{SlideShowTime} >= 1); + $userinfo = "slideshow time: ".$config{SlideShowTime}." sec"; $userInfoL->update; + } + else { + zoomStep(-1); + } + } ); + # key-desc,+,zoom in or slideshow slower + $bind_w->bind('', sub { + if ($slideshow) { + $config{SlideShowTime}++ if ($config{SlideShowTime} < 30); + $userinfo = "slideshow time: ".$config{SlideShowTime}." sec"; $userInfoL->update; + } + else { + zoomStep(1); + } + }); + + # key-desc,Ctrl-h,display picture in original size (100% zoom) + $bind_w->bind('', sub { zoom100(); }); + # key-desc,z,display picture in original size (100% zoom) + $bind_w->bind('', sub { zoom100(); }); + # key-desc,f,fit picture in canvas (auto zoom) + $bind_w->bind('', sub { fitPicture(); }); + +} + +############################################################## # addCommonKeyBindings - add key shortcuts to a widget ############################################################## sub addCommonKeyBindings { my $bind_w = shift; # widget to bind keys to my $lb_w = shift; # thumbnail listbox to use - # key-desc,a,add a JPEG comment + # key-desc,a,add JPEG comment $bind_w->bind('', sub { addComment($lb_w); } ); - # key-desc,e,edit a JPEG comment + # key-desc,e,edit JPEG comment $bind_w->bind('', sub { editComment($lb_w); } ); # key-desc,v,open picture in external viewer $bind_w->bind('', sub { openPicInViewer($lb_w); } ); @@ -1818,45 +1965,47 @@ # key-desc,Ctrl-l,show selected thumbnails on light table $bind_w->bind('', sub { light_table_add_from_lb($lb_w); } ); # key-desc,Ctrl-t,add/remove categories - $bind_w->bind('', sub { editIPTCCategories($lb_w); } ); + $bind_w->bind('', sub { editIPTCCategories($lb_w); } ); # key-desc,Ctrl-k,add/remove keywords - $bind_w->bind('', sub { editIPTCKeywords($lb_w); } ); + $bind_w->bind('', sub { editIPTCKeywords($lb_w); } ); -# key-desc,Ctrl-F01,set IPTC urgency to 1 - high -$bind_w->bind('', sub { setIPTCurgency($lb_w, 1); } ); -# key-desc,Ctrl-F02,set IPTC urgency to 2 -$bind_w->bind('', sub { setIPTCurgency($lb_w, 2); } ); -# key-desc,Ctrl-F03,set IPTC urgency to 3 -$bind_w->bind('', sub { setIPTCurgency($lb_w, 3); } ); -# key-desc,Ctrl-F04,set IPTC urgency to 4 -$bind_w->bind('', sub { setIPTCurgency($lb_w, 4); } ); -# key-desc,Ctrl-F05,set IPTC urgency to 5 - normal -$bind_w->bind('', sub { setIPTCurgency($lb_w, 5); } ); -# key-desc,Ctrl-F06,set IPTC urgency to 6 -$bind_w->bind('', sub { setIPTCurgency($lb_w, 6); } ); -# key-desc,Ctrl-F07,set IPTC urgency to 7 -$bind_w->bind('', sub { setIPTCurgency($lb_w, 7); } ); -# key-desc,Ctrl-F08,set IPTC urgency to 8 - low -$bind_w->bind('', sub { setIPTCurgency($lb_w, 8); } ); -# key-desc,Ctrl-F09,set IPTC urgency to 0 - none -$bind_w->bind('', sub { setIPTCurgency($lb_w, 0); } ); -# key-desc,Ctrl-F10,remove IPTC urgency flag -$bind_w->bind('', sub { setIPTCurgency($lb_w, 9); } ); + # key-desc,Ctrl-F01,set IPTC urgency to 1 - high + $bind_w->bind('', sub { setIPTCurgency($lb_w, 1); } ); + # key-desc,Ctrl-F02,set IPTC urgency to 2 + $bind_w->bind('', sub { setIPTCurgency($lb_w, 2); } ); + # key-desc,Ctrl-F03,set IPTC urgency to 3 + $bind_w->bind('', sub { setIPTCurgency($lb_w, 3); } ); + # key-desc,Ctrl-F04,set IPTC urgency to 4 + $bind_w->bind('', sub { setIPTCurgency($lb_w, 4); } ); + # key-desc,Ctrl-F05,set IPTC urgency to 5 - normal + $bind_w->bind('', sub { setIPTCurgency($lb_w, 5); } ); + # key-desc,Ctrl-F06,set IPTC urgency to 6 + $bind_w->bind('', sub { setIPTCurgency($lb_w, 6); } ); + # key-desc,Ctrl-F07,set IPTC urgency to 7 + $bind_w->bind('', sub { setIPTCurgency($lb_w, 7); } ); + # key-desc,Ctrl-F08,set IPTC urgency to 8 - low + $bind_w->bind('', sub { setIPTCurgency($lb_w, 8); } ); + # key-desc,Ctrl-F09,set IPTC urgency to 0 - none + $bind_w->bind('', sub { setIPTCurgency($lb_w, 0); } ); + # key-desc,Ctrl-F10,remove IPTC urgency flag + $bind_w->bind('', sub { setIPTCurgency($lb_w, 9); } ); } ############################################################## -# startup - shows the given pic in the canvas +# startup - process all stuff needed to set up mapivi ############################################################## sub startup { + print "sub startup ...\n" if $verbose; $picLB->focus; - + if ($config{NrOfRuns} == 0) { - #whereIsPerl(); + print "first run ...\n" if $verbose; makeConfigDir(); - copyConfigPics(); - copyOtherStuff(); - copyPlugIns(); + # todo this should be done outside mapivi (we need an installer!!! :) + #copyConfigPics(); + #copyOtherStuff(); + #copyPlugIns(); } $config{NrOfRuns}++; gratulation() if (($config{NrOfRuns} % 1000 == 0) and ($config{NrOfRuns} > 0)); # modulo @@ -1893,14 +2042,14 @@ %searchDB = %{$hashRef}; } - # try to get the saved hotlist directories + # try to get the saved hotlist folders if (-f "$configdir/hotlist") { my $hashRef = retrieve("$configdir/hotlist"); warn "could not retrieve hotlist" unless defined $hashRef; %dirHotlist = %{$hashRef}; } - # try to get the saved directory properties + # try to get the saved folder properties if (-f "$configdir/dirProperties") { my $hashRef = retrieve("$configdir/dirProperties"); warn "could not retrieve dirProperties" unless defined $hashRef; @@ -1926,7 +2075,7 @@ updateDirMenu(); if (-f $config{DefaultThumb}) { - $defaultthumbP = $picLB->Photo(-format => "jpeg", -file => $config{DefaultThumb}, -gamma => $config{Gamma}); + $defaultthumbP = $picLB->Photo(-format => 'jpeg', -file => $config{DefaultThumb}, -gamma => $config{Gamma}); } else { warn "Mapivi info: no file ".$config{DefaultThumb}." found! (Please copy any thumbnail to this folder and rename it ".basename($config{DefaultThumb}).")\n"; @@ -1945,11 +2094,18 @@ setDirProperties(); updateThumbs(); setAdjusterPos(); - - showPic($actpic) if (defined $actpic and $actpic ne ""); + + 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); @@ -1966,7 +2122,7 @@ my @childs = $picLB->info('children'); if (@childs < 2) { - $top->messageBox(-icon => 'error', -message => "test suite must be started in a directory with at least two picture!", + $top->messageBox(-icon => 'error', -message => "test suite must be started in a folder with at least two picture!", -title => "test suite", -type => 'OK'); return; } @@ -2216,62 +2372,6 @@ } ############################################################## -# whereIsPerl - adjust the first line of this program according -# to the path to perl -# start mapivi the first time with: -# > perl mapivi -# and then just a: -# > mapivi -# will do it. -############################################################## -sub whereIsPerl { - - return if $EvilOS; - - # look for perl - my $rc = `which perl`; # run shell command which - chomp $rc; - print "whereIsPerl: which perl: $rc\n" if $verbose; - if ($rc =~ m/^(no perl)/i) { - warn "whereIsPerl: no perl found!"; - return; - } - - unless (-w $0) { - warn "whereIsPerl: could not open $0 for write access!"; - return; - } - - my $file; - # look what's in the first line of this program - if (!open($file, "<$0")) { - warn "whereIsPerl: could not open $0 for read access!: $!"; - return; - } - my @lines = <$file>; # read the complete into the array lines - close $file; - - my $firstline = "#!$rc -w\n"; # this should be the first line - - print "whereIsPerl: first line: --".$lines[0]."--\n" if $verbose; # this is the first line - - if ($lines[0] ne $firstline) { # compare them - $lines[0] = $firstline; - } else { - print "whereIsPerl: nothing to do, first line is ok!" if $verbose; - return; - } - - # first line has changed - if (!open($file, ">$0")) { - warn "whereIsPerl: could not open $0 for write access!: $!"; - return; - } - print $file @lines; # write everything back - close $file; -} - -############################################################## # addToCachedPics - add a image (path and file name) to # the cachedPics list # if it is already in the list, move it to @@ -2319,7 +2419,7 @@ while (@cachedPics > $config{MaxCachedPics}) { if ($actpic eq $cachedPics[0]) { print "this is the aktual pic - skipping!\n" if $verbose; - next; # todo this was last. what is right??? + next; } my $dpic = shift @cachedPics; # get the oldest print "checkCachedPics: removing old $dpic list:$#cachedPics\n" if $verbose; @@ -2459,15 +2559,27 @@ my $size = shift; my $sizeStr; - $size = int($size/1024); - if ($size > 1024) { # MegaByte - if ($size < (1024*100)) { # less than 100MB + $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"; @@ -2562,7 +2674,6 @@ # load pic $photos{$dpic} = $top->Photo(-file => $dpic, -gamma => $config{Gamma}); # zoom pic - autoZoom(\$photos{$dpic}, $dpic, $c->width, $c->height) if (exists $photos{$dpic} and $config{AutoZoom}); #} @@ -2672,13 +2783,13 @@ } ############################################################## -# showMostPopularPics - display the Top50 of the most viewed pics +# showMostPopularPics - display the Top 100 of the best rated pics ############################################################## sub showMostPopularPics { # open window my $win = $top->Toplevel(); - $win->title('Most popular pictures - TOP50'); + $win->title('Best rated pictures - TOP 100'); $win->iconimage($mapiviicon) if $mapiviicon; my $text = "searching ..."; @@ -2686,7 +2797,7 @@ $win->Label(-textvariable => \$text)->pack(-expand => 0, -fill => 'x'); my $tlb = $win->Scrolled("HList", -header => 1, - -separator => ';', # todo here we hope that ; will never be in a directory or file name + -separator => ';', # todo here we hope that ; will never be in a folder or file name -pady => 0, -columns => 3, -scrollbars => 'osoe', @@ -2721,19 +2832,29 @@ repositionWindow($win); my @populatity_list = sort { - my $popa = 0; - $popa = $searchDB{$a}{POP} if (defined $searchDB{$a}{POP}); - my $popb = 0; - $popb = $searchDB{$b}{POP} if (defined $searchDB{$b}{POP}); - $popb <=> $popa; + my $urga = 0; + $urga = $searchDB{$a}{URG} if (defined $searchDB{$a}{URG}); + $urga = 9 if ($urga == 0); + my $urgb = 0; + $urgb = $searchDB{$b}{URG} if (defined $searchDB{$b}{URG}); + $urgb = 9 if ($urgb == 0); + $urga <=> $urgb; } keys %searchDB; +# my @populatity_list = sort { +# my $popa = 0; +# $popa = $searchDB{$a}{POP} if (defined $searchDB{$a}{POP}); +# my $popb = 0; +# $popb = $searchDB{$b}{POP} if (defined $searchDB{$b}{POP}); +# $popb <=> $popa; +# } keys %searchDB; + $win->update(); $text = "loading ..."; my %thumbs; - foreach my $nr (0 .. 49) { + foreach my $nr (0 .. 99) { my $dpic = $populatity_list[$nr]; my $num = $nr + 1; my $pic = basename($dpic); @@ -2753,7 +2874,9 @@ my $pop = 0; $pop = $searchDB{$dpic}{POP} if (defined $searchDB{$dpic}{POP}); - $tlb->itemCreate($dpic, 2, -text => "$pic\n$path\nViewed $pop times", -style => $fileS); + my $urg = 0; + $urg = $searchDB{$dpic}{URG} if (defined $searchDB{$dpic}{URG}); + $tlb->itemCreate($dpic, 2, -text => "$pic\n$path\nRating: $urg\n(viewed $pop times)", -style => $fileS); } @@ -2879,7 +3002,7 @@ # central thumbDB if (($config{CentralThumbDB}) or # config option set to central thumbdir - (!-d $dir) or # if the directory is not mounted/available + (!-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 @@ -3031,12 +3154,6 @@ } else { # we run on a evil OS like windows - no threading :( - # todo added for vinci - #my $thumbdir = dirname($thumb); - #print "*** no thumb dir: $thumbdir\n" unless (-d $thumbdir); - #my $picdir = dirname($dpic); - #print "*** no pic dir: $picdir\n" unless (-d $picdir); - #print "*** no source pic: $dpic\n" unless (-f $dpic); proccount(1); # count processes (system "$string") == 0 or warn "$string failed: $!"; updateOneThumb($thumb, $lpic, $show); @@ -3128,7 +3245,7 @@ $ltw->bind('', sub {light_table_select_all();}); # window resize event $ltw->bind("" => sub { - # if there is a timer running cancel it + # 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 @@ -3234,22 +3351,23 @@ $context_menu->Popup(-popover => "cursor", -popanchor => "nw"); } ); $ltw->bind('', sub {light_table_delete(); }); - $context_menu->command(-label => 'Move selected to top', - -command => sub { light_table_shift('top'); }); - $context_menu->command(-label => 'Move selected to bottom', - -command => sub { light_table_shift('bottom'); }); - $context_menu->command(-label => 'Delete selected', + $context_menu->command(-image => compound_menu($top, 'move selected to top', 'go-first.png'), -command => sub { light_table_shift('top'); }); + $context_menu->command(-image => compound_menu($top, 'move selected to bottom', 'go-first.png'), -command => sub { light_table_shift('bottom'); }); + $context_menu->separator; + $context_menu->command(-label => 'remove selected from light table', -accelerator => "", -command => sub { light_table_delete(); }); - $context_menu->command(-label => 'Copy and rename selected', + $context_menu->command(-label => 'copy and rename selected', -command => sub { light_table_copy_rename(); }); + $context_menu->command(-image => compound_menu($top, 'copy to print ...', 'printer.png'), -command => sub { copyToPrint($ltw->{canvas}); }); + $context_menu->separator; $context_menu->command(-label => 'montage/index print ...', -command => sub { my @pics = getSelection($ltw->{canvas}); indexPrint(\@pics); }); - $context_menu->command(-label => 'Show in viewer', + $context_menu->separator; + $context_menu->command(-image => compound_menu($top, 'open picture in external viewer', 'image-x-generic.png'), -command => sub { openPicInViewer($ltw->{canvas}); }); #$context_menu->command(-label => 'Show in external viewer', # -command => sub { openPicInViewer($ltw);(); }); - $context_menu->separator; #$context_menu->command(-label => 'Add pics', -command => sub { add_pics(); }); $ltw->{thumb_distance} = 5; # in pixels @@ -3480,7 +3598,7 @@ my $ask = shift; if ((defined $ask) and ($ask == ASK)) { my $rc = $ltw->messageBox(-icon => 'question', - -message => "The slideshow will not be saved automatically.\nReally quit?", + -message => "The slideshow will not be saved automatically.\nOK to close light table?", -title => "Close light table?", -type => 'OKCancel'); return unless ($rc =~ m/Ok/i); } @@ -3564,7 +3682,7 @@ 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) + # get thumb size info from first thumbnail in list (this may be wrong, as others may be bigger) my ($tw, $th) = getSize(getThumbFileName($$list_ref[0])); $ltw->{thumb_size} = $tw if ($tw > 1); @@ -3720,7 +3838,9 @@ my $i = 0; $rc = 1; - my $digits = 3; + #my $digits = 3; + # idea from Yann Michel + my $digits = int(log(@sel)/log(10))+1; # calculate the needed digits dynamically my $pw = progressWinInit($ltw, "Copy and rename pictures"); foreach my $id (@sel) { my $dpic = get_path_from_id($id); @@ -3761,7 +3881,7 @@ my $dis = $ltw->{thumb_size} + $ltw->{thumb_distance}; $dis = 1 if ($dis == 0); # avoid division by zero # drop position in cols/rows - my $col = sprintf "%0d", ($x / $dis); + my $col = sprintf "%0d", ($x / $dis); # round my $row = sprintf "%0d", ($y / $dis); print "drop at x=$x y=$y col=$col row=$row\n"; @@ -3958,10 +4078,10 @@ foreach my $thumb (@sel) { my ($x, $y) = $ltw->{canvas}->coords( $thumb ); $ltw->{canvas}->createRectangle( $x, $y, $x+$ltw->{thumb_size}+1, $y+$ltw->{thumb_size}+1, - -tags => ['FRAME'], - -outline => $config{ColorSel}, - -width => 3, - ); + -tags => ['FRAME'], + -outline => $config{ColorSel}, + -width => 3, + ); } $ltw->{label} = scalar @light_table_list.' pictures, '.scalar @sel.' selected'; @@ -4247,7 +4367,7 @@ # smart_update - reread actual directory, add new and remove # deleted pics, without reloading the existing # thumbnails; the goal is to have a faster -# update for large directories +# update for large folders ############################################################## sub smart_update { @@ -4403,7 +4523,7 @@ addToSearchDB($dpic); # save the infos into the search data base } } - else { + 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 } @@ -4415,8 +4535,8 @@ $exif = $searchDB{$dpic}{EXIF}; $iptc = displayIPTC($dpic); $size = getAllFileInfo($dpic); - $com = formatString($com, $config{LineLength}); # format the comment for the list - $iptc = formatString($iptc, $config{LineLength}); # format the IPTC info for the list + $com = formatString($com, $config{LineLength}, , $config{LineLimit}); # format the comment for the list + $iptc = formatString($iptc, $config{LineLength},, $config{LineLimit}); # format the IPTC info for the list my $image; if ((defined $thumbP) and $with_thumb) { @@ -4509,7 +4629,15 @@ $pop = 0; $pop = $searchDB{$dpic}{POP} if (defined $searchDB{$dpic}{POP}); - # build a string from the keyword list + # 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 @@ -4528,27 +4656,57 @@ # try to get the EXIF date from the short EXIF info format: "dd.mm.yyyy hh:mm:ss" # there may be [t] or [s] before the date! undef $ctime; - if (defined($exif) and ($exif =~ m/(\d\d)\.(\d\d)\.(\d\d\d\d)\s(\d\d):(\d\d):(\d\d)/)) { - my $mon = $2; - my $year = $3; - $mon--; - if ($year > $copyright_year) { # fix wrong dates - print "Mapivi warning: $dpic: EXIF year: $year is in the future, correcting to $copyright_year\n"; - $year = $copyright_year; + 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; } - $year -= 1900; - if ($mon >= 0 and $mon <= 11) { - # calculate the time as value in seconds since the Epoch (Midnight, January 1, 1970) - $ctime = timelocal($6,$5,$4,$1,$mon,$year); - #warn "using exifdate for $dpic: $ctime\n" if $verbose; - - # optional checks - #my ($s,$m,$h,$d,$mo,$y) = localtime $ctime; - #$y += 1900; $mo++; # do some adjustments - # build up the date time string, sim#lar to the EXIF format - #my $date1 = sprintf "%04d:%02d:%02d %02d:%02d:%02d", $y, $mo, $d, $h, $m, $s; - #my $date2 = "$3:$2:$1 $4:$5:$6"; - #print "$date2 $date $dpic\n" if ($date1 ne $date2); + $mon--; + if (defined $year) { + if ($year > $copyright_year) { # fix wrong dates + print "Mapivi warning: $dpic: EXIF year: $year is in the future, correcting to $copyright_year\n"; + $year = $copyright_year; + } + $year -= 1900; + + if ($mon >= 0 and $mon <= 11) { + # calculate the time as value in seconds since the Epoch (Midnight, January 1, 1970) + $ctime = timelocal($sec,$min,$hour,$day,$mon,$year); + #warn "using exifdate for $dpic: $ctime\n" if $verbose; + + # optional checks + #my ($s,$m,$h,$d,$mo,$y) = localtime $ctime; + #$y += 1900; $mo++; # do some adjustments + # build up the date time string, sim#lar to the EXIF format + #my $date1 = sprintf "%04d:%02d:%02d %02d:%02d:%02d", $y, $mo, $d, $h, $m, $s; + #my $date2 = "$3:$2:$1 $4:$5:$6"; + #print "$date2 $date $dpic\n" if ($date1 ne $date2); + } } #else { print "mon = $mon $3:$2:$1 $4:$5:$6\n";} } @@ -4566,9 +4724,9 @@ #$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); + $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 @@ -4629,18 +4787,21 @@ return '' if (!-f $dpic); $size = basename($dpic)."\n\n"; - $size .= int($searchDB{$dpic}{SIZE}/1024).'kB'; + $size .= int($searchDB{$dpic}{SIZE}/1024).'kB' if $searchDB{$dpic}{SIZE}; $size .= '[bak]' if (-f $bpic); # show that there is a backup file my ($basename, $suffix) = getBasenameSuffix($dpic); - $size .= '[raw]' if (-f $basename.'.nef'); # show that there is a raw file - $size .= '[raw]' if (-f $basename.'.crw'); # show that there is a raw file + $size .= '[raw]' if ((-f $basename.'.nef') or (-f $basename.'.NEF')); # show that there is a raw file + $size .= '[raw]' if ((-f $basename.'.crw') or (-f $basename.'.CRW')); # show that there is a raw file + $size .= '[XMP]' if ((-f $basename.'.xmp') or (-f $basename.'.XMP')); # show that there is a XMP sidecar file + $size .= '[WAV]' if ((-f $basename.'.wav') or (-f $basename.'.WAV')); # show that there is a WAV audio file - $size .= "\n".buildDateTime($searchDB{$dpic}{MOD}) if ($config{ShowFileDate}); + $size .= "\n".buildDateTime($searchDB{$dpic}{MOD}) if ($config{ShowFileDate} and defined $searchDB{$dpic}{MOD}); - $w = $searchDB{$dpic}{PIXX}; - $h = $searchDB{$dpic}{PIXY}; + $w = $searchDB{$dpic}{PIXX} if $searchDB{$dpic}{PIXX}; + $h = $searchDB{$dpic}{PIXY} if $searchDB{$dpic}{PIXY}; - my $p = sprintf "%.2f", ($w*$h/1000000); # MP = MegaPixel + # MP = MegaPixel + my $p = sprintf "%.2f", ($w*$h/1000000); $size .= "\n${w}x$h (${p}MP)"; if ($config{BitsPixel}) { @@ -4773,36 +4934,37 @@ ############################################################## # formatString - cuts and formats a string to # a width of $linelenght chars and a length of -# $config{LineLimit} lines. +# $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; +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 "")); + return '' if ((!defined $string) or ($string eq '')); $Text::Wrap::columns = $linelenght+1; -# $string =~ s/^\s+//; # cut leading white -# $string =~ s/\s+$//; # cut trailing white $string =~ s/\r//g; # cut \r (carriage return) - # cut long strings and add a ... -# $string = substr($string, 0, $chars)."..." if (($chars > 0) and (length($string) > ($chars + 3))); -# $string =~ s/$/ /; # add a trailing space -# $string =~ s/(.{0,$linelenght})\s+/$1\n/g; # insert a newline every $linelenght chars with withespace $string =~ tr[\200-\377][\000-\177]; # remove the eight bit - $string = wrap("","",$string); - my @l = split /\n/, $string; # limit the lines - my $max = $config{LineLimit}; - $max = @l if (@l < $config{LineLimit}); - $string = ""; - for ( 0 .. ($max - 1)) { - $string .= sprintf "%s\n", $l[$_]; + $string = 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) } - $string =~ s/\n+$//; # cut off trailing newline(s) return $string; } @@ -4854,8 +5016,8 @@ return 1 if (-d $dir); if ( ($ask == ASK) and $config{AskMakeDir} ) { - my $rc = checkDialog("Create new directory?", - "MaPiVi would like to create this directory:\n$dir\nContinue?", + my $rc = checkDialog("Create new folder?", + "MaPiVi would like to create this folder:\n$dir\nContinue?", \$config{AskMakeDir}, "ask every time", "", @@ -5083,12 +5245,16 @@ $commentText->delete( 0.1, 'end'); # remove old comment $commentText->insert('end', $comment); # insert new comment } - if ($config{ShowUrgency}) { - $urgencyStr = getIPTCurgency($dpic, $meta); - $urgencyScale = 9 - $urgencyStr; - $urgencyScale = 0 if (($urgencyStr < 1) or ($urgencyStr > 8)); - $urgencyStr = "" if ($urgencyStr > 8); - } + if ($config{ShowCaptionField}) { + my $caption = getIPTCCaption($dpic); + $captionText->delete( 0.1, 'end'); # remove old caption + $captionText->insert('end', $caption); # insert new caption + } + $urgencyStr = getIPTCurgency($dpic, $meta); + $urgencyScale = 9 - $urgencyStr; + $urgencyScale = 0 if (($urgencyStr < 1) or ($urgencyStr > 8)); + $urgencyStr = "" if ($urgencyStr > 8); + $size = getFileSize($dpic, FORMAT); } setTitle(); @@ -5108,14 +5274,14 @@ my $info = ""; my $meta = getMetaData($dpic, "COM|APP13|APP1|SOF", 'FASTREADONLY'); - my $exif = formatString(getShortEXIF($dpic, NO_WRAP, $meta), 80); - my $comm = formatString(getComment($dpic, LONG, $meta), 80); - my $iptc = formatString(getIPTC($dpic, SHORT, $meta), 80); + my $exif = formatString(getShortEXIF($dpic, NO_WRAP, $meta), 80, -1); + my $comm = formatString(getComment($dpic, LONG, $meta), 80, -1); + my $iptc = formatString(getIPTC($dpic, LONG, $meta), 80, -1); $info .= "EXIF:\n$exif\n" if ($exif ne ""); $info .= "--------------------\n" if (($exif ne "") and (($comm ne "") or ($iptc ne ""))); - $info .= "Comment:\n$comm\n" if ($comm ne ""); - $info .= "--------------------\n" if (($comm ne "") and ($iptc ne "")); $info .= "IPTC:\n$iptc" if ($iptc ne ""); + $info .= "--------------------\n" if (($comm ne "") and ($iptc ne "")); + $info .= "Comment:\n$comm" if ($comm ne ""); return if ($info eq ''); # show image info on canvas white font with black shadow @@ -5164,7 +5330,7 @@ my $myDiag = $top->Toplevel(); $myDiag->title('Non-JPEG pictures'); - $myDiag->Label(-text => "There are ".scalar @pics." non-JPEG pictures in directory ".basename($dir).".\nShould I convert these pictures to JPEG format?\n(After convertion these pictures will be visible in Mapivi.)", + $myDiag->Label(-text => "There are ".scalar @pics." non-JPEG pictures in folder ".basename($dir).".\nShould I convert these pictures to JPEG format?\n(After convertion these pictures will be visible in Mapivi.)", -bg => $config{ColorBG} )->pack(-fill => 'x', -padx => 3, -pady => 3); @@ -5738,8 +5904,13 @@ my @fileDirList = readDir($dir); my @dirList; foreach (@fileDirList) { - next if (($_ eq ".") or ($_ eq "..")); - push @dirList, $_ if (-d "$dir/$_"); + 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; @@ -5773,7 +5944,8 @@ sub readDir { my $dir = shift; - + $dir = Encode::encode('iso-8859-1', $dir); + if (! -d $dir) { warn "readDir: $dir is no dir!: $!" unless (($dir =~ m/.*$thumbdirname$/) or ($dir =~ m/.*$plugindir$/)); return 0; @@ -5783,7 +5955,7 @@ # open the directory if (!opendir ACTDIR, "$dir") { - warn "Can't open directory $dir: $!"; + warn "Can't open folder $dir: $!"; return 0; } @@ -5845,7 +6017,8 @@ saveAdjusterPos(); $config{LastDir} = $actdir if (-d $actdir); - + $config{ActPic} = $actpic; + # we don't want to start in full screen mode # so if we've been in fullscreen mode, we save the settings from before the fullscreen switch if ($topFullScreen) { @@ -5854,6 +6027,7 @@ $config{ShowMenu} = $topFullSceenConf{ShowMenu}; $config{ShowInfoFrame} = $topFullSceenConf{ShowInfoFrame}; $config{ShowCommentField} = $topFullSceenConf{ShowCommentField}; + $config{ShowCaptionField} = $topFullSceenConf{ShowCaptionField}; $config{ShowEXIFField} = $topFullSceenConf{ShowEXIFField}; $config{Layout} = $topFullSceenConf{Layout}; } @@ -5864,21 +6038,21 @@ if ($config{SaveDatabase}) { $userinfo = "saving search database ..."; $userInfoL->update; - store(\%searchDB, "$configdir/SearchDataBase") or warn "could not store searchDB in file $configdir/SearchDataBase: $!"; + nstore(\%searchDB, "$configdir/SearchDataBase") or warn "could not store searchDB in file $configdir/SearchDataBase: $!"; } $userinfo = "saving dir hotlist ..."; $userInfoL->update; - store(\%dirHotlist, "$configdir/hotlist") or warn "could not store $configdir/hotlist: $!"; + nstore(\%dirHotlist, "$configdir/hotlist") or warn "could not store $configdir/hotlist: $!"; my $datetime = getDateTime(); # save a copy of the old hash in the trash # todo: remove very old backups $userinfo = "saving dir check list ..."; $userInfoL->update; mycopy("$configdir/dirProperties", "$trashdir/dirProperties-$datetime", OVERWRITE) if (-f "$configdir/dirProperties"); - store(\%dirProperties, "$configdir/dirProperties") or warn "could not store $configdir/dirProperties: $!"; - store(\%ignore_keywords, "$configdir/keywords_ignore") or warn "could not store $configdir/keywords_ignore: $!"; + nstore(\%dirProperties, "$configdir/dirProperties") or warn "could not store $configdir/dirProperties: $!"; + nstore(\%ignore_keywords, "$configdir/keywords_ignore") or warn "could not store $configdir/keywords_ignore: $!"; if (MatchEntryAvail) { $userinfo = "saving entry values ..."; $userInfoL->update; - store(\%entryHistory, $file_Entry_values) or warn "could not store $file_Entry_values: $!"; + nstore(\%entryHistory, $file_Entry_values) or warn "could not store $file_Entry_values: $!"; } $userinfo = "saving categories ..."; $userInfoL->update; @@ -5915,7 +6089,7 @@ $comment =~ s/\r*//g; # remove \r (carriage return) $comment =~ s/\n+$//; # cut off last newline(s) - $comment = formatString($comment, $config{LineLength}) if ($format == SHORT); + $comment = formatString($comment, $config{LineLength}, $config{LineLimit}) if ($format == SHORT); print "getComment: $comment $dpic\n" if $verbose; @@ -5998,7 +6172,9 @@ $datestr = getEXIFDate($dpic, $er); if ($datestr ne "") { if (my ($y, $M, $d, $h, $m, $s) = $datestr =~ m/(\d\d\d\d):(\d\d):(\d\d) (\d\d):(\d\d):(\d\d)/) { - $exif .= "$d.$M.$y $h:$m:$s "; + #$exif .= "$d.$M.$y $h:$m:$s "; # german date format + #$exif .= "$M/$d/$y $h:$m:$s "; # american date format + $exif .= "$y-$M-$d $h:$m:$s "; # ISO 8601 date format $exif .= "\n" if $wrap; } else { @@ -6271,7 +6447,7 @@ ############################################################## sub getEXIFMeta { my $dpic = shift; - my $exif = ""; + my $exif = ''; return $exif unless is_a_JPEG($dpic); @@ -6295,11 +6471,12 @@ while (my ($d, $h) = each %$hash_ref) { while (my ($t, $a) = each %$h) { - my $a2 = ""; + my $a2 = ''; foreach (@$a) { + $_ =~ tr/ -~//cd; # remove all non-printable chars $a2 .= sprintf "%-5s", $_; } - $a2 = cutString($a2, 30 , ".."); + $a2 = cutString($a2, 30 , '..'); $exif .= sprintf "%-25s\t%-25s\t-> %-s\n", $d, $t, $a2; } } @@ -6545,7 +6722,7 @@ my $selected = @sellist; my $rc = $top->messageBox(-icon => 'question', - -message => "Extract embedded EXIF thumbnails of $selected selected pictures and write them to a (new created) subdirectory \"EXIFThumbs/\" in the current directory.\nShould I continue?", + -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); @@ -6672,7 +6849,7 @@ next; } - #date time format: 2006:04:04 11:12:13 + #date time format: 2007:04:04 11:12:13 my $hash = $meta->set_Exif_data({'DateTime' => $datetime, 'DateTimeOriginal' => $datetime, 'DateTimeDigitized' => $datetime}, 'IMAGE_DATA', 'ADD'); @@ -6699,6 +6876,24 @@ } ############################################################## +# 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' ############################################################## @@ -6718,15 +6913,22 @@ )->pack(-anchor => 'w'); - my $f = $dtw->Frame()->pack; - my $af = $f->Frame(-bd => 1, -relief => "raised")->pack(-fill => "y", -side => "left"); # absolut - my $rf = $f->Frame(-bd => 1, -relief => "raised")->pack(-fill => "y", -side => "left"); # relative + # 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->Radiobutton(-text => "use absolute value", -variable => \$config{EXIFAbsRel}, -value => "abs")->pack(-anchor => 'w'); - $af->Label(-text => "Please enter the new date and time to store\nin the selected pictures\n(please use the format: yyyy:mm:dd-hh:mm:ss\nexample: 2006:05:21-11:07:59)", + $af->Label(-text => "Please enter the new date and time to store\nin the selected pictures\n(please use the format: yyyy:mm:dd-hh:mm:ss\nexample: 2008:05:21-11:07:59)", -bg => $config{ColorBG}, -justify => "left")->pack(-anchor => 'w'); my $entry = $af->Entry(-textvariable => \$$datetime, @@ -6742,10 +6944,9 @@ ######### relative - $rf->Radiobutton(-text => "use relative value", -variable => \$config{EXIFAbsRel}, -value => "rel")->pack(-anchor => 'w'); $rf->Radiobutton(-text => "+ (add time)", -variable => \$config{EXIFPlusMin}, -value => "+")->pack(-anchor => 'w'); - $rf->Radiobutton(-text => "- (subtract time)", -variable => \$config{EXIFPlusMin}, -value => "-")->pack(-anchor => 'w'); + $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); @@ -6792,8 +6993,8 @@ return unless askSelection(\@sellist, 10, "EXIF thumbnail"); if (!-d $trashdir) { # we need the trash dir for the temp files - $top->messageBox(-icon => 'warning', -message => "Trash directory $trashdir not found!\nPlease create this directory (shell: mkdir $trashdir) and retry.\n\nAborting.", - -title => "No trash directory", -type => 'OK'); + $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; } @@ -7059,7 +7260,7 @@ next; } - unless (store($seg, $exiffile)) { + unless (nstore($seg, $exiffile)) { $errors .= "could not store EXIF segment in file $exiffile: $!\n"; next; } @@ -7083,7 +7284,7 @@ return unless checkSelection($top, 1, 0, \@sellist); if (!-d "$actdir/$exifdirname") { - $top->messageBox(-icon => 'warning', -message => "Found no saved EXIF infos in this directory!", + $top->messageBox(-icon => 'warning', -message => "Found no saved EXIF infos in this folder!", -title => "No EXIF infos", -type => 'OK'); return; } @@ -7157,7 +7358,7 @@ return unless checkSelection($top, 1, 0, \@sellist); if (!-d "$actdir/$exifdirname") { - $top->messageBox(-icon => 'warning', -message => "Sorry, but there are no saved EXIF infos in this directory!", + $top->messageBox(-icon => 'warning', -message => "Sorry, but there are no saved EXIF infos in this folder!", -title => "no EXIF infos", -type => 'OK'); return; } @@ -7357,7 +7558,7 @@ if (!-d $iptcdir) { if ( !mkdir $iptcdir, 0755 ) { - $top->messageBox(-icon => 'warning', -message => "Error making IPTC template directory $iptcdir: $!", + $top->messageBox(-icon => 'warning', -message => "Error making IPTC template folder $iptcdir: $!", -title => "Save IPTC template", -type => 'OK'); return; } @@ -7380,7 +7581,7 @@ return if ($rc !~ m/Ok/i); } - my $rc = store($iptc, $file) or warn "could not store IPTC in file $file: $!"; + my $rc = nstore($iptc, $file) or warn "could not store IPTC in file $file: $!"; $userinfo = "IPTC template saved ($rc)"; $userInfoL->update; @@ -7453,13 +7654,13 @@ ############################################################## sub applyIPTC { my $lb = shift; # reference to listbox widget - my $iptc = shift; # reference to a IPTC hash as provided by Image::MetaData::JPEG + my $iptc = shift; # reference to an IPTC hash as provided by Image::MetaData::JPEG my $piclist = shift; # picture list reference - my $errors = ""; + my $errors = ''; my $pw = 0; - $pw = progressWinInit($lb, "Apply IPTC template ") if (@$piclist > 1); + $pw = progressWinInit($lb, 'Apply IPTC template') if (@$piclist > 1); my $i = 0; foreach my $dpic (@$piclist) { last if ($pw and progressWinCheck($pw)); @@ -7486,7 +7687,7 @@ # 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); + showImageInfoCanvas($dpic) if ($dpic eq $actpic); } else { $errors .= "save failed for $dpic\n"; @@ -7495,7 +7696,7 @@ progressWinEnd($pw) if $pw; $userinfo = "ready! ($i of ".scalar @$piclist." processed)"; $userInfoL->update; - showText("Errors while applying IPTC infos", $errors, NO_WAIT) if ($errors ne ""); + showText('Errors while applying IPTC infos', $errors, NO_WAIT) if ($errors ne ''); } ############################################################## @@ -7510,19 +7711,32 @@ ############################################################## # uniqueIPTC - remove double entries from SupplementalCategories -# and Keywords and sort them +# and Keywords and sort them alphabetically # !Function will not save IPTC! ############################################################## sub uniqueIPTC { my $meta = shift; my $iptc = $meta->get_app13_data('TEXTUAL', 'IPTC'); + + # todo - doesn't work + # replace (german) umlaute by corresponding letters + #${$iptc->{Caption}}[0] =~ s/([$umlaute])/$umlaute{$1}/g if ($config{ConvertUmlaut}); + + # replace all non-printable chars, but not newline etc. + ${$iptc->{Caption}}[0] =~ tr/\n\t\r\f -~//cd if (${$iptc->{Caption}}[0]); my %d; # build a hash - foreach (@{$iptc->{SupplementalCategory}}) { $d{$_} = 1; } + 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}}) { $d{$_} = 1; } + 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'); @@ -7552,7 +7766,7 @@ my $XBut = $catw->Button(-text => "Close", -command => sub { saveTreeMode($cattree); - store($cattree->{m_mode}, "$configdir/categoryMode") or warn "could not store $configdir/categoryMode: $!"; + nstore($cattree->{m_mode}, "$configdir/categoryMode") or warn "could not store $configdir/categoryMode: $!"; $catw->destroy; })->pack(-expand => 0,-fill => 'x',-padx => 1,-pady => 1); @@ -7698,12 +7912,12 @@ my $keytree; - my $af = $keyw->Frame()->pack(-fill =>'x', -padx => 2, -pady => 2); + my $af = $keyw->Frame()->pack(-fill =>'x', -padx => 2, -pady => 1); # global button, as it has to be called from saveAllConfig (todo: find better solution for this) $keyXBut = $af->Button(-text => "Close", -command => sub { saveTreeMode($keytree); - store($keytree->{m_mode}, "$configdir/keywordMode") or warn "could not store $configdir/keywordMode: $!"; + nstore($keytree->{m_mode}, "$configdir/keywordMode") or warn "could not store $configdir/keywordMode: $!"; $config{KeyGeometry} = $keyw->geometry; $keyw->destroy; })->pack(-side => 'left', -expand => 1,-fill => 'x'); @@ -7780,6 +7994,7 @@ 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); @@ -7787,12 +8002,18 @@ $balloon->attach($rmB, -msg => "Remove the selected keywords from the selected pictures"); - my $bf = $keyw->Frame()->pack(-fill =>'x', -padx => 2, -pady => 2); - $bf->Radiobutton(-text => "all", -variable => \$config{KeywordsAll}, -value => 1)->pack(-side => 'left'); + my $bf = $keyw->Frame()->pack(-fill =>'x', -padx => 2, -pady => 1); $bf->Radiobutton(-text => "join", -variable => \$config{KeywordsAll}, -value => 2)->pack(-side => 'left'); + $bf->Radiobutton(-text => "all", -variable => \$config{KeywordsAll}, -value => 1)->pack(-side => 'left'); $bf->Radiobutton(-text => "last", -variable => \$config{KeywordsAll}, -value => 0)->pack(-side => 'left'); - $balloon->attach($bf, -msg => "Keyword add mode\nExample keyword: Friend/Bundy/Kelly\nmode all: three keywords: Friend, Bundy and Kelly\nmode join: one keyword: Friend.Bundy.Kelly\nmode last: one keyword: Kelly"); + $balloon->attach($bf, -msg => "Keyword add mode\nExample keyword: Friend/Bundy/Kelly\nmode join: one keyword: Friend.Bundy.Kelly\nmode all: three keywords: Friend, Bundy and Kelly\nmode last: one keyword: Kelly\n\nDefault and recommended mode: join\nIf you want to store and retrieve your keyword\nhierarchie from your pictures you should use join mode."); + my $df = $keyw->Frame()->pack(-fill =>'x', -padx => 3, -pady => 1); + $balloon->attach($df, -msg => "Use the checkbutton to dock the keyword window to the main window.\nSelect < to dock it to the left side and > to dock it to the right side."); + $df->Checkbutton(-text => 'dock', -variable => \$config{KeywordDialogDock}, -command => sub {dock_keyword_dialog();})->pack(-side => 'left'); + $df->Radiobutton(-text => '<', -variable => \$config{KeywordDialogDockL}, -value => 1, -command => sub {dock_keyword_dialog();})->pack(-side => 'left'); + $df->Radiobutton(-text => '>', -variable => \$config{KeywordDialogDockL}, -value => 0, -command => sub {dock_keyword_dialog();})->pack(-side => 'left'); + $keytree = $keyw->Scrolled('Tree', -separator => '/', -scrollbars => 'osoe', @@ -7800,7 +8021,7 @@ -exportselection => 0, -width => 25, -height => 25, - )->pack(-expand => 1, -fill =>'both', -padx => 4, -pady => 2); + )->pack(-expand => 1, -fill =>'both', -padx => 1, -pady => 1); $keyw->{tree} = $keytree; bindMouseWheel($keytree->Subwidget("scrolled")); @@ -7854,7 +8075,7 @@ my $XBut = $keycw->Button(-text => "Close", -command => sub { saveTreeMode($keytree); - store($keytree->{m_mode}, "$configdir/keywordMode") or warn "could not store $configdir/keywordMode: $!"; + nstore($keytree->{m_mode}, "$configdir/keywordMode") or warn "could not store $configdir/keywordMode: $!"; $keycw->destroy; })->pack(-expand => 0,-fill => 'x',-padx => 1,-pady => 1); @@ -7962,9 +8183,10 @@ $menu->command(-label => "add new item", -command => sub { my @keys = $tree->info('selection'); - return unless checkSelection($tree, 1, 1, \@keys); - my $item = ""; - my $parent = $keys[0]; + return unless checkSelection($tree, 0, 1, \@keys); + my $item = ''; + my $parent = ''; + $parent = $keys[0] if (@keys); if ($parent !~ m/.*\/.*/) { $parent = ''; } @@ -7978,6 +8200,23 @@ \$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}); }); @@ -7986,14 +8225,31 @@ my @keys = $tree->info('selection'); return unless checkSelection($tree, 1, 1, \@keys); - my $item = ""; + my $item = ''; my $parent = $keys[0]; my $rc = myEntryDialog('New sub item', "Please enter the new sub item (below $parent)", \$item); return if ($rc ne 'OK'); return if ($item eq ''); + + # avoid slash and backslash + if (($item =~ m|.*\/.*|) or ($item =~ m|.*\\.*|)) { + $tree->messageBox(-icon => 'info', + -message => 'Sorry, but the slash (/) and the backslash (\) are not allowed.', + -title => 'Wrong character', -type => 'OK'); + return; + } $parent .= '/' if (($parent ne '') and ($parent !~ m/.*\/$/)); + + # avoid double entries + if (isInList($parent.$item, $listRef)) { + $tree->messageBox(-icon => 'info', + -message => "Sorry, but $parent$item is already in the list.", + -title => 'Double entry', -type => 'OK'); + return; + } + push @{$listRef}, $parent.$item; insertTreeList($tree, @{$listRef}); }); @@ -8021,15 +8277,17 @@ }); $menu->separator; - $menu->command(-label => "delete selected item", -command => sub { + $menu->command(-label => "delete selected item(s)", -command => sub { my @keys = $tree->info('selection'); - return unless checkSelection($tree, 1, 1, \@keys); + return unless checkSelection($tree, 1, 0, \@keys); for my $t (reverse 0 .. $#{@{$listRef}} ) { - if ($$listRef[$t] =~ m/^$keys[0].*/) { + foreach my $key (@keys) { + if ($$listRef[$t] =~ m/^$key.*/) { print "trow out: $$listRef[$t] ($t)\n" if $verbose; splice @{$listRef}, $t, 1; # remove it from list } + } } insertTreeList($tree, @{$listRef}); }); @@ -8052,7 +8310,7 @@ if (@keys > 1) { $pat = "(?=.*".$pat; # and-function with look-ahead $pat =~ s/\s+/)(?=.*/g; # replace one or more whitespaces with )(?=.* - $pat .= ")"; # "Tom Tim" is now: "(?=.*Tom)(?=.*Tim)" + $pat .= ')'; # "Tom Tim" is now: "(?=.*Tom)(?=.*Tim)" } my $start_time = Tk::timeofday(); @@ -8081,7 +8339,7 @@ }); $tree->bind('', sub { - $menu->Popup(-popover => "cursor", -popanchor => "nw"); + $menu->Popup(-popover => 'cursor', -popanchor => 'nw'); } ); } @@ -8216,6 +8474,24 @@ } } +#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 ############################################################## @@ -8228,39 +8504,54 @@ my $format = shift; my $meta = shift; # optional, the Image::MetaData::JPEG object of $pic if available - my $iptc = ""; + my $iptc = ''; return $iptc unless is_a_JPEG($dpic); my $shortkey; - + # todo: is , 'FASTREADONLY' here possible? $meta = getMetaData($dpic, 'APP13') unless (defined($meta)); if ($meta) { my $seg = $meta->retrieve_app13_segment(undef, 'IPTC'); if ($seg) { - my $hashref = $seg->get_app13_data("TEXTUAL", 'IPTC'); + 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"); + next if ($key eq "RecordVersion"); - if (defined($hashref->{$key})) { - if (($format == LONG)) { - $iptc .= sprintf "%-31s: ", $key; - } else { - my $shortkey = $key; - $shortkey =~ s/SupplementalCategory/SuppCategories/; - $shortkey = substr($shortkey, 0, 7)."." if (length($shortkey) > 8); - $iptc .= sprintf "%-8s: ", $shortkey; - } - $iptc .= "$_ " for @{$hashref->{$key}}; - $iptc =~ s/\s+$//; # cut trailing whitespace - $iptc .= "\n"; + if (defined($hashref->{$key})) { + if (($format == LONG)) { + $iptc .= sprintf "%-31s: ", $key; + } else { + my $shortkey = $key; + $shortkey =~ s/SupplementalCategory/SuppCategories/; + $shortkey = substr($shortkey, 0, 7)."." if (length($shortkey) > 8); + $iptc .= sprintf "%-8s: ", $shortkey; + } + $iptc .= "$_ " for @{$hashref->{$key}}; + $iptc =~ s/\s+$//; # cut trailing whitespace + $iptc .= "\n"; } } + + # add Coded Character Set info + my $hash_1 = $seg->get_app13_data('TEXTUAL', 'IPTC_1'); + if (defined $hash_1->{'CodedCharacterSet'}) { + my $encoding = PrintCodedCharset(${$hash_1->{'CodedCharacterSet'}}[0]); + if (($format == LONG)) { + $iptc .= sprintf "%-31s: ", 'CodedCharacterSet'; + } else { + $iptc .= 'CCharSet: '; + } + $iptc .= "$encoding\n"; + #print "found Coded character set in $dpic: [$encoding][${$hash_1->{'CodedCharacterSet'}}[0]]\n"; + } + } } - + + $iptc =~ tr/\n -~//cd; # remove all non-printable chars, but not newline return $iptc; } @@ -8283,7 +8574,7 @@ my $info = getIPTC($dpic, SHORT); - $info = formatString($info, $config{LineLength}) if ((defined $format) and ($format == SHORT)); + $info = formatString($info, $config{LineLength}, $config{LineLimit}) if ((defined $format) and ($format == SHORT)); return $info; } @@ -8326,23 +8617,30 @@ ############################################################## sub processARGV { + getopts('i'); # sets $opt_i if switch -i is found + my $nr = @ARGV; - if ($nr < 1) { # open the last dir + if ($nr < 1) { # no arguments - open the last dir $actdir = $config{LastDir}; dirSave($actdir); return; } - if ($nr > 1) { - print "\nmapivi error: to many command line options\n"; + + if ($nr > 1) { # too many argument + print "Mapivi error: to many command line options\n"; printUsage(); exit; } my $item = abs_path($ARGV[0]); + #print "processARGV: -e $item = ", -e $item, "\n"; + $item = Encode::encode('iso-8859-1', $item); + #print "processARGV: item: $item item2: $item2\n"; + #print "processARGV: -e $item = ", -e $item, "\n"; if (-f $item) { - $actpic = basename($item); + $actpic = $item; $actdir = dirname($item); } elsif (-d $item) { @@ -8363,16 +8661,16 @@ sub getDirAndOpen { my $dir = $actdir; - my $rc = myEntryDialog("open dir","Please enter directory:",\$dir); + my $rc = myEntryDialog("open dir","Please enter folder:",\$dir); return if ($rc ne 'OK'); print " --$dir--\n" if $verbose; $dir = glob("$dir"); print "g--$dir--\n" if $verbose; while (!-d $dir) { - $top->messageBox(-icon => 'warning', -message => "Sorry, but I can't find the directory \"$dir\"", - -title => "No valid directory", -type => 'OK'); - $rc = myEntryDialog("open dir","Please enter directory:",\$dir); + $top->messageBox(-icon => 'warning', -message => "Sorry, but I can't find the folder \"$dir\"", + -title => "No valid folder", -type => 'OK'); + $rc = myEntryDialog("open dir","Please enter folder:",\$dir); return if ($rc ne 'OK'); $dir = glob("$dir"); } @@ -8394,6 +8692,12 @@ ############################################################## sub openDirPost { my $dir = shift; + $dir = Encode::encode('iso-8859-1', $dir); + #print "openDirPost: dir: $dir"; + #if (-d $dir) { print " is a dir\n"; } + #else { print " is not a dir\n"; } + + $dir =~ s/\/\//\//g; # replace all // with / return unless (defined $dir); @@ -8410,8 +8714,9 @@ setTitle(); $exif = "" if ($config{ShowEXIFField}); $commentText->delete( 0.1, 'end') if ($config{ShowCommentField} and defined $commentText); + $captionText->delete( 0.1, 'end') if ($config{ShowCaptionField} and defined $captionText); $dirtree->configure(-directory => $actdir); - # Set the directory + # Set the folder exists &Tk::DirTree::chdir ? $dirtree->chdir($actdir) : $dirtree->set_dir($actdir); selectDirInTree($actdir); @@ -8448,14 +8753,14 @@ # open window $dpw = $top->Toplevel(); $dpw->withdraw; - $dpw->title('Directory Checklist'); + $dpw->title('Folder Checklist'); $dpw->iconimage($mapiviicon) if $mapiviicon; my $topf = $dpw->Frame()->pack(); my $dplb = $dpw->Scrolled("HList", -header => 1, - -separator => ';', # todo here we hope that ; will never be in a directory or file name + -separator => ';', # todo here we hope that ; will never be in a folder or file name -pady => 1, -columns => 5, -scrollbars => 'osoe', @@ -8493,16 +8798,16 @@ $dplb->see($last) if ($dplb->info("exists", $last));; })->pack(-side => 'left', -expand => 0,-padx => 1,-pady => 1); - $topf->Checkbutton(-text => "Show unfinished directories", + $topf->Checkbutton(-text => "Show unfinished folders", -variable => \$config{ShowUnfinishedDirs} )->pack(-side => 'left', -expand => 0,-fill => 'x',-padx => 1,-pady => 1); - $topf->Checkbutton(-text => "Show finished directories", + $topf->Checkbutton(-text => "Show finished folders", -variable => \$config{ShowFinishedDirs} )->pack(-side => 'left', -expand => 0,-fill => 'x',-padx => 1,-pady => 1); - my $dpmenu = $dpw->Menu(-title => "Directory Checklist Menu"); + my $dpmenu = $dpw->Menu(-title => "Folder Checklist Menu"); - $dpmenu->command(-label => "open directory", + $dpmenu->command(-label => "open folder", -command => sub { my @dirs = $dplb->info('selection'); return unless checkSelection($dpw, 1, 1, \@dirs); @@ -8512,7 +8817,7 @@ $top->deiconify; $top->raise; } else { - $dplb->messageBox(-icon => 'info', -message => "Sorry, but this folder is currently not available!", -title => "Directory not available", -type => 'OK'); + $dplb->messageBox(-icon => 'info', -message => "Sorry, but this folder is currently not available!", -title => "Folder not available", -type => 'OK'); } } ); $dpmenu->command(-label => "add all sub folders to this list", @@ -8583,7 +8888,7 @@ $top->deiconify; $top->raise; } else { - $dplb->messageBox(-icon => 'info', -message => "Sorry, but this folder is currently not available!", -title => "Directory not available", -type => 'OK'); + $dplb->messageBox(-icon => 'info', -message => "Sorry, but this folder is currently not available!", -title => "Folder not available", -type => 'OK'); } } ); @@ -8656,8 +8961,7 @@ my @alldirs; my $break = 0; - my $i = 0; - my $pw = progressWinInit($top, "Collect sub directories"); + my $pw = progressWinInit($top, "Collect sub folders"); foreach my $dir (@dirs) { if (progressWinCheck($pw)) { $break = 1; @@ -8667,8 +8971,7 @@ # process just dirs, but not .thumbs/ .xvpics/ etc. if (progressWinCheck($pw)) { $break = 1; $File::Find::prune = 1; } if (-d and ($_ ne $thumbdirname) and ($_ ne ".xvpics") and ($_ ne $exifdirname)) { - $i++; $i = 0 if ($i > 10); - progressWinUpdate($pw, "collecting directories, found ".scalar @alldirs." ...", $i, 10); + progressWinUpdate($pw, "collecting folders, found ".scalar @alldirs." ...", 0, 0); push @alldirs, $File::Find::name; # add dir if it contains at least one picture #if (getPics($File::Find::name, JUST_FILE) > 0) { @@ -8681,23 +8984,23 @@ shift @alldirs if (@alldirs > 1); # remove the parent (starting) dir if there are subdirs - #$label = "Found ".scalar @alldirs." directories, getting size ..."; + #$label = "Found ".scalar @alldirs." folders, getting size ..."; - # hash key: directory value: size of dir in Bytes (including all subdirs) + # hash key: folder value: size of dir in Bytes (including all subdirs) my %dirsize; my $max = 0; #my $allsize = 0; my $dirCount = 0; my $fileCount = 0; - $i = 0; - $pw = progressWinInit($top, "Calculate directory sizes"); + my $i = 0; + $pw = progressWinInit($top, "Calculate folder sizes"); foreach my $dir (@alldirs) { if (progressWinCheck($pw)) { $break = 1; last; } $i++; - progressWinUpdate($pw, "in directory $dir ($i/".scalar @alldirs.") ...", $i, scalar @alldirs); + progressWinUpdate($pw, "in folder $dir ($i/".scalar @alldirs.") ...", $i, scalar @alldirs); my $size = 0; $dirCount++; find(sub { @@ -8714,7 +9017,7 @@ # open window $dsw = $top->Toplevel(); #$dsw->withdraw; - $dsw->title('Directory Sizes'); + $dsw->title('Folder Sizes'); $dsw->iconimage($mapiviicon) if $mapiviicon; #$dsw->{label} = "Starting soon"; @@ -8814,6 +9117,8 @@ ############################################################## sub selectDirInTree { my $dir = shift; + $dir = Encode::encode('iso-8859-1', $dir); + $dirtree->selectionClear(); if ($dirtree->info('exists', "/$dir")) { $dirtree->selectionSet("/$dir"); @@ -8881,47 +9186,49 @@ ############################################################## 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 Directory", "CSIDL_DESKTOP"); + $dir = BrowseForFolder("Choose folder", "CSIDL_DESKTOP"); $dir =~ s|\\|/|g; # perl likes the slashes like this return $dir; } else { # windows, but no win32 FileOp available print "FileOp is not available!\n" if $verbose; -# checkDialog('Select file instead of directory', -# 'There is no directory selector available, so please select a file instead of the directory. -#You may use any file, Mapivi will use the directory of that file. -#If the directory is empty, you may create a new file and select this. +# checkDialog('Select file instead of folder', +# 'There is no folder selector available, so please select a file instead of the folder. +#You may use any file, Mapivi will use the folder of that file. +#If the folder is empty, you may create a new file and select this. #Sorry for that inconvenience! #Example: -#To use the directory C:\pictures\2006\ select e.g. C:\pictures\2006\pic1.jpg', +#To use the folder C:\pictures\2006\ select e.g. C:\pictures\2006\pic1.jpg', # \$config{winDirRequesterAskAgain}, # "remind everytime", # "", # 'OK') if ($config{winDirRequesterAskAgain}); # my $file = $top->getOpenFile(); # little tricky here -# if ((defined $file) and (-f $file)) { # until there is no win directory dialog +# if ((defined $file) and (-f $file)) { # until there is no win folder dialog # $dir = dirname($file); # we take a file and jump to the dir of that file # } # but empty dirs are a problem!!! # else { # $dir = ""; # } - $dir = $top->chooseDirectory(-title => "Select directory", -initialdir => $dir); - $dir = "" unless (-d $dir); + $dir = $top->chooseDirectory(-title => "Select folder", -initialdir => $dir); + $dir = '' unless (defined $dir); + $dir = '' unless (-d $dir); return $dir; } } else { # non windows system # code based on Tk::chooseDirectory my $t = $top->Toplevel; $t->withdraw; - $t->title('Open directory ...'); + $t->title('Open folder ...'); $t->iconimage($mapiviicon) if $mapiviicon; my $ok = 0; # flag: "1" means OK, "0" means cancelled @@ -8931,9 +9238,9 @@ my $d; - my $mkdB = $t->Button(-text => 'Make new directory', + my $mkdB = $t->Button(-text => 'Make new folder', -command => sub { makeNewDir($dir, $d); })->pack(-fill => 'x'); - $balloon->attach($mkdB, -msg => "The new directory will be created underneath the selected directory.\nSo, please select a directory in the tree first"); + $balloon->attach($mkdB, -msg => "The new folder will be created underneath the selected folder.\nSo, please select a folder in the tree first"); $d = $t->Scrolled('DirTree', -scrollbars => 'osoe', @@ -8943,28 +9250,29 @@ -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 "$dir does not exists!\n"; return; } + 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")) { + my $lastdir = $dir.'/'.$dirs[-1]; + if ($d->info('exists', "$lastdir")) { $d->see($lastdir) if (-d $lastdir); } $t->Unbusy; }, # With this version of -command a double-click will - # select the directory + # select the folder -command => sub { $ok = 1; $t->destroy; }, # With this version of -command a double-click will - # open a directory. Selection is only possible with + # open a folder. Selection is only possible with # the Ok button. #-command => sub { $d->opencmd($_[0]) }, )->pack(-fill => "both", -expand => 1); - # Set the initial directory + # Set the initial folder exists &Tk::DirTree::chdir ? $d->chdir($dir) : $d->set_dir($dir); $f->Button(-text => 'Ok', @@ -8990,7 +9298,8 @@ # printUsage - show the user how to use mapivi ############################################################## sub printUsage { - print "\nUsage: mapivi [file|directory]\n\n"; + print "\nUsage: mapivi [-i] [file|folder]\n"; + print "\n -i start with import wizard\n"; } ############################################################## @@ -9279,7 +9588,6 @@ warn "entry $dpic not found in listbox!"; return; } - my $iptc = ''; my $exif = ''; my $com = ''; my $size = ''; my $meta = addToSearchDB($dpic); # save meta data of picture into the search data base @@ -9288,14 +9596,14 @@ $iptc = displayIPTC($dpic); $size = getAllFileInfo($dpic); - $com = formatString($com, $config{LineLength}); # format the comment for the list - $iptc = formatString($iptc, $config{LineLength}); # format the IPTC info for the list + $com = formatString($com, $config{LineLength}, $config{LineLimit}); # format the comment for the list + $iptc = formatString($iptc, $config{LineLength}, $config{LineLimit}); # format the IPTC info for the list # update the metainfo in the listbox - $lb->itemConfigure($dpic, $lb->{thumbcol}, -text => getThumbCaption($dpic)); - $lb->itemConfigure($dpic, $lb->{comcol}, -text => $com); - $lb->itemConfigure($dpic, $lb->{exifcol}, -text => $exif); - $lb->itemConfigure($dpic, $lb->{iptccol}, -text => $iptc); + $lb->itemConfigure($dpic, $lb->{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}); } @@ -9760,6 +10068,28 @@ return 1; } +############################################################## +# getImageMagickFonts - get the font families supported by IM +############################################################## +sub getImageMagickFonts { + + return if (!checkExternProgs('getImageMagickFonts', 'identify')); + my $fonts = `identify -list type`; + my %families; + + my @lines = split(/\n/, $fonts); + foreach my $line (@lines) { + #print "line = $line\n"; + # \s = whitespace \S = non-whitespece \d = number + if ($line =~ m |(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\d+)|) { + $families{$2} = 1; + } + } + my @font_families = sort keys(%families); + #print "font_families: $_\n" foreach (@font_families); + return @font_families; +} + my $decoW; ############################################################## # decorationDialog @@ -9777,7 +10107,8 @@ my $rc = 0; my $max = 1000; - my @fontFamilies = sort $top->fontFamilies; + #my @fontFamilies = sort $top->fontFamilies; + my @fontFamilies = getImageMagickFonts(); # open window $decoW = $top->Toplevel(); @@ -10114,20 +10445,85 @@ my %iptcmh; my $iptcm = \%iptcmh; # $iptcm = IPTC master, must be a hash reference - if (@sellist == 1) { - # if we edit just one file, we use the IPTC info as master (no matter if it's empty) - my $meta = getMetaData($dpic, 'APP13'); - unless ($meta) { + + # take the first picture as master for the IPTC data + my $meta = getMetaData($dpic, 'APP13'); + unless ($meta) { + warn "no APP13 in $dpic"; + return; + } + if (defined $meta->get_app13_data('TEXTUAL', 'IPTC')) { + $iptcm = $meta->get_app13_data('TEXTUAL', 'IPTC'); + } + + # handle several pictures: the IPTC dialog should just show common elements + if (@sellist > 1) { + my $i = 0; + # show a progressbar if there are more than 5 pictures selected + my $pw = progressWinInit($lb, 'Analyzing IPTC data ...') if (@sellist > 5); + foreach my $dpic (@sellist) { + if ($pw) {last if progressWinCheck($pw)}; + $i++; + progressWinUpdate($pw, "Collecting common data ($i/".scalar @sellist.") ...", $i, scalar @sellist) if ($pw); + my $iptc; + # get IPTC data + my $meta = getMetaData($dpic, 'APP13'); + unless ($meta) { warn "no APP13 in $dpic"; - return; - } - if (defined $meta->get_app13_data('TEXTUAL', 'IPTC')) { - $iptcm = $meta->get_app13_data('TEXTUAL', 'IPTC'); + next; + } + if (defined $meta->get_app13_data('TEXTUAL', 'IPTC')) { + $iptc = $meta->get_app13_data('TEXTUAL', 'IPTC'); + } + + # compare each key from the master + foreach my $key (keys %{$iptcm}) { + my $ref = ref($iptcm->{$key}); + my $nr = scalar @{$iptcm->{$key}}; + # if key doesn't exists in one of the pictures we remove this key + unless (exists $iptc->{$key}) { + delete $iptcm->{$key}; + next; + } + # get the intersection of the key content (this works for single elements and lists) + my @intersection = listIntersection($iptcm->{$key}, $iptc->{$key}); + # if there is something left we take the intersection + if (@intersection) { + $iptcm->{$key} = \@intersection; + } + # else we remove the key + else { + delete $iptcm->{$key}; + } + } } + progressWinEnd($pw) if ($pw); } - my $rc = iptcDialog($iptcm, $pic, scalar @sellist); + + my @keywords_common = (); + my @suppcats_common = (); + foreach (@{$iptcm->{Keywords}}) { + $_ =~ tr/ -~//cd; # remove non-printables (Picasa adds one to each keyword) + } + ${$iptcm->{Caption}}[0] =~ tr/\n\t\r\f -~//cd if (${$iptcm->{Caption}}[0]); # replace all non-printable chars, but not newline etc. + + # these are the common items (e.g. common keywords of all selected pictures) + @keywords_common = @{$iptcm->{Keywords}} if (exists $iptcm->{Keywords}); + @suppcats_common = @{$iptcm->{SupplementalCategory}} if (exists $iptcm->{SupplementalCategory}); + + my $rc = iptcDialog($iptcm, $pic, scalar @sellist); return if ($rc ne 'OK'); + # after user interaction in the dialog + my @keywords_master = (); + @keywords_master = @{$iptcm->{Keywords}} if (exists $iptcm->{Keywords}); + my @suppcats_master = (); + @suppcats_master = @{$iptcm->{SupplementalCategory}} if (exists $iptcm->{SupplementalCategory}); + + # to remove keywords and categories we need to figure out what has been removed by the user + my @keywords_removed = diffList(\@keywords_common, \@keywords_master); + my @suppcats_removed = diffList(\@suppcats_common, \@suppcats_master); + my $IPTC_action = $config{IPTC_action}; $IPTC_action = 'REPLACE' if (@sellist == 1); @@ -10148,13 +10544,22 @@ my $meta = getMetaData($dpic, 'APP1'); # APP1 includes EXIF and IPTC (APP13) my $er = $meta->get_Exif_data('ALL', 'TEXTUAL'); - my $iptc = $iptcm; + my $iptc; + # copy (clone) master iptc hash to picture iptc hash + $iptc = dclone($iptcm); if (($config{IPTCdateEXIF}) or ($config{IPTCtimeEXIF})) { my $date = getEXIFDate($dpic, $er); # date format YYYY:MM:DD HH:mm:SS if (my ($y, $M, $d, $h, $m, $s) = $date =~ m/(\d\d\d\d):(\d\d):(\d\d) (\d\d):(\d\d):(\d\d)/) { my $time = timelocal($s,$m,$h,$d,($M-1),($y-1900)); my $diff = ((localtime($time))[2] - (gmtime($time))[2]); + # RJW: Correct timezone calculation in case of migration over + # 24 hour border + if ( $diff > 12 ) { + $diff -= 24; + } elsif ( $diff < -12 ) { + $diff += 24; + } my $GMToffset = sprintf("%+03d00", $diff); my $IPTCdate = $y.$M.$d; my $IPTCtime = $h.$m.$s.$GMToffset; @@ -10181,9 +10586,7 @@ } else { } if ($owner ne '') { - $owner =~ tr/\n -~//cd; # remove non-printable characters (but not \n) - $owner =~ s/\r//g; # cut \r (carriage return) - $owner =~ s/\n//g; # cut \n (newline) + $owner =~ 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 @@ -10197,7 +10600,34 @@ ${$iptc->{OriginatingProgram}}[0] = 'Mapivi'; ${$iptc->{ProgramVersion}}[0] = $version; } - + + # make some corrections for keywords and supp cats + # according to the documentation of Image::MetaData::JPEG this should not be needed + if ((@sellist > 1) and (($IPTC_action eq 'UPDATE') or ($IPTC_action eq 'ADD'))) { + # todo problem is still, that removed elements (where nothing is left, e.g. a headline) are not removed in Update mode + my $seg = $meta->retrieve_app13_segment(undef, 'IPTC'); # todo should be possible without segement + if ($seg) { + my $hashref = $seg->get_app13_data('TEXTUAL', 'IPTC'); + + my @keywords; + # take the original items and add the items from the dialog (master) + push @keywords, @{$hashref->{Keywords}} if (defined($hashref->{Keywords})); + push @keywords, @keywords_master; + # then remove items which have been removed in the dialog + @keywords = diffList(\@keywords, \@keywords_removed); + #@keywords = ('') unless (@keywords); + $iptc->{Keywords} = \@keywords; + + my @suppcats; + # take the original items and add the items from the dialog (master) + push @suppcats, @{$hashref->{SupplementalCategory}} if (defined($hashref->{SupplementalCategory})); + push @suppcats, @suppcats_master; + # then remove items which have been removed in the dialog + @suppcats = diffList(\@suppcats, \@suppcats_removed); + $iptc->{SupplementalCategory} = \@suppcats; + } + } + $meta->set_app13_data($iptc, $IPTC_action, 'IPTC'); uniqueIPTC($meta); unless ($meta->save()) { $errors .= "save failed for $dpic\n"; } @@ -10206,8 +10636,14 @@ touch($dirthumb); updateOneRow($dpic, $lb); - showImageInfoCanvas($dpic) if ($dpic eq $actpic); - + if ($dpic eq $actpic) { + showImageInfoCanvas($dpic); + if ($config{ShowCaptionField}) { + my $caption = getIPTCCaption($dpic); + $captionText->delete( 0.1, 'end'); # remove old caption + $captionText->insert('end', $caption); # insert new caption + } + } } progressWinEnd($pw); $userinfo = "ready! ($i/".scalar @sellist." written)"; $userInfoL->update; @@ -10253,13 +10689,20 @@ my $meta = getMetaData($dpic, 'APP13'); my $iptc = $meta->get_app13_data('TEXTUAL', 'IPTC'); - warn "IPTC segment of $dpic has errors!" if ($iptc->{error}); + warn "IPTC segment of $dpic has errors!" if ($iptc->{error}); if ($config{UrgencyChangeWarning} and (defined $iptc->{"Urgency"}) and (${$iptc->{"Urgency"}}[0] != $urgency)) { $errors .= "Info: Urgency changed from ".${$iptc->{"Urgency"}}[0]." to $urgency $dpic\n"; } - $iptc->{"Urgency"} = $urgency; + $iptc->{Urgency} = $urgency; + + # todo why is this here + foreach (@{$iptc->{Keywords}}) { + $_ =~ tr/ -~//cd; # remove non-printables (Picasa adds one to each keyword) + } + # todo why is this here + ${$iptc->{Caption}}[0] =~ tr/\n\t\r\f -~//cd if (${$iptc->{Caption}}[0]); # replace all non-printable chars, but not newline etc. $meta->set_app13_data($iptc, 'REPLACE', 'IPTC'); if (!$meta->save()) { @@ -10267,7 +10710,11 @@ } else { # urgency changed successfully! print "saved IPTC urgency $urgency to $pic\n" if $verbose; + # touch the thumbnail pic (set actual time stamp), to suppress rebuilding + touch($dirthumb); + updateOneRow($dpic, $lb); if ($dpic eq $actpic) { + showImageInfoCanvas($dpic); $urgencyStr = $urgency; # display new urgency in the status bar unless ($urgency eq "") { $urgencyScale = 9 - $urgencyStr; @@ -10275,11 +10722,6 @@ } } } - - # touch the thumbnail pic (set actual time stamp), to suppress rebuilding - touch($dirthumb); - - updateOneRow($dpic, $lb); } progressWinEnd($pw); $msg = "urgency $urgency written to"; @@ -10355,6 +10797,14 @@ 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; } @@ -10518,8 +10968,7 @@ foreach (@alist) { $ent = labeledEntry($aF,'top',$w,$_,\${$iptc->{$_}}[0], 5); if (defined $iptcHelp{$_}) { - # todo this cuts very long desc because of config{LineLimit} - $balloon->attach($ent, -msg => formatString($_.":\n".$iptcHelp{$_}, 80)) if (Exists $ent); + $balloon->attach($ent, -msg => formatString($_.":\n".$iptcHelp{$_}, 80, -1)) if (Exists $ent); } } push @tag_list, @alist; # add already displayed elements to the list @@ -10548,9 +10997,9 @@ ####### Writer/Editor and Credit ############# labeledDoubleEntry($aF, 'top', $w, 'Writer/Editor', 'Credit', \${$iptc->{'Writer/Editor'}}[0], - formatString("Writer/Editor:\n".$iptcHelp{'Writer/Editor'}, 80), + formatString("Writer/Editor:\n".$iptcHelp{'Writer/Editor'}, 80, -1), \${$iptc->{'Credit'}}[0], - formatString("Credit:\n".$iptcHelp{'Credit'}, 80)); + formatString("Credit:\n".$iptcHelp{'Credit'}, 80, -1)); push @tag_list, ('Writer/Editor', 'Credit'); # add already displayed elements to the list } @@ -10558,9 +11007,9 @@ # !!! 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), + formatString("ByLineTitle:\n".$iptcHelp{'ByLineTitle'}, 80, -1), \${$iptc->{ByLine}}[0], - formatString("ByLine:\n".$iptcHelp{'ByLine'}, 80)); + formatString("ByLine:\n".$iptcHelp{'ByLine'}, 80, -1)); push @tag_list, ('ByLineTitle', 'ByLine'); # add already displayed elements to the list ####### EditStatus etc. ############## @@ -10570,7 +11019,7 @@ $ent = labeledEntry($aF,'top',$w,$_,\${$iptc->{$_}}[0]); if (defined $iptcHelp{$_}) { # todo this cuts very long desc because of config{LineLimit} - $balloon->attach($ent, -msg => formatString($_.":\n".$iptcHelp{$_}, 80)) if (Exists $ent); + $balloon->attach($ent, -msg => formatString($_.":\n".$iptcHelp{$_}, 80, -1)) if (Exists $ent); } } push @tag_list, @alist; # add already displayed elements to the list @@ -10582,18 +11031,18 @@ $ent = labeledEntry($locF,'top',$w,'SubLocation',\${$iptc->{'SubLocation'}}[0]); if (defined $iptcHelp{'SubLocation'}) { # todo this cuts very long desc because of config{LineLimit} - $balloon->attach($ent, -msg => formatString("SubLocation:\n".$iptcHelp{'SubLocation'}, 80)) if (Exists $ent); + $balloon->attach($ent, -msg => formatString("SubLocation:\n".$iptcHelp{'SubLocation'}, 80, -1)) if (Exists $ent); } labeledDoubleEntry($locF, 'top', $w, 'City', 'Province/State', \${$iptc->{'City'}}[0], - formatString("City:\n".$iptcHelp{'City'}, 80), + formatString("City:\n".$iptcHelp{'City'}, 80, -1), \${$iptc->{'Province/State'}}[0], - formatString("Province/State:\n".$iptcHelp{'Province/State'}, 80)); + formatString("Province/State:\n".$iptcHelp{'Province/State'}, 80, -1)); labeledDoubleEntry($locF, 'top', $w, 'Country', 'Code', \${$iptc->{'Country/PrimaryLocationName'}}[0], - formatString("Country/PrimaryLocationName:\n".$iptcHelp{'Country/PrimaryLocationName'}, 80), + formatString("Country/PrimaryLocationName:\n".$iptcHelp{'Country/PrimaryLocationName'}, 80, -1), \${$iptc->{'Country/PrimaryLocationCode'}}[0], - formatString("Country/PrimaryLocationCode:\n".$iptcHelp{'Country/PrimaryLocationCode'}, 80)); + formatString("Country/PrimaryLocationCode:\n".$iptcHelp{'Country/PrimaryLocationCode'}, 80, -1)); push @tag_list, ('SubLocation', 'City', 'Province/State', 'Country/PrimaryLocationName', 'Country/PrimaryLocationCode'); ####### Date and Time ############ @@ -10603,15 +11052,15 @@ $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), + formatString("DateCreated:\n".$iptcHelp{'DateCreated'}, 80, -1), \${$iptc->{TimeCreated}}[0], - formatString("TimeCreated:\n".$iptcHelp{'TimeCreated'}, 80)); + formatString("TimeCreated:\n".$iptcHelp{'TimeCreated'}, 80, -1)); labeledDoubleEntry($dateF, 'top', $w, 'Date released', 'Time', \${$iptc->{ReleaseDate}}[0], - formatString("ReleaseDate:\n".$iptcHelp{'ReleaseDate'}, 80), + formatString("ReleaseDate:\n".$iptcHelp{'ReleaseDate'}, 80, -1), \${$iptc->{ReleaseTime}}[0], - formatString("ReleaseTime:\n".$iptcHelp{'ReleaseTime'}, 80)); + formatString("ReleaseTime:\n".$iptcHelp{'ReleaseTime'}, 80, -1)); push @tag_list, @alist; # add already displayed elements to the list } @@ -10623,11 +11072,11 @@ ####### Categories ########## my $category_frame; - if ($config{IPTCProfessional}) { + 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)); # todo + $balloon->attach($ent, -msg => formatString("Category:\n".$iptcHelp{Category}, 80, -1)); # todo } # supp categories ### doubleList($category_frame, \@precats, \@{$iptc->{SupplementalCategory}}, 'supplemental categories'); @@ -10642,7 +11091,7 @@ next if (isInList($_, \@tag_list)); $ent = labeledEntry($p,'top',40,$_,\${$iptc->{$_}}[0]); if (defined $iptcHelp{$_}) { - $balloon->attach($ent, -msg => formatString($_.":\n".$iptcHelp{$_}, 80)); # todo + $balloon->attach($ent, -msg => formatString($_.":\n".$iptcHelp{$_}, 80, -1)); # todo } } @@ -10676,9 +11125,11 @@ into the ProgramVersion tag.'); my $optF = $cN->Frame()->pack(); - $optF->Label(-text => 'IPTC dialog layout')->pack(-side => 'left', -anchor => 'w'); - $optF->Radiobutton(-text => 'Simple', -variable => \$config{IPTCProfessional}, -value => 0)->pack(-side => 'left', -anchor => 'w'); - $optF->Radiobutton(-text => 'Professional', -variable => \$config{IPTCProfessional}, -value => 1)->pack(-side => 'left', -anchor => 'w'); + $optF->Label(-text => 'IPTC dialog layout')->pack(-anchor => 'w'); + $optF->Radiobutton(-text => 'Simple', -variable => \$config{IPTCProfessional}, -value => 0)->pack(-anchor => 'w'); + $optF->Radiobutton(-text => 'Professional without Category', -variable => \$config{IPTCProfessional}, -value => 2)->pack(-anchor => 'w'); + $optF->Radiobutton(-text => 'Professional with Category', -variable => \$config{IPTCProfessional}, -value => 1)->pack(-anchor => 'w'); + $cN->Label(-text => 'Note: According to the IPTC standard Categories are deprecated.')->pack(); $cN->Label(-text => 'Please choose IPTC dialog layout, close dialog and open it again to see changes.')->pack(); my $f = $t->Frame()->pack(-anchor=>'w',-fill => 'x', -expand => 0); @@ -10699,7 +11150,7 @@ Update: new records replace those characterised by the same tags, but the others are preserved. This makes it possible to modify some repeatable IPTC records without deleting the other tags. -Replace: all records present in the IPTC subdirectory are deleted +Replace: all records present in the IPTC sub folder are deleted before inserting the new ones.'); } @@ -10713,11 +11164,11 @@ $config{IPTCLastPad} = $notebook->raised(); if (Exists $keyword_frame) { saveTreeMode($keyword_frame->{m_tree}); # todo - store($keyword_frame->{m_tree}->{m_mode}, "$configdir/keywordMode") or warn "could not store $configdir/keywordMode: $!"; + nstore($keyword_frame->{m_tree}->{m_mode}, "$configdir/keywordMode") or warn "could not store $configdir/keywordMode: $!"; } if (Exists $category_frame) { saveTreeMode($category_frame->{m_tree}); # todo - store($category_frame->{m_tree}->{m_mode}, "$configdir/categoryMode") or warn "could not store $configdir/categoryMode: $!"; + nstore($category_frame->{m_tree}->{m_mode}, "$configdir/categoryMode") or warn "could not store $configdir/categoryMode: $!"; } $t->destroy; # close window $rc = 'OK'; @@ -10769,7 +11220,7 @@ my $l2 = shift; # real list ref my $name = shift; - # build a frame for the supplemental categories + # build a frame for the keywords/categories my $f = $widget->Frame(-bd => $config{Borderwidth}, -relief => 'raised')->pack(-expand => 1, -fill => 'both', -anchor=>'w', -padx => 3, -pady => 3); $f->Label(-text => $name, -bg => $config{ColorBG})->pack(-anchor=>'w', -padx => 2, -pady => 2); @@ -10784,7 +11235,7 @@ $fcent->bind('', sub { return if ($category eq ""); - # check if category is allready in list + # check if keyword/category is allready in list return if isInList($category, $l2); push @$l2, $category; $category = ""; @@ -10798,7 +11249,7 @@ -scrollbars => 'osoe', -selectmode => 'extended', -exportselection => 0, - -width => 16, + -width => 26, -height => 14, )->pack(-expand => 1, -fill => 'both', -padx => 2, -pady => 2); $widget->{m_tree} = $tree; @@ -11007,6 +11458,7 @@ 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) { @@ -11168,6 +11620,7 @@ 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 @@ -11647,6 +12100,8 @@ my $pic = shift; # the preview pic my $nr = shift; # the number of pics + my $preview_size = 400; + if (Exists($rotw)) { $rotw->deiconify; $rotw->raise; @@ -11663,9 +12118,9 @@ my ($w, $h) = getSize($orig); - if ($w > $cropPreviewSize or $h > $cropPreviewSize) { + if ($w > $preview_size or $h > $preview_size) { $userinfo = "rotate: resizing preview picture ..."; $userInfoL->update; - my $command = "mogrify -geometry ${cropPreviewSize}x${cropPreviewSize} -quality 70 \"$orig\""; + my $command = "mogrify -geometry ${preview_size}x${preview_size} -quality 80 \"$orig\""; $top->Busy; execute($command); $top->Unbusy; @@ -11684,17 +12139,17 @@ my $fc = $rotw->Frame()->pack(); my $prevC = $fc->Scrolled("Canvas", -scrollbars => 'osoe', - -width => $cropPreviewSize, - -height => $cropPreviewSize, + -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 => $cropPreviewSize, + -length => $preview_size, -from => 0, - -to => $cropPreviewSize, + -to => $preview_size, -resolution => 1, -sliderlength => 10, -orient => 'vertical', @@ -11706,9 +12161,9 @@ drawHorizont($prevC, $horizont, $vertical); } )->pack(-side => "left", -padx => 3,-pady => 3); $rotw->Scale(-variable => \$vertical, - -length => $cropPreviewSize, + -length => $preview_size, -from => 0, - -to => $cropPreviewSize, + -to => $preview_size, -resolution => 1, -sliderlength => 10, -orient => 'horizontal', @@ -11905,8 +12360,8 @@ ############################################################## # getLinkTarget - returns the file a link is pointing to -# input (directory, link) or (dirlink) where -# dirlink consists of directory and link +# input (folder, link) or (dirlink) where +# dirlink consists of folder and link # works with relative and absolute links ############################################################## sub getLinkTarget { @@ -11974,7 +12429,7 @@ my $title = shift; my $text = shift; - my $varRef = shift; # if $$varRef contains "no-entry" no entry is displayed + my $varRef = shift; my $thumbnail = shift; # optional my $icon; my $rc = 'Cancel'; @@ -12011,48 +12466,40 @@ my $OKB; - # if $$varRef contains no-entry we create a entry dialog without a entry :) - if ($$varRef ne "no-entry") { - my $entry = - $myDiag->Entry(-textvariable => \$$varRef, - -width => 40, - )->pack(-fill => 'x', -padx => 3, -pady => 3); - - if ($$varRef =~ /(.*)(\.jp(g|eg))/i) { # if it is a jpeg image name - $entry->selectionRange(0,length($1)); # select only the part before the suffix - $entry->icursor(length($1)); - } - else { - $entry->selectionRange(0,'end'); # else select all - $entry->icursor('end'); - } - $entry->xview('end'); - - $entry->bind('', sub { $OKB->invoke; } ); - $entry->focus; + 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 { - $myDiag->bind('', sub { $OKB->invoke; } ); + $entry->selectionRange(0,'end'); # else select all + $entry->icursor('end'); } + $entry->xview('end'); + + $entry->bind('', sub { $OKB->invoke; } ); + $entry->focus; my $ButF = $myDiag->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); $OKB = $ButF->Button(-text => 'OK', - -command => sub { - $rc = 'OK'; - $myDiag->destroy; - })->pack(-side => 'left', -expand => 1, -fill => 'x', - -padx => 3, -pady => 3); - - $OKB->focus if ($$varRef eq "no-entry"); + -command => sub { + $rc = 'OK'; + $myDiag->destroy; + })->pack(-side => 'left', -expand => 1, -fill => 'x', + -padx => 3, -pady => 3); my $XBut = $ButF->Button(-text => 'Cancel', - -command => sub { - $rc = 'Cancel'; - $myDiag->destroy; - } - )->pack(-side => 'left', -expand => 1, -fill => 'x', - -padx => 3, -pady => 3); + -command => sub { + $rc = 'Cancel'; + $myDiag->destroy; + } + )->pack(-side => 'left', -expand => 1, -fill => 'x', + -padx => 3, -pady => 3); $myDiag->bind('', sub { $XBut->invoke; }); $myDiag->Popup; @@ -12067,138 +12514,138 @@ ############################################################## sub myFontDialog { - my $widget = shift; - my $title = shift; - #my $text = shift; - my $varRef = shift; # if $$varRef contains "no-entry" no entry is displayed - my $size = shift; - my $rc = 0; - - # open window - my $myDiag = $widget->Toplevel(); - $myDiag->title($title); - $myDiag->iconimage($mapiviicon) if $mapiviicon; - - my $listBox = $myDiag->Scrolled('Listbox', - -scrollbars => 'osoe', - -selectmode => 'single', - -exportselection => 0, - -width => 30, - #-height => 40, - )->pack(-side => 'left', -anchor => 'w', -expand => 1, -fill =>'y', -padx => 3, -pady => 3); + my $widget = shift; + my $title = shift; + #my $text = shift; + my $varRef = shift; + my $size = shift; + my $rc = 0; - my $f = $myDiag->Frame()->pack(-side => 'left', -expand => 1, -anchor => 'w', -fill =>'both'); + # open window + my $myDiag = $widget->Toplevel(); + $myDiag->title($title); + $myDiag->iconimage($mapiviicon) if $mapiviicon; - my @fontFamilies = sort $top->fontFamilies; - shift @fontFamilies unless ($fontFamilies[0]); + 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); - bindMouseWheel($listBox); + my $f = $myDiag->Frame()->pack(-side => 'left', -expand => 1, -anchor => 'w', -fill =>'both'); - $listBox->insert('end', @fontFamilies); + my @fontFamilies = sort $top->fontFamilies; + shift @fontFamilies unless ($fontFamilies[0]); - foreach my $i (0 .. $#fontFamilies) { - if ($fontFamilies[$i] eq $$varRef) { - $listBox->selectionSet($i); - $listBox->see($i); - last; - } - } + bindMouseWheel($listBox); - 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"; + $listBox->insert('end', @fontFamilies); - my $ButF = $f->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); + foreach my $i (0 .. $#fontFamilies) { + if ($fontFamilies[$i] eq $$varRef) { + $listBox->selectionSet($i); + $listBox->see($i); + last; + } + } - my $pane = $f->Scrolled('Pane', -bd => $config{Borderwidth}, -relief => 'groove', -scrollbars => 'osoe', -width => 1000)->pack(-expand => 1, -anchor => 'w', -fill => 'both', -padx => 3, -pady => 3); - my $example = $pane->Label(-text => $normalText, -bg => $config{ColorBG}, -justify => 'left')->pack(-fill => 'both', -expand => 1, -anchor => 'w'); + 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"; - $listBox->bind('', 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; - } ); + my $ButF = $f->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); + my $pane = $f->Scrolled('Pane', -bd => $config{Borderwidth}, -relief => 'groove', -scrollbars => 'osoe', -width => 1000)->pack(-expand => 1, -anchor => 'w', -fill => 'both', -padx => 3, -pady => 3); + my $example = $pane->Label(-text => $normalText, -bg => $config{ColorBG}, -justify => 'left')->pack(-fill => 'both', -expand => 1, -anchor => 'w'); - $ButF->Button(-text => 'next', - -command => sub { - my @sell = $listBox->curselection(); - return unless @sell; - my $index = $sell[0]; - $listBox->selectionClear(0, 'end'); - $index++; - $index = 0 if ($index >= @fontFamilies); - $listBox->selectionSet($index); - $listBox->see($index); - my $actfont = $fontFamilies[$index]; - return unless $actfont; - $myDiag->Busy; - my $font = $top->Font(-family => $actfont, - -size => $size); - $example->configure(-font => $font); - $example->update(); - $myDiag->Unbusy; - })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); + $listBox->bind('', sub { + my @sell = $listBox->curselection(); + return unless @sell; + my $actfont = $fontFamilies[$sell[0]]; + return unless $actfont; + $myDiag->Busy; + my $font = $top->Font(-family => $actfont, + -size => $size); + $example->configure(-font => $font); + $example->update(); + $myDiag->Unbusy; + } ); + + + $ButF->Button(-text => 'next', + -command => sub { + my @sell = $listBox->curselection(); + return unless @sell; + my $index = $sell[0]; + $listBox->selectionClear(0, 'end'); + $index++; + $index = 0 if ($index >= @fontFamilies); + $listBox->selectionSet($index); + $listBox->see($index); + my $actfont = $fontFamilies[$index]; + return unless $actfont; + $myDiag->Busy; + my $font = $top->Font(-family => $actfont, + -size => $size); + $example->configure(-font => $font); + $example->update(); + $myDiag->Unbusy; + })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); + + $ButF->Button(-text => 'previous', + -command => sub { + my @sell = $listBox->curselection(); + return unless @sell; + my $index = $sell[0]; + $listBox->selectionClear(0, 'end'); + $index--; + $index = $#fontFamilies if ($index < 0); + $listBox->selectionSet($index); + $listBox->see($index); + my $actfont = $fontFamilies[$index]; + return unless $actfont; + $myDiag->Busy; + my $font = $top->Font(-family => $actfont, + -size => $size); + $example->configure(-font => $font); + $example->update(); + $myDiag->Unbusy; + })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); - $ButF->Button(-text => 'previous', - -command => sub { - my @sell = $listBox->curselection(); - return unless @sell; - my $index = $sell[0]; - $listBox->selectionClear(0, 'end'); - $index--; - $index = $#fontFamilies if ($index < 0); - $listBox->selectionSet($index); - $listBox->see($index); - my $actfont = $fontFamilies[$index]; - return unless $actfont; - $myDiag->Busy; - my $font = $top->Font(-family => $actfont, - -size => $size); - $example->configure(-font => $font); - $example->update(); - $myDiag->Unbusy; - })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); + my $OKB = $ButF->Button(-text => 'OK', + -command => sub { + my @sell = $listBox->curselection(); + $$varRef = $fontFamilies[$sell[0]] if @sell; + $rc = 1; + $myDiag->destroy; + })->pack(-side => 'left', -expand => 1, -fill => 'x', + -padx => 3, -pady => 3); - my $OKB = $ButF->Button(-text => 'OK', - -command => sub { - my @sell = $listBox->curselection(); - $$varRef = $fontFamilies[$sell[0]] if @sell; - $rc = 1; - $myDiag->destroy; - })->pack(-side => 'left', -expand => 1, -fill => 'x', - -padx => 3, -pady => 3); - - $myDiag->bind ('', sub { $OKB->invoke; } ); - $listBox->bind('', sub { $OKB->invoke; } ); - $OKB->focus; + $myDiag->bind ('', sub { $OKB->invoke; } ); + $listBox->bind('', sub { $OKB->invoke; } ); + $OKB->focus; - my $XBut = $ButF->Button(-text => 'Cancel', - -command => sub { - $rc = 0; - $myDiag->destroy; - } - )->pack(-side => 'left', -expand => 1, -fill => 'x', - -padx => 3, -pady => 3); + my $XBut = $ButF->Button(-text => 'Cancel', + -command => sub { + $rc = 0; + $myDiag->destroy; + } + )->pack(-side => 'left', -expand => 1, -fill => 'x', + -padx => 3, -pady => 3); - $myDiag->bind('', sub { $XBut->invoke; }); - my $ws = 0.5; - my $w = int($ws * $myDiag->screenwidth); - my $h = int($ws * $myDiag->screenheight); - my $x = int(((1 - $ws) * $myDiag->screenwidth)/3); - my $y = int(((1 - $ws) * $myDiag->screenheight)/3); - #print "geo==${w}x${h}+${x}+${y}\n"; - $myDiag->geometry("${w}x${h}+${x}+${y}"); - $myDiag->Popup; - repositionWindow($myDiag); - $myDiag->waitWindow(); - return $rc; + $myDiag->bind('', sub { $XBut->invoke; }); + my $ws = 0.5; + my $w = int($ws * $myDiag->screenwidth); + my $h = int($ws * $myDiag->screenheight); + my $x = int(((1 - $ws) * $myDiag->screenwidth)/3); + my $y = int(((1 - $ws) * $myDiag->screenheight)/3); + #print "geo==${w}x${h}+${x}+${y}\n"; + $myDiag->geometry("${w}x${h}+${x}+${y}"); + $myDiag->Popup; + repositionWindow($myDiag); + $myDiag->waitWindow(); + return $rc; } ############################################################## @@ -12516,7 +12963,7 @@ } $rc = 'OK'; saveTreeMode($keytree); - store($keytree->{m_mode}, "$configdir/keywordMode") or warn "could not store $configdir/keywordMode: $!"; + nstore($keytree->{m_mode}, "$configdir/keywordMode") or warn "could not store $configdir/keywordMode: $!"; $myDiag->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $balloon->attach($OKB, -msg => "You can press Control-x to close the dialog (OK button)"); @@ -12569,7 +13016,7 @@ -command => sub { $rc = 'Cancel'; saveTreeMode($keytree); - store($keytree->{m_mode}, "$configdir/keywordMode") or warn "could not store $configdir/keywordMode: $!"; + nstore($keytree->{m_mode}, "$configdir/keywordMode") or warn "could not store $configdir/keywordMode: $!"; $myDiag->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); @@ -12723,6 +13170,7 @@ 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 @@ -12746,6 +13194,9 @@ -width => 80, -height => $listBoxY, )->pack(-expand => 1, -fill =>'both', -padx => 3, -pady => 3); + + $listBox->configure(-selectmode => 'single') if ($mode == SINGLE); + bindMouseWheel($listBox); $listBox->insert('end', @list); @@ -12755,16 +13206,19 @@ $rc = 1; } ); - my $ubutF = $myDiag->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); - $ubutF->Button(-text => 'Select all', + # select all|none make only sense if multiple selection is possible + if ($mode == MULTIPLE) { + my $ubutF = $myDiag->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); + $ubutF->Button(-text => 'Select all', -command => sub { $listBox->selectionSet(0, 'end'); })->pack(-side => 'left', -padx => 3, -pady => 3); - $ubutF->Button(-text => 'Select none', + $ubutF->Button(-text => 'Select none', -command => sub { $listBox->selectionClear(0, 'end'); })->pack(-side => 'left', -padx => 3, -pady => 3); - + } + my $ButF = $myDiag->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); my $OKB = @@ -12796,67 +13250,85 @@ ############################################################## sub createDirMenu { $dirMenu = - $top->Menu(-title => "Directory Menu"); + $top->Menu(-title => "Folder Menu"); } ############################################################## -# createDirMenu +# updateDirMenu ############################################################## sub updateDirMenu { return if (!defined($dirMenu)); - # clear dir menu - $dirMenu->delete(0, 'end'); + # get number of items + my $end = $dirMenu->index('end'); - $dirMenu->command(-label => "open directory ...", -command => sub { - my $dir = getRightDir(); - openDirPost($dir);}, -accelerator => "double click"); - $dirMenu->command(-label => "preview directory ...", -command => sub { - my $dir = getRightDir(); - my @list = getPics($dir, WITH_PATH); - sortPics($config{SortBy}, $config{SortReverse}, \@list); - showThumbList(\@list, $dir); }, -accelerator => "middle click"); - $dirMenu->command(-label => "search in directory ...", -command => sub { - my $tmp = $config{SearchOnlyInDir}; # save search mode - $config{SearchOnlyInDir} = 1; # set to local search - searchMetaInfo(); - $config{SearchOnlyInDir} = $tmp; # restore search mode - }); - my $dir_size = $dirMenu->cascade(-label => 'directory size'); - $dir_size->command(-label => "calculate directory size ...", -command => sub { calcDirSize(); } ); - $dir_size->command(-label => "display directory sizes (graphic) ...", -command => sub { showDirSizes(getRightDir()); } ); + # first call to function - build up menu fixed part + if ($end < 10) { + + $dirMenu->command(-image => compound_menu($top, 'open folder ...', 'folder.png'), + -command => sub { + my $dir = getRightDir(); + openDirPost($dir);}, -accelerator => "double click"); + $dirMenu->command(-image => compound_menu($top, 'preview folder ...', ''), + -command => sub { + my $dir = getRightDir(); + my @list = getPics($dir, WITH_PATH); + sortPics($config{SortBy}, $config{SortReverse}, \@list); + showThumbList(\@list, $dir); }, -accelerator => "middle click"); + $dirMenu->command(-image => compound_menu($top, 'search in folder ...', 'system-search.png'), + -command => sub { + my $tmp = $config{SearchOnlyInDir}; # save search mode + $config{SearchOnlyInDir} = 1; # set to local search + searchMetaInfo(); + $config{SearchOnlyInDir} = $tmp; # restore search mode + }); + my $dir_size = $dirMenu->cascade(-image => compound_menu($top, 'folder size', '')); + $dir_size->command(-label => "calculate folder size ...", -command => sub { calcDirSize(); } ); + $dir_size->command(-label => "display folder sizes (graphic) ...", + -command => sub { showDirSizes(getRightDir()); } ); $dirMenu->separator; - $dirMenu->command(-label => "rename directory ...", -command => sub { renameDir(); }); - $dirMenu->command(-label => "new directory ...", -command => sub { - my $dir = getRightDir(); - if (!-d $dir) { warn "dir $dir is no dir"; return; } - makeNewDir($dir, $dirtree); }); - $dirMenu->command(-label => "delete directory ...", -command => sub { deleteDir(); }); + $dirMenu->command(-image => compound_menu($top, 'rename folder ...', ''), + -command => sub { renameDir(); }); + $dirMenu->command(-image => compound_menu($top, 'new folder ...', 'folder-new.png'), + -command => sub { + my $dir = getRightDir(); + if (!-d $dir) { warn "dir $dir is no dir"; return; } + makeNewDir($dir, $dirtree); }); + $dirMenu->command(-image => compound_menu($top, 'delete folder ...', ''), + -command => sub { deleteDir(); }); $dirMenu->separator; - my $dir_hot = $dirMenu->cascade(-label => 'directory hotlist'); - $dir_hot->command(-label => "add to hotlist", -command => sub { - my $dir = getRightDir(); - my $max = 0; - foreach (sort {$dirHotlist{$b} <=> $dirHotlist{$a}} keys %dirHotlist) { - $max = $dirHotlist{$_}; - last; - } - $dirHotlist{$dir} = $max; - $userinfo = "added $dir to hotlist!"; $userInfoL->update; - updateDirMenu(); - }); - $dir_hot->command(-label => "remove from hotlist", -command => sub { - my $dir = getRightDir(); - delete $dirHotlist{$dir} if (defined($dirHotlist{$dir})); - $userinfo = "removed $dir from hotlist!"; $userInfoL->update; - updateDirMenu(); - }); + my $dir_hot = $dirMenu->cascade(-image => compound_menu($top, 'folder hotlist', 'emblem-favorite.png')); + $dir_hot->command(-label => "add to hotlist", + -command => sub { + my $dir = getRightDir(); + my $max = 0; + foreach (sort {$dirHotlist{$b} <=> $dirHotlist{$a}} keys %dirHotlist) { + $max = $dirHotlist{$_}; + last; + } + $dirHotlist{$dir} = $max; + $userinfo = "added $dir to hotlist!"; $userInfoL->update; + updateDirMenu(); + }); + $dir_hot->command(-label => "remove from hotlist", -command => sub { + my $dir = getRightDir(); + delete $dirHotlist{$dir} if (defined($dirHotlist{$dir})); + $userinfo = "removed $dir from hotlist!"; $userInfoL->update; + updateDirMenu(); + }); + } + else { + # clear dir menu (dynamic part) + $dirMenu->delete(11, 'end'); + } + + # add the dynamic part my $i = 0; - # add the 12 most wanted hotlist directories :) + # add the 12 most wanted hotlist folders :) my @dirlist; foreach (sort {$dirHotlist{$b} <=> $dirHotlist{$a}} keys %dirHotlist) { # remove deleted dirs @@ -12872,14 +13344,14 @@ foreach (sort @dirlist) { my $dir = $_; # we need a local copy - # this will add the number of accesses of the directory + # 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 directories + # add the last used folders foreach (reverse @dirHist) { next if (!-d $_); my $dir = $_; # we need a local copy @@ -12901,7 +13373,7 @@ $thumbMenu->separator; addMetaInfoMenu($thumbMenu); $thumbMenu->separator; - $thumbMenu->command(-label => "rescan directory", -command => \&updateThumbsPlus, -accelerator => ""); + $thumbMenu->command(-image => compound_menu($top, 'rescan folder', 'view-refresh.png'), -command => \&updateThumbsPlus, -accelerator => ""); $thumbMenu->command(-label => "rebuild thumbs ...", -command => \&rebuildThumbs, -accelerator => ""); $thumbMenu->command(-label => "add to light table", -command => sub {light_table_add_from_lb($picLB);}, -accelerator => ""); } @@ -12912,18 +13384,41 @@ sub createPicMenu { $picMenu = $top->Menu(-title => "Picture Menu"); $picMenu->command(-label => "reload picture", -command => \&reloadPic ); - $picMenu->command(-label => "show picture in new window", -command => \&showPicInOwnWin, -accelerator => "" ); + $picMenu->command(-image => compound_menu($top, 'open picture in new window', 'image-x-generic.png'), -command => \&showPicInOwnWin, -accelerator => "" ); $picMenu->separator; addPicProcessing($picMenu); $picMenu->separator; addZoomMenu($picMenu); $picMenu->separator; - $picMenu->command(-label => "options ...", -command => \&options, -accelerator => ""); - $picMenu->command(-label => "switch layout", -command => sub { $config{Layout}++; layout(1); } ); - $picMenu->command(-label => "toggle fullscreen mode", -command => sub { topFullScreen(); } ); + $picMenu->command(-image => compound_menu($top, 'options ...', 'preferences-system.png'), -command => \&options, -accelerator => ""); + $picMenu->command(-label => "toggle layout", -command => sub { $config{Layout}++; layout(1); } ); + $picMenu->command(-image => compound_menu($top, 'toggle fullscreen mode', 'view-fullscreen.png'), -command => sub { topFullScreen(); } ); } ############################################################## +# compoud_menu +############################################################## +sub compound_menu { + my $w = shift; + my $text = shift; + my $icon_name = shift; + my $space = shift; # optional + $space = 19 unless defined $space; + + my $compound_image = $w->Compound(); + if (-f "$icon_path/$icon_name") { + $compound_image->Image(-image => $top->Photo(-file => "$icon_path/$icon_name", -gamma => $config{Gamma})); + $compound_image->Space(-width => 3); + } + else { + $compound_image->Space(-width => $space); + print "Mapivi info: icon $icon_path/$icon_name not found.\n" if ($icon_name ne ''); + } + $compound_image->Text(-text => $text); + return $compound_image; +} + +############################################################## # createMenubar ############################################################## sub createMenubar { @@ -12948,32 +13443,35 @@ my $help_menu = $menubar->cascade(-label => "Help"); $help_menu->cget(-menu)->configure(-title => "Help menu"); - $file_menu->command(-label => "open directory ...", -command => \&openDir, -accelerator => ""); - $file_menu->command(-label => "preview directory ...", -command => sub { + + #my $icon = ; + $file_menu->command(-image => compound_menu($top, 'open folder ...', 'folder.png'), -command => \&openDir, -accelerator => ""); + #$file_menu->command(-image => compound_menu($top, 'open umlaut folder ...', ''), -command => sub { openDirPost("/home/herrmann/tmp/dirb/subdirä"); } ); + $file_menu->command(-image => compound_menu($top, 'preview folder', ''), -command => sub { my $dir = getRightDir(); my @list = getPics($dir, WITH_PATH); sortPics($config{SortBy}, $config{SortReverse}, \@list); showThumbList(\@list, $dir); }, -accelerator => "middle click"); - $file_menu->command(-label => "search in directory ...", -command => sub { + $file_menu->command(-image => compound_menu($top, 'search in folder ...', ''), -command => sub { my $tmp = $config{SearchOnlyInDir}; # save search mode $config{SearchOnlyInDir} = 1; # set to local search searchMetaInfo(); $config{SearchOnlyInDir} = $tmp; # restore search mode }); - my $dir_size = $file_menu->cascade(-label => 'directory size ...'); - $dir_size->command(-label => "calculate directory size ...", -command => sub { calcDirSize(); } ); - $dir_size->command(-label => "display directory sizes (graphic) ...", -command => sub { showDirSizes(getRightDir()); } ); + my $dir_size = $file_menu->cascade(-image => compound_menu($top, 'folder size', '')); + $dir_size->command(-label => "calculate folder size ...", -command => sub { calcDirSize(); } ); + $dir_size->command(-label => "display folder sizes (graphic) ...", -command => sub { showDirSizes(getRightDir()); } ); $file_menu->separator; - $file_menu->command(-label => "rename directory ...", -command => \&renameDir); - $file_menu->command(-label => "new directory ...", -command => sub { + $file_menu->command(-image => compound_menu($top, 'rename folder ...', ''), -command => \&renameDir); + $file_menu->command(-image => compound_menu($top, 'new folder ...', 'folder-new.png'), -command => sub { my $dir = getRightDir(); if (!-d $dir) { warn "dir $dir is no dir"; return; } makeNewDir($dir, $dirtree); } ); - $file_menu->command(-label => "delete directory ...", -command => \&deleteDir); + $file_menu->command(-image => compound_menu($top, 'delete folder ...', ''), -command => \&deleteDir); - $file_menu->command(-label => "hot directories ...", -command => sub { + $file_menu->command(-image => compound_menu($top, 'hot folders ...', ''), -command => sub { $dirMenu->Popup(-popover => "cursor", -popanchor => "nw"); }, , -accelerator => ""); @@ -12981,23 +13479,24 @@ addFileActionsMenu($file_menu, $picLB); $file_menu->separator; - my $trash_menu = $file_menu->cascade(-label => "trash"); + my $trash_menu = $file_menu->cascade(-image => compound_menu($top, 'trash', 'user-trash.png')); $trash_menu->command(-label => "empty trash ...", -command => \&emptyTrash); $trash_menu->command(-label => "open trash in main window", -command => [\&openDirPost, $trashdir]); - $file_menu->command(-label => "directory checklist ...", -command => sub { showDirProperties(); } ); - $file_menu->command(-label => "import wizard ...", -command => \&importWizard); + $file_menu->command(-image => compound_menu($top, 'folder checklist ...', ''), -command => sub { showDirProperties(); } ); + $file_menu->command(-image => compound_menu($top, 'import wizard ...', 'camera-photo.png'), -command => \&importWizard); $file_menu->separator; - $file_menu->command(-label => "light table (slideshow) ...", -command => \&light_table_open_window); - $file_menu->command(-label => "convert non-JPEG pictures ...", -command => \&convertNonJPEGS); - $file_menu->command(-label => "rescan directory", -accelerator => "", + $file_menu->command(-image => compound_menu($top, 'light table (slideshow) ...', ''), -command => \&light_table_open_window); + $file_menu->command(-image => compound_menu($top, 'convert non-JPEG pictures ...', ''), -command => \&convertNonJPEGS); + $file_menu->command(-image => compound_menu($top, 'rescan folder', 'view-refresh.png'), -accelerator => "", -command => \&updateThumbsPlus); - $file_menu->command(-label => "rebuild thumbs ...", -command => \&rebuildThumbs, -accelerator => ""); - $file_menu->command(-label => "build thumbs ...", -command => \&buildThumbsRecursive); + $file_menu->command(-image => compound_menu($top, 'smart update', 'view-refresh.png'), -command => sub { smart_update(); }, -accelerator => ""); + $file_menu->command(-image => compound_menu($top, 'rebuild selected thumbnails ...', ''), -command => \&rebuildThumbs, -accelerator => ""); + $file_menu->command(-image => compound_menu($top, 'build thumbnails ...', ''), -command => \&buildThumbsRecursive); $file_menu->separator; - $file_menu->command(-label => "iconify", -accelerator => "", -command => sub { $top->iconify; }); - $file_menu->command(-label => "restart", -command => \&restart) unless ($EvilOS); - $file_menu->command(-label => "quit", -accelerator => "", -command => \&quitMain); + $file_menu->command(-image => compound_menu($top, 'iconify', 'user-desktop.png'), -accelerator => "", -command => sub { $top->iconify; }); + $file_menu->command(-image => compound_menu($top, 'restart', ''), -command => \&restart) unless ($EvilOS); + $file_menu->command(-image => compound_menu($top, 'quit', 'system-log-out.png'), -accelerator => "", -command => \&quitMain); addSelectMenu($edit_menu); @@ -13005,20 +13504,18 @@ addPicProcessing($edit_menu); $edit_menu->separator; - $edit_menu->command(-label => "search ...", -command => \&searchMetaInfo, -accelerator => ""); - $edit_menu->separator; # add the comments, EXIF and IPTC menu addMetaInfoMenu($edit_menu); - $view_menu->command(-label => "next", -command => sub { + $view_menu->command(-image => compound_menu($top, 'next', 'go-next.png'), -command => sub { return if (stillBusy()); # block, until last picture is loaded if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off showPic(nextPic($actpic)); }, -accelerator => ""); - $view_menu->command(-label => "previous", -command => sub { + $view_menu->command(-image => compound_menu($top, 'previous', 'go-previous.png'), -command => sub { return if (stillBusy()); # block, until last picture is loaded if ($slideshow == 1) { $slideshow = 0; slideshow(); @@ -13028,14 +13525,14 @@ $view_menu->separator; - $view_menu->command(-label => "first", -command => sub { + $view_menu->command(-image => compound_menu($top, 'first', 'go-first.png'), -command => sub { return if (stillBusy()); # block, until last picture is loaded if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off my @childs = $picLB->info('children'); return unless (@childs); showPic($childs[0]); }, -accelerator => ""); - $view_menu->command(-label => "last", -command => sub { + $view_menu->command(-image => compound_menu($top, 'last', 'go-last.png'), -command => sub { return if (stillBusy()); # block, until last picture is loaded if ($slideshow == 1) { $slideshow = 0; slideshow(); @@ -13048,24 +13545,21 @@ $view_menu->separator; - $view_menu->command(-label => "go to/select ...", -command => sub { gotoPic($picLB); }, - -accelerator => ""); + $view_menu->command(-image => compound_menu($top, 'go to/select ...', ''), -command => sub { gotoPic($picLB); }, -accelerator => ""); $view_menu->separator; addZoomMenu($view_menu); $view_menu->separator; - $view_menu->checkbutton(-variable => \$config{ShowCoordinates}, -label => "display mouse coordinates"); - $view_menu->separator; - $view_menu->command(-label => "open picture in new window", -command => \&showPicInOwnWin, -accelerator => ""); - $view_menu->command(-label => "open picture in external viewer", -command => sub{openPicInViewer($picLB);}, -accelerator => ""); + $view_menu->command(-image => compound_menu($top, 'open picture in new window', 'image-x-generic.png'), -command => \&showPicInOwnWin, -accelerator => ""); + $view_menu->command(-image => compound_menu($top, 'open picture in external viewer', 'image-x-generic.png'), -command => sub{openPicInViewer($picLB);}, -accelerator => ""); $view_menu->command(-label => "show infos about picture", -command => \&identifyPic); $view_menu->command(-label => "show histogram (ImageMagick)", -command => sub { showHistogram($picLB); } ); $view_menu->command(-label => "show histogram (builtin)", -command => sub { showHistogram2($picLB); } ); $view_menu->command(-label => "show JPEG segments", -command => \&showSegments); - $view_menu->command(-label => "start/stop slideshow", -command => sub { + $view_menu->command(-image => compound_menu($top, 'start/stop slideshow', 'media-playback-start.png'), -command => sub { if ($slideshow == 0) { $slideshow = 1; } else { @@ -13073,10 +13567,50 @@ } slideshow(); }, -accelerator => ""); - $view_menu->command(-label => "use actual picture as desktop background", + $view_menu->command(-label => "use actual picture as desktop background", -command => \&setBackground); - $view_menu->command(-label => "smart update", - -command => sub { smart_update(); }); + + $view_menu->separator; + my $layout_menu = $view_menu->cascade(-label => "Window layout ..."); + $layout_menu->cget(-menu)->configure(-title => "Window layout ..."); + + $layout_menu->command(-label => "toggle layout", -command => sub { $config{Layout}++; layout(1); }, -accelerator => ""); + $layout_menu->separator; + $layout_menu->command(-label => "folder-thumbnails-picture", -command => sub { $config{Layout} = 0 ; layout(1); }, -accelerator => ""); + $layout_menu->command(-label => "folder-thumbnails", -command => sub { $config{Layout} = 1 ; layout(1); }, -accelerator => ""); + $layout_menu->command(-label => "thumbnails", -command => sub { $config{Layout} = 2 ; layout(1); }, -accelerator => ""); + $layout_menu->command(-label => "thumbnails-picture", -command => sub { $config{Layout} = 3 ; layout(1); }, -accelerator => ""); + $layout_menu->command(-label => "picture", -command => sub { $config{Layout} = 4 ; layout(1); }, -accelerator => ""); + $layout_menu->separator; + $layout_menu->checkbutton(-label => "menu bar", -variable => \$config{ShowMenu}, -command => sub { showHideFrames(); }, -accelerator => ""); + $layout_menu->checkbutton(-label => "status bar", -variable => \$config{ShowInfoFrame}, -command => sub { showHideFrames(); }, -accelerator => ""); + $layout_menu->checkbutton(-label => "EXIF box", -variable => \$config{ShowEXIFField}, -command => sub { showHideFrames(); }, -accelerator => ""); + $layout_menu->checkbutton(-label => "caption box", -variable => \$config{ShowCaptionField}, -command => sub { showHideFrames(); }, -accelerator => ""); + $layout_menu->checkbutton(-label => "comment box", -variable => \$config{ShowCommentField}, -command => sub { showHideFrames(); }); + $layout_menu->checkbutton(-label => "overlap picture with info", -variable => \$config{ShowInfoInCanvas}, -command => sub { showPic($actpic); }); + $layout_menu->checkbutton(-label => "display mouse coordinates", -variable => \$config{ShowCoordinates}); + + $view_menu->separator; + my $thumb_menu = $view_menu->cascade(-label => "Thumbnail table layout ..."); + $thumb_menu->cget(-menu)->configure(-title => "Thumbnail table layout ..."); + + my $caption_menu = $thumb_menu->cascade(-label => "Thumbnail caption ..."); + $caption_menu->cget(-menu)->configure(-title => "Thumbnail caption ..."); + $caption_menu->radiobutton(-label => "none", -variable => \$config{ThumbCapt}, -value => "none", -command => sub { updateThumbsPlus(); }); + + $caption_menu->radiobutton(-label => "file name without suffix", -variable => \$config{ThumbCapt}, -value => "filename", -command => sub { updateThumbsPlus(); }); + + $caption_menu->radiobutton(-label => "file name with suffix", -variable => \$config{ThumbCapt}, -value => "filenameSuffix", -command => sub { updateThumbsPlus(); }); + + $caption_menu->radiobutton(-label => "IPTC object name", -variable => \$config{ThumbCapt}, -value => "objectname", -command => sub { updateThumbsPlus(); }); + + $thumb_menu->separator; + + $thumb_menu->checkbutton(-label => "show file info", -variable => \$config{ShowFile}, -command => \&toggleHeaders); + $thumb_menu->checkbutton(-label => "show IPTC/IIM", -variable => \$config{ShowIPTC}, -command => \&toggleHeaders); + $thumb_menu->checkbutton(-label => "show comments", -variable => \$config{ShowComment}, -command => \&toggleHeaders); + $thumb_menu->checkbutton(-label => "show EXIF", -variable => \$config{ShowEXIF}, -command => \&toggleHeaders); + $thumb_menu->checkbutton(-label => "show folder", -variable => \$config{ShowDirectory}, -command => \&toggleHeaders); $sort_menu->radiobutton(-label => "file name", -variable => \$config{SortBy}, -value => "name", -command => sub { updateThumbsPlus(); }); @@ -13102,81 +13636,56 @@ #my $data_menu = $extr_menu->cascade(-label => "Search database"); #$data_menu->cget(-menu)->configure(-title => "Search database"); - $find_menu->command(-label => "search ...", -command => \&searchMetaInfo, -accelerator => ""); - $find_menu->command(-label => "search for file name ...", -command => sub { searchFileName($picLB);}); - $find_menu->command(-label => "search duplicates ...", -command => \&findDups); + $find_menu->command(-image => compound_menu($top, 'search ...', 'system-search.png'), -command => \&searchMetaInfo, -accelerator => ''); + $find_menu->command(-image => compound_menu($top, 'search by keywords (tag cloud) ...', 'weather-overcast.png'), -command => \&keyword_browse, -accelerator => ''); + $find_menu->command(-image => compound_menu($top, 'search by timeline ...', 'x-office-calendar.png'), -command => \&database_info); + $find_menu->command(-image => compound_menu($top, 'search by location ...', 'applications-internet.png'), -command => sub { search_by_location($picLB); } ); + $find_menu->command(-image => compound_menu($top, 'search duplicates ...', ''), -command => \&findDups); + #$find_menu->command(-label => "check for new keywords ...", -command => \&check_new_keywords); $find_menu->separator; - $find_menu->command(-label => "add to database ...", -command => \&buildDatabase); - $find_menu->command(-label => "clean database ...", -command => \&cleanDatabase); - $find_menu->command(-label => "check database ...", -command => \&checkDatabase); - $find_menu->command(-label => "edit database ...", -command => \&editDatabase); + my $find_special_menu = $find_menu->cascade(-image => compound_menu($top, 'special searches', '')); + $find_special_menu->command(-label => "show TOP 100 of best rated pictures", -command => \&showMostPopularPics); + $find_special_menu->command(-image => compound_menu($top, 'search for file name ...', 'edit-find.png'), -command => sub { searchFileName($picLB);}); $find_menu->separator; - $find_menu->command(-label => "browse database by timeline ...", -command => \&database_info); - $find_menu->command(-label => "browse database by keywords ...", -command => \&keyword_browse); - #$find_menu->command(-label => "check for new keywords ...", -command => \&check_new_keywords); + $find_menu->command(-image => compound_menu($top, 'add to database ...', 'list-add.png'), -command => \&buildDatabase); + $find_menu->command(-image => compound_menu($top, 'clean database ...', 'list-remove.png'), -command => \&cleanDatabase); + $find_menu->command(-image => compound_menu($top, 'check database ...', ''), -command => \&checkDatabase); + $find_menu->command(-image => compound_menu($top, 'edit database ...', 'accessories-text-editor.png'), -command => \&editDatabase); - $opti_menu->command(-label => "options ...", -command => \&options, -accelerator => ""); + $opti_menu->command(-image => compound_menu($top, 'options ...', 'preferences-system.png'), -command => \&options, -accelerator => ""); $opti_menu->command(-label => "save options", -command => \&saveAllConfig); - $opti_menu->separator; - $opti_menu->checkbutton(-label => "show picture", -variable => \$config{ShowPic}, - -command => sub { showPic($actpic); }); - $opti_menu->checkbutton(-label => "show menu bar", -variable => \$config{ShowMenu}, - -command => \&showHideFrames); - - $opti_menu->separator; - - $opti_menu->radiobutton(-label => "thumbnail caption: none", -variable => \$config{ThumbCapt}, -value => "none", -command => sub { updateThumbsPlus(); }); - - $opti_menu->radiobutton(-label => "thumbnail caption: file name without suffix", -variable => \$config{ThumbCapt}, -value => "filename", -command => sub { updateThumbsPlus(); }); - - $opti_menu->radiobutton(-label => "thumbnail caption: file name with suffix", -variable => \$config{ThumbCapt}, -value => "filenameSuffix", -command => sub { updateThumbsPlus(); }); - - $opti_menu->radiobutton(-label => "thumbnail caption: IPTC object name", -variable => \$config{ThumbCapt}, -value => "objectname", -command => sub { updateThumbsPlus(); }); - - $opti_menu->separator; - - $opti_menu->checkbutton(-label => "show file info", -variable => \$config{ShowFile}, -command => \&toggleHeaders); - $opti_menu->checkbutton(-label => "show IPTC/IIM", -variable => \$config{ShowIPTC}, -command => \&toggleHeaders); - $opti_menu->checkbutton(-label => "show comments", -variable => \$config{ShowComment}, -command => \&toggleHeaders); - $opti_menu->checkbutton(-label => "show EXIF", -variable => \$config{ShowEXIF}, -command => \&toggleHeaders); - $opti_menu->checkbutton(-label => "show folder", -variable => \$config{ShowDirectory}, -command => \&toggleHeaders); - - $opti_menu->separator; - $opti_menu->command(-label => "switch layout", -command => sub { $config{Layout}++; layout(1); }, -accelerator => ""); $extr_menu->command(-label => "export filelist ...", -command => \&exportFilelist); - $extr_menu->command(-label => "diff directories ...", -command => sub { dirDiffWindow(); } ); + $extr_menu->command(-label => "compare folders ...", -command => sub { dirDiffWindow(); } ); + $extr_menu->command(-label => "compare pictures", -command => \&diffPics); $extr_menu->command(-label => "show window list ...", -command => \&showWindowList, -accelerator => ""); $extr_menu->separator; $extr_menu->command(-label => "montage/index print ...", -command => sub { my @pics = getSelection($picLB); indexPrint(\@pics); }); $extr_menu->command(-label => "interpolate dead pixels ...", -command => \&interpolatePics); $extr_menu->command(-label => "add fuzzy border ...", -command => \&fuzzyBorder); - $extr_menu->command(-label => "add lossless border ...", -command => \&losslessBorder); - $extr_menu->command(-label => "build difference picture", -command => \&diffPics); + $extr_menu->command(-label => "add lossless watermark ...", -command => \&losslessWatermark); $extr_menu->command(-label => "make screenshot ...", -command => \&screenshot); $extr_menu->separator; $extr_menu->command(-label => "build thumbnails database ...", -command => \&buildThumbsRecursive); $extr_menu->command(-label => "clean thumbnail database ...", -command => sub { cleanThumbDB(); } ); - $extr_menu->command(-label => "clean directory ...", -command => sub { cleanDir($actdir); } ); + $extr_menu->command(-label => "clean folder ...", -command => sub { cleanDir($actdir); } ); $extr_menu->command(-label => "edit entry history ...", -command => sub { editEntryHistory(); } ); # just an experiment: #$extr_menu->separator; #$extr_menu->command(-label => "show picture view list", -command => sub { showPicViewList(); }); $extr_menu->separator; $extr_menu->command(-label => "mapivi test suite", -command => \&testSuite); - $extr_menu->separator; - $extr_menu->command(-label => "show TOP50 of most popular pictures", -command => \&showMostPopularPics); makePlugInsMenu($plug_menu); - $help_menu->command(-label => "About", -command => \&about); - $help_menu->command(-label => "Keys", -command => \&showkeys); - $help_menu->command(-label => "Tips", -command => sub { showFile("$configdir/Tips.txt") }) if (-f "$configdir/Tips.txt"); - $help_menu->command(-label => "System infos", -command => \&systemInfo); - $help_menu->command(-label => "License", -command => [\&showFile, "$configdir/License.txt"]) if (-f "$configdir/License.txt"); - $help_menu->command(-label => "History", -command => [\&showFile, "$configdir/Changes.txt"]) if (-f "$configdir/Changes.txt"); - $help_menu->command(-label => "FAQ", -command => [\&showFile, "$configdir/FAQ"]) if (-f "$configdir/FAQ"); + $help_menu->command(-image => compound_menu($top, 'About', 'dialog-information.png'), -command => \&about); + $help_menu->command(-image => compound_menu($top, 'Keys', 'input-keyboard.png'), -command => \&showkeys); + $help_menu->command(-image => compound_menu($top, 'System information', 'utilities-system-monitor.png'), -command => \&systemInfo); + $help_menu->command(-image => compound_menu($top, 'License', ''), -command => [\&showFile, "$configdir/License.txt"]) if (-f "$configdir/License.txt"); + $help_menu->command(-image => compound_menu($top, 'History', ''), -command => [\&showFile, "$configdir/Changes.txt"]) if (-f "$configdir/Changes.txt"); + $help_menu->command(-image => compound_menu($top, 'Tips', 'help-browser.png'), -command => sub { showFile("$configdir/Tips.txt") }) if (-f "$configdir/Tips.txt"); + $help_menu->command(-image => compound_menu($top, 'FAQ', 'help-browser.png'), -command => [\&showFile, "$configdir/FAQ"]) if (-f "$configdir/FAQ"); $top->configure(-menu => $menubar) if $config{ShowMenu}; } @@ -13187,7 +13696,7 @@ sub addPicProcessing { my $menu = shift; - my $rot_menu = $menu->cascade(-label => "rotate (clockwise) ..."); + my $rot_menu = $menu->cascade(-image => compound_menu($top, 'rotate (clockwise) ...', 'transform-rotate.png')); $rot_menu->cget(-menu)->configure(-title => "rotation menu"); $rot_menu->command(-label => "rotate 90 - right (lossless)", -command => [\&rotate, 90], -accelerator => "<9>"); $rot_menu->command(-label => "rotate 180 (lossless)", -command => [\&rotate, 180], -accelerator => "<8>"); @@ -13198,12 +13707,19 @@ $rot_menu->command(-label => "clear rotate flag (lossless)", -command => [\&rotate, "clear"]); $rot_menu->command(-label => "rotate ...", -command => [\&rotateAny]); - $menu->command(-label => "change size/quality ...", -command => \&changeSizeQuality, -accelerator => "" ); - $menu->command(-label => "crop (lossless) ...", -command => sub { crop($picLB); }, -accelerator => ""); - $menu->command(-label => "image processing ...", -command => \&filterPic, -accelerator => ""); - $menu->command(-label => "make grayscale ...", -command => sub { grayscalePic($picLB); } ); - $menu->command(-label => "add border or copyright ...", -command => \&addDecoration, -accelerator => ""); - $menu->command(-label => "edit in GIMP", -command => \&GIMPedit, -accelerator => "") unless ($exprogs{"gimp-remote"} or $exprogs{"gimp-win-remote"}); + $menu->command(-image => compound_menu($top, 'change size/quality ...', 'transform-scale.png'), -command => \&changeSizeQuality, -accelerator => "" ); + $menu->command(-image => compound_menu($top, 'crop (lossless) ...', 'edit-cut.png'), -command => sub { crop($picLB); }, -accelerator => ""); + $menu->command(-image => compound_menu($top, 'image processing ...', 'camera-photo.png'), -command => \&filterPic, -accelerator => ""); + $menu->command(-image => compound_menu($top, 'make grayscale ...', 'image-x-generic-bw.png'), -command => sub { grayscalePic($picLB); } ); + my $border_menu = $menu->cascade(-image => compound_menu($top, 'add border ...', 'image-x-generic.png')); + $border_menu->cget(-menu)->configure(-title => 'border menu'); + + $border_menu->command(-image => compound_menu($top, 'add border (lossless) ...', ''), -command => sub { losslessBorder(PIXEL); }, -accelerator => ""); + $border_menu->command(-image => compound_menu($top, 'add border aspect ratio (lossless) ...', ''), -command => sub { losslessBorder(ASPECT_RATIO); } ); + $border_menu->command(-image => compound_menu($top, 'add relative border (lossless) ...', ''), -command => sub { losslessBorder(RELATIVE); } ); + $border_menu->command(-image => compound_menu($top, 'add border or copyright (lossy) ...', ''), -command => \&addDecoration); + + $menu->command(-image => compound_menu($top, 'edit in GIMP', 'applications-graphics.png'), -command => \&GIMPedit, -accelerator => "") unless ($exprogs{"gimp-remote"} or $exprogs{"gimp-win-remote"}); } ############################################################## @@ -13213,22 +13729,21 @@ my $menu = shift; my $lb = shift; - my $fop_menu = $menu->cascade(-label => "file operations ..."); - $fop_menu->command(-label => "copy to ...", -command => sub { copyPicsDialog(COPY, $lb); } ); - $fop_menu->command(-label => "link to ...", -command => \&linkPicsDialog) if (!$EvilOS); - $fop_menu->command(-label => "move to ...", -command => sub { movePicsDialog($lb); } ); - $fop_menu->command(-label => "send to ...", -command => sub { sendTo($lb); } ); - $fop_menu->command(-label => "convert ...", -command => sub { convertPics($lb); } ); - $fop_menu->command(-label => "copy to print ...", -command => sub { copyToPrint($lb); }, -accelerator => ""); - $fop_menu->command(-label => "rename ...", -command => sub { renamePic($lb); }, -accelerator => ""); - $fop_menu->command(-label => "smart rename ...", -command => sub { renameSmart($lb); }, -accelerator => ""); - $fop_menu->command(-label => "make backup", -command => sub { copyPicsDialog(BACKUP, $lb); } ); - $fop_menu->command(-label => "make HTML ...", -command => sub { makeHTML($lb); }); + my $fop_menu = $menu->cascade(-image => compound_menu($top, 'file operations ...', '')); + $fop_menu->command(-image => compound_menu($top, 'copy to ...', 'edit-copy.png'), -command => sub { copyPicsDialog(COPY, $lb); } ); + $fop_menu->command(-image => compound_menu($top, 'link to ...', ''), -command => \&linkPicsDialog) if (!$EvilOS); + $fop_menu->command(-image => compound_menu($top, 'move to ...', ''), -command => sub { movePicsDialog($lb); } ); + $fop_menu->command(-image => compound_menu($top, 'send to ...', 'mail-message-new.png'), -command => sub { sendTo($lb); } ); + $fop_menu->command(-image => compound_menu($top, 'convert ...', ''), -command => sub { convertPics($lb); } ); + $fop_menu->command(-image => compound_menu($top, 'copy to print ...', 'printer.png'), -command => sub { copyToPrint($lb); }, -accelerator => ""); + $fop_menu->command(-image => compound_menu($top, 'rename ...', ''), -command => sub { renamePic($lb); }, -accelerator => ""); + $fop_menu->command(-image => compound_menu($top, 'smart rename ...', ''), -command => sub { renameSmart($lb); }, -accelerator => ""); + $fop_menu->command(-image => compound_menu($top, 'make backup', ''), -command => sub { copyPicsDialog(BACKUP, $lb); } ); + $fop_menu->command(-image => compound_menu($top, 'make HTML ...', 'applications-internet.png'), -command => sub { makeHTML($lb); }); $fop_menu->separator; - $fop_menu->command(-label => "delete to trash", -accelerator => "", + $fop_menu->command(-image => compound_menu($top, 'delete to trash', 'user-trash.png'), -accelerator => "", -command => sub { deletePics($lb, TRASH); } ); - $fop_menu->command(-label => "delete ...", -accelerator => "", - -command => sub { deletePics($lb, REMOVE); } ); + $fop_menu->command(-image => compound_menu($top, 'delete ...', ''), -accelerator => "", -command => sub { deletePics($lb, REMOVE); } ); } ############################################################## @@ -13237,7 +13752,7 @@ sub addSelectMenu { my $menu = shift; - my $sel_menu = $menu->cascade(-label => "select ..."); + my $sel_menu = $menu->cascade(-image => compound_menu($top, 'select ...', '')); $sel_menu->command(-label => "select all", -accelerator => "", -command => sub {selectAll($picLB);} ); $sel_menu->command(-label => "select all backups", -command => \&selectBak ); $sel_menu->command(-label => "invert selection", -command => \&selectInv ); @@ -13282,52 +13797,61 @@ my $menu = shift; - my $iptc_menu = $menu->cascade(-label => "IPTC/IIM info"); + my $iptc_menu = $menu->cascade(-image => compound_menu($top, 'IPTC/IIM info', '')); $iptc_menu->cget(-menu)->configure(-title => "IPTC/IIM menu"); - $iptc_menu->command(-label => "show", -command => sub { displayIPTCData($picLB); }, -accelerator => ""); - $iptc_menu->command(-label => "edit ...", -command => sub { editIPTC($picLB); }, -accelerator => ""); - $iptc_menu->command(-label => "remove ...", -command => \&removeIPTC); + $iptc_menu->command(-image => compound_menu($top, 'show', ''), -command => sub { displayIPTCData($picLB); }, -accelerator => ""); + $iptc_menu->command(-image => compound_menu($top, 'edit ...', 'accessories-text-editor.png'), -command => sub { editIPTC($picLB); }, -accelerator => ""); + $iptc_menu->command(-image => compound_menu($top, 'remove ...', ''), -command => \&removeIPTC); $iptc_menu->separator; - $iptc_menu->command(-label => "copy from ...", -command => \©IPTC); - $iptc_menu->command(-label => "copy to ...", -command => \&pasteIPTC); + $iptc_menu->command(-image => compound_menu($top, 'copy from ...', 'edit-copy.png'), -command => \©IPTC); + $iptc_menu->command(-image => compound_menu($top, 'copy to ...', 'edit-paste.png'), -command => \&pasteIPTC); $iptc_menu->separator; - $iptc_menu->command(-label => "add/remove keywords ...", -command => sub { editIPTCKeywords($picLB); }, -accelerator => ''); - $iptc_menu->command(-label => "add/remove categories ...", -command => sub { editIPTCCategories($picLB); } , -accelerator => ''); + $iptc_menu->command(-image => compound_menu($top, 'add/remove keywords ...', ''), -command => sub { editIPTCKeywords($picLB); }, -accelerator => ''); + $iptc_menu->command(-image => compound_menu($top, 'add/remove categories ...', ''), -command => sub { editIPTCCategories($picLB); } , -accelerator => ''); $iptc_menu->separator; - $iptc_menu->command(-label => "save template ...", -command => \&saveIPTC); - $iptc_menu->command(-label => "merge template ...", -command => \&mergeIPTC); + $iptc_menu->command(-image => compound_menu($top, 'save template ...', ''), -command => \&saveIPTC); + $iptc_menu->command(-image => compound_menu($top, 'merge template ...', ''), -command => \&mergeIPTC); $iptc_menu->separator; addRatingMenu($iptc_menu, $picLB); addRatingMenu($menu, $picLB); - my $exif_menu = $menu->cascade(-label => "EXIF info"); + if ($exiftoolAvail) { + my $xmp_menu = $menu->cascade(-image => compound_menu($top, 'XMP info', '')); + $xmp_menu->cget(-menu)->configure(-title => 'XMP menu'); + $xmp_menu->command(-image => compound_menu($top, 'show info', ''), -command => sub { xmp_show($picLB); }); # -accelerator => ""); + $xmp_menu->command(-image => compound_menu($top, 'add title ...', ''), -command => sub { xmp_add_title($picLB); }); + $xmp_menu->command(-image => compound_menu($top, 'edit title ...', ''), -command => sub { xmp_edit_title($picLB); }); + $xmp_menu->command(-image => compound_menu($top, 'add keyword ...', ''), -command => sub { xmp_add_keyword($picLB); }); + } + + my $exif_menu = $menu->cascade(-image => compound_menu($top, 'EXIF info', '')); $exif_menu->cget(-menu)->configure(-title => "EXIF menu"); - $exif_menu->command(-label => "show info", -command => sub { displayEXIFData($picLB); }, -accelerator => ""); - $exif_menu->command(-label => "show thumbnail", -command => \&showEXIFThumb, -accelerator => ""); - $exif_menu->command(-label => "save thumbnail ...", -command => \&getEXIFThumb); - $exif_menu->command(-label => "(re)build thumbnail ...", -command => \&buildEXIFThumb); + $exif_menu->command(-image => compound_menu($top, 'show info', ''), -command => sub { displayEXIFData($picLB); }, -accelerator => ""); + $exif_menu->command(-image => compound_menu($top, 'show thumbnail', ''), -command => \&showEXIFThumb, -accelerator => ""); + $exif_menu->command(-image => compound_menu($top, 'save thumbnail ...', ''), -command => \&getEXIFThumb); + $exif_menu->command(-image => compound_menu($top, '(re)build thumbnail ...', ''), -command => \&buildEXIFThumb); $exif_menu->separator; - $exif_menu->command(-label => "copy from", -command => [\©EXIFData, "from"]); - $exif_menu->command(-label => "copy to ...", -command => [\©EXIFData, "to"]); - $exif_menu->command(-label => "copy thumbnail to ...", -command => \©Thumbnail); + $exif_menu->command(-image => compound_menu($top, 'copy from ...', 'edit-copy.png'), -command => [\©EXIFData, "from"]); + $exif_menu->command(-image => compound_menu($top, 'copy to ...', 'edit-paste.png'), -command => [\©EXIFData, "to"]); + $exif_menu->command(-image => compound_menu($top, 'copy thumbnail to ...', ''), -command => \©Thumbnail); $exif_menu->separator; - $exif_menu->command(-label => "save", -command => \&EXIFsave); - $exif_menu->command(-label => "restore ...", -command => \&EXIFrestore); - $exif_menu->command(-label => "remove saved info ...", -command => \&EXIFremoveSaved); + $exif_menu->command(-image => compound_menu($top, 'save', ''), -command => \&EXIFsave); + $exif_menu->command(-image => compound_menu($top, 'restore ...', ''), -command => \&EXIFrestore); + $exif_menu->command(-image => compound_menu($top, 'remove saved info ...', ''), -command => \&EXIFremoveSaved); $exif_menu->separator; - $exif_menu->command(-label => "set date/time ...", -command => \&setEXIFDate); + $exif_menu->command(-image => compound_menu($top, 'set date/time ...', 'accessories-text-editor.png'), -command => \&setEXIFDate); $exif_menu->separator; - $exif_menu->command(-label => "remove thumbnail ...", -command => [\&removeEXIFData, "thumb"]); - $exif_menu->command(-label => "remove all ...", -command => [\&removeEXIFData, "all"]); + $exif_menu->command(-image => compound_menu($top, 'remove thumbnail ...', ''), -command => [\&removeEXIFData, "thumb"]); + $exif_menu->command(-image => compound_menu($top, 'remove all ...', ''), -command => [\&removeEXIFData, "all"]); - my $comm_menu = $menu->cascade(-label => "Comments"); + my $comm_menu = $menu->cascade(-image => compound_menu($top, 'Comments', '')); $comm_menu->cget(-menu)->configure(-title => "Comment menu"); $comm_menu->command(-label => "show ...", -command => \&showComment, -accelerator => ""); $comm_menu->separator; $comm_menu->command(-label => "add ...", -command => sub{ addComment($picLB); }, -accelerator => ""); - $comm_menu->command(-label => "edit ...", -command => sub{ editComment($picLB); }, -accelerator => ""); + $comm_menu->command(-image => compound_menu($top, 'edit ...', 'accessories-text-editor.png'), -command => sub{ editComment($picLB); }, -accelerator => ""); $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); } ); @@ -13335,8 +13859,8 @@ $comm_menu->command(-label => "remove ...", -command => \&removeComment); $comm_menu->command(-label => "remove all ...", -command => sub { removeAllComments(ASK); } ); $comm_menu->separator; - $comm_menu->command(-label => "copy from", -command => [\©Comment, "from"]); - $comm_menu->command(-label => "copy to ...", -command => [\©Comment, "to"]); + $comm_menu->command(-image => compound_menu($top, 'copy from ...', 'edit-copy.png'), -command => [\©Comment, "from"]); + $comm_menu->command(-image => compound_menu($top, 'copy to ...', 'edit-paste.png'), -command => [\©Comment, "to"]); $comm_menu->separator; $comm_menu->command(-label => "add filename as comment ...", -command => [\&nameToComment, "to"]); } @@ -13347,7 +13871,7 @@ sub addRatingMenu { my $menu = shift; my $widget = shift; # e.g. $picLB - my $iptc_urge = $menu->cascade(-label => "rating (IPTC urgency)"); + my $iptc_urge = $menu->cascade(-image => compound_menu($top, 'rating (IPTC urgency)', '')); $iptc_urge->cget(-menu)->configure(-title => "rating (IPTC urgency)"); $iptc_urge->command(-label => "******** (1 high)", -command => sub { setIPTCurgency($widget, 1); }, -accelerator => ""); $iptc_urge->command(-label => "******* (2)", -command => sub { setIPTCurgency($widget, 2); }, -accelerator => ""); @@ -13445,23 +13969,23 @@ my $dir = getRightDir(); my $size = 0; my $break = 0; - my $pw = progressWinInit($top, "Calculate directory size"); + my $pw = progressWinInit($top, "Calculate folder size"); find(sub { if (progressWinCheck($pw)) { $break = 1; $File::Find::prune = 1; } - # we don't know how long it will take, so we leave the progressbar at 50% - progressWinUpdate($pw, "size $size Bytes", 5, 10); + # we don't know how long it will take, so we set total to zero + progressWinUpdate($pw, "size $size Bytes", 0, 0); $size += -s; },$dir); progressWinEnd($pw); my $msg = "Calculation finished."; if ($break) { $msg = "Warning: The calculation wasn't finished!\nReal size may be bigger than displayed."; } my $unitSize = computeUnit($size); - $top->messageBox(-icon => 'question', -message => "$msg\nThe directory size of $dir is $unitSize ($size Bytes)", - -title => "Directory size", -type => 'OK'); + $top->messageBox(-icon => 'question', -message => "$msg\nThe folder size of $dir is $unitSize ($size Bytes)", + -title => "Folder size", -type => 'OK'); } ############################################################## -# buildThumbsRecursive - scans through all subdirectories of +# 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 @@ -13469,11 +13993,11 @@ sub buildThumbsRecursive { my $basedir = getRightDir(); - my $rc = $top->messageBox(-icon => 'question', -message => "MaPiVi will first scan through all sub directories of $basedir and collect all directories containing JPEG files.\nThen you are able to select in which directories mapivi should build/refresh thumbnails.", - -title => "Build thumbnails in all sub directories", -type => 'OKCancel'); + my $rc = $top->messageBox(-icon => 'question', -message => "MaPiVi will first scan through all sub folders of $basedir and collect all folders containing JPEG files.\nThen you are able to select in which folders mapivi should build/refresh thumbnails.", + -title => "Build thumbnails in all sub folders", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); - $userinfo = "searching sub directories ..."; $userInfoL->update; + $userinfo = "searching sub folders ..."; $userInfoL->update; my @dirlist; my @pictestlist; @@ -13483,14 +14007,12 @@ my $pic_count = 0; my $break = 0; - my $i = 0; - my $pw = progressWinInit($top, "Collect sub directories"); + 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)) { - $i++; $i = 0 if ($i > 10); # restart progressbar every 10 steps; todo - progressWinUpdate($pw, "collecting directories, found ".scalar @dirlist." ...", $i, 10); + progressWinUpdate($pw, "collecting folders, found ".scalar @dirlist." ...", 0, 0); @pictestlist = getPics($File::Find::name, JUST_FILE); # no sort needed if (@pictestlist > 0) { $pic_count += scalar @pictestlist; @@ -13501,17 +14023,18 @@ }, $basedir); progressWinEnd($pw); if ($break) { - $userinfo = "user break while counting sub directories"; + $userinfo = "user break while counting sub folders"; return; } $config{CheckForNonJPEGs} = $tmp; - $userinfo = "found ".@dirlist." sub directories"; $userInfoL->update; + $userinfo = "found ".@dirlist." sub folders"; $userInfoL->update; my @sellist; - return if (!mySelListBoxDialog("Select directories", - "Found ".scalar @dirlist." directories with $pic_count JPEG pictures.\nThumbnails will be created/updated in the selected directories.", + return if (!mySelListBoxDialog("Select folders", + "Found ".scalar @dirlist." folders with $pic_count JPEG pictures.\nThumbnails will be created/updated in the selected folders.", + MULTIPLE, "build thumbnails", \@sellist, @dirlist)); # copy the selected elements into the @sel_dirs list @@ -13534,7 +14057,7 @@ $tmp = $config{CheckForNonJPEGs}; $config{CheckForNonJPEGs} = 0; - $i = 0; + my $i = 0; $pw = progressWinInit($top, "build/refresh thumbnails"); foreach $dir (@sel_dirs) { last if progressWinCheck($pw); @@ -13646,8 +14169,9 @@ makeDir(dirname(getThumbFileName("$targetdir/dummy.jpg")), ASK); - my ($pic, $dpic, $tpic, $thumbpic, $thumbtpic, $njpic); - my $process = "copy"; + my ($pic, $dpic, $tpic, $thumbpic, $thumbtpic, $njpic, $filename, $suffix); + my $process = 'copy'; + my $errors = ''; my $i = 0; my $rc = 1; my $n = 0; # count successfull copied pictures @@ -13656,13 +14180,14 @@ foreach $dpic (@sellist) { last if progressWinCheck($pw); $pic = basename($dpic); + $i++; $tpic = "$targetdir/$pic"; $thumbpic = getThumbFileName($dpic); $thumbtpic = getThumbFileName($tpic); if ($mode == BACKUP) { - $process = "backup"; + $process = 'backup'; $tpic = buildBackupName($dpic); $thumbtpic = buildBackupName(getThumbFileName($dpic)); print "copyPics: duplicate mode $tpic\n" if $verbose; @@ -13674,13 +14199,19 @@ next if ($rc == 0); last if ($rc == -1); + # if the copy is successfull if (mycopy ($dpic, $tpic, OVERWRITE)) { $n++; + # copy the thumbnail picture if ((-d dirname($thumbtpic)) and (-f $thumbpic)) { - mycopy ("$thumbpic","$thumbtpic", OVERWRITE) - } + mycopy ($thumbpic, $thumbtpic, OVERWRITE) + } + + # copy XMP, WAV, RAW files + do_other_files(COPY, $dpic, $tpic, \$errors); - $searchDB{$tpic} = $searchDB{$dpic}; # copy meta info in search database + # copy meta info in search database + $searchDB{$tpic} = $searchDB{$dpic}; if ($mode == BACKUP) { hlistCopy($lb, $dpic, $tpic); # insert and show the backup in the listbox @@ -13691,60 +14222,213 @@ } # foreach - end progressWinEnd($pw); $userinfo = "ready! ($n/".scalar @sellist." copied)"; $userInfoL->update; + if ($errors ne '') { + $errors = "These errors occured while copying ".scalar @sellist." selected pictures:\n$errors"; + showText('Error while moving', $errors, NO_WAIT); + } reselect($lb, @sellist); } ############################################################## -# linkPicsDialog - link the selected pictures to a choosen dir +# rename_XMP_file - rename XMP file if any ############################################################## -sub linkPicsDialog { - - if ($EvilOS) { - $top->messageBox(-icon => 'warning', -message => "Sorry, but this OS does not support symbolic links.", - -title => 'Error', -type => 'OK'); - return; - } - my @sellist = $picLB->info('selection'); - return unless checkSelection($top, 1, 0, \@sellist); +sub rename_XMP_file { - my $targetdir = getDirDialog("Link pictures to"); + # XMP files follow picture file operations if this option is set to 1 + return unless $config{XMP_file_operations}; - return if ($targetdir eq ""); + my $dpic = shift; + my $ndpic = shift; + my $error_ref = shift; # reference to error string to add warnings etc. - linkPics($targetdir, @sellist); + my ($name,$dir,$suffix) = fileparse($dpic, '\.[^.]*'); # suffix = . and not-. (one dot and zero or more non-dots) + my $dpic_no_suffix = "$dir/$name"; + my ($nname,$ndir,$nsuffix) = fileparse($ndpic, '\.[^.]*'); # suffix = . and not-. (one dot and zero or more non-dots) + my $ndpic_no_suffix = "$ndir/$nname"; + my $xmp_file = ''; + # we have to support upper and lower case XMP suffix + if ((-f $dpic_no_suffix.'.xmp')) { + $xmp_file = $dpic_no_suffix.'.xmp'; + } + elsif ((-f $dpic_no_suffix.'.XMP')) { + $xmp_file = $dpic_no_suffix.'.XMP'; + } + else { + } + if ($xmp_file ne '') { + my $txmp_file = "$ndir/${nname}.xmp"; + if (-f $txmp_file) { + $$error_ref .= "XMP file $txmp_file exists, file not renamed!\n"; + } + else { + print "rename $xmp_file to $txmp_file\n" if $verbose; + rename ($xmp_file, $txmp_file); + } + } } ############################################################## -# linkPics - link the selected pictures to a choosen dir +# do_other_files - rename, copy, move XMP, WAV and RAW files ############################################################## -sub linkPics { - - my $targetdir = shift; - my @sellist = @_; +sub do_other_files { - if ($EvilOS) { - $top->messageBox(-icon => 'warning', -message => "Sorry, but this OS does not support symbolic links.", - -title => 'Error', -type => 'OK'); - return; - } + my $action = shift; # COPY, MOVE or RENAME + return unless ($action == RENAME or $action == COPY or $action == MOVE); - return unless (-d $targetdir); - return if (@sellist < 1); + my @suffixes; + # we have to support upper and lower case XMP suffix + push @suffixes, ('.xmp', '.XMP') if $config{XMP_file_operations}; + push @suffixes, ('.wav', '.WAV') if $config{WAV_file_operations}; + push @suffixes, ('.nef', '.NEF', '.crw', '.CRW') if $config{RAW_file_operations}; - makeDir(dirname(getThumbFileName("$targetdir/dummy.jpg")), ASK); + return unless (@suffixes); + #print "$action - suffixes: $_\n" foreach (@suffixes); - my ($pic, $dpic, $tpic, $thumbpic, $thumbtpic, $njpic); - my $i = 0; - my $rc = 1; - my $n = 0; # count successfull copied pictures - my $pw = progressWinInit($top, "Link pictures"); - foreach $dpic (@sellist) { - last if progressWinCheck($pw); - $pic = basename($dpic); - $i++; - progressWinUpdate($pw, "linking ($i/".scalar @sellist.") ...", $i, scalar @sellist); - $tpic = "$targetdir/$pic"; + my $dpic = shift; + my $ndpic = shift; + my $error_ref = shift; # reference to error string to add warnings etc. + + my ($name,$dir,$suffix) = fileparse($dpic, '\.[^.]*'); # suffix = . and not-. (one dot and zero or more non-dots) + my $dpic_no_suffix = "$dir/$name"; + my ($nname,$ndir,$nsuffix) = fileparse($ndpic, '\.[^.]*'); # suffix = . and not-. (one dot and zero or more non-dots) + my $ndpic_no_suffix = "$ndir/$nname"; + foreach my $suffix (@suffixes) { + if ((-f $dpic_no_suffix.$suffix)) { + my $t_file = "$ndpic_no_suffix$suffix"; + if (-f $t_file) { + $$error_ref .= "$suffix file $t_file exists, file not "; + $$error_ref .= "renamed!\n" if $action == RENAME; + $$error_ref .= "copyed!\n" if $action == COPY; + $$error_ref .= "moved!\n" if $action == MOVE; + } + else { + #print "rename, copy, move $action $dpic_no_suffix${suffix} to $t_file\n"; #if $verbose; + rename ($dpic_no_suffix.$suffix, $t_file) if $action == RENAME; + move ($dpic_no_suffix.$suffix, $ndir) if $action == MOVE; + mycopy ($dpic_no_suffix.$suffix, $t_file, ASK_OVERWRITE) if $action == COPY; + } + } + } +} + +############################################################## +# delete_XMP_file - delete XMP file if any +############################################################## +sub delete_XMP_file { + + # XMP files follow picture file operations if this option is set to 1 + return unless $config{XMP_file_operations}; + + my $dpic = shift; + + my ($name,$dir,$suffix) = fileparse($dpic, '\.[^.]*'); # suffix = . and not-. (one dot and zero or more non-dots) + my $dpic_no_suffix = "$dir/$name"; + my $xmp_file = ''; + # we have to support upper and lower case XMP suffix + if ((-f $dpic_no_suffix.'.xmp')) { + $xmp_file = $dpic_no_suffix.'.xmp'; + } + elsif ((-f $dpic_no_suffix.'.XMP')) { + $xmp_file = $dpic_no_suffix.'.XMP'; + } + else { + } + if ($xmp_file ne '') { + print "remove $xmp_file\n" if $verbose; + removeFile($xmp_file); + } +} + +############################################################## +# rename_WAV_file - rename WAV audio file if any +############################################################## +# todo: check if this function could be integrated into the XMP function (rename with any suffix) +sub rename_WAV_file { + + # WAV files follow picture file operations if this option is set to 1 + return unless $config{WAV_file_operations}; + + my $dpic = shift; + my $ndpic = shift; + my $error_ref = shift; # reference to error string to add warnings etc. + + my ($name,$dir,$suffix) = fileparse($dpic, '\.[^.]*'); # suffix = . and not-. (one dot and zero or more non-dots) + my $dpic_no_suffix = "$dir/$name"; + my ($nname,$ndir,$nsuffix) = fileparse($ndpic, '\.[^.]*'); # suffix = . and not-. (one dot and zero or more non-dots) + my $ndpic_no_suffix = "$ndir/$nname"; + my $wav_file = ''; + # we have to support upper and lower case WAV suffix + if ((-f $dpic_no_suffix.'.wav')) { + $wav_file = $dpic_no_suffix.'.wav'; + } + elsif ((-f $dpic_no_suffix.'.WAV')) { + $wav_file = $dpic_no_suffix.'.WAV'; + } + else { + } + if ($wav_file ne '') { + my $twav_file = "$ndir/${nname}.wav"; + if (-f $twav_file) { + $$error_ref .= "WAV file $twav_file exists, file not renamed!\n"; + } + else { + print "rename $wav_file to $twav_file\n" if $verbose; + rename ($wav_file, $twav_file); + } + } +} + +############################################################## +# linkPicsDialog - link the selected pictures to a choosen dir +############################################################## +sub linkPicsDialog { + + if ($EvilOS) { + $top->messageBox(-icon => 'warning', -message => "Sorry, but this OS does not support symbolic links.", + -title => 'Error', -type => 'OK'); + return; + } + my @sellist = $picLB->info('selection'); + return unless checkSelection($top, 1, 0, \@sellist); + + my $targetdir = getDirDialog("Link pictures to"); + + return if ($targetdir eq ""); + + linkPics($targetdir, @sellist); +} + +############################################################## +# linkPics - link the selected pictures to a choosen dir +############################################################## +sub linkPics { + + my $targetdir = shift; + my @sellist = @_; + + if ($EvilOS) { + $top->messageBox(-icon => 'warning', -message => "Sorry, but this OS does not support symbolic links.", + -title => 'Error', -type => 'OK'); + return; + } + + return unless (-d $targetdir); + return if (@sellist < 1); + + makeDir(dirname(getThumbFileName("$targetdir/dummy.jpg")), ASK); + + my ($pic, $dpic, $tpic, $thumbpic, $thumbtpic, $njpic); + my $i = 0; + my $rc = 1; + my $n = 0; # count successfull copied pictures + my $pw = progressWinInit($top, "Link pictures"); + foreach $dpic (@sellist) { + last if progressWinCheck($pw); + $pic = basename($dpic); + $i++; + progressWinUpdate($pw, "linking ($i/".scalar @sellist.") ...", $i, scalar @sellist); + $tpic = "$targetdir/$pic"; # Do not link to a link. Always link to the original image. next if (!getRealFile(\$dpic)); @@ -13794,14 +14478,14 @@ sub getDirDialog($) { my $title = shift; - my $text = "Please choose a target directory from the list below or open the directory browser\nby double clicking the first item or by just pressing OK.\n\nDirectories from the hotlist and recently visited direcories:"; - my $another = "Open directory browser"; + my $text = "Please choose a target folder from the list below or open the folder browser\nby double clicking the first item or by just pressing OK.\n\nfolders from the hotlist and recently visited direcories:"; + my $another = "Open folder browser"; my @list; my @sellist; # sort dirs hash by numerical value reverse (number of accesses) - # %dirHotlist contains directories used as target in open dir, copy, link, move, ... operations + # %dirHotlist contains folders used as target in open dir, copy, link, move, ... operations foreach (sort { $dirHotlist{$b} <=> $dirHotlist{$a} } keys %dirHotlist) { next if (!-d $_); # skip non existing dirs next if ($_ eq $trashdir); @@ -13809,22 +14493,22 @@ last if (@list > 15); # 15 entries should be enough } - # add the last used directories + # add the last used folders foreach (reverse @dirHist) { next if (!-d $_); push @list, $_; } - # remove duplicates and sort directory list alphabetical + # remove duplicates and sort folder list alphabetical my %saw; @saw{@list} = (); @list = (); @list = sort keys %saw; - # put the "Open directory browser" item at the first position + # put the "Open folder browser" item at the first position unshift @list, $another; - return '' unless (mySelListBoxDialog($title, $text, 'OK', \@sellist, @list)); + return '' unless (mySelListBoxDialog($title, $text, SINGLE, 'OK', \@sellist, @list)); my $dir = ''; $dir = $list[$sellist[0]] if $sellist[0]; @@ -13873,6 +14557,7 @@ my $i = 0; my $rc = 1; my $changed = 0; + my $errors = ''; my $pw = progressWinInit($lb, "Move pictures"); foreach $dpic (@sellist) { last if progressWinCheck($pw); @@ -13890,18 +14575,20 @@ last if ($rc == -1); # move picture - if (!move ("$dpic","$tpic")) { - $lb->messageBox(-icon => 'warning', -message => "Could not move $dpic to $tpic: $!", - -title => 'Error', -type => 'OK'); + 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")) { - $lb->messageBox(-icon => 'warning', -message => "Could not move $thumbpic to $thumbtpic: $!", - -title => 'Error', -type => 'OK'); + if (!move ($thumbpic, $thumbtpic)) { + $errors .= "Could not move thumbnail $thumbpic to $thumbtpic: $!"; } } + + # move XMP, WAV, RAW files + do_other_files(MOVE, $dpic, $tpic, \$errors); + # ask to move non-JPEG file, if any # foreach my $suf (split /\|/, $nonJPEGsuffixes) { # $njpic = $dpic; @@ -13911,8 +14598,7 @@ # -title => "Move non-JPEG?", -type => 'OKCancel'); # next if ($rc !~ m/Ok/i); # if (!move ("$njpic","$targetdir")) { -# $lb->messageBox(-icon => 'warning', -message => "Could not move $njpic to $targetdir: $!", -# -title => 'Error', -type => 'OK'); +# $errors .= "Could not move $njpic to $targetdir: $!"; # } # } # } @@ -13922,6 +14608,11 @@ } progressWinEnd($pw); + if ($errors ne '') { + $errors = "These errors occured while moving ".scalar @sellist." selected pictures:\n$errors"; + showText('Error while moving', $errors, NO_WAIT); + } + if ($changed == 0) { # nothing happend, no update needed $userinfo = "ready! (nothing moved)"; $userInfoL->update; return; @@ -13932,7 +14623,7 @@ #stopButStart(); foreach $dpic (@sellist) { #last if stopButCheck(); - $lb->delete("entry", $dpic) if ($lb->info('exists', $dpic)); + $lb->delete('entry', $dpic) if ($lb->info('exists', $dpic)); reloadPic() if (($lb == $picLB) and ($dpic eq $actpic)); } #stopButEnd(); @@ -14027,11 +14718,31 @@ my @sellist = $lb->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); - return if (!checkExternProgs("sendTo", "thunderbird")); - # check if some files are links return if (!checkLinks($lb, @sellist)); + if ($config{MailTool} =~ m/thunderbird/i) { + } + elsif ($config{MailTool} =~ m/evolution/i) { + } + else { + $top->messageBox(-icon => 'warning', + -message => "Sorry, the selected mail tool ($config{MailTool}) is not supported! Please try to find the command line syntax to send a mail with attachment and send this info to Martin-Herrmann\@gmx.de.", + -title => "External mail tool not yet supported", + -type => 'OK'); + return; + } + + + if ((system "$config{MailTool} --version") != 0) { + $top->messageBox(-icon => 'warning', + -message => "Sorry, no mail tool ($config{MailTool}) found! Please use Ctrl-o (Options->Advanced->External mail tool) to select the right tool.", + -title => "External mail tool not available", + -type => 'OK'); + return; + } + + # open dialog window my $myDiag = $top->Toplevel(); $myDiag->title("Change size/quality before sending"); @@ -14069,11 +14780,11 @@ unless ($config{MailPicNoChange}) { # copy to trash - $userinfo = "send to: copy pictures to temp directory"; $userInfoL->update; + $userinfo = "send to: copy pictures to temp folder"; $userInfoL->update; foreach $dpic (@sellist) { mycopy($dpic, $trashdir, OVERWRITE); } - # exchange the directory from original to trash + # exchange the folder from original to trash foreach (@sellist) { $_ = "$trashdir/".basename($_); } @@ -14095,10 +14806,21 @@ } } +# /usr/bin/evolution mailto:Martin-Herrmann@gmx.de?attach=file:///home/pic1.jpg\&attach=file:///home/pic2.jpg\&subject=My%20Pictures\&body=Text%20for%20description & + $userinfo = "send to: starting email client ..."; $userInfoL->update; - my $command = "thunderbird -compose \"subject=Fotos,attachment=\'$pics\'\""; + my $command = "$config{MailTool} "; + if ($config{MailTool} =~ m/thunderbird/i) { + $command .= "-compose \"subject=Pictures,attachment=\'$pics\'\""; + } + elsif ($config{MailTool} =~ m/evolution/i) { + $command .= "\"mailto:Receiver?attach=\'$pics\'\\&subject=Pictures\\&body=Text\"" ; + } + else { + # this case is already handled adove. + } $command .= " &" unless ($EvilOS); - print "command = $command\n" if $verbose; + print "command = $command\n";# if $verbose; (system "$command") == 0 or warn "$command failed: $!"; # todo: this does not work, the pic still has to be there, when the user presses the send button @@ -14265,6 +14987,7 @@ my ($pic, $dir, $dpic, $newname, $rc, $thumb); my $i = 0; + my $errors = ''; my $pw = progressWinInit($lb, "Rename pictures"); foreach $dpic (@sellist){ last if progressWinCheck($pw); @@ -14296,13 +15019,12 @@ 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 + -buttons => ['Overwrite', 'Cancel'])->Show(); + next if ($rc ne 'Overwrite'); # skip this file } if (!rename ($dpic, $ndpic)) { - $lb->messageBox(-icon => 'warning', -message => "Could not rename $pic to $newname: $!", - -title => 'Error', -type => 'OK'); + $errors .= "Could not rename $pic to $newname: $!"; next; } @@ -14323,23 +15045,29 @@ # rename thumbnail if (-f $thumb) { if (!rename ($thumb, dirname($thumb)."/$newname")) { - $lb->messageBox(-icon => 'warning', -message => "Could not rename thumbnail $pic to $newname: $!", - -title => 'Error', -type => 'OK'); + $errors .= "Could not rename thumbnail $pic to $newname: $!"; } } + # rename XMP, WAV, RAW files + do_other_files(RENAME, $dpic, $ndpic, \$errors); + # rename exif info file, if any if (-f "$dir/$exifdirname/$pic") { if (!rename ("$actdir/$exifdirname/$pic", "$actdir/$exifdirname/$newname")) { - $lb->messageBox(-icon => 'warning', -message => "Could not rename exif info file $pic to $newname: $!", - -title => 'Error', -type => 'OK'); + $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) { @@ -14473,13 +15201,16 @@ %d = day (dd) %xr = EXIF artist %h = hour (hh) %iw = image width %M = Minute (MM) %ih = image height -%s = second (ss) +%s = second (ss) %F = file name substring Examples: "%y%m%d-%h%M%s" will rename all pictures to their internal EXIF -date e.g. 20061231-155959 (the file date will be used, if there +date e.g. 20081231-155959 (the file date will be used, if there is no EXIF date). +"%F4-7" will rename PIC0001.jpg to file name substring from +4th char up to 7th char e.g 0001.jpg + If you select 3 pictures and enter "flower" as file name format, the pics will be renamed to "flower.jpg", "flower-01.jpg" and "flower-02.jpg". @@ -14506,7 +15237,7 @@ } ############################################################## -# renameSmart - rename the selected pictures to e.g. the EXIF date +# renameSmart - rename the selected pictures using e.g. the EXIF date ############################################################## sub renameSmart { @@ -14516,7 +15247,7 @@ return unless checkSelection($lb, 1, 0, \@sellist); my ($pic, $dir, $dpic, $ndpic, $rc, @datetime, @times, $time, @dates, $date, $n, $base); my $doForAll = 0; - my $errors = ""; + my $errors = ''; my $useFileDate = undef; my @renamed; @@ -14585,8 +15316,8 @@ $userinfo = "ready! (renamed $i/".scalar @sellist.")"; $userInfoL->update; setTitle(); } - if ($errors ne "") { - $errors = "These errors occured while renaming the ".scalar @sellist." selected pictures:\n$errors"; + if ($errors ne '') { + $errors = "These errors occured while renaming ".scalar @sellist." selected pictures:\n$errors"; showText("Error while renaming", $errors, NO_WAIT); } $lb->focusForce; @@ -14623,6 +15354,12 @@ $$errors .= "Could not rename exif info file $pic to $npic: $!\n"; } } + + # rename the XMP, WAV, RAW sidecar files, if any + do_other_files(RENAME, $dpic, $ndpic, \$errors); + + # rename theWAV audio file, if any + #rename_WAV_file($dpic, $ndpic, \$errors); # rename backup file, if any renameBackup($picLB, $dpic, $npic); @@ -14643,14 +15380,14 @@ ############################################################## # renameSmartFix - fix the renaming of renameSmart by adding -# "-00" to the first pic of a set -# e.g. pic1.jpg and pic1-01.jpg will become -# pic1-00.jpg and pic1-01.jpg +# "-000" to the first pic of a set +# e.g. pic1.jpg and pic1-001.jpg will become +# pic1-000.jpg and pic1-001.jpg # todo: this really is an ugly solution ############################################################## sub renameSmartFix { - my $errors = shift; # ref to scalar, errors will be added + my $errors = shift; # ref to scalar, errors will be added my @piclist = @_; return unless (@piclist); @@ -14658,17 +15395,17 @@ $hash{$_} = 1 foreach (@piclist); my %renamed; # hash of the renamed files (key: old name, value: new name) - # search the list for files matching file-01.jpg + # search the list for files matching file-001.jpg foreach my $dpic (@piclist) { - if ($dpic =~ m/(.*)-01\.(.*)$/i) { # e.g. file-01.jpg + if ($dpic =~ m/(.*)-001\.(.*)$/i) { # e.g. file-001.jpg my $pic = "$1.$2"; - my $npic = "$1-00.$2"; + my $npic = "$1-000.$2"; # if there is a file named file.jpg if (defined $hash{$pic}) { - # and no file named file-00.jpg + # and no file named file-000.jpg unless (defined $hash{$npic}) { print "renameSmartFix: rename $pic to $npic\n" if $verbose; - # we rename file.jpg to file-00.jpg + # we rename file.jpg to file-000.jpg if (renamePicInt($pic, $npic, $errors)) { $renamed{$pic} = $npic; } @@ -14698,6 +15435,24 @@ $$newname =~ s/%f/$name/g; } + # idea from Thierry Daucourt + # replace %F with the file name substring + if ($format =~ m/\%F(\d+)\-(\d+)/) { + my $begin = $1 - 1; # we start with index 1, not 0 + my $end = $2 - 1; + if ($pic =~ /(.*)\.(.*)/) { + my $name = $1; + #print "begin: $begin end: $end length ($name): ",length($name),"\n"; + # some safety checks + if (($begin <= $end) and + ($end < length($name)) and + ($begin >= 0)) { + $name = substr($name, $begin, $end - $begin + 1); + } + $$newname =~ s/\%F(\d+)\-(\d+)/$name/g; + } + } + # get the date and replace it, only when needed if ($format =~ m/(\%y|\%m|\%d|\%h|\%M|\%s)/) { my $datestr = ""; @@ -14757,7 +15512,7 @@ ############################################################## # findNewName - find a unused name by adding a number -# e.g. name-03.jpg +# e.g. name-001.jpg # input: filename with dir! with or without suffix # output: new filename - no dir!!! ############################################################## @@ -14777,9 +15532,9 @@ my $suffix = $2; # if a file with this name already exists, we add a number - for ( 1 .. 99 ) { + for ( 1 .. 999 ) { # three digits if (-f "$dir/$new$suffix") { - $new = sprintf "%s-%02d", $base, $_; + $new = sprintf "%s-%03d", $base, $_; # three digits } else { last; } @@ -14845,15 +15600,15 @@ # open window my $win = $top->Toplevel(); - $win->title('New keywords'); + $win->title('New IPTC keywords'); $win->iconimage($mapiviicon) if $mapiviicon; - my $text = 'Found new keywords, please choose how to proceed.'; + my $text = 'Found new IPTC keywords, please choose how to proceed.'; $win->Label(-textvariable => \$text)->pack(-expand => 0, -fill => 'x'); my $tlb = $win->Scrolled("HList", -header => 1, - -separator => ';', # todo here we hope that ; will never be in a directory or file name + -separator => ';', # todo here we hope that ; will never be in a folder or file name -pady => 0, -columns => 2, -scrollbars => 'osoe', @@ -14889,6 +15644,9 @@ $win->destroy() if ($nr < 1); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); + $butF2->Checkbutton(-variable => \$config{CheckNewKeywords}, + -text => "Check for new keywords")->pack(-side => 'left', -anchor => 'w'); + my $Xbut = $butF2->Button(-text => 'Ask later', -command => sub { $win->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); @@ -14901,7 +15659,7 @@ repositionWindow($win); my $nr = show_new_keywords($tlb); - $text = "Found $nr new keywords, please choose how to proceed."; + $text = "Found $nr new IPTC keywords, please choose how to proceed."; $win->waitWindow; } @@ -14968,15 +15726,6 @@ } ############################################################## -# openWith -############################################################## -sub openWith { - # todo - $top->messageBox(-icon => 'warning', -message => '"Open with ..." is not yet implemented, sorry!', - -title => 'Error', -type => 'OK'); -} - -############################################################## # deletePics - deletes selected pictures # mode: trash|rm # trash = move to $trashdir @@ -15055,6 +15804,7 @@ $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 @@ -15073,6 +15823,7 @@ $errors .= "Could not move thumbnail \"$thumb\" to $trashdir/$thumbdirname: $!\n"; } } + do_other_files(MOVE, $dpic, $tpic, \$errors); } else { $errors .= "Could not move picture \"$pic\" to $trashdir: $!\n"; } @@ -15414,11 +16165,11 @@ my $newDir = shift; return 0 unless defined $newDir; if ( !chdir $newDir ) { - my $dialog = $top->Dialog(-title => "Changing to $newDir directory failed", - -text => "Can't change to $newDir directory: $!", + 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 directory: $!"; + warn "Can't change to $newDir folder: $!"; return 0; } return 1; @@ -15667,13 +16418,13 @@ my $info = ""; if ($config{Layout} == 0) { - $info = "directories-thumbnails-picture"; + $info = "folders|thumbnails|picture"; $config{ShowDirTree} = 1; $config{ShowThumbFrame} = 1; $config{ShowPicFrame} = 1; } elsif ($config{Layout} == 1) { - $info = "directories-thumbnails"; + $info = "folders|thumbnails"; $config{ShowDirTree} = 1; $config{ShowThumbFrame} = 1; $config{ShowPicFrame} = 0; @@ -15685,7 +16436,7 @@ $config{ShowPicFrame} = 0; } elsif ($config{Layout} == 3) { - $info = "thumbnails-picture"; + $info = "thumbnails|picture"; $config{ShowDirTree} = 0; $config{ShowThumbFrame} = 1; $config{ShowPicFrame} = 1; @@ -15697,7 +16448,7 @@ $config{ShowPicFrame} = 1; } elsif ($config{Layout} == 5) { - $info = "picture"; + $info = "folders|picture"; $config{ShowDirTree} = 1; $config{ShowThumbFrame} = 0; $config{ShowPicFrame} = 1; @@ -15965,112 +16716,18 @@ ############################################################## sub showPicInOwnWin { - my $dpic = shift; - - my $fullscreen = 0; - - my $lb = 0; - - if ((!defined $dpic) or ($dpic eq "") or (!-f $dpic)) { + 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; - } - - if (!-f $dpic) { - $top->messageBox(-icon => 'warning', -message => "showPicinOwnWin: Error no file $dpic", - -title => 'Error', -type => 'OK'); - return; - } - - my $pic = basename($dpic); - $userinfo = "opening $pic in new window ..."; $userInfoL->update; - my $photo = $top->Photo(-file => $dpic, -gamma => $config{Gamma}); - if (! $photo) { - $top->messageBox(-icon => 'warning', -message => "showPicinOwnWin: Error no photo $pic!", - -title => 'Error', -type => 'OK'); - $userinfo = ""; $userInfoL->update; - return; - } - - increasePicPopularity($dpic); - if (($config{trackPopularity}) and ($lb == $picLB)) { - updateOneRow($dpic, $lb); # update popularity (viewed x times) info - $lb->update; - } - - my $zoomFactor = autoZoom(\$photo, $dpic, $top->screenwidth, $top->screenheight); - - # open window - my $win = $top->Toplevel(-bg => "black"); - #$win->withdraw; - $win->title("$pic $zoomFactor"); - $win->iconname($pic); - # use the picture thumbnail as window icon - my $iconfile = getThumbFileName($dpic); - my $iconPhoto = $win->Photo(-file => $iconfile) if (-f $iconfile); - $win->idletasks if $EvilOS; # this line is crucial (at least on windows) - $win->iconimage($iconPhoto) if $iconPhoto; - - my $but = $win->Button(-image => $photo, - -border => 0, - -relief => "flat", - -command => sub { - $win->grabRelease(); - $win->withdraw(); - $photo->delete; - $iconPhoto->delete if $iconPhoto; - $win->destroy(); - },)->pack(-anchor => "center", -expand => 1, -padx => 0, -pady => 0); - - my $balloonmsg = makeBalloonMsg($dpic); - $balloonmsg .= "\n\n(Click on picture to close window)"; - $balloon->attach($but, -balloonposition => "mouse", -msg => \$balloonmsg); - - $win->bind('', sub { $but->invoke; }); - $win->bind('', sub { $but->invoke; }); - # invoke $but when the window is closed by the window manager (x-button) - $win->protocol("WM_DELETE_WINDOW" => sub { $but->invoke; }); - -# key-desc,F11,toggle fullscreen mode when displaying picture in own window - $win->bind('', sub - { - $fullscreen = ($fullscreen) ? 0 : 1; - fullscreen($win, $fullscreen); - }); - -# key-desc,o,overrideredirect (fullscreen mode - experimental) when displaying picture in own window - $win->bind('', sub - { - #print "override=".$config{Overrideredirect}."\n"; - if ($config{Overrideredirect}) { - #print "no frame\n"; - #fullscreen($win, 1); - #$but->bind('',sub{$but->focusForce;$but->grabGlobal}); - #$but->bind('',sub{$but->grabRelease}); - #$win->focusForce; - #$win->grabGlobal; - $config{Overrideredirect} = 0; # toggle - } else { - #print "frame\n"; - #fullscreen($win, 0); - #$win->grabRelease(); - $config{Overrideredirect} = 1; # toggle - } - #print "override=".$config{Overrideredirect}."\n"; - fullscreen($win, $fullscreen); - $win->bind('',sub{$win->focusForce;$win->grabGlobal;}); - $win->bind('',sub{$win->grabRelease}); - } - ); - - #$win->deiconify; - #$win->raise; - fullscreen($win, $fullscreen); - $but->focusForce if (Exists($but)); - $userinfo = "ready!"; $userInfoL->update; + # 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); } ############################################################## @@ -16078,19 +16735,19 @@ # a mouse click on the picture will close # the window ############################################################## -sub show_multiple_pics { +sub show_multiple_pics($$) { my $pic_list = shift; # reference to a picture list, each with full path - my $index = 0; $index = shift; # start index number, optional, defaults to first pic (index = 0) + my $index = shift; # start index number, first pic is index = 0 unless (defined $pic_list) { warn "pic list undef"; return; } unless (ref($pic_list) eq 'ARRAY') {warn "pic list is no array reference"; return; } unless (@{$pic_list} >= 1) {warn "pic list is empty"; return; } - #my $fullscreen = 0; + my $fullscreen = 0; my $balloon_addon = "\n\n(Click on picture to close window; use PgUp and PgDown for next/previous picture)"; - my $dpic = @$pic_list[$index]; + my $dpic = @{$pic_list}[$index]; my $pic = basename($dpic); my ($photo, $zoomFactor); @@ -16098,9 +16755,9 @@ return unless ($rc); # open window - my $win = $top->Toplevel(-bg => "black"); - #$win->withdraw; - $win->title(sprintf "(%d/%d) %s %s", ($index+1), ($#{@{$pic_list}}+1), $pic, $zoomFactor); + my $win = $top->Toplevel(-bg => 'black'); + my $total_pics = scalar @{$pic_list}; + $win->title(sprintf "(%d/%d) %s %s", ($index+1), $total_pics, $pic, $zoomFactor); $win->iconname($pic); # use the picture thumbnail as window icon my $iconfile = getThumbFileName($dpic); @@ -16110,7 +16767,7 @@ my $but = $win->Button(-image => $photo, -border => 0, - -relief => "flat", + -relief => 'flat', -command => sub { $win->grabRelease(); $win->withdraw(); @@ -16135,8 +16792,8 @@ $balloon->detach($but); } }); - $menu->command(-label => "next picture", -command => sub { print "use PageDown instead\n"; }); # todo - $menu->command(-label => "previous picture", -command => sub { print "use PageUp instead\n"; }); # todo + #$menu->command(-label => "next picture", -command => sub { print "use PageDown instead\n"; }); # todo + #$menu->command(-label => "previous picture", -command => sub { print "use PageUp instead\n"; }); # todo $menu->command(-label => "close window", -command => sub { $but->invoke; }); # mouse and button bindings $win->bind('', sub { @@ -16149,7 +16806,8 @@ $win->protocol("WM_DELETE_WINDOW" => sub { $but->invoke; }); $win->bind('', sub { - $win->Busy; + return if ($total_pics <= 1); + $but->Busy; # we can't use $win here else the cursor won't change $index++; $index = 0 if ($index > $#{@{$pic_list}}); $dpic = @$pic_list[$index]; @@ -16161,11 +16819,12 @@ $win->iconname($pic); $but->configure(-image => $photo); $balloonmsg = makeBalloonMsg($dpic).$balloon_addon; - $win->Unbusy; + $but->Unbusy; }); - + $win->bind('', sub { - $win->Busy; + return if ($total_pics <= 1); + $but->Busy; # we can't use $win here else the cursor won't change $index--; $index = $#{@{$pic_list}} if ($index < 0); $dpic = @$pic_list[$index]; @@ -16177,17 +16836,22 @@ $win->iconname($pic); $but->configure(-image => $photo); $balloonmsg = makeBalloonMsg($dpic).$balloon_addon; - $win->Unbusy; + $but->Unbusy; }); - # key-desc,F11,toggle fullscreen mode when displaying picture in own window - #$win->bind('', sub - # { - # $fullscreen = ($fullscreen) ? 0 : 1; - # fullscreen($win, $fullscreen); - # }); - #$win->deiconify; - #$win->raise; +# key-desc,F11,toggle fullscreen mode when displaying picture in own window + $win->bind('', sub + { + toggle(\$fullscreen); + # the fullscreen modus is always without border when the option ToggleBorder is set + $config{Overrideredirect} = 0; + $config{Overrideredirect} = $fullscreen if $config{ToggleBorder}; + fullscreen($win, $fullscreen); + # the next two lines may hlep if there are focus problems + #$win->bind('',sub{$win->focusForce;$win->grabGlobal;}); + #$win->bind('',sub{$win->grabRelease}); + }); + $but->focusForce if (Exists($but)); $userinfo = "ready!"; $userInfoL->update; } @@ -16218,7 +16882,7 @@ increasePicPopularity($dpic); if ($config{trackPopularity}) { - updateOneRow($dpic, $picLB); # update popularity (viewed x times) info - todo: will throw a warning if started somewhere else and dpic is not in this lb + updateOneRow($dpic, $picLB); # update popularity (viewed x times) info $picLB->update; } @@ -16252,7 +16916,7 @@ $win->iconname("Pictures"); $win->iconimage($mapiviicon) if $mapiviicon; - my $topFrame = $win->Frame()->pack(-fill => 'both', -expand => 1); + my $topFrame = $win->Frame()->pack(-fill => 'both'); my %tphotos; # local hash to store the thumbnail photo objects @@ -16263,11 +16927,12 @@ $topFrame->Label(-textvariable => \$win->{label})->pack(-side => 'left'); my $cols = 6; - $cols = $nr if ($nr < $cols); + $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 maxroe:$maxrows\n" if $verbose; + $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, @@ -16275,7 +16940,7 @@ -scrollbars => 'oe', )->pack(-fill => 'both', -expand => 1); - bindMouseWheel($tiler); + bindMouseWheel($tiler->Subwidget("scrolled")); # list of all the window objects of $tiler # special values are $a[$i]->{selected} a boolean value 1=selected 0=not selected @@ -16326,17 +16991,17 @@ $menu->separator; ############# open picture in main window - $menu->command(-label => "open picture in main window", -command => sub { + $menu->command(-label => "open picture in main window", -accelerator => '', -command => sub { my @sel; # get the selection foreach (@a) { push @sel, $_->{dpic} if $_->{selected}; } - return unless checkSelection($win, 1, 1, \@sel); + return unless checkSelection($win, 1, 1, \@sel); my $dpic = $sel[0]; my $dir = dirname($dpic); my $pic = basename($dpic); if (!-d $dir) { - $win->messageBox(-icon => 'warning', -message => "Sorry, but the directory\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.", - -title => 'directory not found', -type => 'OK'); + $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; @@ -16575,18 +17240,18 @@ my ($w, $h) = getSize($dpic); my $exif = getShortEXIF($dpic, NO_WRAP); if ($exif ne "") { - $exif = formatString($exif, 80); + $exif = formatString($exif, 80, -1); $exif = "\nEXIF: ".$exif; } my $iptc = getIPTC($dpic, SHORT); - $iptc = formatString($iptc, 80); # needed for many joined keywords + $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); + $comment = formatString($comment, 80, -1); if ($comment ne "") { $comment = "\n\n".$comment; # if comment is not empty, add a little distance } @@ -16597,36 +17262,6 @@ } ############################################################## -# fullscreen -############################################################## -sub fullscreen { - my $win = shift; - #my $dpic = shift; - my $fullscreen = shift; - - #my $geo; - if ($fullscreen) { - #saveOffsets($win); - #my $screenw = $top->screenwidth - 10; - #my $screenh = $top->screenheight - 30; - #$geo = "${screenw}x${screenh}+0+0"; - print "fullscreen: full \n" if $verbose; - # this should olso work: - $win->packPropagate(0); - $win->FullScreen; - - } else { - #my ($w, $h) = getSize($dpic); - $win->packPropagate(1); - #$geo = "${w}x${h}+${picwinx}+${picwiny}"; - print "fullscreen: normal \n" if $verbose; - } - #$win->geometry($geo); - $win->update; - $win->overrideredirect($config{Overrideredirect}); # no window decoration, but also no key input possible?! -} - -############################################################## # saveOffsets ############################################################## # sub saveOffsets { @@ -16639,25 +17274,6 @@ # } ############################################################## -# systemInfo - show some infos about the system to the user -############################################################## -sub systemInfo { - - my $string = "Here is a list of all external programs used by mapivi:\n\n"; - - foreach my $prog (sort keys %exprogs) { - if ($exprogs{$prog}) { - $string .= " "; - } - else { - $string .= " not "; - } - $string .= sprintf("available: %-12s - %s\n", $prog, $exprogscom{$prog}); - } - showText("System Information", $string, WAIT, $mapiviiconfile); -} - -############################################################## # options ############################################################## sub options { @@ -16715,13 +17331,13 @@ and you can restore it later. (see menu Edit->EXIF info->restore)"); $aF->Checkbutton(-variable => \$tmpconf{ShowHiddenDirs}, - -text => 'Show hidden directories (starting with a dot ".")')->pack(-anchor => 'w'); + -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 directory (e.g. $thumbdirname)")->pack(-anchor => 'w'); + -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 = @@ -16740,9 +17356,15 @@ $aF->Checkbutton(-variable => \$tmpconf{AspectRatio}, -text => "Calculate and show image aspect ratio (e.g. 4:3 or 3:2)")->pack(-anchor => 'w'); $aF->Checkbutton(-variable => \$tmpconf{ShowFileDate}, -text => - "Show the file date in the size column")->pack(-anchor => 'w'); + "Show file date in the size column")->pack(-anchor => 'w'); $aF->Checkbutton(-variable => \$tmpconf{RenameBackup}, -text => - "Rename the backup file, if the file is renamed")->pack(-anchor => 'w'); + "Rename backup file, if the file is renamed")->pack(-anchor => 'w'); + $aF->Checkbutton(-variable => \$tmpconf{WAV_file_operations}, -text => + "WAV audio files follow picture file operations (copy, move, rename, delete *.wav file)")->pack(-anchor => 'w'); + $aF->Checkbutton(-variable => \$tmpconf{XMP_file_operations}, -text => + "XMP sidecar files follow picture file operations (copy, move, rename, delete *.xmp file)")->pack(-anchor => 'w'); + $aF->Checkbutton(-variable => \$tmpconf{RAW_file_operations}, -text => + "RAW (nef, crw) files follow picture file operations (copy, move, rename, delete *.nef or *.crw file)")->pack(-anchor => 'w'); my $trb = $aF->Checkbutton(-variable => \$tmpconf{jpegtranTrim}, @@ -16764,16 +17386,17 @@ $balloon->attach($aFcp, -msg => "MaPiVi is able to cache some pictures.\nCached pictures can be displayed very fast, but eat up memory."); - my $aFtp = labeledScale($aF, 'top', $w, "Max number of displayed thumbnail", \$tmpconf{ThumbMaxLimit}, 10, 1000, 10); +my $aFtp = labeledScale($aF, 'top', $w, "Max number of displayed thumbnails", \$tmpconf{ThumbMaxLimit}, 10, 10000, 10); + $balloon->attach($aFtp, -msg => "Each thumbnail eats up a little bit of memory -(about 40kByte), so opening a directory +(about 40kByte), so opening a folder with a huge number of pictures may be dangerous. With this option you are able to limit the memory consumption of the thumbnails. -The remainding thumbnails will be displayed -with the default thumbnail."); +The remaining thumbnails will be displayed +with the default thumbnail."); - my $aFst = labeledScale($aF, 'top', $w, "Maximum size of trash (MB)", \$tmpconf{MaxTrashSize}, 1, 250, 5); + my $aFst = labeledScale($aF, 'top', $w, "Maximum size of trash (MB)", \$tmpconf{MaxTrashSize}, 1, 500, 5); $balloon->attach($aFst, -msg => "The trash size is not really limited, but there will be a warning, when this limit is reached."); @@ -16875,7 +17498,7 @@ $cF->Checkbutton(-variable => \$tmpconf{ShowInfoFrame}, -text => "Show info frame on the upper side")->pack(-anchor => 'w'); $cF->Checkbutton(-variable => \$tmpconf{ShowDirTree}, - -text => "Show directory tree on the left side")->pack(-anchor => 'w'); + -text => "Show folder tree on the left side")->pack(-anchor => 'w'); $cF->Checkbutton(-variable => \$tmpconf{ShowThumbFrame}, -text => "Show thumbnail list")->pack(-anchor => 'w'); $cF->Checkbutton(-variable => \$tmpconf{ShowPicFrame}, @@ -16889,6 +17512,10 @@ -text => "Display comment info in picture view")->pack(-anchor => 'w'); $balloon->attach($aFc, -msg => "show/hide the textfield containing the picture comments\nand the buttons to add, edit and remove a comment.\nThis field is usually located above the actual picture"); + my $aFic = $cF->Checkbutton(-variable => \$tmpconf{ShowCaptionField}, + -text => "Display IPTC caption info in picture view")->pack(-anchor => 'w'); + $balloon->attach($aFic, -msg => "show/hide the textfield containing the picture IPTC caption\nand a button to store it.\nThis field is usually located above the actual picture"); + my $aFp = $cF->Checkbutton(-variable => \$tmpconf{ShowPicInfo}, -text => "Show picture info as a balloon on the actual picture")->pack(-anchor => 'w'); $balloon->attach($aFp, -msg => "if this is enabled and you move and hold your mouse pointer\nover the actual picture (right frame of the main window)\na balloon info box (with EXIF, comment, size, ...) will appear"); @@ -16904,6 +17531,7 @@ -text => "Display the coordinates of the mouse cursor in the status bar")->pack(-anchor => 'w'); my $fontF = $cF->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3); + $balloon->attach($fontF, -msg => "Font for the main window and nearly all dialogs.\nIt's recommeded to choose a fixed font."); my $fontL = $fontF->Label(-text => "Font family: ", -bg => $config{ColorBG})->pack(-side => "left"); $fontF->Label(-textvariable => \$tmpconf{FontFamily}, -bg => $config{ColorBG})->pack(-side => "left"); @@ -16942,9 +17570,50 @@ })->pack(-side => "left", -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $fontF->Label(-textvariable => \$tmpconf{FontSize})->pack(-side => "left"); - my $tfontF = $cF->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3); - my $tfontL = $tfontF->Label(-text => "Thumbnail font size:", -bg => $config{ColorBG})->pack(-side => "left"); - $tfontF->Scale( + my $propFontF = $cF->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3); + $balloon->attach($propFontF, -msg => "Please choose a propotional font here which is available in different sizes.\nIt will be used in the keyword browser (tag cloud)."); + my $propFontL = $propFontF->Label(-text => "Proportional font family: ", -bg => $config{ColorBG})->pack(-side => "left"); + $propFontF->Label(-textvariable => \$tmpconf{PropFontFamily}, -bg => $config{ColorBG})->pack(-side => "left"); + + $propFontF->Button(-text => 'Set', + -command => sub { + my $font = $tmpconf{PropFontFamily}; + my $rc = myFontDialog($ow, 'Select font family', \$font, $tmpconf{PropFontSize}); + return unless $rc; + $tmpconf{PropFontFamily} = $font; + $ow->Busy; + my $font2 = $top->Font(-family => $tmpconf{PropFontFamily}, + -size => $tmpconf{PropFontSize}); + $propFontL->configure(-font => $font2); + $propFontL->update(); + $ow->Unbusy; + })->pack(-side => "left"); + + $propFontF->Label(-text => " Font size: ", -bg => $config{ColorBG})->pack(-side => "left"); + $propFontF->Scale( + -variable => \$tmpconf{PropFontSize}, + -from => 5, + -to => 30, + -resolution => 1, + -sliderlength => 30, + -orient => 'horizontal', + -showvalue => 0, + -width => 15, + -bd => $config{Borderwidth}, + -command => sub { + $ow->Busy; + my $font = $top->Font(-family => $tmpconf{PropFontFamily}, + -size => $tmpconf{PropFontSize}); + $propFontL->configure(-font => $font); + $propFontL->update(); + $ow->Unbusy; + })->pack(-side => "left", -expand => 1, -fill => 'x', -padx => 3, -pady => 3); + $propFontF->Label(-textvariable => \$tmpconf{PropFontSize})->pack(-side => "left"); + + + my $tfontF = $cF->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3); + my $tfontL = $tfontF->Label(-text => "Thumbnail font size:", -bg => $config{ColorBG})->pack(-side => "left"); + $tfontF->Scale( -variable => \$tmpconf{ThumbCaptFontSize}, -from => 5, -to => 20, @@ -17100,7 +17769,7 @@ labeledEntryColor($eF,'top',$w,"Font color: IPTC",'Set',\$tmpconf{ColorIPTC}); labeledEntryColor($eF,'top',$w,"Font color: EXIF",'Set',\$tmpconf{ColorEXIF}); labeledEntryColor($eF,'top',$w,"Font color: size",'Set',\$tmpconf{ColorFile}); - labeledEntryColor($eF,'top',$w,"Font color: directory",'Set',\$tmpconf{ColorDir}); + labeledEntryColor($eF,'top',$w,"Font color: folder",'Set',\$tmpconf{ColorDir}); # ############### advanced notepad ######################## @@ -17108,19 +17777,21 @@ $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'); - $dF->Checkbutton(-variable => \$tmpconf{ShowUrgency}, - -text => "show the rating (the IPTC urgency flag) in the status line (needs restart)")->pack(-anchor => 'w'); my $ctcb = $dF->Checkbutton(-variable => \$tmpconf{CenterThumb}, @@ -17136,7 +17807,7 @@ my $ctdb = $dF->Checkbutton(-variable => \$tmpconf{CentralThumbDB}, -text => "Store all thumbnails in a central place")->pack(-anchor => 'w'); - $balloon->attach($ctdb, -msg => "If this is enabled all thumbnails will be\nstored in a central place (~/.maprogs/thumbDB),\nif disabled thumbnails will be stored\ndecentral in sub directories (.thumbs)."); + $balloon->attach($ctdb, -msg => "If this is enabled all thumbnails will be\nstored in a central place (~/.maprogs/thumbDB),\nif disabled thumbnails will be stored\ndecentral in sub folders (.thumbs)."); my $tbb = $dF->Checkbutton(-variable => \$tmpconf{ToggleBorder}, @@ -17154,6 +17825,12 @@ $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."); @@ -17164,9 +17841,11 @@ labeledScale($dF, 'top', $w, "preview size in filter dialog (pixel)", \$tmpconf{FilterPrevSize}, 50, 500, 5); labeledScale($dF, 'top', $w, "Comment text box height (lines)", \$tmpconf{CommentHeight}, 1, 50, 1); labeledScale($dF, 'top', $w, "Gamma value, when displaying pictures", \$tmpconf{Gamma}, 0.1, 10.0, 0.01); - labeledScale($dF, 'top', $w, "Maximum number of lines of a comment", \$tmpconf{LineLimit}, 1, 20, 1); + labeledScale($dF, 'top', $w, "Maximum 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); - labeledEntry($dF, 'top', $w, "External picture viewer",\$tmpconf{ExtViewer}); + my $epv = labeledEntry($dF, 'top', $w, "External picture viewer",\$tmpconf{ExtViewer}); + $balloon->attach($epv, + -msg => "Enter the command to start the external picture viewer here.\nYou may also add options.\nExamles: \"gqview -f\", \"gthumb --fullscreen\""); my $evmf = $dF->Checkbutton(-variable => \$tmpconf{ExtViewerMulti}, -text => "External picture viewer can handle multiple files")->pack(-anchor => 'w'); @@ -17178,7 +17857,9 @@ "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".'); - labeledEntry($dF, 'top', $w, "Tool to set the desktop background",\$tmpconf{ExtBGApp}); + my $emt = labeledEntry($dF, 'top', $w, "External mail tool",\$tmpconf{MailTool}); + $balloon->attach($emt, + -msg => "Enter the command to start the external mail tool here.\nExamles: \"thunderbird\", \"mozilla-thunderbird\", \"evolution\""); # ############### button frame ######################## @@ -17187,7 +17868,7 @@ -padx => 3, -pady => 3); - $butF->Button(-text => 'OK', + my $OKB = $butF->Button(-text => 'OK', -command => sub { %config = %{ dclone(\%tmpconf) }; applyConfig(); @@ -17196,6 +17877,10 @@ $ow->destroy(); } )->pack(-side=>'left', -expand => 1, -fill =>'x'); + + # bind ctrl-x to OK button + $ow->bind('', sub { $OKB->invoke; }); + $butF->Button(-text => "Apply", -command => sub { %config = %{ dclone(\%tmpconf) }; @@ -17291,7 +17976,7 @@ # following widgets # so we always remove them all - from the inner to the outer ones # and pack them again according to the actual settings - foreach ($c, $comF, $exifF, $mainF, $thumbA, $thumbF, $dirA, $dirF, $subF, $infoF) { + foreach ($c, $capF, $comF, $exifF, $mainF, $thumbA, $thumbF, $dirA, $dirF, $subF, $infoF) { $_->packForget if ($_->ismapped); } @@ -17327,6 +18012,9 @@ if ($config{ShowCommentField}) { $comF->pack(-fill => 'x',-expand => "1", -anchor=>'w', -padx => 0, -pady => 0) ; } + if ($config{ShowCaptionField}) { + $capF->pack(-fill => 'x',-expand => "1", -anchor=>'w', -padx => 0, -pady => 0) ; + } $c->pack(-expand => 1, -fill => "both", -padx => 0, -pady => 0, -ipadx => 0, -ipady => 0); } @@ -17354,7 +18042,7 @@ -anchor => 'w', -text => "Create backup" )->pack(-side => $side, -anchor => 'w', -padx => 5, -pady => 3); - $balloon->attach($but, -msg => "Create a backup of the original picture\nin the same directory named \"name-bak.jpg\""); + $balloon->attach($but, -msg => "Create a backup of the original picture\nin the same folder named \"name-bak.jpg\""); } ############################################################## @@ -17607,12 +18295,13 @@ my ($parentWidget, $position, $butlabel, $varRef) = @_; my $ccbut; $ccbut = $parentWidget->Button(-text => $butlabel, - -bg => $$varRef, - -command => sub { - my $rc = color_chooser(); - if (defined $rc) { - $ccbut->configure(-bg => $rc); - $$varRef = $rc; + -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') { @@ -17622,7 +18311,7 @@ $ccbut->configure(-fg => 'black'); } } - })->pack(-side => $position); + })->pack(-side => $position, -pady => 0,); # this is needed when drawing the button if ($$varRef eq 'black') { @@ -17722,7 +18411,7 @@ my $path = shift; my $tree = shift; my $newDir = "newdir"; - my $rc = myEntryDialog("Make a new directory","Enter name of new directory in $path",\$newDir); + my $rc = myEntryDialog("Make a new folder","Enter name of new folder in $path",\$newDir); return if ($rc ne 'OK' or $newDir eq ""); @@ -17798,8 +18487,8 @@ my $dirname = basename($dir); my $rc = $top->messageBox(-icon => 'question', - -message => "Do you really want to delete directory \"$dirname\"\n($dir)?\nThere is no undelete!", - -title => "Delete directory?", + -message => "Do you really want to delete folder \"$dirname\"\n($dir)?\nThere is no undelete!", + -title => "Delete folder?", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); @@ -17809,7 +18498,7 @@ my $size = 0; my $timeout = ""; my $start_time = Tk::timeofday(); - $userinfo = "scanning directory ..."; $userInfoL->update; + $userinfo = "scanning folder ..."; $userInfoL->update; $top->Busy; find(sub { # jump out after 5 seconds @@ -17824,13 +18513,13 @@ } }, "$dir"); $top->Unbusy; - $userinfo = "directory scanned!"; $userInfoL->update; + $userinfo = "folder scanned!"; $userInfoL->update; $size = computeUnit($size); - my $question = sprintf "There are%s\n%8d directories and\n%8d files with a total size of\n%8s in \"%s\".\nReally delete?", $timeout, $dirs, $files, $size, $dirname; + my $question = sprintf "There are%s\n%8d folders and\n%8d files with a total size of\n%8s in \"%s\".\nReally delete?", $timeout, $dirs, $files, $size, $dirname; $rc = $top->messageBox(-icon => 'question', -message => $question, - -title => "Delete directory?", + -title => "Delete folder?", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); @@ -17854,7 +18543,7 @@ # open parent dir if we've deleted the actual dir openDirPost($path) unless (-d $dir); - $userinfo = "ready! (removed directory \"$dirname\" with $files files)"; $userInfoL->update; + $userinfo = "ready! (removed folder \"$dirname\" with $files files)"; $userInfoL->update; } ############################################################## @@ -17867,7 +18556,7 @@ my $path = dirname($dir); my $newDir = basename($dir); - my $rc = myEntryDialog("rename directory","Enter new name for directory $dir",\$newDir); + my $rc = myEntryDialog("rename folder","Enter new name for folder $dir",\$newDir); return if ($rc ne 'OK' or $newDir eq ""); @@ -17878,7 +18567,7 @@ } if (!rename "$dir", "$path/$newDir") { - $top->messageBox(-icon => 'warning', -message => "error renameing directory $dir to $path/$newDir: $!", + $top->messageBox(-icon => 'warning', -message => "error renaming folder $dir to $path/$newDir: $!", -title => 'Error', -type => 'OK'); return; } @@ -17913,11 +18602,11 @@ my ($nw, $nh); if ($ow >= $oh) { # landscape $nw = $w; - $nh = sprintf("%.0f",($nw/$aspect)); # int() does not round! + $nh = round($nw/$aspect); } else { # portrait $nh = $w; - $nw = sprintf("%.0f",($aspect*$nh)); + $nw = round($aspect*$nh); } return ($nw, $nh); } @@ -18001,8 +18690,8 @@ -command => sub { $height = $origH; $width = $origW; - $widthP = sprintf("%.0f",($width/$origW * 100)); - $heightP = sprintf("%.0f",($height/$origH * 100)); + $widthP = round($width/$origW * 100); + $heightP = round($height/$origH * 100); })->pack(-side => "left", -padx => 0); $csf1->Button(-text => "email preset", -command => sub { @@ -18019,8 +18708,8 @@ } $config{PicBlur} = 0; ($width, $height) = calcSize(640, 480, $origW, $origH); - $widthP = sprintf("%.0f",($width/$origW * 100)); - $heightP = sprintf("%.0f",($height/$origH * 100)); + $widthP = round($width/$origW * 100); + $heightP = round($height/$origH * 100); })->pack(-side => "left", -padx => 0); $csf1->Button(-text => "half", -width => 9, @@ -18029,8 +18718,8 @@ $keepaspect = 1; $widthP = 50; $heightP = 50; - $width = sprintf("%.0f",($origW * $widthP/100)); - $height = sprintf("%.0f",($origH * $heightP/100)); + $width = round($origW * $widthP/100); + $height = round($origH * $heightP/100); })->pack(-side => "left", -padx => 0); my $csf2 = $myDiag->Frame()->pack(-fill =>'x',-padx => 3,-pady => 3); $csf2->Button(-text => "640x480", @@ -18039,8 +18728,8 @@ $PixPro = "pix"; $keepaspect = 1; ($width, $height) = calcSize(640, 480, $origW, $origH); - $widthP = sprintf("%.0f",($width/$origW * 100)); - $heightP = sprintf("%.0f",($height/$origH * 100)); + $widthP = round($width/$origW * 100); + $heightP = round($height/$origH * 100); })->pack(-side => "left", -padx => 0); $csf2->Button(-text => "720x576", -width => 9, @@ -18048,8 +18737,8 @@ $PixPro = "pix"; $keepaspect = 1; ($width, $height) = calcSize(720, 576, $origW, $origH); - $widthP = sprintf("%.0f",($width/$origW * 100)); - $heightP = sprintf("%.0f",($height/$origH * 100)); + $widthP = round($width/$origW * 100); + $heightP = round($height/$origH * 100); })->pack(-side => "left", -padx => 0); $csf2->Button(-text => "800x600", -width => 9, @@ -18057,8 +18746,8 @@ $PixPro = "pix"; $keepaspect = 1; ($width, $height) = calcSize(800, 600, $origW, $origH); - $widthP = sprintf("%.0f",($width/$origW * 100)); - $heightP = sprintf("%.0f",($height/$origH * 100)); + $widthP = round($width/$origW * 100); + $heightP = round($height/$origH * 100); })->pack(-side => "left", -padx => 0); $csf2->Button(-text => "1024x768", -width => 9, @@ -18066,8 +18755,8 @@ $PixPro = "pix"; $keepaspect = 1; ($width, $height) = calcSize(1024, 768, $origW, $origH); - $widthP = sprintf("%.0f",($width/$origW * 100)); - $heightP = sprintf("%.0f",($height/$origH * 100)); + $widthP = round($width/$origW * 100); + $heightP = round($height/$origH * 100); })->pack(-side => "left", -padx => 0); $csf2->Button(-text => "1280x960", -width => 9, @@ -18075,8 +18764,8 @@ $PixPro = "pix"; $keepaspect = 1; ($width, $height) = calcSize(1280, 960, $origW, $origH); - $widthP = sprintf("%.0f",($width/$origW * 100)); - $heightP = sprintf("%.0f",($height/$origH * 100)); + $widthP = round($width/$origW * 100); + $heightP = round($height/$origH * 100); })->pack(-side => "left", -padx => 0); my $w = 20; @@ -18097,25 +18786,25 @@ my $labEhp = ($labFhp->children)[1]; $labEw->bind('', sub { if ($keepaspect) { - $height = sprintf("%.0f",($width/$aspect)); # int() does not round! + $height = round($width/$aspect); # int() does not round! } - $widthP = sprintf("%.0f",($width/$origW * 100)); - $heightP = sprintf("%.0f",($height/$origH * 100)); + $widthP = round($width/$origW * 100); + $heightP = round($height/$origH * 100); $PixPro = "pix"; }); $labEh->bind('', sub { if ($keepaspect) { $width = sprintf("%.0f",($aspect*$height)); } - $widthP = sprintf("%.0f",($width/$origW * 100)); - $heightP = sprintf("%.0f",($height/$origH * 100)); + $widthP = round($width/$origW * 100); + $heightP = round($height/$origH * 100); $PixPro = "pix"; }); $labEwp->bind('', sub { if ($keepaspect) { $heightP = $widthP; # int() does not round! } - $width = sprintf("%.0f",($origW * $widthP/100)); + $width = round($origW * $widthP/100); $height = sprintf("%.0f",($origH * $heightP/100)); $PixPro = "pro"; }); @@ -18123,7 +18812,7 @@ if ($keepaspect) { $widthP = $heightP; } - $width = sprintf("%.0f",($origW * $widthP/100)); + $width = round($origW * $widthP/100); $height = sprintf("%.0f",($origH * $heightP/100)); $PixPro = "pro"; }); @@ -18532,7 +19221,7 @@ $ButF->Button(-text => 'OK', -command => sub { # save the filter settings - store(\%filters, "$configdir/filters") or warn "could not store filter settings in file"; + nstore(\%filters, "$configdir/filters") or warn "could not store filter settings in file"; $uw->withdraw if (Exists($uw)); $lw->withdraw if (Exists($lw)); $colw->withdraw if (Exists($colw)); @@ -18712,7 +19401,7 @@ last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "cropping picture ($i/".scalar @sellist.") ...", $i, scalar @sellist); - $pic = basename($dpic); + $pic = basename($dpic); # check if file is a link and get the real target next if (!getRealFile(\$dpic)); @@ -18746,9 +19435,10 @@ $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 to small pics + # save crop frame offset before adjusting too small pics my $xsave = $x; my $ysave = $y; if (($x + $w) > $wo) { # crop frame outside the picture @@ -18830,21 +19520,21 @@ if ($w >= $h) { # landscape image $w = sprintf "%.0f", ($h * $config{CropAspect}); } else { # portait image - $w = sprintf "%.0f", ($h / $config{CropAspect}); + $w = sprintf "%.0f", ($h / $config{CropAspect}); # round } } } else { # no master defined if ($w >= $h) { # landscape image if (($h != 0) and ($w/$h >= $config{CropAspect})) { # too wide - $w = sprintf "%.0f", ($h * $config{CropAspect}); + $w = sprintf "%.0f", ($h * $config{CropAspect}); # round } else { # too high - $h = sprintf "%.0f", ($w / $config{CropAspect}); + $h = sprintf "%.0f", ($w / $config{CropAspect}); # round } } else { # portait image if (($h != 0) and ($w/$h >= 1/$config{CropAspect})) { # too wide - $w = sprintf "%.0f", ($h / $config{CropAspect}); + $w = sprintf "%.0f", ($h / $config{CropAspect}); # round } else { # too high - $h = sprintf "%.0f", ($w * $config{CropAspect}); + $h = sprintf "%.0f", ($w * $config{CropAspect}); # round } } } @@ -18868,7 +19558,8 @@ } ############################################################## -#bindForResize +# 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; @@ -18880,10 +19571,10 @@ my ( $dx, $dy ) = ( 0, 0 ); # Drag mode: NO_ACTIVE_MODE, MOVE_MODE, or RESIZE_MODE. - use constant NO_ACTIVE_MODE => 0; -# use constant MOVE_MODE => 1; - use constant RESIZE_MODE => 1; - my $mode = NO_ACTIVE_MODE; + 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 @@ -18898,19 +19589,15 @@ # Bind left-mouse clicks (<1>) over any widget with a 'RECT' tag to # do... - $canvas->bind( 'RECT' => '<1>' => + $canvas->CanvasBind('<1>' => sub { my ( $x, $y ) = ( $Tk::event->x, $Tk::event->y ); - my $id = $canvas ->find( qw|withtag current| ); - my ( $x0, $y0, $x1, $y1 ) = $canvas->coords( $id ); + my ( $x0, $y0, $x1, $y1 ) = $canvas->coords( 'RECT' ); + return if ( !defined $x0 or !defined $y0 or !defined $x1 or !defined $y1 or $x < $x0 or $x > $x1 or $y < $y0 or $y > $y1); + #my ( $x0, $y0, $x1, $y1 ) = $canvas->coords( 'RECT' ); my ( $width, $height ) = ( $x1 - $x0, $y1 - $y0 ); - #my $rrrrx = $canvas->width * $canvas->{m_xzoom}; - #my $rrrry = $canvas->height * $canvas->{m_yzoom}; - - #print "canvas $canvas->width,$canvas->height $rrrrx, $rrrry\n"; - # Determine if the user wants to size in the x direction. If # the user clicks within $resize_within of the edge, then he # wants to resize. @@ -18924,53 +19611,54 @@ elsif( $y > ( $y1 - $resize_within * $width ) ) { $dy = -1; } # If resizing in either direction, set resize mode. -# $mode = ( $dx || $dy ) ? RESIZE_MODE : MOVE_MODE; - $mode = RESIZE_MODE; + $mode = ( $dx || $dy ) ? M_RESIZE_MODE : M_MOVE_MODE; + my $id = $canvas ->find( qw|withtag RECT| ); ( $oldx, $oldy, $rect ) = ( $x, $y, $id ); - # Create the red-outlined rectangle that shows the resize as - # it occurs. -# if( $mode == RESIZE_MODE ) { - $canvas->createRectangle( $x0, $y0, $x1, $y1, - -outline => 'red', - #-dash => [6,4,2,4], - -tags => ['TEMP'] ); - #$canvas->createRectangle( $x0, $y0, $x1, $y1, - # -outline => 'white', - # -dash => [2,6,2,4], - # -tags => ['TEMP'] ); -# } return; } ); # Bind motion with the left mouse button down () over a # widget with a 'RECT' tag to do... - $canvas->bind( 'RECT' => '' => + $canvas->CanvasBind('' => sub { my ( $x, $y ) = ( $Tk::event->x, $Tk::event->y ); - - if( $mode == RESIZE_MODE ) { - # Get coordinates of resizing rectangle. Note that we - # tagged it with 'TEMP' in the createRectangle call. - my ( $x0, $y0, $x1, $y1 ) = $canvas->coords( 'TEMP' ); + #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 ( $dx == 1 ) { $x0 = $x; } + elsif ( $dx == -1 ) { $x1 = $x; } - if( $dy == 1 ) { $y0 = $y; } - elsif( $dy == -1 ){ $y1 = $y; } + if ( $dy == 1 ) { $y0 = $y; } + elsif ( $dy == -1 ) { $y1 = $y; } $x0 = 0 if ($x0 < 0); $x1 = $canvas->width if ($x1 > $canvas->width); $y0 = 0 if ($y0 < 0); $y1 = $canvas->height if ($y1 > $canvas->height); - # Set the coordinates of the temporary resizing rectangle. - $canvas->coords( 'TEMP', $x0, $y0, $x1, $y1 ); + # Set the coordinates of the resizing rectangle. + $canvas->coords( 'RECT', $x0, $y0, $x1, $y1 ); + draw_grid($canvas, $x0, $y0, $x1, $y1); + } else { + #print "M_MOVE_MODE\n"; + my ( $x0, $y0, $x1, $y1 ) = $canvas->coords( 'RECT' ); + return if ( !defined $x0 or !defined $y0 or !defined $x1 or !defined $y1 or $x < $x0 or $x > $x1 or $y < $y0 or $y > $y1); + # Move the rectangle under mouse pointer relative to its + # old position. + $canvas->move( $canvas->find( 'withtag', 'RECT' ), + $x - $oldx, + $y - $oldy ); + draw_grid($canvas, $canvas->coords( 'RECT' )); + # Update "old" coordinates. + ( $oldx, $oldy ) = ( $x, $y ); } } ); @@ -18984,7 +19672,7 @@ # [$x][$y] my @cursors = ( # [ (0,0), (0,1), (0,2) ] - [ 'target', 'top_side', 'bottom_side' ], + [ '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) ] @@ -18994,10 +19682,8 @@ $canvas->CanvasBind( '' => sub { - my @coords = $canvas->coords( 'TEMP' ); - $canvas->delete( 'TEMP' ); - $canvas->coords( $rect => @coords ); - $mode = NO_ACTIVE_MODE; + my @coords = $canvas->coords( 'RECT' ); + $mode = M_NO_ACTIVE_MODE; $canvas->configure( -cursor => 'left_ptr' ); @old_cursors = ( 3, 3 ); $cursor_is_normal = 1; @@ -19013,11 +19699,16 @@ # cursor. $canvas->CanvasBind( '' => sub { - my $id = $canvas->find( qw|withtag current| ); - my @tags = $canvas->gettags($id); + #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. - if ( (!defined $id) or (!isInList('RECT', \@tags)) ) { + + my ( $x, $y ) = ( $Tk::event->x, $Tk::event->y ); + my ( $x0, $y0, $x1, $y1 ) = $canvas->coords( 'RECT' ); + + if ( !defined $x0 or !defined $y0 or !defined $x1 or !defined $y1 or $x < $x0 or $x > $x1 or $y < $y0 or $y > $y1) { unless( $cursor_is_normal ) { $canvas->configure( -cursor => 'left_ptr' ); @old_cursors = ( 3, 3 ); @@ -19025,13 +19716,11 @@ } return; } + # Don't update the cursor once we've started a drag or resize # operation. - return unless $mode == NO_ACTIVE_MODE; + return unless $mode == M_NO_ACTIVE_MODE; - my ( $x, $y ) = ( $Tk::event->x, $Tk::event->y ); - my ( $x0, $y0, $x1, $y1 ) = $canvas->coords( $id ); - return unless (defined $x0 and defined $y0 and defined $x1 and defined $y1); my( $width, $height ) = ( $x1 - $x0, $y1 - $y0 ); # Now figure out where we are in the widget. @@ -19040,19 +19729,12 @@ # 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; - } + 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; - } + 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] ); @@ -19061,10 +19743,9 @@ @old_cursors = ( $px, $py ); $cursor_is_normal = 0; } - ); + ); } - ############################################################## # cropDialog - let the user set the crop offset ############################################################## @@ -19085,7 +19766,7 @@ warn "copy error" if (!mycopy($dpic, $zpic, OVERWRITE)); my $per = 0.75; # preview pic should be 75% of the min screen size my $cropPreviewSize = int($per * $top->screenwidth); - $cropPreviewSize = int($per * $top->screenheight) if ($top->screenheight < $top->screenwidth); + $cropPreviewSize = int($per * $top->screenheight) if ($top->screenheight < $top->screenwidth); # just shrink big pictures, do not blow up small ones my $command = 'mogrify -geometry "'.$cropPreviewSize.'x'.$cropPreviewSize.'>" -quality 80 "'.$zpic.'"'; print "croppreview: $command\n" if $verbose; @@ -19123,8 +19804,13 @@ my $fF = $cropFR->Frame(-bd => $config{Borderwidth}, -relief => 'groove' )->pack(-anchor => 'w', -padx => 3, -pady => 3, -expand => 0, -fill => 'x'); $fF->Label(-text => "Help")->pack(-expand => 0, -fill => 'x'); my $rotext = $fF->ROText(-wrap => "word", -bg => $config{ColorBG}, - -bd => "0", -width => 26, -height => 7)->pack(-expand => 0, -fill => 'x', -anchor => 'w'); - $rotext->insert('end', "Use right mouse button to open and drag a crop frame and the left mouse button to adjuste this frame"); + -bd => "0", -width => 26, -height => 3)->pack(-expand => 0, -fill => 'x', -anchor => 'w'); + $rotext->insert('end', "Use left mouse button to move and to adjuste the crop frame"); + $fF->Checkbutton(-variable => \$config{CropGrid}, + -anchor => 'w', + -text => 'display 1/3 crop grid', + -command => sub { drawFrame($pc); }, + )->pack(-anchor => 'w'); my $iF = $cropFR->Frame(-bd => $config{Borderwidth}, -relief => 'groove' )->pack(-anchor => 'w', -padx => 3, -pady => 3, -expand => 0, -fill => 'x'); $iF->Label(-text => "Info")->pack(-expand => 0, -fill => 'x'); @@ -19145,31 +19831,6 @@ #$pc->bind('' => sub { $pc->Tk::focus }); - $pc->CanvasBind('<3>' => sub { - my $x = $pc->canvasx($Tk::event->x); - my $y = $pc->canvasy($Tk::event->y); - $pc->delete('withtag', 'RECT'); - @cropRectCoords = ($x, $y, $x, $y); - - $cropRect = $pc->createRectangle(@cropRectCoords, - -tags => ['RECT'], -outline => 'red', - ); - }); - - $pc->CanvasBind('' => sub { - @cropRectCoords[2,3] = ($pc->canvasx($Tk::event->x), - $pc->canvasy($Tk::event->y)); - $pc->coords($cropRect => @cropRectCoords); - }); - - $pc->CanvasBind( '' => - sub { - my @coords = $pc->coords('RECT'); - drawFrame($pc, @coords); - $pc->raise($cropRect); - } - ); - bindForResize($pc); my $zpicP = $cropFL->Photo(-file => "$zpic", -gamma => $config{Gamma}) if (-f $zpic); @@ -19230,27 +19891,15 @@ my $aspF = $aF->Frame()->pack(-anchor => 'w'); $aspF->Label(-text => "actual aspect ratio:", -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w'); $aspF->Label(-textvariable => \$pc->{m_aspect}, -width => 8, -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w'); - $aF->Radiobutton(-text => "X:Y (any aspect ratio)", -variable => \$config{CropAspect}, -value => 0, - -command => sub { setNewAspect($pc); } - )->pack(-side => 'top', -anchor => 'w'); - $aF->Radiobutton(-text => "3:2 (e.g. 10x15)", -variable => \$config{CropAspect}, -value => 3/2, - -command => sub { setNewAspect($pc); } - )->pack(-side => 'top', -anchor => 'w'); - $aF->Radiobutton(-text => "4:3", -variable => \$config{CropAspect}, -value => 4/3, - -command => sub { setNewAspect($pc); } - )->pack(-side => 'top', -anchor => 'w'); - $aF->Radiobutton(-text => "5:4 (PAL)", -variable => \$config{CropAspect}, -value => 5/4, - -command => sub { setNewAspect($pc); } - )->pack(-side => 'top', -anchor => 'w'); - $aF->Radiobutton(-text => "7:5 (e.g. 13x18)", -variable => \$config{CropAspect}, -value => 7/5, - -command => sub { setNewAspect($pc); } - )->pack(-side => 'top', -anchor => 'w'); - $aF->Radiobutton(-text => "16:9", -variable => \$config{CropAspect}, -value => 16/9, - -command => sub { setNewAspect($pc); } - )->pack(-side => 'top', -anchor => 'w'); - $aF->Radiobutton(-text => "1:1", -variable => \$config{CropAspect}, -value => 1/1, - -command => sub { setNewAspect($pc); } - )->pack(-side => 'top', -anchor => 'w'); + my $dummy; + $aF->Optionmenu(-variable => \$config{CropAspect}, -options => [ + ['X:Y (any aspect ratio)' => 0], + ['3:2 (e.g. 10x15)' => 3/2], + ['4:3' => 4/3], + ['5:4 (PAL)' => 5/4], + ['7:5 (e.g. 13x18)' => 7/5], + ['16:9' => 16/9], + ['1:1' => 1/1], ], -textvariable => \$dummy)->pack(-side => 'top', -anchor => 'w'); # my $portLandB = # $aF->Button(-text => "portrait/landscape", @@ -19295,8 +19944,8 @@ $$wr = $pc->{m_x2} - $pc->{m_x1}; $$hr = $pc->{m_y2} - $pc->{m_y1}; $cropW->withdraw(); - $cropW->destroy(); $rc = 1; + $cropW->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); my $Xbut = @@ -19309,7 +19958,13 @@ $cropW->bind('', sub { $Xbut->invoke; }); $cropW->bind('', sub { $Xbut->invoke; }); + # first popup the window then draw the frame! $cropW->Popup; + $cropW->update; + my $distx = int($zpicx/10); + my $disty = int($zpicy/10); + drawFrame($pc, $distx, $disty, ($zpicx-$distx), ($zpicy-$disty)); + $cropW->waitWindow; # clean up @@ -19413,6 +20068,45 @@ $coords[2] = int($canvas->{m_x2} / $canvas->{m_xzoom}); $coords[3] = int($canvas->{m_y2} / $canvas->{m_yzoom}); + $canvas->delete('withtag', 'RECT'); + $canvas->createRectangle(@coords, -tags => ['RECT'], -outline => 'red'); + + # draw 1/3 grid - divide the crop frame in nine rectangles + draw_grid($canvas, @coords); + + #my $rect = $canvas->find('withtag', 'RECT'); + #$canvas->coords( $rect => @coords ); + $canvas->raise('RECT'); + # black dashed line +# $canvas->createRectangle( @coords, +# -tags => ['RECT'], +# -outline => "black", +# -dash => [6,4,2,4], +# ); + # white dashed line +# $canvas->createRectangle( @coords, +# -tags => ['RECT'], +# -outline => "white", +# -dash => [2,6,2,4], +# ); +} + +############################################################## +############################################################## +sub draw_grid { + my $canvas = shift; + my @coords = @_; + # draw 1/3 grid - divide the crop frame in nine rectangles + $canvas->delete('withtag', 'GRID'); + if ($config{CropGrid}) { + my $grid_dist_h = round(($coords[3] - $coords[1])/3); + my $grid_dist_w = round(($coords[2] - $coords[0])/3); + $canvas->createLine($coords[0],$coords[1] + $grid_dist_h, $coords[2],$coords[1] + $grid_dist_h, -dash => [6,4,2,4],-tags => ['GRID'], -width => 1, -fill => '#ccc'); + $canvas->createLine($coords[0],$coords[1] + 2*$grid_dist_h,$coords[2],$coords[1] + 2*$grid_dist_h, -dash => [6,4,2,4],-tags => ['GRID'], -fill => '#ccc'); + $canvas->createLine($coords[0] + $grid_dist_w, $coords[1],$coords[0] + $grid_dist_w,$coords[3], -dash => [6,4,2,4],-tags => ['GRID'], -fill => '#ccc'); + $canvas->createLine($coords[0] + 2*$grid_dist_w,$coords[1],$coords[0] + 2*$grid_dist_w,$coords[3], -dash => [6,4,2,4],-tags => ['GRID'], -fill => '#ccc'); + } + $canvas->delete('withtag', 'FRAME'); # draw a pseudo transparent box around the crop frame @@ -19440,26 +20134,8 @@ -fill => 'black', -stipple => 'transp', ); - $canvas->delete('withtag', 'RECT'); - $canvas->createRectangle(@coords, -tags => ['RECT'], -outline => 'red'); - #my $rect = $canvas->find('withtag', 'RECT'); - #$canvas->coords( $rect => @coords ); - $canvas->raise('RECT'); - # black dashed line -# $canvas->createRectangle( @coords, -# -tags => ['RECT'], -# -outline => "black", -# -dash => [6,4,2,4], -# ); - # white dashed line -# $canvas->createRectangle( @coords, -# -tags => ['RECT'], -# -outline => "white", -# -dash => [2,6,2,4], -# ); } - ############################################################## # cropPic - cut a rect out of the pic # needs a geometry (e.g. 200x200+33+66) @@ -19490,14 +20166,14 @@ 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; - } + print "$dpic: cropping lossless using jpegtran\n" if $verbose; + } } # the fallback solution if ($command eq "") { $command = "mogrify -crop $geo -quality $qua \"$dpic\""; - print "$dpic: cropping with loss using mogrify\n" if $verbose; + print "$dpic: cropping lossy using mogrify (reason: not a JPEG or wrong jpegtran version\n"; # if $verbose; } if ((system $command) != 0) { @@ -19529,13 +20205,13 @@ 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'); + -title => 'Copy file', -type => 'OKCancel'); return 0 if ($rc !~ m/Ok/i); } - if (!copy ("$from", "$to")) { + if (!copy ($from, $to)) { $top->messageBox(-icon => 'warning', -message => "Could not copy $from to $to: $!", - -title => "Copy file", -type => 'OK'); + -title => 'Copy file', -type => 'OK'); return 0; } return 1; @@ -19641,8 +20317,10 @@ return $quickSortHashPixel{$dpic} if ($quickSortSwitch and defined $quickSortHashPixel{$dpic}); - my $x = $searchDB{$dpic}{PIXX}; - my $y = $searchDB{$dpic}{PIXY}; + 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; @@ -19685,18 +20363,6 @@ } ############################################################## -# getSuffix - return the file suffix or undef -############################################################## -sub getSuffix { - my $file = shift; - - if ($file =~ m/(.*)\.(.*)$/) { - return $2; - } - return undef; -} - -############################################################## # is_a_JPEG - returns true (1) if the given file is a JPEG/JFIF ############################################################## sub is_a_JPEG($) { @@ -19730,7 +20396,7 @@ if (!-d $configdir) { # ask the user for permission to create a configdir my $rc = $top->messageBox(-icon => 'question', - -message => "MaPiVi would like to create a directory \"$configdir\" in your home directory to store the configuration of Mapivi and some button and background pictures.", + -message => "MaPiVi would like to create a folder \"$configdir\" in your home folder to store the configuration of Mapivi and some button and background pictures.", -title => "Mapivi installation", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); } @@ -19783,24 +20449,24 @@ ############################################################## sub copyConfigPics { + print "sub copyConfigPics ...\n" if $verbose; return if (!-d $configdir); # try to find the pictures in the actual dir and in the dir where mapivi is located - my $searchdir = dirname($0)."/pics"; + my $searchdir; my @pics; my @searchDirList = ("$actdir/pics", dirname($0)."/pics"); foreach $searchdir (@searchDirList) { print "searching $searchdir ...\n" if $verbose; next if (!-d $searchdir); @pics = getFiles($searchdir); # mapivi should be startet as mapivi or mapivi . - # so $actdir points to the dir where mapivi is stored + # so $actdir points to the dir where mapivi is stored last if (@pics > 0); } if (@pics <= 0) { - my $rc = $top->messageBox(-icon => 'warning', -message => "Error could not find any pictures! Please stop mapivi, change to the directory where mapivi is installed and restart mapivi", - -title => "Mapivi installation", -type => 'OKCancel'); + print "Mapivi Warning:\nCould not find any pictures!\nPlease stop Mapivi, change to the folder where Mapivi is installed and restart Mapivi\n"; #todo $config{NrOfRuns}-- if ($rc =~ m/Ok/i); return; } @@ -19808,7 +20474,7 @@ # copy the pictures to the config dir foreach (@pics) { if (-f "$configdir/$_") { - my $rc = $top->Dialog(-text => "I found a button/icon picture \"$_\" in the mapivi config directory (seem like there was another mapivi version installed before). Ok to overwrite?", + my $rc = $top->Dialog(-text => "I found a button/icon picture \"$_\" in the mapivi config folder (seem like there was another mapivi version installed before). Ok to overwrite?", -title => "Mapivi installation", -width => 40, -buttons => ['OK', 'Cancel', "Cancel all"])->Show(); @@ -19860,8 +20526,7 @@ } if (@plugs <= 0) { - my $rc = $top->messageBox(-icon => 'warning', -message => "Error could not find any PlugIns! Please stop mapivi, change to the directory where mapivi is installed and restart mapivi", - -title => "Mapivi installation", -type => 'OKCancel'); + print "Mapivi Warning:\nCould not find any PlugIns! Please stop Mapivi, change to the folder where Mapivi is installed and restart Mapivi\n"; # todo $config{NrOfRuns}-- if ($rc =~ m/Ok/i); return; } @@ -19869,7 +20534,7 @@ # copy the PlugIns to the plugin dir foreach (@plugs) { if (-f "$plugindir/$_") { - my $rc = $top->messageBox(-icon => 'question', -message => "I found a PlugIn\n $_\nin the mapivi PlugIn directory (seem like there was another mapivi version installed before).\n\nOk to overwrite?", + my $rc = $top->messageBox(-icon => 'question', -message => "I found a PlugIn\n $_\nin the mapivi PlugIn folder (seem like there was another mapivi version installed before).\n\nOk to overwrite?", -title => "Mapivi installation", -type => 'OKCancel'); next if ($rc !~ m/Ok/i); } @@ -20141,14 +20806,14 @@ my $l2 = labeledEntry($htmlW, 'top', $w, "Link to gallery index page", \$config{HTMLGalleryIndex}); my $l3 = labeledEntry($htmlW, 'top', $w, "Link to homepage", \$config{HTMLHomepage}); my $l4 = labeledEntry($htmlW, 'top', $w, "HTML footer", \$config{HTMLFooter}); - my $l5 = labeledEntryButton($htmlW,'top',$w,"HTML target directory",'Set',\$config{HTMLTargetDir},1); + my $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 field."); $balloon->attach($l2, -msg => "The content of this entry will be\ninserted in the field."); $balloon->attach($l3, -msg => "The content of this entry will be\ninserted in the field."); $balloon->attach($l4, -msg => "The content of this entry will be\ninserted in the field.\nIt may contain a link to your homepage\nand your email address."); - $balloon->attach($l5, -msg => "Mapivi will save the generated\npages and pictures in this directory."); + $balloon->attach($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."); @@ -20766,7 +21431,7 @@ if (@htmlfiles >= 1) { $rc = $htmlW->messageBox(-icon => 'question', -message => scalar @htmlfiles." HTML pages should be deleted in $targetDir.\nOk, to delete?", - -title => "clean up HTML directories", + -title => "clean up HTML folders", -type => 'OKCancel'); if ($rc eq "Ok") { foreach (@htmlfiles) { @@ -20795,7 +21460,7 @@ $rc = $htmlW->messageBox(-icon => 'question', -message => scalar @toDelete." $pictures should be deleted in\n$dir\nOk, to delete?", - -title => "clean up HTML directories", + -title => "clean up HTML folders", -type => 'OKCancel'); if ($rc !~ m/Ok/i) { next; @@ -20822,21 +21487,23 @@ ############################################################## # diffList - returns a list containing all elements of list1 -# which are not in list2 +# 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 - my %d; - + + return () unless (@{$list1Ref}); + return (@{$list1Ref}) unless (@{$list2Ref}); + # build a hash - foreach (@{$list1Ref}) { - $d{$_} = 1; - } - # delete all elements, which are in list2 + my %d; + $d{$_}++ foreach (@{$list1Ref}); + + # delete all elements in hash, which are in list2 foreach (@{$list2Ref}) { - delete $d{$_}; + delete $d{$_} if (exists $d{$_}); } return (keys %d); @@ -20874,7 +21541,7 @@ # open window $ddw = $top->Toplevel(); $ddw->withdraw; - $ddw->title("Compare two directories"); + $ddw->title("Compare two folders"); $ddw->iconimage($mapiviicon) if $mapiviicon; my $f1 = $ddw->Frame(-relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3); @@ -20887,14 +21554,14 @@ my $ddlb; $ddw->Label(-textvariable => \$ddw->{label}, -anchor => 'w', -bg => $config{ColorBG})->pack(-padx => 3, -anchor => 'w'); - $ddw->{label} = 'Choose directories to compare and press the "Compare" button.'; + $ddw->{label} = 'Choose folders to compare and press the "Compare" button.'; - labeledEntryButton($f1a,'top',12,"directory A",'Set',\$config{dirDiffDirA},1); - labeledEntryButton($f1a,'top',12,"directory B",'Set',\$config{dirDiffDirB},1); + labeledEntryButton($f1a,'top',12,"folder A",'Set',\$config{dirDiffDirA},1); + labeledEntryButton($f1a,'top',12,"folder B",'Set',\$config{dirDiffDirB},1); $ddlb = $ddw->Scrolled("HList", -header => 1, - -separator => ';', # todo here we hope that ; will never be in a directory or file name + -separator => ';', # todo here we hope that ; will never be in a folder or file name -pady => 0, -columns => 12, -scrollbars => 'osoe', @@ -20941,13 +21608,13 @@ # check both dirs first foreach ($config{dirDiffDirA}, $config{dirDiffDirB}) { unless (-d $_) { - $ddw->messageBox(-icon => 'warning', -message => "Directory \"$_\" is not valid!", + $ddw->messageBox(-icon => 'warning', -message => "Folder \"$_\" is not valid!", -title => 'Error', -type => 'OK'); return; } } if ($config{dirDiffDirA} eq $config{dirDiffDirB}) { - $ddw->messageBox(-icon => 'warning', -message => "Please choose two different directories!", + $ddw->messageBox(-icon => 'warning', -message => "Please choose two different folders!", -title => 'Error', -type => 'OK'); return; } @@ -21089,7 +21756,7 @@ return unless ($ddlb->info('children')); my @sellist = $ddlb->info('selection'); return unless (@sellist); - my $rc = $ddw->messageBox(-message => "Really delete ".scalar @sellist." pictures in directory ".$config{dirDiffDirA}."?", + 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); @@ -21120,7 +21787,7 @@ return unless ($ddlb->info('children')); my @sellist = $ddlb->info('selection'); return unless (@sellist); - my $rc = $ddw->messageBox(-message => "Really delete ".scalar @sellist." pictures in directory ".$config{dirDiffDirB}."?", + 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); @@ -21356,7 +22023,7 @@ } ############################################################## -# buildDatabase - scans through all subdirectories of +# 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 @@ -21364,9 +22031,9 @@ sub buildDatabase { my $mydir = getRightDir(); - my $rc = checkDialog( 'Add pictures to database in all sub directories', - 'MaPiVi will create a list of all sub directories of directory "'.basename($mydir).'" containing JPEG files. -You are then able to select directories from the list.', + my $rc = checkDialog( 'Add pictures to database in all sub folders', + 'MaPiVi will create a list of all sub folders of folder "'.basename($mydir).'" containing JPEG files. +You are then able to select folders from the list.', \$config{SearchDBOnlyNew}, "add only new pictures", "", @@ -21376,18 +22043,16 @@ my $tmp = $config{CheckForNonJPEGs}; # save the option to a temp variable $config{CheckForNonJPEGs} = 0; # switch the option off - $userinfo = "searching sub directories ..."; $userInfoL->update; + $userinfo = "searching sub folders ..."; $userInfoL->update; my @dirlist; my %nr_of_pics_in_dir; my @pictestlist; my $pic_count = 0; - my $pw = progressWinInit($top, "Collect sub directories"); - my $i = 0; + my $pw = progressWinInit($top, "Collect sub folders"); my $break = 0; find(sub { if (progressWinCheck($pw)) { $break = 1; $File::Find::prune = 1; } - $i++; $i = 0 if ($i > 10); - progressWinUpdate($pw, "collecting directories, found ".scalar @dirlist." ...", $i, 10); + progressWinUpdate($pw, "collecting folders, found ".scalar @dirlist." ...", 0, 0); # search in dirs, but not in .thumbs/ .xvpics/ etc. if (-d and ($_ ne $thumbdirname) and ($_ ne ".xvpics") and ($_ ne $exifdirname)) { @pictestlist = getPics($File::Find::name, JUST_FILE); # no sorting needed @@ -21395,25 +22060,26 @@ $pic_count += scalar @pictestlist; $nr_of_pics_in_dir{$File::Find::name} = scalar @pictestlist; push @dirlist, $File::Find::name; - $userinfo = "found ".scalar @dirlist." sub directories ..."; $userInfoL->update; + $userinfo = "found ".scalar @dirlist." sub folders ..."; $userInfoL->update; } } }, $mydir); progressWinEnd($pw); if ($break) { - $userinfo = "user break while counting directories"; + $userinfo = "user break while counting folders"; return; } $config{CheckForNonJPEGs} = $tmp; # restore the option - $userinfo = "found ".@dirlist." sub directories with $pic_count JPEGs"; $userInfoL->update; + $userinfo = "found ".@dirlist." sub folders with $pic_count JPEGs"; $userInfoL->update; @dirlist = sort @dirlist; my @sellist; - return if (!mySelListBoxDialog("Select directories", - "Found ".scalar @dirlist." directories with $pic_count JPEG pictures.\nThe database will be updated with the pictures of the selected directories.", + return if (!mySelListBoxDialog("Select folders", + "Found ".scalar @dirlist." folders with $pic_count JPEG pictures.\nThe database will be updated with the pictures of the selected folders.", + MULTIPLE, "add to database", \@sellist, @dirlist)); # copy the selected elements into the @sel_dirs list @@ -21430,7 +22096,7 @@ $config{CheckForNonJPEGs} = 0; # switch the option off $pw = progressWinInit($top, "building search database"); - $i = 0; + my $i = 0; my $new = 0; foreach $dir (@sel_dirs) { last if progressWinCheck($pw); @@ -21442,8 +22108,7 @@ foreach (@dpics) { last if progressWinCheck($pw); $i++; - # todo $pic_count is not correct if not all directories have been selected - progressWinUpdate($pw, "adding picture ($i/$pic_count) in directory $dirshort", $i, $pic_count); + progressWinUpdate($pw, "adding picture ($i/$pic_count) in folder $dirshort", $i, $pic_count); next if ($config{SearchDBOnlyNew} and exists $searchDB{$_}); addToSearchDB($_); $new++; @@ -21490,7 +22155,7 @@ 1 ); return if ($rc ne 'OK'); - store(\%ignorePaths, "$configdir/ignorePaths") or warn "could not store ignorePaths"; + nstore(\%ignorePaths, "$configdir/ignorePaths") or warn "could not store ignorePaths"; $userinfo = "cleaning database - please wait ..."; $userInfoL->update; my $pw = progressWinInit($top, "cleaning search database"); @@ -21547,7 +22212,7 @@ ############################################################## -# cleanDatabaseFolder - clean the database in one directory +# cleanDatabaseFolder - clean the database in one folder ############################################################## sub cleanDatabaseFolder { my $directory = shift; @@ -21689,20 +22354,20 @@ 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); + my $pw = progressWinInit($top, "Calculating statistic (chronological distribution)"); + foreach my $dpic (keys %searchDB) { + last if progressWinCheck($pw); + $i++; + progressWinUpdate($pw, "adding picture ($i/$keys) ...", $i, $keys); if ($searchDB{$dpic}{TIME}) { - my ($s,$m,$h,$d,$mo,$y) = localtime $searchDB{$dpic}{TIME}; - $y += 1900; $mo++; # do some adjustments - my $key = sprintf "%04d%02d", $y, $mo; # key = yyyymm - $chrono_hash{$key}++; - $pic_count++; + my ($s,$m,$h,$d,$mo,$y) = localtime $searchDB{$dpic}{TIME}; + $y += 1900; $mo++; # do some adjustments + my $key = sprintf "%04d%02d", $y, $mo; # key = yyyymm + $chrono_hash{$key}++; + $pic_count++; } else { - $error_count++; + $error_count++; } } progressWinEnd($pw); @@ -21999,7 +22664,7 @@ @search_keys = (); $label = ''; show_keywords($win, \@search_keys, \@exclude_keys); - })->pack(-side => 'left'); + })->pack(-side => 'left', -padx => 3); $balloon->attach($hb, -msg => "Restart\nShow all keywords"); my $bb = $butF->Button(-text => 'back', @@ -22010,7 +22675,7 @@ $label = ''; $label .= "$_ " foreach (@search_keys); show_keywords($win, \@search_keys, \@exclude_keys); - })->pack(-side => 'left'); + })->pack(-side => 'left', -padx => 3); $balloon->attach($bb, -msg => "Go back\nRemove last keyword from list"); $butF->Label(-textvariable => \$label, @@ -22020,7 +22685,7 @@ and the search is narrowed to pictures containing all displayed keywords. If add mode is disabled, each click on a keyword -will start a new search for this keyword.'); +will start a new search for just this keyword.'); my $Xbut = $butF->Button(-text => 'Close', -command => sub { @@ -22029,7 +22694,7 @@ $config{KeywordExclude} .= "$_ " foreach (@exclude_keys); # clode window $win->destroy(); - })->pack(-side => 'right'); + })->pack(-side => 'right', -padx => 3); $balloon->attach($Xbut, -msg => 'Close window (key: ESC)'); $win->bind('', sub { $Xbut->invoke; }); $win->bind('', sub { $Xbut->invoke; }); @@ -22038,14 +22703,14 @@ -command => sub { my @list = get_pics_with_keywords(\@search_keys, \@exclude_keys); showThumbList(\@list, $label); - })->pack(-side => 'left'); + })->pack(-side => 'left', -padx => 3); my $lab2 = $butF2->Label(-textvariable => \$win->{label2}, - )->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 1, -pady => 1); + )->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 3, -pady => 1); $balloon->attach($lab2, -msg => "x pictures\nx = number of pictures with the selected keywords\ny/z keywords\n = number of displayed keywords\nz = number of all matching keywords"); my $more_button; $more_button = $butF2->Checkbutton(-variable => \$config{KeywordMore}, - -text => 'more', + -text => 'more options', -command => sub { if ($config{KeywordMore}) { $butF3->pack(-after => $butF2, -expand => 0, -fill => 'x', -padx => 4, -pady => 3); @@ -22062,20 +22727,114 @@ @exclude_keys = (); $label_ex = ''; show_keywords($win, \@search_keys, \@exclude_keys); - })->pack(-side => 'left'); + })->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'); + )->pack(-anchor => 'w', -padx => 3); $balloon->attach($lib, -msg => 'Limit to a maximum of the 100 most popular keywords.'); - $butF3->Label(-text => 'Right click to select a keyword, left click to exclude it')->pack(-anchor => 'w'); - $cc = $win->Scrolled('Canvas', + my $butF3j = $butF3->Frame()->pack(-fill =>'x', -padx => 0, -pady => 0); + my $dab = $butF3j->Checkbutton(-variable => \$config{KeywordDate}, + -text => 'Limit by date between ', + -command => sub {show_keywords($win, \@search_keys, \@exclude_keys);} + )->pack(-side => 'left', -anchor => 'sw', -pady => 0); + $balloon->attach($dab, -msg => "Limit to a date range.\nThe first scale is the first day of the selected year\nthe second scale is the last day of the selected year.\nIf both scales show e.g. 2008 only keywords from pictures taken\nbetween 2008-01-01 and 2008-12-31 are shown.\nThe EXIF date is used for this function."); + + my ($first, $last) = get_date_limits(); + + my (undef,undef,undef,undef,undef,$start) = localtime $config{KeywordStart}; + $start += 1900; + my (undef,undef,undef,undef,undef,$end) = localtime $config{KeywordEnd}; + $end += 1900; + + $butF3j->Scale(-variable => \$start, + -from => $first, + -to => $last, + -resolution => 1, + -sliderlength => 20, + -orient => 'horizontal', + -showvalue => 1, + -width => 15, + -command => sub { + $end = $start if ($end < $start); + $win->{LAST_RESCALE_TIMER_MH}->cancel if ($win->{LAST_RESCALE_TIMER_MH}); + # after 500 msec we recalculate the keywords this gives better responsiveness + $win->{LAST_RESCALE_TIMER_MH} = $win->after(500, sub { + # sec,min,hour,day,mon,year (day = 1-31 month = 0-11) + $config{KeywordStart} = timelocal(0,0,0,1,0,$start); + $config{KeywordEnd} = timelocal(0,0,0,31,11,$end); + show_keywords($win, \@search_keys, \@exclude_keys) if $config{KeywordDate}; + }); + })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 0); + $butF3j->Scale(-variable => \$end, + -from => $first, + -to => $last, + -resolution => 1, + -sliderlength => 30, + -orient => 'horizontal', + -showvalue => 1, + -width => 15, + -command => sub { + $start = $end if ($start > $end); + $win->{LAST_RESCALE_TIMER_MH}->cancel if ($win->{LAST_RESCALE_TIMER_MH}); + # after 500 msec we recalculate the keywords this gives better responsiveness + $win->{LAST_RESCALE_TIMER_MH} = $win->after(500, sub { + # sec,min,hour,day,mon,year (day = 1-31 month = 0-11) + $config{KeywordStart} = timelocal(0,0,0,1,0,$start); + $config{KeywordEnd} = timelocal(0,0,0,31,11,$end); + show_keywords($win, \@search_keys, \@exclude_keys) if $config{KeywordDate}; + }); + })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 0); + + my $butF3k = $butF3->Frame()->pack(-fill =>'x', -padx => 0, -pady => 0); + my $rab = $butF3k->Checkbutton(-variable => \$config{KeywordRating}, + -text => 'Limit by rating between', + -command => sub {show_keywords($win, \@search_keys, \@exclude_keys);} + )->pack(-side => 'left', -anchor => 'sw', -pady => 3); + $balloon->attach($rab, -msg => "Limit to a rating range.\nIf the first scale shows e.g. 2 and the second scale shows 4\nonly keywords from pictures with a rating of 2, 3 or 4 are shown.\nThe IPTC urgency is used for this function.\nNote: 1 is the highest (best) rating, 8 the lowest."); + + $butF3k->Scale(-variable => \$config{KeywordRatingA}, + -from => 1, + -to => 8, + -resolution => 1, + -sliderlength => 20, + -orient => 'horizontal', + -showvalue => 1, + -width => 15, + -command => sub { + $config{KeywordRatingB} = $config{KeywordRatingA} if ($config{KeywordRatingB} < $config{KeywordRatingA}); + $win->{LAST_RESCALE_TIMER_MH}->cancel if ($win->{LAST_RESCALE_TIMER_MH}); + # after 500 msec we recalculate the keywords this gives better responsiveness + $win->{LAST_RESCALE_TIMER_MH} = $win->after(500, sub { + show_keywords($win, \@search_keys, \@exclude_keys) if $config{KeywordRating}; + }); + })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 0); + $butF3k->Scale(-variable => \$config{KeywordRatingB}, + -from => 1, + -to => 8, + -resolution => 1, + -sliderlength => 30, + -orient => 'horizontal', + -showvalue => 1, + -width => 15, + -command => sub { + $config{KeywordRatingA} = $config{KeywordRatingB} if ($config{KeywordRatingA} > $config{KeywordRatingB}); + $win->{LAST_RESCALE_TIMER_MH}->cancel if ($win->{LAST_RESCALE_TIMER_MH}); + # after 500 msec we recalculate the keywords this gives better responsiveness + $win->{LAST_RESCALE_TIMER_MH} = $win->after(500, sub { + show_keywords($win, \@search_keys, \@exclude_keys) if $config{KeywordRating}; + }); + })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 0); + + $cc = $win->Scrolled('Canvas', -scrollbars => 'osoe', -width => 700, -height => 400, @@ -22127,6 +22886,26 @@ } ############################################################## +# get_date_limits - get the first and the last year from database +############################################################## +sub get_date_limits { + my $first = 99999999999; + my $last = 0; + foreach my $dpic (keys %searchDB) { + if ($searchDB{$dpic}{TIME}) { + $last = $searchDB{$dpic}{TIME} if ($searchDB{$dpic}{TIME} > $last); + $first = $searchDB{$dpic}{TIME} if ($searchDB{$dpic}{TIME} < $first); + } + } + # from UNIX time to calendar years + (undef,undef,undef,undef,undef,$last) = localtime $last; + $last += 1900; + (undef,undef,undef,undef,undef,$first) = localtime $first; + $first += 1900; + return ($first, $last); +} + +############################################################## # show_keywords - add keyword cloud to a canvas ############################################################## sub show_keywords { @@ -22166,65 +22945,72 @@ $win->{label2} = "$count pictures (".keys(%keyword_hash)."/$all_keys keywords)"; - # find max an min numbers - my $min = 10000; my $max = 0; - foreach (keys %keyword_hash) { - $min = $keyword_hash{$_} if ($keyword_hash{$_} < $min); - $max = $keyword_hash{$_} if ($keyword_hash{$_} > $max); - } - - # to have a nice size distribution we need the log function - my $diff = 1; - $diff = log($max - $min) if ($max != $min); - #print "max $max min $min diff $diff\n"; - - # maximum and minimum font size for tag cloud - my $font_min = 9; - my $font_max = 20; - my $font_middle = int(($font_max-$font_min)/2 + $font_min); - - # h and v space between tags/keywords - my $x_space = 5; - my $y_space = 3; - - my $x_max = 0; - my $x = $x_space; - my $y = $y_space + int($font_max/2); - # sort keywords alphabetical - foreach my $key (sort keys %keyword_hash) { - my $size = $font_middle; - + 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 - $size = int(log($keyword_hash{$key} - $min + 1)/$diff * ($font_max-$font_min) + $font_min) if ($max != $min); - #printf "%-20s %5d %2.2f size: %2d", $key, $keyword_hash{$key}, log($keyword_hash{$key})/$diff, $size; - # safety check - $size = $font_max if ($size > $font_max); - $size = $font_min if ($size < $font_min); - #print " $size\n"; - - # bold style for the bigger fonts - my $style = 'normal'; - $style = 'bold' if ($size >= $font_middle); - my $font = $top->Font(-family => $config{FontFamily}, -size => $size, -weight => $style); - - # the more often a keyword is used there brighter it is displayed - my $color_percent = 100; - $color_percent = int(log($keyword_hash{$key} - $min + 1)/$diff * 100) if ($max != $min); - my $color = $win->Darken('blue', $color_percent); - - # add the keyword (tag) to the canvas - my $id = $cc->createText($x, $y, -text => $key, -fill => $color, -font => $font, -anchor => 'w', -tags => [$key]); - - # get the needed canvas space - my ($x1, $y1, $x2, $y2) = $cc->bbox($id); - - # calculate next coordinates - $x += ($x2 - $x1) + $x_space; - if ($x > 600) { $x_max = $x if ($x > $x_max); $x = $x_space; $y += ($font_max + $y_space); } - } - - # adjust the canvas scrollbars to the used space - $cc->configure(-scrollregion => [0, 0, $x_max, ($y + int($font_max/2) + $y_space)]); + my $diff = 1; + $diff = log($max - $min) if ($max != $min); # log(1) = 0! log(0) = -infinite + #print "max $max min $min diff $diff\n"; + $diff = 0.1 if ($diff == 0); # prevent division by zero + + # maximum and minimum font size for tag cloud + my $font_min = 9; + my $font_max = 20; + my $font_middle = int(($font_max-$font_min)/2 + $font_min); + + # h and v space between tags/keywords + my $x_space = 5; + my $y_space = 3; + + my $x_max = 0; + my $x = $x_space; + my $y = $y_space + int($font_max/2); + # sort keywords alphabetical + foreach my $key (sort keys %keyword_hash) { + my $size = $font_middle; + + # to have a nice size distribution we need the log function + $size = int(log($keyword_hash{$key} - $min + 1)/$diff * ($font_max-$font_min) + $font_min) if ($max != $min); + #printf "%-20s %5d %2.2f size: %2d", $key, $keyword_hash{$key}, log($keyword_hash{$key})/$diff, $size; + # safety check + $size = $font_max if ($size > $font_max); + $size = $font_min if ($size < $font_min); + #print " $size\n"; + + # bold style for the bigger fonts + my $style = 'normal'; + $style = 'bold' if ($size >= $font_middle); + my $font = $top->Font(-family => $config{PropFontFamily}, -size => $size, -weight => $style); + + # the more often a keyword is used there brighter it is displayed + my $color_percent = 100; + $color_percent = int(log($keyword_hash{$key} - $min + 1)/$diff * 100) if ($max != $min); + my $color = $win->Darken('blue', $color_percent); + + # add the keyword (tag) to the canvas + my $id = $cc->createText($x, $y, -text => $key, -fill => $color, -font => $font, -anchor => 'w', -tags => [$key]); + + # get the needed canvas space + my ($x1, $y1, $x2, $y2) = $cc->bbox($id); + + # calculate next coordinates + $x += ($x2 - $x1) + $x_space; + # todo: replace 600 by windo width + if ($x > 600) { $x_max = $x if ($x > $x_max); $x = $x_space; $y += ($font_max + $y_space); } + } + # adjust the canvas scrollbars to the used space + $cc->configure(-scrollregion => [0, 0, $x_max, ($y + int($font_max/2) + $y_space)]); + } + else { + # adjust the canvas scrollbars to the used space + $cc->configure(-scrollregion => [0, 0, 0, 0]); + } $win->Unbusy; } @@ -22233,17 +23019,31 @@ # get_keywords - get all keywords from the searchDB (may be restriced by a keyword list ($search_keys)) ############################################################## sub get_keywords { - my $search_keys = shift; # list reference for keywords which must be contained - my $exclude_keys = shift; # list reference for keywords which must not be contained + my $search_keys = shift; # list reference for included keywords + my $exclude_keys = shift; # list reference for excluded keywords my %keyword_hash; my $count = 0; + #my $start_date = timelocal(0,0,0,1,11,2003); # sec,min,hour,day,mon,year (day = 1-31 month = 0-11) + #my $end_date = timelocal(0,0,0,1,11,2004); # sec,min,hour,day,mon,year (day = 1-31 month = 0-11) + # build keyword/tag hash #stopWatchStart(); # loop through all pictures in the DB foreach my $dpic (keys %searchDB) { # skip if no keywords info in picture next unless (defined $searchDB{$dpic}{KEYS}); + + if ($config{KeywordDate}) { + next if (defined $searchDB{$dpic}{TIME} and ($searchDB{$dpic}{TIME} < $config{KeywordStart})); + next if (defined $searchDB{$dpic}{TIME} and ($searchDB{$dpic}{TIME} > $config{KeywordEnd})); + } + + if ($config{KeywordRating}) { + next unless (defined $searchDB{$dpic}{URG}); # ignore pictures withour rating/urgency + next if (defined $searchDB{$dpic}{URG} and ($searchDB{$dpic}{URG} < $config{KeywordRatingA})); + next if (defined $searchDB{$dpic}{URG} and ($searchDB{$dpic}{URG} > $config{KeywordRatingB})); + } # check if any items of the exclude_keys list are contained in this keyword string my $wrong = 0; @@ -22267,7 +23067,7 @@ # 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 + # 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 @@ -22291,89 +23091,389 @@ } ############################################################## -# get_pics_with_keywords - returns a list of pictures with the -# given keywords (source: searchDB) +# search_by_location ############################################################## -sub get_pics_with_keywords { - - my $search_keys = shift; # list reference - my $exclude_keys = shift; # list reference for keywords which must not be contained - my @pic_list; - - # build keyword/tag hash - #stopWatchStart(); - foreach my $dpic (keys %searchDB) { - # skip if no keywords in picture - next unless (defined $searchDB{$dpic}{KEYS}); - - # check if any items of the exclude_keys list are contained in this keyword string - my $wrong = 0; - foreach (@{$exclude_keys}) { - $wrong++ if ($searchDB{$dpic}{KEYS} =~ m/$_/); - last if ($wrong > 0); - } - next if ($wrong > 0); +sub search_by_location { - # check if all items of the search_keys list are contained in this keyword string - $wrong = 0; - foreach (@{$search_keys}) { - $wrong++ unless ($searchDB{$dpic}{KEYS} =~ m/$_/); - last if ($wrong > 0); - } - next if ($wrong > 0); - - # collect matching pics in a list - push @pic_list, $dpic; + if (Exists($locw)) { + $locw->deiconify; + $locw->raise; + $locw->focus; + return; } - #stopWatchStop('collecting pics'); - #print "done\nFound ".scalar @pic_list." pictures\n"; - - return @pic_list; -} - -############################################################## -# editDatabase -############################################################## -sub editDatabase { - - my $buttext = "Remove picture(s) from database"; - my $text = "This list shows all pictures of the search database.\nYou may select any number of pictures and remove them with the \"$buttext\" button.\nThe pictures won't be deleted, only the entry in the database is removed.\nIt's recommended to call the function \"clean database\" first, because it will remove all invalid entries for you."; - - my $rc; - + my $lb = shift; # thumbnail widget e.g. $picLB + # open window - my $ew = $top->Toplevel(); - $ew->title("Edit search database"); - $ew->iconimage($mapiviicon) if $mapiviicon; + $locw = $top->Toplevel(); + $locw->withdraw; + $locw->title('Locations'); + $locw->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", + + my $locXBut = $locw->Button(-text => "Close", + -command => sub { + $config{LocGeometry} = $locw->geometry; + $locw->destroy; + })->pack(-fill => 'x'); + + my $rotext = $locw->Scrolled("ROText", -scrollbars => 'osoe', -wrap => 'word', - -tabs => '4', - -width => 110, - -height => $height, - -relief => "flat", - -bg => $config{ColorBG}, - -bd => "0" - )->pack(-expand => "0", -padx => 3, -pady => 3,-anchor => 'w'); - $rotext->insert('end', $text); + -width => 40, + -height => 4, + -relief => 'flat', + -bd => 0 + )->pack(-expand => 0, -fill => 'x', -padx => 3, -pady => 3); + $rotext->insert('end', "Information:\nDouble click on any location to see pictures.\nThe location information is gathered from the IPTC tags Country, Province/State, City and SubLocation"); + + my $tree; + my $af = $locw->Frame()->pack(-fill =>'x', -padx => 2, -pady => 1); + my $add_but = $af->Button(-text => 'Add', + -command => sub { + my @locs = $tree->info('selection'); + return unless checkSelection($locw, 1, 1, \@locs, 'location'); + my @loc = split(/%/, $locs[0]); + my @sellist = getSelection($lb); + return unless checkSelection($locw, 1, 0, \@sellist, 'picture'); + my $pics_with_location = check_locations(\@sellist); + if ($pics_with_location > 0) { + my $rc = $locw->messageBox(-message => "$pics_with_location of the ".scalar @sellist." selected pictures have a location info. This information will be overwritten. Please press Ok to continue.", + -icon => 'question', -title => "Ovewrwrite location?", -type => 'OKCancel'); + return if ($rc !~ m/Ok/i); + } + my $location; + $location .= "$_ " foreach (@loc); + $userinfo = "adding ${location}to ".scalar @sellist." pictures ..."; $userInfoL->update; + my $errors = ''; + my $count = 0; + # add location info to selected pictures + foreach my $dpic (@sellist) { + my $meta = getMetaData($dpic, 'APP13'); + my $iptc = $meta->get_app13_data('TEXTUAL', 'IPTC'); + if ($iptc->{error}) { + #warn "IPTC segment of $file has errors!"; + $errors .= "$dpic: IPTC segment has errors!\n"; + } + else { + if (defined $loc[0] and $loc[0] ne '[empty]') { + $iptc->{'Country/PrimaryLocationName'} = $loc[0]; + } else { + undef $iptc->{'Country/PrimaryLocationName'}; + } + if (defined $loc[1] and $loc[1] ne '[empty]') { + $iptc->{'Province/State'} = $loc[1]; + } else { + undef $iptc->{'Province/State'}; + } + if (defined $loc[2] and $loc[2] ne '[empty]') { + $iptc->{'City'} = $loc[2]; + } else { + undef $iptc->{'City'}; + } + if (defined $loc[3] and $loc[3] ne '[empty]') { + $iptc->{'SubLocation'} = $loc[3]; + } else { + undef $iptc->{'SubLocation'}; + } + $meta->set_app13_data($iptc, $config{LocationMode}, 'IPTC'); + if (!$meta->save()) { + $errors .= "$dpic: writing of location failed!\n"; + } + else { + updateOneRow($dpic, $lb); + showImageInfoCanvas($dpic) if ($dpic eq $actpic); + $count++; + } + } + } + $userinfo = "added ${location}to $count of ".scalar @sellist." pictures."; $userInfoL->update; + + if ($errors ne '') { + $errors = "These errors occured while adding the location info to ".scalar @sellist." pictures.\n\n$errors"; + showText("Errors while adding location", $errors, NO_WAIT); + } + })->pack(-side => 'left'); + $balloon->attach($add_but, -msg => "Add selected location to all selected pictures.\nMapivi will ask before overwriting existing location information."); + + $af->Radiobutton(-text => 'Update', -variable => \$config{LocationMode}, -value => 'UPDATE')->pack(-side => 'left'); + $af->Radiobutton(-text => 'Replace', -variable => \$config{LocationMode}, -value => 'REPLACE')->pack(-side => 'left'); + $balloon->attach($af, -msg => "In Update mode non-selected location info won't be overwritten.\nIn Replace mode all four locations (Country/State/City/Sublocation)\nwill be overwritten.\nExample: If you select just a country (USA) and add this location\nto a picture with existing location (e.g. City = New York)\nIn Update mode the City information will be preserved\nwhile in Replace mode City will be deleted"); - my $size = getFileSize("$configdir/SearchDataBase", FORMAT); - my $keys = keys %searchDB; - my $info = "$keys entries in the database (file size: $size)"; - my $listBoxY = $keys; - $listBoxY = 25 if ($listBoxY > 25); # not higher than 30 entries + $tree = $locw->Scrolled('Tree', + -separator => '%', + -scrollbars => 'osoe', + -selectmode => 'extended', + -exportselection => 0, + -width => 25, + -height => 25, + )->pack(-expand => 1, -fill =>'both', -padx => 1, -pady => 1); + #$locw->{tree} = $tree; - my $listBox = - $ew->Scrolled('Listbox', - -scrollbars => 'osoe', - -selectmode => 'extended', - -exportselection => 0, - #-width => 80, + bindMouseWheel($tree->Subwidget("scrolled")); + #$balloon->attach($tree, -msg => "Double click on a location to see pictures from there."); + + # get all location info from the database (IPTC tags: country, state, city and sublocation) + $top->Busy; + $userinfo = "getting locations from database ..."; $userInfoL->update; + my %loc_hash = get_locations(); + $userinfo = "ready!"; $userInfoL->update; + $top->Unbusy; + + $tree->bind("", sub { + my @locs = $tree->info('selection'); + return unless checkSelection($locw, 1, 0, \@locs); + my @loc = split(/%/, $locs[0]); + my @list; + my $nr_of_locations = @loc; + if ($nr_of_locations == 1) { + foreach my $state (sort keys %{$loc_hash{$loc[0]}}) { + foreach my $city (sort keys %{$loc_hash{$loc[0]}{$state}}) { + foreach my $subloc (sort keys %{$loc_hash{$loc[0]}{$state}{$city}}) { + push @list, sort keys %{$loc_hash{$loc[0]}{$state}{$city}{$subloc}}; + } + } + } + } + elsif ($nr_of_locations == 2) { + foreach my $city (sort keys %{$loc_hash{$loc[0]}{$loc[1]}}) { + foreach my $subloc (sort keys %{$loc_hash{$loc[0]}{$loc[1]}{$city}}) { + push @list, sort keys %{$loc_hash{$loc[0]}{$loc[1]}{$city}{$subloc}}; + } + } + } + elsif ($nr_of_locations == 3) { + foreach my $subloc (sort keys %{$loc_hash{$loc[0]}{$loc[1]}{$loc[2]}}) { + push @list, sort keys %{$loc_hash{$loc[0]}{$loc[1]}{$loc[2]}{$subloc}}; + } + } + elsif ($nr_of_locations == 4) { + @list = sort keys %{$loc_hash{$loc[0]}{$loc[1]}{$loc[2]}{$loc[3]}}; + } + else { + warn "Wrong number of locations: $nr_of_locations"; + return; + } + my $title = 'Location: '; + $title .= "$_ " foreach (@loc); + showThumbList(\@list, $title); + }); + + #addTreeMenu($keytree, \@prekeys); + + # insert the hash in the tree + foreach my $country (sort keys %loc_hash) { + my $pics = 0; + foreach my $state (sort keys %{$loc_hash{$country}}) { + foreach my $city (sort keys %{$loc_hash{$country}{$state}}) { + foreach my $subloc (sort keys %{$loc_hash{$country}{$state}{$city}}) { + $pics += keys %{$loc_hash{$country}{$state}{$city}{$subloc}}; + } + } + } + $tree->add($country, -text => "$country [$pics]"); + foreach my $state (sort keys %{$loc_hash{$country}}) { + my $pics = 0; + foreach my $city (sort keys %{$loc_hash{$country}{$state}}) { + foreach my $subloc (sort keys %{$loc_hash{$country}{$state}{$city}}) { + $pics += keys %{$loc_hash{$country}{$state}{$city}{$subloc}}; + } + } + $tree->add("$country%$state", -text => "$state [$pics]"); + foreach my $city (sort keys %{$loc_hash{$country}{$state}}) { + my $pics = 0; + foreach my $subloc (sort keys %{$loc_hash{$country}{$state}{$city}}) { + $pics += keys %{$loc_hash{$country}{$state}{$city}{$subloc}}; + } + $tree->add("$country%$state%$city", -text => "$city [$pics]"); + foreach my $subloc (sort keys %{$loc_hash{$country}{$state}{$city}}) { + my $pics = keys %{$loc_hash{$country}{$state}{$city}{$subloc}}; + $tree->add("$country%$state%$city%$subloc", -text => "$subloc [$pics]"); + } + } + } + } + + # add plus/minus buttons to colapse tree + $tree->autosetmode; + + # close tree for the first 4 levels + foreach ($tree->info('children')) { + $tree->close($_); + foreach ($tree->info('children', $_)) { + $tree->close($_); + foreach ($tree->info('children', $_)) { + $tree->close($_); + foreach ($tree->info('children', $_)) { + $tree->close($_); + } + } + } + } + + $locw->bind('', sub { $locXBut->invoke; }); + $locw->bind('', sub { $locXBut->invoke; }); + # invoke $but when the window is closed by the window manager (x-button) + $locw->protocol("WM_DELETE_WINDOW" => sub { $locXBut->invoke; }); + + $locw->Popup; + checkGeometry(\$config{LocGeometry}); + $locw->geometry($config{LocGeometry}); + $locw->waitWindow; +} + +############################################################## +# get_locations - get all locations from the searchDB as hash +############################################################## +sub get_locations { + my %location_hash; + + # build location hash + # loop through all pictures in the DB + foreach my $dpic (keys %searchDB) { + + my $country = '[empty]'; + my $state = '[empty]'; + my $city = '[empty]'; + my $subloc = '[empty]'; + + if (defined $searchDB{$dpic}{IPTC}) { + my $iptc = $searchDB{$dpic}{IPTC}; + if ($iptc =~ m|Country\.: (.*)\n|) { + $country = $1; + } + if ($iptc =~ m|Provinc\.: (.*)\n|) { + $state = $1; + } + if ($iptc =~ m|City\s*: (.*)\n|) { + $city = $1; + } + if ($iptc =~ m|SubLoca\.: (.*)\n|) { + $subloc = $1; + } + } + $location_hash{$country}{$state}{$city}{$subloc}{$dpic}++; + } + + return %location_hash; +} + +############################################################## +# check_locations - check if the given list of pictures has any location info +# returns the number of pictures with locations +############################################################## +sub check_locations { + my $pic_list = shift; # list reference + + my $count = 0; + # loop through all pictures of the list + foreach my $dpic (@$pic_list) { + if (defined $searchDB{$dpic}{IPTC}) { + my $iptc = $searchDB{$dpic}{IPTC}; + if (($iptc =~ m|Country\.:.*\n|) or ($iptc =~ m|Provinc\.:.*\n|) or ($iptc =~ m|City\s*:.*\n|) or ($iptc =~ m|SubLoca\.:.*\n|)) { + $count++; + } + } + } + return $count; +} + +############################################################## +# get_pics_with_keywords - returns a list of pictures with the +# given keywords (source: searchDB) +############################################################## +sub get_pics_with_keywords { + + my $search_keys = shift; # list reference + my $exclude_keys = shift; # list reference for keywords which must not be contained + my @pic_list; + + # build keyword/tag hash + #stopWatchStart(); + foreach my $dpic (keys %searchDB) { + # skip if no keywords in picture + next unless (defined $searchDB{$dpic}{KEYS}); + + if ($config{KeywordDate}) { + next if (defined $searchDB{$dpic}{TIME} and ($searchDB{$dpic}{TIME} < $config{KeywordStart})); + next if (defined $searchDB{$dpic}{TIME} and ($searchDB{$dpic}{TIME} > $config{KeywordEnd})); + } + + if ($config{KeywordRating}) { + next unless (defined $searchDB{$dpic}{URG}); # ignore pictures withour rating/urgency + next if (defined $searchDB{$dpic}{URG} and ($searchDB{$dpic}{URG} < $config{KeywordRatingA})); + next if (defined $searchDB{$dpic}{URG} and ($searchDB{$dpic}{URG} > $config{KeywordRatingB})); + } + + # check if any items of the exclude_keys list are contained in this keyword string + my $wrong = 0; + foreach (@{$exclude_keys}) { + $wrong++ if ($searchDB{$dpic}{KEYS} =~ m/$_/); + last if ($wrong > 0); + } + next if ($wrong > 0); + + # check if all items of the search_keys list are contained in this keyword string + $wrong = 0; + foreach (@{$search_keys}) { + $wrong++ unless ($searchDB{$dpic}{KEYS} =~ m/$_/); + last if ($wrong > 0); + } + next if ($wrong > 0); + + # collect matching pics in a list + push @pic_list, $dpic; + } + + #stopWatchStop('collecting pics'); + #print "done\nFound ".scalar @pic_list." pictures\n"; + + return @pic_list; +} + +############################################################## +# editDatabase +############################################################## +sub editDatabase { + + my $buttext = "Remove picture(s) from database"; + my $text = "This list shows all pictures of the search database.\nYou may select any number of pictures and remove them with the \"$buttext\" button.\nThe pictures won't be deleted, only the entry in the database is removed.\nIt's recommended to call the function \"clean database\" first, because it will remove all invalid entries for you."; + + my $rc; + + # open window + my $ew = $top->Toplevel(); + $ew->title("Edit search database"); + $ew->iconimage($mapiviicon) if $mapiviicon; + + my $height = ($text =~ tr/\n//); + $height += 2; + $height = 10 if ($height > 10); # not to big, we have scrollbars + my $rotext = $ew->Scrolled("ROText", + -scrollbars => 'osoe', + -wrap => 'word', + -tabs => '4', + -width => 110, + -height => $height, + -relief => "flat", + -bg => $config{ColorBG}, + -bd => "0" + )->pack(-expand => "0", -padx => 3, -pady => 3,-anchor => 'w'); + $rotext->insert('end', $text); + + my $size = getFileSize("$configdir/SearchDataBase", FORMAT); + my $keys = keys %searchDB; + my ($first, $last) = get_date_limits(); + my $info = "$keys pictures in the database between the years $first and $last (file size: $size)"; + my $listBoxY = $keys; + $listBoxY = 25 if ($listBoxY > 25); # not higher than 30 entries + + my $listBox = + $ew->Scrolled('Listbox', + -scrollbars => 'osoe', + -selectmode => 'extended', + -exportselection => 0, + #-width => 80, -height => $listBoxY, )->pack(-expand => 1, -fill =>'both', -padx => 3, -pady => 3); bindMouseWheel($listBox); @@ -22447,29 +23547,34 @@ ############################################################## # checkDatabase - check the comment and iptc fields of all -# database entries for problematic chars +# database entries for problematic (non-ASCII) chars # will e.g. complain about the copyright sign ############################################################## sub checkDatabase { - my ($com, $iptc, $text); + my ($com, $iptc, $keys, $text); my $i = 0; foreach my $dpic (sort keys %searchDB) { $i++; $com = $searchDB{$dpic}{COM}; $iptc = $searchDB{$dpic}{IPTC}; + $keys = $searchDB{$dpic}{KEYS}; + + if ((defined $com) and ($com =~ m/[^\x00-\x7f]/)) { + $text .= "comment of $dpic\n"; + } - if ($com =~ m/[^\x00-\x7f]/) { - $text .= "comment of $dpic\n"; + if ((defined $iptc) and ($iptc =~ m/[^\x00-\x7f]/)) { + $text .= "IPTC of $dpic\n"; } - if ($iptc =~ m/[^\x00-\x7f]/) { - $text .= "IPTC of $dpic\n"; + if ((defined $keys) and ($keys =~ m/[^\x00-\x7f]/)) { + $text .= "IPTC keyword of $dpic\n"; } } - $text = "Check finished.\nFound these problematic chars in $i pictures:\n\n$text"; + $text = "Check finished.\nFound these problematic (non-ASCII) chars in $i pictures:\n\n$text"; showText("Check database", $text, WAIT); } @@ -22479,15 +23584,17 @@ ############################################################## 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 $dpics = shift; # ref to hash of all file names key: file name value: list of dirs+pic containing this pic + my $ignore_links = shift; + my $filter = shift; + my $ignore_filter = shift; undef %$dpics; #$userinfo = "searching duplicates by file name ..."; $userInfoL->update; # loop through all database entries foreach my $dpic (sort keys %searchDB) { next if (($filter ne '') and ($dpic !~ m!$filter!i)); + next if (($ignore_filter ne '') and ($dpic =~ m!$ignore_filter!i)); next if ($ignore_links and -l $dpic); my $pic = basename($dpic); # new entry @@ -22512,17 +23619,19 @@ ############################################################## 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 $dpics = shift; # ref to hash of all file names key: file size value: list of dirs+pic containing this pic + my $ignore_links = shift; + my $filter = shift; + my $ignore_filter = shift; undef %$dpics; #$userinfo = "searching duplicates by file size ..."; $userInfoL->update; # loop through all database entries foreach my $dpic (sort keys %searchDB) { next if (($filter ne '') and ($dpic !~ m!$filter!i)); - next unless ($ignore_links and -f $dpic); - next if (-l $dpic); + 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}) { @@ -22541,6 +23650,45 @@ } ############################################################## +# searchDupDate - search duplicate pics in the database by +# same EXIF creation date +############################################################## +sub searchDupsDate { + my %pics; # hash of all file names key: file name or date value: directory+pic + my $dpics = shift; # ref to hash of all file names key: file date value: list of dirs+pic containing this pic + my $ignore_links = shift; + my $filter = shift; + my $ignore_filter = shift; + undef %$dpics; + #$userinfo = "searching duplicates by file size ..."; $userInfoL->update; + # loop through all database entries + foreach my $dpic (sort keys %searchDB) { + next if (($filter ne '') and ($dpic !~ m!$filter!i)); + next if (($ignore_filter ne '') and ($dpic =~ m!$ignore_filter!i)); + next if ($ignore_links and -l $dpic); + #next if (-l $dpic); + unless (defined $searchDB{$dpic}{TIME}) { + print "$dpic has no EXIF date/time!\n"; + next; + } + my $date = $searchDB{$dpic}{TIME}; # EXIF creation date/time + # new entry + if (!defined $pics{$date}) { + $pics{$date} = $dpic; + } + # duplicate found + else { + # if not defined in the dups hash, add first dir (was saved before) + if (!defined $$dpics{$date}) { + $$dpics{$date} = [$pics{$date}]; + } + # and add the actual dir and pic + push @{$$dpics{$date}}, $dpic; + } + } +} + +############################################################## # findDups - find duplicate pics in the database ############################################################## sub findDups { @@ -22552,6 +23700,7 @@ return; } + my %dup_thumbs; # hash to store all thumbnails displayed in the duplicate window my $pic; my $dir; @@ -22560,14 +23709,13 @@ 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 %dupthumbs; - my $subF = $dupw->Frame()->pack(-fill => 'x', -expand => 0, -pady => 1); my $subF2 = $dupw->Frame()->pack(-fill => 'x', -expand => 0, -pady => 1); @@ -22600,56 +23748,35 @@ my $label = ""; $subF->Label(-textvariable => \$label, -justify => "left",-bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w', -padx => 2); - labeledEntry($subF2, 'left', 33, "Show only path filenames matching", \$filter); - - my $duplb = $dupw->Scrolled("HList", - -header => 1, - -separator => ';', # todo here we hope that ; will never be in a directory or file name - -pady => 0, - -columns => 4, - -scrollbars => 'osoe', - -selectmode => "extended", - -background => $config{ColorBG}, #8fa8bf - -width => 40, - -height => 200, - )->pack(-fill => "both"); - - bindMouseWheel($duplb); - - my $col = 0; - $duplb->{thumbcol} = $col; # save the colomn numbers in the list box widget ref - $duplb->header('create', $col++, -text => 'Thumbnail', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); - $duplb->{namecol} = $col; - $duplb->header('create', $col++, -text => 'Name', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); - $duplb->{filecol} = $col; - $duplb->header('create', $col++, -text => 'File info', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); - $duplb->{dircol} = $col; # save the colomn number of the directory in the list box widget ref - $duplb->header('create', $col, -text => 'Folder', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); + my $filter_entry = labeledEntry($subF2, 'left', 7, "Include", \$filter, 15); + $balloon->attach($filter_entry, -msg => "Enter a part of the file or path name to filter for.\nExample: If you enter \"photos/2008\" only duplicates\nfrom the folder ...photos/2008... will be shown."); + my $ignore_filter_entry = labeledEntry($subF2, 'left', 6, "Ignore", \$ignore_filter, 15); + $balloon->attach($ignore_filter_entry, -msg => "Enter a part of the file or path name to ignore.\nExample: If you enter \"photos/2008\" no duplicates\nfrom the folder ...photos/2008... will be shown."); - $balloon->attach($duplb, -msg => "left click : select\nmiddle click: open picture in new window\nright click : open context menu"); + my $duplb = makeThumbListbox($dupw); $subF->Button(-text => "Search", -command => sub { + $stop = 0; # clean up $duplb->delete("all"); $label = 'cleaning up ...'; - $duplb->update; + $duplb->update; # clean up memory - delete all found thumbnail photo objects - foreach (keys %dupthumbs) { - print "findDups: deleting thumb $_\n" if $verbose; - $dupthumbs{$_}->delete if (defined $dupthumbs{$_}); - delete $dupthumbs{$_}; - } + delete_thumb_objects(\%dup_thumbs); $label = 'searching duplicates in database ...'; - $duplb->update; - my $filterP = makePattern($filter); # create a windows like pattern + $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); + searchDupsName(\%dpics, $ignore_links, $filterP, $ignore_filterP); } elsif ($searchForDups eq 'Size') { - searchDupsSize(\%dpics, $ignore_links, $filterP); + searchDupsSize(\%dpics, $ignore_links, $filterP, $ignore_filterP); + } elsif ($searchForDups eq 'Date') { + searchDupsDate(\%dpics, $ignore_links, $filterP, $ignore_filterP); } elsif ($searchForDups eq 'Cancel') { return; } else { @@ -22663,8 +23790,19 @@ my $last_time; my $pcount = 0; # pic count = keys %dpics my $dcount = 0; # dir count (if each pic has one duplicate this number is $pcount * 2) - my ($dpic, $size, $date, $dir, $pic, $thumb); - my $style = $iptcS; + + my $style1 = $duplb->ItemStyle('text', -anchor=>'nw', -foreground=>'black', -background=>'gray90'); + my $style2 = $duplb->ItemStyle('text', -anchor=>'nw', -foreground=>'black', -background=>'gray80'); + + # save global styles to restore them later + my $comS_save = $comS; + my $exifS_save = $exifS; + my $iptcS_save = $iptcS; + my $fileS_save = $fileS; + my $dirS_save = $dirS; + + $_ = $style2 foreach ($fileS, $exifS, $iptcS, $comS, $dirS); + $stopB->configure(-state => 'normal'); # insert duplicates in hlist @@ -22674,41 +23812,11 @@ foreach my $dpic (@{$dpics{$item}}) { last if $stop; #$dir =~ s!^([a-z]:)/!$1\\!i if $EvilOS; # replace E:/ with E:\ else Win will fire an error message that E: is not mounted - - $dir = dirname($dpic); - $pic = basename($dpic); - $thumb = getThumbFileName($dpic); - - # create new row - $duplb->add($dpic); - - if (-f $thumb) { - $dupthumbs{$thumb} = $duplb->Photo(-file => $thumb, -gamma => $config{Gamma}); - if (defined $dupthumbs{$thumb}) { - $duplb->itemCreate($dpic, $duplb->{thumbcol}, -image => $dupthumbs{$thumb}, -itemtype => 'image'); - } - } - - if ($searchForDups eq "size") { - $size = $item; - } else { - $size = "n.a."; # default value - if ((-d $dir) and (-f $dpic)) { - $size = getFileSize($dpic, NO_FORMAT); # size in Bytes - } - } - - $date = "n.a."; # default value - if ((-d $dir) and (-f $dpic)) { - $date = getFileDate($dpic, FORMAT); # date in exif format - } - - $duplb->itemCreate($dpic, $duplb->{namecol}, -text => $pic, -style => $style); - $duplb->itemCreate($dpic, $duplb->{filecol}, -text => "$size bytes\n$date", -style => $comS); - $duplb->itemCreate($dpic, $duplb->{dircol}, -text => $dir, -style => $style); + insertPic($duplb, $dpic, \%dup_thumbs); + $dcount++; - # show progress and found pics every 0.5 seconds - idea from Slaven - if (!defined $last_time || Tk::timeofday()-$last_time > 0.5) { + # show progress and found pics every 0.3 seconds - idea from Slaven + if (!defined $last_time || Tk::timeofday()-$last_time > 0.3) { $progress = int($pcount/$keys*100); $label = " displaying duplicates $progress% ($pcount/$keys)"; $duplb->update(); @@ -22716,8 +23824,19 @@ } } # toggle style of name col - if ($style == $iptcS) { $style = $comS } else {$style = $iptcS }; + if ($fileS == $style2) { + $_ = $style1 foreach ($fileS, $exifS, $iptcS, $comS, $dirS); + } else { + $_ = $style2 foreach ($fileS, $exifS, $iptcS, $comS, $dirS); + }; } + # reset gloabal style + $fileS = $fileS_save; + $exifS = $exifS_save; + $iptcS = $iptcS_save; + $comS = $comS_save; + $dirS = $dirS_save; + $progress = 100 if ($pcount >= $keys); # sometimes there is a little gap $stopB->configure(-state => "disabled"); $label = " found $pcount duplicates in $dcount files."; @@ -22725,9 +23844,12 @@ })->pack(-side => "left", -anchor => 'w', -fill => "both", -padx => 1,-pady => 1); - $subF->Label(-text => "duplicates by same file", -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w', -fill => "both"); + $subF->Label(-text => "duplicates by same ", -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w', -fill => "both"); - $subF->Optionmenu(-options => [qw(Name Size)], -variable => \$searchForDups, -textvariable => \$searchForDups)->pack(-side => "left", -anchor => 'w', -fill => "both"); + $subF->Optionmenu(-variable => \$searchForDups, -textvariable => \$searchForDups, -options => [ + ['file name' => 'Name'], + ['creation date' => 'Date'], + ['file size' => 'Size'], ])->pack(-side => "left", -anchor => 'w', -fill => "both"); $subF->Checkbutton(-text => 'ignore links', -variable => \$ignore_links)->pack(-side => "left", -anchor => 'w', -fill => "both", -padx => 1,-pady => 1); my $Xbut = $subF->Button(-text => "Close", @@ -22735,11 +23857,7 @@ $dupw->withdraw(); $dupw->destroy(); # clean up memory - delete all found thumbnail photo objects - foreach (keys %dupthumbs) { - print "findDups: deleting thumb $_\n" if $verbose; - $dupthumbs{$_}->delete if (defined $dupthumbs{$_}); - delete $dupthumbs{$_}; - } + delete_thumb_objects(\%dup_thumbs); } )->pack(-side => "left", -anchor => 'w', -fill => "both", -expand => 1, -padx => 1,-pady => 1); @@ -22760,8 +23878,8 @@ my $dpic = $sellist[0]; my $dir = dirname($dpic); if (!-d $dir) { - $dupw->messageBox(-icon => 'warning', -message => "Sorry, but the directory\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.", - -title => "directory not found", -type => 'OK'); + $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; @@ -22770,7 +23888,7 @@ }); ############# open dir - $menu->command(-label => "open directory and show picture", -command => sub { + $menu->command(-label => "open folder and show picture", -command => sub { my @pics = $duplb->info('children'); return unless (@pics); my @sellist = $duplb->info('selection'); @@ -22782,8 +23900,8 @@ my $dpic = $sellist[0]; my $dir = dirname($dpic); if (!-d $dir) { - $dupw->messageBox(-icon => 'warning', -message => "Sorry, but the directory\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.", - -title => "directory not found", -type => 'OK'); + $dupw->messageBox(-icon => 'warning', -message => "Sorry, but the folder\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.", + -title => "folder not found", -type => 'OK'); return; } $top->deiconify; @@ -22794,7 +23912,7 @@ }); ############# ignore dir - $menu->command(-label => "ignore directory ...", -command => sub { + $menu->command(-label => "ignore folder ...", -command => sub { my @pics = $duplb->info('children'); return unless (@pics); my @sellist = $duplb->info('selection'); @@ -22804,7 +23922,7 @@ return; } my $ignoredir = dirname($sellist[0]); - my $rc = myEntryDialog("Ignore directory", "Ignore all directories matching this pattern:", \$ignoredir); + 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) { @@ -22817,7 +23935,7 @@ $duplb->delete("entry", $i); } } - $label = "removed $count directories."; + $label = "removed $count folders."; }); ############# select all @@ -22848,29 +23966,31 @@ } ); # mouse and button bindings + addCommonKeyBindings($duplb, $duplb); + $duplb->bind('', sub { $menu->Popup(-popover => "cursor", -popanchor => "nw"); } ); $duplb->bind('', sub { - return unless ($duplb->info('children')); - my $dpic = getNearestItem($duplb); + return unless ($duplb->info('children')); + my $dpic = getNearestItem($duplb); my $dir = dirname($dpic); if (!-d $dir) { - $dupw->messageBox(-icon => 'warning', -message => "Sorry, but the directory\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.", - -title => "directory not found", -type => 'OK'); + $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; + $dupw->Busy; showPicInOwnWin($dpic); - $dupw->Unbusy; + $dupw->Unbusy; } ); $dupw->bind('', sub { $Xbut->invoke; }); $dupw->bind('', sub { $Xbut->invoke; }); - my $w = int(0.7 * $dupw->screenwidth); - my $h = int(0.7 * $dupw->screenheight); + my $w = int(0.8 * $dupw->screenwidth); + my $h = int(0.8 * $dupw->screenheight); $dupw->geometry("${w}x${h}+10+10"); $duplb->update(); @@ -23116,7 +24236,7 @@ if (!$config{SaveDatabase}) { my $rc = - $top->messageBox(-message => "The save database to file option is off. The search will only cover the directories visited during this session.\nShould I switch the save option on?\nYou can change this option also in the options dialog.", + $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); @@ -23176,7 +24296,7 @@ setFileButton($locSF,'left','Set','Select folder to search in',\$start_dir, 1); $balloon->attach($locSF, -msg => 'When this option is enabled, the search will only take place -in directories matching the displayed string. +in folders matching the displayed string. When the option is disabled a global search will take place.'); my ($addMF, $addF); @@ -23231,36 +24351,36 @@ match any will find all pictures containing "Tim" or "Tom" or both (or-search)'); my $urgF = $f3->Frame()->pack(-anchor=>'w', -padx => 0, -pady => 0); - $urgF->Checkbutton(-variable => \$config{SearchUrgencyOn}, -text => "urgency")->pack(-side => "left", -anchor => 'w'); - $urgF->Optionmenu(-variable => \$config{SearchUrgencyRel}, -textvariable => \$config{SearchUrgencyRel}, -options => [ qw(= <= >=) ] )->pack(-side => "left", -anchor => 'w'); + $urgF->Checkbutton(-variable => \$config{SearchUrgencyOn}, -text => 'urgency')->pack(-side => 'left', -anchor => 'w'); + $urgF->Optionmenu(-variable => \$config{SearchUrgencyRel}, -textvariable => \$config{SearchUrgencyRel}, -options => [ qw(= <= >=) ] )->pack(-side => 'left', -anchor => 'w'); # 0 must be first, because it's the default my $dummy; - $urgF->Optionmenu(-variable => \$config{SearchUrgency}, -options => [ ["0 None" => 0], ["1 High" => 1], 2,3,4,["5 Normal" => 5],6,7, ["8 Low" => 8], ], -variable => \$config{SearchUrgency}, -textvariable => \$dummy)->pack(-side => "left", -anchor => 'w'); + $urgF->Optionmenu(-variable => \$config{SearchUrgency}, -options => [ ["0 None" => 0], ["1 High" => 1], 2,3,4,["5 Normal" => 5],6,7, ["8 Low" => 8], ], -textvariable => \$dummy)->pack(-side => 'left', -anchor => 'w'); # todo search for empty urgency tags: , [Empty => ""] $balloon->attach($urgF, -msg => "Search only for pictures with this IPTC urgency.\nYou can use the urgency flag to set the priority\nof the picture (1 = high to 8 = low)."); - #$f3->Checkbutton(-variable => \$config{SearchUrgencyIg}, -text => "ignore pictures without urgency")->pack(-anchor => "nw"); + #$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); + $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"); + 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'); + $f4->Checkbutton(-variable => \$config{SearchDate}, -text => 'search by EXIF date', -width => 19, -anchor => 'w')->pack(-anchor => 'w'); my $datetext = 'Please use date format: dd.mm.yyyy and check if you entered a valid date. dd (day) is between 01 and 31 mm (month) is between 01 and 12 yyyy (year) is between 1901 and 2038 -Example 25.02.2006'; +Example 25.02.2008'; my $fromF = $f4->Frame()->pack(-anchor => 'w'); - $fromF->Button(-text => 'from', -anchor => 'w', -width => 4, -command => sub { setFromTo(); } )->pack(-side => "left", -anchor => 'w', -padx => 3); + $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, @@ -23268,24 +24388,24 @@ -validatecommand => sub { checkDateFormat($_[0]); }, -invalidcommand => sub { $config{SearchDateStart} = "01.01.2004"; - $sw->messageBox(-icon => 'warning', -message => $datetext, -title => "Wrong date format", -type => 'OK'); + $sw->messageBox(-icon => 'warning', -message => $datetext, -title => 'Wrong date format', -type => 'OK'); } -)->pack(-side => "left", -padx => 3); +)->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); + $toF->Button(-text => 'to', -anchor => 'w', -width => 4, -command => sub { setFromTo(); } )->pack(-side => 'left', -anchor => 'w', -padx => 3); my $todate = $toF->Entry( -textvariable => \$config{SearchDateEnd}, -width => 11, -validate => 'focus', -validatecommand => sub { checkDateFormat($_[0]); }, -invalidcommand => sub { - $config{SearchDateEnd} = "01.01.2007"; - $sw->messageBox(-icon => 'warning', -message => $datetext, -title => "Wrong date format", -type => 'OK'); + $config{SearchDateEnd} = "01.01.2009"; + $sw->messageBox(-icon => 'warning', -message => $datetext, -title => 'Wrong date format', -type => 'OK'); } -)->pack(-side => "left", -padx => 3); +)->pack(-side => 'left', -padx => 3); $balloon->attach($fromdate, -msg => "Search only for pictures with a creation date\nwith or after this date.\nFormat: dd.mm.yyyy (example: 21.12.2001)"); - $balloon->attach($todate, -msg => "Search only for pictures with a creation date\nbefore or with this date.\nFormat: dd.mm.yyyy (example: 31.01.2006)"); + $balloon->attach($todate, -msg => "Search only for pictures with a creation date\nbefore or with this date.\nFormat: dd.mm.yyyy (example: 31.01.2008)"); $addMF = $sw->Frame()->pack(-fill => 'x', -expand => 0, -pady => 0, -padx => 3); # this empty frame is needed, else the frame won't shrink after removing the other content @@ -23294,8 +24414,8 @@ # pixel size my $pixF = $addF->Frame()->pack(-anchor=>'w', -padx => 0, -pady => 0); - $pixF->Checkbutton(-variable => \$config{SearchPixelOn}, -text => "pixel size")->pack(-side => "left", -anchor => 'w'); - $pixF->Optionmenu(-variable => \$config{SearchPixelRel}, -textvariable => \$config{SearchPixelRel}, -options => [ qw(= <= >=) ] )->pack(-side => "left", -anchor => 'w'); + $pixF->Checkbutton(-variable => \$config{SearchPixelOn}, -text => 'pixel size')->pack(-side => 'left', -anchor => 'w'); + $pixF->Optionmenu(-variable => \$config{SearchPixelRel}, -textvariable => \$config{SearchPixelRel}, -options => [ qw(= <= >=) ] )->pack(-side => 'left', -anchor => 'w'); $pixF->Entry(-width => 8,-textvariable => \$config{SearchPixel})->pack(-side => 'top', -anchor => 'w', -padx => 8); if ($config{SearchMore}) { @@ -23324,25 +24444,32 @@ -from => 0, -to => 100, )->pack(-side => 'left', -fill => 'both', -expand => 0, -padx => 8, -pady => 0); - $balloon->attach($progB, -msg => "Displays the search progress"); + $balloon->attach($progB, -msg => 'Displays the search progress'); - $subF->Label(-textvariable => \$label, -justify => "left",-bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w', -padx => 8); + $subF->Label(-textvariable => \$label, -justify => 'left',-bg => $config{ColorBG})->pack(-side => 'left', -anchor => 'w', -padx => 8); my $findLB = makeThumbListbox($sw); $balloon->attach($findLB, -msg => "left click : select\nmiddle click: open picture in new window\nright click : open context menu"); addCommonKeyBindings($findLB, $findLB); + + $findLB->bind('', sub { + my @sellist = getSelection($findLB); + return unless checkSelection($sw, 1, 0, \@sellist); + show_multiple_pics(\@sellist, 0); + } ); + $findLB->bind('', sub { deletePics($findLB, TRASH); } ); $findLB->bind('', sub { deletePics($findLB, REMOVE); } ); # the context menu - my $menu = $sw->Menu(-title => "Search menu"); + my $menu = $sw->Menu(-title => 'Search menu'); ############# select all - $menu->command(-label => "selected all", + $menu->command(-label => 'selected all', -command => sub {selectAll($findLB);}, - -accelerator => "" ); + -accelerator => '' ); $menu->separator; @@ -23365,24 +24492,42 @@ }); ############# open pic - $menu->command(-label => "show pictures in new window", -command => sub { + $menu->command(-label => 'show pictures in new window', -accelerator => '', -command => sub { my @sellist = getSelection($findLB); - return unless checkSelection($top, 1, 0, \@sellist); + return unless checkSelection($sw, 1, 0, \@sellist); show_multiple_pics(\@sellist, 0); }); ############# open dir - $menu->command(-label => "open picture in main window", -command => sub { + $menu->command(-label => "open picture in main window", -accelerator => '', -command => sub { my @pics = $findLB->info('children'); return unless (@pics); my @sellist = $findLB->info('selection'); + return unless checkSelection($sw, 1, 1, \@sellist); + my $dpic = $sellist[0]; + my $dir = dirname($dpic); + my $pic = basename($dpic); + if (!-d $dir) { + $sw->messageBox(-icon => 'warning', -message => "Sorry, but the folder\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.", + -title => 'folder not found', -type => 'OK'); + return; + } + $top->deiconify; + $top->raise; + $top->focus; + openDirPost($dir) if ($dir ne $actdir); + showPic($dpic); + }); + +# key-desc,m,show picture in main window (from search window) + $findLB->bind('', sub { + my @sellist = $findLB->info('selection'); return unless checkSelection($sw, 1, 1, \@sellist); my $dpic = $sellist[0]; my $dir = dirname($dpic); my $pic = basename($dpic); if (!-d $dir) { - $sw->messageBox(-icon => 'warning', -message => "Sorry, but the directory\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.", - -title => "directory not found", -type => 'OK'); + $sw->messageBox(-icon => 'warning', -message => "Sorry, but the folder\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.", -title => 'folder not found', -type => 'OK'); return; } $top->deiconify; @@ -23393,81 +24538,81 @@ }); ############# open in external viewer - $menu->command(-label => "open pictures in external viewer", -command => sub { - openPicInViewer($findLB); }, -accelerator => ""); + $menu->command(-label => 'open pictures in external viewer', -command => sub { + openPicInViewer($findLB); }, -accelerator => ''); $menu->separator; ############# display IPTC - $menu->command(-label => "show IPTC", -command => sub { - displayIPTCData($findLB); }, -accelerator => ""); + $menu->command(-label => 'show IPTC', -command => sub { + displayIPTCData($findLB); }, -accelerator => ''); ############# edit IPTC - $menu->command(-label => "edit IPTC ...", -command => sub { - editIPTC($findLB); }, -accelerator => ""); + $menu->command(-label => 'edit IPTC ...', -command => sub { + editIPTC($findLB); }, -accelerator => ''); addRatingMenu($menu, $findLB); - $menu->command(-label => "add/remove keywords ...", -command => sub { editIPTCKeywords($findLB); }, -accelerator => ''); - $menu->command(-label => "add/remove categories ...", -command => sub { editIPTCCategories($findLB); } , -accelerator => ''); + $menu->command(-label => 'add/remove keywords ...', -command => sub { editIPTCKeywords($findLB); }, -accelerator => ''); + $menu->command(-label => 'add/remove categories ...', -command => sub { editIPTCCategories($findLB); } , -accelerator => ''); $menu->separator; ############# add comment - $menu->command(-label => "add comment ...", -command => sub { - addComment($findLB); }, -accelerator => ""); + $menu->command(-label => 'add comment ...', -command => sub { + addComment($findLB); }, -accelerator => ''); ############# edit comment - $menu->command(-label => "edit comment ...", -command => sub { - editComment($findLB); }, -accelerator => ""); + $menu->command(-label => 'edit comment ...', -command => sub { + editComment($findLB); }, -accelerator => ''); ############# search/replace comment - $menu->command(-label => "search/replace comment ...", -command => sub { + $menu->command(-label => 'search/replace comment ...', -command => sub { replaceComment($findLB); }, ); $menu->separator; - ############# sort - todo - my $sort_menu = $menu->cascade(-label => "sort by ..."); + ############# sort + my $sort_menu = $menu->cascade(-label => 'sort by ...'); $menu->separator; - $menu->command(-label => "add to light table", -command => sub {light_table_add_from_lb($findLB);}, -accelerator => ""); + $menu->command(-label => 'add to light table', -command => sub {light_table_add_from_lb($findLB);}, -accelerator => ''); - $sort_menu->command(-label => "file name", -command => sub { + $sort_menu->command(-label => 'file name', -command => sub { my @pics = $findLB->info('children'); - $findLB->delete("all"); - searchThumbsDelete(); - sortPics("name", 0, \@pics); + $findLB->delete('all'); + delete_thumb_objects(\%searchthumbs); + sortPics('name', 0, \@pics); foreach (@pics) { - insertPic($findLB, $_); + insertPic($findLB, $_, \%searchthumbs); } }, ); - $sort_menu->command(-label => "urgency", -command => sub { + $sort_menu->command(-label => 'urgency', -command => sub { my @pics = $findLB->info('children'); - $findLB->delete("all"); - searchThumbsDelete(); - sortPics("urgency", 0, \@pics); + $findLB->delete('all'); + delete_thumb_objects(\%searchthumbs); + sortPics('urgency', 0, \@pics); foreach (@pics) { - insertPic($findLB, $_); + insertPic($findLB, $_, \%searchthumbs); } }, ); - $sort_menu->command(-label => "file date", -command => sub { + $sort_menu->command(-label => 'file date', -command => sub { my @pics = $findLB->info('children'); - $findLB->delete("all"); - searchThumbsDelete(); - sortPics("date", 0, \@pics); + $findLB->delete('all'); + delete_thumb_objects(\%searchthumbs); + sortPics('date', 0, \@pics); foreach (@pics) { - insertPic($findLB, $_); + insertPic($findLB, $_, \%searchthumbs); } }, ); - $sort_menu->command(-label => "EXIF date", -command => sub { + $sort_menu->command(-label => 'EXIF date', -command => sub { my @pics = $findLB->info('children'); - $findLB->delete("all"); - searchThumbsDelete(); - sortPics("exifdate", 0, \@pics); + $findLB->delete('all'); + delete_thumb_objects(\%searchthumbs); + sortPics('exifdate', 0, \@pics); foreach (@pics) { - insertPic($findLB, $_); + insertPic($findLB, $_, \%searchthumbs); } }, ); @@ -23475,7 +24620,7 @@ # mouse and button bindings $findLB->bind('', sub { - $menu->Popup(-popover => "cursor", -popanchor => "nw"); + $menu->Popup(-popover => 'cursor', -popanchor => 'nw'); } ); $findLB->bind('', sub { @@ -23483,7 +24628,7 @@ my $dpic = getNearestItem($findLB); my $dir = dirname($dpic); if (!-d $dir) { - $sw->messageBox(-icon => 'warning', -message => "Sorry, but the directory\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.",-title => "directory not found", -type => 'OK'); + $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; @@ -23491,10 +24636,10 @@ $sw->Unbusy; } ); - my $SButF = $ButF->Frame(-bd => 0)->pack(-side => 'top', -anchor => "n", -expand => 1, -fill =>'both',-padx => 0,-pady => 0); + my $SButF = $ButF->Frame(-bd => 0)->pack(-side => 'top', -anchor => 'n', -expand => 1, -fill =>'both',-padx => 0,-pady => 0); $OKB = - $SButF->Button(-text => "Search", + $SButF->Button(-text => 'Search', -command => sub { my $searchStart = Tk::timeofday(); my $count = 0; @@ -23508,7 +24653,7 @@ $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'); + -title => 'No search field selected', -type => 'OK'); return; } @@ -23516,7 +24661,7 @@ $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'); + -title => 'Wrong format', -type => 'OK'); return; } @@ -23536,16 +24681,16 @@ 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"; + $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 = '(?=.*'.$pat; # and-function with look-ahead $pat =~ s/\s+/)(?=.*/g; # replace one or more whitespaces with )(?=.* - $pat .= ")"; # "Tom Tim" is now: "(?=.*Tom)(?=.*Tim)" + $pat .= ')'; # "Tom Tim" is now: "(?=.*Tom)(?=.*Tim)" } else { # do nothing (normal string search) } @@ -23562,11 +24707,11 @@ if ($config{SearchDate}) { if (!checkDateFormat($config{SearchDateStart})) { - $sw->messageBox(-icon => 'warning', -message => $datetext, -title => "Wrong from-date", -type => 'OK'); + $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'); + $sw->messageBox(-icon => 'warning', -message => $datetext, -title => 'Wrong to-date', -type => 'OK'); return; } $start_time = buildUnixTime($config{SearchDateStart}); @@ -23575,15 +24720,15 @@ 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'); + -title => 'Wrong search date', -type => 'OK'); return; } } - $findLB->delete("all"); # clear listbox + $findLB->delete('all'); # clear listbox $sw->Busy; - my $case = "i"; $case = "" if $config{SearchCase}; + my $case = 'i'; $case = '' if $config{SearchCase}; $stopB->configure(-state => 'normal'); $stopB->update(); @@ -23617,15 +24762,15 @@ # skip if wrong urgency if ($config{SearchUrgencyOn} and (defined $urg)) { - if ($config{SearchUrgencyRel} eq "=") { # equal + if ($config{SearchUrgencyRel} eq '=') { # equal next if ($urg != $config{SearchUrgency}); } else { # handle bigger and lower $urg = 9 if ($urg == 0); # urgency 0 means none, which is less than 8 (low) - if ($config{SearchUrgencyRel} eq ">=") { # bigger + if ($config{SearchUrgencyRel} eq '>=') { # bigger next if ($urg < $config{SearchUrgency}); } - if ($config{SearchUrgencyRel} eq "<=") { # lower + if ($config{SearchUrgencyRel} eq '<=') { # lower next if ($urg > $config{SearchUrgency}); } } @@ -23636,14 +24781,14 @@ 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 + if ($config{SearchPixelRel} eq '=') { # equal next if ($pixy != $config{SearchPixel}); } else { # handle bigger and lower - if ($config{SearchPixelRel} eq ">=") { # bigger + if ($config{SearchPixelRel} eq '>=') { # bigger next if ($pixy < $config{SearchPixel}); } - if ($config{SearchPixelRel} eq "<=") { # lower + if ($config{SearchPixelRel} eq '<=') { # lower next if ($pixy > $config{SearchPixel}); } } @@ -23651,14 +24796,14 @@ # skip if wrong numer of views (popularity) if ($config{SearchPopOn}) { - if ($config{SearchPopRel} eq "=") { # equal + if ($config{SearchPopRel} eq '=') { # equal next if ($searchDB{$dpic}{POP} != $config{SearchPop}); } else { # handle bigger and lower - if ($config{SearchPopRel} eq ">=") { # bigger + if ($config{SearchPopRel} eq '>=') { # bigger next if ($searchDB{$dpic}{POP} < $config{SearchPop}); } - if ($config{SearchPopRel} eq "<=") { # lower + if ($config{SearchPopRel} eq '<=') { # lower next if ($searchDB{$dpic}{POP} > $config{SearchPop}); } } @@ -23680,27 +24825,28 @@ $exif =~ s/\n/ /g if (defined $exif); $iptc =~ s/\n/ /g if (defined $iptc); - my $allMeta = ""; + 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 .= ' '.$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 + if ((($config{SearchJoin} and ($allMeta ne '') and ($allMeta =~ m/(?$case).*$pat.*/) ) ) or (($config{SearchCom} and (defined $com) and ($com =~ m/(?$case).*$pat.*/)) or ($config{SearchExif} and (defined $exif) and ($exif =~ m/(?$case).*$pat.*/)) or ($config{SearchIptc} and (defined $iptc) and ($iptc =~ m/(?$case).*$pat.*/)) or ($config{SearchKeys} and (defined $keys) and ($keys =~ m/(?$case).*$pat.*/)) or + ($config{SearchKeys} and (!defined $keys) and ($pat eq '')) or # empty keywords ($config{SearchName} and (basename($dpic) =~ m/(?$case).*$pat.*/)) or ($config{SearchDir} and (dirname($dpic) =~ m/(?$case).*$pat.*/)))) { # skip if exclude pattern matches - if ((defined $exl) and ($exl ne "")) { + 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 @@ -23711,7 +24857,7 @@ } unless ($justCount) { - insertPic($findLB, $dpic); + insertPic($findLB, $dpic, \%searchthumbs); } $count++; $label = "found pattern in $count pictures."; @@ -23730,7 +24876,7 @@ $msg .= " with pixel size ".$config{SearchPixelRel}." ".$config{SearchPixel} if ($config{SearchPixelOn}); $msg .= " with views ".$config{SearchPopRel}." ".$config{SearchPop} if ($config{SearchPopOn}); $msg .= " dated between ".$config{"SearchDateStart"}." and ".$config{"SearchDateEnd"} if ($config{"SearchDate"} != 0); - $msg .= " in directories matching $start_dir" if ($config{"SearchOnlyInDir"} != 0); + $msg .= " in folders matching $start_dir" if ($config{"SearchOnlyInDir"} != 0); $msg .= " in the database."; @@ -23764,7 +24910,7 @@ $stop = 1; $config{SearchGeometry} = $sw->geometry; $sw->withdraw; - searchThumbsDelete(); + delete_thumb_objects(\%searchthumbs); $sw->destroy; } )->pack(-side => 'top', -anchor => 'w', -expand => 1,-fill => 'x',-padx => 1,-pady => 1); @@ -23780,24 +24926,28 @@ } ############################################################## -# searchThumbsDelete +# delete_thumb_objects ############################################################## -sub searchThumbsDelete { +sub delete_thumb_objects { + + my $thumbs = shift; # hash ref to store the thumbnails + # clean up memory - delete all found thumbnail photo objects foreach (keys %searchthumbs) { print "searchMetaInfo: deleting thumb $_\n" if $verbose; - $searchthumbs{$_}->delete if (defined $searchthumbs{$_}); - delete $searchthumbs{$_}; + $$thumbs{$_}->delete if (defined $$thumbs{$_}); + delete $$thumbs{$_}; } } ############################################################## # insertPic ############################################################## -sub insertPic($$) { - my $lb = shift; - my $dpic = shift; - +sub insertPic($$$) { + my $lb = shift; + my $dpic = shift; + my $thumbs = shift; # hash ref to store the thumbnails + my $thumb = getThumbFileName($dpic); # create new row @@ -23805,9 +24955,9 @@ my $pic = basename($dpic); if (-f $thumb) { - $searchthumbs{$thumb} = $lb->Photo(-file => $thumb, -gamma => $config{Gamma}); - if (defined $searchthumbs{$thumb}) { - $lb->itemCreate($dpic, $lb->{thumbcol}, -image => $searchthumbs{$thumb}, -itemtype => "imagetext", -text => getThumbCaption($dpic), -style => $thumbS); + $$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 { @@ -23819,9 +24969,9 @@ my $iptc; $iptc = displayIPTC($dpic); - my $com = formatString($searchDB{$dpic}{COM}, 30); # format the comment for the list - my $exif = formatString($searchDB{$dpic}{EXIF}, 30); # format the EXIF info for the list - $iptc = formatString($iptc, 30); # format the IPTC info for the list + my $com = formatString($searchDB{$dpic}{COM}, 30, $config{LineLimit}); # format the comment for the list + my $exif = formatString($searchDB{$dpic}{EXIF}, 30, $config{LineLimit}); # format the EXIF info for the list + $iptc = formatString($iptc, 30, $config{LineLimit}); # format the IPTC info for the list my $size = basename($dpic)."\n\n"; $size .= int($searchDB{$dpic}{SIZE}/1024)."kB\n" if (defined $searchDB{$dpic}{SIZE}); @@ -23890,86 +25040,217 @@ return $size; } + ############################################################## -# about - display some infos about the application +# xmp_show - show XMP info using Image::ExifTool ############################################################## -sub about { +sub xmp_show { - my $title = "About Mapivi $version"; + unless ($exiftoolAvail) { + $top->messageBox(-icon => 'info', -message => "Sorry, but the Perl module Image::ExifTool is not available.\nPlease install it and restart Mapivi.", + -title => "Image::ExifTool not available", -type => 'OK'); + return; + } - my @date = split / /, '$Date: 2006/10/31 03:20:58 $ '; - my @datum = split /\//, $date[1]; - my $nrs = $config{NrOfRuns}; + my $lb = shift; + my @sellist = getSelection($lb); + return unless checkSelection($lb, 1, 0, \@sellist); + my $selected = scalar @sellist; + $userinfo = "extracting XMP information of $selected pictures"; $userInfoL->update; - my $sec = time() - $^T; - my $min = 0; - my $hou = 0; - my $day = 0; + my $exifTool = new Image::ExifTool; + my $i = 0; + my $pw = progressWinInit($lb, "Extracting XMP information"); + foreach my $dpic (@sellist) { + last if progressWinCheck($pw); + $i++; + progressWinUpdate($pw, "Extracting XMP ($i/$selected) ...", $i, $selected); + my $xmp = ''; + my $info = $exifTool->ImageInfo($dpic, 'XMP:*'); + foreach (sort keys %$info) { + my $val = $$info{$_}; + if (ref $val eq 'ARRAY') { + $val = join(', ', @$val); + } elsif (ref $val eq 'SCALAR') { + $val = '(Binary data)'; + } + $xmp .= sprintf("%-24s : %s\n", $_, $val); + } + $xmp = 'No XMP data found.' if ($xmp eq ''); + showText("XMP data of $dpic", $xmp, NO_WAIT); + } + progressWinEnd($pw); + $userinfo = "ready! ($i of $selected)"; $userInfoL->update; +} - # 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; +############################################################## +# xmp_add_keyword - add XMP keyword using Image::ExifTool +############################################################## +sub xmp_add_keyword { - my $perlversion = sprintf "%vd",$^V; + unless ($exiftoolAvail) { + $top->messageBox(-icon => 'info', -message => "Sorry, but the Perl module Image::ExifTool is not available.\nPlease install it and restart Mapivi.", + -title => "Image::ExifTool not available", -type => 'OK'); + return; + } - my $about = << "EOA"; + my $lb = shift; + my @sellist = getSelection($lb); + return unless checkSelection($lb, 1, 0, \@sellist); + my $selected = scalar @sellist; - MaPiVi - Martin\'s Picture Viewer and Organizer + my $keyword = ''; + my $rc = myEntryDialog('Add XMP keyword', "Please enter a new keyword to add to the $selected pictures", \$keyword); + return if (($rc ne 'OK') or ($keyword eq '')); - A JPEG picture viewer with EXIF/IPTC/Comment support. + $userinfo = "adding XMP keyword to $selected pictures"; $userInfoL->update; - Mapivi Version: $version - Date of last change: $datum[2].$datum[1].$datum[0] - Mapivi config dir: $configdir + my $exifTool = new Image::ExifTool; + my $i = 0; + my $error = ''; + my $pw = progressWinInit($lb, 'Adding XMP keyword'); + foreach my $dpic (@sellist) { + last if progressWinCheck($pw); + $i++; + progressWinUpdate($pw, "Adding XMP keyword ($i/$selected) ...", $i, $selected); + my $info = $exifTool->ImageInfo($dpic, 'XMP:*'); + # get exsisting keywords + my @keywords = $exifTool->GetValue('Subject'); + # add new keyword to list + push @keywords, $keyword; + # remove double entries and sort alphabetical + uniqueArray(\@keywords); + # add XMP keywords + $exifTool->SetNewValue('XMP-dc:Subject' => \@keywords); + #$exifTool->SetNewValue('XMP-dc:Title' => 'Mapivi can write XMP!'); + #$exifTool->SetNewValue('XMP:Urgency' => 3); + + my $rc = $exifTool->WriteInfo($dpic); + + if ($rc != 1) { + if ($rc == 2) { + $error .= "$dpic written, but no changes made\n"; + } + else { + $error .= "Error writing $dpic: $rc\n"; + # retrieve error and warning messages + $error .= sprintf "error: %s\n", $exifTool->GetValue('Error') if $exifTool->GetValue('Error'); + $error .= sprintf "warning: %s\n", $exifTool->GetValue('Warning') if $exifTool->GetValue('Warning'); + } + } - Author: Martin Herrmann - email: - www: $mapiviURL - download: http://sourceforge.net/projects/mapivi + } + progressWinEnd($pw); + $userinfo = "ready! ($i of $selected)"; $userInfoL->update; + showText("Errors while adding XMP keywords", $error, NO_WAIT) if ($error ne ''); +} - You have used Mapivi $nrs times +############################################################## +# xmp_add_title - add XMP title using Image::ExifTool +############################################################## +sub xmp_add_title { - Perl version: $perlversion - Perl/Tk version: $Tk::VERSION - Tcl/Tk version: $Tk::version - Tcl/Tk patch level: $Tk::patchLevel - Tk::JPEG version: $Tk::JPEG::VERSION - MetaData version: $Image::MetaData::JPEG::VERSION - Perl executable: $^X - System (OS): $^O - Process ID (PID): $$ - Running since: $uptime -EOA + unless ($exiftoolAvail) { + $top->messageBox(-icon => 'info', -message => "Sorry, but the Perl module Image::ExifTool is not available.\nPlease install it and restart Mapivi.", + -title => "Image::ExifTool not available", -type => 'OK'); + return; + } - my $procTabAvail = (eval "require Proc::ProcessTable") ? 1 : 0 ; + my $lb = shift; + my @sellist = getSelection($lb); + return unless checkSelection($lb, 1, 0, \@sellist); + my $selected = scalar @sellist; - my $mem = int(getMemoryUsage()/(1024*1024))."MB" if $procTabAvail; - $about .= " memory usage: ".$mem."\n" if $procTabAvail; + 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'); - $about .= " OS type: ".$ENV{OS}."\n" if ($ENV{OS}); - $about .= " OS: ".$ENV{PC_OS}."\n" if ($ENV{PC_OS}); - $about .= " OS type: ".$ENV{OSTYPE}."\n" if ($ENV{OSTYPE}); - $about .= " System name: ".$ENV{HOSTNAME}."\n" if ($ENV{HOSTNAME}); - $about .= " System name: ".$ENV{COMPUTERNAME}."\n" if ($ENV{COMPUTERNAME}); - $about .= " System type: ".$ENV{HOSTTYPE}."\n" if ($ENV{HOSTTYPE}); - $about .= " # of processors: ".$ENV{NUMBER_OF_PROCESSORS}."\n" if ($ENV{NUMBER_OF_PROCESSORS}); - $about .= " Processor: ".$ENV{CPU}."\n" if ($ENV{CPU}); - $about .= " Processor: ".$ENV{PROCESSOR_ARCHITECTURE}."\n" if ($ENV{PROCESSOR_ARCHITECTURE}); - $about .= " Processor type: ".$ENV{PROCESSOR_IDENTIFIER}."\n" if ($ENV{PROCESSOR_IDENTIFIER}); - $about .= " Processor type: ".$ENV{MACHTYPE}."\n" if ($ENV{MACHTYPE}); - $about .= " Processor rev.: ".$ENV{PROCESSOR_REVISION}."\n" if ($ENV{PROCESSOR_REVISION}); + $userinfo = "adding XMP title to $selected picture(s)"; $userInfoL->update; - $about .= ' - Mapivi is free software, if you want you may make a donation, - see http://herrmanns-stern.de/software/donations.shtml - Your donation of any amount will encourage me to continue the - development.'; + my $exifTool = new Image::ExifTool; + my $i = 0; + my $error = ''; + my $pw = progressWinInit($lb, 'Adding XMP title'); + foreach my $dpic (@sellist) { + last if progressWinCheck($pw); + $i++; + progressWinUpdate($pw, "Adding XMP title ($i/$selected) ...", $i, $selected); + my $info = $exifTool->ImageInfo($dpic, 'XMP:*'); + # add XMP title + $exifTool->SetNewValue('XMP-dc:Title' => $item); + + my $rc = $exifTool->WriteInfo($dpic); + + if ($rc != 1) { + if ($rc == 2) { + $error .= "$dpic written, but no changes made\n"; + } + else { + $error .= "Error writing $dpic: $rc\n"; + # retrieve error and warning messages + $error .= sprintf "error: %s\n", $exifTool->GetValue('Error') if $exifTool->GetValue('Error'); + $error .= sprintf "warning: %s\n", $exifTool->GetValue('Warning') if $exifTool->GetValue('Warning'); + } + } - $about .= "\n\n I am always happy to receive some feedback about Mapivi!\n"; + } + progressWinEnd($pw); + $userinfo = "ready! ($i of $selected)"; $userInfoL->update; + showText("Errors while adding XMP title", $error, NO_WAIT) if ($error ne ''); +} - showText($title, $about, WAIT, $mapiviiconfile); +############################################################## +# xmp_edit_title - edit XMP title using Image::ExifTool +############################################################## +sub xmp_edit_title { + + unless ($exiftoolAvail) { + $top->messageBox(-icon => 'info', -message => "Sorry, but the Perl module Image::ExifTool is not available.\nPlease install it and restart Mapivi.", + -title => "Image::ExifTool not available", -type => 'OK'); + return; + } + + my $lb = shift; + my @sellist = getSelection($lb); + return unless checkSelection($lb, 1, 0, \@sellist); + my $selected = scalar @sellist; + + $userinfo = "adding XMP title to $selected picture(s)"; $userInfoL->update; + + my $exifTool = new Image::ExifTool; + my $i = 0; + my $error = ''; + my $pw = progressWinInit($lb, 'Adding XMP title'); + foreach my $dpic (@sellist) { + last if progressWinCheck($pw); + $i++; + my $item = ''; + my $info = $exifTool->ImageInfo($dpic, 'XMP:*'); + $item = $$info{Title} unless (ref $$info{Title} eq 'SCALAR'); + my $rc = myEntryDialog('Edit XMP title', "Please edit title of $dpic", \$item); + next if ($rc ne 'OK'); + progressWinUpdate($pw, "Edit XMP title ($i/$selected) ...", $i, $selected); + # add XMP title + $exifTool->SetNewValue('XMP-dc:Title' => $item); + + $rc = $exifTool->WriteInfo($dpic); + + if ($rc != 1) { + if ($rc == 2) { + $error .= "$dpic written, but no changes made\n"; + } + else { + $error .= "Error writing $dpic: $rc\n"; + # retrieve error and warning messages + $error .= sprintf "error: %s\n", $exifTool->GetValue('Error') if $exifTool->GetValue('Error'); + $error .= sprintf "warning: %s\n", $exifTool->GetValue('Warning') if $exifTool->GetValue('Warning'); + } + } + + } + progressWinEnd($pw); + $userinfo = "ready! ($i of $selected)"; $userInfoL->update; + showText("Errors while adding XMP title", $error, NO_WAIT) if ($error ne ''); } ############################################################## @@ -23989,18 +25270,18 @@ my $dialog = $top->Dialog(-title => "Trash full!", -text => "The trash contains $msum MB in ".scalar @files." files!", - -buttons => ["Do nothing", "Show me the trash", "Empty trash"]); + -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 me the trash") { + elsif ($rc eq "Show trash in main window") { openDirPost($trashdir); $top->focusForce; return; } - elsif ($rc eq "Empty trash") { + elsif ($rc eq "Empty trash ...") { emptyTrash(); } else { @@ -24029,7 +25310,7 @@ $win->Label(-textvariable => \$text)->pack(-expand => 0, -fill => 'x'); my $tlb = $win->Scrolled("HList", -header => 1, - -separator => ';', # todo here we hope that ; will never be in a directory or file name + -separator => ';', # todo here we hope that ; will never be in a folder or file name -pady => 0, -columns => 4, -scrollbars => 'osoe', @@ -24073,28 +25354,28 @@ $butF->Button(-text => 'Restore selected', -command => sub { my @sellist = $tlb->info('selection'); - my $error = ''; + my $error = ''; foreach my $dpic (@sellist) { - # if original dir (odir) is defined and not unknown and the folder exists, we move the picture back - if ($searchDB{$dpic}{odir} and - ($searchDB{$dpic}{odir} ne 'unknown') and - ( -d $searchDB{$dpic}{odir})) { - my @list; # we need a dummy list here with one element - push @list, $dpic; - #print "moving $dpic to $searchDB{$dpic}{odir}\n"; - movePics($searchDB{$dpic}{odir}, $tlb, @list); - #$tlb->delete('entry', $dpic) unless (-f $dpic); - } - else { - $error .= "Could not restore $dpic (no folder information available)\n"; - } + # if original dir (odir) is defined and not unknown and the folder exists, we move the picture back + if ($searchDB{$dpic}{odir} and + ($searchDB{$dpic}{odir} ne 'unknown') and + ( -d $searchDB{$dpic}{odir})) { + my @list; # we need a dummy list here with one element + push @list, $dpic; + #print "moving $dpic to $searchDB{$dpic}{odir}\n"; + movePics($searchDB{$dpic}{odir}, $tlb, @list); + #$tlb->delete('entry', $dpic) unless (-f $dpic); + } + else { + $error .= "Could not restore $dpic (no folder information available)\n"; + } } - if ($error ne '') { - $error = "Errors while restoring selected pictures:\n$error"; - showText("Errors", $error, NO_WAIT); - } - #updateThumbsPlus() if ($actdir eq $trashdir); - #$win->destroy; + if ($error ne '') { + $error = "Errors while restoring selected pictures:\n$error"; + showText("Errors", $error, NO_WAIT); + } + #updateThumbsPlus() if ($actdir eq $trashdir); + #$win->destroy; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); my $Xbut = $butF->Button(-text => 'Close', @@ -24122,7 +25403,7 @@ 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}); @@ -24138,7 +25419,7 @@ my $msum = sprintf "%.1f", $sum/(1024*1024); # size in MB - $text = "Please press Ok to delete all files ($msum MB in ".scalar @files." files) in the trash.\nThere is no undelete!\n\nPath: $trashdir"; + $text = "Please press \"Empty trash\" to delete all files ($msum MB in ".scalar @files." files) from the trash.\nThere is no undelete!\n\n(Trash folder: $trashdir)"; $win->waitWindow; foreach (keys %thumbs) { $thumbs{$_}->delete if (defined $thumbs{$_}); } # free memory @@ -24153,7 +25434,7 @@ 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]; @@ -24168,7 +25449,7 @@ my (@day, @month, @year); push @day, sprintf "%02d",$_ for ( 1 .. 31); push @month, sprintf "%02d",$_ for ( 1 .. 12); - push @year, sprintf "%4d", $_ for ( 1990 .. 2010); + 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); @@ -24279,7 +25560,7 @@ 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}); + $icon = $win->Photo(-file => $thumbnail, -gamma => $config{Gamma}); if ($icon) { $fl->Label(-image => $icon, -bg => $config{ColorBG}, -relief => "sunken", )->pack(-padx => 1, -pady => 2); @@ -24298,7 +25579,7 @@ -height => $height, )->pack(-fill => 'both', -expand => "1"); - $rotext->insert('end', "$text"); + $rotext->insert('end', $text); bindMouseWheel($rotext); $xBut->focus; @@ -24558,7 +25839,7 @@ my $command = "identify -verbose \"$dpic\" "; my $buffer = `$command`; - showText("Informations about $pic", $buffer, NO_WAIT, $thumb); + showText("Information about $pic", $buffer, NO_WAIT, $thumb); $userinfo = "ready!"; $userInfoL->update; } @@ -24819,24 +26100,26 @@ my $min = shift; my $max = shift; # use 0 for any number my $listref = shift; - + my $itemkind = shift; # optional string, e.g. "picture" or "keyword", ... + $itemkind = '' unless defined $itemkind; + my $plural = ''; $plural = 's' if ($min > 1); - + if (($min == $max) and (@$listref != $min)) { - $win->messageBox(-icon => 'warning', -message => "Please select exactly $min item$plural!", + $win->messageBox(-icon => 'warning', -message => "Please select exactly $min $itemkind item$plural!", -title => "Wrong selection", -type => 'OK'); return 0; } if (@$listref < $min) { - $win->messageBox(-icon => 'warning', -message => "Please select at least $min item$plural!", + $win->messageBox(-icon => 'warning', -message => "Please select at least $min $itemkind item$plural!", -title => "Wrong selection", -type => 'OK'); return 0; } if (($max != 0) and (@$listref > $max)) { - $win->messageBox(-icon => 'warning', -message => "Please select not more than $max items!", + $win->messageBox(-icon => 'warning', -message => "Please select not more than $max $itemkind items!", -title => "Wrong selection", -type => 'OK'); return 0; } @@ -24919,7 +26202,7 @@ $lF->Checkbutton(-variable => \$config{indexLabel}, -text => "add a label to each picture")->pack(-anchor=>'w'); my $labstr = labeledEntry($lF, 'top', $w, "label string", \$config{indexLabelStr}); - $balloon->attach($labstr, -msg => "%b file size\n%c comment\n%d directory\n%e filename extention\n%f filename\n%h height\n%i input filename\n%l label\n%m magick\n%n number of scenes\n%o output filename\n%p page number\n%q quantum depth\n%s scene number\n%t top of filename\n%u unique temporary filename\n%w width\n%x x resolution\n%y y resolution"); + $balloon->attach($labstr, -msg => "%b file size\n%c comment\n%d folder\n%e filename extention\n%f filename\n%h height\n%i input filename\n%l label\n%m magick\n%n number of scenes\n%o output filename\n%p page number\n%q quantum depth\n%s scene number\n%t top of filename\n%u unique temporary filename\n%w width\n%x x resolution\n%y y resolution"); my $fss = labeledScale($lF, 'top', $w, "label font size", \$config{indexFontSize}, 0, 50, 1); $balloon->attach($fss, -msg => "The font size of the labels.\nIf you set this to 0, montage will\ntry to choose a appropriate size."); @@ -25430,11 +26713,14 @@ ############################################################## sub cleanThumbDB { + # todo create dialog window and make e.g. the $days an adjustable option my $days = 30; my $thumbDB = "$configdir/thumbDB"; + my $thumbDB_quote = $thumbDB; + $thumbDB_quote =~ s|\\|\\\\|g; # replace backslash with double backslashe \ -> \\ (quoting) my @thumbs; my $rc = $top->messageBox(-icon => "question", - -message => "This function will delete all stored thumbnails in the thumbnail data base which have no corresponding picture and are older than $days days. Please press Ok to proceed.", + -message => "This function will display all stored thumbnails in the thumbnail data base which have no corresponding picture and are older than $days days. You may then select which of then to delete. Please press Ok to proceed.", -title => "Clean thumbnail database", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); @@ -25443,9 +26729,10 @@ #print "dir: $File::Find::name\n"; if (-f and (-M >= $days)) { my $orig = $File::Find::name; - $orig =~ s/^$thumbDB//; + # 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"; + print "file: $File::Find::name -> $orig\n" if $verbose; push @thumbs, $File::Find::name; } } @@ -25455,17 +26742,25 @@ $userinfo = "found ".@thumbs." outdated thumbnails ..."; $userInfoL->update; if (@thumbs > 0) { - my @dummylist; - # todo: use mySelListBoxDialog user may select which to delete + my @sel_list; + # user may select which to delete if (mySelListBoxDialog("Really delete?", - "Please press Ok to delete these ".scalar @thumbs." thumbnails.", - 'OK', \@dummylist, @thumbs)) { - foreach (@thumbs) { print "removing $_\n"; removeFile($_); } + "Please select which of these ".scalar @thumbs." thumbnails to delete.", + MULTIPLE, + 'OK', \@sel_list, @thumbs)) { + foreach (@sel_list) { + print "removing $thumbs[$_]\n" if $verbose; + removeFile($thumbs[$_]); + } } + $userinfo = "ready!"; $userInfoL->update; + } + else { + $top->messageBox(-icon => "info", + -message => "Found no outdated thumbnails in $thumbDB. Seems like your thumbnails are up to date.", + -title => "Thumbnail database is up to date", -type => 'OK'); } - $userinfo = "ready!"; $userInfoL->update; return; - # todo: remove empty dirs in $thumbDB ... } @@ -25480,9 +26775,9 @@ return unless ((defined $dir) or (-d $dir)); my $rc; if (($cleanDirLevel == 0) or (!$cleanDirNoAsk)) { - my $dia = $top->DialogBox(-title => "Clean directory ".basename($dir)."?", + my $dia = $top->DialogBox(-title => "Clean folder ".basename($dir)."?", -buttons => ['OK', 'Cancel']); - $dia->add("Label", -text => "Remove all sub directories and files from\n$dir\nwhich were created from MaPiVi\nContinue?", -bg => $config{ColorBG}, -justify => "left")->pack; + $dia->add("Label", -text => "Remove all sub folders and files from\n$dir\nwhich were created from MaPiVi\nContinue?", -bg => $config{ColorBG}, -justify => "left")->pack; $dia->add("Checkbutton", -text => "Continue without asking again", -variable => \$cleanDirNoAsk)->pack; $rc = $dia->Show(); return if ($rc ne 'OK'); @@ -25495,8 +26790,8 @@ @fileDirList = readDir($subdir); unless ($cleanDirNoAsk) { $rc = $top->messageBox(-icon => 'question', - -message => "There are ".scalar @fileDirList." files in the sub directory\n".basename($subdir)."\nRemove?", - -title => "Remove sub directory?", + -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); } @@ -25532,8 +26827,8 @@ my $nr = keys %dirh; if (($nr > 0) and (!$cleanDirNoAsk)) { $rc = $top->messageBox(-icon => 'question', - -message => "There are $nr sub directories in\n$dir\n, should I clean them too?", - -title => "Clean sub directories?", + -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); } @@ -26305,10 +27600,12 @@ ############################################################## 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 the lossless drop patch from http://jpegclub.org.", + $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; } @@ -26319,11 +27616,34 @@ return unless checkSelection($top, 1, 0, \@sellist); my $selected = @sellist; my ($dpic, $i); + my $aspectdelta = 1 + ($config{AspectSloppyFactor} / 100); # delta factor for aspect ratio + my $info = ''; - return if (!losslessBorderDialog()); - - my $bi = $config{llBorderWidthI}; # inner width - my $bw = $config{llBorderWidth}; # complete width + 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) { @@ -26340,42 +27660,122 @@ $i = 0; foreach $dpic (@sellist) { last if progressWinCheck($pw); - progressWinUpdate($pw, "creating border ($i/$selected) ...", $i, $selected); + $i++; + progressWinUpdate($pw, "adding border ($i/$selected) ...", $i, $selected); - next if (!checkWriteable($dpic)); - next if (!makeBackup($dpic)); + 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; + } - # get size of pic - my ($x, $y) = getSize($dpic); + 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; + + } - my $cx = $x + 2 * $bw; - my $cy = $y + 2 * $bw; + # 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; + } - my $r1 = $bw - $bi; - my $rx2 = $cx - $bw + $bi - 1; - my $ry2 = $cy - $bw + $bi - 1; + $bix = sprintf("%.0f",($config{RelativeBorderIX} * $w / 100)); + $biy = sprintf("%.0f",($config{RelativeBorderIY} * $h / 100)); - print "losslessBorder: pic $x,$y canvas $cx,$cy rect $r1,$r1 $rx2,$ry2\n" if $verbose; + # 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 - my $command = "convert -size ${cx}x${cy} xc:\"".$config{llBorderColor}."\" -fill \"".$config{llBorderColorI}."\" "; - $command .= "-draw \'rectangle $r1,$r1 $rx2,$ry2\' -quality 95 \"$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) { - warn "losslessBorder: could not create lossless border, skipping $dpic!\n"; + $info .= "$dpic: could not create lossless border - skipping\n"; next; } progressWinUpdate($pw, "adding border ($i/$selected) ...", $i, $selected); - # drop the picture on top of the frame - $command = "jpegtran -drop +${bw}+${bw} \"$dpic\" -outfile \"$dpic\" \"$frame\" "; + # 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); - $i++; - progressWinUpdate($pw, "adding border ($i/$selected) ...", $i, $selected); - if ($config{AddMapiviComment}) { $command =~ s/\"//g; $command = "Picture processed by Mapivi ($mapiviURL):\n".$command; @@ -26390,13 +27790,20 @@ removeFile($frame); reselect($picLB, @sellist); $userinfo = "ready! (added lossless border to $i of $selected)"; $userInfoL->update; + if ($info ne '') { + showText('Add Border Information', $info, NO_WAIT); + } + generateThumbs(ASK, SHOW); } ############################################################## -# losslessBorderDialog +# losslessBorderDialogPixel ############################################################## -sub losslessBorderDialog { +sub losslessBorderDialogPixel { + + my $w = shift; # pixel size of first selcted picture for preview + my $h = shift; if (Exists($ll_b_w)) { $ll_b_w->deiconify; @@ -26404,30 +27811,95 @@ return; } - my $rc = 0; + my $rc = 0; # open window $ll_b_w = $top->Toplevel(); $ll_b_w->title("Add lossless border"); $ll_b_w->iconimage($mapiviicon) if $mapiviicon; - labeledScale($ll_b_w, 'top', 30, "Border width (pixel)", \$config{llBorderWidth}, 8, 200, 8); - labeledEntryColor($ll_b_w,'top',30,"Border color",'Set',\$config{llBorderColor}); - labeledScale($ll_b_w, 'top', 30, "Inner border width (pixel)", \$config{llBorderWidthI}, 1, 50, 1); - labeledEntryColor($ll_b_w,'top',30,"Inner border color",'Set',\$config{llBorderColorI}); + my $fb = $ll_b_w->Frame(-relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3); + $balloon->attach($fb, -msg => "This is the overall width of the border in x- and y-direction.\nAs JPEGs are organized in 8 or 16 pixel blocks only 16 pixel-steps are allowed.\nUse the add-border function if you need other sizes."); + my $fbi = $ll_b_w->Frame(-relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3); + $balloon->attach($fbi, -msg => "This is the width of the inner border in x- and y-direction.\nSet to 0 for no inner border."); + labeledScale($fb, 'top', 35, "Complete border width x-direction", \$config{llBorderWidthX}, 0, 1000, 16); + labeledScale($fb, 'top', 35, "Complete border width y-direction", \$config{llBorderWidthY}, 0, 1000, 16); + labeledEntryColor($fb,'top',35,"Border color",'Set',\$config{llBorderColor}); + labeledScale($fbi, 'top', 35, "Inner border width x-direction", \$config{llBorderWidthIX}, 0, 1000, 1); + labeledScale($fbi, 'top', 35, "Inner border width y-direction", \$config{llBorderWidthIY}, 0, 1000, 1); + labeledEntryColor($fbi,'top',35,"Inner border color",'Set',\$config{llBorderColorI}); buttonBackup($ll_b_w, 'top'); buttonComment($ll_b_w, 'top'); + my $preF = $ll_b_w->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); + $preF->Label(-text => 'Preset ')->pack(-side => 'left'); + $preF->Button(-text => '1 B/W', + -command => sub {$config{llBorderWidthX} = 100; + $config{llBorderWidthY} = 100; + $config{llBorderColor} = 'black'; + $config{llBorderWidthIX} = 2; + $config{llBorderWidthIY} = 2; + $config{llBorderColorI} = 'white'; })->pack(-side => 'left'); + $preF->Button(-text => '2 W/B', + -command => sub {$config{llBorderWidthX} = 100; + $config{llBorderWidthY} = 100; + $config{llBorderColor} = 'white'; + $config{llBorderWidthIX} = 2; + $config{llBorderWidthIY} = 2; + $config{llBorderColorI} = 'black'; })->pack(-side => 'left'); + $preF->Button(-text => '3 P W/B', + -command => sub {$config{llBorderWidthX} = 0; + $config{llBorderWidthY} = 100; + $config{llBorderColor} = 'white'; + $config{llBorderWidthIX} = 0; + $config{llBorderWidthIY} = 2; + $config{llBorderColorI} = 'black'; })->pack(-side => 'left'); + $preF->Button(-text => '4 P B/W', + -command => sub {$config{llBorderWidthX} = 0; + $config{llBorderWidthY} = 100; + $config{llBorderColor} = 'black'; + $config{llBorderWidthIX} = 0; + $config{llBorderWidthIY} = 2; + $config{llBorderColorI} = 'white'; })->pack(-side => 'left'); + my $ButF = $ll_b_w->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); my $OKB = $ButF->Button(-text => 'OK', -command => sub { + # some checks + if (($config{llBorderWidthIX} > $config{llBorderWidthX}) or + ($config{llBorderWidthIY} > $config{llBorderWidthY})) { + $ll_b_w->messageBox(-icon => 'warning', + -message => 'The inner border must be smaller than the complete border.', + -title => 'Lossess border - Error', -type => 'OK'); + return; + } $ll_b_w->withdraw(); $ll_b_w->destroy(); $rc = 1; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); + $ButF->Button(-text => 'Preview', + -command => sub { + # some checks + if (($config{llBorderWidthIX} > $config{llBorderWidthX}) or + ($config{llBorderWidthIY} > $config{llBorderWidthY})) { + $ll_b_w->messageBox(-icon => 'warning', + -message => 'The inner border must be smaller than the complete border.', + -title => 'Lossess border - Error', -type => 'OK'); + return; + } + border_preview($w, $h, $config{llBorderWidthX}, $config{llBorderWidthY}, $config{llBorderColor}, $config{llBorderWidthIX}, $config{llBorderWidthIY}, $config{llBorderColorI}); + })->pack(-side => 'left', -padx => 3, -pady => 3); + + $ButF->Button(-text => 'Help', + -command => sub { + showText('Help for lossless border', + "This function can be used to add a border to a JPEG without losing quality due to recompressing.\n\nHow it works:\nIt will first create a background with the border and then drop the original picture on top of it. The picture is not recompressed and thus every pixel stays exactly the same. The tool jpegtran with the lossless drop patch is used for this task. See http://jpegclub.org.\n\nYou can check this by adding a border to a picture (don't forget to save the original picture by selecting \"Create Backup\") then you crop the border away and compare the original and the processed picture using the Mapivi function \"build difference picture\". If the resulting difference picture is complety black no pixel was changed.\nYou may check this again with a lossy border to see the differences.", + NO_WAIT); + })->pack(-side => 'left', -expand => 0, -padx => 3, -pady => 3); + my $Xbut = $ButF->Button(-text => 'Cancel', -command => sub { $rc = 0; $ll_b_w->withdraw(); @@ -26444,134 +27916,582 @@ } ############################################################## -# importWizard +# border_preview - quick preview in correct proportions, but +# without rescaling the real picture (would +# take too much time). +############################################################## +sub border_preview { + + my $w = shift; # picture size + my $h = shift; + my $bx = shift; # complete border size + my $by = shift; + my $bc = shift; # border color + my $bix = shift; # inner border size + my $biy = shift; + my $bic = shift; # inner border color + my $c; # Canvas + + unless (Exists($bpw)) { + # open window + $bpw = $top->Toplevel(); + $bpw->title('Border Preview'); + $bpw->iconimage($mapiviicon) if $mapiviicon; + + my $fa = $bpw->Frame(-relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3); + + $bpw->{c} = $fa->Canvas(-width => 100, + -height => 100, + -background => 'gray', + -relief => 'sunken', + )->pack(-padx => 3, -pady => 3); + + my $Xbut = $bpw->Button(-text => 'Close', + -command => sub { $bpw->withdraw(); + $bpw->destroy(); + })->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3); + } + + $bpw->deiconify; + $bpw->raise; + + my $wc = $w + 2 * $bx; # complete width + my $hc = $h + 2 * $by; # complete height + + # clear canvas + $bpw->{c}->delete('all'); + + my $per = 0.8; # preview canvas should be 80% of the min screen size + my $preview_size = int($per * $top->screenwidth); + $preview_size = int($per * $top->screenheight) if ($top->screenheight < $top->screenwidth); + + my $max_side = $wc; $max_side = $hc if ($hc > $wc); # longest side + if ($max_side == 0) { warn "border_preview: Error max_side = $max_side"; return; } + + my $scale = $preview_size / $max_side; + + $scale = 1 if ($scale > 1); # we don't want to magnify small pictures + + $bpw->{c}->configure(-width => sprintf("%.0f",($wc*$scale)), + -height => sprintf("%.0f",($hc*$scale)),); + + + # outer border + $bpw->{c}->createRectangle( 0, 0, sprintf("%.0f",($wc*$scale)), sprintf("%.0f",($hc*$scale)), + -fill => $bc, + -width => 0, + ); + + # inner border + if (($bix > 0) or ($biy > 0)) { + $bpw->{c}->createRectangle( sprintf("%.0f",(($bx-$bix)*$scale)), sprintf("%.0f",(($by-$biy)*$scale)), sprintf("%.0f",(($bx+$w+$bix)*$scale)), sprintf("%.0f",(($by+$h+$biy)*$scale)), + -fill => $bic, + -width => 0, + ); + } + + # picture + $bpw->{c}->createRectangle( sprintf("%.0f",($bx*$scale)), sprintf("%.0f",($by*$scale)), sprintf("%.0f",(($bx+$w)*$scale)), sprintf("%.0f",(($by+$h)*$scale)), + -fill => 'gray50', + -width => 0, + ); + + my $font = $top->Font(-family => $config{FontFamily}, -size => 40, -weight => 'bold'); + $bpw->{c}->createText(int(($bx+$w/2)*$scale), int(($by+$h/2)*$scale), -text => 'Picture', -fill => 'black', -font => $font, -anchor => 'c'); + +} + ############################################################## -sub importWizard { +# losslessBorderDialogRelative +############################################################## +sub losslessBorderDialogRelative { - if (Exists($wizW)) { - $wizW->deiconify; - $wizW->raise; + if (Exists($ll_r_w)) { + $ll_r_w->deiconify; + $ll_r_w->raise; return; } - my $pics = shift; my $rc = 0; # open window - $wizW = $top->Toplevel(); - $wizW->title("Import pictures wizard"); - $wizW->iconimage($mapiviicon) if $mapiviicon; + $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}); - $wizW->Label(-text => "Import pictures from a removable device like e.g. a camera\nor a card reader connected via e.g. USB.\nThe selected actions will take place in the displayed order.", -bg => $config{ColorBG}, -justify => "left")->pack(-anchor => 'w', -padx => 3, -pady => 3); + $ll_r_w->Checkbutton(-text => 'Symmetric border (biggest wins)', -variable => \$config{RelativeBorderEqual})->pack(-anchor => 'w', -padx => 5, -pady => 5); - my ($s,$m,$ho,$d,$mo,$y) = localtime(time()); - # do some adjustments - $y += 1900; $mo++; - # build up the date string for the dir structure (e.g. "2006/10/29") - my $date = sprintf "%04d/%02d/%02d", $y, $mo, $d; + buttonBackup($ll_r_w, 'top'); + buttonComment($ll_r_w, 'top'); - my $w = 32; - my $w2 = $w - 3; + my $ButF = $ll_r_w->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); - if (!$EvilOS && !$MacOSX) { - my $moF = $wizW->Frame()->pack(-anchor => 'w', -fill => 'x'); - $moF->Checkbutton(-variable => \$config{ImportMount}, - -anchor => 'w', - #-width => $w2*2, - -text => "Mount device" - )->pack(-side => "left", -anchor => 'w', -padx => 3, -pady => 3); - $moF->Label(-textvariable => \$config{ImportDevice}, - -anchor => 'w', - -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w', -padx => 3, -pady => 3); - $moF->Button(-text => 'Set', - -command => sub { - mountDialog(); - $wizW->raise; - })->pack(-side => "right", -anchor => 'w', -padx => 3, -pady => 3); - $moF->Button(-text => "Mount now", - -command => sub { - my $command = "mount ".$config{ImportDevice}; - execute($command); - })->pack(-side => "right", -anchor => 'w', -padx => 3, -pady => 3); - } - else { - $config{ImportMount} = 0; # no mount for windows - # Mac OS X automounts when the device is plugged in. - } + my $OKB = $ButF->Button(-text => 'OK', + -command => sub { + # some checks + if (($config{RelativeBorderIX} > $config{RelativeBorderX}) or + ($config{RelativeBorderIY} > $config{RelativeBorderY})) { + $ll_r_w->messageBox(-icon => 'warning', + -message => 'The inner border must be smaller than the complete border.', + -title => 'Lossess border - Error', -type => 'OK'); + return; + } + $ll_r_w->withdraw(); + $ll_r_w->destroy(); + $rc = 1; + })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); - labeledEntryButton($wizW,'top',$w,"Source directory",'Set',\$config{ImportSource}, 1); - $wizW->Checkbutton(-variable => \$config{ImportSubdirs}, - -anchor => 'w', - -text => "Import from all sub directories, too" - )->pack(-side => 'top', -anchor => 'w', -padx => 3, -pady => 3); - labeledEntryButton($wizW,'top',$w,"Target directory (fix part)",'Set',\$config{ImportTargetFix}, 1); - my $varF = $wizW->Frame()->pack(-anchor => 'w', -fill => 'x'); - labeledEntry($varF,"left",$w,"Target directory (variable part)",\$config{ImportTargetVar}); - $varF->Button(-text => 'Set' , -command => sub {$config{ImportTargetVar} = $date;})->pack(-side => "right", -padx => 3, -pady => 3); - $varF->Label(-text => "actual date:", - -anchor => "e", - -bg => $config{ColorBG})->pack(-side => "right", -anchor => 'w', -padx => 3, -pady => 3); + $ButF->Button(-text => 'Help', + -command => sub { + showText('Help for relative border (lossless)', + "This function can be used to add a border to a JPEG without losing quality due to recompressing.\nThe actual border width in pixel will be calculated depending on the picture size. As JPEGs are organized in 8 or 16 pixel blocks the complete border width will be in 16 pixel-steps.\nThe inner border may be have any width, set it to 0 to have just one frame. If the inner border is bigger than 0, then it will be at least one pixel.\n\nHow it works:\nIt will first create a background with the border and then drop the original picture on top of it. The picture is not recompressed and thus every pixel stays exactly the same. The tool jpegtran with the lossless drop patch is used for this task. See http://jpegclub.org.\n\nYou can check this by adding a border to a picture (don't forget to save the original picture by selecting \"Create Backup\") then you crop the border away and compare the original and the processed picture using the Mapivi function \"build difference picture\". If the resulting difference picture is complety black no pixel was changed.\nYou may check this again with a lossy border to see the differences.", + NO_WAIT); + })->pack(-side => 'left', -expand => 0, -padx => 3, -pady => 3); - my $dpF = $wizW->Frame()->pack(-anchor => 'w', -fill => 'x'); - my $dpC = $dpF->Checkbutton(-variable => \$config{ImportDeadPixel}, - -anchor => 'w', - -text => "Interpolate dead pixels" - )->pack(-side => "left", -anchor => 'w', -padx => 3, -pady => 3); - my $dpB = $dpF->Button(-text => 'Set', - -command => sub { - interpolateDialog(); - $wizW->raise; - })->pack(-side => "right", -anchor => 'w', -padx => 3, -pady => 3); - if (missingProgs("Interpolate dead pixels", "jpegpixi")) { - $config{ImportDeadPixel} = 0; # disabled if jpegpixi is not available - $dpC->configure(-state => "disabled"); - $dpB->configure(-state => "disabled"); - $dpC->configure(-disabledforeground => 'gray30'); - $dpB->configure(-disabledforeground => 'gray30'); - $balloon->attach($dpF, -msg => explainMissingProg("Interpolate dead pixels", "jpegpixi")); - } + my $Xbut = $ButF->Button(-text => 'Cancel', + -command => sub { $rc = 0; + $ll_r_w->withdraw(); + $ll_r_w->destroy(); + })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); - my $rot = $wizW->Checkbutton(-variable => \$config{ImportRotate}, - -anchor => 'w', - -text => "Automatic rotation (lossless)" - )->pack(-anchor => 'w', -padx => 3, -pady => 3); - if (missingProgs("Automatic rotation", "jhead") > 0) { - $config{ImportRotate} = 0; # disabled if jhead is not available - $rot->configure(-state => "disabled"); - $rot->configure(-disabledforeground => 'gray30'); - $balloon->attach($rot, -msg => explainMissingProg("Automatic rotation", "jhead")); - } + $ll_r_w->bind('', sub { $Xbut->invoke; }); + $ll_r_w->bind('', sub { $Xbut->invoke; }); - my $comF = $wizW->Frame()->pack(-anchor => 'w', -fill => 'x'); - $comF->Checkbutton(-variable => \$config{NameComment}, - -anchor => 'w', - -text => "Add original file name to comment (" - )->pack(-side => "left", -anchor => 'w', -padx => 3, -pady => 3); - $comF->Checkbutton(-variable => \$config{NameComRmSuffix}, - -anchor => 'w', - -text => "remove file suffix )" - )->pack(-side => "left", -anchor => 'w', -padx => 0, -pady => 3); + $ll_r_w->Popup; + $ll_r_w->waitWindow; - my $acomF = $wizW->Frame()->pack(-anchor => 'w', -fill => 'x'); - $acomF->Checkbutton(-variable => \$config{ImportAddCom}, - -anchor => 'w', - -text => '', - )->pack(-side => 'left', -anchor => 'w', -padx => 3, -pady => 3); - labeledEntry($acomF,"left",$w,"Add this comment to each picture",\$config{ImportAddComment}); + return $rc; +} - my $iptcF = $wizW->Frame()->pack(-anchor => 'w', -fill => 'x'); - $iptcF->Checkbutton(-variable => \$config{ImportAddIPTC}, - -anchor => 'w', - -text => '', - )->pack(-side => 'left', -anchor => 'w', -padx => 3, -pady => 3); +############################################################## +# losslessBorderDialogAspect +############################################################## +sub losslessBorderDialogAspect { + + if (Exists($ll_a_w)) { + $ll_a_w->deiconify; + $ll_a_w->raise; + return; + } + + my $rc = 0; + + # open window + $ll_a_w = $top->Toplevel(); + $ll_a_w->title("Add border to aspect ratio (lossless)"); + $ll_a_w->iconimage($mapiviicon) if $mapiviicon; + + my $oF = $ll_a_w->Frame(-relief => 'groove')->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3); + $oF->Label(-text => 'Aspect ratio ')->pack(-side => 'left', -padx => 3, -pady => 3); + $oF->Entry(-textvariable => \$config{AspectBorderN}, -width => 5, -justify => 'right')->pack(-side => 'left', -padx => 3, -pady => 3); + $oF->Label(-text => ':')->pack(-side => 'left', -padx => 3, -pady => 3); + $oF->Entry(-textvariable => \$config{AspectBorderM}, -width => 5)->pack(-side => 'left', -padx => 3, -pady => 3); + #labeledEntry($oF,'left',17,': Aspect ratio M',\$config{AspectBorderM}); + + my $aF = $ll_a_w->Frame(-relief => 'groove')->pack(-padx => 3, -pady => 3); + $aF->Label(-text => 'Presets')->pack(); + $aF->Button(-text => "3:2 (e.g. 10x15)", -anchor => 'w', + -command => sub { $config{AspectBorderN} = 3; $config{AspectBorderM} = 2; } + )->pack(-anchor => 'w', -fill => 'x', -padx => 3, -pady => 3); + $aF->Button(-text => "4:3", -anchor => 'w', + -command => sub { $config{AspectBorderN} = 4; $config{AspectBorderM} = 3; } + )->pack(-anchor => 'w', -fill => 'x', -padx => 3, -pady => 3); + $aF->Button(-text => "5:4 (PAL)", -anchor => 'w', + -command => sub { $config{AspectBorderN} = 5; $config{AspectBorderM} = 4; } + )->pack(-anchor => 'w', -fill => 'x', -padx => 3, -pady => 3); + $aF->Button(-text => "7:5 (e.g. 13x18)", -anchor => 'w', + -command => sub { $config{AspectBorderN} = 7; $config{AspectBorderM} = 5; } + )->pack(-anchor => 'w', -fill => 'x', -padx => 3, -pady => 3); + $aF->Button(-text => "16:9", -anchor => 'w', + -command => sub { $config{AspectBorderN} = 16; $config{AspectBorderM} = 9; } + )->pack(-anchor => 'w', -fill => 'x', -padx => 3, -pady => 3); + $aF->Button(-text => "1:1", -anchor => 'w', + -command => sub { $config{AspectBorderN} = 1; $config{AspectBorderM} = 1; } + )->pack(-anchor => 'w', -fill => 'x', -padx => 3, -pady => 3); + + labeledEntryColor($ll_a_w,'top',12,'Border color','Set',\$config{llBorderColor}); + + buttonBackup($ll_a_w, 'top'); + buttonComment($ll_a_w, 'top'); + + my $ButF = $ll_a_w->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); + + my $OKB = $ButF->Button(-text => 'OK', + -command => sub { + # some checks + if (($config{AspectBorderM} !~ m|^\d+$|) or # must be an integer + ($config{AspectBorderN} !~ m|^\d+$|)) { + $ll_a_w->messageBox(-icon => 'warning', + -message => 'Aspect ratio must be a natural number', + -title => 'Aspect ratio border - Error', -type => 'OK'); + return; + } + if (($config{AspectBorderM} <= 0) or + ($config{AspectBorderN} <= 0)) { + $ll_a_w->messageBox(-icon => 'warning', + -message => 'Aspect ratio must be positive and bigger than 0', + -title => 'Aspect ratio border - Error', -type => 'OK'); + return; + } + $ll_a_w->withdraw(); + $ll_a_w->destroy(); + $rc = 1; + })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); + + $ButF->Button(-text => 'Help', + -command => sub { + showText('Help for lossless aspect ratio border', + "This function can be used to add a border to a JPEG to fit the selected aspect ratio without losing quality due to recompressing.\nAs JPEGs are organized in 8 or 16 pixel blocks the complete border width will be in 16 pixel-steps. Thus the resulting picture will not always match the selected aspect ratio.\n\nHow it works:\nIt will first create a background with the border and then drop the original picture on top of it. The picture is not recompressed and thus every pixel stays exactly the same. The tool jpegtran with the lossless drop patch is used for this task. See http://jpegclub.org.\n\nYou can check this by adding a border to a picture (don't forget to save the original picture by selecting \"Create Backup\") then you crop the border away and compare the original and the processed picture using the Mapivi function \"build difference picture\". If the resulting difference picture is complety black no pixel was changed.\nYou may check this again with a lossy border to see the differences.", + NO_WAIT); + })->pack(-side => 'left', -expand => 0, -padx => 3, -pady => 3); + + my $Xbut = $ButF->Button(-text => 'Cancel', + -command => sub { $rc = 0; + $ll_a_w->withdraw(); + $ll_a_w->destroy(); + })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); + + $ll_a_w->bind('', sub { $Xbut->invoke; }); + $ll_a_w->bind('', sub { $Xbut->invoke; }); + + $ll_a_w->Popup; + $ll_a_w->waitWindow; + + return $rc; +} + +############################################################## +# losslessWatermark - add a watermark to the selected pics +# without recompressing the whole picture +############################################################## +sub losslessWatermark { + + # check if jpegtran supports lossless dropping + my $usage = `jpegtran -? 2>&1`; + if ($usage !~ m/.*-drop.*/) { + $top->messageBox(-icon => 'warning', -message => "Sorry, but your version of jpegtran does not support lossless dropping!\nTry to get jpegtran with the lossless drop patch from http://jpegclub.org.", + -title => "Wrong jpegtran version", -type => 'OK'); + return; + } + + # todo: + # 1. Select a part of the picture with e.g. the crop dialog + # 2. Select a font and size and enter a text + # 3. crop the selected part out of the picture + # 4. add the text to the crop: + # convert crop.jpg -pointsize 120 -fill white -gravity center + # -annotate 0 'Mapivi' -quality 95 crop2.jpg + # 5. lossless drop the crop at the same position + + # benefit: as color sampling is from original picture there should + # be no problem with lossless drop + + my @sellist = $picLB->info('selection'); + return unless checkSelection($top, 1, 0, \@sellist); + my $selected = @sellist; + my ($dpic, $i); + + return if (!losslessWatermarkDialog()); + + my $wmx = $config{llWatermarkX}; # X position + my $wmy = $config{llWatermarkY}; # Y position + my $file = $config{llWatermarkFile}; # the picture to add + + # get size of watermark pic + my ($wmw, $wmh) = getSize($file); + + $userinfo = "adding lossless watermark to $selected pictures"; $userInfoL->update; + + # check if some files are links + return if (!checkLinks($picLB, @sellist)); + + my $error = ''; + my $pw = progressWinInit($top, "Adding lossless watermark"); + $i = 0; + foreach $dpic (@sellist) { + last if progressWinCheck($pw); + progressWinUpdate($pw, "adding watermark ($i/$selected) ...", $i, $selected); + + next if (!checkWriteable($dpic)); + next if (!makeBackup($dpic)); + + # todo: either just drop a existing pic or + # 1. crop a part of the picture -> cropPic($dpic,$w,$h,$x,$y,95); + # 2. write a text on this crop -> convert crop.jpg -pointsize 50 -gravity south -stroke '#000C' -strokewidth 2 -annotate 0 'Martin' -stroke none -fill white -annotate 0 'Martin' crop-text.jpg + # 3. drop it back on the same position + + # get size of pic + my ($w, $h) = getSize($dpic); + + if (($wmx + $wmw > $w) or ($wmy + $wmh > $h)) { + $error .= "$dpic: watermark out of picture - skipped\n"; + next; + } + + # drop the watermark lossless! on top of the picture + # no recompression of the picture! + my $position = ''; + if ($wmx >= 0) { $position = "+"; } + $position .= $wmx; + if ($wmy >= 0) { $position .= "+"; } + $position .= $wmy; + + # todo: still unclear what the -trim and -perfect switch does + #my $command = "jpegtran -copy all -trim -perfect -drop $position \"$file\" -outfile \"$dpic\" \"$dpic\" "; + my $command = "jpegtran -copy all -drop $position \"$file\" -outfile \"$dpic\" \"$dpic\" "; + execute($command); + + $i++; + progressWinUpdate($pw, "adding watermark ($i/$selected) ...", $i, $selected); + + if ($config{AddMapiviComment}) { + $command =~ s/\"//g; + $command = "Picture processed by Mapivi ($mapiviURL):\n".$command; + addCommentToPic($command, $dpic, NO_TOUCH); + } + updateOneRow($dpic, $picLB); + + deleteCachedPics($dpic); + showPic($dpic) if ($dpic eq $actpic); # redisplay the picture if it is the actual one + } + progressWinEnd($pw); + if ($error ne '') { + $error = "Some pictures caused errors:\n\n".$error; + showText('Watermark errors', $error, NO_WAIT); + } + reselect($picLB, @sellist); + $userinfo = "ready! (added lossless watermark to $i of $selected)"; $userInfoL->update; + generateThumbs(ASK, SHOW); +} + +############################################################## +# losslessWatermarkDialog +############################################################## +sub losslessWatermarkDialog { + + if (Exists($ll_w_w)) { + $ll_w_w->deiconify; + $ll_w_w->raise; + return; + } + + my $rc = 0; + + # open window + $ll_w_w = $top->Toplevel(); + $ll_w_w->title("Add lossless watermark"); + $ll_w_w->iconimage($mapiviicon) if $mapiviicon; + + #$balloon->attach($fb, -msg => "This is the overall width of the border in x- and y-direction.\nAs JPEGs are organized in 8 or 16 pixel blocks only 16 pixel-steps are allowed.\nUse the add-border function if you need other sizes."); + + labeledEntry($ll_w_w,'top',35,"x-position",\$config{llWatermarkX}); + labeledEntry($ll_w_w,'top',35,"y-position",\$config{llWatermarkY}); + labeledEntryButton($ll_w_w,'top',35,"Watermark picture (JPEG)",'Set', \$config{llWatermarkFile}); + + buttonBackup($ll_w_w, 'top'); + buttonComment($ll_w_w, 'top'); + + my $ButF = $ll_w_w->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); + + my $OKB = $ButF->Button(-text => 'OK', + -command => sub { + # some checks + unless (-f $config{llWatermarkFile}) { + $ll_w_w->messageBox(-icon => 'warning', + -message => 'The watermark picture could not be found.', + -title => 'File not found', -type => 'OK'); + return; + } + unless (is_a_JPEG($config{llWatermarkFile})) { + $ll_w_w->messageBox(-icon => 'warning', + -message => 'The watermark picture is no JPEG.', + -title => 'File not found', -type => 'OK'); + return; + } + $ll_w_w->withdraw(); + $ll_w_w->destroy(); + $rc = 1; + })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); + + # todo + $ButF->Button(-text => 'Help', + -command => sub { + showText('Help for lossless watermark', + "This function can be used to add a watermark (small graphic) to a JPEG without losing quality due to recompressing.\n\nHow it works:\nIt will drop the rectangular small watermark picture on top of the original picture. The picture is not recompressed and thus every pixel stays exactly the same. Both pictures must have the same JPEG sampling factors!\nThe tool jpegtran with the lossless drop patch is used for this task. See http://jpegclub.org.\n\nYou can check this by adding a watermark to a picture (don't forget to save the original picture by selecting \"Create Backup\") then you compare the original and the processed picture using the Mapivi function \"build difference picture\". If the resulting difference picture is complety black (except where the watermark was added) no pixel was changed.", + NO_WAIT); + })->pack(-side => 'left', -expand => 0, -padx => 3, -pady => 3); + + my $Xbut = $ButF->Button(-text => 'Cancel', + -command => sub { $rc = 0; + $ll_w_w->withdraw(); + $ll_w_w->destroy(); + })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); + + $ll_w_w->bind('', sub { $Xbut->invoke; }); + $ll_w_w->bind('', sub { $Xbut->invoke; }); + + $ll_w_w->Popup; + $ll_w_w->waitWindow; + + return $rc; +} + +############################################################## +# importWizard +############################################################## +sub importWizard { + + if (Exists($wizW)) { + $wizW->deiconify; + $wizW->raise; + return; + } + + my $pics = shift; + my $rc = 0; + + # open window + $wizW = $top->Toplevel(); + $wizW->title("Import pictures wizard"); + $wizW->iconimage($mapiviicon) if $mapiviicon; + + my $i_text = $wizW->Scrolled("ROText", + -scrollbars => 'osoe', + -wrap => 'word', + -width => 70, + -height => 5, + -relief => "flat", + -bd => 0 + )->pack(-fill => 'both', -expand => "0", -padx => 3, -pady => 3); + $i_text->insert('end', "Import pictures from a removable device like e.g. a camera or a card reader connected via e.g. USB.\nThe selected actions will take place in the displayed order.\nMapivi is rather paranoid when importing pictures to be on the safe side.\nIf there are any errors during import (like a mismatch in the number of files or file size) you will be asked how to proceed."); + + + my ($s,$m,$ho,$d,$mo,$y) = localtime(time()); + # do some adjustments + $y += 1900; $mo++; + # build up the date string for the dir structure (e.g. "2007/10/29") + my $date = sprintf "%04d/%02d/%02d", $y, $mo, $d; + + my $w = 32; + my $w2 = $w - 3; + + + labeledEntryButton($wizW,'top',$w,"Source folder",'Set',\$config{ImportSource}, 1); + $wizW->Checkbutton(-variable => \$config{ImportSubdirs}, + -anchor => 'w', + -text => "Import from all sub folders, too" + )->pack(-side => 'top', -anchor => 'w', -padx => 3, -pady => 3); + labeledEntryButton($wizW,'top',$w,"Target folder (fix part)",'Set',\$config{ImportTargetFix}, 1); + my $varF = $wizW->Frame()->pack(-anchor => 'w', -fill => 'x'); + labeledEntry($varF,"left",$w,"Target folder (variable part)",\$config{ImportTargetVar}); + $varF->Button(-text => 'Set' , -command => sub {$config{ImportTargetVar} = $date;})->pack(-side => "right", -padx => 3, -pady => 3); + $varF->Label(-text => "actual date:", + -anchor => "e", + -bg => $config{ColorBG})->pack(-side => "right", -anchor => 'w', -padx => 3, -pady => 3); + + my $moreF = $wizW->Frame(-relief => 'groove'); + + my $more_button; + + $more_button = $wizW->Checkbutton(-variable => \$config{ImportMore}, + -anchor => 'w', + -text => 'more options', + -command => sub { + if ($config{ImportMore}) { + $moreF->pack(-after => $more_button, -fill => 'x', -expand => 0, -padx => 4, -pady => 3); + } + else { $moreF->packForget(); } + })->pack(-padx => 3, -anchor => 'w'); + + if ($config{ImportMore}) { + $moreF->pack(-after => $more_button, -expand => 0, -fill => 'x', -padx => 4, -pady => 3); + } + else { $moreF->packForget(); } + + + my $dpF = $moreF->Frame()->pack(-anchor => 'w', -fill => 'x'); + my $dpC = $dpF->Checkbutton(-variable => \$config{ImportDeadPixel}, + -anchor => 'w', + -text => "Interpolate dead pixels" + )->pack(-side => "left", -anchor => 'w', -padx => 3, -pady => 3); + my $dpB = $dpF->Button(-text => 'Set', + -command => sub { + interpolateDialog(); + $wizW->raise; + })->pack(-side => "right", -anchor => 'w', -padx => 3, -pady => 3); + if (missingProgs("Interpolate dead pixels", "jpegpixi")) { + $config{ImportDeadPixel} = 0; # disabled if jpegpixi is not available + $dpC->configure(-state => "disabled"); + $dpB->configure(-state => "disabled"); + $dpC->configure(-disabledforeground => 'gray30'); + $dpB->configure(-disabledforeground => 'gray30'); + $balloon->attach($dpF, -msg => explainMissingProg("Interpolate dead pixels", "jpegpixi")); + } + + my $rot = $wizW->Checkbutton(-variable => \$config{ImportRotate}, + -anchor => 'w', + -text => "Automatic rotation (lossless)" + )->pack(-anchor => 'w', -padx => 3, -pady => 3); + if (missingProgs("Automatic rotation", "jhead") > 0) { + $config{ImportRotate} = 0; # disabled if jhead is not available + $rot->configure(-state => "disabled"); + $rot->configure(-disabledforeground => 'gray30'); + $balloon->attach($rot, -msg => explainMissingProg("Automatic rotation", "jhead")); + } + + my $comF = $moreF->Frame()->pack(-anchor => 'w', -fill => 'x'); + $comF->Checkbutton(-variable => \$config{NameComment}, + -anchor => 'w', + -text => "Add original file name to comment (" + )->pack(-side => "left", -anchor => 'w', -padx => 3, -pady => 3); + $comF->Checkbutton(-variable => \$config{NameComRmSuffix}, + -anchor => 'w', + -text => "remove file suffix )" + )->pack(-side => "left", -anchor => 'w', -padx => 0, -pady => 3); + + my $acomF = $moreF->Frame()->pack(-anchor => 'w', -fill => 'x'); + $acomF->Checkbutton(-variable => \$config{ImportAddCom}, + -anchor => 'w', + -text => '', + )->pack(-side => 'left', -anchor => 'w', -padx => 3, -pady => 3); + labeledEntry($acomF,"left",$w,"Add this comment to each picture",\$config{ImportAddComment}); + + + my $iptcF = $moreF->Frame()->pack(-anchor => 'w', -fill => 'x'); + $iptcF->Checkbutton(-variable => \$config{ImportAddIPTC}, + -anchor => 'w', + -text => '', + )->pack(-side => 'left', -anchor => 'w', -padx => 3, -pady => 3); labeledEntryButton($iptcF,'top',$w,"Add IPTC info to each picture",'Set',\$config{ImportIPTCTempl}); + my $lockB = $moreF->Checkbutton(-variable => \$config{ImportMarkLocked}, + -anchor => 'w', + -text => "Add high rating to locked pictures" + )->pack(-anchor => 'w', -padx => 3, -pady => 3); + $balloon->attach($lockB, -msg => "Some digital cameras allow to lock pictures.\nThis feature can be used to mark important pictures already in the camera.\nIf this function is enabled Mapivi will add a high rating to all locked pictures\n(files with write protection)."); + + $moreF->Checkbutton(-variable => \$config{ImportDeleteCameraJunk}, + -anchor => 'w', + -text => "Delete camera junk files in target folder after copy (e.g. *.CTG)" + )->pack(-anchor => 'w', -padx => 3, -pady => 3); + my $renF = $wizW->Frame()->pack(-anchor => 'w', -fill => 'x'); $renF->Checkbutton(-variable => \$config{ImportRename}, -anchor => 'w', -text => "Smart Rename with this pattern:" - )->pack(-side => "left", -anchor => 'w', -padx => 3, -pady => 3); + )->pack(-side => "left", -anchor => 'w', -padx => 2, -pady => 3); $renF->Label(-textvariable => \$config{FileNameFormat}, -bg => $config{ColorBG}, -anchor => 'w', @@ -26582,36 +28502,11 @@ getRenameFormat(); })->pack(-side => "right", -anchor => 'w', -padx => 3, -pady => 3); - $wizW->Checkbutton(-variable => \$config{ImportDeleteCameraJunk}, - -anchor => 'w', - -text => "Delete camera junk files in target directory after copy (e.g. *.CTG)" - )->pack(-anchor => 'w', -padx => 3, -pady => 3); - $wizW->Checkbutton(-variable => \$config{ImportDelete}, -anchor => 'w', - -text => "Delete files in source directory after copy" + -text => "Delete files in source folder after copy" )->pack(-anchor => 'w', -padx => 3, -pady => 3); - if (!$EvilOS) { - my $ejF = $wizW->Frame()->pack(-anchor => 'w', -fill => 'x'); - $ejF->Checkbutton(-variable => \$config{ImportUnmount}, - -anchor => 'w', - #-width => $w2*2, - -text => "Unmount device when finished" - )->pack(-side => "left", -anchor => 'w', -padx => 3, -pady => 3); - # It is not necessary to set the mount device in Mac OS X, because - # the diskutil command can unmount by the name of the source dir. - if (!$MacOSX) { - $ejF->Button(-text => 'Set', - -command => sub { - mountDialog(); - $wizW->raise; - })->pack(-side => "right", -anchor => 'w', -padx => 3, -pady => 3); - } - } - else { - $config{ImportUnmount} = 0; # no umount for windows - } $wizW->Checkbutton(-variable => \$config{ImportShowPics}, -anchor => 'w', @@ -26654,14 +28549,13 @@ my $printW; ############################################################## -# copyToPrint - copy pics to print directories +# copyToPrint - copy pics to print folders # (e.g. 2_times_5x7/ or 1_times_13x18/) ############################################################## sub copyToPrint { - my $lb =shift; - - my @sellist = $lb->info('selection'); + my $lb = shift; # the reference to the active listbox widget + my @sellist = getSelection($lb); return unless checkSelection($top, 1, 0, \@sellist); if (Exists($printW)) { @@ -26675,10 +28569,10 @@ # open window $printW = $lb->Toplevel(); - $printW->title("copy pictures to print directory"); + $printW->title("copy pictures to print folder"); $printW->iconimage($mapiviicon) if $mapiviicon; - $printW->Label(-text => "Copy ".scalar @sellist." pictures to a according print directory.", -bg => $config{ColorBG}, -justify => "left")->pack(-anchor => 'w', -padx => 3, -pady => 3); + $printW->Label(-text => "Copy ".scalar @sellist." pictures to a according print folder.", -bg => $config{ColorBG}, -justify => "left")->pack(-anchor => 'w', -padx => 3, -pady => 3); my $w = 32; my $w2 = $w - 3; @@ -26687,7 +28581,7 @@ my $timesStr = "times"; my $size = "10x15"; - labeledEntryButton($printW,'top',$w,"Print base directory",'Set',\$config{PrintBaseDir}, 1); + labeledEntryButton($printW,'top',$w,"Print base folder",'Set',\$config{PrintBaseDir}, 1); my $sf = $printW->Frame()->pack(); $sf->Label(-text => "numer, string and size", -width => $w, -bg => $config{ColorBG}, -justify => "left")->pack(-side => "left"); @@ -26706,7 +28600,7 @@ )->pack(-side => "left", -anchor => 'w'); - labeledEntry($printW,'top',$w,"directory",\$config{PrintVarDir}); + labeledEntry($printW,'top',$w,"folder",\$config{PrintVarDir}); my $ButF = $printW->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); @@ -26734,7 +28628,7 @@ if (!-d $config{PrintBaseDir}) { my $rc = $top->messageBox(-icon => 'question', -message => $config{PrintBaseDir}." does not exist. Should I create it?", - -title => "Create print base directory?", -type => 'OKCancel'); + -title => "Create print base folder?", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); eval { mkpath($config{PrintBaseDir}, 0, 0755) }; # 0 = no output, 0755 = access rights @@ -26770,21 +28664,13 @@ ############################################################## sub importPictures { - ############################################################## - ##### mount device - if ($config{ImportMount}) { - $userinfo = "mounting ".$config{ImportDevice}." ..."; $userInfoL->update; - my $command = "mount ".$config{ImportDevice}; - execute($command); - } - my $source = $config{ImportSource}; ##### check source dir - $userinfo = "checking directories ..."; $userInfoL->update; + $userinfo = "checking folders ..."; $userInfoL->update; if (!-d $source) { $top->messageBox(-icon => 'warning', - -message => "Sorry, but the source directory\n$source\ndoes not exists!\nPlease check, if the device is mounted.", + -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; } @@ -26862,8 +28748,9 @@ my $dcount = 0; # progress of dirs my $pcount = 0; # progress of pics + my $rating_count = 0; # counter for locked pictures with successfull added rating my $progF = $impW->Frame()->pack(-expand => 1, -fill =>'x'); - $progF->Label(-text => "progress directories ", -bg => $config{ColorBG})->pack(-side => "left"); + $progF->Label(-text => "progress folders ", -bg => $config{ColorBG})->pack(-side => "left"); $progF->ProgressBar(-takefocus => 0, -borderwidth => 1, -relief => 'sunken', @@ -26913,14 +28800,14 @@ foreach $source (@sdirs) { last if $stop; $dcount++; - $rotext->insert('end', "in directory ($dcount/".scalar @sdirs.") $source ...\n", "G"); $impW->update; + $rotext->insert('end', "in folder ($dcount/".scalar @sdirs.") $source ...\n", "G"); $impW->update; ##### get and check files to import my @importfiles = getFiles($source); print "In dir $source are ".@importfiles." files\n" if $verbose; if (@importfiles <= 0) { - $rotext->insert('end', " no pictures in this directory - skipping\n", "R"); $rotext->see('end'); + $rotext->insert('end', " no pictures in this folder - skipping\n", "R"); $rotext->see('end'); next; } @@ -26939,6 +28826,30 @@ $rotext->see('end'); $impW->update; mycopy("$source/$file", "$tdir/$file", ASK_OVERWRITE); + if ($config{ImportMarkLocked}) { + # if source file is write protected + if (!-w "$source/$file") { + # add rating 1 to target file + my $meta = getMetaData("$tdir/$file", 'APP13'); + my $iptc = $meta->get_app13_data('TEXTUAL', 'IPTC'); + if ($iptc->{error}) { + warn "IPTC segment of $file has errors!"; + $rotext->insert('end', " locked picture, but IPTC segment has errors!\n"); + } + else { + $iptc->{Urgency} = 1; + $meta->set_app13_data($iptc, 'REPLACE', 'IPTC'); + if (!$meta->save()) { + $rotext->insert('end', " locked picture, but writing of rating failed!\n"); + } + else { + $rotext->insert('end', " locked picture, setting rating to 1!\n"); + $rating_count++; + } + } + $rotext->see('end'); + } + } $sum += $size if (-f "$tdir/$file"); } my $duration = Tk::timeofday() - $startTime; # in seconds @@ -26957,9 +28868,11 @@ } if (($filediff > 0) or ($sizediff > 0)) { + my $rating_info = ""; + $rating_info = "$rating_count locked pictures found and rating added. This will increase the file size and may explain the difference.\n"; my $rc = $top->messageBox(-icon => 'question', - -message => "Not all files in the source and target directory are eqal.\n$filediff files are missing and $sizediff files have another size.\nShould I continue?", - -title => "Continue?", -type => 'OKCancel'); + -message => "Not all files in the source and target folder are eqal.\n$filediff files are missing and $sizediff files have another size.\n${rating_info}Should I continue?", + -title => "Continue importing pictures?", -type => 'OKCancel'); return 0 if ($rc !~ m/Ok/i); } @@ -27118,7 +29031,7 @@ # check if everything is alright if (($filediff > 0) or ($sizediff > 0)) { my $rc = $top->messageBox(-icon => 'question', - -message => "There have been some warnings while importing.\nShould I continue and delete the ".scalar @importfiles." files in the source directory?", + -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); } @@ -27138,24 +29051,6 @@ $stopB->configure(-state => "disabled"); - ############################################################## - ##### unmount device - if ($config{ImportUnmount}) { - my $command; - my $mountpoint; - if ($MacOSX) { - $command = "diskutil unmount"; - $mountpoint = $config{ImportSource}; - } else { - # todo: don't know what fits better - #$command = "umount"; - $command = "eject"; - $mountpoint = $config{ImportDevice}; - } - $rotext->insert('end', "unmounting $mountpoint\n"); $rotext->see('end'); $rotext->update; - execute("$command \"$mountpoint\""); - } - ($s,$m,$ho,$d,$mo,$y) = localtime(time()); $time = sprintf "%02d:%02d:%02d", $ho, $m, $s; $rotext->insert('end', "$time import finished!\n", "B"); $rotext->see('end'); $rotext->update; @@ -27163,19 +29058,34 @@ } ############################################################## -# mountDialog +# dock_keyword_dialog ############################################################## -sub mountDialog { +sub dock_keyword_dialog { + # only if dock is selected + return unless ($config{KeywordDialogDock}); + # and the keyword dialog is open + return unless (Exists($keyw)); + + # get coordinates of main window + my $geo = $top->geometry; + my ($tw, $th, $tx, $ty) = splitGeometry($geo); + # take the border and menubar into account + my $rootx = $top->rootx; + my $borderx = $rootx-$tx; - my $device = $config{ImportDevice}; - my $rc = myEntryDialog('Set mount device', - 'Please enter the device to mount/unmount, when importing pictures. -(Mapivi will execute the commands "mount" and "umount" with this device.)', - \$device); - if ($rc eq 'OK') { - $config{ImportDevice} = $device; + # get coordinates of keyword window + $geo = $keyw->geometry; + my ($w, $h, $x, $y) = splitGeometry($geo); + if ($config{KeywordDialogDockL}) { + # move keyword window to left side of main window + $x = $tx - $w - 2*$borderx; } - + else { + # move keyword window to right side of main window + $x = $tx + $tw + 2*$borderx; + } + $h = $th + 4*$borderx + 3; + $keyw->geometry("${w}x${h}+${x}+${ty}"); } ############################################################## @@ -27265,29 +29175,33 @@ my $index = shift; my $total = shift; - if ($total == 0) { - warn "total ($total) is zero!"; - return; - } + $pw->{label} = $string; - my $add_str = ""; - my $percent = int(($index/$total)*100); - my $min = 0; - my $sec = int(Tk::timeofday() - $pw->{start_time}); - # try to estimate the time to go, after 3% are finished - if (($percent > 3) and ($sec > 10)) { + 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 $min = 0; - if ($to_go > 59) { $min = int($to_go / 60); $to_go = $to_go % 60; } # modulo - $add_str = sprintf ", estimated time to go %d:%02d",$min, $to_go; + my $totalt = $to_go + $sec; + my $tgmin = 0; + my $total_min = 0; + if ($to_go > 59) { $tgmin = int($to_go / 60); $to_go = $to_go % 60; } # modulo + if ($totalt > 59) { $total_min = int($totalt / 60); $totalt = $totalt % 60; } # modulo + $add_str = sprintf "\n\nEstimated time to go %d:%02d, estimated total time %d:%02d",$tgmin, $to_go, $total_min, $totalt; + } + if ($sec > 59) { $min = int($sec / 60); $sec = $sec % 60; } # modulo + $pw->{label2} = sprintf "%d%% done, time elapsed %d:%02d%s", $percent, $min, $sec, $add_str; + $pw->{percent} = $percent; + $pw->iconname("$percent% done"); + } + else { + $pw->{label2} = ''; } - if ($sec > 59) { $min = int($sec / 60); $sec = $sec % 60; } # modulo - $pw->{label2} = sprintf "%d%% done, time elapsed %d:%02d%s",$percent,$min,$sec, $add_str; - $pw->{percent} = $percent; - $pw->{label} = $string; - $pw->iconname("$percent% done"); $pw->update(); - $pw->{last_time} = Tk::timeofday(); + $pw->{last_time} = Tk::timeofday() if ($total > 0); } ############################################################## @@ -27302,6 +29216,38 @@ } ############################################################## +# fullscreen +############################################################## +sub fullscreen { + my $win = shift; + my $fullscreen = shift; + + # Mai 2007: $win->attributes(-fullscreen => 1); should also work with 804.027_500 but it doesn't (at least not under windows) + + if ($fullscreen) { + #saveOffsets($win); + #my $screenw = $top->screenwidth - 10; + #my $screenh = $top->screenheight - 30; + #$geo = "${screenw}x${screenh}+0+0"; + print "fullscreen: full \n" if $verbose; + # this should also work: + $win->packPropagate(0); + $win->FullScreen; + + } else { + #my ($w, $h) = getSize($dpic); + $win->packPropagate(1); + #$geo = "${w}x${h}+${picwinx}+${picwiny}"; + print "fullscreen: normal \n" if $verbose; + } + #$win->geometry($geo); + $win->update; + $win->overrideredirect($config{Overrideredirect}); # no window decoration, but also no key input possible?! + $win->focusForce; + +} + +############################################################## # topFullScreen - toggle the main window to fullscreen and back ############################################################## sub topFullScreen { @@ -27321,12 +29267,12 @@ #unset geometry #$top->geometry(""); #$top->geometry("+0+0"); - $config{ShowMenu} = 0; - $config{ShowInfoFrame} = 0; - $config{ShowCommentField} = 0; - $config{ShowEXIFField} = 0; - $config{Layout} = 4 ; - layout(1); + #$config{ShowMenu} = 0; + #$config{ShowInfoFrame} = 0; + #$config{ShowCommentField} = 0; + #$config{ShowEXIFField} = 0; + #$config{Layout} = 4 ; + #layout(1); #$mainF->configure(-bg => $config{ColorBGCanvas}); #$mainF->configure(-fg => $config{ColorBGCanvas}); #$mainF->configure(-highlightcolor => $config{ColorBGCanvas}); @@ -27335,23 +29281,28 @@ my $w = $top->screenwidth; # - 20; my $h = $top->screenheight; # - 80; $top->geometry("${w}x${h}+0+0"); - $top->deiconify; + #$top->GeometryRequest($w,$h); + $top->deiconify; + #$top->overrideredirect(1); + $top->packPropagate(0); + $top->Post(0,0); + $top->update; if ($config{ToggleBorder}) { $top->grabGlobal; - $top->focusForce; } } else { # reset from fullscreen mode - $top->withdraw; + #$top->withdraw; $mainF->configure(-bg => $config{ColorBGCanvas}); $top->geometry($topFullSceenConf{Geometry}); - $config{ShowMenu} = $topFullSceenConf{ShowMenu}; - $config{ShowInfoFrame} = $topFullSceenConf{ShowInfoFrame}; - $config{ShowCommentField} = $topFullSceenConf{ShowCommentField}; - $config{ShowEXIFField} = $topFullSceenConf{ShowEXIFField}; - $config{Layout} = $topFullSceenConf{Layout}; - $top->deiconify; - layout(1); + #$config{ShowMenu} = $topFullSceenConf{ShowMenu}; + #$config{ShowInfoFrame} = $topFullSceenConf{ShowInfoFrame}; + #$config{ShowCommentField} = $topFullSceenConf{ShowCommentField}; + #$config{ShowEXIFField} = $topFullSceenConf{ShowEXIFField}; + #$config{Layout} = $topFullSceenConf{Layout}; + #$top->deiconify; + #layout(1); } + $top->focusForce; # the canvas size has changed, so we need to rezoom all cached pics deleteCachedPics(); fitPicture(); @@ -27408,6 +29359,120 @@ } ############################################################## +# round +############################################################## +sub round { + # int() does not round! + return sprintf "%d", shift; +} + +############################################################## +# about - display some infos about the application +############################################################## +sub about { + + my $title = "About Mapivi $version"; + + my @date = split / /, '$Date: 2008/02/21 20:53:27 $ '; + my @datum = split /\//, $date[1]; + my $nrs = $config{NrOfRuns}; + + my $about = << "EOA"; + + Mapivi - Martin\'s Picture Viewer and Manager + + Open-source and cross-platform picture manager with IPTC, EXIF and Comment support. + + Mapivi Version: $version + Date of last change: $datum[2].$datum[1].$datum[0] + + Author: Martin Herrmann + email: Martin-Herrmann\@gmx.de + www: $mapiviURL + download: http://sourceforge.net/projects/mapivi + + You have used Mapivi $nrs times +EOA + + $about .= ' + Mapivi is free software, if you want you may make a donation, + see http://herrmanns-stern.de/software/donations.shtml + Your donation of any amount will encourage me to continue the + development.'; + + $about .= "\n\n I am always happy to receive some feedback about Mapivi!\n"; + + showText($title, $about, WAIT, $mapiviiconfile); +} + +############################################################## +# systemInfo - show some infos about the system to the user +############################################################## +sub systemInfo { + + my $sec = time() - $^T; + my $min = 0; + my $hou = 0; + my $day = 0; + + # some modula calculations + if ($sec > 59) { $min = int($sec / 60); $sec = $sec % 60; } # modulo + if ($min > 59) { $hou = int($min / 60); $min = $min % 60; } + if ($hou > 24) { $day = int($hou / 24); $hou = $hou % 24; } + my $uptime = sprintf "%d day(s) %02d:%02d:%02d", $day, $hou, $min, $sec; + + my $perlversion = sprintf "%vd",$^V; + + my $string = << "EOA"; + Mapivi config dir: $configdir + + Perl version: $perlversion + Perl/Tk version: $Tk::VERSION + Tcl/Tk version: $Tk::version + Tcl/Tk patch level: $Tk::patchLevel + Tk::JPEG version: $Tk::JPEG::VERSION + MetaData version: $Image::MetaData::JPEG::VERSION + Perl executable: $^X + System (OS): $^O + Process ID (PID): $$ + Running since: $uptime + + +EOA + + my $procTabAvail = (eval "require Proc::ProcessTable") ? 1 : 0 ; + + my $mem = int(getMemoryUsage()/(1024*1024))."MB" if $procTabAvail; + $string .= " memory usage: ".$mem."\n" if $procTabAvail; + + $string .= " OS type: ".$ENV{OS}."\n" if ($ENV{OS}); + $string .= " OS: ".$ENV{PC_OS}."\n" if ($ENV{PC_OS}); + $string .= " OS type: ".$ENV{OSTYPE}."\n" if ($ENV{OSTYPE}); + $string .= " System name: ".$ENV{HOSTNAME}."\n" if ($ENV{HOSTNAME}); + $string .= " System name: ".$ENV{COMPUTERNAME}."\n" if ($ENV{COMPUTERNAME}); + $string .= " System type: ".$ENV{HOSTTYPE}."\n" if ($ENV{HOSTTYPE}); + $string .= " # of processors: ".$ENV{NUMBER_OF_PROCESSORS}."\n" if ($ENV{NUMBER_OF_PROCESSORS}); + $string .= " Processor: ".$ENV{CPU}."\n" if ($ENV{CPU}); + $string .= " Processor: ".$ENV{PROCESSOR_ARCHITECTURE}."\n" if ($ENV{PROCESSOR_ARCHITECTURE}); + $string .= " Processor type: ".$ENV{PROCESSOR_IDENTIFIER}."\n" if ($ENV{PROCESSOR_IDENTIFIER}); + $string .= " Processor type: ".$ENV{MACHTYPE}."\n" if ($ENV{MACHTYPE}); + $string .= " Processor rev.: ".$ENV{PROCESSOR_REVISION}."\n" if ($ENV{PROCESSOR_REVISION}); + + $string .= "Here is a list of all external programs used by Mapivi.\nSome of them are needed, some are optional.\n\n"; + + foreach my $prog (sort keys %exprogs) { + if ($exprogs{$prog}) { + $string .= " "; + } + else { + $string .= " not "; + } + $string .= sprintf("available: %-12s - %s\n", $prog, $exprogscom{$prog}); + } + showText("System Information", $string, WAIT, $mapiviiconfile); +} + +############################################################## # gratulation ############################################################## sub gratulation { @@ -27445,13 +29510,13 @@ print <