From 877d5852718dc2d8c73de51f2f88f25339dd0d61 Mon Sep 17 00:00:00 2001 From: bootchk Date: Thu, 28 Jan 2021 09:08:39 -0500 Subject: [PATCH] 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. --- plug-ins/script-fu/Makefile.am | 6 +- plug-ins/script-fu/meson.build | 1 + plug-ins/script-fu/scheme-wrapper.c | 216 +++++++++++++++++--------- plug-ins/script-fu/script-fu-compat.c | 211 +++++++++++++++++++++++++ plug-ins/script-fu/script-fu-compat.h | 27 ++++ plug-ins/script-fu/script-fu-errors.c | 93 ++++++----- plug-ins/script-fu/script-fu-errors.h | 42 +++-- 7 files changed, 456 insertions(+), 140 deletions(-) create mode 100644 plug-ins/script-fu/script-fu-compat.c create mode 100644 plug-ins/script-fu/script-fu-compat.h diff --git a/plug-ins/script-fu/Makefile.am b/plug-ins/script-fu/Makefile.am index c34c1dc6d9..b39dd999e0 100644 --- a/plug-ins/script-fu/Makefile.am +++ b/plug-ins/script-fu/Makefile.am @@ -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 diff --git a/plug-ins/script-fu/meson.build b/plug-ins/script-fu/meson.build index 4ef5fae417..c13a6c14ce 100644 --- a/plug-ins/script-fu/meson.build +++ b/plug-ins/script-fu/meson.build @@ -19,6 +19,7 @@ plugin_sources = [ 'script-fu-utils.c', 'script-fu.c', 'script-fu-errors.c', + 'script-fu-compat.c' ] if platform_windows diff --git a/plug-ins/script-fu/scheme-wrapper.c b/plug-ins/script-fu/scheme-wrapper.c index c291c85a5b..6417c96378 100644 --- a/plug-ins/script-fu/scheme-wrapper.c +++ b/plug-ins/script-fu/scheme-wrapper.c @@ -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 diff --git a/plug-ins/script-fu/script-fu-compat.c b/plug-ins/script-fu/script-fu-compat.c new file mode 100644 index 0000000000..9a167d3966 --- /dev/null +++ b/plug-ins/script-fu/script-fu-compat.c @@ -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 . + */ + +#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; +} diff --git a/plug-ins/script-fu/script-fu-compat.h b/plug-ins/script-fu/script-fu-compat.h new file mode 100644 index 0000000000..c03c045c68 --- /dev/null +++ b/plug-ins/script-fu/script-fu-compat.h @@ -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 . + */ + +#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__ */ diff --git a/plug-ins/script-fu/script-fu-errors.c b/plug-ins/script-fu/script-fu-errors.c index 1027d47269..2e2610bf6a 100644 --- a/plug-ins/script-fu/script-fu-errors.c +++ b/plug-ins/script-fu/script-fu-errors.c @@ -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 ())); */ -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); diff --git a/plug-ins/script-fu/script-fu-errors.h b/plug-ins/script-fu/script-fu-errors.h index 1d5e71c5c4..a4cad90944 100644 --- a/plug-ins/script-fu/script-fu-errors.h +++ b/plug-ins/script-fu/script-fu-errors.h @@ -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,