| Subject: | patch to callback problem |
Currently Gimp module don't return any return values from Perl-Fu. I think I've solved the problem. At least the patch solved my problem for now. :)
If you don't see attached patch, it's also at http://freebsd.sinica.edu.tw/~plasma/gimp-return_value.patch.
How To Verify
Apply the patch file, then install Gimp module.
A tiny Perl-Fu script is placed at http://freebsd.sinica.edu.tw/~plasma/tiny-test.pl. Put it in ~/.gimp/plug-ins, then start Gimp.
Invoke a perl debugger with 'perl -de 0', then type the following commands:
use Gimp ":auto"
use Gimp::Fu
Gimp::init
x perl_fu_tiny_test("Text","Charter",45)
Below is my output:
DB<66> x perl_fu_tiny_test("Text","Charter",45) 0 Gimp::Image=SCALAR(0x85bb0e4)
-> 0
1 Gimp::Layer=SCALAR(0x85b7384)
-> 2
Now it really return values. :)
Best Regards,
Chen, Wei-Hon
diff -ruN Gimp-1.21.orig/Gimp/Lib.xs Gimp-1.21/Gimp/Lib.xs
--- Gimp-1.21.orig/Gimp/Lib.xs Thu Apr 11 16:48:11 2002
+++ Gimp-1.21/Gimp/Lib.xs Thu Apr 11 16:22:33 2002
@@ -966,7 +966,12 @@
arg->data.d_image = gimp_channel_get_image_id (unbless(sv, PKG_CHANNEL , croak_str));
else if (sv_derived_from (sv, PKG_IMAGE) || !SvROK (sv))
{
- arg->data.d_image = unbless(sv, PKG_IMAGE , croak_str); break;
+ arg->data.d_image = unbless(sv, PKG_IMAGE , croak_str); break;
+ }
+ else if (sv_derived_from (sv, PKG_IMAGE) || SvROK(sv))
+ {
+ printf("(sv_derived_from (sv, PKG_IMAGE) || SvROK(sv) is called\n");
+ arg->data.d_image = unbless(SvRV(sv), PKG_IMAGE , croak_str); break;
}
else
strcpy (croak_str, __("argument incompatible with type IMAGE"));
@@ -1227,7 +1232,7 @@
{
--count;
(void) POPs;
- }
+ }
if (errmsg [0])
{
diff -ruN Gimp-1.21.orig/Gimp.pm Gimp-1.21/Gimp.pm
--- Gimp-1.21.orig/Gimp.pm Thu Apr 11 16:48:11 2002
+++ Gimp-1.21/Gimp.pm Thu Apr 11 16:16:00 2002
@@ -392,7 +392,9 @@
sub callback {
my $type = shift;
my @cb;
+ my @results;
if ($type eq "-run") {
+ print "[callback] -run block.\n";
local $function = shift;
local $in_run = 1;
_initialized_callback;
@@ -405,8 +407,9 @@
);
}
die_msg __"required callback 'run' not found\n" unless @cb;
- for (@cb) { &$_ }
+ for (@cb) { push(@results, &$_) }
} elsif ($type eq "-net") {
+ print "[callback] -net block.\n";
local $in_net = 1;
_initialized_callback;
{
@@ -418,8 +421,9 @@
);
}
die_msg __"required callback 'net' not found\n" unless @cb;
- for (@cb) { &$_ }
+ for (@cb) { push(@results, &$_) }
} elsif ($type eq "-query") {
+ print "[callback] -query block.\n";
local $in_query = 1;
_initialized_callback;
{
@@ -429,8 +433,9 @@
);
}
die_msg __"required callback 'query' not found\n" unless @cb;
- for (@cb) { &$_ }
+ for (@cb) { push(@results, &$_) }
} elsif ($type eq "-quit") {
+ print "[callback] -quit block.\n";
local $in_quit = 1;
{
local $^W = 0;
@@ -438,8 +443,10 @@
@{$callback{quiet}},
);
}
- for (@cb) { &$_ }
+ for (@cb) { push(@results, &$_) }
}
+
+ return (wantarray) ? @results : $results[0];
}
sub register_callback($$) {