[gimp] Partial fix 5426. Lets old scriptfu script call old name gimp-image-is-valid, mapped to new PDB pro
- From: Jehan <jehanp src gnome org>
- To: commits-list gnome org
- Cc:
- Subject: [gimp] Partial fix 5426. Lets old scriptfu script call old name gimp-image-is-valid, mapped to new PDB pro
- Date: Thu, 22 Apr 2021 17:39:14 +0000 (UTC)
commit 877d5852718dc2d8c73de51f2f88f25339dd0d61
Author: bootchk <bootchk users noreply github com>
Date: Thu Jan 28 09:08:39 2021 -0500
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(-)
---
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 <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;
+}
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 <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__ */
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 (<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);
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,
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]
