dnrops
/
gimp
mirror of https://github.com/GNOME/gimp.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

see plug-ins/perl/Changes

This commit is contained in:
Marc Lehmann 1999-05-20 22:14:38 +00:00
parent 8218179aa6
commit 26eb474362
6 changed files with 67 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
plug-ins/perl/Gimp/Lib.xs
View File

@ -1902,13 +1902,13 @@ GPixelRgnIterator
gimp_pixel_rgns_register(...)
CODE:
if (items == 1)
RETVAL = gimp_pixel_rgns_register (1, old_pixelrgn (ST (0)));
RETVAL = gimp_pixel_rgns_register (1, old_pixelrgn (ST (0)));
else if (items == 2)
RETVAL = gimp_pixel_rgns_register (2, old_pixelrgn (ST (0)), old_pixelrgn (ST (1)));
RETVAL = gimp_pixel_rgns_register (2, old_pixelrgn (ST (0)), old_pixelrgn (ST (1)));
else if (items == 3)
RETVAL = gimp_pixel_rgns_register (3, old_pixelrgn (ST (0)), old_pixelrgn (ST (1)), old_pixelrgn (ST (2)));
RETVAL = gimp_pixel_rgns_register (3, old_pixelrgn (ST (0)), old_pixelrgn (ST (1)), old_pixelrgn (ST (2)));
else
croak ("gimp_pixel_rgns_register supports only 1, 2 or 3 arguments, upgrade to gimp-1.1 and report this error");
croak ("gimp_pixel_rgns_register supports only 1, 2 or 3 arguments, upgrade to gimp-1.1 and report this error");
OUTPUT:
RETVAL

18
plug-ins/perl/Gimp/Net.pm
View File

@ -41,7 +41,7 @@ sub import {
*Gimp::Tile::DESTROY=
*Gimp::PixelRgn::DESTROY=
*Gimp::GDrawable::DESTROY=sub {
my $req="DTRY".args2net(@_);
my $req="DTRY".args2net(0,@_);
print $server_fh pack("N",length($req)).$req;
};
}
@ -59,13 +59,13 @@ sub response {
read($server_fh,$len,4) == 4 or die "protocol error (1)";
$len=unpack("N",$len);
read($server_fh,$req,$len) == $len or die "protocol error (2)";
net2args($req);
net2args(0,$req);
}
# this is hardcoded into gimp_call_procedure!
sub command {
my $req=shift;
$req.=args2net(@_);
$req.=args2net(0,@_);
print $server_fh pack("N",length($req)).$req;
}
@ -73,18 +73,18 @@ sub gimp_call_procedure {
my($len,@args,$trace,$req);
if ($trace_level) {
$req="TRCE".args2net($trace_level,@_);
$req="TRCE".args2net(0,$trace_level,@_);
print $server_fh pack("N",length($req)).$req;
do {
read($server_fh,$len,4) == 4 or die "protocol error";
$len=unpack("N",$len);
read($server_fh,$req,abs($len)) == $len or die "protocol error";
if ($len<0) {
($req,@args)=net2args($req);
($req,@args)=net2args(0,$req);
print "ignoring callback $req\n";
redo;
}
($trace,$req,@args)=net2args($req);
($trace,$req,@args)=net2args(0,$req);
if (ref $trace_res eq "SCALAR") {
$$trace_res = $trace;
} else {
@ -92,18 +92,18 @@ sub gimp_call_procedure {
}
} while 0;
} else {
$req="EXEC".args2net(@_);
$req="EXEC".args2net(0,@_);
print $server_fh pack("N",length($req)).$req;
do {
read($server_fh,$len,4) == 4 or die "protocol error";
$len=unpack("N",$len);
read($server_fh,$req,abs($len)) == $len or die "protocol error";
if ($len<0) {
($req,@args)=net2args($req);
($req,@args)=net2args(0,$req);
print "ignoring callback $req\n";
redo;
}
($req,@args)=net2args($req);
($req,@args)=net2args(0,$req);
} while 0;
}
croak $req if $req;

6
plug-ins/perl/Net/Makefile.PL
View File

@ -1,5 +1,8 @@
use ExtUtils::MakeMaker;
chomp ($_gccflags = qx<glib-config --cflags glib>);
chomp ($_gldflags = qx<glib-config --libs glib>);
do '../config.pl';
sub MY::postamble {
@ -14,7 +17,8 @@ $GIMP_INC_NOUI = "-I../../.. $GIMP_INC_NOUI" if $IN_GIMP;
WriteMakefile(
'NAME' => 'Gimp::Net',
'VERSION_FROM' => '../Gimp.pm',
'INC' => "$INC1 $CPPFLAGS $pdl_inc $CFLAGS",
'INC' => "$INC1 $CPPFLAGS $pdl_inc $_gccflags $CFLAGS",
'DEFINE' => "$DEFINE1 $DEFS",
'TYPEMAPS' => ["$topdir/typemap",@pdl_typemaps],
dynamic_lib => { OTHERLDFLAGS => "$LDFLAGS $LIBS $_gldflags" },
);

52
plug-ins/perl/Net/Net.xs
View File

@ -9,6 +9,8 @@
#define NEED_newCONSTSUB
#include "ppport.h"
#include <glib.h>
#if HAVE_PDL
# include <pdlcore.h>
@ -35,6 +37,20 @@ static void need_pdl (void)
#endif
#define is_dynamic(sv) \
(sv_derived_from (sv, "Gimp::Tile") \
|| sv_derived_from (sv, "Gimp::PixelRgn") \
|| sv_derived_from (sv, "Gimp::GDrawable"))
static GHashTable *object_cache;
#define init_object_cache if (!object_cache) object_cache = g_hash_table_new (g_int_hash, g_int_equal)
static void destroy (gint id)
{
init_object_cache;
}
/* allocate this much as initial length */
#define INITIAL_PV 256
/* and increment in these steps */
@ -53,7 +69,7 @@ static void need_pdl (void)
*
*/
static void sv2net (SV *s, SV *sv)
static void sv2net (int deobjectify, SV *s, SV *sv)
{
if (SvLEN(s)-SvCUR(s) < 96)
SvGROW (s, SvLEN(s) + PV_INC);
@ -66,6 +82,11 @@ static void sv2net (SV *s, SV *sv)
char *name = HvNAME (SvSTASH (rv));
sv_catpvf (s, "b%x:%s", strlen (name), name);
if (is_dynamic (sv))
{
//return;
}
}
else
sv_catpvn (s, "r", 1);
@ -77,10 +98,10 @@ static void sv2net (SV *s, SV *sv)
sv_catpvf (s, "a%x:", (int)av_len(av));
for (i = 0; i <= av_len(av); i++)
sv2net (s, *av_fetch(av,i,0));
sv2net (deobjectify, s, *av_fetch(av,i,0));
}
else if (SvTYPE(rv) == SVt_PVMG)
sv2net (s, rv);
sv2net (deobjectify, s, rv);
else
croak ("Internal error: unable to convert reference in sv2net, please report!");
}
@ -103,7 +124,7 @@ static void sv2net (SV *s, SV *sv)
sv_catpvn (s, "u", 1);
}
static SV *net2sv (char **_s)
static SV *net2sv (int objectify, char **_s)
{
char *s = *_s;
SV *sv;
@ -130,7 +151,7 @@ static SV *net2sv (char **_s)
break;
case 'r':
sv = newRV_noinc (net2sv (&s));
sv = newRV_noinc (net2sv (objectify, &s));
break;
case 'b':
@ -140,7 +161,7 @@ static SV *net2sv (char **_s)
memcpy (str, s, ui); s += ui;
str[ui] = 0;
sv = sv_bless (newRV_noinc (net2sv (&s)), gv_stashpv (str, 1));
sv = sv_bless (newRV_noinc (net2sv (objectify, &s)), gv_stashpv (str, 1));
break;
case 'a':
@ -148,7 +169,7 @@ static SV *net2sv (char **_s)
av = newAV ();
av_extend (av, ui);
for (n = 0; n <= ui; n++)
av_store (av, n, net2sv (&s));
av_store (av, n, net2sv (objectify, &s));
sv = (SV*)av;
break;
@ -166,27 +187,34 @@ MODULE = Gimp::Net PACKAGE = Gimp::Net
PROTOTYPES: ENABLE
SV *
args2net(...)
args2net(deobjectify,...)
int deobjectify
CODE:
int index;
if (deobjectify) init_object_cache;
RETVAL = newSVpv ("", 0);
(void) SvUPGRADE (RETVAL, SVt_PV);
SvGROW (RETVAL, INITIAL_PV);
for (index = 0; index < items; index++)
sv2net (RETVAL, ST(index));
for (index = 1; index <= items; index++)
sv2net (deobjectify, RETVAL, ST(index));
/*printf (">>>>%s\n",SvPV_nolen(RETVAL));*/
OUTPUT:
RETVAL
void
net2args(s)
net2args(objectify,s)
int objectify
char * s
PPCODE:
/*printf ("<<<<%s\n",s);*/
if (objectify) init_object_cache;
/* this depends on a trailing zero! */
while (*s)
XPUSHs (sv_2mortal (net2sv (&s)));
XPUSHs (sv_2mortal (net2sv (objectify, &s)));

16
plug-ins/perl/Perl-Server
View File

@ -95,7 +95,7 @@ sub destroy_objects {
# this is hardcoded into handle_request!
sub reply {
my $fh=shift;
my $data=Gimp::Net::args2net(@_);
my $data=Gimp::Net::args2net(0,@_);
print $fh pack("N",length($data)).$data;
}
@ -120,29 +120,29 @@ sub handle_request($) {
if(!$auth or $authorized[fileno($fh)]) {
if($req eq "EXEC") {
no strict 'refs';
($req,@args)=Gimp::Net::net2args($data);
($req,@args)=Gimp::Net::net2args(1,$data);
@args=deobjectify(eval { Gimp->$req(objectify(@args)) });
$data=Gimp::Net::args2net($@,@args);
$data=Gimp::Net::args2net(1,$@,@args);
print $fh pack("N",length($data)).$data;
} elsif ($req eq "TEST") {
no strict 'refs';
print $fh (defined(*{"Gimp::Lib::$data"}{CODE}) || Gimp::_gimp_procedure_available($data)) ? "1" : "0";
} elsif ($req eq "DTRY") {
destroy_objects Gimp::Net::net2args($data);
destroy_objects Gimp::Net::net2args(0,$data);
} elsif($req eq "TRCE") {
no strict 'refs';
($trace_level,$req,@args)=Gimp::Net::net2args($data);
($trace_level,$req,@args)=Gimp::Net::net2args(1,$data);
Gimp::set_trace($trace_level);
$trace_res="";
@args=deobjectify(eval { Gimp->$req(objectify(@args)) });
$data=Gimp::Net::args2net($trace_res,$@,@args);
$data=Gimp::Net::args2net(1,$trace_res,$@,@args);
print $fh pack("N",length($data)).$data;
Gimp::set_trace(0);
} elsif ($req eq "QUIT") {
slog "received QUIT request";
$server_quit = 1;
} elsif($req eq "AUTH") {
$data=Gimp::Net::args2net(1,"authorization unnecessary");
$data=Gimp::Net::args2net(0,1,"authorization unnecessary");
print $fh pack("N",length($data)).$data;
} elsif($req eq "LOCK") {
my($lock,$shared)=unpack("N*",$data);
@ -178,7 +178,7 @@ sub handle_request($) {
slog $msg;
sleep 5; # safety measure
}
$data=Gimp::Net::args2net($ok,$msg);
$data=Gimp::Net::args2net(0,$ok,$msg);
print $fh pack("N",length($data)).$data;
return $ok;
} else {

1
plug-ins/perl/TODO
View File

@ -11,6 +11,7 @@ make test TEST_VERBOSE=1
bugs
* KILL :auto from default(!)
* auto-flush of gdrawable when merge_shadow(?)
* gimp-piddle must be written back automatically on destroy, if changed
* possibly rename "Brush Selection" to "Paint Settings"
* gimp-tile set dirty automatically(!)