Skip to content
GitLab
Commit 2ea8e217 authored by Marc Lehmann's avatar Marc Lehmann
Browse files

see plug-ins/perl/Changes

parent d86538d5
Hide whitespace changes
Inline Side-by-side
plug-ins/perl/COPYING
View file @ 2ea8e217
This is distributed under the same license as perl itself, i.e. either the
Artistic License (COPYING.Artistic) or the GPL (COPYING.GNU).
This package is distributed under the same license as perl itself, i.e.
either the Artistic License (COPYING.Artistic) or the GPL (COPYING.GNU).
Please note that this does _NOT_ include the scripts in the examples/
directory. Most of them have their own distribution license (see their
source for details, and read the file examples/README).
If you make modifications, please consider sending them to me,
Marc Lehmann <pcg@goof.com>
......
plug-ins/perl/Changes
View file @ 2ea8e217
Revision history for Gimp-Perl extension.
- added examples/yinyang, examples/image_tile.
- bangpath is no longer updated inplace. As a result, only plug-ins
that are going to get installed are being fixed, the examples are
not.
- fixed error handling bugs in Gimp::Lib, streamlined and improved
error handling.
- reworked callback handling, should be more flexible in the future.
- changed implementation of PF_CUSTOM (still untested).
1.061 Fri Mar 12 21:27:26 CET 1999
- closed big, BIG security hole on password authenticitation
(basically one could do anything includung killing your
system without authorization. argh). This required a
protocol change, so old clients are unable to connect using
password-authenticitation.
- sped up Gimp::Net considerably, by getting rid of the IO::Socket
module, which required half a second(!!) to load.
- closed big, BIG security hole on password authenticitation
(basically one could do anything includung killing your
system without authorization. argh). This required a
protocol change, so old clients are unable to connect using
password-authenticitation.
- sped up Gimp::Net considerably, by getting rid of the IO::Socket
module, which required half a second(!!) to load.
- fixed Gimp::Util::gimp_image_layertype.
- make install checks for install directory writability
and refuses to install if it isn't.
- fixed a longstanding bug that caused (some) set_trace calls
to be ignored when running under Gimp::Net.
- make install checks for install directory writability and refuses to
install if it isn't.
- fixed a longstanding bug that caused (some) set_trace calls
to be ignored when running under Gimp::Net.
- added new convinience functions to Gimp::Util.
- Gimp::Fu checks for the presence of Gtk and dies
if it can't be found.
- PF_FONT should now display a string widget in gtk+ 1.0.
- PixelRgn/Tile data sould now be accessible again.
- updated PDB.
- extensive tests is now always on.
- added examples/gimpmagick, examples/sethspin.pl, animate_cells.
- new function Gimp::initialized that returns true whenever its
safe to call gimp functins.
- added the Gimp::Feature module, allowing for easy feature checks.
See examples/gimpmagick or examples/parasite-editor for example
usage.
- added perlcc, the perl control center. Only displays log messages
at the moment.
- error and warning logging through the Perl Control Center.
- Data::Dumper is now longer required to run the scripts, some
buttons and RUN_WITH_LAST_VALS won't work, though.
- removed POSIX dependency in examples/gimpmagick.
- Uh, ah, debugging code in the repository, again!
- Gimp::Fu checks for the presence of Gtk and dies if it can't be
found.
- PF_FONT should now display a string widget in gtk+ 1.0.
- PixelRgn/Tile data sould now be accessible again.
- updated PDB.
- extensive tests is now always on.
- added examples/gimpmagick, examples/sethspin.pl, animate_cells.
- new function Gimp::initialized that returns true whenever its
safe to call gimp functins.
- added the Gimp::Feature module, allowing for easy feature checks.
See examples/gimpmagick or examples/parasite-editor for example
usage.
- added perlcc, the perl control center. Only displays log messages
at the moment.
- error and warning logging through the Perl Control Center.
- Data::Dumper is now longer required to run the scripts, some
buttons and RUN_WITH_LAST_VALS won't work, though.
- removed POSIX dependency in examples/gimpmagick.
- Uh, ah, debugging code in the repository, again!
1.06 Sat Mar 6 19:36:12 CET 1999
- Gimp::Fu does no longer display the returned image when it
is the same as the one passed in.
- append imagenumber to "Untitled"-images in widget.
- removed publicly-visible non-PDB pixelfunctions.
"uuuuuse peedee-ell or dieieie".
- implemented Gimp::Fu::PF_RADIO.
- added blowinout.pl, terral_text and xachvision.pl.
- the use of Gimp::PDL to access the region/tile functions is
now mandatory. The old string interface does not exist anymore.
- the path to the server-socket now includes the UID, to avoid
collisions. CGI-scripts should use either tcp or specify the path
directly using GIMP_HOST (see Gimp::Net for details).
- use _much_ saner defaults for the Scale types in Gimp::Fu.
- Gimp::Fu's optionmenus didn't work in net()-mode.
- implemented PF_CUSTOM (untested).
- added Gimp::UI::ColorSelectbutton, I was utterly fed up with
GtkColorSelectbutton never working.
is the same as the one passed in.
- append imagenumber to "Untitled"-images in widget.
- removed publicly-visible non-PDB pixelfunctions.
"uuuuuse peedee-ell or dieieie".
- implemented Gimp::Fu::PF_RADIO.
- added blowinout.pl, terral_text and xachvision.pl.
- the use of Gimp::PDL to access the region/tile functions is
now mandatory. The old string interface does not exist anymore.
- the path to the server-socket now includes the UID, to avoid
collisions. CGI-scripts should use either tcp or specify the path
directly using GIMP_HOST (see Gimp::Net for details).
- use _much_ saner defaults for the Scale types in Gimp::Fu.
- Gimp::Fu's optionmenus didn't work in net()-mode.
- implemented PF_CUSTOM (untested).
- added Gimp::UI::ColorSelectbutton, I was utterly fed up with
GtkColorSelectbutton never working.
1.055 Mon Feb 22 22:38:44 CET 1999
- applied seth's script changes.
- gimp11ified some plug-ins.
- removed debugging code in Gimp/Lib.xs.
- got rid of a perl5.004 warning.
- removed gimp_{main,init,end}.
- gimp11ified some plug-ins.
- removed debugging code in Gimp/Lib.xs.
- got rid of a perl5.004 warning.
- removed gimp_{main,init,end}.
1.054 Mon Feb 22 15:23:41 CET 1999
- scm2scm and scm2perl will now be installed in INST_SCRIPT
- fixed a bug in interact/PF_FONT.
- made save_image more 1.1 compatible and automatically index
when saving to gif.
- many, Many, MANY 5.004 compatibility fixes.
- fixed a bug in interact/PF_FONT.
- made save_image more 1.1 compatible and automatically index
when saving to gif.
- many, Many, MANY 5.004 compatibility fixes.
1.053 Mon Feb 15 01:35:04 CET 1999
- more errornous argument types are detected now, without
just calling abort().
- fixed a MAJOR namespace-leak: for example, if one used
gimp_parasite_list once, Gimp::Image->parasite_list would call
gimp_parasite_list and NOT gimp_image_parasite_list, as would be
correct.
- Gimp::Net now works correctly with parasites.
- added examples/parasite_editor
- added gimp_ prefix to Parasite-class
- use $Config{perlpath} for bangpath, not $PERL
just calling abort().
- fixed a MAJOR namespace-leak: for example, if one used
gimp_parasite_list once, Gimp::Image->parasite_list would call
gimp_parasite_list and NOT gimp_image_parasite_list, as would be
correct.
- Gimp::Net now works correctly with parasites.
- added examples/parasite_editor
- added gimp_ prefix to Parasite-class
- use $Config{perlpath} for bangpath, not $PERL
1.052 Tue Feb 9 18:16:15 CET 1999
- moved the xlfd_size function from Gimp::Fu into Gimp
(and maybe later into Gimp::Util?)
(and maybe later into Gimp::Util?)
- functions in Gimp::Util are now treated in the same way
as PDB functions (when the module is loaded)
- improved handling of "make clean" to make it less perl-ish
and more gnu-ish
- enabled full testsuite (keep your fingers crossed)
as PDB functions (when the module is loaded)
- improved handling of "make clean" to make it less perl-ish
and more gnu-ish
- enabled full testsuite (keep your fingers crossed)
- PDL examples no longer cause errors at startup
- more compatibility fixes for 5.005_54
- bangpaths are now replaced by $PERL at configuration time
- fixed a few quirks in scm2scm and added it to the package
- more compatibility fixes for 5.005_54
- bangpaths are now replaced by $PERL at configuration time
- fixed a few quirks in scm2scm and added it to the package
1.051 Tue Jan 19 21:10:20 CET 1999
- corrected a minor typoe found by Stefan Traby <stefan@sime.com>
- added SPIRAL* constants for gimp_blend
- moved constants from Gimp.xs and extradefs.h to Gimp.pm, where
they belong (either there or into Gimp.xs)
- added SPIRAL* constants for gimp_blend
- moved constants from Gimp.xs and extradefs.h to Gimp.pm, where
they belong (either there or into Gimp.xs)
- added view3d.pl to examples (untested)
- Gimp::Util is reborn (give it a try and contribute!)
- more Gtk changes (tested with Gtk-0.5 and gtk-1.1.x, uh-oh)
......@@ -104,11 +113,11 @@ Revision history for Gimp-Perl extension.
1.05 Fri Dec 18 22:05:25 CET 1998
- some 5.006 compatibility fixes
- disabled some functionality for poor gtk-1.0 which
is borken to no end
- fixed PARASITE_PERSISTENT typoe
- new functions: gimp_{major,minor,micro}_version
- PF_BRUSH, PATTERN and GRADIENT widgets are "emulated" in gimp-1.0
- disabled some functionality for poor gtk-1.0 which
is borken to no end
- fixed PARASITE_PERSISTENT typoe
- new functions: gimp_{major,minor,micro}_version
- PF_BRUSH, PATTERN and GRADIENT widgets are "emulated" in gimp-1.0
1.049 Mon Nov 23 20:54:41 CET 1998
- updated configure to require 1.0.2
......@@ -493,9 +502,9 @@ Revision history for Gimp-Perl extension.
0.80 Fri Feb 13 17:15:48 CET 1998
- version 1.0 is the first one generally usable.. we're getting
close!
- Gimp::Net and Gimp::Lib are only internal modules, there is not
much of a distinction between networked modules and modules
using libgimp!
- Gimp::Net and Gimp::Lib are only internal modules, there is not
much of a distinction between networked modules and modules
using libgimp!
- Gimp::OO usable over the network.
0.07 Thu Feb 12 06:51:56 CET 1998
......
plug-ins/perl/Gimp.pm
View file @ 2ea8e217
......@@ -5,13 +5,13 @@ use Carp;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD %EXPORT_TAGS @EXPORT_FAIL
@_consts @_procs $interface_pkg $interface_type @_param @_al_consts
@PREFIXES $_PROT_VERSION
@gimp_gui_functions
@gimp_gui_functions $function $ignore_die
$help $verbose $host);
require DynaLoader;
@ISA=qw(DynaLoader);
$VERSION = 1.061;
$VERSION = 1.07;
@_param = qw(
PARAM_BOUNDARY PARAM_CHANNEL PARAM_COLOR PARAM_DISPLAY PARAM_DRAWABLE
......@@ -268,9 +268,18 @@ EOF
}
my @log;
my $caller;
sub format_msg {
$_=shift;
"$_->[0]: $_->[2] ".($_->[1] ? "($_->[1])":"");
}
sub _initialized_callback {
if (@log) {
for(@log) {
Gimp->message(format_msg($_)) if $_->[3] && $interface_type eq "lib";
}
Gimp->_gimp_append_data ('gimp-perl-log', map join("\1",@$_)."\0",@log);
@log=();
}
......@@ -284,37 +293,75 @@ sub logger {
my $file=$0;
$file=~s/^.*[\\\/]//;
$args{message} = "unknown message" unless defined $args{message};
$args{function} = $function unless defined $args{function};
$args{function} = "" unless defined $args{function};
$args{fatal} = 1 unless defined $args{fatal};
print STDERR "$file: $args{message} ",($args{function} ? "(for function $args{function})":""),"\n" if $verbose || $interface_type eq 'net';
push(@log,[$file,@args{'function','message','fatal'}]);
print STDERR format_msg($log[-1]),"\n" if $verbose || $interface_type eq 'net';
_initialized_callback if initialized();
}
# calm down the gimp module
sub net {}
sub query {}
sub die_msg {
logger(message => substr($_[0],0,-1), fatal => 1, function => 'DIE');
}
sub call_callback {
my $req = shift;
my $cb = shift;
if (UNIVERSAL::can($caller,$cb)) {
&{"${caller}::$cb"};
} else {
die_msg "required callback '$cb' not found\n" if $req;
}
}
sub callback {
my $type = shift;
confess unless initialized();
_initialized_callback;
return () if $caller eq "Gimp";
if ($type eq "-run") {
local $function = shift;
call_callback 1,$function,@_;
} elsif ($type eq "-net") {
call_callback 1,"net";
} elsif ($type eq "-query") {
call_callback 1,"query";
} elsif ($type eq "-quit") {
local $ignore_die = 0;
call_callback 0,"quit";
}
}
sub main {
$caller=caller;
&{"${interface_pkg}::gimp_main"};
}
sub normal_context {
!$^S && defined $^S;
# same as main, but callbacks are ignored
sub quiet_main {
main;
}
$SIG{__DIE__} = sub {
if (normal_context) {
logger(message => substr($_[0],0,-1), fatal => 1, function => 'DIE');
if (!$^S && $ignore_die) {
die_msg $_[0];
initialized() ? die "BE QUIET ABOUT THIS DIE\n" : exit main();
} else {
die $_[0];
}
die $_[0];
};
$SIG{__WARN__} = sub {
if (normal_context) {
logger(message => substr($_[0],0,-1), fatal => 0, function => 'WARN');
if ($ignore_die) {
warn $_[0];
} else {
warn $_[0];
logger(message => substr($_[0],0,-1), fatal => 0, function => 'WARN');
}
};
##############################################################################
if ($interface_type=~/^lib$/i) {
$interface_pkg="Gimp::Lib";
} elsif ($interface_type=~/^net$/i) {
......@@ -331,10 +378,8 @@ for(qw(_gimp_procedure_available gimp_call_procedure set_trace initialized)) {
*$_ = \&{"${interface_pkg}::$_"};
}
*main = \&{"${interface_pkg}::gimp_main"};
*init = \&{"${interface_pkg}::gimp_init"};
*end = \&{"${interface_pkg}::gimp_end" };
*init = \&{"${interface_pkg}::gimp_init"};
*end = \&{"${interface_pkg}::gimp_end" };
*lock = \&{"${interface_pkg}::lock" };
*unlock= \&{"${interface_pkg}::unlock" };
......
plug-ins/perl/Gimp/Feature.pm
View file @ 2ea8e217
......@@ -35,10 +35,6 @@ my %description = (
'never' => '(for testing, will never be present)',
);
# calm down the gimp module
sub net {}
sub query {}
sub import {
my $pkg = shift;
my $feature;
......@@ -59,7 +55,7 @@ sub need {
my ($feature,$function)=@_;
unless (present($feature)) {
missing($description{$feature},$function);
Gimp::initialized() ? die "BE QUIET ABOUT THIS DIE\n" : exit Gimp::main();
Gimp::initialized() ? die "BE QUIET ABOUT THIS DIE\n" : exit Gimp::quiet_main();
}
}
......
plug-ins/perl/Gimp/Fu.pm
View file @ 2ea8e217
......@@ -388,9 +388,10 @@ sub interact($$$@) {
}
} elsif($type == PF_CUSTOM) {
$a=$extra->[0];
push(@setvals,$extra->[1]);
push(@getvals,$extra->[2]);
my (@widget)=&$extra;
$a=$widget[0];
push(@setvals,$widget[1]);
push(@getvals,$widget[2]);
} else {
$label="Unsupported argumenttype $type";
......@@ -814,10 +815,10 @@ string. The default brush/pattern/gradient-name can be preset.
=item PF_CUSTOM
PF_CUSTOM is for those of you requiring some non-standard-widget. Just supply an array reference
with three elements as extra argument:
PF_CUSTOM is for those of you requiring some non-standard-widget. You have
to supply a code reference returning three values as the extra argument:
[widget, settor, gettor]
(widget, settor, gettor)
C<widget> is Gtk widget that should be used.
......@@ -828,7 +829,7 @@ C<gettor> is a function that should return the current value of the widget.
While the values can be of any type (as long as it fits into a scalar),
you should be prepared to get a string when the script is started from the
commandline.
commandline or via the PDB.
=back
......
plug-ins/perl/Gimp/Lib.xs
View file @ 2ea8e217
......@@ -18,6 +18,9 @@
#undef MIN
#undef MAX
/* various functions allocate static buffers, STILL. */
#define MAX_STRING 4096
/* dunno where this comes from */
#undef VOIDUSED
......@@ -187,7 +190,7 @@ trace_init ()
void trace_printf (char *frmt, ...)
{
va_list args;
char buffer[4096]; /* sorry... */
char buffer[MAX_STRING]; /* sorry... */
va_start (args, frmt);
#ifdef HAVE_VSNPRINTF
......@@ -200,10 +203,33 @@ void trace_printf (char *frmt, ...)
}
#else
#error need ansi compiler, maybe try c89?
error need_ansi_compiler__maybe_try_c89
#endif
/* in case g_strdup_printf is missing. */
#if (GLIB_MAJOR_VERSION>1) || (GLIB_MAJOR_VERSION==1 && GLIB_MINOR_VERSION>1)
#define strdup_printf g_strdup_printf
#elif __STDC__
#include <stdarg.h>
static char *
strdup_printf (char *frmt, ...)
{
va_list args;
char buffer[MAX_STRING]; /* sorry... */
va_start (args, frmt);
#ifdef HAVE_VSNPRINTF
vsnprintf (buffer, sizeof buffer, frmt, args);
#else
vsprintf (buffer, frmt, args);
#endif
return g_strdup (buffer);
}
#else
error need_ansi_compiler__maybe_try_c89
#endif
static int
is_array (GParamType typ)
{
......@@ -482,7 +508,7 @@ unbless (SV *sv, char *type, char *croak_str)
static gint32
unbless_croak (SV *sv, char *type)
{
char croak_str[320];
char croak_str[MAX_STRING];
gint32 r;
croak_str[0] = 0;
......@@ -777,25 +803,30 @@ destroy_paramdefs (GParamDef *arg, int count)
}
#endif
/* calls Gimp::die_msg. */
static void gimp_die_msg (char *msg)
{
char *argv[2];
argv[0] = msg;
argv[1] = 0;
perl_call_argv ("Gimp::die_msg", G_DISCARD, argv);
}
/* first check wether the procedure exists at all. */
static void try_call (char *name, int req)
static void try_call (char *name)
{
dSP;
CV *cv = perl_get_cv (name, 0);
char *argv[2];
PUSHMARK(sp); perl_call_pv ("Gimp::_initialized_callback", G_DISCARD | G_NOARGS);
/* it's not an error if the callback doesn't exist. */
if (cv) {
PUSHMARK(sp);
perl_call_sv ((SV *)cv, G_DISCARD | G_NOARGS);
} else if (req)
croak ("required callback '%s' not found", name);
argv[0] = name;
argv[1] = 0;
perl_call_argv ("Gimp::callback", G_DISCARD, argv);
}
static void pii_init (void) { try_call ("init" ,0); }
static void pii_query(void) { try_call ("query",1); }
static void pii_quit (void) { try_call ("quit" ,0); }
static void pii_init (void) { try_call ("-init" ); }
static void pii_query(void) { try_call ("-query"); }
static void pii_quit (void) { try_call ("-quit" ); }
static void pii_run(char *name, int nparams, GParam *param, int *xnreturn_vals, GParam **xreturn_vals)
{
......@@ -805,7 +836,6 @@ static void pii_run(char *name, int nparams, GParam *param, int *xnreturn_vals,
dSP;
STRLEN dc;
int i, count;
GParamDef *return_defs;
char *err_msg = 0;
char *proc_blurb;
......@@ -816,15 +846,8 @@ static void pii_run(char *name, int nparams, GParam *param, int *xnreturn_vals,
int proc_type;
int _nparams;
GParamDef *params;
PUSHMARK(sp); perl_call_pv ("Gimp::_initialized_callback", G_DISCARD | G_NOARGS);
GParamDef *return_defs;
if (return_vals) /* the libgimp is soooooooo braindamaged. */
{
destroy_params (return_vals, nreturn_vals);
return_vals = 0;
}
if (gimp_query_procedure (name, &proc_blurb, &proc_help, &proc_author,
&proc_copyright, &proc_date, &proc_type, &_nparams, &nreturn_vals,
&params, &return_defs) == TRUE)
......@@ -840,6 +863,9 @@ static void pii_run(char *name, int nparams, GParam *param, int *xnreturn_vals,
SAVETMPS;
PUSHMARK(sp);
XPUSHs (newSVpv ("-run", 4));
XPUSHs (newSVpv (name, 0));
if (nparams)
{
......@@ -856,7 +882,7 @@ static void pii_run(char *name, int nparams, GParam *param, int *xnreturn_vals,
SPAGAIN;
}
count = perl_call_pv (name, G_EVAL
count = perl_call_pv ("Gimp::callback", G_EVAL
| (nparams ? 0 : G_NOARGS)
| (nreturn_vals == 0 ? G_VOID|G_DISCARD : nreturn_vals == 1 ? G_SCALAR : G_ARRAY));
......@@ -885,51 +911,54 @@ static void pii_run(char *name, int nparams, GParam *param, int *xnreturn_vals,
else
{
int i;
char err_msg [1024];
err_msg [0] = 0;
char errmsg [MAX_STRING];
errmsg [0] = 0;
return_vals = (GParam *) g_new0 (GParam, nreturn_vals + 1);
return_vals->type = PARAM_STATUS;
return_vals->data.d_status = STATUS_SUCCESS;
*xnreturn_vals = nreturn_vals;
*xreturn_vals = return_vals++;
for (i = nreturn_vals; i-- && count; )
{
return_vals[i].type = return_defs[i].type;
if ((i >= nreturn_vals-1 || !is_array (return_defs[i+1].type))
&& convert_sv2gimp (err_msg, &return_vals[i], TOPs))
&& convert_sv2gimp (errmsg, &return_vals[i], TOPs))
{
--count;
POPs;
}
if (err_msg [0])
croak (err_msg);
if (errmsg [0])
{
err_msg = g_strdup (errmsg);
break;
}
}
if (count)
croak ("callback returned %s more values than expected", count);
if (count && !err_msg)
err_msg = strdup_printf ("plug-in returned %d more values than expected", count);
}
while (count--)
POPs;
g_free (return_defs);
destroy_paramdefs (return_defs, nreturn_vals);
FREETMPS;
LEAVE;
}
else
croak ("being called as '%s', but '%s' not registered in the pdb", name, name);
err_msg = strdup_printf ("being called as '%s', but '%s' not registered in the pdb", name, name);
if (err_msg)
{
gimp_message (err_msg);
gimp_die_msg (err_msg);
g_free (err_msg);
if (return_vals)
destroy_params (return_vals, nreturn_vals);
destroy_params (*xreturn_vals, nreturn_vals+1);
nreturn_vals = 1;
return_vals = g_new (GParam, 1);
......@@ -938,7 +967,6 @@ static void pii_run(char *name, int nparams, GParam *param, int *xnreturn_vals,
*xnreturn_vals = nreturn_vals;