callisto-debian/gimp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

plug-ins/script-fu/tinyscheme/scheme.[ch] make it possible for foreign

Browse Source 
2007-08-31  Simon Budig  <simon@gimp.org>

	* plug-ins/script-fu/tinyscheme/scheme.[ch]
	* plug-ins/script-fu/tinyscheme/scheme-private.h: make it possible
	for foreign functions to return an error.

	* plug-ins/script-fu/script-fu-scripts.c
	* plug-ins/script-fu/scheme-wrapper.c: Make use of this.
	Fixes bug #472026.


svn path=/trunk/; revision=23432
This commit is contained in:
Simon Budig
2007-08-31 19:35:26 +00:00
committed by Simon Budig
parent 95f3ed4984
commit 8d42d089ca
6 changed files with 75 additions and 72 deletions
Download Patch File Download Diff File Expand all files Collapse all files

59
plug-ins/script-fu/script-fu-scripts.c
View File

@ -125,13 +125,6 @@ script_fu_find_scripts (const gchar *path)
script_menu_list = NULL;
}
static pointer
my_err (scheme *sc, char *msg)
{
ts_output_string (TS_OUTPUT_ERROR, msg, -1);
return sc->F;
}
pointer
script_fu_add_script (scheme *sc, pointer a)
{
@ -221,22 +214,22 @@ script_fu_add_script (scheme *sc, pointer a)
if (a != sc->NIL)
{
if (!sc->vptr->is_integer (sc->vptr->pair_car (a)))
return my_err (sc, "script-fu-register: argument types must be integer values");
return foreign_error (sc, "script-fu-register: argument types must be integer values", 0);
script->arg_types[i] = sc->vptr->ivalue (sc->vptr->pair_car (a));
a = sc->vptr->pair_cdr (a);
}
else
return my_err (sc, "script-fu-register: missing type specifier");
return foreign_error (sc, "script-fu-register: missing type specifier", 0);
if (a != sc->NIL)
{
if (!sc->vptr->is_string (sc->vptr->pair_car (a)))
return my_err (sc, "script-fu-register: argument labels must be strings");
return foreign_error (sc, "script-fu-register: argument labels must be strings", 0);
script->arg_labels[i] = g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
a = sc->vptr->pair_cdr (a);
}
else
return my_err (sc, "script-fu-register: missing arguments label");
return foreign_error (sc, "script-fu-register: missing arguments label", 0);
if (a != sc->NIL)
{
@ -249,7 +242,7 @@ script_fu_add_script (scheme *sc, pointer a)
case SF_VECTORS:
case SF_DISPLAY:
if (!sc->vptr->is_integer (sc->vptr->pair_car (a)))
return my_err (sc, "script-fu-register: default IDs must be integer values");
return foreign_error (sc, "script-fu-register: default IDs must be integer values", 0);
script->arg_defaults[i].sfa_image =
sc->vptr->ivalue (sc->vptr->pair_car (a));
script->arg_values[i].sfa_image =
@ -300,7 +293,7 @@ script_fu_add_script (scheme *sc, pointer a)
if (! gimp_rgb_parse_css (&script->arg_defaults[i].sfa_color,
sc->vptr->string_value (sc->vptr->pair_car (a)),
-1))
return my_err (sc, "script-fu-register: invalid default color name");
return foreign_error (sc, "script-fu-register: invalid default color name", 0);
gimp_rgb_set_alpha (&script->arg_defaults[i].sfa_color,
1.0);
}
@ -318,7 +311,7 @@ script_fu_add_script (scheme *sc, pointer a)
}
else
{
return my_err (sc, "script-fu-register: color defaults must be a list of 3 integers or a color name");
return foreign_error (sc, "script-fu-register: color defaults must be a list of 3 integers or a color name", 0);
}
script->arg_values[i].sfa_color = script->arg_defaults[i].sfa_color;
@ -330,7 +323,7 @@ script_fu_add_script (scheme *sc, pointer a)
case SF_TOGGLE:
if (!sc->vptr->is_integer (sc->vptr->pair_car (a)))
return my_err (sc, "script-fu-register: toggle default must be an integer value");
return foreign_error (sc, "script-fu-register: toggle default must be an integer value", 0);
script->arg_defaults[i].sfa_toggle =
(sc->vptr->ivalue (sc->vptr->pair_car (a))) ? TRUE : FALSE;
@ -344,7 +337,7 @@ script_fu_add_script (scheme *sc, pointer a)
case SF_VALUE:
if (!sc->vptr->is_string (sc->vptr->pair_car (a)))
return my_err (sc, "script-fu-register: value defaults must be string values");
return foreign_error (sc, "script-fu-register: value defaults must be string values", 0);
script->arg_defaults[i].sfa_value =
g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
@ -359,7 +352,7 @@ script_fu_add_script (scheme *sc, pointer a)
case SF_STRING:
case SF_TEXT:
if (!sc->vptr->is_string (sc->vptr->pair_car (a)))
return my_err (sc, "script-fu-register: string defaults must be string values");
return foreign_error (sc, "script-fu-register: string defaults must be string values", 0);
script->arg_defaults[i].sfa_value =
g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
@ -373,7 +366,7 @@ script_fu_add_script (scheme *sc, pointer a)
case SF_ADJUSTMENT:
if (!sc->vptr->is_list (sc, a))
return my_err (sc, "script-fu-register: adjustment defaults must be a list");
return foreign_error (sc, "script-fu-register: adjustment defaults must be a list", 0);
adj_list = sc->vptr->pair_car (a);
script->arg_defaults[i].sfa_adjustment.value =
@ -414,12 +407,12 @@ script_fu_add_script (scheme *sc, pointer a)
case SF_FILENAME:
if (!sc->vptr->is_string (sc->vptr->pair_car (a)))
return my_err (sc, "script-fu-register: filename defaults must be string values");
return foreign_error (sc, "script-fu-register: filename defaults must be string values", 0);
/* fallthrough */
case SF_DIRNAME:
if (!sc->vptr->is_string (sc->vptr->pair_car (a)))
return my_err (sc, "script-fu-register: dirname defaults must be string values");
return foreign_error (sc, "script-fu-register: dirname defaults must be string values", 0);
script->arg_defaults[i].sfa_file.filename =
g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
@ -448,7 +441,7 @@ script_fu_add_script (scheme *sc, pointer a)
case SF_FONT:
if (!sc->vptr->is_string (sc->vptr->pair_car (a)))
return my_err (sc, "script-fu-register: font defaults must be string values");
return foreign_error (sc, "script-fu-register: font defaults must be string values", 0);
script->arg_defaults[i].sfa_font =
g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
@ -462,7 +455,7 @@ script_fu_add_script (scheme *sc, pointer a)
case SF_PALETTE:
if (!sc->vptr->is_string (sc->vptr->pair_car (a)))
return my_err (sc, "script-fu-register: palette defaults must be string values");
return foreign_error (sc, "script-fu-register: palette defaults must be string values", 0);
script->arg_defaults[i].sfa_palette =
g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
@ -476,7 +469,7 @@ script_fu_add_script (scheme *sc, pointer a)
case SF_PATTERN:
if (!sc->vptr->is_string (sc->vptr->pair_car (a)))
return my_err (sc, "script-fu-register: pattern defaults must be string values");
return foreign_error (sc, "script-fu-register: pattern defaults must be string values", 0);
script->arg_defaults[i].sfa_pattern =
g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
@ -490,7 +483,7 @@ script_fu_add_script (scheme *sc, pointer a)
case SF_BRUSH:
if (!sc->vptr->is_list (sc, a))
return my_err (sc, "script-fu-register: brush defaults must be a list");
return foreign_error (sc, "script-fu-register: brush defaults must be a list", 0);
brush_list = sc->vptr->pair_car (a);
script->arg_defaults[i].sfa_brush.name =
@ -523,7 +516,7 @@ script_fu_add_script (scheme *sc, pointer a)
case SF_GRADIENT:
if (!sc->vptr->is_string (sc->vptr->pair_car (a)))
return my_err (sc, "script-fu-register: gradient defaults must be string values");
return foreign_error (sc, "script-fu-register: gradient defaults must be string values", 0);
script->arg_defaults[i].sfa_gradient =
g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
@ -537,7 +530,7 @@ script_fu_add_script (scheme *sc, pointer a)
case SF_OPTION:
if (!sc->vptr->is_list (sc, a))
return my_err (sc, "script-fu-register: option defaults must be a list");
return foreign_error (sc, "script-fu-register: option defaults must be a list", 0);
for (option_list = sc->vptr->pair_car (a);
option_list != sc->NIL;
@ -559,11 +552,11 @@ script_fu_add_script (scheme *sc, pointer a)
case SF_ENUM:
if (!sc->vptr->is_list (sc, a))
return my_err (sc, "script-fu-register: enum defaults must be a list");
return foreign_error (sc, "script-fu-register: enum defaults must be a list", 0);
option_list = sc->vptr->pair_car (a);
if (!sc->vptr->is_string (sc->vptr->pair_car (option_list)))
return my_err (sc, "script-fu-register: first element in enum defaults must be a type-name");
return foreign_error (sc, "script-fu-register: first element in enum defaults must be a type-name", 0);
val =
sc->vptr->string_value (sc->vptr->pair_car (option_list));
@ -576,14 +569,14 @@ script_fu_add_script (scheme *sc, pointer a)
if (! G_TYPE_IS_ENUM (enum_type))
{
g_free (val);
return my_err (sc, "script-fu-register: first element in enum defaults must be the name of a registered type");
return foreign_error (sc, "script-fu-register: first element in enum defaults must be the name of a registered type", 0);
}
script->arg_defaults[i].sfa_enum.type_name = val;
option_list = sc->vptr->pair_cdr (option_list);
if (!sc->vptr->is_string (sc->vptr->pair_car (option_list)))
return my_err (sc, "script-fu-register: second element in enum defaults must be a string");
return foreign_error (sc, "script-fu-register: second element in enum defaults must be a string", 0);
enum_value =
g_enum_get_value_by_nick (g_type_class_peek (enum_type),
@ -602,8 +595,7 @@ script_fu_add_script (scheme *sc, pointer a)
}
else
{
return my_err (sc,
"script-fu-register: missing default argument");
return foreign_error (sc, "script-fu-register: missing default argument", 0);
}
}
}
@ -631,8 +623,7 @@ script_fu_add_menu (scheme *sc, pointer a)
/* Check the length of a */
if (sc->vptr->list_length (sc, a) != 2)
return my_err (sc,
"Incorrect number of arguments for script-fu-menu-register");
return foreign_error (sc, "Incorrect number of arguments for script-fu-menu-register", 0);
/* Find the script PDB entry name */
name = sc->vptr->string_value (sc->vptr->pair_car (a));