#!/usr/bin/perl

eval 'exec /usr/bin/perl  -S $0 ${1+"$@"}'
    if 0; # not running under some shell

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;
