#!/usr/bin/perl
# bins-edit-gui -- graphical editor for BINS-format XML tag files
#
# Copyright 2002 Mark W. Eichin <eichin@thok.org>
# The Herd of Kittens
#
# -- GPL notice --
$gpl_text = <<EOF ;
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
EOF
# -- end GPL notice --

$version = "0.9";

@album_tags = qw(title longdesc shortdesc sampleimage);
@image_tags = qw(title event location people date description);
@known_tags = sort (@album_tags, @image_tags);
{
    # perlfaq4 uniquify
    my $prev = undef;
    @known_tags = grep($_ ne $prev && ($prev = $_, 1), @known_tags);
}
# allbery suggests
# keys %{{map(($_,1),@array)}}
# would be like the perlfaq unique-keys example...

use Getopt::Long;

BEGIN {
	unless (eval "use Gtk; 1;") {
		push @p, "libgtk-perl";
		$fail=1
	}

	unless (eval "use Gtk::GladeXML; 1;") {
		push @p, "libgladexml-perl";
		$fail=1
	}

	unless (eval "use Gtk::Gdk::ImlibImage; 1;") {
		push @p, "libgtk-imlib-perl";
		$fail=1
	}

	unless (eval "use Gnome; 1;") {
		push @p, "libgnome-perl";
		$fail=1
	}

	if ($fail)
	{
		print "You need to install the Debian package(s): ", join(", ", @p), "\n";
		exit;
	}
}

use XML::DOM;
use XML::XQL;
use XML::XQL::DOM;
use XML::Writer;

use Gtk::Gdk::ImlibImage;
use Gnome;

use Text::Iconv;

# for localized text
# use POSIX qw(setlocale LC_MESSAGES); # apparently only works on Debian,
# mandrake, redhat, and suse are reported to need the following instead:
use POSIX 'locale_h';
use Locale::gettext;

sub _ {
   Locale::gettext::gettext(shift);
}

$debug=0;

$localePath = "/usr/local/share/locale"; # Base locale path  (for I18N)

setlocale(LC_MESSAGES, "");
bindtextdomain("bins-edit-gui", $localePath);
textdomain("bins-edit-gui");

sub usage {
    my $why = shift;
    my $usage =
"bins-edit-gui: [--debug] [--version] " . _("file [files...]") ."\n".
"   "._("Edit BINS-format tags (captions, titles, etc) for image files.") ."\n".
"\n".
"   --debug     " . _("enable developer-only debugging.") ."\n".
"   --version   " . _("display version information.") ."\n";

    if ($why eq 'error') {
	print STDERR $usage;
	exit 1;
    } elsif ($why eq 'user') {
	print STDOUT $usage;
	exit 0;
    }
}

$o_help=0;
$o_version=0;

$fullversion =
"bins-edit-gui $version " . _("for BINS") ."\n".
"Copyright 2002 Mark W. Eichin <eichin\@thok.org>" ."\n".
_("This is free software distributed under the GPL.  There is NO WARRANTY.") ."\n".


GetOptions('debug+' => \$debug,
	   'h|help' => \$o_help,
	   'v|version' => \$o_version,
	   ) or usage('error');
usage('user') if $o_help;
if ($o_version) {
    print $fullversion;
    exit 0;
}

# take this out when we have a file browser
usage('error') if scalar(@ARGV) < 1;

# find a way to do this in Perl; nl_langinfo seems to be coming in 5.8
my $localEncoding = "";
my $codeset;
eval {
    require I18N::Langinfo;
    I18N::Langinfo->import(qw(langinfo CODESET));
    $codeset = langinfo(CODESET());
};
# ANSI is unspeakably primitive, keep LATIN1 instead
# Solaris refers to ISO 646 as "646" but that is not a valid codeset
if (!$@ && $codeset && $codeset ne "ANSI_X3.4-1968" && $codeset ne "646") {
  $localEncoding = $codeset;
  print "Forcing encoding to $codeset\n";
}

chomp($localEncoding);
if (! $localEncoding) {
  $localEncoding = "LATIN1";
}
$Latin2UTF = Text::Iconv->new($localEncoding, "UTF-8");
$UTF2Latin = Text::Iconv->new("UTF-8", $localEncoding);

my_init_rotations();

Gtk->set_locale;

Gnome->init("bins-edit-gui", $version);
Gtk->init;

$glade = "/usr/share/bins/bins-edit-gui.glade";
if (! -r $glade) {
    $glade = "bins-edit-gui.glade" ; # developer hack
    print "DEVELOPER HACK\n";
    if (! -r $glade) {
	die "No bins-edit-gui.glade available";
    }
}
#$g = new Gtk::GladeXML($glade, 'image_edit_top');
$g = new Gtk::GladeXML($glade);
die "Gtk::GladeXML($glade) initialization failed; check required packages" unless $g;

$g->signal_autoconnect_from_package('main'); # main:: so we can grab stuff directly

# get the "global" widgets

$w = $g->get_widget('image_edit_pixmap'); # GTK-Interface/widget/name
$w->signal_connect(expose_event => \&on_test_expose_event);
$name_entry = $g->get_widget("field_name_entry");
$value_entry = $g->get_widget("field_value_entry");
$ilist = $g->get_widget("image_prop_list");
$ilist->column_titles_passive;	# shouldn't this be in the .glade?
# work around libglade 0.17 bug (debbugs #147051)
$ilist->set_column_title(0, _("Property"));
$ilist->set_column_title(1, _("Value"));
# end workaround.
$statusbar = $g->get_widget('statusbar1');
$aboutbox = $g->get_widget('about_box');
$aboutbox->close_hides;
$licensebox = $g->get_widget('license_box');
$licensetext = $g->get_widget('license_text'); # GtkText
#print ref($licensetext),": ",join("\n\t|",%Gtk::Text::),"\n";
$gpl_text =~ s/^\# ?//gm;
$licensetext->insert(undef, undef, undef, $gpl_text);

## album-panel globals
$albumedit = $g->get_widget('album_edit_top');
$albumfile = $g->get_widget('album_edit_filename');
$albumprop = $g->get_widget('album_prop_list');
# work around libglade 0.17 bug (debbugs #147051)
$albumprop->set_column_title(0, _("Property"));
$albumprop->set_column_title(1, _("Value"));
# end workaround.
$albumname = $g->get_widget('album_name_entry');
$albumname->set_popdown_strings(@album_tags);
$albumvalue = $g->get_widget('album_edit_text');

sub on_dismiss_about_clicked {
    $licensebox->hide;
    status(_("Thank you for sharing."));
}

sub status {
    my $msg = shift;
    $statusbar->pop(1);
    $statusbar->push(1, $msg);
}

use Image::Info;

# original orientation for viewing
sub get_image_orientation($) {
    my $filename = shift;
    # bail directly if we have a tag-loaded value
    return $newimage_tagged_or if (defined $newimage_tagged_or);
    # try and find a way to get this from imlib?
    my $info = Image::Info::image_info($filename);
    if (exists $info->{'error'}) {
	my $msg = sprintf(_("Couldn't read EXIF info from %s: %s, ignoring."),
			  $filename, $info->{'error'});
			  
	status($msg);
	print $msg if $debug;
	return "top_left";
    }
    $info->{'Orientation'};
}

# see http://www.ba.wakwak.com/~tsuruzoh/Computer/Digicams/exif-e.html
# for the meaning of the orientations.
# see /usr/share/doc/imlib-base/html/index.html
# for the not-quite-apology for the function supplied.
# see the qiv sources for an example of how to use it anyway...

sub my_real_gdk_rotate($$) {
    my ($newimage,$orientation) = @_;
    my $degrees;

    if ($orientation eq "right_top"){
	$degrees = 90;
	$newimage->rotate_image('a 45 degree mirror is *not* a rotate');
	$newimage->flip_image_horizontal ();
    } elsif ($orientation eq "left_bot"){
	$degrees = 270;
	$newimage->rotate_image('a 45 degree mirror is *not* a rotate');
	$newimage->flip_image_vertical ();
    } elsif ($orientation eq "right_bot"){
	$degrees = 180;
	# test this, maybe simplify...
	$newimage->rotate_image('a 45 degree mirror is *not* a rotate');
	$newimage->flip_image_horizontal ();
	$newimage->rotate_image('a 45 degree mirror is *not* a rotate');
	$newimage->flip_image_horizontal ();
    } elsif ($orientation eq "top_left"){
	# do nothing
	return;
    } else {
	print STDERR "Warning, Orientation field has an unknown value '$orientation'.\n" if $debug;
	# still do nothing
	return 0;
    }

}


sub load_image_tags($);

sub load_image { # no proto, we're cheating and doing 1arg/2arg (or should that be @?)
    my $test_filename = shift;
    my $extra = shift;
    my $ilabel = $g->get_widget('image_filename_label');
    $newimage->destroy_image() if defined $newimage;
    $newimage = load_image Gtk::Gdk::ImlibImage($test_filename);
    if (defined $newimage) {
	if ($extra ne "keeptags") {
	    load_image_tags $test_filename;
	    $newimage_loaded_or = $newimage_or = get_image_orientation($test_filename);
	    print "$test_filename: got orientation <$newimage_or>\n" if $debug;
	}
	my_real_gdk_rotate($newimage,$newimage_or);
	$ilabel->set($test_filename);
	status(sprintf(_("Loaded %s."), $test_filename));
    } else {
	# no image - just skip.  we've already filtered xml files, though.
	$ilabel->set(_("Load failed: ") . $test_filename);
	status(sprintf(_("IMLib failed loading %s."), $test_filename));
    }
    # regardless, rerender
    if (defined $imagesized) {
	undef $imagesized;
	on_test_expose_event();	# cheat, it doesn't use it
    }

}
# from bins_edit

# my $grove_builder = XML::Grove::Builder->new;
# my $parser = XML::Parser::PerlSAX->new ( Handler => $grove_builder );
# $document = $parser->parse ( Source => { SystemId => "${test_filename}.xml" } );

# now only internal for load...
sub load_image_tags($) {
    %old_field = %field;	# save for later recall

    my $test_filename = shift;
    $parser = new XML::DOM::Parser;
    if (-r "${test_filename}.xml" ) {
	$doc = $parser->parsefile ("${test_filename}.xml");
    } else {
	# literal minimal tree
	$doc = $parser->parse('<?xml version="1.0" encoding="UTF-8"?><image><description></description><bins></bins><exif></exif></image>');
	status(sprintf(_("%s not found, constructing"), "${test_filename}.xml"));
    }


    undef %field;

    for my $i (@image_tags) {
	$field{$i} = "";
    }

    for my $field_node ($doc->xql("image/description/field")) {
	# <field name="location"></field>
	# <field name="description">Sjenka</field>
	my $fieldname = ($field_node->xql("\@name"))[0]->xql_toString;
	my $fieldval = $field_node->xql_toString;
	print "N: $fieldname  V: $fieldval\n" if $debug;
	my $newval;
	do {
	    $newval = $UTF2Latin->convert($fieldval);
	    charmap_failed("load_image_tags", $fieldval) if (not defined $newval);
	} until defined $newval;
	$field{$fieldname} = $newval;
    }

    undef $newimage_tagged_or;
    # <image><exif><tag name="Orientation" priority="1">right_top</tag> 
    for my $tag_node ($doc->xql("image/exif/tag[\@name = 'Orientation']")) {
	my $tagname = ($tag_node->xql("\@name"))[0]->xql_toString;
	my $tagprio_node = ($tag_node->xql("\@priority"))[0];
	my $tagprio;
	$tagprio = $tagprio_node->xql_toString if defined $tagprio_node;
	my $tagval = $tag_node->xql_toString;
	# but actually, we only care about orientation 
	print "N: $tagname  V: $tagval P: $tagprio\n" if $debug;
	if ($tagprio == 1) {
	    $newimage_tagged_or = $tagval;
	}
    }

    # a clist is output only.  someday, replace it with a list of
    # editboxes, even if we have to write one all in perl.

    # in the mean time, we vector out to a pair of combo boxes and let
    # the user edit there, while copying the changes back live.

    # save last index if any...
    my $oldtag;
    my $oldrow = $ilist->focus_row();
    $oldtag = $ilist->get_text($oldrow, 0) if $oldrow > 0;
    print "old $oldrow: $oldtag\n" if $debug;
    $ilist->clear;
    for my $i (sort keys %field) {
	$ilist->append("\u$i", $field{$i});
    }
    if ($oldrow > 0) {
	my $newrow = my_gtk_find_row($ilist, 0, $oldtag);
	print "new $newrow\n" if $debug;
	if ($newrow > 0) {
	    $ilist->set_focus_row($newrow);
	    $ilist->grab_focus();
	}
    }

    # help the user enter stuff
    $name_entry->set_popdown_strings(@known_tags);
    # tag as unchanged
    $dirty = 0;
}

sub charmap_failed($$) {
    my $ipop = $g->get_widget('iconv_failed_dialog');

    my $lbutton = $g->get_widget('iconv_latin1_charmap_button');
    $lbutton->set_active(Gtk->true); # really we mean it
    my $ubutton = $g->get_widget('iconv_user_charmap_button');
    my $uentry = $g->get_widget('iconv_user_charmap_entry');
    # if there's a value there, it is from the previous attempt, and is wrong.
    $uentry->set_text("");

    $ipop->run_and_close;

    if ($lbutton->get_active) {
	set_encoding("LATIN1");
    } elsif ($ubutton->get_active) {
	set_encoding($uentry->get_text);
    }

}

sub save_image_tags {
    my $test_filename = shift;
    if ((not $dirty) && ($newimage_or eq $newimage_loaded_or)) {
	status(sprintf(_("%s not dirty, not saved"), ${test_filename}));
	return;
    }

    my $parent = ($doc->xql("image/description"))[0]; # first one
    my $exif = ($doc->xql("image/exif"))[0];
    my %f = %field;

    # write out the tree...
    for my $xmlfield ($doc->xql("image/description/field")) {
	my $namestr = $xmlfield->getAttribute("name");
	if (defined $f{$namestr}) {
	    # delete this node so we can append it later
	    $xmlfield->getParentNode->removeChild($xmlfield);
	}
    }
    # now append the remaining ones...
    for my $k (keys %f) {
	next if ($f{$k} eq "");
	my $newfield = new XML::DOM::Element($doc, "field");
	print "creating <$k> with <$f{$k}>\n" if $debug;
	$newfield->setAttribute("name", $k); # needs quoting!
	print "k: ", $k, " f: ", $f{$k}, " L2U: ", $Latin2UTF->convert($f{$k}), "\n" if $debug;
	my $newval;
	do {
	    $newval = $Latin2UTF->convert($f{$k});
	    charmap_failed("save_image_tags", $f{$k}) if (not defined $newval);
	} until defined $newval;
	
	$newfield->addText($newval);
	$parent->appendChild($newfield);
	print "created $k with $f{$k}\n" if $debug;
	}

    # and orientation, if set
    if ($newimage_or ne $newimage_loaded_or) {
	for my $tag_node ($doc->xql("image/exif/tag[\@name = 'Orientation']")) {
	    # delete the node, then construct a new one
	    $tag_node->getParentNode->removeChild($tag_node);
	}
	my $newtag = new XML::DOM::Element($doc, "tag");
	$newtag->setAttribute("name", "Orientation");
	$newtag->setAttribute("priority", "1");
	$newtag->addText($Latin2UTF->convert($newimage_or)); # unneeded conversion
	$exif->appendChild($newtag);
	print "Set orientation <$newimage_or> (loaded $newimage_loaded_or) in exif tag\n" if $debug;
    }

    $doc->printToFile("${test_filename}.xml");
    status(sprintf(_("Saved %s."), $test_filename));
    # undirty it
    $dirty = 0;
    $newimage_loaded_or = $newimage_or;
}

# if they enter or select a known one, snarf the value
$name_entry->entry->signal_connect('changed', sub {
    my $entry = shift;
    my $val = $field{$entry->get_text};
    if (defined $val) {
	$value_entry->entry->set_text($val);
	$value_entry->entry->set_editable(Gtk->true);
    }
    $dirty = 1;
});

sub my_album_replace_text($$) {
    my $aw = shift;
    my $text = shift;
    $aw->set_point(0);
    $aw->forward_delete($albumvalue->get_length());
    $aw->insert(undef, undef, undef, $text);
    $aw->set_editable(Gtk->true);
}

# album version
$albumname->entry->signal_connect('changed', sub {
    my $entry = shift;
    my $val = $album{$entry->get_text};
    if (defined $val) {
	my_album_replace_text($albumvalue, $val);
    }
    $album_dirty = 1;
});
    
sub my_gtk_find_row {		# returns row
    my ($clist, $col, $value) = @_;
    for my $i (0..$clist->rows) {
	my $cell = $clist->get_text($i, $col);
	return $i if ($cell ne "" && lc($cell) eq lc($value));
    }
    return -1;
}

# if the value changes, update the text
$value_entry->entry->signal_connect('changed', sub {
    my $entry = shift;
    my $newval = $entry->get_text;
    my $tag = lc($name_entry->entry->get_text);
    $field{$tag} = $newval;
    $dirty = 1;
    my $row = my_gtk_find_row($ilist, 0, $tag);
    print "row: $row tag: $tag newval: $newval\n" if $debug;
    # oh, no tag yet, add one
    if ($row != -1) {
	$ilist->set_text($row, 1, $newval);
    } else {
	# triggers select-row?
	$ilist->append("\u$tag", $newval);
	# update the dropdown too
	@known_tags = sort (@known_tags, $tag);
	$name_entry->set_popdown_strings(@known_tags);
	# force it all back
	$ilist->select_row($ilist->rows()-1, 0);
    }
});
# album version
$albumvalue->signal_connect('changed', sub {
    my $entry = shift;
    my $newval = $entry->get_chars(0,-1);
    my $tag = lc($albumname->entry->get_text);
    $album{$tag} = $newval;
    $dirty = 1;
    my $row = my_gtk_find_row($albumprop, 0, $tag);
    print "row: $row tag: $tag newval: $newval\n" if $debug;
    # oh, no tag yet, add one
    if ($row != -1) {
	$albumprop->set_text($row, 1, $newval);
    } else {
	# triggers select-row?
	$albumprob->append("\u$tag", $newval);
	# update the dropdown too
	@known_tags = sort (@known_tags, $tag);
	$albumname->set_popdown_strings(@known_tags);
	# force it all back
	$albumprob->select_row($ilist->rows()-1, 0);
    }
});

$ilist->signal_connect('select-row', sub {
    my ($clist, $row, $col, $event, $udata) = @_;
    print "list: $clist row: $row col: $col event: $event udata: $udata\n" 
	if $debug;
    $name_entry->entry->set_text($clist->get_text($row,0));
    $value_entry->entry->set_text($clist->get_text($row,1));
    print "focus on $value_entry\n" if $debug;
    $value_entry->entry->grab_focus();
});

# album version
$albumprop->signal_connect('select-row', sub {
    my ($clist, $row, $col, $event, $udata) = @_;
    print "list: $clist row: $row col: $col event: $event udata: $udata\n" 
	if $debug;
    $albumname->entry->set_text($clist->get_text($row,0));
    my_album_replace_text($albumvalue, $clist->get_text($row,1));
    print "focus on $value_entry\n" if $debug;
    $albumvalue->grab_focus();
});


# filter out .xml files, as we always derive them from the images
# (also lets us eventually use the images as database keys instead)
@filenames = grep (!/\.xml$/, @ARGV);

$current_n = 0;
$current_filename = $filenames[$current_n];

load_image $current_filename;

Gtk->main;

## callbacks..
# new callbacks
# sgrep -o '%r\n' 'stag("HANDLER") __ etag("HANDLER") ' bins-edit-gui.glade | while read sub; do grep "$sub" bins-edit-gui.pl >/dev/null || echo "$sub"; done

sub on_save1_activate {
    save_image_tags $current_filename;
}

sub on_about2_activate {
    $aboutbox->show;
}

sub on_license1_activate {
    $licensebox->show;
    my $button = $g->get_widget('dismiss_about');
    $button->grab_focus();
}

sub on_open2_activate {
    status(_("File browser not yet implemented."));
}

sub on_revert1_activate {
    load_image $current_filename;
    status(sprintf(_("Reverted from %s."), $current_filename));
}

sub set_filename_index($) {
    $current_n = shift;
    $current_filename = $filenames[$current_n];
    load_image $current_filename;
}

sub move_filename_index($) {
    save_image_tags $current_filename;
    my $delta = shift;
    my $new_n = $current_n + $delta;

    # clamp it
    $new_n = 0 if $new_n < 0;
    $new_n = $#filenames if $new_n > $#filenames;
    if ($new_n == $current_n) {
        # we didn't move
        status(_("Out of filenames."));
    } else {
        set_filename_index($new_n);
    }
}

sub on_next_file1_activate {
    move_filename_index(+1);
}

sub on_prev_file1_activate {
    move_filename_index(-1);
}

sub on_forward_10_activate {
    move_filename_index(+10);
}
sub on_back_10_activate {
    move_filename_index(-10);
}
sub on_start_of_list1_activate {
    set_filename_index(0);
}
sub on_end_of_list1_activate {
    set_filename_index($#filenames);
}


# auto fill from old_field
sub on_auto_fill1_activate {
    for my $k (keys %old_field) {
	if ($field{$k} eq "" && $old_field{$k} ne "") {
	    $field{$k} = $old_field{$k};
	    $dirty = 1;
	    # and change it on-screen
	    my $row = my_gtk_find_row($ilist, 0, $k);
	    if ($row != -1) {
		print "updating row $row with $k ($field{$k})\n" if $debug;
		$ilist->set_text($row, 1, $field{$k});
	    } # maybe warn, or add field, if not found?
	}
    }
    status("Auto-filled fields.");
}

sub on_exit1_activate {
    save_image_tags $current_filename;

    Gtk->main_quit;
}

sub on_test_expose_event {
    my($widget) = @_;

    # print "otee, ",defined $imagesized,"\n";
    # if (1 || not defined $imagesized) {
	my $w = $g->get_widget('image_edit_pixmap'); # GTK-Interface/widget/name
	# x,y,width,height
	my ($alloc_x, $alloc_y, $alloc_w, $alloc_h) = @{$w->allocation};
	my $widget_w = $alloc_w;
	my $widget_h = $alloc_h;

	if ($debug) {
	    print join("| ", @{$w->allocation});
	    print "| x: $widget_w  y: $widget_h ";
	    print
		"nw: ", $newimage->rgb_width, 
		" nh: ", $newimage->rgb_height, "\n" if defined $newimage;
	    print
		" x/y: ",$widget_w/$widget_h,
		" nw/x: ", $newimage->rgb_width/$widget_w, 
		" nh/y: ", $newimage->rgb_height/$widget_h, 
		"\n"  if defined $newimage;
	}
	# print "ox: $old_x oy: $old_y ww: $widget_w wh: $widget_h I:$imagesized\n";
        # return if same size
	if ($old_x == $widget_w && $old_y == $widget_h) {
	    # but not if we never dealt before
	    return if (defined $imagesized);
	}
	if (defined $newimage) {
	    my ($use_w, $use_h) = ($newimage->rgb_width, $newimage->rgb_height);
	    my $rat_w = $use_w/$widget_w;
	    my $rat_h = $use_h/$widget_h;
	    $rat = ($rat_w > $rat_h) ? $rat_w : $rat_h;

	    $use_w = $use_w / $rat;
	    $use_h = $use_h / $rat;
	    $newimage->render($use_w, $use_h);
	    my $my_image = $newimage->copy_image(); # returns Gtk::Gdk::Pixmap
	    my $my_mask  = $newimage->copy_mask();  # returns Gtk::Gdk::Bitmap
	    $w->set($my_image, $my_mask);
	    $my_image->imlib_free();
	} else {
	    # come up with more clever "test pattern" later?
	    $w->set(undef, undef);
	}
	$old_x = $widget_w;
	$old_y = $widget_h;
	#undef $imagesized;
	$imagesized = 1;
    # }
}

# rotations that override, or rather compound, the EXIF values
# build the rotation-ring first
sub my_init_rotations {
    my @rotation_order = ("right_top", "right_bot", "left_bot", "top_left");
    my $left = $rotation_order[$#rotation_order];
    for my $curr (@rotation_order) {
	$rotate_right{$left} = $curr;
	$rotate_left{$curr} = $left;
	$left = $curr;
    }
    # special case none->top_left
    $rotate_right{""} = $rotate_right{"top_left"};
    $rotate_left{""} = $rotate_left{"top_left"};
}

sub my_image_rotate {
    my $delta_or = shift;
    print "$test_filename: new user-requested rotation $delta_or to $newimage_or\n" if $debug;

    my_real_gdk_rotate($newimage,$delta_or);
    # consider noticing that $newimage_or == $newimage_loaded_or and reverting.
    # regardless, rerender
    if (defined $imagesized) {
	undef $imagesized;
	on_test_expose_event();
    }
    status(_("Rotated."));
}

sub on_rotate_right_cw1_activate {
    $newimage_or = $rotate_right{$newimage_or};
    my_image_rotate("right_top");
}

sub on_rotate_left1_activate {
    $newimage_or = $rotate_left{$newimage_or};
    my_image_rotate("left_bot");
}

# don't actually undo the rotations, just reload - but don't lose tags
sub on_cancel_rotation1_activate {
    load_image $current_filename, "keeptags";
    status(_("Image restored."));
}

### album stuff ###
sub load_album_tags($);

sub on_album1_activate {
    $current_album = $current_filename;
    # basename
    $current_album =~ s{[^/]*$}{}; # } perl-mode-sucks
    # make a complete name out of it
    $current_album .= "album.xml"; #if (-d "${current_album}");
    $albumfile->set($current_album);
    load_album_tags($current_album);
    $albumedit->show;
}

sub on_open2_activate {
    status(_("File browser not yet implemented."));
}

sub on_close1_activate {
    # save if dirty
    save_album_tags($current_album) if $album_dirty;
    $albumedit->hide;
}

sub on_revert2_activate {
    load_album_tags $current_album;
    status(sprintf(_("Reverted from %s."), $current_album));
}

sub save_album_tags;

sub on_save2_activate {
    save_album_tags $current_album;
}

# sub on_exit2_activate {
#     &on_exit1_activate(@_);
# }

sub load_album_tags($) {
    %old_album = %album;	# save for later recall

    my $test_filename = shift;
    $parser = new XML::DOM::Parser;
    if (-r "${test_filename}" ) {
	$album_doc = $parser->parsefile ("${test_filename}");
    } else {
	# literal minimal tree
	$album_doc = $parser->parse('<?xml version="1.0" encoding="UTF-8"?><album><description></description><bins></bins></album>');
	status(sprintf(_("%s not found, constructing"), "${test_filename}"));
    }


    undef %album;

    for my $i (@album_tags) {
	$album{$i} = "";
    }

    for my $field_node ($album_doc->xql("album/description/field")) {
	my $fieldname = ($field_node->xql("\@name"))[0]->xql_toString;
	my $fieldval = $field_node->xql_toString;
	print "N: $fieldname  V: $fieldval\n" if $debug;
	$album{$fieldname} = $UTF2Latin->convert($fieldval);
    }

    # a clist is output only.  someday, replace it with a list of
    # editboxes, even if we have to write one all in perl.

    # in the mean time, we vector out to a pair of combo boxes and let
    # the user edit there, while copying the changes back live.

    # save last index if any...
    my $oldtag;
    my $oldrow = $albumprop->focus_row();
    $oldtag = $albumprop->get_text($oldrow, 0) if $oldrow > 0;
    print "old $oldrow: $oldtag\n" if $debug;
    $albumprop->clear;
    for my $i (sort keys %album) {
	$albumprop->append("\u$i", $album{$i});
    }
    if ($oldrow > 0) {
	my $newrow = my_gtk_find_row($albumprop, 0, $oldtag);
	print "new $newrow\n" if $debug;
	if ($newrow > 0) {
	    $albumprop->set_focus_row($newrow);
	    $albumprop->grab_focus();
	}
    }

    # help the user enter stuff
    $albumname->set_popdown_strings(@known_tags);
    # tag as unchanged
    $dirty = 0;
}

sub save_album_tags {
    my $test_filename = shift;
    if (not $album_dirty) {
	status(sprintf(_("%s not dirty, not saved"), ${test_filename}));
	return;
    }

    my $parent = ($album_doc->xql("album/description"))[0]; # first one
    my %f = %album;

    # write out the tree...
    for my $xmlfield ($album_doc->xql("album/description/field")) {
	my $namestr = $xmlfield->getAttribute("name");
	if (defined $f{$namestr}) {
	    # delete this node so we can append it later
	    $xmlfield->getParentNode->removeChild($xmlfield);
	}
    }
    # now append the remaining ones...
    for my $k (keys %f) {
	next if ($f{$k} eq "");
	my $newfield = new XML::DOM::Element($album_doc, "field");
	print "creating <$k> with <$f{$k}>\n" if $debug;
	$newfield->setAttribute("name", $k); # needs quoting!
	$newfield->addText($Latin2UTF->convert($f{$k}));
	$parent->appendChild($newfield);
	print "created $k with $f{$k}\n" if $debug;
	}

    $album_doc->printToFile("${test_filename}");
    status(sprintf(_("Saved %s."), $test_filename));
    # undirty it
    $album_dirty = 0;
}