gimp/plug-ins/perl/gimpdoc

435 lines
12 KiB
Perl
Executable File

#!/usr/bin/perl
use Gimp qw(:consts spawn_options=no-data);
use Getopt::Std;
#use Config '%Config';
$VERSION=2.0;
getopts('rw:');
if (@ARGV<1) {
my $me = $0;
$me =~ s,.*[/\\],,;
print STDERR <<EOF;
Usage: $me [-r] [-w dir] function...
Options:
-r print raw tbl|nroff source.
-w dir create html (use prefix dir when writing out files)
EOF
exit(1);
}
Gimp::init;
for (@ARGV) {
push @matches, Gimp->procedural_db_query ($_,"","","","","","");
}
@matches or die "No matching function found\n";
@matches = sort @matches;
%pf_type2string = (
&PDB_INT8 => 'INT8',
&PDB_INT16 => 'INT16',
&PDB_INT32 => 'INT32',
&PDB_FLOAT => 'FLOAT',
&PDB_STRING => 'STRING',
&PDB_INT8ARRAY => 'INT8ARRAY',
&PDB_INT16ARRAY => 'INT16ARRAY',
&PDB_INT32ARRAY => 'INT32ARRAY',
&PDB_FLOATARRAY => 'FLOATARRAY',
&PDB_STRINGARRAY => 'STRINGARRAY',
&PDB_COLOR => 'COLOUR',
&PDB_IMAGE => 'IMAGE',
&PDB_LAYER => 'LAYER',
&PDB_CHANNEL => 'CHANNEL',
&PDB_DRAWABLE => 'DRAWABLE',
&PDB_DISPLAY => 'DISPLAY',
&PDB_SELECTION => 'SELECTION',
&PDB_PARASITE => 'PARASITE',
&PDB_STATUS => 'STATUS',
&PDB_REGION => 'REGION',
&PDB_BOUNDARY => 'BOUNDARY',
&PDB_PATH => 'PATH',
);
sub type2str {
$pf_type2string{$_[0]}
? $pf_type2string{$_[0]}
: "UNKNOWN($_[0])";
}
my %plugin_info;
#'extension_db_browser' => ARRAY(0x8290e98)
# 0 '<Toolbox>/Xtns/DB Browser'
# 1 undef
# 2 '/usr/app/lib/gimp/1.1/plug-ins/dbbrowser'
# 3 ''
# 4 936739664
sub get_plugininfo {
eval {
my ($a, $b, $c, $d, $e, $f) = Gimp->plugins_query("");
for $i (0..$#$a) {
$plugin_info{$f->[$i]} = [map $_->[$i], $a, $b, $c, $d, $e];
}
}
}
sub format_html {
$created_by = "<br><hr><font size=-1>This page was created by <tt>gimpdoc</tt>, written by ".
"<a href=\"mailto:pcg\@goof.com\">Marc Lehmann &lt;pcg\@goof.com&gt;</a></font>";
$nbsp = "&nbsp;";
($b1,$b0)=('<b>','</b>');
($sh1,$sh0)=('<dt>',"<dd>");
($tt1,$tt0)=('<tt>','</tt>');
$br = "<br>";
$theader = <<EOF;
<table><tr align=left><th>TYPE<th>NAME<th>DESCRIPTION
EOF
$tr = "<tr>";
$tend = "</table>";
$body = '<body text="#000000" link="#1010c0" vlink="#101080" alink="#ff0000" bgcolor="#ffffff">';
$section = sub {
"<dt>$_[0]<dd>$_[1]";
};
$header = <<'EOF';
<html><head><title>Gimp PDB documentation - $name</title>$body
<a href=\"$prev_fun.html\">$prev_fun</a> &lt;&lt; <a href=index.html>INDEX</a> &gt;&gt;
<a href=\"$next_fun.html\">$next_fun</a>
<h1><b>$name</b> ($date)</h1>
<dl>
<dt>NAME<dd><b>$name - $blurb</b>
<dt>SYNOPSIS<dd><tt>$vals<b>$name</b>$args</tt>
<dt>DESCRIPTION<dd>$help
EOF
$trailer = <<'EOF';
<dt>AUTHOR<dd>$author<br>(c)$date $copyright
</dl>
$created_by
</html>
EOF
*escape = sub {
$_[0] =~ s/&/&amp;/;
$_[0] =~ s/</&lt;/;
$_[0] =~ s/>/&gt;/;
# FIX: the following three lines are only required for my m4 macro package.
$_[0] =~ s/{/_lbr/;
$_[0] =~ s/}/{}_rbr{}/;
$_[0] =~ s/_lbr/{}_lbr{}/;
# do a best effort to replace function names by links
$_[0] =~ s{\b([a-z_]+_[a-z_]+)\b}{
my $proc = $1;
if (grep $_ eq $proc, @matches) {
"<a href=$proc.html>$proc</a>";
} else {
$proc;
}
}ge;
};
*table_line = sub {
my ($a,$b,$c) = @_;
for ($a,$b,$c) { escape($_) };
"<tr><td>$a<td>$b<td>$c";
};
}
sub format_roff {
$nbsp = "\\ ";
($b1,$b0)=("\\fB","\\fR");
($sh1,$sh0)=('.SH ',"\n");
($tt1,$tt0)=('','');
$br = "\n.br\n";
$theader = <<EOF;
.TS H
expand ;
l l l
___
lw20 lw20 lw60.
TYPE NAME DESCRIPTION
EOF
$tend = "\n.TE\n";
$section = sub {
".SH $_[0]\n$_[1]\n";
};
$header = <<'EOF';
.TH \"$name\" \"gimpdoc\" \"$date\" \"$version\"
.SH NAME
\\fB$name\\fR \- $blurb
.SH SYNOPSIS
$vals\\fB$name\\fR$args
.SH DESCRIPTION
$help
EOF
$trailer = <<'EOF';
.SH AUTHOR
$author
.br
(c)$date $copyright
EOF
*escape = sub {};
*table_line = sub {
join(" ",$_[0]." ",$_[1]." ","T{\n".$_[2]."\nT}")."\n";
}
}
format_roff;
my $version = "gimp-".Gimp->major_version.".".Gimp->minor_version;
sub gen_va(\@\@) {
my @vals = @{+shift};
my @args = @{+shift};
my($vals,$args);
if (@vals == 0) {
$vals = "";
} elsif (@vals == 1) {
$vals = "$vals[0][1]$nbsp=$nbsp";
} else {
$vals = "(".join(",",map $_->[1],@vals).")$nbsp=$nbsp";
}
if (@args == 0) {
$args = "";
} else {
$args = "$nbsp(".join(",",map $_->[1],@args).")";
}
($vals,$args);
}
sub isarray {
return 1 if $_[0] == &PDB_INT8ARRAY;
return 1 if $_[0] == &PDB_INT16ARRAY;
return 1 if $_[0] == &PDB_INT32ARRAY;
return 1 if $_[0] == &PDB_FLOATARRAY;
return 1 if $_[0] == &PDB_STRINGARRAY;
return 0;
}
sub killcounts(\@) {
my $a = shift;
my $roa=0;
for(local $_=0; $_<$#$a; $_++) {
if (isarray ($a->[$_+1][0]) && $a->[$_][0] == &PDB_INT32) {
splice @$a, $_, 1;
$roa=1;
}
}
$roa;
}
sub weight {
my ($v,$n,$a)=@$_;
my $w = $#$v + $#$a;
$w-- if $n =~ s/^\$\w+//;
$w += 1-1/(1+length $n);
if ($n =~ / ([A-Z][a-z]+)$/) {
$w += 1 unless $1 eq ucfirst $a->[0][1];
}
$w;
}
sub gen_alternatives(\@$\@) {
my @vals = @{+shift};
my $name = shift;
my @args = @{+shift};
killcounts(@vals); killcounts(@args);
my @new = [\@vals,$name,\@args];
my @res;
do {
my @prev = @new;
@new = ();
for my $alt (@prev) {
my @vals = @{$alt->[0]};
my $name = $alt->[1];
my @args = @{$alt->[2]};
# try to get rid of array counts
unless ($name =~ /[$ ]/) {
for my $class (qw(
Gimp Layer Image Drawable Selection Channel Display
Palette Plugin Gradients Edit Progress Region Tile
PixelRgn GImpDrawable Patterns GimpParasite
)) {
my @pre = @{$class."::PREFIXES"};
prefix:
for (@pre) {
my $n2 = $name;
if ($_ && $n2 =~ s/^$_//) {
for my $p (@pre) {
last if $_ eq $p;
last prefix if Gimp::_gimp_procedure_available($p.$n2);
}
if ($class eq "Drawable" && @args && $args[0][0] == &PDB_DRAWABLE) {
push @new, [\@vals,"\$drawable->$n2",[@args[1..$#args]]];
} elsif ($class eq "Layer" && @args && $args[0][0] == &PDB_LAYER) {
push @new, [\@vals,"\$layer->$n2",[@args[1..$#args]]];
} elsif ($class eq "Channel" && @args && $args[0][0] == &PDB_CHANNEL) {
push @new, [\@vals,"\$channel->$n2",[@args[1..$#args]]];
} elsif ($class eq "Image" && @args && $args[0][0] == &PDB_IMAGE) {
push @new, [\@vals,"\$image->$n2",[@args[1..$#args]]];
} elsif (@args < 1 or ($args[0][0] != &PDB_IMAGE
&& $args[0][0] != &PDB_DRAWABLE
&& $args[0][0] != &PDB_CHANNEL
&& $args[0][0] != &PDB_LAYER)) {
if ($class =~ /Gimp|Gradient|Palette|Edit|Patterns|GimpParasite|PixelRgn/) {
push @new, [\@vals,"${class}->$n2",\@args];
} else {
push @new, [\@vals,"$n2$nbsp$class",\@args];
}
}
last prefix;
}
}
}
}
if (@args && $args[0][0] == &PDB_INT32 && $args[0][1] eq "run_mode") {
push @new, [\@vals,,$name,[@args[1..$#args]]];
}
if (@args>1 && $args[0][0] == &PDB_IMAGE && $args[1][0] == &PDB_DRAWABLE) {
push @new, [\@vals,,$name,[@args[1..$#args]]];
}
}
push @res, @new;
} while @new;
map {
my($vals,$args)=gen_va(@{$_->[0]},@{$_->[2]});
"${tt1}$vals${b1}$_->[1]$b0$args$tt0";
} map $_->[1], sort {
$a->[0] <=> $b->[0]
} map [weight($_),$_], @res;
}
sub gen_desc {
my $name = shift;
my ($blurb, $help, $author, $copyright, $date, $type, $nargs, $nvals) =
Gimp->procedural_db_proc_info ($name);
my @args = map [Gimp->procedural_db_proc_arg ($name, $_)],0..($nargs-1);
my @vals = map [Gimp->procedural_db_proc_val ($name, $_)],0..($nvals-1);
my $r;
my($vals,$args)=gen_va(@vals,@args);
my($menu_path, $accelerator, $path, $image_types, $mtime) = @{$plugin_info{$name}};
for ($blurb, $help, $author, $copyright, $date, $menu_path, $accelerator, $path, $image_types) {
escape($_);
}
$r = eval "\"$header\"";
$r .= $section->("MENUPATH", $menu_path) if $menu_path;
$r .= $section->("IMAGETYPES", $image_types) if $image_types;
$r .= $section->("ACCELERATOR", $accelerator) if $accelerator;
if ($nargs) {
$r .= "${sh1}INPUT ARGUMENTS$sh0$theader";
for (@args) {
$r .= table_line(type2str($_->[0]),$_->[1],$_->[2]);
}
$r .= $tend;
}
if ($nvals) {
$r .= "${sh1}RETURN VALUES$sh0$theader";
for (@vals) {
$r .= table_line(type2str($_->[0]),$_->[1],$_->[2]);
}
$r .= $tend;
}
my @alts = gen_alternatives @vals,$name,@args;
if (@alts) {
@alts = @alts[0..5] if @alts > 6;
$r .= "${sh1}SOME SYNTAX ALTERNATIVES$sh0". join($br, @alts). "\n";
}
$r .= $section->("INSTALLATION PATH", $path) if $path;
$r .= eval "\"$trailer\"";
$r;
}
get_plugininfo;
if ($opt_w) {
format_html;
$|=1;
use POSIX 'strftime';
my $today = strftime ("%Y-%m-%d %H:%M:%SZ", gmtime time);
open HTML,">$opt_w/index.html" or die "Unable to create '$opt_w/index.html': $!\n";
print "$opt_w/index.html";
my %done;
print HTML <<EOF;
<html><head><title>Gimp PDB Documentation, created on $today by gimpdoc</title>$body
<h1>Gimp PDB Documentation</h1>
The following pages contain a htmlified version of the <a
href="http://www.gimp.org/"><b>Gimp</b></a> PDB documentation</b>. They
were automatically generated on $today from $version, using the program
<tt>gimpdoc</tt> (part of the $version distribution). If you have any
questions please direct them to <a href=\"mailto:pcg\@goof.com\">Marc
Lehmann &lt;pcg\@goof.com&gt;</a>.
EOF
my($listing,$head);
for $group (qw(
script-fu- file_ extension_ plug_in_ perl_fu_ gimp_drawable_ gimp_channel_ gimp_layer_ gimp_image_ gimp_
),'.') {
my $some;
my $glisting;
for (grep /^$group/, @matches) {
next if $done{$_};
$done{$_}++;
my $blurb = (Gimp->procedural_db_proc_info($_))[0];
$blurb = substr($blurb,0,47)."..." if length($blurb)>50;
escape($blurb);
$some=1;
$glisting .= "<tr><td><a href=$_.html>$_</a><td>$blurb";
}
if ($some) {
my $xgroup = $group;
$xgroup =~ y/-_/ /;
$xgroup =~ s/\b(.)/uc($1)/ge;
$xgroup = "Ungrouped Functions" if $xgroup eq ".";
$head = "<h2><a href=\"#$group\">$xgroup</a></h2>".$head;
$listing = "<h2><a name=\"$group\">$xgroup</a></h2>".
"<table><tr align=left><th>Function<th>Description".
$glisting.
"</table>".
$listing;
}
}
print HTML "$head$listing$created_by</html>";
close HTML;
print "\n";
for $_ (0..$#matches) {
$prev_fun = $matches[$_-1];
$next_fun = $matches[$_+1-@matches];
$name = $matches[$_];
open HTML,">$opt_w/$name.html" or die "Unable to create '$opt_w/$name.html': $!\n";
print "$opt_w/$name.html";
print HTML gen_desc($name);
close HTML;
print "\n";
}
} else {
format_roff;
$filter = "| tbl | nroff -man | ( '$ENV{PAGER}' 2>/dev/null || less || pg || more )";
$filter = ">&STDOUT" if $opt_r;
open PAGER,$filter or die "unable to open pipe to the pager ($filter)\n";
if(@matches>1) {
print PAGER ".TH gimpdoc gimpdoc\n.SH MATCHING FUNCTIONS\n",join("\n.br\n",@matches),"\n";
}
for $name (@matches) {
print PAGER gen_desc($name);
}
}
Gimp::end;
close PAGER;