Initial checkin of Pika from heckimp

plug-ins/script-fu/console/meson.build

@@ -0,0 +1,39 @@
+# library for script-fu-console
+#
+# Contains just the run_func for ScriptFu console plugin.
+# The plugin is a PDB procedure of type temporary.
+# The PDB procedure is registered by script-fu plugin,
+# which passes the run_func as a closure at registration time.
+#
+# Static library: just an archive of object files.
+# The library is not installed,
+# only linked with the script-fu plugin which references it.
+
+# uses libscriptfu
+
+libscriptfuconsoleInclude = include_directories('.')
+
+libscriptfuconsole_sources = [
+  'script-fu-console.c',
+  'script-fu-console-editor.c',
+  'script-fu-console-history.c',
+  'script-fu-console-total.c',
+]
+
+libscriptfuconsole = static_library('scriptfu-console',
+  libscriptfuconsole_sources,
+  include_directories: [
+    libscriptfuInclude,
+    rootInclude,
+    appInclude,
+  ],
+  c_args: [
+    '-DG_LOG_DOMAIN="scriptfu-console"',
+  ],
+  dependencies: [
+    libpikaui_dep,
+    math,
+  ],
+  link_with: libscriptfu,
+  install: false,
+)

plug-ins/script-fu/console/script-fu-console-editor.c

@@ -0,0 +1,97 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * 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 <gtk/gtk.h>
+
+#include "script-fu-console-editor.h"
+
+
+/* ConsoleEditor
+
+ * An API that abstracts these GtkWidgets for editing text:
+ * - GtkTextEntry is single line,
+ * - GtkTextView is multiline.
+ *
+ * So that we can swap out or enhance widget without affecting main logic.
+ *
+ * Not a defined class but methods conform to naming and calling conventions.
+ *
+ * Is-a GtkWidget.
+ */
+
+/* FUTURE
+ * GtkTextEntry => GtkTextView (multiline)
+ *
+ * Possibly: an editor that understands syntax and highlighting.
+ */
+
+GtkWidget *
+console_editor_new (void)
+{
+  return gtk_entry_new ();
+}
+
+/* Set editor's text and position the cursor.
+ * @position conforms to GtkEditable interface.
+ */
+void
+console_editor_set_text_and_position (GtkWidget   *self,
+                                      const gchar *text,
+                                      gint         position)
+{
+  /* gtk_entry_set_text not allow NULL */
+  if (text != NULL)
+    gtk_entry_set_text (GTK_ENTRY (self), text);
+  gtk_editable_set_position (GTK_EDITABLE (self), position);
+}
+
+void
+console_editor_clear (GtkWidget *self)
+{
+  console_editor_set_text_and_position (self, "", -1);
+}
+
+const gchar *
+console_editor_get_text (GtkWidget *self)
+{
+  return gtk_entry_get_text (GTK_ENTRY (self));
+}
+
+gboolean
+console_editor_is_empty (GtkWidget *self)
+{
+  const gchar *str;
+
+  if ((str = console_editor_get_text (self)) == NULL)
+    return TRUE;
+
+  while (*str)
+    {
+      if (*str != ' ' && *str != '\t' && *str != '\n')
+        return FALSE;
+
+      str ++;
+    }
+
+  return TRUE;
+}

plug-ins/script-fu/console/script-fu-console-editor.h

@@ -0,0 +1,36 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#ifndef __SCRIPT_FU_CONSOLE_EDITOR_H__
+#define __SCRIPT_FU_CONSOLE_EDITOR_H__
+
+
+GtkWidget   *console_editor_new                   (void);
+void         console_editor_set_text_and_position (GtkWidget   *self,
+                                                   const gchar *text,
+                                                   gint         position);
+
+const gchar *console_editor_get_text              (GtkWidget   *self);
+gboolean     console_editor_is_empty              (GtkWidget   *self);
+void         console_editor_clear                 (GtkWidget   *self);
+
+
+#endif /*  __SCRIPT_FU_CONSOLE_EDITOR_H__  */

plug-ins/script-fu/console/script-fu-console-history.c

@@ -0,0 +1,262 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * 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 "libpika/pika.h"
+
+#include "script-fu-console-history.h"
+
+static gint            console_history_tail_position (CommandHistory *self);
+static GStrv           console_history_to_strv       (CommandHistory *self);
+
+
+/* CommandHistory
+ *
+ * Not a true class, just a struct with methods.
+ * Does not inherit GObject.
+ *
+ * Is a model that affects a view of the "console history."
+ * The model is a sequence of ExecutedCommands.
+ * The sequence is a time-ordered queue.
+ * You can only append to the end, called the tail.
+ * An ExecutedCommand does not contain the result of interpretation,
+ * only the string that was interpreted.
+ *
+ * The sequence is finite.
+ * When you append to the tail,
+ * commands might be discarded from the head.
+ *
+ * Has a cursor.
+ * You can only get the command at the cursor.
+ * The user scrolling through the history moves the cursor.
+ * This scrolling is arrow keys in the editor pane,
+ * (not scroll bars in the history view pane.)
+ * See the main console logic:
+ * when user hits arrow keys in the editor,
+ * move cursor in the history, get the command at the cursor,
+ * and display it in the editor, ready to execute.
+ *
+ * A CommandHistory is a model,
+ * but there is also a distinct TotalHistory model for a scrolling view of the history
+ * (e.g. a GtkTextBuffer model for a GtkTextView.)
+ *
+ * CommandHistory <-supersets- TotalHistory <-views- ConsoleView
+ *
+ * TotalHistory contains more than the commands in CommandHistory.
+ * TotalHistory contains e.g. splash, prompts, and interpretation results.
+ *
+ * !!! Self does not currently write TotalHistory;
+ * The main console logic writes TotalHistory,
+ *
+ * CommandHistory is persistent across sessions of the ScriptFu Console,
+ * and across sessions of Pika.
+ * When the SFConsole starts, the TotalHistory,
+ * is just the CommandHistory, without results of eval.
+ * Old results are not meaningful since the environment changed.
+ * Specifically, a new session of SFConsole has a new initialized interpreter.
+ * Similarly, when the user closes the console,
+ * only the CommandHistory is saved as settings.
+ */
+
+void
+console_history_init (CommandHistory *self)
+{
+  self->model     = g_list_append (self->model, NULL);
+  self->model_len = 1;
+  self->model_max = 100;
+}
+
+
+
+/* Store the command in tail of CommandHistory.
+ * The tail is the most recent added element, which was created prior by new_tail.
+ *
+ * @commmand transfer full
+ *
+ * !!! The caller is executing the command.
+ * The caller updates TotalHistory, with a prompt string and the command string.
+ * Self does not update TotalHistory, the model of the view.
+ */
+void
+console_history_set_tail (CommandHistory *self,
+                          const gchar    *command)
+{
+  GList *list;
+
+  list = g_list_nth (self->model,
+                     console_history_tail_position (self));
+
+  if (list->data)
+    g_free (list->data);
+
+  /* Discarding const. */
+  list->data = (gpointer) command;
+}
+
+/* Remove the head of the history and free its string.
+ *
+ * GList doesn't have such a direct method.
+ * Search web to find this solution.
+ * !!! g_list_remove does not free the data of the removed element.
+ *
+ * Remove the element whose data (a string)
+ * matches the data of the first element.
+ * Then free the data of the first element.
+ */
+static void
+console_history_remove_head (CommandHistory *self)
+{
+  gpointer * data;
+
+  g_return_if_fail (self->model != NULL);
+
+  data = self->model->data;
+  self->model = g_list_remove (self->model, data);
+  g_free (data);
+}
+
+/* Append NULL string at tail of CommandHistory.
+ * Prune head when max exceeded, freeing the string.
+ * Position the cursor at last element.
+ */
+void
+console_history_new_tail (CommandHistory *self)
+{
+  self->model = g_list_append (self->model, NULL);
+
+  if (self->model_len == self->model_max)
+    {
+      console_history_remove_head (self);
+    }
+  else
+    {
+      self->model_len++;
+    }
+
+  self->model_cursor = console_history_tail_position (self);
+}
+
+void
+console_history_cursor_to_tail (CommandHistory *self)
+{
+  self->model_cursor = console_history_tail_position (self);
+}
+
+gboolean
+console_history_is_cursor_at_tail (CommandHistory *self)
+{
+  return self->model_cursor == console_history_tail_position (self);
+}
+
+void
+console_history_move_cursor (CommandHistory *self,
+                             gint            direction)
+{
+  self->model_cursor += direction;
+
+  /* Clamp cursor in range [0, model_len-1] */
+  if (self->model_cursor < 0)
+    self->model_cursor = 0;
+
+  if (self->model_cursor >= self->model_len)
+    self->model_cursor = self->model_len - 1;
+}
+
+const gchar *
+console_history_get_at_cursor (CommandHistory *self)
+{
+  return g_list_nth (self->model, self->model_cursor)->data;
+}
+
+
+/* Methods for persisting history as a setting. */
+
+/* Return a GStrv of the history from settings.
+ * The Console knows how to put GStrv to both models!
+ *
+ * !!! Handle attack on settings file.
+ * The returned cardinality of the set of strings
+ * may be zero or very many.
+ * Elsewhere ensure we don't overflow models.
+ */
+GStrv
+console_history_from_settings (CommandHistory       *self,
+                               PikaProcedureConfig  *config)
+{
+  GStrv           in_history;
+
+  /* Get aux arg from property of config. */
+  g_object_get (config,
+                "history", &in_history,
+                NULL);
+
+  return in_history;
+}
+
+void
+console_history_to_settings (CommandHistory       *self,
+                             PikaProcedureConfig  *config)
+{
+  GStrv           out_history;
+
+  out_history = console_history_to_strv (self);
+
+  /* set an aux arg in config. */
+  g_object_set (config,
+                "history", out_history,
+                NULL);
+}
+
+/* Return history model as GStrv.
+ * Converts from interal list into a string array.
+ *
+ * !!! The exported history may have a tail
+ * which is user's edits to the command line,
+ * that the user never evaluated.
+ * Exported history does not have an empty tail.
+ *
+ * Caller must g_strfreev the returned GStrv.
+ */
+static GStrv
+console_history_to_strv (CommandHistory *self)
+{
+  GStrv         history_strv;
+  GStrvBuilder *builder;
+
+  builder = g_strv_builder_new ();
+  /* Order is earliest first. */
+  for (GList *l = self->model; l != NULL; l = l->next)
+    {
+      /* Don't write an empty pre-allocated tail. */
+      if (l->data != NULL)
+        g_strv_builder_add (builder, l->data);
+    }
+  history_strv = g_strv_builder_end (builder);
+  g_strv_builder_unref (builder);
+  return history_strv;
+}
+
+static gint
+console_history_tail_position (CommandHistory *self)
+{
+  return g_list_length (self->model) - 1;
+}

plug-ins/script-fu/console/script-fu-console-history.h

@@ -0,0 +1,53 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#ifndef __SCRIPT_FU_CONSOLE_HISTORY_H__
+#define __SCRIPT_FU_CONSOLE_HISTORY_H__
+
+
+typedef struct
+{
+  GList         *model;
+  gint           model_len;
+  gint           model_cursor;
+  gint           model_max;
+} CommandHistory;
+
+
+void         console_history_init              (CommandHistory *self);
+
+void         console_history_new_tail          (CommandHistory *self);
+void         console_history_set_tail          (CommandHistory *self,
+                                                const gchar    *command);
+
+void         console_history_move_cursor       (CommandHistory *self,
+                                                gint            direction);
+void         console_history_cursor_to_tail    (CommandHistory *self);
+gboolean     console_history_is_cursor_at_tail (CommandHistory *self);
+const gchar *console_history_get_at_cursor     (CommandHistory *self);
+
+GStrv        console_history_from_settings     (CommandHistory       *self,
+                                                PikaProcedureConfig  *config);
+void         console_history_to_settings       (CommandHistory       *self,
+                                                PikaProcedureConfig  *config);
+
+
+#endif /*  __SCRIPT_FU_CONSOLE_HISTORY_H__  */

plug-ins/script-fu/console/script-fu-console-total.c

@@ -0,0 +1,169 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * 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 <gtk/gtk.h>
+
+#include "script-fu-console-total.h"
+
+#include "script-fu-intl.h"
+
+/* TotalHistory
+ * Model for the history pane of SFConsole.
+ *
+ * Shows welcome, prompts repr, commands executed, and results of evaluation.
+ *
+ * A thin wrapper around GtkTextBuffer
+ *
+ * All changes to the model update the view via signals of the underlying Gtk classes.
+ */
+
+
+GtkTextBuffer *
+console_total_history_new (void)
+{
+  return gtk_text_buffer_new (NULL);
+}
+
+/* Clear TotalHistory.
+ *
+ * !!! Not clear CommandHistory, only TotalHistory.
+ * So TotalHistory is not always a superset of CommandHistory.
+ * FUTURE: also clear CommandHistory??
+ *
+ * !!! Not affect cursor of CommandHistory
+ * FUTURE: reset cursor to bottom?
+ */
+void
+console_total_history_clear (GtkTextBuffer *self)
+{
+  GtkTextIter start, end;
+
+  gtk_text_buffer_get_start_iter (self, &start);
+  gtk_text_buffer_get_end_iter (self, &end);
+  gtk_text_buffer_delete (self, &start, &end);
+}
+
+/* Get all the text in self, including text
+ * that is not in CommandHistory, i.e. splash, prompts, and results.
+ */
+gchar *
+console_total_history_get_text (GtkTextBuffer *self)
+{
+  GtkTextIter start, end;
+
+  gtk_text_buffer_get_start_iter (self, &start);
+  gtk_text_buffer_get_end_iter (self, &end);
+  return gtk_text_buffer_get_text (self, &start, &end, FALSE);
+}
+
+void
+console_total_append_welcome (GtkTextBuffer *self)
+{
+  gtk_text_buffer_create_tag (self, "strong",
+                              "weight", PANGO_WEIGHT_BOLD,
+                              "scale",  PANGO_SCALE_LARGE,
+                              NULL);
+  gtk_text_buffer_create_tag (self, "emphasis",
+                              "style",  PANGO_STYLE_OBLIQUE,
+                              NULL);
+
+  {
+    const gchar * const greetings[] =
+    {
+      "emphasis", N_("Welcome to TinyScheme"),
+      NULL,       "\n",
+      "emphasis", "Copyright (c) Dimitrios Souflis",
+      NULL,       "\n",
+      "emphasis", N_("Scripting PIKA in the Scheme language"),
+      NULL,       "\n"
+    };
+
+    GtkTextIter cursor;
+    gint        i;
+
+    gtk_text_buffer_get_end_iter (self, &cursor);
+
+    for (i = 0; i < G_N_ELEMENTS (greetings); i += 2)
+      {
+        if (greetings[i])
+          gtk_text_buffer_insert_with_tags_by_name (self, &cursor,
+                                                    gettext (greetings[i + 1]),
+                                                    -1, greetings[i],
+                                                    NULL);
+        else
+          gtk_text_buffer_insert (self, &cursor,
+                                  gettext (greetings[i + 1]), -1);
+      }
+  }
+
+}
+
+void
+console_total_append_text_normal (GtkTextBuffer *self,
+                                  const gchar  *text,
+                                  gint          len)
+{
+  GtkTextIter    cursor;
+
+  gtk_text_buffer_get_end_iter (self, &cursor);
+  gtk_text_buffer_insert (self, &cursor, text, len);
+  gtk_text_buffer_insert (self, &cursor, "\n", 1);
+}
+
+void
+console_total_append_text_emphasize (GtkTextBuffer *self,
+                                     const gchar   *text,
+                                     gint           len)
+{
+  GtkTextIter    cursor;
+
+  gtk_text_buffer_get_end_iter (self, &cursor);
+  gtk_text_buffer_insert_with_tags_by_name (self,
+                                            &cursor,
+                                            text, len, "emphasis",
+                                            NULL);
+  gtk_text_buffer_insert (self, &cursor, "\n", 1);
+}
+
+/* Write newlines, prompt, and command. */
+void
+console_total_append_command (GtkTextBuffer *self,
+                              const gchar   *command)
+{
+  GtkTextIter  cursor;
+
+  gtk_text_buffer_get_end_iter (self, &cursor);
+
+  /* assert we are just after a newline. */
+
+  /* Write repr of a prompt.
+   * SFConsole doesn't have a prompt in it's command line,
+   * But we show one in the history view to distinguish commands.
+   */
+  gtk_text_buffer_insert_with_tags_by_name (self, &cursor,
+                                            "> ", 2,
+                                            "strong",
+                                            NULL);
+  gtk_text_buffer_insert (self, &cursor, command, -1);
+  gtk_text_buffer_insert (self, &cursor, "\n", 1);
+}

plug-ins/script-fu/console/script-fu-console-total.h

@@ -0,0 +1,41 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#ifndef __SCRIPT_FU_CONSOLE_TOTAL_H__
+#define __SCRIPT_FU_CONSOLE_TOTAL_H__
+
+
+GtkTextBuffer *console_total_history_new           (void);
+void           console_total_history_clear         (GtkTextBuffer *self);
+gchar         *console_total_history_get_text      (GtkTextBuffer *self);
+
+void           console_total_append_welcome        (GtkTextBuffer *self);
+void           console_total_append_text_normal    (GtkTextBuffer *self,
+                                                    const gchar   *text,
+                                                    gint           len);
+void           console_total_append_text_emphasize (GtkTextBuffer *self,
+                                                    const gchar   *text,
+                                                    gint           len);
+void           console_total_append_command        (GtkTextBuffer *self,
+                                                    const gchar   *command);
+
+
+#endif /*  __SCRIPT_FU_CONSOLE_TOTAL_H__  */

plug-ins/script-fu/console/script-fu-console.c

@@ -0,0 +1,646 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * 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 <errno.h>
+#include <string.h>
+
+#include <glib/gstdio.h>
+
+#include "libpika/pika.h"
+#include "libpika/pikaui.h"
+
+#include <gdk/gdkkeysyms.h>
+
+#include "script-fu-console.h"
+#include "script-fu-console-editor.h"
+#include "script-fu-console-history.h"
+#include "script-fu-console-total.h"
+
+#include "script-fu-lib.h"
+#include "script-fu-intl.h"
+
+
+#define TEXT_WIDTH  480
+#define TEXT_HEIGHT 400
+
+#define PROC_NAME   "plug-in-script-fu-console"
+
+typedef struct
+{
+  GtkWidget     *dialog;
+  GtkTextBuffer *total_history;
+  GtkWidget     *editor;
+  GtkWidget     *history_view;
+  GtkWidget     *proc_browser;
+  GtkWidget     *save_dialog;
+
+  CommandHistory history;
+} ConsoleInterface;
+
+enum
+{
+  RESPONSE_CLEAR,
+  RESPONSE_SAVE
+};
+
+/*
+ *  Local Functions
+ */
+static void      script_fu_console_response      (GtkWidget        *widget,
+                                                  gint              response_id,
+                                                  ConsoleInterface *console);
+static void      script_fu_console_save_dialog   (ConsoleInterface *console);
+static void      script_fu_console_save_response (GtkWidget        *dialog,
+                                                  gint              response_id,
+                                                  ConsoleInterface *console);
+
+static void      script_fu_browse_callback       (GtkWidget        *widget,
+                                                  ConsoleInterface *console);
+static void      script_fu_browse_response       (GtkWidget        *widget,
+                                                  gint              response_id,
+                                                  ConsoleInterface *console);
+static void      script_fu_browse_row_activated  (GtkDialog        *dialog);
+
+static gboolean  script_fu_editor_key_function   (GtkWidget        *widget,
+                                                  GdkEventKey      *event,
+                                                  ConsoleInterface *console);
+static void      script_fu_console_scroll_end    (GtkWidget        *view);
+static void      script_fu_output_to_console     (gboolean          is_error,
+                                                  const gchar      *text,
+                                                  gint              len,
+                                                  gpointer          user_data);
+
+static void      script_fu_models_from_settings  (ConsoleInterface    *console,
+                                                  PikaProcedureConfig *config);
+static void      script_fu_command_to_history    (ConsoleInterface    *console,
+                                                  const gchar         *command);
+
+/*
+ *  Function definitions
+ */
+
+PikaValueArray *
+script_fu_console_run (PikaProcedure        *procedure,
+                       const PikaValueArray *args)
+{
+  ConsoleInterface  console = { 0, };
+  GtkWidget        *vbox;
+  GtkWidget        *button;
+  GtkWidget        *scrolled_window;
+  GtkWidget        *hbox;
+
+  PikaProcedureConfig *config;
+
+  script_fu_set_print_flag (1);
+
+  pika_ui_init ("script-fu");
+
+  /* Create model early so we can fill from settings. */
+  console.total_history = console_total_history_new ();
+  console_history_init (&console.history);
+  console_total_append_welcome (console.total_history);
+
+  /* Get previous or default settings into config. */
+  config = pika_procedure_create_config (procedure);
+  pika_procedure_config_begin_run (config, NULL, PIKA_RUN_INTERACTIVE, args);
+
+  script_fu_models_from_settings (&console, config);
+
+  console.dialog = pika_dialog_new (_("Script Console"),
+                                    "pika-script-fu-console",
+                                    NULL, 0,
+                                    pika_standard_help_func, PROC_NAME,
+
+                                    _("_Save"),  RESPONSE_SAVE,
+                                    _("C_lear"), RESPONSE_CLEAR,
+                                    _("_Close"), GTK_RESPONSE_CLOSE,
+
+                                    NULL);
+  gtk_window_set_default_size (GTK_WINDOW (console.dialog), TEXT_WIDTH,
+                               TEXT_HEIGHT);
+
+  pika_dialog_set_alternative_button_order (GTK_DIALOG (console.dialog),
+                                           GTK_RESPONSE_CLOSE,
+                                           RESPONSE_CLEAR,
+                                           RESPONSE_SAVE,
+                                           -1);
+
+  g_object_add_weak_pointer (G_OBJECT (console.dialog),
+                             (gpointer) &console.dialog);
+
+  g_signal_connect (console.dialog, "response",
+                    G_CALLBACK (script_fu_console_response),
+                    &console);
+
+  /*  The main vbox  */
+  vbox = gtk_box_new (GTK_ORIENTATION_VERTICAL, 12);
+  gtk_container_set_border_width (GTK_CONTAINER (vbox), 12);
+  gtk_box_pack_start (GTK_BOX (gtk_dialog_get_content_area (GTK_DIALOG (console.dialog))),
+                      vbox, TRUE, TRUE, 0);
+  gtk_widget_show (vbox);
+
+  /*  A view of the total history.  */
+  scrolled_window = gtk_scrolled_window_new (NULL, NULL);
+  gtk_scrolled_window_set_policy (GTK_SCROLLED_WINDOW (scrolled_window),
+                                  GTK_POLICY_AUTOMATIC,
+                                  GTK_POLICY_ALWAYS);
+  gtk_box_pack_start (GTK_BOX (vbox), scrolled_window, TRUE, TRUE, 0);
+  gtk_widget_show (scrolled_window);
+
+  console.history_view = gtk_text_view_new_with_buffer (console.total_history);
+  /* View keeps reference.  Unref our ref so buffer is destroyed with view. */
+  g_object_unref (console.total_history);
+
+  gtk_text_view_set_editable (GTK_TEXT_VIEW (console.history_view), FALSE);
+  gtk_text_view_set_wrap_mode (GTK_TEXT_VIEW (console.history_view),
+                               GTK_WRAP_WORD);
+  gtk_text_view_set_left_margin (GTK_TEXT_VIEW (console.history_view), 6);
+  gtk_text_view_set_right_margin (GTK_TEXT_VIEW (console.history_view), 6);
+  gtk_widget_set_size_request (console.history_view, TEXT_WIDTH, TEXT_HEIGHT);
+  gtk_container_add (GTK_CONTAINER (scrolled_window), console.history_view);
+  gtk_widget_show (console.history_view);
+
+  /*  An editor of a command to be executed. */
+  hbox = gtk_box_new (GTK_ORIENTATION_HORIZONTAL, 6);
+  gtk_box_pack_start (GTK_BOX (vbox), hbox, FALSE, FALSE, 0);
+  gtk_widget_show (hbox);
+
+  console.editor = console_editor_new ();
+  gtk_box_pack_start (GTK_BOX (hbox), console.editor, TRUE, TRUE, 0);
+  gtk_widget_grab_focus (console.editor);
+  gtk_widget_show (console.editor);
+
+  g_signal_connect (console.editor, "key-press-event",
+                    G_CALLBACK (script_fu_editor_key_function),
+                    &console);
+
+  button = gtk_button_new_with_mnemonic (_("_Browse..."));
+  g_object_set (gtk_bin_get_child (GTK_BIN (button)),
+                "margin-start", 2,
+                "margin-end",   2,
+                NULL);
+  gtk_box_pack_start (GTK_BOX (hbox), button, FALSE, TRUE, 0);
+  gtk_widget_show (button);
+
+  g_signal_connect (button, "clicked",
+                    G_CALLBACK (script_fu_browse_callback),
+                    &console);
+
+  gtk_widget_show (console.dialog);
+
+  /* The history model may fill the view, scroll. */
+  script_fu_console_scroll_end (console.history_view);
+
+  gtk_main ();
+
+  if (console.save_dialog)
+    gtk_widget_destroy (console.save_dialog);
+
+  if (console.dialog)
+    gtk_widget_destroy (console.dialog);
+
+  /* Update config with user's change to history */
+  console_history_to_settings (&console.history, config);
+  /* Persist config */
+  pika_procedure_config_end_run (config, PIKA_PDB_SUCCESS);
+
+  return pika_procedure_new_return_values (procedure, PIKA_PDB_SUCCESS, NULL);
+}
+
+static void
+script_fu_console_response (GtkWidget        *widget,
+                            gint              response_id,
+                            ConsoleInterface *console)
+{
+  switch (response_id)
+    {
+    case RESPONSE_CLEAR:
+      console_total_history_clear (console->total_history);
+      break;
+
+    case RESPONSE_SAVE:
+      script_fu_console_save_dialog (console);
+      break;
+
+    default:
+      gtk_main_quit ();
+      break;
+    }
+}
+
+
+static void
+script_fu_console_save_dialog (ConsoleInterface *console)
+{
+  if (! console->save_dialog)
+    {
+      console->save_dialog =
+        gtk_file_chooser_dialog_new (_("Save Script-Fu Console Output"),
+                                     GTK_WINDOW (console->dialog),
+                                     GTK_FILE_CHOOSER_ACTION_SAVE,
+
+                                     _("_Cancel"), GTK_RESPONSE_CANCEL,
+                                     _("_Save"),   GTK_RESPONSE_OK,
+
+                                     NULL);
+
+      gtk_dialog_set_default_response (GTK_DIALOG (console->save_dialog),
+                                       GTK_RESPONSE_OK);
+      pika_dialog_set_alternative_button_order (GTK_DIALOG (console->save_dialog),
+                                               GTK_RESPONSE_OK,
+                                               GTK_RESPONSE_CANCEL,
+                                               -1);
+
+      gtk_file_chooser_set_do_overwrite_confirmation (GTK_FILE_CHOOSER (console->save_dialog),
+                                                      TRUE);
+
+      g_object_add_weak_pointer (G_OBJECT (console->save_dialog),
+                                 (gpointer) &console->save_dialog);
+
+      g_signal_connect (console->save_dialog, "response",
+                        G_CALLBACK (script_fu_console_save_response),
+                        console);
+    }
+
+  gtk_window_present (GTK_WINDOW (console->save_dialog));
+}
+
+static void
+script_fu_console_save_response (GtkWidget        *dialog,
+                                 gint              response_id,
+                                 ConsoleInterface *console)
+{
+  if (response_id == GTK_RESPONSE_OK)
+    {
+      gchar *filename;
+      gchar *str;
+      FILE  *fh;
+
+      filename = gtk_file_chooser_get_filename (GTK_FILE_CHOOSER (dialog));
+
+      fh = g_fopen (filename, "w");
+
+      if (! fh)
+        {
+          g_message (_("Could not open '%s' for writing: %s"),
+                     pika_filename_to_utf8 (filename),
+                     g_strerror (errno));
+
+          g_free (filename);
+          return;
+        }
+
+      str = console_total_history_get_text (console->total_history);
+
+      fputs (str, fh);
+      fclose (fh);
+
+      g_free (str);
+    }
+
+  gtk_widget_hide (dialog);
+}
+
+static void
+script_fu_browse_callback (GtkWidget        *widget,
+                           ConsoleInterface *console)
+{
+  if (! console->proc_browser)
+    {
+      console->proc_browser =
+        pika_proc_browser_dialog_new (_("Script-Fu Procedure Browser"),
+                                      "script-fu-procedure-browser",
+                                      pika_standard_help_func, PROC_NAME,
+
+                                      _("_Apply"), GTK_RESPONSE_APPLY,
+                                      _("_Close"), GTK_RESPONSE_CLOSE,
+
+                                      NULL);
+
+      gtk_dialog_set_default_response (GTK_DIALOG (console->proc_browser),
+                                       GTK_RESPONSE_APPLY);
+      pika_dialog_set_alternative_button_order (GTK_DIALOG (console->proc_browser),
+                                               GTK_RESPONSE_CLOSE,
+                                               GTK_RESPONSE_APPLY,
+                                               -1);
+
+      g_object_add_weak_pointer (G_OBJECT (console->proc_browser),
+                                 (gpointer) &console->proc_browser);
+
+      g_signal_connect (console->proc_browser, "response",
+                        G_CALLBACK (script_fu_browse_response),
+                        console);
+      g_signal_connect (console->proc_browser, "row-activated",
+                        G_CALLBACK (script_fu_browse_row_activated),
+                        console);
+    }
+
+  gtk_window_present (GTK_WINDOW (console->proc_browser));
+}
+
+static void
+script_fu_browse_response (GtkWidget        *widget,
+                           gint              response_id,
+                           ConsoleInterface *console)
+{
+  PikaProcBrowserDialog  *dialog = PIKA_PROC_BROWSER_DIALOG (widget);
+  PikaProcedure          *procedure;
+  gchar                  *proc_name;
+  GParamSpec            **pspecs;
+  gint                    n_pspecs;
+  gint                    i;
+  GString                *text;
+
+  if (response_id != GTK_RESPONSE_APPLY)
+    {
+      gtk_widget_destroy (widget);
+      return;
+    }
+
+  proc_name = pika_proc_browser_dialog_get_selected (dialog);
+
+  if (proc_name == NULL)
+    return;
+
+  procedure = pika_pdb_lookup_procedure (pika_get_pdb (), proc_name);
+
+  pspecs = pika_procedure_get_arguments (procedure, &n_pspecs);
+
+  text = g_string_new ("(");
+  text = g_string_append (text, proc_name);
+
+  for (i = 0; i < n_pspecs; i++)
+    {
+      text = g_string_append_c (text, ' ');
+      text = g_string_append (text, pspecs[i]->name);
+    }
+
+  text = g_string_append_c (text, ')');
+
+  gtk_window_set_focus (GTK_WINDOW (console->dialog), console->editor);
+
+  console_editor_set_text_and_position (console->editor,
+                                        text->str,
+                                        g_utf8_pointer_to_offset (
+                                          text->str,
+                                          text->str + strlen (proc_name) + 2));
+
+  g_string_free (text, TRUE);
+
+  gtk_window_present (GTK_WINDOW (console->dialog));
+
+  g_free (proc_name);
+}
+
+static void
+script_fu_browse_row_activated (GtkDialog *dialog)
+{
+  gtk_dialog_response (dialog, GTK_RESPONSE_APPLY);
+}
+
+static gboolean
+script_fu_console_idle_scroll_end (GtkWidget *view)
+{
+  GtkWidget *parent = gtk_widget_get_parent (view);
+
+  if (parent)
+    {
+      GtkAdjustment *adj;
+
+      adj = gtk_scrolled_window_get_vadjustment (GTK_SCROLLED_WINDOW (parent));
+
+      gtk_adjustment_set_value (adj,
+                                gtk_adjustment_get_upper (adj) -
+                                gtk_adjustment_get_page_size (adj));
+    }
+
+  g_object_unref (view);
+
+  return FALSE;
+}
+
+static void
+script_fu_console_scroll_end (GtkWidget *view)
+{
+  /*  the text view idle updates, so we need to idle scroll too
+   */
+  g_object_ref (view);
+
+  g_idle_add ((GSourceFunc) script_fu_console_idle_scroll_end, view);
+}
+
+/* Write result of eval to the console view.
+ * But not put results in the history model.
+ */
+static void
+script_fu_output_to_console (gboolean      is_error_msg,
+                             const gchar  *result_text,
+                             gint          len,
+                             gpointer      user_data)
+{
+  ConsoleInterface *console = user_data;
+
+  if (console && console->history_view)
+    {
+      if (! is_error_msg)
+        console_total_append_text_normal (console->total_history, result_text, len);
+      else
+        console_total_append_text_emphasize (console->total_history, result_text, len);
+
+      script_fu_console_scroll_end (console->history_view);
+    }
+}
+
+
+
+static gboolean
+script_fu_editor_key_function (GtkWidget        *widget,
+                               GdkEventKey      *event,
+                               ConsoleInterface *console)
+{
+  gint         direction = 0;
+  GString     *output;
+  gboolean     is_error;
+  const gchar *command;
+
+  switch (event->keyval)
+    {
+    case GDK_KEY_Return:
+    case GDK_KEY_KP_Enter:
+    case GDK_KEY_ISO_Enter:
+      if (console_editor_is_empty (console->editor))
+        return TRUE;
+
+      command = g_strdup (console_editor_get_text (console->editor));
+
+      script_fu_command_to_history (console, command);
+      /* Assert history advanced to new, empty tail. */
+
+      script_fu_console_scroll_end (console->history_view);
+
+      console_editor_clear (console->editor);
+
+      output = g_string_new (NULL);
+      script_fu_redirect_output_to_gstr (output);
+
+      pika_plug_in_set_pdb_error_handler (pika_get_plug_in (),
+                                          PIKA_PDB_ERROR_HANDLER_PLUGIN);
+
+      is_error = script_fu_interpret_string (command);
+
+      script_fu_output_to_console (is_error,
+                                   output->str,
+                                   output->len,
+                                   console);
+
+      pika_plug_in_set_pdb_error_handler (pika_get_plug_in (),
+                                          PIKA_PDB_ERROR_HANDLER_INTERNAL);
+
+      g_string_free (output, TRUE);
+
+      pika_displays_flush ();
+
+      return TRUE;
+      break;
+
+    case GDK_KEY_KP_Up:
+    case GDK_KEY_Up:
+      direction = -1;
+      break;
+
+    case GDK_KEY_KP_Down:
+    case GDK_KEY_Down:
+      direction = 1;
+      break;
+
+    case GDK_KEY_P:
+    case GDK_KEY_p:
+      if (event->state & GDK_CONTROL_MASK)
+        direction = -1;
+      break;
+
+    case GDK_KEY_N:
+    case GDK_KEY_n:
+      if (event->state & GDK_CONTROL_MASK)
+        direction = 1;
+      break;
+
+    default:
+      /* Any other key is the user editing.
+       * Set cursor to tail: user is done scrolling history.
+       * Must do this to ensure edited command line is saved in history.
+       */
+      console_history_cursor_to_tail (&console->history);
+      break;
+    }
+
+  if (direction)
+    {
+      /* Tail was preallocated and usually empty.
+       * Keep the editor contents in the tail as cursor is moved away from tail.
+       * So any edited text is not lost if user moves cursor back to tail.
+       */
+      command = console_editor_get_text (console->editor);
+      /* command can be NULL */
+      if (console_history_is_cursor_at_tail (&console->history))
+        console_history_set_tail (&console->history, g_strdup (command));
+
+      /* Now move cursor and replace editor contents. */
+      console_history_move_cursor (&console->history, direction);
+      command = console_history_get_at_cursor (&console->history);
+      /* command can be NULL. */
+      console_editor_set_text_and_position (console->editor,
+                                            command,
+                                            -1);
+
+      return TRUE;
+    }
+
+  return FALSE;
+}
+
+/* Restore models from settings.
+ * This understands how to get history as a GStrv from settings
+ * and how to put GStrv into both models.
+ *
+ * Just the model.  The view does not exist yet.
+ */
+static void
+script_fu_models_from_settings (ConsoleInterface    *console,
+                                PikaProcedureConfig *config)
+
+{
+  GStrv strings_in;
+
+  /* Assert the History model is empty, recently init. */
+
+  strings_in = console_history_from_settings (&console->history, config);
+
+  /* The history setting can be empty, and GStrv can be NULL.
+   * !!! But g_strv_length requires its arg!=NULL
+   */
+  if (strings_in==NULL)
+    return;
+
+  /* Adding requires a new tail. */
+  console_history_new_tail (&console->history);
+
+  /* Order of the GStrv is earliest command first.
+   * Iterate ascending, i.e. earliest command to history first.
+   * Not concerned with performance.
+   */
+  for (gint i = 0; i < g_strv_length (strings_in); i++)
+    script_fu_command_to_history (console, g_strdup (strings_in[i]));
+
+  g_strfreev (strings_in);
+}
+
+
+/* Append a command to history.
+ *
+ * Knows to put to both TotalHistory and History models.
+ *
+ * Transfers ownership of command to History model.
+ * Caller may retain a reference, for a short time.
+ *
+ * !!! The History model is finite and limits itself.
+ * While the TotalHistory model is nearly unlimited.
+ * More commands in the view than in the History model.
+ */
+static void
+script_fu_command_to_history (ConsoleInterface *console,
+                              const gchar      *command)
+{
+  /* Require new_tail called previously. */
+
+  /* To History model. */
+  console_history_set_tail (&console->history, command);
+
+  /* Advance history, editor wants preallocated tail. */
+  console_history_new_tail (&console->history);
+
+  /* Decorated command to TotalHistory model. */
+  console_total_append_command (console->total_history, command);
+
+  /* Ensure there is a new tail. */
+}

plug-ins/script-fu/console/script-fu-console.h

@@ -0,0 +1,30 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#ifndef __SCRIPT_FU_CONSOLE_H__
+#define __SCRIPT_FU_CONSOLE_H__
+
+
+PikaValueArray * script_fu_console_run (PikaProcedure        *procedure,
+                                        const PikaValueArray *args);
+
+
+#endif /*  __SCRIPT_FU_CONSOLE_H__  */

plug-ins/script-fu/interpreter/README

@@ -0,0 +1,178 @@
+# About script-fu-interpreter
+
+It is PIKA's Scheme interpreter akin to any other language interpreter,
+rather than a PIKA extension as is the plugin extension-script-fu.
+This interpreter (like all the ScriptFu plugins) embeds a TinyScheme interpreter.
+
+It is an executable program that is passed the name of a .scm file.
+The combination defines one or more PDB procedures of type PLUGIN.
+
+Differences from extension-script-fu
+====================================
+
+Since pika-script-fu-interpreter and extension-script-fu use the same
+embedded interpreter (they both wrap TinyScheme)
+there is no difference in the language interpreted.
+Any differences are in the larger behavior of plugins.
+
+### PDB Procedure type
+
+Defines PDB procedure(s) of type PLUGIN.
+Unlike for the scriptfu extension,
+where a .scm file defines PDB procedure(s) of type TEMPORARY
+(owned by the PDB procedure of type PLUGIN named extension-script-fu)
+
+### Protocol
+
+Uses protocol to PIKA like other interpreters e.g. Python
+(query, create, and run phases.)
+The protocol to PIKA is unlike the protocol to the PIKA extension extension-script-fu.
+
+(Note that "extension" has many meanings.  It can denote: a protocol,
+or "suffix of a filename", or "a resource that extends PIKA."
+extension-script-fu is "a resource that extends PIKA" and it also uses
+the "extension" protocol,
+while pika-script-fu-interpreter is a "a resource that extends PIKA" but uses
+the "plugin" protocol.)
+
+### Process lifetimes
+
+Executed many times, for many phases,
+unlike extension-script-fu which stays executing and gets a remote procedure call
+from PIKA to run a PDB procedure.
+
+### Process concurrency
+
+Each invocation of a plugin is in a separate process.
+One plugin process crash does not affect others.
+Unlike extension-script-fu, where a crash means the PIKA app must be restarted
+to restart extension-script-fu.
+
+### GUI concurrency
+
+Each plugin can have its own GUI visible concurrently
+with the GUI of other ScriptFu plugins.
+
+For extension-script-fu, an open dialog
+prevents other plugins in /scripts (implemented by extension-script-fu)
+from opening a dialog.
+Instead extension-script-fu opens such dialogs sequentially.
+
+This difference is not very important,
+since most users work sequentially.
+Most dialogs for plugins do not do anything substantive
+until a user closes the dialog with the OK button.
+
+### Calls between scripts
+
+In extension-script-fu, a call to another PDB procedure
+implemented by TEMPORARY procedure owned by extension-script-fu
+does not leave the process.
+
+In pika-script-fu-interpreter, a call to another PDB procedure
+implemented in another plugin file starts another process.
+
+For other plugins, most calls to another PDB procedure starts another process.
+The exception is when one plugin file implements many PDB procedures.
+One common case is when one plugin file implements its own TEMPORARY PDB procedures that
+exist only for the duration of the plugin's lifetime.
+
+Naming
+======
+
+script-fu-interpreter is the informal name.
+
+Source is located in /plug-ins/script-fu/interpreter
+
+Filename of the executable is pika-script-fu-interpreter-3.0.
+The name is versioned by a number corresponding to the API
+and the major version of PIKA (when script-fu-interpreter was introduced).
+We expect plugin authors to be insulated from changes to script-fu-interpreter,
+for the duration of the PIKA 3 version.
+
+
+About .scm scripts for script-fu-interpreter
+============================================
+
+The contents of a .scm file queried by script-fu-interpreter
+are the same as those handled by extension-script-fu
+except for the addition of a shebang:
+
+    #!/usr/bin/env pika-script-fu-interpreter-3.0
+    (define (script-fu-test img  drawable)
+    ...
+    (script-fu-register "script-fu-test"
+    ...
+
+### Query of scripts
+
+As for other interpreters, a plugin script file must have certain attributes
+to be queried by PIKA.  But a queried file may define many PDB procedures.
+
+A .scm file queried by script-fu-interpreter:
+
+- must have permission to execute.
+- must be in a directory names the same as the file's base name (less suffix.)
+
+A directory containing an .scm file queried by script-fu-interpreter
+is usually a subdirectory of one of the /plug-ins directories,
+unlike for extension-script-fu, where the .scm files are in a /scripts dir.
+
+A plugin directory should contain only one queriable .scm file:
+only one file can have the same base name as the directory and
+PIKA will query that file.
+
+### Defining many PDB procedures per directory
+
+When PIKA queries, script-fu-interpreter will load *ALL* the .scm files
+in the same directory (regardless of shebang or execute permission.)
+Any of the .scm files can declare and register a PDB procedure.
+Any single  .scm file can declare and register many PDB procedures.
+
+Similarly, when PIKA runs a named PDB procedure defined in an .scm file,
+script-fu-interpreter will actually load *ALL* the .scm files
+in the same directory, but run only the define run function so named.
+
+A plugin directory that contains many .scm files having a shebang
+will also work, since only one can be named the same as the parent directory,
+and PIKA will only query it,
+but find the other .scm files with a shebang.
+
+### Requery of scripts
+
+As with other plugins, PIKA caches plugin definitions between sessions.
+PIKA queries plugin files at startup.
+PIKA will not requery any plugin files which have not changed since cached.
+PIKA will not query a plugin file that is added to the file system
+until PIKA is restarted.
+(Filters>Development>ScriptFu>Refresh Scripts  will not requery script files
+handled by pika-script-fu-interpreter, only those handled by extension-script-fu.)
+
+### Errors during query
+
+Most errors occurring during query appear only in the console.
+If you are a plugin author, you should start PIKA in a console
+so you can see such errors.
+
+A script may be malformed because it does not define
+a "run" function having the same name as the PDB procedure name declared
+in the call to script-fu-register().
+Formerly, such a malformed script was successfully queried but
+the script would throw a "undefined variable" error at run time.
+Now, such a malformed script is not queried successfully,
+but throws a warning to the console:
+"Run function not defined, or does not match PDB procedure name:"
+
+
+
+Test scripts
+============
+
+Small test scripts for pika-script-fu-interpreter
+are located in /plug-ins/script-fu/scripts/test
+
+The script ts-helloworld.scm,
+formerly installed in /scripts and handled by extension-script-fu,
+is now installed in /plug-ins/ts-helloworld/ts-helloworld.scm
+and is now handled by pika-script-fu-interpreter.
+It appears as "Filters>Development>Script-Fu>Test>Hello World..."

plug-ins/script-fu/interpreter/meson.build

@@ -0,0 +1,42 @@
+
+scriptfuInclude = include_directories('..')
+
+executable_name = 'pika-script-fu-interpreter-' + pika_api_version
+
+plugin_sources = [
+  'script-fu-interpreter.c',
+  'script-fu-interpreter-plugin.c',
+]
+
+if platform_windows
+  plugin_sources += windows.compile_resources(
+    plugin_rc,
+    args: [
+      '--define', 'ORIGINALFILENAME_STR="@0@"'.format(executable_name+'.exe'),
+      '--define', 'INTERNALNAME_STR="@0@"'    .format(executable_name),
+      '--define', 'TOP_SRCDIR="@0@"'          .format(meson.project_source_root()),
+    ],
+    include_directories: [
+      rootInclude, appInclude,
+    ],
+  )
+endif
+
+# !!! Installs as a usual binary say to /usr/bin, unlike extension-script-fu
+# PIKA queries scripts with shebangs, which invokes pika-script-fu-interpreter-3.0.
+
+script_fu_interpreter = executable(executable_name,
+  plugin_sources,
+  dependencies: [
+    libpikaui_dep,
+    math,
+  ],
+  c_args: [
+    '-DG_LOG_DOMAIN="scriptfu"',
+  ],
+  include_directories: [
+    scriptfuInclude,
+  ],
+  link_with : libscriptfu,
+  install: true,
+)

plug-ins/script-fu/interpreter/script-fu-interpreter-plugin.c

@@ -0,0 +1,144 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * 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/>.
+ */
+
+/* This file understands how to make a PikaPlugin of the interpreter.
+ * This is mostly boilerplate for any plugin.
+ * It understands little about ScriptFu internals,
+ * hidden by script-fu-interpreter.[ch] and libscriptfu.
+ */
+
+#include "config.h"
+#include <glib.h>
+#include <libpika/pika.h>
+
+#include "libscriptfu/script-fu-intl.h"
+
+#include "script-fu-interpreter.h"
+
+
+/* ScriptFuInterpreter subclasses PikaPlugIn */
+
+#define SCRIPT_FU_INTERPRETER_TYPE (script_fu_interpreter_get_type ())
+G_DECLARE_FINAL_TYPE (ScriptFuInterpreter, script_fu_interpreter, SCRIPT, FU_INTERPRETER, PikaPlugIn)
+
+struct _ScriptFuInterpreter
+{
+  PikaPlugIn      parent_instance;
+};
+
+static GList          * script_fu_interpreter_query_procedures (PikaPlugIn  *plug_in);
+static PikaProcedure  * script_fu_interpreter_create_procedure (PikaPlugIn  *plug_in,
+                                                                const gchar *name);
+
+G_DEFINE_TYPE (ScriptFuInterpreter, script_fu_interpreter, PIKA_TYPE_PLUG_IN)
+
+/* An alias to argv[1], which is the path to the .scm file.
+ * Each instance of ScriptFuInterpreter is specialized by the script passed in argv[1]
+ * This var need not belong to the class or to an instance,
+ * because there will only be one instance of ScriptFuInterpreter per plugin process.
+ */
+static gchar * path_to_this_script;
+
+/* Connect to Pika.  See libpika/pika.c.
+ *
+ * Can't use PIKA_MAIN macro, it doesn't omit argv[0].
+ *
+ * First arg is app cited in the shebang.
+ * Second arg is the .scm file containing the shebang.
+ * Second to last arg is the "phase" e.g. -query or -run
+ * Last arg is the mode for crash dumps.
+ * Typical argv:
+ *   pika-script-fu-interpreter-3.0 ~/.config/PIKA/2.99/plug-ins/fu/fu
+ *          -pika 270 12 11 -query 1
+ */
+int main (int argc, char *argv[])
+{
+  g_debug ("Enter script-fu-interpreter main");
+
+  /* Alias path to this plugin's script file. */
+  path_to_this_script = argv[1];
+
+  /* pika_main will create an instance of the class given by the first arg, a GType.
+   * The class is a subclass of PikaPlugIn (with overridden query and create methods.)
+   * PIKA will subsequently callback the query or create methods,
+   * or the run_func of the PDB procedure of the plugin,
+   * depending on the "phase" arg in argv,
+   * which is set by the pika plugin manager, which is invoking this interpreter.
+   */
+  /* Omit argv[0] when passing to pika */
+  pika_main (SCRIPT_FU_INTERPRETER_TYPE, argc-1, &argv[1] );
+
+  g_debug ("Exit script-fu-interpreter.");
+}
+
+DEFINE_STD_SET_I18N
+
+static void
+script_fu_interpreter_class_init (ScriptFuInterpreterClass *klass)
+{
+  PikaPlugInClass *plug_in_class = PIKA_PLUG_IN_CLASS (klass);
+
+  plug_in_class->query_procedures = script_fu_interpreter_query_procedures;
+  plug_in_class->create_procedure = script_fu_interpreter_create_procedure;
+  plug_in_class->set_i18n         = STD_SET_I18N;
+}
+
+
+/* called by the GType system to initialize instance of the class. */
+static void
+script_fu_interpreter_init (ScriptFuInterpreter *script_fu)
+{
+  /* Nothing to do. */
+}
+
+
+/* Return the names of PDB procedures implemented. A callback from PIKA. */
+static GList *
+script_fu_interpreter_query_procedures (PikaPlugIn *plug_in)
+{
+  GList *result = NULL;
+
+  g_debug ("queried");
+
+  result = script_fu_interpreter_list_defined_proc_names (plug_in, path_to_this_script);
+  if (g_list_length (result) < 1)
+    g_warning ("No procedures defined in %s", path_to_this_script);
+
+  /* Caller is PIKA and it will free the list. */
+  return result;
+}
+
+
+/* Create and return a PikaPDBProcedure,
+ * for the named one of the PDB procedures that the script implements.
+ * A callback from PIKA.
+ *
+ * Also set attributes on the procedure, most importantly, menu items (optional.)
+ * Also create any menus/submenus that the script defines e.g. Filters>My
+ */
+static PikaProcedure *
+script_fu_interpreter_create_procedure (PikaPlugIn  *plug_in,
+                                        const gchar *proc_name)
+{
+  return script_fu_interpreter_create_proc_at_path (plug_in,
+                                                    proc_name,
+                                                    path_to_this_script);
+}

plug-ins/script-fu/interpreter/script-fu-interpreter.c

@@ -0,0 +1,196 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * 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 <libpika/pika.h>
+
+#include "libscriptfu/script-fu-lib.h"
+
+#include "script-fu-interpreter.h"
+
+/* Implementation of the outer ScriptFuInterpreter.
+ * This understands ScriptFu internals
+ * i.e. uses libscriptfu shared with other ScriptFu plugins e.g. extension-script-fu.
+ */
+
+/* We don't need to load (into the interpreter) any .scm files handled by extension-script-fu.
+ * Namely, the .scm in the PIKA installation /scripts or in the user local /scripts dirs.
+ *
+ * During startup, PIKA might call pika-script-fu-interpreter
+ * to query new files such as /plug-ins/fu/fu.scm.
+ * This is before extension-script-fu starts.
+ * But all the .scm files handled by extension-script-fu are type TEMPORARY and not needed
+ * for a /plug-ins/fu.scm to be queried.
+ * The only Scheme executed during query are calls to script-fu-register.
+ * Later, when a /plug-ins/fu.scm is run, it can call temporary PDB procedures
+ * that extension-script-fu provides.
+ *
+ * When we call script_fu_init_embedded_interpreter(),
+ * the passed paths should include the path to /scripts
+ * because that is the location of scripts for initialization and compatibility
+ * (script-fu.init, plug-in-compat.init and script-fu-compat.init,
+ * which are really scheme files.)
+ *
+ * scrip-fu-interpreter always inits embedded interpreter(allow_register=TRUE)
+ * In the "run" phase, you don't need script-fu-register to be defined, but its harmless.
+ */
+
+static GFile *script_fu_get_plugin_parent_path (const gchar *path_to_this_script);
+static void   script_fu_free_path_list         (GList      **list);
+
+
+/* Return a list of PDB procedure names defined in all .scm files in
+ * the parent dir of the given path, which is a filename of the one being queried.
+ *
+ * Each .scm file may contain many calls to script-fu-register, which defines a PDB procedure.
+ * All .scm files in the parent dir are searched.
+ *
+ * This executable is named script-fu-interpreter
+ * but no PDB procedure is named "script-fu-interpreter".
+ * Instead, the interpreter registers PDB procs named from name strings
+ * give in the in script-fu-register() calls in the interpreted scripts.
+ *
+ * Caller must free the list.
+ */
+GList *
+script_fu_interpreter_list_defined_proc_names (PikaPlugIn  *plug_in,
+                                               const gchar *path_to_this_script)
+{
+  GList *name_list = NULL;  /* list of strings */
+  GList *path_list = NULL;  /* list of GFile */
+
+  /* path_list is /scripts dir etc. from which we will load compat and init scripts.
+   * second argument TRUE means define script-fu-register into the interpreter.
+   */
+  path_list = script_fu_search_path ();
+  script_fu_init_embedded_interpreter (path_list, TRUE, PIKA_RUN_NONINTERACTIVE);
+  script_fu_free_path_list (&path_list);
+
+  /* Reuse path_list, now a list of one path, the parent dir of the queried script. */
+  path_list = g_list_append (path_list,
+                             script_fu_get_plugin_parent_path (path_to_this_script));
+  name_list = script_fu_find_scripts_list_proc_names (plug_in, path_list);
+  script_fu_free_path_list (&path_list);
+
+  /* Usually name_list is not NULL i.e. not empty.
+   * But an .scm file that is not an actual PIKA plugin, or broken, may yield empty list.
+   */
+  return name_list;
+}
+
+
+/* Create a PDB proc of type PLUGIN with the given name.
+ * Unlike extension-script-fu, create proc of type PLUGIN.
+ *
+ * We are in "create procedure" phase of call from PIKA.
+ * Create a PDB procedure that the script-fu-interpreter wraps.
+ *
+ * A PikaPDBProcedure has a run function, here script_fu_script_proc()
+ * of this outer interpreter.
+ * Sometime after the create, PIKA calls the run func, passing a name aka command.
+ * In ScriptFu, the same name is used for the PDB proc and the Scheme function
+ * which is the inner run func defined in the script.
+ * script_fu_script_proc calls the TinyScheme interpreter to evaluate
+ * the inner run func in the script.
+ */
+PikaProcedure *
+script_fu_interpreter_create_proc_at_path (PikaPlugIn  *plug_in,
+                                           const gchar *proc_name,
+                                           const gchar *path_to_this_script
+                                          )
+{
+  PikaProcedure *procedure = NULL;
+  GList         *path_list = NULL;  /* list of GFile */
+
+  g_debug ("script_fu_interpreter_create_proc_at_path, name: %s", proc_name);
+
+  /* Require proc_name is a suitable name for a PDB procedure eg "script-fu-test".
+   * (Not tested for canonical name "script-fu-<something>")
+   * Require proc_name is a name that was queried earlier.
+   * Require the proc_name was defined in some .scm file
+   * in the same directory as the .scm file passed as argv[0].
+   * The name of the .scm file eg "/plug-ins/fu/fu.scm"
+   * can be entirely different from proc_name.
+   *
+   * Otherwise, we simply won't find the proc_name defined in any .scm file,
+   * and will fail gracefully, returning NULL.
+   */
+
+  path_list = script_fu_search_path ();
+  path_list = g_list_append (path_list,
+                             script_fu_get_plugin_parent_path (path_to_this_script));
+  /* path_list are the /scripts dir, for .init and compat.scm, plus the path to this.
+   * second arg TRUE means define script-fu-register so it is effective.
+   */
+  script_fu_init_embedded_interpreter (path_list, TRUE, PIKA_RUN_NONINTERACTIVE);
+
+  /* Reuse path_list, now a list of only the path to this script. */
+  script_fu_free_path_list (&path_list);
+  path_list = g_list_append (path_list,
+                             script_fu_get_plugin_parent_path (path_to_this_script));
+
+  procedure = script_fu_find_scripts_create_PDB_proc_plugin (plug_in, path_list, proc_name);
+  script_fu_free_path_list (&path_list);
+
+  /* When procedure is not NULL, assert:
+   *    some .scm was evaluated.
+   *    the script defined many PDB procedures locally, i.e. in script-tree
+   *    we created a single PDB procedure (but not put it in the PIKA PDB)
+   *
+   * Ensure procedure is-a PikaProcedure or NULL.
+   * PIKA is the caller and will put non-NULL procedure in the PDB.
+   */
+  return procedure;
+}
+
+
+/* Return GFile of the parent directory of this plugin, whose filename is given.
+ *
+ * Caller must free the GFile.
+ */
+static GFile *
+script_fu_get_plugin_parent_path (const gchar *path_to_this_script)
+{
+  GFile *path        = NULL;
+  GFile *parent_path = NULL;
+
+  /* A libpika PikaPlugin does not know its path,
+   * but its path was passed in argv to this interpreter.
+   * The path is to a file being queried e.g. "~/.config/PIKA/2.99/plug-ins/fu/fu.scm"
+   */
+  g_debug ("path to this plugin %s", path_to_this_script);
+  path = g_file_new_for_path (path_to_this_script);
+  parent_path = g_file_get_parent (path);
+  g_object_unref (path);
+  return parent_path;
+}
+
+/* Free a list of paths at the given handle.
+ * Ensures that the pointer to the list is NULL, prevents "dangling."
+ * g_list_free_full alone does not do that.
+ */
+static void
+script_fu_free_path_list (GList **list)
+{
+  /* !!! g_steal_pointer takes a handle. */
+  g_list_free_full (g_steal_pointer (list), g_object_unref);
+}

plug-ins/script-fu/interpreter/script-fu-interpreter.h

@@ -0,0 +1,33 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#ifndef __SCRIPT_FU_INTERPRETER_H__
+#define __SCRIPT_FU_INTERPRETER_H__
+
+GList         *script_fu_interpreter_list_defined_proc_names (
+                                            PikaPlugIn  *plug_in,
+                                            const gchar *path_to_this_plugin);
+PikaProcedure *script_fu_interpreter_create_proc_at_path (
+                                            PikaPlugIn  *plug_in,
+                                            const gchar *proc_name,
+                                            const gchar *path_to_this_script);
+
+#endif /*  __SCRIPT_FU_INTERPRETER_H__  */

plug-ins/script-fu/libscriptfu/README

@@ -0,0 +1,45 @@
+About libscriptfu
+
+libscriptfu is part of PIKA.
+It is not generally useful except by PIKA.
+
+The libscriptfu library is used by plugin executables,
+and the PDB procedures they create,
+all part of the "ScriptFu" machinery.
+
+The libscriptfu library is not intended for third-party developers,
+only for core PIKA developers.
+Headers for libscriptfu might not be installed.
+
+This directory contains three libraries: libscriptfu, tinyscheme, and ftx.
+The tinyscheme library contains a TinyScheme interpreter.
+The ftx library extends the TinyScheme interpreter,
+adding file functions to the Scheme language.
+The libscriptfu library contains both the tinyscheme and ftx libraries.
+The libscriptfu library wraps the TinyScheme interpreter,
+specializing it for PIKA.
+The script-fu executable uses the libscriptfu library,
+to interpret Scheme scripts that PIKA users refer to as "plug-ins."
+
+These libraries depend on other libraries, e.g. math, libpika, glib, etc.
+
+Coupling between the executables and the libraries should be in one direction:
+source for the inner libs should not include headers from the outer executables.
+This lets you more easily update the inner libraries
+(which originated elsewhere and might be maintained elsewhere),
+and change the outer executables
+(which are subject to change by PIKA developers.)
+
+Example (which may change):
+The script-fu executable is a plugin file that implements PDB procedures:
+extension-script-fu, script-fu-console, script-fu-text-console, script-fu-eval,
+and script-fu-server.
+Each of those PDB procedures runs as a separate process.
+Each of those processes uses libscriptfu.
+The main PDB procedure is extension-script-fu, which is a long-lived process.
+It is a PDB procedure of PDBProcedureType EXTENSION.
+It interprets the Scheme scripts that user's call "plug-ins."
+
+Rarely two of the PDB procedure processes run concurrently.
+When they do, and libscriptfu is built as a shared library,
+the read-only, code portion of the library is only loaded in memory once.

plug-ins/script-fu/libscriptfu/ftx/LICENSE

@@ -0,0 +1,31 @@
+                         LICENSE TERMS
+
+(c) 2002 Manuel Heras-Gilsanz (manuel@heras-gilsanz.com)
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+
+Redistributions in binary form must reproduce the above copyright
+notice, this list of conditions and the following disclaimer in the
+documentation and/or other materials provided with the distribution.
+
+Neither the name of Manuel Heras-Gilsanz nor the names of the
+contributors may be used to endorse or promote products derived from
+this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR 
+CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 
+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 
+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 
+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 
+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

plug-ins/script-fu/libscriptfu/ftx/README

@@ -0,0 +1,99 @@
+TinyScheme Extensions (TSX) 1.1  [September, 2002]
+(c) 2002 Manuel Heras-Gilsanz (manuel@heras-gilsanz.com)
+
+This software is subject to the license terms contained in the
+LICENSE file.
+
+Changelog:
+1.1 (Sept. 2002) Updated to tinyscheme 1.31
+1.0 (April 2002) First released version
+
+
+WHAT IS TSX?
+
+TinyScheme Extensions is a set of dynamic libraries incorporating
+additional funcionality to TinyScheme, a lightweight
+implementation of the Scheme programming language. TinyScheme
+(http://tinyscheme.sourceforge.net) is maintained by D. Souflis
+(dsouflis@acm.org), and is based on MiniSCHEME version 0.85k4.
+
+Scheme is a very nice and powerful programming language, but the
+basic language is very minimalistic in terms of library functions;
+only basic file input / output functionality is specified.
+Different implementations of the language (MIT Scheme, GUILE,
+Bigloo...) provide their own extension libraries. TSX attempts to
+provide commonly needed functions at a small cost in terms of
+additional program footprint. The library is modularized, so that
+it is possible (and easy!) to select desired functionality via
+#defines in tsx.h.
+
+
+INSTALLATION
+
+TSX has been tested on GNU/Linux 2.4.2 with gcc 2.96 and
+libc-2.2.2, with TinyScheme 1.31.
+
+To install, copy the distribution file to the directory
+where TinyScheme is installed (and where scheme.h lies),
+and run make. If building succeeds, a file called tsx.so
+should be created. This file can be loaded as a TinyScheme
+extension with 
+
+    (load-extension "tsx-1.0/tsx")
+
+After loading TSX, you can make use of its functions.
+To reduce footprint, you can choose the functionality which
+will be included. To do so, have a look at tsx.h and
+comment the #defines for unneeded modules.
+
+If you get compiler errors, make sure you have enabled
+dynamic modules in your tinyscheme runtime (define USE_DL
+somewhere near the top in scheme.h).
+
+
+SAMPLE APPLICATIONS
+
+Three sample applications are distributed with TSX 1.0.
+The code is not particularly elegant, nor written in proper
+functional style, but is provided for illustration of the
+implemented calls.
+
+-smtp.scm
+    Sends an email to the user getting the username from
+    the USER shell variable, connecting to the SMTP port
+    on the local machine.
+
+-listhome.scm
+    Provides a list of all the files on the user's home
+    directory (obtained with the HOME environment variable).
+
+-srepl.scm
+    Provides a socket-based read-eval-print-loop. It listens
+    for connections on the 9000 port of the local machines,
+    and executes the commands received. To test it, run
+
+        telnet localhost 9000
+
+    after starting the sample application, and type Scheme
+    expressions. You will get the evaluations. To exit the
+    session, type "quit" and TinyScheme will exit, closing
+    the socket. The output of some functions will not
+    be the same as you would obtain on TinyScheme's
+    "command line", because standard output is not
+    redirected to the socket, but most commands work ok.
+
+You should copy these applications to the directory where
+TinyScheme is installed (i.e., where the "scheme" binary
+file resides), and can be run with:
+
+    ./scheme listhome.scm
+    ./scheme smtp.scm
+    ./scheme srepl.scm
+
+
+TSX FUNCTIONS
+
+The extension functions implemented by TinyScheme Extensions are
+documented in the file "tsx-functions.txt".
+
+END

plug-ins/script-fu/libscriptfu/ftx/ftx-functions.txt

@@ -0,0 +1,119 @@
+File and Time Extensions for TinyScheme (FTX) 1.0  [August, 2004]
+
+Based on the TinyScheme Extensions (TSX) 1.1  [September, 2002]
+(c) 2002 Manuel Heras-Gilsanz (manuel@heras-gilsanz.com)
+
+This software is subject to the license terms contained in the
+LICENSE file.
+
+
+TSX FUNCTIONS
+
+TSX incorporates the following functions:
+
+*File system (included if HAVE_FILESYSTEM is defined in tsx.h)
+
+Scheme already defines functions to read and write files. These
+functions allow access to the filesystem to check if a certain
+file exists, to get its size, etc.
+
+In addition to these functions, a string constant DIR-SEPARATOR
+has been defined. It should be used in scripts which build file
+names that include one or more directories to keep the scripts
+portable to different operating systems.
+
+(file-exists? filename)
+        filename: string
+
+        This function returns #t if the indicated file exists, and
+        #f if it does not exist or if it is not accessible to the
+        requesting user. Accessibility is based on the real user
+        and group ID rather than the effective user ID and group ID.
+
+(file-type filename)
+        filename: string
+
+        This function returns a value based on the file type. It
+        returns FILE_TYPE_FILE (1) for regular files, FILE_TYPE_DIR
+        (2) for directories, and FILE_TYPE_LINK (3) for symbolic
+        links. The value FILE_TYPE_OTHER (0) is returned if the file
+        is of some other type, does not exist, or if the user does
+        not have sufficient privileges to allow the file type to be
+        determined.
+
+(file-size filename)
+        filename: string
+
+        This function returns the size (in bytes) of the
+        indicated file, or #f if the file does not exists or
+        is not accessible to the requesting user.
+
+(file-delete filename)
+        filename: string
+
+        Removes the specified file. It returns #t if the operation
+        succeeds, or #f otherwise (e.g., because the file is
+        read-only, or because the file does not exist).
+
+(dir-open-stream path)
+        path: string
+
+        Opens a "directory stream" on the provided directory path.
+        This stream will provide all the files within the directory,
+        using the function read-dir-entry. The stream should be closed
+        at the end with dir-close-stream.
+
+(dir-read-entry dirstream)
+        dirstream: directory stream, obtained with dir-open-stream.
+
+        It returns the name of the following directory entry, or eof
+        if all the entries were provided. Check the return value with
+        with eof-object?.
+
+(dir-rewind dirstream)
+        dirstream: directory stream, obtained with dir-open-stream.
+
+        Resets the given directory stream. The next call to dir-read-entry
+        will return the first entry again. It returns #t if the operation
+        succeeds, or #f otherwise (ie. dirstream not valid)..
+
+(dir-close-stream dirstream) 
+        dirstream: directory stream, obtained with dir-open-stream.
+
+        Close directory stream. No further calls to read-dir-entry should
+        be performed.
+
+(dir-make dirname . mode)
+       dirname: string
+       mode: integer representing permissions
+
+       Create the directory specified, setting the directory permissions based
+       upon the optional mode argument (taking into account the current
+       umask). If no mode is specified then use the default (umask)
+       permissions. Returns #t if the operation succeeds, otherwise #f.
+       Possible reasons for failure are that the directory already exists,
+       the user is not authorized to create it, or the mode is incorrectly
+       specified).
+
+*Time (available if HAVE_TIME is defined in tsx.h)
+
+(time)
+        Returns the current local time, as a list of integer
+        containing:
+          (year month day-of-month hour min sec millisec)
+        The year is expressed as an offset from 1900.
+
+(gettimeofday)
+        Returns a list containing the number of seconds from
+        the beginning of the day, and microseconds within the
+        current second.
+
+(usleep microsec)
+        microsec: integer
+
+        Suspends execution of the calling thread during the
+        specified number of microseconds.
+
+
+END
+

plug-ins/script-fu/libscriptfu/ftx/ftx.c

@@ -0,0 +1,415 @@
+/* TinyScheme Extensions
+ * (c) 2002 Visual Tools, S.A.
+ * Manuel Heras-Gilsanz (manuel@heras-gilsanz.com)
+ *
+ * This software is subject to the terms stated in the
+ * LICENSE file.
+ */
+
+#include "config.h"
+
+#include <sys/types.h>
+#include <sys/stat.h>
+#if HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+#include <time.h>
+
+#include <glib.h>
+
+#include "tinyscheme/scheme-private.h"
+
+#undef cons
+
+typedef enum
+{
+  FILE_TYPE_UNKNOWN = 0, FILE_TYPE_FILE, FILE_TYPE_DIR, FILE_TYPE_LINK
+} FileType;
+
+struct
+named_constant {
+    const char *name;
+    FileType    value;
+};
+
+struct named_constant
+file_type_constants[] = {
+    { "FILE-TYPE-UNKNOWN", FILE_TYPE_UNKNOWN },
+    { "FILE-TYPE-FILE",    FILE_TYPE_FILE },
+    { "FILE-TYPE-DIR",     FILE_TYPE_DIR },
+    { "FILE-TYPE-LINK",    FILE_TYPE_LINK },
+    { NULL, 0 }
+};
+
+pointer foreign_fileexists(scheme *sc, pointer args);
+pointer foreign_filetype(scheme *sc, pointer args);
+pointer foreign_filesize(scheme *sc, pointer args);
+pointer foreign_filedelete(scheme *sc, pointer args);
+pointer foreign_diropenstream(scheme *sc, pointer args);
+pointer foreign_dirreadentry(scheme *sc, pointer args);
+pointer foreign_dirrewind(scheme *sc, pointer args);
+pointer foreign_dirclosestream(scheme *sc, pointer args);
+pointer foreign_mkdir(scheme *sc, pointer args);
+
+pointer foreign_getenv(scheme *sc, pointer args);
+pointer foreign_time(scheme *sc, pointer args);
+pointer foreign_gettimeofday(scheme *sc, pointer args);
+pointer foreign_usleep(scheme *sc, pointer args);
+void    init_ftx (scheme *sc);
+
+
+pointer foreign_fileexists(scheme *sc, pointer args)
+{
+  pointer first_arg;
+  char   *filename;
+
+  if (args == sc->NIL)
+    return sc->F;
+
+  first_arg = sc->vptr->pair_car(args);
+  if (!sc->vptr->is_string(first_arg))
+    return sc->F;
+
+  filename = sc->vptr->string_value(first_arg);
+  filename = g_filename_from_utf8 (filename, -1, NULL, NULL, NULL);
+  if (g_file_test(filename, G_FILE_TEST_EXISTS))
+    return sc->T;
+
+  return sc->F;
+}
+
+pointer foreign_filetype(scheme *sc, pointer args)
+{
+  pointer first_arg;
+  char   *filename;
+  int     retcode;
+
+  if (args == sc->NIL)
+    return sc->F;
+
+  first_arg = sc->vptr->pair_car(args);
+  if (!sc->vptr->is_string(first_arg))
+    return sc->F;
+
+  filename = sc->vptr->string_value(first_arg);
+  filename = g_filename_from_utf8 (filename, -1, NULL, NULL, NULL);
+
+  if (g_file_test(filename, G_FILE_TEST_IS_SYMLINK))
+    retcode =  FILE_TYPE_LINK;
+  else if (g_file_test(filename, G_FILE_TEST_IS_REGULAR))
+    retcode = FILE_TYPE_FILE;
+  else if (g_file_test(filename, G_FILE_TEST_IS_DIR))
+    retcode = FILE_TYPE_DIR;
+  else
+    retcode = FILE_TYPE_UNKNOWN;
+
+  return sc->vptr->mk_integer(sc, retcode);
+}
+
+pointer foreign_filesize(scheme *sc, pointer args)
+{
+  pointer first_arg;
+  pointer ret;
+  struct stat buf;
+  char * filename;
+  int retcode;
+
+  if (args == sc->NIL)
+    return sc->F;
+
+  first_arg = sc->vptr->pair_car(args);
+  if (!sc->vptr->is_string(first_arg))
+    return sc->F;
+
+  filename = sc->vptr->string_value(first_arg);
+  filename = g_filename_from_utf8 (filename, -1, NULL, NULL, NULL);
+  retcode = stat(filename, &buf);
+  if (retcode == 0)
+    ret = sc->vptr->mk_integer(sc,buf.st_size);
+  else
+    ret = sc->F;
+  return ret;
+}
+
+pointer foreign_filedelete(scheme *sc, pointer args)
+{
+  pointer first_arg;
+  pointer ret;
+  char * filename;
+  int retcode;
+
+  if (args == sc->NIL)
+    return sc->F;
+
+  first_arg = sc->vptr->pair_car(args);
+  if (!sc->vptr->is_string(first_arg)) {
+    return sc->F;
+  }
+
+  filename = sc->vptr->string_value(first_arg);
+  filename = g_filename_from_utf8 (filename, -1, NULL, NULL, NULL);
+  retcode = unlink(filename);
+  if (retcode == 0)
+    ret = sc->T;
+  else
+    ret = sc->F;
+  return ret;
+}
+
+pointer foreign_diropenstream(scheme *sc, pointer args)
+{
+  pointer first_arg;
+  char   *dirpath;
+  GDir   *dir;
+
+  if (args == sc->NIL)
+    return sc->F;
+
+  first_arg = sc->vptr->pair_car(args);
+  if (!sc->vptr->is_string(first_arg))
+    return sc->F;
+
+  dirpath = sc->vptr->string_value(first_arg);
+  dirpath = g_filename_from_utf8 (dirpath, -1, NULL, NULL, NULL);
+
+  dir = g_dir_open(dirpath, 0, NULL);
+  if (dir == NULL)
+    return sc->F;
+
+  /* Stuffing a pointer in a long may not always be portable ~~~~~ */
+  return (sc->vptr->mk_integer(sc, (long) dir));
+}
+
+pointer foreign_dirreadentry(scheme *sc, pointer args)
+{
+  pointer first_arg;
+  GDir   *dir;
+  gchar  *entry;
+
+  if (args == sc->NIL)
+    return sc->F;
+
+  first_arg = sc->vptr->pair_car(args);
+  if (!sc->vptr->is_integer(first_arg))
+    return sc->F;
+
+  dir = (GDir *) sc->vptr->ivalue(first_arg);
+  if (dir == NULL)
+    return sc->F;
+
+  entry = (gchar *)g_dir_read_name(dir);
+  if (entry == NULL)
+    return sc->EOF_OBJ;
+
+  entry = g_filename_to_utf8 (entry, -1, NULL, NULL, NULL);
+  return (sc->vptr->mk_string(sc, entry));
+}
+
+pointer foreign_dirrewind(scheme *sc, pointer args)
+{
+  pointer first_arg;
+  GDir   *dir;
+
+  if (args == sc->NIL)
+    return sc->F;
+
+  first_arg = sc->vptr->pair_car(args);
+  if (!sc->vptr->is_integer(first_arg))
+    return sc->F;
+
+  dir = (GDir *) sc->vptr->ivalue(first_arg);
+  if (dir == NULL)
+    return sc->F;
+
+  g_dir_rewind(dir);
+  return sc->T;
+}
+
+pointer foreign_dirclosestream(scheme *sc, pointer args)
+{
+  pointer first_arg;
+  GDir   *dir;
+
+  if (args == sc->NIL)
+    return sc->F;
+
+  first_arg = sc->vptr->pair_car(args);
+  if (!sc->vptr->is_integer(first_arg))
+    return sc->F;
+
+  dir = (GDir *) sc->vptr->ivalue(first_arg);
+  if (dir == NULL)
+    return sc->F;
+
+  g_dir_close(dir);
+  return sc->T;
+}
+
+pointer foreign_mkdir(scheme *sc, pointer args)
+{
+  pointer     first_arg;
+  pointer     rest;
+  pointer     second_arg;
+  char       *dirname;
+  mode_t      mode;
+  int         retcode;
+
+  if (args == sc->NIL)
+    return sc->F;
+
+  first_arg = sc->vptr->pair_car(args);
+  if (!sc->vptr->is_string(first_arg))
+    return sc->F;
+  dirname = sc->vptr->string_value(first_arg);
+  dirname = g_filename_from_utf8 (dirname, -1, NULL, NULL, NULL);
+
+  rest = sc->vptr->pair_cdr(args);
+  if (sc->vptr->is_pair(rest)) /* optional mode argument */
+    {
+      second_arg = sc->vptr->pair_car(rest);
+      if (!sc->vptr->is_integer(second_arg))
+        return sc->F;
+      mode = sc->vptr->ivalue(second_arg);
+    }
+  else
+    mode = 0777;
+
+  retcode = g_mkdir(dirname, (mode_t)mode);
+  if (retcode == 0)
+    return sc->T;
+  else
+    return sc->F;
+}
+
+pointer foreign_getenv(scheme *sc, pointer args)
+{
+  pointer     first_arg;
+  pointer     ret;
+  char       *varname;
+  const char *value;
+
+  if (args == sc->NIL)
+    return sc->F;
+
+  first_arg = sc->vptr->pair_car(args);
+
+  if (!sc->vptr->is_string(first_arg))
+    return sc->F;
+
+  varname = sc->vptr->string_value(first_arg);
+  value = g_getenv(varname);
+  if (value == NULL)
+    ret = sc->F;
+  else
+    ret = sc->vptr->mk_string(sc,value);
+
+  return ret;
+}
+
+pointer foreign_time(scheme *sc, pointer args)
+{
+  time_t now;
+  struct tm *now_tm;
+  pointer ret;
+
+  if (args != sc->NIL)
+    return sc->F;
+
+  time(&now);
+  now_tm = localtime(&now);
+
+  ret = sc->vptr->cons(sc, sc->vptr->mk_integer(sc,(long) now_tm->tm_year),
+         sc->vptr->cons(sc, sc->vptr->mk_integer(sc,(long) now_tm->tm_mon),
+          sc->vptr->cons(sc, sc->vptr->mk_integer(sc,(long) now_tm->tm_mday),
+           sc->vptr->cons(sc, sc->vptr->mk_integer(sc,(long) now_tm->tm_hour),
+            sc->vptr->cons(sc, sc->vptr->mk_integer(sc,(long) now_tm->tm_min),
+             sc->vptr->cons(sc, sc->vptr->mk_integer(sc,(long) now_tm->tm_sec),sc->NIL))))));
+
+  return ret;
+}
+
+pointer foreign_gettimeofday(scheme *sc, pointer args)
+{
+  pointer ret;
+  gint64  time;
+
+  time = g_get_real_time ();
+
+  ret = sc->vptr->cons(sc, sc->vptr->mk_integer(sc,(long) time / G_USEC_PER_SEC),
+         sc->vptr->cons(sc, sc->vptr->mk_integer(sc,(long) time % G_USEC_PER_SEC),
+          sc->NIL));
+
+  return ret;
+}
+
+pointer foreign_usleep(scheme *sc, pointer args)
+{
+  pointer first_arg;
+  long usec;
+
+  if (args == sc->NIL)
+    return sc->F;
+
+  first_arg = sc->vptr->pair_car(args);
+  if (!sc->vptr->is_integer(first_arg))
+    return sc->F;
+
+  usec = sc->vptr->ivalue(first_arg);
+  g_usleep(usec);
+
+  return sc->T;
+}
+
+/* This function gets called when TinyScheme is loading the extension */
+void init_ftx (scheme *sc)
+{
+  int i;
+
+  sc->vptr->scheme_define(sc,sc->global_env,
+                               sc->vptr->mk_symbol(sc,"getenv"),
+                               sc->vptr->mk_foreign_func(sc, foreign_getenv));
+  sc->vptr->scheme_define(sc, sc->global_env,
+                               sc->vptr->mk_symbol(sc,"time"),
+                               sc->vptr->mk_foreign_func(sc, foreign_time));
+  sc->vptr->scheme_define(sc, sc->global_env,
+                               sc->vptr->mk_symbol(sc,"gettimeofday"),
+                               sc->vptr->mk_foreign_func(sc, foreign_gettimeofday));
+  sc->vptr->scheme_define(sc, sc->global_env,
+                               sc->vptr->mk_symbol(sc,"usleep"),
+                               sc->vptr->mk_foreign_func(sc, foreign_usleep));
+
+  sc->vptr->scheme_define(sc, sc->global_env,
+                               sc->vptr->mk_symbol(sc,"file-exists?"),
+                               sc->vptr->mk_foreign_func(sc, foreign_fileexists));
+  sc->vptr->scheme_define(sc, sc->global_env,
+                               sc->vptr->mk_symbol(sc,"file-type"),
+                               sc->vptr->mk_foreign_func(sc, foreign_filetype));
+  sc->vptr->scheme_define(sc, sc->global_env,
+                               sc->vptr->mk_symbol(sc,"file-size"),
+                               sc->vptr->mk_foreign_func(sc, foreign_filesize));
+  sc->vptr->scheme_define(sc, sc->global_env,
+                               sc->vptr->mk_symbol(sc,"file-delete"),
+                               sc->vptr->mk_foreign_func(sc, foreign_filedelete));
+  sc->vptr->scheme_define(sc, sc->global_env,
+                               sc->vptr->mk_symbol(sc,"dir-open-stream"),
+                               sc->vptr->mk_foreign_func(sc, foreign_diropenstream));
+  sc->vptr->scheme_define(sc, sc->global_env,
+                               sc->vptr->mk_symbol(sc,"dir-read-entry"),
+                               sc->vptr->mk_foreign_func(sc, foreign_dirreadentry));
+  sc->vptr->scheme_define(sc, sc->global_env,
+                               sc->vptr->mk_symbol(sc,"dir-rewind"),
+                               sc->vptr->mk_foreign_func(sc, foreign_dirrewind));
+  sc->vptr->scheme_define(sc, sc->global_env,
+                               sc->vptr->mk_symbol(sc,"dir-close-stream"),
+                               sc->vptr->mk_foreign_func(sc, foreign_dirclosestream));
+  sc->vptr->scheme_define(sc, sc->global_env,
+                               sc->vptr->mk_symbol(sc,"dir-make"),
+                               sc->vptr->mk_foreign_func(sc, foreign_mkdir));
+
+  for (i = 0; file_type_constants[i].name != NULL; ++i)
+  {
+      sc->vptr->scheme_define(sc, sc->global_env,
+            sc->vptr->mk_symbol(sc, file_type_constants[i].name),
+            sc->vptr->mk_integer(sc, file_type_constants[i].value));
+  }
+}

plug-ins/script-fu/libscriptfu/ftx/ftx.h

@@ -0,0 +1,2 @@
+/* This function gets called when TinyScheme is initializing the extension */
+void init_ftx (scheme *sc);

plug-ins/script-fu/libscriptfu/ftx/listhome.scm

@@ -0,0 +1,58 @@
+; listhome.scm
+; Sample usage of TinyScheme Extension
+; This simple program lists the directory entries on the
+; user's home directory.
+
+; It uses the following TinyScheme Extension functions:
+;    getenv
+;      Used to get HOME environment variable.
+;    open-dir-stream
+;      Used to open directory stream.
+;    read-dir-entry
+;      Used to read directory entries.
+;    close-dir-entry
+;      Used at the end, to close directory stream when done.
+
+; check that extensions are enabled
+(if (not (defined? 'load-extension))
+    (begin
+      (display "TinyScheme has extensions disabled. Enable them!!")
+      (newline)
+      (quit)))
+
+; load TinyScheme extension
+(load-extension "tsx-1.1/tsx")
+
+; check that the necessary functions are available (the user
+; might have removed some functionality...)
+(if (or
+      (not (defined? 'getenv))
+      (not (defined? 'dir-open-stream))
+      (not (defined? 'dir-read-entry))
+      (not (defined? 'dir-close-stream)))
+    (begin
+      (display "Some necessary functions are not available. Exiting!")
+      (newline)
+      (quit)))
+
+; get user's home dir from HOME environment var
+(define homedir (getenv "HOME"))
+(display "Listing contents of ") (display homedir) (newline)
+
+; create directory stream to read dir entries
+(define dirstream (dir-open-stream homedir))
+(if (not dirstream)
+  (begin
+    (display "Unable to open home directory!! Check value of HOME environment var.")
+    (quit)))
+
+(let listentry ((entry (dir-read-entry dirstream)))
+  (if (eof-object? entry)
+    #t
+    (begin
+      (display entry)
+      (newline)
+      (listentry (dir-read-entry dirstream)))))
+
+(dir-close-stream dirstream)
+

plug-ins/script-fu/libscriptfu/ftx/meson.build

@@ -0,0 +1,12 @@
+
+scriptfu_ftx = static_library('scriptfu-ftx',
+  'ftx.c',
+  include_directories: [ rootInclude, libscriptfuInclude, ],
+  dependencies: [
+    glib,
+  ],
+  c_args: [
+    '-DUSE_INTERFACE=1',
+  ],
+  install: false,
+)

plug-ins/script-fu/libscriptfu/meson.build

@@ -0,0 +1,67 @@
+libscriptfuInclude = include_directories('.')
+
+subdir('tinyscheme')
+subdir('ftx')
+
+libscriptfu_sources = [
+  'scheme-wrapper.c',
+  'scheme-marshal.c',
+  'scheme-marshal-return.c',
+  'script-fu-interface.c',
+  'script-fu-regex.c',
+  'script-fu-script.c',
+  'script-fu-scripts.c',
+  'script-fu-utils.c',
+  'script-fu-errors.c',
+  'script-fu-compat.c',
+  'script-fu-lib.c',
+  'script-fu-proc-factory.c',
+  'script-fu-arg.c',
+  'script-fu-register.c',
+  'script-fu-dialog.c',
+  'script-fu-run-func.c',
+  'script-fu-command.c',
+]
+
+# !! just "library(...)" which means shared versus static depends on configuration of project.
+# Meson defaults to shared, but you can reconfigure to static.
+# This library is not generally useful except by core PIKA developers.
+
+# Dependencies:
+# libscriptfu uses Gtk (which libpikaui_dep references)
+# FUTURE: libscriptfu should use libpikaui but not Gtk directly
+# libscriptfu does not use sockets (unlike the outer script-fu or script-fu-server)
+
+# link_whole means the entire ftx and tinyscheme static libraries are in
+# this library, whether or not they are used (see meson docs.)
+
+# FUTURE: install private to pika, in 'lib' subdir parallel to 'modules' subdir
+# Not doing this because it complicates packaging
+# Instead, this library installs in same place as libpika
+# install_dir: pikaplugindir / 'lib',
+
+libscriptfu = library('pika-scriptfu-'+ pika_api_version,
+  libscriptfu_sources,
+  include_directories: [
+    rootInclude,
+    appInclude,
+  ],
+  c_args: [
+    '-DG_LOG_DOMAIN="scriptfu"',
+    '-DSTANDALONE=0',
+    '-DUSE_INTERFACE=1',
+    '-DUSE_STRLWR=0',
+  ],
+  dependencies: [
+    libpikaui_dep,
+    math,
+    gi,
+  ],
+  link_whole: [
+    scriptfu_tinyscheme,
+    scriptfu_ftx,
+  ],
+  vs_module_defs: 'script-fu.def',
+  version: so_version,
+  install: true,
+)

plug-ins/script-fu/libscriptfu/scheme-marshal-return.c

@@ -0,0 +1,619 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * 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 "libpika/pika.h"
+#include "tinyscheme/scheme-private.h"
+#include "script-fu-errors.h"
+#include "scheme-marshal.h"
+#include "scheme-marshal-return.h"
+
+/* When include scheme-private.h, must undef cons macro */
+#undef cons
+
+static pointer marshal_PDB_return_by_arity  (scheme         *sc,
+                                             PikaValueArray *values,
+                                             pointer        *error);
+
+static pointer marshal_returned_PDB_values  (scheme         *sc,
+                                             PikaValueArray *values,
+                                             pointer        *error);
+
+static pointer marshal_returned_PDB_value   (scheme        *sc,
+                                             GValue        *value,
+                                             guint          array_length,
+                                             pointer       *error);
+
+
+/* Marshall a GValueArray returned by a PDB procedure.
+ * From a GValueArray into scheme value or error.
+ *
+ * Understands PDB status values.
+ * Delegates most marshalling to marshal_PDB_return_by_arity.
+ * See its doc string.
+ */
+pointer
+marshal_PDB_return (scheme         *sc,
+                    PikaValueArray *values,
+                    gchar          *proc_name,
+                    pointer        *error)
+{
+  gchar   error_str[1024];
+  pointer result = NULL;
+
+  *error = NULL;
+
+  /* caller asserts status value index 0 exists. */
+  switch (PIKA_VALUES_GET_ENUM (values, 0))
+    {
+    case PIKA_PDB_EXECUTION_ERROR:
+      if (pika_value_array_length (values) > 1 &&
+          G_VALUE_HOLDS_STRING (pika_value_array_index (values, 1)))
+        {
+          g_snprintf (error_str, sizeof (error_str),
+                      "Procedure execution of %s failed: %s",
+                      proc_name,
+                      PIKA_VALUES_GET_STRING (values, 1));
+        }
+      else
+        {
+          g_snprintf (error_str, sizeof (error_str),
+                      "Procedure execution of %s failed",
+                      proc_name);
+        }
+        /* not language errors, procedure returned error for unknown reason. */
+      *error = foreign_error (sc, error_str, 0);
+      break;
+
+    case PIKA_PDB_CALLING_ERROR:
+      if (pika_value_array_length (values) > 1 &&
+          G_VALUE_HOLDS_STRING (pika_value_array_index (values, 1)))
+        {
+          g_snprintf (error_str, sizeof (error_str),
+                      "Procedure execution of %s failed on invalid input arguments: %s",
+                      proc_name,
+                      PIKA_VALUES_GET_STRING (values, 1));
+        }
+      else
+        {
+          g_snprintf (error_str, sizeof (error_str),
+                      "Procedure execution of %s failed on invalid input arguments",
+                      proc_name);
+        }
+      /* not language errors, PIKA validated the GValueArray
+       * and decided it doesn't match the registered signature
+       * or the procedure decided its preconditions not met (e.g. out of range)
+       */
+      *error = foreign_error (sc, error_str, 0);
+      break;
+
+    case PIKA_PDB_SUCCESS:
+      {
+        pointer marshalling_error;
+
+        result = marshal_PDB_return_by_arity (sc, values, &marshalling_error);
+        if (marshalling_error != NULL)
+          {
+            /* Error marshalling set of values.
+             * Any scheme values already marshalled will be garbage collected.
+             */
+            /* Propagate. */
+            *error = marshalling_error;
+            g_assert (result == NULL);
+          }
+        /* else assert result is not NULL but can be sc->NIL */
+      }
+      break;
+
+    case PIKA_PDB_PASS_THROUGH:
+      /* Should not happen. No plugin in the repo returns this.
+       * See app/pdb/pika-pdb.c for what little doc there is.
+       * It says there the result should be discarded
+       * in lieu of the subsequent procedure's result.
+       * */
+      g_warning ("Status is PASS_THROUGH, not handled properly.");
+      result = sc->vptr->cons (sc, sc->F, sc->NIL);
+
+    case PIKA_PDB_CANCEL:
+      /* A PDB procedure called interactively showed a dialog which the user cancelled. */
+      g_debug ("cancelled PDB proc returns (#f)");
+      /* A scheme function must return a value.
+       * Return false to indicate canceled. But is not an error.
+       *
+       * This is moot because you can't call a plugin interactively from a script anyway.
+       * (Top level scripts can be called interactively.)
+       *
+       * FUTURE: (when a script can call another script passing run mode INTERACTIVE)
+       * A well written script should not call PDB procedure interactively (cancelable)
+       * without checking whether the result is just #f or the expected value signature.
+       * No PDB procedure returning boolean should be called interactively from ScriptFu
+       * since you can't distinguish canceled from another false result.
+       * You can call such a procedure only for its side effects, if you ignore the result.
+       */
+      /* Returning (#f),
+       * FUTURE: return only #f, no reason to wrap.
+       */
+      result = sc->vptr->cons (sc, sc->F, sc->NIL);
+      break;
+    } /* end switch on PDB status. */
+
+  g_assert (   (result == NULL && *error != NULL)
+            || (result != NULL && *error == NULL));
+  return result;
+}
+
+
+/* Marshall a GValueArray returned by a PDB procedure.
+ * From a GValueArray into scheme value.
+ *
+ * Understands the return arity of PDB procedures.
+ *
+ * Returns a scheme "pointer" type referencing the scheme return value.
+ *
+ * The return value is a list.
+ * FUTURE: value is either a single value or a list.
+ *
+ * Same error return as marshal_returned_PDB_values.
+ */
+pointer
+marshal_PDB_return_by_arity (scheme         *sc,
+                             PikaValueArray *values,
+                             pointer        *error)
+{
+  /* NULL, not defaulting to sc->NIL. */
+  pointer result = NULL;
+  pointer marshalling_error = NULL;
+  gint   return_arity;
+
+  *error = NULL;
+
+  /* values has an extra status value over the return arity of the procedure.
+   * This is actual signature of the returned values.
+   * Could compare with the declared formal signature.
+   */
+  return_arity = pika_value_array_length (values) - 1;
+
+  /* Require caller ensured there is a status value. */
+  g_assert (return_arity >= 0);
+
+  if (return_arity == 0)
+    {
+      /* PDB procedure returns void.
+       * Every scheme function must return a value.
+       * Return (#t)
+       * FUTURE: return just sc->T, no reason to wrap it.
+       * result = sc->T;
+       */
+      g_debug ("void PDB proc returns (#t)");
+      result = sc->vptr->cons (sc, sc->T, sc->NIL);
+    }
+  else if (return_arity == 1)
+    {
+      /* Unary result.
+       * Return a list wrapping the result.
+       * FUTURE: return just unwrapped result (which can itself be a list.)
+       * i.e. just call marshal_returned_PDB_value (singular)
+       */
+      result = marshal_returned_PDB_values (sc, values, &marshalling_error);
+      if (marshalling_error != NULL)
+        {
+          /* Propagate error. */
+          *error = marshalling_error;
+        }
+    }
+  else /* >1 */
+    {
+      /* Many result values.
+       * Return a list wrapping the results. Similar to Python tuple return.
+       */
+      result = marshal_returned_PDB_values (sc, values, &marshalling_error);
+      if (marshalling_error != NULL)
+        {
+          /* Propagate error. */
+          *error = marshalling_error;
+        }
+    }
+  g_assert (   (result == NULL && *error != NULL)
+            || (result != NULL && *error == NULL));
+  /* result is: (#t) or sc->NIL i.e. empty list or a non-empty list. */
+  /* FUTURE result is: #t or an atom or a vector
+   * or empty list or a non-empty list.
+   * A non-empty list is either a single result that itself is a list
+   * or a list wrapping a multiple result.
+   */
+  return result;
+}
+
+
+/* Marshall a set of values returned by a PDB procedure.
+ * From a GValueArray into scheme list.
+ *
+ * Returns a scheme "pointer" type referencing the scheme list.
+ *
+ * Either returns a non-null scheme value and sets error to null,
+ * or sets error and returns a null scheme value.
+ * IOW, error is an OUT argument.
+ *
+ * The returned scheme value is scheme type list.
+ * The list can be non-homogenous (elements of different scheme types.)
+ *
+ * The returned list may be empty or have only a single element.
+ * FUTURE:
+ * When a PDB procedure returns a single value (which can be a container)
+ * do not wrap it in a list.
+ * It will be an error to call this function
+ * for PDB procedures that return a single value or return void.
+ * IOW, for PDB procedures of return arity < 2.
+ */
+static pointer
+marshal_returned_PDB_values (scheme         *sc,
+                             PikaValueArray *values,
+                             pointer        *error)
+{
+  /* Result is empty list. */
+  pointer result = sc->NIL;
+
+  *error = NULL;
+
+  /* Counting down, i.e. traversing in reverse.
+  * i+1 is the current index.  i is the preceding value.
+  * When at the current index is an array, preceding value (at i) is array length.
+  */
+  for (gint i = pika_value_array_length (values) - 2; i >= 0; --i)
+    {
+      GValue *value = pika_value_array_index (values, i + 1);
+      pointer scheme_value;
+      pointer single_error = NULL;
+      gint32  array_length = 0;
+
+      g_debug ("Return value %d is type %s", i+1, G_VALUE_TYPE_NAME (value));
+
+      /* In some cases previous value is array_length. */
+      if (   PIKA_VALUE_HOLDS_INT32_ARRAY (value)
+          || PIKA_VALUE_HOLDS_FLOAT_ARRAY (value)
+          || PIKA_VALUE_HOLDS_RGB_ARRAY   (value))
+        {
+          array_length = PIKA_VALUES_GET_INT (values, i);
+        }
+
+      scheme_value = marshal_returned_PDB_value (sc, value, array_length, &single_error);
+
+      if (single_error == NULL)
+        {
+          /* Prepend to scheme list of returned values and continue iteration. */
+          result = sc->vptr->cons (sc, scheme_value, result);
+        }
+      else
+        {
+          /* Error marshalling a single return value.
+          * Any scheme values already marshalled will be garbage collected.
+          */
+          /* Propagate error to caller. */
+          *error = single_error;
+          /* null C pointer not the same as pointer to scheme NIL */
+          result = NULL;
+          break;
+        }
+    }
+
+  g_assert (   (result == NULL && *error != NULL)
+            || (result != NULL && *error == NULL));
+  /* result can be sc->NIL i.e. empty list. */
+  return result;
+}
+
+
+
+/* The below code for array results is not safe.
+ * It implicitly requires, but does not explicitly check,
+ * that the returned length equals the actual length of the returned array,
+ * and iterates over the returned array assuming it has the returned length.
+ * It could read past the end of the array.
+ */
+
+/* Convert a GValue from C type to Scheme type.
+ *
+ * Returns a scheme "pointer" type referencing the scheme value.
+ *
+ * When the value has C type an array type,
+ * array_length must be its length,
+ * otherwise array_length is not used.
+ *
+ * Either returns a non-null scheme value and sets error to null,
+ * or sets error and returns a null scheme value.
+ * IOW, error is an OUT argument.
+ *
+ * The returned scheme value is an atom or a container (list or vector.)
+ * Returned containers are homogeneous (elements all the same type.)
+ * Returned atoms are scheme type number or string.
+ * Currently, does not return atoms of scheme type byte or char
+ * (no PDB procedure returns those types.)
+ *
+ * !!! Returns a scheme number (0 or 1) for C type boolean.
+ * FUTURE: return atoms #f and #t.
+ */
+static pointer
+marshal_returned_PDB_value    (scheme        *sc,
+                               GValue        *value,
+                               guint          array_length,
+                               pointer       *error)
+{
+  pointer  result = sc->NIL;
+  gint     j;
+  gchar    error_str[1024];
+
+  *error = NULL;
+
+  /* Order is important.
+    * GFile before other objects.
+    * PIKA Image, Drawable, etc. objects.
+    * Alternatively, more specific tests.
+    */
+  if (G_VALUE_TYPE (value) == G_TYPE_FILE)
+    {
+      gchar *parsed_filepath = marshal_returned_gfile_to_string (value);
+
+      if (parsed_filepath)
+        {
+          g_debug ("PDB procedure returned GFile '%s'", parsed_filepath);
+          /* copy string into interpreter state. */
+          result = sc->vptr->mk_string (sc, parsed_filepath);
+          g_free (parsed_filepath);
+        }
+      else
+        {
+          g_warning ("PDB procedure failed to return a valid GFile");
+          result = sc->vptr->mk_string (sc, "");
+        }
+      /* Ensure result holds a string, possibly empty. */
+    }
+  else if (G_VALUE_HOLDS_OBJECT (value))
+    {
+      /* G_VALUE_HOLDS_OBJECT only ensures value derives from GObject.
+        * Could be a PIKA or a GLib type.
+        * Here we handle PIKA types, which all have an id property.
+        * Resources, Images, Drawables etc. have an int ID.
+        */
+      GObject *object = g_value_get_object (value);
+      gint     id     = -1;
+
+      /* expect a PIKA opaque object having an "id" property */
+      if (object)
+        g_object_get (object, "id", &id, NULL);
+
+      /* id is -1 when the gvalue had no GObject*,
+        * or the referenced object had no property "id".
+        * This can be an undetected fault in the called procedure.
+        * It is not necessarily an error in the script.
+        */
+      if (id == -1)
+        g_warning ("PDB procedure returned NULL PIKA object.");
+
+      g_debug ("PDB procedure returned object ID: %i", id);
+
+      /* Scriptfu stores object IDs as int. */
+      result = sc->vptr->mk_integer (sc, id);
+    }
+  else if (G_VALUE_HOLDS_INT (value))
+    {
+      gint v = g_value_get_int (value);
+      result = sc->vptr->mk_integer (sc, v);
+    }
+  else if (G_VALUE_HOLDS_UINT (value))
+    {
+      guint v = g_value_get_uint (value);
+      result = sc->vptr->mk_integer (sc, v);
+    }
+  else if (G_VALUE_HOLDS_DOUBLE (value))
+    {
+      gdouble v = g_value_get_double (value);
+      result = sc->vptr->mk_real (sc, v);
+    }
+  else if (G_VALUE_HOLDS_ENUM (value))
+    {
+      gint v = g_value_get_enum (value);
+      result = sc->vptr->mk_integer (sc, v);
+    }
+  else if (G_VALUE_HOLDS_BOOLEAN (value))
+    {
+      gboolean v = g_value_get_boolean (value);
+      result = sc->vptr->mk_integer (sc, v);
+    }
+  else if (G_VALUE_HOLDS_STRING (value))
+    {
+      const gchar *v = g_value_get_string (value);
+
+      if (! v)
+        v = "";
+
+      result = sc->vptr->mk_string (sc, v);
+    }
+  else if (PIKA_VALUE_HOLDS_INT32_ARRAY (value))
+    {
+      const gint32 *v      = pika_value_get_int32_array (value);
+      pointer       vector = sc->vptr->mk_vector (sc, array_length);
+
+      for (j = 0; j < array_length; j++)
+        {
+          sc->vptr->set_vector_elem (vector, j,
+                                      sc->vptr->mk_integer (sc, v[j]));
+        }
+
+      result = vector;
+    }
+  else if (G_VALUE_HOLDS (value, G_TYPE_BYTES))
+    {
+      GBytes       *v_bytes  = g_value_get_boxed (value);
+      const guint8 *v        = g_bytes_get_data (v_bytes, NULL);
+      gsize         n        = g_bytes_get_size (v_bytes);
+      pointer       vector   = sc->vptr->mk_vector (sc, n);
+
+      for (j = 0; j < n; j++)
+        {
+          sc->vptr->set_vector_elem (vector, j,
+                                      sc->vptr->mk_integer (sc, v[j]));
+        }
+
+      result = vector;
+    }
+  else if (PIKA_VALUE_HOLDS_FLOAT_ARRAY (value))
+    {
+      const gdouble *v      = pika_value_get_float_array (value);
+      pointer        vector = sc->vptr->mk_vector (sc, array_length);
+
+      for (j = 0; j < array_length; j++)
+        {
+          sc->vptr->set_vector_elem (vector, j,
+                                      sc->vptr->mk_real (sc, v[j]));
+        }
+
+      result = vector;
+    }
+  else if (G_VALUE_HOLDS (value, G_TYPE_STRV))
+    {
+      gint32         n    = 0;
+      const gchar  **v    = g_value_get_boxed (value);
+      pointer        list = sc->NIL;
+
+      n = (v)? g_strv_length ((char **) v) : 0;
+      for (j = n - 1; j >= 0; j--)
+        {
+          list = sc->vptr->cons (sc,
+                                  sc->vptr->mk_string (sc,
+                                                      v[j] ?
+                                                      v[j] : ""),
+                                  list);
+        }
+
+      result = list;
+    }
+  else if (PIKA_VALUE_HOLDS_RGB (value))
+    {
+      PikaRGB  v;
+      guchar   r, g, b;
+      gpointer temp_val;
+
+      pika_value_get_rgb (value, &v);
+      pika_rgb_get_uchar (&v, &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)));
+
+      result = temp_val;
+    }
+  else if (PIKA_VALUE_HOLDS_RGB_ARRAY (value))
+    {
+      const PikaRGB  *v = pika_value_get_rgb_array (value);
+      pointer  vector   = sc->vptr->mk_vector (sc, array_length);
+
+      for (j = 0; j < array_length; j++)
+        {
+          guchar  r, g, b;
+          pointer temp_val;
+
+          pika_rgb_get_uchar (&v[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);
+        }
+
+      result = vector;
+    }
+  else if (PIKA_VALUE_HOLDS_PARASITE (value))
+    {
+      PikaParasite *v = g_value_get_boxed (value);
+
+      if (v->name == NULL)
+        {
+          /* Wrongly passed a Parasite that appears to be null, or other error. */
+          *error = implementation_error (sc, "Error: null parasite", 0);
+        }
+      else
+        {
+          gchar   *data = g_strndup (v->data, v->size);
+          gint     char_cnt = g_utf8_strlen (data, v->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, v->name),
+                        sc->vptr->cons
+                          (sc,
+                            sc->vptr->mk_integer (sc, v->flags),
+                            sc->vptr->cons
+                              (sc,
+                              sc->vptr->mk_counted_string (sc,
+                                                            data,
+                                                            char_cnt),
+                              sc->NIL)));
+
+          result = temp_val;
+          g_free (data);
+
+          g_debug ("name '%s'", v->name);
+          g_debug ("flags %d", v->flags);
+          g_debug ("size %d", v->size);
+          g_debug ("data '%.*s'", v->size, (gchar *) v->data);
+        }
+    }
+  else if (PIKA_VALUE_HOLDS_OBJECT_ARRAY (value))
+    {
+      result = marshal_returned_object_array_to_vector (sc, value);
+    }
+  else if (G_VALUE_TYPE (&value) == PIKA_TYPE_PDB_STATUS_TYPE)
+    {
+      /* Called procedure implemented incorrectly. */
+      *error = implementation_error (sc, "Procedure execution returned multiple status values", 0);
+    }
+  else
+    {
+      /* Missing cases here. */
+      g_snprintf (error_str, sizeof (error_str),
+                  "Unhandled return type %s",
+                  G_VALUE_TYPE_NAME (value));
+      *error = implementation_error (sc, error_str, 0);
+    }
+
+  g_assert (   (result == NULL && *error != NULL)
+            || (result != NULL && *error == NULL));
+
+  return result;
+}

plug-ins/script-fu/libscriptfu/scheme-marshal-return.h

@@ -0,0 +1,30 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#ifndef __SCHEME_MARSHAL_RETURN_H__
+#define __SCHEME_MARSHAL_RETURN_H__
+
+pointer marshal_PDB_return    (scheme         *sc,
+                               PikaValueArray *values,
+                               gchar          *proc_name,
+                               pointer        *error);
+
+#endif /* __SCHEME_MARSHAL_RETURN_H__ */

plug-ins/script-fu/libscriptfu/scheme-marshal.c

@@ -0,0 +1,237 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * 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 "libpika/pika.h"
+#include "tinyscheme/scheme-private.h"
+#include "scheme-marshal.h"
+#include "script-fu-errors.h"
+
+
+/*
+ * Marshal arguments to, and return values from, calls to PDB.
+ * Convert Scheme constructs to/from a GValue.
+ *
+ * For each marshalling function:
+ *   - a returned "pointer" is a scheme pointer to a foreign error or NULL.
+ *   - marshal into a GValue holding a designated type,
+ *     usually a PIKA type but also GLib types, e.g. GFile.
+ *     The GValue's held type is already set, but value is uninitialized.
+ *
+ * When marshalling into a PikaObjectArray, arbitrarily say the contained type is PIKA_TYPE_DRAWABLE.
+ * The actual contained type is opaque to the PDB calling mechanism.
+ * Setting the GValue's value does not check the contained type.
+ * But we do call pika_drawable_get_by_id.
+ * PIKA_TYPE_DRAWABLE is a superclass of most common uses.
+ * But perhaps we should call pika_item_get_by_id
+ * and arbitrarily say PIKA_TYPE_ITEM, a superclass of drawable.
+ */
+
+
+
+
+/* Marshal single drawable ID from script into a single GObject. */
+pointer
+marshal_ID_to_drawable (scheme   *sc,
+                        pointer   a,
+                        gint      id,
+                        GValue   *value)
+{
+  PikaDrawable *drawable;
+
+  pointer error = get_drawable_from_script (sc, a, id, &drawable);
+  if (error)
+    return error;
+
+  /* drawable is NULL or valid */
+
+  /* Shallow copy, adding a reference while the GValue exists. */
+  g_value_set_object (value, drawable);
+  return NULL;  /* no error */
+}
+
+/* Marshal a vector of ID into PikaObjectArray of same length. */
+pointer
+marshal_vector_to_drawable_array (scheme   *sc,
+                                  pointer   vector,
+                                  GValue   *value)
+{
+  PikaDrawable **drawable_array;
+  gint           id;
+  pointer        error;
+
+  guint num_elements = sc->vptr->vector_length (vector);
+  g_debug ("vector has %d elements", num_elements);
+  /* empty vector will produce empty PikaObjectArray */
+
+  drawable_array = g_new0 (PikaDrawable*, num_elements);
+
+  for (int j = 0; j < num_elements; ++j)
+    {
+      pointer element = sc->vptr->vector_elem (vector, j);
+
+      if (!sc->vptr->is_number (element))
+        {
+          g_free (drawable_array);
+          return script_error (sc, "Expected numeric in drawable vector", vector);
+          /* FUTURE more detailed error msg:
+           * return script_type_error_in_container (sc, "numeric", i, j, proc_name, vector);
+           */
+        }
+
+      id = sc->vptr->ivalue (element);
+      error = get_drawable_from_script (sc, element, id, &drawable_array[j]);
+      if (error)
+        {
+          g_free (drawable_array);
+          return error;
+        }
+    }
+
+  /* Shallow copy. */
+  pika_value_set_object_array (value, PIKA_TYPE_DRAWABLE, (GObject**)drawable_array, num_elements);
+
+  g_free (drawable_array);
+
+  return NULL;  /* no error */
+}
+
+
+/* Marshal path string from script into a GValue holding type GFile */
+void
+marshal_path_string_to_gfile (scheme     *sc,
+                              pointer     a,
+                              GValue     *value)
+{
+  /* require sc->vptr->is_string (sc->vptr->pair_car (a)) */
+
+  GFile *gfile = g_file_new_for_path (sc->vptr->string_value (sc->vptr->pair_car (a)));
+  /* GLib docs say that g_file_new_for_path():
+   * "never fails, but the returned object might not support any I/O operation if path is malformed."
+   */
+
+  g_value_set_object (value, gfile);
+  g_debug ("gfile arg is '%s'\n", g_file_get_parse_name (gfile));
+}
+
+
+/* Marshal values returned from PDB call in a GValue, into a Scheme construct to a script. */
+
+
+/* Marshal a GValue holding a GFile into a string.
+ *
+ * Returns NULL or a string that must be freed.
+ */
+ gchar *
+ marshal_returned_gfile_to_string (GValue   *value)
+{
+  gchar * filepath = NULL;
+
+  GObject *object = g_value_get_object (value);
+  /* object can be NULL, the GValue's type only indicates what should have been returned. */
+  if (object)
+    {
+      filepath = g_file_get_parse_name ((GFile *) object);
+      /* GLib docs:
+       * For local files with names that can safely be converted to UTF-8 the pathname is used,
+       * otherwise the IRI is used (a form of URI that allows UTF-8 characters unescaped).
+       */
+     }
+  return filepath;
+}
+
+
+/* Marshal a PikaObjectArray into a Scheme list of ID's.
+ *
+ * Before v3.0, PDB procedure's return type was say INT32ARRAY,
+ * preceded by a type INT32 designating array length.
+ * Now return type is PikaObjectArray preceded by length.
+ *
+ * Returns a vector, since most arrays in Scriptfu are returned as vectors.
+ * An alternate implementation would be return list.
+ *
+ * Existing scheme plugins usually expect PDB to return values: len, vector.
+ * If ever the PDB is changed to be more object-oriented,
+ * scripts could use a scheme call: (vector-length vector)
+ * to get the length of the vector.
+ */
+pointer
+marshal_returned_object_array_to_vector (scheme   *sc,
+                                         GValue   *value)
+{
+  GObject **object_array;
+  gint32    n;
+  pointer   vector;
+
+  object_array = pika_value_get_object_array (value);
+  /* array knows own length, ignore length in preceding return value */
+  n = ((PikaObjectArray*)g_value_get_boxed (value))->length;
+
+  vector = sc->vptr->mk_vector (sc, n);
+
+  /* Iterate starting at the back of the array, and prefix to container
+   * so the order of objects is not changed.
+   */
+  for (int j = n - 1; j >= 0; j--)
+    {
+      GObject *object = object_array[j];
+      gint     id;
+
+      if (object)
+        g_object_get (object, "id", &id, NULL); /* get property "id" */
+      else
+        /* Scriptfu language represents NULL object by ID of -1*/
+        id = -1;
+
+      sc->vptr->set_vector_elem (vector, j, sc->vptr->mk_integer (sc, id));
+      /* Alt: list = sc->vptr->cons (sc, sc->vptr->mk_integer (sc, id), list); */
+    }
+  /* ensure container's len equals object array's len and all elements are ID's or -1 */
+  return vector;
+}
+
+
+ /* From a script numeric (a drawable ID) set a handle to a drawable.
+  * When ID is -1, sets drawable to NULL and returns no error.
+  * When ID is valid, sets drawable and returns no error.
+  * Otherwise (ID is not -1 and not valid ID of a drawable) returns error.
+  */
+pointer
+get_drawable_from_script (scheme        *sc,
+                          pointer        a,
+                          gint           id,
+                          PikaDrawable **drawable_handle)
+{
+  if (id == -1)
+    {
+      /* -1 is scriptfu language for NULL i.e. none for an optional */
+      *drawable_handle = NULL;
+    }
+  else
+    {
+      *drawable_handle = pika_drawable_get_by_id (id);
+      if (! *drawable_handle)
+          return script_error (sc, "Invalid drawable ID", a);
+    }
+
+  /* ensure *drawable_handle is NULL or a valid reference to a drawable */
+  return NULL;  /* no error */
+}

plug-ins/script-fu/libscriptfu/scheme-marshal.h

@@ -0,0 +1,49 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#ifndef __SCHEME_MARSHAL_H__
+#define __SCHEME_MARSHAL_H__
+
+pointer       get_drawable_from_script         (scheme        *sc,
+                                                pointer        a,
+                                                gint           id,
+                                                PikaDrawable **drawable_handle);
+
+pointer       marshal_ID_to_drawable           (scheme   *sc,
+                                                pointer   a,
+                                                gint      id,
+                                                GValue   *value);
+
+pointer       marshal_vector_to_drawable_array (scheme   *sc,
+                                                pointer   a,
+                                                GValue   *value);
+
+void          marshal_path_string_to_gfile     (scheme   *sc,
+                                                pointer   a,
+                                                GValue   *value);
+
+
+pointer       marshal_returned_object_array_to_vector (scheme   *sc,
+                                                       GValue   *value);
+
+gchar *       marshal_returned_gfile_to_string        (GValue   *value);
+
+#endif /* __SCHEME_MARSHAL_H__ */

plug-ins/script-fu/libscriptfu/scheme-wrapper.h

@@ -0,0 +1,57 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#ifndef __SCHEME_WRAPPER_H__
+#define __SCHEME_WRAPPER_H__
+
+#include "tinyscheme/scheme.h"
+
+typedef void (*TsCallbackFunc) (void);
+typedef pointer (*TsWrapperFunc) (scheme*, pointer);
+
+
+void          tinyscheme_init         (GList        *path,
+                                       gboolean      register_scripts);
+
+void          ts_set_run_mode         (PikaRunMode   run_mode);
+
+void          ts_set_print_flag       (gint          print_flag);
+void          ts_print_welcome        (void);
+
+const gchar * ts_get_success_msg      (void);
+
+void          ts_interpret_stdin      (void);
+
+/* if the return value is 0, success. error otherwise. */
+gint          ts_interpret_string     (const gchar  *expr);
+
+void          ts_stdout_output_func   (TsOutputType  type,
+                                       const char   *string,
+                                       int           len,
+                                       gpointer      user_data);
+void          ts_gstring_output_func  (TsOutputType  type,
+                                       const char   *string,
+                                       int           len,
+                                       gpointer      user_data);
+void          ts_register_quit_callback         (TsCallbackFunc callback);
+void          ts_register_post_command_callback (TsCallbackFunc callback);
+
+#endif /* __SCHEME_WRAPPER_H__ */

plug-ins/script-fu/libscriptfu/script-fu-arg.c

@@ -0,0 +1,920 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * 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 <string.h>
+
+#include <libpika/pika.h>
+
+#include "script-fu-types.h"
+#include "script-fu-arg.h"
+#include "script-fu-utils.h"
+
+
+/*
+ * Methods of SFArg.
+ * SFArg is an informal class.
+ * All methods take first argument SFArg*, i.e. self.
+ *
+ * A SFArg is similar to a GValue and a GParamSpec.
+ * Like a GValue, it holds a value.
+ * Like a GParamSpec, it is metadata and holds a default value.
+ *
+ * In PIKA 2, extension-script-fu stays running and keeps instances of SFArg in memory.
+ * This is how ScriptFu "settings" aka "last values" are persistent for a session of PIKA.
+ *
+ * In PIKA 2, in the GUI implemented by ScriptFu (script-fu-interface.c),
+ * initial values of widgets are taken from SFArg (s),
+ * and result values of widgets are written back to SFArg.
+ *
+ * In PIKA 3, SFArg might be somewhat replaced with PikaConfig.
+ * Then many of these methods are not needed.
+ *
+ * Roughly, the methods hide how to convert/represent SFArgs back/forth
+ * to [GParamSpec, GValue, Scheme string representation.]
+ *
+ * Since SFArg is a union, similar to a GValue, the code is mostly switch on type.
+ */
+
+/*
+ * An SFArg has a type SFArgType that denotes not only a type, but a kind of widget.
+ * For example, SF_STRING denotes string type and a string entry widget,
+ * while SF_TEXT denotes a string type and a multiline text editing widget.
+ *
+ * But the SFArgType:SF_ADJUSTMENT further specifies a kind of widget,
+ * either spinner or slider.
+ * I.E. SFArgType is not one-to-one with widget kind.
+ *
+ * Unlike PythonFu, there is no SFArgType.SF_INT.
+ * Thus a ScriptFu author cannot specify an int-valued widget.
+ * While Scheme speakers understand Scheme uses "numeric" for both float and int,
+ * this might be confusing to script authors using other programming languages.
+ *
+ * SF_VALUE probably should be obsoleted.
+ * Search ChangeLog for mention of "SF_VALUE"
+ * See below, the only difference is that one get string escaped.
+ * Otherwise, SF_VALUE is identical to SF_STRING.
+ * Probably SF_VALUE still exists just for backward compatibility.
+ *
+ * SFArgType denotes not only a C type, but also a Scheme type.
+ * For example, SF_ADJUSTMENT denotes the C type "float"
+ * and the Scheme type "numeric" (which encompasses float and int.)
+ * Another example, SF_PATTERN denotes the C type PikaPattern
+ * and the Scheme type string (names of brushes are used in scripts.)
+ */
+
+
+static void pspec_set_default_file (GParamSpec *pspec, const gchar *filepath);
+static void append_int_repr_from_gvalue (GString *result_string, GValue *gvalue);
+
+/* Free any allocated members.
+ * Somewhat hides what members of the SFArg struct are allocated.
+ * !!! A few other places in the code do the allocations.
+ * !!! A few other places in the code free members.
+ */
+void
+script_fu_arg_free (SFArg *arg)
+{
+  g_free (arg->label);
+
+  switch (arg->type)
+    {
+    case SF_IMAGE:
+    case SF_DRAWABLE:
+    case SF_LAYER:
+    case SF_CHANNEL:
+    case SF_VECTORS:
+    case SF_DISPLAY:
+    case SF_COLOR:
+    case SF_TOGGLE:
+      break;
+
+    case SF_VALUE:
+    case SF_STRING:
+    case SF_TEXT:
+      g_free (arg->default_value.sfa_value);
+      g_free (arg->value.sfa_value);
+      break;
+
+    case SF_ADJUSTMENT:
+      break;
+
+    case SF_FILENAME:
+    case SF_DIRNAME:
+      g_free (arg->default_value.sfa_file.filename);
+      g_free (arg->value.sfa_file.filename);
+      break;
+
+    /* FUTURE: font..gradient could all use the same code.
+     * Since the type in the union are all the same: gchar*.
+     * That is, group these cases with SF_VALUE.
+     * But this method should go away altogether.
+     */
+    case SF_FONT:
+      g_free (arg->default_value.sfa_font);
+      g_free (arg->value.sfa_font);
+      break;
+
+    case SF_PALETTE:
+      g_free (arg->default_value.sfa_palette);
+      g_free (arg->value.sfa_palette);
+      break;
+
+    case SF_PATTERN:
+      g_free (arg->default_value.sfa_pattern);
+      g_free (arg->value.sfa_pattern);
+      break;
+
+    case SF_GRADIENT:
+      g_free (arg->default_value.sfa_gradient);
+      g_free (arg->value.sfa_gradient);
+      break;
+
+    case SF_BRUSH:
+      g_free (arg->default_value.sfa_brush);
+      g_free (arg->value.sfa_brush);
+      break;
+
+    case SF_OPTION:
+      g_slist_free_full (arg->default_value.sfa_option.list,
+                         (GDestroyNotify) g_free);
+      break;
+
+    case SF_ENUM:
+      g_free (arg->default_value.sfa_enum.type_name);
+      break;
+    }
+}
+
+/* Reset: copy the default value to current value. */
+void
+script_fu_arg_reset (SFArg *arg, gboolean should_reset_ids)
+{
+  SFArgValue *value         = &arg->value;
+  SFArgValue *default_value = &arg->default_value;
+
+  switch (arg->type)
+    {
+    case SF_IMAGE:
+    case SF_DRAWABLE:
+    case SF_LAYER:
+    case SF_CHANNEL:
+    case SF_VECTORS:
+    case SF_DISPLAY:
+      if (should_reset_ids)
+        {
+          /* !!! Use field name "sfa_image"; all these cases have same type in union.
+           * The field type is an int, this is an ID.
+           * We can use the same trick to group other cases, below.
+           */
+          value->sfa_image = default_value->sfa_image;
+        }
+
+      break;
+
+    case SF_COLOR:
+      value->sfa_color = default_value->sfa_color;
+      break;
+
+    case SF_TOGGLE:
+      value->sfa_toggle = default_value->sfa_toggle;
+      break;
+
+    case SF_VALUE:
+    case SF_STRING:
+    case SF_TEXT:
+      g_free (value->sfa_value);
+      value->sfa_value = g_strdup (default_value->sfa_value);
+      break;
+
+    case SF_ADJUSTMENT:
+      value->sfa_adjustment.value = default_value->sfa_adjustment.value;
+      break;
+
+    case SF_FILENAME:
+    case SF_DIRNAME:
+      g_free (value->sfa_file.filename);
+      value->sfa_file.filename = g_strdup (default_value->sfa_file.filename);
+      break;
+
+    /* FUTURE: font..gradient could all use the same code.
+     * Since the type in the union are all the same: gchar*.
+     * That is, group these cases with SF_VALUE.
+     */
+    case SF_FONT:
+      g_free (value->sfa_font);
+      value->sfa_font = g_strdup (default_value->sfa_font);
+      break;
+
+    case SF_PALETTE:
+      g_free (value->sfa_palette);
+      value->sfa_palette = g_strdup (default_value->sfa_palette);
+      break;
+
+    case SF_PATTERN:
+      g_free (value->sfa_pattern);
+      value->sfa_pattern = g_strdup (default_value->sfa_pattern);
+      break;
+
+    case SF_GRADIENT:
+      g_free (value->sfa_gradient);
+      value->sfa_gradient = g_strdup (default_value->sfa_gradient);
+      break;
+
+    case SF_BRUSH:
+      g_free (value->sfa_brush);
+      value->sfa_brush = g_strdup (default_value->sfa_brush);
+      break;
+
+    case SF_OPTION:
+      value->sfa_option.history = default_value->sfa_option.history;
+      break;
+
+    case SF_ENUM:
+      value->sfa_enum.history = default_value->sfa_enum.history;
+      break;
+    }
+}
+
+/* Return param spec that describes the arg.
+ * Convert instance of SFArg to instance of GParamSpec.
+ *
+ * Used to specify an arg to the PDB proc which this script implements.
+ * The GParamSpec is "floating" meaning ownership will transfer
+ * to the PikaPDBProcedure.
+ *
+ * Ensure GParamSpec has a default except as noted below.
+ * Default value from self.
+ *
+ * FUTURE: use PikaProcedureDialog
+ * Because PikaProcedureDialog creates widgets from properties/paramspecs,
+ * this should convey what SFArg denotes about desired widget kind,
+ * but it doesn't fully do that yet.
+ */
+GParamSpec *
+script_fu_arg_get_param_spec (SFArg       *arg,
+                              const gchar *name,
+                              const gchar *nick)
+{
+  GParamSpec * pspec = NULL;
+
+  switch (arg->type)
+    {
+      /* No defaults for PIKA objects: Image, Item subclasses, Display */
+    case SF_IMAGE:
+      pspec = pika_param_spec_image (name,
+                                     nick,
+                                     arg->label,
+                                     TRUE,  /* None is valid. */
+                                     G_PARAM_READWRITE);
+      break;
+
+    case SF_DRAWABLE:
+      pspec = pika_param_spec_drawable (name,
+                                        nick,
+                                        arg->label,
+                                        TRUE,
+                                        G_PARAM_READWRITE);
+      break;
+
+    case SF_LAYER:
+      pspec = pika_param_spec_layer (name,
+                                     nick,
+                                     arg->label,
+                                     TRUE,
+                                     G_PARAM_READWRITE);
+      break;
+
+    case SF_CHANNEL:
+      pspec = pika_param_spec_channel (name,
+                                       nick,
+                                       arg->label,
+                                       TRUE,
+                                       G_PARAM_READWRITE);
+      break;
+
+    case SF_VECTORS:
+      pspec = pika_param_spec_vectors (name,
+                                       nick,
+                                       arg->label,
+                                       TRUE,
+                                       G_PARAM_READWRITE);
+      break;
+
+    case SF_DISPLAY:
+      pspec = pika_param_spec_display (name,
+                                       nick,
+                                       arg->label,
+                                       TRUE,
+                                       G_PARAM_READWRITE);
+      break;
+
+    case SF_COLOR:
+      /* Pass address of default color i.e. instance of PikaRGB.
+       * Color is owned by ScriptFu and exists for lifetime of SF process.
+       */
+      pspec = pika_param_spec_rgb (name,
+                                   nick,
+                                   arg->label,
+                                   TRUE,  /* is alpha relevant */
+                                   &arg->default_value.sfa_color,
+                                   G_PARAM_READWRITE);
+      /* FUTURE: Default not now appear in PDB browser, but appears in widgets? */
+      break;
+
+    case SF_TOGGLE:
+      /* Implicit conversion from gint32 to gboolean. */
+      pspec = g_param_spec_boolean (name,
+                                    nick,
+                                    arg->label,
+                                    arg->default_value.sfa_toggle,
+                                    G_PARAM_READWRITE);
+      break;
+
+    /* FUTURE special widgets for multiline text.
+     * script-fu-interface does, but PikaProcedureDialog does not.
+     */
+    case SF_VALUE:
+    case SF_STRING:
+    case SF_TEXT:
+      pspec = g_param_spec_string (name,
+                                   nick,
+                                   arg->label,
+                                   arg->default_value.sfa_value,
+                                   G_PARAM_READWRITE);
+      break;
+
+    /* Subclasses of PikaResource.  Special widgets. */
+    case SF_FONT:
+      pspec = pika_param_spec_font (name,
+                                    nick,
+                                    arg->label,
+                                    FALSE,  /* none OK */
+                                    G_PARAM_READWRITE | PIKA_PARAM_NO_VALIDATE);
+      break;
+    case SF_PALETTE:
+      pspec = pika_param_spec_palette (name,
+                                       nick,
+                                       arg->label,
+                                       FALSE,  /* none OK */
+                                       G_PARAM_READWRITE | PIKA_PARAM_NO_VALIDATE);
+      break;
+
+    case SF_PATTERN:
+      pspec = pika_param_spec_pattern (name,
+                                       nick,
+                                       arg->label,
+                                       FALSE,  /* none OK */
+                                       G_PARAM_READWRITE | PIKA_PARAM_NO_VALIDATE);
+      break;
+
+    case SF_GRADIENT:
+      pspec = pika_param_spec_gradient (name,
+                                        nick,
+                                        arg->label,
+                                        FALSE,  /* none OK */
+                                        G_PARAM_READWRITE | PIKA_PARAM_NO_VALIDATE);
+      break;
+
+    case SF_BRUSH:
+      pspec = pika_param_spec_brush (name,
+                                     nick,
+                                     arg->label,
+                                     FALSE,  /* none OK */
+                                     G_PARAM_READWRITE | PIKA_PARAM_NO_VALIDATE);
+      break;
+
+    case SF_ADJUSTMENT:
+      /* switch on number of decimal places aka "digits
+       * !!! on the default value, not the current value.
+       * Decimal places == 0 means type integer, else float
+       */
+      if (arg->default_value.sfa_adjustment.digits == 0)
+        pspec = g_param_spec_int (name, nick, arg->label,
+                                  arg->default_value.sfa_adjustment.lower,
+                                  arg->default_value.sfa_adjustment.upper,
+                                  arg->default_value.sfa_adjustment.value,
+                                  G_PARAM_READWRITE);
+      else
+        pspec = g_param_spec_double (name, nick, arg->label,
+                                     arg->default_value.sfa_adjustment.lower,
+                                     arg->default_value.sfa_adjustment.upper,
+                                     arg->default_value.sfa_adjustment.value,
+                                     G_PARAM_READWRITE);
+      break;
+
+    case SF_FILENAME:
+    case SF_DIRNAME:
+      pspec = g_param_spec_object (name,
+                                   nick,
+                                   arg->label,
+                                   G_TYPE_FILE,
+                                   G_PARAM_READWRITE |
+                                   PIKA_PARAM_NO_VALIDATE);
+      pspec_set_default_file (pspec, arg->default_value.sfa_file.filename);
+      /* FUTURE: Default not now appear in PDB browser, but appears in widgets? */
+      break;
+
+    case SF_ENUM:
+      /* history is the last used value AND the default. */
+      pspec = g_param_spec_enum (name,
+                                 nick,
+                                 arg->label,
+                                 g_type_from_name (arg->default_value.sfa_enum.type_name),
+                                 arg->default_value.sfa_enum.history,
+                                 G_PARAM_READWRITE);
+      break;
+
+    case SF_OPTION:
+      pspec = g_param_spec_int (name,
+                                nick,
+                                arg->label,
+                                0,        /* Always zero based. */
+                                g_slist_length (arg->default_value.sfa_option.list),
+                                arg->default_value.sfa_option.history,
+                                G_PARAM_READWRITE);
+      /* FUTURE: Model values not now appear in PDB browser NOR in widgets? */
+      /* FUTURE: Does not show a combo box widget ??? */
+      break;
+    }
+
+  return pspec;
+}
+
+
+/* Append a Scheme representation of the arg value from the given gvalue.
+ * Append to a Scheme text to be interpreted.
+ *
+ * The SFArg only specifies the type,
+ * but the GType held by the GValue must be the same or convertable.
+ *
+ * The repr comes from the value of the GValue, not the value of the SFArg.
+ *
+ * Used when PIKA is calling the PDB procedure implemented by the script,
+ * passing a GValueArray.
+ */
+void
+script_fu_arg_append_repr_from_gvalue (SFArg       *arg,
+                                       GString     *result_string,
+                                       GValue      *gvalue)
+{
+  g_debug ("script_fu_arg_append_repr_from_gvalue %s", arg->label);
+  switch (arg->type)
+    {
+    case SF_IMAGE:
+    case SF_DRAWABLE:
+    case SF_LAYER:
+    case SF_CHANNEL:
+    case SF_VECTORS:
+    case SF_DISPLAY:
+      {
+        GObject *object = g_value_get_object (gvalue);
+        gint     id     = -1;
+
+        if (object)
+          g_object_get (object, "id", &id, NULL);
+
+        g_string_append_printf (result_string, "%d", id);
+      }
+      break;
+
+    case SF_COLOR:
+      {
+        PikaRGB color;
+        guchar  r, g, b;
+
+        pika_value_get_rgb (gvalue, &color);
+        pika_rgb_get_uchar (&color, &r, &g, &b);
+        g_string_append_printf (result_string, "'(%d %d %d)",
+                                (gint) r, (gint) g, (gint) b);
+      }
+      break;
+
+    case SF_TOGGLE:
+      g_string_append_printf (result_string, (g_value_get_boolean (gvalue) ?
+                                  "TRUE" : "FALSE"));
+      break;
+
+    case SF_VALUE:
+      g_string_append (result_string, g_value_get_string (gvalue));
+      break;
+
+    case SF_STRING:
+    case SF_TEXT:
+      {
+        gchar *tmp;
+
+        tmp = script_fu_strescape (g_value_get_string (gvalue));
+        g_string_append_printf (result_string, "\"%s\"", tmp);
+        g_free (tmp);
+      }
+      break;
+
+    case SF_FILENAME:
+    case SF_DIRNAME:
+      {
+        if (G_VALUE_HOLDS_OBJECT (gvalue) && G_VALUE_TYPE (gvalue) == G_TYPE_FILE)
+          {
+            GFile *file = g_value_get_object (gvalue);
+
+            /* Catch: GValue initialized to hold a GFile, but not hold one.
+             * Specificially, PikaProcedureDialog can yield that condition;
+             * the dialog shows "(None)" meaning user has not chosen a file yet.
+             */
+            if (G_IS_FILE (file))
+              {
+                /* Not checking file exists, only creating a descriptive string.
+                 * I.E. not g_file_get_path, which can return NULL.
+                 */
+                gchar *filepath = g_file_get_parse_name (file);
+                /* assert filepath not null. */
+                /* Not escape special chars for whitespace or double quote. */
+                g_string_append_printf (result_string, "\"%s\"", filepath);
+                g_free (filepath);
+              }
+            else
+              {
+                gchar *msg = "Invalid GFile in gvalue.";
+                g_warning ("%s", msg);
+                g_string_append_printf (result_string, "\"%s\"", msg);
+              }
+          }
+        else
+          {
+            gchar *msg = "Expecting GFile in gvalue.";
+            g_warning ("%s", msg);
+            g_string_append_printf (result_string, "\"%s\"", msg);
+          }
+        /* Ensure appended a filepath string OR an error string.*/
+      }
+      break;
+
+    case SF_ADJUSTMENT:
+      {
+        if (arg->default_value.sfa_adjustment.digits != 0)
+          {
+            gchar buffer[G_ASCII_DTOSTR_BUF_SIZE];
+
+            g_ascii_dtostr (buffer, sizeof (buffer), g_value_get_double (gvalue));
+            g_string_append (result_string, buffer);
+          }
+        else
+          {
+            append_int_repr_from_gvalue (result_string, gvalue);
+          }
+      }
+      break;
+
+    case SF_FONT:
+    case SF_PALETTE:
+    case SF_PATTERN:
+    case SF_GRADIENT:
+    case SF_BRUSH:
+      {
+        /* The GValue is a GObject of type inheriting PikaResource */
+        PikaResource *resource;
+        gchar        *name = NULL;
+
+        resource = g_value_get_object (gvalue);
+
+        if (resource)
+          name = pika_resource_get_name (resource);
+
+        g_string_append_printf (result_string, "\"%s\"", name);
+      }
+      break;
+
+    case SF_OPTION:
+      append_int_repr_from_gvalue (result_string, gvalue);
+      break;
+
+    case SF_ENUM:
+      if (G_VALUE_HOLDS_ENUM (gvalue))
+        {
+          /* Effectively upcasting to a less restrictive Scheme class Integer. */
+          g_string_append_printf (result_string, "%d", g_value_get_enum (gvalue));
+        }
+      else
+        {
+          /* For now, occurs when PikaConfig or PikaProcedureDialog does not support GParamEnum. */
+          g_warning ("Expecting GValue holding a GEnum.");
+          /* Append arbitrary int, so no errors in signature of Scheme call.
+           * The call might not yield result the user intended.
+           */
+          g_string_append (result_string, "1");
+        }
+      break;
+    }
+}
+
+/* Append a Scheme representation of the arg value from self's value.
+ * Append to a Scheme text to be interpreted.
+ *
+ * Used when the PDB procedure implemented by the script is being calling interactively,
+ * after a GUI dialog has written user's choices into self's value.
+ *
+ * This method is slated for deletion when script-fu-interface.c is deleted.
+ */
+void
+script_fu_arg_append_repr_from_self (SFArg       *arg,
+                                     GString     *result_string)
+{
+  SFArgValue *arg_value = &arg->value;
+
+  switch (arg->type)
+    {
+    case SF_IMAGE:
+    case SF_DRAWABLE:
+    case SF_LAYER:
+    case SF_CHANNEL:
+    case SF_VECTORS:
+    case SF_DISPLAY:
+      g_string_append_printf (result_string, "%d", arg_value->sfa_image);
+      break;
+
+    case SF_COLOR:
+      {
+        guchar r, g, b;
+
+        pika_rgb_get_uchar (&arg_value->sfa_color, &r, &g, &b);
+        g_string_append_printf (result_string, "'(%d %d %d)",
+                                (gint) r, (gint) g, (gint) b);
+      }
+      break;
+
+    case SF_TOGGLE:
+      g_string_append (result_string, arg_value->sfa_toggle ? "TRUE" : "FALSE");
+      break;
+
+    case SF_VALUE:
+      g_string_append (result_string, arg_value->sfa_value);
+      break;
+
+    case SF_STRING:
+    case SF_TEXT:
+      {
+        gchar *tmp;
+
+        tmp = script_fu_strescape (arg_value->sfa_value);
+        g_string_append_printf (result_string, "\"%s\"", tmp);
+        g_free (tmp);
+      }
+      break;
+
+    case SF_ADJUSTMENT:
+      {
+        gchar buffer[G_ASCII_DTOSTR_BUF_SIZE];
+
+        g_ascii_dtostr (buffer, sizeof (buffer),
+                        arg_value->sfa_adjustment.value);
+        g_string_append (result_string, buffer);
+      }
+      break;
+
+    case SF_FILENAME:
+    case SF_DIRNAME:
+      {
+        gchar *tmp;
+
+        tmp = script_fu_strescape (arg_value->sfa_file.filename);
+        g_string_append_printf (result_string, "\"%s\"", tmp);
+        g_free (tmp);
+      }
+      break;
+
+    case SF_FONT:
+      g_string_append_printf (result_string, "\"%s\"", arg_value->sfa_font);
+      break;
+
+    case SF_PALETTE:
+      g_string_append_printf (result_string, "\"%s\"", arg_value->sfa_palette);
+      break;
+
+    case SF_PATTERN:
+      g_string_append_printf (result_string, "\"%s\"", arg_value->sfa_pattern);
+      break;
+
+    case SF_GRADIENT:
+      g_string_append_printf (result_string, "\"%s\"", arg_value->sfa_gradient);
+      break;
+
+    case SF_BRUSH:
+      g_string_append_printf (result_string, "\"%s\"", arg_value->sfa_brush);
+      break;
+
+    case SF_OPTION:
+      g_string_append_printf (result_string, "%d", arg_value->sfa_option.history);
+      break;
+
+    case SF_ENUM:
+      g_string_append_printf (result_string, "%d", arg_value->sfa_enum.history);
+      break;
+    }
+}
+
+
+/* Array the size of the enum
+ * Counts names generated per SF type per generator session.
+ */
+static gint arg_count[SF_DISPLAY + 1] = { 0, };
+
+void
+script_fu_arg_reset_name_generator (void)
+{
+  for (guint i = 0; i <= SF_DISPLAY; i++)
+    arg_count[i] = 0;
+}
+
+/*
+ * Return a unique name, and non-unique nick, for self.
+ *
+ * Self's label came from a call to script-fu-register ()
+ * and was not lexically checked so is unsuitable for a property name.
+ * ScriptFu does not require script author to provide a unique name
+ * for args in a call to script-fu-register.
+ *
+ * This is a generator.
+ * Returned name is a canonical name for a GParamSpec, i.e. a property name.
+ * It meets the lexical requirements for a property name.
+ * It is unique among all names returned between resets of the generator.
+ * Thus name meets uniquity for names of properties of one object.
+ *
+ * !!! PikaImageProcedures already have properties for convenience arguments,
+ * e.g. a property named "image" "n_drawables" and "drawables"
+ * So we avoid that name clash by starting with "otherImage"
+ *
+ * The name means nothing to human readers of the spec.
+ * Instead, the nick is descriptive for human readers.
+ *
+ * The returned string is owned by the generator, a constant.
+ * The caller need not copy it,
+ * but usually does by creating a GParamSpec.
+ */
+void
+script_fu_arg_generate_name_and_nick (SFArg        *arg,
+                                      const gchar **returned_name,
+                                      const gchar **returned_nick)
+{
+  static gchar  numbered_name[64];
+  gchar        *name = NULL;
+
+  switch (arg->type)
+    {
+    case SF_IMAGE:
+      name = "otherImage";  /* !!! Avoid name clash. */
+      break;
+
+    case SF_DRAWABLE:
+      name = "drawable";
+      break;
+
+    case SF_LAYER:
+      name = "layer";
+      break;
+
+    case SF_CHANNEL:
+      name = "channel";
+      break;
+
+    case SF_VECTORS:
+      name = "vectors";
+      break;
+
+    case SF_DISPLAY:
+      name = "display";
+      break;
+
+    case SF_COLOR:
+      name = "color";
+      break;
+
+    case SF_TOGGLE:
+      name = "toggle";
+      break;
+
+    case SF_VALUE:
+      name = "value";
+      break;
+
+    case SF_STRING:
+      name = "string";
+      break;
+
+    case SF_TEXT:
+      name = "text";
+      break;
+
+    case SF_ADJUSTMENT:
+      name = "adjustment";
+      break;
+
+    case SF_FILENAME:
+      name = "filename";
+      break;
+
+    case SF_DIRNAME:
+      name = "dirname";
+      break;
+
+    case SF_FONT:
+      name = "font";
+      break;
+
+    case SF_PALETTE:
+      name = "palette";
+      break;
+
+    case SF_PATTERN:
+      name = "pattern";
+      break;
+
+    case SF_BRUSH:
+      name = "brush";
+      break;
+
+    case SF_GRADIENT:
+      name = "gradient";
+      break;
+
+    case SF_OPTION:
+      name = "option";
+      break;
+
+    case SF_ENUM:
+      name = "enum";
+      break;
+    }
+
+  if (arg_count[arg->type] == 0)
+    {
+      g_strlcpy (numbered_name, name, sizeof (numbered_name));
+    }
+  else
+    {
+      g_snprintf (numbered_name, sizeof (numbered_name),
+                  "%s-%d", name, arg_count[arg->type] + 1);
+    }
+
+  arg_count[arg->type]++;
+
+  *returned_name = numbered_name;
+
+  /* nick is what the script author said describes the arg */
+  *returned_nick = arg->label;
+}
+
+
+/* Set the default of a GParamSpec to a GFile for a path string.
+ * The GFile is allocated and ownership is transferred to the GParamSpec.
+ * The GFile is only a name and a so-named file might not exist.
+ */
+static void
+pspec_set_default_file (GParamSpec *pspec, const gchar *filepath)
+{
+  GValue  gvalue = G_VALUE_INIT;
+  GFile  *gfile  = NULL;
+
+  g_value_init (&gvalue, G_TYPE_FILE);
+  gfile = g_file_new_for_path (filepath);
+  g_value_set_object (&gvalue, gfile);
+  g_param_value_set_default (pspec, &gvalue);
+}
+
+/* Append a string repr of an integer valued gvalue to given GString.
+ * When the gvalue doesn't hold an integer, warn and append arbitrary int literal.
+ */
+static void
+append_int_repr_from_gvalue (GString *result_string, GValue *gvalue)
+{
+  if (G_VALUE_HOLDS_INT (gvalue))
+    {
+      g_string_append_printf (result_string, "%d", g_value_get_int (gvalue));
+    }
+  else
+    {
+      g_warning ("Expecting GValue holding an int.");
+      /* Append arbitrary int, so no errors in signature of Scheme call.
+       * The call might not yield result the user intended.
+       */
+      g_string_append (result_string, "1");
+    }
+}

plug-ins/script-fu/libscriptfu/script-fu-arg.h

@@ -0,0 +1,43 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#ifndef __SCRIPT_FU_ARG_H__
+#define __SCRIPT_FU_ARG_H__
+
+void        script_fu_arg_free                    (SFArg    *arg);
+void        script_fu_arg_reset                   (SFArg    *arg,
+                                                   gboolean should_reset_ids);
+
+GParamSpec *script_fu_arg_get_param_spec          (SFArg       *arg,
+                                                   const gchar *name,
+                                                   const gchar *nick);
+void        script_fu_arg_append_repr_from_gvalue (SFArg       *arg,
+                                                   GString     *result_string,
+                                                   GValue      *gvalue);
+void        script_fu_arg_append_repr_from_self   (SFArg       *arg,
+                                                   GString     *result_string);
+
+void        script_fu_arg_reset_name_generator    (void);
+void        script_fu_arg_generate_name_and_nick  (SFArg        *arg,
+                                                   const gchar **name,
+                                                   const gchar **nick);
+
+#endif /*  __SCRIPT_FU_ARG__  */

plug-ins/script-fu/libscriptfu/script-fu-command.c

@@ -0,0 +1,154 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * 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 <libpika/pika.h>
+
+#include "script-fu-types.h"    /* SFScript */
+#include "script-fu-lib.h"
+#include "script-fu-script.h"
+
+#include "script-fu-command.h"
+
+
+/* Methods for interpreting commands.
+ *
+ * Usually there is a stack of calls similar to:
+ *       script_fu_run_image_procedure (outer run func)
+ * calls script_fu_interpret_image_proc
+ * calls script_fu_run_command
+ * calls ts_interpret_string
+ * calls the inner run func in Scheme
+ *
+ * but script_fu_run_command is also called directly for loading scripts.
+ *
+ * FUTURE: see also similar code in script-fu-interface.c
+ * which could be migrated here.
+ */
+
+
+/* Interpret a command.
+ *
+ * When errors during interpretation:
+ * 1) set the error message from tinyscheme into GError at given handle.
+ * 2) return FALSE
+ * otherwise, return TRUE and discard any result of interpretation
+ * ScriptFu return values only have a PikaPDBStatus,
+ * since ScriptFu plugin scripts can only be declared returning void.
+ *
+ * While interpreting, any errors from further calls to the PDB
+ * can show error dialogs in any PIKA gui,
+ * unless the caller has taken responsibility with a prior call to
+ * pika_plug_in_set_pdb_error_handler
+ *
+ * FIXME: see script_fu_run_procedure.
+ * It does not call pika_plug_in_set_pdb_error_handler for NON-INTERACTIVE mode.
+ */
+gboolean
+script_fu_run_command (const gchar  *command,
+                       GError      **error)
+{
+  GString  *output;
+  gboolean  success = FALSE;
+
+  g_debug ("script_fu_run_command: %s", command);
+  output = g_string_new (NULL);
+  script_fu_redirect_output_to_gstr (output);
+
+  if (script_fu_interpret_string (command))
+    {
+      g_set_error (error, PIKA_PLUG_IN_ERROR, 0, "%s", output->str);
+    }
+  else
+    {
+      success = TRUE;
+    }
+
+  g_string_free (output, TRUE);
+
+  return success;
+}
+
+
+
+/* Interpret a script that defines a PikaImageProcedure.
+ *
+ * Similar to v2 code in script-fu-interface.c, except:
+ * 1) builds a command from a GValueArray from a PikaConfig,
+ *    instead of from local array of SFArg.
+ * 2) adds actual args image, drawable, etc. for PikaImageProcedure
+ */
+PikaValueArray *
+script_fu_interpret_image_proc (
+                            PikaProcedure        *procedure,
+                            SFScript             *script,
+                            PikaImage            *image,
+                            guint                 n_drawables,
+                            PikaDrawable        **drawables,
+                            const PikaValueArray *args)
+{
+  gchar          *command;
+  PikaValueArray *result = NULL;
+  gboolean        interpretation_result;
+  GError         *error = NULL;
+
+  command = script_fu_script_get_command_for_image_proc (script, image, n_drawables, drawables, args);
+
+  /* Take responsibility for handling errors from the scripts further calls to PDB.
+   * ScriptFu does not show an error dialog, but forwards errors back to PIKA.
+   * This only tells PIKA that ScriptFu itself will forward PikaPDBStatus errors from
+   * this scripts calls to the PDB.
+   * The onus is on this script's called PDB procedures to return errors in the PikaPDBStatus.
+   * Any that do not, but for example only call pika-message, are breaching contract.
+   */
+  pika_plug_in_set_pdb_error_handler (pika_get_plug_in (),
+                                      PIKA_PDB_ERROR_HANDLER_PLUGIN);
+
+  interpretation_result = script_fu_run_command (command, &error);
+  g_free (command);
+  if (! interpretation_result)
+    {
+      /* This is to the console.
+       * script->name not localized.
+       * error->message expected to be localized.
+       * PIKA will later display "PDB procedure failed: <message>" localized.
+       */
+      g_warning ("While executing %s: %s",
+                 script->name,
+                 error->message);
+      /* A GError was allocated and this will take ownership. */
+      result = pika_procedure_new_return_values (procedure,
+                                                 PIKA_PDB_EXECUTION_ERROR,
+                                                 error);
+    }
+  else
+    {
+      result = pika_procedure_new_return_values (procedure,
+                                                 PIKA_PDB_SUCCESS,
+                                                 NULL);
+    }
+
+  pika_plug_in_set_pdb_error_handler (pika_get_plug_in (),
+                                      PIKA_PDB_ERROR_HANDLER_INTERNAL);
+
+  return result;
+}

plug-ins/script-fu/libscriptfu/script-fu-command.h

@@ -0,0 +1,35 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ */
+
+ #ifndef __SCRIPT_FU_COMMAND_H__
+ #define __SCRIPT_FU_COMMAND_H__
+
+gboolean        script_fu_run_command          (const gchar  *command,
+                                                GError      **error);
+
+PikaValueArray *script_fu_interpret_image_proc (PikaProcedure        *procedure,
+                                                SFScript             *script,
+                                                PikaImage            *image,
+                                                guint                 n_drawables,
+                                                PikaDrawable        **drawables,
+                                                const PikaValueArray *args);
+
+#endif /* __SCRIPT_FU_COMMAND_H__ */

plug-ins/script-fu/libscriptfu/script-fu-compat.c

@@ -0,0 +1,214 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#include "config.h"
+#include "tinyscheme/scheme-private.h"
+#include "script-fu-compat.h"
+
+/*
+ * Make some PDB procedure names deprecated in ScriptFu.
+ * Until such time as we turn deprecation off and make them obsolete.
+ *
+ * This only makes them deprecated in ScriptFu.
+ */
+
+
+/* private */
+
+static const struct
+{
+  const gchar *old_name;
+  const gchar *new_name;
+}
+compat_procs[] =
+{
+  /*
+   * deprecations since 2.99
+   *
+   * With respect to ScriptFu,
+   * the old names are *obsolete in the PDB* (as of this writing.)
+   * That is, they don't exist in the PDB with the same signature.
+   * There is no "compatibility" procedure in the PDB.
+   *
+   * With respect to Python using GI, some old names are *NOT* obsolete.
+   * (Where "some" means those dealing with ID.)
+   * I.E. Pika.Image.is_valid() exists but takes a GObject *, not an int ID.
+   *
+   * Original data was constructed more or less by hand, partially automated.
+   */
+   { "pika-brightness-contrast"               , "pika-drawable-brightness-contrast"      },
+   { "pika-brushes-get-brush"                 , "pika-context-get-brush"                 },
+   { "pika-drawable-is-channel"               , "pika-item-id-is-channel"                },
+   { "pika-drawable-is-layer"                 , "pika-item-id-is-layer"                  },
+   { "pika-drawable-is-layer-mask"            , "pika-item-id-is-layer-mask"             },
+   { "pika-drawable-is-text-layer"            , "pika-item-id-is-text-layer"             },
+   { "pika-drawable-is-valid"                 , "pika-item-id-is-valid"                  },
+   { "pika-drawable-transform-2d"             , "pika-item-transform-2d"                 },
+   { "pika-drawable-transform-flip"           , "pika-item-transform-flip"               },
+   { "pika-drawable-transform-flip-simple"    , "pika-item-transform-flip-simple"        },
+   { "pika-drawable-transform-matrix"         , "pika-item-transform-matrix"             },
+   { "pika-drawable-transform-perspective"    , "pika-item-transform-perspective"        },
+   { "pika-drawable-transform-rotate"         , "pika-item-transform-rotate"             },
+   { "pika-drawable-transform-rotate-simple"  , "pika-item-transform-rotate-simple"      },
+   { "pika-drawable-transform-scale"          , "pika-item-transform-scale"              },
+   { "pika-drawable-transform-shear"          , "pika-item-transform-shear"              },
+   { "pika-display-is-valid"                  , "pika-display-id-is-valid"               },
+   { "pika-image-is-valid"                    , "pika-image-id-is-valid"                 },
+   { "pika-item-is-channel"                   , "pika-item-id-is-channel"                },
+   { "pika-item-is-drawable"                  , "pika-item-id-is-drawable"               },
+   { "pika-item-is-layer"                     , "pika-item-id-is-layer"                  },
+   { "pika-item-is-layer-mask"                , "pika-item-id-is-layer-mask"             },
+   { "pika-item-is-selection"                 , "pika-item-id-is-selection"              },
+   { "pika-item-is-text-layer"                , "pika-item-id-is-text-layer"             },
+   { "pika-item-is-valid"                     , "pika-item-id-is-valid"                  },
+   { "pika-item-is-vectors"                   , "pika-item-id-is-vectors"                },
+   { "pika-procedural-db-dump"                , "pika-pdb-dump"                          },
+   { "pika-procedural-db-get-data"            , "pika-pdb-get-data"                      },
+   { "pika-procedural-db-set-data"            , "pika-pdb-set-data"                      },
+   { "pika-procedural-db-get-data-size"       , "pika-pdb-get-data-size"                 },
+   { "pika-procedural-db-proc-arg"            , "pika-pdb-get-proc-argument"             },
+   { "pika-procedural-db-proc-info"           , "pika-pdb-get-proc-info"                 },
+   { "pika-procedural-db-proc-val"            , "pika-pdb-get-proc-return-value"         },
+   { "pika-procedural-db-proc-exists"         , "pika-pdb-proc-exists"                   },
+   { "pika-procedural-db-query"               , "pika-pdb-query"                         },
+   { "pika-procedural-db-temp-name"           , "pika-pdb-temp-name"                     },
+   { "pika-image-get-exported-uri"            , "pika-image-get-exported-file"           },
+   { "pika-image-get-imported-uri"            , "pika-image-get-imported-file"           },
+   { "pika-image-get-xcf-uri"                 , "pika-image-get-xcf-file"                },
+   { "pika-image-get-filename"                , "pika-image-get-file"                    },
+   { "pika-image-set-filename"                , "pika-image-set-file"                    },
+   { "pika-plugin-menu-register"              , "pika-pdb-add-proc-menu-path"            },
+   { "pika-plugin-get-pdb-error-handler"      , "pika-plug-in-get-pdb-error-handler"     },
+   { "pika-plugin-help-register"              , "pika-plug-in-help-register"             },
+   { "pika-plugin-menu-branch-register"       , "pika-plug-in-menu-branch-register"      },
+   { "pika-plugin-set-pdb-error-handler"      , "pika-plug-in-set-pdb-error-handler"     },
+   { "pika-plugins-query"                     , "pika-plug-ins-query"                    },
+   { "file-gtm-save"                          , "file-html-table-save"                   },
+   { "python-fu-histogram-export"             , "histogram-export"                       },
+   { "python-fu-gradient-save-as-css"         , "gradient-save-as-css"                   }
+};
+
+static gchar *empty_string = "";
+
+
+static void
+define_deprecated_scheme_func (const char   *old_name,
+                               const char   *new_name,
+                               const scheme *sc)
+{
+  gchar *buff;
+
+  /* Creates a definition in Scheme of a function that calls a PDB procedure.
+   *
+   * The magic below that makes it deprecated:
+   * - the "--pika-proc-db-call"
+   * - defining under the old_name but calling the new_name
+
+   * See scheme-wrapper.c, where this was copied from.
+   * But here creates scheme definition of old_name
+   * that calls a PDB procedure of a different name, new_name.
+   *
+   * As functional programming is: eval(define(apply f)).
+   * load_string is more typically called eval().
+   */
+  buff = g_strdup_printf (" (define (%s . args)"
+                          " (apply --pika-proc-db-call \"%s\" args))",
+                          old_name, new_name);
+
+  sc->vptr->load_string ((scheme *) sc, buff);
+
+  g_free (buff);
+}
+
+
+/*  public functions  */
+
+/* Define Scheme functions whose name is old name
+ * that call compatible PDB procedures whose name is new name.
+ * Define into the lisp machine.
+
+ * Compatible means: signature same, semantics same.
+ * The new names are not "compatibility" procedures, they are the new procedures.
+ *
+ * This can overwrite existing definitions in the lisp machine.
+ * If the PDB has the old name already
+ * (if a compatibility procedure is defined in the PDB
+ * or the old name exists with a different signature)
+ * and ScriptFu already defined functions for procedures of the PDB,
+ * this will overwrite the ScriptFu definition,
+ * but produce the same overall effect.
+ * The definition here will not call the old name PDB procedure,
+ * but from ScriptFu call the new name PDB procedure.
+ */
+void
+define_compat_procs (scheme *sc)
+{
+  gint i;
+
+  for (i = 0; i < G_N_ELEMENTS (compat_procs); i++)
+    {
+      define_deprecated_scheme_func (compat_procs[i].old_name,
+                                     compat_procs[i].new_name,
+                                     sc);
+    }
+}
+
+/* Return empty string or old_name */
+/* Used for a warning message */
+const gchar *
+deprecated_name_for (const char *new_name)
+{
+  gint i;
+  const gchar * result = empty_string;
+
+  /* search values of dictionary/map. */
+  for (i = 0; i < G_N_ELEMENTS (compat_procs); i++)
+    {
+      if (strcmp (compat_procs[i].new_name, new_name) == 0)
+        {
+          result = compat_procs[i].old_name;
+          break;
+        }
+    }
+  return result;
+
+}
+
+/* Not used.
+ * Keep for future implementation: catch "undefined symbol" from lisp machine.
+ */
+gboolean
+is_deprecated (const char *old_name)
+{
+  gint i;
+  gboolean result = FALSE;
+
+  /* search keys of dictionary/map. */
+  for (i = 0; i < G_N_ELEMENTS (compat_procs); i++)
+  {
+    if (strcmp (compat_procs[i].old_name, old_name) == 0)
+      {
+        result = TRUE;
+        break;
+      }
+  }
+  return result;
+}

plug-ins/script-fu/libscriptfu/script-fu-compat.h

@@ -0,0 +1,31 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#ifndef __SCRIPT_FU_COMPAT_H__
+#define __SCRIPT_FU_COMPAT_H__
+
+
+void          define_compat_procs (scheme *sc);
+gboolean      is_deprecated       (const char *old_name);
+const gchar * deprecated_name_for (const char *new_name);
+
+
+#endif /*  __SCRIPT_FU_COMPAT_H__  */

plug-ins/script-fu/libscriptfu/script-fu-dialog.c

@@ -0,0 +1,256 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * script-fu-dialog.c
+ * Copyright (C) 2022 Lloyd Konneker
+ *
+ * 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 <libpika/pikaui.h>
+
+#include "script-fu-types.h"    /* SFScript */
+#include "script-fu-script.h"   /* get_title */
+#include "script-fu-command.h"
+
+#include "script-fu-dialog.h"
+
+
+/* An informal class that shows a dialog for a script then runs the script.
+ * It is internal to libscriptfu.
+ *
+ * The dialog is modal for the script:
+ * OK button hides the dialog then runs the script once.
+ *
+ * The dialog is non-modal with respect to the PIKA app GUI, which remains responsive.
+ *
+ * When called from plugin extension-script-fu, the dialog is modal on the extension:
+ * although PIKA app continues responsive, a user choosing a menu item
+ * that is also implemented by a script and extension-script-fu
+ * will not show a dialog until the first called script finishes.
+ */
+
+/* FUTURE: delete this after v3 is stable. */
+#define DEBUG_CONFIG_PROPERTIES  TRUE
+
+#if DEBUG_CONFIG_PROPERTIES
+static void
+dump_properties (PikaProcedureConfig *config)
+{
+  GParamSpec **pspecs;
+  guint        n_pspecs;
+
+  pspecs = g_object_class_list_properties (G_OBJECT_GET_CLASS (config),
+                                           &n_pspecs);
+  for (guint i = 1; i < n_pspecs; i++)
+    g_printerr ("%s %s\n", pspecs[i]->name, G_PARAM_SPEC_TYPE_NAME (pspecs[i]));
+  g_free (pspecs);
+}
+
+static gint
+get_length (PikaProcedureConfig *config)
+{
+  GParamSpec **pspecs;
+  guint        n_pspecs;
+
+  pspecs = g_object_class_list_properties (G_OBJECT_GET_CLASS (config),
+                                           &n_pspecs);
+  g_free (pspecs);
+  g_debug ("length config: %d", n_pspecs);
+
+  return n_pspecs;
+}
+
+/* Fill a new (length zero) gva with new gvalues (empty but holding the correct type)
+ from the config.
+ */
+static void
+fill_gva_from (PikaProcedureConfig *config,
+               PikaValueArray      *gva)
+{
+  GParamSpec **pspecs;
+  guint        n_pspecs;
+
+  pspecs = g_object_class_list_properties (G_OBJECT_GET_CLASS (config),
+                                           &n_pspecs);
+  /* !!! Start at property 1 */
+  for (guint i = 1; i < n_pspecs; i++)
+    {
+      g_debug ("%s %s\n", pspecs[i]->name, G_PARAM_SPEC_TYPE_NAME (pspecs[i]));
+      /* append empty gvalue */
+      pika_value_array_append (gva, NULL);
+    }
+
+  g_free (pspecs);
+}
+
+static void
+dump_objects (PikaProcedureConfig  *config)
+{
+  /* Check it will return non-null objects. */
+  PikaValueArray *args;
+  gint length;
+
+  /* Need one less gvalue !!! */
+  args = pika_value_array_new (get_length (config) - 1);
+  /* The array still has length zero. */
+  g_debug ("GVA length: %d", pika_value_array_length (args));
+
+  fill_gva_from (config, args);
+
+  pika_procedure_config_get_values (config, args);
+  if (args == NULL)
+    {
+      g_debug ("config holds no values");
+      return;
+    }
+  length = pika_value_array_length (args);
+
+  for (guint i = 1; i < length; i++)
+    {
+      GValue *gvalue = pika_value_array_index (args, i);
+      if (G_VALUE_HOLDS_OBJECT (gvalue))
+        if (g_value_get_object (gvalue) == NULL)
+          g_debug ("gvalue %d holds NULL object", i);
+    }
+}
+
+#endif
+
+/* Run a dialog for a procedure, then interpret the script.
+ *
+ * Run dialog: create config, create dialog for config, show dialog, and return a config.
+ * Interpret: marshal config into Scheme text for function call, then interpret script.
+ *
+ * One widget per param of the procedure.
+ * Require the procedure registered with params of GTypes
+ * corresponding to SFType the author declared in script-fu-register call.
+ *
+ * Require initial_args is not NULL or empty.
+ * A caller must ensure a dialog is needed because args is not empty.
+ */
+PikaValueArray*
+script_fu_dialog_run (PikaProcedure        *procedure,
+                      SFScript             *script,
+                      PikaImage            *image,
+                      guint                 n_drawables,
+                      PikaDrawable        **drawables,
+                      const PikaValueArray *initial_args)
+
+{
+  PikaValueArray      *result = NULL;
+  PikaProcedureDialog *dialog = NULL;
+  PikaProcedureConfig *config = NULL;
+  gboolean             not_canceled;
+
+  if ( (! G_IS_OBJECT (procedure)) || script == NULL)
+    return pika_procedure_new_return_values (procedure, PIKA_PDB_EXECUTION_ERROR, NULL);
+
+  if ( pika_value_array_length (initial_args) < 1)
+    return pika_procedure_new_return_values (procedure, PIKA_PDB_EXECUTION_ERROR, NULL);
+
+  /* We don't prevent concurrent dialogs as in script-fu-interface.c.
+   * For extension-script-fu, Pika is already preventing concurrent dialogs.
+   * For pika-script-fu-interpreter, each plugin is a separate process
+   * so concurrent dialogs CAN occur.
+   */
+  /* There is no progress widget in PikaProcedureDialog.
+   * Also, we don't need to update the progress in Pika UI,
+   * because Pika shows progress: the name of all called PDB procedures.
+   */
+
+  /* Script's menu label */
+  pika_ui_init (script_fu_script_get_title (script));
+
+  config = pika_procedure_create_config (procedure);
+#if DEBUG_CONFIG_PROPERTIES
+  dump_properties (config);
+  g_debug ("Len  of initial_args %i", pika_value_array_length (initial_args) );
+#endif
+
+  /* Get saved settings (last values) into the config.
+   * Since run mode is INTERACTIVE, initial_args is moot.
+   * Instead, last used values or default values populate the config.
+   */
+  pika_procedure_config_begin_run (config, NULL, PIKA_RUN_INTERACTIVE, initial_args);
+  #if DEBUG_CONFIG_PROPERTIES
+
+    dump_objects (config);
+  #endif
+
+  /* Create a dialog having properties (describing arguments of the procedure)
+   * taken from the config.
+   *
+   * Title dialog with the menu item, not the procedure name.
+   * Assert menu item is localized.
+   */
+  dialog = (PikaProcedureDialog*) pika_procedure_dialog_new (
+                                      procedure,
+                                      config,
+                                      script_fu_script_get_title (script));
+  /* dialog has no widgets except standard buttons. */
+
+  /* It is possible to create custom widget where the provided widget is not adequate.
+   * Then pika_procedure_dialog_fill_list will create the rest.
+   * For now, the provided widgets should be adequate.
+   */
+
+  /* NULL means create widgets for all properties of the procedure
+   * that we have not already created widgets for.
+   */
+  pika_procedure_dialog_fill_list (dialog, NULL);
+
+  not_canceled = pika_procedure_dialog_run (dialog);
+  /* Assert config holds validated arg values from a user interaction. */
+
+  #if DEBUG_CONFIG_PROPERTIES
+    dump_objects (config);
+  #endif
+
+  if (not_canceled)
+    {
+      PikaValueArray *final_args = pika_value_array_copy (initial_args);
+
+      /* Store config's values into final_args. */
+      pika_procedure_config_get_values (config, final_args);
+
+      result = script_fu_interpret_image_proc (procedure, script,
+                                               image, n_drawables, drawables,
+                                               final_args);
+
+      pika_value_array_unref (final_args);
+    }
+  else
+    {
+      result = pika_procedure_new_return_values (procedure, PIKA_PDB_CANCEL, NULL);
+    }
+
+  gtk_widget_destroy ((GtkWidget*) dialog);
+
+  /* Persist config aka settings for the next run of the plugin.
+   * Passing the PikaPDBStatus from result[0].
+   * We must have a matching end_run for the begin_run, regardless of status.
+   */
+  pika_procedure_config_end_run (config, g_value_get_enum (pika_value_array_index (result, 0)));
+
+  g_object_unref (config);
+
+  return result;
+}

plug-ins/script-fu/libscriptfu/script-fu-dialog.h

@@ -0,0 +1,35 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * script-fu-dialog.h
+ * Copyright (C) 2022 Lloyd Konneker
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ */
+
+ #ifndef __SCRIPT_FU_DIALOG_H__
+ #define __SCRIPT_FU_DIALOG_H__
+
+PikaValueArray *script_fu_dialog_run (PikaProcedure        *procedure,
+                                      SFScript             *script,
+                                      PikaImage            *image,
+                                      guint                 n_drawables,
+                                      PikaDrawable        **drawables,
+                                      const PikaValueArray *args);
+
+#endif /* __SCRIPT_FU_DIALOG_H__ */

plug-ins/script-fu/libscriptfu/script-fu-enums.h

@@ -0,0 +1,94 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#ifndef __SCRIPT_FU_ENUMS_H__
+#define __SCRIPT_FU_ENUMS_H__
+
+/* Note these are C names with underbar.
+ * The Scheme names are usually the same with hyphen substituted for underbar.
+ */
+
+/*  script-fu argument types  */
+typedef enum
+{
+  SF_IMAGE = 0,
+  SF_DRAWABLE,
+  SF_LAYER,
+  SF_CHANNEL,
+  SF_VECTORS,
+  SF_COLOR,
+  SF_TOGGLE,
+  SF_VALUE,
+  SF_STRING,
+  SF_ADJUSTMENT,
+  SF_FONT,
+  SF_PATTERN,
+  SF_BRUSH,
+  SF_GRADIENT,
+  SF_FILENAME,
+  SF_DIRNAME,
+  SF_OPTION,
+  SF_PALETTE,
+  SF_TEXT,
+  SF_ENUM,
+  SF_DISPLAY
+} SFArgType;
+
+typedef enum
+{
+  SF_SLIDER = 0,
+  SF_SPINNER
+} SFAdjustmentType;
+
+/* This enum is local to ScriptFu
+ * but the notion is general to other plugins.
+ *
+ * A PikaImageProcedure has drawable  arity > 1.
+ * A PikaProcedure often does not take any drawables, i.e. arity zero.
+ * Some PikaProcedure may take drawables i.e. arity > 0,
+ * but the procedure's menu item is always sensitive,
+ * and the drawable can be chosen in the plugin's dialog.
+ *
+ * Script author does not use SF-NO-DRAWABLE, for now.
+ *
+ * Scripts of class PikaProcedure are declared by script-fu-register.
+ * Their GUI is handled by ScriptFu, script-fu-interface.c
+ * An author does not declare drawable_arity.
+ *
+ * Scripts of class PikaImageProcedure are declared by script-fu-register-filter.
+ * Their GUI is handled by libpikaui, PikaProcedureDialog.
+ * Their drawable_arity is declared by the author of the script.
+ *
+ * For backward compatibility, PIKA deprecates but allows PDB procedures
+ * to take a single drawable, and sets their sensitivity automatically.
+ * Their drawable_arity is inferred by ScriptFu.
+ * FUTURE insist that an author use script-fu-register-filter (not script-fu-register)
+ * for PikaImageProcedure taking image and one or more drawables.
+ */
+typedef enum
+{
+  SF_NO_DRAWABLE = 0,       /* PikaProcedure. */
+  SF_ONE_DRAWABLE,          /* PikaImageProcedure, but only process one layer */
+  SF_ONE_OR_MORE_DRAWABLE,  /* PikaImageProcedure, multilayer capable */
+  SF_TWO_OR_MORE_DRAWABLE,  /* PikaImageProcedure, requires at least two drawables. */
+} SFDrawableArity;
+
+#endif /*  __SCRIPT_FU_ENUMS__  */

plug-ins/script-fu/libscriptfu/script-fu-errors.c

@@ -0,0 +1,242 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * 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 */
+
+/* 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 PikaProtocol 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 Pika types, pika_item_get_id (PIKA_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);
+}

plug-ins/script-fu/libscriptfu/script-fu-errors.h

@@ -0,0 +1,68 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#ifndef __SCRIPT_FU_ERRORS_H__
+#define __SCRIPT_FU_ERRORS_H__
+
+pointer script_error (scheme        *sc,
+                      const gchar   *error_message,
+                      const pointer  a);
+
+pointer script_type_error (scheme       *sc,
+                           const gchar  *expected_type,
+                           const guint   arg_index,
+                           const gchar  *proc_name);
+
+pointer script_type_error_in_container (scheme       *sc,
+                                        const gchar  *expected_type,
+                                        const guint   arg_index,
+                                        const guint   element_index,
+                                        const gchar  *proc_name,
+                                        const pointer a);
+
+pointer script_length_error_in_vector (scheme       *sc,
+                                       const guint   arg_index,
+                                       const gchar  *proc_name,
+                                       const guint   expected_length,
+                                       const pointer vector);
+
+pointer implementation_error (scheme        *sc,
+                              const gchar   *error_message,
+                              const pointer  a);
+
+
+void debug_vector (scheme        *sc,
+                   const pointer  vector,
+                   const gchar   *format);
+
+void debug_list (scheme       *sc,
+                 pointer       list,
+                 const char   *format,
+                 const guint   num_elements);
+
+void debug_in_arg(scheme           *sc,
+                  const pointer     a,
+                  const guint       arg_index,
+                  const gchar      *type_name );
+
+void debug_gvalue(const GValue     *value);
+
+#endif /*  __SCRIPT_FU_ERRORS_H__  */

plug-ins/script-fu/libscriptfu/script-fu-interface.h

@@ -0,0 +1,32 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#ifndef __SCRIPT_FU_INTERFACE_H__
+#define __SCRIPT_FU_INTERFACE_H__
+
+
+PikaPDBStatusType  script_fu_interface           (SFScript     *script,
+                                                  gint          start_arg);
+void               script_fu_interface_report_cc (const gchar  *command);
+gboolean           script_fu_interface_is_active (void);
+
+
+#endif /*  __SCRIPT_FU_INTERFACE_H__  */

plug-ins/script-fu/libscriptfu/script-fu-intl.h

@@ -0,0 +1,49 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * script-fu-intl.h
+ *
+ * This library is free software: you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 3 of the License, or (at your option) any later version.
+ *
+ * This library 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
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library.  If not, see
+ * <https://www.gnu.org/licenses/>.
+ */
+
+#ifndef __SCRIPT_FU_INTL_H__
+#define __SCRIPT_FU_INTL_H__
+
+#ifndef GETTEXT_PACKAGE
+#error "config.h must be included prior to script-fu-intl.h"
+#endif
+
+#include <glib/gi18n.h>
+
+
+#define DEFINE_STD_SET_I18N                                          \
+static gboolean                                                      \
+set_i18n (PikaPlugIn   *plug_in,                                     \
+          const gchar  *procedure_name,                              \
+          gchar       **gettext_domain,                              \
+          gchar       **catalog_dir)                                 \
+{                                                                    \
+  *gettext_domain = g_strdup (GETTEXT_PACKAGE"-script-fu");       \
+  return TRUE;                                                       \
+};
+
+#define STD_SET_I18N set_i18n
+
+
+#endif /* __SCRIPT_FU_INTL_H__ */

plug-ins/script-fu/libscriptfu/script-fu-lib.c

@@ -0,0 +1,224 @@
+
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * 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 <libpika/pika.h>
+
+#include "script-fu-lib.h"
+
+#include "script-fu-types.h"     /* SFScript */
+#include "scheme-wrapper.h"      /* tinyscheme_init etc, */
+#include "script-fu-scripts.h"   /* script_fu_find_scripts */
+#include "script-fu-interface.h" /* script_fu_interface_is_active */
+#include "script-fu-proc-factory.h"
+
+
+/*
+ * The purpose here is a small, clean API to the exported functions of the library,
+ * hiding internal types of the library
+ * and hiding functions not static but not exported.
+ *
+ * Some are simple delegation to scheme_wrapper functions,
+ * but others adapt
+ * and some call functions not in scheme_wrapper.c
+ */
+
+
+/*
+ * Return whether extension-script-fu has an open dialog.
+ * extension-script-fu is a single process.
+ * It cannot have concurrent dialogs open in the PIKA app.
+ *
+ * Other plugins implementing PLUGIN type PDB procedures
+ * in their own process (e.g. pika-scheme-interpreter) do not need this.
+ */
+gboolean
+script_fu_extension_is_busy (void)
+{
+  return script_fu_interface_is_active ();
+}
+
+/*
+ * Find files at given paths, load them into the interpreter,
+ * and register them as PDB procs of type TEMPORARY,
+ * owned by the PDB proc of type PLUGIN for the given plugin.
+ */
+void
+script_fu_find_and_register_scripts ( PikaPlugIn     *plugin,
+                                      GList          *paths)
+{
+  script_fu_find_scripts (plugin, paths);
+}
+
+/*
+ * Init the embedded interpreter.
+ *
+ * allow_register:
+ * TRUE: allow loaded scripts to register PDB procedures.
+ * The scheme functions script-fu-register and script-fu-menu-register are
+ * defined to do something.
+ * FALSE:  The scheme functions script-fu-register and script-fu-menu-register are
+ * defined but do nothing.
+ *
+ * Note that the embedded interpreter always defines scheme functions
+ * for all PDB procedures already existing when the interpreter starts
+ * (currently bound at startup, but its possible to lazy bind.)
+ * allow_register doesn't affect that.
+ */
+void
+script_fu_init_embedded_interpreter ( GList          *paths,
+                                      gboolean        allow_register,
+                                      PikaRunMode     run_mode)
+{
+  g_debug ("script_fu_init_embedded_interpreter");
+  tinyscheme_init (paths, allow_register);
+  ts_set_run_mode (run_mode);
+  /*
+   * Ensure the embedded interpreter is running
+   * and has loaded its internal Scheme scripts
+   * and has defined existing PDB procs as Scheme foreign functions
+   * (is ready to interpret PDB-like function calls in scheme scripts.)
+   *
+   * scripts/...init and scripts/...compat.scm are loaded
+   * iff paths includes the "/scripts" dir.
+   *
+   * The .scm file(s) for plugins are loaded
+   * iff paths includes their parent directory (e.g. /scripts)
+   * Loaded does not imply yet registered in the PDB
+   * (yet, they soon might be for some phases of the plugin.)
+   */
+}
+
+void
+script_fu_set_print_flag  (gboolean should_print)
+{
+  ts_set_print_flag (should_print);
+}
+
+/*
+ * Make tinyscheme begin writing output to given gstring.
+ */
+void
+script_fu_redirect_output_to_gstr (GString *output)
+{
+  ts_register_output_func (ts_gstring_output_func, output);
+}
+
+void
+script_fu_redirect_output_to_stdout (void)
+{
+  ts_register_output_func (ts_stdout_output_func, NULL);
+}
+
+void
+script_fu_print_welcome (void)
+{
+  ts_print_welcome ();
+}
+
+gboolean
+script_fu_interpret_string (const gchar *text)
+{
+  /*converting from enum to boolean */
+  return (gboolean) ts_interpret_string (text);
+}
+
+void
+script_fu_set_run_mode (PikaRunMode run_mode)
+{
+  ts_set_run_mode (run_mode);
+}
+
+const gchar *
+script_fu_get_success_msg (void)
+{
+  return ts_get_success_msg ();
+}
+
+void
+script_fu_run_read_eval_print_loop (void)
+{
+  ts_interpret_stdin ();
+}
+
+void
+script_fu_register_quit_callback (void (*func) (void))
+{
+  ts_register_quit_callback (func);
+}
+
+void
+script_fu_register_post_command_callback (void (*func) (void))
+{
+  ts_register_post_command_callback (func);
+}
+
+/*
+ * Return list of paths to directories containing .scm and .init scripts.
+ * Usually at least PIKA's directory named like "/scripts."
+ * List can also contain dirs custom or private to a user.
+ " The PIKA dir often contain: plugins, init scripts, and utility scripts.
+ *
+ * Caller must free the returned list.
+ */
+GList *
+script_fu_search_path (void)
+{
+  gchar *path_str;
+  GList *path = NULL;
+
+  path_str = pika_pikarc_query ("script-fu-path");
+  if (path_str)
+    {
+      GError *error = NULL;
+
+      path = pika_config_path_expand_to_files (path_str, &error);
+      g_free (path_str);
+
+      if (! path)
+        {
+          g_warning ("Can't convert script-fu-path to filesystem encoding: %s",
+                     error->message);
+          g_clear_error (&error);
+        }
+    }
+  return path;
+}
+
+
+PikaProcedure *
+script_fu_find_scripts_create_PDB_proc_plugin (PikaPlugIn  *plug_in,
+                                               GList       *paths,
+                                               const gchar *name)
+{
+  /* Delegate to factory. */
+  return script_fu_proc_factory_make_PLUGIN (plug_in, paths, name);
+}
+
+GList *
+script_fu_find_scripts_list_proc_names (PikaPlugIn *plug_in,
+                                        GList      *paths)
+{
+  /* Delegate to factory. */
+  return script_fu_proc_factory_list_names (plug_in, paths);
+}

plug-ins/script-fu/libscriptfu/script-fu-lib.h

@@ -0,0 +1,55 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#ifndef __SCRIPT_FU_LIB_H__
+#define __SCRIPT_FU_LIB_H__
+
+gboolean     script_fu_extension_is_busy         (void);
+
+GList *      script_fu_search_path               (void);
+void         script_fu_find_and_register_scripts (PikaPlugIn     *plugin,
+                                                  GList          *paths);
+
+void         script_fu_set_run_mode              (PikaRunMode     run_mode);
+void         script_fu_init_embedded_interpreter (GList          *paths,
+                                                  gboolean        allow_register,
+                                                  PikaRunMode     run_mode);
+
+void         script_fu_set_print_flag            (gboolean        should_print);
+void         script_fu_redirect_output_to_gstr   (GString        *output);
+void         script_fu_redirect_output_to_stdout (void);
+void         script_fu_print_welcome             (void);
+
+gboolean     script_fu_interpret_string          (const gchar     *text);
+const gchar *script_fu_get_success_msg           (void);
+
+void         script_fu_run_read_eval_print_loop  (void);
+
+void         script_fu_register_quit_callback         (void (*func) (void));
+void         script_fu_register_post_command_callback (void (*func) (void));
+
+PikaProcedure *script_fu_find_scripts_create_PDB_proc_plugin (PikaPlugIn  *plug_in,
+                                                              GList       *paths,
+                                                              const gchar *name);
+GList         *script_fu_find_scripts_list_proc_names        (PikaPlugIn  *plug_in,
+                                                              GList       *paths);
+
+#endif /* __SCRIPT_FU_LIB_H__ */

plug-ins/script-fu/libscriptfu/script-fu-proc-factory.c

@@ -0,0 +1,207 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * 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 <libpika/pika.h>
+
+#include "tinyscheme/scheme-private.h"
+#include "script-fu-types.h"
+#include "script-fu-scripts.h"
+#include "script-fu-script.h"
+
+#include "script-fu-proc-factory.h"
+
+/* Local functions */
+static void  script_fu_add_menu_to_procedure (PikaProcedure *procedure,
+                                              SFScript      *script);
+
+
+/* Methods to register PDB procs. A factory makes objects, here PDB procedures.
+ *
+ * Used by the outer script-fu-interpreter
+ *
+ * This is in libscriptfu to hide the SFScript type from outer plugins.
+ * These methods use instances of type SFScript as specs for procedures.
+ *
+ * FUTURE: migrate code.
+ * There are two flavors of factory-like code: for PDBProcType TEMPORARY and PLUGIN.
+ * extension-script-fu outer plugin only makes TEMPORARY
+ * script-fu-interpreter outer plugin only makes PLUGIN type
+ * This source file supports only script-fu-interpreter.
+ * script_fu_find_scripts() in script-fu-scripts.c is also a factory-like method,
+ * and could be extracted to a separate source file.
+ * Maybe more code sharing between the two flavors.
+ */
+
+
+/* Create and return a single PDB procedure of type PLUGIN,
+ * for the given proc name, by reading the script file in the given paths.
+ * Also add a menu for the procedure.
+ *
+ * PDB proc of type PLUGIN has permanent lifetime, unlike type TEMPORARY.
+ *
+ * The list of paths is usually just one directory, a subdir of /plug-ins.
+ * The directory may contain many .scm files.
+ * The plugin manager only queries one .scm file,
+ * having the same name as its parent dir and and having execute permission.
+ * But here we read all the .scm files in the directory.
+ * Each .scm file may register (and define run func for) many PDB procedures.
+ *
+ * Here, one name is passed, and though we load all the .scm files,
+ * we only create a PDB procedure for the passed name.
+ */
+PikaProcedure *
+script_fu_proc_factory_make_PLUGIN (PikaPlugIn  *plug_in,
+                                    GList       *paths,
+                                    const gchar *proc_name)
+{
+  SFScript      * script    = NULL;
+  PikaProcedure * procedure = NULL;
+
+  /* Reads all .scm files at paths, even though only one is pertinent.
+   * The returned script_tree is also in the state of the interpreter,
+   * we don't need the result here.
+  */
+  (void) script_fu_find_scripts_into_tree (plug_in, paths);
+
+  /* Get the pertinent script from the tree. */
+  script = script_fu_find_script (proc_name);
+
+  if (script)
+    {
+      procedure = script_fu_script_create_PDB_procedure (
+        plug_in,
+        script,
+        PIKA_PDB_PROC_TYPE_PLUGIN);
+      script_fu_add_menu_to_procedure (procedure, script);
+    }
+  else
+    {
+      g_warning ("Failed to find script: %s.", proc_name);
+    }
+  return procedure;
+}
+
+ /* Traverse the list of scripts, for each defined name of a PDB proc,
+  * add it list whose handle is given.
+  *
+  * Order is not important.  Could just as well prepend.
+  *
+  * This is a GTraverseFunction
+  */
+static gboolean
+script_fu_append_script_names (gpointer      *foo G_GNUC_UNUSED,
+                               GList         *scripts,
+                               GList        **name_list)
+{
+  for (GList * list = scripts; list; list = g_list_next (list))
+    {
+      SFScript *script   = list->data;
+
+      if ( !script_fu_is_defined (script->name))
+        {
+          g_warning ("Run function not defined, or does not match PDB procedure name: %s",
+                     script->name);
+          continue;
+        }
+
+      /* Must assign result from g_list_append back to name_list */
+      *name_list = g_list_append ( (GList *) *name_list, g_strdup (script->name));
+    }
+  return FALSE; /* We traversed all. */
+ }
+
+/* Load script texts (.scm files) in the given paths.
+ * Iterate over all loaded scripts to get the PDB proc names they define.
+ * Return a list of the names.
+ */
+GList *
+script_fu_proc_factory_list_names (PikaPlugIn *plug_in,
+                                   GList      *paths)
+{
+  GList * result_list = NULL;
+  GTree * script_tree = NULL;
+
+  /* Load (eval) all .scm files in all dirs in paths. */
+  script_tree = script_fu_find_scripts_into_tree (plug_in, paths);
+
+  /* Iterate over the tree, adding each script name to result list */
+  g_tree_foreach (script_tree,
+                  (GTraverseFunc) script_fu_append_script_names,
+                  &result_list);
+
+  return result_list;
+}
+
+/* From scriptfu's internal data, add any menu to given procedure in the PDB.
+ * Requires that a script was just eval'ed so that scriptfu's list of menus
+ * declared in a script is valid.
+ * Requires the proc exists in PDB.
+ *
+ * Not ensure the PDB proc has a menu, when no menu was defined in the script.
+ *
+ * Derived from script_fu_install_menu, but that is specific to TEMPORARY procs.
+ * Also, unlike script_fu_install_menu, we don't nuke the menu list as we proceed.
+ *
+ * For each "create" of a procedure, the pika-script-fu-interpreter is started anew,
+ * and a new script_menu_list is derived from the .scm file.
+ * We don't traverse the menu list more than once per session, which soon exits.
+ */
+static void
+script_fu_add_menu_to_procedure (PikaProcedure *procedure,
+                                  SFScript      *script)
+{
+  GList    *menu_list;
+  gboolean  did_add_menu = FALSE;
+
+  menu_list = script_fu_get_menu_list ();
+  /* menu_list might be NULL: for loop will have no iterations. */
+
+  /* Each .scm file can declare many menu paths.
+   * Traverse the list to find the menu path defined for the procedure.
+   * Each SFMenu points to the procedure (SFScript) it belongs to.
+   */
+  for (GList * traverser = menu_list; traverser; traverser = g_list_next (traverser))
+    {
+      SFMenu *menu = traverser->data;
+      if (menu->script == script)
+        {
+          g_debug ("Add menu: %s", menu->menu_path);
+          pika_procedure_add_menu_path (procedure, menu->menu_path);
+          did_add_menu = TRUE;
+          break;
+        }
+    }
+
+  /* Some procedures don't have menu path.
+   * It is normal, but not common, to define procs of type PLUGIN that don't appear in the menus.
+   * No part of PIKA defaults a menu path for procedures.
+   * A menu label without a menu path is probably a mistake by the script author.
+   */
+  if ( ! did_add_menu )
+    {
+      /* Unusual for a .scm file to have no menu paths, but not an error. */
+      g_debug ("No menu paths! Does the procedure name in script-fu-menu-register match?");
+      /* FUTURE if the script defines a menu *label*, declare an error. */
+    }
+  /* script_menu_list is a reference we do not need to free. */
+ }

plug-ins/script-fu/libscriptfu/script-fu-proc-factory.h

@@ -0,0 +1,31 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#ifndef __SCRIPT_FU_PDB_PROC_FACTORY_H__
+#define __SCRIPT_FU_PDB_PROC_FACTORY_H__
+
+PikaProcedure *script_fu_proc_factory_make_PLUGIN (PikaPlugIn  *plug_in,
+                                                   GList       *paths,
+                                                   const gchar *name);
+GList         *script_fu_proc_factory_list_names  (PikaPlugIn  *plug_in,
+                                                   GList       *paths);
+
+#endif /*  __SCRIPT_FU_PDB_PROC_FACTORY__  */

plug-ins/script-fu/libscriptfu/script-fu-regex.c

@@ -0,0 +1,183 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * 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/>.
+ */
+
+/* Based on re.c
+ *
+ * Henry Spencer's implementation of Regular Expressions,
+ * used for TinyScheme
+ *
+ * Refurbished by Stephen Gildea
+ *
+ * Ported to GRegex and de-uglified by Michael Natterer
+ */
+
+#include "config.h"
+
+#include "tinyscheme/scheme-private.h"
+#include "script-fu-regex.h"
+
+
+/*  local function prototypes  */
+
+static pointer foreign_re_match (scheme  *sc,
+                                 pointer  args);
+static void    set_vector_elem  (pointer  vec,
+                                 int      ielem,
+                                 pointer  newel);
+
+
+/*  public functions  */
+
+void
+script_fu_regex_init (scheme *sc)
+{
+  sc->vptr->scheme_define (sc,
+                           sc->global_env,
+                           sc->vptr->mk_symbol(sc,"re-match"),
+                           sc->vptr->mk_foreign_func(sc, foreign_re_match));
+
+#if 0
+  sc->vptr->load_string
+    (sc,
+     ";; return the substring of STRING matched in MATCH-VECTOR,\n"
+     ";; the Nth subexpression match (default 0).\n"
+     "\n"
+     "(define (re-match-nth string match-vector . n)\n"
+     "  (let ((n (if (pair? n) (car n) 0)))\n"
+     "    (substring string (car (vector-ref match-vector n))\n"
+     "                      (cdr (vector-ref match-vector n)))))\n"
+     "(define (re-before-nth string match-vector . n)\n"
+     "  (let ((n (if (pair? n) (car n) 0)))\n"
+     "    (substring string 0 (car (vector-ref match-vector n)))))\n"
+     "(define (re-after-nth string match-vector . n)\n"
+     "  (let ((n (if (pair? n) (car n) 0)))\n"
+     "    (substring string (cdr (vector-ref match-vector n))\n"
+     "                      (string-length string))))\n");
+#endif
+}
+
+
+/*  private functions  */
+
+static pointer
+foreign_re_match (scheme  *sc,
+                  pointer  args)
+{
+  pointer   retval = sc->F;
+  gboolean  success;
+  gboolean  is_valid_utf8;
+  GRegex   *regex;
+  pointer   first_arg, second_arg;
+  pointer   third_arg = sc->NIL;
+  char     *string;
+  char     *pattern;
+  int       num = 0;
+
+  if (!((args != sc->NIL)
+        && sc->vptr->is_string ((first_arg = sc->vptr->pair_car (args)))
+        && (args = sc->vptr->pair_cdr (args))
+        && sc->vptr->is_pair (args)
+        && sc->vptr->is_string ((second_arg = sc->vptr->pair_car (args)))))
+    {
+      return sc->F;
+    }
+
+  pattern = sc->vptr->string_value (first_arg);
+  string  = sc->vptr->string_value (second_arg);
+
+  is_valid_utf8 = g_utf8_validate (string, -1, NULL);
+
+  args = sc->vptr->pair_cdr (args);
+
+  if (args != sc->NIL)
+    {
+      if (!(sc->vptr->is_pair (args)
+            && sc->vptr->is_vector ((third_arg = sc->vptr->pair_car (args)))))
+        {
+          return sc->F;
+        }
+      else
+        {
+          num = third_arg->_object._number.value.ivalue;
+        }
+    }
+
+  regex = g_regex_new (pattern, G_REGEX_EXTENDED, 0, NULL);
+  if (! regex)
+    return sc->F;
+
+  if (! num)
+    {
+      success = g_regex_match (regex, string, 0, NULL);
+    }
+  else
+    {
+      GMatchInfo *match_info;
+      gint        i;
+
+      success = g_regex_match (regex, string, 0, &match_info);
+
+      for (i = 0; i < num; i++)
+        {
+          gint start, end;
+
+          g_match_info_fetch_pos (match_info, i, &start, &end);
+
+          if (is_valid_utf8)
+            {
+              start = g_utf8_pointer_to_offset (string, string + start);
+              end   = g_utf8_pointer_to_offset (string, string + end);
+            }
+
+#undef cons
+          set_vector_elem (third_arg, i,
+                           sc->vptr->cons(sc,
+                                          sc->vptr->mk_integer(sc, start),
+                                          sc->vptr->mk_integer(sc, end)));
+        }
+
+      g_match_info_free (match_info);
+    }
+
+  if (success)
+    retval = sc->T;
+
+  g_regex_unref (regex);
+
+  return retval;
+}
+
+static void
+set_vector_elem (pointer vec,
+                 int     ielem,
+                 pointer newel)
+{
+  int n = ielem / 2;
+
+  if (ielem % 2 == 0)
+    {
+      vec[1 + n]._object._cons._car = newel;
+    }
+  else
+    {
+      vec[1 + n]._object._cons._cdr = newel;
+    }
+}

plug-ins/script-fu/libscriptfu/script-fu-regex.h

@@ -0,0 +1,29 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#ifndef __SCRIPT_FU_REGEX_H__
+#define __SCRIPT_FU_REGEX_H__
+
+
+void   script_fu_regex_init (scheme *sc);
+
+
+#endif /* __SCRIPT_FU_REGEX_H__ */

plug-ins/script-fu/libscriptfu/script-fu-register.c

@@ -0,0 +1,474 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * 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>
+
+#ifdef G_OS_WIN32
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+#endif
+
+#include <libpika/pika.h>
+
+#include "tinyscheme/scheme-private.h"
+
+#include "script-fu-types.h"
+#include "script-fu-script.h"
+#include "script-fu-register.h"
+
+/* Methods for a script's call to script-fu-register or script-fu-register-filter.
+ * Such calls declare a PDB procedure, that ScriptFu will register in the PDB,
+ * that the script implements by its inner run func.
+ * These methods are only creating structs local to ScriptFu, used later to register.
+ */
+
+
+
+/* Traverse Scheme argument list
+ * creating a new SFScript with metadata, but empty SFArgs (formal arg specs)
+ *
+ * Takes a handle to a pointer into the argument list.
+ * Advances the pointer past the metadata args.
+ *
+ * Returns new SFScript.
+ */
+SFScript*
+script_fu_script_new_from_metadata_args (scheme  *sc,
+                                         pointer *handle)
+{
+  SFScript    *script;
+  const gchar *name;
+  const gchar *menu_label;
+  const gchar *blurb;
+  const gchar *author;
+  const gchar *copyright;
+  const gchar *date;
+  const gchar *image_types;
+  guint        n_args;
+
+  /* dereference handle into local pointer. */
+  pointer a = *handle;
+
+  g_debug ("script_fu_script_new_from_metadata_args");
+
+  /* Require list_length starting at a is >=7
+   * else strange parsing errors at plugin query time.
+   */
+
+  name = sc->vptr->string_value (sc->vptr->pair_car (a));
+  a = sc->vptr->pair_cdr (a);
+  menu_label = sc->vptr->string_value (sc->vptr->pair_car (a));
+  a = sc->vptr->pair_cdr (a);
+  blurb = sc->vptr->string_value (sc->vptr->pair_car (a));
+  a = sc->vptr->pair_cdr (a);
+  author = sc->vptr->string_value (sc->vptr->pair_car (a));
+  a = sc->vptr->pair_cdr (a);
+  copyright = sc->vptr->string_value (sc->vptr->pair_car (a));
+  a = sc->vptr->pair_cdr (a);
+  date = sc->vptr->string_value (sc->vptr->pair_car (a));
+  a = sc->vptr->pair_cdr (a);
+
+  if (sc->vptr->is_pair (a))
+    {
+      image_types = sc->vptr->string_value (sc->vptr->pair_car (a));
+      a = sc->vptr->pair_cdr (a);
+    }
+  else
+    {
+      image_types = sc->vptr->string_value (a);
+      a = sc->NIL;
+    }
+
+  /* Store local, advanced pointer at handle from caller. */
+  *handle = a;
+
+  /* Calculate supplied number of formal arguments of the PDB procedure,
+   * each takes three actual args from Scheme call.
+   */
+  n_args = sc->vptr->list_length (sc, a) / 3;
+
+  /* This allocates empty array of SFArg. Hereafter, script knows its n_args. */
+  script = script_fu_script_new (name,
+                                 menu_label,
+                                 blurb,
+                                 author,
+                                 copyright,
+                                 date,
+                                 image_types,
+                                 n_args);
+  return script;
+}
+
+/* Traverse suffix of Scheme argument list,
+ * creating SFArgs (formal arg specs) from triplets.
+ *
+ * Takes a handle to a pointer into the argument list.
+ * Advances the pointer past the triplets.
+ * Changes state of SFScript.args[]
+ *
+ * Returns a foreign_error or NIL.
+ */
+pointer
+script_fu_script_create_formal_args (scheme   *sc,
+                                     pointer  *handle,
+                                     SFScript *script)
+{
+  /* dereference handle into local pointer. */
+  pointer a = *handle;
+
+  g_debug ("script_fu_script_create_formal_args");
+
+  for (guint i = 0; i < script->n_args; i++)
+    {
+      SFArg *arg = &script->args[i];
+
+      if (a != sc->NIL)
+        {
+          if (!sc->vptr->is_integer (sc->vptr->pair_car (a)))
+            return foreign_error (sc, "script-fu-register: argument types must be integer values", 0);
+
+          arg->type = sc->vptr->ivalue (sc->vptr->pair_car (a));
+          a = sc->vptr->pair_cdr (a);
+        }
+      else
+        return foreign_error (sc, "script-fu-register: missing type specifier", 0);
+
+      if (a != sc->NIL)
+        {
+          if (!sc->vptr->is_string (sc->vptr->pair_car (a)))
+            return foreign_error (sc, "script-fu-register: argument labels must be strings", 0);
+
+          arg->label = g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
+          a = sc->vptr->pair_cdr (a);
+        }
+      else
+        return foreign_error (sc, "script-fu-register: missing arguments label", 0);
+
+      if (a != sc->NIL)
+        {
+          switch (arg->type)
+            {
+            case SF_IMAGE:
+            case SF_DRAWABLE:
+            case SF_LAYER:
+            case SF_CHANNEL:
+            case SF_VECTORS:
+            case SF_DISPLAY:
+              if (!sc->vptr->is_integer (sc->vptr->pair_car (a)))
+                return foreign_error (sc, "script-fu-register: default IDs must be integer values", 0);
+
+              arg->default_value.sfa_image =
+                sc->vptr->ivalue (sc->vptr->pair_car (a));
+              break;
+
+            case SF_COLOR:
+              if (sc->vptr->is_string (sc->vptr->pair_car (a)))
+                {
+                  if (! pika_rgb_parse_css (&arg->default_value.sfa_color,
+                                            sc->vptr->string_value (sc->vptr->pair_car (a)),
+                                            -1))
+                    return foreign_error (sc, "script-fu-register: invalid default color name", 0);
+
+                  pika_rgb_set_alpha (&arg->default_value.sfa_color, 1.0);
+                }
+              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, g, b;
+
+                  color_list = sc->vptr->pair_car (a);
+                  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);
+
+                  pika_rgb_set_uchar (&arg->default_value.sfa_color, r, g, b);
+                }
+              else
+                {
+                  return foreign_error (sc, "script-fu-register: color defaults must be a list of 3 integers or a color name", 0);
+                }
+              break;
+
+            case SF_TOGGLE:
+              if (!sc->vptr->is_integer (sc->vptr->pair_car (a)))
+                return foreign_error (sc, "script-fu-register: toggle default must be an integer value", 0);
+
+              arg->default_value.sfa_toggle =
+                (sc->vptr->ivalue (sc->vptr->pair_car (a))) ? TRUE : FALSE;
+              break;
+
+            case SF_VALUE:
+              if (!sc->vptr->is_string (sc->vptr->pair_car (a)))
+                return foreign_error (sc, "script-fu-register: value defaults must be string values", 0);
+
+              arg->default_value.sfa_value =
+                g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
+              break;
+
+            case SF_STRING:
+            case SF_TEXT:
+              if (!sc->vptr->is_string (sc->vptr->pair_car (a)))
+                return foreign_error (sc, "script-fu-register: string defaults must be string values", 0);
+
+              arg->default_value.sfa_value =
+                g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
+              break;
+
+            case SF_ADJUSTMENT:
+              {
+                pointer adj_list;
+
+                if (!sc->vptr->is_list (sc, a))
+                  return foreign_error (sc, "script-fu-register: adjustment defaults must be a list", 0);
+
+                adj_list = sc->vptr->pair_car (a);
+                arg->default_value.sfa_adjustment.value =
+                  sc->vptr->rvalue (sc->vptr->pair_car (adj_list));
+
+                adj_list = sc->vptr->pair_cdr (adj_list);
+                arg->default_value.sfa_adjustment.lower =
+                  sc->vptr->rvalue (sc->vptr->pair_car (adj_list));
+
+                adj_list = sc->vptr->pair_cdr (adj_list);
+                arg->default_value.sfa_adjustment.upper =
+                  sc->vptr->rvalue (sc->vptr->pair_car (adj_list));
+
+                adj_list = sc->vptr->pair_cdr (adj_list);
+                arg->default_value.sfa_adjustment.step =
+                  sc->vptr->rvalue (sc->vptr->pair_car (adj_list));
+
+                adj_list = sc->vptr->pair_cdr (adj_list);
+                arg->default_value.sfa_adjustment.page =
+                  sc->vptr->rvalue (sc->vptr->pair_car (adj_list));
+
+                adj_list = sc->vptr->pair_cdr (adj_list);
+                arg->default_value.sfa_adjustment.digits =
+                  sc->vptr->ivalue (sc->vptr->pair_car (adj_list));
+
+                adj_list = sc->vptr->pair_cdr (adj_list);
+                arg->default_value.sfa_adjustment.type =
+                  sc->vptr->ivalue (sc->vptr->pair_car (adj_list));
+              }
+              break;
+
+            case SF_FILENAME:
+              if (!sc->vptr->is_string (sc->vptr->pair_car (a)))
+                return foreign_error (sc, "script-fu-register: filename defaults must be string values", 0);
+              /* fallthrough */
+
+            case SF_DIRNAME:
+              if (!sc->vptr->is_string (sc->vptr->pair_car (a)))
+                return foreign_error (sc, "script-fu-register: dirname defaults must be string values", 0);
+
+              arg->default_value.sfa_file.filename =
+                g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
+
+#ifdef G_OS_WIN32
+              {
+                /* Replace POSIX slashes with Win32 backslashes. This
+                 * is just so script-fus can be written with only
+                 * POSIX directory separators.
+                 */
+                gchar *filename = arg->default_value.sfa_file.filename;
+
+                while (*filename)
+                  {
+                    if (*filename == '/')
+                      *filename = G_DIR_SEPARATOR;
+
+                    filename++;
+                  }
+              }
+#endif
+              break;
+
+            case SF_FONT:
+              if (!sc->vptr->is_string (sc->vptr->pair_car (a)))
+                return foreign_error (sc, "script-fu-register: font defaults must be string values", 0);
+
+              arg->default_value.sfa_font =
+                g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
+              break;
+
+            case SF_PALETTE:
+              if (!sc->vptr->is_string (sc->vptr->pair_car (a)))
+                return foreign_error (sc, "script-fu-register: palette defaults must be string values", 0);
+
+              arg->default_value.sfa_palette =
+                g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
+              break;
+
+            case SF_PATTERN:
+              if (!sc->vptr->is_string (sc->vptr->pair_car (a)))
+                return foreign_error (sc, "script-fu-register: pattern defaults must be string values", 0);
+
+              arg->default_value.sfa_pattern =
+                g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
+              break;
+
+            case SF_BRUSH:
+              {
+                pointer brush_list;
+
+                if (!sc->vptr->is_list (sc, a))
+                  return foreign_error (sc, "script-fu-register: brush defaults must be a list", 0);
+
+                #ifdef OLD
+                temporarily, still a list, but use only the name
+                future: not a list, only a name
+
+                brush_list = sc->vptr->pair_car (a);
+                arg->default_value.sfa_brush.name =
+                  g_strdup (sc->vptr->string_value (sc->vptr->pair_car (brush_list)));
+
+                brush_list = sc->vptr->pair_cdr (brush_list);
+                arg->default_value.sfa_brush.opacity =
+                  sc->vptr->rvalue (sc->vptr->pair_car (brush_list));
+
+                brush_list = sc->vptr->pair_cdr (brush_list);
+                arg->default_value.sfa_brush.spacing =
+                  sc->vptr->ivalue (sc->vptr->pair_car (brush_list));
+
+                brush_list = sc->vptr->pair_cdr (brush_list);
+                arg->default_value.sfa_brush.paint_mode =
+                  sc->vptr->ivalue (sc->vptr->pair_car (brush_list));
+                #else
+                brush_list = sc->vptr->pair_car (a);
+                arg->default_value.sfa_brush =
+                  g_strdup (sc->vptr->string_value (sc->vptr->pair_car (brush_list)));
+                #endif
+              }
+              break;
+
+            case SF_GRADIENT:
+              if (!sc->vptr->is_string (sc->vptr->pair_car (a)))
+                return foreign_error (sc, "script-fu-register: gradient defaults must be string values", 0);
+
+              arg->default_value.sfa_gradient =
+                g_strdup (sc->vptr->string_value (sc->vptr->pair_car (a)));
+              break;
+
+            case SF_OPTION:
+              {
+                pointer option_list;
+
+                if (!sc->vptr->is_list (sc, a))
+                  return foreign_error (sc, "script-fu-register: option defaults must be a list", 0);
+
+                for (option_list = sc->vptr->pair_car (a);
+                     option_list != sc->NIL;
+                     option_list = sc->vptr->pair_cdr (option_list))
+                  {
+                    arg->default_value.sfa_option.list =
+                      g_slist_append (arg->default_value.sfa_option.list,
+                                      g_strdup (sc->vptr->string_value
+                                                (sc->vptr->pair_car (option_list))));
+                  }
+              }
+              break;
+
+            case SF_ENUM:
+              {
+                pointer      option_list;
+                const gchar *val;
+                gchar       *type_name;
+                GEnumValue  *enum_value;
+                GType        enum_type;
+
+                if (!sc->vptr->is_list (sc, a))
+                  return foreign_error (sc, "script-fu-register: enum defaults must be a list", 0);
+
+                option_list = sc->vptr->pair_car (a);
+                if (!sc->vptr->is_string (sc->vptr->pair_car (option_list)))
+                  return foreign_error (sc, "script-fu-register: first element in enum defaults must be a type-name", 0);
+
+                val = sc->vptr->string_value (sc->vptr->pair_car (option_list));
+
+                if (g_str_has_prefix (val, "Pika"))
+                  type_name = g_strdup (val);
+                else
+                  type_name = g_strconcat ("Pika", val, NULL);
+
+                enum_type = g_type_from_name (type_name);
+                if (! G_TYPE_IS_ENUM (enum_type))
+                  {
+                    g_free (type_name);
+                    return foreign_error (sc, "script-fu-register: first element in enum defaults must be the name of a registered type", 0);
+                  }
+
+                arg->default_value.sfa_enum.type_name = type_name;
+
+                option_list = sc->vptr->pair_cdr (option_list);
+                if (!sc->vptr->is_string (sc->vptr->pair_car (option_list)))
+                  return foreign_error (sc, "script-fu-register: second element in enum defaults must be a string", 0);
+
+                enum_value =
+                  g_enum_get_value_by_nick (g_type_class_peek (enum_type),
+                                            sc->vptr->string_value (sc->vptr->pair_car (option_list)));
+                if (enum_value)
+                  arg->default_value.sfa_enum.history = enum_value->value;
+              }
+              break;
+            }
+
+          a = sc->vptr->pair_cdr (a);
+        }
+      else
+        {
+          return foreign_error (sc, "script-fu-register: missing default argument", 0);
+        }
+    } /* end for */
+
+  /* Store local, advanced pointer at handle from caller. */
+  *handle = a;
+
+  return sc->NIL;
+}
+
+/* Traverse next arg in Scheme argument list.
+ * Set SFScript.drawable_arity from the argument.
+ * Used only by script-fu-register-filter.
+ *
+ * Return foreign_error or NIL.
+ */
+pointer
+script_fu_script_parse_drawable_arity_arg (scheme   *sc,
+                                           pointer  *handle,
+                                           SFScript *script)
+{
+  /* dereference handle into local pointer. */
+  pointer a = *handle;
+
+  /* argument must be an int, usually a symbol from enum e.g. SF-MULTIPLE-DRAWABLE */
+  if (!sc->vptr->is_integer (sc->vptr->pair_car (a)))
+    return foreign_error (sc, "script-fu-register-filter: drawable arity must be integer value", 0);
+  script->drawable_arity = sc->vptr->ivalue (sc->vptr->pair_car (a));
+
+  /* Advance the pointer into script. */
+  a = sc->vptr->pair_cdr (a);
+  *handle = a;
+  return sc->NIL;
+}

plug-ins/script-fu/libscriptfu/script-fu-register.h

@@ -0,0 +1,34 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#ifndef __SCRIPT_FU_REGISTER_H__
+#define __SCRIPT_FU_REGISTER_H__
+
+pointer   script_fu_script_create_formal_args       (scheme   *sc,
+                                                     pointer  *handle,
+                                                     SFScript *script);
+SFScript *script_fu_script_new_from_metadata_args   (scheme   *sc,
+                                                     pointer  *handle);
+pointer   script_fu_script_parse_drawable_arity_arg (scheme   *sc,
+                                                     pointer  *handle,
+                                                     SFScript *script);
+
+#endif /* __SCRIPT_FU_REGISTER_H__ */

plug-ins/script-fu/libscriptfu/script-fu-run-func.c

@@ -0,0 +1,220 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * 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 <string.h>
+#include <glib.h>
+
+#include <libpika/pika.h>
+
+#include "scheme-wrapper.h"       /* type "pointer" */
+
+#include "script-fu-types.h"
+#include "script-fu-interface.h"  /* ScriptFu's GUI implementation. */
+#include "script-fu-dialog.h"     /* Pika's GUI implementation. */
+#include "script-fu-script.h"
+#include "script-fu-scripts.h"    /* script_fu_find_script */
+#include "script-fu-command.h"
+
+#include "script-fu-run-func.h"
+
+/* Outer run_funcs
+ * One each for PikaProcedure and PikaImageProcedure.
+ * These are called from Gimp, with two different signatures.
+ * These form and interpret "commands" which are calls to inner run_funcs
+ * defined in Scheme by a script.
+
+ * These return the result of interpretation,
+ * in a PikaValueArray whose only element is a status.
+ * !!! ScriptFu does not let authors define procedures that return values.
+ */
+
+/* run_func for a PikaImageProcedure
+ *
+ * Type is PikaRunImageFunc.
+ *
+ * Uses Pika's config and gui.
+ *
+ * Since 3.0
+ */
+PikaValueArray *
+script_fu_run_image_procedure ( PikaProcedure         *procedure, /* PikaImageProcedure */
+                                PikaRunMode           run_mode,
+                                PikaImage            *image,
+                                guint                 n_drawables,
+                                PikaDrawable        **drawables,
+                                const PikaValueArray *other_args,
+                                gpointer              data)
+{
+
+  PikaValueArray    *result = NULL;
+  SFScript          *script;
+
+  g_debug ("script_fu_run_image_procedure");
+  script = script_fu_find_script (pika_procedure_get_name (procedure));
+
+  if (! script)
+    return pika_procedure_new_return_values (procedure, PIKA_PDB_CALLING_ERROR, NULL);
+
+  ts_set_run_mode (run_mode);
+
+  switch (run_mode)
+    {
+    case PIKA_RUN_INTERACTIVE:
+      {
+        if (pika_value_array_length (other_args) > 0)
+          {
+            /* Let user choose "other" args in a dialog, then interpret. Maintain a config. */
+            result = script_fu_dialog_run (procedure, script, image, n_drawables, drawables, other_args);
+          }
+        else
+          {
+            /* No "other" args for user to choose. No config to maintain. */
+            result = script_fu_interpret_image_proc (procedure, script, image, n_drawables, drawables, other_args);
+          }
+        break;
+      }
+    case PIKA_RUN_NONINTERACTIVE:
+      {
+        /* A call from another PDB procedure.
+         * Use the given other_args, without interacting with user.
+         * Since no user interaction, no config to maintain.
+         */
+        result = script_fu_interpret_image_proc (procedure, script, image, n_drawables, drawables, other_args);
+        break;
+      }
+    case PIKA_RUN_WITH_LAST_VALS:
+      {
+        /* User invoked from a menu "Filter>Run with last values".
+         * Do not show dialog. other_args are already last values, from a config.
+         */
+        result = script_fu_interpret_image_proc (procedure, script, image, n_drawables, drawables, other_args);
+        break;
+      }
+    default:
+      {
+        result = pika_procedure_new_return_values (procedure, PIKA_PDB_CALLING_ERROR, NULL);
+      }
+    }
+  return result;
+}
+
+
+/* run_func for a PikaProcedure.
+ *
+ * Type is PikaRunFunc
+ *
+ * Uses ScriptFu's own GUI implementation, and retains settings locally.
+ *
+ * Since prior to 3.0 but formerly named script_fu_script_proc
+ */
+PikaValueArray *
+script_fu_run_procedure (PikaProcedure        *procedure,
+                         const PikaValueArray *args,
+                         gpointer              data)
+{
+  PikaPDBStatusType  status = PIKA_PDB_SUCCESS;
+  SFScript          *script;
+  PikaRunMode        run_mode;
+  GError            *error = NULL;
+
+  script = script_fu_find_script (pika_procedure_get_name (procedure));
+
+  if (! script)
+    return pika_procedure_new_return_values (procedure,
+                                             PIKA_PDB_CALLING_ERROR,
+                                             NULL);
+
+  run_mode = PIKA_VALUES_GET_ENUM (args, 0);
+
+  ts_set_run_mode (run_mode);
+
+  switch (run_mode)
+    {
+    case PIKA_RUN_INTERACTIVE:
+      {
+        gint min_args = 0;
+
+        /*  First, try to collect the standard script arguments...  */
+        min_args = script_fu_script_collect_standard_args (script, args);
+
+        /*  ...then acquire the rest of arguments (if any) with a dialog  */
+        if (script->n_args > min_args)
+          {
+            status = script_fu_interface (script, min_args);
+            break;
+          }
+        /*  otherwise (if the script takes no more arguments), skip
+         *  this part and run the script directly (fallthrough)
+         */
+      }
+
+    case PIKA_RUN_NONINTERACTIVE:
+      /*  Make sure all the arguments are there  */
+      if (pika_value_array_length (args) != (script->n_args + 1))
+        status = PIKA_PDB_CALLING_ERROR;
+
+      if (status == PIKA_PDB_SUCCESS)
+        {
+          gchar *command;
+
+          command = script_fu_script_get_command_from_params (script, args);
+
+          /*  run the command through the interpreter  */
+          if (! script_fu_run_command (command, &error))
+            {
+              return pika_procedure_new_return_values (procedure,
+                                                       PIKA_PDB_EXECUTION_ERROR,
+                                                       error);
+            }
+
+          g_free (command);
+        }
+      break;
+
+    case PIKA_RUN_WITH_LAST_VALS:
+      {
+        gchar *command;
+
+        /*  First, try to collect the standard script arguments  */
+        script_fu_script_collect_standard_args (script, args);
+
+        command = script_fu_script_get_command (script);
+
+        /*  run the command through the interpreter  */
+        if (! script_fu_run_command (command, &error))
+          {
+            return pika_procedure_new_return_values (procedure,
+                                                     PIKA_PDB_EXECUTION_ERROR,
+                                                     error);
+          }
+
+        g_free (command);
+      }
+      break;
+
+    default:
+      break;
+    }
+
+  return pika_procedure_new_return_values (procedure, status, NULL);
+}

plug-ins/script-fu/libscriptfu/script-fu-run-func.h

@@ -0,0 +1,37 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#ifndef __SCRIPT_FU_RUN_FUNC_H__
+#define __SCRIPT_FU_RUN_FUNC_H__
+
+PikaValueArray *script_fu_run_procedure       (PikaProcedure        *procedure,
+                                               const PikaValueArray *args,
+                                               gpointer              data);
+
+PikaValueArray *script_fu_run_image_procedure (PikaProcedure        *procedure,
+                                               PikaRunMode           run_mode,
+                                               PikaImage            *image,
+                                               guint                 n_drawables,
+                                               PikaDrawable        **drawables,
+                                               const PikaValueArray *args,
+                                               gpointer              data);
+
+#endif /*  __SCRIPT_FU_RUN_FUNC__  */

plug-ins/script-fu/libscriptfu/script-fu-script.c

@@ -0,0 +1,626 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * 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 <string.h>
+
+#include <libpika/pika.h>
+
+#include "tinyscheme/scheme-private.h"
+
+#include "script-fu-types.h"
+#include "script-fu-arg.h"
+#include "script-fu-script.h"
+#include "script-fu-run-func.h"
+
+#include "script-fu-intl.h"
+
+
+/*
+ *  Local Functions
+ */
+
+static gboolean script_fu_script_param_init (SFScript             *script,
+                                             const PikaValueArray *args,
+                                             SFArgType             type,
+                                             gint                  n);
+static void     script_fu_script_set_proc_metadata (
+                                             PikaProcedure        *procedure,
+                                             SFScript             *script);
+static void     script_fu_script_set_proc_args (
+                                             PikaProcedure        *procedure,
+                                             SFScript             *script,
+                                             guint                 first_conveyed_arg);
+static void     script_fu_script_set_drawable_sensitivity (
+                                             PikaProcedure        *procedure,
+                                             SFScript             *script);
+
+static void     script_fu_command_append_drawables (
+                                             GString              *s,
+                                             guint                 n_drawables,
+                                             PikaDrawable        **drawables);
+/*
+ *  Function definitions
+ */
+
+SFScript *
+script_fu_script_new (const gchar *name,
+                      const gchar *menu_label,
+                      const gchar *blurb,
+                      const gchar *author,
+                      const gchar *copyright,
+                      const gchar *date,
+                      const gchar *image_types,
+                      gint         n_args)
+{
+  SFScript *script;
+
+  script = g_slice_new0 (SFScript);
+
+  script->name        = g_strdup (name);
+  script->menu_label  = g_strdup (menu_label);
+  script->blurb       = g_strdup (blurb);
+  script->author      = g_strdup (author);
+  script->copyright   = g_strdup (copyright);
+  script->date        = g_strdup (date);
+  script->image_types = g_strdup (image_types);
+
+  script->n_args = n_args;
+  script->args   = g_new0 (SFArg, script->n_args);
+
+  script->drawable_arity = SF_NO_DRAWABLE; /* default */
+
+  return script;
+}
+
+void
+script_fu_script_free (SFScript *script)
+{
+  gint i;
+
+  g_return_if_fail (script != NULL);
+
+  g_free (script->name);
+  g_free (script->blurb);
+  g_free (script->menu_label);
+  g_free (script->author);
+  g_free (script->copyright);
+  g_free (script->date);
+  g_free (script->image_types);
+
+  for (i = 0; i < script->n_args; i++)
+    {
+      script_fu_arg_free (&script->args[i]);
+    }
+
+  g_free (script->args);
+
+  g_slice_free (SFScript, script);
+}
+
+
+/*
+ * From the script, create a temporary PDB procedure,
+ * and install it as owned by the scriptfu extension PDB proc.
+ */
+void
+script_fu_script_install_proc (PikaPlugIn  *plug_in,
+                               SFScript    *script)
+{
+  PikaProcedure *procedure;
+
+  g_return_if_fail (PIKA_IS_PLUG_IN (plug_in));
+  g_return_if_fail (script != NULL);
+
+  procedure = script_fu_script_create_PDB_procedure (plug_in,
+                                                     script,
+                                                     PIKA_PDB_PROC_TYPE_TEMPORARY);
+
+  pika_plug_in_add_temp_procedure (plug_in, procedure);
+  g_object_unref (procedure);
+}
+
+
+/*
+ * Create and return a PikaProcedure or its subclass PikaImageProcedure.
+ * Caller typically either:
+ *    install it owned by self as TEMPORARY type procedure
+ *    OR return it as the result of a create_procedure callback from PIKA (PLUGIN type procedure.)
+ *
+ * Caller must unref the procedure.
+ *
+ * Understands ScriptFu's internal run funcs for PikaProcedure and PikaImageProcedure
+ */
+PikaProcedure *
+script_fu_script_create_PDB_procedure (PikaPlugIn     *plug_in,
+                                       SFScript       *script,
+                                       PikaPDBProcType plug_in_type)
+{
+  PikaProcedure *procedure;
+
+  if (script->proc_class == PIKA_TYPE_IMAGE_PROCEDURE)
+    {
+      g_debug ("script_fu_script_create_PDB_procedure: %s, plugin type %i, image_proc",
+               script->name, plug_in_type);
+
+      procedure = pika_image_procedure_new (
+                                      plug_in, script->name,
+                                      plug_in_type,
+                                      (PikaRunImageFunc) script_fu_run_image_procedure,
+                                      script, /* user_data, pointer in extension-script-fu process */
+                                      NULL);
+
+      script_fu_script_set_proc_metadata (procedure, script);
+
+      /* Script author does not declare image, drawable in script-fu-register-filter,
+       * and we don't add to formal args in PDB.
+       * The convenience class PikaImageProcedure already has formal args:
+       * run_mode, image, n_drawables, drawables.
+       * "0" means not skip any arguments declared in the script.
+       */
+      script_fu_script_set_proc_args (procedure, script, 0);
+
+      script_fu_script_set_drawable_sensitivity (procedure, script);
+    }
+  else
+    {
+      g_assert (script->proc_class == PIKA_TYPE_PROCEDURE);
+      g_debug ("script_fu_script_create_PDB_procedure: %s, plugin type %i, ordinary proc",
+               script->name, plug_in_type);
+
+      procedure = pika_procedure_new (plug_in, script->name,
+                                      plug_in_type,
+                                      script_fu_run_procedure,
+                                      script, NULL);
+
+      script_fu_script_set_proc_metadata (procedure, script);
+
+      pika_procedure_add_argument (procedure,
+                                   g_param_spec_enum ("run-mode",
+                                                      "Run mode",
+                                                      "The run mode",
+                                                      PIKA_TYPE_RUN_MODE,
+                                                      PIKA_RUN_INTERACTIVE,
+                                                      G_PARAM_READWRITE));
+
+      script_fu_script_set_proc_args (procedure, script, 0);
+
+      /* !!! Author did not declare drawable arity, it was inferred. */
+      script_fu_script_set_drawable_sensitivity (procedure, script);
+    }
+
+
+  return procedure;
+}
+
+void
+script_fu_script_uninstall_proc (PikaPlugIn *plug_in,
+                                 SFScript   *script)
+{
+  g_return_if_fail (PIKA_IS_PLUG_IN (plug_in));
+  g_return_if_fail (script != NULL);
+
+  pika_plug_in_remove_temp_procedure (plug_in, script->name);
+}
+
+gchar *
+script_fu_script_get_title (SFScript *script)
+{
+  gchar *title;
+  gchar *tmp;
+
+  g_return_val_if_fail (script != NULL, NULL);
+
+  /* strip mnemonics from the menupath */
+  title = pika_strip_uline (script->menu_label);
+
+  /* if this looks like a full menu path, use only the last part */
+  if (title[0] == '<' && (tmp = strrchr (title, '/')) && tmp[1])
+    {
+      tmp = g_strdup (tmp + 1);
+
+      g_free (title);
+      title = tmp;
+    }
+
+  /* cut off ellipsis */
+  tmp = (strstr (title, "..."));
+  if (! tmp)
+    /* U+2026 HORIZONTAL ELLIPSIS */
+    tmp = strstr (title, "\342\200\246");
+
+  if (tmp && tmp == (title + strlen (title) - 3))
+    *tmp = '\0';
+
+  return title;
+}
+
+void
+script_fu_script_reset (SFScript *script,
+                        gboolean  reset_ids)
+{
+  gint i;
+
+  g_return_if_fail (script != NULL);
+
+  for (i = 0; i < script->n_args; i++)
+    {
+      script_fu_arg_reset (&script->args[i], reset_ids);
+    }
+}
+
+gint
+script_fu_script_collect_standard_args (SFScript             *script,
+                                        const PikaValueArray *args)
+{
+  gint params_consumed = 0;
+
+  g_return_val_if_fail (script != NULL, 0);
+
+  /*  the first parameter may be a DISPLAY id  */
+  if (script_fu_script_param_init (script,
+                                   args, SF_DISPLAY,
+                                   params_consumed))
+    {
+      params_consumed++;
+    }
+
+  /*  an IMAGE id may come first or after the DISPLAY id  */
+  if (script_fu_script_param_init (script,
+                                   args, SF_IMAGE,
+                                   params_consumed))
+    {
+      params_consumed++;
+
+      /*  and may be followed by a DRAWABLE, LAYER, CHANNEL or
+       *  VECTORS id
+       */
+      if (script_fu_script_param_init (script,
+                                       args, SF_DRAWABLE,
+                                       params_consumed) ||
+          script_fu_script_param_init (script,
+                                       args, SF_LAYER,
+                                       params_consumed) ||
+          script_fu_script_param_init (script,
+                                       args, SF_CHANNEL,
+                                       params_consumed) ||
+          script_fu_script_param_init (script,
+                                       args, SF_VECTORS,
+                                       params_consumed))
+        {
+          params_consumed++;
+        }
+    }
+
+  return params_consumed;
+}
+
+/* Methods that form "commands" i.e. texts in Scheme language
+ * that represent calls to the inner run func defined in a script.
+ */
+
+gchar *
+script_fu_script_get_command (SFScript *script)
+{
+  GString *s;
+  gint     i;
+
+  g_return_val_if_fail (script != NULL, NULL);
+
+  s = g_string_new ("(");
+  g_string_append (s, script->name);
+
+  for (i = 0; i < script->n_args; i++)
+    {
+      g_string_append_c (s, ' ');
+
+      script_fu_arg_append_repr_from_self (&script->args[i], s);
+    }
+
+  g_string_append_c (s, ')');
+
+  return g_string_free (s, FALSE);
+}
+
+gchar *
+script_fu_script_get_command_from_params (SFScript             *script,
+                                          const PikaValueArray *args)
+{
+  GString *s;
+  gint     i;
+
+  g_return_val_if_fail (script != NULL, NULL);
+
+  s = g_string_new ("(");
+  g_string_append (s, script->name);
+
+  for (i = 0; i < script->n_args; i++)
+    {
+      GValue *value = pika_value_array_index (args, i + 1);
+
+      g_string_append_c (s, ' ');
+
+      script_fu_arg_append_repr_from_gvalue (&script->args[i],
+                                             s,
+                                             value);
+    }
+
+  g_string_append_c (s, ')');
+
+  return g_string_free (s, FALSE);
+}
+
+/* Append a literal representing a Scheme container of numerics
+ * where the numerics are the ID's of the given drawables.
+ * Container is scheme vector, meaning its elements are all the same type.
+ */
+static void
+script_fu_command_append_drawables (GString       *s,
+                                    guint          n_drawables,
+                                    PikaDrawable **drawables)
+{
+  /* Require non-empty array of drawables. */
+  g_assert (n_drawables > 0);
+
+  /* !!! leading space to separate from prior args.
+   * #() is scheme syntax for a vector.
+   */
+  g_string_append (s, " #(" );
+  for (guint i=0; i < n_drawables; i++)
+    {
+      g_string_append_printf (s, " %d", pika_item_get_id ((PikaItem*) drawables[i]));
+    }
+  g_string_append (s, ")" );
+  /* Ensure string is like: " #( 1 2 3)" */
+}
+
+
+gchar *
+script_fu_script_get_command_for_image_proc (SFScript            *script,
+                                             PikaImage            *image,
+                                             guint                 n_drawables,
+                                             PikaDrawable        **drawables,
+                                             const PikaValueArray *args)
+{
+  GString *s;
+
+  g_return_val_if_fail (script != NULL, NULL);
+
+  s = g_string_new ("(");
+  g_string_append (s, script->name);
+
+  /* The command has no run mode. */
+
+  /* scripts use integer ID's for Pika objects. */
+  g_string_append_printf (s, " %d", pika_image_get_id (image));
+
+  /* Not pass n_drawables.
+   * An author must use Scheme functions for length of container of drawables.
+   */
+
+  /* Append text repr for a container of all drawable ID's.
+   * Even if script->drawable_arity = SF_PROC_IMAGE_SINGLE_DRAWABLE
+   * since that means the inner run func takes many but will only process one.
+   * We are not adapting to an inner run func that expects a single numeric.
+   */
+  script_fu_command_append_drawables (s, n_drawables, drawables);
+
+  /* args contains the "other" args
+   * Iterate over the PikaValueArray.
+   * But script->args should be the same length, and types should match.
+   */
+  for (guint i = 0; i < pika_value_array_length (args); i++)
+    {
+      GValue *value = pika_value_array_index (args, i);
+      g_string_append_c (s, ' ');
+      script_fu_arg_append_repr_from_gvalue (&script->args[i],
+                                             s,
+                                             value);
+    }
+
+  g_string_append_c (s, ')');
+
+  return g_string_free (s, FALSE);
+}
+
+/* Infer whether the script, defined using v2 script-fu-register,
+ * which does not specify the arity for drawables,
+ * is actually a script that takes one and only one drawable.
+ * Such plugins are deprecated in v3: each plugin must take container of drawables
+ * and declare its drawable arity via pika_procedure_set_sensitivity_mask.
+ */
+void
+script_fu_script_infer_drawable_arity (SFScript *script)
+{
+  if ((script->n_args > 1) &&
+      script->args[0].type == SF_IMAGE &&
+      script->args[1].type == SF_DRAWABLE)
+    {
+      g_debug ("Inferring drawable arity one.");
+      script->drawable_arity = SF_ONE_DRAWABLE;
+    }
+}
+
+/*
+ *  Local Functions
+ */
+
+static gboolean
+script_fu_script_param_init (SFScript             *script,
+                             const PikaValueArray *args,
+                             SFArgType             type,
+                             gint                  n)
+{
+  SFArg *arg = &script->args[n];
+
+  if (script->n_args > n &&
+      arg->type == type  &&
+      pika_value_array_length (args) > n + 1)
+    {
+      GValue *value = pika_value_array_index (args, n + 1);
+
+      switch (type)
+        {
+        case SF_IMAGE:
+          if (PIKA_VALUE_HOLDS_IMAGE (value))
+            {
+              PikaImage *image = g_value_get_object (value);
+
+              arg->value.sfa_image = pika_image_get_id (image);
+              return TRUE;
+            }
+          break;
+
+        case SF_DRAWABLE:
+          if (PIKA_VALUE_HOLDS_DRAWABLE (value))
+            {
+              PikaItem *item = g_value_get_object (value);
+
+              arg->value.sfa_drawable = pika_item_get_id (item);
+              return TRUE;
+            }
+          break;
+
+        case SF_LAYER:
+          if (PIKA_VALUE_HOLDS_LAYER (value))
+            {
+              PikaItem *item = g_value_get_object (value);
+
+              arg->value.sfa_layer = pika_item_get_id (item);
+              return TRUE;
+            }
+          break;
+
+        case SF_CHANNEL:
+          if (PIKA_VALUE_HOLDS_CHANNEL (value))
+            {
+              PikaItem *item = g_value_get_object (value);
+
+              arg->value.sfa_channel = pika_item_get_id (item);
+              return TRUE;
+            }
+          break;
+
+        case SF_VECTORS:
+          if (PIKA_VALUE_HOLDS_VECTORS (value))
+            {
+              PikaItem *item = g_value_get_object (value);
+
+              arg->value.sfa_vectors = pika_item_get_id (item);
+              return TRUE;
+            }
+          break;
+
+        case SF_DISPLAY:
+          if (PIKA_VALUE_HOLDS_DISPLAY (value))
+            {
+              PikaDisplay *display = g_value_get_object (value);
+
+              arg->value.sfa_display = pika_display_get_id (display);
+              return TRUE;
+            }
+          break;
+
+        default:
+          break;
+        }
+    }
+
+  return FALSE;
+}
+
+
+static void
+script_fu_script_set_proc_metadata (PikaProcedure *procedure,
+                                    SFScript      *script)
+{
+  const gchar *menu_label = NULL;
+
+  /* Allow scripts with no menus */
+  if (strncmp (script->menu_label, "<None>", 6) != 0)
+    menu_label = script->menu_label;
+
+  pika_procedure_set_image_types (procedure, script->image_types);
+
+  if (menu_label && strlen (menu_label))
+    pika_procedure_set_menu_label (procedure, menu_label);
+
+  pika_procedure_set_documentation (procedure,
+                                    script->blurb,
+                                    NULL,
+                                    script->name);
+  pika_procedure_set_attribution (procedure,
+                                  script->author,
+                                  script->copyright,
+                                  script->date);
+}
+
+/* Convey formal arguments from SFArg to the PDB. */
+static void
+script_fu_script_set_proc_args (PikaProcedure *procedure,
+                                SFScript      *script,
+                                guint          first_conveyed_arg)
+{
+  script_fu_arg_reset_name_generator ();
+  for (gint i = first_conveyed_arg; i < script->n_args; i++)
+    {
+      GParamSpec  *pspec = NULL;
+      const gchar *name  = NULL;
+      const gchar *nick  = NULL;
+
+      script_fu_arg_generate_name_and_nick (&script->args[i], &name, &nick);
+      pspec = script_fu_arg_get_param_spec (&script->args[i],
+                                            name,
+                                            nick);
+      pika_procedure_add_argument (procedure, pspec);
+    }
+}
+
+/* Convey drawable arity to the PDB.
+ * !!! Unless set, sensitivity defaults to drawable arity 1.
+ * See libpika/pikaprocedure.c pika_procedure_set_sensitivity_mask
+ */
+static void
+script_fu_script_set_drawable_sensitivity (PikaProcedure *procedure, SFScript *script)
+{
+  switch (script->drawable_arity)
+    {
+    case SF_TWO_OR_MORE_DRAWABLE:
+      pika_procedure_set_sensitivity_mask (procedure,
+                                           PIKA_PROCEDURE_SENSITIVE_DRAWABLES);
+      break;
+    case SF_ONE_OR_MORE_DRAWABLE:
+      pika_procedure_set_sensitivity_mask (procedure,
+                                           PIKA_PROCEDURE_SENSITIVE_DRAWABLE |
+                                           PIKA_PROCEDURE_SENSITIVE_DRAWABLES);
+      break;
+    case SF_ONE_DRAWABLE:
+      pika_procedure_set_sensitivity_mask (procedure, PIKA_PROCEDURE_SENSITIVE_DRAWABLE);
+      break;
+    case SF_NO_DRAWABLE:
+      /* menu item always sensitive. */
+      break;
+    default:
+      /* Fail to set sensitivy mask. */
+      g_warning ("Unhandled case for SFDrawableArity");
+    }
+}

plug-ins/script-fu/libscriptfu/script-fu-script.h

@@ -0,0 +1,64 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#ifndef __SCRIPT_FU_SCRIPT_H__
+#define __SCRIPT_FU_SCRIPT_H__
+
+
+SFScript * script_fu_script_new                     (const gchar          *name,
+                                                     const gchar          *menu_label,
+                                                     const gchar          *blurb,
+                                                     const gchar          *authors,
+                                                     const gchar          *copyright,
+                                                     const gchar          *date,
+                                                     const gchar          *image_types,
+                                                     gint                  n_args);
+void       script_fu_script_free                    (SFScript             *script);
+
+void       script_fu_script_install_proc            (PikaPlugIn           *plug_in,
+                                                     SFScript             *script);
+void       script_fu_script_uninstall_proc          (PikaPlugIn           *plug_in,
+                                                     SFScript             *script);
+
+gchar    * script_fu_script_get_title               (SFScript             *script);
+void       script_fu_script_reset                   (SFScript             *script,
+                                                     gboolean              reset_ids);
+
+gint       script_fu_script_collect_standard_args   (SFScript             *script,
+                                                     const PikaValueArray *args);
+
+gchar    * script_fu_script_get_command             (SFScript             *script);
+gchar    * script_fu_script_get_command_from_params (SFScript             *script,
+                                                     const PikaValueArray *args);
+gchar    * script_fu_script_get_command_for_image_proc (
+                                                     SFScript             *script,
+                                                     PikaImage            *image,
+                                                     guint                 n_drawables,
+                                                     PikaDrawable        **drawables,
+                                                     const PikaValueArray *args);
+
+PikaProcedure * script_fu_script_create_PDB_procedure (PikaPlugIn         *plug_in,
+                                                       SFScript           *script,
+                                                       PikaPDBProcType     plug_in_type);
+
+void            script_fu_script_infer_drawable_arity (SFScript           *script);
+
+#endif /*  __SCRIPT_FU_SCRIPT__  */

plug-ins/script-fu/libscriptfu/script-fu-scripts.c

@@ -0,0 +1,617 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * 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 <string.h>
+#include <glib.h>
+
+#ifdef G_OS_WIN32
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+#endif
+
+#include <libpika/pika.h>
+
+#include "tinyscheme/scheme-private.h"
+
+#include "script-fu-types.h"
+#include "script-fu-script.h"
+#include "script-fu-scripts.h"
+#include "script-fu-utils.h"
+#include "script-fu-register.h"
+#include "script-fu-command.h"
+
+#include "script-fu-intl.h"
+
+
+/*
+ *  Local Functions
+ */
+
+static void             script_fu_load_directory (GFile                *directory);
+static void             script_fu_load_script    (GFile                *file);
+static gboolean         script_fu_install_script (gpointer              foo,
+                                                  GList                *scripts,
+                                                  gpointer              data);
+static void             script_fu_install_menu   (SFMenu               *menu);
+static gboolean         script_fu_remove_script  (gpointer              foo,
+                                                  GList                *scripts,
+                                                  gpointer              data);
+
+static gchar          * script_fu_menu_map       (const gchar          *menu_path);
+static gint             script_fu_menu_compare   (gconstpointer         a,
+                                                  gconstpointer         b);
+
+static void             script_fu_try_map_menu           (SFScript     *script);
+static void             script_fu_append_script_to_tree  (SFScript     *script);
+
+/*
+ *  Local variables
+ */
+
+static GTree *script_tree      = NULL;
+static GList *script_menu_list = NULL;
+
+
+/*
+ *  Function definitions
+ */
+
+/* Traverse list of paths, finding .scm files.
+ * Load and eval any found script texts.
+ * Script texts will call Scheme functions script-fu-register
+ * and script-fu-menu-register,
+ * which insert a SFScript record into script_tree,
+ * and insert a SFMenu record into script_menu_list.
+ * These are side effects on the state of the outer (SF) interpreter.
+ *
+ * Return the tree of scripts, as well as keeping a local pointer to the tree.
+ * The other result (script_menu_list) is not returned, see script_fu_get_menu_list.
+ *
+ * Caller should free script_tree and script_menu_list,
+ * This should only be called once.
+ */
+GTree *
+script_fu_find_scripts_into_tree ( PikaPlugIn *plug_in,
+                                   GList      *paths)
+{
+  /*  Clear any existing scripts  */
+  if (script_tree != NULL)
+    {
+      g_tree_foreach (script_tree,
+                      (GTraverseFunc) script_fu_remove_script,
+                      plug_in);
+      g_tree_destroy (script_tree);
+    }
+
+  script_tree = g_tree_new ((GCompareFunc) g_utf8_collate);
+
+  if (paths)
+    {
+      GList *list;
+
+      for (list = paths; list; list = g_list_next (list))
+        {
+          script_fu_load_directory (list->data);
+        }
+    }
+
+  /*
+   * Assert result is not NULL, but may be an empty tree.
+   * When paths is NULL, or no scripts found at paths.
+   */
+
+  g_debug ("script_fu_find_scripts_into_tree found %i scripts", g_tree_nnodes (script_tree));
+  return script_tree;
+}
+
+/*
+ * Return list of SFMenu for recently loaded scripts.
+ * List is non-empty only after a call to script_fu_find_scripts_into_tree.
+ */
+GList *
+script_fu_get_menu_list (void)
+{
+  return script_menu_list;
+}
+
+/* Find scripts, create and install TEMPORARY PDB procedures,
+ * owned by self PDB procedure (e.g. extension-script-fu.)
+ */
+void
+script_fu_find_scripts (PikaPlugIn *plug_in,
+                        GList      *path)
+{
+  script_fu_find_scripts_into_tree (plug_in, path);
+
+  /*  Now that all scripts are read in and sorted, tell pika about them  */
+  g_tree_foreach (script_tree,
+                  (GTraverseFunc) script_fu_install_script,
+                  plug_in);
+
+  script_menu_list = g_list_sort (script_menu_list,
+                                  (GCompareFunc) script_fu_menu_compare);
+
+  /*  Install and nuke the list of menu entries  */
+  g_list_free_full (script_menu_list,
+                    (GDestroyNotify) script_fu_install_menu);
+  script_menu_list = NULL;
+}
+
+
+
+/* For a script's call to script-fu-register.
+ * Traverse Scheme argument list creating a new SFScript
+ * whose drawable_arity is SF_PROC_ORDINARY.
+ *
+ * Return NIL or a foreign_error
+ */
+pointer
+script_fu_add_script (scheme  *sc,
+                      pointer  a)
+{
+  SFScript    *script;
+  pointer      args_error;
+
+  /*  Check metadata args args are present */
+  if (sc->vptr->list_length (sc, a) < 7)
+    return foreign_error (sc, "script-fu-register: Not enough arguments", 0);
+
+  /* pass handle to pointer into script (on the stack) */
+  script = script_fu_script_new_from_metadata_args (sc, &a);
+
+  /* Require drawable_arity defaults to SF_PROC_ORDINARY.
+   * script-fu-register specifies an ordinary PikaProcedure.
+   * We may go on to infer a different arity.
+   */
+  g_assert (script->drawable_arity == SF_NO_DRAWABLE);
+
+  args_error = script_fu_script_create_formal_args (sc, &a, script);
+  if (args_error != sc->NIL)
+    return args_error;
+
+  /*  fill all values from defaults  */
+  script_fu_script_reset (script, TRUE);
+
+  /* Infer whether the script really requires one drawable,
+   * so that later we can set the sensitivity.
+   * For backward compatibility:
+   * v2 script-fu-register does not require author to declare drawable arity.
+   */
+  script_fu_script_infer_drawable_arity (script);
+
+  script->proc_class = PIKA_TYPE_PROCEDURE;
+
+  script_fu_try_map_menu (script);
+  script_fu_append_script_to_tree (script);
+  return sc->NIL;
+}
+
+/* For a script's call to script-fu-register-filter.
+ * Traverse Scheme argument list creating a new SFScript
+ * whose drawable_arity is SF_PROC_IMAGE_MULTIPLE_DRAWABLE or
+ * SF_PROC_IMAGE_SINGLE_DRAWABLE
+ *
+ * Same as script-fu-register, except one more arg for drawable_arity.
+ *
+ * Return NIL or a foreign_error
+ */
+pointer
+script_fu_add_script_filter (scheme  *sc,
+                             pointer  a)
+{
+  SFScript    *script;
+  pointer      args_error;  /* a foreign_error or NIL. */
+
+  /* Check metadata args args are present.
+   * Has one more arg than script-fu-register.
+   */
+  if (sc->vptr->list_length (sc, a) < 8)
+    return foreign_error (sc, "script-fu-register-filter: Not enough arguments", 0);
+
+  /* pass handle i.e. "&a" ("a" of type "pointer" is on the stack) */
+  script = script_fu_script_new_from_metadata_args (sc, &a);
+
+  /* Check semantic error: a script declaring it takes an image must specify
+   * image types.  Otherwise the script's menu item will be enabled
+   * even when no images exist.
+   */
+  if (g_strcmp0(script->image_types, "")==0)
+    return foreign_error (sc, "script-fu-register-filter: A filter must declare image types.", 0);
+
+  args_error = script_fu_script_parse_drawable_arity_arg (sc, &a, script);
+  if (args_error != sc->NIL)
+      return args_error;
+
+  args_error = script_fu_script_create_formal_args (sc, &a, script);
+  if (args_error != sc->NIL)
+      return args_error;
+
+  script->proc_class = PIKA_TYPE_IMAGE_PROCEDURE;
+
+  script_fu_try_map_menu (script);
+  script_fu_append_script_to_tree (script);
+  return sc->NIL;
+}
+
+pointer
+script_fu_add_menu (scheme  *sc,
+                    pointer  a)
+{
+  SFScript    *script;
+  SFMenu      *menu;
+  const gchar *name;
+  const gchar *path;
+
+  /*  Check the length of a  */
+  if (sc->vptr->list_length (sc, a) != 2)
+    return foreign_error (sc, "Incorrect number of arguments for script-fu-menu-register", 0);
+
+  /*  Find the script PDB entry name  */
+  name = sc->vptr->string_value (sc->vptr->pair_car (a));
+  a = sc->vptr->pair_cdr (a);
+
+  script = script_fu_find_script (name);
+
+  if (! script)
+    {
+      g_message ("Procedure %s in script-fu-menu-register does not exist",
+                 name);
+      return sc->NIL;
+    }
+
+  /*  Create a new list of menus  */
+  menu = g_slice_new0 (SFMenu);
+
+  menu->script = script;
+
+  /*  Find the script menu path  */
+  path = sc->vptr->string_value (sc->vptr->pair_car (a));
+
+  menu->menu_path = script_fu_menu_map (path);
+
+  if (! menu->menu_path)
+    menu->menu_path = g_strdup (path);
+
+  script_menu_list = g_list_prepend (script_menu_list, menu);
+
+  return sc->NIL;
+}
+
+
+/*  private functions  */
+
+static void
+script_fu_load_directory (GFile *directory)
+{
+  GFileEnumerator *enumerator;
+
+  g_debug ("Load dir: %s", g_file_get_parse_name (directory));
+
+  enumerator = g_file_enumerate_children (directory,
+                                          G_FILE_ATTRIBUTE_STANDARD_NAME ","
+                                          G_FILE_ATTRIBUTE_STANDARD_IS_HIDDEN ","
+                                          G_FILE_ATTRIBUTE_STANDARD_TYPE,
+                                          G_FILE_QUERY_INFO_NONE,
+                                          NULL, NULL);
+
+  if (enumerator)
+    {
+      GFileInfo *info;
+
+      while ((info = g_file_enumerator_next_file (enumerator, NULL, NULL)))
+        {
+          GFileType file_type = g_file_info_get_file_type (info);
+
+          if ((file_type == G_FILE_TYPE_REGULAR ||
+               file_type == G_FILE_TYPE_DIRECTORY) &&
+              ! g_file_info_get_is_hidden (info))
+            {
+              GFile *child = g_file_enumerator_get_child (enumerator, info);
+
+              if (file_type == G_FILE_TYPE_DIRECTORY)
+                script_fu_load_directory (child);
+              else
+                script_fu_load_script (child);
+
+              g_object_unref (child);
+            }
+
+          g_object_unref (info);
+        }
+
+      g_object_unref (enumerator);
+    }
+}
+
+static void
+script_fu_load_script (GFile *file)
+{
+  if (pika_file_has_extension (file, ".scm"))
+    {
+      gchar  *path    = g_file_get_path (file);
+      gchar  *escaped = script_fu_strescape (path);
+      gchar  *command;
+      GError *error   = NULL;
+
+      command = g_strdup_printf ("(load \"%s\")", escaped);
+      g_free (escaped);
+
+      if (! script_fu_run_command (command, &error))
+        {
+          gchar *message = g_strdup_printf (_("Error while loading %s:"),
+                                            pika_file_get_utf8_name (file));
+
+          g_message ("%s\n\n%s", message, error->message);
+
+          g_clear_error (&error);
+          g_free (message);
+        }
+
+#ifdef G_OS_WIN32
+      /* No, I don't know why, but this is
+       * necessary on NT 4.0.
+       */
+      Sleep (0);
+#endif
+
+      g_free (command);
+      g_free (path);
+    }
+}
+
+/* This is-a GTraverseFunction.
+ *
+ * Traverse.  For each, install TEMPORARY PDB proc.
+ * Returning FALSE means entire list was traversed.
+ */
+static gboolean
+script_fu_install_script (gpointer  foo G_GNUC_UNUSED,
+                          GList    *scripts,
+                          gpointer  data)
+{
+  PikaPlugIn *plug_in = data;
+  GList      *list;
+
+  for (list = scripts; list; list = g_list_next (list))
+    {
+      SFScript *script = list->data;
+
+      const gchar* name = script->name;
+      if (script_fu_is_defined (name))
+        script_fu_script_install_proc (plug_in, script);
+      else
+        g_warning ("Run function not defined, or does not match PDB procedure name: %s", name);
+    }
+
+  return FALSE;
+}
+
+static void
+script_fu_install_menu (SFMenu *menu)
+{
+  PikaPlugIn    *plug_in   = pika_get_plug_in ();
+  PikaProcedure *procedure = NULL;
+
+  procedure = pika_plug_in_get_temp_procedure (plug_in,
+                                               menu->script->name);
+
+  if (procedure)
+    pika_procedure_add_menu_path (procedure, menu->menu_path);
+
+  g_free (menu->menu_path);
+  g_slice_free (SFMenu, menu);
+}
+
+/*
+ *  The following function is a GTraverseFunction.
+ */
+static gboolean
+script_fu_remove_script (gpointer  foo G_GNUC_UNUSED,
+                         GList    *scripts,
+                         gpointer  data)
+{
+  PikaPlugIn *plug_in = data;
+  GList      *list;
+
+  for (list = scripts; list; list = g_list_next (list))
+    {
+      SFScript *script = list->data;
+
+      script_fu_script_uninstall_proc (plug_in, script);
+      script_fu_script_free (script);
+    }
+
+  g_list_free (scripts);
+
+  return FALSE;
+}
+
+
+
+/* this is a GTraverseFunction */
+static gboolean
+script_fu_lookup_script (gpointer      *foo G_GNUC_UNUSED,
+                         GList         *scripts,
+                         gconstpointer *name)
+{
+  GList *list;
+
+  for (list = scripts; list; list = g_list_next (list))
+    {
+      SFScript *script = list->data;
+
+      if (strcmp (script->name, *name) == 0)
+        {
+          /* store the script in the name pointer and stop the traversal */
+          *name = script;
+          return TRUE;
+        }
+    }
+
+  return FALSE;
+}
+
+SFScript *
+script_fu_find_script (const gchar *name)
+{
+  gconstpointer script = name;
+
+  g_tree_foreach (script_tree,
+                  (GTraverseFunc) script_fu_lookup_script,
+                  &script);
+
+  if (script == name)
+    return NULL;
+
+  return (SFScript *) script;
+}
+
+static gchar *
+script_fu_menu_map (const gchar *menu_path)
+{
+  /*  for backward compatibility, we fiddle with some menu paths  */
+  const struct
+  {
+    const gchar *old;
+    const gchar *new;
+  } mapping[] = {
+    { "<Image>/Script-Fu/Alchemy",       "<Image>/Filters/Artistic"            },
+    { "<Image>/Script-Fu/Alpha to Logo", "<Image>/Filters/Alpha to Logo"       },
+    { "<Image>/Script-Fu/Animators",     "<Image>/Filters/Animation" },
+    { "<Image>/Script-Fu/Decor",         "<Image>/Filters/Decor"               },
+    { "<Image>/Script-Fu/Render",        "<Image>/Filters/Render"              },
+    { "<Image>/Script-Fu/Selection",     "<Image>/Select/Modify"               },
+    { "<Image>/Script-Fu/Shadow",        "<Image>/Filters/Light and Shadow/[Shadow]" },
+    { "<Image>/Script-Fu/Stencil Ops",   "<Image>/Filters/Decor"               }
+  };
+
+  gint i;
+
+  for (i = 0; i < G_N_ELEMENTS (mapping); i++)
+    {
+      if (g_str_has_prefix (menu_path, mapping[i].old))
+        {
+          const gchar *suffix = menu_path + strlen (mapping[i].old);
+
+          if (*suffix != '/')
+            continue;
+
+          return g_strconcat (mapping[i].new, suffix, NULL);
+        }
+    }
+
+  return NULL;
+}
+
+static gint
+script_fu_menu_compare (gconstpointer a,
+                        gconstpointer b)
+{
+  const SFMenu *menu_a = a;
+  const SFMenu *menu_b = b;
+  gint          retval = 0;
+
+  if (menu_a->menu_path && menu_b->menu_path)
+    {
+      retval = g_utf8_collate (menu_a->menu_path,
+                               menu_b->menu_path);
+
+      if (retval == 0 &&
+          menu_a->script->menu_label && menu_b->script->menu_label)
+        {
+          retval = g_utf8_collate (menu_a->script->menu_label,
+                                   menu_b->script->menu_label);
+        }
+    }
+
+  return retval;
+}
+
+/* Is name a defined symbol in the interpreter state?
+ * (Defined in any script already loaded.)
+ * Where "symbol" has the usual lisp meaning: a unique name associated with
+ * a variable or function.
+ *
+ * The most common use is
+ * test the name of a PDB proc, which in ScriptFu must match
+ * a defined function that is the inner run function.
+ * I.E. check for typos by author of script.
+ * Used during query, to preflight so that we don't install a PDB proc
+ * that won't run later (during the run phase)
+ * giving "undefined symbol" for extension-script-fu.
+ * Note that if instead we create a PDB proc having no defined run func,
+ * script-fu-interpreter would load and define a same-named scheme function
+ * that calls the PDB, and can enter an infinite loop.
+ */
+gboolean
+script_fu_is_defined (const gchar * name)
+{
+  gchar   *scheme_text;
+  GError  *error = NULL;
+  gboolean result;
+
+  /* text to be interpreted is a call to an internal scheme function. */
+  scheme_text = g_strdup_printf (" (symbol? %s ) ",  name);
+
+  /* Use script_fu_run_command, it correctly handles the string yielded.
+   * But we don't need the string yielded.
+   * If defined, string yielded is "#t", else is "Undefined symbol" or "#f"
+   */
+  result = script_fu_run_command (scheme_text, &error);
+  if (!result)
+    {
+      g_debug ("script_fu_is_defined returns false");
+      /* error contains string yielded by interpretation. */
+      g_error_free (error);
+    }
+  return result;
+}
+
+
+/* Side effects on script. */
+static void
+script_fu_try_map_menu (SFScript *script)
+{
+  if (script->menu_label[0] == '<')
+    {
+      gchar *mapped = script_fu_menu_map (script->menu_label);
+
+      if (mapped)
+        {
+          g_free (script->menu_label);
+          script->menu_label = mapped;
+        }
+    }
+}
+
+/* Append to ordered tree.
+ * Side effects on script_tree.
+ */
+static void
+script_fu_append_script_to_tree (SFScript *script)
+{
+  GList *list = g_tree_lookup (script_tree, script->menu_label);
+
+  g_tree_insert (script_tree, (gpointer) script->menu_label,
+                  g_list_append (list, script));
+}

plug-ins/script-fu/libscriptfu/script-fu-scripts.h

@@ -0,0 +1,41 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#ifndef __SCRIPT_FU_SCRIPTS_H__
+#define __SCRIPT_FU_SCRIPTS_H__
+
+void      script_fu_find_scripts  (PikaPlugIn *plug_in,
+                                   GList      *path);
+pointer   script_fu_add_script        (scheme     *sc,
+                                       pointer     a);
+pointer   script_fu_add_script_filter (scheme     *sc,
+                                       pointer     a);
+pointer   script_fu_add_menu      (scheme     *sc,
+                                   pointer     a);
+
+GTree          * script_fu_find_scripts_into_tree (PikaPlugIn  *plug_in,
+                                                   GList       *path);
+SFScript       * script_fu_find_script            (const gchar *name);
+GList          * script_fu_get_menu_list          (void);
+
+gboolean         script_fu_is_defined             (const gchar          *name);
+
+#endif /*  __SCRIPT_FU_SCRIPTS__  */

plug-ins/script-fu/libscriptfu/script-fu-types.h

@@ -0,0 +1,109 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#ifndef __SCRIPT_FU_TYPES_H__
+#define __SCRIPT_FU_TYPES_H__
+
+
+#include "script-fu-enums.h"
+
+
+typedef struct
+{
+  gdouble           value;
+  gdouble           lower;
+  gdouble           upper;
+  gdouble           step;
+  gdouble           page;
+  gint              digits;
+  SFAdjustmentType  type;
+} SFAdjustment;
+
+typedef struct
+{
+  gchar  *filename;
+} SFFilename;
+
+typedef struct
+{
+  GSList *list;
+  gint    history;
+} SFOption;
+
+typedef struct
+{
+  gchar *type_name;
+  gint   history;
+} SFEnum;
+
+typedef union
+{
+  gint32         sfa_image;
+  gint32         sfa_drawable;
+  gint32         sfa_layer;
+  gint32         sfa_channel;
+  gint32         sfa_vectors;
+  gint32         sfa_display;
+  PikaRGB        sfa_color;
+  gint32         sfa_toggle;
+  gchar         *sfa_value;
+  SFAdjustment   sfa_adjustment;
+  SFFilename     sfa_file;
+  gchar         *sfa_font;
+  gchar         *sfa_gradient;
+  gchar         *sfa_palette;
+  gchar         *sfa_pattern;
+  gchar         *sfa_brush;
+  SFOption       sfa_option;
+  SFEnum         sfa_enum;
+} SFArgValue;
+
+typedef struct
+{
+  SFArgType   type;
+  gchar      *label;
+  SFArgValue  default_value;
+  SFArgValue  value;
+} SFArg;
+
+typedef struct
+{
+  gchar        *name;
+  gchar        *menu_label;
+  gchar        *blurb;
+  gchar        *author;
+  gchar        *copyright;
+  gchar        *date;
+  gchar        *image_types;
+
+  gint          n_args;
+  SFArg        *args;
+  SFDrawableArity drawable_arity;
+  GType           proc_class; /* PikaProcedure or PikaImageProcedure. */
+} SFScript;
+
+typedef struct
+{
+  SFScript *script;   /* script which defined this menu path and label */
+  gchar    *menu_path;
+} SFMenu;
+
+#endif /*  __SCRIPT_FU_TYPES__  */

plug-ins/script-fu/libscriptfu/script-fu-utils.c

@@ -0,0 +1,73 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * 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 <string.h>
+
+#include <glib.h>
+
+#include "script-fu-utils.h"
+
+
+/*
+ * Escapes the special characters '\b', '\f', '\n', '\r', '\t', '\' and '"'
+ * in the string source by inserting a '\' before them.
+ */
+gchar *
+script_fu_strescape (const gchar *source)
+{
+  const guchar *p;
+  gchar        *dest;
+  gchar        *q;
+
+  g_return_val_if_fail (source != NULL, NULL);
+
+  p = (const guchar *) source;
+
+  /* Each source byte needs maximally two destination chars */
+  q = dest = g_malloc (strlen (source) * 2 + 1);
+
+  while (*p)
+    {
+      switch (*p)
+        {
+        case '\b':
+        case '\f':
+        case '\n':
+        case '\r':
+        case '\t':
+        case '\\':
+        case '"':
+          *q++ = '\\';
+          /* fallthrough */
+        default:
+          *q++ = *p;
+          break;
+        }
+
+      p++;
+    }
+
+  *q = 0;
+
+  return dest;
+}

plug-ins/script-fu/libscriptfu/script-fu-utils.h

@@ -0,0 +1,29 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#ifndef __SCRIPT_FU_UTILS_H__
+#define __SCRIPT_FU_UTILS_H__
+
+
+gchar * script_fu_strescape (const gchar *source);
+
+
+#endif /*  __SCRIPT_FU_UTILS__  */

plug-ins/script-fu/libscriptfu/script-fu.def

@@ -0,0 +1,17 @@
+EXPORTS
+  script_fu_extension_is_busy
+  script_fu_find_and_register_scripts
+  script_fu_find_scripts_create_PDB_proc_plugin
+  script_fu_find_scripts_list_proc_names
+  script_fu_get_success_msg
+  script_fu_init_embedded_interpreter
+  script_fu_interpret_string
+  script_fu_print_welcome
+  script_fu_redirect_output_to_gstr
+  script_fu_redirect_output_to_stdout
+  script_fu_register_post_command_callback
+  script_fu_register_quit_callback
+  script_fu_run_read_eval_print_loop
+  script_fu_search_path
+  script_fu_set_print_flag
+  script_fu_set_run_mode

plug-ins/script-fu/libscriptfu/tinyscheme/BUILDING

@@ -0,0 +1,139 @@
+        Building TinyScheme
+        -------------------
+
+The included makefile includes logic for Linux, Solaris and Win32, and can
+readily serve as an example for other OSes, especially Unixes. There are
+a lot of compile-time flags in TinyScheme (preprocessor defines) that can trim
+unwanted features. See next section. 'make all' and 'make clean' function as
+expected.
+
+Autoconfing TinyScheme was once proposed, but the distribution would not be
+so small anymore. There are few platform dependencies in TinyScheme, and in
+general compiles out of the box.
+
+     Customizing
+     -----------
+
+     The following symbols are defined to default values in scheme.h.
+     Use the -D flag of cc to set to either 1 or 0.
+
+     STANDALONE
+     Define this to produce a standalone interpreter.
+
+     USE_MATH
+     Includes math routines.
+
+     USE_CHAR_CLASSIFIERS
+     Includes character classifier procedures.
+
+     USE_ASCII_NAMES
+     Enable extended character notation based on ASCII names.
+
+     USE_STRING_PORTS
+     Enables string ports.
+
+     USE_ERROR_HOOK
+     To force system errors through user-defined error handling.
+     (see "Error handling")
+
+     USE_TRACING
+     To enable use of TRACING.
+
+     USE_COLON_HOOK
+     Enable use of qualified identifiers. (see "Colon Qualifiers - Packages")
+     Defining this as 0 has the rather drastic consequence that any code using
+     packages will stop working, and will have to be modified. It should only
+     be used if you *absolutely* need to use '::' in identifiers.
+
+     USE_STRCASECMP
+     Defines stricmp as strcasecmp, for Unix.
+
+     STDIO_ADDS_CR
+     Informs TinyScheme that stdio translates "\n" to "\r\n". For DOS/Windows.
+
+     USE_DL
+     Enables dynamically loaded routines. If you define this symbol, you
+     should also include dynload.c in your compile.
+
+     USE_PLIST
+     Enables property lists (not Standard Scheme stuff). Off by default.
+     
+     USE_NO_FEATURES
+     Shortcut to disable USE_MATH, USE_CHAR_CLASSIFIERS, USE_ASCII_NAMES,
+     USE_STRING_PORTS, USE_ERROR_HOOK, USE_TRACING, USE_COLON_HOOK,
+     USE_DL.
+
+     USE_SCHEME_STACK
+     Enables 'cons' stack (the alternative is a faster calling scheme, which 
+     breaks continuations). Undefine it if you don't care about strict compatibility
+     but you do care about faster execution.
+
+
+     OS-X tip
+     --------
+     I don't have access to OS-X, but Brian Maher submitted the following tip:
+
+[1] Download and install fink (I installed fink in
+/usr/local/fink)
+[2] Install the 'dlcompat' package using fink as such:
+> fink install dlcompat
+[3] Make the following changes to the
+tinyscheme-1.32.tar.gz
+
+diff -r tinyscheme-1.32/dynload.c
+tinyscheme-1.32-new/dynload.c
+24c24
+< #define SUN_DL
+---
+> 
+Only in tinyscheme-1.32-new/: dynload.o
+Only in tinyscheme-1.32-new/: libtinyscheme.a Only in tinyscheme-1.32-new/: libtinyscheme.so diff -r tinyscheme-1.32/makefile tinyscheme-1.32-new/makefile
+33,34c33,43
+< LD = gcc
+< LDFLAGS = -shared
+---
+> #LD = gcc
+> #LDFLAGS = -shared
+> #DEBUG=-g -Wno-char-subscripts -O
+> #SYS_LIBS= -ldl
+> #PLATFORM_FEATURES= -DSUN_DL=1
+> 
+> # Mac OS X
+> CC = gcc
+> CFLAGS = -I/usr/local/fink/include
+> LD = gcc
+> LDFLAGS = -L/usr/local/fink/lib
+37c46
+< PLATFORM_FEATURES= -DSUN_DL=1
+---
+> PLATFORM_FEATURES= -DSUN_DL=1 -DOSX
+60c69
+<       $(CC) -I. -c $(DEBUG) $(FEATURES)
+$(DL_FLAGS) $<
+---
+>       $(CC) $(CFLAGS) -I. -c $(DEBUG)
+$(FEATURES) $(DL_FLAGS) $<
+66c75
+<       $(CC) -o $@ $(DEBUG) $(OBJS) $(SYS_LIBS) 
+---
+>       $(CC) $(LDFLAGS) -o $@ $(DEBUG) $(OBJS)
+$(SYS_LIBS)
+Only in tinyscheme-1.32-new/: scheme
+diff -r tinyscheme-1.32/scheme.c
+tinyscheme-1.32-new/scheme.c
+60,61c60,61
+< #ifndef macintosh
+< # include <malloc.h>
+---
+> #ifdef OSX
+> /* Do nothing */
+62a63,65
+> # ifndef macintosh
+> #  include <malloc.h>
+> # else
+77c80,81
+< #endif /* macintosh */
+---
+> # endif /* macintosh */
+> #endif /* !OSX */
+Only in tinyscheme-1.32-new/: scheme.o

plug-ins/script-fu/libscriptfu/tinyscheme/CHANGES

@@ -0,0 +1,341 @@
+Change Log
+----------
+
+Version 1.42
+    Other changes:
+        - Fixed segfault crash caused by invalid syntax to cond  (PG)
+        - Fixed a bug in the close-port routine in init.scm
+        - Fixed possible crash loading file due to uninitialized variable  (MP)
+        - Don't use snprintf() in atom2str to return some fixed strings  (KC/MP)
+        - Added "tinyscheme" to the features list  (JaW)
+        - Added Sconstruct to allow building using scons  (AG)
+        - Fixed function prototype for scheme_init_new  (JuW)
+        - Make various limits configurable  (JuW)
+
+    Contributors:
+        Kevin Cozens, Mauro Persano, Pedro Gimeno, James Woodcock, Atanu Ghosh,
+        and Justus Winter.
+
+Version 1.41
+    Bugs fixed:
+        #3020389 - Added makefile section for Mac OS X  (SL)
+        #3286135 - Fixed num_mod routine which caused errors in use of modulo
+        #3290232 - Corrected version number shown on startup  (GM)
+        #3394882 - Added missing #if in opdefines.h around get and put  (DC)
+        #3395547 - Fix for the modulo procedure  (DC)
+        #3400290 - Optimized append to make it an O(n) operation  (DC)
+        #3493926 - Corrected flag used when building shared files on OSX  (J)
+
+    R5RS related changes:
+        #2866196 - Parser does not handle delimiters correctly
+        #3395548 - Add a decimal point to inexact numbers in atom2str  (DC)
+        #3399331 - Make min/max return inexact when any argument is inexact
+        #3399332 - Compatibility fix for expt.
+        #3399335 - Optional radix for string->number and number->string  (DC)
+        #3400202 - Append with one argument should not return a list  (DC)
+        #3400284 - Compatibility fix for integer?
+
+    Other changes:
+        - Added flags to makefile for MinGW/MSYS (TC)
+        - Moved variable declarations to avoid warnings with some compilers
+        - Don't print space after initial #( when printing vectors.
+        - Minor optimization for is_nonneg().
+        - No need to round integers in OP_ROUND (#3400284)
+        - Fixes to code that reports line number with error  (RC)
+
+    Contributors:
+        Kevin Cozens, Gordon McNutt, Doug Currie, Sean Long, Tim Cas, Joey,
+        Richard Copley, and CMarinier.
+
+Version 1.40
+    Bugs fixed:
+        #1964950 - Stop core dumps due to bad syntax in LET (and variants)
+        #2826594 - allow reverse to work on empty list (Tony Garnock-Jones)
+        Potential problem of arglist to foreign calls being wrongly GC'ed.
+        Fixed bug that read could loop forever (tehom).
+
+    API changes:
+        Exposed is_list and list_length.
+        Added scheme_register_foreign_func_list and declarations for it (tehom)
+        Defined *compile-hook* (tehom)
+
+    Other changes:
+        Updated is_list and list_length to handle circular lists.
+        Nested calling thru C has been made now safer (tehom)
+        Peter Michaux cleaned up port_rep_from_file
+        Added unwind-protect (tehom)
+        Some cleanups to in/outport and Eval_Cycle by Peter Michaux
+        Report error line number (Mostly by Sanel Zukan, back-compatibility by Tehom)
+
+    Contributors:
+        Kevin Cozens, Dimitrios Souflis, Tom Breton, Peter Michaux, Sanel Zukan,
+        and Tony Garnock-Jones.
+
+Version 1.39
+    Bugs fixed:
+        Fix for the load bug
+        Fixed parsing of octal coded characters. Fixes bug #1818018.
+        Added tests for when mk_vector is out of memory. Can't rely on sc->sink.
+        Fix for bug #1794369
+        Finished feature-request 1599947: scheme_apply0 etc return values.
+        Partly provided feature-request 1599947: Expose list_length, eqv, etc
+        Provided feature-request 1599945, Scheme->C->Scheme calling.
+        Fix for bug 1593861 (behavior of is_integer)
+        Fix for bug 1589711
+        Error checking of binding spec syntax in LET and LETREC. The bad syntax
+        was causing a segmentation fault in Linux. Complete fixes for bug #1817986.
+        Error checking of binding spec syntax in LET*
+        Bad syntax was causing core dump in Linux.
+        Fix for nasty gc bug
+
+    R5RS changes:
+        R5RS requires numbers to be of equal value AND of the same type (ie. both
+        exact or inexact) in order to return #t from eqv?. R5RS compliance fix.
+        String output ports now conform to SRFI-6
+
+    Other changes:
+        Drew Yao fixed buffer overflow problems in mk_sharp_const.
+        put OP_T0LVL in charge of reacting to EOF
+        file_push checks array bounds (patch from Ray Lehtiniemi)
+        Changed to always use snprintf (Patch due to Ramiro bsd1628)
+        Updated usage information using text from the Manual.txt file.
+
+Version 1.38
+    Interim release until the rewrite, mostly incorporating modifications
+    from Kevin Cozens. Small addition for Cygwin in the makefile, and
+    modifications by Andrew Guenther for Apple platforms.
+
+Version 1.37
+    Joe Buehler submitted reserve_cells.
+
+Version 1.36
+    Joe Buehler fixed a patch in the allocator.
+    Alexander Shendi moved the comment handling in the scanner, which
+    fixed an obscure bug for which Mike E had provided a patch as well.
+    Kevin Cozens has submitted some fixes and modifications which have
+    not been incorporated yet in their entirety.
+
+Version 1.35
+    Todd Showalter discovered that the number of free cells reported
+    after GC was incorrect, which could also cause unnecessary allocations.
+
+Version 1.34
+    Long missing version. Lots of bugfixes have accumulated in my email, so
+    I had to start using them. In this version, Keenan Pepper has submitted
+    a bugfix for the string comparison library procedure, Wouter Boeke
+    modified some code that was casting to the wrong type and crashed on
+    some machines, "SheppardCo" submitted a replacement "modulo" code and
+    Scott Fenton submitted lots of corrections that shut up some compiler
+    warnings. Brian Maher submitted instructions on how to build on OS-X.
+    I have to dig deeper into my mailbox and find earlier emails, too.
+
+Version 1.33
+    Charles Hayden fixed a nasty GC bug of the new stack frame, while in
+    the process of porting TinyScheme to C++. He also submitted other
+    changes, and other people also had comments or requests, but the GC
+    bug was so important that this version is put through the door to
+    correct it.
+
+Version 1.32
+    Stephen Gildea put some quality time on TinyScheme again, and made
+    a whole lot of changes to the interpreter that made it noticeably
+    faster.
+
+Version 1.31
+    Patches to the hastily-done version 1.30. Stephen Gildea fixed
+    some things done wrongly, and Richard Russo fixed the makefile
+    for building on Windows. Property lists (heritage from MiniScheme)
+    are now optional and have disappeared from the interface. They
+    should be considered as deprecated.
+
+Version 1.30
+    After many months, I followed Preston Bannister's advice of
+    using macros and a single source text to keep the enums and the
+    dispatch table in sync, and I used his contributed "opdefines.h".
+    Timothy Downs contributed a helpful function, "scheme_call".
+    Stephen Gildea contributed new versions of the makefile and
+    practically all other sources. He created a built-in STRING-APPEND,
+    and fixed a lot of other bugs.
+    Ruhi Bloodworth reported fixes necessary for OS X and a small
+    bug in dynload.c.
+
+Version 1.29
+    The previous version contained a lot of corrections, but there
+    were a lot more that still wait on a sheet of paper lost in a
+    carton someplace after my house move... Manuel Heras-Gilsanz
+    noticed this and resent his own contribution, which relies on
+    another bugfix that v.1.28 was missing: a problem with string
+    output, that this version fixes. I hope other people will take
+    the time to resend their contributions, if they didn't make it
+    to v.1.28.
+
+Version 1.28
+    Many people have contacted me with bugfixes or remarks in
+    the three months I was inactive. A lot of them spotted that
+    scheme_deinit crashed while reporting gc results. They suggested
+    that sc->outport be set to NIL in scheme_deinit, which I did.
+    Dennis Taylor remarked that OP_VALUEPRINT reset sc->value instead
+    of preserving it. He submitted a modification which I adopted
+    partially. David Hovemeyer sent me many little changes, that you
+    will find in version 1.28, and Patrice Stoessel modified the
+    float reader to conform to R5RS.
+
+Version 1.27
+    Version 1.27 is the successor of 1.25. Bug fixes only, but I had to
+    release them so that everybody can profit. 'Backchar' tried to write
+    back to the string, which obviously didn't work for const strings.
+    'Substring' didn't check for crossed start and end indices. Defines
+    changed to restore the ability to compile under MSVC.
+
+Version 1.26
+    Version 1.26 was never released. I changed a lot of things, in fact
+    too much, even the garbage collector, and hell broke loose. I'll
+    try a more gradual approach next time.
+
+Version 1.25
+    Types have been homogenized to be able to accommodate a different
+    representation. Plus, promises are no longer closures. Unfortunately,
+    I discovered that continuations and force/delay do not pass the SCM
+    test (and never did)... However, on the bright side, what little
+    modifications I did had a large impact on the footprint:
+    USE_NO_FEATURES now produces an object file of 63960 bytes on Linux!
+
+Version 1.24
+    SCM tests now pass again after change in atom2str.
+
+Version 1.23
+    Finally I managed to mess it up with my version control. Version
+    1.22 actually lacked some of the things I have been fixing in the
+    meantime. This should be considered as a complete replacement for
+    1.22.
+
+Version 1.22
+    The new ports had a bug in LOAD. MK_CLOSURE is introduced.
+    Shawn Wagner inquired about string->number and number->string.
+    I added string->atom and atom->string and defined the number
+    functions from them. Doing that, I fixed WRITE applied to symbols
+    (it didn't quote them). Unfortunately, minimum build is now
+    slightly larger than 64k... I postpone action because Jason's idea
+    might solve it elegantly.
+
+Version 1.21
+    Jason Felice submitted a radically different datatype representation
+    which he had implemented. While discussing its pros and cons, it
+    became apparent that the current implementation of ports suffered
+    from a grave fault: ports were not garbage-collected. I changed the
+    ports to be heap-allocated, which enabled the use of string ports
+    for loading. Jason also fixed errors in the garbage collection of
+    vectors. USE_VERBATIM is gone. "ssp_compiler.c" has a better solution
+    on HTML generation. A bug involving backslash notation in strings
+    has been fixed. '-c' flag now executes next argument as a stream of
+    Scheme commands. Foreign functions are now also heap allocated,
+    and scheme_define is used to define everything.
+
+Version 1.20
+    Tracing has been added. The toplevel loop has been slightly
+    rearranged. Backquote reading for vector templates has been
+    sanitized. Symbol interning is now correct. Arithmetic functions
+    have been corrected. APPLY, MAP, FOR-EACH, numeric comparison
+    functions fixed. String reader/writer understands \xAA notation.
+
+Version 1.19
+    Carriage Return now delimits identifiers. DOS-formatted Scheme files
+    can be used by Unix. Random number generator added to library.
+    Fixed some glitches of the new type-checking scheme. Fixed erroneous
+    (append '() 'a) behavior. Will continue with r4rstest.scm to
+    fix errors.
+
+Version 1.18
+    The FFI has been extended. USE_VERBOSE_GC has gone. Anyone wanting
+    the same functionality can put (gcverbose #t) in init.scm.
+    print-width was removed, along with three corresponding op-codes.
+    Extended character constants with ASCII names were added.
+    mk_counted_string paves the way for full support of binary strings.
+    As much as possible of the type-checking chores were delegated
+    to the inner loop, thus reducing the code size to less than 4200 loc!
+
+Version 1.17
+    Dynamically-loaded extensions are more fully integrated.
+    TinyScheme is now distributed under the BSD open-source license.
+
+Version 1.16
+    Dynamically-loaded extensions introduced (USE_DL).
+    Santeri Paavolainen found a race condition: When a cons is executed,
+    and each of the two arguments is a constructing function,  GC could
+    happen before all arguments are evaluated and cons() is called, and
+    the evaluated arguments would all be reclaimed!
+    Fortunately, such a case was rare in the code, although it is
+    a pitfall in new code and code in foreign functions. Currently, only
+    one such case remains, when COLON_HOOK is defined.
+
+Version 1.15
+    David Gould also contributed some changes that speed up operation.
+    Kirk Zurell fixed HASPROP.
+    The Garbage Collection didn't collect all the garbage...fixed.
+
+Version 1.14
+    Unfortunately, after Andre fixed the GC it became obvious that the
+    algorithm was too slow... Fortunately, David Gould found a way to
+    speed it up.
+
+Version 1.13
+    Silly bug involving division by zero resolved by Roland Kaufman.
+    Macintoch support from Shmulik Regev.
+    Float parser bug fixed by Alexander Shendi.
+    GC bug from Andru Luvisi.
+
+Version 1.12
+    Cis* incorrectly called isalpha() instead of isascii()
+    Added USE_CHAR_CLASSIFIERS, USE_STRING_PORTS.
+
+Version 1.11
+    BSDI defines isnumber... changed all similar functions to is_*
+    EXPT now has correct definition. Added FLOOR,CEILING,TRUNCATE
+    and ROUND, courtesy of Bengt Kleberg. Preprocessor symbols now
+    have values 1 or 0, and can be set as compiler defines (proposed
+    by Andy Ganor *months* ago). 'prompt' and 'InitFile' can now be
+    defined during compilation, too.
+
+Version 1.10
+    Another bug when file ends with comment!
+    Added DEFINE-MACRO in init.scm, courtesy of Andy Gaynor.
+
+Version 1.09
+    Removed bug when READ met EOF. lcm.
+
+Version 1.08
+    quotient,remainder and modulo. gcd.
+
+Version 1.07
+    '=>' in cond now exists
+    list? now checks for circularity
+    some reader bugs removed
+    Reader is more consistent wrt vectors
+    Quote and Quasiquote work with vectors
+
+Version 1.06
+    #! is now skipped
+    generic-assoc bug removed
+    strings are now managed differently, hack.txt is removed
+    various delicate points fixed
+
+Version 1.05
+    Support for scripts, *args*, "-1" option.
+    Various R5RS procedures.
+    *sharp-hook*
+    Handles unmatched parentheses.
+    New architecture for procedures.
+
+Version 1.04
+    Added missing T_ATOM bits...
+    Added vectors
+    Free-list is sorted by address, since vectors need consecutive cells.
+    (quit <exitcode>) for use with scripts
+
+Version 1.03 (26 Aug 1998):
+    Extended .h with useful functions for FFI
+    Library: with-input-* etc.
+    Finished R5RS I/O, added string ports.
+
+Version 1.02 (25 Aug 1998):
+    First part of R5RS I/O.

plug-ins/script-fu/libscriptfu/tinyscheme/COPYING

@@ -0,0 +1,31 @@
+                         LICENSE TERMS
+
+Copyright (c) 2000, Dimitrios Souflis
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+
+Redistributions in binary form must reproduce the above copyright
+notice, this list of conditions and the following disclaimer in the
+documentation and/or other materials provided with the distribution.
+
+Neither the name of Dimitrios Souflis nor the names of the
+contributors may be used to endorse or promote products derived from
+this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR 
+CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 
+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 
+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 
+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 
+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

plug-ins/script-fu/libscriptfu/tinyscheme/Manual.txt

@@ -0,0 +1,452 @@
+
+
+                       TinySCHEME Version 1.41
+
+                    "Safe if used as prescribed"
+                    -- Philip K. Dick, "Ubik"
+
+This software is open source, covered by a BSD-style license.
+Please read accompanying file COPYING.
+-------------------------------------------------------------------------------
+
+     This Scheme interpreter is based on MiniSCHEME version 0.85k4
+     (see miniscm.tar.gz in the Scheme Repository)
+     Original credits in file MiniSCHEMETribute.txt.
+
+     D. Souflis (dsouflis@acm.org)
+
+-------------------------------------------------------------------------------
+     What is TinyScheme?
+     -------------------
+
+     TinyScheme is a lightweight Scheme interpreter that implements as large
+     a subset of R5RS as was possible without getting very large and
+     complicated. It is meant to be used as an embedded scripting interpreter
+     for other programs. As such, it does not offer IDEs or extensive toolkits
+     although it does sport a small top-level loop, included conditionally.
+     A lot of functionality in TinyScheme is included conditionally, to allow
+     developers freedom in balancing features and footprint.
+
+     As an embedded interpreter, it allows multiple interpreter states to
+     coexist in the same program, without any interference between them.
+     Programmatically, foreign functions in C can be added and values
+     can be defined in the Scheme environment. Being a quite small program,
+     it is easy to comprehend, get to grips with, and use.
+
+     Known bugs
+     ----------
+
+     TinyScheme is known to misbehave when memory is exhausted.
+
+
+     Things that keep missing, or that need fixing
+     ---------------------------------------------
+
+     There are no hygienic macros. No rational or
+     complex numbers. No unwind-protect and call-with-values.
+
+     Maybe (a subset of) SLIB will work with TinySCHEME...
+
+     Decent debugging facilities are missing. Only tracing is supported
+     natively.
+
+
+     Scheme Reference
+     ----------------
+
+     If something seems to be missing, please refer to the code and
+     "init.scm", since some are library functions.  Refer to the MiniSCHEME
+     readme as a last resort.
+
+          Environments
+     (interaction-environment)
+     See R5RS. In TinySCHEME, immutable list of association lists.
+
+     (current-environment)
+     The environment in effect at the time of the call. An example of its
+     use and its utility can be found in the sample code that implements
+     packages in "init.scm":
+
+          (macro (package form)
+               `(apply (lambda ()
+                         ,@(cdr form)
+                         (current-environment))))
+
+     The environment containing the (local) definitions inside the closure
+     is returned as an immutable value.
+
+     (defined? <symbol>) (defined? <symbol> <environment>)
+     Checks whether the given symbol is defined in the current (or given)
+     environment.
+
+          Symbols
+     (gensym)
+     Returns a new interned symbol each time. Will probably move to the
+     library when string->symbol is implemented.
+
+          Directives
+     (gc)
+     Performs garbage collection immediately.
+
+     (gcverbose) (gcverbose <bool>)
+     The argument (defaulting to #t) controls whether GC produces
+     visible outcome.
+
+     (quit) (quit <num>)
+     Stops the interpreter and sets the 'retcode' internal field (defaults
+     to 0). When standalone, 'retcode' is returned as exit code to the OS.
+
+     (tracing <num>)
+     1, turns on tracing. 0 turns it off. (Only when USE_TRACING is 1).
+
+          Mathematical functions
+     Since rationals and complexes are absent, the respective functions
+     are also missing.
+     Supported: exp, log, sin, cos, tan, asin, acos, atan, floor, ceiling,
+     trunc, round and also sqrt and expt when USE_MATH=1.
+     Number-theoretical quotient, remainder and modulo, gcd, lcm.
+     Library: exact?, inexact?, odd?, even?, zero?, positive?, negative?,
+     exact->inexact. inexact->exact is a core function.
+
+          Type predicates
+     boolean?,eof-object?,symbol?,number?,string?,integer?,real?,list?,null?,
+     char?,port?,input-port?,output-port?,procedure?,pair?,environment?',
+     vector?. Also closure?, macro?.
+
+          Types
+     Types supported:
+
+          Numbers (integers and reals)
+          Symbols
+          Pairs
+          Strings
+          Characters
+          Ports
+          Eof object
+          Environments
+          Vectors
+
+          Literals
+     String literals can contain escaped quotes \" as usual, but also
+     \n, \r, \t, \xDD (hex representations) and \DDD (octal representations).
+     Note also that it is possible to include literal newlines in string
+     literals, e.g.
+
+          (define s "String with newline here
+          and here
+          that can function like a HERE-string")
+
+     Character literals contain #\space and #\newline and are supplemented
+     with #\return and #\tab, with obvious meanings. Hex character
+     representations are allowed (e.g. #\x20 is #\space).
+     When USE_ASCII_NAMES is defined, various control characters can be
+     referred to by their ASCII name.
+     0	     #\nul	       17       #\dc1
+     1	     #\soh             18       #\dc2
+     2	     #\stx             19       #\dc3
+     3	     #\etx             20       #\dc4
+     4	     #\eot             21       #\nak
+     5	     #\enq             22       #\syn
+     6	     #\ack             23       #\etv
+     7	     #\bel             24       #\can
+     8	     #\bs              25       #\em
+     9	     #\ht              26       #\sub
+     10	     #\lf              27       #\esc
+     11	     #\vt              28       #\fs
+     12	     #\ff              29       #\gs
+     13	     #\cr              30       #\rs
+     14	     #\so              31       #\us
+     15	     #\si
+     16	     #\dle             127      #\del 		
+
+     Numeric literals support #x #o #b and #d. Flonums are currently read only
+     in decimal notation. Full grammar will be supported soon.
+
+          Quote, quasiquote etc.
+     As usual.
+
+          Immutable values
+     Immutable pairs cannot be modified by set-car! and set-cdr!.
+     Immutable strings cannot be modified via string-set!
+
+          I/O
+     As per R5RS, plus String Ports (see below).
+     current-input-port, current-output-port,
+     close-input-port, close-output-port, input-port?, output-port?,
+     open-input-file, open-output-file.
+     read, write, display, newline, write-char, read-char, peek-char.
+     char-ready? returns #t only for string ports, because there is no
+     portable way in stdio to determine if a character is available.
+     Also open-input-output-file, set-input-port, set-output-port (not R5RS)
+     Library: call-with-input-file, call-with-output-file,
+     with-input-from-file, with-output-from-file and
+     with-input-output-from-to-files, close-port and input-output-port?
+     (not R5RS).
+     String Ports: open-input-string, open-output-string, get-output-string,
+     open-input-output-string. Strings can be used with I/O routines.
+
+          Vectors
+     make-vector, vector, vector-length, vector-ref, vector-set!, list->vector,
+     vector-fill!, vector->list, vector-equal? (auxiliary function, not R5RS)
+
+          Strings
+     string, make-string, list->string, string-length, string-ref, string-set!,
+     substring, string->list, string-fill!, string-append, string-copy.
+     string=?, string<?, string>?, string>?, string<=?, string>=?.
+     (No string-ci*? yet). string->number, number->string. Also atom->string,
+     string->atom (not R5RS).
+
+          Symbols
+     symbol->string, string->symbol
+
+          Characters
+     integer->char, char->integer.
+     char=?, char<?, char>?, char<=?, char>=?.
+     (No char-ci*?)
+
+          Pairs & Lists
+     cons, car, cdr, list, length, map, for-each, foldr, list-tail,
+     list-ref, last-pair, reverse, append.
+     Also member, memq, memv, based on generic-member, assoc, assq, assv
+     based on generic-assoc.
+
+          Streams
+     head, tail, cons-stream
+
+          Control features
+     Apart from procedure?, also macro? and closure?
+     map, for-each, force, delay, call-with-current-continuation (or call/cc),
+     eval, apply. 'Forcing' a value that is not a promise produces the value.
+     There is no call-with-values, values, nor dynamic-wind. Dynamic-wind in
+     the presence of continuations would require support from the abstract
+     machine itself.
+
+          Property lists
+     TinyScheme inherited from MiniScheme property lists for symbols.
+     put, get.
+
+          Dynamically-loaded extensions
+     (load-extension <filename without extension>)
+     Loads a DLL declaring foreign procedures. On Unix/Linux, one can make use
+     of the ld.so.conf file or the LD_RUN_PATH system variable in order to place
+     the library in a directory other than the current one. Please refer to the
+     appropriate 'man' page.
+
+          Esoteric procedures
+     (oblist)
+     Returns the oblist, an immutable list of all the symbols.
+
+     (macro-expand <form>)
+     Returns the expanded form of the macro call denoted by the argument
+
+     (define-with-return (<procname> <args>...) <body>)
+     Like plain 'define', but makes the continuation available as 'return'
+     inside the procedure. Handy for imperative programs.
+
+     (new-segment <num>)
+     Allocates more memory segments.
+
+     defined?
+     See "Environments"
+
+     (get-closure-code <closure>)
+     Gets the code as scheme data.
+
+     (make-closure <code> <environment>)
+     Makes a new closure in the given environment.
+
+          Obsolete procedures
+     (print-width <object>)
+
+     Programmer's Reference
+     ----------------------
+
+     The interpreter state is initialized with "scheme_init".
+     Custom memory allocation routines can be installed with an alternate
+     initialization function: "scheme_init_custom_alloc".
+     Files can be loaded with "scheme_load_file". Strings containing Scheme
+     code can be loaded with "scheme_load_string". It is a good idea to
+     "scheme_load" init.scm before anything else.
+
+     External data for keeping external state (of use to foreign functions)
+     can be installed with "scheme_set_external_data".
+     Foreign functions are installed with "assign_foreign". Additional
+     definitions can be added to the interpreter state, with "scheme_define"
+     (this is the way HTTP header data and HTML form data are passed to the
+     Scheme script in the Altera SQL Server). If you wish to define the
+     foreign function in a specific environment (to enhance modularity),
+     use "assign_foreign_env".
+
+     The procedure "scheme_apply0" has been added with persistent scripts in
+     mind. Persistent scripts are loaded once, and every time they are needed
+     to produce HTTP output, appropriate data are passed through global
+     definitions and function "main" is called to do the job. One could
+     add easily "scheme_apply1" etc.
+
+     The interpreter state should be deinitialized with "scheme_deinit".
+
+     DLLs containing foreign functions should define a function named
+     init_<base-name>. E.g. foo.dll should define init_foo, and bar.so
+     should define init_bar. This function should assign_foreign any foreign
+     function contained in the DLL.
+
+     The first dynamically loaded extension available for TinyScheme is
+     a regular expression library. Although it's by no means an
+     established standard, this library is supposed to be installed in
+     a directory mirroring its name under the TinyScheme location.
+
+
+     Foreign Functions
+     -----------------
+
+     The user can add foreign functions in C. For example, a function
+     that squares its argument:
+
+          pointer square(scheme *sc, pointer args) {
+           if(args!=sc->NIL) {
+               if(sc->isnumber(sc->pair_car(args))) {
+                    double v=sc->rvalue(sc->pair_car(args));
+                    return sc->mk_real(sc,v*v);
+               }
+           }
+           return sc->NIL;
+          }
+
+   Foreign functions are now defined as closures:
+
+   sc->interface->scheme_define(
+        sc,
+        sc->global_env,
+        sc->interface->mk_symbol(sc,"square"),
+        sc->interface->mk_foreign_func(sc, square));
+
+
+     Foreign functions can use the external data in the "scheme" struct
+     to implement any kind of external state.
+
+     External data are set with the following function:
+          void scheme_set_external_data(scheme *sc, void *p);
+
+     As of v.1.17, the canonical way for a foreign function in a DLL to
+     manipulate Scheme data is using the function pointers in sc->interface.
+
+     Standalone
+     ----------
+
+     Usage: tinyscheme -?
+     or:    tinyscheme [<file1> <file2> ...]
+     followed by
+	       -1 <file> [<arg1> <arg2> ...]
+	       -c <Scheme commands> [<arg1> <arg2> ...]
+     assuming that the executable is named tinyscheme.
+
+     Use - in the place of a filename to denote stdin.
+     The -1 flag is meant for #! usage in shell scripts. If you specify
+          #! /somewhere/tinyscheme -1
+     then tinyscheme will be called to process the file. For example, the
+     following script echoes the Scheme list of its arguments.
+
+	       #! /somewhere/tinyscheme -1
+	       (display *args*)
+
+     The -c flag permits execution of arbitrary Scheme code.
+
+
+     Error Handling
+     --------------
+
+     Errors are recovered from without damage. The user can install their
+     own handler for system errors, by defining *error-hook*. Defining
+     to '() gives the default behavior, which is equivalent to "error".
+     USE_ERROR_HOOK must be defined.
+
+     A simple exception handling mechanism can be found in "init.scm".
+     A new syntactic form is introduced:
+
+          (catch <expr returned exceptionally>
+               <expr1> <expr2> ... <exprN>)
+
+     "Catch" establishes a scope spanning multiple call-frames
+     until another "catch" is encountered.
+
+     Exceptions are thrown with:
+
+          (throw "message")
+
+     If used outside a (catch ...), reverts to (error "message").
+
+     Example of use:
+
+          (define (foo x) (write x) (newline) (/ x 0))
+
+          (catch (begin (display "Error!\n") 0)
+               (write "Before foo ... ")
+               (foo 5)
+               (write "After foo"))
+
+     The exception mechanism can be used even by system errors, by
+
+          (define *error-hook* throw)
+
+     which makes use of the error hook described above.
+
+     If necessary, the user can devise their own exception mechanism with
+     tagged exceptions etc.
+
+
+     Reader extensions
+     -----------------
+
+     When encountering an unknown character after '#', the user-specified
+     procedure *sharp-hook* (if any), is called to read the expression.
+     This can be used to extend the reader to handle user-defined constants
+     or whatever. It should be a procedure without arguments, reading from
+     the current input port (which will be the load-port).
+
+
+     Colon Qualifiers - Packages
+     ---------------------------
+
+     When USE_COLON_HOOK=1:
+     The lexer now recognizes the construction <qualifier>::<symbol> and
+     transforms it in the following manner (T is the transformation function):
+
+          T(<qualifier>::<symbol>) = (*colon-hook* 'T(<symbol>) <qualifier>)
+
+     where <qualifier> is a symbol not containing any double-colons.
+
+     As the definition is recursive, qualifiers can be nested.
+     The user can define their own *colon-hook*, to handle qualified names.
+     By default, "init.scm" defines *colon-hook* as EVAL. Consequently,
+     the qualifier must denote a Scheme environment, such as one returned
+     by (interaction-environment). "Init.scm" defines a new syntantic form,
+     PACKAGE, as a simple example. It is used like this:
+
+          (define toto
+               (package
+                    (define foo 1)
+                    (define bar +)))
+
+          foo                                     ==>  Error, "foo" undefined
+          (eval 'foo)                             ==>  Error, "foo" undefined
+          (eval 'foo toto)                        ==>  1
+          toto::foo                               ==>  1
+          ((eval 'bar toto) 2 (eval 'foo toto))   ==>  3
+          (toto::bar 2 toto::foo)                 ==>  3
+          (eval (bar 2 foo) toto)                 ==>  3
+
+     If the user installs another package infrastructure, he must define
+     a new 'package' procedure or macro to retain compatibility with supplied
+     code.
+
+     Note: Older versions used ':' as a qualifier. Unfortunately, the use
+     of ':' as a pseudo-qualifier in existing code (i.e. SLIB) essentially
+     precludes its use as a real qualifier.
+
+
+
+
+
+
+
+

plug-ins/script-fu/libscriptfu/tinyscheme/MiniSCHEMETribute.txt

@@ -0,0 +1,88 @@
+     TinyScheme would not exist if it wasn't for MiniScheme. I had just
+     written the HTTP server for Ovrimos SQL Server, and I was lamenting the
+     lack of a scripting language. Server-side Javascript would have been the
+     preferred solution, had there been a Javascript interpreter I could
+     lay my hands on. But there weren't. Perl would have been another solution,
+     but it was probably ten times bigger that the program it was supposed to
+     be embedded in. There would also be thorny licencing issues. 
+     
+     So, the obvious thing to do was find a truly small interpreter. Forth
+     was a language I had once quasi-implemented, but the difficulty of
+     handling dynamic data and the weirdness of the language put me off. I then
+     looked around for a LISP interpreter, the next thing I knew was easy to
+     implement. Alas, the LeLisp I knew from my days in UPMC (Universite Pierre
+     et Marie Curie) had given way to Common Lisp, a megalith of a language!
+     Then my search lead me to Scheme, a language I knew was very orthogonal
+     and clean. When I found Mini-Scheme, a single C file of some 2400 loc, I 
+     fell in love with it! What if it lacked floating-point numbers and 
+     strings! The rest, as they say, is history.
+     
+     Below  are the original credits. Don't email Akira KIDA, the address has
+     changed.
+     
+     ---------- Mini-Scheme Interpreter Version 0.85 ----------
+
+                coded by Atsushi Moriwaki (11/5/1989)
+
+            E-MAIL :  moriwaki@kurims.kurims.kyoto-u.ac.jp
+
+               THIS SOFTWARE IS IN THE PUBLIC DOMAIN
+               ------------------------------------
+ This software is completely free to copy, modify and/or re-distribute.
+ But I would appreciate it if you left my name on the code as the author.
+
+  This version has been modified by R.C. Secrist.
+
+  Mini-Scheme is now maintained by Akira KIDA.
+
+  This is a revised and modified version by Akira KIDA.
+   current version is 0.85k4 (15 May 1994)
+
+  Please send suggestions, bug reports and/or requests to:
+        <SDI00379@niftyserve.or.jp>
+
+
+     Features compared to MiniSCHEME
+     -------------------------------
+
+     All code is now reentrant. Interpreter state is held in a 'scheme'
+     struct, and many interpreters can coexist in the same program, possibly
+     in different threads. The user can specify user-defined memory allocation
+     primitives. (see "Programmer's Reference")
+
+     The reader is more consistent.
+
+     Strings, characters and flonums are supported. (see "Types")
+
+     Files being loaded can be nested up to some depth.
+
+     R5RS I/O is there, plus String Ports. (see "Scheme Reference","I/O")
+
+     Vectors exist.
+
+     As a standalone application, it supports command-line arguments.
+     (see "Standalone")
+
+     Running out of memory is now handled.
+
+     The user can add foreign functions in C. (see "Foreign Functions")
+
+     The code has been changed slightly, core functions have been moved
+     to the library, behavior has been aligned with R5RS etc.
+
+     Support has been added for user-defined error recovery.
+     (see "Error Handling")
+
+     Support has been added for modular programming.
+     (see "Colon Qualifiers - Packages")
+
+     To enable this, EVAL has changed internally, and can
+     now take two arguments, as per R5RS. Environments are supported.
+     (see "Colon Qualifiers - Packages")
+
+     Promises are now evaluated once only.
+
+     (macro (foo form) ...) is now equivalent to (macro foo (lambda(form) ...))
+
+     The reader can be extended using new #-expressions
+     (see "Reader extensions")

plug-ins/script-fu/libscriptfu/tinyscheme/README

@@ -0,0 +1,14 @@
+This directory contains a version of TinyScheme which has been modified
+to support UTF-8 coded strings. The strings stored in a data cell are
+expected to be in UTF-8 format. This allows the continued use of gchar
+pointers to pass around the strings. Processing the strings will require
+conversion to unicode at times depending on the specific operation that
+needs to be done on the UTF-8 coded strings.
+
+The string length value stored in a data cell is the length in bytes of that
+string including the terminating NUL.
+
+Routines that want a string length for a UTF-8 coded string will be passed
+the number of characters and not the number of bytes. If the number of bytes
+is needed, the normal call to strlen() will work.
+

plug-ins/script-fu/libscriptfu/tinyscheme/dynload.c

@@ -0,0 +1,152 @@
+/* dynload.c Dynamic Loader for TinyScheme */
+/* Original Copyright (c) 1999 Alexander Shendi     */
+/* Modifications for NT and dl_* interface, scm_load_ext: D. Souflis */
+/* Refurbished by Stephen Gildea */
+
+#define _SCHEME_SOURCE
+#include "dynload.h"
+#include <string.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+#include <glib/glib.h>
+
+#ifndef MAXPATHLEN
+# define MAXPATHLEN 1024
+#endif
+
+static void make_filename(const char *name, char *filename);
+static void make_init_fn(const char *name, char *init_fn);
+
+#ifdef _WIN32
+# include <windows.h>
+#else
+typedef void *HMODULE;
+typedef void (*FARPROC)();
+#ifndef SUN_DL
+#define SUN_DL
+#endif
+#include <dlfcn.h>
+#endif
+
+#ifdef _WIN32
+
+#define PREFIX ""
+#define SUFFIX ".dll"
+
+ static void display_w32_error_msg(const char *additional_message)
+ {
+   LPVOID msg_buf;
+
+   FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER,
+                 NULL, GetLastError(), 0,
+                 (LPTSTR)&msg_buf, 0, NULL);
+   fprintf(stderr, "scheme load-extension: %s: %s", additional_message, msg_buf);
+   LocalFree(msg_buf);
+ }
+
+static HMODULE dl_attach(const char *module) {
+  wchar_t *module_utf16 = g_utf8_to_utf16 (module, -1, NULL, NULL, NULL);
+  HMODULE  dll          = NULL;
+
+  if (!module_utf16)
+    return NULL;
+
+  dll = LoadLibraryW (module_utf16);
+  if (!dll)
+    display_w32_error_msg (module);
+
+  free (module_utf16);
+  return dll;
+}
+
+static FARPROC dl_proc(HMODULE mo, const char *proc) {
+  FARPROC procedure = GetProcAddress(mo,proc);
+  if (!procedure) display_w32_error_msg(proc);
+  return procedure;
+}
+
+static void dl_detach(HMODULE mo) {
+ (void)FreeLibrary(mo);
+}
+
+#elif defined(SUN_DL)
+
+#include <dlfcn.h>
+
+#define PREFIX "lib"
+#define SUFFIX ".so"
+
+static HMODULE dl_attach(const char *module) {
+  HMODULE so=dlopen(module,RTLD_LAZY);
+  if(!so) {
+    fprintf(stderr, "Error loading scheme extension \"%s\": %s\n", module, dlerror());
+  }
+  return so;
+}
+
+static FARPROC dl_proc(HMODULE mo, const char *proc) {
+  const char *errmsg;
+  FARPROC fp=(FARPROC)dlsym(mo,proc);
+  if ((errmsg = dlerror()) == 0) {
+    return fp;
+  }
+  fprintf(stderr, "Error initializing scheme module \"%s\": %s\n", proc, errmsg);
+ return 0;
+}
+
+static void dl_detach(HMODULE mo) {
+ (void)dlclose(mo);
+}
+#endif
+
+pointer scm_load_ext(scheme *sc, pointer args)
+{
+   pointer first_arg;
+   pointer retval;
+   char filename[MAXPATHLEN], init_fn[MAXPATHLEN+6];
+   char *name;
+   HMODULE dll_handle;
+   void (*module_init)(scheme *sc);
+
+   if ((args != sc->NIL) && is_string((first_arg = pair_car(args)))) {
+      name = string_value(first_arg);
+      make_filename(name,filename);
+      make_init_fn(name,init_fn);
+      dll_handle = dl_attach(filename);
+      if (dll_handle == 0) {
+         retval = sc -> F;
+      }
+      else {
+         module_init = (void(*)(scheme *))dl_proc(dll_handle, init_fn);
+         if (module_init != 0) {
+            (*module_init)(sc);
+            retval = sc -> T;
+         }
+         else {
+            retval = sc->F;
+         }
+      }
+   }
+   else {
+      retval = sc -> F;
+   }
+
+  return(retval);
+}
+
+static void make_filename(const char *name, char *filename) {
+ strcpy(filename,name);
+ strcat(filename,SUFFIX);
+}
+
+static void make_init_fn(const char *name, char *init_fn) {
+ const char *p=strrchr(name,'/');
+ if(p==0) {
+     p=name;
+ } else {
+     p++;
+ }
+ strcpy(init_fn,"init_");
+ strcat(init_fn,p);
+}

plug-ins/script-fu/libscriptfu/tinyscheme/dynload.h

@@ -0,0 +1,12 @@
+/* dynload.h */
+/* Original Copyright (c) 1999 Alexander Shendi     */
+/* Modifications for NT and dl_* interface: D. Souflis */
+
+#ifndef DYNLOAD_H
+#define DYNLOAD_H
+
+#include "scheme-private.h"
+
+SCHEME_EXPORT pointer scm_load_ext(scheme *sc, pointer arglist);
+
+#endif

plug-ins/script-fu/libscriptfu/tinyscheme/hack.txt

@@ -0,0 +1,233 @@
+
+                              How to hack TinyScheme
+                              ----------------------
+
+     TinyScheme is easy to learn and modify. It is structured like a
+     meta-interpreter, only it is written in C. All data are Scheme
+     objects, which facilitates both understanding/modifying the
+     code and reifying the interpreter workings.
+
+     In place of a dry description, we will pace through the addition
+     of a useful new datatype: garbage-collected memory blocks.
+     The interface will be:
+
+          (make-block <n> [<fill>]) makes a new block of the specified size
+               optionally filling it with a specified byte
+          (block? <obj>)
+          (block-length <block>)
+          (block-ref <block> <index>) retrieves byte at location
+          (block-set! <block> <index> <byte>) modifies byte at location
+     
+     In the sequel, lines that begin with '>' denote lines to add to the
+     code. Lines that begin with '|' are just citations of existing code.
+     Lines that begin with X are deleted.
+
+     First of all, we need to assign a typeid to our new type. Typeids
+     in TinyScheme are small integers declared in an enum, very close to
+     the top of scheme.c; it begins with T_STRING. Add a new one before the
+     end, call it T_MEMBLOCK. Adjust T_LAST_SYSTEM_TYPE.
+
+|      T_ENVIRONMENT=14,
+X      T_LAST_SYSTEM_TYPE=14
+>      T_MEMBLOCK=15,
+>      T_LAST_SYSTEM_TYPE=15
+|    };
+
+     Then, some helper macros would be useful. Go to where is_string() and
+     the rest are defined and define:
+
+>    int is_memblock(pointer p)      { return (type(p)==T_MEMBLOCK); }
+
+     This actually is a function, because it is meant to be exported by
+     scheme.h. If no foreign function will ever manipulate a memory block,
+     you can instead define it as a macro
+
+>    #define is_memblock(p) (type(p)==T_MEMBLOCK)
+
+     Then we make space for the new type in the main data structure:
+     struct cell. As it happens, the _string part of the union _object
+     (that is used to hold character strings) has two fields that suit us:
+
+|         struct {
+|              char   *_svalue;
+|              int   _keynum;
+|         } _string;
+
+     We can use _svalue to hold the actual pointer and _keynum to hold its
+     length. If we couldn't reuse existing fields, we could always add other
+     alternatives in union _object.
+
+     We then proceed to write the function that actually makes a new block.
+     For conformance reasons, we name it mk_memblock
+
+>     static pointer mk_memblock(scheme *sc, int len, char fill) {
+>          pointer x;
+>          char *p=(char*)sc->malloc(len);
+>
+>          if(p==0) {
+>               return sc->NIL;
+>          }
+>          x = get_cell(sc, sc->NIL, sc->NIL);
+>
+>          typeflag(x) = T_MEMBLOCK|T_ATOM;
+>          strvalue(x)=p;
+>          keynum(x)=len;
+>          memset(p,fill,len);
+>          return (x);
+>     }
+
+     The memory used by the MEMBLOCK will have to be freed when the cell
+     is reclaimed during garbage collection. There is a placeholder for
+     that staff, function finalize_cell(), currently handling strings only.
+
+|     static void finalize_cell(scheme *sc, pointer a) {
+|          if(is_string(a)) {
+|               sc->free(strvalue(a));
+>          else if(is_memblock(a)) {
+>               sc->free(strvalue(a));
+|          } else if(is_port(a)) {
+
+     There are no MEMBLOCK literals, so we don't concern ourselves with
+     the READER part (yet!). We must cater to the PRINTER, though. We
+     add one case more in atom2str().
+
+|    } else if (is_foreign(l)) {
+|         p = sc->strbuff;
+|         snprintf(p,STRBUFFSIZE,"#<FOREIGN PROCEDURE %ld>", procnum(l));
+>    } else if (ismemblock(l)) {
+>         p = "#<MEMBLOCK>";
+|    } else if (is_continuation(l)) {
+|         p = "#<CONTINUATION>";
+|    } else {
+
+     Whenever a MEMBLOCK is displayed, it will look like that.
+
+     Now, we must add the interface functions: constructor, predicate,
+     accessor, modifier. We must in fact create new op-codes for the
+     virtual machine underlying TinyScheme. Since version 1.30, TinyScheme
+     uses macros and a single source text to keep the enums and the
+     dispatch table in sync. That's where the op-codes are declared. Note
+     that the opdefines.h file uses unusually long lines to accommodate
+     all the information; adjust your editor to handle this. The file has
+     six columns: A to Z. they contain:
+       - Column A is the name of a routine to handle the scheme function.
+       - Column B is the name the scheme function.
+       - Columns C and D are the minimum and maximum number of arguments
+         that are accepted by the scheme function.
+       - Column E is a set of flags that are used when the interpreter
+         verifies that the passed parameters are of the correct type.
+       - Column F is used to create a set of enums. The enum is used in a
+         switch in the routine listed in column A to get to the code that
+	 does the work needed for the scheme function.
+     For reasons of cohesion, we add the new op-codes right after those
+     for vectors:
+
+|   _OP_DEF(opexe_2, "vector-set!",                    3,  3,       TST_VECTOR TST_NATURAL TST_ANY,  OP_VECSET           )
+>   _OP_DEF(opexe_2, "make-block",                     1,  2,       TST_NATURAL TST_CHAR,            OP_MKBLOCK          )
+>   _OP_DEF(opexe_2, "block-length",                   1,  1,       T_MEMBLOCK,                      OP_BLOCKLEN         )
+>   _OP_DEF(opexe_2, "block-ref",                      2,  2,       T_MEMBLOCK TST_NATURAL,          OP_BLOCKREF         )
+>   _OP_DEF(opexe_2, "block-set!",                     1,  1,       T_MEMBLOCK TST_NATURAL TST_CHAR, OP_BLOCKSET         )
+|   _OP_DEF(opexe_3, "not",                            1,  1,       TST_NONE,                        OP_NOT              )
+
+     We add the predicate along the other predicates:
+
+|   _OP_DEF(opexe_3, "vector?",                        1,  1,       TST_ANY,                         OP_VECTORP          )
+>   _OP_DEF(opexe_3, "block?",                         1,  1,       TST_ANY,                         OP_BLOCKP           )
+|   _OP_DEF(opexe_3, "eq?",                            2,  2,       TST_ANY,                         OP_EQ               )
+
+     All that remains is to write the actual processing in opexe_2, right
+     after OP_VECSET.
+
+>     case OP_MKBLOCK: { /* make-block */
+>          int fill=0;
+>          int len;
+>
+>          if(!isnumber(car(sc->args))) {
+>               Error_1(sc,"make-block: not a number:",car(sc->args));
+>          }
+>          len=ivalue(car(sc->args));
+>          if(len<=0) {
+>               Error_1(sc,"make-block: not positive:",car(sc->args));
+>          }
+>
+>          if(cdr(sc->args)!=sc->NIL) {
+>               if(!isnumber(cadr(sc->args)) || ivalue(cadr(sc->args))<0) {
+>                    Error_1(sc,"make-block: not a positive number:",cadr(sc->args));
+>               }
+>               fill=charvalue(cadr(sc->args))%255;
+>          }
+>          s_return(sc,mk_memblock(sc,len,(char)fill));
+>     }
+>
+>     case OP_BLOCKLEN:  /* block-length */
+>          if(!ismemblock(car(sc->args))) {
+>               Error_1(sc,"block-length: not a memory block:",car(sc->args));
+>          }
+>          s_return(sc,mk_integer(sc,keynum(car(sc->args))));
+>
+>     case OP_BLOCKREF: { /* block-ref */
+>          char *str;
+>          int index;
+>
+>          if(!ismemblock(car(sc->args))) {
+>               Error_1(sc,"block-ref: not a memory block:",car(sc->args));
+>          }
+>          str=strvalue(car(sc->args));
+>
+>          if(cdr(sc->args)==sc->NIL) {
+>               Error_0(sc,"block-ref: needs two arguments");
+>          }
+>          if(!isnumber(cadr(sc->args))) {
+>               Error_1(sc,"block-ref: not a number:",cadr(sc->args));
+>          }
+>          index=ivalue(cadr(sc->args));
+>
+>          if(index<0 || index>=keynum(car(sc->args))) {
+>               Error_1(sc,"block-ref: out of bounds:",cadr(sc->args));
+>          }
+>
+>          s_return(sc,mk_integer(sc,str[index]));
+>     }
+>
+>     case OP_BLOCKSET: { /* block-set! */
+>          char *str;
+>          int index;
+>          int c;
+>
+>          if(!ismemblock(car(sc->args))) {
+>               Error_1(sc,"block-set!: not a memory block:",car(sc->args));
+>          }
+>          if(isimmutable(car(sc->args))) {
+>               Error_1(sc,"block-set!: unable to alter immutable memory block:",car(sc->args));
+>          }
+>          str=strvalue(car(sc->args));
+>
+>          if(cdr(sc->args)==sc->NIL) {
+>               Error_0(sc,"block-set!: needs three arguments");
+>          }
+>          if(!isnumber(cadr(sc->args))) {
+>               Error_1(sc,"block-set!: not a number:",cadr(sc->args));
+>          }
+>          index=ivalue(cadr(sc->args));
+>          if(index<0 || index>=keynum(car(sc->args))) {
+>               Error_1(sc,"block-set!: out of bounds:",cadr(sc->args));
+>          }
+>
+>          if(cddr(sc->args)==sc->NIL) {
+>               Error_0(sc,"block-set!: needs three arguments");
+>          }
+>          if(!isinteger(caddr(sc->args))) {
+>               Error_1(sc,"block-set!: not an integer:",caddr(sc->args));
+>          }
+>          c=ivalue(caddr(sc->args))%255;
+>
+>          str[index]=(char)c;
+>          s_return(sc,car(sc->args));
+>     }
+
+     Same for the predicate in opexe_3.
+
+|     case OP_VECTORP:     /* vector? */
+|          s_retbool(isvector(car(sc->args)));
+>     case OP_BLOCKP:     /* block? */
+>          s_retbool(ismemblock(car(sc->args)));

plug-ins/script-fu/libscriptfu/tinyscheme/init.scm

@@ -0,0 +1,716 @@
+;    Initialization file for TinySCHEME 1.41
+
+; Per R5RS, up to four deep compositions should be defined
+(define (caar x) (car (car x)))
+(define (cadr x) (car (cdr x)))
+(define (cdar x) (cdr (car x)))
+(define (cddr x) (cdr (cdr x)))
+(define (caaar x) (car (car (car x))))
+(define (caadr x) (car (car (cdr x))))
+(define (cadar x) (car (cdr (car x))))
+(define (caddr x) (car (cdr (cdr x))))
+(define (cdaar x) (cdr (car (car x))))
+(define (cdadr x) (cdr (car (cdr x))))
+(define (cddar x) (cdr (cdr (car x))))
+(define (cdddr x) (cdr (cdr (cdr x))))
+(define (caaaar x) (car (car (car (car x)))))
+(define (caaadr x) (car (car (car (cdr x)))))
+(define (caadar x) (car (car (cdr (car x)))))
+(define (caaddr x) (car (car (cdr (cdr x)))))
+(define (cadaar x) (car (cdr (car (car x)))))
+(define (cadadr x) (car (cdr (car (cdr x)))))
+(define (caddar x) (car (cdr (cdr (car x)))))
+(define (cadddr x) (car (cdr (cdr (cdr x)))))
+(define (cdaaar x) (cdr (car (car (car x)))))
+(define (cdaadr x) (cdr (car (car (cdr x)))))
+(define (cdadar x) (cdr (car (cdr (car x)))))
+(define (cdaddr x) (cdr (car (cdr (cdr x)))))
+(define (cddaar x) (cdr (cdr (car (car x)))))
+(define (cddadr x) (cdr (cdr (car (cdr x)))))
+(define (cdddar x) (cdr (cdr (cdr (car x)))))
+(define (cddddr x) (cdr (cdr (cdr (cdr x)))))
+
+;;;; Utility to ease macro creation
+(define (macro-expand form)
+     ((eval (get-closure-code (eval (car form)))) form))
+
+(define (macro-expand-all form)
+   (if (macro? form)
+      (macro-expand-all (macro-expand form))
+      form))
+
+(define *compile-hook* macro-expand-all)
+
+
+(macro (unless form)
+     `(if (not ,(cadr form)) (begin ,@(cddr form))))
+
+(macro (when form)
+     `(if ,(cadr form) (begin ,@(cddr form))))
+
+; DEFINE-MACRO Contributed by Andy Gaynor
+(macro (define-macro dform)
+  (if (symbol? (cadr dform))
+    `(macro ,@(cdr dform))
+    (let ((form (gensym)))
+      `(macro (,(caadr dform) ,form)
+         (apply (lambda ,(cdadr dform) ,@(cddr dform)) (cdr ,form))))))
+
+; Utilities for math. Notice that inexact->exact is primitive,
+; but exact->inexact is not.
+(define exact? integer?)
+(define (inexact? x) (and (real? x) (not (integer? x))))
+(define (even? n) (= (remainder n 2) 0))
+(define (odd? n) (not (= (remainder n 2) 0)))
+(define (zero? n) (= n 0))
+(define (positive? n) (> n 0))
+(define (negative? n) (< n 0))
+(define complex? number?)
+(define rational? real?)
+(define (abs n) (if (>= n 0) n (- n)))
+(define (exact->inexact n) (* n 1.0))
+(define (<> n1 n2) (not (= n1 n2)))
+
+; min and max must return inexact if any arg is inexact; use (+ n 0.0)
+(define (max . lst)
+  (foldr (lambda (a b)
+           (if (> a b)
+             (if (exact? b) a (+ a 0.0))
+             (if (exact? a) b (+ b 0.0))))
+         (car lst) (cdr lst)))
+(define (min . lst)
+  (foldr (lambda (a b)
+           (if (< a b)
+             (if (exact? b) a (+ a 0.0))
+             (if (exact? a) b (+ b 0.0))))
+         (car lst) (cdr lst)))
+
+(define (succ x) (+ x 1))
+(define (pred x) (- x 1))
+(define gcd
+  (lambda a
+    (if (null? a)
+      0
+      (let ((aa (abs (car a)))
+            (bb (abs (cadr a))))
+         (if (= bb 0)
+              aa
+              (gcd bb (remainder aa bb)))))))
+(define lcm
+  (lambda a
+    (if (null? a)
+      1
+      (let ((aa (abs (car a)))
+            (bb (abs (cadr a))))
+         (if (or (= aa 0) (= bb 0))
+             0
+             (abs (* (quotient aa (gcd aa bb)) bb)))))))
+
+
+(define (string . charlist)
+     (list->string charlist))
+
+(define (list->string charlist)
+     (let* ((len (length charlist))
+            (newstr (make-string len))
+            (fill-string!
+               (lambda (str i len charlist)
+                    (if (= i len)
+                         str
+                         (begin (string-set! str i (car charlist))
+                         (fill-string! str (+ i 1) len (cdr charlist)))))))
+          (fill-string! newstr 0 len charlist)))
+
+(define (string-fill! s e)
+     (let ((n (string-length s)))
+          (let loop ((i 0))
+               (if (= i n)
+                    s
+                    (begin (string-set! s i e) (loop (succ i)))))))
+
+(define (string->list s)
+     (let loop ((n (pred (string-length s))) (l '()))
+          (if (= n -1)
+               l
+               (loop (pred n) (cons (string-ref s n) l)))))
+
+(define (string-copy str)
+     (string-append str))
+
+(define (string->anyatom str pred)
+     (let* ((a (string->atom str)))
+       (if (pred a) a
+         (error "string->xxx: not a xxx" a))))
+
+(define (string->number str . base)
+    (let ((n (string->atom str (if (null? base) 10 (car base)))))
+        (if (number? n) n #f)))
+
+(define (anyatom->string n pred)
+  (if (pred n)
+      (atom->string n)
+      (error "xxx->string: not a xxx" n)))
+
+(define (number->string n . base)
+    (atom->string n (if (null? base) 10 (car base))))
+
+
+(define (char-cmp? cmp a b)
+     (cmp (char->integer a) (char->integer b)))
+(define (char-ci-cmp? cmp a b)
+     (cmp (char->integer (char-downcase a)) (char->integer (char-downcase b))))
+
+(define (char=? a b) (char-cmp? = a b))
+(define (char<? a b) (char-cmp? < a b))
+(define (char>? a b) (char-cmp? > a b))
+(define (char<=? a b) (char-cmp? <= a b))
+(define (char>=? a b) (char-cmp? >= a b))
+
+(define (char-ci=? a b) (char-ci-cmp? = a b))
+(define (char-ci<? a b) (char-ci-cmp? < a b))
+(define (char-ci>? a b) (char-ci-cmp? > a b))
+(define (char-ci<=? a b) (char-ci-cmp? <= a b))
+(define (char-ci>=? a b) (char-ci-cmp? >= a b))
+
+; Note the trick of returning (cmp x y)
+(define (string-cmp? chcmp cmp a b)
+     (let ((na (string-length a)) (nb (string-length b)))
+          (let loop ((i 0))
+               (cond
+                    ((= i na)
+                         (if (= i nb) (cmp 0 0) (cmp 0 1)))
+                    ((= i nb)
+                         (cmp 1 0))
+                    ((chcmp = (string-ref a i) (string-ref b i))
+                         (loop (succ i)))
+                    (else
+                         (chcmp cmp (string-ref a i) (string-ref b i)))))))
+
+
+(define (string=? a b) (string-cmp? char-cmp? = a b))
+(define (string<? a b) (string-cmp? char-cmp? < a b))
+(define (string>? a b) (string-cmp? char-cmp? > a b))
+(define (string<=? a b) (string-cmp? char-cmp? <= a b))
+(define (string>=? a b) (string-cmp? char-cmp? >= a b))
+
+(define (string-ci=? a b) (string-cmp? char-ci-cmp? = a b))
+(define (string-ci<? a b) (string-cmp? char-ci-cmp? < a b))
+(define (string-ci>? a b) (string-cmp? char-ci-cmp? > a b))
+(define (string-ci<=? a b) (string-cmp? char-ci-cmp? <= a b))
+(define (string-ci>=? a b) (string-cmp? char-ci-cmp? >= a b))
+
+(define (list . x) x)
+
+(define (foldr f x lst)
+     (if (null? lst)
+          x
+          (foldr f (f x (car lst)) (cdr lst))))
+
+(define (unzip1-with-cdr . lists)
+  (unzip1-with-cdr-iterative lists '() '()))
+
+(define (unzip1-with-cdr-iterative lists cars cdrs)
+  (if (null? lists)
+      (cons cars cdrs)
+      (let ((car1 (caar lists))
+            (cdr1 (cdar lists)))
+        (unzip1-with-cdr-iterative
+          (cdr lists)
+          (append cars (list car1))
+          (append cdrs (list cdr1))))))
+
+(define (map proc . lists)
+  (if (null? lists)
+      (apply proc)
+      (if (null? (car lists))
+        '()
+        (let* ((unz (apply unzip1-with-cdr lists))
+               (cars (car unz))
+               (cdrs (cdr unz)))
+          (cons (apply proc cars) (apply map (cons proc cdrs)))))))
+
+(define (for-each proc . lists)
+  (if (null? lists)
+      (apply proc)
+      (if (null? (car lists))
+        #t
+        (let* ((unz (apply unzip1-with-cdr lists))
+               (cars (car unz))
+               (cdrs (cdr unz)))
+          (apply proc cars) (apply map (cons proc cdrs))))))
+
+(define (list-tail x k)
+    (if (zero? k)
+        x
+        (list-tail (cdr x) (- k 1))))
+
+(define (list-ref x k)
+    (car (list-tail x k)))
+
+(define (last-pair x)
+    (if (pair? (cdr x))
+        (last-pair (cdr x))
+        x))
+
+(define (head stream) (car stream))
+
+(define (tail stream) (force (cdr stream)))
+
+(define (vector-equal? x y)
+     (and (vector? x) (vector? y) (= (vector-length x) (vector-length y))
+          (let ((n (vector-length x)))
+               (let loop ((i 0))
+                    (if (= i n)
+                         #t
+                         (and (equal? (vector-ref x i) (vector-ref y i))
+                              (loop (succ i))))))))
+
+(define (list->vector x)
+     (apply vector x))
+
+(define (vector-fill! v e)
+     (let ((n (vector-length v)))
+          (let loop ((i 0))
+               (if (= i n)
+                    v
+                    (begin (vector-set! v i e) (loop (succ i)))))))
+
+(define (vector->list v)
+     (let loop ((n (pred (vector-length v))) (l '()))
+          (if (= n -1)
+               l
+               (loop (pred n) (cons (vector-ref v n) l)))))
+
+;; The following quasiquote macro is due to Eric S. Tiedemann.
+;;   Copyright 1988 by Eric S. Tiedemann; all rights reserved.
+;;
+;; Subsequently modified to handle vectors: D. Souflis
+
+(macro
+ quasiquote
+ (lambda (l)
+   (define (mcons f l r)
+     (if (and (pair? r)
+              (eq? (car r) 'quote)
+              (eq? (car (cdr r)) (cdr f))
+              (pair? l)
+              (eq? (car l) 'quote)
+              (eq? (car (cdr l)) (car f)))
+         (if (or (procedure? f) (number? f) (string? f))
+               f
+               (list 'quote f))
+         (if (eqv? l vector)
+               (apply l (eval r))
+               (list 'cons l r)
+               )))
+   (define (mappend f l r)
+     (if (or (null? (cdr f))
+             (and (pair? r)
+                  (eq? (car r) 'quote)
+                  (eq? (car (cdr r)) '())))
+         l
+         (list 'append l r)))
+   (define (foo level form)
+     (cond ((not (pair? form))
+               (if (or (procedure? form) (number? form) (string? form))
+                    form
+                    (list 'quote form))
+               )
+           ((eq? 'quasiquote (car form))
+            (mcons form ''quasiquote (foo (+ level 1) (cdr form))))
+           (#t (if (zero? level)
+                   (cond ((eq? (car form) 'unquote) (car (cdr form)))
+                         ((eq? (car form) 'unquote-splicing)
+                          (error "Unquote-splicing wasn't in a list:"
+                                 form))
+                         ((and (pair? (car form))
+                               (eq? (car (car form)) 'unquote-splicing))
+                          (mappend form (car (cdr (car form)))
+                                   (foo level (cdr form))))
+                         (#t (mcons form (foo level (car form))
+                                         (foo level (cdr form)))))
+                   (cond ((eq? (car form) 'unquote)
+                          (mcons form ''unquote (foo (- level 1)
+                                                     (cdr form))))
+                         ((eq? (car form) 'unquote-splicing)
+                          (mcons form ''unquote-splicing
+                                      (foo (- level 1) (cdr form))))
+                         (#t (mcons form (foo level (car form))
+                                         (foo level (cdr form)))))))))
+   (foo 0 (car (cdr l)))))
+
+;;;;;Helper for the dynamic-wind definition.  By Tom Breton (Tehom)
+(define (shared-tail x y)
+   (let ((len-x (length x))
+         (len-y (length y)))
+      (define (shared-tail-helper x y)
+         (if
+            (eq? x y)
+            x
+            (shared-tail-helper (cdr x) (cdr y))))
+
+      (cond
+         ((> len-x len-y)
+            (shared-tail-helper
+               (list-tail x (- len-x len-y))
+               y))
+         ((< len-x len-y)
+            (shared-tail-helper
+               x
+               (list-tail y (- len-y len-x))))
+         (#t (shared-tail-helper x y)))))
+
+;;;;;Dynamic-wind by Tom Breton (Tehom)
+
+;;Guarded because we must only eval this once, because doing so
+;;redefines call/cc in terms of old call/cc
+(unless (defined? 'dynamic-wind)
+   (let
+      ;;These functions are defined in the context of a private list of
+      ;;pairs of before/after procs.
+      (  (*active-windings* '())
+         ;;We'll define some functions into the larger environment, so
+         ;;we need to know it.
+         (outer-env (current-environment)))
+
+      ;;Poor-man's structure operations
+      (define before-func car)
+      (define after-func  cdr)
+      (define make-winding cons)
+
+      ;;Manage active windings
+      (define (activate-winding! new)
+         ((before-func new))
+         (set! *active-windings* (cons new *active-windings*)))
+      (define (deactivate-top-winding!)
+         (let ((old-top (car *active-windings*)))
+            ;;Remove it from the list first so it's not active during its
+            ;;own exit.
+            (set! *active-windings* (cdr *active-windings*))
+            ((after-func old-top))))
+
+      (define (set-active-windings! new-ws)
+         (unless (eq? new-ws *active-windings*)
+            (let ((shared (shared-tail new-ws *active-windings*)))
+
+               ;;Define the looping functions.
+               ;;Exit the old list.  Do deeper ones last.  Don't do
+               ;;any shared ones.
+               (define (pop-many)
+                  (unless (eq? *active-windings* shared)
+                     (deactivate-top-winding!)
+                     (pop-many)))
+               ;;Enter the new list.  Do deeper ones first so that the
+               ;;deeper windings will already be active.  Don't do any
+               ;;shared ones.
+               (define (push-many new-ws)
+                  (unless (eq? new-ws shared)
+                     (push-many (cdr new-ws))
+                     (activate-winding! (car new-ws))))
+
+               ;;Do it.
+               (pop-many)
+               (push-many new-ws))))
+
+      ;;The definitions themselves.
+      (eval
+         `(define call-with-current-continuation
+             ;;It internally uses the built-in call/cc, so capture it.
+             ,(let ((old-c/cc call-with-current-continuation))
+                 (lambda (func)
+                    ;;Use old call/cc to get the continuation.
+                    (old-c/cc
+                       (lambda (continuation)
+                          ;;Call func with not the continuation itself
+                          ;;but a procedure that adjusts the active
+                          ;;windings to what they were when we made
+                          ;;this, and only then calls the
+                          ;;continuation.
+                          (func
+                             (let ((current-ws *active-windings*))
+                                (lambda (x)
+                                   (set-active-windings! current-ws)
+                                   (continuation x)))))))))
+         outer-env)
+      ;;We can't just say "define (dynamic-wind before thunk after)"
+      ;;because the lambda it's defined to lives in this environment,
+      ;;not in the global environment.
+      (eval
+         `(define dynamic-wind
+             ,(lambda (before thunk after)
+                 ;;Make a new winding
+                 (activate-winding! (make-winding before after))
+                 (let ((result (thunk)))
+                    ;;Get rid of the new winding.
+                    (deactivate-top-winding!)
+                    ;;The return value is that of thunk.
+                    result)))
+         outer-env)))
+
+(define call/cc call-with-current-continuation)
+
+
+;;;;; atom? and equal? written by a.k
+
+;;;; atom?
+(define (atom? x)
+  (not (pair? x)))
+
+;;;;    equal?
+(define (equal? x y)
+     (cond
+          ((pair? x)
+               (and (pair? y)
+                    (equal? (car x) (car y))
+                    (equal? (cdr x) (cdr y))))
+          ((vector? x)
+               (and (vector? y) (vector-equal? x y)))
+          ((string? x)
+               (and (string? y) (string=? x y)))
+          (else (eqv? x y))))
+
+;;;; (do ((var init inc) ...) (endtest result ...) body ...)
+;;
+(macro do
+  (lambda (do-macro)
+    (apply (lambda (do vars endtest . body)
+             (let ((do-loop (gensym)))
+               `(letrec ((,do-loop
+                           (lambda ,(map (lambda (x)
+                                           (if (pair? x) (car x) x))
+                                      `,vars)
+                             (if ,(car endtest)
+                               (begin ,@(cdr endtest))
+                               (begin
+                                 ,@body
+                                 (,do-loop
+                                   ,@(map (lambda (x)
+                                            (cond
+                                              ((not (pair? x)) x)
+                                              ((< (length x) 3) (car x))
+                                              (else (car (cdr (cdr x))))))
+                                       `,vars)))))))
+                  (,do-loop
+                    ,@(map (lambda (x)
+                             (if (and (pair? x) (cdr x))
+                               (car (cdr x))
+                               '()))
+                        `,vars)))))
+      do-macro)))
+
+;;;; generic-member
+(define (generic-member cmp obj lst)
+  (cond
+    ((null? lst) #f)
+    ((cmp obj (car lst)) lst)
+    (else (generic-member cmp obj (cdr lst)))))
+
+(define (memq obj lst)
+     (generic-member eq? obj lst))
+(define (memv obj lst)
+     (generic-member eqv? obj lst))
+(define (member obj lst)
+     (generic-member equal? obj lst))
+
+;;;; generic-assoc
+(define (generic-assoc cmp obj alst)
+     (cond
+          ((null? alst) #f)
+          ((cmp obj (caar alst)) (car alst))
+          (else (generic-assoc cmp obj (cdr alst)))))
+
+(define (assq obj alst)
+     (generic-assoc eq? obj alst))
+(define (assv obj alst)
+     (generic-assoc eqv? obj alst))
+(define (assoc obj alst)
+     (generic-assoc equal? obj alst))
+
+(define (acons x y z) (cons (cons x y) z))
+
+;;;; Handy for imperative programs
+;;;; Used as: (define-with-return (foo x y) .... (return z) ...)
+(macro (define-with-return form)
+     `(define ,(cadr form)
+          (call/cc (lambda (return) ,@(cddr form)))))
+
+;;;; Simple exception handling
+;
+;    Exceptions are caught as follows:
+;
+;         (catch (do-something to-recover and-return meaningful-value)
+;              (if-something goes-wrong)
+;              (with-these calls))
+;
+;    "Catch" establishes a scope spanning multiple call-frames
+;    until another "catch" is encountered.
+;
+;    Exceptions are thrown with:
+;
+;         (throw "message")
+;
+;    If used outside a (catch ...), reverts to (error "message)
+
+(define *handlers* (list))
+
+(define (push-handler proc)
+     (set! *handlers* (cons proc *handlers*)))
+
+(define (pop-handler)
+     (let ((h (car *handlers*)))
+          (set! *handlers* (cdr *handlers*))
+          h))
+
+(define (more-handlers?)
+     (pair? *handlers*))
+
+(define (throw . x)
+     (if (more-handlers?)
+          (apply (pop-handler))
+          (apply error x)))
+
+(macro (catch form)
+     (let ((label (gensym)))
+          `(call/cc (lambda (exit)
+               (push-handler (lambda () (exit ,(cadr form))))
+               (let ((,label (begin ,@(cddr form))))
+                    (pop-handler)
+                    ,label)))))
+
+(define *error-hook* throw)
+
+
+;;;;; Definition of MAKE-ENVIRONMENT, to be used with two-argument EVAL
+
+(macro (make-environment form)
+     `(apply (lambda ()
+               ,@(cdr form)
+               (current-environment))))
+
+(define-macro (eval-polymorphic x . envl)
+  (display envl)
+  (let* ((env (if (null? envl) (current-environment) (eval (car envl))))
+         (xval (eval x env)))
+    (if (closure? xval)
+      (make-closure (get-closure-code xval) env)
+      xval)))
+
+; Redefine this if you install another package infrastructure
+; Also redefine 'package'
+(define *colon-hook* eval)
+
+;;;;; I/O
+
+(define (input-output-port? p)
+     (and (input-port? p) (output-port? p)))
+
+(define (close-port p)
+     (cond
+          ((input-output-port? p) (close-input-port p) (close-output-port p))
+          ((input-port? p) (close-input-port p))
+          ((output-port? p) (close-output-port p))
+          (else (throw "Not a port" p))))
+
+(define (call-with-input-file s p)
+     (let ((inport (open-input-file s)))
+          (if (eq? inport #f)
+               #f
+               (let ((res (p inport)))
+                    (close-input-port inport)
+                    res))))
+
+(define (call-with-output-file s p)
+     (let ((outport (open-output-file s)))
+          (if (eq? outport #f)
+               #f
+               (let ((res (p outport)))
+                    (close-output-port outport)
+                    res))))
+
+(define (with-input-from-file s p)
+     (let ((inport (open-input-file s)))
+          (if (eq? inport #f)
+               #f
+               (let ((prev-inport (current-input-port)))
+                    (set-input-port inport)
+                    (let ((res (p)))
+                         (close-input-port inport)
+                         (set-input-port prev-inport)
+                         res)))))
+
+(define (with-output-to-file s p)
+     (let ((outport (open-output-file s)))
+          (if (eq? outport #f)
+               #f
+               (let ((prev-outport (current-output-port)))
+                    (set-output-port outport)
+                    (let ((res (p)))
+                         (close-output-port outport)
+                         (set-output-port prev-outport)
+                         res)))))
+
+(define (with-input-output-from-to-files si so p)
+     (let ((inport (open-input-file si))
+           (outport (open-input-file so)))
+          (if (not (and inport outport))
+               (begin
+                    (close-input-port inport)
+                    (close-output-port outport)
+                    #f)
+               (let ((prev-inport (current-input-port))
+                     (prev-outport (current-output-port)))
+                    (set-input-port inport)
+                    (set-output-port outport)
+                    (let ((res (p)))
+                         (close-input-port inport)
+                         (close-output-port outport)
+                         (set-input-port prev-inport)
+                         (set-output-port prev-outport)
+                         res)))))
+
+; Random number generator (maximum cycle)
+(define *seed* 1)
+(define (random-next)
+     (let* ((a 16807) (m 2147483647) (q (quotient m a)) (r (modulo m a)))
+          (set! *seed*
+               (-   (* a (- *seed*
+                         (* (quotient *seed* q) q)))
+                    (* (quotient *seed* q) r)))
+          (if (< *seed* 0) (set! *seed* (+ *seed* m)))
+          *seed*))
+;; SRFI-0
+;; COND-EXPAND
+;; Implemented as a macro
+(define *features* '(srfi-0 tinyscheme))
+
+(define-macro (cond-expand . cond-action-list)
+  (cond-expand-runtime cond-action-list))
+
+(define (cond-expand-runtime cond-action-list)
+  (if (null? cond-action-list)
+      #t
+      (if (cond-eval (caar cond-action-list))
+          `(begin ,@(cdar cond-action-list))
+          (cond-expand-runtime (cdr cond-action-list)))))
+
+(define (cond-eval-and cond-list)
+  (foldr (lambda (x y) (and (cond-eval x) (cond-eval y))) #t cond-list))
+
+(define (cond-eval-or cond-list)
+  (foldr (lambda (x y) (or (cond-eval x) (cond-eval y))) #f cond-list))
+
+(define (cond-eval condition)
+  (cond
+    ((symbol? condition)
+       (if (member condition *features*) #t #f))
+    ((eq? condition #t) #t)
+    ((eq? condition #f) #f)
+    (else (case (car condition)
+            ((and) (cond-eval-and (cdr condition)))
+            ((or) (cond-eval-or (cdr condition)))
+            ((not) (if (not (null? (cddr condition)))
+                     (error "cond-expand : 'not' takes 1 argument")
+                     (not (cond-eval (cadr condition)))))
+            (else (error "cond-expand : unknown operator" (car condition)))))))
+
+(gc-verbose #f)

plug-ins/script-fu/libscriptfu/tinyscheme/meson.build

@@ -0,0 +1,18 @@
+
+# No include_directories('.') here; use libscriptfuInclude 
+
+scriptfu_tinyscheme = static_library('scriptfu-tinyscheme',
+  'scheme.c',
+  include_directories: [ rootInclude, ],
+  dependencies: [
+    glib,
+  ],
+  c_args: [
+    '-DSTANDALONE=0',
+    '-DUSE_ASCII_NAMES=0',
+    '-DUSE_INTERFACE=1',
+    '-DUSE_MATH=1',
+    '-DUSE_STRLWR=0',
+  ],
+  install: false,
+)

plug-ins/script-fu/libscriptfu/tinyscheme/opdefines.h

@@ -0,0 +1,202 @@
+    _OP_DEF(opexe_0, "load",                           1,  1,       TST_STRING,                      OP_LOAD             )
+    _OP_DEF(opexe_0, 0,                                0,  0,       0,                               OP_T0LVL            )
+    _OP_DEF(opexe_0, 0,                                0,  0,       0,                               OP_T1LVL            )
+    _OP_DEF(opexe_0, 0,                                0,  0,       0,                               OP_READ_INTERNAL    )
+    _OP_DEF(opexe_0, "gensym",                         0,  0,       0,                               OP_GENSYM           )
+    _OP_DEF(opexe_0, 0,                                0,  0,       0,                               OP_VALUEPRINT       )
+    _OP_DEF(opexe_0, 0,                                0,  0,       0,                               OP_EVAL             )
+#if USE_TRACING
+    _OP_DEF(opexe_0, 0,                                0,  0,       0,                               OP_REAL_EVAL        )
+#endif
+    _OP_DEF(opexe_0, 0,                                0,  0,       0,                               OP_E0ARGS           )
+    _OP_DEF(opexe_0, 0,                                0,  0,       0,                               OP_E1ARGS           )
+    _OP_DEF(opexe_0, 0,                                0,  0,       0,                               OP_APPLY            )
+#if USE_TRACING
+    _OP_DEF(opexe_0, 0,                                0,  0,       0,                               OP_REAL_APPLY       )
+    _OP_DEF(opexe_0, "tracing",                        1,  1,       TST_NATURAL,                     OP_TRACING          )
+#endif
+    _OP_DEF(opexe_0, 0,                                0,  0,       0,                               OP_DOMACRO          )
+    _OP_DEF(opexe_0, 0,                                0,  0,       0,                               OP_LAMBDA           )
+    _OP_DEF(opexe_0, 0,                                0,  0,       0,                               OP_LAMBDA1          )
+    _OP_DEF(opexe_0, "make-closure",                   1,  2,       TST_PAIR TST_ENVIRONMENT,        OP_MKCLOSURE        )
+    _OP_DEF(opexe_0, 0,                                0,  0,       0,                               OP_QUOTE            )
+    _OP_DEF(opexe_0, 0,                                0,  0,       0,                               OP_DEF0             )
+    _OP_DEF(opexe_0, 0,                                0,  0,       0,                               OP_DEF1             )
+    _OP_DEF(opexe_0, "defined?",                       1,  2,       TST_SYMBOL TST_ENVIRONMENT,      OP_DEFP             )
+    _OP_DEF(opexe_0, 0,                                0,  0,       0,                               OP_BEGIN            )
+    _OP_DEF(opexe_0, 0,                                0,  0,       0,                               OP_IF0              )
+    _OP_DEF(opexe_0, 0,                                0,  0,       0,                               OP_IF1              )
+    _OP_DEF(opexe_0, 0,                                0,  0,       0,                               OP_SET0             )
+    _OP_DEF(opexe_0, 0,                                0,  0,       0,                               OP_SET1             )
+    _OP_DEF(opexe_0, 0,                                0,  0,       0,                               OP_LET0             )
+    _OP_DEF(opexe_0, 0,                                0,  0,       0,                               OP_LET1             )
+    _OP_DEF(opexe_0, 0,                                0,  0,       0,                               OP_LET2             )
+    _OP_DEF(opexe_0, 0,                                0,  0,       0,                               OP_LET0AST          )
+    _OP_DEF(opexe_0, 0,                                0,  0,       0,                               OP_LET1AST          )
+    _OP_DEF(opexe_0, 0,                                0,  0,       0,                               OP_LET2AST          )
+    _OP_DEF(opexe_1, 0,                                0,  0,       0,                               OP_LET0REC          )
+    _OP_DEF(opexe_1, 0,                                0,  0,       0,                               OP_LET1REC          )
+    _OP_DEF(opexe_1, 0,                                0,  0,       0,                               OP_LET2REC          )
+    _OP_DEF(opexe_1, 0,                                0,  0,       0,                               OP_COND0            )
+    _OP_DEF(opexe_1, 0,                                0,  0,       0,                               OP_COND1            )
+    _OP_DEF(opexe_1, 0,                                0,  0,       0,                               OP_DELAY            )
+    _OP_DEF(opexe_1, 0,                                0,  0,       0,                               OP_AND0             )
+    _OP_DEF(opexe_1, 0,                                0,  0,       0,                               OP_AND1             )
+    _OP_DEF(opexe_1, 0,                                0,  0,       0,                               OP_OR0              )
+    _OP_DEF(opexe_1, 0,                                0,  0,       0,                               OP_OR1              )
+    _OP_DEF(opexe_1, 0,                                0,  0,       0,                               OP_C0STREAM         )
+    _OP_DEF(opexe_1, 0,                                0,  0,       0,                               OP_C1STREAM         )
+    _OP_DEF(opexe_1, 0,                                0,  0,       0,                               OP_MACRO0           )
+    _OP_DEF(opexe_1, 0,                                0,  0,       0,                               OP_MACRO1           )
+    _OP_DEF(opexe_1, 0,                                0,  0,       0,                               OP_CASE0            )
+    _OP_DEF(opexe_1, 0,                                0,  0,       0,                               OP_CASE1            )
+    _OP_DEF(opexe_1, 0,                                0,  0,       0,                               OP_CASE2            )
+    _OP_DEF(opexe_1, "eval",                           1,  2,       TST_ANY TST_ENVIRONMENT,         OP_PEVAL            )
+    _OP_DEF(opexe_1, "apply",                          1,  INF_ARG, TST_NONE,                        OP_PAPPLY           )
+    _OP_DEF(opexe_1, "call-with-current-continuation", 1,  1,       TST_NONE,                        OP_CONTINUATION     )
+#if USE_MATH
+    _OP_DEF(opexe_2, "inexact->exact",                 1,  1,       TST_NUMBER,                      OP_INEX2EX          )
+    _OP_DEF(opexe_2, "exp",                            1,  1,       TST_NUMBER,                      OP_EXP              )
+    _OP_DEF(opexe_2, "log",                            1,  1,       TST_NUMBER,                      OP_LOG              )
+    _OP_DEF(opexe_2, "sin",                            1,  1,       TST_NUMBER,                      OP_SIN              )
+    _OP_DEF(opexe_2, "cos",                            1,  1,       TST_NUMBER,                      OP_COS              )
+    _OP_DEF(opexe_2, "tan",                            1,  1,       TST_NUMBER,                      OP_TAN              )
+    _OP_DEF(opexe_2, "asin",                           1,  1,       TST_NUMBER,                      OP_ASIN             )
+    _OP_DEF(opexe_2, "acos",                           1,  1,       TST_NUMBER,                      OP_ACOS             )
+    _OP_DEF(opexe_2, "atan",                           1,  2,       TST_NUMBER,                      OP_ATAN             )
+    _OP_DEF(opexe_2, "sqrt",                           1,  1,       TST_NUMBER,                      OP_SQRT             )
+    _OP_DEF(opexe_2, "expt",                           2,  2,       TST_NUMBER,                      OP_EXPT             )
+    _OP_DEF(opexe_2, "floor",                          1,  1,       TST_NUMBER,                      OP_FLOOR            )
+    _OP_DEF(opexe_2, "ceiling",                        1,  1,       TST_NUMBER,                      OP_CEILING          )
+    _OP_DEF(opexe_2, "truncate",                       1,  1,       TST_NUMBER,                      OP_TRUNCATE         )
+    _OP_DEF(opexe_2, "round",                          1,  1,       TST_NUMBER,                      OP_ROUND            )
+#endif
+    _OP_DEF(opexe_2, "+",                              0,  INF_ARG, TST_NUMBER,                      OP_ADD              )
+    _OP_DEF(opexe_2, "-",                              1,  INF_ARG, TST_NUMBER,                      OP_SUB              )
+    _OP_DEF(opexe_2, "*",                              0,  INF_ARG, TST_NUMBER,                      OP_MUL              )
+    _OP_DEF(opexe_2, "/",                              1,  INF_ARG, TST_NUMBER,                      OP_DIV              )
+    _OP_DEF(opexe_2, "quotient",                       2,  2,       TST_INTEGER,                     OP_INTDIV           )
+    _OP_DEF(opexe_2, "remainder",                      2,  2,       TST_INTEGER,                     OP_REM              )
+    _OP_DEF(opexe_2, "modulo",                         2,  2,       TST_INTEGER,                     OP_MOD              )
+    _OP_DEF(opexe_2, "car",                            1,  1,       TST_PAIR,                        OP_CAR              )
+    _OP_DEF(opexe_2, "cdr",                            1,  1,       TST_PAIR,                        OP_CDR              )
+    _OP_DEF(opexe_2, "cons",                           2,  2,       TST_NONE,                        OP_CONS             )
+    _OP_DEF(opexe_2, "set-car!",                       2,  2,       TST_PAIR TST_ANY,                OP_SETCAR           )
+    _OP_DEF(opexe_2, "set-cdr!",                       2,  2,       TST_PAIR TST_ANY,                OP_SETCDR           )
+    _OP_DEF(opexe_2, "byte->integer",                  1,  1,       TST_BYTE,                        OP_BYTE2INT         )
+    _OP_DEF(opexe_2, "integer->byte",                  1,  1,       TST_NATURAL,                     OP_INT2BYTE         )
+    _OP_DEF(opexe_2, "char->integer",                  1,  1,       TST_CHAR,                        OP_CHAR2INT         )
+    _OP_DEF(opexe_2, "integer->char",                  1,  1,       TST_NATURAL,                     OP_INT2CHAR         )
+    _OP_DEF(opexe_2, "char-upcase",                    1,  1,       TST_CHAR,                        OP_CHARUPCASE       )
+    _OP_DEF(opexe_2, "char-downcase",                  1,  1,       TST_CHAR,                        OP_CHARDNCASE       )
+    _OP_DEF(opexe_2, "symbol->string",                 1,  1,       TST_SYMBOL,                      OP_SYM2STR          )
+    _OP_DEF(opexe_2, "atom->string",                   1,  2,       TST_ANY TST_NATURAL,             OP_ATOM2STR         )
+    _OP_DEF(opexe_2, "string->symbol",                 1,  1,       TST_STRING,                      OP_STR2SYM          )
+    _OP_DEF(opexe_2, "string->atom",                   1,  2,       TST_STRING TST_NATURAL,          OP_STR2ATOM         )
+    _OP_DEF(opexe_2, "make-string",                    1,  2,       TST_NATURAL TST_CHAR,            OP_MKSTRING         )
+    _OP_DEF(opexe_2, "string-length",                  1,  1,       TST_STRING,                      OP_STRLEN           )
+    _OP_DEF(opexe_2, "string-ref",                     2,  2,       TST_STRING TST_NATURAL,          OP_STRREF           )
+    _OP_DEF(opexe_2, "string-set!",                    3,  3,       TST_STRING TST_NATURAL TST_CHAR, OP_STRSET           )
+    _OP_DEF(opexe_2, "string-append",                  0,  INF_ARG, TST_STRING,                      OP_STRAPPEND        )
+    _OP_DEF(opexe_2, "substring",                      2,  3,       TST_STRING TST_NATURAL,          OP_SUBSTR           )
+    _OP_DEF(opexe_2, "vector",                         0,  INF_ARG, TST_NONE,                        OP_VECTOR           )
+    _OP_DEF(opexe_2, "make-vector",                    1,  2,       TST_NATURAL TST_ANY,             OP_MKVECTOR         )
+    _OP_DEF(opexe_2, "vector-length",                  1,  1,       TST_VECTOR,                      OP_VECLEN           )
+    _OP_DEF(opexe_2, "vector-ref",                     2,  2,       TST_VECTOR TST_NATURAL,          OP_VECREF           )
+    _OP_DEF(opexe_2, "vector-set!",                    3,  3,       TST_VECTOR TST_NATURAL TST_ANY,  OP_VECSET           )
+    _OP_DEF(opexe_3, "not",                            1,  1,       TST_NONE,                        OP_NOT              )
+    _OP_DEF(opexe_3, "boolean?",                       1,  1,       TST_NONE,                        OP_BOOLP            )
+    _OP_DEF(opexe_3, "eof-object?",                    1,  1,       TST_NONE,                        OP_EOFOBJP          )
+    _OP_DEF(opexe_3, "null?",                          1,  1,       TST_NONE,                        OP_NULLP            )
+    _OP_DEF(opexe_3, "=",                              2,  INF_ARG, TST_NUMBER,                      OP_NUMEQ            )
+    _OP_DEF(opexe_3, "<",                              2,  INF_ARG, TST_NUMBER,                      OP_LESS             )
+    _OP_DEF(opexe_3, ">",                              2,  INF_ARG, TST_NUMBER,                      OP_GRE              )
+    _OP_DEF(opexe_3, "<=",                             2,  INF_ARG, TST_NUMBER,                      OP_LEQ              )
+    _OP_DEF(opexe_3, ">=",                             2,  INF_ARG, TST_NUMBER,                      OP_GEQ              )
+    _OP_DEF(opexe_3, "symbol?",                        1,  1,       TST_ANY,                         OP_SYMBOLP          )
+    _OP_DEF(opexe_3, "number?",                        1,  1,       TST_ANY,                         OP_NUMBERP          )
+    _OP_DEF(opexe_3, "string?",                        1,  1,       TST_ANY,                         OP_STRINGP          )
+    _OP_DEF(opexe_3, "integer?",                       1,  1,       TST_ANY,                         OP_INTEGERP         )
+    _OP_DEF(opexe_3, "real?",                          1,  1,       TST_ANY,                         OP_REALP            )
+    _OP_DEF(opexe_3, "byte?",                          1,  1,       TST_ANY,                         OP_BYTEP            )
+    _OP_DEF(opexe_3, "char?",                          1,  1,       TST_ANY,                         OP_CHARP            )
+#if USE_CHAR_CLASSIFIERS
+    _OP_DEF(opexe_3, "char-alphabetic?",               1,  1,       TST_CHAR,                        OP_CHARAP           )
+    _OP_DEF(opexe_3, "char-numeric?",                  1,  1,       TST_CHAR,                        OP_CHARNP           )
+    _OP_DEF(opexe_3, "char-whitespace?",               1,  1,       TST_CHAR,                        OP_CHARWP           )
+    _OP_DEF(opexe_3, "char-upper-case?",               1,  1,       TST_CHAR,                        OP_CHARUP           )
+    _OP_DEF(opexe_3, "char-lower-case?",               1,  1,       TST_CHAR,                        OP_CHARLP           )
+#endif
+    _OP_DEF(opexe_3, "port?",                          1,  1,       TST_ANY,                         OP_PORTP            )
+    _OP_DEF(opexe_3, "input-port?",                    1,  1,       TST_ANY,                         OP_INPORTP          )
+    _OP_DEF(opexe_3, "output-port?",                   1,  1,       TST_ANY,                         OP_OUTPORTP         )
+    _OP_DEF(opexe_3, "procedure?",                     1,  1,       TST_ANY,                         OP_PROCP            )
+    _OP_DEF(opexe_3, "pair?",                          1,  1,       TST_ANY,                         OP_PAIRP            )
+    _OP_DEF(opexe_3, "list?",                          1,  1,       TST_ANY,                         OP_LISTP            )
+    _OP_DEF(opexe_3, "environment?",                   1,  1,       TST_ANY,                         OP_ENVP             )
+    _OP_DEF(opexe_3, "vector?",                        1,  1,       TST_ANY,                         OP_VECTORP          )
+    _OP_DEF(opexe_3, "eq?",                            2,  2,       TST_ANY,                         OP_EQ               )
+    _OP_DEF(opexe_3, "eqv?",                           2,  2,       TST_ANY,                         OP_EQV              )
+    _OP_DEF(opexe_4, "force",                          1,  1,       TST_ANY,                         OP_FORCE            )
+    _OP_DEF(opexe_4, 0,                                0,  0,       0,                               OP_SAVE_FORCED      )
+    _OP_DEF(opexe_4, "write",                          1,  2,       TST_ANY TST_OUTPORT,             OP_WRITE            )
+    _OP_DEF(opexe_4, "write-byte",                     1,  2,       TST_BYTE TST_OUTPORT,            OP_WRITE_BYTE       )
+    _OP_DEF(opexe_4, "write-char",                     1,  2,       TST_CHAR TST_OUTPORT,            OP_WRITE_CHAR       )
+    _OP_DEF(opexe_4, "display",                        1,  2,       TST_ANY TST_OUTPORT,             OP_DISPLAY          )
+    _OP_DEF(opexe_4, "newline",                        0,  1,       TST_OUTPORT,                     OP_NEWLINE          )
+    _OP_DEF(opexe_4, "error",                          1,  INF_ARG, TST_NONE,                        OP_ERR0             )
+    _OP_DEF(opexe_4, 0,                                0,  0,       0,                               OP_ERR1             )
+    _OP_DEF(opexe_4, "reverse",                        1,  1,       TST_LIST,                        OP_REVERSE          )
+    _OP_DEF(opexe_4, "list*",                          1,  INF_ARG, TST_NONE,                        OP_LIST_STAR        )
+    _OP_DEF(opexe_4, "append",                         0,  INF_ARG, TST_NONE,                        OP_APPEND           )
+#if USE_PLIST
+    _OP_DEF(opexe_4, "put",                            3,  3,       TST_NONE,                        OP_PUT              )
+    _OP_DEF(opexe_4, "get",                            2,  2,       TST_NONE,                        OP_GET              )
+#endif
+    _OP_DEF(opexe_4, "quit",                           0,  1,       TST_NUMBER,                      OP_QUIT             )
+    _OP_DEF(opexe_4, "gc",                             0,  0,       0,                               OP_GC               )
+    _OP_DEF(opexe_4, "gc-verbose",                     0,  1,       TST_NONE,                        OP_GCVERB           )
+    _OP_DEF(opexe_4, "new-segment",                    0,  1,       TST_NUMBER,                      OP_NEWSEGMENT       )
+    _OP_DEF(opexe_4, "oblist",                         0,  0,       0,                               OP_OBLIST           )
+    _OP_DEF(opexe_4, "current-input-port",             0,  0,       0,                               OP_CURR_INPORT      )
+    _OP_DEF(opexe_4, "current-output-port",            0,  0,       0,                               OP_CURR_OUTPORT     )
+    _OP_DEF(opexe_4, "open-input-file",                1,  1,       TST_STRING,                      OP_OPEN_INFILE      )
+    _OP_DEF(opexe_4, "open-output-file",               1,  1,       TST_STRING,                      OP_OPEN_OUTFILE     )
+    _OP_DEF(opexe_4, "open-input-output-file",         1,  1,       TST_STRING,                      OP_OPEN_INOUTFILE   )
+#if USE_STRING_PORTS
+    _OP_DEF(opexe_4, "open-input-string",              1,  1,       TST_STRING,                      OP_OPEN_INSTRING    )
+    _OP_DEF(opexe_4, "open-input-output-string",       1,  1,       TST_STRING,                      OP_OPEN_INOUTSTRING )
+    _OP_DEF(opexe_4, "open-output-string",             0,  1,       TST_STRING,                      OP_OPEN_OUTSTRING   )
+    _OP_DEF(opexe_4, "get-output-string",              1,  1,       TST_OUTPORT,                     OP_GET_OUTSTRING    )
+#endif
+    _OP_DEF(opexe_4, "close-input-port",               1,  1,       TST_INPORT,                      OP_CLOSE_INPORT     )
+    _OP_DEF(opexe_4, "close-output-port",              1,  1,       TST_OUTPORT,                     OP_CLOSE_OUTPORT    )
+    _OP_DEF(opexe_4, "interaction-environment",        0,  0,       0,                               OP_INT_ENV          )
+    _OP_DEF(opexe_4, "current-environment",            0,  0,       0,                               OP_CURR_ENV         )
+    _OP_DEF(opexe_5, "read",                           0,  1,       TST_INPORT,                      OP_READ             )
+    _OP_DEF(opexe_5, "read-char",                      0,  1,       TST_INPORT,                      OP_READ_CHAR        )
+    _OP_DEF(opexe_5, "peek-char",                      0,  1,       TST_INPORT,                      OP_PEEK_CHAR        )
+    _OP_DEF(opexe_5, "char-ready?",                    0,  1,       TST_INPORT,                      OP_CHAR_READY       )
+    _OP_DEF(opexe_5, "read-byte",                      0,  1,       TST_INPORT,                      OP_READ_BYTE        )
+    _OP_DEF(opexe_5, "peek-byte",                      0,  1,       TST_INPORT,                      OP_PEEK_BYTE        )
+    _OP_DEF(opexe_5, "byte-ready?",                    0,  1,       TST_INPORT,                      OP_BYTE_READY       )
+    _OP_DEF(opexe_5, "set-input-port",                 1,  1,       TST_INPORT,                      OP_SET_INPORT       )
+    _OP_DEF(opexe_5, "set-output-port",                1,  1,       TST_OUTPORT,                     OP_SET_OUTPORT      )
+    _OP_DEF(opexe_5, 0,                                0,  0,       0,                               OP_RDSEXPR          )
+    _OP_DEF(opexe_5, 0,                                0,  0,       0,                               OP_RDLIST           )
+    _OP_DEF(opexe_5, 0,                                0,  0,       0,                               OP_RDDOT            )
+    _OP_DEF(opexe_5, 0,                                0,  0,       0,                               OP_RDQUOTE          )
+    _OP_DEF(opexe_5, 0,                                0,  0,       0,                               OP_RDQQUOTE         )
+    _OP_DEF(opexe_5, 0,                                0,  0,       0,                               OP_RDQQUOTEVEC      )
+    _OP_DEF(opexe_5, 0,                                0,  0,       0,                               OP_RDUNQUOTE        )
+    _OP_DEF(opexe_5, 0,                                0,  0,       0,                               OP_RDUQTSP          )
+    _OP_DEF(opexe_5, 0,                                0,  0,       0,                               OP_RDVEC            )
+    _OP_DEF(opexe_5, 0,                                0,  0,       0,                               OP_P0LIST           )
+    _OP_DEF(opexe_5, 0,                                0,  0,       0,                               OP_P1LIST           )
+    _OP_DEF(opexe_5, 0,                                0,  0,       0,                               OP_PVECFROM         )
+    _OP_DEF(opexe_6, "length",                         1,  1,       TST_LIST,                        OP_LIST_LENGTH      )
+    _OP_DEF(opexe_6, "assq",                           2,  2,       TST_NONE,                        OP_ASSQ             )
+    _OP_DEF(opexe_6, "get-closure-code",               1,  1,       TST_NONE,                        OP_GET_CLOSURE      )
+    _OP_DEF(opexe_6, "closure?",                       1,  1,       TST_NONE,                        OP_CLOSUREP         )
+    _OP_DEF(opexe_6, "macro?",                         1,  1,       TST_NONE,                        OP_MACROP           )
+#undef _OP_DEF

plug-ins/script-fu/libscriptfu/tinyscheme/scheme-private.h

@@ -0,0 +1,226 @@
+/* scheme-private.h */
+
+#ifndef _SCHEME_PRIVATE_H
+#define _SCHEME_PRIVATE_H
+
+#include "scheme.h"
+/*------------------ Ugly internals -----------------------------------*/
+/*------------------ Of interest only to FFI users --------------------*/
+
+enum scheme_port_kind {
+  port_free=0,
+  port_file=1,
+  port_string=2,
+  port_srfi6=4,
+  port_input=16,
+  port_output=32,
+  port_saw_EOF=64
+};
+
+typedef struct port {
+  unsigned char kind;
+  union {
+    struct {
+      FILE *file;
+      int closeit;
+#if SHOW_ERROR_LINE
+      int curr_line;
+      char *filename;
+#endif
+    } stdio;
+    struct {
+      char *start;
+      char *past_the_end;
+      char *curr;
+    } string;
+  } rep;
+} port;
+
+/* cell structure */
+struct cell {
+  unsigned int _flag;
+  union {
+    struct {
+      char   *_svalue;
+      int   _length;
+    } _string;
+    num _number;
+    port *_port;
+    foreign_func _ff;
+    struct {
+      struct cell *_car;
+      struct cell *_cdr;
+    } _cons;
+  } _object;
+};
+
+struct scheme {
+/* arrays for segments */
+func_alloc malloc;
+func_dealloc free;
+
+/* return code */
+int retcode;
+int tracing;
+
+
+#ifndef CELL_SEGSIZE
+#define CELL_SEGSIZE    25000 /* # of cells in one segment */
+#endif
+#ifndef CELL_NSEGMENT
+#define CELL_NSEGMENT   50    /* # of segments for cells */
+#endif
+char *alloc_seg[CELL_NSEGMENT];
+pointer cell_seg[CELL_NSEGMENT];
+int     last_cell_seg;
+
+/* We use 5 registers. */
+pointer args;            /* register for arguments of function */
+pointer envir;           /* stack register for current environment */
+pointer code;            /* register for current code */
+pointer dump;            /* stack register for next evaluation */
+pointer foreign_error;   /* used for foreign functions to signal an error */
+
+int interactive_repl;    /* are we in an interactive REPL? */
+int print_output;        /* set to 1 to print results and error messages */
+
+struct cell _sink;
+pointer sink;            /* when mem. alloc. fails */
+struct cell _NIL;
+pointer NIL;             /* special cell representing empty cell */
+struct cell _HASHT;
+pointer T;               /* special cell representing #t */
+struct cell _HASHF;
+pointer F;               /* special cell representing #f */
+struct cell _EOF_OBJ;
+pointer EOF_OBJ;         /* special cell representing end-of-file object */
+pointer oblist;          /* pointer to symbol table */
+pointer global_env;      /* pointer to global environment */
+
+pointer c_nest;          /* stack for nested calls from C */
+
+/* global pointers to special symbols */
+pointer LAMBDA;          /* pointer to syntax lambda */
+pointer QUOTE;           /* pointer to syntax quote */
+
+pointer QQUOTE;          /* pointer to symbol quasiquote */
+pointer UNQUOTE;         /* pointer to symbol unquote */
+pointer UNQUOTESP;       /* pointer to symbol unquote-splicing */
+pointer FEED_TO;         /* => */
+pointer COLON_HOOK;      /* *colon-hook* */
+pointer ERROR_HOOK;      /* *error-hook* */
+pointer SHARP_HOOK;      /* *sharp-hook* */
+pointer COMPILE_HOOK;    /* *compile-hook* */
+
+pointer free_cell;       /* pointer to top of free cells */
+long    fcells;          /* # of free cells */
+
+pointer inport;
+pointer outport;
+pointer save_inport;
+pointer loadport;
+
+#ifndef MAXFIL
+#define MAXFIL 64
+#endif
+port load_stack[MAXFIL]; /* Stack of open files for port -1 (LOADing) */
+int nesting_stack[MAXFIL];
+int file_i;
+int nesting;
+
+char    gc_verbose;      /* if gc_verbose is not zero, print gc status */
+char    no_memory;       /* Whether mem. alloc. has failed */
+
+#ifndef LINESIZE
+#define LINESIZE 1024
+#endif
+char    linebuff[LINESIZE];
+#ifndef STRBUFFSIZE
+#define STRBUFFSIZE 1024
+#endif
+char    strbuff[STRBUFFSIZE];
+
+FILE *tmpfp;
+int tok;
+int print_flag;
+pointer value;
+int op;
+
+void *ext_data;      /* For the benefit of foreign functions */
+long gensym_cnt;
+
+struct scheme_interface *vptr;
+void *dump_base;     /* pointer to base of allocated dump stack */
+int dump_size;       /* number of frames allocated for dump stack */
+};
+
+/* operator code */
+enum scheme_opcodes {
+#define _OP_DEF(A,B,C,D,E,OP) OP,
+#include "opdefines.h"
+  OP_MAXDEFINED
+};
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#define cons(sc,a,b) _cons(sc,a,b,0)
+#define immutable_cons(sc,a,b) _cons(sc,a,b,1)
+
+int is_string(pointer p);
+char *string_value(pointer p);
+int is_number(pointer p);
+num nvalue(pointer p);
+long ivalue(pointer p);
+double rvalue(pointer p);
+int is_integer(pointer p);
+int is_real(pointer p);
+int is_byte (pointer p);
+int is_character(pointer p);
+int string_length(pointer p);
+guint8 bytevalue (pointer p);
+gunichar charvalue(pointer p);
+int is_vector(pointer p);
+
+int is_port(pointer p);
+int is_inport(pointer p);
+int is_outport(pointer p);
+
+int is_pair(pointer p);
+pointer pair_car(pointer p);
+pointer pair_cdr(pointer p);
+pointer set_car(pointer p, pointer q);
+pointer set_cdr(pointer p, pointer q);
+
+int is_symbol(pointer p);
+char *symname(pointer p);
+char *symkey(pointer p);
+int hasprop(pointer p);
+
+int is_syntax(pointer p);
+int is_proc(pointer p);
+int is_foreign(pointer p);
+char *syntaxname(pointer p);
+int is_closure(pointer p);
+int is_macro(pointer p);
+pointer closure_code(pointer p);
+pointer closure_env(pointer p);
+
+int is_continuation(pointer p);
+int is_promise(pointer p);
+int is_environment(pointer p);
+int is_immutable(pointer p);
+void setimmutable(pointer p);
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif
+
+/*
+Local variables:
+c-file-style: "k&r"
+End:
+*/

plug-ins/script-fu/libscriptfu/tinyscheme/scheme.h

@@ -0,0 +1,277 @@
+/* SCHEME.H */
+
+#ifndef _SCHEME_H
+#define _SCHEME_H
+
+#include <stdio.h>
+#include <glib.h>
+#include <glib/gstdio.h>
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/*
+ * Default values for #define'd symbols
+ */
+#ifndef STANDALONE       /* If used as standalone interpreter */
+# define STANDALONE 1
+#endif
+
+#ifndef _MSC_VER
+# ifndef USE_STRLWR
+#   define USE_STRLWR 1
+# endif
+# define SCHEME_EXPORT extern
+#else
+# define USE_STRLWR 0
+# ifdef _SCHEME_SOURCE
+#  define SCHEME_EXPORT __declspec(dllexport)
+# else
+#  define SCHEME_EXPORT __declspec(dllimport)
+# endif
+#endif
+
+#if USE_NO_FEATURES
+# define USE_MATH 0
+# define USE_CHAR_CLASSIFIERS 0
+# define USE_ASCII_NAMES 0
+# define USE_STRING_PORTS 0
+# define USE_ERROR_HOOK 0
+# define USE_TRACING 0
+# define USE_COLON_HOOK 0
+# define USE_DL 0
+# define USE_PLIST 0
+#endif
+
+/*
+ * Leave it defined if you want continuations, and also for the Sharp Zaurus.
+ * Undefine it if you only care about faster speed and not strict Scheme compatibility.
+ */
+#define USE_SCHEME_STACK
+
+#if USE_DL
+# define USE_INTERFACE 1
+#endif
+
+
+#ifndef USE_MATH         /* If math support is needed */
+# define USE_MATH 1
+#endif
+
+#ifndef USE_CHAR_CLASSIFIERS  /* If char classifiers are needed */
+# define USE_CHAR_CLASSIFIERS 1
+#endif
+
+#ifndef USE_ASCII_NAMES  /* If extended escaped characters are needed */
+# define USE_ASCII_NAMES 1
+#endif
+
+#ifndef USE_STRING_PORTS      /* Enable string ports */
+# define USE_STRING_PORTS 1
+#endif
+
+#ifndef USE_TRACING
+#define USE_TRACING 1
+#endif
+
+#ifndef USE_PLIST
+# define USE_PLIST 0
+#endif
+
+/* To force system errors through user-defined error handling (see *error-hook*) */
+#ifndef USE_ERROR_HOOK
+# define USE_ERROR_HOOK 1
+#endif
+
+#ifndef USE_COLON_HOOK   /* Enable qualified qualifier */
+# define USE_COLON_HOOK 1
+#endif
+
+#ifndef USE_STRLWR
+# define USE_STRLWR 1
+#endif
+
+#ifndef STDIO_ADDS_CR    /* Define if DOS/Windows */
+# define STDIO_ADDS_CR 0
+#endif
+
+#ifndef INLINE
+# define INLINE
+#endif
+
+#ifndef USE_INTERFACE
+# define USE_INTERFACE 0
+#endif
+
+#ifndef SHOW_ERROR_LINE   /* Show error line in file */
+# define SHOW_ERROR_LINE 1
+#endif
+
+typedef struct scheme scheme;
+typedef struct cell *pointer;
+
+typedef void * (*func_alloc)(size_t);
+typedef void (*func_dealloc)(void *);
+
+/* num, for generic arithmetic */
+typedef struct num {
+     char is_fixnum;
+     union {
+          long ivalue;
+          double rvalue;
+     } value;
+} num;
+
+#if !STANDALONE
+
+typedef enum { TS_OUTPUT_NORMAL, TS_OUTPUT_ERROR } TsOutputType;
+
+typedef void (* ts_output_func)       (TsOutputType    type,
+                                       const char     *string,
+                                       int             len,
+                                       gpointer        data);
+
+SCHEME_EXPORT void ts_register_output_func (ts_output_func  func,
+                                            gpointer        user_data);
+SCHEME_EXPORT void ts_output_string        (TsOutputType    type,
+                                            const char     *string,
+                                            int             len);
+#endif
+
+SCHEME_EXPORT scheme *scheme_init_new(void);
+SCHEME_EXPORT scheme *scheme_init_new_custom_alloc(func_alloc malloc, func_dealloc free);
+SCHEME_EXPORT int scheme_init(scheme *sc);
+SCHEME_EXPORT int scheme_init_custom_alloc(scheme *sc, func_alloc, func_dealloc);
+SCHEME_EXPORT void scheme_deinit(scheme *sc);
+SCHEME_EXPORT void scheme_set_input_port_file(scheme *sc, FILE *fin);
+void scheme_set_input_port_string(scheme *sc, char *start, char *past_the_end);
+SCHEME_EXPORT void scheme_set_output_port_file(scheme *sc, FILE *fin);
+void scheme_set_output_port_string(scheme *sc, char *start, char *past_the_end);
+SCHEME_EXPORT void scheme_load_file(scheme *sc, FILE *fin);
+SCHEME_EXPORT void scheme_load_named_file(scheme *sc, FILE *fin, const char *filename);
+SCHEME_EXPORT void scheme_load_string(scheme *sc, const char *cmd);
+SCHEME_EXPORT pointer scheme_apply0(scheme *sc, const char *procname);
+SCHEME_EXPORT pointer scheme_call(scheme *sc, pointer func, pointer args);
+SCHEME_EXPORT pointer scheme_eval(scheme *sc, pointer obj);
+void scheme_set_external_data(scheme *sc, void *p);
+SCHEME_EXPORT void scheme_define(scheme *sc, pointer env, pointer symbol, pointer value);
+
+typedef pointer (*foreign_func)(scheme *, pointer);
+
+pointer _cons(scheme *sc, pointer a, pointer b, int immutable);
+pointer mk_integer(scheme *sc, long num);
+pointer mk_real(scheme *sc, double num);
+pointer mk_symbol(scheme *sc, const char *name);
+pointer gensym(scheme *sc);
+pointer mk_string(scheme *sc, const char *str);
+pointer mk_counted_string(scheme *sc, const char *str, int len);
+pointer mk_empty_string(scheme *sc, int len, gunichar fill);
+pointer mk_byte (scheme *sc, guint8 b);
+pointer mk_character(scheme *sc, gunichar c);
+pointer mk_foreign_func(scheme *sc, foreign_func f);
+void    putcharacter(scheme *sc, gunichar c);
+void    putstr(scheme *sc, const char *s);
+int list_length(scheme *sc, pointer a);
+int eqv(pointer a, pointer b);
+
+SCHEME_EXPORT pointer foreign_error (scheme *sc, const char *s, pointer a);
+
+#if USE_INTERFACE
+struct scheme_interface {
+  void (*scheme_define)(scheme *sc, pointer env, pointer symbol, pointer value);
+  pointer (*cons)(scheme *sc, pointer a, pointer b);
+  pointer (*immutable_cons)(scheme *sc, pointer a, pointer b);
+  pointer (*reserve_cells)(scheme *sc, int n);
+  pointer (*mk_integer)(scheme *sc, long num);
+  pointer (*mk_real)(scheme *sc, double num);
+  pointer (*mk_symbol)(scheme *sc, const char *name);
+  pointer (*gensym)(scheme *sc);
+  pointer (*mk_string)(scheme *sc, const char *str);
+  pointer (*mk_counted_string)(scheme *sc, const char *str, int len);
+  pointer (*mk_byte)(scheme *sc, guint8 b);
+  pointer (*mk_character)(scheme *sc, gunichar c);
+  pointer (*mk_vector)(scheme *sc, int len);
+  pointer (*mk_foreign_func)(scheme *sc, foreign_func f);
+  pointer (*mk_closure)(scheme *sc, pointer c, pointer e);
+  void (*putstr)(scheme *sc, const char *s);
+  void (*putcharacter)(scheme *sc, gunichar c);
+
+  int (*is_string)(pointer p);
+  int (*string_length)(pointer p);
+  char *(*string_value)(pointer p);
+  int (*is_number)(pointer p);
+  num (*nvalue)(pointer p);
+  long (*ivalue)(pointer p);
+  double (*rvalue)(pointer p);
+  int (*is_integer)(pointer p);
+  int (*is_real)(pointer p);
+  int (*is_byte)(pointer p);
+  int (*is_character)(pointer p);
+  guint8 (*bytevalue)(pointer p);
+  gunichar (*charvalue)(pointer p);
+  int (*is_list)(scheme *sc, pointer p);
+  int (*is_vector)(pointer p);
+  int (*list_length)(scheme *sc, pointer p);
+  long (*vector_length)(pointer vec);
+  void (*fill_vector)(pointer vec, pointer elem);
+  pointer (*vector_elem)(pointer vec, int ielem);
+  pointer (*set_vector_elem)(pointer vec, int ielem, pointer newel);
+
+  int (*is_port)(pointer p);
+
+  int (*is_pair)(pointer p);
+  pointer (*pair_car)(pointer p);
+  pointer (*pair_cdr)(pointer p);
+  pointer (*set_car)(pointer p, pointer q);
+  pointer (*set_cdr)(pointer p, pointer q);
+
+  int (*is_symbol)(pointer p);
+  char *(*symname)(pointer p);
+
+  int (*is_syntax)(pointer p);
+  int (*is_proc)(pointer p);
+  int (*is_foreign)(pointer p);
+  char *(*syntaxname)(pointer p);
+  int (*is_closure)(pointer p);
+  int (*is_macro)(pointer p);
+  pointer (*closure_code)(pointer p);
+  pointer (*closure_env)(pointer p);
+
+  int (*is_continuation)(pointer p);
+  int (*is_promise)(pointer p);
+  int (*is_environment)(pointer p);
+  int (*is_immutable)(pointer p);
+  void (*setimmutable)(pointer p);
+
+  void (*load_file)(scheme *sc, FILE *fin);
+  void (*load_string)(scheme *sc, const char *input);
+};
+#endif
+
+#if !STANDALONE
+typedef struct scheme_registerable
+{
+  foreign_func  f;
+  const char *  name;
+}
+scheme_registerable;
+
+void scheme_register_foreign_func(scheme * sc, scheme_registerable * sr);
+void scheme_register_foreign_func_list(scheme * sc,
+                                      scheme_registerable * list,
+                                      int n);
+
+#endif /* !STANDALONE */
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif
+
+/*
+Local variables:
+c-file-style: "k&r"
+End:
+*/

plug-ins/script-fu/meson.build

@@ -0,0 +1,65 @@
+
+# Build executable plugins that define several PDB procs.
+# An executable is not versioned since installed private in /plug-ins
+
+# Not define include_directories; no higher pika source references scriptfu
+
+# Not using c_args: -DSTANDALONE=0','-DUSE_INTERFACE=1','-DUSE_STRLWR=0',
+# since those are compile time switches for tinyscheme, not present in this dir
+
+subdir('libscriptfu')
+subdir('scripts')
+subdir('server')
+subdir('interpreter')
+subdir('console')
+subdir('test')
+
+
+executable_name = 'script-fu'
+
+# script-fu.c registers registers many PDB procs in the PDB.
+# Several source files implement the PDB procedures of type PLUGIN, of similar names.
+# script-fu.c also implements PDB procedure of type EXTENSION "extension-script-fu"
+
+plugin_sources = [
+  'script-fu-eval.c',
+  'script-fu-text-console.c',
+
+  'script-fu.c',
+]
+
+if platform_windows
+  plugin_sources += windows.compile_resources(
+    plugin_rc,
+    args: [
+      '--define', 'ORIGINALFILENAME_STR="@0@"'.format(executable_name+'.exe'),
+      '--define', 'INTERNALNAME_STR="@0@"'    .format(executable_name),
+      '--define', 'TOP_SRCDIR="@0@"'          .format(meson.project_source_root()),
+    ],
+    include_directories: [
+      rootInclude, appInclude,
+    ],
+  )
+endif
+
+# Several components use Gtk
+
+# libscriptfu is installed to standard place; no rpath necessary
+
+executable(executable_name,
+  plugin_sources,
+  dependencies: [
+    libpikaui_dep,
+    math,
+    gi,
+  ],
+  c_args: [
+    '-DG_LOG_DOMAIN="scriptfu"',
+  ],
+  include_directories: [
+    libscriptfuInclude,
+  ],
+  link_with : [libscriptfuconsole, libscriptfu ],
+  install: true,
+  install_dir: pikaplugindir / 'plug-ins' / executable_name,
+)

plug-ins/script-fu/script-fu-eval.c

@@ -0,0 +1,73 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * 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 "libpika/pika.h"
+
+#include "script-fu-eval.h"
+
+#include "script-fu-lib.h"
+#include "script-fu-intl.h"
+
+
+PikaValueArray *
+script_fu_eval_run (PikaProcedure        *procedure,
+                    PikaRunMode           run_mode,
+                    const gchar          *code,
+                    const PikaValueArray *args)
+{
+  GString           *output = g_string_new (NULL);
+  PikaPDBStatusType  status = PIKA_PDB_SUCCESS;
+
+  script_fu_set_run_mode (run_mode);
+  script_fu_redirect_output_to_gstr (output);
+
+  switch (run_mode)
+    {
+    case PIKA_RUN_NONINTERACTIVE:
+      if (script_fu_interpret_string (code) != 0)
+        status = PIKA_PDB_EXECUTION_ERROR;
+      break;
+
+    case PIKA_RUN_INTERACTIVE:
+    case PIKA_RUN_WITH_LAST_VALS:
+      status        = PIKA_PDB_CALLING_ERROR;
+      g_string_assign (output, _("Script-Fu evaluation mode only allows "
+                                 "non-interactive invocation"));
+      break;
+
+    default:
+      break;
+    }
+
+  if (status != PIKA_PDB_SUCCESS && output->len > 0)
+    {
+      GError *error = g_error_new_literal (g_quark_from_string("scriptfu"), 0,
+                                           g_string_free (output, FALSE));
+
+      return pika_procedure_new_return_values (procedure, status, error);
+    }
+
+  g_string_free (output, TRUE);
+
+  return pika_procedure_new_return_values (procedure, status, NULL);
+}

plug-ins/script-fu/script-fu-eval.h

@@ -0,0 +1,32 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#ifndef __SCRIPT_FU_EVAL_H__
+#define __SCRIPT_FU_EVAL_H__
+
+
+PikaValueArray * script_fu_eval_run (PikaProcedure        *procedure,
+                                     PikaRunMode           run_mode,
+                                     const gchar          *code,
+                                     const PikaValueArray *args);
+
+
+#endif /*  __SCRIPT_FU_EVAL_H__  */

plug-ins/script-fu/script-fu-text-console.c

@@ -0,0 +1,55 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * 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 <stdio.h>
+#include <errno.h>
+
+#if HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
+#include "libpika/pika.h"
+
+#include "script-fu-text-console.h"
+
+#include "script-fu-intl.h"
+#include "script-fu-lib.h"
+
+PikaValueArray *
+script_fu_text_console_run (PikaProcedure        *procedure,
+                            const PikaValueArray *args)
+{
+  script_fu_redirect_output_to_stdout ();
+
+  script_fu_print_welcome ();
+
+  pika_plug_in_set_pdb_error_handler (pika_procedure_get_plug_in (procedure),
+                                      PIKA_PDB_ERROR_HANDLER_PLUGIN);
+
+  script_fu_run_read_eval_print_loop ();
+
+  pika_plug_in_set_pdb_error_handler (pika_procedure_get_plug_in (procedure),
+                                      PIKA_PDB_ERROR_HANDLER_INTERNAL);
+
+  return pika_procedure_new_return_values (procedure, PIKA_PDB_SUCCESS, NULL);
+}

plug-ins/script-fu/script-fu-text-console.h

@@ -0,0 +1,30 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#ifndef __SCRIPT_FU_TEXT_CONSOLE_H__
+#define __SCRIPT_FU_TEXT_CONSOLE_H__
+
+
+PikaValueArray * script_fu_text_console_run (PikaProcedure        *procedure,
+                                             const PikaValueArray *args);
+
+
+#endif /*  __SCRIPT_FU_TEXT_CONSOLE_H__  */

plug-ins/script-fu/script-fu.c

@@ -0,0 +1,399 @@
+/* PIKA - Photo and Image Kooker Application
+ * a rebranding of The GNU Image Manipulation Program (created with heckimp)
+ * A derived work which may be trivial. However, any changes may be (C)2023 by Aldercone Studio
+ *
+ * Original copyright, applying to most contents (license remains unchanged): 
+ * 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 <string.h>
+
+#include <libpika/pika.h>
+
+#include "console/script-fu-console.h"
+#include "script-fu-eval.h"
+#include "script-fu-text-console.h"
+
+#include "libscriptfu/script-fu-lib.h"
+#include "libscriptfu/script-fu-intl.h"
+
+
+#define SCRIPT_FU_TYPE (script_fu_get_type ())
+G_DECLARE_FINAL_TYPE (ScriptFu, script_fu, SCRIPT, FU, PikaPlugIn)
+
+struct _ScriptFu
+{
+  PikaPlugIn      parent_instance;
+};
+
+static GList          * script_fu_query_procedures (PikaPlugIn           *plug_in);
+static PikaProcedure  * script_fu_create_procedure (PikaPlugIn           *plug_in,
+                                                    const gchar          *name);
+
+static PikaValueArray * script_fu_run              (PikaProcedure        *procedure,
+                                                    const PikaValueArray *args,
+                                                    gpointer              run_data);
+static PikaValueArray * script_fu_batch_run        (PikaProcedure        *procedure,
+                                                    PikaRunMode           run_mode,
+                                                    const gchar          *code,
+                                                    const PikaValueArray *args,
+                                                    gpointer              run_data);
+static void             script_fu_run_init         (PikaProcedure        *procedure,
+                                                    PikaRunMode           run_mode);
+static void             script_fu_extension_init   (PikaPlugIn           *plug_in);
+static PikaValueArray * script_fu_refresh_proc     (PikaProcedure        *procedure,
+                                                    const PikaValueArray *args,
+                                                    gpointer              run_data);
+
+
+G_DEFINE_TYPE (ScriptFu, script_fu, PIKA_TYPE_PLUG_IN)
+
+PIKA_MAIN (SCRIPT_FU_TYPE)
+DEFINE_STD_SET_I18N
+
+
+static void
+script_fu_class_init (ScriptFuClass *klass)
+{
+  PikaPlugInClass *plug_in_class = PIKA_PLUG_IN_CLASS (klass);
+
+  plug_in_class->query_procedures = script_fu_query_procedures;
+  plug_in_class->create_procedure = script_fu_create_procedure;
+  plug_in_class->set_i18n         = STD_SET_I18N;
+}
+
+static void
+script_fu_init (ScriptFu *script_fu)
+{
+}
+
+static GList *
+script_fu_query_procedures (PikaPlugIn *plug_in)
+{
+  GList *list = NULL;
+
+  list = g_list_append (list, g_strdup ("extension-script-fu"));
+  list = g_list_append (list, g_strdup ("plug-in-script-fu-console"));
+  list = g_list_append (list, g_strdup ("plug-in-script-fu-text-console"));
+  list = g_list_append (list, g_strdup ("plug-in-script-fu-eval"));
+
+  return list;
+}
+
+static PikaProcedure *
+script_fu_create_procedure (PikaPlugIn  *plug_in,
+                            const gchar *name)
+{
+  PikaProcedure *procedure = NULL;
+
+  if (! strcmp (name, "extension-script-fu"))
+    {
+      procedure = pika_procedure_new (plug_in, name,
+                                      PIKA_PDB_PROC_TYPE_EXTENSION,
+                                      script_fu_run, NULL, NULL);
+
+      pika_procedure_set_documentation (procedure,
+                                        "A scheme interpreter for scripting "
+                                        "PIKA operations",
+                                        "More help here later",
+                                        NULL);
+      pika_procedure_set_attribution (procedure,
+                                      "Spencer Kimball & Peter Mattis",
+                                      "Spencer Kimball & Peter Mattis",
+                                      "1997");
+    }
+  else if (! strcmp (name, "plug-in-script-fu-console"))
+    {
+      procedure = pika_procedure_new (plug_in, name,
+                                      PIKA_PDB_PROC_TYPE_PLUGIN,
+                                      script_fu_run, NULL, NULL);
+
+      pika_procedure_set_menu_label (procedure, _("Script-Fu _Console"));
+      pika_procedure_add_menu_path (procedure,
+                                    "<Image>/Filters/Development/Script-Fu");
+
+      pika_procedure_set_documentation (procedure,
+                                        _("Interactive console for Script-Fu "
+                                          "development"),
+                                        "Provides an interface which allows "
+                                        "interactive scheme development.",
+                                        name);
+      pika_procedure_set_attribution (procedure,
+                                      "Spencer Kimball & Peter Mattis",
+                                      "Spencer Kimball & Peter Mattis",
+                                      "1997");
+
+      PIKA_PROC_ARG_ENUM (procedure, "run-mode",
+                          "Run mode",
+                          "The run mode",
+                          PIKA_TYPE_RUN_MODE,
+                          PIKA_RUN_INTERACTIVE,
+                          G_PARAM_READWRITE);
+      PIKA_PROC_AUX_ARG_STRV (procedure, "history",
+                              "Command history",
+                              "History",
+                              G_PARAM_READWRITE);
+    }
+  else if (! strcmp (name, "plug-in-script-fu-text-console"))
+    {
+      procedure = pika_procedure_new (plug_in, name,
+                                      PIKA_PDB_PROC_TYPE_PLUGIN,
+                                      script_fu_run, NULL, NULL);
+
+      pika_procedure_set_documentation (procedure,
+                                        "Provides a text console mode for "
+                                        "script-fu development",
+                                        "Provides an interface which allows "
+                                        "interactive scheme development.",
+                                        name);
+      pika_procedure_set_attribution (procedure,
+                                      "Spencer Kimball & Peter Mattis",
+                                      "Spencer Kimball & Peter Mattis",
+                                      "1997");
+
+      PIKA_PROC_ARG_ENUM (procedure, "run-mode",
+                          "Run mode",
+                          "The run mode",
+                          PIKA_TYPE_RUN_MODE,
+                          PIKA_RUN_INTERACTIVE,
+                          G_PARAM_READWRITE);
+    }
+  else if (! strcmp (name, "plug-in-script-fu-eval"))
+    {
+      procedure = pika_batch_procedure_new (plug_in, name, "Script-fu (scheme)",
+                                            PIKA_PDB_PROC_TYPE_PLUGIN,
+                                            script_fu_batch_run, NULL, NULL);
+
+      pika_procedure_set_documentation (procedure,
+                                        "Evaluate scheme code",
+                                        "Evaluate the code under the scheme "
+                                        "interpreter (primarily for batch mode)",
+                                        name);
+      pika_procedure_set_attribution (procedure,
+                                      "Manish Singh",
+                                      "Manish Singh",
+                                      "1998");
+    }
+
+  return procedure;
+}
+
+static PikaValueArray *
+script_fu_run (PikaProcedure        *procedure,
+               const PikaValueArray *args,
+               gpointer              run_data)
+{
+  PikaPlugIn     *plug_in     = pika_procedure_get_plug_in (procedure);
+  const gchar    *name        = pika_procedure_get_name (procedure);
+  PikaValueArray *return_vals = NULL;
+
+  if (pika_value_array_length (args) > 0)
+    script_fu_run_init (procedure, PIKA_VALUES_GET_ENUM (args, 0));
+  else
+    script_fu_run_init (procedure, PIKA_RUN_NONINTERACTIVE);
+
+  if (strcmp (name, "extension-script-fu") == 0)
+    {
+      /*
+       *  The main script-fu extension.
+       */
+
+      /*  Acknowledge that the extension is properly initialized  */
+      pika_procedure_extension_ready (procedure);
+
+      /*  Go into an endless loop  */
+      while (TRUE)
+        pika_plug_in_extension_process (plug_in, 0);
+    }
+  else if (strcmp (name, "plug-in-script-fu-text-console") == 0)
+    {
+      /*
+       *  The script-fu text console for interactive Scheme development
+       */
+
+      return_vals = script_fu_text_console_run (procedure, args);
+    }
+  else if (strcmp (name, "plug-in-script-fu-console") == 0)
+    {
+      /*
+       *  The script-fu console for interactive Scheme development
+       */
+
+      return_vals = script_fu_console_run (procedure, args);
+    }
+
+  if (! return_vals)
+    return_vals = pika_procedure_new_return_values (procedure,
+                                                    PIKA_PDB_SUCCESS,
+                                                    NULL);
+
+  return return_vals;
+}
+
+static PikaValueArray *
+script_fu_batch_run (PikaProcedure        *procedure,
+                     PikaRunMode           run_mode,
+                     const gchar          *code,
+                     const PikaValueArray *args,
+                     gpointer              run_data)
+{
+  const gchar    *name        = pika_procedure_get_name (procedure);
+  PikaValueArray *return_vals = NULL;
+
+  script_fu_run_init (procedure, run_mode);
+
+  if (strcmp (name, "plug-in-script-fu-eval") == 0)
+    {
+      /*
+       *  A non-interactive "console" (for batch mode)
+       */
+
+      if (g_strcmp0 (code, "-") == 0)
+        /* Redirecting to script-fu text console, for backward compatibility  */
+        return_vals = script_fu_text_console_run (procedure, args);
+      else
+        return_vals = script_fu_eval_run (procedure, run_mode, code, args);
+    }
+
+  if (! return_vals)
+    return_vals = pika_procedure_new_return_values (procedure,
+                                                    PIKA_PDB_SUCCESS,
+                                                    NULL);
+
+  return return_vals;
+}
+
+static void
+script_fu_run_init (PikaProcedure *procedure,
+                    PikaRunMode    run_mode)
+{
+  PikaPlugIn     *plug_in     = pika_procedure_get_plug_in (procedure);
+  const gchar    *name        = pika_procedure_get_name (procedure);
+  GList          *path;
+
+  path = script_fu_search_path ();
+
+  /*  Determine before we allow scripts to register themselves
+   *   whether this is the base, automatically installed script-fu extension
+   */
+  if (strcmp (name, "extension-script-fu") == 0)
+    {
+      /*  Setup auxiliary temporary procedures for the base extension  */
+      script_fu_extension_init (plug_in);
+
+      /*  Init the interpreter, allow register scripts */
+      script_fu_init_embedded_interpreter (path, TRUE, run_mode);
+    }
+  else
+    {
+      /*  Init the interpreter, not allow register scripts */
+      script_fu_init_embedded_interpreter (path, FALSE, run_mode);
+    }
+
+  script_fu_find_and_register_scripts (plug_in, path);
+
+  g_list_free_full (path, (GDestroyNotify) g_object_unref);
+}
+
+static void
+script_fu_extension_init (PikaPlugIn *plug_in)
+{
+  PikaProcedure *procedure;
+
+  pika_plug_in_add_menu_branch (plug_in, "<Image>/Help", N_("_PIKA Online"));
+  pika_plug_in_add_menu_branch (plug_in, "<Image>/Help", N_("_User Manual"));
+
+  pika_plug_in_add_menu_branch (plug_in, "<Image>/Filters/Development",
+                                N_("_Script-Fu"));
+  pika_plug_in_add_menu_branch (plug_in, "<Image>/Filters/Development/Script-Fu",
+                                N_("_Test"));
+
+  pika_plug_in_add_menu_branch (plug_in, "<Image>/File/Create",
+                                N_("_Buttons"));
+  pika_plug_in_add_menu_branch (plug_in, "<Image>/File/Create",
+                                N_("_Logos"));
+  pika_plug_in_add_menu_branch (plug_in, "<Image>/File/Create",
+                                N_("_Patterns"));
+
+  pika_plug_in_add_menu_branch (plug_in, "<Image>/File/Create",
+                                N_("_Web Page Themes"));
+  pika_plug_in_add_menu_branch (plug_in, "<Image>/File/Create/Web Page Themes",
+                                N_("_Alien Glow"));
+  pika_plug_in_add_menu_branch (plug_in, "<Image>/File/Create/Web Page Themes",
+                                N_("_Beveled Pattern"));
+  pika_plug_in_add_menu_branch (plug_in, "<Image>/File/Create/Web Page Themes",
+                                N_("_Classic.Pika.Org"));
+
+  pika_plug_in_add_menu_branch (plug_in, "<Image>/Filters",
+                                N_("Alpha to _Logo"));
+
+  procedure = pika_procedure_new (plug_in, "script-fu-refresh",
+                                  PIKA_PDB_PROC_TYPE_TEMPORARY,
+                                  script_fu_refresh_proc, NULL, NULL);
+
+  pika_procedure_set_menu_label (procedure, _("_Refresh Scripts"));
+  pika_procedure_add_menu_path (procedure,
+                                "<Image>/Filters/Development/Script-Fu");
+
+  pika_procedure_set_documentation (procedure,
+                                    _("Re-read all available Script-Fu scripts"),
+                                    "Re-read all available Script-Fu scripts",
+                                    "script-fu-refresh");
+  pika_procedure_set_attribution (procedure,
+                                  "Spencer Kimball & Peter Mattis",
+                                  "Spencer Kimball & Peter Mattis",
+                                  "1997");
+
+  PIKA_PROC_ARG_ENUM (procedure, "run-mode",
+                      "Run mode",
+                      "The run mode",
+                      PIKA_TYPE_RUN_MODE,
+                      PIKA_RUN_INTERACTIVE,
+                      G_PARAM_READWRITE);
+
+  pika_plug_in_add_temp_procedure (plug_in, procedure);
+  g_object_unref (procedure);
+}
+
+static PikaValueArray *
+script_fu_refresh_proc (PikaProcedure        *procedure,
+                        const PikaValueArray *args,
+                        gpointer              run_data)
+{
+  if (script_fu_extension_is_busy ())
+    {
+      g_message (_("You can not use \"Refresh Scripts\" while a "
+                   "Script-Fu dialog box is open.  Please close "
+                   "all Script-Fu windows and try again."));
+
+      return pika_procedure_new_return_values (procedure,
+                                               PIKA_PDB_EXECUTION_ERROR,
+                                               NULL);
+    }
+  else
+    {
+      /*  Reload all of the available scripts  */
+      GList *path = script_fu_search_path ();
+
+      script_fu_find_and_register_scripts (pika_procedure_get_plug_in (procedure), path);
+
+      g_list_free_full (path, (GDestroyNotify) g_object_unref);
+    }
+
+  return pika_procedure_new_return_values (procedure, PIKA_PDB_SUCCESS, NULL);
+}

plug-ins/script-fu/scripts/add-bevel.scm

@@ -0,0 +1,202 @@
+; PIKA - Photo and Image Kooker Application
+; Copyright (C) 1995 Spencer Kimball and Peter Mattis
+;
+; add-bevel.scm version 1.04
+; Time-stamp: <2004-02-09 17:07:06 simon>
+;
+; 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/>.
+;
+; Copyright (C) 1997 Andrew Donkin  (ard@cs.waikato.ac.nz)
+; Contains code from add-shadow.scm by Sven Neumann
+; (neumanns@uni-duesseldorf.de) (thanks Sven).
+;
+; Adds a bevel to an image.  See http://www.cs.waikato.ac.nz/~ard/pika/
+;
+; If there is a selection, it is bevelled.
+; Otherwise if there is an alpha channel, the selection is taken from it
+; and bevelled.
+; Otherwise the part of the layer inside the image boundaries is bevelled.
+;
+; The selection is set on exit, so Select->Invert then Edit->Clear will
+; leave a cut-out.  Then use Sven's add-shadow for that
+; floating-bumpmapped-texture cliche.
+
+;
+; 1.01: now works on offset layers.
+; 1.02: has crop-pixel-border option to trim one pixel off each edge of the
+;       bevelled image.  Bumpmapping leaves edge pixels unchanged, which
+;       looks bad.  Oddly, this is not apparent in PIKA - you have to
+;       save the image and load it into another viewer.  First noticed in
+;       Nutscrape.
+;       Changed path (removed "filters/").
+; 1.03: adds one-pixel border before bumpmapping, and removes it after.
+;       Got rid of the crop-pixel-border option (no longer reqd).
+; 1.04: Fixed undo handling, ensure that bumpmap is big enough,
+;       (instead of resizing the image). Removed references to outdated
+;       bumpmap plugin.     (Simon)
+; 1.05  When there is no selection, bevel the whole layer instead of the
+;       whole image (which was broken in the first place).
+;       Also fixed some bugs with setting the selection when there is no
+;       initial selection.     (Barak Itkin)
+;
+
+(define (script-fu-add-bevel img
+                             drawable
+                             thickness
+                             work-on-copy
+                             keep-bump-layer)
+
+  (let* (
+        (index 1)
+        (greyness 0)
+        (thickness (abs thickness))
+        (type (car (pika-drawable-type-with-alpha drawable)))
+        (image (if (= work-on-copy TRUE) (car (pika-image-duplicate img)) img))
+        (pic-layer (aref (cadr (pika-image-get-selected-drawables image)) 0))
+        (offsets (pika-drawable-get-offsets pic-layer))
+        (width (car (pika-drawable-get-width pic-layer)))
+        (height (car (pika-drawable-get-height pic-layer)))
+
+        ; Bumpmap has a one pixel border on each side
+        (bump-layer (car (pika-layer-new image
+                                         (+ width 2)
+                                         (+ height 2)
+                                         RGB-IMAGE
+                                         _"Bumpmap"
+                                         100
+                                         LAYER-MODE-NORMAL)))
+
+        (selection-exists (car (pika-selection-bounds image)))
+        (selection 0)
+        )
+
+    (pika-context-push)
+    (pika-context-set-defaults)
+
+    ; disable undo on copy, start group otherwise
+    (if (= work-on-copy TRUE)
+      (pika-image-undo-disable image)
+      (pika-image-undo-group-start image)
+    )
+
+    (pika-image-insert-layer image bump-layer 0 1)
+
+    ; If the layer we're bevelling is offset from the image's origin, we
+    ; have to do the same to the bumpmap
+    (pika-layer-set-offsets bump-layer (- (car offsets) 1)
+                                       (- (cadr offsets) 1))
+
+    ;------------------------------------------------------------
+    ;
+    ; Set the selection to the area we want to bevel.
+    ;
+    (if (= selection-exists 0)
+        (pika-image-select-item image CHANNEL-OP-REPLACE pic-layer)
+    )
+
+    ; Store it for later.
+    (set! selection (car (pika-selection-save image)))
+    ; Try to lose the jaggies
+    (pika-selection-feather image 2)
+
+    ;------------------------------------------------------------
+    ;
+    ; Initialise our bumpmap
+    ;
+    (pika-context-set-background '(0 0 0))
+    (pika-drawable-fill bump-layer FILL-BACKGROUND)
+
+    (while (and (< index thickness)
+                (= (car (pika-selection-is-empty image)) FALSE)
+           )
+           (set! greyness (/ (* index 255) thickness))
+           (pika-context-set-background (list greyness greyness greyness))
+           ;(pika-selection-feather image 1) ;Stop the slopey jaggies?
+           (pika-drawable-edit-fill bump-layer FILL-BACKGROUND)
+           (pika-selection-shrink image 1)
+           (set! index (+ index 1))
+    )
+    ; Now the white interior
+    (if (= (car (pika-selection-is-empty image)) FALSE)
+        (begin
+          (pika-context-set-background '(255 255 255))
+          (pika-drawable-edit-fill bump-layer FILL-BACKGROUND)
+        )
+    )
+
+    ;------------------------------------------------------------
+    ;
+    ; Do the bump.
+    ;
+    (pika-selection-none image)
+
+    ; To further lessen jaggies?
+    ;(plug-in-gauss-rle RUN-NONINTERACTIVE image bump-layer thickness TRUE TRUE)
+
+
+    ;
+    ; BUMPMAP INVOCATION:
+    ;
+    (plug-in-bump-map RUN-NONINTERACTIVE image pic-layer bump-layer 125 45 3 0 0 0 0 TRUE FALSE 1)
+
+    ;------------------------------------------------------------
+    ;
+    ; Restore things
+    ;
+    (if (= selection-exists 0)
+        (pika-selection-none image)        ; No selection to start with
+        (pika-image-select-item image CHANNEL-OP-REPLACE selection)
+    )
+    ; If they started with a selection, they can Select->Invert then
+    ; Edit->Clear for a cutout.
+
+    ; clean up
+    (pika-image-remove-channel image selection)
+    (if (= keep-bump-layer TRUE)
+        (pika-item-set-visible bump-layer 0)
+        (pika-image-remove-layer image bump-layer)
+    )
+
+    (pika-image-set-selected-layers image 1 (vector pic-layer))
+
+    ; enable undo / end undo group
+    (if (= work-on-copy TRUE)
+      (begin
+        (pika-display-new image)
+        (pika-image-undo-enable image)
+      )
+      (pika-image-undo-group-end image)
+    )
+
+    (pika-displays-flush)
+
+    (pika-context-pop)
+  )
+)
+
+(script-fu-register "script-fu-add-bevel"
+  _"Add B_evel..."
+  _"Add a beveled border to an image"
+  "Andrew Donkin <ard@cs.waikato.ac.nz>"
+  "Andrew Donkin"
+  "1997/11/06"
+  "RGB*"
+  SF-IMAGE       "Image"           0
+  SF-DRAWABLE    "Drawable"        0
+  SF-ADJUSTMENT _"Thickness"       '(5 0 30 1 2 0 0)
+  SF-TOGGLE     _"Work on copy"    TRUE
+  SF-TOGGLE     _"Keep bump layer" FALSE
+)
+
+(script-fu-menu-register "script-fu-add-bevel" "<Image>/Filters/Decor")

plug-ins/script-fu/scripts/addborder.scm

@@ -0,0 +1,177 @@
+; PIKA - Photo and Image Kooker Application
+; 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/>.
+;
+; Copyright (C) 1997 Andy Thomas alt@picnic.demon.co.uk
+;
+; Version 0.2 10.6.97 Changed to new script-fu interface in 0.99.10
+
+; Delta the color by the given amount. Check for boundary conditions
+; If < 0 set to zero
+; If > 255 set to 255
+; Return the new value
+
+(define (script-fu-addborder aimg adraw xsize ysize color dvalue)
+
+  (define (deltacolor col delta)
+    (let* ((newcol (+ col delta)))
+      (if (< newcol 0) (set! newcol 0))
+      (if (> newcol 255) (set! newcol 255))
+      newcol
+    )
+  )
+
+  (define (adjcolor col delta)
+    (mapcar (lambda (x) (deltacolor x delta)) col)
+  )
+
+  (define (gen_top_array xsize ysize owidth oheight width height)
+    (let* ((n_array (cons-array 10 'double)))
+      (aset n_array 0 0 )
+      (aset n_array 1 0 )
+      (aset n_array 2 xsize)
+      (aset n_array 3 ysize)
+      (aset n_array 4 (+ xsize owidth))
+      (aset n_array 5 ysize)
+      (aset n_array 6 width)
+      (aset n_array 7 0 )
+      (aset n_array 8 0 )
+      (aset n_array 9 0 )
+      n_array)
+  )
+
+  (define (gen_left_array xsize ysize owidth oheight width height)
+    (let* ((n_array (cons-array 10 'double)))
+      (aset n_array 0 0 )
+      (aset n_array 1 0 )
+      (aset n_array 2 xsize)
+      (aset n_array 3 ysize)
+      (aset n_array 4 xsize)
+      (aset n_array 5 (+ ysize oheight))
+      (aset n_array 6 0 )
+      (aset n_array 7 height )
+      (aset n_array 8 0 )
+      (aset n_array 9 0 )
+      n_array)
+  )
+
+  (define (gen_right_array xsize ysize owidth oheight width height)
+    (let* ((n_array (cons-array 10 'double)))
+      (aset n_array 0 width )
+      (aset n_array 1 0 )
+      (aset n_array 2 (+ xsize owidth))
+      (aset n_array 3 ysize)
+      (aset n_array 4 (+ xsize owidth))
+      (aset n_array 5 (+ ysize oheight))
+      (aset n_array 6 width)
+      (aset n_array 7 height)
+      (aset n_array 8 width )
+      (aset n_array 9 0 )
+      n_array)
+  )
+
+  (define (gen_bottom_array xsize ysize owidth oheight width height)
+    (let* ((n_array (cons-array 10 'double)))
+      (aset n_array 0 0 )
+      (aset n_array 1 height)
+      (aset n_array 2 xsize)
+      (aset n_array 3 (+ ysize oheight))
+      (aset n_array 4 (+ xsize owidth))
+      (aset n_array 5 (+ ysize oheight))
+      (aset n_array 6 width)
+      (aset n_array 7 height)
+      (aset n_array 8 0 )
+      (aset n_array 9 height)
+      n_array)
+  )
+
+  (let* ((img (car (pika-item-get-image adraw)))
+         (owidth (car (pika-image-get-width img)))
+         (oheight (car (pika-image-get-height img)))
+         (width (+ owidth (* 2 xsize)))
+         (height (+ oheight (* 2 ysize)))
+         (layer (car (pika-layer-new img
+                                     width height
+                                     (car (pika-drawable-type-with-alpha adraw))
+                                     _"Border Layer" 100 LAYER-MODE-NORMAL))))
+
+    (pika-context-push)
+    (pika-context-set-paint-mode LAYER-MODE-NORMAL)
+    (pika-context-set-opacity 100.0)
+    (pika-context-set-antialias FALSE)
+    (pika-context-set-feather FALSE)
+
+    (pika-image-undo-group-start img)
+
+    (pika-image-resize img
+                       width
+                       height
+                       xsize
+                       ysize)
+
+    (pika-image-insert-layer img layer 0 0)
+    (pika-drawable-fill layer FILL-TRANSPARENT)
+
+    (pika-context-set-background (adjcolor color dvalue))
+    (pika-image-select-polygon img
+                               CHANNEL-OP-REPLACE
+                               10
+                               (gen_top_array xsize ysize owidth oheight width height))
+    (pika-drawable-edit-fill layer FILL-BACKGROUND)
+    (pika-context-set-background (adjcolor color (/ dvalue 2)))
+    (pika-image-select-polygon img
+                               CHANNEL-OP-REPLACE
+                               10
+                               (gen_left_array xsize ysize owidth oheight width height))
+    (pika-drawable-edit-fill layer FILL-BACKGROUND)
+    (pika-context-set-background (adjcolor color (- 0 (/ dvalue 2))))
+    (pika-image-select-polygon img
+                               CHANNEL-OP-REPLACE
+                               10
+                               (gen_right_array xsize ysize owidth oheight width height))
+
+    (pika-drawable-edit-fill layer FILL-BACKGROUND)
+    (pika-context-set-background (adjcolor color (- 0 dvalue)))
+    (pika-image-select-polygon img
+                               CHANNEL-OP-REPLACE
+                               10
+                               (gen_bottom_array xsize ysize owidth oheight width height))
+
+    (pika-drawable-edit-fill layer FILL-BACKGROUND)
+    (pika-selection-none img)
+    (pika-image-undo-group-end img)
+    (pika-displays-flush)
+
+    (pika-context-pop)
+    )
+)
+
+(script-fu-register "script-fu-addborder"
+  _"Add _Border..."
+  _"Add a border around an image"
+  "Andy Thomas <alt@picnic.demon.co.uk>"
+  "Andy Thomas"
+  "6/10/97"
+  "*"
+  SF-IMAGE       "Input image" 0
+  SF-DRAWABLE    "Input drawable" 0
+  SF-ADJUSTMENT _"Border X size" '(12 1 250 1 10 0 1)
+  SF-ADJUSTMENT _"Border Y size" '(12 1 250 1 10 0 1)
+  SF-COLOR      _"Border color" '(38 31 207)
+  SF-ADJUSTMENT _"Delta value on color" '(25 1 255 1 10 0 1)
+)
+
+(script-fu-menu-register "script-fu-addborder"
+                         "<Image>/Filters/Decor")

plug-ins/script-fu/scripts/blend-anim.scm

@@ -0,0 +1,242 @@
+; PIKA - Photo and Image Kooker Application
+; 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/>.
+;
+;
+; blend-anim.scm   version 1.03   1999/12/21
+;
+; CHANGE-LOG:
+; 1.00 - initial release
+; 1.01 - some code cleanup, no real changes
+; 1.02 - use pika-message to output an error message if called
+;        with less than three layers
+; 1.03 - only call blur plugin when blut-radius >= 1.0
+;
+; Copyright (C) 1997-1999 Sven Neumann <sven@gimp.org>
+;
+;
+; Blends two or more layers over a background, so that an animation can
+; be saved. A minimum of three layers is required.
+
+(define (script-fu-blend-anim img
+                              drawable
+                              frames
+                              max-blur
+                              looped)
+
+  (define (multi-raise-layer image layer times)
+    (while (> times 0)
+       (pika-image-raise-item image layer)
+       (set! times (- times 1))
+    )
+  )
+
+  (let* (
+        (max-blur (max max-blur 0))
+        (frames (max frames 0))
+        (image (car (pika-image-duplicate img)))
+        (width (car (pika-image-get-width image)))
+        (height (car (pika-image-get-height image)))
+        (layers (pika-image-get-layers image))
+        (num-layers (car layers))
+        (layer-array (cadr layers))
+        (slots (- num-layers 2))
+        (bg-layer (aref layer-array (- num-layers 1)))
+        (max-width 0)
+        (max-height 0)
+        (offset-x 0)
+        (offset-y 0)
+        )
+
+    (if (> num-layers 2)
+        (begin
+		  (pika-image-undo-disable image)
+
+		  (if (= looped TRUE)
+			  ; add a copy of the lowest blend layer on top
+			  (let* ((copy (car (pika-layer-copy
+						 (aref layer-array (- num-layers 2)) TRUE))))
+				(pika-image-insert-layer image copy 0 0)
+				(set! layers (pika-image-get-layers image))
+				(set! num-layers (car layers))
+				(set! layer-array (cadr layers))
+				(set! slots (- num-layers 2))
+				(set! bg-layer (aref layer-array (- num-layers 1)))))
+
+		  ; make all layers invisible and check for sizes
+		  (let* ((min-offset-x width)
+				 (min-offset-y height)
+				 (layer-count slots))
+			(pika-item-set-visible bg-layer FALSE)
+			(while (> layer-count -1)
+				   (let* ((layer (aref layer-array layer-count))
+				  (layer-width (+ (car (pika-drawable-get-width layer))
+						  (* max-blur 2)))
+				  (layer-height (+ (car (pika-drawable-get-height layer))
+						   (* max-blur 2)))
+				  (layer-offsets (pika-drawable-get-offsets layer))
+				  (layer-offset-x (- (car layer-offsets) max-blur))
+				  (layer-offset-y (- (cadr layer-offsets) max-blur)))
+				 (pika-item-set-visible layer FALSE)
+				 (set! max-width (max max-width layer-width))
+				 (set! max-height (max max-height layer-height))
+				 (set! min-offset-x (min min-offset-x layer-offset-x))
+				 (set! min-offset-y (min min-offset-y layer-offset-y))
+				 (set! layer-count (- layer-count 1))))
+			(set! offset-x (- (car (pika-drawable-get-offsets bg-layer))
+					  min-offset-x))
+			(set! offset-y (- (cadr (pika-drawable-get-offsets bg-layer))
+					  min-offset-y)))
+
+		  ; create intermediate frames by merging copies of adjacent layers
+		  ; with the background layer
+		  (let* ((layer-count slots))
+			(while (> layer-count 0)
+			   (let* ((frame-count frames)
+				  (lower-layer (aref layer-array layer-count))
+				  (upper-layer (aref layer-array (- layer-count 1))))
+				 (while (> frame-count 0)
+					(let* ((opacity (* (/ frame-count (+ frames 1)) 100))
+				   (blur (/ (* opacity max-blur) 100))
+				   (upper-copy (car (pika-layer-copy upper-layer TRUE)))
+				   (lower-copy (car (pika-layer-copy lower-layer TRUE)))
+				   (bg-copy (car (pika-layer-copy bg-layer TRUE))))
+				  (pika-image-insert-layer image bg-copy 0 0)
+				  (pika-image-insert-layer image lower-copy 0 0)
+				  (pika-image-insert-layer image upper-copy 0 0)
+				  (pika-item-set-visible upper-copy TRUE)
+				  (pika-item-set-visible lower-copy TRUE)
+				  (pika-item-set-visible bg-copy TRUE)
+				  (pika-layer-set-opacity upper-copy (- 100 opacity))
+				  (pika-layer-set-opacity lower-copy opacity)
+				  (pika-layer-set-opacity bg-copy 100)
+				  (if (> max-blur 0)
+				  (let* ((layer-width (car (pika-drawable-get-width upper-copy)))
+						 (layer-height (car (pika-drawable-get-height upper-copy))))
+					(pika-layer-set-lock-alpha upper-copy FALSE)
+					(pika-layer-resize upper-copy
+							   (+ layer-width (* blur 2))
+							   (+ layer-height (* blur 2))
+							   blur
+							   blur)
+					(if (>= blur 1.0)
+						(plug-in-gauss-rle RUN-NONINTERACTIVE
+							   image
+							   upper-copy
+							   blur
+							   TRUE TRUE))
+					(set! blur (- max-blur blur))
+					(pika-layer-set-lock-alpha lower-copy FALSE)
+					(set! layer-width (car (pika-drawable-get-width
+								lower-copy)))
+					(set! layer-height (car (pika-drawable-get-height
+								 lower-copy)))
+					(pika-layer-resize lower-copy
+							   (+ layer-width (* blur 2))
+							   (+ layer-height (* blur 2))
+							   blur
+							   blur)
+					(if (>= blur 1.0)
+						(plug-in-gauss-rle RUN-NONINTERACTIVE
+							   image
+							   lower-copy
+							   blur
+							   TRUE TRUE))))
+				  (pika-layer-resize bg-copy
+							 max-width
+							 max-height
+							 offset-x
+							 offset-y)
+				  (let* ((merged-layer (car (pika-image-merge-visible-layers
+							   image CLIP-TO-IMAGE))))
+					(pika-item-set-visible merged-layer FALSE))
+				  (set! frame-count (- frame-count 1))))
+				 (set! layer-count (- layer-count 1)))))
+
+		  ; merge all original blend layers but the lowest one
+			  ; with copies of the background layer
+		  (let* ((layer-count 0))
+			(while (< layer-count slots)
+				   (let* ((orig-layer (aref layer-array layer-count))
+				  (bg-copy (car (pika-layer-copy bg-layer TRUE))))
+				 (pika-image-insert-layer image
+						   bg-copy
+						   -1
+						   (* layer-count (+ frames 1)))
+				 (multi-raise-layer image
+						orig-layer
+						(+ (* (- slots layer-count) frames) 1))
+				 (pika-item-set-visible orig-layer TRUE)
+				 (pika-item-set-visible bg-copy TRUE)
+				 (pika-layer-resize bg-copy
+						max-width
+						max-height
+						offset-x
+						offset-y)
+				 (let* ((merged-layer (car (pika-image-merge-visible-layers
+						  image CLIP-TO-IMAGE))))
+			   (pika-item-set-visible merged-layer FALSE))
+			   (set! layer-count (+ layer-count 1)))))
+
+		  ; merge the lowest blend layer with the background layer
+		  (let* ((orig-layer (aref layer-array (- num-layers 2))))
+			(pika-item-set-visible bg-layer TRUE)
+			(pika-item-set-visible orig-layer TRUE)
+			(pika-image-merge-visible-layers image CLIP-TO-IMAGE))
+
+		  ; make all layers visible again
+		  (let* ((result-layers (pika-image-get-layers image))
+				 (num-result-layers (car result-layers))
+				 (result-layer-array (cadr result-layers))
+				 (layer-count (- num-result-layers 1)))
+			(while (> layer-count -1)
+			   (let* ((layer (aref result-layer-array layer-count))
+				  (name (string-append _"Frame" " "
+						       (number->string
+							(- num-result-layers layer-count) 10))))
+				 (pika-item-set-visible layer TRUE)
+				 (pika-item-set-name layer name)
+				 (set! layer-count (- layer-count 1))))
+
+			(if (= looped TRUE)
+				; remove the topmost layer
+				(pika-image-remove-layer image (aref result-layer-array 0))))
+
+		  (pika-image-undo-enable image)
+		  (pika-display-new image)
+		  (pika-displays-flush)
+		)
+
+      (pika-message _"Blend Animation needs at least three source layers")
+    )
+  )
+)
+
+(script-fu-register "script-fu-blend-anim"
+    _"_Blend..."
+    _"Create intermediate layers to blend two or more layers over a background as an animation"
+    "Sven Neumann <sven@gimp.org>"
+    "Sven Neumann"
+    "1999/12/21"
+    "RGB* GRAY*"
+    SF-IMAGE       "Image"               0
+    SF-DRAWABLE    "Drawable"            0
+    SF-ADJUSTMENT _"Intermediate frames" '(3 1 1024 1 10 0 1)
+    SF-ADJUSTMENT _"Max. blur radius"    '(0 0 1024 1 10 0 1)
+    SF-TOGGLE     _"Looped"              TRUE
+)
+
+(script-fu-menu-register "script-fu-blend-anim"
+                         "<Image>/Filters/Animation/")

plug-ins/script-fu/scripts/burn-in-anim.scm

@@ -0,0 +1,243 @@
+;
+;  burn-in-anim.scm V2.1  -  script-fu for PIKA 1.1 and higher
+;
+;  Copyright (C) 9/2000  Roland Berger
+;  roland@fuchur.leute.server.de
+;  http://fuchur.leute.server.de
+;
+;  Let text appear and fade out with a "burn-in" like SFX.
+;  Works on an image with a text and a background layer
+;
+;  Copying Policy:  GNU Public License http://www.gnu.org
+;
+
+(define (script-fu-burn-in-anim org-img
+                                org-layer
+                                glow-color
+                                fadeout
+                                bl-width
+                                corona-width
+                                after-glow
+                                show-glow
+                                optimize
+                                speed)
+
+  (let* (
+        ;--- main variable: "bl-x" runs from 0 to layer-width
+        (bl-x 0)
+        (frame-nr 0)
+        (img 0)
+        (source-layer 0)
+        (bg-source-layer 0)
+        (source-layer-width 0)
+        (bg-layer 0)
+        (bg-layer-name 0)
+        (bl-layer 0)
+        (bl-layer-name 0)
+        (bl-mask 0)
+        (bl-layer-width 0)
+        (bl-height 0)
+        (bl-x-off 0)
+        (bl-y-off 0)
+        (nofadeout-bl-x-off 0)
+        (nofadeout-bl-width 0)
+        (blended-layer 0)
+        (img-display 0)
+        )
+
+    (if (< speed 1)
+        (set! speed (* -1 speed)) )
+
+    ;--- check image and work on a copy
+    (if (and (= (car (pika-image-get-layers org-img)) 2)
+             (= (car (pika-image-get-floating-sel org-img)) -1))
+
+        ;--- main program structure starts here, begin of "if-1"
+        (begin
+          (pika-context-push)
+          (pika-context-set-defaults)
+
+          (set! img (car (pika-image-duplicate org-img)))
+          (pika-image-undo-disable img)
+          (if (> (car (pika-drawable-type org-layer)) 1 )
+              (pika-image-convert-rgb img))
+          (set! source-layer    (aref (cadr (pika-image-get-layers img)) 0 ))
+          (set! bg-source-layer (aref (cadr (pika-image-get-layers img)) 1 ))
+          (set! source-layer-width (car (pika-drawable-get-width  source-layer)))
+
+          ;--- hide layers, cause we want to "merge visible layers" later
+          (pika-item-set-visible source-layer FALSE)
+          (pika-item-set-visible bg-source-layer     FALSE)
+
+          ;--- process image horizontal with pixel-speed
+          (while (< bl-x (+ source-layer-width bl-width))
+              (set! bl-layer (car (pika-layer-copy source-layer TRUE)))
+              (set! bl-layer-name (string-append "fr-nr"
+                                                 (number->string frame-nr 10) ) )
+
+              (pika-image-insert-layer img bl-layer 0 -2)
+              (pika-item-set-name bl-layer bl-layer-name)
+              (pika-item-set-visible bl-layer TRUE)
+              (pika-layer-set-lock-alpha bl-layer TRUE)
+              (pika-layer-add-alpha bl-layer)
+
+              ;--- add an alpha mask for blending and select it
+              (pika-image-select-item img CHANNEL-OP-REPLACE bl-layer)
+              (set! bl-mask (car (pika-layer-create-mask bl-layer ADD-MASK-BLACK)))
+              (pika-layer-add-mask bl-layer bl-mask)
+
+              ;--- handle layer geometry
+              (set! bl-layer-width source-layer-width)
+              (set! bl-height      (car (pika-drawable-get-height bl-layer)))
+              (set! bl-x-off (- bl-x     bl-width))
+              (set! bl-x-off (+ bl-x-off (car  (pika-drawable-get-offsets bl-layer))))
+              (set! bl-y-off             (cadr (pika-drawable-get-offsets bl-layer)))
+
+              ;--- select a rectangular area to blend
+              (pika-image-select-rectangle img CHANNEL-OP-REPLACE bl-x-off bl-y-off bl-width bl-height)
+              ;--- select at least 1 pixel!
+              (pika-image-select-rectangle img CHANNEL-OP-ADD bl-x-off bl-y-off (+ bl-width 1) bl-height)
+
+              (if (= fadeout FALSE)
+                  (begin
+                    (set! nofadeout-bl-x-off (car (pika-drawable-get-offsets bl-layer)))
+                    (set! nofadeout-bl-width (+ nofadeout-bl-x-off bl-x))
+                    (set! nofadeout-bl-width (max nofadeout-bl-width 1))
+                    (pika-image-select-rectangle img CHANNEL-OP-REPLACE
+                                                 nofadeout-bl-x-off bl-y-off
+                                                 nofadeout-bl-width bl-height)
+                  )
+              )
+
+              ;--- alpha blending text to trans (fadeout)
+              (pika-context-set-foreground '(255 255 255))
+              (pika-context-set-background '(  0   0   0))
+              (if (= fadeout TRUE)
+                  (begin
+                    ; blend with 20% offset to get less transparency in the front
+		    (pika-context-set-gradient-fg-bg-rgb)
+                    (pika-drawable-edit-gradient-fill bl-mask
+						      GRADIENT-LINEAR 20
+						      FALSE 0 0
+						      TRUE
+						      (+ bl-x-off bl-width) 0
+						      bl-x-off 0)
+                  )
+              )
+
+              (if (= fadeout FALSE)
+                  (begin
+                    (pika-context-set-foreground '(255 255 255))
+                    (pika-drawable-edit-fill bl-mask FILL-FOREGROUND)
+                  )
+              )
+
+              (pika-layer-remove-mask bl-layer MASK-APPLY)
+
+              ;--- add bright glow in front
+              (if (= show-glow TRUE)
+                  (begin
+                    ;--- add some brightness to whole text
+                    (if (= fadeout TRUE)
+                        (pika-drawable-brightness-contrast bl-layer 0.787 0)
+                    )
+
+		    ;--- blend glow color inside the letters
+		    (pika-context-set-foreground glow-color)
+		    (pika-context-set-gradient-fg-transparent)
+		    (pika-drawable-edit-gradient-fill bl-layer
+						      GRADIENT-LINEAR 0
+						      FALSE 0 0
+						      TRUE
+						      (+ bl-x-off bl-width) 0
+						      (- (+ bl-x-off bl-width) after-glow) 0)
+
+                    ;--- add corona effect
+		    (pika-image-select-item img CHANNEL-OP-REPLACE bl-layer)
+		    (pika-selection-sharpen img)
+		    (pika-selection-grow img corona-width)
+		    (pika-layer-set-lock-alpha bl-layer FALSE)
+		    (pika-selection-feather img corona-width)
+		    (pika-context-set-foreground glow-color)
+		    (pika-drawable-edit-gradient-fill bl-layer
+						      GRADIENT-LINEAR 0
+						      FALSE 0 0
+						      TRUE
+						      (- (+ bl-x-off bl-width) corona-width) 0
+						      (- (+ bl-x-off bl-width) after-glow) 0)
+		    )
+		  )
+
+              ;--- merge with bg layer
+              (set! bg-layer (car (pika-layer-copy bg-source-layer FALSE)))
+              (pika-image-insert-layer img bg-layer 0 -1)
+              (pika-image-lower-item img bg-layer)
+              (set! bg-layer-name (string-append "bg-"
+                                                 (number->string frame-nr 10)))
+              (pika-item-set-name bg-layer bg-layer-name)
+              (pika-item-set-visible bg-layer TRUE)
+              (set! blended-layer (car (pika-image-merge-visible-layers img
+                                        CLIP-TO-IMAGE)))
+              ;(set! blended-layer bl-layer)
+              (pika-item-set-visible blended-layer FALSE)
+
+              ;--- end of "while" loop
+              (set! frame-nr (+ frame-nr 1))
+              (set! bl-x     (+ bl-x speed))
+          )
+
+          ;--- finalize the job
+          (pika-selection-none img)
+          (pika-image-remove-layer img    source-layer)
+          (pika-image-remove-layer img bg-source-layer)
+
+          (pika-image-set-file img "burn-in.xcf")
+
+          (if (= optimize TRUE)
+              (begin
+                (pika-image-convert-indexed img CONVERT-DITHER-FS CONVERT-PALETTE-WEB 250 FALSE TRUE "")
+                (set! img (car (plug-in-animationoptimize RUN-NONINTERACTIVE
+                                                          img
+                                                          blended-layer)))
+              )
+          )
+
+          (pika-item-set-visible (aref (cadr (pika-image-get-layers img)) 0)
+                                  TRUE)
+          (pika-image-undo-enable img)
+          (pika-image-clean-all img)
+          (set! img-display (car (pika-display-new img)))
+
+          (pika-displays-flush)
+
+          (pika-context-pop)
+        )
+
+        ;--- false form of "if-1"
+        (pika-message _"The Burn-In script needs two layers in total. A foreground layer with transparency and a background layer.")
+    )
+  )
+)
+
+
+(script-fu-register "script-fu-burn-in-anim"
+    _"B_urn-In..."
+    _"Create intermediate layers to produce an animated 'burn-in' transition between two layers"
+    "Roland Berger roland@fuchur.leute.server.de"
+    "Roland Berger"
+    "January 2001"
+    "RGBA GRAYA INDEXEDA"
+    SF-IMAGE    "The image"            0
+    SF-DRAWABLE "Layer to animate"     0
+    SF-COLOR   _"Glow color"           "white"
+    SF-TOGGLE  _"Fadeout"              FALSE
+    SF-VALUE   _"Fadeout width"        "100"
+    SF-VALUE   _"Corona width"         "7"
+    SF-VALUE   _"After glow"           "50"
+    SF-TOGGLE  _"Add glowing"          TRUE
+    SF-TOGGLE  _"Prepare for GIF"      FALSE
+    SF-VALUE   _"Speed (pixels/frame)" "50"
+)
+
+(script-fu-menu-register "script-fu-burn-in-anim"
+                         "<Image>/Filters/Animation/")

plug-ins/script-fu/scripts/carve-it.scm

@@ -0,0 +1,234 @@
+;  CARVE-IT
+;   Carving, embossing, & stamping
+;   Process taken from "The Photoshop 3 WOW! Book"
+;   http://www.peachpit.com
+;   This script requires a grayscale image containing a single layer.
+;   This layer is used as the mask for the carving effect
+;   NOTE: This script requires the image to be carved to either be an
+;   RGB color or grayscale image with a single layer. An indexed file
+;   can not be used due to the use of pika-drawable-histogram and
+;   pika-drawable-levels.
+
+
+(define (carve-scale val scale)
+  (* (sqrt val) scale))
+
+(define (calculate-inset-gamma img layer)
+  (let* ((stats (pika-drawable-histogram layer 0 0.0 1.0))
+         (mean (car stats)))
+    (cond ((< mean 127) (+ 1.0 (* 0.5 (/ (- 127 mean) 127.0))))
+          ((>= mean 127) (- 1.0 (* 0.5 (/ (- mean 127) 127.0)))))))
+
+
+(define (copy-layer-carve-it dest-image dest-drawable source-image source-drawable)
+  (pika-selection-all dest-image)
+  (pika-drawable-edit-clear dest-drawable)
+  (pika-selection-none dest-image)
+  (pika-selection-all source-image)
+  (pika-edit-copy 1 (vector source-drawable))
+  (let* (
+         (pasted (pika-edit-paste dest-drawable FALSE))
+         (num-pasted (car pasted))
+         (floating-sel (aref (cadr pasted) (- num-pasted 1)))
+        )
+        (pika-floating-sel-anchor floating-sel)
+  )
+)
+
+
+
+(define (script-fu-carve-it mask-img mask-drawable bg-layer carve-white)
+  (let* (
+        (width (car (pika-drawable-get-width mask-drawable)))
+        (height (car (pika-drawable-get-height mask-drawable)))
+        (type (car (pika-drawable-type bg-layer)))
+        (img (car (pika-image-new width height (cond ((= type RGB-IMAGE) RGB)
+                                                     ((= type RGBA-IMAGE) RGB)
+                                                     ((= type GRAY-IMAGE) GRAY)
+                                                     ((= type GRAYA-IMAGE) GRAY)
+                                                     ((= type INDEXED-IMAGE) INDEXED)
+                                                     ((= type INDEXEDA-IMAGE) INDEXED)))))
+        (size (min width height))
+        (offx (carve-scale size 0.33))
+        (offy (carve-scale size 0.25))
+        (feather (carve-scale size 0.3))
+        (brush-size (carve-scale size 0.3))
+        (brush-name (car (pika-brush-new "Carve It")))
+        (mask (car (pika-channel-new img width height "Engraving Mask" 50 '(0 0 0))))
+        (inset-gamma (calculate-inset-gamma (car (pika-item-get-image bg-layer)) bg-layer))
+        (mask-fat 0)
+        (mask-emboss 0)
+        (mask-highlight 0)
+        (mask-shadow 0)
+        (shadow-layer 0)
+        (highlight-layer 0)
+        (cast-shadow-layer 0)
+        (csl-mask 0)
+        (inset-layer 0)
+        (il-mask 0)
+        (bg-width (car (pika-drawable-get-width bg-layer)))
+        (bg-height (car (pika-drawable-get-height bg-layer)))
+        (bg-type (car (pika-drawable-type bg-layer)))
+        (bg-image (car (pika-item-get-image bg-layer)))
+        (layer1 (car (pika-layer-new img bg-width bg-height bg-type "Layer1" 100 LAYER-MODE-NORMAL)))
+        )
+
+    (pika-context-push)
+    (pika-context-set-defaults)
+
+    (pika-image-undo-disable img)
+
+    (pika-image-insert-layer img layer1 0 0)
+
+    (pika-selection-all img)
+    (pika-drawable-edit-clear layer1)
+    (pika-selection-none img)
+    (copy-layer-carve-it img layer1 bg-image bg-layer)
+
+    (pika-edit-copy 1 (vector mask-drawable))
+    (pika-image-insert-channel img mask -1 0)
+
+    (plug-in-tile RUN-NONINTERACTIVE img 1 (vector layer1) width height FALSE)
+    (let* (
+           (pasted (pika-edit-paste mask FALSE))
+           (num-pasted (car pasted))
+           (floating-sel (aref (cadr pasted) (- num-pasted 1)))
+          )
+          (pika-floating-sel-anchor floating-sel)
+    )
+    (if (= carve-white FALSE)
+        (pika-drawable-invert mask FALSE))
+
+    (set! mask-fat (car (pika-channel-copy mask)))
+    (pika-image-insert-channel img mask-fat -1 0)
+    (pika-image-select-item img CHANNEL-OP-REPLACE mask-fat)
+
+    (pika-brush-set-shape brush-name BRUSH-GENERATED-CIRCLE)
+    (pika-brush-set-spikes brush-name 2)
+    (pika-brush-set-hardness brush-name 1.0)
+    (pika-brush-set-spacing brush-name 25)
+    (pika-brush-set-aspect-ratio brush-name 1)
+    (pika-brush-set-angle brush-name 0)
+    (cond (<= brush-size 17) (pika-brush-set-radius brush-name (\ brush-size 2))
+	  (else pika-brush-set-radius brush-name (\ 19 2)))
+    (pika-context-set-brush brush-name)
+
+    (pika-context-set-foreground '(255 255 255))
+    (pika-drawable-edit-stroke-selection mask-fat)
+    (pika-selection-none img)
+
+    (set! mask-emboss (car (pika-channel-copy mask-fat)))
+    (pika-image-insert-channel img mask-emboss -1 0)
+    (plug-in-gauss-rle RUN-NONINTERACTIVE img mask-emboss feather TRUE TRUE)
+    (plug-in-emboss RUN-NONINTERACTIVE img mask-emboss 315.0 45.0 7 TRUE)
+
+    (pika-context-set-background '(180 180 180))
+    (pika-image-select-item img CHANNEL-OP-REPLACE mask-fat)
+    (pika-selection-invert img)
+    (pika-drawable-edit-fill mask-emboss FILL-BACKGROUND)
+    (pika-image-select-item img CHANNEL-OP-REPLACE mask)
+    (pika-drawable-edit-fill mask-emboss FILL-BACKGROUND)
+    (pika-selection-none img)
+
+    (set! mask-highlight (car (pika-channel-copy mask-emboss)))
+    (pika-image-insert-channel img mask-highlight -1 0)
+    (pika-drawable-levels mask-highlight 0
+			  0.7056 1.0 TRUE
+			  1.0
+			  0.0 1.0 TRUE)
+
+    (set! mask-shadow mask-emboss)
+    (pika-drawable-levels mask-shadow 0
+			  0.0 0.70586 TRUE
+			  1.0
+			  0.0 1.0 TRUE)
+
+    (pika-edit-copy 1 (vector mask-shadow))
+    (let* (
+           (pasted (pika-edit-paste layer1 FALSE))
+           (num-pasted (car pasted))
+           (floating-sel (aref (cadr pasted) (- num-pasted 1)))
+          )
+          (set! shadow-layer floating-sel)
+          (pika-floating-sel-to-layer shadow-layer)
+    )
+    (pika-layer-set-mode shadow-layer LAYER-MODE-MULTIPLY)
+
+    (pika-edit-copy 1 (vector mask-highlight))
+    (let* (
+           (pasted (pika-edit-paste shadow-layer FALSE))
+           (num-pasted (car pasted))
+           (floating-sel (aref (cadr pasted) (- num-pasted 1)))
+          )
+          (set! highlight-layer floating-sel)
+          (pika-floating-sel-to-layer highlight-layer)
+    )
+    (pika-layer-set-mode highlight-layer LAYER-MODE-SCREEN)
+
+    (pika-edit-copy 1 (vector mask))
+    (let* (
+           (pasted (pika-edit-paste highlight-layer FALSE))
+           (num-pasted (car pasted))
+           (floating-sel (aref (cadr pasted) (- num-pasted 1)))
+          )
+          (set! cast-shadow-layer floating-sel)
+          (pika-floating-sel-to-layer cast-shadow-layer)
+    )
+    (pika-layer-set-mode cast-shadow-layer LAYER-MODE-MULTIPLY)
+    (pika-layer-set-opacity cast-shadow-layer 75)
+
+    (plug-in-gauss-rle RUN-NONINTERACTIVE img cast-shadow-layer feather TRUE TRUE)
+    (pika-item-transform-translate cast-shadow-layer offx offy)
+
+    (set! csl-mask (car (pika-layer-create-mask cast-shadow-layer ADD-MASK-BLACK)))
+    (pika-layer-add-mask cast-shadow-layer csl-mask)
+    (pika-image-select-item img CHANNEL-OP-REPLACE mask)
+    (pika-context-set-background '(255 255 255))
+    (pika-drawable-edit-fill csl-mask FILL-BACKGROUND)
+
+    (set! inset-layer (car (pika-layer-copy layer1 TRUE)))
+    (pika-image-insert-layer img inset-layer 0 1)
+
+    (set! il-mask (car (pika-layer-create-mask inset-layer ADD-MASK-BLACK)))
+    (pika-layer-add-mask inset-layer il-mask)
+    (pika-image-select-item img CHANNEL-OP-REPLACE mask)
+    (pika-context-set-background '(255 255 255))
+    (pika-drawable-edit-fill il-mask FILL-BACKGROUND)
+    (pika-selection-none img)
+    (pika-selection-none bg-image)
+    (pika-drawable-levels inset-layer 0 0.0 1.0 TRUE inset-gamma 0.0 1.0 TRUE)
+    (pika-image-remove-channel img mask)
+    (pika-image-remove-channel img mask-fat)
+    (pika-image-remove-channel img mask-highlight)
+    (pika-image-remove-channel img mask-shadow)
+
+    (pika-item-set-name layer1 _"Carved Surface")
+    (pika-item-set-name shadow-layer _"Bevel Shadow")
+    (pika-item-set-name highlight-layer _"Bevel Highlight")
+    (pika-item-set-name cast-shadow-layer _"Cast Shadow")
+    (pika-item-set-name inset-layer _"Inset")
+
+    (pika-brush-delete brush-name)
+
+    (pika-display-new img)
+    (pika-image-undo-enable img)
+
+    (pika-context-pop)
+  )
+)
+
+(script-fu-register "script-fu-carve-it"
+    _"Stencil C_arve..."
+    _"Use the specified drawable as a stencil to carve from the specified image."
+    "Spencer Kimball"
+    "Spencer Kimball"
+    "1997"
+    "GRAY"
+    SF-IMAGE     "Mask image"        0
+    SF-DRAWABLE  "Mask drawable"     0
+    SF-DRAWABLE _"Image to carve"    0
+    SF-TOGGLE   _"Carve white areas" TRUE
+)
+
+(script-fu-menu-register "script-fu-carve-it"
+                         "<Image>/Filters/Decor")

plug-ins/script-fu/scripts/chrome-it.scm

@@ -0,0 +1,261 @@
+;  CHROME-IT
+;   State of the art chrome effect for user-specified mask
+;   This script requires a grayscale image containing a single layer.
+;   This layer is used as the mask for the SOTA chrome effect
+
+(define (script-fu-sota-chrome-it mask-img mask-drawable chrome-saturation
+         chrome-lightness chrome-factor env-map hc cc carve-white)
+
+  (define (set-pt a index x y)
+    (begin
+      (aset a (* index 2) x)
+      (aset a (+ (* index 2) 1) y)
+    )
+  )
+
+  (define (spline-chrome-it)
+    (let* ((a (cons-array 18 'double)))
+      (set-pt a 0 0.0   0.0)
+      (set-pt a 1 0.125 0.9216)
+      (set-pt a 2 0.25  0.0902)
+      (set-pt a 3 0.375 0.9020)
+      (set-pt a 4 0.5   0.0989)
+      (set-pt a 5 0.625 0.9549)
+      (set-pt a 6 0.75  00784)
+      (set-pt a 7 0.875 0.9412)
+      (set-pt a 8 1.0   0.1216)
+      a
+    )
+  )
+
+
+  (define (shadows val)
+    (/ (* 0.96 val) 2.55)
+  )
+
+  (define (midtones val)
+    (/ val 2.55)
+  )
+
+  (define (highlights val)
+    ; The result is used as "pika-drawable-color-balance" color parameter
+    ; and thus must be restricted to -100.0 <= highlights <= 100.0.
+    (min (/ (* 1.108 val) 2.55) 100.0)
+  )
+
+  (define (rval col)
+    (car col)
+  )
+
+  (define (gval col)
+    (cadr col)
+  )
+
+  (define (bval col)
+    (caddr col)
+  )
+
+  (define (sota-scale val scale chrome-factor)
+    (* (sqrt val) (* scale chrome-factor))
+  )
+
+  (define (copy-layer-chrome-it dest-image dest-drawable source-image source-drawable)
+    (pika-selection-all dest-image)
+    (pika-drawable-edit-clear dest-drawable)
+    (pika-selection-none dest-image)
+    (pika-selection-all source-image)
+    (pika-edit-copy 1 (vector source-drawable))
+    (let* (
+           (pasted (pika-edit-paste dest-drawable FALSE))
+           (num-pasted (car pasted))
+           (floating-sel (aref (cadr pasted) (- num-pasted 1)))
+          )
+     (pika-floating-sel-anchor floating-sel)
+    )
+  )
+
+  (let* (
+        (banding-img (car (pika-file-load RUN-NONINTERACTIVE env-map)))
+        (banding-layer (aref (cadr (pika-image-get-selected-drawables banding-img)) 0))
+        (banding-height (car (pika-drawable-get-height banding-layer)))
+        (banding-width (car (pika-drawable-get-width banding-layer)))
+        (banding-type (car (pika-drawable-type banding-layer)))
+        (width (car (pika-drawable-get-width mask-drawable)))
+        (height (car (pika-drawable-get-height mask-drawable)))
+        (img (car (pika-image-new width height GRAY)))
+        (size (min width height))
+        (offx1 (sota-scale size 0.33 chrome-factor))
+        (offy1 (sota-scale size 0.25 chrome-factor))
+        (offx2 (sota-scale size (- 0.33) chrome-factor))
+        (offy2 (sota-scale size (- 0.25) chrome-factor))
+        (feather (sota-scale size 0.5 chrome-factor))
+        (brush-size (sota-scale size 0.5 chrome-factor))
+        (brush-name (car (pika-brush-new "Chrome It")))
+        (mask (car (pika-channel-new img width height "Chrome Stencil" 50 '(0 0 0))))
+        (bg-layer (car (pika-layer-new img width height GRAY-IMAGE _"Background" 100 LAYER-MODE-NORMAL)))
+        (layer1 (car (pika-layer-new img banding-width banding-height banding-type _"Layer 1" 100 LAYER-MODE-NORMAL)))
+        (layer2 (car (pika-layer-new img width height GRAYA-IMAGE _"Layer 2" 100 LAYER-MODE-DIFFERENCE)))
+        (layer3 (car (pika-layer-new img width height GRAYA-IMAGE _"Layer 3" 100 LAYER-MODE-NORMAL)))
+        (shadow (car (pika-layer-new img width height GRAYA-IMAGE _"Drop Shadow" 100 LAYER-MODE-NORMAL)))
+        (layer-mask 0)
+        )
+
+    (pika-context-push)
+    (pika-context-set-defaults)
+
+    (pika-image-undo-disable img)
+
+    (pika-image-insert-channel img mask -1 0)
+    (pika-image-insert-layer img bg-layer 0 0)
+    (pika-image-insert-layer img shadow 0 0)
+    (pika-image-insert-layer img layer3 0 0)
+    (pika-image-insert-layer img layer2 0 0)
+
+    (pika-edit-copy 1 (vector mask-drawable))
+
+    ; Clipboard is copy of mask-drawable.  Paste into mask, a channel, and anchor it.
+    (let* (
+           (pasted (pika-edit-paste mask FALSE))
+           (num-pasted (car pasted))
+           (floating-sel (aref (cadr pasted) (- num-pasted 1)))
+          )
+     (pika-floating-sel-anchor floating-sel)
+    )
+
+    (if (= carve-white FALSE)
+        (pika-drawable-invert mask FALSE)
+    )
+
+    (pika-context-set-background '(255 255 255))
+    (pika-selection-none img)
+    (pika-drawable-edit-fill layer2 FILL-BACKGROUND)
+    (pika-drawable-edit-fill layer3 FILL-BACKGROUND)
+    (pika-drawable-edit-clear shadow)
+
+    (pika-item-set-visible bg-layer FALSE)
+    (pika-item-set-visible shadow FALSE)
+
+    (pika-image-select-item img CHANNEL-OP-REPLACE mask)
+    (pika-context-set-background '(0 0 0))
+    (pika-selection-translate img offx1 offy1)
+    (pika-selection-feather img feather)
+    (pika-drawable-edit-fill layer2 FILL-BACKGROUND)
+    (pika-selection-translate img (* 2 offx2) (* 2 offy2))
+    (pika-drawable-edit-fill layer3 FILL-BACKGROUND)
+    (pika-selection-none img)
+    (set! layer2 (car (pika-image-merge-visible-layers img CLIP-TO-IMAGE)))
+    (pika-drawable-invert layer2 FALSE)
+
+    (pika-image-insert-layer img layer1 0 0)
+    (copy-layer-chrome-it img layer1 banding-img banding-layer)
+    (pika-image-delete banding-img)
+    (pika-layer-scale layer1 width height FALSE)
+    (plug-in-gauss-iir RUN-NONINTERACTIVE img layer1 10 TRUE TRUE)
+    (pika-layer-set-opacity layer1 50)
+    (set! layer1 (car (pika-image-merge-visible-layers img CLIP-TO-IMAGE)))
+    (pika-drawable-curves-spline layer1 HISTOGRAM-VALUE 18 (spline-chrome-it))
+
+    (set! layer-mask (car (pika-layer-create-mask layer1 ADD-MASK-BLACK)))
+    (pika-layer-add-mask layer1 layer-mask)
+    (pika-image-select-item img CHANNEL-OP-REPLACE mask)
+    (pika-context-set-background '(255 255 255))
+    (pika-drawable-edit-fill layer-mask FILL-BACKGROUND)
+
+    (set! layer2 (car (pika-layer-copy layer1 TRUE)))
+    (pika-image-insert-layer img layer2 0 0)
+
+    (pika-brush-set-shape brush-name BRUSH-GENERATED-CIRCLE)
+    (pika-brush-set-spikes brush-name 2)
+    (pika-brush-set-hardness brush-name 1.0)
+    (pika-brush-set-spacing brush-name 25)
+    (pika-brush-set-aspect-ratio brush-name 1)
+    (pika-brush-set-angle brush-name 0)
+    (cond (<= brush-size 17) (pika-brush-set-radius brush-name (\ brush-size 2))
+	  (else pika-brush-set-radius brush-name (\ 19 2)))
+    (pika-context-set-brush brush-name)
+
+    (pika-context-set-foreground '(255 255 255))
+    (pika-drawable-edit-stroke-selection layer-mask)
+
+    (pika-context-set-background '(0 0 0))
+    (pika-selection-feather img (* feather 1.5))
+    (pika-selection-translate img (* 2.5 offx1) (* 2.5 offy1))
+    (pika-drawable-edit-fill shadow FILL-BACKGROUND)
+
+    (pika-selection-all img)
+    (pika-context-set-pattern "Marble #1")
+    (pika-drawable-edit-fill bg-layer FILL-PATTERN)
+    (pika-selection-none img)
+
+    (pika-image-convert-rgb img)
+
+    (pika-drawable-color-balance layer1 TRANSFER-SHADOWS TRUE
+				 (shadows (rval hc))
+				 (shadows (gval hc))
+				 (shadows (bval hc)))
+    (pika-drawable-color-balance layer1 TRANSFER-MIDTONES TRUE
+				 (midtones (rval hc))
+				 (midtones (gval hc))
+				 (midtones (bval hc)))
+    (pika-drawable-color-balance layer1 TRANSFER-HIGHLIGHTS TRUE
+				 (highlights (rval hc))
+				 (highlights (gval hc))
+				 (highlights (bval hc)))
+
+    (pika-drawable-color-balance layer2 TRANSFER-SHADOWS TRUE
+				 (shadows (rval cc))
+				 (shadows (gval cc))
+				 (shadows (bval cc)))
+    (pika-drawable-color-balance layer2 TRANSFER-MIDTONES TRUE
+				 (midtones (rval cc))
+				 (midtones (gval cc))
+				 (midtones (bval cc)))
+    (pika-drawable-color-balance layer2 TRANSFER-HIGHLIGHTS TRUE
+				 (highlights (rval cc))
+				 (highlights (gval cc))
+				 (highlights (bval cc)))
+    (pika-drawable-hue-saturation layer2 HUE-RANGE-ALL
+				  0.0
+				  chrome-lightness
+				  chrome-saturation
+				  0.0)
+
+    (pika-item-set-visible shadow TRUE)
+    (pika-item-set-visible bg-layer TRUE)
+
+    (pika-item-set-name layer2 _"Chrome")
+    (pika-item-set-name layer1 _"Highlight")
+
+    (pika-image-remove-channel img mask)
+
+    (pika-brush-delete brush-name)
+
+    (pika-display-new img)
+    (pika-image-undo-enable img)
+
+    (pika-context-pop)
+  )
+)
+
+(script-fu-register "script-fu-sota-chrome-it"
+  _"Stencil C_hrome..."
+  _"Add a chrome effect to the selected region (or alpha) using a specified (grayscale) stencil"
+  "Spencer Kimball"
+  "Spencer Kimball"
+  "1997"
+  "GRAY"
+  SF-IMAGE       "Chrome image"      0
+  SF-DRAWABLE    "Chrome mask"       0
+  SF-ADJUSTMENT _"Chrome saturation" '(-80 -100 100 1 10 0 0)
+  SF-ADJUSTMENT _"Chrome lightness"  '(-47 -100 100 1 10 0 0)
+  SF-ADJUSTMENT _"Chrome factor"     '(0.75 0 1 0.1 0.2 2 0)
+  SF-FILENAME   _"Environment map"
+                (string-append pika-data-directory
+                              "/scripts/images/beavis.jpg")
+  SF-COLOR      _"Highlight balance"  '(211 95 0)
+  SF-COLOR      _"Chrome balance"     "black"
+  SF-TOGGLE     _"Chrome white areas" TRUE
+)
+
+(script-fu-menu-register "script-fu-sota-chrome-it"
+                         "<Image>/Filters/Decor")

plug-ins/script-fu/scripts/circuit.scm

@@ -0,0 +1,147 @@
+; PIKA - Photo and Image Kooker Application
+; Copyright (C) 1995 Spencer Kimball and Peter Mattis
+;
+; Circuit board effect
+; Copyright (c) 1997 Adrian Likins
+;
+; Generates what looks a little like the back of an old circuit board.
+; Looks even better when gradient-mapp'ed with a suitable gradient.
+;
+; 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 (script-fu-circuit image
+                           drawable
+                           mask-size
+                           seed
+                           remove-bg
+                           keep-selection
+                           separate-layer)
+  (let* (
+        (type (car (pika-drawable-type-with-alpha drawable)))
+        (image-width (car (pika-image-get-width image)))
+        (image-height (car (pika-image-get-height image)))
+        (active-selection 0)
+        (from-selection 0)
+        (selection-bounds 0)
+        (select-offset-x 0)
+        (select-offset-y 0)
+        (select-width 0)
+        (select-height 0)
+        (effect-layer 0)
+        (active-layer 0)
+        )
+
+    (pika-context-push)
+    (pika-context-set-defaults)
+
+    (pika-image-undo-group-start image)
+
+    (pika-layer-add-alpha drawable)
+
+    (if (= (car (pika-selection-is-empty image)) TRUE)
+        (begin
+          (pika-image-select-item image CHANNEL-OP-REPLACE drawable)
+          (set! active-selection (car (pika-selection-save image)))
+          (set! from-selection FALSE))
+        (begin
+          (set! from-selection TRUE)
+          (set! active-selection (car (pika-selection-save image)))))
+
+    (set! selection-bounds (pika-selection-bounds image))
+    (set! select-offset-x (cadr selection-bounds))
+    (set! select-offset-y (caddr selection-bounds))
+    (set! select-width (- (cadr (cddr selection-bounds)) select-offset-x))
+    (set! select-height (- (caddr (cddr selection-bounds)) select-offset-y))
+
+    (if (= separate-layer TRUE)
+        (begin
+          (set! effect-layer (car (pika-layer-new image
+                                                  select-width
+                                                  select-height
+                                                  type
+                                                  _"Effect layer"
+                                                  100
+                                                  LAYER-MODE-NORMAL)))
+
+          (pika-image-insert-layer image effect-layer 0 -1)
+          (pika-layer-set-offsets effect-layer select-offset-x select-offset-y)
+          (pika-selection-none image)
+          (pika-drawable-edit-clear effect-layer)
+          (pika-image-select-item image CHANNEL-OP-REPLACE active-selection)
+          (pika-edit-copy 1 (vector drawable))
+
+          (let* (
+                 (pasted (pika-edit-paste effect-layer FALSE))
+                 (num-pasted (car pasted))
+                 (floating-sel (aref (cadr pasted) (- num-pasted 1)))
+                )
+           (pika-floating-sel-anchor floating-sel)
+          )
+          (pika-image-set-selected-layers image 1 (vector effect-layer)))
+          (set! effect-layer drawable)
+    )
+    (set! active-layer effect-layer)
+
+    (if (= remove-bg TRUE)
+        (pika-context-set-foreground '(0 0 0))
+        (pika-context-set-foreground '(14 14 14))
+    )
+
+    (pika-image-select-item image CHANNEL-OP-REPLACE active-selection)
+    (plug-in-maze RUN-NONINTERACTIVE image active-layer 5 5 TRUE 0 seed 57 1)
+    (plug-in-oilify RUN-NONINTERACTIVE image active-layer mask-size 0)
+    (plug-in-edge RUN-NONINTERACTIVE image active-layer 2 1 0)
+    (if (= type RGBA-IMAGE)
+      (pika-drawable-desaturate active-layer DESATURATE-LIGHTNESS))
+
+    (if (and
+         (= remove-bg TRUE)
+         (= separate-layer TRUE))
+        (begin
+          (pika-image-select-color image CHANNEL-OP-REPLACE active-layer '(0 0 0))
+          (pika-drawable-edit-clear active-layer)))
+
+    (if (= keep-selection FALSE)
+        (pika-selection-none image))
+
+    (pika-image-remove-channel image active-selection)
+    (pika-image-set-selected-layers image 1 (vector drawable))
+
+    (pika-image-undo-group-end image)
+
+    (pika-displays-flush)
+
+    (pika-context-pop)
+  )
+)
+
+(script-fu-register "script-fu-circuit"
+  _"_Circuit..."
+  _"Fill the selected region (or alpha) with traces like those on a circuit board"
+  "Adrian Likins <adrian@gimp.org>"
+  "Adrian Likins"
+  "10/17/97"
+  "RGB* GRAY*"
+  SF-IMAGE      "Image"             0
+  SF-DRAWABLE   "Drawable"          0
+  SF-ADJUSTMENT _"Oilify mask size" '(17 3 50 1 10 0 1)
+  SF-ADJUSTMENT _"Circuit seed"     '(3 1 3000000 1 10 0 1)
+  SF-TOGGLE     _"No background (only for separate layer)" FALSE
+  SF-TOGGLE     _"Keep selection"   TRUE
+  SF-TOGGLE     _"Separate layer"   TRUE
+)
+
+(script-fu-menu-register "script-fu-circuit"
+                         "<Image>/Filters/Render")

plug-ins/script-fu/scripts/clothify-v3.scm

@@ -0,0 +1,84 @@
+; CLOTHIFY version 1.02
+; Gives the current layer in the indicated image a cloth-like texture.
+; Process invented by Zach Beane (Xath@irc.pika.net)
+;
+; Tim Newsome <drz@froody.bloke.com> 4/11/97
+
+; v3>>> Adapted to take many drawables, but only handle the first
+; v3>>> drawables is-a vector, and there is no formal arg for its length i.e.  n_drawables
+
+(define (script-fu-clothify-v3 timg drawables bx by azimuth elevation depth)
+  (let* (
+        (tdrawable (aref drawables 0))  v3>>> only the first drawable
+        (width (car (pika-drawable-get-width tdrawable)))
+        (height (car (pika-drawable-get-height tdrawable)))
+        (img (car (pika-image-new width height RGB)))
+;       (layer-two (car (pika-layer-new img width height RGB-IMAGE "Y Dots" 100 LAYER-MODE-MULTIPLY)))
+        (layer-one (car (pika-layer-new img width height RGB-IMAGE "X Dots" 100 LAYER-MODE-NORMAL)))
+        (layer-two 0)
+        (bump-layer 0)
+        )
+
+    (pika-context-push)
+    (pika-context-set-defaults)
+
+    (pika-image-undo-disable img)
+
+    (pika-image-insert-layer img layer-one 0 0)
+
+    (pika-context-set-background '(255 255 255))
+    (pika-drawable-edit-fill layer-one FILL-BACKGROUND)
+
+    (plug-in-noisify RUN-NONINTERACTIVE img layer-one FALSE 0.7 0.7 0.7 0.7)
+
+    (set! layer-two (car (pika-layer-copy layer-one 0)))
+    (pika-layer-set-mode layer-two LAYER-MODE-MULTIPLY)
+    (pika-image-insert-layer img layer-two 0 0)
+
+    (plug-in-gauss-rle RUN-NONINTERACTIVE img layer-one bx TRUE FALSE)
+    (plug-in-gauss-rle RUN-NONINTERACTIVE img layer-two by FALSE TRUE)
+    (pika-image-flatten img)
+    (set! bump-layer (car (pika-image-get-active-layer img)))
+
+    (plug-in-c-astretch RUN-NONINTERACTIVE img bump-layer)
+    (plug-in-noisify RUN-NONINTERACTIVE img bump-layer FALSE 0.2 0.2 0.2 0.2)
+
+    (plug-in-bump-map RUN-NONINTERACTIVE img tdrawable bump-layer azimuth elevation depth 0 0 0 0 FALSE FALSE 0)
+    (pika-image-delete img)
+    (pika-displays-flush)
+
+    (pika-context-pop)
+
+    ; well-behaved requires error if more than one drawable
+    ( if (> (vector-length drawables) 1 )
+         (begin
+            ; Msg to status bar, need not be acknowledged by any user
+            (pika-message "Received more than one drawable.")
+            ; Msg propagated in a GError to Pika's error dialog that must be acknowledged
+            (write "Received more than one drawable.")
+            ; Indicate err to programmed callers
+            #f)
+         #t
+    )
+  )
+)
+
+; v3 >>> no image or drawable declared.
+; v3 >>> SF-ONE-DRAWABLE means contracts to process only one drawable
+(script-fu-register-filter "script-fu-clothify-v3"
+  _"_Clothify v3..."
+  _"Add a cloth-like texture to the selected region (or alpha)"
+  "Tim Newsome <drz@froody.bloke.com>"
+  "Tim Newsome"
+  "4/11/97"
+  "RGB* GRAY*"
+  SF-ONE-DRAWABLE
+  SF-ADJUSTMENT _"Blur X"         '(9 3 100 1 10 0 1)
+  SF-ADJUSTMENT _"Blur Y"         '(9 3 100 1 10 0 1)
+  SF-ADJUSTMENT _"Azimuth"        '(135 0 360 1 10 1 0)
+  SF-ADJUSTMENT _"Elevation"      '(45 0 90 1 10 1 0)
+  SF-ADJUSTMENT _"Depth"          '(3 1 50 1 10 0 1)
+)
+
+(script-fu-menu-register "script-fu-clothify-v3"
+                         "<Image>/Filters/Artistic")

plug-ins/script-fu/scripts/clothify.scm

@@ -0,0 +1,68 @@
+; CLOTHIFY version 1.02
+; Gives the current layer in the indicated image a cloth-like texture.
+; Process invented by Zach Beane (Xath@irc.pika.net)
+;
+; Tim Newsome <drz@froody.bloke.com> 4/11/97
+
+(define (script-fu-clothify timg tdrawable bx by azimuth elevation depth)
+  (let* (
+        (width (car (pika-drawable-get-width tdrawable)))
+        (height (car (pika-drawable-get-height tdrawable)))
+        (img (car (pika-image-new width height RGB)))
+;       (layer-two (car (pika-layer-new img width height RGB-IMAGE "Y Dots" 100 LAYER-MODE-MULTIPLY)))
+        (layer-one (car (pika-layer-new img width height RGB-IMAGE "X Dots" 100 LAYER-MODE-NORMAL)))
+        (layer-two 0)
+        (bump-layer 0)
+        )
+
+    (pika-context-push)
+    (pika-context-set-defaults)
+
+    (pika-image-undo-disable img)
+
+    (pika-image-insert-layer img layer-one 0 0)
+
+    (pika-context-set-background '(255 255 255))
+    (pika-drawable-edit-fill layer-one FILL-BACKGROUND)
+
+    (plug-in-noisify RUN-NONINTERACTIVE img layer-one FALSE 0.7 0.7 0.7 0.7)
+
+    (set! layer-two (car (pika-layer-copy layer-one 0)))
+    (pika-layer-set-mode layer-two LAYER-MODE-MULTIPLY)
+    (pika-image-insert-layer img layer-two 0 0)
+
+    (plug-in-gauss-rle RUN-NONINTERACTIVE img layer-one bx TRUE FALSE)
+    (plug-in-gauss-rle RUN-NONINTERACTIVE img layer-two by FALSE TRUE)
+    (pika-image-flatten img)
+    (set! bump-layer (aref (cadr (pika-image-get-selected-layers img)) 0))
+
+    (plug-in-c-astretch RUN-NONINTERACTIVE img bump-layer)
+    (plug-in-noisify RUN-NONINTERACTIVE img bump-layer FALSE 0.2 0.2 0.2 0.2)
+
+    (plug-in-bump-map RUN-NONINTERACTIVE img tdrawable bump-layer azimuth elevation depth 0 0 0 0 FALSE FALSE 0)
+    (pika-image-delete img)
+    (pika-displays-flush)
+
+    (pika-context-pop)
+  )
+)
+
+
+(script-fu-register "script-fu-clothify"
+  _"_Clothify..."
+  _"Add a cloth-like texture to the selected region (or alpha)"
+  "Tim Newsome <drz@froody.bloke.com>"
+  "Tim Newsome"
+  "4/11/97"
+  "RGB* GRAY*"
+  SF-IMAGE       "Input image"    0
+  SF-DRAWABLE    "Input drawable" 0
+  SF-ADJUSTMENT _"Blur X"         '(9 3 100 1 10 0 1)
+  SF-ADJUSTMENT _"Blur Y"         '(9 3 100 1 10 0 1)
+  SF-ADJUSTMENT _"Azimuth"        '(135 0 360 1 10 1 0)
+  SF-ADJUSTMENT _"Elevation"      '(45 0 90 1 10 1 0)
+  SF-ADJUSTMENT _"Depth"          '(3 1 50 1 10 0 1)
+)
+
+(script-fu-menu-register "script-fu-clothify"
+                         "<Image>/Filters/Artistic")

plug-ins/script-fu/scripts/coffee.scm

@@ -0,0 +1,94 @@
+; Chris Gutteridge (cjg@ecs.soton.ac.uk)
+; At ECS Dept, University of Southampton, England.
+
+; 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 (script-fu-coffee-stain inImage inLayer inNumber inDark)
+  (let* (
+        (theImage inImage)
+        (theHeight (car (pika-image-get-height theImage)))
+        (theWidth (car (pika-image-get-width theImage)))
+        (theNumber inNumber)
+        (theSize (min theWidth theHeight))
+        (theStain 0)
+        )
+
+    (pika-context-push)
+    (pika-context-set-defaults)
+
+    (pika-image-undo-group-start theImage)
+
+    (while (> theNumber 0)
+      (set! theNumber (- theNumber 1))
+      (set! theStain (car (pika-layer-new theImage theSize theSize
+                                          RGBA-IMAGE _"Stain" 100
+                                          (if (= inDark TRUE)
+                                              LAYER-MODE-DARKEN-ONLY LAYER-MODE-NORMAL))))
+
+      (pika-image-insert-layer theImage theStain 0 0)
+      (pika-selection-all theImage)
+      (pika-drawable-edit-clear theStain)
+
+      (let ((blobSize (/ (rand (- theSize 40)) (+ (rand 3) 1))))
+        (pika-image-select-ellipse theImage
+				   CHANNEL-OP-REPLACE
+				   (/ (- theSize blobSize) 2)
+				   (/ (- theSize blobSize) 2)
+				   blobSize blobSize)
+      )
+
+      (script-fu-distress-selection theImage theStain
+                                    (- (* (+ (rand 15) 1) (+ (rand 15) 1)) 1)
+                                    (/ theSize 25) 4 2 TRUE TRUE)
+
+      (pika-context-set-gradient "Coffee")
+
+      (pika-drawable-edit-gradient-fill theStain
+					GRADIENT-SHAPEBURST-DIMPLED 0
+					FALSE 0 0
+					TRUE
+					0 0 0 0)
+
+      (pika-layer-set-offsets theStain
+                              (- (rand theWidth) (/ theSize 2))
+                              (- (rand theHeight) (/ theSize 2)))
+    )
+
+    (pika-selection-none theImage)
+
+    (pika-image-undo-group-end theImage)
+
+    (pika-displays-flush)
+
+    (pika-context-pop)
+  )
+)
+
+; Register the function with PIKA:
+
+(script-fu-register "script-fu-coffee-stain"
+  _"_Coffee Stain..."
+  _"Add realistic looking coffee stains to the image"
+  "Chris Gutteridge"
+  "1998, Chris Gutteridge / ECS dept, University of Southampton, England."
+  "25th April 1998"
+  "RGB*"
+  SF-IMAGE       "The image"   0
+  SF-DRAWABLE    "The layer"   0
+  SF-ADJUSTMENT _"Stains"      '(3 1 10 1 2 0 0)
+  SF-TOGGLE     _"Darken only" TRUE
+)
+
+(script-fu-menu-register "script-fu-coffee-stain" "<Image>/Filters/Decor")

plug-ins/script-fu/scripts/contactsheet.scm

@@ -0,0 +1,336 @@
+; "Contact Sheet" v1.2 September 5, 2007
+; by Kevin Cozens <kcozens@interlog.com>
+;
+; PIKA - Photo and Image Kooker Application
+; 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/>.
+;
+; Version 1.0 (July 27, 2004)
+; Created
+;
+; Version 1.1 (September 2, 2004)
+; Added ability to select sheet size, set font used for sheet and image
+;
+; Version 1.2 (September 5, 2007)
+; Preserve aspect ratio of original image. Center thumbnail in the area
+; allowed for the thumbnail. Added disable/enable of undo operations.
+; Added 1600x1200 sheet size.
+
+(define (script-fu-contactsheet dir sheet-size
+         title-font legend-font text-color bg-color)
+
+  (define (init-sheet-data size)
+    (let (
+         (sheet-w 0)
+         (sheet-h 0)
+         (thumb-w 0)
+         (thumb-h 0)
+         (border-x 0) ;Space between rows and at top and bottom of thumbnails
+         (border-y 0) ;Space between columns and at left and right of thumbnails
+         (off-x 0)  ; Additional X shift to properly center a row of thumbnails
+         (off-y 0)  ; Additional Y shift to properly center rows of thumbnails
+         (count 0)
+         )
+
+      (case size
+        ((0) (set! sheet-w 640)
+             (set! sheet-h 480)
+             (set! thumb-w 90)
+             (set! thumb-h 68)
+             (set! border-x 32)
+             (set! border-y 23)
+             (set! off-x -1)
+             (set! off-y 0)
+             (set! count 4)
+        )
+
+        ((1) (set! sheet-w 800)
+             (set! sheet-h 600)
+             (set! thumb-w 119)
+             (set! thumb-h 90)
+             (set! border-x 34)
+             (set! border-y 25)
+             (set! off-x 0)
+             (set! off-y 0)
+             (set! count 4)
+        )
+
+        ((2) (set! sheet-w 1024)
+             (set! sheet-h 768)
+             (set! thumb-w 133)
+             (set! thumb-h 100)
+             (set! border-x 32)
+             (set! border-y 24)
+             (set! off-x 1)
+             (set! off-y 0)
+             (set! count 5)
+        )
+
+        ((3) (set! sheet-w 1280)
+             (set! sheet-h 1024)
+             (set! thumb-w 133)
+             (set! thumb-h 100)
+             (set! border-x 24)
+             (set! border-y 25)
+             (set! off-x 0)
+             (set! off-y 0)
+             (set! count 7)
+        )
+
+        ((4) (set! sheet-w 1600)
+             (set! sheet-h 1200)
+             (set! thumb-w 120)
+             (set! thumb-h 90)
+             (set! border-x 36)
+             (set! border-y 25)
+             (set! off-x 2)
+             (set! off-y 0)
+             (set! count 9)
+        )
+      )
+
+      (list sheet-w sheet-h thumb-w thumb-h border-x border-y off-x off-y count)
+    )
+  )
+
+  (define (init-sheet-img img num img-width border-y off-y)
+    (let* (
+          (text-layer 0)
+          (text-width 0)
+          (text-height 0)
+          )
+      (pika-selection-all img)
+      (pika-drawable-fill (aref (cadr (pika-image-get-selected-layers img)) 0)
+                          FILL-BACKGROUND)
+      (pika-selection-none img)
+      (set! text-layer (car (pika-text-fontname img -1 0 0
+                              (string-append _"Contact Sheet "
+                                             (number->string num)
+                                             _" for directory " dir)
+                                             0 TRUE 14 PIXELS title-font)))
+      (set! text-width (car (pika-drawable-get-width text-layer)))
+      (set! text-height (car (pika-drawable-get-height text-layer)))
+      (pika-layer-set-offsets text-layer
+        (/ (- img-width text-width) 2)
+        (/ (- (+ border-y off-y) text-height) 2)
+      )
+      (pika-image-merge-visible-layers img CLIP-TO-IMAGE)
+    )
+  )
+
+  (define (make-thumbnail-size img thumb-w thumb-h)
+    (let* (
+          (file-height (car (pika-image-get-height img)))
+          (file-width  (car (pika-image-get-width img)))
+          (aspect-ratio (/ file-width file-height))
+          )
+
+      ;Preserve the aspect ratio of the original image
+      (if (> file-width file-height)
+        (set! thumb-h (/ thumb-w aspect-ratio))
+        (set! thumb-w (* thumb-h aspect-ratio))
+      )
+
+      (pika-image-scale img thumb-w thumb-h)
+    )
+  )
+
+  (let* (
+        (dir-stream (dir-open-stream dir))
+        (sheet-num 1)
+        (img-count 0)
+        (pos-x 0)
+        (pos-y 0)
+
+        (sheet-data 0)
+        (sheet-width 0)
+        (sheet-height 0)
+        (thumb-w 0)
+        (thumb-h 0)
+        (border-x 0)
+        (border-y 0)
+        (off-x 0)
+        (off-y 0)
+        (max-x 0)
+        (max-y 0)
+
+        (sheet-img 0)
+        (sheet-layer 0)
+
+        (new-img 0)
+        (file 0)
+        (file-path 0)
+        (tmp-layer 0)
+        )
+
+    (pika-context-push)
+    (pika-context-set-defaults)
+    (pika-context-set-foreground text-color)
+    (pika-context-set-background bg-color)
+
+    (set! sheet-data (init-sheet-data sheet-size))
+    (set! sheet-width (car sheet-data))
+    (set! sheet-height (cadr sheet-data))
+    (set! sheet-data (cddr sheet-data))
+    (set! thumb-w (car sheet-data))
+    (set! thumb-h (cadr sheet-data))
+    (set! sheet-data (cddr sheet-data))
+    (set! border-x (car sheet-data))
+    (set! border-y (cadr sheet-data))
+    (set! sheet-data (cddr sheet-data))
+    (set! off-x (car sheet-data))
+    (set! off-y (cadr sheet-data))
+    (set! max-x (caddr sheet-data))
+    (set! max-y max-x)
+
+    (set! sheet-img (car (pika-image-new sheet-width sheet-height RGB)))
+
+    (pika-image-undo-disable sheet-img)
+
+    (set! sheet-layer (car (pika-layer-new sheet-img sheet-width sheet-height
+                            RGB-IMAGE "Background"
+                            100 LAYER-MODE-NORMAL)))
+    (pika-image-insert-layer sheet-img sheet-layer 0 0)
+
+    (init-sheet-img sheet-img sheet-num sheet-width border-y off-y)
+
+    (if (not dir-stream)
+      (pika-message (string-append _"Unable to open directory " dir))
+      (begin
+        (do
+          ( (file (dir-read-entry dir-stream) (dir-read-entry dir-stream)) )
+          ( (eof-object? file) )
+
+          (set! file-path (string-append dir DIR-SEPARATOR file))
+          ; file-path is a full path, file is filename
+          (if (and (not (re-match "index.*" file))
+                   (= (file-type file-path) FILE-TYPE-FILE)
+              )
+            (catch ()
+              (set! new-img
+                    (car (pika-file-load RUN-NONINTERACTIVE file-path)))
+
+              (make-thumbnail-size new-img thumb-w thumb-h)
+
+              (if (> (car (pika-image-get-layers new-img)) 1)
+                (pika-image-flatten new-img)
+              )
+              (set! tmp-layer
+                (car (pika-layer-new-from-drawable
+                        (aref (cadr (pika-image-get-selected-drawables new-img)) 0)
+                        sheet-img)))
+
+              (pika-image-insert-layer sheet-img tmp-layer 0 0)
+
+              ;Move thumbnail in to position and center it in area available.
+              (pika-layer-set-offsets tmp-layer
+                (+ border-x off-x (* pos-x (+ thumb-w border-x))
+                   (/ (- thumb-w (car (pika-image-get-width new-img))) 2)
+                )
+                (+ border-y off-y (* pos-y (+ thumb-h border-y))
+                   (/ (- thumb-h (car (pika-image-get-height new-img))) 2)
+                )
+              )
+
+              (pika-image-delete new-img)
+
+              (set! tmp-layer (car (pika-text-fontname sheet-img -1 0 0 file
+                                     0 TRUE 12 PIXELS legend-font)))
+              (pika-layer-set-offsets tmp-layer
+                (+ border-x off-x (* pos-x (+ thumb-w border-x))
+                   (/ (- thumb-w (car (pika-drawable-get-width tmp-layer))) 2))
+                (+ border-y off-y (* pos-y (+ thumb-h border-y)) thumb-h 6)
+              )
+
+              (set! img-count (+ img-count 1))
+
+              (set! pos-x (+ pos-x 1))
+              (if (> pos-x max-x)
+                (begin
+                  (set! pos-x 0)
+                  (set! pos-y (+ pos-y 1))
+                  (if (> pos-y max-y)
+                    (begin
+                      (set! pos-y 0)
+                      (set! sheet-layer (car (pika-image-flatten sheet-img)))
+                      (pika-file-save
+                        RUN-NONINTERACTIVE
+                        sheet-img
+                        1 (vector sheet-layer)
+                        (string-append dir DIR-SEPARATOR
+                            "index" (number->string sheet-num) ".jpg")
+                      )
+
+                      (set! sheet-num (+ sheet-num 1))
+                      (init-sheet-img sheet-img sheet-num sheet-width
+                                      border-y off-y)
+                      (set! img-count 0)
+                    )
+                  )
+                )
+              )
+            )
+          )
+        )
+
+        (dir-close-stream dir-stream)
+
+        (if (> img-count 0)
+          (begin
+            (set! sheet-layer (car (pika-image-flatten sheet-img)))
+            (pika-file-save
+              RUN-NONINTERACTIVE
+              sheet-img
+              1 (vector sheet-layer)
+              (string-append dir DIR-SEPARATOR
+                  "index" (number->string sheet-num) ".jpg")
+            )
+          )
+        )
+      )
+
+      (pika-image-undo-enable sheet-img)
+      (pika-image-delete sheet-img)
+
+      (display (string-append _"Created " (number->string sheet-num)
+                              _" contact sheets from a total of "
+                              (number->string img-count) _" images"))
+      (newline)
+    )
+
+    (pika-context-pop)
+  )
+)
+
+(script-fu-register "script-fu-contactsheet"
+    _"_Contact Sheet..."
+    _"Create a series of images containing thumbnail sized versions of all of the images in a specified directory."
+    "Kevin Cozens <kcozens@interlog.com>"
+    "Kevin Cozens"
+    "July 19, 2004"
+    ""
+    SF-DIRNAME _"Images Directory" "/tmp/test"
+    SF-OPTION  _"Sheet size"       '("640 x 480"
+                                     "800 x 600"
+                                     "1024 x 768"
+                                     "1280 x 1024"
+                                     "1600 x 1200")
+    SF-FONT    _"Title font"       "Sans Bold Italic"
+    SF-FONT    _"Legend font"      "Sans Bold"
+    SF-COLOR   _"Text color"       "white"
+    SF-COLOR   _"Background color" "black"
+)
+
+(script-fu-menu-register "script-fu-contactsheet" "<Image>/Filters/Combine")

plug-ins/script-fu/scripts/difference-clouds.scm

@@ -0,0 +1,80 @@
+; Plugin for the Photo and Image Kooker Application
+; Copyright (C) 2006 Martin Nordholts
+;
+; 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/>.
+;
+; Renders Difference Clouds onto a layer, i.e. solid noise merged down with the
+; Difference Mode
+;
+
+(define (script-fu-difference-clouds image
+                                     drawable)
+
+  (let* ((draw-offset-x (car (pika-drawable-get-offsets drawable)))
+         (draw-offset-y (cadr (pika-drawable-get-offsets drawable)))
+         (has-sel       (car (pika-drawable-mask-intersect drawable)))
+         (sel-offset-x  (cadr (pika-drawable-mask-intersect drawable)))
+         (sel-offset-y  (caddr (pika-drawable-mask-intersect drawable)))
+         (width         (cadddr (pika-drawable-mask-intersect drawable)))
+         (height        (caddr (cddr (pika-drawable-mask-intersect drawable))))
+         (type          (car (pika-drawable-type-with-alpha drawable)))
+         (diff-clouds  -1)
+         (offset-x      0)
+         (offset-y      0)
+        )
+
+    (pika-image-undo-group-start image)
+
+    ; Create the cloud layer
+    (set! diff-clouds (car (pika-layer-new image width height type
+                                             "Clouds" 100 LAYER-MODE-DIFFERENCE)))
+
+    ; Add the cloud layer above the current layer
+    (pika-image-insert-layer image diff-clouds 0 -1)
+
+    ; Clear the layer (so there are no noise in it)
+    (pika-drawable-fill diff-clouds FILL-TRANSPARENT)
+
+    ; Selections are relative to the drawable; adjust the final offset
+    (set! offset-x (+ draw-offset-x sel-offset-x))
+    (set! offset-y (+ draw-offset-y sel-offset-y))
+
+    ; Offset the clouds layer
+    (if (pika-item-is-layer drawable)
+      (pika-item-transform-translate diff-clouds offset-x offset-y))
+
+    ; Show the solid noise dialog
+    (plug-in-solid-noise SF-RUN-MODE image diff-clouds 0 0 0 1 4.0 4.0)
+
+    ; Merge the clouds layer with the layer below
+    (pika-image-merge-down image diff-clouds EXPAND-AS-NECESSARY)
+
+    (pika-image-undo-group-end image)
+
+    (pika-displays-flush)
+  )
+)
+
+(script-fu-register "script-fu-difference-clouds"
+                    _"_Difference Clouds..."
+                    _"Solid noise applied with Difference layer mode"
+                    "Martin Nordholts <enselic@hotmail.com>"
+                    "Martin Nordholts"
+                    "2006/10/25"
+                    "RGB* GRAY*"
+                    SF-IMAGE       "Image"           0
+                    SF-DRAWABLE    "Drawable"        0)
+
+(script-fu-menu-register "script-fu-difference-clouds"
+			 "<Image>/Filters/Render/Noise")

plug-ins/script-fu/scripts/distress-selection.scm

@@ -0,0 +1,122 @@
+;
+; distress selection
+;
+;
+; Chris Gutteridge (cjg@ecs.soton.ac.uk)
+; At ECS Dept, University of Southampton, England.
+
+; 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 the function:
+
+(define (script-fu-distress-selection inImage
+                                      inDrawable
+                                      inThreshold
+                                      inSpread
+                                      inGranu
+                                      inSmooth
+                                      inSmoothH
+                                      inSmoothV)
+
+  (let (
+       (theImage inImage)
+       (theWidth (car (pika-image-get-width inImage)))
+       (theHeight (car (pika-image-get-height inImage)))
+       (theLayer 0)
+       (theMode (car (pika-image-get-base-type inImage)))
+       (prevLayers (pika-image-get-selected-layers inImage))
+       )
+
+    (pika-context-push)
+    (pika-context-set-defaults)
+    (pika-image-undo-group-start theImage)
+
+    (if (= theMode GRAY)
+      (set! theMode GRAYA-IMAGE)
+      (set! theMode RGBA-IMAGE)
+    )
+    (set! theLayer (car (pika-layer-new theImage
+                                        theWidth
+                                        theHeight
+                                        theMode
+                                        "Distress Scratch Layer"
+                                        100
+                                        LAYER-MODE-NORMAL)))
+
+    (pika-image-insert-layer theImage theLayer 0 0)
+
+    (if (= FALSE (car (pika-selection-is-empty theImage)))
+        (pika-drawable-edit-fill theLayer FILL-BACKGROUND)
+    )
+
+    (pika-selection-invert theImage)
+
+    (if (= FALSE (car (pika-selection-is-empty theImage)))
+        (pika-drawable-edit-clear theLayer)
+    )
+
+    (pika-selection-invert theImage)
+    (pika-selection-none inImage)
+
+    (pika-layer-scale theLayer
+                      (/ theWidth inGranu)
+                      (/ theHeight inGranu)
+                      TRUE)
+
+    (plug-in-spread RUN-NONINTERACTIVE
+                    theImage
+                    theLayer
+                    inSpread
+                    inSpread)
+
+    (plug-in-gauss-iir RUN-NONINTERACTIVE
+           theImage theLayer inSmooth inSmoothH inSmoothV)
+    (pika-layer-scale theLayer theWidth theHeight TRUE)
+    (plug-in-threshold-alpha RUN-NONINTERACTIVE theImage theLayer inThreshold)
+    (plug-in-gauss-iir RUN-NONINTERACTIVE theImage theLayer 1 TRUE TRUE)
+    (pika-image-select-item inImage CHANNEL-OP-REPLACE theLayer)
+    (pika-image-remove-layer theImage theLayer)
+    (if (and (= (car (pika-item-id-is-channel inDrawable)) TRUE)
+             (= (car (pika-item-id-is-layer-mask inDrawable)) FALSE))
+      (pika-image-set-selected-channels theImage 1 (make-vector 1 inDrawable))
+      )
+    (pika-image-undo-group-end theImage)
+
+    (pika-image-set-selected-layers theImage (car prevLayers) (cadr prevLayers))
+
+    (pika-displays-flush)
+    (pika-context-pop)
+  )
+)
+
+
+(script-fu-register "script-fu-distress-selection"
+  _"_Distort..."
+  _"Distress the selection"
+  "Chris Gutteridge"
+  "1998, Chris Gutteridge / ECS dept, University of Southampton, England."
+  "23rd April 1998"
+  "RGB*,GRAY*"
+  SF-IMAGE       "The image"              0
+  SF-DRAWABLE    "The layer"              0
+  SF-ADJUSTMENT _"_Threshold (bigger 1<-->254 smaller)" '(127 1 254 1 10 0 0)
+  SF-ADJUSTMENT _"_Spread"                 '(8 0 1000 1 10 0 1)
+  SF-ADJUSTMENT _"_Granularity (1 is low)" '(4 1 25 1 10 0 1)
+  SF-ADJUSTMENT _"S_mooth"                 '(2 1 150 1 10 0 1)
+  SF-TOGGLE     _"Smooth hor_izontally"    TRUE
+  SF-TOGGLE     _"Smooth _vertically"      TRUE
+)
+
+(script-fu-menu-register "script-fu-distress-selection"
+                         "<Image>/Select/[Modify]")

plug-ins/script-fu/scripts/drop-shadow.scm

@@ -0,0 +1,187 @@
+; PIKA - Photo and Image Kooker Application
+; 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/>.
+;
+;
+; drop-shadow.scm   version 1.05   2011/4/21
+;
+; CHANGE-LOG:
+; 1.00 - initial release
+; 1.01 - fixed the problem with a remaining copy of the selection
+; 1.02 - some code cleanup, no real changes
+; 1.03 - can't call pika-drawable-edit-fill until layer is added to image!
+; 1.04
+; 1.05 - replaced deprecated function calls with new ones for 2.8
+;
+; Copyright (C) 1997-1999 Sven Neumann <sven@gimp.org>
+;
+;
+; Adds a drop-shadow of the current selection or alpha-channel.
+;
+; This script is derived from my script add-shadow, which has become
+; obsolete now. Thanks to Andrew Donkin (ard@cs.waikato.ac.nz) for his
+; idea to add alpha-support to add-shadow.
+
+
+(define (script-fu-drop-shadow image
+                               drawable
+                               shadow-transl-x
+                               shadow-transl-y
+                               shadow-blur
+                               shadow-color
+                               shadow-opacity
+                               allow-resize)
+  (let* (
+        (shadow-blur (max shadow-blur 0))
+        (shadow-opacity (min shadow-opacity 100))
+        (shadow-opacity (max shadow-opacity 0))
+        (type (car (pika-drawable-type-with-alpha drawable)))
+        (image-width (car (pika-image-get-width image)))
+        (image-height (car (pika-image-get-height image)))
+        (from-selection 0)
+        (active-selection 0)
+        (shadow-layer 0)
+        )
+
+  (pika-context-push)
+  (pika-context-set-defaults)
+
+  (pika-image-set-selected-layers image 1 (make-vector 1 drawable))
+
+  (pika-image-undo-group-start image)
+
+  (pika-layer-add-alpha drawable)
+  (if (= (car (pika-selection-is-empty image)) TRUE)
+      (begin
+        (pika-image-select-item image CHANNEL-OP-REPLACE drawable)
+        (set! from-selection FALSE))
+      (begin
+        (set! from-selection TRUE)
+        (set! active-selection (car (pika-selection-save image)))))
+
+  (let* ((selection-bounds (pika-selection-bounds image))
+         (select-offset-x (cadr selection-bounds))
+         (select-offset-y (caddr selection-bounds))
+         (select-width (- (cadr (cddr selection-bounds)) select-offset-x))
+         (select-height (- (caddr (cddr selection-bounds)) select-offset-y))
+
+         (shadow-width (+ select-width (* 2 shadow-blur)))
+         (shadow-height (+ select-height (* 2 shadow-blur)))
+
+         (shadow-offset-x (- select-offset-x shadow-blur))
+         (shadow-offset-y (- select-offset-y shadow-blur)))
+
+    (if (= allow-resize TRUE)
+        (let* ((new-image-width image-width)
+               (new-image-height image-height)
+               (image-offset-x 0)
+               (image-offset-y 0))
+
+          (if (< (+ shadow-offset-x shadow-transl-x) 0)
+              (begin
+                (set! image-offset-x (- 0 (+ shadow-offset-x
+                                             shadow-transl-x)))
+                (set! shadow-offset-x (- 0 shadow-transl-x))
+                (set! new-image-width (+ new-image-width image-offset-x))))
+
+          (if (< (+ shadow-offset-y shadow-transl-y) 0)
+              (begin
+                (set! image-offset-y (- 0 (+ shadow-offset-y
+                                             shadow-transl-y)))
+                (set! shadow-offset-y (- 0 shadow-transl-y))
+                (set! new-image-height (+ new-image-height image-offset-y))))
+
+          (if (> (+ (+ shadow-width shadow-offset-x) shadow-transl-x)
+                 new-image-width)
+              (set! new-image-width
+                    (+ (+ shadow-width shadow-offset-x) shadow-transl-x)))
+
+          (if (> (+ (+ shadow-height shadow-offset-y) shadow-transl-y)
+                 new-image-height)
+              (set! new-image-height
+                    (+ (+ shadow-height shadow-offset-y) shadow-transl-y)))
+
+          (pika-image-resize image
+                             new-image-width
+                             new-image-height
+                             image-offset-x
+                             image-offset-y)
+        )
+    )
+
+    (set! shadow-layer (car (pika-layer-new image
+                                            shadow-width
+                                            shadow-height
+                                            type
+                                            "Drop Shadow"
+                                            shadow-opacity
+                                            LAYER-MODE-NORMAL)))
+    (pika-image-set-selected-layers image 1 (make-vector 1 drawable))
+    (pika-image-insert-layer image shadow-layer 0 -1)
+    (pika-layer-set-offsets shadow-layer
+                            shadow-offset-x
+                            shadow-offset-y))
+
+  (pika-drawable-fill shadow-layer FILL-TRANSPARENT)
+  (pika-context-set-background shadow-color)
+  (pika-drawable-edit-fill shadow-layer FILL-BACKGROUND)
+  (pika-selection-none image)
+  (pika-layer-set-lock-alpha shadow-layer FALSE)
+  (if (>= shadow-blur 1.0) (plug-in-gauss-rle RUN-NONINTERACTIVE
+                                              image
+                                              shadow-layer
+                                              shadow-blur
+                                              TRUE
+                                              TRUE))
+  (pika-item-transform-translate shadow-layer shadow-transl-x shadow-transl-y)
+
+  (if (= from-selection TRUE)
+      (begin
+        (pika-image-select-item image CHANNEL-OP-REPLACE active-selection)
+        (pika-drawable-edit-clear shadow-layer)
+        (pika-image-remove-channel image active-selection)))
+
+  (if (and
+       (= (car (pika-layer-is-floating-sel drawable)) 0)
+       (= from-selection FALSE))
+      (pika-image-raise-item image drawable))
+
+  (pika-image-set-selected-layers image 1 (make-vector 1 drawable))
+  (pika-image-undo-group-end image)
+  (pika-displays-flush)
+
+  (pika-context-pop)
+  )
+)
+
+(script-fu-register "script-fu-drop-shadow"
+  _"_Drop Shadow (legacy)..."
+  _"Add a drop shadow to the selected region (or alpha)"
+  "Sven Neumann <sven@gimp.org>"
+  "Sven Neumann"
+  "1999/12/21"
+  "RGB* GRAY*"
+  SF-IMAGE      "Image"           0
+  SF-DRAWABLE   "Drawable"        0
+  SF-ADJUSTMENT _"Offset X"       '(4 -4096 4096 1 10 0 1)
+  SF-ADJUSTMENT _"Offset Y"       '(4 -4096 4096 1 10 0 1)
+  SF-ADJUSTMENT _"Blur radius"    '(15 0 1024 1 10 0 1)
+  SF-COLOR      _"Color"          "black"
+  SF-ADJUSTMENT _"Opacity"        '(60 0 100 1 10 0 0)
+  SF-TOGGLE     _"Allow resizing" TRUE
+)
+
+(script-fu-menu-register "script-fu-drop-shadow"
+                         "<Image>/Filters/Light and Shadow/[Shadow]")

plug-ins/script-fu/scripts/font-map.scm

@@ -0,0 +1,177 @@
+;; font-map
+;; Spencer Kimball
+
+;; To test, open the Font tool dialog,
+;; press right mouse button in the list of fonts, choose "Render Font Map"
+
+;; Test cases for font filter regex
+;;   ".*"  expect render all installed fonts
+;;   "foo" expect render blank image (no matching fonts)
+;;   "Sans" expect render subset of installed fonts
+
+(define (script-fu-font-map text
+                            use-name
+                            labels
+                            font-filter
+                            font-size
+                            border
+                            colors)
+
+  (define (max-font-width text use-name list-cnt list font-size)
+    (let* ((count    0)
+           (width    0)
+           (maxwidth 0)
+           (font     "")
+           (extents  '()))
+      (while (< count list-cnt)
+        (set! font (car list))
+
+        (if (= use-name TRUE)
+            (set! text font))
+        (set! extents (pika-text-get-extents-fontname text
+                                                      font-size PIXELS
+                                                      font))
+        (set! width (car extents))
+        (if (> width maxwidth)
+            (set! maxwidth width))
+
+        (set! list (cdr list))
+        (set! count (+ count 1))
+      )
+
+      maxwidth
+    )
+  )
+
+  (define (max-font-height text use-name list-cnt list font-size)
+    (let* ((count     0)
+           (height    0)
+           (maxheight 0)
+           (font      "")
+           (extents   '()))
+      (while (< count list-cnt)
+        (set! font (car list))
+
+        (if (= use-name TRUE)
+            (set! text font)
+        )
+        (set! extents (pika-text-get-extents-fontname text
+                                                      font-size PIXELS
+                                                      font))
+        (set! height (cadr extents))
+        (if (> height maxheight)
+            (set! maxheight height)
+        )
+
+        (set! list (cdr list))
+        (set! count (+ count 1))
+      )
+
+      maxheight
+    )
+  )
+
+  (let* (
+        ; pika-fonts-get-list returns a one element list of results,
+        ; the only element is itself a list of fonts, possibly empty.
+        (font-list  (car (pika-fonts-get-list font-filter)))
+        (num-fonts  (length font-list))
+        (label-size (/ font-size 2))
+        (border     (+ border (* labels (/ label-size 2))))
+        (y          border)
+        (maxheight  (max-font-height text use-name num-fonts font-list font-size))
+        (maxwidth   (max-font-width  text use-name num-fonts font-list font-size))
+        (width      (+ maxwidth (* 2 border)))
+        (height     (+ (+ (* maxheight num-fonts) (* 2 border))
+                       (* labels (* label-size num-fonts))))
+        (img        (car (pika-image-new width height (if (= colors 0)
+                                                          GRAY RGB))))
+        (drawable   (car (pika-layer-new img width height (if (= colors 0)
+                                                              GRAY-IMAGE RGB-IMAGE)
+                                         "Background" 100 LAYER-MODE-NORMAL)))
+        (count      0)
+        (font       "")
+        )
+
+    (pika-context-push)
+
+    (pika-image-undo-disable img)
+
+    (if (= colors 0)
+        (begin
+          (pika-context-set-background '(255 255 255))
+          (pika-context-set-foreground '(0 0 0))))
+
+    (pika-image-insert-layer img drawable 0 0)
+    (pika-drawable-edit-clear drawable)
+
+    (if (= labels TRUE)
+        (begin
+          (set! drawable (car (pika-layer-new img width height
+                                              (if (= colors 0)
+                                                  GRAYA-IMAGE RGBA-IMAGE)
+                                              "Labels" 100 LAYER-MODE-NORMAL)))
+          (pika-image-insert-layer img drawable 0 -1)))
+          (pika-drawable-edit-clear drawable)
+
+    (while (< count num-fonts)
+      (set! font (car font-list))
+
+      (if (= use-name TRUE)
+          (set! text font))
+
+      (pika-text-fontname img -1
+                          border
+                          y
+                          text
+                          0 TRUE font-size PIXELS
+                          font)
+
+      (set! y (+ y maxheight))
+
+      (if (= labels TRUE)
+          (begin
+            (pika-floating-sel-anchor (car (pika-text-fontname img drawable
+                                                               (- border
+                                                                  (/ label-size 2))
+                                                               (- y
+                                                                  (/ label-size 2))
+                                                               font
+                                                               0 TRUE
+                                                               label-size PIXELS
+                                                               "Sans")))
+          (set! y (+ y label-size))
+          )
+      )
+
+      (set! font-list (cdr font-list))
+      (set! count (+ count 1))
+    )
+
+    (pika-image-set-selected-layers img 1 (vector drawable))
+
+    (pika-image-undo-enable img)
+    (pika-display-new img)
+
+    (pika-context-pop)
+  )
+)
+
+(script-fu-register "script-fu-font-map"
+  _"Render _Font Map..."
+  _"Create an image filled with previews of fonts matching a fontname filter"
+  "Spencer Kimball"
+  "Spencer Kimball"
+  "1997"
+  ""
+  SF-STRING     _"_Text"                  "How quickly daft jumping zebras vex."
+  SF-TOGGLE     _"Use font _name as text" FALSE
+  SF-TOGGLE     _"_Labels"                TRUE
+  SF-STRING     _"_Filter (regexp)"       "Sans"
+  SF-ADJUSTMENT _"Font _size (pixels)"    '(32 2 1000 1 10 0 1)
+  SF-ADJUSTMENT _"_Border (pixels)"       '(10 0  200 1 10 0 1)
+  SF-OPTION     _"_Color scheme"          '(_"Black on white" _"Active colors")
+)
+
+(script-fu-menu-register "script-fu-font-map"
+                         "<Fonts>")

plug-ins/script-fu/scripts/fuzzyborder.scm

@@ -0,0 +1,168 @@
+;
+; fuzzy-border
+;
+; Do a cool fade to a given color at the border of an image (optional shadow)
+; Will make image RGB if it isn't already.
+;
+; Chris Gutteridge (cjg@ecs.soton.ac.uk)
+; At ECS Dept, University of Southampton, England.
+
+; 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 the function:
+
+(define (script-fu-fuzzy-border inImage
+                                inLayer
+                                inColor
+                                inSize
+                                inBlur
+                                inGranu
+                                inShadow
+                                inShadWeight
+                                inCopy
+                                inFlatten
+        )
+
+  (define (chris-color-edge inImage inLayer inColor inSize)
+    (pika-selection-all inImage)
+    (pika-selection-shrink inImage inSize)
+    (pika-selection-invert inImage)
+    (pika-context-set-background inColor)
+    (pika-drawable-edit-fill inLayer FILL-BACKGROUND)
+    (pika-selection-none inImage)
+  )
+
+  (let (
+       (theWidth (car (pika-image-get-width inImage)))
+       (theHeight (car (pika-image-get-height inImage)))
+       (theImage (if (= inCopy TRUE) (car (pika-image-duplicate inImage))
+                                      inImage))
+       (theLayer 0)
+       )
+
+    (pika-context-push)
+    (pika-context-set-defaults)
+
+    (if (= inCopy TRUE)
+        (pika-image-undo-disable theImage)
+        (pika-image-undo-group-start theImage)
+    )
+
+    (pika-selection-all theImage)
+
+    (if (> (car (pika-drawable-type inLayer)) 1)
+        (pika-image-convert-rgb theImage)
+    )
+
+    (set! theLayer (car (pika-layer-new theImage
+                                        theWidth
+                                        theHeight
+                                        RGBA-IMAGE
+                                        "layer 1"
+                                        100
+                                        LAYER-MODE-NORMAL)))
+
+    (pika-image-insert-layer theImage theLayer 0 0)
+
+
+    (pika-drawable-edit-clear theLayer)
+    (chris-color-edge theImage theLayer inColor inSize)
+
+    (pika-layer-scale theLayer
+                      (/ theWidth inGranu)
+                      (/ theHeight inGranu)
+                      TRUE)
+
+    (plug-in-spread RUN-NONINTERACTIVE
+                    theImage
+                    theLayer
+                    (/ inSize inGranu)
+                    (/ inSize inGranu))
+    (chris-color-edge theImage theLayer inColor 1)
+    (pika-layer-scale theLayer theWidth theHeight TRUE)
+
+    (pika-image-select-item theImage CHANNEL-OP-REPLACE theLayer)
+    (pika-selection-invert theImage)
+    (pika-drawable-edit-clear theLayer)
+    (pika-selection-invert theImage)
+    (pika-drawable-edit-clear theLayer)
+    (pika-context-set-background inColor)
+    (pika-drawable-edit-fill theLayer FILL-BACKGROUND)
+    (pika-selection-none theImage)
+    (chris-color-edge theImage theLayer inColor 1)
+
+    (if (= inBlur TRUE)
+        (plug-in-gauss-rle RUN-NONINTERACTIVE
+                           theImage theLayer inSize TRUE TRUE)
+    )
+    (if (= inShadow TRUE)
+        (begin
+          (pika-image-insert-layer theImage
+                                   (car (pika-layer-copy theLayer FALSE)) 0 -1)
+          (pika-layer-scale theLayer
+                            (- theWidth inSize) (- theHeight inSize) TRUE)
+          (pika-drawable-desaturate theLayer DESATURATE-LIGHTNESS)
+          (pika-drawable-brightness-contrast theLayer 0.5 0.5)
+          (pika-drawable-invert theLayer FALSE)
+          (pika-layer-resize theLayer
+                             theWidth
+                             theHeight
+                             (/ inSize 2)
+                             (/ inSize 2))
+          (plug-in-gauss-rle RUN-NONINTERACTIVE
+                             theImage
+                             theLayer
+                             (/ inSize 2)
+                             TRUE
+                             TRUE)
+          (pika-layer-set-opacity theLayer inShadWeight)
+        )
+    )
+    (if (= inFlatten TRUE)
+        (pika-image-flatten theImage)
+    )
+    (if (= inCopy TRUE)
+        (begin  (pika-image-clean-all theImage)
+                (pika-display-new theImage)
+                (pika-image-undo-enable theImage)
+         )
+        (pika-image-undo-group-end theImage)
+    )
+    (pika-displays-flush)
+
+    (pika-context-pop)
+  )
+)
+
+(script-fu-register "script-fu-fuzzy-border"
+  _"_Fuzzy Border..."
+  _"Add a jagged, fuzzy border to an image"
+  "Chris Gutteridge"
+  "1998, Chris Gutteridge / ECS dept, University of Southampton, England."
+  "3rd April 1998"
+  "RGB* GRAY*"
+  SF-IMAGE      "The image"               0
+  SF-DRAWABLE   "The layer"               0
+  SF-COLOR      _"Color"                  "white"
+  SF-ADJUSTMENT _"Border size"            '(16 1 300 1 10 0 1)
+  SF-TOGGLE     _"Blur border"            TRUE
+  SF-ADJUSTMENT _"Granularity (1 is Low)" '(4 1 16 0.25 5 2 0)
+  SF-TOGGLE     _"Add shadow"             FALSE
+  SF-ADJUSTMENT _"Shadow weight (%)"      '(100 0 100 1 10 0 0)
+  SF-TOGGLE     _"Work on copy"           TRUE
+  SF-TOGGLE     _"Flatten image"          TRUE
+)
+
+(script-fu-menu-register "script-fu-fuzzy-border"
+                         "<Image>/Filters/Decor")

plug-ins/script-fu/scripts/gradient-example.scm

@@ -0,0 +1,81 @@
+; PIKA - Photo and Image Kooker Application
+; Copyright (C) 1995 Spencer Kimball and Peter Mattis
+;
+; Gradient example script --- create an example image of a custom gradient
+; Copyright (C) 1997 Federico Mena Quintero
+; federico@nuclecu.unam.mx
+;
+; 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 (script-fu-gradient-example width
+                                    height
+                                    gradient-reverse)
+  (let* (
+        (img (car (pika-image-new width height RGB)))
+        (drawable (car (pika-layer-new img width height RGB
+                                       "Gradient example" 100 LAYER-MODE-NORMAL)))
+
+        ; Calculate colors for checkerboard... just like in the gradient editor
+
+        (fg-color (* 255 (/ 2 3)))
+        (bg-color (* 255 (/ 1 3)))
+        )
+
+    (pika-image-undo-disable img)
+    (pika-image-insert-layer img drawable 0 0)
+
+    ; Render background checkerboard
+
+    (pika-context-push)
+
+    (pika-context-set-foreground (list fg-color fg-color fg-color))
+    (pika-context-set-background (list bg-color bg-color bg-color))
+    (plug-in-checkerboard RUN-NONINTERACTIVE img 1 (vector drawable) 0 8)
+
+    (pika-context-pop)
+
+    ; Render gradient
+
+    (pika-context-push)
+
+    (pika-context-set-gradient-reverse gradient-reverse)
+    (pika-drawable-edit-gradient-fill drawable
+				      GRADIENT-LINEAR 0
+				      FALSE 0 0
+				      TRUE
+				      0 0 (- width 1) 0)
+
+    (pika-context-pop)
+
+    ; Terminate
+
+    (pika-image-undo-enable img)
+    (pika-display-new img)
+  )
+)
+
+(script-fu-register "script-fu-gradient-example"
+    _"Custom _Gradient..."
+    _"Create an image filled with an example of the current gradient"
+    "Federico Mena Quintero"
+    "Federico Mena Quintero"
+    "June 1997"
+    ""
+    SF-ADJUSTMENT _"Width"            '(400 1 2000 1 10 0 1)
+    SF-ADJUSTMENT _"Height"           '(30 1 2000 1 10 0 1)
+    SF-TOGGLE     _"Gradient reverse" FALSE
+)
+
+(script-fu-menu-register "script-fu-gradient-example"
+                         "<Gradients>")

plug-ins/script-fu/scripts/guides-from-selection.scm

@@ -0,0 +1,43 @@
+;; -*-scheme-*-
+
+(define (script-fu-guides-from-selection image drawable)
+  (let* (
+        (boundaries (pika-selection-bounds image))
+        ;; non-empty INT32 TRUE if there is a selection
+        (selection (car boundaries))
+        (x1 (cadr boundaries))
+        (y1 (caddr boundaries))
+        (x2 (cadr (cddr boundaries)))
+        (y2 (caddr (cddr boundaries)))
+        )
+
+    ;; need to check for a selection or we get guides right at edges of the image
+    (if (= selection TRUE)
+      (begin
+        (pika-image-undo-group-start image)
+
+        (pika-image-add-vguide image x1)
+        (pika-image-add-hguide image y1)
+        (pika-image-add-vguide image x2)
+        (pika-image-add-hguide image y2)
+
+        (pika-image-undo-group-end image)
+        (pika-displays-flush)
+      )
+    )
+  )
+)
+
+(script-fu-register "script-fu-guides-from-selection"
+  _"New Guides from _Selection"
+  _"Create four guides around the bounding box of the current selection"
+  "Alan Horkan"
+  "Alan Horkan, 2004.  Public Domain."
+  "2004-08-13"
+  "*"
+  SF-IMAGE    "Image"    0
+  SF-DRAWABLE "Drawable" 0
+)
+
+(script-fu-menu-register "script-fu-guides-from-selection"
+                         "<Image>/Image/Guides")