callisto-debian/gimp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
f17a42be7586877459fcf02aedb6bf3b00a3341e
gimp/plug-ins/script-fu/libscriptfu/scheme-wrapper.c
Jehan f17a42be75 plug-ins: add type check for the argument names in filter configuration too. 
After the few specific args (drawable/filter ID, opacity, blend mode, op
name…), the op argument names can be passed either as string or with the
new argument name syntax. The error message though focus on argument
name type.

Also fix the argument count for the various possible cases (when
configuring with (gimp-drawable-filter-configure) or
(gimp-drawable-merge|append-new-filter), the start arg count is
different).
2025-01-20 15:28:15 +01:00

2300 lines
76 KiB
C
Raw Blame History

/* 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/>.
*/
#define DEBUG_SCRIPTS 0
#include "config.h"
#include <string.h>
#include <glib/gstdio.h>
#include <girepository.h>
#include <gtk/gtk.h>
#include "libgimp/gimp.h"
#include "tinyscheme/scheme-private.h"
#if USE_DL
#include "tinyscheme/dynload.h"
#endif
#include "ftx/ftx.h"
#include "script-fu-types.h"
#include "script-fu-lib.h"
#include "script-fu-regex.h"
#include "script-fu-scripts.h"
#include "script-fu-errors.h"
#include "script-fu-compat.h"
#include "script-fu-version.h"
#include "script-fu-progress.h"
#include "scheme-wrapper.h"
#include "scheme-marshal.h"
#include "scheme-marshal-return.h"
#undef cons
static void ts_init_constants (scheme *sc,
GIRepository *repo);
static void ts_init_enums (scheme *sc,
GIRepository *repo,
const char *namespace);
static void ts_define_procedure (scheme *sc,
const gchar *symbol_name,
TsWrapperFunc func);
static void ts_init_procedures (scheme *sc,
gboolean register_scipts);
static void ts_load_init_and_compatibility_scripts (GList *paths);
static pointer script_fu_marshal_arg_to_value (scheme *sc,
pointer a,
const gchar *proc_name,
gint arg_index,
GParamSpec *arg_spec,
GValue *value,
gchar **strvalue);
static pointer script_fu_marshal_procedure_call (scheme *sc,
pointer a,
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_marshal_drawable_create_filter (scheme *sc,
pointer a,
const gchar *proc_name,
GimpDrawable **drawable,
GimpDrawableFilter **filter);
static pointer script_fu_marshal_drawable_filter_configure_call (scheme *sc,
pointer a);
static pointer script_fu_marshal_drawable_filter_set_aux_call (scheme *sc,
pointer a);
static pointer script_fu_marshal_drawable_merge_filter_call (scheme *sc,
pointer a);
static pointer script_fu_marshal_drawable_append_filter_call (scheme *sc,
pointer a);
static pointer script_fu_marshal_drawable_merge_new_filter_call (scheme *sc,
pointer a);
static pointer script_fu_marshal_drawable_append_new_filter_call (scheme *sc,
pointer a);
static pointer script_fu_register_call (scheme *sc,
pointer a);
static pointer script_fu_register_call_filter (scheme *sc,
pointer a);
static pointer script_fu_register_call_procedure (scheme *sc,
pointer a);
static pointer script_fu_menu_register_call (scheme *sc,
pointer a);
static pointer script_fu_use_v3_call (scheme *sc,
pointer a);
static pointer script_fu_use_v2_call (scheme *sc,
pointer a);
static pointer script_fu_quit_call (scheme *sc,
pointer a);
static pointer script_fu_nil_call (scheme *sc,
pointer a);
static gboolean ts_load_file (const gchar *dirname,
const gchar *basename);
typedef struct
{
const gchar *name;
gint value;
} NamedConstant;
/* LHS is text in a script, RHS is constant defined in C. */
static const NamedConstant script_constants[] =
{
/* Useful values from libgimpbase/gimplimits.h */
{ "MIN-IMAGE-SIZE", GIMP_MIN_IMAGE_SIZE },
{ "MAX-IMAGE-SIZE", GIMP_MAX_IMAGE_SIZE },
/* Note conversion to int, loss of precision: 0.005=>0 */
{ "MIN-RESOLUTION", (gint) GIMP_MIN_RESOLUTION },
{ "MAX-RESOLUTION", GIMP_MAX_RESOLUTION },
/* Useful misc stuff */
{ "TRUE", TRUE },
{ "FALSE", FALSE },
/* Builtin units */
{ "UNIT-PIXEL", GIMP_UNIT_PIXEL },
{ "UNIT-INCH", GIMP_UNIT_INCH },
{ "UNIT-MM", GIMP_UNIT_MM },
{ "UNIT-POINT", GIMP_UNIT_POINT },
{ "UNIT-PICA", GIMP_UNIT_PICA },
/* Script-Fu types */
/* Arg types. */
{ "SF-IMAGE", SF_IMAGE },
{ "SF-DRAWABLE", SF_DRAWABLE },
{ "SF-LAYER", SF_LAYER },
{ "SF-CHANNEL", SF_CHANNEL },
{ "SF-VECTORS", SF_VECTORS },
{ "SF-COLOR", SF_COLOR },
{ "SF-TOGGLE", SF_TOGGLE },
{ "SF-STRING", SF_STRING },
{ "SF-FILENAME", SF_FILENAME },
{ "SF-DIRNAME", SF_DIRNAME },
{ "SF-ADJUSTMENT", SF_ADJUSTMENT },
{ "SF-FONT", SF_FONT },
{ "SF-PATTERN", SF_PATTERN },
{ "SF-BRUSH", SF_BRUSH },
{ "SF-GRADIENT", SF_GRADIENT },
{ "SF-OPTION", SF_OPTION },
{ "SF-PALETTE", SF_PALETTE },
{ "SF-TEXT", SF_TEXT },
{ "SF-ENUM", SF_ENUM },
{ "SF-DISPLAY", SF_DISPLAY },
/* PDB procedure drawable_arity, i.e. sensitivity.
* Used with script-fu-register-filter.
*
* This declares the arity of the algorithm,
* and not the signature of the PDB procedure.
* Since v3, PDB procedures that are image procedures,
* take a container of drawables.
* This only describes how many drawables the container *should* hold.
*
* For calls invoked by a user, this describes
* how many drawables the user is expected to select,
* which disables/enables the menu item for the procedure.
*
* Procedures are also called from other procedures.
* A call from another procedure may in fact
* pass more drawables than declared for drawable_arity.
* That is a programming error on behalf of the caller.
* A well-written callee that is passed more drawables than declared
* should return an error instead of processing any of the drawables.
*
* Similarly for fewer than declared.
*/
/* Requires two drawables. Often an operation between them, yielding a new drawable */
{ "SF-TWO-OR-MORE-DRAWABLE", SF_TWO_OR_MORE_DRAWABLE },
/* Often processed independently, sequentially, with side effects on the drawables. */
{ "SF-ONE-OR-MORE-DRAWABLE", SF_ONE_OR_MORE_DRAWABLE },
/* Requires exactly one drawable. */
{ "SF-ONE-DRAWABLE", SF_ONE_DRAWABLE },
/* For SF-ADJUSTMENT */
{ "SF-SLIDER", SF_SLIDER },
{ "SF-SPINNER", SF_SPINNER },
{ NULL, 0 }
};
static scheme sc;
/*
* These callbacks break the backwards compile-time dependence
* of inner scheme-wrapper on the outer script-fu-server.
* Only script-fu-server registers, when it runs.
*/
static TsCallbackFunc post_command_callback = NULL;
static TsCallbackFunc quit_callback = NULL;
void
tinyscheme_init (GList *path,
gboolean register_scripts)
{
GIRepository *repo;
GITypelib *typelib;
GError *error = NULL;
/* init the interpreter */
if (! scheme_init (&sc))
{
g_warning ("Could not initialize TinyScheme!");
return;
}
scheme_set_input_port_file (&sc, stdin);
scheme_set_output_port_file (&sc, stdout);
ts_register_output_func (ts_stdout_output_func, NULL);
/* Initialize the TinyScheme extensions */
init_ftx (&sc);
script_fu_regex_init (&sc);
/* Fetch the typelib */
repo = g_irepository_get_default ();
typelib = g_irepository_require (repo, "Gimp", NULL, 0, &error);
if (!typelib)
{
g_warning ("%s", error->message);
g_clear_error (&error);
return;
}
/* register in the interpreter the gimp functions and types. */
ts_init_constants (&sc, repo);
ts_init_procedures (&sc, register_scripts);
ts_load_init_and_compatibility_scripts (path);
}
/* Create an SF-RUN-MODE constant for use in scripts.
* It is set to the run mode state determined by GIMP.
*/
void
ts_set_run_mode (GimpRunMode run_mode)
{
pointer symbol;
symbol = sc.vptr->mk_symbol (&sc, "SF-RUN-MODE");
sc.vptr->scheme_define (&sc, sc.global_env, symbol,
sc.vptr->mk_integer (&sc, run_mode));
sc.vptr->setimmutable (symbol);
}
void
ts_set_print_flag (gint print_flag)
{
sc.print_output = print_flag;
}
void
ts_print_welcome (void)
{
ts_output_string (TS_OUTPUT_NORMAL,
"Welcome to TinyScheme, Version 1.40\n", -1);
ts_output_string (TS_OUTPUT_NORMAL,
"Copyright (c) Dimitrios Souflis\n", -1);
}
void
ts_interpret_stdin (void)
{
scheme_load_file (&sc, stdin);
}
gint
ts_interpret_string (const gchar *expr)
{
gint result;
#if DEBUG_SCRIPTS
sc.print_output = 1;
sc.tracing = 1;
#endif
sc.vptr->load_string (&sc, (char *) expr);
result = sc.retcode;
g_debug ("ts_interpret_string returns: %i", result);
return result;
}
const gchar *
ts_get_success_msg (void)
{
if (sc.vptr->is_string (sc.value))
return sc.vptr->string_value (sc.value);
return "Success";
}
/* Delegate. The caller doesn't know the scheme instance,
* and here we don't know TS internals.
*/
const gchar*
ts_get_error_msg (void)
{
return ts_get_error_string (&sc);
}
void
ts_stdout_output_func (TsOutputType type,
const char *string,
int len,
gpointer user_data)
{
if (len < 0)
len = strlen (string);
fprintf (stdout, "%.*s", len, string);
fflush (stdout);
}
void
ts_gstring_output_func (TsOutputType type,
const char *string,
int len,
gpointer user_data)
{
GString *gstr = (GString *) user_data;
g_string_append_len (gstr, string, len);
}
void
ts_register_quit_callback (TsCallbackFunc callback)
{
quit_callback = callback;
}
void
ts_register_post_command_callback (TsCallbackFunc callback)
{
post_command_callback = callback;
}
/* private functions */
/*
* Below can be found the functions responsible for registering the
* gimp functions and types against the scheme interpreter.
*/
/* Define a symbol into interpreter state, bound to a string, immutable. */
static void
ts_define_constant_string (scheme *sc,
const gchar *symbol_name,
const gchar *symbol_value)
{
pointer symbol = sc->vptr->mk_symbol (sc, symbol_name);
sc->vptr->scheme_define (sc, sc->global_env, symbol,
sc->vptr->mk_string (sc, symbol_value));
sc->vptr->setimmutable (symbol);
}
static void
ts_init_constants (scheme *sc,
GIRepository *repo)
{
ts_define_constant_string (sc, "gimp-directory", gimp_directory ());
ts_define_constant_string (sc, "gimp-data-directory", gimp_data_directory ());
ts_define_constant_string (sc, "gimp-plug-in-directory", gimp_plug_in_directory ());
ts_define_constant_string (sc, "gimp-locale-directory", gimp_locale_directory ());
ts_define_constant_string (sc, "gimp-sysconf-directory", gimp_sysconf_directory ());
{
gchar *path;
path = script_fu_sys_init_directory ();
ts_define_constant_string (sc, "script-fu-sys-init-directory", path);
g_free (path);
path = script_fu_user_init_directory ();
ts_define_constant_string (sc, "script-fu-user-init-directory", path);
g_free (path);
}
ts_init_enums (sc, repo, "Gimp");
ts_init_enums (sc, repo, "Gegl");
/* Constants used in the register block of scripts e.g. SF-ADJUSTMENT */
for (int i = 0; script_constants[i].name != NULL; ++i)
{
pointer symbol;
symbol = sc->vptr->mk_symbol (sc, script_constants[i].name);
sc->vptr->scheme_define (sc, sc->global_env, symbol,
sc->vptr->mk_integer (sc,
script_constants[i].value));
sc->vptr->setimmutable (symbol);
}
/* use to build paths to files/directories */
ts_define_constant_string (sc, "DIR-SEPARATOR", G_DIR_SEPARATOR_S);
/* use to build search paths */
ts_define_constant_string (sc, "SEARCHPATH-SEPARATOR", G_SEARCHPATH_SEPARATOR_S);
}
static void
ts_init_enum (scheme *sc,
GIEnumInfo *info,
const char *namespace)
{
int n_values;
n_values = g_enum_info_get_n_values ((GIEnumInfo *) info);
for (int j = 0; j < n_values; j++)
{
GIValueInfo *value_info;
const char *c_identifier;
char *scheme_name;
int int_value;
pointer symbol;
value_info = g_enum_info_get_value (info, j);
/* Get name & value. Normally, we would use the actual name of the
* GIBaseInfo here, but that would break bw-compatibility */
c_identifier = g_base_info_get_attribute ((GIBaseInfo *) value_info, "c:identifier");
if (c_identifier == NULL)
{
g_warning ("Problem in the GIR file: enum value without \"c:identifier\"!");
g_base_info_unref ((GIBaseInfo *) value_info);
continue;
}
/* Scheme-ify the name */
if (g_strcmp0 (namespace, "Gimp") == 0)
{
/* Skip the GIMP prefix for GIMP enums */
if (g_str_has_prefix (c_identifier, "GIMP_"))
c_identifier += strlen ("GIMP_");
}
else
{
/* Other namespaces: skip non-prefixed symbols, to prevent clashes */
if (g_ascii_strncasecmp (c_identifier, namespace, strlen (namespace)) != 0)
{
g_base_info_unref ((GIBaseInfo *) value_info);
continue;
}
}
scheme_name = g_strdelimit (g_strdup (c_identifier), "_", '-');
int_value = g_value_info_get_value (value_info);
/* Register the symbol */
symbol = sc->vptr->mk_symbol (sc, scheme_name);
sc->vptr->scheme_define (sc, sc->global_env, symbol,
sc->vptr->mk_integer (sc, int_value));
sc->vptr->setimmutable (symbol);
g_free (scheme_name);
g_base_info_unref ((GIBaseInfo *) value_info);
}
}
static void
ts_init_enums (scheme *sc,
GIRepository *repo,
const char *namespace)
{
int i, n_infos;
n_infos = g_irepository_get_n_infos (repo, namespace);
for (i = 0; i < n_infos; i++)
{
GIBaseInfo *info;
info = g_irepository_get_info (repo, namespace, i);
if (GI_IS_ENUM_INFO (info))
{
ts_init_enum (sc, (GIEnumInfo *) info, namespace);
}
g_base_info_unref (info);
}
}
/* Define a symbol into interpreter state,
* bound to a foreign function, language C, defined here in ScriptFu source.
*/
static void
ts_define_procedure (scheme *sc,
const gchar *symbol_name,
TsWrapperFunc func)
{
pointer symbol;
symbol = sc->vptr->mk_symbol (sc, symbol_name);
sc->vptr->scheme_define (sc, sc->global_env, symbol,
sc->vptr->mk_foreign_func (sc, func));
sc->vptr->setimmutable (symbol);
}
/* Define, into interpreter state,
* 1) Scheme functions that call wrapper functions in C here in ScriptFu.
* 2) Scheme functions wrapping every procedure in the PDB.
*/
static void
ts_init_procedures (scheme *sc,
gboolean register_scripts)
{
gchar **proc_list;
gint num_procs;
gint i;
#if USE_DL
/* scm_load_ext not same as other wrappers, defined in tinyscheme/dynload */
ts_define_procedure (sc, "load-extension", scm_load_ext);
#endif
/* Define special functions used in scripts. */
if (register_scripts)
{
ts_define_procedure (sc, "script-fu-register", script_fu_register_call);
ts_define_procedure (sc, "script-fu-register-filter", script_fu_register_call_filter);
ts_define_procedure (sc, "script-fu-register-procedure", script_fu_register_call_procedure);
ts_define_procedure (sc, "script-fu-menu-register", script_fu_menu_register_call);
}
else
{
ts_define_procedure (sc, "script-fu-register", script_fu_nil_call);
ts_define_procedure (sc, "script-fu-register-filter", script_fu_nil_call);
ts_define_procedure (sc, "script-fu-register-procedure", script_fu_nil_call);
ts_define_procedure (sc, "script-fu-menu-register", script_fu_nil_call);
}
ts_define_procedure (sc, "script-fu-use-v3", script_fu_use_v3_call);
ts_define_procedure (sc, "script-fu-use-v2", script_fu_use_v2_call);
ts_define_procedure (sc, "script-fu-quit", script_fu_quit_call);
/* Define wrapper functions, not used in scripts.
* FUTURE: eliminate all but one, deprecated and permissive is obsolete.
*/
ts_define_procedure (sc, "gimp-proc-db-call", script_fu_marshal_procedure_call_strict);
ts_define_procedure (sc, "-gimp-proc-db-call", script_fu_marshal_procedure_call_permissive);
ts_define_procedure (sc, "--gimp-proc-db-call", script_fu_marshal_procedure_call_deprecated);
ts_define_procedure (sc, "gimp-drawable-filter-configure", script_fu_marshal_drawable_filter_configure_call);
ts_define_procedure (sc, "gimp-drawable-filter-set-aux-input", script_fu_marshal_drawable_filter_set_aux_call);
ts_define_procedure (sc, "gimp-drawable-merge-filter", script_fu_marshal_drawable_merge_filter_call);
ts_define_procedure (sc, "gimp-drawable-append-filter", script_fu_marshal_drawable_append_filter_call);
ts_define_procedure (sc, "gimp-drawable-merge-new-filter", script_fu_marshal_drawable_merge_new_filter_call);
ts_define_procedure (sc, "gimp-drawable-append-new-filter", script_fu_marshal_drawable_append_new_filter_call);
/* Define each PDB procedure as a scheme func.
* Each call passes through one of the wrapper funcs.
*/
proc_list = gimp_pdb_query_procedures (gimp_get_pdb (),
".*", ".*", ".*", ".*",
".*", ".*", ".*", ".*");
num_procs = proc_list ? g_strv_length (proc_list) : 0;
for (i = 0; i < num_procs; i++)
{
gchar *buff;
/* Build a define that will call the foreign function.
* The Scheme statement was suggested by Simon Budig.
*
* Call the procedure through -gimp-proc-db-call, which is a more
* permissive version of gimp-proc-db-call, that accepts (and ignores)
* any number of arguments for nullary procedures, for backward
* compatibility.
*/
buff = g_strdup_printf (" (define (%s . args)"
" (apply -gimp-proc-db-call \"%s\" args))",
proc_list[i], proc_list[i]);
/* Execute the 'define' */
sc->vptr->load_string (sc, buff);
g_free (buff);
}
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);
}
/* Load script defining much of Scheme in Scheme language.
* This hides the actual name.
* By convention in Scheme, the name is init.scm.
* Other Schemes use a same named file for the same purpose.
* The contents are more or less same as upstream TinyScheme.
* The contents only define a Lisp dialect,
* and not ScriptFu's additional bindings to the PDB.
*
* Returns TRUE on successful load.
*/
static gboolean
ts_load_main_init_script (gchar *dir)
{
return ts_load_file (dir, "init.scm");
}
/* Load certain Scheme init scripts from certain directories.
* Loads from two directories, user and sys, in that order.
* Only loads from directories named "scriptfu-init.""
* Only loads a small set of named files, not all .scm files in the directory.
* Only loads the first set of init scripts found,
* from the first directory where the main init script is found.
* Does not recursively descend into the directories.
*
* We recommend a user not shadow the sys init scripts,
* especially the main one: init.scm.
* Should not shadow in the user init script directory,
* or in any other script directory.
*/
static void
ts_load_init_and_compatibility_scripts (GList *paths)
{
gboolean did_find_main_init_script = FALSE;
g_debug ("%s", G_STRFUNC);
if (paths == NULL)
{
g_warning ("%s Missing paths.", G_STRFUNC);
return;
}
/* paths is a list of dirs known by ScriptFu, user specific and system wide.
* The order is important, and this first searches user specific directories.
*/
for (GList *list = paths; list; list = g_list_next (list))
{
/* Load from a designated init subdirectory.
* Subsequent loading of ordinary scripts skips this subdir.
*/
gchar *dir = script_fu_get_init_subdirectory (list->data);
if (ts_load_main_init_script (dir))
{
did_find_main_init_script = TRUE;
/* Load small set of named other init scripts.
* Only from same dir as the main init script!
*
* We don't warn when they are missing.
*/
/* Improve compatibility with older Script-Fu scripts,
* load definitions for old dialects of Lisp (SIOD) or older ScriptFu.
*/
(void) ts_load_file (dir, "script-fu-compat.scm");
/* Improve compatibility with older GIMP version,
* load definitions that alias/adapt older PDB procedures or plugins.
*/
(void) ts_load_file (dir, "plug-in-compat.scm");
g_free (dir);
/* !!! Only load init scripts from the first dir found. */
break;
}
g_free (dir);
}
if (! did_find_main_init_script)
{
/* Continue, but the interpreter will be crippled. */
g_warning ("Failed to load main initialization file");
}
}
static gboolean
ts_load_file (const gchar *dirname,
const gchar *basename)
{
gchar *filename;
FILE *fin;
filename = g_build_filename (dirname, basename, NULL);
fin = g_fopen (filename, "rb");
g_free (filename);
if (fin)
{
scheme_load_file (&sc, fin);
fclose (fin);
return TRUE;
}
return FALSE;
}
/* Returns pointer to sc->NIL (normal) or pointer to error. */
static pointer
script_fu_marshal_arg_to_value (scheme *sc,
pointer a,
const gchar *proc_name,
gint arg_index,
GParamSpec *arg_spec,
GValue *value,
gchar **strvalue)
{
pointer arg_val;
pointer vector;
guint n_elements;
gint j;
gchar error_str[1024];
if (sc->vptr->is_pair (a))
arg_val = sc->vptr->pair_car (a);
else
arg_val = a;
if (G_VALUE_HOLDS_INT (value))
{
if (! sc->vptr->is_number (arg_val))
{
return script_type_error (sc, "numeric", arg_index, proc_name);
}
else
{
GParamSpecInt *ispec = G_PARAM_SPEC_INT (arg_spec);
gint v = sc->vptr->ivalue (sc->vptr->pair_car (a));
if (v < ispec->minimum || v > ispec->maximum)
return script_int_range_error (sc, arg_index, proc_name, ispec->minimum, ispec->maximum, v);
g_value_set_int (value, v);
if (strvalue)
*strvalue = g_strdup_printf ("%d", v);
}
}
else if (G_VALUE_HOLDS_UINT (value))
{
if (! sc->vptr->is_number (arg_val))
{
return script_type_error (sc, "numeric", arg_index, proc_name);
}
else
{
GParamSpecUInt *ispec = G_PARAM_SPEC_UINT (arg_spec);
gint v = sc->vptr->ivalue (arg_val);
if (v < ispec->minimum || v > ispec->maximum)
return script_int_range_error (sc, arg_index, proc_name, ispec->minimum, ispec->maximum, v);
g_value_set_uint (value, v);
if (strvalue)
*strvalue = g_strdup_printf ("%u", v);
}
}
else if (G_VALUE_HOLDS_UCHAR (value))
{
if (! sc->vptr->is_number (arg_val))
{
return script_type_error (sc, "numeric", arg_index, proc_name);
}
else
{
GParamSpecUChar *cspec = G_PARAM_SPEC_UCHAR (arg_spec);
gint c = sc->vptr->ivalue (arg_val);
if (c < cspec->minimum || c > cspec->maximum)
return script_int_range_error (sc, arg_index, proc_name, cspec->minimum, cspec->maximum, c);
g_value_set_uchar (value, c);
if (strvalue)
*strvalue = g_strdup_printf ("%d", c);
}
}
else if (G_VALUE_HOLDS_DOUBLE (value))
{
if (! sc->vptr->is_number (arg_val))
{
return script_type_error (sc, "numeric", arg_index, proc_name);
}
else
{
GParamSpecDouble *dspec = G_PARAM_SPEC_DOUBLE (arg_spec);
gdouble d = sc->vptr->rvalue (arg_val);
if (d < dspec->minimum || d > dspec->maximum)
return script_float_range_error (sc, arg_index, proc_name, dspec->minimum, dspec->maximum, d);
g_value_set_double (value, d);
if (strvalue)
*strvalue = g_strdup_printf ("%f", d);
}
}
else if (G_VALUE_HOLDS_ENUM (value))
{
if (! sc->vptr->is_number (arg_val))
{
return script_type_error (sc, "numeric", arg_index, proc_name);
}
else
{
gint e = sc->vptr->ivalue (arg_val);
g_value_set_enum (value, e);
if (strvalue)
*strvalue = g_strdup_printf ("%d", e);
}
}
else if (G_VALUE_HOLDS_BOOLEAN (value))
{
if (sc->vptr->is_number (arg_val))
{
gboolean b = sc->vptr->ivalue (arg_val);
/* Bind according to C idiom: 0 is false, other numeric values true.
* This is not strict Scheme: 0 is truthy in Scheme.
* This lets FALSE still work, where FALSE is a deprecated symbol for 0.
*/
g_value_set_boolean (value, b);
if (strvalue)
*strvalue = g_strdup_printf ("%s", b ? "TRUE" : "FALSE");
}
else
{
if (is_interpret_v3_dialect ())
{
/* Use Scheme semantics: anything but #f is true.
* This allows Scheme expressions yielding any Scheme type.
*/
/* is_false is not exported from scheme.c (but should be.)
* This is the same code: compare Scheme pointers.
*/
gboolean truth_value = ! (arg_val == sc->F);
g_value_set_boolean (value, truth_value);
if (strvalue)
*strvalue = g_strdup_printf ("%s", truth_value ? "TRUE" : "FALSE");
}
else
{
/* v2 */
return script_type_error (sc, "numeric", arg_index, proc_name);
}
}
}
else if (G_VALUE_HOLDS_STRING (value))
{
if (! sc->vptr->is_string (arg_val))
{
return script_type_error (sc, "string", arg_index, proc_name);
}
else
{
const gchar *s = sc->vptr->string_value (arg_val);
g_value_set_string (value, s);
if (strvalue)
{
gchar *escaped = g_strescape (s, NULL);
*strvalue = g_strdup_printf ("\"%s\"", escaped);
g_free (escaped);
}
}
}
else if (G_VALUE_HOLDS (value, G_TYPE_STRV))
{
vector = arg_val; /* vector is pointing to a list */
if (! sc->vptr->is_list (sc, vector))
{
return script_type_error (sc, "vector", arg_index, proc_name);
}
else
{
gchar **array;
GString *v = NULL;
n_elements = sc->vptr->list_length (sc, vector);
array = g_new0 (gchar *, n_elements + 1);
if (strvalue)
v = g_string_new ("");
for (j = 0; j < n_elements; j++)
{
pointer v_element = sc->vptr->pair_car (vector);
if (!sc->vptr->is_string (v_element))
{
g_snprintf (error_str, sizeof (error_str),
"Item %d in vector is not a string (argument %d for function %s)",
j+1, arg_index+1, proc_name);
g_strfreev (array);
if (v)
g_string_free (v, TRUE);
return foreign_error (sc, error_str, vector);
}
array[j] = g_strdup (sc->vptr->string_value (v_element));
if (v)
{
gchar *escaped = g_strescape (array[j], NULL);
g_string_append_printf (v, "%s\"%s\"", j == 0 ? "" : " ", escaped);
g_free (escaped);
}
vector = sc->vptr->pair_cdr (vector);
}
g_value_take_boxed (value, array);
#if DEBUG_MARSHALL
{
glong count = sc->vptr->list_length ( sc, arg_val );
g_printerr (" string vector has %ld elements\n", count);
if (count > 0)
{
g_printerr (" ");
for (j = 0; j < count; ++j)
g_printerr (" \"%s\"", array[j]);
g_printerr ("\n");
}
}
#endif
if (v)
{
*strvalue = g_strdup_printf ("#(%s)", v->str);
g_string_free (v, TRUE);
}
}
}
else if (GIMP_VALUE_HOLDS_DISPLAY (value))
{
if (! sc->vptr->is_number (arg_val))
{
return script_type_error (sc, "numeric", arg_index, proc_name);
}
else
{
GimpDisplay *display;
gint id = sc->vptr->ivalue (arg_val);
display = gimp_display_get_by_id (id);
g_value_set_object (value, display);
if (strvalue)
*strvalue = g_strdup_printf ("%d", id);
}
}
else if (GIMP_VALUE_HOLDS_IMAGE (value))
{
if (! sc->vptr->is_number (arg_val))
{
return script_type_error (sc, "numeric", arg_index, proc_name);
}
else
{
GimpImage *image;
gint id = sc->vptr->ivalue (arg_val);
image = gimp_image_get_by_id (id);
g_value_set_object (value, image);
if (strvalue)
*strvalue = g_strdup_printf ("%d", id);
}
}
else if (GIMP_VALUE_HOLDS_LAYER (value))
{
if (! sc->vptr->is_number (arg_val))
{
return script_type_error (sc, "numeric", arg_index, proc_name);
}
else
{
GimpLayer *layer;
gint id = sc->vptr->ivalue (arg_val);
layer = gimp_layer_get_by_id (id);
g_value_set_object (value, layer);
if (strvalue)
*strvalue = g_strdup_printf ("%d", id);
}
}
else if (GIMP_VALUE_HOLDS_LAYER_MASK (value))
{
if (! sc->vptr->is_number (arg_val))
{
return script_type_error (sc, "numeric", arg_index, proc_name);
}
else
{
GimpLayerMask *layer_mask;
gint id = sc->vptr->ivalue (arg_val);
layer_mask = gimp_layer_mask_get_by_id (id);
g_value_set_object (value, layer_mask);
if (strvalue)
*strvalue = g_strdup_printf ("%d", id);
}
}
else if (GIMP_VALUE_HOLDS_CHANNEL (value))
{
if (! sc->vptr->is_number (arg_val))
{
return script_type_error (sc, "numeric", arg_index, proc_name);
}
else
{
GimpChannel *channel;
gint id = sc->vptr->ivalue (arg_val);
channel = gimp_channel_get_by_id (id);
g_value_set_object (value, channel);
if (strvalue)
*strvalue = g_strdup_printf ("%d", id);
}
}
else if (GIMP_VALUE_HOLDS_DRAWABLE (value))
{
if (! sc->vptr->is_number (arg_val))
{
return script_type_error (sc, "numeric", arg_index, proc_name);
}
else
{
gint id = sc->vptr->ivalue (arg_val);
pointer error = marshal_ID_to_item (sc, a, id, value);
if (error)
return error;
if (strvalue)
*strvalue = g_strdup_printf ("%d", id);
}
}
else if (GIMP_VALUE_HOLDS_PATH (value))
{
if (! sc->vptr->is_number (arg_val))
{
return script_type_error (sc, "numeric", arg_index, proc_name);
}
else
{
GimpPath *path;
gint id = sc->vptr->ivalue (arg_val);
path = gimp_path_get_by_id (id);
g_value_set_object (value, path);
if (strvalue)
*strvalue = g_strdup_printf ("%d", id);
}
}
else if (GIMP_VALUE_HOLDS_ITEM (value))
{
if (! sc->vptr->is_number (arg_val))
{
return script_type_error (sc, "numeric", arg_index, proc_name);
}
else
{
gint id = sc->vptr->ivalue (arg_val);
if (gimp_item_id_is_valid (id))
{
GimpItem *item = gimp_item_get_by_id (id);
g_value_set_object (value, item);
}
else
{
/* item ID is invalid.
* Usually 0 or -1, passed for a nullable arg.
*/
g_value_set_object (value, NULL);
}
if (strvalue)
*strvalue = g_strdup_printf ("%d", id);
}
}
else if (GIMP_VALUE_HOLDS_DRAWABLE_FILTER (value))
{
if (! sc->vptr->is_number (arg_val))
{
return script_type_error (sc, "numeric", arg_index, proc_name);
}
else
{
gint id = sc->vptr->ivalue (arg_val);
if (gimp_drawable_filter_id_is_valid (id))
{
GimpDrawableFilter *filter = gimp_drawable_filter_get_by_id (id);
g_value_set_object (value, filter);
}
else
{
/* Filter ID is invalid.
* Usually 0 or -1, passed for a nullable arg.
*/
g_value_set_object (value, NULL);
}
if (strvalue)
*strvalue = g_strdup_printf ("%d", id);
}
}
else if (GIMP_VALUE_HOLDS_INT32_ARRAY (value))
{
vector = arg_val;
if (! sc->vptr->is_vector (vector))
{
return script_type_error (sc, "vector", arg_index, proc_name);
}
else
{
/* !!! Comments applying to all array args.
* n_elements is expected list length, from previous argument.
* A PDB procedure takes args paired: ...length, array...
* and a script passes the same paired args (..., 1, '("foo"))
* (FUTURE: a more object oriented design for the PDB API
* would obviate need for this discussion.)
*
* When a script passes a shorter or empty list,
* ensure we don't segfault on cdr past end of list.
*
* n_elements is unsigned, we don't need to check >= 0
*
* Since we are not checking for equality of passed length
* to actual container length, we adapt an array
* that is shorter than specified by the length arg.
* Ignoring a discrepancy by the script author.
* FUTURE: List must be *exactly* n_elements long.
* n_elements != sc->vptr->list_length (sc, vector))
*/
gint32 *array;
GString *v = NULL;
n_elements = sc->vptr->vector_length (vector);
array = g_new0 (gint32, n_elements);
if (strvalue)
v = g_string_new ("");
for (j = 0; j < n_elements; j++)
{
pointer v_element = sc->vptr->vector_elem (vector, j);
/* FIXME: Check values in vector stay within range for each type. */
if (! sc->vptr->is_number (v_element))
{
g_free (array);
if (v)
g_string_free (v, TRUE);
return script_type_error_in_container (sc, "numeric", arg_index, j, proc_name, vector);
}
array[j] = (gint32) sc->vptr->ivalue (v_element);
if (v)
g_string_append_printf (v, "%s%d", j == 0 ? "" : " ", array[j]);
}
gimp_value_take_int32_array (value, array, n_elements);
if (v)
{
*strvalue = g_strdup_printf ("#(%s)", v->str);
g_string_free (v, TRUE);
}
debug_vector (sc, vector, "%ld");
}
}
else if (G_VALUE_HOLDS (value, G_TYPE_BYTES))
{
vector = arg_val;
if (! sc->vptr->is_vector (vector))
{
return script_type_error (sc, "vector", arg_index, proc_name);
}
else
{
guint8 *array;
GString *v = NULL;
n_elements = sc->vptr->vector_length (vector);
array = g_new0 (guint8, n_elements);
if (strvalue)
v = g_string_new ("");
for (j = 0; j < n_elements; j++)
{
pointer v_element = sc->vptr->vector_elem (vector, j);
if (!sc->vptr->is_number (v_element))
{
g_free (array);
if (v)
g_string_free (v, TRUE);
return script_type_error_in_container (sc, "numeric", arg_index, j, proc_name, vector);
}
array[j] = (guint8) sc->vptr->ivalue (v_element);
if (v)
g_string_append_printf (v, "%s%d", j == 0 ? "" : " ", array[j]);
}
g_value_take_boxed (value, g_bytes_new_take (array, n_elements));
if (v)
{
*strvalue = g_strdup_printf ("#(%s)", v->str);
g_string_free (v, TRUE);
}
debug_vector (sc, vector, "%ld");
}
}
else if (GIMP_VALUE_HOLDS_DOUBLE_ARRAY (value))
{
vector = arg_val;
if (! sc->vptr->is_vector (vector))
{
return script_type_error (sc, "vector", arg_index, proc_name);
}
else
{
gdouble *array;
GString *v = NULL;
n_elements = sc->vptr->vector_length (vector);
array = g_new0 (gdouble, n_elements);
if (strvalue)
v = g_string_new ("");
for (j = 0; j < n_elements; j++)
{
pointer v_element = sc->vptr->vector_elem (vector, j);
if (!sc->vptr->is_number (v_element))
{
g_free (array);
if (v)
g_string_free (v, TRUE);
return script_type_error_in_container (sc, "numeric", arg_index, j, proc_name, vector);
}
array[j] = (gdouble) sc->vptr->rvalue (v_element);
if (v)
g_string_append_printf (v, "%s%f", j == 0 ? "" : " ", array[j]);
}
gimp_value_take_double_array (value, array, n_elements);
if (v)
{
*strvalue = g_strdup_printf ("#(%s)", v->str);
g_string_free (v, TRUE);
}
debug_vector (sc, vector, "%f");
}
}
else if (GIMP_VALUE_HOLDS_COLOR (value))
{
GeglColor *color = NULL;
if (sc->vptr->is_string (arg_val))
{
gchar *color_string = sc->vptr->string_value (arg_val);
if (! (color = sf_color_get_color_from_name (color_string)))
return script_type_error (sc, "color string", arg_index, proc_name);
if (strvalue)
*strvalue = g_strdup_printf ("\"%s\"", color_string);
}
else if (sc->vptr->is_list (sc, arg_val))
{
pointer color_list = arg_val;
if (! (color = marshal_component_list_to_color (sc, color_list, strvalue)))
return script_type_error (sc, "color list of numeric components", arg_index, proc_name);
}
else
{
return script_type_error (sc, "color string or list", arg_index, proc_name);
}
/* Transfer ownership. */
g_value_take_object (value, color);
}
else if (GIMP_VALUE_HOLDS_COLOR_ARRAY (value))
{
vector = arg_val;
if (! sc->vptr->is_vector (vector))
{
return script_type_error (sc, "vector", arg_index, proc_name);
}
else
{
GeglColor **colors;
GString *v = NULL;
n_elements = sc->vptr->vector_length (vector);
colors = g_new0 (GeglColor *, n_elements + 1);
if (strvalue)
v = g_string_new ("");
for (j = 0; j < n_elements; j++)
{
pointer v_element = sc->vptr->vector_elem (vector, j);
pointer color_list;
guchar rgb[3];
if (! (sc->vptr->is_list (sc,
sc->vptr->pair_car (v_element)) &&
sc->vptr->list_length (sc,
sc->vptr->pair_car (v_element)) == 3))
{
gimp_color_array_free (colors);
g_snprintf (error_str, sizeof (error_str),
"Item %d in vector is not a color "
"(argument %d for function %s)",
j+1, arg_index+1, proc_name);
if (v)
g_string_free (v, TRUE);
return script_error (sc, error_str, 0);
}
color_list = sc->vptr->pair_car (v_element);
rgb[0] = CLAMP (sc->vptr->ivalue (sc->vptr->pair_car (color_list)),
0, 255);
color_list = sc->vptr->pair_cdr (color_list);
rgb[1] = CLAMP (sc->vptr->ivalue (sc->vptr->pair_car (color_list)),
0, 255);
color_list = sc->vptr->pair_cdr (color_list);
rgb[2] = CLAMP (sc->vptr->ivalue (sc->vptr->pair_car (color_list)),
0, 255);
colors[j] = gegl_color_new (NULL);
gegl_color_set_pixel (colors[j], babl_format ("R'G'B' u8"), rgb);
if (v)
g_string_append_printf (v, " '(%d %d %d)", rgb[0], rgb[1], rgb[2]);
}
g_value_take_boxed (value, colors);
if (v)
{
*strvalue = g_strdup_printf ("#(%s)", v->str);
g_string_free (v, TRUE);
}
g_debug ("color vector has %ld elements", sc->vptr->vector_length (vector));
}
}
else if (GIMP_VALUE_HOLDS_PARASITE (value))
{
if (! sc->vptr->is_list (sc, arg_val) ||
sc->vptr->list_length (sc, arg_val) != 3)
{
return script_type_error (sc, "list", arg_index, proc_name);
}
else
{
GimpParasite parasite;
pointer temp_val;
/* parasite->name */
temp_val = arg_val;
if (! sc->vptr->is_string (sc->vptr->pair_car (temp_val)))
return script_type_error_in_container (sc, "string", arg_index, 0, proc_name, 0);
parasite.name =
sc->vptr->string_value (sc->vptr->pair_car (temp_val));
g_debug ("name '%s'", parasite.name);
/* parasite->flags */
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", arg_index, 1, proc_name, 0);
parasite.flags =
sc->vptr->ivalue (sc->vptr->pair_car (temp_val));
g_debug ("flags %d", parasite.flags);
/* parasite->data */
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 (sc, "string", arg_index, 2, proc_name, 0);
parasite.data =
sc->vptr->string_value (sc->vptr->pair_car (temp_val));
parasite.size = strlen (parasite.data);
g_debug ("size %d", parasite.size);
g_debug ("data '%s'", (char *)parasite.data);
g_value_set_boxed (value, &parasite);
if (strvalue)
{
gchar *escaped_name = g_strescape (parasite.name, NULL);
gchar *escaped_data = g_strescape (parasite.data, NULL);
*strvalue = g_strdup_printf ("(\"%s\" %d \"%s\")",
escaped_name, parasite.flags, escaped_data);
g_free (escaped_name);
g_free (escaped_data);
}
}
}
else if (GIMP_VALUE_HOLDS_CORE_OBJECT_ARRAY (value))
{
/* Now PDB procedures take arrays of Item (Drawable, Vectors, etc.).
* When future PDB procedures take arrays of Image, Display, Resource, etc.
* this will need changes.
*/
vector = arg_val;
if (sc->vptr->is_vector (vector))
{
pointer error = marshal_vector_to_item_array (sc, vector, value, strvalue);
if (error)
return error;
}
else
{
return script_type_error (sc, "vector", arg_index, proc_name);
}
}
else if (G_VALUE_TYPE (value) == G_TYPE_FILE)
{
if (! sc->vptr->is_string (arg_val))
return script_type_error (sc, "string for path", arg_index, proc_name);
marshal_path_string_to_gfile (sc, a, value);
if (strvalue)
*strvalue = g_strdup_printf ("%s", sc->vptr->string_value (arg_val));
}
else if (G_VALUE_TYPE (value) == GIMP_TYPE_PDB_STATUS_TYPE)
{
/* A PDB procedure signature wrongly requires a status. */
return implementation_error (sc,
"Status is for return types, not arguments",
arg_val);
}
else if (GIMP_VALUE_HOLDS_RESOURCE (value))
{
if (! sc->vptr->is_integer (arg_val))
{
return script_type_error (sc, "integer", arg_index, proc_name);
}
else
{
/* Create new instance of a resource object. */
GimpResource *resource;
gint resource_id = sc->vptr->ivalue (arg_val);
/* Resource is abstract superclass. Concrete subclass is e.g. Brush.
* The gvalue holds arg_index.e. requires an instance of concrete subclass.
* ID's are unique across all instances of Resource.
*/
if (! gimp_resource_id_is_valid (resource_id))
{
/* Not the ID of any instance of Resource. */
return script_error (sc, "runtime: invalid resource ID", a);
}
resource = gimp_resource_get_by_id (resource_id);
if (! g_value_type_compatible (G_OBJECT_TYPE (resource), G_VALUE_TYPE (value)))
{
/* not the required subclass held by the gvalue */
return script_error (sc, "runtime: resource ID of improper subclass.", a);
}
g_value_set_object (value, resource);
if (strvalue)
*strvalue = g_strdup_printf ("%d", resource_id);
}
}
else if (GIMP_VALUE_HOLDS_EXPORT_OPTIONS (value))
{
/* ExportOptions is work in progress.
* For now, you can't instantiate (no gimp_export_options_new())
* and a script must always pass the equivalent of NULL
* when calling PDB functions having formal arg type ExportOptions.
*
* TEMPORARY: eat the actual Scheme arg but bind to C NULL.
* FUTURE: (unlikely) ScriptFu plugins can use non-NULL export options.
* check Scheme type of actual arg, must be int ID
* create a GimpExportOptions (actually a proxy?)
*/
g_value_set_object (value, NULL);
if (strvalue)
*strvalue = g_strdup_printf ("%d", -1);
}
else
{
g_snprintf (error_str, sizeof (error_str),
"Argument %d for %s is unhandled type %s",
arg_index+1, proc_name, g_type_name (G_VALUE_TYPE (value)));
return implementation_error (sc, error_str, 0);
}
return sc->NIL;
}
/* Called by the Scheme interpreter on calls to GIMP PDB procedures */
static pointer
script_fu_marshal_procedure_call (scheme *sc,
pointer a,
gboolean permissive,
gboolean deprecated)
{
GimpProcedure *procedure;
GimpProcedureConfig *config;
GimpValueArray *values = NULL;
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;
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);
/* The PDB procedure name is the argument or first argument of the list */
if (sc->vptr->is_pair (a))
proc_name = g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
else
proc_name = g_strdup (sc->vptr->string_value (a));
g_debug ("%s, proc name: %s, args rcvd: %d",
G_STRFUNC,
proc_name,
sc->vptr->list_length (sc, a)-1);
if (deprecated )
g_info ("PDB procedure name %s is deprecated, please use %s.",
deprecated_name_for (proc_name),
proc_name);
script_fu_progress_report (proc_name);
/* Attempt to fetch the procedure from the database */
procedure = gimp_pdb_lookup_procedure (gimp_get_pdb (), proc_name);
if (! procedure)
{
g_snprintf (error_str, sizeof (error_str),
"Invalid procedure name: %s", proc_name);
return script_error (sc, error_str, 0);
}
config = gimp_procedure_create_config (procedure);
arg_specs = gimp_procedure_get_arguments (procedure, &n_arg_specs);
actual_arg_count = sc->vptr->list_length (sc, a) - 1;
a = sc->vptr->pair_cdr (a);
/* Check the supplied number of arguments.
* This only gives messages 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".
*/
if (gimp_procedure_is_core (procedure))
{
if (actual_arg_count > n_arg_specs)
{
/* Permit extra args. Will discard args from script, to next right paren.*/
g_info ("in script, permitting too many args to %s", proc_name);
}
else if (actual_arg_count < n_arg_specs)
{
/* Permit too few args. The config carries a sane default for most types. */
g_info ("in script, permitting too few args to %s", proc_name);
}
/* else equal counts of args. */
}
/* Marshall the supplied arguments */
if (gimp_procedure_is_core (procedure) ||
! sc->vptr->is_arg_name (sc->vptr->pair_car (a)))
{
GString *deprecation_warning = NULL;
if (! gimp_procedure_is_core (procedure))
{
deprecation_warning = g_string_new ("Calling Plug-In PDB procedures with arguments as an ordered list is deprecated.\n"
"Please use named arguments: (");
g_string_append (deprecation_warning, proc_name);
}
for (i = 0; i < n_arg_specs; i++)
{
GParamSpec *arg_spec = arg_specs[i];
GValue value = G_VALUE_INIT;
gchar *strvalue = NULL;
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;
}
g_value_init (&value, G_PARAM_SPEC_VALUE_TYPE (arg_spec));
debug_in_arg (sc, a, i, g_type_name (G_VALUE_TYPE (&value)));
return_val = script_fu_marshal_arg_to_value (sc, a, proc_name, i, arg_spec, &value, &strvalue);
if (return_val != sc->NIL)
{
g_value_unset (&value);
return return_val;
}
debug_gvalue (&value);
if (g_param_value_validate (arg_spec, &value))
{
gchar error_message[1024];
g_snprintf (error_message, sizeof (error_message),
"Invalid value for argument %d",
i);
g_value_unset (&value);
return script_error (sc, error_message, 0);
}
g_object_set_property (G_OBJECT (config), arg_specs[i]->name, &value);
g_value_unset (&value);
if (deprecation_warning != NULL)
g_string_append_printf (deprecation_warning, " #:%s %s",
arg_specs[i]->name, strvalue);
a = sc->vptr->pair_cdr (a);
g_free (strvalue);
}
if (deprecation_warning != NULL)
{
g_string_append (deprecation_warning, ")");
g_warning ("%s", deprecation_warning->str);
g_string_free (deprecation_warning, TRUE);
}
}
else
{
for (i = 0; i < actual_arg_count; i++)
{
GParamSpec *arg_spec;
gchar *arg_name;
GValue value = G_VALUE_INIT;
if (! sc->vptr->is_arg_name (sc->vptr->pair_car (a)))
{
g_snprintf (error_str, sizeof (error_str),
"Expected argument name for argument %d", i);
return script_error (sc, error_str, 0);
}
arg_name = g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
arg_spec = g_object_class_find_property (G_OBJECT_GET_CLASS (config), arg_name);
if (arg_spec == NULL)
{
g_snprintf (error_str, sizeof (error_str),
"Invalid argument name: %s", arg_name);
g_free (arg_name);
return script_error (sc, error_str, 0);
}
if (i == actual_arg_count - 1)
{
g_snprintf (error_str, sizeof (error_str),
"Lonely argument with no value: %s", arg_name);
g_free (arg_name);
return script_error (sc, error_str, 0);
}
else
{
a = sc->vptr->pair_cdr (a);
i++;
}
g_value_init (&value, arg_spec->value_type);
return_val = script_fu_marshal_arg_to_value (sc, a, proc_name, i, arg_spec, &value, NULL);
if (return_val != sc->NIL)
{
g_value_unset (&value);
g_free (arg_name);
return return_val;
}
g_object_set_property (G_OBJECT (config), arg_name, &value);
g_value_unset (&value);
a = sc->vptr->pair_cdr (a);
}
}
/* Omit refresh scripts from a script, better than crashing, see #575830. */
if (strcmp (proc_name, "script-fu-refresh") == 0)
return script_error (sc, "A script cannot refresh scripts", 0);
g_debug ("%s, calling:%s", G_STRFUNC, proc_name);
values = gimp_procedure_run_config (procedure, config);
g_clear_object (&config);
/* Check the return status */
if (! values)
{
/* Usually a plugin that crashed, wire error */
g_snprintf (error_str, sizeof(error_str),
"in script, called procedure %s failed to return a status",
proc_name);
return script_error (sc, error_str, 0);
}
{
pointer calling_error;
return_val = marshal_PDB_return (sc, values, proc_name, &calling_error);
/* Now returns error immediately.
* Which leaks memory normally freed below.
* Most plugins, except extension script-fu, will exit soon anyway.
* FUTURE: don't leak.
*/
if (calling_error != NULL)
/* calling error is foreign_error or similar. */
return calling_error;
}
g_free (proc_name);
/* free executed procedure return values */
gimp_value_array_unref (values);
/* free arguments and values */
/* The callback is NULL except for script-fu-server. See explanation there. */
if (post_command_callback != NULL)
post_command_callback ();
#ifdef GDK_WINDOWING_WIN32
/* This seems to help a lot on Windoze. */
while (gtk_events_pending ())
gtk_main_iteration ();
#endif
return return_val;
}
static pointer
script_fu_marshal_procedure_call_strict (scheme *sc,
pointer a)
{
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, 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
script_fu_marshal_drawable_filter_configure (scheme *sc,
pointer a,
const gchar *proc_name,
gint arg_index,
GimpDrawableFilter *filter)
{
pointer return_val = sc->NIL;
GimpLayerMode mode = GIMP_LAYER_MODE_REPLACE;
gdouble opacity = 1.0;
GimpDrawableFilterConfig *config;
gchar error_str[1024];
if (sc->vptr->list_length (sc, a) > 0)
{
mode = sc->vptr->ivalue (sc->vptr->pair_car (a));
a = sc->vptr->pair_cdr (a);
}
if (sc->vptr->list_length (sc, a) > 0)
{
opacity = sc->vptr->rvalue (sc->vptr->pair_car (a));
a = sc->vptr->pair_cdr (a);
}
gimp_drawable_filter_set_opacity (filter, opacity);
gimp_drawable_filter_set_blend_mode (filter, mode);
config = gimp_drawable_filter_get_config (filter);
while (sc->vptr->list_length (sc, a) > 1)
{
gchar *argname;
GParamSpec *arg_spec;
GValue value = G_VALUE_INIT;
if (! sc->vptr->is_arg_name (sc->vptr->pair_car (a)) &&
! sc->vptr->is_string (sc->vptr->pair_car (a)))
{
g_snprintf (error_str, sizeof (error_str),
"Expected argument name for argument %d", arg_index);
return script_error (sc, error_str, 0);
}
argname = g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
arg_spec = g_object_class_find_property (G_OBJECT_GET_CLASS (config), argname);
if (arg_spec == NULL)
{
g_snprintf (error_str, sizeof (error_str),
"Invalid argument name: %s", argname);
g_free (argname);
gimp_drawable_filter_delete (filter);
return script_error (sc, error_str, 0);
}
g_value_init (&value, arg_spec->value_type);
a = sc->vptr->pair_cdr (a);
return_val = script_fu_marshal_arg_to_value (sc, a, proc_name, arg_index, arg_spec, &value, NULL);
if (return_val != sc->NIL)
{
g_value_unset (&value);
g_free (argname);
gimp_drawable_filter_delete (filter);
return return_val;
}
g_object_set_property (G_OBJECT (config), argname, &value);
g_value_unset (&value);
a = sc->vptr->pair_cdr (a);
arg_index += 2;
}
return sc->NIL;
}
static pointer
script_fu_marshal_drawable_create_filter (scheme *sc,
pointer a,
const gchar *proc_name,
GimpDrawable **drawable,
GimpDrawableFilter **filter)
{
gchar *operation_name;
gchar *filter_name = NULL;
gchar error_str[1024];
if (sc->vptr->list_length (sc, a) < 2)
{
g_snprintf (error_str, sizeof (error_str),
"Drawable Filter marshaller was called with missing arguments. "
"The drawable ID, the GEGL operation, filter name, blend mode, opacity "
"and the arguments' names and values it requires (possibly none) must be specified: "
"(%s drawable op title mode opacity arg1 val1 arg2 val2...)",
proc_name);
return implementation_error (sc, error_str, 0);
}
else if (sc->vptr->list_length (sc, a) > 5 && sc->vptr->list_length (sc, a) % 2 != 1)
{
g_snprintf (error_str, sizeof (error_str),
"Drawable Filter marshaller was called with an even number of arguments. "
"The drawable ID, the GEGL operation, filter name, blend mode, opacity "
"and the arguments' names and values it requires (possibly none) must be specified: "
"(%s drawable op title mode opacity arg1 val1 arg2 val2...)",
proc_name);
return implementation_error (sc, error_str, 0);
}
else if (! sc->vptr->is_number (sc->vptr->pair_car (a)))
{
return script_type_error (sc, "numeric", 0, proc_name);
}
else
{
GimpItem *item;
gint id;
id = sc->vptr->ivalue (sc->vptr->pair_car (a));
item = gimp_item_get_by_id (id);
if (item == NULL || ! GIMP_IS_DRAWABLE (item))
{
g_snprintf (error_str, sizeof (error_str),
"Invalid Drawable ID: %d", id);
return script_error (sc, error_str, 0);
}
*drawable = GIMP_DRAWABLE (item);
}
a = sc->vptr->pair_cdr (a);
operation_name = g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
a = sc->vptr->pair_cdr (a);
if (sc->vptr->list_length (sc, a) > 0)
{
if (sc->vptr->is_string (sc->vptr->pair_car (a)))
filter_name = g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
a = sc->vptr->pair_cdr (a);
}
*filter = gimp_drawable_filter_new (*drawable, operation_name, filter_name);
g_free (filter_name);
if (*filter == NULL)
{
g_snprintf (error_str, sizeof (error_str),
"Unknown GEGL Operation: %s", operation_name);
g_free (operation_name);
return script_error (sc, error_str, 0);
}
g_free (operation_name);
return script_fu_marshal_drawable_filter_configure (sc, a, proc_name, 5, *filter);
}
static pointer
script_fu_marshal_drawable_filter_configure_call (scheme *sc,
pointer a)
{
GimpDrawableFilter *filter = NULL;
const gchar *proc_name = "gimp-drawable-filter-configure";
gchar error_str[1024];
if (sc->vptr->list_length (sc, a) < 3)
{
g_snprintf (error_str, sizeof (error_str),
"Drawable Filter marshaller was called with missing arguments. "
"The filter ID, blend mode, opacity and the arguments' names "
"and values it requires (possibly none) must be specified: "
"(%s mode opacity arg1 val1 arg2 val2...)",
proc_name);
return implementation_error (sc, error_str, 0);
}
else if (sc->vptr->list_length (sc, a) > 3 && sc->vptr->list_length (sc, a) % 2 != 1)
{
g_snprintf (error_str, sizeof (error_str),
"Drawable Filter marshaller was called with an even number of arguments. "
"The drawable ID, the GEGL operation, filter name, blend mode, opacity "
"and the arguments' names and values it requires (possibly none) must be specified: "
"(%s mode opacity arg1 val1 arg2 val2...)",
proc_name);
return implementation_error (sc, error_str, 0);
}
else if (! sc->vptr->is_number (sc->vptr->pair_car (a)))
{
return script_type_error (sc, "numeric", 0, proc_name);
}
else
{
gint id;
id = sc->vptr->ivalue (sc->vptr->pair_car (a));
filter = gimp_drawable_filter_get_by_id (id);
if (filter == NULL || ! GIMP_IS_DRAWABLE_FILTER (filter))
{
g_snprintf (error_str, sizeof (error_str),
"Invalid Drawable Filter ID: %d", id);
return script_error (sc, error_str, 0);
}
a = sc->vptr->pair_cdr (a);
}
return script_fu_marshal_drawable_filter_configure (sc, a, proc_name, 3, filter);
}
static pointer
script_fu_marshal_drawable_filter_set_aux_call (scheme *sc,
pointer a)
{
const gchar *proc_name = "gimp-drawable-filter-set-aux-input";
GimpDrawableFilter *filter = NULL;
GimpItem *input = NULL;
gchar *pad_name = NULL;
gint id;
gchar error_str[1024];
if (sc->vptr->list_length (sc, a) != 3)
{
g_snprintf (error_str, sizeof (error_str),
"Drawable Filter marshaller was called with missing arguments. "
"The filter ID, aux pad name and the aux drawable: "
"(%s filter-id pad-name drawable-id)",
proc_name);
return implementation_error (sc, error_str, 0);
}
if (! sc->vptr->is_number (sc->vptr->pair_car (a)))
return script_type_error (sc, "numeric", 0, proc_name);
id = sc->vptr->ivalue (sc->vptr->pair_car (a));
filter = gimp_drawable_filter_get_by_id (id);
if (filter == NULL || ! GIMP_IS_DRAWABLE_FILTER (filter))
{
g_snprintf (error_str, sizeof (error_str),
"Invalid Drawable Filter ID: %d", id);
return script_error (sc, error_str, 0);
}
a = sc->vptr->pair_cdr (a);
if (! sc->vptr->is_string (sc->vptr->pair_car (a)))
/*return script_type_error (sc, "string", 1, proc_name);*/
return script_type_error (sc, "string", 1, "BLAAA");
pad_name = g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
a = sc->vptr->pair_cdr (a);
if (! sc->vptr->is_number (sc->vptr->pair_car (a)))
return script_type_error (sc, "numeric", 2, proc_name);
id = sc->vptr->ivalue (sc->vptr->pair_car (a));
input = gimp_item_get_by_id (id);
if (input == NULL || ! GIMP_IS_DRAWABLE (input))
{
g_snprintf (error_str, sizeof (error_str),
"Invalid Drawable ID: %d", id);
return script_error (sc, error_str, 0);
}
gimp_drawable_filter_set_aux_input (filter, pad_name, GIMP_DRAWABLE (input));
return sc->NIL;
}
static pointer
script_fu_marshal_drawable_merge_filter_call (scheme *sc,
pointer a)
{
const gchar *proc_name = "gimp-drawable-merge-filter";
GimpItem *item;
GimpDrawableFilter *filter;
gint id;
gchar error_str[1024];
if (sc->vptr->list_length (sc, a) != 2)
{
g_snprintf (error_str, sizeof (error_str),
"Drawable Filter marshaller was called with missing arguments. "
"The drawable and filter IDs are required: "
"(%s mode opacity arg1 val1 arg2 val2...)",
proc_name);
return implementation_error (sc, error_str, 0);
}
id = sc->vptr->ivalue (sc->vptr->pair_car (a));
item = gimp_item_get_by_id (id);
if (item == NULL || ! GIMP_IS_DRAWABLE (item))
{
g_snprintf (error_str, sizeof (error_str),
"Invalid Drawable ID: %d", id);
return script_error (sc, error_str, 0);
}
a = sc->vptr->pair_cdr (a);
id = sc->vptr->ivalue (sc->vptr->pair_car (a));
filter = gimp_drawable_filter_get_by_id (id);
if (filter == NULL || ! GIMP_IS_DRAWABLE_FILTER (filter))
{
g_snprintf (error_str, sizeof (error_str),
"Invalid Drawable Filter ID: %d", id);
return script_error (sc, error_str, 0);
}
gimp_drawable_merge_filter (GIMP_DRAWABLE (item), filter);
return sc->NIL;
}
static pointer
script_fu_marshal_drawable_append_filter_call (scheme *sc,
pointer a)
{
const gchar *proc_name = "gimp-drawable-append-filter";
GimpItem *item;
GimpDrawableFilter *filter;
gint id;
gchar error_str[1024];
if (sc->vptr->list_length (sc, a) != 2)
{
g_snprintf (error_str, sizeof (error_str),
"Drawable Filter marshaller was called with missing arguments. "
"The drawable and filter IDs are required: "
"(%s mode opacity arg1 val1 arg2 val2...)",
proc_name);
return implementation_error (sc, error_str, 0);
}
id = sc->vptr->ivalue (sc->vptr->pair_car (a));
item = gimp_item_get_by_id (id);
if (item == NULL || ! GIMP_IS_DRAWABLE (item))
{
g_snprintf (error_str, sizeof (error_str),
"Invalid Drawable ID: %d", id);
return script_error (sc, error_str, 0);
}
a = sc->vptr->pair_cdr (a);
id = sc->vptr->ivalue (sc->vptr->pair_car (a));
filter = gimp_drawable_filter_get_by_id (id);
if (filter == NULL || ! GIMP_IS_DRAWABLE_FILTER (filter))
{
g_snprintf (error_str, sizeof (error_str),
"Invalid Drawable Filter ID: %d", id);
return script_error (sc, error_str, 0);
}
gimp_drawable_append_filter (GIMP_DRAWABLE (item), filter);
return sc->NIL;
}
static pointer
script_fu_marshal_drawable_merge_new_filter_call (scheme *sc,
pointer a)
{
GimpDrawable *drawable = NULL;
GimpDrawableFilter *filter = NULL;
pointer return_val;
return_val = script_fu_marshal_drawable_create_filter (sc, a,
"gimp-drawable-merge-new-filter",
&drawable, &filter);
if (return_val != sc->NIL)
return return_val;
gimp_drawable_merge_filter (drawable, filter);
return sc->NIL;
}
static pointer
script_fu_marshal_drawable_append_new_filter_call (scheme *sc,
pointer a)
{
GimpDrawable *drawable = NULL;
GimpDrawableFilter *filter = NULL;
pointer return_val;
return_val = script_fu_marshal_drawable_create_filter (sc, a,
"gimp-drawable-append-new-filter",
&drawable, &filter);
if (return_val != sc->NIL)
return return_val;
gimp_drawable_append_filter (drawable, filter);
return sc->vptr->mk_integer (sc, gimp_drawable_filter_get_id (filter));
}
static pointer
script_fu_register_call (scheme *sc,
pointer a)
{
return script_fu_add_script (sc, a);
}
static pointer
script_fu_register_call_filter (scheme *sc,
pointer a)
{
return script_fu_add_script_filter (sc, a);
}
static pointer
script_fu_register_call_procedure (scheme *sc,
pointer a)
{
/* Internally "regular" means general "procedure" */
return script_fu_add_script_regular (sc, a);
}
static pointer
script_fu_menu_register_call (scheme *sc,
pointer a)
{
return script_fu_add_menu (sc, a);
}
static pointer
script_fu_use_v3_call (scheme *sc,
pointer a)
{
begin_interpret_v3_dialect ();
return sc->NIL;
}
static pointer
script_fu_use_v2_call (scheme *sc,
pointer a)
{
begin_interpret_v2_dialect ();
return sc->NIL;
}
static pointer
script_fu_quit_call (scheme *sc,
pointer a)
{
/* If script-fu-server running, tell it. */
if (quit_callback != NULL)
quit_callback ();
scheme_deinit (sc);
return sc->NIL;
}
static pointer
script_fu_nil_call (scheme *sc,
pointer a)
{
return sc->NIL;
}
Reference in New Issue View Git Blame Copy Permalink