/* 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 <http://www.gnu.org/licenses/>.
 */

#if 0
#define DEBUG_MARSHALL 0  /* No need to define this until you need it */
#define DEBUG_SCRIPTS  0
#endif

#include "config.h"

#include <string.h>

#include <glib/gstdio.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-console.h"
#include "script-fu-interface.h"
#include "script-fu-regex.h"
#include "script-fu-scripts.h"
#include "script-fu-server.h"

#include "scheme-wrapper.h"


#undef cons

static void     ts_init_constants                (scheme    *sc);
static void     ts_init_procedures               (scheme    *sc,
                                                  gboolean   register_scipts);
static void     convert_string                   (gchar     *str);
static pointer  script_fu_marshal_procedure_call (scheme    *sc,
                                                  pointer    a);
static void     script_fu_marshal_destroy_args   (GimpParam *params,
                                                  gint       n_params);

static pointer  script_fu_register_call          (scheme    *sc,
                                                  pointer    a);
static pointer  script_fu_menu_register_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;

static const NamedConstant const script_constants[] =
{
  /* Useful values from libgimpbase/gimplimits.h */
  { "MIN-IMAGE-SIZE", GIMP_MIN_IMAGE_SIZE },
  { "MAX-IMAGE-SIZE", GIMP_MAX_IMAGE_SIZE },
  { "MIN-RESOLUTION", 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 */
  { "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-VALUE",       SF_VALUE      },
  { "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    },

  /* For SF-ADJUSTMENT */
  { "SF-SLIDER",      SF_SLIDER     },
  { "SF-SPINNER",     SF_SPINNER    },

  { NULL, 0 }
};

/* The following constants are deprecated. They are
 * included to keep backwards compatability with
 * older scripts used with version 2.0 of GIMP.
 */
static const NamedConstant const old_constants[] =
{
  { "NORMAL",               GIMP_NORMAL_MODE       },
  { "DISSOLVE",             GIMP_DISSOLVE_MODE     },
  { "BEHIND",               GIMP_BEHIND_MODE       },
  { "MULTIPLY",             GIMP_MULTIPLY_MODE     },
  { "SCREEN",               GIMP_SCREEN_MODE       },
  { "OVERLAY",              GIMP_OVERLAY_MODE      },
  { "DIFFERENCE",           GIMP_DIFFERENCE_MODE   },
  { "ADDITION",             GIMP_ADDITION_MODE     },
  { "SUBTRACT",             GIMP_SUBTRACT_MODE     },
  { "DARKEN-ONLY",          GIMP_DARKEN_ONLY_MODE  },
  { "LIGHTEN-ONLY",         GIMP_LIGHTEN_ONLY_MODE },
  { "HUE",                  GIMP_HUE_MODE          },
  { "SATURATION",           GIMP_SATURATION_MODE   },
  { "COLOR",                GIMP_COLOR_MODE        },
  { "VALUE",                GIMP_VALUE_MODE        },
  { "DIVIDE",               GIMP_DIVIDE_MODE       },

  { "BLUR",                 GIMP_BLUR_CONVOLVE     },
  { "SHARPEN",              GIMP_SHARPEN_CONVOLVE  },

  { "WHITE-MASK",           GIMP_ADD_WHITE_MASK     },
  { "BLACK-MASK",           GIMP_ADD_BLACK_MASK     },
  { "ALPHA-MASK",           GIMP_ADD_ALPHA_MASK     },
  { "SELECTION-MASK",       GIMP_ADD_SELECTION_MASK },
  { "COPY-MASK",            GIMP_ADD_COPY_MASK      },

  { "ADD",                  GIMP_CHANNEL_OP_ADD       },
  { "SUB",                  GIMP_CHANNEL_OP_SUBTRACT  },
  { "REPLACE",              GIMP_CHANNEL_OP_REPLACE   },
  { "INTERSECT",            GIMP_CHANNEL_OP_INTERSECT },

  { "FG-BG-RGB",            GIMP_FG_BG_RGB_MODE       },
  { "FG-BG-HSV",            GIMP_FG_BG_HSV_MODE       },
  { "FG-TRANS",             GIMP_FG_TRANSPARENT_MODE  },
  { "CUSTOM",               GIMP_CUSTOM_MODE          },

  { "FG-IMAGE-FILL",        GIMP_FOREGROUND_FILL  },
  { "BG-IMAGE-FILL",        GIMP_BACKGROUND_FILL  },
  { "WHITE-IMAGE-FILL",     GIMP_WHITE_FILL       },
  { "TRANS-IMAGE-FILL",     GIMP_TRANSPARENT_FILL },

  { "APPLY",                GIMP_MASK_APPLY   },
  { "DISCARD",              GIMP_MASK_DISCARD },

  { "HARD",                 GIMP_BRUSH_HARD },
  { "SOFT",                 GIMP_BRUSH_SOFT },

  { "CONTINUOUS",           GIMP_PAINT_CONSTANT    },
  { "INCREMENTAL",          GIMP_PAINT_INCREMENTAL },

  { "HORIZONTAL",           GIMP_ORIENTATION_HORIZONTAL },
  { "VERTICAL",             GIMP_ORIENTATION_VERTICAL   },
  { "UNKNOWN",              GIMP_ORIENTATION_UNKNOWN    },

  { "LINEAR",               GIMP_GRADIENT_LINEAR               },
  { "BILINEAR",             GIMP_GRADIENT_BILINEAR             },
  { "RADIAL",               GIMP_GRADIENT_RADIAL               },
  { "SQUARE",               GIMP_GRADIENT_SQUARE               },
  { "CONICAL-SYMMETRIC",    GIMP_GRADIENT_CONICAL_SYMMETRIC    },
  { "CONICAL-ASYMMETRIC",   GIMP_GRADIENT_CONICAL_ASYMMETRIC   },
  { "SHAPEBURST-ANGULAR",   GIMP_GRADIENT_SHAPEBURST_ANGULAR   },
  { "SHAPEBURST-SPHERICAL", GIMP_GRADIENT_SHAPEBURST_SPHERICAL },
  { "SHAPEBURST-DIMPLED",   GIMP_GRADIENT_SHAPEBURST_DIMPLED   },
  { "SPIRAL-CLOCKWISE",     GIMP_GRADIENT_SPIRAL_CLOCKWISE     },
  { "SPIRAL-ANTICLOCKWISE", GIMP_GRADIENT_SPIRAL_ANTICLOCKWISE },

  { "VALUE-LUT",            GIMP_HISTOGRAM_VALUE },
  { "RED-LUT",              GIMP_HISTOGRAM_RED   },
  { "GREEN-LUT",            GIMP_HISTOGRAM_GREEN },
  { "BLUE-LUT",             GIMP_HISTOGRAM_BLUE  },
  { "ALPHA-LUT",            GIMP_HISTOGRAM_ALPHA },

  { NULL, 0 }
};


static scheme sc;


void
tinyscheme_init (const gchar *path,
                 gboolean     register_scripts)
{
  /* init the interpreter */
  if (! scheme_init (&sc))
    {
      g_message ("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);

  /* register in the interpreter the gimp functions and types. */
  ts_init_constants (&sc);
  ts_init_procedures (&sc, register_scripts);

  if (path)
    {
      GList *dir_list = gimp_path_parse (path, 256, TRUE, NULL);
      GList *list;

      for (list = dir_list; list; list = g_list_next (list))
        {
          if (ts_load_file (list->data, "script-fu.init"))
            {
              /*  To improve compatibility with older Script-Fu scripts,
               *  load script-fu-compat.init from the same directory.
               */
              ts_load_file (list->data, "script-fu-compat.init");

              /*  To improve compatibility with older GIMP version,
               *  load plug-in-compat.init from the same directory.
               */
              ts_load_file (list->data, "plug-in-compat.init");

              break;
            }
        }

      if (list == NULL)
        g_printerr ("Unable to read initialization file script-fu.init\n");

      gimp_path_free (dir_list);
    }
}

/* 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)
{
#if DEBUG_SCRIPTS
  sc.print_output = 1;
  sc.tracing = 1;
#endif

  sc.vptr->load_string (&sc, (char *) expr);

  return sc.retcode;
}

const gchar *
ts_get_success_msg (void)
{
  if (sc.vptr->is_string (sc.value))
    return sc.vptr->string_value (sc.value);

  return "Success";
}

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);
}


/*  private functions  */

/*
 * Below can be found the functions responsible for registering the
 * gimp functions and types against the scheme interpreter.
 */
static void
ts_init_constants (scheme *sc)
{
  const gchar **enum_type_names;
  gint          n_enum_type_names;
  gint          i;
  pointer       symbol;

  symbol = sc->vptr->mk_symbol (sc, "gimp-directory");
  sc->vptr->scheme_define (sc, sc->global_env, symbol,
                           sc->vptr->mk_string (sc, gimp_directory ()));
  sc->vptr->setimmutable (symbol);

  symbol = sc->vptr->mk_symbol (sc, "gimp-data-directory");
  sc->vptr->scheme_define (sc, sc->global_env, symbol,
                           sc->vptr->mk_string (sc, gimp_data_directory ()));
  sc->vptr->setimmutable (symbol);

  symbol = sc->vptr->mk_symbol (sc, "gimp-plug-in-directory");
  sc->vptr->scheme_define (sc, sc->global_env, symbol,
                           sc->vptr->mk_string (sc, gimp_plug_in_directory ()));
  sc->vptr->setimmutable (symbol);

  symbol = sc->vptr->mk_symbol (sc, "gimp-locale-directory");
  sc->vptr->scheme_define (sc, sc->global_env, symbol,
                           sc->vptr->mk_string (sc, gimp_locale_directory ()));
  sc->vptr->setimmutable (symbol);

  symbol = sc->vptr->mk_symbol (sc, "gimp-sysconf-directory");
  sc->vptr->scheme_define (sc, sc->global_env, symbol,
                           sc->vptr->mk_string (sc, gimp_sysconf_directory ()));
  sc->vptr->setimmutable (symbol);

  enum_type_names = gimp_enums_get_type_names (&n_enum_type_names);

  for (i = 0; i < n_enum_type_names; i++)
    {
      const gchar *enum_name  = enum_type_names[i];
      GType        enum_type  = g_type_from_name (enum_name);
      GEnumClass  *enum_class = g_type_class_ref (enum_type);
      GEnumValue  *value;

      for (value = enum_class->values; value->value_name; value++)
        {
          if (g_str_has_prefix (value->value_name, "GIMP_"))
            {
              gchar *scheme_name;

              scheme_name = g_strdup (value->value_name + strlen ("GIMP_"));
              convert_string (scheme_name);

              symbol = sc->vptr->mk_symbol (sc, scheme_name);
              sc->vptr->scheme_define (sc, sc->global_env, symbol,
                                       sc->vptr->mk_integer (sc, value->value));
              sc->vptr->setimmutable (symbol);

              g_free (scheme_name);
            }
        }

      g_type_class_unref (enum_class);
    }

  /* Constants used in the register block of scripts */
  for (i = 0; script_constants[i].name != NULL; ++i)
    {
      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);
    }

  /* Define string constant for use in building paths to files/directories */
  symbol = sc->vptr->mk_symbol (sc, "DIR-SEPARATOR");
  sc->vptr->scheme_define (sc, sc->global_env, symbol,
                           sc->vptr->mk_string (sc, G_DIR_SEPARATOR_S));
  sc->vptr->setimmutable (symbol);

  /* Define string constant for use in building search paths */
  symbol = sc->vptr->mk_symbol (sc, "SEARCHPATH-SEPARATOR");
  sc->vptr->scheme_define (sc, sc->global_env, symbol,
                           sc->vptr->mk_string (sc, G_SEARCHPATH_SEPARATOR_S));
  sc->vptr->setimmutable (symbol);

  /* These constants are deprecated and will be removed at a later date. */
  symbol = sc->vptr->mk_symbol (sc, "gimp-dir");
  sc->vptr->scheme_define (sc, sc->global_env, symbol,
                           sc->vptr->mk_string (sc, gimp_directory ()));
  sc->vptr->setimmutable (symbol);

  symbol = sc->vptr->mk_symbol (sc, "gimp-data-dir");
  sc->vptr->scheme_define (sc, sc->global_env, symbol,
                           sc->vptr->mk_string (sc, gimp_data_directory ()));
  sc->vptr->setimmutable (symbol);

  symbol = sc->vptr->mk_symbol (sc, "gimp-plugin-dir");
  sc->vptr->scheme_define (sc, sc->global_env, symbol,
                           sc->vptr->mk_string (sc, gimp_plug_in_directory ()));
  sc->vptr->setimmutable (symbol);

  for (i = 0; old_constants[i].name != NULL; ++i)
    {
      symbol = sc->vptr->mk_symbol (sc, old_constants[i].name);
      sc->vptr->scheme_define (sc, sc->global_env, symbol,
                               sc->vptr->mk_integer (sc,
                                                     old_constants[i].value));
      sc->vptr->setimmutable (symbol);
    }
}

static void
ts_init_procedures (scheme   *sc,
                    gboolean  register_scripts)
{
  gchar   **proc_list;
  gint      num_procs;
  gint      i;
  pointer   symbol;

#if USE_DL
  symbol = sc->vptr->mk_symbol (sc,"load-extension");
  sc->vptr->scheme_define (sc, sc->global_env, symbol,
                           sc->vptr->mk_foreign_func (sc, scm_load_ext));
  sc->vptr->setimmutable (symbol);
#endif

  symbol = sc->vptr->mk_symbol (sc, "script-fu-register");
  sc->vptr->scheme_define (sc, sc->global_env, symbol,
                           sc->vptr->mk_foreign_func (sc,
                                                      register_scripts ?
                                                      script_fu_register_call :
                                                      script_fu_nil_call));
  sc->vptr->setimmutable (symbol);

  symbol = sc->vptr->mk_symbol (sc, "script-fu-menu-register");
  sc->vptr->scheme_define (sc, sc->global_env, symbol,
                           sc->vptr->mk_foreign_func (sc,
                                                      register_scripts ?
                                                      script_fu_menu_register_call :
                                                      script_fu_nil_call));
  sc->vptr->setimmutable (symbol);

  symbol = sc->vptr->mk_symbol (sc, "script-fu-quit");
  sc->vptr->scheme_define (sc, sc->global_env, symbol,
                           sc->vptr->mk_foreign_func (sc, script_fu_quit_call));
  sc->vptr->setimmutable (symbol);

  /*  register the 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));
  sc->vptr->setimmutable (symbol);

  gimp_procedural_db_query (".*", ".*", ".*", ".*", ".*", ".*", ".*",
                            &num_procs, &proc_list);

  /*  Register each procedure as a scheme func  */
  for (i = 0; i < num_procs; i++)
    {
      gchar           *proc_blurb;
      gchar           *proc_help;
      gchar           *proc_author;
      gchar           *proc_copyright;
      gchar           *proc_date;
      GimpPDBProcType  proc_type;
      gint             n_params;
      gint             n_return_vals;
      GimpParamDef    *params;
      GimpParamDef    *return_vals;

      /*  lookup the procedure  */
      if (gimp_procedural_db_proc_info (proc_list[i],
                                        &proc_blurb,
                                        &proc_help,
                                        &proc_author,
                                        &proc_copyright,
                                        &proc_date,
                                        &proc_type,
                                        &n_params, &n_return_vals,
                                        &params, &return_vals))
        {
          gchar *buff;

          /* Build a define that will call the foreign function.
           * The Scheme statement was suggested by Simon Budig.
           */
          if (n_params == 0)
            {
              buff = g_strdup_printf (" (define (%s)"
                                      " (gimp-proc-db-call \"%s\"))",
                                      proc_list[i], proc_list[i]);
            }
          else
            {
              buff = g_strdup_printf (" (define %s (lambda x"
                                      " (apply gimp-proc-db-call (cons \"%s\" x))))",
                                      proc_list[i], proc_list[i]);
            }

          /*  Execute the 'define'  */
          sc->vptr->load_string (sc, buff);

          g_free (buff);

          /*  free the queried information  */
          g_free (proc_blurb);
          g_free (proc_help);
          g_free (proc_author);
          g_free (proc_copyright);
          g_free (proc_date);

          gimp_destroy_paramdefs (params, n_params);
          gimp_destroy_paramdefs (return_vals, n_return_vals);
        }

      g_free (proc_list[i]);
    }

  g_free (proc_list);
}

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;
}

static void
convert_string (gchar *str)
{
  while (*str)
    {
      if (*str == '_') *str = '-';
      str++;
    }
}

/* This is called by the Scheme interpreter to allow calls to GIMP functions */
static pointer
script_fu_marshal_procedure_call (scheme  *sc,
                                  pointer  a)
{
  GimpParam       *args;
  GimpParam       *values = NULL;
  gint             nvalues;
  gchar           *proc_name;
  gchar           *proc_blurb;
  gchar           *proc_help;
  gchar           *proc_author;
  gchar           *proc_copyright;
  gchar           *proc_date;
  GimpPDBProcType  proc_type;
  gint             nparams;
  gint             nreturn_vals;
  GimpParamDef    *params;
  GimpParamDef    *return_vals;
  gchar            error_str[1024];
  gint             i;
  gint             success = TRUE;
  pointer          return_val = sc->NIL;

#if DEBUG_MARSHALL
/* 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"
  };

  g_printerr ("\nIn %s()\n", G_STRFUNC);
#endif

  /*  Make sure there are arguments  */
  if (a == sc->NIL)
    return foreign_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));

#ifdef DEBUG_MARSHALL
  g_printerr ("  proc name: %s\n", proc_name);
  g_printerr ("  parms rcvd: %d\n", sc->vptr->list_length (sc, a)-1);
#endif

  /*  report the current command  */
  script_fu_interface_report_cc (proc_name);

  /*  Attempt to fetch the procedure from the database  */
  if (! gimp_procedural_db_proc_info (proc_name,
                                      &proc_blurb,
                                      &proc_help,
                                      &proc_author,
                                      &proc_copyright,
                                      &proc_date,
                                      &proc_type,
                                      &nparams, &nreturn_vals,
                                      &params, &return_vals))
    {
#ifdef DEBUG_MARSHALL
      g_printerr ("  Invalid procedure name\n");
#endif
      g_snprintf (error_str, sizeof (error_str),
                  "Invalid procedure name %s specified", proc_name);
      return foreign_error (sc, error_str, 0);
    }

  /* Free the name and the description which are of no use here.  */
  for (i = 0; i < nparams; i++)
    {
      g_free (params[i].name);
      g_free (params[i].description);
    }
  for (i = 0; i < nreturn_vals; i++)
    {
      g_free (return_vals[i].name);
      g_free (return_vals[i].description);
    }

  /*  Check the supplied number of arguments  */
  if ((sc->vptr->list_length (sc, a) - 1) != nparams)
    {
#if DEBUG_MARSHALL
      g_printerr ("  Invalid number of arguments (expected %d but received %d)",
                  nparams, (sc->vptr->list_length (sc, a) - 1));
#endif
      g_snprintf (error_str, sizeof (error_str),
                  "Invalid number of arguments for %s (expected %d but received %d)",
                  proc_name, nparams, (sc->vptr->list_length (sc, a) - 1));
      return foreign_error (sc, error_str, 0);
    }

  /*  Marshall the supplied arguments  */
  if (nparams)
    args = g_new (GimpParam, nparams);
  else
    args = NULL;

  for (i = 0; i < nparams; i++)
    {
      gint32  n_elements;
      pointer vector;
      gint    j;

      a = sc->vptr->pair_cdr (a);

#if DEBUG_MARSHALL
      {
        const gchar *type_name;

        gimp_enum_get_value (GIMP_TYPE_PDB_ARG_TYPE,
                             params[i].type,
                             &type_name, NULL, NULL, NULL);

        g_printerr ("    param %d - expecting type %s (%d)\n",
                    i + 1, type_name, params[i].type);
        g_printerr ("      passed arg is type %s (%d)\n",
                    ts_types[ type(sc->vptr->pair_car (a)) ],
                    type(sc->vptr->pair_car (a)));
      }
#endif

      args[i].type = params[i].type;

      switch (params[i].type)
        {
        case GIMP_PDB_INT32:
        case GIMP_PDB_DISPLAY:
        case GIMP_PDB_IMAGE:
        case GIMP_PDB_ITEM:
        case GIMP_PDB_LAYER:
        case GIMP_PDB_CHANNEL:
        case GIMP_PDB_DRAWABLE:
        case GIMP_PDB_SELECTION:
        case GIMP_PDB_VECTORS:
          if (!sc->vptr->is_number (sc->vptr->pair_car (a)))
            success = FALSE;
          if (success)
            {
              args[i].data.d_int32 = sc->vptr->ivalue (sc->vptr->pair_car (a));
#if DEBUG_MARSHALL
              g_printerr ("      int32 arg is '%d'\n", args[i].data.d_int32);
#endif
            }
          break;

        case GIMP_PDB_INT16:
          if (!sc->vptr->is_number (sc->vptr->pair_car (a)))
            success = FALSE;
          if (success)
            {
              args[i].data.d_int16 = (gint16) sc->vptr->ivalue (sc->vptr->pair_car (a));
#if DEBUG_MARSHALL
              g_printerr ("      int16 arg is '%d'\n", args[i].data.d_int16);
#endif
            }
          break;

        case GIMP_PDB_INT8:
          if (!sc->vptr->is_number (sc->vptr->pair_car (a)))
            success = FALSE;
          if (success)
            {
              args[i].data.d_int8 = (guint8) sc->vptr->ivalue (sc->vptr->pair_car (a));
#if DEBUG_MARSHALL
              g_printerr ("      int8 arg is '%u'\n", args[i].data.d_int8);
#endif
            }
          break;

        case GIMP_PDB_FLOAT:
          if (!sc->vptr->is_number (sc->vptr->pair_car (a)))
            success = FALSE;
          if (success)
            {
              args[i].data.d_float = sc->vptr->rvalue (sc->vptr->pair_car (a));
#if DEBUG_MARSHALL
              g_printerr ("      float arg is '%f'\n", args[i].data.d_float);
#endif
            }
          break;

        case GIMP_PDB_STRING:
          if (!sc->vptr->is_string (sc->vptr->pair_car (a)))
            success = FALSE;
          if (success)
            {
              args[i].data.d_string = sc->vptr->string_value (sc->vptr->pair_car (a));
#if DEBUG_MARSHALL
              g_printerr ("      string arg is '%s'\n", args[i].data.d_string);
#endif
            }
          break;

        case GIMP_PDB_INT32ARRAY:
          vector = sc->vptr->pair_car (a);
          if (!sc->vptr->is_vector (vector))
            success = FALSE;
          if (success)
            {
              n_elements = args[i-1].data.d_int32;
              if (n_elements < 0 ||
                  n_elements > sc->vptr->vector_length (vector))
                {
                  g_snprintf (error_str, sizeof (error_str),
                              "INT32 vector (argument %d) for function %s has "
                              "size of %ld but expected size of %d",
                              i+1, proc_name,
                              sc->vptr->vector_length (vector), n_elements);
                  return foreign_error (sc, error_str, 0);
                }

              args[i].data.d_int32array = g_new (gint32, n_elements);

              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_snprintf (error_str, sizeof (error_str),
                                  "Item %d in vector is not a number (argument %d for function %s)",
                                  j+1, i+1, proc_name);
                      return foreign_error (sc, error_str, vector);
                    }

                  args[i].data.d_int32array[j] =
                      (gint32) sc->vptr->ivalue (v_element);
                }

#if DEBUG_MARSHALL
              {
                glong count = sc->vptr->vector_length (vector);
                g_printerr ("      int32 vector has %ld elements\n", count);
                if (count > 0)
                  {
                    g_printerr ("     ");
                    for (j = 0; j < count; ++j)
                      g_printerr (" %ld",
                                  sc->vptr->ivalue ( sc->vptr->vector_elem (vector, j) ));
                    g_printerr ("\n");
                  }
              }
#endif
            }
          break;

        case GIMP_PDB_INT16ARRAY:
          vector = sc->vptr->pair_car (a);
          if (!sc->vptr->is_vector (vector))
            success = FALSE;
          if (success)
            {
              n_elements = args[i-1].data.d_int32;
              if (n_elements < 0 || n_elements > sc->vptr->vector_length (vector))
                {
                  g_snprintf (error_str, sizeof (error_str),
                              "INT16 vector (argument %d) for function %s has "
                              "size of %ld but expected size of %d",
                              i+1, proc_name, sc->vptr->vector_length (vector), n_elements);
                  return foreign_error (sc, error_str, 0);
                }

              args[i].data.d_int16array = g_new (gint16, n_elements);

              for (j = 0; j < n_elements; j++)
                {
                  pointer v_element = sc->vptr->vector_elem (vector, j);

                  if (!sc->vptr->is_number (v_element))
                    {
                      g_snprintf (error_str, sizeof (error_str),
                                  "Item %d in vector is not a number (argument %d for function %s)",
                                  j+1, i+1, proc_name);
                      return foreign_error (sc, error_str, vector);
                    }

                  args[i].data.d_int16array[j] =
                      (gint16) sc->vptr->ivalue (v_element);
                }

#if DEBUG_MARSHALL
              {
                glong count = sc->vptr->vector_length (vector);
                g_printerr ("      int16 vector has %ld elements\n", count);
                if (count > 0)
                  {
                    g_printerr ("     ");
                    for (j = 0; j < count; ++j)
                      g_printerr (" %ld",
                                  sc->vptr->ivalue ( sc->vptr->vector_elem (vector, j) ));
                    g_printerr ("\n");
                  }
              }
#endif
            }
          break;

        case GIMP_PDB_INT8ARRAY:
          vector = sc->vptr->pair_car (a);
          if (!sc->vptr->is_vector (vector))
            success = FALSE;
          if (success)
            {
              n_elements = args[i-1].data.d_int32;
              if (n_elements < 0 ||
                  n_elements > sc->vptr->vector_length (vector))
                {
                  g_snprintf (error_str, sizeof (error_str),
                              "INT8 vector (argument %d) for function %s has "
                              "size of %ld but expected size of %d",
                              i+1, proc_name,
                              sc->vptr->vector_length (vector), n_elements);
                  return foreign_error (sc, error_str, 0);
                }

              args[i].data.d_int8array = g_new (guint8, n_elements);

              for (j = 0; j < n_elements; j++)
                {
                  pointer v_element = sc->vptr->vector_elem (vector, j);

                  if (!sc->vptr->is_number (v_element))
                    {
                      g_snprintf (error_str, sizeof (error_str),
                                  "Item %d in vector is not a number (argument %d for function %s)",
                                  j+1, i+1, proc_name);
                      return foreign_error (sc, error_str, vector);
                    }

                  args[i].data.d_int8array[j] =
                      (guint8) sc->vptr->ivalue (v_element);
                }

#if DEBUG_MARSHALL
              {
                glong count = sc->vptr->vector_length (vector);
                g_printerr ("      int8 vector has %ld elements\n", count);
                if (count > 0)
                  {
                    g_printerr ("     ");
                    for (j = 0; j < count; ++j)
                      g_printerr (" %ld",
                                  sc->vptr->ivalue ( sc->vptr->vector_elem (vector, j) ));
                    g_printerr ("\n");
                  }
              }
#endif
            }
          break;

        case GIMP_PDB_FLOATARRAY:
          vector = sc->vptr->pair_car (a);
          if (!sc->vptr->is_vector (vector))
            success = FALSE;
          if (success)
            {
              n_elements = args[i-1].data.d_int32;
              if (n_elements < 0 ||
                  n_elements > sc->vptr->vector_length (vector))
                {
                  g_snprintf (error_str, sizeof (error_str),
                              "FLOAT vector (argument %d) for function %s has "
                              "size of %ld but expected size of %d",
                              i+1, proc_name,
                              sc->vptr->vector_length (vector), n_elements);
                  return foreign_error (sc, error_str, 0);
                }

              args[i].data.d_floatarray = g_new (gdouble, n_elements);

              for (j = 0; j < n_elements; j++)
                {
                  pointer v_element = sc->vptr->vector_elem (vector, j);

                  if (!sc->vptr->is_number (v_element))
                    {
                      g_snprintf (error_str, sizeof (error_str),
                                  "Item %d in vector is not a number (argument %d for function %s)",
                                  j+1, i+1, proc_name);
                      return foreign_error (sc, error_str, vector);
                    }

                  args[i].data.d_floatarray[j] =
                      (gfloat) sc->vptr->rvalue (v_element);
                }

#if DEBUG_MARSHALL
              {
                glong count = sc->vptr->vector_length (vector);
                g_printerr ("      float vector has %ld elements\n", count);
                if (count > 0)
                  {
                    g_printerr ("     ");
                    for (j = 0; j < count; ++j)
                      g_printerr (" %f",
                                  sc->vptr->rvalue ( sc->vptr->vector_elem (vector, j) ));
                    g_printerr ("\n");
                  }
              }
#endif
            }
          break;

        case GIMP_PDB_STRINGARRAY:
          vector = sc->vptr->pair_car (a);  /* vector is pointing to a list */
          if (!sc->vptr->is_list (sc, vector))
            success = FALSE;
          if (success)
            {
              n_elements = args[i - 1].data.d_int32;
              if (n_elements < 0 ||
                  n_elements > sc->vptr->list_length (sc, vector))
                {
                  g_snprintf (error_str, sizeof (error_str),
                              "STRING vector (argument %d) for function %s has "
                              "length of %d but expected length of %d",
                              i+1, proc_name,
                              sc->vptr->list_length (sc, vector), n_elements);
                  return foreign_error (sc, error_str, 0);
                }

              args[i].data.d_stringarray = g_new (gchar *, n_elements);

              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, i+1, proc_name);
                      return foreign_error (sc, error_str, vector);
                    }

                  args[i].data.d_stringarray[j] =
                      (gchar *) sc->vptr->string_value (v_element);

                  vector = sc->vptr->pair_cdr (vector);
                }

#if DEBUG_MARSHALL
              {
                glong count = sc->vptr->list_length ( sc, sc->vptr->pair_car (a) );
                g_printerr ("      string vector has %ld elements\n", count);
                if (count > 0)
                  {
                    g_printerr ("     ");
                    for (j = 0; j < count; ++j)
                      g_printerr (" \"%s\"",
                                  args[i].data.d_stringarray[j]);
                    g_printerr ("\n");
                  }
              }
#endif
            }
          break;

        case GIMP_PDB_COLOR:
          if (sc->vptr->is_string (sc->vptr->pair_car (a)))
            {
              if (! gimp_rgb_parse_css (&args[i].data.d_color,
                                        sc->vptr->string_value (sc->vptr->pair_car (a)),
                                        -1))
                success = FALSE;

              gimp_rgb_set_alpha (&args[i].data.d_color, 1.0);
#if DEBUG_MARSHALL
              g_printerr ("      (%s)\n",
                          sc->vptr->string_value (sc->vptr->pair_car (a)));
#endif
            }
          else if (sc->vptr->is_list (sc, sc->vptr->pair_car (a)) &&
                   sc->vptr->list_length (sc, sc->vptr->pair_car (a)) == 3)
            {
              pointer color_list;
              guchar  r = 0, g = 0, b = 0;

              color_list = sc->vptr->pair_car (a);
              if (sc->vptr->is_number (sc->vptr->pair_car (color_list)))
                r = CLAMP (sc->vptr->ivalue (sc->vptr->pair_car (color_list)),
                           0, 255);
              else
                success = FALSE;

              color_list = sc->vptr->pair_cdr (color_list);
              if (sc->vptr->is_number (sc->vptr->pair_car (color_list)))
                g = CLAMP (sc->vptr->ivalue (sc->vptr->pair_car (color_list)),
                           0, 255);
              else
                success = FALSE;

              color_list = sc->vptr->pair_cdr (color_list);
              if (sc->vptr->is_number (sc->vptr->pair_car (color_list)))
                b = CLAMP (sc->vptr->ivalue (sc->vptr->pair_car (color_list)),
                           0, 255);
              else
                success = FALSE;

              if (success)
                gimp_rgba_set_uchar (&args[i].data.d_color, r, g, b, 255);
#if DEBUG_MARSHALL
              if (success)
                g_printerr ("      (%d %d %d)\n", r, g, b);
              else
                g_printerr ("      COLOR list contains non-numbers\n");
#endif
            }
          else
            {
              success = FALSE;
            }
          break;

        case GIMP_PDB_COLORARRAY:
          vector = sc->vptr->pair_car (a);
          if (!sc->vptr->is_vector (vector))
            success = FALSE;
          if (success)
            {
              n_elements = args[i-1].data.d_int32;
              if (n_elements < 0 ||
                  n_elements > sc->vptr->vector_length (vector))
                {
                  g_snprintf (error_str, sizeof (error_str),
                              "COLOR vector (argument %d) for function %s has "
                              "size of %ld but expected size of %d",
                              i+1, proc_name,
                              sc->vptr->vector_length (vector), n_elements);
                  return foreign_error (sc, error_str, 0);
                }

              args[i].data.d_colorarray = g_new (GimpRGB, n_elements);

              for (j = 0; j < n_elements; j++)
                {
                  pointer v_element = sc->vptr->vector_elem (vector, j);
                  pointer color_list;
                  guchar  r, g, b;

                  if (! (sc->vptr->is_list (sc,
                                            sc->vptr->pair_car (v_element)) &&
                         sc->vptr->list_length (sc,
                                                sc->vptr->pair_car (v_element)) == 3))
                    {
                      g_snprintf (error_str, sizeof (error_str),
                                  "Item %d in vector is not a color "
                                  "(argument %d for function %s)",
                                  j+1, i+1, proc_name);
                      return foreign_error (sc, error_str, vector);
                    }

                  color_list = sc->vptr->pair_car (v_element);
                  r = CLAMP (sc->vptr->ivalue (sc->vptr->pair_car (color_list)),
                             0, 255);
                  color_list = sc->vptr->pair_cdr (color_list);
                  g = CLAMP (sc->vptr->ivalue (sc->vptr->pair_car (color_list)),
                             0, 255);
                  color_list = sc->vptr->pair_cdr (color_list);
                  b = CLAMP (sc->vptr->ivalue (sc->vptr->pair_car (color_list)),
                             0, 255);

                  gimp_rgba_set_uchar (&args[i].data.d_colorarray[j],
                                       r, g, b, 255);
                }
#if DEBUG_MARSHALL
              {
                glong count = sc->vptr->vector_length (vector);
                g_printerr ("      color vector has %ld elements\n", count);
              }
#endif
            }
          break;

        case GIMP_PDB_PARASITE:
          if (!sc->vptr->is_list (sc, sc->vptr->pair_car (a)) ||
              sc->vptr->list_length (sc, sc->vptr->pair_car (a)) != 3)
            success = FALSE;
          if (success)
            {
              pointer temp_val;

              /* parasite->name */
              temp_val = sc->vptr->pair_car (a);

              if (!sc->vptr->is_string (sc->vptr->pair_car (temp_val)))
                {
                  success = FALSE;
                  break;
                }

              args[i].data.d_parasite.name =
                sc->vptr->string_value (sc->vptr->pair_car (temp_val));
#if DEBUG_MARSHALL
              g_printerr ("      name '%s'\n", args[i].data.d_parasite.name);
#endif

              /* parasite->flags */
              temp_val = sc->vptr->pair_cdr (temp_val);

              if (!sc->vptr->is_number (sc->vptr->pair_car (temp_val)))
                {
                  success = FALSE;
                  break;
                }

              args[i].data.d_parasite.flags =
                sc->vptr->ivalue (sc->vptr->pair_car (temp_val));
#if DEBUG_MARSHALL
              g_printerr ("      flags %d", args[i].data.d_parasite.flags);
#endif

              /* parasite->data */
              temp_val = sc->vptr->pair_cdr (temp_val);

              if (!sc->vptr->is_string (sc->vptr->pair_car (temp_val)))
                {
                  success = FALSE;
                  break;
                }

              args[i].data.d_parasite.data =
                sc->vptr->string_value (sc->vptr->pair_car (temp_val));
              args[i].data.d_parasite.size = strlen (args[i].data.d_parasite.data);

#if DEBUG_MARSHALL
              g_printerr (", size %d\n", args[i].data.d_parasite.size);
              g_printerr ("      data '%s'\n", (char *)args[i].data.d_parasite.data);
#endif
            }
          break;

        case GIMP_PDB_STATUS:
          return foreign_error (sc,
                                "Status is for return types, not arguments",
                                sc->vptr->pair_car (a));
          break;

        default:
          g_snprintf (error_str, sizeof (error_str),
                      "Argument %d for %s is an unknown type",
                      i+1, proc_name);
          return foreign_error (sc, error_str, 0);
        }

      /* Break out of loop before i gets updated when error was detected */
      if (! success)
        break;
    }

  if (success)
    {
#if DEBUG_MARSHALL
      g_printerr ("    calling %s...", proc_name);
#endif
      values = gimp_run_procedure2 (proc_name, &nvalues, nparams, args);
#if DEBUG_MARSHALL
      g_printerr ("  done.\n");
#endif
    }
  else
    {
#if DEBUG_MARSHALL
      g_printerr ("  Invalid type for argument %d\n", i+1);
#endif
      g_snprintf (error_str, sizeof (error_str),
                  "Invalid type for argument %d to %s",
                  i+1, proc_name);
      return foreign_error (sc, error_str, 0);
    }

  /*  Check the return status  */
  if (! values)
    {
#if DEBUG_MARSHALL
      g_printerr ("  Did not return status\n");
#endif
      g_snprintf (error_str, sizeof(error_str),
                  "Procedure execution of %s did not return a status",
                  proc_name);

      return foreign_error (sc, error_str, 0);
    }

#if DEBUG_MARSHALL
  {
    const gchar *status_name;

    gimp_enum_get_value (GIMP_TYPE_PDB_STATUS_TYPE,
                         values[0].data.d_status,
                         &status_name, NULL, NULL, NULL);
    g_printerr ("    return value is %s\n", status_name);
  }
#endif

  switch (values[0].data.d_status)
    {
    case GIMP_PDB_EXECUTION_ERROR:
      if (nvalues > 1 && values[1].type == GIMP_PDB_STRING)
        {
          g_snprintf (error_str, sizeof (error_str),
                      "Procedure execution of %s failed: %s",
                      proc_name, values[1].data.d_string);
        }
      else
        {
          g_snprintf (error_str, sizeof (error_str),
                      "Procedure execution of %s failed",
                      proc_name);
        }
      return foreign_error (sc, error_str, 0);
      break;

    case GIMP_PDB_CALLING_ERROR:
      if (nvalues > 1 && values[1].type == GIMP_PDB_STRING)
        {
          g_snprintf (error_str, sizeof (error_str),
                      "Procedure execution of %s failed on invalid input arguments: %s",
                      proc_name, values[1].data.d_string);
        }
      else
        {
          g_snprintf (error_str, sizeof (error_str),
                      "Procedure execution of %s failed on invalid input arguments",
                      proc_name);
        }
      return foreign_error (sc, error_str, 0);
      break;

    case GIMP_PDB_SUCCESS:
#if DEBUG_MARSHALL
      g_printerr ("    values returned: %d\n", nvalues-1);
#endif
      for (i = nvalues - 2; i >= 0; --i)
        {
          const gchar *string;
          gint         j;

#if DEBUG_MARSHALL
          {
            const gchar *type_name;

            gimp_enum_get_value (GIMP_TYPE_PDB_ARG_TYPE,
                                 return_vals[i].type,
                                 &type_name, NULL, NULL, NULL);

            g_printerr ("      value %d is type %s (%d)\n",
                        i, type_name, return_vals[i].type);
          }
#endif
          switch (return_vals[i].type)
            {
            case GIMP_PDB_INT32:
            case GIMP_PDB_DISPLAY:
            case GIMP_PDB_IMAGE:
            case GIMP_PDB_ITEM:
            case GIMP_PDB_LAYER:
            case GIMP_PDB_CHANNEL:
            case GIMP_PDB_DRAWABLE:
            case GIMP_PDB_SELECTION:
            case GIMP_PDB_VECTORS:
              return_val = sc->vptr->cons (sc,
                             sc->vptr->mk_integer (sc,
                                                   values[i + 1].data.d_int32),
                             return_val);
              break;

            case GIMP_PDB_INT16:
              return_val = sc->vptr->cons (sc,
                             sc->vptr->mk_integer (sc,
                                                   values[i + 1].data.d_int16),
                             return_val);
              break;

            case GIMP_PDB_INT8:
              return_val = sc->vptr->cons (sc,
                             sc->vptr->mk_integer (sc,
                                                   values[i + 1].data.d_int8),
                             return_val);
              break;

            case GIMP_PDB_FLOAT:
              return_val = sc->vptr->cons (sc,
                             sc->vptr->mk_real (sc,
                                                values[i + 1].data.d_float),
                             return_val);
              break;

            case GIMP_PDB_STRING:
              string = values[i + 1].data.d_string;
              if (! string)
                string = "";
              return_val = sc->vptr->cons (sc,
                             sc->vptr->mk_string (sc, string),
                             return_val);
              break;

            case GIMP_PDB_INT32ARRAY:
              {
                gint32  num_int32s = values[i].data.d_int32;
                gint32 *array      = (gint32 *) values[i + 1].data.d_int32array;
                pointer vector     = sc->vptr->mk_vector (sc, num_int32s);

                for (j = 0; j < num_int32s; j++)
                  {
                    sc->vptr->set_vector_elem (vector, j,
                                               sc->vptr->mk_integer (sc,
                                                                     array[j]));
                  }

                return_val = sc->vptr->cons (sc, vector, return_val);
              }
              break;

            case GIMP_PDB_INT16ARRAY:
              {
                gint32  num_int16s = values[i].data.d_int32;
                gint16 *array      = (gint16 *) values[i + 1].data.d_int16array;
                pointer vector     = sc->vptr->mk_vector (sc, num_int16s);

                for (j = 0; j < num_int16s; j++)
                  {
                    sc->vptr->set_vector_elem (vector, j,
                                               sc->vptr->mk_integer (sc,
                                                                     array[j]));
                  }

                return_val = sc->vptr->cons (sc, vector, return_val);
              }
              break;

            case GIMP_PDB_INT8ARRAY:
              {
                gint32  num_int8s = values[i].data.d_int32;
                guint8 *array     = (guint8 *) values[i + 1].data.d_int8array;
                pointer vector    = sc->vptr->mk_vector (sc, num_int8s);

                for (j = 0; j < num_int8s; j++)
                  {
                    sc->vptr->set_vector_elem (vector, j,
                                               sc->vptr->mk_integer (sc,
                                                                     array[j]));
                  }

                return_val = sc->vptr->cons (sc, vector, return_val);
              }
              break;

            case GIMP_PDB_FLOATARRAY:
              {
                gint32   num_floats = values[i].data.d_int32;
                gdouble *array      = (gdouble *) values[i + 1].data.d_floatarray;
                pointer  vector     = sc->vptr->mk_vector (sc, num_floats);

                for (j = 0; j < num_floats; j++)
                  {
                    sc->vptr->set_vector_elem (vector, j,
                                               sc->vptr->mk_real (sc,
                                                                  array[j]));
                  }

                return_val = sc->vptr->cons (sc, vector, return_val);
              }
              break;

            case GIMP_PDB_STRINGARRAY:
              {
                gint    num_strings = values[i].data.d_int32;
                gchar **array       = (gchar **) values[i + 1].data.d_stringarray;
                pointer list        = sc->NIL;

                for (j = num_strings - 1; j >= 0; j--)
                  {
                    list = sc->vptr->cons (sc,
                                           sc->vptr->mk_string (sc,
                                                                array[j] ?
                                                                array[j] : ""),
                                           list);
                  }

                return_val = sc->vptr->cons (sc, list, return_val);
              }
              break;

            case GIMP_PDB_COLOR:
              {
                guchar   r, g, b;
                gpointer temp_val;

                gimp_rgb_get_uchar (&values[i + 1].data.d_color, &r, &g, &b);

                temp_val = sc->vptr->cons (sc,
                             sc->vptr->mk_integer (sc, r),
                             sc->vptr->cons (sc,
                               sc->vptr->mk_integer (sc, g),
                               sc->vptr->cons (sc,
                                 sc->vptr->mk_integer (sc, b),
                                 sc->NIL)));
                return_val = sc->vptr->cons (sc,
                                             temp_val,
                                             return_val);
                break;
              }

            case GIMP_PDB_COLORARRAY:
              {
                gint32   num_colors = values[i].data.d_int32;
                GimpRGB *array      = (GimpRGB *) values[i + 1].data.d_colorarray;
                pointer  vector     = sc->vptr->mk_vector (sc, num_colors);

                for (j = 0; j < num_colors; j++)
                  {
                    guchar  r, g, b;
                    pointer temp_val;

                    gimp_rgb_get_uchar (&array[j], &r, &g, &b);

                    temp_val = sc->vptr->cons (sc,
                                 sc->vptr->mk_integer (sc, r),
                                 sc->vptr->cons (sc,
                                   sc->vptr->mk_integer (sc, g),
                                   sc->vptr->cons (sc,
                                     sc->vptr->mk_integer (sc, b),
                                     sc->NIL)));
                    sc->vptr->set_vector_elem (vector, j, temp_val);
                  }

                return_val = sc->vptr->cons (sc, vector, return_val);
              }
              break;

            case GIMP_PDB_PARASITE:
              {
                if (values[i + 1].data.d_parasite.name == NULL)
                  {
                    return_val = foreign_error (sc, "Error: null parasite", 0);
                  }
                else
                  {
                    GimpParasite *p = &values[i + 1].data.d_parasite;
                    gchar        *data = g_strndup (p->data, p->size);
                    gint          char_cnt = g_utf8_strlen (data, p->size);
                    pointer       temp_val;

                    /* don't move the mk_foo() calls outside this function call,
                     * otherwise they might be garbage collected away!
                     */
                    temp_val = sc->vptr->cons (sc,
                                 sc->vptr->mk_string (sc, p->name),
                                 sc->vptr->cons (sc,
                                   sc->vptr->mk_integer (sc, p->flags),
                                   sc->vptr->cons (sc,
                                     sc->vptr->mk_counted_string (sc,
                                                                  data,
                                                                  char_cnt),
                                     sc->NIL)));
                    return_val = sc->vptr->cons (sc,
                                                 temp_val,
                                                 return_val);
                    g_free (data);

#if DEBUG_MARSHALL
                    g_printerr ("      name '%s'\n", p->name);
                    g_printerr ("      flags %d", p->flags);
                    g_printerr (", size %d\n", p->size);
                    g_printerr ("      data '%.*s'\n",
                                p->size, (gchar *) p->data);
#endif
                  }
              }
              break;

            case GIMP_PDB_STATUS:
              return foreign_error (sc, "Procedure execution returned multiple status values", 0);
              break;

            default:
              return foreign_error (sc, "Unknown return type", 0);
            }
        }

    case GIMP_PDB_PASS_THROUGH:
    case GIMP_PDB_CANCEL:   /*  should we do something here?  */
      break;
    }

  /* If we have no return value(s) from PDB call, return
   * either TRUE or FALSE to indicate if call succeeded.
   */
  if (return_val == sc->NIL)
    {
      if (values[0].data.d_status == GIMP_PDB_SUCCESS)
        return_val = sc->vptr->cons (sc, sc->T, sc->NIL);
      else
        return_val = sc->vptr->cons (sc, sc->F, sc->NIL);
    }

  /*  free the proc name  */
  g_free (proc_name);

  /*  free up the executed procedure return values  */
  gimp_destroy_params (values, nvalues);

  /*  free up arguments and values  */
  script_fu_marshal_destroy_args (args, nparams);

  /*  free the query information  */
  g_free (proc_blurb);
  g_free (proc_help);
  g_free (proc_author);
  g_free (proc_copyright);
  g_free (proc_date);
  g_free (params);
  g_free (return_vals);

  /*  if we're in server mode, listen for additional commands for 10 ms  */
  if (script_fu_server_get_mode ())
    script_fu_server_listen (10);

#ifdef GDK_WINDOWING_WIN32
  /* This seems to help a lot on Windoze. */
  while (gtk_events_pending ())
    gtk_main_iteration ();
#endif

  return return_val;
}

static void
script_fu_marshal_destroy_args (GimpParam *params,
                                gint       n_params)
{
  gint i;

  for (i = 0; i < n_params; i++)
    {
      switch (params[i].type)
        {
        case GIMP_PDB_INT32:
        case GIMP_PDB_INT16:
        case GIMP_PDB_INT8:
        case GIMP_PDB_FLOAT:
        case GIMP_PDB_STRING:
          break;

        case GIMP_PDB_INT32ARRAY:
          g_free (params[i].data.d_int32array);
          break;

        case GIMP_PDB_INT16ARRAY:
          g_free (params[i].data.d_int16array);
          break;

        case GIMP_PDB_INT8ARRAY:
          g_free (params[i].data.d_int8array);
          break;

        case GIMP_PDB_FLOATARRAY:
          g_free (params[i].data.d_floatarray);
          break;

        case GIMP_PDB_STRINGARRAY:
          g_free (params[i].data.d_stringarray);
          break;

        case GIMP_PDB_COLORARRAY:
          g_free (params[i].data.d_colorarray);
          break;

        case GIMP_PDB_COLOR:
        case GIMP_PDB_DISPLAY:
        case GIMP_PDB_IMAGE:
        case GIMP_PDB_ITEM:
        case GIMP_PDB_LAYER:
        case GIMP_PDB_CHANNEL:
        case GIMP_PDB_DRAWABLE:
        case GIMP_PDB_SELECTION:
        case GIMP_PDB_VECTORS:
        case GIMP_PDB_PARASITE:
        case GIMP_PDB_STATUS:
        case GIMP_PDB_END:
          break;
        }
    }

  g_free (params);
}

static pointer
script_fu_register_call (scheme  *sc,
                         pointer  a)
{
  return script_fu_add_script (sc, a);
}

static pointer
script_fu_menu_register_call (scheme  *sc,
                              pointer  a)
{
  return script_fu_add_menu (sc, a);
}

static pointer
script_fu_quit_call (scheme  *sc,
                     pointer  a)
{
  script_fu_server_quit ();

  scheme_deinit (sc);

  return sc->NIL;
}

static pointer
script_fu_nil_call (scheme  *sc,
                    pointer  a)
{
  return sc->NIL;
}