libgeda/src/g_basic.c

   1 /* gEDA - GPL Electronic Design Automation
   2  * libgeda - gEDA's library
   3  * Copyright (C) 1998-2010 Ales Hvezda
   4  * Copyright (C) 1998-2010 gEDA Contributors (see ChangeLog for details)
   5  *
   6  * This program is free software; you can redistribute it and/or modify
   7  * it under the terms of the GNU General Public License as published by
   8  * the Free Software Foundation; either version 2 of the License, or
   9  * (at your option) any later version.
  10  *
  11  * This program is distributed in the hope that it will be useful,
  12  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  13  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14  * GNU General Public License for more details.
  15  *
  16  * You should have received a copy of the GNU General Public License
  17  * along with this program; if not, write to the Free Software
  18  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  19  */
  20 #include <config.h>
  21 #include <missing.h>
  22
  23 #include <stdio.h>
  24 #include <sys/stat.h>
  25 #ifdef HAVE_STDLIB_H
  26 #include <stdlib.h>
  27 #endif
  28
  29 #ifdef HAVE_UNISTD_H
  30 #include <unistd.h>
  31 #endif
  32
  33 #ifdef HAVE_STRING_H
  34 #include <string.h>
  35 #endif
  36
  37 #include "libgeda_priv.h"
  38 #include "libgedaguile.h"
  39
  40 #ifdef HAVE_LIBDMALLOC
  41 #include <dmalloc.h>
  42 #endif
  43
  44 static void process_error_stack (SCM s_stack, SCM s_key, SCM s_args, GError **err);
  45
  46 /* Pre-unwind handler called in the context in which the exception was
  47  * thrown. */
  48 static SCM protected_pre_unwind_handler (void *data, SCM key, SCM args)
  49 {
  50   /* Capture the stack trace */
  51   *((SCM *) data) = scm_make_stack (SCM_BOOL_T, SCM_EOL);
  52
  53   return SCM_BOOL_T;
  54 }
  55
  56 /* Post-unwind handler called in the context of the catch expression.
  57  * This actually does the work of parsing the stack and generating log
  58  * messages. */
  59 static SCM protected_post_unwind_handler (void *data, SCM key, SCM args)
  60 {
  61   /* The stack was captured pre-unwind */
  62   SCM s_stack = *(SCM *) data;
  63
  64   process_error_stack (s_stack, key, args, NULL);
  65
  66   return SCM_BOOL_F;
  67 }
  68
  69 /* Actually carries out evaluation for protected eval */
  70 static SCM protected_body_eval (void *data)
  71 {
  72   SCM args = *((SCM *)data);
  73   return scm_eval (scm_car (args), scm_cadr (args));
  74 }
  75
  76 /*! \brief Evaluate a Scheme expression safely.
  77  *  \par Function Description
  78  *
  79  *  Often a libgeda program (or libgeda itself) will need to call out
  80  *  to Scheme code, for example to load a Scheme configuration file.
  81  *  If an error or exception caused by such code goes uncaught, it
  82  *  locks up the Scheme interpreter, stopping any further Scheme code
  83  *  from being run until the program is restarted.
  84  *
  85  *  This function is equivalent to scm_eval (), with the important
  86  *  difference that any errors or exceptions caused by the evaluated
  87  *  expression \a exp are caught and reported via the libgeda logging
  88  *  mechanism.  If an error occurs during evaluation, this function
  89  *  returns SCM_BOOL_F.  If \a module_or_state is undefined, uses the
  90  *  current interaction environment.
  91  *
  92  *  \param exp             Expression to evaluate
  93  *  \param module_or_state Environment in which to evaluate \a exp
  94  *
  95  *  \returns Evaluation results or SCM_BOOL_F if exception caught.
  96  */
  97 SCM g_scm_eval_protected (SCM exp, SCM module_or_state)
  98 {
  99   SCM stack = SCM_BOOL_T;
 100   SCM body_data;
 101   SCM result;
 102
 103   if (module_or_state == SCM_UNDEFINED) {
 104     body_data = scm_list_2 (exp, scm_interaction_environment ());
 105   } else {
 106     body_data = scm_list_2 (exp, module_or_state);
 107   }
 108
 109   result = scm_c_catch (SCM_BOOL_T,
 110                         protected_body_eval,           /* catch body */
 111                         &body_data,                    /* body data */
 112                         protected_post_unwind_handler, /* post handler */
 113                         &stack,                        /* post data */
 114                         protected_pre_unwind_handler,  /* pre handler */
 115                         &stack                         /* pre data */
 116                         );
 117
 118   scm_remember_upto_here_2 (body_data, stack);
 119
 120   return result;
 121 }
 122
 123 /*! \brief Evaluate a C string as a Scheme expression safely
 124  *  \par Function Description
 125  *
 126  *  Evaluates a C string like scm_c_eval_string().  Simple wrapper for
 127  *  g_scm_eval_string_protected().
 128  *
 129  *  \param str  String to evaluate.
 130  *
 131  *  \returns Evaluation results or SCM_BOOL_F if exception caught.
 132  */
 133 SCM g_scm_c_eval_string_protected (const gchar *str) {
 134   SCM s_str;
 135   g_return_val_if_fail ((str != NULL), SCM_BOOL_F);
 136   s_str = scm_from_utf8_string (str);
 137   return g_scm_eval_string_protected (s_str);
 138 }
 139
 140 /*! \brief Evaluate a string as a Scheme expression safely
 141  *  \par Function Description
 142  *
 143  *  Evaluates a string similarly to scm_eval_string(), but catching
 144  *  any errors or exceptions and reporting them via the libgeda
 145  *  logging mechanism.
 146  *
 147  *  See also g_scm_eval_protected() and g_scm_c_eval_string_protected().
 148  *
 149  *  \param str  String to evaluate.
 150  *
 151  *  \returns Evaluation results or SCM_BOOL_F if exception caught.
 152  */
 153 SCM g_scm_eval_string_protected (SCM str)
 154 {
 155   SCM expr = scm_list_2 (scm_from_utf8_symbol ("eval-string"),
 156                          str);
 157
 158   return g_scm_eval_protected (expr, SCM_UNDEFINED);
 159 }
 160
 161 /* Data to be passed to g_read_file()'s worker functions. */
 162 struct g_read_file_data_t
 163 {
 164   SCM stack;
 165   SCM filename;
 166   GError *err;
 167 };
 168
 169 /* Body function for g_read_file(). Simply loads the specified
 170  * file. */
 171 SCM
 172 g_read_file__body (struct g_read_file_data_t *data)
 173 {
 174   return scm_primitive_load (data->filename);
 175 }
 176
 177 /* Post-unwind handler for g_read_file(). Processes the stack captured
 178  * in the pre-unwind handler. */
 179 SCM
 180 g_read_file__post_handler (struct g_read_file_data_t *data, SCM key, SCM args)
 181 {
 182   process_error_stack (data->stack, key, args, &data->err);
 183   return SCM_BOOL_F;
 184 }
 185
 186 /* Pre-unwind handler for g_read_file().  Captures the Guile stack for
 187  * processing in the post-unwind handler. */
 188 SCM
 189 g_read_file__pre_handler (struct g_read_file_data_t *data, SCM key, SCM args)
 190 {
 191   data->stack = scm_make_stack (SCM_BOOL_T, SCM_EOL);
 192   return SCM_BOOL_F;
 193 }
 194
 195 /*! \brief Load a Scheme file, catching and logging errors.
 196  * \par Function Description
 197  * Loads \a filename, catching any uncaught errors and logging them.
 198  *
 199  * \bug Most other functions in the libgeda API return TRUE on success
 200  * and FALSE on failure. g_read_file() shouldn't be an exception.
 201  *
 202  * \param toplevel  The TOPLEVEL structure.
 203  * \param filename  The file name of the Scheme file to load.
 204  * \param err       Return location for errors, or NULL.
 205  *  \return TRUE on success, FALSE on failure.
 206  */
 207 gboolean
 208 g_read_file(TOPLEVEL *toplevel, const gchar *filename, GError **err)
 209 {
 210   struct g_read_file_data_t data;
 211
 212   g_return_val_if_fail ((filename != NULL), FALSE);
 213
 214   data.stack = SCM_BOOL_F;
 215   data.filename = scm_from_utf8_string (filename);
 216   data.err = NULL;
 217
 218   scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
 219   edascm_dynwind_toplevel (toplevel);
 220
 221   scm_c_catch (SCM_BOOL_T,
 222                (scm_t_catch_body) g_read_file__body, &data,
 223                (scm_t_catch_handler) g_read_file__post_handler, &data,
 224                (scm_t_catch_handler) g_read_file__pre_handler, &data);
 225
 226   scm_dynwind_end ();
 227
 228   /* If no error occurred, indicate success. */
 229   if (data.err == NULL) return TRUE;
 230
 231   g_propagate_error (err, data.err);
 232   return FALSE;
 233 }
 234
 235
 236 /*! \brief Process a Scheme error into the log and/or a GError
 237  * \par Function Description
 238  * Process a captured Guile exception with the given \a s_key and \a
 239  * s_args, and optionally the stack trace \a s_stack.  The stack trace
 240  * and source location are logged, and if a GError return location \a
 241  * err is provided, it is populated with an informative error message.
 242  */
 243 static void
 244 process_error_stack (SCM s_stack, SCM s_key, SCM s_args, GError **err) {
 245   char *long_message;
 246   char *short_message;
 247   SCM s_port, s_subr, s_message, s_message_args, s_rest, s_location;
 248
 249   /* Split s_args up */
 250   s_rest = s_args;
 251   s_subr = scm_car (s_rest);         s_rest = scm_cdr (s_rest);
 252   s_message = scm_car (s_rest);      s_rest = scm_cdr (s_rest);
 253   s_message_args = scm_car (s_rest); s_rest = scm_cdr (s_rest);
 254
 255   /* Capture short error message */
 256   s_port = scm_open_output_string ();
 257   scm_display_error_message (s_message, s_message_args, s_port);
 258   short_message = scm_to_utf8_string (scm_get_output_string (s_port));
 259   scm_close_output_port (s_port);
 260
 261   /* Capture long error message (including possible backtrace) */
 262   s_port = scm_open_output_string ();
 263   if (scm_is_true (scm_stack_p (s_stack))) {
 264     scm_puts (_("\nBacktrace:\n"), s_port);
 265     scm_display_backtrace (s_stack, s_port, SCM_BOOL_F, SCM_BOOL_F);
 266     scm_puts ("\n", s_port);
 267   }
 268
 269   s_location = SCM_BOOL_F;
 270 #ifdef HAVE_SCM_DISPLAY_ERROR_STACK
 271   s_location = s_stack;
 272 #endif /* HAVE_SCM_DISPLAY_ERROR_STACK */
 273 #ifdef HAVE_SCM_DISPLAY_ERROR_FRAME
 274   s_location =
 275     scm_is_true (s_stack) ? scm_stack_ref (s_stack, SCM_INUM0) : SCM_BOOL_F;
 276 #endif /* HAVE_SCM_DISPLAY_ERROR_FRAME */
 277
 278   scm_display_error (s_location, s_port, s_subr,
 279                      s_message, s_message_args, s_rest);
 280
 281   long_message = scm_to_utf8_string (scm_get_output_string (s_port));
 282   scm_close_output_port (s_port);
 283
 284   /* Send long message to log */
 285   s_log_message ("%s", long_message);
 286
 287   /* Populate any GError */
 288   g_set_error (err, EDA_ERROR, EDA_ERROR_SCHEME, "%s", short_message);
 289 }