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-14 20:02:47 +00:00
parent 844a73d33f
commit ecb1449456
7 changed files with 197 additions and 71 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
plug-ins/perl/Changes
View File

@ -14,6 +14,11 @@ Revision history for Gimp-Perl extension.
- gimp_progress_init now accepts either one or two arguments.
- switched to using Devel::PPPort, which hopefulyl solves all my
problems.
- argh! gimptool path was wrong again! the fix version should be much
faster as well.
- new module Gimp::Pod.
- embedded pod documentation will now be shown when the Help button
is pressed (see image_tile for an example).
1.061 Fri Mar 12 21:27:26 CET 1999
- closed big, BIG security hole on password authenticitation

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

@ -158,17 +158,42 @@ sub _find_digits {
$digits>0 ? int $digits+0.9 : 0;
}
sub help_window {
my($blurb,$help)=@_;
my $helpwin = new Gtk::Dialog;
set_title $helpwin $0;
$helpwin->vbox->add(new Gtk::Label "Blurb:\n".Gimp::wrap_text($blurb,60)
."\n\nHelp:\n".Gimp::wrap_text($help,60));
my $button = new Gtk::Button "Close";
signal_connect $button "clicked",sub { hide $helpwin };
$helpwin->action_area->add($button);
sub help_window(\$$$) {
my($helpwin,$blurb,$help)=@_;
unless ($$helpwin) {
$$helpwin = new Gtk::Dialog;
$$helpwin->set_title("Help for ".$Gimp::function);
my($font,$b);
show_all $helpwin;
$b = new Gtk::Text;
$b->set_editable (0);
$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;
$$helpwin->vbox->add($b);
$b->realize; # for gtk-1.0
$b->insert($font,$b->style->fg(-normal),undef,"BLURB:\n\n$blurb\n\nHELP:\n\n$help");
$b->set_usize($font->string_width('M')*80,($font->ascent+$font->descent)*26);
my $button = new Gtk::Button "OK";
signal_connect $button "clicked",sub { hide $$helpwin };
$$helpwin->action_area->add($button);
$$helpwin->signal_connect("destroy",sub { undef $$helpwin });
Gtk->idle_add(sub {
require Gimp::Pod;
my $pod = new Gimp::Pod;
my $text = $pod->format;
if ($text) {
$b->insert($font,$b->style->fg(-normal),undef,"\n\nEMBEDDED POD DOCUMENTATION:\n\n");
$b->insert($font,$b->style->fg(-normal),undef,$text);
}
});
}
$$helpwin->show_all();
}
sub interact($$$@) {
@ -179,6 +204,7 @@ sub interact($$$@) {
my(@types)=@{shift()};
my(@getvals,@setvals,@lastvals,@defaults);
my($button,$box,$bot,$g);
my($helpwin);
my $res=0;
# only pull these in if _really_ required
@ -432,7 +458,7 @@ sub interact($$$@) {
$button = new Gtk::Button "Help";
$g->attach($button,0,1,$res,$res+1,{},{},4,2);
signal_connect $button "clicked", sub { help_window($blurb,$help) };
signal_connect $button "clicked", sub { help_window($helpwin,$blurb,$help) };
my $v=new Gtk::HBox 0,5;
$g->attach($v,1,2,$res,$res+1,{},{},4,2);

88
plug-ins/perl/Gimp/Pod.pm Normal file
View File

@ -0,0 +1,88 @@
package Gimp::Pod;
use Carp;
use Config;
$VERSION=$Gimp::VERSION;
sub find_converters {
my $path = $Config{installscript};
$converter{text}="$path/pod2text" if -x "$path/pod2text";
$converter{html}="$path/pod2html" if -x "$path/pod2html";
$converter{man} ="$path/pod2man" if -x "$path/pod2man" ;
}
sub find {
-f $0 ? $0 : ();
}
sub new {
my $pkg = shift;
my $self={};
return () unless defined($self->{path}=find);
bless $self, $pkg;
}
sub cache_doc {
my $self = shift;
my $fmt = shift;
if (!$self->{doc}{$fmt} && $converter{$fmt}) {
my $doc = qx($converter{$fmt} $self->{path});
undef $doc if $?>>8;
$self->{doc}{$fmt}=$doc;
}
$self->{doc}{$fmt};
}
sub format {
my $self = shift;
my $fmt = shift || 'text';
$self->cache_doc($fmt);
}
find_converters;
1;
__END__
=head1 NAME
Gimp::Pod - Evaluate pod documentation embedded in scripts.
=head1 SYNOPSIS
use Gimp::Pod;
$pod = new Gimp::Pod;
$text = $pod->format ();
$html = $pod->format ('html');
=head1 DESCRIPTION
Gimp::Pod can be used to find and parse embedded pod documentation in
gimp-perl scripts. At the moment only the formatted text can be fetched,
future versions might have more interesting features.
=head1 METHODS
=over 4
=item new
return a new pod object representing the current script or undef, if an
error occured.
=item format [format]
=back
=head1 AUTHOR
Marc Lehmann <pcg@goof.com>
=head1 SEE ALSO
perl(1), Gimp(1),
=cut

1
plug-ins/perl/MANIFEST
View File

@ -38,6 +38,7 @@ Gimp/Pixel.pod
Gimp/UI.pm
Gimp/Util.pm
Gimp/Feature.pm
Gimp/Pod.pm
examples/PDB
examples/alpha2color.pl
examples/tex-to-float

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

@ -66,65 +66,65 @@ eval "use Parse::RecDescent;"; $PRD = $@ eq "";
$] >= 5.005 or print <<EOF;
WARNING: you are using a version of perl older than 5.005. While this
extension should run on older versions (and I try to keep source
compatibility), some people get spurious errors that go away
after upgrading to 5.005 (or to gimp-1.1). Therefore, some
features of Gimp DO NOT WORK WITH 5.004 or gimp-1.0. Since 5.005
is much better and has many many bugs fixed, an upgrade would
come in handy...
extension should run on older versions (and I try to keep source
compatibility), some people get spurious errors that go away
after upgrading to 5.005 (or to gimp-1.1). Therefore, some
features of Gimp DO NOT WORK WITH 5.004 or gimp-1.0. Since 5.005
is much better and has many many bugs fixed, an upgrade would
come in handy...
EOF
$GTK or print <<EOF;
WARNING: unable to use the Perl-Gtk interface. Most features (like
Gimp::Fu) rely on this extension. You can try to build without
it (and many scripts won't work), but it's better to install
it (version 0.3 or higher is required, you can get it from
ftp://ftp.gimp.org/pub/gtk/perl/ or any CPAN mirror.
Gimp::Fu) rely on this extension. You can try to build without
it (and many scripts won't work), but it's better to install
it (version 0.3 or higher is required, you can get it from
ftp://ftp.gimp.org/pub/gtk/perl/ or any CPAN mirror.
EOF
$PDL or print <<EOF;
WARNING: unable to use PDL (the perl data language). This means that
Gimp::PDL is non-functional. Unless you plan to use Tile/PixelRgn
functions together with PDL, this is harmless. Gimp::PDL will
be installed, just in case you later install PDL. The plug-ins
using PDL, however, will NOT WORK. You can get PDL from any CPAN
mirror.
Gimp::PDL is non-functional. Unless you plan to use Tile/PixelRgn
functions together with PDL, this is harmless. Gimp::PDL will
be installed, just in case you later install PDL. The plug-ins
using PDL, however, will NOT WORK. You can get PDL from any CPAN
mirror.
EOF
!$PDL or $PDL::Version::VERSION > 1.99 or print <<EOF;
WARNING: PDL version $PDL::Version::VERSION is installed. Gimp::PDL was only
tested with 1.99 and higher. In case of problems its advisable to
upgrade PDL to at least version 2.
tested with 1.99 and higher. In case of problems its advisable to
upgrade PDL to at least version 2.
EOF
$PRD or print <<EOF;
WARNING: Parse::RecDescent is not installed (correctly) on your system. This
means scm2perl (the Scheme->Perl translator) isn't usable. If you
don't need this functionality there is nothing to worry about.
Should the need arise you can install Parse::RecDescent later; it
is available from any CPAN mirror.
means scm2perl (the Scheme->Perl translator) isn't usable. If you
don't need this functionality there is nothing to worry about.
Should the need arise you can install Parse::RecDescent later; it
is available from any CPAN mirror.
EOF
($major,$minor,$patch)=split /[._]/,$Gtk::VERSION;
unless ($major > 0
|| ($major == 0 && $minor > 3)
|| ($major == 0 && $minor == 3 && $patch >= -1)) {
|| ($major == 0 && $minor > 3)
|| ($major == 0 && $minor == 3 && $patch >= -1)) {
$GTK && print <<EOF;
WARNING: version 0.3 of Gtk is _required_ for this module to
build properly. You can get the newest version from
ftp://ftp.gimp.org/pub/gtk/perl/ or any CPAN mirror. Older
versions may work, but I have warned you!
build properly. You can get the newest version from
ftp://ftp.gimp.org/pub/gtk/perl/ or any CPAN mirror. Older
versions may work, but I have warned you!
EOF
}
@ -136,33 +136,33 @@ unless($@) {
print <<EOF;
WARNING: I've detected an old version of Gimp-Perl installed
already. Since I cannot detect the prefix used to install
it I will just overwrite it. If you happen to use two
different and incompatible versions of the Gimp with differing
prefixes you should call configure with the --disable-perl
switch to disable the perl extension, or consider installing
the perl module elsewhere, using the environment variables
PERL5LIB=/my/module/dir and PERL_MM_OPTS="PREFIX=\$PERL5LIB" to
overwrite the installation directory (PERL_MM_OPTS) and run the
Gimp (PERL5LIB). See "perldoc ExtUtils::MakeMaker" for a full
discussion of your options.
already. Since I cannot detect the prefix used to install
it I will just overwrite it. If you happen to use two
different and incompatible versions of the Gimp with differing
prefixes you should call configure with the --disable-perl
switch to disable the perl extension, or consider installing
the perl module elsewhere, using the environment variables
PERL5LIB=/my/module/dir and PERL_MM_OPTS="PREFIX=\$PERL5LIB" to
overwrite the installation directory (PERL_MM_OPTS) and run the
Gimp (PERL5LIB). See "perldoc ExtUtils::MakeMaker" for a full
discussion of your options.
EOF
} else {
if ($GIMP_PREFIX ne $old_prefix) {
print <<EOF;
print <<EOF;
WARNING: I've detected another installaion of the Gimp-Perl extension.
This version uses the prefix '$GIMP_PREFIX'.
The already installed version uses the prefix '$old_prefix'.
This version uses the prefix '$GIMP_PREFIX'.
The already installed version uses the prefix '$old_prefix'.
They don't match, which indicates that installing Gimp-Perl might
overwrite an old but still used installation. Gimp-Perl will
therefore be disabled, and not be installed.
They don't match, which indicates that installing Gimp-Perl might
overwrite an old but still used installation. Gimp-Perl will
therefore be disabled, and not be installed.
EOF
not_halt("prefix mismatch");
not_halt("prefix mismatch");
}
}
}
@ -195,19 +195,13 @@ install ::
exit ; \
fi \
done ; \
$(MAKE) UNINST=1 really-install install-plugins
$(MAKE) UNINST=1 really-install install-plugins
'.$install;
}
sub fixinstall {
my($src,$dst)=@_;
" cp '$src' '\$(INST_SCRIPT)/$dst' && \$(FIXIN) '\$(INST_SCRIPT)/$dst' && \\\n".
" cd '\$(INST_SCRIPT)' && $GIMPTOOL --install-admin-bin '$dst' && \\\n".
" rm '$dst'\n";
}
sub MY::postamble {
my $GT = $IN_GIMP ? "../$GIMPTOOL" : $GIMPTOOL;
my $postamble="
objclean :: clean
@ -217,18 +211,29 @@ check :: test
clean ::
test -f Makefile || mv -f Makefile.old Makefile
\$(RM_RF) inst-temp
install-plugins :: \$(INST_SCRIPT)/.exists\n"
.fixinstall('Perl-Server','Perl-Server')
.join("",map fixinstall("examples/$_",$_),@examples);
install-plugins ::
\$(RM_RF) inst-temp
\$(MKPATH) inst-temp
cd inst-temp ; \\
\$(UMASK_NULL) ; \\
\$(CP) ".join(' ',map("'../examples/$_'",@examples))." ../Perl-Server . ; \\
\$(CHMOD) 755 * ; \\
\$(FIXIN) * ; \\
for plugin in * ; do \\
$GT --install-admin-bin \"\$\$plugin\" ; \\
done
\$(RM_RF) inst-temp
";
}
WriteMakefile(
'dist' => {
'PREOP' => 'chmod -R u=rwX,go=rX . ;',
'COMPRESS' => 'gzip -9v',
'SUFFIX' => '.gz',
},
'PREOP' => 'chmod -R u=rwX,go=rX . ;',
'COMPRESS' => 'gzip -9v',
'SUFFIX' => '.gz',
},
'PREREQ_PM' => {
"Gtk" => 0.3,
"Data::Dumper" => 2,

1
plug-ins/perl/TODO
View File

@ -18,6 +18,7 @@ bugs
important issues
* change set_usize to something else..
* Gimp::IO (?)
* Gimp::Fu import after Gimp? use Gimp::main for Gimp::Fu??
* generic config query mechanism

2
plug-ins/perl/ppport.h
View File

@ -39,7 +39,7 @@
special defines should be used, ppport.h can be run through Perl to check
your source code. Simply say:
perl -x ppport.h *.c *.h *.xs foo/*.c [etc]
perl -x ppport.h *.c *.h *.xs [etc]
The result will be a list of patches suggesting changes that should at
least be acceptable, if not necessarily the most efficient solution, or a