g_basic.c

Go to the documentation of this file.

/* gEDA - GPL Electronic Design Automation
 * libgeda - gEDA's library
 * Copyright (C) 1998-2010 Ales Hvezda
 * Copyright (C) 1998-2010 gEDA Contributors (see ChangeLog for details)
 *
 * 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 2 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, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 */
#include <config.h>
#include <missing.h>

#include <stdio.h>
#include <sys/stat.h>
#ifdef HAVE_STDLIB_H
#include <stdlib.h>
#endif

#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif

#ifdef HAVE_STRING_H
#include <string.h>
#endif

#include "libgeda_priv.h"
#include "libgedaguile.h"

#ifdef HAVE_LIBDMALLOC
#include <dmalloc.h>
#endif

static void process_error_stack (SCM s_stack, SCM s_key, SCM s_args, GError **err);

/* Pre-unwind handler called in the context in which the exception was
 * thrown. */
static SCM protected_pre_unwind_handler (void *data, SCM key, SCM args)
{
  /* Capture the stack trace */
  *((SCM *) data) = scm_make_stack (SCM_BOOL_T, SCM_EOL);

  return SCM_BOOL_T;
}

/* Post-unwind handler called in the context of the catch expression.
 * This actually does the work of parsing the stack and generating log
 * messages. */
static SCM protected_post_unwind_handler (void *data, SCM key, SCM args)
{ 
  /* The stack was captured pre-unwind */
  SCM s_stack = *(SCM *) data;

  process_error_stack (s_stack, key, args, NULL);

  return SCM_BOOL_F;
}

/* Actually carries out evaluation for protected eval */
static SCM protected_body_eval (void *data)
{
  SCM args = *((SCM *)data);
  return scm_eval (scm_car (args), scm_cadr (args));
}

SCM g_scm_eval_protected (SCM exp, SCM module_or_state)
{
  SCM stack = SCM_BOOL_T;
  SCM body_data;
  SCM result;

  if (module_or_state == SCM_UNDEFINED) {
    body_data = scm_list_2 (exp, scm_interaction_environment ());
  } else {
    body_data = scm_list_2 (exp, module_or_state);
  }

  result = scm_c_catch (SCM_BOOL_T,
                        protected_body_eval,           /* catch body */
                        &body_data,                    /* body data */
                        protected_post_unwind_handler, /* post handler */
                        &stack,                        /* post data */
                        protected_pre_unwind_handler,  /* pre handler */
                        &stack                         /* pre data */
                        );

  scm_remember_upto_here_2 (body_data, stack);

  return result;
}

SCM g_scm_c_eval_string_protected (const gchar *str) {
  SCM s_str;
  g_return_val_if_fail ((str != NULL), SCM_BOOL_F);
  s_str = scm_from_utf8_string (str);
  return g_scm_eval_string_protected (s_str);
}

SCM g_scm_eval_string_protected (SCM str)
{
  SCM expr = scm_list_2 (scm_from_utf8_symbol ("eval-string"),
                         str);

  return g_scm_eval_protected (expr, SCM_UNDEFINED);
}

/* Data to be passed to g_read_file()'s worker functions. */
struct g_read_file_data_t
{
  SCM stack;
  SCM filename;
  GError *err;
};

/* Body function for g_read_file(). Simply loads the specified
 * file. */
SCM
g_read_file__body (struct g_read_file_data_t *data)
{
  return scm_primitive_load (data->filename);
}

/* Post-unwind handler for g_read_file(). Processes the stack captured
 * in the pre-unwind handler. */
SCM
g_read_file__post_handler (struct g_read_file_data_t *data, SCM key, SCM args)
{
  process_error_stack (data->stack, key, args, &data->err);
  return SCM_BOOL_F;
}

/* Pre-unwind handler for g_read_file().  Captures the Guile stack for
 * processing in the post-unwind handler. */
SCM
g_read_file__pre_handler (struct g_read_file_data_t *data, SCM key, SCM args)
{
  data->stack = scm_make_stack (SCM_BOOL_T, SCM_EOL);
  return SCM_BOOL_F;
}

gboolean
g_read_file(TOPLEVEL *toplevel, const gchar *filename, GError **err)
{
  struct g_read_file_data_t data;

  g_return_val_if_fail ((filename != NULL), FALSE);

  data.stack = SCM_BOOL_F;
  data.filename = scm_from_utf8_string (filename);
  data.err = NULL;

  scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
  edascm_dynwind_toplevel (toplevel);

  scm_c_catch (SCM_BOOL_T,
               (scm_t_catch_body) g_read_file__body, &data,
               (scm_t_catch_handler) g_read_file__post_handler, &data,
               (scm_t_catch_handler) g_read_file__pre_handler, &data);

  scm_dynwind_end ();

  /* If no error occurred, indicate success. */
  if (data.err == NULL) return TRUE;

  g_propagate_error (err, data.err);
  return FALSE;
}


static void
process_error_stack (SCM s_stack, SCM s_key, SCM s_args, GError **err) {
  char *long_message;
  char *short_message;
  SCM s_port, s_subr, s_message, s_message_args, s_rest, s_location;

  /* Split s_args up */
  s_rest = s_args;
  s_subr = scm_car (s_rest);         s_rest = scm_cdr (s_rest);
  s_message = scm_car (s_rest);      s_rest = scm_cdr (s_rest);
  s_message_args = scm_car (s_rest); s_rest = scm_cdr (s_rest);

  /* Capture short error message */
  s_port = scm_open_output_string ();
  scm_display_error_message (s_message, s_message_args, s_port);
  short_message = scm_to_utf8_string (scm_get_output_string (s_port));
  scm_close_output_port (s_port);

  /* Capture long error message (including possible backtrace) */
  s_port = scm_open_output_string ();
  if (scm_is_true (scm_stack_p (s_stack))) {
    scm_puts (_("\nBacktrace:\n"), s_port);
    scm_display_backtrace (s_stack, s_port, SCM_BOOL_F, SCM_BOOL_F);
    scm_puts ("\n", s_port);
  }

  s_location = SCM_BOOL_F;
#ifdef HAVE_SCM_DISPLAY_ERROR_STACK
  s_location = s_stack;
#endif /* HAVE_SCM_DISPLAY_ERROR_STACK */
#ifdef HAVE_SCM_DISPLAY_ERROR_FRAME
  s_location =
    scm_is_true (s_stack) ? scm_stack_ref (s_stack, SCM_INUM0) : SCM_BOOL_F;
#endif /* HAVE_SCM_DISPLAY_ERROR_FRAME */

  scm_display_error (s_location, s_port, s_subr,
                     s_message, s_message_args, s_rest);

  long_message = scm_to_utf8_string (scm_get_output_string (s_port));
  scm_close_output_port (s_port);

  /* Send long message to log */
  s_log_message ("%s", long_message);

  /* Populate any GError */
  g_set_error (err, EDA_ERROR, EDA_ERROR_SCHEME, "%s", short_message);
}