Gimp/plug-ins/script-fu/scheme-wrapper.c
Kevin Cozens e2d373d817 Additional simplifications for return values by using the same code for
2006-06-10  Kevin Cozens  <kcozens@cvs.gnome.org>

	* plug-ins/script-fu/siod-wrapper.c (marshall_proc_db_call):
	Additional simplifications for return values by using the same
	code for all INT32 PDB types. Wrong member name was being used
	for INT16 and INT8 return types. Added back if statement that
	was removed but is needed.
2006-06-10 04:03:55 +00:00

1134 lines
36 KiB
C

/* 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.
*/
#include "config.h"
#include <string.h> /* memcpy, strcpy, strlen */
#include <gtk/gtk.h>
#include "libgimp/gimp.h"
#include "siod/siod.h"
#include "script-fu-types.h"
#include "script-fu-console.h"
#include "script-fu-interface.h"
#include "script-fu-scripts.h"
#include "script-fu-server.h"
#include "siod-wrapper.h"
static int siod_console_mode;
/* global variables declared by the scheme interpreter */
extern FILE * siod_output;
extern int siod_verbose_level;
extern gchar siod_err_msg[];
extern void * siod_output_routine;
extern LISP repl_return_val;
/* defined in regex.c. not exported by regex.h */
extern void init_regex (void);
/* defined in siodp.h but this file cannot be imported... */
extern long nlength (LISP obj);
extern LISP leval_define (LISP args, LISP env);
/* wrapper functions */
FILE *
siod_get_output_file (void)
{
return siod_output;
}
void
siod_set_output_file (FILE *file)
{
siod_output = file;
}
void
siod_set_console_mode (int flag)
{
siod_console_mode = flag;
}
int
siod_get_verbose_level (void)
{
return siod_verbose_level;
}
void
siod_set_verbose_level (gint verbose_level)
{
siod_verbose_level = verbose_level;
}
void
siod_print_welcome (void)
{
print_welcome ();
}
gint
siod_interpret_string (const gchar *expr)
{
return repl_c_string ((char *) expr, 0, 0, 1);
}
const gchar *
siod_get_error_msg (void)
{
return siod_err_msg;
}
const gchar *
siod_get_success_msg (void)
{
if (TYPEP (repl_return_val, tc_string))
return get_c_string (repl_return_val);
else
return "Success";
}
void
siod_output_string (FILE *fp,
const gchar *format,
...)
{
gchar *buf;
va_list args;
va_start (args, format);
buf = g_strdup_vprintf (format, args);
va_end (args);
if (siod_console_mode && fp == stdout)
{
script_fu_output_to_console (buf);
}
else
{
fprintf (fp, buf);
fflush (fp);
}
g_free (buf);
}
static void init_constants (void);
static void init_procedures (void);
static gboolean register_scripts = FALSE;
void
siod_init (gboolean local_register_scripts)
{
char *siod_argv[] =
{
"siod",
"-h100000:10",
"-g0",
"-o1000",
"-s200000",
"-n2048",
"-v0",
};
register_scripts = local_register_scripts;
siod_output_routine = siod_output_string;
/* init the interpreter */
process_cla (G_N_ELEMENTS (siod_argv), siod_argv, 1);
init_storage ();
init_subrs ();
init_trace ();
init_regex ();
/* register in the interpreter the gimp functions and types. */
init_procedures ();
init_constants ();
}
static void convert_string (gchar *str);
static gint sputs_fcn (gchar *st,
gpointer dest);
static LISP lprin1s (LISP exp,
gchar *dest);
static LISP marshall_proc_db_call (LISP a);
static LISP script_fu_register_call (LISP a);
static LISP script_fu_menu_register_call (LISP a);
static LISP script_fu_quit_call (LISP a);
/*
* Below can be found the functions responsible for registering the
* gimp functions and types against the scheme interpreter.
*/
static void
init_procedures (void)
{
gchar **proc_list;
gchar *proc_blurb;
gchar *proc_help;
gchar *proc_author;
gchar *proc_copyright;
gchar *proc_date;
GimpPDBProcType proc_type;
gint nparams;
gint nreturn_vals;
GimpParamDef *params;
GimpParamDef *return_vals;
gint num_procs;
gint i;
/* register the database execution procedure */
init_lsubr ("gimp-proc-db-call", marshall_proc_db_call);
init_lsubr ("script-fu-register", script_fu_register_call);
init_lsubr ("script-fu-menu-register", script_fu_menu_register_call);
init_lsubr ("script-fu-quit", script_fu_quit_call);
gimp_procedural_db_query (".*", ".*", ".*", ".*", ".*", ".*", ".*",
&num_procs, &proc_list);
/* Register each procedure as a scheme func */
for (i = 0; i < num_procs; i++)
{
/* lookup the procedure */
if (gimp_procedural_db_proc_info (proc_list[i],
&proc_blurb,
&proc_help,
&proc_author,
&proc_copyright,
&proc_date,
&proc_type,
&nparams, &nreturn_vals,
&params, &return_vals))
{
LISP args = NIL;
LISP code = NIL;
gint j;
/* create a new scheme func that calls gimp-proc-db-call */
for (j = 0; j < nparams; j++)
{
args = cons (rintern (params[j].name), args);
code = cons (rintern (params[j].name), code);
}
/* reverse the list */
args = nreverse (args);
code = nreverse (code);
/* set the procedure name */
args = cons (rintern (proc_list[i]), args);
/* set the actual pdb procedure name */
code = cons (cons (cintern ("quote"),
cons (rintern (proc_list[i]), NIL)), code);
code = cons (cintern ("gimp-proc-db-call"), code);
leval_define (cons (args, cons (code, NIL)), NIL);
/* free the queried information */
g_free (proc_blurb);
g_free (proc_help);
g_free (proc_author);
g_free (proc_copyright);
g_free (proc_date);
gimp_destroy_paramdefs (params, nparams);
gimp_destroy_paramdefs (return_vals, nreturn_vals);
}
g_free (proc_list[i]);
}
g_free (proc_list);
}
static void
init_constants (void)
{
const gchar **enum_type_names;
gint n_enum_type_names;
gint i;
GimpUnit unit;
setvar (cintern ("gimp-directory"),
strcons (-1, (gchar *) gimp_directory ()), NIL);
setvar (cintern ("gimp-data-directory"),
strcons (-1, (gchar *) gimp_data_directory ()), NIL);
setvar (cintern ("gimp-plug-in-directory"),
strcons (-1, (gchar *) gimp_plug_in_directory ()), NIL);
setvar (cintern ("gimp-locale-directory"),
strcons (-1, (gchar *) gimp_locale_directory ()), NIL);
setvar (cintern ("gimp-sysconf-directory"),
strcons (-1, (gchar *) gimp_sysconf_directory ()), NIL);
enum_type_names = gimp_enums_get_type_names (&n_enum_type_names);
for (i = 0; i < n_enum_type_names; i++)
{
const gchar *enum_name = enum_type_names[i];
GType enum_type = g_type_from_name (enum_name);
GEnumClass *enum_class = g_type_class_ref (enum_type);
GEnumValue *value;
for (value = enum_class->values; value->value_name; value++)
{
if (! strncmp ("GIMP_", value->value_name, 5))
{
gchar *scheme_name;
scheme_name = g_strdup (value->value_name + 5);
convert_string (scheme_name);
setvar (rintern (scheme_name), flocons (value->value), NIL);
g_free (scheme_name);
}
}
g_type_class_unref (enum_class);
}
for (unit = GIMP_UNIT_PIXEL;
unit < gimp_unit_get_number_of_built_in_units ();
unit++)
{
gchar *tmp;
gchar *scheme_name;
tmp = g_ascii_strup (gimp_unit_get_singular (unit), -1);
scheme_name = g_strconcat ("UNIT-", tmp, NULL);
g_free (tmp);
setvar (rintern (scheme_name), flocons (unit), NIL);
g_free (scheme_name);
}
/* These are for backwards compatibility; they should be removed sometime */
setvar (cintern ("gimp-dir"),
strcons (-1, (gchar *) gimp_directory ()), NIL);
setvar (cintern ("gimp-data-dir"),
strcons (-1, (gchar *) gimp_data_directory ()), NIL);
setvar (cintern ("gimp-plugin-dir"),
strcons (-1, (gchar *) gimp_plug_in_directory ()), NIL);
setvar (cintern ("NORMAL"), flocons (GIMP_NORMAL_MODE), NIL);
setvar (cintern ("DISSOLVE"), flocons (GIMP_DISSOLVE_MODE), NIL);
setvar (cintern ("BEHIND"), flocons (GIMP_BEHIND_MODE), NIL);
setvar (cintern ("MULTIPLY"), flocons (GIMP_MULTIPLY_MODE), NIL);
setvar (cintern ("SCREEN"), flocons (GIMP_SCREEN_MODE), NIL);
setvar (cintern ("OVERLAY"), flocons (GIMP_OVERLAY_MODE), NIL);
setvar (cintern ("DIFFERENCE"), flocons (GIMP_DIFFERENCE_MODE), NIL);
setvar (cintern ("ADDITION"), flocons (GIMP_ADDITION_MODE), NIL);
setvar (cintern ("SUBTRACT"), flocons (GIMP_SUBTRACT_MODE), NIL);
setvar (cintern ("DARKEN-ONLY"), flocons (GIMP_DARKEN_ONLY_MODE), NIL);
setvar (cintern ("LIGHTEN-ONLY"), flocons (GIMP_LIGHTEN_ONLY_MODE), NIL);
setvar (cintern ("HUE"), flocons (GIMP_HUE_MODE), NIL);
setvar (cintern ("SATURATION"), flocons (GIMP_SATURATION_MODE), NIL);
setvar (cintern ("COLOR"), flocons (GIMP_COLOR_MODE), NIL);
setvar (cintern ("VALUE"), flocons (GIMP_VALUE_MODE), NIL);
setvar (cintern ("DIVIDE"), flocons (GIMP_DIVIDE_MODE), NIL);
setvar (cintern ("BLUR"), flocons (GIMP_BLUR_CONVOLVE), NIL);
setvar (cintern ("SHARPEN"), flocons (GIMP_SHARPEN_CONVOLVE), NIL);
setvar (cintern ("WHITE-MASK"), flocons (GIMP_ADD_WHITE_MASK), NIL);
setvar (cintern ("BLACK-MASK"), flocons (GIMP_ADD_BLACK_MASK), NIL);
setvar (cintern ("ALPHA-MASK"), flocons (GIMP_ADD_ALPHA_MASK), NIL);
setvar (cintern ("ADD"), flocons (GIMP_CHANNEL_OP_ADD), NIL);
setvar (cintern ("SUB"), flocons (GIMP_CHANNEL_OP_SUBTRACT), NIL);
setvar (cintern ("REPLACE"), flocons (GIMP_CHANNEL_OP_REPLACE), NIL);
setvar (cintern ("INTERSECT"), flocons (GIMP_CHANNEL_OP_INTERSECT), NIL);
setvar (cintern ("FG-BG-RGB"), flocons (GIMP_FG_BG_RGB_MODE), NIL);
setvar (cintern ("FG-BG-HSV"), flocons (GIMP_FG_BG_HSV_MODE), NIL);
setvar (cintern ("FG-TRANS"), flocons (GIMP_FG_TRANSPARENT_MODE), NIL);
setvar (cintern ("CUSTOM"), flocons (GIMP_CUSTOM_MODE), NIL);
setvar (cintern ("FG-IMAGE-FILL"), flocons (GIMP_FOREGROUND_FILL), NIL);
setvar (cintern ("BG-IMAGE-FILL"), flocons (GIMP_BACKGROUND_FILL), NIL);
setvar (cintern ("WHITE-IMAGE-FILL"), flocons (GIMP_WHITE_FILL), NIL);
setvar (cintern ("TRANS-IMAGE-FILL"), flocons (GIMP_TRANSPARENT_FILL), NIL);
setvar (cintern ("APPLY"), flocons (GIMP_MASK_APPLY), NIL);
setvar (cintern ("DISCARD"), flocons (GIMP_MASK_DISCARD), NIL);
setvar (cintern ("HARD"), flocons (GIMP_BRUSH_HARD), NIL);
setvar (cintern ("SOFT"), flocons (GIMP_BRUSH_SOFT), NIL);
setvar (cintern ("CONTINUOUS"), flocons (GIMP_PAINT_CONSTANT), NIL);
setvar (cintern ("INCREMENTAL"), flocons (GIMP_PAINT_INCREMENTAL), NIL);
setvar (cintern ("HORIZONTAL"), flocons (GIMP_ORIENTATION_HORIZONTAL), NIL);
setvar (cintern ("VERTICAL"), flocons (GIMP_ORIENTATION_VERTICAL), NIL);
setvar (cintern ("UNKNOWN"), flocons (GIMP_ORIENTATION_UNKNOWN), NIL);
setvar (cintern ("LINEAR"), flocons (GIMP_GRADIENT_LINEAR), NIL);
setvar (cintern ("BILINEAR"), flocons (GIMP_GRADIENT_BILINEAR), NIL);
setvar (cintern ("RADIAL"), flocons (GIMP_GRADIENT_RADIAL), NIL);
setvar (cintern ("SQUARE"), flocons (GIMP_GRADIENT_SQUARE), NIL);
setvar (cintern ("CONICAL-SYMMETRIC"), flocons (GIMP_GRADIENT_CONICAL_SYMMETRIC), NIL);
setvar (cintern ("CONICAL-ASYMMETRIC"), flocons (GIMP_GRADIENT_CONICAL_ASYMMETRIC), NIL);
setvar (cintern ("SHAPEBURST-ANGULAR"), flocons (GIMP_GRADIENT_SHAPEBURST_ANGULAR), NIL);
setvar (cintern ("SHAPEBURST-SPHERICAL"), flocons (GIMP_GRADIENT_SHAPEBURST_SPHERICAL), NIL);
setvar (cintern ("SHAPEBURST-DIMPLED"), flocons (GIMP_GRADIENT_SHAPEBURST_DIMPLED), NIL);
setvar (cintern ("SPIRAL-CLOCKWISE"), flocons (GIMP_GRADIENT_SPIRAL_CLOCKWISE), NIL);
setvar (cintern ("SPIRAL-ANTICLOCKWISE"), flocons (GIMP_GRADIENT_SPIRAL_ANTICLOCKWISE), NIL);
setvar (cintern ("VALUE-LUT"), flocons (GIMP_HISTOGRAM_VALUE), NIL);
setvar (cintern ("RED-LUT"), flocons (GIMP_HISTOGRAM_RED), NIL);
setvar (cintern ("GREEN-LUT"), flocons (GIMP_HISTOGRAM_GREEN), NIL);
setvar (cintern ("BLUE-LUT"), flocons (GIMP_HISTOGRAM_BLUE), NIL);
setvar (cintern ("ALPHA-LUT"), flocons (GIMP_HISTOGRAM_ALPHA), NIL);
/* Useful values from libgimpbase/gimplimits.h */
setvar (cintern ("MIN-IMAGE-SIZE"), flocons (GIMP_MIN_IMAGE_SIZE), NIL);
setvar (cintern ("MAX-IMAGE-SIZE"), flocons (GIMP_MAX_IMAGE_SIZE), NIL);
setvar (cintern ("MIN-RESOLUTION"), flocons (GIMP_MIN_RESOLUTION), NIL);
setvar (cintern ("MAX-RESOLUTION"), flocons (GIMP_MAX_RESOLUTION), NIL);
/* Useful misc stuff */
setvar (cintern ("TRUE"), flocons (TRUE), NIL);
setvar (cintern ("FALSE"), flocons (FALSE), NIL);
/* Script-fu types */
setvar (cintern ("SF-IMAGE"), flocons (SF_IMAGE), NIL);
setvar (cintern ("SF-DRAWABLE"), flocons (SF_DRAWABLE), NIL);
setvar (cintern ("SF-LAYER"), flocons (SF_LAYER), NIL);
setvar (cintern ("SF-CHANNEL"), flocons (SF_CHANNEL), NIL);
setvar (cintern ("SF-COLOR"), flocons (SF_COLOR), NIL);
setvar (cintern ("SF-TOGGLE"), flocons (SF_TOGGLE), NIL);
setvar (cintern ("SF-VALUE"), flocons (SF_VALUE), NIL);
setvar (cintern ("SF-STRING"), flocons (SF_STRING), NIL);
setvar (cintern ("SF-FILENAME"), flocons (SF_FILENAME), NIL);
setvar (cintern ("SF-DIRNAME"), flocons (SF_DIRNAME), NIL);
setvar (cintern ("SF-ADJUSTMENT"), flocons (SF_ADJUSTMENT), NIL);
setvar (cintern ("SF-FONT"), flocons (SF_FONT), NIL);
setvar (cintern ("SF-PATTERN"), flocons (SF_PATTERN), NIL);
setvar (cintern ("SF-BRUSH"), flocons (SF_BRUSH), NIL);
setvar (cintern ("SF-GRADIENT"), flocons (SF_GRADIENT), NIL);
setvar (cintern ("SF-OPTION"), flocons (SF_OPTION), NIL);
setvar (cintern ("SF-PALETTE"), flocons (SF_PALETTE), NIL);
setvar (cintern ("SF-TEXT"), flocons (SF_TEXT), NIL);
setvar (cintern ("SF-ENUM"), flocons (SF_ENUM), NIL);
/* for SF_ADJUSTMENT */
setvar (cintern ("SF-SLIDER"), flocons (SF_SLIDER), NIL);
setvar (cintern ("SF-SPINNER"), flocons (SF_SPINNER), NIL);
}
static void
convert_string (gchar *str)
{
while (*str)
{
if (*str == '_') *str = '-';
str++;
}
}
static gboolean
sputs_fcn (gchar *st,
gpointer dest)
{
strcpy (*((gchar**)dest), st);
*((gchar**)dest) += strlen (st);
return TRUE;
}
static LISP
lprin1s (LISP exp,
gchar *dest)
{
struct gen_printio s;
s.putc_fcn = NULL;
s.puts_fcn = sputs_fcn;
s.cb_argument = &dest;
lprin1g (exp, &s);
return (NIL);
}
static LISP
marshall_proc_db_call (LISP a)
{
GimpParam *args;
GimpParam *values = NULL;
gint nvalues;
gchar *proc_name;
gchar *proc_blurb;
gchar *proc_help;
gchar *proc_author;
gchar *proc_copyright;
gchar *proc_date;
GimpPDBProcType proc_type;
gint nparams;
gint nreturn_vals;
GimpParamDef *params;
GimpParamDef *return_vals;
gchar error_str[256];
gint i;
gint success = TRUE;
LISP intermediate_val;
LISP return_val = NIL;
gchar *string;
gint string_len;
LISP a_saved;
/* Save a in case it is needed for an error message. */
a_saved = a;
/* Make sure there are arguments */
if (a == NIL)
return my_err ("Procedure database argument marshaller was called with no arguments. "
"The procedure to be executed and the arguments it requires "
"(possibly none) must be specified.", NIL);
/* Derive the pdb procedure name from the argument
or first argument of a list */
if (TYPEP (a, tc_cons))
proc_name = g_strdup (get_c_string (car (a)));
else
proc_name = g_strdup (get_c_string (a));
/* report the current command */
script_fu_interface_report_cc (proc_name);
/* Attempt to fetch the procedure from the database */
if (! gimp_procedural_db_proc_info (proc_name,
&proc_blurb,
&proc_help,
&proc_author,
&proc_copyright,
&proc_date,
&proc_type,
&nparams, &nreturn_vals,
&params, &return_vals))
{
g_snprintf (error_str, sizeof (error_str),
"Invalid procedure name %s specified", proc_name);
return my_err (error_str, NIL);
}
/* Free the name and the description which are of no use here. */
for (i = 0; i < nparams; i++)
{
g_free (params[i].name);
g_free (params[i].description);
}
for (i = 0; i < nreturn_vals; i++)
{
g_free (return_vals[i].name);
g_free (return_vals[i].description);
}
/* Check the supplied number of arguments */
if ((nlength (a) - 1) != nparams)
{
g_snprintf (error_str, sizeof (error_str),
"Invalid arguments supplied to %s -- "
"(# args: %ld, expecting: %d)",
proc_name, (nlength (a) - 1), nparams);
return my_err (error_str, NIL);
}
/* Marshall the supplied arguments */
if (nparams)
args = g_new (GimpParam, nparams);
else
args = NULL;
for (i = 0; i < nparams && success; i++)
{
a = cdr (a);
args[i].type = params[i].type;
switch (params[i].type)
{
case GIMP_PDB_INT32:
case GIMP_PDB_DISPLAY:
case GIMP_PDB_IMAGE:
case GIMP_PDB_LAYER:
case GIMP_PDB_CHANNEL:
case GIMP_PDB_DRAWABLE:
case GIMP_PDB_SELECTION:
case GIMP_PDB_VECTORS:
if (!TYPEP (car (a), tc_flonum))
success = FALSE;
else
args[i].data.d_int32 = get_c_long (car (a));
break;
case GIMP_PDB_INT16:
if (!TYPEP (car (a), tc_flonum))
success = FALSE;
else
args[i].data.d_int16 = (gint16) get_c_long (car (a));
break;
case GIMP_PDB_INT8:
if (!TYPEP (car (a), tc_flonum))
success = FALSE;
else
args[i].data.d_int8 = (gint8) get_c_long (car (a));
break;
case GIMP_PDB_FLOAT:
if (!TYPEP (car (a), tc_flonum))
success = FALSE;
else
args[i].data.d_float = get_c_double (car (a));
break;
case GIMP_PDB_STRING:
if (!TYPEP (car (a), tc_string))
success = FALSE;
else
args[i].data.d_string = get_c_string (car (a));
break;
case GIMP_PDB_INT32ARRAY:
if (!TYPEP (car (a), tc_long_array))
success = FALSE;
else
{
gint n_elements = args[i - 1].data.d_int32;
LISP list = car (a);
if ((n_elements < 0) || (n_elements > nlength (list)))
{
g_snprintf (error_str, sizeof (error_str),
"INT32 array (argument %d) for function %s has "
"incorrect length (got %ld, expected %d)",
i + 1, proc_name, nlength (list), n_elements);
return my_err (error_str, NIL);
}
args[i].data.d_int32array =
(gint32 *) list->storage_as.long_array.data;
}
break;
case GIMP_PDB_INT16ARRAY:
if (!TYPEP (car (a), tc_long_array))
success = FALSE;
else
{
gint n_elements = args[i - 1].data.d_int32;
LISP list = car (a);
if ((n_elements < 0) || (n_elements > nlength (list)))
{
g_snprintf (error_str, sizeof (error_str),
"INT16 array (argument %d) for function %s has "
"incorrect length (got %ld, expected %d)",
i + 1, proc_name, nlength (list), n_elements);
return my_err (error_str, NIL);
}
args[i].data.d_int16array =
(gint16 *) list->storage_as.long_array.data;
}
break;
case GIMP_PDB_INT8ARRAY:
if (!TYPEP (car (a), tc_byte_array))
success = FALSE;
else
{
gint n_elements = args[i - 1].data.d_int32;
LISP list = car (a);
if ((n_elements < 0) || (n_elements > nlength (list)))
{
g_snprintf (error_str, sizeof (error_str),
"INT8 array (argument %d) for function %s has "
"incorrect length (got %ld, expected %d)",
i + 1, proc_name, nlength (list), n_elements);
return my_err (error_str, NIL);
}
args[i].data.d_int8array =
(gint8 *) list->storage_as.string.data;
}
break;
case GIMP_PDB_FLOATARRAY:
if (!TYPEP (car (a), tc_double_array))
success = FALSE;
else
{
gint n_elements = args[i - 1].data.d_int32;
LISP list = car (a);
if ((n_elements < 0) || (n_elements > nlength (list)))
{
g_snprintf (error_str, sizeof (error_str),
"FLOAT array (argument %d) for function %s has "
"incorrect length (got %ld, expected %d)",
i + 1, proc_name, nlength (list), n_elements);
return my_err (error_str, NIL);
}
args[i].data.d_floatarray = list->storage_as.double_array.data;
}
break;
case GIMP_PDB_STRINGARRAY:
if (!TYPEP (car (a), tc_cons))
success = FALSE;
else
{
gint n_elements = args[i - 1].data.d_int32;
LISP list = car (a);
gint j;
if ((n_elements < 0) || (n_elements > nlength (list)))
{
g_snprintf (error_str, sizeof (error_str),
"String array (argument %d) for function %s has "
"incorrect length (got %ld, expected %d)",
i + 1, proc_name, nlength (list), n_elements);
return my_err (error_str, NIL);
}
args[i].data.d_stringarray = g_new0 (gchar *, n_elements);
for (j = 0; j < n_elements; j++)
{
args[i].data.d_stringarray[j] = get_c_string (car (list));
list = cdr (list);
}
}
break;
case GIMP_PDB_COLOR:
if (TYPEP (car (a), tc_string))
{
if (! gimp_rgb_parse_css (&args[i].data.d_color,
get_c_string (car (a)), -1))
success = FALSE;
gimp_rgb_set_alpha (&args[i].data.d_color, 1.0);
}
else if (TYPEP (car (a), tc_cons))
{
LISP color_list;
guchar r, g, b;
color_list = car (a);
r = CLAMP (get_c_long (car (color_list)), 0, 255);
color_list = cdr (color_list);
g = CLAMP (get_c_long (car (color_list)), 0, 255);
color_list = cdr (color_list);
b = CLAMP (get_c_long (car (color_list)), 0, 255);
gimp_rgba_set_uchar (&args[i].data.d_color, r, g, b, 255);
}
else
{
success = FALSE;
}
break;
case GIMP_PDB_REGION:
return my_err ("Regions are currently unsupported as arguments",
car (a));
break;
case GIMP_PDB_BOUNDARY:
return my_err ("Boundaries are currently unsupported as arguments",
car (a));
break;
case GIMP_PDB_PARASITE:
if (!TYPEP (car (a), tc_cons))
success = FALSE;
else
{
/* parasite->name */
intermediate_val = car (a);
if (!TYPEP (car (intermediate_val), tc_string))
{
success = FALSE;
break;
}
args[i].data.d_parasite.name =
get_c_string (car (intermediate_val));
/* parasite->flags */
intermediate_val = cdr (intermediate_val);
if (!TYPEP (car (intermediate_val), tc_flonum))
{
success = FALSE;
break;
}
args[i].data.d_parasite.flags =
get_c_long (car (intermediate_val));
/* parasite->size */
intermediate_val = cdr (intermediate_val);
if (!TYPEP (car (intermediate_val), tc_string) &&
!TYPEP (car (intermediate_val), tc_byte_array))
{
success = FALSE;
break;
}
args[i].data.d_parasite.size =
(car (intermediate_val))->storage_as.string.dim;
/* parasite->data */
args[i].data.d_parasite.data =
(car (intermediate_val))->storage_as.string.data;
}
break;
case GIMP_PDB_STATUS:
return my_err ("Status is for return types, not arguments", car (a));
break;
default:
g_snprintf (error_str, sizeof (error_str),
"Argument %d for %s is an unknown type",
i + 1, proc_name);
return my_err (error_str, NIL);
}
if (! success)
break;
}
if (success)
{
values = gimp_run_procedure2 (proc_name, &nvalues, nparams, args);
}
else
{
g_snprintf (error_str, sizeof (error_str),
"Invalid type for argument %d to %s", i + 1, proc_name);
return my_err (error_str, NIL);
}
/* Check the return status */
if (! values)
{
strcpy (error_str,
"Procedural database execution did not return a status:\n ");
lprin1s (a_saved, error_str + strlen (error_str));
return my_err (error_str, NIL);
}
switch (values[0].data.d_status)
{
case GIMP_PDB_EXECUTION_ERROR:
strcpy (error_str,
"Procedural database execution failed:\n ");
lprin1s (a_saved, error_str + strlen (error_str));
return my_err (error_str, NIL);
break;
case GIMP_PDB_CALLING_ERROR:
strcpy (error_str,
"Procedural database execution failed on invalid input arguments:\n ");
lprin1s (a_saved, error_str + strlen (error_str));
return my_err (error_str, NIL);
break;
case GIMP_PDB_SUCCESS:
return_val = NIL;
for (i = 0; i < nvalues - 1; i++)
{
switch (return_vals[i].type)
{
case GIMP_PDB_INT32:
case GIMP_PDB_DISPLAY:
case GIMP_PDB_IMAGE:
case GIMP_PDB_LAYER:
case GIMP_PDB_CHANNEL:
case GIMP_PDB_DRAWABLE:
case GIMP_PDB_SELECTION:
case GIMP_PDB_VECTORS:
return_val = cons (flocons (values[i + 1].data.d_int32),
return_val);
break;
case GIMP_PDB_INT16:
return_val = cons (flocons (values[i + 1].data.d_int16),
return_val);
break;
case GIMP_PDB_INT8:
return_val = cons (flocons (values[i + 1].data.d_int8),
return_val);
break;
case GIMP_PDB_FLOAT:
return_val = cons (flocons (values[i + 1].data.d_float),
return_val);
break;
case GIMP_PDB_STRING:
string = values[i + 1].data.d_string;
if (! string)
string = "";
string_len = strlen (string);
return_val = cons (strcons (string_len, string), return_val);
break;
case GIMP_PDB_INT32ARRAY:
{
LISP array;
gint j;
array = arcons (tc_long_array, values[i].data.d_int32, 0);
for (j = 0; j < values[i].data.d_int32; j++)
{
array->storage_as.long_array.data[j] =
values[i + 1].data.d_int32array[j];
}
return_val = cons (array, return_val);
}
break;
case GIMP_PDB_INT16ARRAY:
{
LISP array;
gint j;
array = arcons (tc_long_array, values[i].data.d_int32, 0);
for (j = 0; j < values[i].data.d_int32; j++)
{
array->storage_as.long_array.data[j] =
values[i + 1].data.d_int16array[j];
}
return_val = cons (array, return_val);
}
break;
case GIMP_PDB_INT8ARRAY:
{
LISP array;
gint j;
array = arcons (tc_byte_array, values[i].data.d_int32, 0);
for (j = 0; j < values[i].data.d_int32; j++)
{
array->storage_as.string.data[j] =
values[i + 1].data.d_int8array[j];
}
return_val = cons (array, return_val);
}
break;
case GIMP_PDB_FLOATARRAY:
{
LISP array;
gint j;
array = arcons (tc_double_array, values[i].data.d_int32, 0);
for (j = 0; j < values[i].data.d_int32; j++)
{
array->storage_as.double_array.data[j] =
values[i + 1].data.d_floatarray[j];
}
return_val = cons (array, return_val);
}
break;
case GIMP_PDB_STRINGARRAY:
{
LISP array = NIL;
gint j;
for (j = 0; j < values[i].data.d_int32; j++)
{
string = (values[i + 1].data.d_stringarray)[j];
if (string)
{
string_len = strlen (string);
array = cons (strcons (string_len, string), array);
}
else
{
array = cons (strcons (0, ""), array);
}
}
return_val = cons (nreverse (array), return_val);
}
break;
case GIMP_PDB_COLOR:
{
guchar r, g, b;
gimp_rgb_get_uchar (&values[i + 1].data.d_color, &r, &g, &b);
intermediate_val = cons (flocons (r),
cons (flocons (g),
cons (flocons (b),
NIL)));
return_val = cons (intermediate_val, return_val);
break;
}
case GIMP_PDB_REGION:
return my_err ("Regions are currently unsupported as return values", NIL);
break;
case GIMP_PDB_BOUNDARY:
return my_err ("Boundaries are currently unsupported as return values", NIL);
break;
case GIMP_PDB_PARASITE:
{
LISP name, flags, data;
if (values[i + 1].data.d_parasite.name == NULL)
{
return_val = my_err("Error: null parasite", NIL);
}
else
{
string_len = strlen (values[i + 1].data.d_parasite.name);
name = strcons (string_len,
values[i + 1].data.d_parasite.name);
flags = flocons (values[i + 1].data.d_parasite.flags);
data = arcons (tc_byte_array,
values[i + 1].data.d_parasite.size, 0);
memcpy(data->storage_as.string.data,
values[i + 1].data.d_parasite.data,
values[i + 1].data.d_parasite.size);
intermediate_val = cons (name,
cons(flags, cons(data, NIL)));
return_val = cons (intermediate_val, return_val);
}
}
break;
case GIMP_PDB_STATUS:
return my_err ("Procedural database execution returned multiple status values", NIL);
break;
default:
return my_err ("Unknown return type", NIL);
}
}
break;
case GIMP_PDB_PASS_THROUGH:
case GIMP_PDB_CANCEL: /* should we do something here? */
break;
}
/* free the proc name */
g_free (proc_name);
/* free up the executed procedure return values */
gimp_destroy_params (values, nvalues);
/* free up arguments and values */
g_free (args);
/* free the query information */
g_free (proc_blurb);
g_free (proc_help);
g_free (proc_author);
g_free (proc_copyright);
g_free (proc_date);
g_free (params);
g_free (return_vals);
/* reverse the return values */
return_val = nreverse (return_val);
/* if we're in server mode, listen for additional commands for 10 ms */
if (script_fu_server_get_mode ())
script_fu_server_listen (10);
#ifdef GDK_WINDOWING_WIN32
/* This seems to help a lot on Windoze. */
while (gtk_events_pending ())
gtk_main_iteration ();
#endif
return return_val;
}
static LISP
script_fu_register_call (LISP a)
{
if (register_scripts)
return script_fu_add_script (a);
else
return NIL;
}
static LISP
script_fu_menu_register_call (LISP a)
{
if (register_scripts)
return script_fu_add_menu (a);
else
return NIL;
}
static LISP
script_fu_quit_call (LISP a)
{
script_fu_server_quit ();
return NIL;
}