[Author Prev][Author Next][Thread Prev][Thread Next][Author Index][Thread Index]

gEDA-cvs: branch: master updated (1.1.2.20070818-179-ga4b3077)



The branch, master has been updated
       via  a4b3077e848339d9db363d89b4714e09228b3297 (commit)
       via  cf220890a4f70ba16fbe3fc5c76e6e371720c5cb (commit)
       via  8575431a17efb7a753649ae16087dc8f203981ce (commit)
       via  9b1b44f0268271fc167ba5040ab3086cd2901706 (commit)
       via  eb82d0c6a2a3ae3eb6023375c4db10e0eaf9fb91 (commit)
       via  f3be59545162de9a575cdb3d7bc9953377bdc74d (commit)
      from  eaa1db9f3913126b157cdc283b34250d5497530f (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.


=========
 Summary
=========

 libgeda/configure.ac               |   42 ++----
 libgeda/include/Makefile.am        |    3 +-
 libgeda/include/guile_compat_1.6.h |   49 +++++++
 libgeda/include/libgeda_priv.h     |    1 +
 libgeda/include/prototype.h        |    4 +
 libgeda/lib/system-gafrc           |    4 +
 libgeda/scheme/geda.scm            |    2 +-
 libgeda/src/g_basic.c              |  274 +++++++++++++++++++++++++-----------
 libgeda/src/g_register.c           |    3 +
 9 files changed, 269 insertions(+), 113 deletions(-)
 create mode 100644 libgeda/include/guile_compat_1.6.h


=================
 Commit Messages
=================

commit a4b3077e848339d9db363d89b4714e09228b3297
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Date:   Sun Dec 23 15:22:53 2007 +0000

    libgeda: Load gafrc.d scripts with protected eval.
    
    Stops one bad gafrc.d script blocking system-gafrc from loading
    completely.

:100644 100644 3fbf766... 5187dde... M	libgeda/scheme/geda.scm

commit cf220890a4f70ba16fbe3fc5c76e6e371720c5cb
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Date:   Sun Dec 23 15:22:53 2007 +0000

    libgeda: Make protected evaluators available from Scheme.

:100644 100644 b3807a2... 12d6751... M	libgeda/src/g_register.c

commit 8575431a17efb7a753649ae16087dc8f203981ce
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Date:   Sun Dec 23 15:22:53 2007 +0000

    libgeda: Add protected string evaluation functions.
    
    Add a protected equivalents to scm_eval_string_in_module() and
    scm_c_eval_string().

:100644 100644 7526329... 4082f67... M	libgeda/include/prototype.h
:100644 100644 348395d... 5e75610... M	libgeda/src/g_basic.c

commit 9b1b44f0268271fc167ba5040ab3086cd2901706
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Date:   Sun Dec 23 15:22:53 2007 +0000

    libgeda: Add g_scm_eval_protected()
    
    Add a function that allows evaluation of a Guile expression safely,
    catching any exceptions and logging error messages.
    
    Modify the rc file helper function g_read_file() to use this new
    infrastructure.

:100644 100644 25581c2... 7526329... M	libgeda/include/prototype.h
:100644 100644 059550f... 348395d... M	libgeda/src/g_basic.c

commit eb82d0c6a2a3ae3eb6023375c4db10e0eaf9fb91
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Date:   Sun Dec 23 15:22:53 2007 +0000

    libgeda: Set Guile debug flags to aid debugging rc files

:100644 100644 23fee18... 44b76be... M	libgeda/lib/system-gafrc

commit f3be59545162de9a575cdb3d7bc9953377bdc74d
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Date:   Sun Dec 23 15:22:47 2007 +0000

    libgeda: Use a dedicated header for Guile 1.6 compatibility.
    
    Also adds some more useful checks & definitions for 1.8 functions
    missing from 1.6.

:100644 100644 2362485... f5399b7... M	libgeda/configure.ac
:100644 100644 854a301... 262e8af... M	libgeda/include/Makefile.am
:000000 100644 0000000... 201bb56... A	libgeda/include/guile_compat_1.6.h
:100644 100644 2f7de73... 4f1a333... M	libgeda/include/libgeda_priv.h

=========
 Changes
=========

commit a4b3077e848339d9db363d89b4714e09228b3297
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Date:   Sun Dec 23 15:22:53 2007 +0000

    libgeda: Load gafrc.d scripts with protected eval.
    
    Stops one bad gafrc.d script blocking system-gafrc from loading
    completely.

diff --git a/libgeda/scheme/geda.scm b/libgeda/scheme/geda.scm
index 3fbf766..5187dde 100644
--- a/libgeda/scheme/geda.scm
+++ b/libgeda/scheme/geda.scm
@@ -40,7 +40,7 @@
           (if (and (regular-file? path)
                    (has-suffix? path ".scm")
                    (access? path R_OK))
-            (load path)
+            (eval-protected `(load ,path))
             #f
           )))
       (closedir dir))

commit cf220890a4f70ba16fbe3fc5c76e6e371720c5cb
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Date:   Sun Dec 23 15:22:53 2007 +0000

    libgeda: Make protected evaluators available from Scheme.

diff --git a/libgeda/src/g_register.c b/libgeda/src/g_register.c
index b3807a2..12d6751 100644
--- a/libgeda/src/g_register.c
+++ b/libgeda/src/g_register.c
@@ -46,6 +46,9 @@ struct gsubr_t {
 
 /*! \brief */
 static struct gsubr_t libgeda_funcs[] = {
+  { "eval-protected",           1, 1, 0, g_scm_eval_protected },
+  { "eval-string-protected",    1, 0, 0, g_scm_eval_string_protected },
+
   { "component-library",        1, 1, 0, g_rc_component_library },
   { "component-library-command", 3, 0, 0, g_rc_component_library_command },
   { "component-library-funcs",  3, 0, 0, g_rc_component_library_funcs },

commit 8575431a17efb7a753649ae16087dc8f203981ce
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Date:   Sun Dec 23 15:22:53 2007 +0000

    libgeda: Add protected string evaluation functions.
    
    Add a protected equivalents to scm_eval_string_in_module() and
    scm_c_eval_string().

diff --git a/libgeda/include/prototype.h b/libgeda/include/prototype.h
index 7526329..4082f67 100644
--- a/libgeda/include/prototype.h
+++ b/libgeda/include/prototype.h
@@ -27,6 +27,9 @@ void f_print_set_type(TOPLEVEL *toplevel, int type);
 
 /* g_basic.c */
 SCM g_scm_eval_protected (SCM exp, SCM module_or_state);
+SCM g_scm_eval_string_protected (SCM str);
+#define g_scm_c_eval_string_protected (x) \
+  g_scm_eval_string_protected (scm_from_locale_string (x))
 int g_read_file(const gchar *filename);
 
 /* g_rc.c */
diff --git a/libgeda/src/g_basic.c b/libgeda/src/g_basic.c
index 348395d..5e75610 100644
--- a/libgeda/src/g_basic.c
+++ b/libgeda/src/g_basic.c
@@ -191,6 +191,54 @@ SCM g_scm_eval_protected (SCM exp, SCM module_or_state)
   return result;
 }
 
+/* Actually carries out evaluation for protected eval-string */
+static SCM protected_body_eval_string (void *data)
+{
+  SCM str = *((SCM *)data);
+  return scm_eval_string (str);
+}
+
+/*! \brief Evaluate a string as a Scheme expression safely
+ *  \par Function Description
+ *
+ *  Evaluates a string similarly to scm_eval_string(), but catching
+ *  any errors or exceptions and reporting them via the libgeda
+ *  logging mechanism.
+ *
+ *  See also g_scm_eval_protected() and g_scm_c_eval_string_protected().
+ *
+ *  \param str  String to evaluate.
+ *
+ *  \returns Evaluation results or SCM_BOOL_F if exception caught.
+ */
+SCM g_scm_eval_string_protected (SCM str)
+{
+  SCM stack = SCM_BOOL_T;
+  SCM result;
+
+#if HAVE_DECL_SCM_C_CATCH /* Guile 1.8.x approach */
+  result = scm_c_catch (SCM_BOOL_T,
+                        protected_body_eval_string,    /* catch body */
+                        &str,                          /* body data */
+                        protected_post_unwind_handler, /* post handler */
+                        &stack,                        /* post data */
+                        protected_pre_unwind_handler,  /* pre handler */
+                        &stack                         /* pre data */
+                        );
+#else                     /* Guile 1.6.x approach using magic variables */
+  result =
+    scm_internal_stack_catch (SCM_BOOL_T,
+                              protected_body_eval_string,    /* catch body */
+                              &str,                          /* body data */
+                              protected_post_unwind_handler, /* post handler */
+                              NULL);
+#endif /* HAVE_DECL_SCM_C_CATCH */
+
+  scm_remember_upto_here_1 (stack);
+
+  return result;
+}
+
 
 /*! \brief Start reading a scheme file
  *  \par Function Description

commit 9b1b44f0268271fc167ba5040ab3086cd2901706
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Date:   Sun Dec 23 15:22:53 2007 +0000

    libgeda: Add g_scm_eval_protected()
    
    Add a function that allows evaluation of a Guile expression safely,
    catching any exceptions and logging error messages.
    
    Modify the rc file helper function g_read_file() to use this new
    infrastructure.

diff --git a/libgeda/include/prototype.h b/libgeda/include/prototype.h
index 25581c2..7526329 100644
--- a/libgeda/include/prototype.h
+++ b/libgeda/include/prototype.h
@@ -26,6 +26,7 @@ int f_print_stream(TOPLEVEL *toplevel, FILE *fp);
 void f_print_set_type(TOPLEVEL *toplevel, int type);
 
 /* g_basic.c */
+SCM g_scm_eval_protected (SCM exp, SCM module_or_state);
 int g_read_file(const gchar *filename);
 
 /* g_rc.c */
diff --git a/libgeda/src/g_basic.c b/libgeda/src/g_basic.c
index 059550f..348395d 100644
--- a/libgeda/src/g_basic.c
+++ b/libgeda/src/g_basic.c
@@ -29,101 +29,166 @@
 #include <unistd.h>
 #endif
 
+#ifdef HAVE_STRING_H
+#include <string.h>
+#endif
+
 #include "libgeda_priv.h"
 
 #ifdef HAVE_LIBDMALLOC
 #include <dmalloc.h>
 #endif
 
-/* The following code was contributed by thi (with formating changes
- * by Ales) Thanks!
- * Later updated by spe
- *
- * This `load()' is modeled after libguile/load.c, load().
- * Additionally, the most recent form read is saved in case something
- * goes wrong.
- */
+/* Pre-unwind handler called in the context in which the exception was
+ * thrown.  Not used with Guile 1.6.x. */
+#if HAVE_DECL_SCM_C_CATCH
+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);
 
-/*! \brief */
-static SCM most_recently_read_form = SCM_BOOL_F;
+  return SCM_BOOL_T;
+}
+#endif
 
-/*! \todo Finish function description!!!
- *  \brief Loads a scheme file.
- *  \par Function Description
- *  Loads a scheme file.
- *
- *  \param [in] data  ????
- *  \return SCM_BOOL_T always.
- */
-static SCM load (void *data)
+/* 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)
 {
-	SCM load_port = (SCM)data;
-	SCM form;
-	int eof_found = 0;
-
-	while (!eof_found) {
-		form = scm_read(load_port);
-		if (SCM_EOF_OBJECT_P(form)) {
-			eof_found = 1;
-		} else {
-			most_recently_read_form = form;
-  			scm_eval_x (form, scm_current_module() );
-		}
-	}
-
-	most_recently_read_form = SCM_BOOL_F;
+  SCM s_stack;
+#if HAVE_DECL_SCM_C_CATCH /* The stack was captured pre-unwind */
+  s_stack = *(SCM *) data;
+#else                        /* Get stack from magic variable */
+  s_stack = scm_fluid_ref (SCM_VARIABLE_REF (scm_the_last_stack_fluid_var));
+#endif /* HAVE_DECL_SCM_C_CATCH */
+
+
+  char *message = NULL;
+  
+  /* Capture the error message */
+  if (scm_list_p (scm_caddr (args)) == SCM_BOOL_T) {
+    SCM s_msg = scm_simple_format (SCM_BOOL_F, 
+                                   scm_cadr (args), 
+                                   scm_caddr (args));
+    message = scm_to_locale_string (s_msg);
+  } else {
+    message = scm_to_locale_string (scm_cadr (args));
+  }
+
+  /* If a stack was captured, extract debugging information */
+  if (scm_stack_p (s_stack) == SCM_BOOL_T) {
+    SCM s_port, s_source, s_filename, s_line_num, s_col_num;
+    char *filename, *trace;
+
+    /* Capture & log backtrace */
+    s_port = scm_open_output_string();
+    scm_display_backtrace (s_stack, s_port,
+                           SCM_BOOL_F, SCM_BOOL_F);
+    trace = scm_to_locale_string (scm_get_output_string (s_port));
+    scm_close_output_port (s_port);
+    s_log_message ("\n%s\n", trace);
+    free (trace);
+    trace = NULL;
+
+    /* Capture & log location */
+    s_source = scm_frame_source (scm_stack_ref (s_stack, scm_from_int (0)));
+
+    s_filename = scm_source_property (s_source,
+                                      scm_from_locale_symbol ("filename"));
+    s_line_num = scm_source_property (s_source,
+                                      scm_from_locale_symbol ("line"));
+    s_col_num = scm_source_property (s_source,
+                                     scm_from_locale_symbol ("column"));
+    
+    if (scm_is_string (s_filename)
+         && scm_is_integer (s_line_num)
+         && scm_is_integer (s_col_num)) {
+
+       filename = scm_to_locale_string (s_filename);
+       s_log_message ("%s:%i:%i: %s\n", filename, scm_to_int (s_line_num),
+                      scm_to_int (s_col_num), message);
+       free (filename);
+
+    } else {
+
+      s_log_message ("Unknown file: %s\n", message);
+
+    }
+
+  } else {
+    /* No stack, so can't display debugging info */
+    s_log_message ("Evaluation failed: %s\n"
+                   "Enable debugging for more detailed information\n",
+                   message);
+  }
+
+  free (message);
+
+  return SCM_BOOL_F;
+}
 
-	return SCM_BOOL_T;
+/* 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));
 }
 
-/*! \todo Finish function description!!!
- *  \brief The error handler for load.
+/*! \brief Evaluate a Scheme expression safely.
  *  \par Function Description
- *  The error handler for load
  *
- *  \param [in] data
- *  \param [in] tag
- *  \param [in] throw_args
- *  \return SCM_BOOL_F always.
+ *  Often a libgeda program (or libgeda itself) will need to call out
+ *  to Scheme code, for example to load a Scheme configuration file.
+ *  If an error or exception caused by such code goes uncaught, it
+ *  locks up the Scheme interpreter, stopping any further Scheme code
+ *  from being run until the program is restarted.
+ *
+ *  This function is equivalent to scm_eval (), with the important
+ *  difference that any errors or exceptions caused by the evaluated
+ *  expression \a exp are caught and reported via the libgeda logging
+ *  mechanism.  If an error occurs during evaluation, this function
+ *  returns SCM_BOOL_F.  If \a module_or_state is undefined, uses the
+ *  current interaction environment.
+ *
+ *  \param exp             Expression to evaluate
+ *  \param module_or_state Environment in which to evaluate \a exp
+ *
+ *  \returns Evaluation results or SCM_BOOL_F if exception caught.
  */
-static SCM load_error_handler(void *data, SCM tag, SCM throw_args)
+SCM g_scm_eval_protected (SCM exp, SCM module_or_state)
 {
-	SCM cur_out = scm_current_output_port ();
-	SCM load_port = (SCM)data;
-	SCM filename  = scm_port_filename(load_port);
-
-	/*
-	 * If misc-error the column and line pointers points
-	 * to end of file. Not necessary to confuse user.
-	 */
-
-    if (!scm_eq_p (tag, scm_str2symbol ("misc-error"))) {
-               scm_display(scm_makfrom0str("Error : "), cur_out);
-		scm_display(tag, cur_out);
-			
-		scm_display(scm_makfrom0str(" [C:"), cur_out);
-		scm_display(scm_port_column(load_port), cur_out );
-		scm_display(scm_makfrom0str(" L:"), cur_out);
-		scm_display(scm_port_line(load_port), cur_out );
-		scm_display(scm_makfrom0str("]"), cur_out);
-	} else {
-		scm_display(scm_makfrom0str("Probably parenthesis mismatch"), 
-			    cur_out);
-
-	}
-
-	scm_display(scm_makfrom0str(" in "), cur_out);
-	scm_display(filename, cur_out);
-	scm_newline(cur_out);
-
-	if (most_recently_read_form != SCM_BOOL_F) {
-		scm_display(scm_makfrom0str ("Most recently read form: "),
-			    cur_out);
-		scm_display(most_recently_read_form, cur_out);
-		scm_newline(cur_out);
-	}
-
-	return SCM_BOOL_F;
+  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);
+  }
+
+#if HAVE_DECL_SCM_C_CATCH /* Guile 1.8.x approach */
+  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 */
+                        );
+#else                     /* Guile 1.6.x approach using magic variables */
+  result =
+    scm_internal_stack_catch (SCM_BOOL_T,
+                              protected_body_eval,           /* catch body */
+                              &body_data,                    /* body data */
+                              protected_post_unwind_handler, /* post handler */
+                              NULL);
+#endif /* HAVE_DECL_SCM_C_CATCH */
+
+  scm_remember_upto_here_2 (body_data, stack);
+
+  return result;
 }
 
 
@@ -136,8 +201,8 @@ static SCM load_error_handler(void *data, SCM tag, SCM throw_args)
  */
 int g_read_file(const gchar *filename)
 {
-	SCM port;
 	SCM eval_result = SCM_BOOL_F;
+        SCM expr;
 	char * full_filename;
 
 	if (filename == NULL) {
@@ -156,17 +221,12 @@ int g_read_file(const gchar *filename)
 		return(-1);
   	}
 
-	port = scm_open_file(scm_makfrom0str(full_filename), scm_makfrom0str("r"));
-
-	eval_result = scm_internal_catch (SCM_BOOL_T,
-                                      (scm_t_catch_body)load,
-                                      (void*)port,
-                                      (scm_t_catch_handler)load_error_handler,
-                                      (void*)port);
+        expr = scm_list_2 (scm_from_locale_symbol ("load"),
+                           scm_from_locale_string (full_filename));
+        eval_result = g_scm_eval_protected (expr,
+                                            scm_interaction_environment ());
 
-	scm_close_port(port);
-	
 	g_free(full_filename);
 
-	return (eval_result == SCM_BOOL_T);
+	return (eval_result != SCM_BOOL_F);
 }

commit eb82d0c6a2a3ae3eb6023375c4db10e0eaf9fb91
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Date:   Sun Dec 23 15:22:53 2007 +0000

    libgeda: Set Guile debug flags to aid debugging rc files

diff --git a/libgeda/lib/system-gafrc b/libgeda/lib/system-gafrc
index 23fee18..44b76be 100644
--- a/libgeda/lib/system-gafrc
+++ b/libgeda/lib/system-gafrc
@@ -9,6 +9,10 @@
 ; geda-data-path -- path to gEDA system-wide data directory
 ; geda-rc-path   -- path to gEDA system-wide config directory
 
+;; Set some flags to aid in debugging rc files
+(debug-enable 'debug)
+(debug-enable 'backtrace)
+(read-enable 'positions)
 
 ;; The directory containing gaf Scheme code.
 (define geda-scheme-path (string-append geda-data-path path-sep "scheme"))

commit f3be59545162de9a575cdb3d7bc9953377bdc74d
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Date:   Sun Dec 23 15:22:47 2007 +0000

    libgeda: Use a dedicated header for Guile 1.6 compatibility.
    
    Also adds some more useful checks & definitions for 1.8 functions
    missing from 1.6.

diff --git a/libgeda/configure.ac b/libgeda/configure.ac
index 2362485..f5399b7 100644
--- a/libgeda/configure.ac
+++ b/libgeda/configure.ac
@@ -98,37 +98,23 @@ fi
 
 CFLAGS_temp_save="$CFLAGS"
 CFLAGS="$CFLAGS $GUILE_CFLAGS"
-AC_CHECK_DECLS([scm_is_string, scm_is_integer, scm_to_int,
-scm_from_int,  scm_is_true,    scm_is_false,
-scm_from_locale_string, scm_to_locale_string],,,
+AC_CHECK_DECLS([
+scm_c_catch,
+scm_caddr,
+scm_cadr,
+scm_car,
+scm_from_int,
+scm_from_locale_string,
+scm_from_locale_symbol,
+scm_is_false,
+scm_is_integer,
+scm_is_string,
+scm_is_true,
+scm_to_int,
+scm_to_locale_string],,,
 [#include <libguile.h>])
 CFLAGS="$CFLAGS_temp_save"
 
-AH_VERBATIM(SCM_IS_STRING, [#if !HAVE_DECL_SCM_IS_STRING
-#  define scm_is_string(x) SCM_STRINGP(x)
-#endif])
-AH_VERBATIM(SCM_IS_INTEGER, [#if !HAVE_DECL_SCM_IS_INTEGER
-#  define scm_is_integer(x) SCM_INUMP(x)
-#endif])
-AH_VERBATIM(SCM_TO_INT, [#if !HAVE_DECL_SCM_TO_INT
-#  define scm_to_int(x)     SCM_INUM(x)
-#endif])
-AH_VERBATIM(SCM_FROM_INT, [#if !HAVE_DECL_SCM_FROM_INT
-#  define scm_from_int(x)   SCM_MAKINUM(x)
-#endif])
-AH_VERBATIM(SCM_IS_TRUE, [#if !HAVE_DECL_SCM_IS_TRUE
-#  define scm_is_true(x)    SCM_NFALSEP(x)
-#endif])
-AH_VERBATIM(SCM_IS_FALSE, [#if !HAVE_DECL_SCM_IS_FALSE
-#  define scm_is_false(x)   SCM_FALSEP(x)
-#endif])
-AH_VERBATIM(SCM_FROM_LOCALE_STRING, [#if !HAVE_DECL_SCM_FROM_LOCALE_STRING
-#  define scm_from_locale_string(x) scm_makfrom0str(x)
-#endif])
-AH_VERBATIM(SCM_TO_LOCALE_STRING, [#if !HAVE_DECL_SCM_TO_LOCALE_STRING
-#  define scm_to_locale_string(x)   strdup(SCM_STRING_CHARS(x))
-#endif])
-
 #
 # Check for guile end
 ############################################################################
diff --git a/libgeda/include/Makefile.am b/libgeda/include/Makefile.am
index 854a301..262e8af 100644
--- a/libgeda/include/Makefile.am
+++ b/libgeda/include/Makefile.am
@@ -8,7 +8,8 @@ libgedainclude_HEADERS = \
 
 noinst_HEADERS = \
 	libgeda_priv.h \
-	prototype_priv.h
+	prototype_priv.h \
+	guile_compat_1.6.h
 
 MOSTLYCLEANFILES = *.log core FILE *~
 CLEANFILES = *.log core FILE *~
diff --git a/libgeda/include/guile_compat_1.6.h b/libgeda/include/guile_compat_1.6.h
new file mode 100644
index 0000000..201bb56
--- /dev/null
+++ b/libgeda/include/guile_compat_1.6.h
@@ -0,0 +1,49 @@
+#if !HAVE_DECL_SCM_IS_TRUE
+#define scm_is_true(x)    SCM_NFALSEP(x)
+#endif
+
+#if !HAVE_DECL_SCM_IS_FALSE
+#define scm_is_false(x)   SCM_FALSEP(x)
+#endif
+
+#if !HAVE_DECL_SCM_IS_INTEGER
+#define scm_is_integer(x) SCM_INUMP(x)
+#endif
+
+#if !HAVE_DECL_SCM_TO_INT
+#define scm_to_int(x)     SCM_INUM(x)
+#endif
+
+#if !HAVE_DECL_SCM_FROM_INT
+#define scm_from_int(x)   SCM_MAKINUM(x)
+#endif
+
+#if !HAVE_DECL_SCM_IS_STRING
+#define scm_is_string(x) SCM_STRINGP(x)
+#endif
+
+#if !HAVE_DECL_SCM_TO_LOCALE_STRING
+#define scm_to_locale_string(x)   strdup(SCM_STRING_CHARS(x))
+#endif
+
+#if !HAVE_DECL_SCM_FROM_LOCALE_STRING
+#define scm_from_locale_string(x) scm_makfrom0str(x)
+#endif
+
+#if !HAVE_DECL_SCM_FROM_LOCALE_SYMBOL
+#define scm_from_locale_symbol(x) \
+  scm_string_to_symbol (scm_from_locale_string (x))
+#endif
+
+#if !HAVE_DECL_SCM_CAR
+#define scm_car(x) SCM_CAR(x)
+#endif
+
+#if !HAVE_DECL_SCM_CADDR
+#define scm_caddr(x) SCM_CADDR(x)
+#endif
+
+#if !HAVE_DECL_SCM_CADR
+#define scm_cadr(x) SCM_CADR(x)
+#endif
+
diff --git a/libgeda/include/libgeda_priv.h b/libgeda/include/libgeda_priv.h
index 2f7de73..4f1a333 100644
--- a/libgeda/include/libgeda_priv.h
+++ b/libgeda/include/libgeda_priv.h
@@ -2,6 +2,7 @@
 #include <glib.h>
 #include <gtk/gtk.h> /* FIXME */
 #include <libguile.h>
+#include "guile_compat_1.6.h"
 
 /* Public libgeda headers */
 #include "defines.h"




_______________________________________________
geda-cvs mailing list
geda-cvs@xxxxxxxxxxxxxx
http://www.seul.org/cgi-bin/mailman/listinfo/geda-cvs