gimp/tools/pdbgen/pdb/procedural_db.pdb

# 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 proc_name_arg {
    { name => 'procedure', type => 'string',
      desc => 'The procedure name', alias => 'proc_name' },
}

sub regex_arg {
    my $type = shift;
    { name => $type, type => 'string',
      desc => "The regex for procedure $type" }
}

sub data_ident_arg {
    { name => 'identifier', type => 'string',
      desc => 'The identifier associated with data' }
}

sub data_bytes_arg {
    { name => 'bytes', type => 'int32',
      desc => 'The number of bytes in the data' }
}

sub data_arg {
    { name => 'data', type => 'int8array',
      desc => 'A byte array containing data' }
}

sub arg_info_proc {
    my $type = shift; my $long_type = shift; my $real_type = shift;

    $blurb = <<BLURB;
Queries the procedural database for information on the specified procedure's
$long_type.
BLURB

    $help = <<HELP;
This procedure returns information on the specified procedure's $long_type. The
$long_type type, name, and a description are retrieved.
HELP

    &std_pdb_misc;
    $date = '1997';

    @inargs = (
	&proc_name_arg,
	{ name => "$type_num", type => 'int32',
	  desc => "The $long_type number" }
    );

    @outargs = (
	{ name => "${type}_type", type => 'enum PDBArgType',
	  desc => "The type of $long_type %%desc%%",
	  alias => "${type}->arg_type" },
	{ name => "${type}_name", type => 'string',
	  desc => "The name of the $long_type",
	  alias => "${type}->name" },
	{ name => "${type}_desc", type => 'string',
	  desc => "A description of the $long_type",
	  alias => "${type}->description" }
    );

   %invoke = (
	headers => [ qw("procedural_db.h") ],
	vars => [ 'ProcRecord *proc;' ],
	code => <<CODE
{
  proc = procedural_db_lookup (proc_name);
  if (proc && (${type}_num >= 0 && ${type}_num < proc->num_$real_type))
    $type = \&proc->${real_type}[${type}_num];
  else
    success = FALSE;
}
CODE
   );
}

# The defs

sub procedural_db_query {
    $alias{lib} = 'query_database';

    $blurb = <<'BLURB';
Queries the procedural database for its contents using regular expression
matching.
BLURB

    $help = <<'HELP';
This procedure queries the contents of the procedural database. It is supplied
with seven arguments matching procedures on { name, blurb, help, author,
copyright, date, procedure type}. This is accomplished using regular expression
matching. For instance, to find all procedures with "jpeg" listed in the blurb,
all seven arguments can be supplied as ".*", except for the second, which can
be supplied as ".*jpeg.*". There are two return arguments for this procedure.
The first is the number of procedures matching the query. The second is a
concatenated list of procedure names corresponding to those matching the query.
If no matching entries are found, then the returned string is NULL and the
number of entries is 0.
HELP

    &std_pdb_misc;

    @inargs = (
	&regex_arg('name'),
	&regex_arg('blurb'),
	&regex_arg('help'),
	&regex_arg('author'),
	&regex_arg('copyright'),
	&regex_arg('date'),
	&regex_arg('proc_type')
    );
    $inargs[$#inargs]->{desc} =~
	s <proc_type$>
	  <type: { 'Internal GIMP procedure', 'GIMP Plug-in',
		   'GIMP Extension' }>;

    @outargs = (
	{
	    name  => 'num_matches',
	    type  => 'int32',
	    desc  => 'The number of matching procedures',
	    alias => 'pdb_query.num_procs'
	},
	{
	    name  => 'procedure_names',
	    type  => 'stringarray',
	    desc  => 'The list of procedure names',
	    alias => 'pdb_query.list_or_procs'
	}
    );

    my($regcomp, $free, $once);
    foreach (@inargs) {
	$regcomp .= ' ' x 2 if $once;
	$regcomp .= "regcomp (&pdb_query.${_}_regex, $_, 0);\n";

	$free .= ' ' x 2 if $once++;
	$free .= "free (pdb_query.${_}_regex.buffer);\n";
    }

    %invoke = (
	headers => [ qw("procedural_db.h" "regex.h") ],
	vars => [ 'PDBQuery pdb_query' ],
	code => <<CODE
{
  $regcomp
  pdb_query.list_of_procs = NULL;
  pdb_query.num_procs = 0;

  g_hash_table_foreach (procedural_ht, procedural_db_query_entry, \&pdb_query);

  $free
}
CODE
    );
}

sub procedural_db_proc_info {
    $alias{lib} = 'query_procedure';

    $blurb = <<'BLURB';
Queries the procedural database for information on the specified procedure.
BLURB

    $help = <<'HELP';
This procedure returns information on the specified procedure. A short blurb,
detailed help, author(s), copyright information, procedure type, number of
input, and number of return values are returned. For specific information on
each input argument and return value, use the
'gimp-procedural-db-query-proc-arg' and
'gimp-procedural-db-query-proc-val' procedures.
HELP

    &std_pdb_misc;
    $date = '1997';

    @inargs = ( &proc_name_arg );

    @outargs = (
	{ name => 'blurb', type => 'string',
	  desc => 'A short blurb' },
	{ name => 'help', type => 'string',
	  desc => 'Detailed procedure help' },
	{ name => 'author', type => 'string',
	  desc => 'Author(s) of the procedure' },
	{ name => 'copyright', type => 'string',
	  desc => 'The copyright' },
	{ name => 'date', type => 'string',
	  desc => 'Copyright date' },
        { name => 'proc_type', type => 'enum PDBProcType',
	  desc => 'The procedure type: %%desc%%' },
        { name => 'num_args', type => 'int32',
	  desc => 'The number of input arguments' },
        { name => 'num_values', type => 'int32',
	  desc => 'The number of return values' }
    );

    foreach (@outargs) { $_->{alias} = "proc->$_->{name}" }

    %invoke = (
	headers => [ qw("procedural_db.h") ],
	code => <<'CODE'
success = ((proc = procedural_db_lookup (proc_name)) != NULL);
CODE
    );
}

sub procedural_db_proc_arg {
    &arg_info_proc('arg', 'argument', 'args');
}

sub procedural_db_proc_val {
    &arg_info_proc('val', 'return value', 'values');
}

sub procedural_db_get_data {
    $alias{lib} = 'get_data';

    $blurb = 'Returns data associated with the specified identifier.';

    $help = <<'HELP';
This procedure returns any data which may have been associated with the
specified identifier. The data is a variable length array of bytes. If no data
has been associated with the identifier, an error is returned.
HELP

    &std_pdb_misc;
    $date = '1997';

    @inargs = ( &data_ident_arg );

    @outargs = ( &data_bytes_arg, &data_arg );
    $outargs[0]->{alias} = 'data->bytes';
    $outargs[1]->{alias} = 'data_copy';

    @globals = ('static GList *data_list = NULL');

    %invoke = (
	headers => [ qw("procedural.db.h") ],
	vars => ['PDBData *data', 'char *data_copy', 'GList *list'],
	code => <<'CODE'
{
  success = FALSE;

  list = data_list;
  while (list)
    {
      data = (PDBData *) list->data;
      list = list->next;

      if (strcmp (data->identifier, identifier) == 0)
	{
	  data_copy = g_new (char, data->bytes);
	  memcpy (data_copy, data->data, data->bytes);

	  success = TRUE;
	  break;
	}
    }
}
CODE
    );
}

sub procedural_db_get_data_size {
    $alias{lib} = 'get_data_size';

    $blurb = 'Returns size of data associated with the specified identifier.';

    $help = <<'HELP';
This procedure returns the size of any data which may have been associated with
the specified identifier. If no data has been associated with the identifier,
an error is returned.
HELP

    $author = 'Nick Lamb';
    $copyright = $author;
    $date = '1998';

    @inargs = ( &data_ident_arg );

    @outargs = ( &data_bytes_arg );
    $outargs[0]->{alias} = 'data->bytes';

    %invoke = (
	headers => [ qw("procedural.db.h") ],
	vars => ['PDBData *data', 'GList *list'],
	code => <<'CODE'
{
  success = FALSE;

  list = data_list;
  while (list)
    {
      data = (PDBData *) list->data;
      list = list->next;

      if (strcmp (data->identifier, identifier) == 0)
	{
	  success = TRUE;
	  break;
	}
    }
}
CODE
    );
}

sub procedural_db_set_data {
    $alias{lib} = 'set_data';

    $blurb = 'Associates the specified identifier with the supplied data.';

    $help = <<'HELP';
This procedure associates the supplied data with the provided identifier. The
data may be subsequently retrieved by a call to 'procedural-db-get-data'.
HELP

    &std_pdb_misc;
    $date = '1997';

    @inargs = ( &data_ident_arg, &data_bytes_arg, &data_arg );
    $inargs[2]->{alias} = 'data_src';

    %invoke = (
	headers => [ qw("procedural.db.h") ],
	vars => ['PDBData *data = NULL', 'GList *list'],
	code => <<'CODE'
{
  list = data_list;
  while (list)
    {
      if (strcmp (((PDBData *) list->data)->identifier, identifier) == 0)
	data = (PDBData *) list->data;

      list = list->next;
    }

  /* If there isn't already data with the specified identifier, create one */
  if (data == NULL)
    {
      data = (PDBData *) g_new (PDBData, 1);
      data_list = g_list_append (data_list, data);
    }
  else
    g_free (data->data);

  data->identifier = g_strdup (identifier);
  data->bytes = bytes;
  data->data = g_new (char, data->bytes);
  memcpy (data->data, (char *) data_src, data->bytes);
}
CODE
    );
}

$support{types} = <<'SUPPORT';
/*  Query structure  */
typedef struct _PDBQuery PDBQuery;

struct _PDBQuery
{
  regex_t name_regex;
  regex_t blurb_regex;
  regex_t help_regex;
  regex_t author_regex;
  regex_t copyright_regex;
  regex_t date_regex;
  regex_t proc_type_regex;

  char ** list_of_procs;
  int     num_procs;
};

typedef struct _PDBData PDBData;

struct _PDBData
{
  char *identifier;
  int   bytes;
  char *data;
};
SUPPORT

$support{code} = <<'SUPPORT';
static inline int
match_strings (regex_t *preg,
	       char    *a)
{
  return regexec (preg, a, 0, NULL, 0);
}

static void
procedural_db_query_entry (gpointer key,
                           gpointer value,
                           gpointer user_data)
{
  GList *list;
  ProcRecord *proc;
  PDBQuery *pdb_query;
  int new_length;

  list = (GList *) value;
  proc = (ProcRecord *) list->data;
  pdb_query = (PDBQuery *) user_data;

  if (!match_strings (&pdb_query->name_regex, proc->name) &&
      !match_strings (&pdb_query->blurb_regex, proc->blurb) &&
      !match_strings (&pdb_query->help_regex, proc->help) &&
      !match_strings (&pdb_query->author_regex, proc->author) &&
      !match_strings (&pdb_query->copyright_regex, proc->copyright) &&
      !match_strings (&pdb_query->date_regex, proc->date) &&
      !match_strings (&pdb_query->proc_type_regex, proc_type_str[(int) proc->pro
c_type]))
    {
      new_length = (proc->name) ? (strlen (proc->name) + 1) : 0;

      if (new_length)
        {
          pdb_query->num_procs++;
          pdb_query->list_of_procs = g_realloc (pdb_query->list_of_procs,
                                               (sizeof (char **) * pdb_query->nu
m_procs));
          pdb_query->list_of_procs[pdb_query->num_procs - 1] = g_strdup (proc->n
ame);
        }
    }
}
SUPPORT

@procs = qw(procedural_db_dump procedural_db_query procedural_db_proc_info
	    procedural_db_proc_arg procedural_db_proc_val
	    procedural_db_get_data procedural_db_get_data_size
	    procedural_db_set_data)
%exports = (app => [@procs], lib => [@procs[5..7], @procs[1..2]]);

$desc = 'Procedural database';

1;