callisto-debian/gimp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

see plug-ins/perl/Changes

Browse Source
This commit is contained in:
Marc Lehmann
1999-03-11 20:08:58 +00:00
parent a4fd7b62ab
commit 12cd1a5c0e
23 changed files with 772 additions and 104 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
plug-ins/perl/Changes
View File

@ -14,6 +14,16 @@ Revision history for Gimp-Perl extension.
system without authorization. argh). This required a
protocol change, so old clients are unable to connect using
password-authenticitation.
- 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.
- 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.
1.06 Sat Mar 6 19:36:12 CET 1999
- Gimp::Fu does no longer display the returned image when it

46
plug-ins/perl/Gimp.pm
View File

@ -192,6 +192,13 @@ sub xlfd_size($) {
: ($pt*0.1,&Gimp::POINTS);
}
# internal utility function for Gimp::Fu and others
sub wrap_text {
my $x=$_[0];
$x=~s/(\G.{1,$_[1]})(\s+|$)/$1\n/g;
$x;
}
my %rgb_db;
my $rgb_db_path;
@ -261,6 +268,30 @@ EOF
}
}
my @log;
sub _initialized_callback {
if (@log) {
Gimp->_gimp_append_data ('gimp-perl-log', map join("\1",@$_)."\0",@log);
@log=();
}
}
# message
# function
# fatal
sub logger {
my %args = @_;
my $file=$0;
$file=~s/^.*[\\\/]//;
$args{message} = "unknown message" unless defined $args{message};
$args{function} = "" unless defined $args{function};
$args{fatal} = 1 unless defined $args{fatal};
print STDERR "$file: $args{message} (for function $args{function})\n" if $verbose || $interface_type eq 'net';
push(@log,[$file,@args{'function','message','fatal'}]);
_initialized_callback if initialized();
}
if ($interface_type=~/^lib$/i) {
$interface_pkg="Gimp::Lib";
} elsif ($interface_type=~/^net$/i) {
@ -273,7 +304,7 @@ eval "require $interface_pkg" or croak "$@";
$interface_pkg->import;
# create some common aliases
for(qw(_gimp_procedure_available gimp_call_procedure set_trace)) {
for(qw(_gimp_procedure_available gimp_call_procedure set_trace initialized)) {
*$_ = \&{"${interface_pkg}::$_"};
}
@ -430,7 +461,9 @@ package Gimp; # for __DATA__
Gimp - Perl extension for writing Gimp Extensions/Plug-ins/Load & Save-Handlers
This is mostly a reference manual. For a quick intro, look at L<Gimp::Fu>.
This is mostly a reference manual. For a quick intro, look at
L<Gimp::Fu>. For more information, including tutorials, look at the
Gimp-Perl pages at http://gimp.pages.de.
=head1 RATIONALE
@ -791,6 +824,11 @@ invocation.
write trace to FILEHANDLE instead of STDERR.
=item initialized ()
this function returns true whenever it is safe to clal gimp functions. This is
usually only the case after gimp_main or gimp_init have been called.
=back
=head1 SUPPORTED GIMP DATA TYPES
@ -839,12 +877,12 @@ Marc Lehmann <pcg@goof.com>
=head1 SEE ALSO
perl(1), gimp(1), L<Gimp::OO>, L<Gimp::Data>, L<Gimp::Pixel>, L<Gimp::PDL>, L<Gimp::UI>, L<Gimp::Net> and L<Gimp::Lib>.
perl(1), gimp(1), L<Gimp::OO>, L<Gimp::Data>, L<Gimp::Pixel>, L<Gimp::PDL>, L<Gimp::Util>, L<Gimp::UI>, L<Gimp::Feature>, L<Gimp::Net>,
L<Gimp::Lib>, L<scm2perl> and L<scm2scm>.
=cut
__DATA__
! $XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp $
255 250 250 snow
248 248 255 ghost white
248 248 255 GhostWhite

15
plug-ins/perl/Gimp.xs
View File

@ -33,6 +33,9 @@ extern "C" {
# define GIMP_PARASITE 1
#endif
/* expect iso-c here. */
#include <signal.h>
/* Shamelesssly stolen from IO.xs. See perlguts, this is only for
* 5.004 compatibility.
*/
@ -74,6 +77,18 @@ MODULE = Gimp PACKAGE = Gimp
PROTOTYPES: ENABLE
void
_exit()
CODE:
#ifdef HAVE__EXIT
_exit(0);
#elif defined(SIGKILL)
raise(SIGKILL);
#else
raise(9);
#endif
abort();
BOOT:
{
HV *stash = gv_stashpvn("Gimp", 4, TRUE);

183
plug-ins/perl/Gimp/Feature.pm Normal file
View File

@ -0,0 +1,183 @@
package Gimp::Feature;
use Carp;
use Gimp ();
use base qw(Exporter);
require Exporter;
@EXPORT = ();
my($gtk,$gtk_10,$gtk_11);
sub _check_gtk {
return if defined $gtk;
eval { require Gtk }; $gtk = $@ eq "";
if ($gtk) {
$gtk_10 = (Gtk->major_version==1 && Gtk->minor_version==0);
$gtk_11 = (Gtk->major_version==1 && Gtk->minor_version>=1) || Gtk->major_version>1;
$gtk_12 = (Gtk->major_version==1 && Gtk->minor_version>=2) || Gtk->major_version>1;
}
}
my %description = (
'gtk' => 'the gtk perl module',
'gtk-1.1' => 'gtk+ version 1.1 or higher',
'gtk-1.2' => 'gtk+ version 1.2 or higher',
'gimp-1.1' => 'gimp version 1.1 or higher',
'gimp-1.2' => 'gimp version 1.2 or higher',
'perl-5.005' => 'perl version 5.005 or higher',
'pdl' => 'PDL (the Perl Data Language), version 1.9906 or higher',
'gnome' => 'the gnome perl module',
'gtkxmhtml' => 'the Gtk::XmHTML module',
);
# calm down the gimp module
sub net {}
sub query {}
sub import {
my $pkg = shift;
my $feature;
while(@_) {
$_=shift;
s/^:// and need($_);
}
}
sub missing {
my ($msg,$function)=@_;
Gimp::logger(message => "$_[0] is required but not found", function => $function);
}
sub need {
my ($feature,$function)=@_;
unless (present($feature)) {
missing($description{$feature},$function);
Gimp::initialized() ? die "BE QUIET ABOUT THIS DIE\n" : exit eval { Gimp::main() };
}
}
sub describe {
$description{$_[0]};
}
sub Gimp::Feature::list {
keys %description;
}
sub present {
$_ = shift;
if ($_ eq "gtk") {
_check_gtk; $gtk;
} elsif ($_ eq "gtk-1.1") {
_check_gtk; $gtk_11;
} elsif ($_ eq "gtk-1.2") {
_check_gtk; $gtk_11;
} elsif ($_ eq "gimp-1.1") {
(Gimp->major_version==1 && Gimp->minor_version>=1) || Gimp->major_version>1;
} elsif ($_ eq "gimp-1.2") {
(Gimp->major_version==1 && Gimp->minor_version>=2) || Gimp->major_version>1;
} elsif ($_ eq "perl-5.005") {
$] >= 5.005;
} elsif ($_ eq "pdl") {
eval { require PDL }; $@ eq "" && $PDL::VERSION>=1.9906;
} elsif ($_ eq "gnome") {
eval { require Gnome }; $@ eq "";
} elsif ($_ eq "gtkxmhtml") {
eval { require Gtk::XmHTML }; $@ eq "";
}
}
1;
__END__
=head1 NAME
Gimp::Features - check for specific features to be present before registering the script.
=head1 SYNOPSIS
use Gimp::Features;
or
use Gimp::Features qw(:feature1 :feature2 ...);
=head1 DESCRIPTION
This module can be used to check for specific features to be present. This
can be used to deny running the script when neccessary features are not
present. While some features can be checked for at any time, the Gimp::Fu
module offers a nicer way to check for them.
=over 4
=item C<gtk>
checks for the presence of the gtk interface module.
=item C<gtk-1.1>, C<gtk-1.2>
checks for the presence of gtk-1.1 (1.2) or higher.
=item C<perl-5.005>
checks for perl version 5.005 or higher.
=item C<pdl>
checks for the presence of a suitable version of PDL (>=1.9906).
=item C<gnome>
checks for the presence of the Gnome-Perl module.
=item C<gtkxmhtl>
checks for the presence of the Gtk::XmHTML module.
=back
The following features can only be checked B<after> C<Gimp->main> has been
called (usually found in the form C<exit main>). See L<Gimp::Fu> on how to
check for these.
=over 4
=item C<gimp-1.1>, C<gimp-1.2>
checks for the presense of gimp in at least version 1.1 (1.2).
=back
=head2 FUNCTIONS
=over 4
=item present(feature)
=item need(feature,[function-name])
=item describe(feature)
=item missing(feature-description,[function-name])
=item list()
=back
=head1 AUTHOR
Marc Lehmann <pcg@goof.com>
=head1 SEE ALSO
perl(1), Gimp(1).
=cut

72
plug-ins/perl/Gimp/Fu.pm
View File

@ -7,13 +7,22 @@ use vars qw($VERSION @ISA @EXPORT @EXPORT_OK @EXPORT_FAIL %EXPORT_TAGS
use Gimp qw(:param);
use Gimp::Data;
use File::Basename;
use Data::Dumper;
use base qw(Exporter);
require Exporter;
require DynaLoader;
require AutoLoader;
eval {
require Data::Dumperx;
import Data::Dumper;
};
if ($@) {
*Dumper = sub {
"()";
};
}
=cut
=head1 NAME
@ -130,12 +139,6 @@ sub import {
# the old value of the trace flag
my $old_trace;
sub wrap_text {
my $x=$_[0];
$x=~s/(\G.{$_[1]}\S*)\s+/$1\n/g;
$x;
}
sub _new_adjustment {
my @adj = eval { @{$_[1]} };
@ -155,6 +158,7 @@ sub _find_digits {
sub interact($$$@) {
local $^W=0;
my($function)=shift;
my($blurb)=shift;
my($help)=shift;
my(@types)=@{shift()};
@ -168,7 +172,10 @@ sub interact($$$@) {
require Gtk; import Gtk;
init Gtk; # gross hack...
};
die "The Gtk perl module is required to run perl-scripts in interactive mode!\n" if $@;
if ($@) {
Gimp::logger(message => 'the gtk perl module is required to run in interactive mode', function => $function);
die "The Gtk perl module is required to run this function ($function) in interactive mode!\n";
}
parse Gtk::Rc Gimp->gtkrc;
@ -183,7 +190,7 @@ sub interact($$$@) {
set_title $w $0;
my $h = new Gtk::HBox 0,2;
$h->add(new Gtk::Label wrap_text($blurb,40));
$h->add(new Gtk::Label Gimp::wrap_text($blurb,40));
$w->vbox->pack_start($h,1,1,0);
realize $w;
my $l = logo($w);
@ -412,8 +419,8 @@ sub interact($$$@) {
signal_connect $button "clicked", sub {
my $helpwin = new Gtk::Dialog;
set_title $helpwin $0;
$helpwin->vbox->add(new Gtk::Label "Blurb:\n".wrap_text($blurb,40)
."\n\nHelp:\n".wrap_text($help,40));
$helpwin->vbox->add(new Gtk::Label "Blurb:\n".Gimp::wrap_text($blurb,40)
."\n\nHelp:\n".Gimp::wrap_text($help,40));
my $button = new Gtk::Button "Close";
signal_connect $button "clicked",sub { hide $helpwin };
$helpwin->action_area->add($button);
@ -574,9 +581,20 @@ sub net {
sub query {
my($type);
script:
for(@scripts) {
my($function,$blurb,$help,$author,$copyright,$date,
$menupath,$imagetypes,$params,$results,$code)=@$_;
$menupath,$imagetypes,$params,$results,$features,$code)=@$_;
if(@$features) {
require Gimp::Feature;
for(@$features) {
unless (Gimp::Feature::present($_)) {
Gimp::Feature::missing(Gimp::Feature::describe($_),$function);
next script;
}
}
}
if ($menupath=~/^<Image>\//) {
$type=&Gimp::PROC_PLUG_IN;
@ -607,6 +625,8 @@ sub query {
$_;
} @$params],
$results);
Gimp::logger(message => 'OK', function => $function, fatal => 0);
}
}
@ -624,11 +644,12 @@ sub query {
[
[PF_TYPE,name,desc,optional-default,optional-extra-args],
[PF_TYPE,name,desc,optional-default,optional-extra-args],
etc...
# etc...
],
[
like above, but for return values
# like above, but for return values (optional)
],
['feature1', 'feature2'...], # optionally check for features
sub { code };
=over 2
@ -692,7 +713,13 @@ See the section PARAMETER TYPES for the supported types.
This is just like the parameter array, just that it describes the return
values. Of course, default values don't make much sense here. (Even if they
did, it's not implemented anyway..)
did, it's not implemented anyway..). This argument is optional.
=item the features requirements
See L<Gimp::Features> for a description of which features can be checked
for. This argument is optional (but remember to specify an empty return
value array, C<[]>, if you want to specify it).
=item the code
@ -803,9 +830,14 @@ commandline.
sub register($$$$$$$$$;@) {
no strict 'refs';
my($function,$blurb,$help,$author,$copyright,$date,
$menupath,$imagetypes,$params,$results,$code)=@_;
$menupath,$imagetypes,$params)=splice(@_,0,9);
my($results,$features,$code);
$code or ($results,$code)=([],$results);
$results = (ref $_[0] eq "ARRAY") ? shift : [];
$features = (ref $_[0] eq "ARRAY") ? shift : [];
$code = shift;
@_==0 or die "register called with too many or wrong arguments\n";
for my $p (@$params,@$results) {
int($p->[0]) eq $p->[0] or croak "Argument/return value '$p->[1]' has illegal type '$p->[0]'";
@ -842,12 +874,12 @@ sub register($$$$$$$$$;@) {
local $^W=0; # perl -w is braindamaged
my $VAR1; # Data::Dumper is braindamaged
# gimp is braindamaged, is doesn't deliver useful values!!
($res,@_)=interact($blurb,$help,$params,@{eval $Gimp::Data{"$function/_fu_data"}});
($res,@_)=interact($function,$blurb,$help,$params,@{eval $Gimp::Data{"$function/_fu_data"}});
return unless $res;
}
} elsif ($run_mode == &Gimp::RUN_FULLINTERACTIVE) {
my($res);
($res,@_)=interact($blurb,$help,[@image_params,@{$params}],[@pre,@_]);
($res,@_)=interact($function,$blurb,$help,[@image_params,@{$params}],[@pre,@_]);
undef @pre;
return unless $res;
} elsif ($run_mode == &Gimp::RUN_NONINTERACTIVE) {
@ -894,7 +926,7 @@ sub register($$$$$$$$$;@) {
wantarray ? @imgs : $imgs[0];
};
push(@scripts,[$function,$blurb,$help,$author,$copyright,$date,
$menupath,$imagetypes,$params,$results,$code]);
$menupath,$imagetypes,$params,$results,$features,$code]);
}
=cut

6
plug-ins/perl/Gimp/Lib.pm
View File

@ -12,6 +12,7 @@ $VERSION = $Gimp::VERSION;
use subs qw(
gimp_call_procedure gimp_main gimp_init
_gimp_procedure_available set_trace gimp_end
initialized
);
sub gimp_init {
@ -78,6 +79,11 @@ sub Gimp::PixelRgn::DESTROY {
if $self->dirty;
};
# this is here to be atomic over the perl-server
sub _gimp_append_data($$) {
gimp_set_data ($_[0], gimp_get_data ($_[0]) . $_[1]);
}
1;
__END__

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

@ -72,6 +72,9 @@ static char pkg_anyable[] = PKG_DRAWABLE ", " PKG_LAYER " or " PKG_CHANNEL;
static int trace = TRACE_NONE;
/* set when its safe to call gimp functions. */
static int gimp_is_initialized = 0;
typedef gint32 IMAGE;
typedef gint32 LAYER;
typedef gint32 CHANNEL;
@ -777,11 +780,13 @@ destroy_paramdefs (GParamDef *arg, int count)
/* first check wether the procedure exists at all. */
static void try_call (char *name, int req)
{
dSP;
CV *cv = perl_get_cv (name, 0);
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) {
dSP;
PUSHMARK(sp);
perl_call_sv ((SV *)cv, G_DISCARD | G_NOARGS);
} else if (req)
@ -812,6 +817,8 @@ static void pii_run(char *name, int nparams, GParam *param, int *xnreturn_vals,
int _nparams;
GParamDef *params;
PUSHMARK(sp); perl_call_pv ("Gimp::_initialized_callback", G_DISCARD | G_NOARGS);
if (return_vals) /* the libgimp is soooooooo braindamaged. */
{
destroy_params (return_vals, nreturn_vals);
@ -862,7 +869,19 @@ static void pii_run(char *name, int nparams, GParam *param, int *xnreturn_vals,
}
if (SvTRUE (ERRSV))
{
if (strEQ ("BE QUIET ABOUT THIS DIE\n", SvPV (ERRSV, dc)))
{
nreturn_vals = 1;
return_vals = g_new (GParam, 1);
return_vals->type = PARAM_STATUS;
return_vals->data.d_status = STATUS_SUCCESS;
*xnreturn_vals = nreturn_vals;
*xreturn_vals = return_vals;
}
else
err_msg = g_strdup (SvPV (ERRSV, dc));
}
else
{
int i;
@ -1015,13 +1034,22 @@ gimp_main(...)
else
croak ("arguments to main not yet supported!");
gimp_is_initialized = 1;
RETVAL = gimp_main (argc, argv);
gimp_is_initialized = 0;
}
OUTPUT:
RETVAL
PROTOTYPES: ENABLE
int
initialized()
CODE:
RETVAL = gimp_is_initialized;
OUTPUT:
RETVAL
int
gimp_major_version()
CODE:

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

@ -22,8 +22,15 @@ $default_unix_sock = "gimp-perl-serv";
$trace_res = *STDERR;
$trace_level = 0;
my $initialized = 0;
sub initialized { $initialized }
sub import {
return if @_>1;
my $pkg = shift;
return if @_;
*Gimp::Tile::DESTROY=
*Gimp::PixelRgn::DESTROY=
*Gimp::GDrawable::DESTROY=sub {
@ -213,9 +220,14 @@ sub gimp_init {
print "authorization ok, but: $r[1]\n" if $Gimp::verbose and $r[1];
}
}
$initialized = 1;
Gimp::_initialized_callback;
}
sub gimp_end {
$initialized = 0;
undef $server_fh;
kill 'KILL',$gimp_pid if $gimp_pid;
undef $gimp_pid;
@ -241,16 +253,6 @@ END {
gimp_end;
}
# provide some functions for the Gimp::PDL module to override
# this is yet another hack (YAH)
for my $f (qw(gimp_pixel_rgn_get_pixel gimp_pixel_rgn_get_row gimp_pixel_rgn_get_col gimp_pixel_rgn_get_rect
gimp_pixel_rgn_set_pixel gimp_pixel_rgn_set_row gimp_pixel_rgn_set_col gimp_pixel_rgn_set_rect)) {
no strict;
*{$f} = sub {
gimp_call_procedure $f,@_;
};
}
1;
__END__

2
plug-ins/perl/Gimp/PDL.pm
View File

@ -6,8 +6,6 @@ use PDL;
use base qw(Exporter);
require Exporter;
require DynaLoader;
require AutoLoader;
@EXPORT = ();

3
plug-ins/perl/MANIFEST
View File

@ -21,6 +21,7 @@ Perl-Server
etc/configure
etc/configure.in
etc/aclocal.m4
etc/acconfig.h
etc/config.h.in
etc/config.pl.in
etc/configure.frag
@ -35,6 +36,7 @@ Gimp/PDL.pm
Gimp/Pixel.pod
Gimp/UI.pm
Gimp/Util.pm
Gimp/Feature.pm
examples/PDB
examples/alpha2color.pl
examples/tex-to-float
@ -61,3 +63,4 @@ examples/blowinout.pl
examples/terral_text
examples/xachvision.pl
examples/gimpmagick
examples/perlcc

7
plug-ins/perl/Makefile.PL
View File

@ -106,7 +106,7 @@ EOF
unless ($major > 0
|| ($major == 0 && $minor > 3)
|| ($major == 0 && $minor == 3 && $patch >= -1)) {
print <<EOF;
$GTK && print <<EOF;
WARNING: version 0.3 of Gtk is _required_ for this module to
build properly. You can get the newest version from
@ -119,10 +119,10 @@ EOF
@examples =
qw(windy.pl prep4gif.pl webify.pl PDB alpha2color.pl tex-to-float ditherize.pl
border.pl view3d.pl feedback.pl xachlego.pl xachshadow.pl parasite-editor
scratches.pl blowinout.pl terral_text xachvision.pl gimpmagick);
scratches.pl blowinout.pl terral_text xachvision.pl gimpmagick perlcc);
@shebang = (map("examples/$_",@examples),
qw(Perl-Server scm2perl scm2scm examples/example-net.pl examples/homepage-logo.pl
examples/example-fu.pl));
examples/example-fu.pl examples/example-oo.pl));
for(@shebang) {
print "updating bangpath in $_\n";
@ -172,6 +172,7 @@ WriteMakefile(
'Gimp/Net.pm' => '$(INST_LIBDIR)/Gimp/Net.pm',
'Gimp/PDL.pm' => '$(INST_LIBDIR)/Gimp/PDL.pm',
'Gimp/Util.pm' => '$(INST_LIBDIR)/Gimp/Util.pm',
'Gimp/Feature.pm' => '$(INST_LIBDIR)/Gimp/Feature.pm',
},
'LIBS' => [''],
'INC' => "$CPPFLAGS $CFLAGS $GIMP_INC_NOUI $DEFS",

21
plug-ins/perl/etc/acconfig.h Normal file
View File

@ -0,0 +1,21 @@
/* Define if you have the ANSI C header files. */
#undef STDC_HEADERS
/* Define if you have the vsnprintf function. */
#undef HAVE_VSNPRINTF
/* Define if you have the <libgimp/gimp.h> header file. */
#undef HAVE_LIBGIMP_GIMP_H
/* Define if you have the glib library (-lglib). */
#undef HAVE_LIBGLIB
/* Define if you don't have gimp_get_data_size. */
#undef HAVE_GET_DATA_SIZE
/* Define if we have DIVIDE_MODE. */
#undef HAVE_DIVIDE_MODE
/* Define if we have _exit(2). */
#undef HAVE__EXIT

6
plug-ins/perl/etc/aclocal.m4 vendored
View File

@ -1,7 +1,7 @@
dnl aclocal.m4 generated automatically by aclocal 1.3
dnl aclocal.m4 generated automatically by aclocal 1.4
dnl Copyright (C) 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
dnl This Makefile.in is free software; the Free Software Foundation
dnl Copyright (C) 1994, 1995-8, 1999 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.

20
plug-ins/perl/etc/config.h.in
View File

@ -1,20 +1,16 @@
/* config.h.in. Generated automatically from configure.in by autoheader. */
/* Define if you have the ANSI C header files. */
#undef STDC_HEADERS
/* Define if you have the vsnprintf function. */
#undef HAVE_VSNPRINTF
/* Define if you have the <libgimp/gimp.h> header file. */
#undef HAVE_LIBGIMP_GIMP_H
/* Define if you have the glib library (-lglib). */
#undef HAVE_LIBGLIB
/* Define if you don't have gimp_get_data_size. */
#undef HAVE_GET_DATA_SIZE
/* Define if we have DIVIDE_MODE. */
#undef HAVE_DIVIDE_MODE
/* Define if you have the _exit function. */
#undef HAVE__EXIT
/* Define if you have the vsnprintf function. */
#undef HAVE_VSNPRINTF
/* Define if you have the <unistd.h> header file. */
#undef HAVE_UNISTD_H

237
plug-ins/perl/etc/configure vendored
View File

@ -1,7 +1,7 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated automatically using autoconf version 2.12.1
# Generated automatically using autoconf version 2.13
# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
#
# This configure script is free software; the Free Software Foundation
@ -348,7 +348,7 @@ EOF
verbose=yes ;;
-version | --version | --versio | --versi | --vers)
echo "configure generated by autoconf version 2.12.1"
echo "configure generated by autoconf version 2.13"
exit 0 ;;
-with-* | --with-*)
@ -518,9 +518,11 @@ ac_ext=c
# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
ac_cpp='$CPP $CPPFLAGS'
ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
cross_compiling=$ac_cv_prog_cc_cross
ac_exeext=
ac_objext=o
if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
# Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
@ -571,15 +573,16 @@ do
# Extract the first word of "$ac_prog", so it can be a program name with args.
set dummy $ac_prog; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:575: checking for $ac_word" >&5
echo "configure:577: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_GIMP'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
if test -n "$GIMP"; then
ac_cv_prog_GIMP="$GIMP" # Let the user override the test.
else
IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:"
for ac_dir in $PATH; do
IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
ac_dummy="$PATH"
for ac_dir in $ac_dummy; do
test -z "$ac_dir" && ac_dir=.
if test -f $ac_dir/$ac_word; then
ac_cv_prog_GIMP="$ac_prog"
@ -642,7 +645,7 @@ fi
# Extract the first word of "gimptool", so it can be a program name with args.
set dummy gimptool; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
echo "configure:646: checking for $ac_word" >&5
echo "configure:649: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_path_GIMPTOOL'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@ -654,8 +657,9 @@ else
ac_cv_path_GIMPTOOL="$GIMPTOOL" # Let the user override the test with a dos path.
;;
*)
IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:"
for ac_dir in $PATH; do
IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
ac_dummy="$PATH"
for ac_dir in $ac_dummy; do
test -z "$ac_dir" && ac_dir=.
if test -f $ac_dir/$ac_word; then
ac_cv_path_GIMPTOOL="$ac_dir/$ac_word"
@ -676,7 +680,7 @@ fi
min_gimp_version=1.0.2
echo $ac_n "checking for GIMP - version >= $min_gimp_version""... $ac_c" 1>&6
echo "configure:680: checking for GIMP - version >= $min_gimp_version" >&5
echo "configure:684: checking for GIMP - version >= $min_gimp_version" >&5
no_gimp=""
if test "$GIMPTOOL" = "no" ; then
no_gimp=yes
@ -709,7 +713,7 @@ echo "configure:680: checking for GIMP - version >= $min_gimp_version" >&5
echo $ac_n "cross compiling; assumed OK... $ac_c"
else
cat > conftest.$ac_ext <<EOF
#line 713 "configure"
#line 717 "configure"
#include "confdefs.h"
#include <stdio.h>
@ -758,7 +762,7 @@ int main ()
EOF
if { (eval echo configure:762: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>/dev/null
if { (eval echo configure:766: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
:
else
@ -792,7 +796,7 @@ fi
CFLAGS="$CFLAGS $GIMP_CFLAGS"
LIBS="$LIBS $GIMP_LIBS"
cat > conftest.$ac_ext <<EOF
#line 796 "configure"
#line 800 "configure"
#include "confdefs.h"
#include <stdio.h>
@ -802,7 +806,7 @@ int main() {
return 0;
; return 0; }
EOF
if { (eval echo configure:806: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
if { (eval echo configure:810: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
echo "*** The test program compiled, but did not run. This usually means"
echo "*** that the run-time linker is not finding GIMP or finding the wrong"
@ -840,10 +844,10 @@ rm -f conftest*
rm -f conf.gimptest
ac_save_CPPFLAGS="$CPPFLAGS"
ac_gimp_save_CPPFLAGS="$CPPFLAGS"
CPPFLAGS="$CPPFLAGS $GIMP_CFLAGS"
echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
echo "configure:847: checking how to run the C preprocessor" >&5
echo "configure:851: checking how to run the C preprocessor" >&5
# On Suns, sometimes $CPP names a directory.
if test -n "$CPP" && test -d "$CPP"; then
CPP=
@ -858,14 +862,14 @@ else
# On the NeXT, cc -E runs the code through the compiler's parser,
# not just through cpp.
cat > conftest.$ac_ext <<EOF
#line 862 "configure"
#line 866 "configure"
#include "confdefs.h"
#include <assert.h>
Syntax Error
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
{ (eval echo configure:868: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out`
{ (eval echo configure:872: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
:
else
@ -875,14 +879,31 @@ else
rm -rf conftest*
CPP="${CC-cc} -E -traditional-cpp"
cat > conftest.$ac_ext <<EOF
#line 879 "configure"
#line 883 "configure"
#include "confdefs.h"
#include <assert.h>
Syntax Error
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
{ (eval echo configure:885: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out`
{ (eval echo configure:889: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
:
else
echo "$ac_err" >&5
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
CPP="${CC-cc} -nologo -E"
cat > conftest.$ac_ext <<EOF
#line 900 "configure"
#include "confdefs.h"
#include <assert.h>
Syntax Error
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
{ (eval echo configure:906: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
:
else
@ -894,6 +915,8 @@ else
fi
rm -f conftest*
fi
rm -f conftest*
fi
rm -f conftest*
ac_cv_prog_CPP="$CPP"
fi
@ -904,7 +927,7 @@ fi
echo "$ac_t""$CPP" 1>&6
cat > conftest.$ac_ext <<EOF
#line 908 "configure"
#line 931 "configure"
#include "confdefs.h"
#include <libgimp/gimp.h>
EOF
@ -918,19 +941,57 @@ EOF
fi
rm -f conftest*
CPPFLAGS="$ac_save_CPPFLAGS"
CPPFLAGS="$ac_gimp_save_CPPFLAGS"
CONFIG_H="config.h"
for ac_hdr in unistd.h
do
ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
echo "configure:951: checking for $ac_hdr" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
#line 956 "configure"
#include "confdefs.h"
#include <$ac_hdr>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
{ (eval echo configure:961: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
eval "ac_cv_header_$ac_safe=yes"
else
echo "$ac_err" >&5
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
eval "ac_cv_header_$ac_safe=no"
fi
rm -f conftest*
fi
if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
echo "$ac_t""yes" 1>&6
ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'`
cat >> confdefs.h <<EOF
#define $ac_tr_hdr 1
EOF
for ac_func in vsnprintf
else
echo "$ac_t""no" 1>&6
fi
done
for ac_func in _exit
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
echo "configure:929: checking for $ac_func" >&5
echo "configure:990: checking for $ac_func" >&5
if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
#line 934 "configure"
#line 995 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
@ -953,7 +1014,65 @@ $ac_func();
; return 0; }
EOF
if { (eval echo configure:957: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
if { (eval echo configure:1018: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_$ac_func=yes"
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
eval "ac_cv_func_$ac_func=no"
fi
rm -f conftest*
fi
if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then
echo "$ac_t""yes" 1>&6
ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'`
cat >> confdefs.h <<EOF
#define $ac_tr_func 1
EOF
else
echo "$ac_t""no" 1>&6
fi
done
CONFIG_H="config.h"
for ac_func in vsnprintf
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
echo "configure:1048: checking for $ac_func" >&5
if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
#line 1053 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
#include <assert.h>
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
builtin and then its argument prototype would still apply. */
char $ac_func();
int main() {
/* The GNU C library defines this for functions which it implements
to always fail with ENOSYS. Some functions are actually named
something starting with __ and the normal name is an alias. */
#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
choke me
#else
$ac_func();
#endif
; return 0; }
EOF
if { (eval echo configure:1076: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_$ac_func=yes"
else
@ -1006,6 +1125,61 @@ fi
for ac_func in _exit
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
echo "configure:1132: checking for $ac_func" >&5
if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
#line 1137 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
#include <assert.h>
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
builtin and then its argument prototype would still apply. */
char $ac_func();
int main() {
/* The GNU C library defines this for functions which it implements
to always fail with ENOSYS. Some functions are actually named
something starting with __ and the normal name is an alias. */
#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
choke me
#else
$ac_func();
#endif
; return 0; }
EOF
if { (eval echo configure:1160: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_$ac_func=yes"
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
eval "ac_cv_func_$ac_func=no"
fi
rm -f conftest*
fi
if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then
echo "$ac_t""yes" 1>&6
ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'`
cat >> confdefs.h <<EOF
#define $ac_tr_func 1
EOF
else
echo "$ac_t""no" 1>&6
fi
done
@ -1033,7 +1207,7 @@ EOF
# Ultrix sh set writes to stderr and can't be redirected directly,
# and sets the high bit in the cache file unless we assign to the vars.
(set) 2>&1 |
case `(ac_space=' '; set) 2>&1 | grep ac_space` in
case `(ac_space=' '; set | grep ac_space) 2>&1` in
*ac_space=\ *)
# `set' does not quote correctly, so add quotes (double-quote substitution
# turns \\\\ into \\, and sed turns \\ into \).
@ -1100,7 +1274,7 @@ do
echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
-version | --version | --versio | --versi | --vers | --ver | --ve | --v)
echo "$CONFIG_STATUS generated by autoconf version 2.12.1"
echo "$CONFIG_STATUS generated by autoconf version 2.13"
exit 0 ;;
-help | --help | --hel | --he | --h)
echo "\$ac_cs_usage"; exit 0 ;;
@ -1123,6 +1297,7 @@ s%@SHELL@%$SHELL%g
s%@CFLAGS@%$CFLAGS%g
s%@CPPFLAGS@%$CPPFLAGS%g
s%@CXXFLAGS@%$CXXFLAGS%g
s%@FFLAGS@%$FFLAGS%g
s%@DEFS@%$DEFS%g
s%@LDFLAGS@%$LDFLAGS%g
s%@LIBS@%$LIBS%g

1
plug-ins/perl/etc/configure.frag
View File

@ -27,5 +27,6 @@ AC_SUBST(GIMP)
AC_SUBST(GIMPTOOL)
AC_SUBST(GIMP_CFLAGS)
AC_SUBST(GIMP_LIBS)
AC_CHECK_FUNCS(_exit)

7
plug-ins/perl/etc/configure.in
View File

@ -23,10 +23,13 @@ AM_PATH_GIMP(1.0.2,, AC_MSG_ERROR(
** You can get the Gimp from ftp://ftp.gimp.org/pub/gimp.
))
ac_save_CPPFLAGS="$CPPFLAGS"
ac_gimp_save_CPPFLAGS="$CPPFLAGS"
CPPFLAGS="$CPPFLAGS $GIMP_CFLAGS"
AC_EGREP_CPP(DIVIDE_MODE,[#include <libgimp/gimp.h>],AC_DEFINE(HAVE_DIVIDE_MODE))
CPPFLAGS="$ac_save_CPPFLAGS"
CPPFLAGS="$ac_gimp_save_CPPFLAGS"
AC_CHECK_HEADERS(unistd.h)
AC_CHECK_FUNCS(_exit)
CONFIG_H="config.h"

4
plug-ins/perl/examples/PDB
View File

@ -4,7 +4,7 @@
use Gimp (':consts');
use Gimp::Fu;
BEGIN { $] >= 5.005 or exit main }
use Gimp::Feature qw(:perl-5.005 :gtk);
use Gtk;
use Gtk::Gdk;
@ -434,7 +434,7 @@ register "extension_pdb_explorer",
"This is a more interactive version of the DB Browser",
"Marc Lehmann",
"Marc Lehmann",
"0.1",
"0.1.1",
"<Toolbox>/Xtns/PDB Explorer",
"",
[],

4
plug-ins/perl/examples/border.pl
View File

@ -4,7 +4,7 @@
use Gimp;
use Gimp::Fu;
BEGIN { eval "use PDL"; $@ and exit main }
use Gimp::Feature qw(:pdl);
use Gimp::PDL;
use PDL::LiteF;
@ -15,7 +15,7 @@ register "border_average",
"calulcates the average border colour",
"Marc Lehmann",
"Marc Lehmann",
"0.2",
"0.2.1",
"<Image>/Filters/Misc/Border Average",
"RGB",
[

11
plug-ins/perl/examples/gimpmagick
View File

@ -1,10 +1,10 @@
#!/usr/bin/perl
BEGIN { $] >= 5.005 or exit main }
use Gimp::Feature qw(:gtk :perl-5.005);
use Gimp 1.06;
use Gimp::Fu;
use POSIX;
BEGIN { eval "use Gtk; use Image::Magick 1.45"; $@ and exit main };
use Gtk;
BEGIN { eval "use Image::Magick 1.45"; $@ and Gimp::Feature::missing ("Image::Magick version 1.45 or higher") };
$VERSION = '0.1';
@ -178,7 +178,7 @@ sub update_preview {
}
if(0==open BLOB,"-|") {
$im->Write('RGB:-');
POSIX::_exit(0);
Gimp::_exit;
}
my($w,$h)=$im->get('width','height');
@ -195,6 +195,9 @@ sub update_preview {
sub gimp_magick {
my ($drawable)=@_;
init Gtk;
parse Gtk::Rc Gimp->gtkrc;
# generate main window
my $im = new Image::Magick;

6
plug-ins/perl/examples/parasite-editor
View File

@ -4,7 +4,7 @@
use Gimp ();
use Gimp::Fu;
BEGIN { $] >= 5.005 or exit main }
use Gimp::Feature qw(:perl-5.005 :gtk);
use Gtk;
Gtk->init;
@ -182,10 +182,12 @@ register "extension_parasite_editor",
"This plug-in can be used to view (and in a future version edit) existing parasites",
"Marc Lehmann",
"Marc Lehmann",
"0.1",
"0.1.1",
"<Toolbox>/Xtns/Parasite Editor",
"",
[],
[],
['gimp-1.1'],
sub {
create_main;

150
plug-ins/perl/examples/perlcc Executable file
View File

@ -0,0 +1,150 @@
#!/usr/bin/perl
use Gimp ();
use Gimp::Feature;
$VERSION='0.0';
$gtk = Gimp::Feature::present 'gtk';
if($gtk) {
# make a relatively extensive check for gtk capabilities
# this must be done before initializing Gtk in the main program (thus here)
unless(open GTK,"-|") {
close STDERR;
require Gtk;
init Gtk;
my $w = new Gtk::Dialog;
show_all $w;
Gtk->idle_add(sub{main_quit Gtk});
main Gtk;
print "OK";
exit;
}
unless (<GTK> eq "OK") {
$gtk=0;
Gimp::logger(message => 'gtk module present but unusable', function => 'gtktest');
}
close GTK;
}
sub generate_status {
my ($log);
$log="Feature Status\n\n";
$log.=sprintf "%-12s %-7s %s\n",'Feature','Present','Description';
for(sort &Gimp::Feature::list) {
$log.=sprintf "%-12s %-7s %s\n",$_,Gimp::Feature::present($_) ? 'Yes':'No',Gimp::Feature::describe($_);
}
$log;
}
sub generate_log {
my ($log);
$log="Log Entries\n\n";
$log.=sprintf "%-16s %-5s %s\n", 'File','Fatal', 'Message';
for (split /\x00/,Gimp->get_data ('gimp-perl-log')) {
my ($file,$function,$msg,$installed)=split /\x01/;
@msg = split /\n/,Gimp::wrap_text ($msg.($function ? " ($function)" : ""),56);
$log.=sprintf "%-16s %-5s %s\n",$file,$installed ? 'Yes':'No',shift(@msg);
while(@msg) {
$log.=sprintf "%-16s %-5s %s\n",'','+->',shift(@msg);
}
}
$log;
}
sub gtkview_log {
my($title,$log)=@_;
my($w,$b,$font,$lines);
$w = new Gtk::Dialog;
$w->set_title ($title);
$b = new Gtk::Text;
$b->set_editable(0);
$lines=$log=~y/\n//;
$lines=25 if $lines>25;
$font = load Gtk::Gdk::Font "9x15bold";
$font = fontset_load Gtk::Gdk::Font "-*-courier-medium-r-normal--*-120-*-*-*-*-*" unless $font;
$font = $b->style->font unless $font;
$b->insert($font,$b->style->fg(-normal),undef,$log);
$b->set_usize($font->string_width('M')*80,($font->ascent+$font->descent)*($lines+1));
$w->vbox->add($b);
$b = new Gtk::Button "OK";
$b->can_default(1);
$b->grab_default;
$b->signal_connect(clicked => sub { destroy $w });
$w->action_area->add($b);
show_all $w;
}
# the extension that's called.
sub extension_perl_control_center {
if ($gtk) {
my($w,$b);
init Gtk;
parse Gtk::Rc Gimp->gtkrc;
$w = new Gtk::Dialog;
$w->set_title ('Perl Control Center');
$b = new Gtk::Button "View Perl Feature Status";
$b->signal_connect(clicked => sub { gtkview_log 'Perl Feature Status',generate_status});
$w->vbox->add($b);
$b = new Gtk::Button "View Perl Error/Warning Log";
$b->signal_connect(clicked => sub { gtkview_log 'Perl Error/Warning Log',generate_log });
$w->vbox->add($b);
$b = new Gtk::Button "Clear Perl Error/Warning Log";
$b->signal_connect(clicked => sub { Gimp->set_data('gimp-perl-log',"") });
$w->vbox->add($b);
$b = new Gtk::Button "OK";
$b->can_default(1);
$b->grab_default;
$b->signal_connect(clicked => sub { main_quit Gtk });
$w->action_area->add($b);
$w->signal_connect(destroy => sub { main_quit Gtk });
show_all $w;
main Gtk;
} else {
my $temp="/tmp/gimp-perl-$$-".rand; # this is not very secure
require Fcntl;
sysopen TEMP,$temp,&Fcntl::O_EXCL|&Fcntl::O_CREAT|&Fcntl::O_WRONLY or die "unable to create temporary file $temp\n";
print TEMP generate_status,"\n",generate_log,"\n<using xterm for display, press enter to continue>";
close TEMP;
system("xterm +ls -sb -sl 500 -geometry 80x30 -T 'Perl Control Center Error Log (Version $VERSION)' ".
"-e sh -c 'cat $temp; rm -f $temp; read' >/dev/null 2>&1");
if ($? >> 8 && -f $temp) {
system("xterm -e sh -c 'cat $temp; rm -f $temp; read' >/dev/null 2>&1");
}
if ($? >> 8) {
print STDERR "\n",generate_status,"\n",generate_log,"\n";
Gimp->message (generate_status."\n".generate_log."\n<using gimp_message for display>");
}
unlink $temp;
}
}
sub net {
extension_perl_control_center;
# print "\n",generate_log,"\n";
}
sub query {
Gimp->install_procedure("extension_perl_control_center", "the perl control center gives information about gimp-perl",
"The perl control center gives information about the status of gimp-perl and allows configuration of important system parameters",
"Marc Lehmann", "Marc Lehmann", $VERSION,
"<Toolbox>/Xtns/Perl Control Center", "*", &Gimp::PROC_EXTENSION,
[[&Gimp::PARAM_INT32, "run_mode", "Interactive, [non-interactive]"]], []);
}
exit Gimp::main;

5
plug-ins/perl/examples/view3d.pl
View File

@ -5,7 +5,8 @@ use strict;
use Gimp;
use Gimp::Fu;
BEGIN { eval "use PDL::Graphics::TriD"; $@ and exit main }
use Gimp::Feature qw(:pdl);
BEGIN { eval "use PDL::Graphics::TriD"; $@ and Gimp::Feature::missing('PDL TriD (OpenGL) support') }
use PDL::Math;
use PDL::Core;
use PDL;
@ -15,7 +16,7 @@ register (
'view3d',
'View grayscale drawable in 3D',
'This script uses PDL::Graphics:TriD to view a grayscale drawable in 3D. You can choose a Cartesian (default) or Polar projection, toggle the drawing of lines, and toggle normal smoothing.',
'Tom Rathborne', 'GPLv2', 'v0.0:1998-11-28',
'Tom Rathborne', 'GPLv2', '1999-03-11',
'<Image>/View/3D Surface',
'GRAY', [
[ PF_BOOL, 'Polar', 'Radial view', 0],