dnrops
/
gimp
mirror of https://github.com/GNOME/gimp.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Partial fix 5426. Lets old scriptfu script call old name gimp-image-is-valid, 

mapped to new PDB procedure gimp-image-id-is-valid (same signature), for example.

Edit a few comments in new code.

Style changes, no logic change.
This commit is contained in:
bootchk 2021-01-28 09:08:39 -05:00 committed by lloyd konneker
parent 34150ddda7
commit 877d585271
7 changed files with 456 additions and 140 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
plug-ins/script-fu/Makefile.am
View File

@ -81,8 +81,10 @@ script_fu_SOURCES = \
script-fu-server.h \
script-fu-utils.c \
script-fu-utils.h \
script-fu-errors.c \
script-fu-errors.h \
script-fu-errors.c \
script-fu-errors.h \
script-fu-compat.c \
script-fu-compat.h \
scheme-wrapper.c \
scheme-wrapper.h

1
plug-ins/script-fu/meson.build
View File

@ -19,6 +19,7 @@ plugin_sources = [
'script-fu-utils.c',
'script-fu.c',
'script-fu-errors.c',
'script-fu-compat.c'
]
if platform_windows

216
plug-ins/script-fu/scheme-wrapper.c
View File

@ -42,6 +42,7 @@
#include "script-fu-scripts.h"
#include "script-fu-server.h"
#include "script-fu-errors.h"
#include "script-fu-compat.h"
#include "scheme-wrapper.h"
@ -56,11 +57,14 @@ static void ts_init_procedures (scheme *sc,
static void convert_string (gchar *str);
static pointer script_fu_marshal_procedure_call (scheme *sc,
pointer a,
gboolean permissive);
gboolean permissive,
gboolean deprecated);
static pointer script_fu_marshal_procedure_call_strict (scheme *sc,
pointer a);
static pointer script_fu_marshal_procedure_call_permissive (scheme *sc,
pointer a);
static pointer script_fu_marshal_procedure_call_deprecated (scheme *sc,
pointer a);
static pointer script_fu_register_call (scheme *sc,
pointer a);
@ -431,20 +435,26 @@ ts_init_procedures (scheme *sc,
sc->vptr->mk_foreign_func (sc, script_fu_quit_call));
sc->vptr->setimmutable (symbol);
/* register the database execution procedure */
/* register normal database execution procedure */
symbol = sc->vptr->mk_symbol (sc, "gimp-proc-db-call");
sc->vptr->scheme_define (sc, sc->global_env, symbol,
sc->vptr->mk_foreign_func (sc,
script_fu_marshal_procedure_call_strict));
sc->vptr->setimmutable (symbol);
/* register the internal database execution procedure; see comment below */
/* register permissive and deprecated db execution procedure; see comment below */
symbol = sc->vptr->mk_symbol (sc, "-gimp-proc-db-call");
sc->vptr->scheme_define (sc, sc->global_env, symbol,
sc->vptr->mk_foreign_func (sc,
script_fu_marshal_procedure_call_permissive));
sc->vptr->setimmutable (symbol);
symbol = sc->vptr->mk_symbol (sc, "--gimp-proc-db-call");
sc->vptr->scheme_define (sc, sc->global_env, symbol,
sc->vptr->mk_foreign_func (sc,
script_fu_marshal_procedure_call_deprecated));
sc->vptr->setimmutable (symbol);
proc_list = gimp_pdb_query_procedures (gimp_get_pdb (),
".*", ".*", ".*", ".*",
".*", ".*", ".*", ".*",
@ -474,6 +484,11 @@ ts_init_procedures (scheme *sc,
}
g_strfreev (proc_list);
/* Register more scheme funcs that call PDB procedures, for compatibility
* This can overwrite earlier scheme func definitions.
*/
define_compat_procs (sc);
}
static gboolean
@ -514,7 +529,8 @@ convert_string (gchar *str)
static pointer
script_fu_marshal_procedure_call (scheme *sc,
pointer a,
gboolean permissive)
gboolean permissive,
gboolean deprecated)
{
GimpProcedure *procedure;
GimpValueArray *args;
@ -532,9 +548,10 @@ script_fu_marshal_procedure_call (scheme *sc,
if (a == sc->NIL)
/* Some ScriptFu function is calling this incorrectly. */
return implementation_error (sc,
"Procedure argument marshaller was called with no arguments. "
"The procedure to be executed and the arguments it requires "
"(possibly none) must be specified.", 0);
"Procedure argument marshaller was called with no arguments. "
"The procedure to be executed and the arguments it requires "
"(possibly none) must be specified.",
0);
/* The PDB procedure name is the argument or first argument of the list */
if (sc->vptr->is_pair (a))
@ -545,6 +562,11 @@ script_fu_marshal_procedure_call (scheme *sc,
g_debug ("proc name: %s", proc_name);
g_debug ("parms rcvd: %d", sc->vptr->list_length (sc, a)-1);
if (deprecated )
g_warning ("PDB procedure name %s is deprecated, please use %s.",
deprecated_name_for (proc_name),
proc_name);
/* report the current command */
script_fu_interface_report_cc (proc_name);
@ -555,20 +577,49 @@ script_fu_marshal_procedure_call (scheme *sc,
{
g_snprintf (error_str, sizeof (error_str),
"Invalid procedure name: %s", proc_name);
return script_error(sc, error_str, 0);
return script_error (sc, error_str, 0);
}
arg_specs = gimp_procedure_get_arguments (procedure, &n_arg_specs);
/* Check the supplied number of arguments */
if ((n_arg_specs > 0 || ! permissive) &&
(sc->vptr->list_length (sc, a) - 1) != n_arg_specs)
{
g_snprintf (error_str, sizeof (error_str),
"in script, wrong number of arguments for %s (expected %d but received %d)",
proc_name, n_arg_specs, (sc->vptr->list_length (sc, a) - 1));
return script_error(sc, error_str, 0);
}
{
int actual_arg_count = sc->vptr->list_length (sc, a) - 1;
if (n_arg_specs == 0)
{
if (actual_arg_count > 0 )
{
if (permissive)
{
/* Warn but permit extra args to a procedure that takes zero args (nullary)
* Deprecated behaviour, may go away.
*/
g_warning ("in script, permitting too many args to %s", proc_name);
}
else
{
g_snprintf (error_str, sizeof (error_str),
"in script, arguments passed to %s which takes no arguments",
proc_name);
return script_error (sc, error_str, 0);
}
}
/* else both actual and formal counts zero */
}
else /* formal arg count > 0 */
{
if ( actual_arg_count != n_arg_specs)
{
/* Not permitted. We don't say whether too few or too many. */
g_snprintf (error_str, sizeof (error_str),
"in script, wrong number of arguments for %s (expected %d but received %d)",
proc_name, n_arg_specs, actual_arg_count);
return script_error (sc, error_str, 0);
}
/* else matching counts of args. */
}
}
/* Marshall the supplied arguments */
args = gimp_value_array_new (n_arg_specs);
@ -585,60 +636,60 @@ script_fu_marshal_procedure_call (scheme *sc,
g_value_init (&value, G_PARAM_SPEC_VALUE_TYPE (arg_spec));
debug_in_arg(sc, a, i, g_type_name (G_VALUE_TYPE (&value)));
debug_in_arg (sc, a, i, g_type_name (G_VALUE_TYPE (&value)));
if (G_VALUE_HOLDS_INT (&value))
{
if (! sc->vptr->is_number (sc->vptr->pair_car (a)))
return script_type_error(sc, "numeric", i, proc_name);
return script_type_error (sc, "numeric", i, proc_name);
else
g_value_set_int (&value,
sc->vptr->ivalue (sc->vptr->pair_car (a)));
sc->vptr->ivalue (sc->vptr->pair_car (a)));
}
else if (G_VALUE_HOLDS_UINT (&value))
{
if (! sc->vptr->is_number (sc->vptr->pair_car (a)))
return script_type_error(sc, "numeric", i, proc_name);
return script_type_error (sc, "numeric", i, proc_name);
else
g_value_set_uint (&value,
sc->vptr->ivalue (sc->vptr->pair_car (a)));
sc->vptr->ivalue (sc->vptr->pair_car (a)));
}
else if (G_VALUE_HOLDS_UCHAR (&value))
{
if (! sc->vptr->is_number (sc->vptr->pair_car (a)))
return script_type_error(sc, "numeric", i, proc_name);
return script_type_error (sc, "numeric", i, proc_name);
else
g_value_set_uchar (&value,
sc->vptr->ivalue (sc->vptr->pair_car (a)));
sc->vptr->ivalue (sc->vptr->pair_car (a)));
}
else if (G_VALUE_HOLDS_DOUBLE (&value))
{
if (! sc->vptr->is_number (sc->vptr->pair_car (a)))
return script_type_error(sc, "numeric", i, proc_name);
return script_type_error (sc, "numeric", i, proc_name);
else
g_value_set_double (&value,
sc->vptr->rvalue (sc->vptr->pair_car (a)));
sc->vptr->rvalue (sc->vptr->pair_car (a)));
}
else if (G_VALUE_HOLDS_ENUM (&value))
{
if (! sc->vptr->is_number (sc->vptr->pair_car (a)))
return script_type_error(sc, "numeric", i, proc_name);
return script_type_error (sc, "numeric", i, proc_name);
else
g_value_set_enum (&value,
sc->vptr->ivalue (sc->vptr->pair_car (a)));
sc->vptr->ivalue (sc->vptr->pair_car (a)));
}
else if (G_VALUE_HOLDS_BOOLEAN (&value))
{
if (! sc->vptr->is_number (sc->vptr->pair_car (a)))
return script_type_error(sc, "numeric", i, proc_name);
return script_type_error (sc, "numeric", i, proc_name);
else
g_value_set_boolean (&value,
sc->vptr->ivalue (sc->vptr->pair_car (a)));
sc->vptr->ivalue (sc->vptr->pair_car (a)));
}
else if (G_VALUE_HOLDS_STRING (&value))
{
if (! sc->vptr->is_string (sc->vptr->pair_car (a)))
return script_type_error(sc, "string", i, proc_name);
return script_type_error (sc, "string", i, proc_name);
else
g_value_set_string (&value,
sc->vptr->string_value (sc->vptr->pair_car (a)));
@ -646,7 +697,7 @@ script_fu_marshal_procedure_call (scheme *sc,
else if (GIMP_VALUE_HOLDS_DISPLAY (&value))
{
if (! sc->vptr->is_number (sc->vptr->pair_car (a)))
return script_type_error(sc, "numeric", i, proc_name);
return script_type_error (sc, "numeric", i, proc_name);
else
{
GimpDisplay *display =
@ -658,7 +709,7 @@ script_fu_marshal_procedure_call (scheme *sc,
else if (GIMP_VALUE_HOLDS_IMAGE (&value))
{
if (! sc->vptr->is_number (sc->vptr->pair_car (a)))
return script_type_error(sc, "numeric", i, proc_name);
return script_type_error (sc, "numeric", i, proc_name);
else
{
GimpImage *image =
@ -670,7 +721,7 @@ script_fu_marshal_procedure_call (scheme *sc,
else if (GIMP_VALUE_HOLDS_LAYER (&value))
{
if (! sc->vptr->is_number (sc->vptr->pair_car (a)))
return script_type_error(sc, "numeric", i, proc_name);
return script_type_error (sc, "numeric", i, proc_name);
else
{
GimpLayer *layer =
@ -682,7 +733,7 @@ script_fu_marshal_procedure_call (scheme *sc,
else if (GIMP_VALUE_HOLDS_LAYER_MASK (&value))
{
if (! sc->vptr->is_number (sc->vptr->pair_car (a)))
return script_type_error(sc, "numeric", i, proc_name);
return script_type_error (sc, "numeric", i, proc_name);
else
{
GimpLayerMask *layer_mask =
@ -694,7 +745,7 @@ script_fu_marshal_procedure_call (scheme *sc,
else if (GIMP_VALUE_HOLDS_CHANNEL (&value))
{
if (! sc->vptr->is_number (sc->vptr->pair_car (a)))
return script_type_error(sc, "numeric", i, proc_name);
return script_type_error (sc, "numeric", i, proc_name);
else
{
GimpChannel *channel =
@ -706,7 +757,7 @@ script_fu_marshal_procedure_call (scheme *sc,
else if (GIMP_VALUE_HOLDS_DRAWABLE (&value))
{
if (! sc->vptr->is_number (sc->vptr->pair_car (a)))
return script_type_error(sc, "numeric", i, proc_name);
return script_type_error (sc, "numeric", i, proc_name);
else
{
GimpDrawable *drawable =
@ -718,7 +769,7 @@ script_fu_marshal_procedure_call (scheme *sc,
else if (GIMP_VALUE_HOLDS_VECTORS (&value))
{
if (! sc->vptr->is_number (sc->vptr->pair_car (a)))
return script_type_error(sc, "numeric", i, proc_name);
return script_type_error (sc, "numeric", i, proc_name);
else
{
GimpVectors *vectors =
@ -730,7 +781,7 @@ script_fu_marshal_procedure_call (scheme *sc,
else if (GIMP_VALUE_HOLDS_ITEM (&value))
{
if (! sc->vptr->is_number (sc->vptr->pair_car (a)))
return script_type_error(sc, "numeric", i, proc_name);
return script_type_error (sc, "numeric", i, proc_name);
else
{
GimpItem *item =
@ -743,7 +794,7 @@ script_fu_marshal_procedure_call (scheme *sc,
{
vector = sc->vptr->pair_car (a);
if (! sc->vptr->is_vector (vector))
return script_type_error(sc, "vector", i, proc_name);
return script_type_error (sc, "vector", i, proc_name);
else
{
/* !!! Comments applying to all array args.
@ -770,7 +821,7 @@ script_fu_marshal_procedure_call (scheme *sc,
n_elements = GIMP_VALUES_GET_INT (args, i - 1);
if (n_elements > sc->vptr->vector_length (vector))
return script_length_error_in_vector(sc, i, proc_name, n_elements, vector);
return script_length_error_in_vector (sc, i, proc_name, n_elements, vector);
array = g_new0 (gint32, n_elements);
@ -782,8 +833,7 @@ script_fu_marshal_procedure_call (scheme *sc,
if (! sc->vptr->is_number (v_element))
{
g_free (array);
return script_type_error_in_container(sc,
"numeric", i, j, proc_name, vector);
return script_type_error_in_container (sc, "numeric", i, j, proc_name, vector);
}
array[j] = (gint32) sc->vptr->ivalue (v_element);
@ -791,14 +841,14 @@ script_fu_marshal_procedure_call (scheme *sc,
gimp_value_take_int32_array (&value, array, n_elements);
debug_vector(sc, vector, "%ld");
debug_vector (sc, vector, "%ld");
}
}
else if (GIMP_VALUE_HOLDS_UINT8_ARRAY (&value))
{
vector = sc->vptr->pair_car (a);
if (! sc->vptr->is_vector (vector))
return script_type_error(sc, "vector", i, proc_name);
return script_type_error (sc, "vector", i, proc_name);
else
{
guint8 *array;
@ -806,7 +856,7 @@ script_fu_marshal_procedure_call (scheme *sc,
n_elements = GIMP_VALUES_GET_INT (args, i - 1);
if (n_elements > sc->vptr->vector_length (vector))
return script_length_error_in_vector(sc, i, proc_name, n_elements, vector);
return script_length_error_in_vector (sc, i, proc_name, n_elements, vector);
array = g_new0 (guint8, n_elements);
@ -817,7 +867,7 @@ script_fu_marshal_procedure_call (scheme *sc,
if (!sc->vptr->is_number (v_element))
{
g_free (array);
return script_type_error_in_container(sc, "numeric", i, j, proc_name, vector);
return script_type_error_in_container (sc, "numeric", i, j, proc_name, vector);
}
array[j] = (guint8) sc->vptr->ivalue (v_element);
@ -825,14 +875,14 @@ script_fu_marshal_procedure_call (scheme *sc,
gimp_value_take_uint8_array (&value, array, n_elements);
debug_vector(sc, vector, "%ld");
debug_vector (sc, vector, "%ld");
}
}
else if (GIMP_VALUE_HOLDS_FLOAT_ARRAY (&value))
{
vector = sc->vptr->pair_car (a);
if (! sc->vptr->is_vector (vector))
return script_type_error(sc, "vector", i, proc_name);
return script_type_error (sc, "vector", i, proc_name);
else
{
gdouble *array;
@ -840,7 +890,7 @@ script_fu_marshal_procedure_call (scheme *sc,
n_elements = GIMP_VALUES_GET_INT (args, i - 1);
if (n_elements > sc->vptr->vector_length (vector))
return script_length_error_in_vector(sc, i, proc_name, n_elements, vector);
return script_length_error_in_vector (sc, i, proc_name, n_elements, vector);
array = g_new0 (gdouble, n_elements);
@ -851,7 +901,7 @@ script_fu_marshal_procedure_call (scheme *sc,
if (!sc->vptr->is_number (v_element))
{
g_free (array);
return script_type_error_in_container(sc, "numeric", i, j, proc_name, vector);
return script_type_error_in_container (sc, "numeric", i, j, proc_name, vector);
}
array[j] = (gfloat) sc->vptr->rvalue (v_element);
@ -859,7 +909,7 @@ script_fu_marshal_procedure_call (scheme *sc,
gimp_value_take_float_array (&value, array, n_elements);
debug_vector(sc, vector, "%f");
debug_vector (sc, vector, "%f");
}
}
else if (GIMP_VALUE_HOLDS_STRING_ARRAY (&value))
@ -867,7 +917,7 @@ script_fu_marshal_procedure_call (scheme *sc,
/* !!!! "vector" is-a list and has different methods than is-a vector */
vector = sc->vptr->pair_car (a);
if (! sc->vptr->is_list (sc, vector))
return script_type_error(sc, "list", i, proc_name);
return script_type_error (sc, "list", i, proc_name);
else
{
gchar **array;
@ -895,8 +945,7 @@ script_fu_marshal_procedure_call (scheme *sc,
g_strfreev (array);
/* is-a list, but can use script_type_error_in_container */
/* Pass remaining suffix of original list to err msg */
return script_type_error_in_container (sc,
"string", i, j, proc_name, vector);
return script_type_error_in_container (sc, "string", i, j, proc_name, vector);
}
array[j] = g_strdup (sc->vptr->string_value (v_element));
@ -911,7 +960,7 @@ script_fu_marshal_procedure_call (scheme *sc,
* Since we already advanced pointer "vector" into the list,
* pass a new pointer to the list.
*/
debug_list(sc, sc->vptr->pair_car (a), "\"%s\"", n_elements);
debug_list (sc, sc->vptr->pair_car (a), "\"%s\"", n_elements);
}
}
else if (GIMP_VALUE_HOLDS_RGB (&value))
@ -923,7 +972,7 @@ script_fu_marshal_procedure_call (scheme *sc,
if (! gimp_rgb_parse_css (&color,
sc->vptr->string_value (sc->vptr->pair_car (a)),
-1))
return script_type_error(sc, "color string", i, proc_name);
return script_type_error (sc, "color string", i, proc_name);
gimp_rgb_set_alpha (&color, 1.0);
g_debug ("(%s)", sc->vptr->string_value (sc->vptr->pair_car (a)));
@ -955,21 +1004,20 @@ script_fu_marshal_procedure_call (scheme *sc,
b = CLAMP (sc->vptr->ivalue (sc->vptr->pair_car (color_list)),
0, 255);
else
return script_type_error_in_container (
sc, "numeric", i, 2, proc_name, 0);
return script_type_error_in_container (sc, "numeric", i, 2, proc_name, 0);
gimp_rgba_set_uchar (&color, r, g, b, 255);
gimp_value_set_rgb (&value, &color);
g_debug ("(%d %d %d)", r, g, b);
}
else
return script_type_error(sc, "color string or list", i, proc_name);
return script_type_error (sc, "color string or list", i, proc_name);
}
else if (GIMP_VALUE_HOLDS_RGB_ARRAY (&value))
{
vector = sc->vptr->pair_car (a);
if (! sc->vptr->is_vector (vector))
return script_type_error(sc, "vector", i, proc_name);
return script_type_error (sc, "vector", i, proc_name);
else
{
GimpRGB *array;
@ -977,8 +1025,7 @@ script_fu_marshal_procedure_call (scheme *sc,
n_elements = GIMP_VALUES_GET_INT (args, i - 1);
if (n_elements > sc->vptr->vector_length (vector))
return script_length_error_in_vector(
sc, i, proc_name, n_elements, vector);
return script_length_error_in_vector (sc, i, proc_name, n_elements, vector);
array = g_new0 (GimpRGB, n_elements);
@ -1023,7 +1070,7 @@ script_fu_marshal_procedure_call (scheme *sc,
{
if (! sc->vptr->is_list (sc, sc->vptr->pair_car (a)) ||
sc->vptr->list_length (sc, sc->vptr->pair_car (a)) != 3)
return script_type_error(sc, "list", i, proc_name);
return script_type_error (sc, "list", i, proc_name);
else
{
GimpParasite parasite;
@ -1033,8 +1080,7 @@ script_fu_marshal_procedure_call (scheme *sc,
temp_val = sc->vptr->pair_car (a);
if (! sc->vptr->is_string (sc->vptr->pair_car (temp_val)))
return script_type_error_in_container(
sc, "string", i, 0, proc_name, 0);
return script_type_error_in_container (sc, "string", i, 0, proc_name, 0);
parasite.name =
sc->vptr->string_value (sc->vptr->pair_car (temp_val));
@ -1044,8 +1090,7 @@ script_fu_marshal_procedure_call (scheme *sc,
temp_val = sc->vptr->pair_cdr (temp_val);
if (! sc->vptr->is_number (sc->vptr->pair_car (temp_val)))
return script_type_error_in_container(
sc, "numeric", i, 1, proc_name, 0);
return script_type_error_in_container (sc, "numeric", i, 1, proc_name, 0);
parasite.flags =
sc->vptr->ivalue (sc->vptr->pair_car (temp_val));
@ -1055,7 +1100,7 @@ script_fu_marshal_procedure_call (scheme *sc,
temp_val = sc->vptr->pair_cdr (temp_val);
if (!sc->vptr->is_string (sc->vptr->pair_car (temp_val)))
return script_type_error_in_container(
return script_type_error_in_container (
sc, "string", i, 2, proc_name, 0);
parasite.data =
@ -1072,8 +1117,8 @@ script_fu_marshal_procedure_call (scheme *sc,
{
/* A PDB procedure signature wrongly requires a status. */
return implementation_error (sc,
"Status is for return types, not arguments",
sc->vptr->pair_car (a));
"Status is for return types, not arguments",
sc->vptr->pair_car (a));
}
else
{
@ -1082,7 +1127,7 @@ script_fu_marshal_procedure_call (scheme *sc,
i+1, proc_name, g_type_name (G_VALUE_TYPE (&value)));
return implementation_error (sc, error_str, 0);
}
debug_gvalue(&value);
debug_gvalue (&value);
gimp_value_array_append (args, &value);
g_value_unset (&value);
}
@ -1168,16 +1213,25 @@ script_fu_marshal_procedure_call (scheme *sc,
GValue *value = gimp_value_array_index (values, i + 1);
gint j;
g_debug("Return value %d is type %s", i+1, G_VALUE_TYPE_NAME (value));
g_debug ("Return value %d is type %s", i+1, G_VALUE_TYPE_NAME (value));
if (G_VALUE_HOLDS_OBJECT (value))
{
GObject *object = g_value_get_object (value);
gint id = -1;
/* expect a GIMP opaque object having an "id" property */
if (object)
g_object_get (object, "id", &id, NULL);
/* id is -1 when the gvalue had no GObject*,
* or the referenced object had no property "id".
* This can be an undetected fault in the called procedure.
* But it is not an error in the script.
*/
g_debug ("PDB procedure returned object ID: %i", id);
/* Scriptfu stores object IDs as int. */
return_val = sc->vptr->cons (sc, sc->vptr->mk_integer (sc, id),
return_val);
}
@ -1397,7 +1451,7 @@ script_fu_marshal_procedure_call (scheme *sc,
case GIMP_PDB_PASS_THROUGH:
case GIMP_PDB_CANCEL: /* should we do something here? */
g_debug("Status is PASS_THROUGH or CANCEL");
g_debug ("Status is PASS_THROUGH or CANCEL");
break;
}
@ -1406,11 +1460,16 @@ script_fu_marshal_procedure_call (scheme *sc,
*/
if (return_val == sc->NIL)
{
g_debug ("returning with only a status result");
if (GIMP_VALUES_GET_ENUM (values, 0) == GIMP_PDB_SUCCESS)
return_val = sc->vptr->cons (sc, sc->T, sc->NIL);
else
return_val = sc->vptr->cons (sc, sc->F, sc->NIL);
}
else
{
g_debug ("returning with non-empty result");
}
g_free (proc_name);
@ -1437,14 +1496,21 @@ static pointer
script_fu_marshal_procedure_call_strict (scheme *sc,
pointer a)
{
return script_fu_marshal_procedure_call (sc, a, FALSE);
return script_fu_marshal_procedure_call (sc, a, FALSE, FALSE);
}
static pointer
script_fu_marshal_procedure_call_permissive (scheme *sc,
pointer a)
{
return script_fu_marshal_procedure_call (sc, a, TRUE);
return script_fu_marshal_procedure_call (sc, a, TRUE, FALSE);
}
static pointer
script_fu_marshal_procedure_call_deprecated (scheme *sc,
pointer a)
{
return script_fu_marshal_procedure_call (sc, a, TRUE, TRUE);
}
static pointer

211
plug-ins/script-fu/script-fu-compat.c Normal file
View File

@ -0,0 +1,211 @@
/* GIMP - The GNU 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 3 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, see <https://www.gnu.org/licenses/>.
*/
#include "config.h"
#include "tinyscheme/scheme-private.h"
#include "script-fu-compat.h"
/*
* Make some PDB procedure names deprecated in ScriptFu.
* Until such time as we turn deprecation off and make them obsolete.
*
* This only makes them deprecated in ScriptFu.
*/
/* private */
static const struct
{
const gchar *old_name;
const gchar *new_name;
}
compat_procs[] =
{
/*
* deprecations since 2.99
*
* With respect to ScriptFu,
* the old names are *obsolete in the PDB* (as of this writing.)
* That is, they don't exist in the PDB with the same signature.
* There is no "compatibility" procedure in the PDB.
*
* With respect to Python using GI, some old names are *NOT* obsolete.
* (Where "some" means those dealing with ID.)
* I.E. Gimp.Image.is_valid() exists but takes a GObject *, not an int ID.
*
* Original data was constructed more or less by hand, partially automated.
*/
{ "gimp-brightness-contrast" , "gimp-drawable-brightness-contrast" },
{ "gimp-brushes-get-brush" , "gimp-context-get-brush" },
{ "gimp-drawable-is-channel" , "gimp-item-id-is-channel" },
{ "gimp-drawable-is-layer" , "gimp-item-id-is-layer" },
{ "gimp-drawable-is-layer-mask" , "gimp-item-id-is-layer-mask" },
{ "gimp-drawable-is-text-layer" , "gimp-item-id-is-text-layer" },
{ "gimp-drawable-is-valid" , "gimp-item-id-is-valid" },
{ "gimp-drawable-transform-2d" , "gimp-item-transform-2d" },
{ "gimp-drawable-transform-flip" , "gimp-item-transform-flip" },
{ "gimp-drawable-transform-flip-simple" , "gimp-item-transform-flip-simple" },
{ "gimp-drawable-transform-matrix" , "gimp-item-transform-matrix" },
{ "gimp-drawable-transform-perspective" , "gimp-item-transform-perspective" },
{ "gimp-drawable-transform-rotate" , "gimp-item-transform-rotate" },
{ "gimp-drawable-transform-rotate-simple" , "gimp-item-transform-rotate-simple" },
{ "gimp-drawable-transform-scale" , "gimp-item-transform-scale" },
{ "gimp-drawable-transform-shear" , "gimp-item-transform-shear" },
{ "gimp-display-is-valid" , "gimp-display-id-is-valid" },
{ "gimp-image-is-valid" , "gimp-image-id-is-valid" },
{ "gimp-item-is-channel" , "gimp-item-id-is-channel" },
{ "gimp-item-is-drawable" , "gimp-item-id-is-drawable" },
{ "gimp-item-is-layer" , "gimp-item-id-is-layer" },
{ "gimp-item-is-layer-mask" , "gimp-item-id-is-layer-mask" },
{ "gimp-item-is-selection" , "gimp-item-id-is-selection" },
{ "gimp-item-is-text-layer" , "gimp-item-id-is-text-layer" },
{ "gimp-item-is-valid" , "gimp-item-id-is-valid" },
{ "gimp-item-is-vectors" , "gimp-item-id-is-vectors" },
{ "gimp-procedural-db-dump" , "gimp-pdb-dump" },
{ "gimp-procedural-db-get-data" , "gimp-pdb-get-data" },
{ "gimp-procedural-db-set-data" , "gimp-pdb-set-data" },
{ "gimp-procedural-db-get-data-size" , "gimp-pdb-get-data-size" },
{ "gimp-procedural-db-proc-arg" , "gimp-pdb-get-proc-argument" },
{ "gimp-procedural-db-proc-info" , "gimp-pdb-get-proc-info" },
{ "gimp-procedural-db-proc-val" , "gimp-pdb-get-proc-return-value" },
{ "gimp-procedural-db-proc-exists" , "gimp-pdb-proc-exists" },
{ "gimp-procedural-db-query" , "gimp-pdb-query" },
{ "gimp-procedural-db-temp-name" , "gimp-pdb-temp-name" },
{ "gimp-image-get-exported-uri" , "gimp-image-get-exported-file" },
{ "gimp-image-get-imported-uri" , "gimp-image-get-imported-file" },
{ "gimp-image-get-xcf-uri" , "gimp-image-get-xcf-file" },
{ "gimp-image-get-filename" , "gimp-image-get-file" },
{ "gimp-image-set-filename" , "gimp-image-set-file" },
{ "gimp-plugin-menu-register" , "gimp-pdb-add-proc-menu-path" },
{ "gimp-plugin-domain-register" , "gimp-plug-in-domain-register" },
{ "gimp-plugin-get-pdb-error-handler" , "gimp-plug-in-get-pdb-error-handler" },
{ "gimp-plugin-help-register" , "gimp-plug-in-help-register" },
{ "gimp-plugin-menu-branch-register" , "gimp-plug-in-menu-branch-register" },
{ "gimp-plugin-set-pdb-error-handler" , "gimp-plug-in-set-pdb-error-handler" },
{ "gimp-plugins-query" , "gimp-plug-ins-query" },
{ "file-gtm-save" , "file-html-table-save" },
{ "python-fu-histogram-export" , "histogram-export" },
{ "python-fu-gradient-save-as-css" , "gradient-save-as-css" }
};
static gchar *empty_string = "";
static void
define_deprecated_scheme_func (const char *old_name,
const char *new_name,
const scheme *sc)
{
gchar *buff;
/* Creates a definition in Scheme of a function that calls a PDB procedure.
*
* The magic below that makes it deprecated:
* - the "--gimp-proc-db-call"
* - defining under the old_name but calling the new_name
* See scheme-wrapper.c, where this was copied from.
* But here creates scheme definition of old_name
* that calls a PDB procedure of a different name, new_name.
*
* As functional programming is: eval(define(apply f)).
* load_string is more typically called eval().
*/
buff = g_strdup_printf (" (define (%s . args)"
" (apply --gimp-proc-db-call \"%s\" args))",
old_name, new_name);
sc->vptr->load_string (sc, buff);
g_free (buff);
}
/* public functions */
/* Define Scheme functions whose name is old name
* that call compatible PDB procedures whose name is new name.
* Define into the lisp machine.
* Compatible means: signature same, semantics same.
* The new names are not "compatibility" procedures, they are the new procedures.
*
* This can overwrite existing definitions in the lisp machine.
* If the PDB has the old name already
* (if a compatibility procedure is defined in the PDB
* or the old name exists with a different signature)
* and ScriptFu already defined functions for procedures of the PDB,
* this will overwrite the ScriptFu definition,
* but produce the same overall effect.
* The definition here will not call the old name PDB procedure,
* but from ScriptFu call the new name PDB procedure.
*/
void
define_compat_procs (scheme *sc)
{
gint i;
for (i = 0; i < G_N_ELEMENTS (compat_procs); i++)
{
define_deprecated_scheme_func (compat_procs[i].old_name,
compat_procs[i].new_name,
sc);
}
}
/* Return empty string or old_name */
/* Used for a warning message */
const gchar *
deprecated_name_for (const char *new_name)
{
gint i;
const gchar * result = empty_string;
/* search values of dictionary/map. */
for (i = 0; i < G_N_ELEMENTS (compat_procs); i++)
{
if (strcmp (compat_procs[i].new_name, new_name) == 0)
{
result = compat_procs[i].old_name;
break;
}
}
return result;
}
/* Not used.
* Keep for future implementation: catch "undefined symbol" from lisp machine.
*/
gboolean
is_deprecated (const char *old_name)
{
gint i;
gboolean result = FALSE;
/* search keys of dictionary/map. */
for (i = 0; i < G_N_ELEMENTS (compat_procs); i++)
{
if (strcmp (compat_procs[i].old_name, old_name) == 0)
{
result = TRUE;
break;
}
}
return result;
}

27
plug-ins/script-fu/script-fu-compat.h Normal file
View File

@ -0,0 +1,27 @@
/* GIMP - The GNU 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 3 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, see <https://www.gnu.org/licenses/>.
*/
#ifndef __SCRIPT_FU_COMPAT_H__
#define __SCRIPT_FU_COMPAT_H__
void define_compat_procs (scheme *sc);
gboolean is_deprecated (const char *old_name);
const gchar * deprecated_name_for (const char *new_name);
#endif /* __SCRIPT_FU_COMPAT_H__ */

93
plug-ins/script-fu/script-fu-errors.c
View File

@ -61,7 +61,9 @@
* Returns a value which the caller must return to its caller.
*/
pointer
script_error (scheme *sc, const gchar *error_message, const pointer a)
script_error (scheme *sc,
const gchar *error_message,
const pointer a)
{
/* Logs to domain "scriptfu" since G_LOG_DOMAIN is set to that. */
g_debug ("%s", error_message);
@ -78,30 +80,30 @@ script_error (scheme *sc, const gchar *error_message, const pointer a)
/* Arg has wrong type. */
pointer
script_type_error (scheme *sc,
const gchar *expected_type,
const guint arg_index,
const gchar * proc_name)
script_type_error (scheme *sc,
const gchar *expected_type,
const guint arg_index,
const gchar *proc_name)
{
gchar error_message[1024];
gchar error_message[1024];
g_snprintf (error_message, sizeof (error_message),
"in script, expected type: %s for argument %d to %s ",
expected_type, arg_index+1, proc_name );
return script_error(sc, error_message, 0);
return script_error (sc, error_message, 0);
}
/* Arg is container (list or vector) having an element of wrong type. */
pointer
script_type_error_in_container (scheme *sc,
const gchar *expected_type,
const guint arg_index,
const guint element_index,
const gchar *proc_name,
const pointer container)
script_type_error_in_container (scheme *sc,
const gchar *expected_type,
const guint arg_index,
const guint element_index,
const gchar *proc_name,
const pointer container)
{
gchar error_message[1024];
gchar error_message[1024];
/* convert zero based indices to ordinals */
g_snprintf (error_message, sizeof (error_message),
@ -109,18 +111,18 @@ script_type_error_in_container (scheme *sc,
expected_type, element_index+1, arg_index+1, proc_name );
/* pass container to foreign_error */
return script_error(sc, error_message, container);
return script_error (sc, error_message, container);
}
/* Arg is vector of wrong length. !!! Arg is not a list. */
pointer script_length_error_in_vector (
scheme *sc,
const guint arg_index,
const gchar *proc_name,
const guint expected_length,
const pointer vector)
pointer
script_length_error_in_vector (scheme *sc,
const guint arg_index,
const gchar *proc_name,
const guint expected_length,
const pointer vector)
{
gchar error_message[1024];
gchar error_message[1024];
/* vector_length returns signed long (???) but expected_length is unsigned */
g_snprintf (error_message, sizeof (error_message),
@ -130,7 +132,7 @@ pointer script_length_error_in_vector (
sc->vptr->vector_length (vector), expected_length);
/* not pass vector to foreign_error */
return script_error(sc, error_message, 0);
return script_error (sc, error_message, 0);
}
@ -139,7 +141,8 @@ pointer script_length_error_in_vector (
* Names a kind of error: in ScriptFu code, or in external code.
* Same as script_error, but FUTURE distinguish the message with a prefix.
*/
pointer implementation_error (scheme *sc,
pointer
implementation_error (scheme *sc,
const gchar *error_message,
const pointer a)
{
@ -154,15 +157,19 @@ pointer implementation_error (scheme *sc,
* Or conditionally compile.
*/
void debug_vector(scheme *sc, const pointer vector, const char *format)
void
debug_vector (scheme *sc,
const pointer vector,
const char *format)
{
glong count = sc->vptr->vector_length (vector);
g_debug ("vector has %ld elements", count);
if (count > 0)
{
for (int j = 0; j < count; ++j)
{
if (strcmp(format, "%f")==0)
if (strcmp (format, "%f")==0)
/* real i.e. float */
g_debug (format,
sc->vptr->rvalue ( sc->vptr->vector_elem (vector, j) ));
@ -182,20 +189,22 @@ void debug_vector(scheme *sc, const pointer vector, const char *format)
*
* !!! Only for lists of strings.
*/
void debug_list(scheme *sc,
pointer list,
const char *format,
const guint num_elements)
void
debug_list (scheme *sc,
pointer list,
const char *format,
const guint num_elements)
{
g_return_if_fail(num_elements == sc->vptr->list_length (sc, list));
g_return_if_fail (num_elements == sc->vptr->list_length (sc, list));
g_debug ("list has %d elements", num_elements);
if (num_elements > 0)
{
for (int j = 0; j < num_elements; ++j)
{
pointer v_element = sc->vptr->pair_car (list);
g_debug (format,
sc->vptr->string_value ( v_element ));
sc->vptr->string_value ( v_element ));
list = sc->vptr->pair_cdr (list);
}
}
@ -205,24 +214,26 @@ void debug_list(scheme *sc,
* Log types of formal and actual args.
* Scheme type names, and enum of actual type.
*/
void debug_in_arg(scheme *sc,
const pointer a,
const guint arg_index,
const gchar *type_name )
void
debug_in_arg (scheme *sc,
const pointer a,
const guint arg_index,
const gchar *type_name )
{
g_debug ("param %d - expecting type %s", arg_index + 1, type_name );
g_debug ("actual arg is type %s (%d)",
ts_types[ type(sc->vptr->pair_car (a)) ],
type(sc->vptr->pair_car (a)));
ts_types[ type(sc->vptr->pair_car (a)) ],
type(sc->vptr->pair_car (a)));
}
/* Log GValue: its value and its GType
* FUTURE: for Gimp types, gimp_item_get_id (GIMP_ITEM (<value>)));
*/
void debug_gvalue(const GValue *value)
void
debug_gvalue (const GValue *value)
{
char * contents_str;
const char * type_name;
char *contents_str;
const char *type_name;
type_name = G_VALUE_TYPE_NAME(value);
contents_str = g_strdup_value_contents (value);

42
plug-ins/script-fu/script-fu-errors.h
View File

@ -29,38 +29,36 @@
#endif
pointer script_error (scheme *sc,
const gchar *error_message,
const pointer a);
pointer script_error (scheme *sc,
const gchar *error_message,
const pointer a);
pointer script_type_error (scheme *sc,
const gchar *expected_type,
const guint arg_index,
const gchar *proc_name);
pointer script_type_error_in_container (
scheme *sc,
const gchar *expected_type,
const guint arg_index,
const guint element_index,
const gchar *proc_name,
const pointer a);
pointer script_type_error_in_container (scheme *sc,
const gchar *expected_type,
const guint arg_index,
const guint element_index,
const gchar *proc_name,
const pointer a);
pointer script_length_error_in_vector (
scheme *sc,
const guint arg_index,
const gchar *proc_name,
const guint expected_length,
const pointer vector);
pointer script_length_error_in_vector (scheme *sc,
const guint arg_index,
const gchar *proc_name,
const guint expected_length,
const pointer vector);
pointer implementation_error (scheme *sc,
const gchar *error_message,
const pointer a);
pointer implementation_error (scheme *sc,
const gchar *error_message,
const pointer a);
void debug_vector (scheme *sc,
const pointer vector,
const gchar *format);
void debug_vector (scheme *sc,
const pointer vector,
const gchar *format);
void debug_list (scheme *sc,
pointer list,