Commit f351a909 authored by Ed J's avatar Ed J Committed by Ed J

Update & test Gimp::Pod

parent 4cbac4fd
package Gimp::Pod;
$VERSION = 2.300001;
sub myqx(&) {
local $/;
local *MYQX;
if (0==open MYQX,"-|") {
&{$_[0]};
close STDOUT;
Gimp::_exit;
}
<MYQX>;
}
use Config;
use strict;
use FindBin qw($RealBin $RealScript);
sub find_converters {
my $path = eval 'use Config; $Config{installscript}';
our $VERSION = 2.3001;
if ($] < 5.00558) {
$converter{text} = sub { my $pod=shift; require Pod::Text; myqx { Pod::Text::pod2text (-60000, $pod) } };
$converter{texta}= sub { my $pod=shift; require Pod::Text; myqx { Pod::Text::pod2text (-60000, '-a', $pod) } };
} else {
$converter{text} = sub { qx($path/pod2text $_[0]) } if -x "$path/pod2text" ;
$converter{texta}= sub { qx($path/pod2text $_[0]) } if -x "$path/pod2text" ;
}
$converter{html} = sub { my $pod=shift; require Pod::Html; myqx { Pod::Html::pod2html ($pod) } };
$converter{man} = sub { qx($path/pod2man $_[0]) } if -x "$path/pod2man" ;
$converter{latex}= sub { qx($path/pod2latex $_[0]) } if -x "$path/pod2latex" ;
}
warn "$$-Loading ".__PACKAGE__ if $Gimp::verbose;
sub find {
-f $0 ? $0 : ();
{
package Gimp::Pod::Parser;
use base 'Pod::Text';
sub output { shift->{gpp_text} .= join '', @_; }
sub get_text { $_[0]->{gpp_text} }
}
sub new {
my $pkg = shift;
my $self={};
return () unless defined($self->{path}=find);
bless $self, $pkg;
return unless -f "$RealBin/$RealScript";
bless { path => "$RealBin/$RealScript", }, $_[0];
}
sub _cache {
my $self = shift;
my $fmt = shift;
if (!$self->{doc}{$fmt} && $converter{$fmt}) {
local $^W = 0;
my $doc = $converter{$fmt}->($self->{path});
undef $doc if $?>>8;
undef $doc if $doc=~/^[ \t\r\n]*$/;
$self->{doc}{$fmt}=\$doc;
}
$self->{doc}{$fmt};
return $self->{doc} if $self->{doc};
my $parser = Gimp::Pod::Parser->new;
$parser->parse_from_file($self->{path});
$self->{doc} = $parser->get_text;
}
sub format {
my $self = shift;
my $fmt = shift || 'text';
${$self->_cache($fmt)};
}
sub format { $_[0]->_cache; }
sub sections {
my $self = shift;
my $doc = $self->_cache('text');
$$doc =~ /^\S.*$/mg;
}
sub sections { $_[0]->_cache =~ /^\S.*$/mg; }
sub section {
my $self = shift;
my $doc = $self->_cache('text');
if (defined $$doc) {
($doc) = $$doc =~ /^$_[0]$(.*?)(?:^[A-Z]|$)/sm;
if ($doc) {
$doc =~ y/\r//d;
$doc =~ s/^\s*\n//;
$doc =~ s/[ \t\r\n]+$/\n/;
$doc =~ s/^ //mg;
}
$doc;
} else {
();
warn __PACKAGE__."::section(@_)" if $Gimp::verbose;
return unless defined(my $doc = $self->_cache);
($doc) = $doc =~ /^$_[0]\n(.*?)(?:^[A-Z]|\Z)/sm;
if ($doc) {
$doc =~ y/\r//d;
$doc =~ s/^\s*\n//;
$doc =~ s/[\s]+$/\n/;
$doc =~ s/^ //mg;
chomp $doc;
}
warn __PACKAGE__."::section returning '$doc'" if $Gimp::verbose;
$doc;
}
sub author {
my $self = shift;
$self->section('AUTHOR');
}
sub blurb {
my $self = shift;
$self->section('BLURB') || $self->section('NAME');
}
sub description {
my $self = shift;
$self->section('DESCRIPTION');
}
sub copyright {
my $self = shift;
$self->section('COPYRIGHT') || $self->section('AUTHOR');
}
find_converters;
1;
__END__
......@@ -113,19 +58,15 @@ Gimp::Pod - Evaluate pod documentation embedded in scripts.
=head1 SYNOPSIS
use Gimp::Pod;
$pod = new Gimp::Pod;
$text = $pod->format ();
$html = $pod->format ('html');
$synopsis = $pod->section ('SYNOPSIS');
$author = $pod->author;
@sections = $pod->sections;
my $pod = Gimp::Pod->new;
my $text = $pod->format;
my $synopsis = $pod->section('SYNOPSIS');
my @sections = $pod->sections;
=head1 DESCRIPTION
C<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.
Gimp-Perl scripts, returning formatted text.
=head1 METHODS
......@@ -133,43 +74,30 @@ future versions might have more interesting features.
=item new
return a new Gimp::Pod object representing the current script or undef, if
Return a new Gimp::Pod object representing the current script or undef, if
an error occured.
=item format([$format])
=item format
Returns the embedded pod documentation in the given format, or undef if no
documentation can be found. Format can be one of 'text', 'html', 'man' or
'latex'. If none is specified, 'text' is assumed.
Return the embedded pod documentation in text format, or undef if no
documentation can be found.
=item section($header)
Tries to retrieve the section with the header C<$header>. There is no
trailing newline on the returned string, which may be undef in case the
section can't be found.
=item author
=item blurb
=item description
=item copyright
Tries to retrieve fields suitable for calls to the register function.
Return the section with the header C<$header>, or undef if not
found. There is no trailing newline on the returned string.
=item sections
Returns a list of paragraphs found in the pod.
Returns a list of paragraph titles found in the pod.
=back
=head1 AUTHOR
Marc Lehmann <pcg@goof.com>
Marc Lehmann <pcg@goof.com>.
Rewritten to eliminate external executables by Ed J.
=head1 SEE ALSO
perl(1), Gimp(1),
=cut
perl(1), L<Gimp>
......@@ -44,7 +44,6 @@ examples/burst
examples/centerguide
examples/colorhtml
examples/dataurl
examples/dialogtest
examples/ditherize
examples/dots
examples/dust
......@@ -139,10 +138,11 @@ po/zh_CN.po
po/zh_TW.po
pxgettext
t/examples-api.pl
t/gimppod.t
t/gimpsetup.pl
t/import.t
t/loadlib.t
t/load.t
t/loadlib.t
t/netplugin.t
t/pdl.t
t/perlplugin.t
......
Items as of 2014-03-31 (by Ed J)
Items as of 2014-04-19 (by Ed J)
* <Load> and <Save> need any registration as such done in Gimp::Fu - see pod
* image in Gimp.pm POD http://perlmaven.com/how-to-add-images-to-cpan -
input image -> output image of a plugin
* longer example in Gimp.pm/SYNOPSIS
* examples POD (and Gimp::Pod TLC)
* Add Gimp::existing (Gimp::Fu IMAGE) and ::become (examples/xachshadows)
* Gimp/Lib.xs is huge, and not very XS-y - lots of it is manually
pushing GIMP data structures onto perl stack and vice versa. Figure
way to pass GIMP data back and forth directly via typemap system. May
involve a gimp-perl "wrapper" data structure that pairs an SV with its
GimpPDBArgType/GimpParamDef counterpart - Gimp::Lib::Data?
GimpParam counterpart - Gimp::Lib::Data?
* gimp-perl website: maybe just gimp.org/glossary entry - only needs
links to CPAN, bugzilla, git - make sure CPAN has all POD docs
- https://mail.gnome.org/mailman/listinfo/gimp-developer-list
......@@ -13,11 +19,14 @@ Items as of 2014-03-31 (by Ed J)
* http://search.cpan.org/dist/Glib-Object-Introspection/
* Add a gtk2 gimp-perl console - cf http://registry.gimp.org/node/29348
- gimp/plug-ins/script-fu/script-fu-console.c
* Test menupath <File> etc
* Test Gimp::Fu menupath <Load>/<Save>/<Image>/<Toolbox>/<None>
* "IGNORE THIS MESSAGE" - $in_top - whole quiet_die probably needs to go too
* PS flags are obsolete - replace with verbose - set_trace may also be obsolete
* interactive collab image-editing:
http://users.telenet.be/blendix/verse/#gimp_plugin
https://github.com/verse/verse/wiki/Tutorial-Simple-C-Verse-Client
http://graphicdesign.stackexchange.com/questions/25077/how-can-i-collaborate-using-gimp2
Legacy notes from Seth Burgess:
* Win32 port
* Improve documentation quality - feedback desired!
* Figure out i18n some day.
......@@ -8,7 +8,7 @@ require '../config.pl';
@pins = qw(
Perl-Server
dataurl
dialogtest
example-fu
exceptiontest
colorhtml
fade-alpha
......
......@@ -129,10 +129,6 @@ on top of it which represent your "cells".
Written in 1999 (c) by Aaron Sherman E<lt>ajs@ajs.comE<gt>
=head1 BUGS
TBD
=head1 SEE ALSO
L<gimp>, L<perl>, L<Gimp>: the Gimp module for perl.
......
#!/usr/local/bin/perl -w
use strict;
#BEGIN { $Gimp::verbose = 1; }
use Gimp;
use Gimp::Fu;
#Gimp::set_trace(TRACE_ALL);
&register(
"test_dialogs", 'help', 'blurb', 'id', 'id', '20140411',
N_ '<Image>/Filters/Languages/_Perl/Test/Dialog', undef,
[
[ PF_COLOR, "colour", "Image colour", [255, 127, 0], ],
[ PF_FONT, "font", "Font", 'Arial', ],
[ PF_INT8, "int8", "Int8", 100],
[ PF_INT16, "int16", "Int16", 100],
[ PF_INT32, "int32", "Int32", 100],
[ PF_FLOAT, "float", "FLOAT", 100],
[ PF_STRING, "string", "string", 'text'],
],
sub { }
);
exit main;
......@@ -319,7 +319,7 @@ register
N_"<Image>/File/Create/Logos/Glowing Steel",
undef,
[
[PF_STRING, "string", "string", "GET LOST"],
[PF_STRING, "string", "String", "GET LOST"],
# The font in the poster was like "cobalt extended"
[PF_FONT, "font", "Font", "Bitstream Charter Bold"],
[PF_SPINNER, "size", "Size", 100, [0, 3000, 1]],
......
......@@ -3,43 +3,32 @@
use Gimp ":auto";
use Gimp::Fu;
sub SOBEL() {0}
sub PREWITT() {1}
sub GRADIENT() {2}
sub ROBERTS() {3}
sub DIFFERENTIAL() {4}
sub LAPLACE() {5}
# Gimp::set_trace(TRACE_ALL);
sub my_code {
my ($img,$original_layer,$sharpen_radius,$sharpen_amt,$sharpen_threshold) = @_;
my $edge_layer;
my $saved_selection;
my @selbounds;
# sanity stuff
$original_layer->is_layer || die "Can only operate on layers";
die "Can only operate on layers" unless $original_layer->is_layer;
$original_layer->become('Gimp::Layer');
$img->undo_group_start;
@selbounds = $img->selection_bounds;
if ($selbounds[0] == 0) # if empty
{
$img->selection_all;
}
my @selbounds = $img->selection_bounds;
$img->selection_all if $selbounds[0] == 0;
$saved_selection = $img->selection_save;
my $saved_selection = $img->selection_save;
$img->selection_none;
# 1) take the original photo, duplicate the layer
$edge_layer = $original_layer->Gimp::Layer::copy(1);
my $edge_layer = $original_layer->Gimp::Layer::copy(1);
$img->insert_layer($edge_layer,0,-1);
# 2) convert the copy to grayscale
$edge_layer->desaturate;
# 3) run edge detect to the gray layer (default works)
$edge_layer->edge(2.0, 3, 0);
$edge_layer->edge(2.0, 2, 0);
# 4) blur it slightly
$edge_layer->gauss_iir2(3.0, 3.0);
......
use Test::More;
#$Gimp::verbose = 1;
require Gimp::Pod;
my $p = Gimp::Pod->new;
ok($p, 'obj init');
is_deeply([ $p->sections ], [ qw(NAME VERBATIM OTHER) ], 'sections');
is($p->section('NAME'), 'test - Run some tests', 'sect name');
is($p->section('VERBATIM'), " verbatim\n verbatim2", 'sect verbatim');
is($p->section('OTHER'), 'Other text.', 'sect at eof');
done_testing;
__END__
=head1 NAME
test - Run some tests
=head1 VERBATIM
verbatim
verbatim2
=head1 OTHER
Other text.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment