[gimp] Issue #5402 Scriptfu handle GFile and GimpObjectArray types
- From: Jehan <jehanp src gnome org>
- To: commits-list gnome org
- Cc:
- Subject: [gimp] Issue #5402 Scriptfu handle GFile and GimpObjectArray types
- Date: Mon, 24 May 2021 15:16:32 +0000 (UTC)
commit e57304f71a44ccb1393a75fac85231293d6a40a2
Author: lloyd konneker <konnekerl gmail com>
Date: Fri Apr 30 13:51:04 2021 -0400
Issue #5402 Scriptfu handle GFile and GimpObjectArray types
plug-ins/script-fu/Makefile.am | 2 +
plug-ins/script-fu/meson.build | 1 +
plug-ins/script-fu/scheme-marshal.c | 233 ++++++++++++++++++++++++++++++++++++
plug-ins/script-fu/scheme-marshal.h | 45 +++++++
plug-ins/script-fu/scheme-wrapper.c | 135 +++++++++++++++------
5 files changed, 377 insertions(+), 39 deletions(-)
---
diff --git a/plug-ins/script-fu/Makefile.am b/plug-ins/script-fu/Makefile.am
index b39dd999e0..bc5e0f829b 100644
--- a/plug-ins/script-fu/Makefile.am
+++ b/plug-ins/script-fu/Makefile.am
@@ -85,6 +85,8 @@ script_fu_SOURCES = \
script-fu-errors.h \
script-fu-compat.c \
script-fu-compat.h \
+ scheme-marshal.c \
+ scheme-marshal.h \
scheme-wrapper.c \
scheme-wrapper.h
diff --git a/plug-ins/script-fu/meson.build b/plug-ins/script-fu/meson.build
index c13a6c14ce..1a2fb4ccb2 100644
--- a/plug-ins/script-fu/meson.build
+++ b/plug-ins/script-fu/meson.build
@@ -8,6 +8,7 @@ plugin_name = 'script-fu'
plugin_sources = [
'scheme-wrapper.c',
+ 'scheme-marshal.c',
'script-fu-console.c',
'script-fu-eval.c',
'script-fu-interface.c',
diff --git a/plug-ins/script-fu/scheme-marshal.c b/plug-ins/script-fu/scheme-marshal.c
new file mode 100644
index 0000000000..afe05e7ab0
--- /dev/null
+++ b/plug-ins/script-fu/scheme-marshal.c
@@ -0,0 +1,233 @@
+/* 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 "libgimp/gimp.h"
+#include "tinyscheme/scheme-private.h"
+#include "scheme-marshal.h"
+#include "script-fu-errors.h"
+
+
+/*
+ * Marshal arguments to, and return values from, calls to PDB.
+ * Convert Scheme constructs to/from a GValue.
+ *
+ * For each marshalling function:
+ * - a returned "pointer" is a scheme pointer to a foreign error or NULL.
+ * - marshal into a GValue holding a designated type,
+ * usually a GIMP type but also GLib types, e.g. GFile.
+ * The GValue's held type is already set, but value is uninitialized.
+ *
+ * When marshalling into a GimpObjectArray, arbitrarily say the contained type is GIMP_TYPE_DRAWABLE.
+ * The actual contained type is opaque to the PDB calling mechanism.
+ * Setting the GValue's value does not check the contained type.
+ * But we do call gimp_drawable_get_by_id.
+ * GIMP_TYPE_DRAWABLE is a superclass of most common uses.
+ * But perhaps we should call gimp_item_get_by_id
+ * and arbitrarily say GIMP_TYPE_ITEM, a superclass of drawable.
+ */
+
+
+
+
+/* Marshal single drawable ID from script into a single GObject. */
+pointer
+marshal_ID_to_drawable (scheme *sc,
+ pointer a,
+ gint id,
+ GValue *value)
+{
+ GimpDrawable *drawable;
+
+ pointer error = get_drawable_from_script (sc, a, id, &drawable);
+ if (error)
+ return error;
+
+ /* drawable is NULL or valid */
+
+ /* Shallow copy, adding a reference while the GValue exists. */
+ g_value_set_object (value, drawable);
+ return NULL; /* no error */
+}
+
+/* Marshal a vector of ID into GimpObjectArray of same length. */
+pointer
+marshal_vector_to_drawable_array (scheme *sc,
+ pointer vector,
+ GValue *value)
+{
+ GimpDrawable **drawable_array;
+ gint id;
+ pointer error;
+
+ guint num_elements = sc->vptr->vector_length (vector);
+ g_debug ("vector has %d elements", num_elements);
+ /* empty vector will produce empty GimpObjectArray */
+
+ drawable_array = g_new0 (GimpDrawable*, num_elements);
+
+ for (int j = 0; j < num_elements; ++j)
+ {
+ pointer element = sc->vptr->vector_elem (vector, j);
+
+ if (!sc->vptr->is_number (element))
+ {
+ g_free (drawable_array);
+ return script_error (sc, "Expected numeric in drawable vector", vector);
+ /* FUTURE more detailed error msg:
+ * return script_type_error_in_container (sc, "numeric", i, j, proc_name, vector);
+ */
+ }
+
+ id = sc->vptr->ivalue (element);
+ error = get_drawable_from_script (sc, element, id, &drawable_array[j]);
+ if (error)
+ {
+ g_free (drawable_array);
+ return error;
+ }
+ }
+
+ /* Shallow copy. */
+ gimp_value_set_object_array (value, GIMP_TYPE_DRAWABLE, (GObject**)drawable_array, num_elements);
+
+ g_free (drawable_array);
+
+ return NULL; /* no error */
+}
+
+
+/* Marshal path string from script into a GValue holding type GFile */
+void
+marshal_path_string_to_gfile (scheme *sc,
+ pointer a,
+ GValue *value)
+{
+ /* require sc->vptr->is_string (sc->vptr->pair_car (a)) */
+
+ GFile *gfile = g_file_new_for_path (sc->vptr->string_value (sc->vptr->pair_car (a)));
+ /* GLib docs say that g_file_new_for_path():
+ * "never fails, but the returned object might not support any I/O operation if path is malformed."
+ */
+
+ g_value_set_object (value, gfile);
+ g_debug ("gfile arg is '%s'\n", g_file_get_parse_name (gfile));
+}
+
+
+/* Marshal values returned from PDB call in a GValue, into a Scheme construct to a script. */
+
+
+/* Marshal a GValue holding a GFile into a string.
+ *
+ * Returns NULL or a string that must be freed.
+ */
+ gchar *
+ marshal_returned_gfile_to_string (GValue *value)
+{
+ gchar * filepath = NULL;
+
+ GObject *object = g_value_get_object (value);
+ /* object can be NULL, the GValue's type only indicates what should have been returned. */
+ if (object)
+ {
+ filepath = g_file_get_parse_name ((GFile *) object);
+ /* GLib docs:
+ * For local files with names that can safely be converted to UTF-8 the pathname is used,
+ * otherwise the IRI is used (a form of URI that allows UTF-8 characters unescaped).
+ */
+ }
+ return filepath;
+}
+
+
+/* Marshal a GimpObjectArray into a Scheme list of ID's.
+ *
+ * Before v3.0, PDB procedure's return type was say INT32ARRAY,
+ * preceded by a type INT32 designating array length.
+ * Now return type is GimpObjectArray preceded by length.
+ *
+ * Returns a vector, since most arrays in Scriptfu are returned as vectors.
+ * An alternate implementation would be return list.
+ *
+ * Existing scheme plugins usually expect PDB to return values: len, vector.
+ * If ever the PDB is changed to be more object-oriented,
+ * scripts could use a scheme call: (vector-length vector)
+ * to get the length of the vector.
+ */
+pointer
+marshal_returned_object_array_to_vector (scheme *sc,
+ GValue *value)
+{
+ GObject **object_array;
+ gint32 n;
+ pointer vector;
+
+ object_array = gimp_value_get_object_array (value);
+ /* array knows own length, ignore length in preceding return value */
+ n = ((GimpObjectArray*)g_value_get_boxed (value))->length;
+
+ vector = sc->vptr->mk_vector (sc, n);
+
+ /* Iterate starting at the back of the array, and prefix to container
+ * so the order of objects is not changed.
+ */
+ for (int j = n - 1; j >= 0; j--)
+ {
+ gint id;
+ GObject *object = object_array[j];
+
+ if (object)
+ g_object_get (object, "id", &id, NULL); /* get property "id" */
+ else
+ /* Scriptfu language represents NULL object by ID of -1*/
+ id = -1;
+
+ sc->vptr->set_vector_elem (vector, j, sc->vptr->mk_integer (sc, id));
+ /* Alt: list = sc->vptr->cons (sc, sc->vptr->mk_integer (sc, id), list); */
+ }
+ /* ensure container's len equals object array's len and all elements are ID's or -1 */
+ return vector;
+}
+
+
+ /* From a script numeric (a drawable ID) set a handle to a drawable.
+ * When ID is -1, sets drawable to NULL and returns no error.
+ * When ID is valid, sets drawable and returns no error.
+ * Otherwise (ID is not -1 and not valid ID of a drawable) returns error.
+ */
+pointer
+get_drawable_from_script (scheme *sc,
+ pointer a,
+ gint id,
+ GimpDrawable **drawable_handle)
+{
+ if (id == -1)
+ {
+ /* -1 is scriptfu language for NULL i.e. none for an optional */
+ *drawable_handle = NULL;
+ }
+ else
+ {
+ *drawable_handle = gimp_drawable_get_by_id (id);
+ if (! *drawable_handle)
+ return script_error (sc, "Invalid drawable ID", a);
+ }
+
+ /* ensure *drawable_handle is NULL or a valid reference to a drawable */
+ return NULL; /* no error */
+}
diff --git a/plug-ins/script-fu/scheme-marshal.h b/plug-ins/script-fu/scheme-marshal.h
new file mode 100644
index 0000000000..8a499c8723
--- /dev/null
+++ b/plug-ins/script-fu/scheme-marshal.h
@@ -0,0 +1,45 @@
+/* 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 __SCHEME_MARSHAL_H__
+#define __SCHEME_MARSHAL_H__
+
+pointer get_drawable_from_script (scheme *sc,
+ pointer a,
+ gint id,
+ GimpDrawable **drawable_handle);
+
+pointer marshal_ID_to_drawable (scheme *sc,
+ pointer a,
+ gint id,
+ GValue *value);
+
+pointer marshal_vector_to_drawable_array (scheme *sc,
+ pointer a,
+ GValue *value);
+
+void marshal_path_string_to_gfile (scheme *sc,
+ pointer a,
+ GValue *value);
+
+
+pointer marshal_returned_object_array_to_vector (scheme *sc,
+ GValue *value);
+
+gchar * marshal_returned_gfile_to_string (GValue *value);
+
+#endif /* __SCHEME_MARSHAL_H__ */
diff --git a/plug-ins/script-fu/scheme-wrapper.c b/plug-ins/script-fu/scheme-wrapper.c
index 6417c96378..7698e56ec1 100644
--- a/plug-ins/script-fu/scheme-wrapper.c
+++ b/plug-ins/script-fu/scheme-wrapper.c
@@ -45,6 +45,7 @@
#include "script-fu-compat.h"
#include "scheme-wrapper.h"
+#include "scheme-marshal.h"
#undef cons
@@ -538,6 +539,8 @@ script_fu_marshal_procedure_call (scheme *sc,
gchar *proc_name;
GParamSpec **arg_specs;
gint n_arg_specs;
+ gint actual_arg_count;
+ gint consumed_arg_count = 0;
gchar error_str[1024];
gint i;
pointer return_val = sc->NIL;
@@ -581,44 +584,34 @@ script_fu_marshal_procedure_call (scheme *sc,
}
arg_specs = gimp_procedure_get_arguments (procedure, &n_arg_specs);
-
- /* Check the supplied number of arguments */
+ actual_arg_count = sc->vptr->list_length (sc, a) - 1;
+
+ /* Check the supplied number of arguments.
+ * This only gives warnings to the console.
+ * It does not ensure that the count of supplied args equals the count of formal args.
+ * Subsequent code must not assume that.
+ *
+ * When too few supplied args, when permissive, scriptfu or downstream machinery
+ * can try to provide missing args e.g. defaults.
+ *
+ * Extra supplied args can be discarded.
+ * Formerly, this was a deprecated behavior depending on "permissive".
+ */
{
- int actual_arg_count = sc->vptr->list_length (sc, a) - 1;
-
- if (n_arg_specs == 0)
+ if (actual_arg_count > n_arg_specs)
{
- 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 */
+ /* Warn, but permit extra args. Will discard args from script.*/
+ g_warning ("in script, permitting too many args to %s", proc_name);
}
- else /* formal arg count > 0 */
+ else if (actual_arg_count < n_arg_specs)
{
- 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. */
+ /* Warn, but permit too few args.
+ * Scriptfu or downstream might provide missing args.
+ * It is author friendly to continue to parse the script for type errors.
+ */
+ g_warning ("in script, permitting too few args to %s", proc_name);
}
+ /* else equal counts of args. */
}
/* Marshall the supplied arguments */
@@ -632,7 +625,20 @@ script_fu_marshal_procedure_call (scheme *sc,
pointer vector; /* !!! list or vector */
gint j;
- a = sc->vptr->pair_cdr (a);
+ consumed_arg_count++;
+
+ if (consumed_arg_count > actual_arg_count)
+ {
+ /* Exhausted supplied arguments before formal specs. */
+
+ /* Say formal type of first missing arg. */
+ g_warning ("Missing arg type: %s", g_type_name (G_PARAM_SPEC_VALUE_TYPE (arg_spec)));
+
+ /* Break loop over formal specs. Continuation is to call PDB with partial args. */
+ break;
+ }
+ else
+ a = sc->vptr->pair_cdr (a); /* advance pointer to next arg in list. */
g_value_init (&value, G_PARAM_SPEC_VALUE_TYPE (arg_spec));
@@ -760,10 +766,11 @@ script_fu_marshal_procedure_call (scheme *sc,
return script_type_error (sc, "numeric", i, proc_name);
else
{
- GimpDrawable *drawable =
- gimp_drawable_get_by_id (sc->vptr->ivalue (sc->vptr->pair_car (a)));
+ gint id = sc->vptr->ivalue (sc->vptr->pair_car (a));
- g_value_set_object (&value, drawable);
+ pointer error = marshal_ID_to_drawable(sc, a, id, &value);
+ if (error)
+ return error;
}
}
else if (GIMP_VALUE_HOLDS_VECTORS (&value))
@@ -1113,6 +1120,25 @@ script_fu_marshal_procedure_call (scheme *sc,
g_value_set_boxed (&value, ¶site);
}
}
+ else if (GIMP_VALUE_HOLDS_OBJECT_ARRAY (&value))
+ {
+ vector = sc->vptr->pair_car (a);
+
+ if (sc->vptr->is_vector (vector))
+ {
+ pointer error = marshal_vector_to_drawable_array (sc, vector, &value);
+ if (error)
+ return error;
+ }
+ else
+ return script_type_error (sc, "vector", i, proc_name);
+ }
+ else if (G_VALUE_TYPE (&value) == G_TYPE_FILE)
+ {
+ if (! sc->vptr->is_string (sc->vptr->pair_car (a)))
+ return script_type_error (sc, "string for path", i, proc_name);
+ marshal_path_string_to_gfile (sc, a, &value);
+ }
else if (G_VALUE_TYPE (&value) == GIMP_TYPE_PDB_STATUS_TYPE)
{
/* A PDB procedure signature wrongly requires a status. */
@@ -1215,8 +1241,31 @@ script_fu_marshal_procedure_call (scheme *sc,
g_debug ("Return value %d is type %s", i+1, G_VALUE_TYPE_NAME (value));
- if (G_VALUE_HOLDS_OBJECT (value))
+ /* Order is important. GFile before GIMP objects. */
+ if (G_VALUE_TYPE (value) == G_TYPE_FILE)
+ {
+ gchar *parsed_filepath = marshal_returned_gfile_to_string (value);
+
+ if (parsed_filepath)
+ {
+ g_debug ("PDB procedure returned GFile '%s'", parsed_filepath);
+ /* copy string into interpreter state. */
+ return_val = sc->vptr->cons (sc, sc->vptr->mk_string (sc, parsed_filepath), return_val);
+ g_free (parsed_filepath);
+ }
+ else
+ {
+ g_warning ("PDB procedure failed to return a valid GFile");
+ return_val = sc->vptr->cons (sc, sc->vptr->mk_string (sc, ""), return_val);
+ }
+ /* Ensure return_val holds a string, possibly empty. */
+ }
+ else if (G_VALUE_HOLDS_OBJECT (value))
{
+ /* G_VALUE_HOLDS_OBJECT only ensures value derives from GObject.
+ * Could be a GIMP or a GLib type.
+ * Here we handle GIMP types, which all have an id property.
+ */
GObject *object = g_value_get_object (value);
gint id = -1;
@@ -1227,8 +1276,11 @@ script_fu_marshal_procedure_call (scheme *sc,
/* 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.
+ * It is not necessarily an error in the script.
*/
+ if (id == -1)
+ g_warning("PDB procedure returned NULL GIMP object or non-GIMP object.");
+
g_debug ("PDB procedure returned object ID: %i", id);
/* Scriptfu stores object IDs as int. */
@@ -1433,6 +1485,11 @@ script_fu_marshal_procedure_call (scheme *sc,
g_debug ("data '%.*s'", v->size, (gchar *) v->data);
}
}
+ else if (GIMP_VALUE_HOLDS_OBJECT_ARRAY (value))
+ {
+ pointer vector = marshal_returned_object_array_to_vector (sc, value);
+ return_val = sc->vptr->cons (sc, vector, return_val);
+ }
else if (G_VALUE_TYPE (&value) == GIMP_TYPE_PDB_STATUS_TYPE)
{
/* Called procedure implemented incorrectly. */
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]
