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

148 lines
4.5 KiB
C

/* GIMP - The GNU Image Manipulation Program
* Copyright (C) 1995 Spencer Kimball and Peter Mattis
*
* This program is free software: you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 3 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see <https://www.gnu.org/licenses/>.
*/
#include "config.h"
#include "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;
}