mirror of
https://gitlab.gnome.org/GNOME/gimp.git
synced 2025-07-04 01:43:24 +00:00
5cc3becf16
Changes are mostly to the dir structures and build system for ScriptFu. Some changes to the outer plugin source to call the library. Why: so that other executables (future gimp-scheme-interpreter, or a future separated script-fu-server) can exist in separate directories, and share the library in memory (when built shared.) Whether the library is built shared and installed on its own (versus static and not installed) is a compile time option (both automake LibTool and meson abstract it away) The default is shared and installed, say as libgimp-scriptfu-3.0.so. Installed alongside other shared libraries (e.g. wherever libgimp is installed) to simplify packaging. A preliminary refactoring which helps enable MR gimp!647
242 lines
7.5 KiB
C
242 lines
7.5 KiB
C
/* 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 <glib.h>
|
|
#include <glib-object.h>
|
|
|
|
#include "tinyscheme/scheme-private.h"
|
|
#include "script-fu-errors.h"
|
|
|
|
|
|
/* Enable logging by "export G_MESSAGES_DEBUG=scriptfu" in the env
|
|
* See G_LOG_DOMAIN in script-fu-errors.h
|
|
*/
|
|
|
|
|
|
|
|
/* Used by debug_in_arg().
|
|
* FUTURE: conditional compile out when debug not enabled.
|
|
*/
|
|
/* These three #defines are from Tinyscheme (tinyscheme/scheme.c) */
|
|
#define T_MASKTYPE 31
|
|
#define typeflag(p) ((p)->_flag)
|
|
#define type(p) (typeflag(p)&T_MASKTYPE)
|
|
|
|
static const char *ts_types[] =
|
|
{
|
|
"T_NONE",
|
|
"T_STRING", "T_NUMBER", "T_SYMBOL", "T_PROC",
|
|
"T_PAIR", "T_CLOSURE", "T_CONTINUATION", "T_FOREIGN",
|
|
"T_CHARACTER", "T_PORT", "T_VECTOR", "T_MACRO",
|
|
"T_PROMISE", "T_ENVIRONMENT","T_ARRAY"
|
|
};
|
|
|
|
|
|
/*
|
|
* Called on event: language error in the author's script.
|
|
* Logs the error and returns a foreign_error.
|
|
* Not all foreign_error are errors in script, some are scriptfu implementation
|
|
* errors or implementation errors in called procedures.
|
|
*
|
|
* This should specialize foreign_error by emphasizing script error.
|
|
* For now, it just specializes by also logging.
|
|
* foreign error does not do logging, since the caller usually logs.
|
|
|
|
* Returns a value which the caller must return to its caller.
|
|
*/
|
|
pointer
|
|
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);
|
|
|
|
/* Return message that will cross the GimpProtocol in a GError in return values
|
|
* to be displayed to GUI user.
|
|
*/
|
|
/* FUTURE prefix with "ScriptFu: in script," */
|
|
return foreign_error (sc, error_message, a);
|
|
}
|
|
|
|
|
|
/* Specialized calls to script_error. */
|
|
|
|
/* Arg has wrong type. */
|
|
pointer
|
|
script_type_error (scheme *sc,
|
|
const gchar *expected_type,
|
|
const guint arg_index,
|
|
const gchar *proc_name)
|
|
{
|
|
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);
|
|
}
|
|
|
|
/* 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)
|
|
{
|
|
gchar error_message[1024];
|
|
|
|
/* convert zero based indices to ordinals */
|
|
g_snprintf (error_message, sizeof (error_message),
|
|
"in script, expected type: %s for element %d of argument %d to %s ",
|
|
expected_type, element_index+1, arg_index+1, proc_name );
|
|
|
|
/* pass container to foreign_error */
|
|
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)
|
|
{
|
|
gchar error_message[1024];
|
|
|
|
/* vector_length returns signed long (???) but expected_length is unsigned */
|
|
g_snprintf (error_message, sizeof (error_message),
|
|
"in script, vector (argument %d) for function %s has "
|
|
"length %ld but expected length %u",
|
|
arg_index+1, proc_name,
|
|
sc->vptr->vector_length (vector), expected_length);
|
|
|
|
/* not pass vector to foreign_error */
|
|
return script_error (sc, error_message, 0);
|
|
}
|
|
|
|
|
|
/* Thin wrapper around foreign_error.
|
|
* Does logging.
|
|
* 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,
|
|
const gchar *error_message,
|
|
const pointer a)
|
|
{
|
|
g_debug ("%s", error_message);
|
|
return foreign_error (sc, error_message, a);
|
|
}
|
|
|
|
|
|
/* Debug helpers.
|
|
* Enabled by G_MESSAGES_DEBUG=scriptfu env var.
|
|
* FUTURE: For performance, return early if not debugging.
|
|
* Or conditionally compile.
|
|
*/
|
|
|
|
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)
|
|
/* real i.e. float */
|
|
g_debug (format,
|
|
sc->vptr->rvalue ( sc->vptr->vector_elem (vector, j) ));
|
|
else
|
|
/* integer */
|
|
g_debug (format,
|
|
sc->vptr->ivalue ( sc->vptr->vector_elem (vector, j) ));
|
|
/* FUTURE vectors of strings or other formats? */
|
|
}
|
|
}
|
|
}
|
|
|
|
/* TinyScheme has no polymorphic length(), elem() methods on containers.
|
|
* Must walk a list with car/cdr.
|
|
*
|
|
* Unlike vectors, lists have a guint length, not gulong
|
|
*
|
|
* !!! Only for lists of strings.
|
|
*/
|
|
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_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 ));
|
|
list = sc->vptr->pair_cdr (list);
|
|
}
|
|
}
|
|
}
|
|
|
|
/* Understands the adapted type system: Scheme interpreter type system.
|
|
* 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 )
|
|
{
|
|
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)));
|
|
}
|
|
|
|
/* Log GValue: its value and its GType
|
|
* FUTURE: for Gimp types, gimp_item_get_id (GIMP_ITEM (<value>)));
|
|
*/
|
|
void
|
|
debug_gvalue (const GValue *value)
|
|
{
|
|
char *contents_str;
|
|
const char *type_name;
|
|
|
|
type_name = G_VALUE_TYPE_NAME(value);
|
|
contents_str = g_strdup_value_contents (value);
|
|
g_debug ("Value: %s Type: %s", contents_str, type_name);
|
|
g_free (contents_str);
|
|
}
|