|
0
|
1 #!/usr/bin/perl |
|
|
2 # bins-edit-gui -- graphical editor for BINS-format XML tag files |
|
|
3 # |
|
|
4 # Copyright 2002 Mark W. Eichin <eichin@thok.org> |
|
|
5 # The Herd of Kittens |
|
|
6 # |
|
|
7 # -- GPL notice -- |
|
|
8 $gpl_text = <<EOF ; |
|
|
9 # This program is free software; you can redistribute it and/or modify |
|
|
10 # it under the terms of the GNU General Public License as published by |
|
|
11 # the Free Software Foundation; either version 2 of the License, or |
|
|
12 # (at your option) any later version. |
|
|
13 # |
|
|
14 # This program is distributed in the hope that it will be useful, |
|
|
15 # but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
|
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
|
17 # GNU General Public License for more details. |
|
|
18 # |
|
|
19 # You should have received a copy of the GNU General Public License |
|
|
20 # along with this program; if not, write to the Free Software |
|
|
21 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
|
|
22 EOF |
|
|
23 # -- end GPL notice -- |
|
|
24 |
|
|
25 $version = "0.9"; |
|
|
26 |
|
|
27 @album_tags = qw(title longdesc shortdesc sampleimage); |
|
|
28 @image_tags = qw(title event location people date description); |
|
|
29 @known_tags = sort (@album_tags, @image_tags); |
|
|
30 { |
|
|
31 # perlfaq4 uniquify |
|
|
32 my $prev = undef; |
|
|
33 @known_tags = grep($_ ne $prev && ($prev = $_, 1), @known_tags); |
|
|
34 } |
|
|
35 # allbery suggests |
|
|
36 # keys %{{map(($_,1),@array)}} |
|
|
37 # would be like the perlfaq unique-keys example... |
|
|
38 |
|
|
39 use Getopt::Long; |
|
|
40 |
|
|
41 use Gtk; |
|
|
42 use Gtk::GladeXML; |
|
|
43 |
|
|
44 use XML::DOM; |
|
|
45 use XML::XQL; |
|
|
46 use XML::XQL::DOM; |
|
|
47 use XML::Writer; |
|
|
48 |
|
|
49 use Gtk::Gdk::ImlibImage; |
|
|
50 use Gnome; |
|
|
51 |
|
|
52 use Text::Iconv; |
|
|
53 |
|
|
54 # for localized text |
|
|
55 # use POSIX qw(setlocale LC_MESSAGES); # apparently only works on Debian, |
|
|
56 # mandrake, redhat, and suse are reported to need the following instead: |
|
|
57 use POSIX 'locale_h'; |
|
|
58 use Locale::gettext; |
|
|
59 |
|
|
60 sub _ { |
|
|
61 Locale::gettext::gettext(shift); |
|
|
62 } |
|
|
63 |
|
|
64 $debug=0; |
|
|
65 |
|
|
66 $localePath = "/usr/local/share/locale"; # Base locale path (for I18N) |
|
|
67 |
|
|
68 setlocale(LC_MESSAGES, ""); |
|
|
69 bindtextdomain("bins-edit-gui", $localePath); |
|
|
70 textdomain("bins-edit-gui"); |
|
|
71 |
|
|
72 sub usage { |
|
|
73 my $why = shift; |
|
|
74 my $usage = |
|
|
75 "bins-edit-gui: [--debug] [--version] " . _("file [files...]") ."\n". |
|
|
76 " "._("Edit BINS-format tags (captions, titles, etc) for image files.") ."\n". |
|
|
77 "\n". |
|
|
78 " --debug " . _("enable developer-only debugging.") ."\n". |
|
|
79 " --version " . _("display version information.") ."\n"; |
|
|
80 |
|
|
81 if ($why eq 'error') { |
|
|
82 print STDERR $usage; |
|
|
83 exit 1; |
|
|
84 } elsif ($why eq 'user') { |
|
|
85 print STDOUT $usage; |
|
|
86 exit 0; |
|
|
87 } |
|
|
88 } |
|
|
89 |
|
|
90 $o_help=0; |
|
|
91 $o_version=0; |
|
|
92 |
|
|
93 $fullversion = |
|
|
94 "bins-edit-gui $version " . _("for BINS") ."\n". |
|
|
95 "Copyright 2002 Mark W. Eichin <eichin\@thok.org>" ."\n". |
|
|
96 _("This is free software distributed under the GPL. There is NO WARRANTY.") ."\n". |
|
|
97 |
|
|
98 |
|
|
99 GetOptions('debug+' => \$debug, |
|
|
100 'h|help' => \$o_help, |
|
|
101 'v|version' => \$o_version, |
|
|
102 ) or usage('error'); |
|
|
103 usage('user') if $o_help; |
|
|
104 if ($o_version) { |
|
|
105 print $fullversion; |
|
|
106 exit 0; |
|
|
107 } |
|
|
108 |
|
|
109 # take this out when we have a file browser |
|
|
110 usage('error') if scalar(@ARGV) < 1; |
|
|
111 |
|
|
112 # find a way to do this in Perl; nl_langinfo seems to be coming in 5.8 |
|
|
113 my $localEncoding = ""; |
|
|
114 my $codeset; |
|
|
115 eval { |
|
|
116 require I18N::Langinfo; |
|
|
117 I18N::Langinfo->import(qw(langinfo CODESET)); |
|
|
118 $codeset = langinfo(CODESET()); |
|
|
119 }; |
|
|
120 # ANSI is unspeakably primitive, keep LATIN1 instead |
|
|
121 # Solaris refers to ISO 646 as "646" but that is not a valid codeset |
|
|
122 if (!$@ && $codeset && $codeset ne "ANSI_X3.4-1968" && $codeset ne "646") { |
|
|
123 $localEncoding = $codeset; |
|
|
124 print "Forcing encoding to $codeset"; |
|
|
125 } |
|
|
126 |
|
|
127 chop($localEncoding); |
|
|
128 if (! $localEncoding) { |
|
|
129 $localEncoding = "LATIN1"; |
|
|
130 } |
|
|
131 $Latin2UTF = Text::Iconv->new($localEncoding, "UTF-8"); |
|
|
132 $UTF2Latin = Text::Iconv->new("UTF-8", $localEncoding); |
|
|
133 |
|
|
134 my_init_rotations(); |
|
|
135 |
|
|
136 Gtk->set_locale; |
|
|
137 |
|
|
138 Gnome->init("bins-edit-gui", $version); |
|
|
139 Gtk->init; |
|
|
140 |
|
|
141 $glade = "/usr/local/share/bins/bins-edit-gui.glade"; |
|
|
142 if (! -r $glade) { |
|
|
143 $glade = "bins-edit-gui.glade" ; # developer hack |
|
|
144 print "DEVELOPER HACK\n"; |
|
|
145 if (! -r $glade) { |
|
|
146 die "No bins-edit-gui.glade available"; |
|
|
147 } |
|
|
148 } |
|
|
149 #$g = new Gtk::GladeXML($glade, 'image_edit_top'); |
|
|
150 $g = new Gtk::GladeXML($glade); |
|
|
151 die "Gtk::GladeXML($glade) initialization failed; check required packages" unless $g; |
|
|
152 |
|
|
153 $g->signal_autoconnect_from_package('main'); # main:: so we can grab stuff directly |
|
|
154 |
|
|
155 # get the "global" widgets |
|
|
156 |
|
|
157 $w = $g->get_widget('image_edit_pixmap'); # GTK-Interface/widget/name |
|
|
158 $w->signal_connect(expose_event => \&on_test_expose_event); |
|
|
159 $name_entry = $g->get_widget("field_name_entry"); |
|
|
160 $value_entry = $g->get_widget("field_value_entry"); |
|
|
161 $ilist = $g->get_widget("image_prop_list"); |
|
|
162 $ilist->column_titles_passive; # shouldn't this be in the .glade? |
|
|
163 # work around libglade 0.17 bug (debbugs #147051) |
|
|
164 $ilist->set_column_title(0, _("Property")); |
|
|
165 $ilist->set_column_title(1, _("Value")); |
|
|
166 # end workaround. |
|
|
167 $statusbar = $g->get_widget('statusbar1'); |
|
|
168 $aboutbox = $g->get_widget('about_box'); |
|
|
169 $aboutbox->close_hides; |
|
|
170 $licensebox = $g->get_widget('license_box'); |
|
|
171 $licensetext = $g->get_widget('license_text'); # GtkText |
|
|
172 #print ref($licensetext),": ",join("\n\t|",%Gtk::Text::),"\n"; |
|
|
173 $gpl_text =~ s/^\# ?//gm; |
|
|
174 $licensetext->insert(undef, undef, undef, $gpl_text); |
|
|
175 |
|
|
176 ## album-panel globals |
|
|
177 $albumedit = $g->get_widget('album_edit_top'); |
|
|
178 $albumfile = $g->get_widget('album_edit_filename'); |
|
|
179 $albumprop = $g->get_widget('album_prop_list'); |
|
|
180 # work around libglade 0.17 bug (debbugs #147051) |
|
|
181 $albumprop->set_column_title(0, _("Property")); |
|
|
182 $albumprop->set_column_title(1, _("Value")); |
|
|
183 # end workaround. |
|
|
184 $albumname = $g->get_widget('album_name_entry'); |
|
|
185 $albumname->set_popdown_strings(@album_tags); |
|
|
186 $albumvalue = $g->get_widget('album_edit_text'); |
|
|
187 |
|
|
188 sub on_dismiss_about_clicked { |
|
|
189 $licensebox->hide; |
|
|
190 status(_("Thank you for sharing.")); |
|
|
191 } |
|
|
192 |
|
|
193 sub status { |
|
|
194 my $msg = shift; |
|
|
195 $statusbar->pop(1); |
|
|
196 $statusbar->push(1, $msg); |
|
|
197 } |
|
|
198 |
|
|
199 use Image::Info; |
|
|
200 |
|
|
201 # original orientation for viewing |
|
|
202 sub get_image_orientation($) { |
|
|
203 my $filename = shift; |
|
|
204 # bail directly if we have a tag-loaded value |
|
|
205 return $newimage_tagged_or if (defined $newimage_tagged_or); |
|
|
206 # try and find a way to get this from imlib? |
|
|
207 my $info = Image::Info::image_info($filename); |
|
|
208 if (exists $info->{'error'}) { |
|
|
209 my $msg = sprintf(_("Couldn't read EXIF info from %s: %s, ignoring."), |
|
|
210 $filename, $info->{'error'}); |
|
|
211 |
|
|
212 status($msg); |
|
|
213 print $msg if $debug; |
|
|
214 return "top_left"; |
|
|
215 } |
|
|
216 $info->{'Orientation'}; |
|
|
217 } |
|
|
218 |
|
|
219 # see http://www.ba.wakwak.com/~tsuruzoh/Computer/Digicams/exif-e.html |
|
|
220 # for the meaning of the orientations. |
|
|
221 # see /usr/share/doc/imlib-base/html/index.html |
|
|
222 # for the not-quite-apology for the function supplied. |
|
|
223 # see the qiv sources for an example of how to use it anyway... |
|
|
224 |
|
|
225 sub my_real_gdk_rotate($$) { |
|
|
226 my ($newimage,$orientation) = @_; |
|
|
227 my $degrees; |
|
|
228 |
|
|
229 if ($orientation eq "right_top"){ |
|
|
230 $degrees = 90; |
|
|
231 $newimage->rotate_image('a 45 degree mirror is *not* a rotate'); |
|
|
232 $newimage->flip_image_horizontal (); |
|
|
233 } elsif ($orientation eq "left_bot"){ |
|
|
234 $degrees = 270; |
|
|
235 $newimage->rotate_image('a 45 degree mirror is *not* a rotate'); |
|
|
236 $newimage->flip_image_vertical (); |
|
|
237 } elsif ($orientation eq "right_bot"){ |
|
|
238 $degrees = 180; |
|
|
239 # test this, maybe simplify... |
|
|
240 $newimage->rotate_image('a 45 degree mirror is *not* a rotate'); |
|
|
241 $newimage->flip_image_horizontal (); |
|
|
242 $newimage->rotate_image('a 45 degree mirror is *not* a rotate'); |
|
|
243 $newimage->flip_image_horizontal (); |
|
|
244 } elsif ($orientation eq "top_left"){ |
|
|
245 # do nothing |
|
|
246 return; |
|
|
247 } else { |
|
|
248 print STDERR "Warning, Orientation field has an unknown value '$orientation'.\n" if $debug; |
|
|
249 # still do nothing |
|
|
250 return 0; |
|
|
251 } |
|
|
252 |
|
|
253 } |
|
|
254 |
|
|
255 |
|
|
256 sub load_image_tags($); |
|
|
257 |
|
|
258 sub load_image { # no proto, we're cheating and doing 1arg/2arg (or should that be @?) |
|
|
259 my $test_filename = shift; |
|
|
260 my $extra = shift; |
|
|
261 my $ilabel = $g->get_widget('image_filename_label'); |
|
|
262 $newimage->destroy_image() if defined $newimage; |
|
|
263 $newimage = load_image Gtk::Gdk::ImlibImage($test_filename); |
|
|
264 if (defined $newimage) { |
|
|
265 if ($extra ne "keeptags") { |
|
|
266 load_image_tags $test_filename; |
|
|
267 $newimage_loaded_or = $newimage_or = get_image_orientation($test_filename); |
|
|
268 print "$test_filename: got orientation <$newimage_or>\n" if $debug; |
|
|
269 } |
|
|
270 my_real_gdk_rotate($newimage,$newimage_or); |
|
|
271 $ilabel->set($test_filename); |
|
|
272 status(sprintf(_("Loaded %s."), $test_filename)); |
|
|
273 } else { |
|
|
274 # no image - just skip. we've already filtered xml files, though. |
|
|
275 $ilabel->set(_("Load failed: ") . $test_filename); |
|
|
276 status(sprintf(_("IMLib failed loading %s."), $test_filename)); |
|
|
277 } |
|
|
278 # regardless, rerender |
|
|
279 if (defined $imagesized) { |
|
|
280 undef $imagesized; |
|
|
281 on_test_expose_event(); # cheat, it doesn't use it |
|
|
282 } |
|
|
283 |
|
|
284 } |
|
|
285 # from bins_edit |
|
|
286 |
|
|
287 # my $grove_builder = XML::Grove::Builder->new; |
|
|
288 # my $parser = XML::Parser::PerlSAX->new ( Handler => $grove_builder ); |
|
|
289 # $document = $parser->parse ( Source => { SystemId => "${test_filename}.xml" } ); |
|
|
290 |
|
|
291 # now only internal for load... |
|
|
292 sub load_image_tags($) { |
|
|
293 %old_field = %field; # save for later recall |
|
|
294 |
|
|
295 my $test_filename = shift; |
|
|
296 $parser = new XML::DOM::Parser; |
|
|
297 if (-r "${test_filename}.xml" ) { |
|
|
298 $doc = $parser->parsefile ("${test_filename}.xml"); |
|
|
299 } else { |
|
|
300 # literal minimal tree |
|
|
301 $doc = $parser->parse('<?xml version="1.0" encoding="UTF-8"?><image><description></description><bins></bins><exif></exif></image>'); |
|
|
302 status(sprintf(_("%s not found, constructing"), "${test_filename}.xml")); |
|
|
303 } |
|
|
304 |
|
|
305 |
|
|
306 undef %field; |
|
|
307 |
|
|
308 for my $i (@image_tags) { |
|
|
309 $field{$i} = ""; |
|
|
310 } |
|
|
311 |
|
|
312 for my $field_node ($doc->xql("image/description/field")) { |
|
|
313 # <field name="location"></field> |
|
|
314 # <field name="description">Sjenka</field> |
|
|
315 my $fieldname = ($field_node->xql("\@name"))[0]->xql_toString; |
|
|
316 my $fieldval = $field_node->xql_toString; |
|
|
317 print "N: $fieldname V: $fieldval\n" if $debug; |
|
|
318 my $newval; |
|
|
319 do { |
|
|
320 $newval = $UTF2Latin->convert($fieldval); |
|
|
321 charmap_failed("load_image_tags", $fieldval) if (not defined $newval); |
|
|
322 } until defined $newval; |
|
|
323 $field{$fieldname} = $newval; |
|
|
324 } |
|
|
325 |
|
|
326 undef $newimage_tagged_or; |
|
|
327 # <image><exif><tag name="Orientation" priority="1">right_top</tag> |
|
|
328 for my $tag_node ($doc->xql("image/exif/tag[\@name = 'Orientation']")) { |
|
|
329 my $tagname = ($tag_node->xql("\@name"))[0]->xql_toString; |
|
|
330 my $tagprio_node = ($tag_node->xql("\@priority"))[0]; |
|
|
331 my $tagprio; |
|
|
332 $tagprio = $tagprio_node->xql_toString if defined $tagprio_node; |
|
|
333 my $tagval = $tag_node->xql_toString; |
|
|
334 # but actually, we only care about orientation |
|
|
335 print "N: $tagname V: $tagval P: $tagprio\n" if $debug; |
|
|
336 if ($tagprio == 1) { |
|
|
337 $newimage_tagged_or = $tagval; |
|
|
338 } |
|
|
339 } |
|
|
340 |
|
|
341 # a clist is output only. someday, replace it with a list of |
|
|
342 # editboxes, even if we have to write one all in perl. |
|
|
343 |
|
|
344 # in the mean time, we vector out to a pair of combo boxes and let |
|
|
345 # the user edit there, while copying the changes back live. |
|
|
346 |
|
|
347 # save last index if any... |
|
|
348 my $oldtag; |
|
|
349 my $oldrow = $ilist->focus_row(); |
|
|
350 $oldtag = $ilist->get_text($oldrow, 0) if $oldrow > 0; |
|
|
351 print "old $oldrow: $oldtag\n" if $debug; |
|
|
352 $ilist->clear; |
|
|
353 for my $i (sort keys %field) { |
|
|
354 $ilist->append("\u$i", $field{$i}); |
|
|
355 } |
|
|
356 if ($oldrow > 0) { |
|
|
357 my $newrow = my_gtk_find_row($ilist, 0, $oldtag); |
|
|
358 print "new $newrow\n" if $debug; |
|
|
359 if ($newrow > 0) { |
|
|
360 $ilist->set_focus_row($newrow); |
|
|
361 $ilist->grab_focus(); |
|
|
362 } |
|
|
363 } |
|
|
364 |
|
|
365 # help the user enter stuff |
|
|
366 $name_entry->set_popdown_strings(@known_tags); |
|
|
367 # tag as unchanged |
|
|
368 $dirty = 0; |
|
|
369 } |
|
|
370 |
|
|
371 sub charmap_failed($$) { |
|
|
372 my $ipop = $g->get_widget('iconv_failed_dialog'); |
|
|
373 |
|
|
374 my $lbutton = $g->get_widget('iconv_latin1_charmap_button'); |
|
|
375 $lbutton->set_active(Gtk->true); # really we mean it |
|
|
376 my $ubutton = $g->get_widget('iconv_user_charmap_button'); |
|
|
377 my $uentry = $g->get_widget('iconv_user_charmap_entry'); |
|
|
378 # if there's a value there, it is from the previous attempt, and is wrong. |
|
|
379 $uentry->set_text(""); |
|
|
380 |
|
|
381 $ipop->run_and_close; |
|
|
382 |
|
|
383 if ($lbutton->get_active) { |
|
|
384 set_encoding("LATIN1"); |
|
|
385 } elsif ($ubutton->get_active) { |
|
|
386 set_encoding($uentry->get_text); |
|
|
387 } |
|
|
388 |
|
|
389 } |
|
|
390 |
|
|
391 sub save_image_tags { |
|
|
392 my $test_filename = shift; |
|
|
393 if ((not $dirty) && ($newimage_or eq $newimage_loaded_or)) { |
|
|
394 status(sprintf(_("%s not dirty, not saved"), ${test_filename})); |
|
|
395 return; |
|
|
396 } |
|
|
397 |
|
|
398 my $parent = ($doc->xql("image/description"))[0]; # first one |
|
|
399 my $exif = ($doc->xql("image/exif"))[0]; |
|
|
400 my %f = %field; |
|
|
401 |
|
|
402 # write out the tree... |
|
|
403 for my $xmlfield ($doc->xql("image/description/field")) { |
|
|
404 my $namestr = $xmlfield->getAttribute("name"); |
|
|
405 if (defined $f{$namestr}) { |
|
|
406 # delete this node so we can append it later |
|
|
407 $xmlfield->getParentNode->removeChild($xmlfield); |
|
|
408 } |
|
|
409 } |
|
|
410 # now append the remaining ones... |
|
|
411 for my $k (keys %f) { |
|
|
412 next if ($f{$k} eq ""); |
|
|
413 my $newfield = new XML::DOM::Element($doc, "field"); |
|
|
414 print "creating <$k> with <$f{$k}>\n" if $debug; |
|
|
415 $newfield->setAttribute("name", $k); # needs quoting! |
|
|
416 print "k: ", $k, " f: ", $f{$k}, " L2U: ", $Latin2UTF->convert($f{$k}), "\n" if $debug; |
|
|
417 my $newval; |
|
|
418 do { |
|
|
419 $newval = $Latin2UTF->convert($f{$k}); |
|
|
420 charmap_failed("save_image_tags", $f{$k}) if (not defined $newval); |
|
|
421 } until defined $newval; |
|
|
422 |
|
|
423 $newfield->addText($newval); |
|
|
424 $parent->appendChild($newfield); |
|
|
425 print "created $k with $f{$k}\n" if $debug; |
|
|
426 } |
|
|
427 |
|
|
428 # and orientation, if set |
|
|
429 if ($newimage_or ne $newimage_loaded_or) { |
|
|
430 for my $tag_node ($doc->xql("image/exif/tag[\@name = 'Orientation']")) { |
|
|
431 # delete the node, then construct a new one |
|
|
432 $tag_node->getParentNode->removeChild($tag_node); |
|
|
433 } |
|
|
434 my $newtag = new XML::DOM::Element($doc, "tag"); |
|
|
435 $newtag->setAttribute("name", "Orientation"); |
|
|
436 $newtag->setAttribute("priority", "1"); |
|
|
437 $newtag->addText($Latin2UTF->convert($newimage_or)); # unneeded conversion |
|
|
438 $exif->appendChild($newtag); |
|
|
439 print "Set orientation <$newimage_or> (loaded $newimage_loaded_or) in exif tag\n" if $debug; |
|
|
440 } |
|
|
441 |
|
|
442 $doc->printToFile("${test_filename}.xml"); |
|
|
443 status(sprintf(_("Saved %s."), $test_filename)); |
|
|
444 # undirty it |
|
|
445 $dirty = 0; |
|
|
446 $newimage_loaded_or = $newimage_or; |
|
|
447 } |
|
|
448 |
|
|
449 # if they enter or select a known one, snarf the value |
|
|
450 $name_entry->entry->signal_connect('changed', sub { |
|
|
451 my $entry = shift; |
|
|
452 my $val = $field{$entry->get_text}; |
|
|
453 if (defined $val) { |
|
|
454 $value_entry->entry->set_text($val); |
|
|
455 $value_entry->entry->set_editable(Gtk->true); |
|
|
456 } |
|
|
457 $dirty = 1; |
|
|
458 }); |
|
|
459 |
|
|
460 sub my_album_replace_text($$) { |
|
|
461 my $aw = shift; |
|
|
462 my $text = shift; |
|
|
463 $aw->set_point(0); |
|
|
464 $aw->forward_delete($albumvalue->get_length()); |
|
|
465 $aw->insert(undef, undef, undef, $text); |
|
|
466 $aw->set_editable(Gtk->true); |
|
|
467 } |
|
|
468 |
|
|
469 # album version |
|
|
470 $albumname->entry->signal_connect('changed', sub { |
|
|
471 my $entry = shift; |
|
|
472 my $val = $album{$entry->get_text}; |
|
|
473 if (defined $val) { |
|
|
474 my_album_replace_text($albumvalue, $val); |
|
|
475 } |
|
|
476 $album_dirty = 1; |
|
|
477 }); |
|
|
478 |
|
|
479 sub my_gtk_find_row { # returns row |
|
|
480 my ($clist, $col, $value) = @_; |
|
|
481 for my $i (0..$clist->rows) { |
|
|
482 my $cell = $clist->get_text($i, $col); |
|
|
483 return $i if ($cell ne "" && lc($cell) eq lc($value)); |
|
|
484 } |
|
|
485 return -1; |
|
|
486 } |
|
|
487 |
|
|
488 # if the value changes, update the text |
|
|
489 $value_entry->entry->signal_connect('changed', sub { |
|
|
490 my $entry = shift; |
|
|
491 my $newval = $entry->get_text; |
|
|
492 my $tag = lc($name_entry->entry->get_text); |
|
|
493 $field{$tag} = $newval; |
|
|
494 $dirty = 1; |
|
|
495 my $row = my_gtk_find_row($ilist, 0, $tag); |
|
|
496 print "row: $row tag: $tag newval: $newval\n" if $debug; |
|
|
497 # oh, no tag yet, add one |
|
|
498 if ($row != -1) { |
|
|
499 $ilist->set_text($row, 1, $newval); |
|
|
500 } else { |
|
|
501 # triggers select-row? |
|
|
502 $ilist->append("\u$tag", $newval); |
|
|
503 # update the dropdown too |
|
|
504 @known_tags = sort (@known_tags, $tag); |
|
|
505 $name_entry->set_popdown_strings(@known_tags); |
|
|
506 # force it all back |
|
|
507 $ilist->select_row($ilist->rows()-1, 0); |
|
|
508 } |
|
|
509 }); |
|
|
510 # album version |
|
|
511 $albumvalue->signal_connect('changed', sub { |
|
|
512 my $entry = shift; |
|
|
513 my $newval = $entry->get_chars(0,-1); |
|
|
514 my $tag = lc($albumname->entry->get_text); |
|
|
515 $album{$tag} = $newval; |
|
|
516 $dirty = 1; |
|
|
517 my $row = my_gtk_find_row($albumprop, 0, $tag); |
|
|
518 print "row: $row tag: $tag newval: $newval\n" if $debug; |
|
|
519 # oh, no tag yet, add one |
|
|
520 if ($row != -1) { |
|
|
521 $albumprop->set_text($row, 1, $newval); |
|
|
522 } else { |
|
|
523 # triggers select-row? |
|
|
524 $albumprob->append("\u$tag", $newval); |
|
|
525 # update the dropdown too |
|
|
526 @known_tags = sort (@known_tags, $tag); |
|
|
527 $albumname->set_popdown_strings(@known_tags); |
|
|
528 # force it all back |
|
|
529 $albumprob->select_row($ilist->rows()-1, 0); |
|
|
530 } |
|
|
531 }); |
|
|
532 |
|
|
533 $ilist->signal_connect('select-row', sub { |
|
|
534 my ($clist, $row, $col, $event, $udata) = @_; |
|
|
535 print "list: $clist row: $row col: $col event: $event udata: $udata\n" |
|
|
536 if $debug; |
|
|
537 $name_entry->entry->set_text($clist->get_text($row,0)); |
|
|
538 $value_entry->entry->set_text($clist->get_text($row,1)); |
|
|
539 print "focus on $value_entry\n" if $debug; |
|
|
540 $value_entry->entry->grab_focus(); |
|
|
541 }); |
|
|
542 |
|
|
543 # album version |
|
|
544 $albumprop->signal_connect('select-row', sub { |
|
|
545 my ($clist, $row, $col, $event, $udata) = @_; |
|
|
546 print "list: $clist row: $row col: $col event: $event udata: $udata\n" |
|
|
547 if $debug; |
|
|
548 $albumname->entry->set_text($clist->get_text($row,0)); |
|
|
549 my_album_replace_text($albumvalue, $clist->get_text($row,1)); |
|
|
550 print "focus on $value_entry\n" if $debug; |
|
|
551 $albumvalue->grab_focus(); |
|
|
552 }); |
|
|
553 |
|
|
554 |
|
|
555 # filter out .xml files, as we always derive them from the images |
|
|
556 # (also lets us eventually use the images as database keys instead) |
|
|
557 @filenames = grep (!/\.xml$/, @ARGV); |
|
|
558 |
|
|
559 $current_n = 0; |
|
|
560 $current_filename = $filenames[$current_n]; |
|
|
561 |
|
|
562 load_image $current_filename; |
|
|
563 |
|
|
564 Gtk->main; |
|
|
565 |
|
|
566 ## callbacks.. |
|
|
567 # new callbacks |
|
|
568 # 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 |
|
|
569 |
|
|
570 sub on_save1_activate { |
|
|
571 save_image_tags $current_filename; |
|
|
572 } |
|
|
573 |
|
|
574 sub on_about2_activate { |
|
|
575 $aboutbox->show; |
|
|
576 } |
|
|
577 |
|
|
578 sub on_license1_activate { |
|
|
579 $licensebox->show; |
|
|
580 my $button = $g->get_widget('dismiss_about'); |
|
|
581 $button->grab_focus(); |
|
|
582 } |
|
|
583 |
|
|
584 sub on_open2_activate { |
|
|
585 status(_("File browser not yet implemented.")); |
|
|
586 } |
|
|
587 |
|
|
588 sub on_revert1_activate { |
|
|
589 load_image $current_filename; |
|
|
590 status(sprintf(_("Reverted from %s."), $current_filename)); |
|
|
591 } |
|
|
592 |
|
|
593 sub set_filename_index($) { |
|
|
594 $current_n = shift; |
|
|
595 $current_filename = $filenames[$current_n]; |
|
|
596 load_image $current_filename; |
|
|
597 } |
|
|
598 |
|
|
599 sub move_filename_index($) { |
|
|
600 save_image_tags $current_filename; |
|
|
601 my $delta = shift; |
|
|
602 my $new_n = $current_n + $delta; |
|
|
603 |
|
|
604 # clamp it |
|
|
605 $new_n = 0 if $new_n < 0; |
|
|
606 $new_n = $#filenames if $new_n > $#filenames; |
|
|
607 if ($new_n == $current_n) { |
|
|
608 # we didn't move |
|
|
609 status(_("Out of filenames.")); |
|
|
610 } else { |
|
|
611 set_filename_index($new_n); |
|
|
612 } |
|
|
613 } |
|
|
614 |
|
|
615 sub on_next_file1_activate { |
|
|
616 move_filename_index(+1); |
|
|
617 } |
|
|
618 |
|
|
619 sub on_prev_file1_activate { |
|
|
620 move_filename_index(-1); |
|
|
621 } |
|
|
622 |
|
|
623 sub on_forward_10_activate { |
|
|
624 move_filename_index(+10); |
|
|
625 } |
|
|
626 sub on_back_10_activate { |
|
|
627 move_filename_index(-10); |
|
|
628 } |
|
|
629 sub on_start_of_list1_activate { |
|
|
630 set_filename_index(0); |
|
|
631 } |
|
|
632 sub on_end_of_list1_activate { |
|
|
633 set_filename_index($#filenames); |
|
|
634 } |
|
|
635 |
|
|
636 |
|
|
637 # auto fill from old_field |
|
|
638 sub on_auto_fill1_activate { |
|
|
639 for my $k (keys %old_field) { |
|
|
640 if ($field{$k} eq "" && $old_field{$k} ne "") { |
|
|
641 $field{$k} = $old_field{$k}; |
|
|
642 $dirty = 1; |
|
|
643 # and change it on-screen |
|
|
644 my $row = my_gtk_find_row($ilist, 0, $k); |
|
|
645 if ($row != -1) { |
|
|
646 print "updating row $row with $k ($field{$k})\n" if $debug; |
|
|
647 $ilist->set_text($row, 1, $field{$k}); |
|
|
648 } # maybe warn, or add field, if not found? |
|
|
649 } |
|
|
650 } |
|
|
651 status("Auto-filled fields."); |
|
|
652 } |
|
|
653 |
|
|
654 sub on_exit1_activate { |
|
|
655 save_image_tags $current_filename; |
|
|
656 |
|
|
657 Gtk->main_quit; |
|
|
658 } |
|
|
659 |
|
|
660 sub on_test_expose_event { |
|
|
661 my($widget) = @_; |
|
|
662 |
|
|
663 # print "otee, ",defined $imagesized,"\n"; |
|
|
664 # if (1 || not defined $imagesized) { |
|
|
665 my $w = $g->get_widget('image_edit_pixmap'); # GTK-Interface/widget/name |
|
|
666 # x,y,width,height |
|
|
667 my ($alloc_x, $alloc_y, $alloc_w, $alloc_h) = @{$w->allocation}; |
|
|
668 my $widget_w = $alloc_w; |
|
|
669 my $widget_h = $alloc_h; |
|
|
670 |
|
|
671 if ($debug) { |
|
|
672 print join("| ", @{$w->allocation}); |
|
|
673 print "| x: $widget_w y: $widget_h "; |
|
|
674 print |
|
|
675 "nw: ", $newimage->rgb_width, |
|
|
676 " nh: ", $newimage->rgb_height, "\n" if defined $newimage; |
|
|
677 print |
|
|
678 " x/y: ",$widget_w/$widget_h, |
|
|
679 " nw/x: ", $newimage->rgb_width/$widget_w, |
|
|
680 " nh/y: ", $newimage->rgb_height/$widget_h, |
|
|
681 "\n" if defined $newimage; |
|
|
682 } |
|
|
683 # print "ox: $old_x oy: $old_y ww: $widget_w wh: $widget_h I:$imagesized\n"; |
|
|
684 # return if same size |
|
|
685 if ($old_x == $widget_w && $old_y == $widget_h) { |
|
|
686 # but not if we never dealt before |
|
|
687 return if (defined $imagesized); |
|
|
688 } |
|
|
689 if (defined $newimage) { |
|
|
690 my ($use_w, $use_h) = ($newimage->rgb_width, $newimage->rgb_height); |
|
|
691 my $rat_w = $use_w/$widget_w; |
|
|
692 my $rat_h = $use_h/$widget_h; |
|
|
693 $rat = ($rat_w > $rat_h) ? $rat_w : $rat_h; |
|
|
694 |
|
|
695 $use_w = $use_w / $rat; |
|
|
696 $use_h = $use_h / $rat; |
|
|
697 $newimage->render($use_w, $use_h); |
|
|
698 my $my_image = $newimage->copy_image(); # returns Gtk::Gdk::Pixmap |
|
|
699 my $my_mask = $newimage->copy_mask(); # returns Gtk::Gdk::Bitmap |
|
|
700 $w->set($my_image, $my_mask); |
|
|
701 $my_image->imlib_free(); |
|
|
702 } else { |
|
|
703 # come up with more clever "test pattern" later? |
|
|
704 $w->set(undef, undef); |
|
|
705 } |
|
|
706 $old_x = $widget_w; |
|
|
707 $old_y = $widget_h; |
|
|
708 #undef $imagesized; |
|
|
709 $imagesized = 1; |
|
|
710 # } |
|
|
711 } |
|
|
712 |
|
|
713 # rotations that override, or rather compound, the EXIF values |
|
|
714 # build the rotation-ring first |
|
|
715 sub my_init_rotations { |
|
|
716 my @rotation_order = ("right_top", "right_bot", "left_bot", "top_left"); |
|
|
717 my $left = $rotation_order[$#rotation_order]; |
|
|
718 for my $curr (@rotation_order) { |
|
|
719 $rotate_right{$left} = $curr; |
|
|
720 $rotate_left{$curr} = $left; |
|
|
721 $left = $curr; |
|
|
722 } |
|
|
723 # special case none->top_left |
|
|
724 $rotate_right{""} = $rotate_right{"top_left"}; |
|
|
725 $rotate_left{""} = $rotate_left{"top_left"}; |
|
|
726 } |
|
|
727 |
|
|
728 sub my_image_rotate { |
|
|
729 my $delta_or = shift; |
|
|
730 print "$test_filename: new user-requested rotation $delta_or to $newimage_or\n" if $debug; |
|
|
731 |
|
|
732 my_real_gdk_rotate($newimage,$delta_or); |
|
|
733 # consider noticing that $newimage_or == $newimage_loaded_or and reverting. |
|
|
734 # regardless, rerender |
|
|
735 if (defined $imagesized) { |
|
|
736 undef $imagesized; |
|
|
737 on_test_expose_event(); |
|
|
738 } |
|
|
739 status(_("Rotated.")); |
|
|
740 } |
|
|
741 |
|
|
742 sub on_rotate_right_cw1_activate { |
|
|
743 $newimage_or = $rotate_right{$newimage_or}; |
|
|
744 my_image_rotate("right_top"); |
|
|
745 } |
|
|
746 |
|
|
747 sub on_rotate_left1_activate { |
|
|
748 $newimage_or = $rotate_left{$newimage_or}; |
|
|
749 my_image_rotate("left_bot"); |
|
|
750 } |
|
|
751 |
|
|
752 # don't actually undo the rotations, just reload - but don't lose tags |
|
|
753 sub on_cancel_rotation1_activate { |
|
|
754 load_image $current_filename, "keeptags"; |
|
|
755 status(_("Image restored.")); |
|
|
756 } |
|
|
757 |
|
|
758 ### album stuff ### |
|
|
759 sub load_album_tags($); |
|
|
760 |
|
|
761 sub on_album1_activate { |
|
|
762 $current_album = $current_filename; |
|
|
763 # basename |
|
|
764 $current_album =~ s{[^/]*$}{}; # } perl-mode-sucks |
|
|
765 # make a complete name out of it |
|
|
766 $current_album .= "album.xml"; #if (-d "${current_album}"); |
|
|
767 $albumfile->set($current_album); |
|
|
768 load_album_tags($current_album); |
|
|
769 $albumedit->show; |
|
|
770 } |
|
|
771 |
|
|
772 sub on_open2_activate { |
|
|
773 status(_("File browser not yet implemented.")); |
|
|
774 } |
|
|
775 |
|
|
776 sub on_close1_activate { |
|
|
777 # save if dirty |
|
|
778 save_album_tags($current_album) if $album_dirty; |
|
|
779 $albumedit->hide; |
|
|
780 } |
|
|
781 |
|
|
782 sub on_revert2_activate { |
|
|
783 load_album_tags $current_album; |
|
|
784 status(sprintf(_("Reverted from %s."), $current_album)); |
|
|
785 } |
|
|
786 |
|
|
787 sub save_album_tags; |
|
|
788 |
|
|
789 sub on_save2_activate { |
|
|
790 save_album_tags $current_album; |
|
|
791 } |
|
|
792 |
|
|
793 # sub on_exit2_activate { |
|
|
794 # &on_exit1_activate(@_); |
|
|
795 # } |
|
|
796 |
|
|
797 sub load_album_tags($) { |
|
|
798 %old_album = %album; # save for later recall |
|
|
799 |
|
|
800 my $test_filename = shift; |
|
|
801 $parser = new XML::DOM::Parser; |
|
|
802 if (-r "${test_filename}" ) { |
|
|
803 $album_doc = $parser->parsefile ("${test_filename}"); |
|
|
804 } else { |
|
|
805 # literal minimal tree |
|
|
806 $album_doc = $parser->parse('<?xml version="1.0" encoding="UTF-8"?><album><description></description><bins></bins></album>'); |
|
|
807 status(sprintf(_("%s not found, constructing"), "${test_filename}")); |
|
|
808 } |
|
|
809 |
|
|
810 |
|
|
811 undef %album; |
|
|
812 |
|
|
813 for my $i (@album_tags) { |
|
|
814 $album{$i} = ""; |
|
|
815 } |
|
|
816 |
|
|
817 for my $field_node ($album_doc->xql("album/description/field")) { |
|
|
818 my $fieldname = ($field_node->xql("\@name"))[0]->xql_toString; |
|
|
819 my $fieldval = $field_node->xql_toString; |
|
|
820 print "N: $fieldname V: $fieldval\n" if $debug; |
|
|
821 $album{$fieldname} = $UTF2Latin->convert($fieldval); |
|
|
822 } |
|
|
823 |
|
|
824 # a clist is output only. someday, replace it with a list of |
|
|
825 # editboxes, even if we have to write one all in perl. |
|
|
826 |
|
|
827 # in the mean time, we vector out to a pair of combo boxes and let |
|
|
828 # the user edit there, while copying the changes back live. |
|
|
829 |
|
|
830 # save last index if any... |
|
|
831 my $oldtag; |
|
|
832 my $oldrow = $albumprop->focus_row(); |
|
|
833 $oldtag = $albumprop->get_text($oldrow, 0) if $oldrow > 0; |
|
|
834 print "old $oldrow: $oldtag\n" if $debug; |
|
|
835 $albumprop->clear; |
|
|
836 for my $i (sort keys %album) { |
|
|
837 $albumprop->append("\u$i", $album{$i}); |
|
|
838 } |
|
|
839 if ($oldrow > 0) { |
|
|
840 my $newrow = my_gtk_find_row($albumprop, 0, $oldtag); |
|
|
841 print "new $newrow\n" if $debug; |
|
|
842 if ($newrow > 0) { |
|
|
843 $albumprop->set_focus_row($newrow); |
|
|
844 $albumprop->grab_focus(); |
|
|
845 } |
|
|
846 } |
|
|
847 |
|
|
848 # help the user enter stuff |
|
|
849 $albumname->set_popdown_strings(@known_tags); |
|
|
850 # tag as unchanged |
|
|
851 $dirty = 0; |
|
|
852 } |
|
|
853 |
|
|
854 sub save_album_tags { |
|
|
855 my $test_filename = shift; |
|
|
856 if (not $album_dirty) { |
|
|
857 status(sprintf(_("%s not dirty, not saved"), ${test_filename})); |
|
|
858 return; |
|
|
859 } |
|
|
860 |
|
|
861 my $parent = ($album_doc->xql("album/description"))[0]; # first one |
|
|
862 my %f = %album; |
|
|
863 |
|
|
864 # write out the tree... |
|
|
865 for my $xmlfield ($album_doc->xql("album/description/field")) { |
|
|
866 my $namestr = $xmlfield->getAttribute("name"); |
|
|
867 if (defined $f{$namestr}) { |
|
|
868 # delete this node so we can append it later |
|
|
869 $xmlfield->getParentNode->removeChild($xmlfield); |
|
|
870 } |
|
|
871 } |
|
|
872 # now append the remaining ones... |
|
|
873 for my $k (keys %f) { |
|
|
874 next if ($f{$k} eq ""); |
|
|
875 my $newfield = new XML::DOM::Element($album_doc, "field"); |
|
|
876 print "creating <$k> with <$f{$k}>\n" if $debug; |
|
|
877 $newfield->setAttribute("name", $k); # needs quoting! |
|
|
878 $newfield->addText($Latin2UTF->convert($f{$k})); |
|
|
879 $parent->appendChild($newfield); |
|
|
880 print "created $k with $f{$k}\n" if $debug; |
|
|
881 } |
|
|
882 |
|
|
883 $album_doc->printToFile("${test_filename}"); |
|
|
884 status(sprintf(_("Saved %s."), $test_filename)); |
|
|
885 # undirty it |
|
|
886 $album_dirty = 0; |
|
|
887 } |
