ScriptFu: fix #10307 plugin call display not effective

This benefits script authors and testers of ScriptFu.

Now a call to (display "foo") in a plugin goes to the terminal where GIMP started.
Whether interactive or in batch mode.

Make TS errors go to an error port instead of the output port.

Tool plugins: Console, Eval, Server get error messages from the error port.
TextConsole not changed. Tools behave per new doc "ScriptFu Tools" at dev web site.

Driveby fix of SF Server: send whole message instead of byte by byte.

Driveby comments and more semantic checking of set-output-port in TS.

Add test plugin test-display.scm

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

@@ -496,10 +496,19 @@ script_fu_editor_key_function (GtkWidget        *widget,
 
       is_error = script_fu_interpret_string (command);
 
-      script_fu_output_to_console (is_error,
+      /* Send captured stdout to console, w/o emphasis. */
-                                   output->str,
+      script_fu_output_to_console (FALSE, output->str, output->len, console);
-                                   output->len,
+      /* Assert the output had a trailing newline, possibly an empty line. */
-                                   console);
+
+      if (is_error)
+        {
+          /* Send error text to console, w emphasis. */
+          const gchar *text = script_fu_get_error_msg ();
+
+          script_fu_output_to_console (TRUE, text, strlen (text), console);
+
+          g_free ( (gpointer) text);
+        }
 
       gimp_plug_in_set_pdb_error_handler (gimp_get_plug_in (),
                                           GIMP_PDB_ERROR_HANDLER_INTERNAL);

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

@@ -328,6 +328,15 @@ ts_get_success_msg (void)
   return "Success";
 }
 
+/* Delegate. The caller doesn't know the scheme instance,
+ * and here we don't know TS internals.
+ */
+const gchar*
+ts_get_error_msg (void)
+{
+  return ts_get_error_string (&sc);
+}
+
 void
 ts_stdout_output_func (TsOutputType  type,
                        const char   *string,

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

@@ -33,6 +33,7 @@ void          ts_set_print_flag       (gint          print_flag);
 void          ts_print_welcome        (void);
 
 const gchar * ts_get_success_msg      (void);
+const gchar * ts_get_error_msg        (void);
 
 void          ts_interpret_stdin      (void);
 

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

@@ -43,14 +43,20 @@
 
 
 /* Interpret a command.
+ * A command is a string for a Scheme call to a script plugin's run function.
  *
  * 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
+ * Otherwise, return TRUE and discard any result of interpretation.
  * ScriptFu return values only have a GimpPDBStatus,
  * since ScriptFu plugin scripts can only be declared returning void.
  *
+ * In v2, we captured output from a script (calls to Scheme:display)
+ * and they were a prefix of any error message.
+ * In v3, output from a script is shown in any stdout/terminal in which Gimp was started.
+ * And any error msg is retrieved from the inner interpreter.
+ *
  * While interpreting, any errors from further calls to the PDB
  * can show error dialogs in any GIMP gui,
  * unless the caller has taken responsibility with a prior call to
@@ -63,25 +69,17 @@ 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, GIMP_PLUG_IN_ERROR, 0, "%s", output->str);
+      *error = script_fu_get_gerror ();
+      return FALSE;
     }
   else
     {
-      success = TRUE;
+      return TRUE;
     }
-
-  g_string_free (output, TRUE);
-
-  return success;
 }
 
 

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

@@ -30,6 +30,7 @@
 
 #include "scheme-wrapper.h"
 
+#include "script-fu-lib.h"
 #include "script-fu-types.h"
 
 #include "script-fu-interface.h"
@@ -773,11 +774,16 @@ script_fu_update_models (SFScript *script)
 }
 
 
-/* Handler for event: OK button clicked. */
+/* Handler for event: OK button clicked.
+ *
+ * Run the scripts with values from the dialog.
+ *
+ * Sets a global status of the PDB call to this plugin,
+ * which is returned later by interface_dialog.
+ */
 static void
 script_fu_ok (SFScript *script)
 {
-  GString *output;
   gchar   *command;
 
   script_fu_update_models (script);
@@ -785,26 +791,29 @@ script_fu_ok (SFScript *script)
   command = script_fu_script_get_command (script);
 
   /*  run the command through the interpreter  */
-  output = g_string_new (NULL);
-  ts_register_output_func (ts_gstring_output_func, output);
 
   gimp_plug_in_set_pdb_error_handler (gimp_get_plug_in (),
                                       GIMP_PDB_ERROR_HANDLER_PLUGIN);
 
+  script_fu_redirect_output_to_stdout ();
+
+  /* Returns non-zero error code on failure. */
   if (ts_interpret_string (command))
     {
-      gchar *message = g_strdup_printf (_("Error while executing %s:"),
+      gchar *message;
-                                        script->name);
 
-      g_message ("%s\n\n%s", message, output->str);
+      /* Log to stdout.  Later to Gimp. */
+      message = g_strdup_printf (_("Error while executing %s:"), script->name);
+      g_message ("%s\n", message);
       g_free (message);
+
+      /* Set global to be returned by script-fu-interface-dialog. */
+      sf_status = GIMP_PDB_EXECUTION_ERROR;
     }
 
   gimp_plug_in_set_pdb_error_handler (gimp_get_plug_in (),
                                       GIMP_PDB_ERROR_HANDLER_INTERNAL);
 
-  g_string_free (output, TRUE);
-
   g_free (command);
 }
 

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

@@ -151,6 +151,41 @@ script_fu_get_success_msg (void)
   return ts_get_success_msg ();
 }
 
+/* Return an error message string for recent failure of script.
+ *
+ * Requires an interpretation just returned an error, else returns "Unknown".
+ * Should be called exactly once per error, else second calls return "Unknown".
+ *
+ * Transfer ownership to caller, the string must be freed.
+ */
+const gchar *
+script_fu_get_error_msg (void)
+{
+  return ts_get_error_msg ();
+}
+
+/* Return a GError for recent failure of script.
+ *
+ * Requires an interpretation just returned an error,
+ * else returns a GError with message "Unknown".
+ * Should be called exactly once per error
+ *
+ * You should call either get_error_msg, or get_gerror, but not both.
+ *
+ * Transfers ownership, caller must free the GError.
+ */
+GError *
+script_fu_get_gerror (void)
+{
+  const gchar *error_message;
+  GError      *result;
+
+  error_message = script_fu_get_error_msg ();
+  result = g_error_new_literal (g_quark_from_string ("scriptfu"), 0, error_message);
+  g_free ((gpointer) error_message);
+  return result;
+}
+
 void
 script_fu_run_read_eval_print_loop (void)
 {

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

@@ -36,6 +36,8 @@ void         script_fu_print_welcome             (void);
 
 gboolean     script_fu_interpret_string          (const gchar     *text);
 const gchar *script_fu_get_success_msg           (void);
+const gchar *script_fu_get_error_msg             (void);
+GError      *script_fu_get_gerror                (void);
 
 void         script_fu_run_read_eval_print_loop  (void);
 

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

@@ -25,6 +25,7 @@
 
 #include "scheme-wrapper.h"       /* type "pointer" */
 
+#include "script-fu-lib.h"
 #include "script-fu-types.h"
 #include "script-fu-interface.h"  /* ScriptFu's GUI implementation. */
 #include "script-fu-dialog.h"     /* Gimp's GUI implementation. */
@@ -185,15 +186,23 @@ script_fu_run_procedure (GimpProcedure       *procedure,
         /*  First, try to collect the standard script arguments...  */
         min_args = script_fu_script_collect_standard_args (script, pspecs, n_pspecs, config);
 
-        /*  ...then acquire the rest of arguments (if any) with a dialog  */
+        /*  If plugin has more than the standard args. */
         if (script->n_args > min_args)
           {
+            /* Get the rest of arguments with a dialog, and run the command.  */
             status = script_fu_interface_dialog (script, min_args);
+
+            if (status == GIMP_PDB_EXECUTION_ERROR)
+              return gimp_procedure_new_return_values (procedure, status,
+                                                       script_fu_get_gerror ());
+
+            /* Else no error, or GIMP_PDB_CANCEL.
+             * GIMP_PDB_CALLING_ERROR is emitted prior to this.
+             * Break and return without an error message.
+             */
             break;
           }
-        /*  otherwise (if the script takes no more arguments), skip
+        /*  Else fallthrough to next case and run the script without dialog. */
-         *  this part and run the script directly (fallthrough)
-         */
       }
 
     case GIMP_RUN_NONINTERACTIVE:

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

@@ -9,6 +9,8 @@ EXPORTS
   script_fu_print_welcome
   script_fu_interpret_string
   script_fu_get_success_msg
+  script_fu_get_error_msg
+  script_fu_get_gerror
   script_fu_run_read_eval_print_loop
   script_fu_register_quit_callback
   script_fu_register_post_command_callback

plug-ins/script-fu/libscriptfu/tinyscheme/error-port.c

@@ -0,0 +1,147 @@
+/* GIMP - The GNU Image Manipulation Program
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#include "config.h"
+
+#include "scheme-private.h"
+#include "string-port.h"
+
+#include "error-port.h"
+
+/* Error port.
+ *
+ * TinyScheme now writes all errors to a separate output string-port
+ * (instead of to the output port.)
+ * Similar to the way UNIX has distinct streams stdout and stderr.
+ *
+ * A program (e.g. ScriptFu) that wraps the inner TinyScheme interpreter
+ * can retrieve error messages.
+ *
+ * A wrapping program can also redirect the inner interpreter's non-error output
+ * but differently, using ts_set_output_func.
+ *
+ * The events:
+ * When the inner interpreter declares an error
+ * it redirects its output to the error port,
+ * writes the error message, and then returns -1 retcode.
+ * Output means internal calls to putbytes.
+ * Interpreter is aborting so won't interpret any more writes in the script.
+ * The wrapping program then gets the error message,
+ * which also clears the error port, ready for the next interpretation.
+ *
+ * When interpretation proceeds without error,
+ * no error port is created.
+ * Existence of error port means:
+ *    - interpreter is in error state, after a final call to internal error
+ *      Note that exception handling occurs before this,
+ *      so a script can still intercept errors using *error-hook*.
+ *    - subsequent writes by putbytes are to the error port,
+ *      until the error port is retrieved and destroyed,
+ *      by the outer interpreter.
+ *      Subsequent writes by putbytes are all writing error message
+ *      and args to (error ... )
+ *
+ * Unlike other fields in scheme struct,
+ * errport is not type pointer i.e. does not point to a cell.
+ * The error port is internal to the interpreter.  Scripts cannot access it.
+ * It is a singleton.
+ */
+
+
+/* Initialize so there is no error port.
+ *
+ * Ensure the next interpretation is w/o redirected errors.
+ * Note the string-port API has no way to empty an output port.
+ * We create/destroy the error port.
+ *
+ * Any existing error port should already be disposed, else leaks.
+ */
+void
+error_port_init (scheme *sc)
+{
+  sc->errport = NULL;
+}
+
+/* Is interpreter in error state and redirecting to the error port? */
+gboolean
+error_port_is_redirect_output (scheme *sc)
+{
+  return sc->errport != NULL;
+}
+
+/* Set the error port so subsequent putbytes (which every IO write uses)
+ * is to the error port.
+ * Even writes passing a port: (write <foo> <port>)
+ * will write to the error port instead of the passed port.
+ *
+ * Requires no error port exist already. When it does, memory can leak.
+ *
+ * Ensure the port is kind string, direction output.
+ */
+void
+error_port_redirect_output (scheme  *sc)
+{
+  g_debug ("%s", G_STRFUNC);
+
+  if (sc->errport != NULL)
+    g_warning ("%s error port exists already", G_STRFUNC);
+
+  sc->errport = string_port_open_output_port (sc);
+
+  g_assert (sc->errport->kind & (port_output | port_string));
+}
+
+/* Return the errport or NULL.
+ * When non-null, interpreter is in an error state, is aborting.
+ */
+port*
+error_port_get_port_rep (scheme  *sc)
+{
+  return sc->errport;
+}
+
+/* Get the content string of the error port and close the port.
+ *
+ * The returned string is owned by the caller and must be freed.
+ *
+ * This must be called exactly once per inner interpretation.
+ * Destroys the error port so next interpretation is not writing to error port.
+ *
+ * Require the inner interpreter just returned to the caller
+ * (the wrapping interpreter) with an error status.
+ * Else the returned string is "Unknown" and not the actual error.
+ */
+const gchar *error_port_take_string_and_close (scheme *sc)
+{
+  gchar *result;
+  port  *port = error_port_get_port_rep (sc);
+
+  if (port != NULL)
+    {
+      result = g_strdup (port->rep.string.start);
+
+      string_port_dispose_struct (sc, port);
+
+      error_port_init (sc);
+    }
+  else
+    {
+      /* Not expected to happen.  Untranslated. */
+      result = g_strdup ("Unknown error");
+    }
+  return result;
+}

plug-ins/script-fu/libscriptfu/tinyscheme/error-port.h

@@ -0,0 +1,28 @@
+/* GIMP - The GNU Image Manipulation Program
+ * Copyright (C) 1995 Spencer Kimball and Peter Mattis
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#ifndef __ERROR_PORT_H__
+#define __ERROR_PORT_H__
+
+void         error_port_init                  (scheme *sc);
+void         error_port_redirect_output       (scheme *sc);
+gboolean     error_port_is_redirect_output    (scheme *sc);
+
+port        *error_port_get_port_rep          (scheme *sc);
+const gchar *error_port_take_string_and_close (scheme *sc);
+
+#endif /* __ERROR_PORT_H__ */

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

@@ -4,6 +4,7 @@
 scriptfu_tinyscheme = static_library('scriptfu-tinyscheme',
   'scheme.c',
   'string-port.c',
+  'error-port.c',
   include_directories: [ rootInclude, ],
   dependencies: [
     glib,

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

@@ -131,6 +131,7 @@ pointer inport;
 pointer outport;
 pointer save_inport;
 pointer loadport;
+port   *errport;          /* Not a cell, a port struct. */
 
 #ifndef MAXFIL
 #define MAXFIL 64

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

@@ -45,11 +45,15 @@
 
 #include "scheme-private.h"
 #include "string-port.h"
+#include "error-port.h"
 
 #if !STANDALONE
 static ts_output_func   ts_output_handler = NULL;
 static gpointer         ts_output_data = NULL;
 
+/* Register an output func from a wrapping interpeter.
+ * Typically the output func writes to a string, or to stdout.
+ */
 void
 ts_register_output_func (ts_output_func  func,
                          gpointer        user_data)
@@ -70,6 +74,28 @@ ts_output_string (TsOutputType  type,
   if (ts_output_handler && len > 0)
     (* ts_output_handler) (type, string, len, ts_output_data);
 }
+
+static gboolean
+ts_is_output_redirected (void)
+{
+  return ts_output_handler != NULL;
+}
+
+/* Returns string of errors declared by interpreter or script.
+ *
+ * You must call when a script has returned an error flag.
+ * Side effect is to clear: you should only call once.
+ *
+ * When called when the script did not return an error flag,
+ * returns "Unknown error"
+ *
+ * Returned string is transfered, owned by the caller and must be freed.
+ */
+const gchar*
+ts_get_error_string (scheme *sc)
+{
+  return error_port_take_string_and_close (sc);
+}
 #endif
 
 /* Used for documentation purposes, to signal functions in 'interface' */
@@ -103,6 +129,19 @@ ts_output_string (TsOutputType  type,
 #include <string.h>
 #include <stdlib.h>
 
+/* Set current outport with checks for validity. */
+void
+set_outport (scheme * sc, pointer arg)
+{
+  if (! is_port (arg))
+    g_warning ("%s arg not a port", G_STRFUNC);
+
+  if ( ! is_outport (arg) )
+    g_warning ("%s port not an output port, or closed", G_STRFUNC);
+
+  sc->outport = arg;
+}
+
 #define stricmp utf8_stricmp
 
 static int utf8_stricmp(const char *s1, const char *s2)
@@ -1526,8 +1565,10 @@ static void file_pop(scheme *sc) {
  if(sc->file_i != 0) {
      sc->nesting=sc->nesting_stack[sc->file_i];
      port_close(sc,sc->loadport,port_input);
+     /* Pop load stack, discarding port soon to be gc. */
      sc->file_i--;
-     sc->loadport->_object._port=sc->load_stack+sc->file_i;
+     /* Top of stack into current load port. */
+     sc->loadport->_object._port = sc->load_stack + sc->file_i;
    }
 }
 
@@ -1599,7 +1640,11 @@ static pointer port_from_file(scheme *sc, FILE *f, int prop) {
 
 static void port_close(scheme *sc, pointer p, int flag) {
   port *pt=p->_object._port;
-  pt->kind&=~flag;
+
+  /* Clear the direction that is closing. */
+  pt->kind &= ~flag;
+
+  /* If there are no directions remaining. */
   if((pt->kind & (port_input|port_output))==0) {
     if(pt->kind&port_file) {
 
@@ -1613,6 +1658,7 @@ static void port_close(scheme *sc, pointer p, int flag) {
 
       fclose(pt->rep.stdio.file);
     }
+    /* Clear port direction, kind, and saw_EOF. */
     pt->kind=port_free;
   }
 }
@@ -1729,30 +1775,45 @@ backbyte (scheme *sc, gint b)
 static void
 putbytes (scheme *sc, const char *bytes, int byte_count)
 {
-  port *pt=sc->outport->_object._port;
+  port *pt;
+
+  if (error_port_is_redirect_output (sc))
+    pt = error_port_get_port_rep (sc);
+  else
+    pt = sc->outport->_object._port;
 
   if(pt->kind&port_file) {
 #if STANDALONE
       fwrite (bytes, 1, byte_count, pt->rep.stdio.file);
       fflush(pt->rep.stdio.file);
 #else
-      /* If output is still directed to stdout (the default) it should be    */
+      /* If output is still directed to stdout (the default) try
-      /* safe to redirect it to the registered output routine. */
+       * redirect it to any registered output routine.
+       * Currently, we require outer wrapper to set_output_func.
+       */
       if (pt->rep.stdio.file == stdout)
         {
-          ts_output_string (TS_OUTPUT_NORMAL, bytes, byte_count);
+          if (ts_is_output_redirected ())
+            ts_output_string (TS_OUTPUT_NORMAL, bytes, byte_count);
+          else
+            g_warning ("%s Output disappears since outer wrapper did not redirect.", G_STRFUNC);
         }
       else
         {
+          /* Otherwise, the script has set the output port, write to it. */
           fwrite (bytes, 1, byte_count, pt->rep.stdio.file);
           fflush (pt->rep.stdio.file);
         }
 #endif
   }
-  else
+  else if (pt->kind & port_string)
     {
       string_port_put_bytes (sc, pt, bytes, byte_count);
     }
+  else
+    {
+      g_warning ("%s closed or unknown port kind", G_STRFUNC);
+    }
 }
 
 static void
@@ -4135,7 +4196,7 @@ static pointer opexe_4(scheme *sc, enum scheme_opcodes op) {
                if(cadr(sc->args)!=sc->outport) {
                     x=cons(sc,sc->outport,sc->NIL);
                     s_save(sc,OP_SET_OUTPORT, x, sc->NIL);
-                    sc->outport=cadr(sc->args);
+                    set_outport (sc, cadr (sc->args));
                }
           }
           sc->args = car(sc->args);
@@ -4151,14 +4212,20 @@ static pointer opexe_4(scheme *sc, enum scheme_opcodes op) {
                if(car(sc->args)!=sc->outport) {
                     x=cons(sc,sc->outport,sc->NIL);
                     s_save(sc,OP_SET_OUTPORT, x, sc->NIL);
-                    sc->outport=car(sc->args);
+                    set_outport (sc, car (sc->args));
                }
           }
           putstr(sc, "\n");
           s_return(sc,sc->T);
 
      case OP_ERR0:  /* error */
+          /* Subsequently, the current interpretation will abort. */
           sc->retcode=-1;
+
+          /* Subsequently, putbytes will write to error_port*/
+          error_port_redirect_output (sc);
+
+          /* Print prefix: "Error: <reason>" OR "Error: --" */
           if (!is_string(car(sc->args))) {
                sc->args=cons(sc,mk_string(sc," -- "),sc->args);
                setimmutable(car(sc->args));
@@ -4171,17 +4238,30 @@ static pointer opexe_4(scheme *sc, enum scheme_opcodes op) {
      case OP_ERR1:  /* error */
           putstr(sc, " ");
           if (sc->args != sc->NIL) {
+               /* Print other args.*/
                s_save(sc,OP_ERR1, cdr(sc->args), sc->NIL);
                sc->args = car(sc->args);
                sc->print_flag = 1;
                s_goto(sc,OP_P0LIST);
+               /* Continues at saved OP_ERR1. */
           } else {
-               putstr(sc, "\n");
+              if (sc->interactive_repl)
-               if(sc->interactive_repl) {
+                {
-                    s_goto(sc,OP_T0LVL);
+                  /* Case is SF Text Console, not SF Console (w GUI).
-               } else {
+                   * Simple write to stdout.
-                    return sc->NIL;
+                   */
-               }
+                  gchar *error_message = (gchar*) error_port_take_string_and_close (sc);
+                  g_printf ("%s", error_message);
+                  g_free (error_message);
+
+                  /* Continue to read stdin and eval. */
+                  s_goto (sc, OP_T0LVL);
+                }
+              else
+                {
+                  /* ScriptFu wrapper will retrieve error message. */
+                  return sc->NIL;
+                }
           }
 
      case OP_REVERSE:   /* reverse */
@@ -4463,7 +4543,7 @@ static pointer opexe_5(scheme *sc, enum scheme_opcodes op) {
           s_return(sc,sc->value);
 
      case OP_SET_OUTPORT: /* set-output-port */
-          sc->outport=car(sc->args);
+          set_outport (sc, car (sc->args));
           s_return(sc,sc->value);
 
      case OP_RDSEXPR:
@@ -5109,6 +5189,7 @@ int scheme_init_custom_alloc(scheme *sc, func_alloc malloc, func_dealloc free) {
   sc->outport=sc->NIL;
   sc->save_inport=sc->NIL;
   sc->loadport=sc->NIL;
+  error_port_init (sc);
   sc->nesting=0;
   sc->interactive_repl=0;
   sc->print_output=0;
@@ -5222,6 +5303,7 @@ void scheme_deinit(scheme *sc) {
     typeflag(sc->loadport) = T_ATOM;
   }
   sc->loadport=sc->NIL;
+  error_port_init (sc);
   sc->gc_verbose=0;
   gc(sc,sc->NIL,sc->NIL);
 

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

@@ -125,6 +125,9 @@ typedef struct num {
 
 #if !STANDALONE
 
+/* Functions to capture and retrieve output i.e. writes using display.
+ * SF Tools: Console, Eval, Server uses.
+ */
 typedef enum { TS_OUTPUT_NORMAL, TS_OUTPUT_ERROR } TsOutputType;
 
 typedef void (* ts_output_func)       (TsOutputType    type,
@@ -137,6 +140,10 @@ SCHEME_EXPORT void ts_register_output_func (ts_output_func  func,
 SCHEME_EXPORT void ts_output_string        (TsOutputType    type,
                                             const char     *string,
                                             int             len);
+
+/* Functions to retrieve error messages. */
+SCHEME_EXPORT const gchar *ts_get_error_string (scheme *sc);
+
 #endif
 
 SCHEME_EXPORT scheme *scheme_init_new(void);

plug-ins/script-fu/libscriptfu/tinyscheme/string-port.c

@@ -188,11 +188,18 @@ output_port_struct_from_scratch (scheme *sc)
 
   pt = (port*) sc->malloc (sizeof (port));
   if (pt == NULL)
-    return NULL;
+    {
+      no_memory (sc, "output port struct");
+      return NULL;
+    }
 
   start = sc->malloc (STRING_PORT_MIN_ALLOCATION);
   if (start == NULL)
-    return NULL;
+    {
+      no_memory (sc, "output port bytes");
+      return NULL;
+    }
+
   memset (start, '\0', STRING_PORT_MIN_ALLOCATION);
 
   init_port_struct (pt, port_string|port_output, start, STRING_PORT_MIN_ALLOCATION);
@@ -212,7 +219,7 @@ output_port_from_scratch (scheme *sc)
   port *pt = output_port_struct_from_scratch (sc);
   if (pt == NULL)
     {
-      no_memory (sc, "output port struct");
+      /* no-memory already called. */
       return sc->NIL;
     }
   else
@@ -273,6 +280,7 @@ output_port_expand_by_at_least (scheme *sc, port *p, size_t byte_count)
   /* GLib MAX */
   size_t new_size = current_content_size_bytes + MAX (byte_count, STRING_PORT_MIN_ALLOCATION) + 1;
 
+  g_debug ("%s byte_count %" G_GSIZE_FORMAT, G_STRFUNC, byte_count);
   g_debug ("%s current contents %" G_GSIZE_FORMAT " new size %" G_GSIZE_FORMAT, G_STRFUNC, current_content_size_bytes, new_size);
 
   new_buffer = sc->malloc (new_size);
@@ -378,6 +386,17 @@ string_port_open_output_string (scheme *sc, pointer scheme_string)
   return output_port_from_scratch (sc);
 }
 
+/* Returns C pointer to a port struct, or NULL.
+ *
+ * Used for internal ports of the interpreter
+ * (not for port objects known by a script.)
+ */
+port*
+string_port_open_output_port (scheme *sc)
+{
+  return output_port_struct_from_scratch (sc);
+}
+
 /* Create a string-port of kind input from a Scheme string.
  *
  * Ensures the port contents do not depend on lifetime of Scheme string.
@@ -398,6 +417,24 @@ string_port_open_input_string (scheme *sc, pointer scheme_string, int prop)
   return input_port_from_string (sc, c_string);
 }
 
+
+/* Free heap allocation of a port struct.
+ *
+ * Require port is-a struct port.
+ * The port* must not be used again.
+ */
+void
+string_port_dispose_struct (scheme  *sc, port *port)
+{
+  g_debug ("%s content size %ld", G_STRFUNC, strlen (port->rep.string.start) + 1);
+
+  /* Free allocated buffer. */
+  sc->free (port->rep.string.start);
+
+  /* Free the allocated struct itself. */
+  sc->free (port);
+}
+
 /* Free heap allocation of the Scheme object.
  * Called during garbage collection, the cell itself is being reclaimed.
  *
@@ -406,13 +443,8 @@ string_port_open_input_string (scheme *sc, pointer scheme_string, int prop)
 void
 string_port_dispose (scheme  *sc, pointer port_cell)
 {
-  g_debug ("%s content size %ld", G_STRFUNC, strlen (port_cell->_object._port->rep.string.start) + 1);
+  string_port_dispose_struct (sc, port_cell->_object._port);
-
+  /* The cell still has a reference, but it is invalid. */
-  /* Free allocated buffer. */
-  sc->free (port_cell->_object._port->rep.string.start);
-
-  /* Free the allocated struct itself. */
-  sc->free (port_cell->_object._port);
 }
 
 /* Implementation of Scheme GET-OUTPUT-STRING.

plug-ins/script-fu/libscriptfu/tinyscheme/string-port.h

@@ -25,7 +25,8 @@ pointer string_port_open_input_string  (scheme      *sc,
                                         int          prop);
 void    string_port_dispose            (scheme      *sc,
                                         pointer      port);
-
+void    string_port_dispose_struct     (scheme      *sc,
+                                        port        *port);
 void    string_port_init_static_port   (port        *port,
                                         const gchar *command);
 
@@ -39,4 +40,6 @@ void    string_port_put_bytes          (scheme      *sc,
 pointer string_port_get_output_string  (scheme      *sc,
                                         port        *port);
 
+port   *string_port_open_output_port   (scheme      *sc);
+
 #endif /* __STRING_PORT_H__ */

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

@@ -31,39 +31,27 @@ script_fu_eval_run (GimpProcedure        *procedure,
                     const gchar          *code,
                     GimpProcedureConfig  *config)
 {
-  GString           *output = g_string_new (NULL);
-  GimpPDBStatusType  status = GIMP_PDB_SUCCESS;
-
   script_fu_set_run_mode (run_mode);
-  script_fu_redirect_output_to_gstr (output);
+
+  /* IO writes by script go to stdout. */
+  script_fu_redirect_output_to_stdout ();
 
   switch (run_mode)
     {
     case GIMP_RUN_NONINTERACTIVE:
       if (script_fu_interpret_string (code) != 0)
-        status = GIMP_PDB_EXECUTION_ERROR;
+        return gimp_procedure_new_return_values (procedure,
-      break;
+                                                 GIMP_PDB_EXECUTION_ERROR,
-
+                                                 script_fu_get_gerror ());
-    case GIMP_RUN_INTERACTIVE:
+      else
-    case GIMP_RUN_WITH_LAST_VALS:
+        return gimp_procedure_new_return_values (procedure, GIMP_PDB_SUCCESS, NULL);
-      status        = GIMP_PDB_CALLING_ERROR;
-      g_string_assign (output, _("Script-Fu evaluation mode only allows "
-                                 "non-interactive invocation"));
-      break;
 
     default:
-      break;
+      {
+        GError *error = g_error_new_literal (g_quark_from_string ("scriptfu"), 0,
+           _("Script-Fu evaluation mode only allows non-interactive invocation"));
+
+        return gimp_procedure_new_return_values (procedure, GIMP_PDB_CALLING_ERROR, error);
+      }
     }
-
-  if (status != GIMP_PDB_SUCCESS && output->len > 0)
-    {
-      GError *error = g_error_new_literal (g_quark_from_string("scriptfu"), 0,
-                                           g_string_free (output, FALSE));
-
-      return gimp_procedure_new_return_values (procedure, status, error);
-    }
-
-  g_string_free (output, TRUE);
-
-  return gimp_procedure_new_return_values (procedure, status, NULL);
 }

plug-ins/script-fu/scripts/test/meson.build

@@ -30,6 +30,7 @@ install_data(
 
 scripts_independent = [
   { 'name': 'test-bytes' },
+  { 'name': 'test-display' },
 ]
 
 foreach plugin : scripts_independent

plug-ins/script-fu/scripts/test/test-display.scm

@@ -0,0 +1,57 @@
+#!/usr/bin/env gimp-script-fu-interpreter-3.0
+
+; Calls scheme (display ...)
+; Tests it prints to any stdout console where Gimp was started.
+
+; Then calls (error ...)
+; Tests Gimp declares an error.
+
+; in v2, (display ...) did not go to the terminal,
+; but was prepended to any error message,
+; or disappeared when there was no error.
+
+
+
+(define (script-fu-test-display)
+
+  ;       test display function
+
+  ; display shows a passed string
+  (display "foo")
+
+  ; display shows repr of any atom or list
+  (display '(1 2 "bar"))
+
+  ; print is same as display but adds newline
+  ; shows repr of a function #<CLOSURE>
+  (print gimp-message)
+
+  (gimp-message "Called display: expect foo(1 2 bar)#<CLOSURE> in terminal")
+
+
+
+  ;       test error function
+
+  ; Call to error yields:
+  ;    dialog when Gimp Error Console not open
+  ;    else text in the open Gimp Error Console
+  (gimp-message "Called error: expect Gimp dialog, OR error in Gimp Error Console.")
+  ; Scheme objects print their representation.
+  ; Here gimp-message should print as #<CLOSURE>
+  (error "Reason" gimp-message)
+
+  ; Call to error returns to Gimp, this should not be reached.
+  (gimp-message "Test failed: unreachable statement was reached.")
+)
+
+(script-fu-register "script-fu-test-display"
+    "Test scheme display and error functions"
+    "Test (display ...) to console, and (error ...) returns err to Gimp"
+    "lkk"
+    "lkk"
+    "2024"
+    ""
+)
+
+(script-fu-menu-register "script-fu-test-display"
+                         "<Image>/Filters/Development/Demos")

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

@@ -19,6 +19,7 @@
  * Testing
  *
  * Use a scriptfu server client such as https://github.com/vit1-irk/gimp-exec.
+ * OR servertest.py in the repo, >python2 servertest.py
  *
  * In a console, export G_MESSAGES_DEBUG=scriptfu (to see more logging from scriptfu)
  * (script-fu-server does not use g_logging but rolls its own.)
@@ -180,7 +181,7 @@ typedef union
 static void      server_start       (const gchar *listen_ip,
                                      gint         port,
                                      const gchar *logfile);
-static gboolean  execute_command    (SFCommand   *cmd);
+static void      execute_command    (SFCommand   *cmd);
 static gint      read_from_client   (gint         filedes);
 static gint      make_socket        (const struct addrinfo
                                                  *ai);
@@ -563,7 +564,6 @@ server_start (const gchar *listen_ip,
         {
           SFCommand *cmd = (SFCommand *) command_queue->data;
 
-          /*  Process the command  */
           execute_command (cmd);
 
           /*  Remove the command from the list  */
@@ -582,69 +582,113 @@ server_start (const gchar *listen_ip,
   server_quit ();
 }
 
+
+/* Interpret command on the ScriptFu interpreter.
+ * Returns whether the script had an error.
+ *
+ * Also creates a GString at the handle script_stdout.
+ * Ownership is transfered, and caller must free.
+ *
+ * The returned script_stdout is either:
+ *  - when no error, what the script writes to stdout
+ *  - an error message from the interpreter,
+ *    or from the script calling Scheme:error or Scheme:quit
+ *
+ * Scheme scripts yield only the value of the final expression.
+ * The yielded value is NOT written to stdout.
+ * Scripts that are calls to Gimp PDB procedure never yield a useful value,
+ * since they are functions returning void.
+ * Most scripts are for their side effects,
+ * and not for what they write to stdout.
+ */
 static gboolean
+get_interpretation_result (SFCommand *cmd, GString **script_stdout)
+{
+  gboolean is_script_error = FALSE;
+
+  *script_stdout = g_string_new (NULL);
+
+  script_fu_redirect_output_to_gstr (*script_stdout);
+
+  /* Returns non-zero on error. */
+  if (script_fu_interpret_string (cmd->command) != 0)
+    {
+      /* Substitute error message for output in script_stdout.
+       * What the script wrote to stdout before error is lost.
+       */
+      g_string_assign (*script_stdout, script_fu_get_error_msg ());
+      is_script_error = TRUE;
+    }
+
+  return is_script_error;
+}
+
+
+/* Interpret command, then relay result to client.
+ * Side effect: log start, response, ending time.
+ *
+ * !!! Does not return a value indicating errors.
+ * Neither IO errors on the socket nor errors interpreting the script.
+ *
+ * Does write an error byte to the client indicating error interpreting script.
+ * On script error, substitutes an error msg for earlier output from the script.
+ */
+static void
 execute_command (SFCommand *cmd)
 {
   guchar      buffer[RESPONSE_HEADER];
-  GString    *response;
+  GString    *response = NULL;
   time_t      clocknow;
-  gboolean    error;
-  gint        i;
   gdouble     total_time;
   GTimer     *timer;
+  gboolean    is_script_error;
 
   server_log ("Processing request #%d\n", cmd->request_no);
+
   timer = g_timer_new ();
 
-  response = g_string_new (NULL);
+  is_script_error = get_interpretation_result (cmd, &response);
-  script_fu_redirect_output_to_gstr (response);
+  /* Require interpretation set response to a valid GString. */
+  if (response == NULL)
+    return;
 
-  /*  run the command  */
+  server_log ("%s\n", response->str);
-  if (script_fu_interpret_string (cmd->command) != 0)
-    {
-      error = TRUE;
 
-      server_log ("%s\n", response->str);
+  total_time = g_timer_elapsed (timer, NULL);
-    }
+  time (&clocknow);
-  else
+  server_log ("Request #%d processed in %.3f seconds, finishing on %s",
-    {
+              cmd->request_no, total_time, ctime (&clocknow));
-      error = FALSE;
 
-      if (response->len == 0)
-        g_string_assign (response, script_fu_get_success_msg ());
-
-      total_time = g_timer_elapsed (timer, NULL);
-      time (&clocknow);
-      server_log ("Request #%d processed in %.3f seconds, finishing on %s",
-                  cmd->request_no, total_time, ctime (&clocknow));
-    }
   g_timer_destroy (timer);
 
   buffer[MAGIC_BYTE]     = MAGIC;
-  buffer[ERROR_BYTE]     = error ? TRUE : FALSE;
+  buffer[ERROR_BYTE]     = is_script_error ? TRUE : FALSE;
   buffer[RSP_LEN_H_BYTE] = (guchar) (response->len >> 8);
   buffer[RSP_LEN_L_BYTE] = (guchar) (response->len & 0xFF);
 
-  /*  Write the response to the client  */
+  /*  Write a header to the client, as one message. */
-  for (i = 0; i < RESPONSE_HEADER; i++)
+  if (cmd->filedes > 0 &&
-    if (cmd->filedes > 0 && send (cmd->filedes, (const void *) (buffer + i), 1, 0) < 0)
+      send (cmd->filedes, (const void *) (buffer), RESPONSE_HEADER, 0) < 0)
-      {
+    {
-        /*  Write error  */
+      /*  Write error  */
-        print_socket_api_error ("send");
+      g_debug ("%s error sending header", G_STRFUNC);
-        return FALSE;
+      print_socket_api_error ("send");
-      }
+      g_string_free (response, TRUE);
+      return;
+    }
 
-  for (i = 0; i < response->len; i++)
+  /*  Write the script response to the client, as one message. */
-    if (cmd->filedes > 0 && send (cmd->filedes, response->str + i, 1, 0) < 0)
+  if (cmd->filedes > 0 &&
-      {
+      send (cmd->filedes, response->str, response->len, 0) < 0)
-        /*  Write error  */
+    {
-        print_socket_api_error ("send");
+      /*  Write error.  A client may have closed before taking all bytes.  */
-        return FALSE;
+      g_debug ("%s error sending response", G_STRFUNC);
-      }
+      print_socket_api_error ("send");
+      g_string_free (response, TRUE);
+      return;
+    }
 
   g_string_free (response, TRUE);
-
-  return FALSE;
 }
 
 static gint