# The GIMP -- an image manipulation program
# Copyright (C) 1995 Spencer Kimball and Peter Mattis

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

# "Perlized" from C source by Manish Singh <yosh@gimp.org>

sub andy_pdb_misc {
    $author = $copyright = 'Andy Thomas';
    $date = '1998';
}

sub mitch_misc {
    $author = $copyright = 'Michael Natterer <mitch@gimp.org>';
    $date = '2000';
}

sub neo_pdb_misc {
    $author = $copyright = 'Sven Neumann';
    $date = '2000';
}

# The defs

sub progress_init {
    $blurb = 'Initializes the progress bar for the current plug-in.';

    $help = <<'HELP';
Initializes the progress bar for the current plug-in. It is only valid to call
this procedure from a plug-in.
HELP

    &std_pdb_misc;

    @inargs = (
	{ name => 'message', type => 'string', no_success => 1,
	  desc => 'Message to use in the progress dialog' },
	{ name => 'gdisplay', type => 'int32',
	  desc => 'GimpDisplay to update progressbar in, or -1 for a seperate
		   window',
	  implicit_fill => 'gimp_default_display ()', no_id_lookup => 1 }
    );

    %invoke = (
	success => 'FALSE',
	code => <<'CODE'
{
  if (gimp->current_plug_in && gimp->current_plug_in->open)
    {
      success = TRUE;

      if (! gimp->no_interface)
	plug_in_progress_start (gimp->current_plug_in, message, gdisplay);
    }
}
CODE
    );
}

sub progress_update {
    $blurb = 'Updates the progress bar for the current plug-in.';

    $help = <<'HELP';
Updates the progress bar for the current plug-in. It is only valid to call this
procedure from a plug-in.
HELP

    &std_pdb_misc;

    @inargs = (
	{ name => 'percentage', type => 'float',
	  desc => 'Percentage of progress completed' }
    );

    %invoke = (
	success => 'FALSE',
	code => <<'CODE'
{
  if (gimp->current_plug_in && gimp->current_plug_in->open)
    {
      success = TRUE;

      if (! gimp->no_interface)
	plug_in_progress_update (gimp->current_plug_in, percentage);
    }
}
CODE
    );
}

sub temp_PDB_name {
    $blurb = 'Generates a unique temporary PDB name.';

    $help = <<'HELP';
This procedure generates a temporary PDB entry name that is guaranteed to be
unique. It is many used by the interactive popup dialogs to generate a PDB
entry name.
HELP

    &andy_pdb_misc;

    @outargs = (
	{ name => 'temp_name', type => 'string',
	  desc => 'A unique temporary name for a temporary PDB entry' }
    );

    %invoke = (
	vars => [ 'static gint proc_number = 0' ],
	code => <<'CODE'
temp_name = g_strdup_printf ("temp_plugin_number_%d", proc_number++);
CODE
    );
}

sub plugins_query {
    $blurb = 'Queries the plugin database for its contents.';

    $help = 'This procedure queries the contents of the plugin database.';

    &andy_pdb_misc;

    @inargs = (
	{ name => 'search_string', type => 'string',
	  desc => 'If not an empty string then use this as a search pattern',
	  alias => 'search_str', no_success => 1 }
    );

    @outargs = (
	{ name => 'menu_path', type => 'stringarray',
	  desc => 'The menu path of the plugin',
	  alias => 'menu_strs' },
	{ name => 'plugin_accelerator', type => 'stringarray',
	  desc => 'String representing keyboard accelerator (could be empty
		   string)',
	  alias => 'accel_strs' },
	{ name => 'plugin_location', type => 'stringarray',
	  desc => 'Location of the plugin program',
	  alias => 'prog_strs' },
	{ name => 'plugin_image_type', type => 'stringarray',
	  desc => 'Type of image that this plugin will work on',
	  alias => 'types_strs' },
	{ name => 'plugin_install_time', type => 'int32array',
	  desc => 'Time that the plugin was installed',
	  alias => 'time_ints' },
	{ name => 'plugin_real_name', type => 'stringarray',
	  desc => 'The internal name of the plugin',
	  alias => 'realname_strs' }
    );

    foreach (@outargs) {
	$_->{array} = { name => 'num_plugins', no_declare => 1,
			desc => 'The number of plugins' }
    }

    $outargs[0]->{array}->{init} = 1;
    delete $outargs[0]->{array}->{no_declare};

    %invoke = (
	vars => [ 'PlugInProcDef *proc_def', 'GSList *list = NULL',
		  'gint i = 0', 'regex_t sregex' ],
	code => <<'CODE'
{
  if (search_str && strlen (search_str))
    regcomp (&sregex, search_str, REG_ICASE);
  else
    search_str = NULL;

  /* count number of plugin entries, then allocate 4 arrays of correct size
   * where we can store the strings.
   */

  for (list = gimp->plug_in_proc_defs; list; list = g_slist_next (list))
    {
      proc_def = (PlugInProcDef *) list->data;

      if (proc_def->prog && proc_def->menu_path)
	{
	  gchar *name = strrchr (proc_def->menu_path, '/');

	  if (name)
	    name = name + 1;
	  else
	    name = proc_def->menu_path;

	  if (search_str && match_strings (&sregex, name))
	    continue;

	  num_plugins++;
	}
    }

  menu_strs     = g_new (gchar *, num_plugins);
  accel_strs    = g_new (gchar *, num_plugins);
  prog_strs     = g_new (gchar *, num_plugins);
  types_strs    = g_new (gchar *, num_plugins);
  realname_strs = g_new (gchar *, num_plugins);
  time_ints     = g_new (gint   , num_plugins);

  for (list = gimp->plug_in_proc_defs; list; list = g_slist_next (list))
    {
      if (i > num_plugins)
	g_error ("Internal error counting plugins");

      proc_def = (PlugInProcDef *) list->data;

      if (proc_def->prog && proc_def->menu_path)
	{
	  ProcRecord *pr = &proc_def->db_info;

	  gchar *name = strrchr (proc_def->menu_path, '/');

	  if (name)
	    name = name + 1;
	  else
	    name = proc_def->menu_path;

	  if (search_str && match_strings(&sregex,name))
	    continue;

	  menu_strs[i]     = g_strdup (proc_def->menu_path);
	  accel_strs[i]    = g_strdup (proc_def->accelerator);
	  prog_strs[i]     = g_strdup (proc_def->prog);
	  types_strs[i]    = g_strdup (proc_def->image_types);
	  realname_strs[i] = g_strdup (pr->name);
	  time_ints[i]     = proc_def->mtime;

	  i++;
	}
    }

  /* This I hope frees up internal stuff */
  if (search_str)
    free (sregex.buffer);
}
CODE
    );
}

sub plugin_domain_register {
    $blurb = 'Registers a textdomain for localisation.';

    $help = <<'HELP';
This procedure adds a textdomain to the list of domains Gimp searches 
for strings when translating its menu entries. There is no need to 
call this function for plug-ins that have their strings included in 
the gimp-std-plugins domain as that is used by default. If the compiled 
message catalog is not in the standard location, you may specify an 
absolute path to another location. This procedure can only be called 
in the query function of a plug-in and it has to be called before any
procedure is installed.
HELP

    &neo_pdb_misc;

    @inargs = (
	{ name => 'domain_name', type => 'string',
	  desc => 'The name of the textdomain (must be unique).' },
	{ name => 'domain_path', type => 'string',
	  desc => 'The absolute path to the compiled message catalog (may be NULL).',
	  no_success => 1 },
    );

    %invoke = (
	success => 'TRUE',
	code => <<'CODE',
{
  if (gimp->current_plug_in && gimp->current_plug_in->query)
    {
      plug_in_def_set_locale_domain_name (gimp->current_plug_in->plug_in_def,
                                          domain_name);
      plug_in_def_set_locale_domain_path (gimp->current_plug_in->plug_in_def,
	                                  domain_path);
    }
}
CODE
    );
}

sub plugin_help_register {
    $blurb = "Register a help path for a plug-in.";

    $help = <<HELP;
This procedure changes the help rootdir for the plug-in which calls it. All
subsequent calls of gimp_help from this plug-in will be interpreted relative
to this rootdir.  This procedure can only be called in the query function of
a plug-in and it has to be called before any procedure is installed.
HELP

    &mitch_misc;

    @inargs = (
	{ name => 'help_path', type => 'string',
	  desc => 'The rootdir of the plug-in\'s help pages' }
    );

    %invoke = (
        success => 'TRUE',
        code => <<'CODE',
{
  if (gimp->current_plug_in && gimp->current_plug_in->query)
    {
      plug_in_def_set_help_path (gimp->current_plug_in->plug_in_def, help_path);
    }
}
CODE
    );
}


$extra{app}->{code} = <<'CODE';
static int
match_strings (regex_t *preg,
               gchar   *a)
{
  return regexec (preg, a, 0, NULL, 0);
}
CODE

@headers = qw(<string.h> <stdlib.h> "regexrepl/regex.h" "core/gimp.h"
              "plug-in/plug-in.h" "plug-in/plug-ins.h"
              "plug-in/plug-in-def.h" "plug-in/plug-in-proc.h"
              "plug-in/plug-in-progress.h");

@procs = qw(progress_init progress_update temp_PDB_name plugins_query
	    plugin_domain_register plugin_help_register);
%exports = (app => [@procs], lib => [@procs[0..2,4,5]]);

$desc = 'Plug-in';

1;
