# HG changeset patch
# User Peter Gervai <grin@grin.hu>
# Date 1225639792 -3600
# Node ID 8b62360dc2a5ac2a4223603aa483e8e746044ed8
# Parent  f962189bab94c13cc1a2d3e6a4e0225fa46c0e76
Adding notes, cloning edit-gui

diff -r f962189bab94 -r 8b62360dc2a5 bins-edit2-gui
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/bins-edit2-gui	Sun Nov 02 16:29:52 2008 +0100
@@ -0,0 +1,887 @@
+#!/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;
+
+use Gtk;
+use Gtk::GladeXML;
+
+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";
+}
+
+chop($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/local/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;
+}
diff -r f962189bab94 -r 8b62360dc2a5 notes
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/notes	Sun Nov 02 16:29:52 2008 +0100
@@ -0,0 +1,3 @@
+ libglade-convert bins-edit-gui.glade > z
+
+