diff --git a/plug-ins/script-fu/console/script-fu-console.c b/plug-ins/script-fu/console/script-fu-console.c
index 2c6f6fd7ad..5d545a2a54 100644
--- a/plug-ins/script-fu/console/script-fu-console.c
+++ b/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,
- output->str,
- output->len,
- console);
+ /* Send captured stdout to console, w/o emphasis. */
+ script_fu_output_to_console (FALSE, output->str, output->len, console);
+ /* Assert the output had a trailing newline, possibly an empty line. */
+
+ 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);
diff --git a/plug-ins/script-fu/libscriptfu/scheme-wrapper.c b/plug-ins/script-fu/libscriptfu/scheme-wrapper.c
index 6155df86aa..632bdc2779 100644
--- a/plug-ins/script-fu/libscriptfu/scheme-wrapper.c
+++ b/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,
diff --git a/plug-ins/script-fu/libscriptfu/scheme-wrapper.h b/plug-ins/script-fu/libscriptfu/scheme-wrapper.h
index 53645bd2fd..513ad73a3b 100644
--- a/plug-ins/script-fu/libscriptfu/scheme-wrapper.h
+++ b/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);
diff --git a/plug-ins/script-fu/libscriptfu/script-fu-command.c b/plug-ins/script-fu/libscriptfu/script-fu-command.c
index 4af58d60ac..6c59026bfe 100644
--- a/plug-ins/script-fu/libscriptfu/script-fu-command.c
+++ b/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;
}
diff --git a/plug-ins/script-fu/libscriptfu/script-fu-interface.c b/plug-ins/script-fu/libscriptfu/script-fu-interface.c
index 0fada20c27..6d0321b097 100644
--- a/plug-ins/script-fu/libscriptfu/script-fu-interface.c
+++ b/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:"),
- script->name);
+ gchar *message;
- 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);
}
diff --git a/plug-ins/script-fu/libscriptfu/script-fu-lib.c b/plug-ins/script-fu/libscriptfu/script-fu-lib.c
index d0081172cc..d9ae465ff2 100644
--- a/plug-ins/script-fu/libscriptfu/script-fu-lib.c
+++ b/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)
{
diff --git a/plug-ins/script-fu/libscriptfu/script-fu-lib.h b/plug-ins/script-fu/libscriptfu/script-fu-lib.h
index 4b22445f12..71d9729b70 100644
--- a/plug-ins/script-fu/libscriptfu/script-fu-lib.h
+++ b/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);
diff --git a/plug-ins/script-fu/libscriptfu/script-fu-run-func.c b/plug-ins/script-fu/libscriptfu/script-fu-run-func.c
index 03a2c363f3..9710d153ef 100644
--- a/plug-ins/script-fu/libscriptfu/script-fu-run-func.c
+++ b/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
- * this part and run the script directly (fallthrough)
- */
+ /* Else fallthrough to next case and run the script without dialog. */
}
case GIMP_RUN_NONINTERACTIVE:
diff --git a/plug-ins/script-fu/libscriptfu/script-fu.def b/plug-ins/script-fu/libscriptfu/script-fu.def
index 1c625bf088..08ccaeef32 100644
--- a/plug-ins/script-fu/libscriptfu/script-fu.def
+++ b/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
diff --git a/plug-ins/script-fu/libscriptfu/tinyscheme/error-port.c b/plug-ins/script-fu/libscriptfu/tinyscheme/error-port.c
new file mode 100644
index 0000000000..deb52a519f
--- /dev/null
+++ b/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 .
+ */
+
+#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 )
+ * 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;
+}
diff --git a/plug-ins/script-fu/libscriptfu/tinyscheme/error-port.h b/plug-ins/script-fu/libscriptfu/tinyscheme/error-port.h
new file mode 100644
index 0000000000..1738e5b313
--- /dev/null
+++ b/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 .
+ */
+
+#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__ */
\ No newline at end of file
diff --git a/plug-ins/script-fu/libscriptfu/tinyscheme/meson.build b/plug-ins/script-fu/libscriptfu/tinyscheme/meson.build
index 96ef4e2bd0..140d1d40d8 100644
--- a/plug-ins/script-fu/libscriptfu/tinyscheme/meson.build
+++ b/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,
diff --git a/plug-ins/script-fu/libscriptfu/tinyscheme/scheme-private.h b/plug-ins/script-fu/libscriptfu/tinyscheme/scheme-private.h
index c47104211e..d08fb28a5c 100644
--- a/plug-ins/script-fu/libscriptfu/tinyscheme/scheme-private.h
+++ b/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
diff --git a/plug-ins/script-fu/libscriptfu/tinyscheme/scheme.c b/plug-ins/script-fu/libscriptfu/tinyscheme/scheme.c
index a86dac0e09..ea44f72bdf 100644
--- a/plug-ins/script-fu/libscriptfu/tinyscheme/scheme.c
+++ b/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
#include
+/* 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 */
- /* safe to redirect it to the registered output routine. */
+ /* If output is still directed to stdout (the default) try
+ * 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: " 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) {
- s_goto(sc,OP_T0LVL);
- } else {
- return sc->NIL;
- }
+ if (sc->interactive_repl)
+ {
+ /* Case is SF Text Console, not SF Console (w GUI).
+ * Simple write to stdout.
+ */
+ 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);
diff --git a/plug-ins/script-fu/libscriptfu/tinyscheme/scheme.h b/plug-ins/script-fu/libscriptfu/tinyscheme/scheme.h
index 12f0536f1c..7d928ed1ec 100644
--- a/plug-ins/script-fu/libscriptfu/tinyscheme/scheme.h
+++ b/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);
diff --git a/plug-ins/script-fu/libscriptfu/tinyscheme/string-port.c b/plug-ins/script-fu/libscriptfu/tinyscheme/string-port.c
index c54facfc75..9c8b770809 100644
--- a/plug-ins/script-fu/libscriptfu/tinyscheme/string-port.c
+++ b/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);
-
- /* Free allocated buffer. */
- sc->free (port_cell->_object._port->rep.string.start);
-
- /* Free the allocated struct itself. */
- sc->free (port_cell->_object._port);
+ string_port_dispose_struct (sc, port_cell->_object._port);
+ /* The cell still has a reference, but it is invalid. */
}
/* Implementation of Scheme GET-OUTPUT-STRING.
diff --git a/plug-ins/script-fu/libscriptfu/tinyscheme/string-port.h b/plug-ins/script-fu/libscriptfu/tinyscheme/string-port.h
index 0357d5e0fa..92581689bd 100644
--- a/plug-ins/script-fu/libscriptfu/tinyscheme/string-port.h
+++ b/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__ */
\ No newline at end of file
diff --git a/plug-ins/script-fu/script-fu-eval.c b/plug-ins/script-fu/script-fu-eval.c
index 68acad137a..0125b7bb3d 100644
--- a/plug-ins/script-fu/script-fu-eval.c
+++ b/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;
- break;
-
- case GIMP_RUN_INTERACTIVE:
- case GIMP_RUN_WITH_LAST_VALS:
- status = GIMP_PDB_CALLING_ERROR;
- g_string_assign (output, _("Script-Fu evaluation mode only allows "
- "non-interactive invocation"));
- break;
+ return gimp_procedure_new_return_values (procedure,
+ GIMP_PDB_EXECUTION_ERROR,
+ script_fu_get_gerror ());
+ else
+ return gimp_procedure_new_return_values (procedure, GIMP_PDB_SUCCESS, NULL);
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);
}
diff --git a/plug-ins/script-fu/scripts/test/meson.build b/plug-ins/script-fu/scripts/test/meson.build
index f8cf43effc..a7efb723ce 100644
--- a/plug-ins/script-fu/scripts/test/meson.build
+++ b/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
diff --git a/plug-ins/script-fu/scripts/test/test-display.scm b/plug-ins/script-fu/scripts/test/test-display.scm
new file mode 100644
index 0000000000..69f7725926
--- /dev/null
+++ b/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 #
+ (print gimp-message)
+
+ (gimp-message "Called display: expect foo(1 2 bar)# 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 #
+ (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"
+ "/Filters/Development/Demos")
diff --git a/plug-ins/script-fu/server/script-fu-server.c b/plug-ins/script-fu/server/script-fu-server.c
index 7bf9ed64cb..55cebf1564 100644
--- a/plug-ins/script-fu/server/script-fu-server.c
+++ b/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);
- script_fu_redirect_output_to_gstr (response);
+ is_script_error = get_interpretation_result (cmd, &response);
+ /* Require interpretation set response to a valid GString. */
+ if (response == NULL)
+ return;
- /* run the command */
- if (script_fu_interpret_string (cmd->command) != 0)
- {
- error = TRUE;
+ server_log ("%s\n", response->str);
- server_log ("%s\n", response->str);
- }
- else
- {
- error = FALSE;
+ 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));
- 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 */
- for (i = 0; i < RESPONSE_HEADER; i++)
- if (cmd->filedes > 0 && send (cmd->filedes, (const void *) (buffer + i), 1, 0) < 0)
- {
- /* Write error */
- print_socket_api_error ("send");
- return FALSE;
- }
+ /* Write a header to the client, as one message. */
+ if (cmd->filedes > 0 &&
+ send (cmd->filedes, (const void *) (buffer), RESPONSE_HEADER, 0) < 0)
+ {
+ /* Write error */
+ g_debug ("%s error sending header", G_STRFUNC);
+ print_socket_api_error ("send");
+ g_string_free (response, TRUE);
+ return;
+ }
- for (i = 0; i < response->len; i++)
- if (cmd->filedes > 0 && send (cmd->filedes, response->str + i, 1, 0) < 0)
- {
- /* Write error */
- print_socket_api_error ("send");
- return FALSE;
- }
+ /* Write the script response to the client, as one message. */
+ if (cmd->filedes > 0 &&
+ send (cmd->filedes, response->str, response->len, 0) < 0)
+ {
+ /* Write error. A client may have closed before taking all bytes. */
+ 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