Add support for guile 2.2

CMakeLists.txt

@@ -269,37 +269,54 @@ IF(BUILDING_FROM_VCS)
 ENDIF()
 
 # Find Guile and determine which version we are using.
-# First look for guile-2.0. If not found, try to locate guile-1.8
+# Look for guile versions in this order: 2.2 > 2.0 > 1.8
 
 # guile library and include dir
-GNC_PKG_CHECK_MODULES (GUILE2 guile-2.0>=2.0.9 QUIET)
+GNC_PKG_CHECK_MODULES (GUILE22 guile-2.2 QUIET)
-IF (GUILE2_FOUND) # found guile-2.0
+IF (GUILE22_FOUND) # found guile-2.2
-  ADD_DEFINITIONS (-DHAVE_GUILE20)
+  ADD_DEFINITIONS (-DHAVE_GUILE22)
   SET(HAVE_GUILE2 TRUE)
-  SET(GUILE_EFFECTIVE_VERSION 2.0)
+  SET(GUILE_EFFECTIVE_VERSION 2.2)
-  SET(GUILE_INCLUDE_DIRS ${GUILE2_INCLUDE_DIRS})
+  SET(GUILE_INCLUDE_DIRS ${GUILE22_INCLUDE_DIRS})
-  SET(GUILE_LDFLAGS ${GUILE2_LDFLAGS})
+  SET(GUILE_LDFLAGS ${GUILE22_LDFLAGS})
 
-  FIND_PROGRAM (GUILD_EXECUTABLE NAMES guild2.0 guild)
+  FIND_PROGRAM (GUILD_EXECUTABLE NAMES guild2.2 guild)
   IF (NOT GUILD_EXECUTABLE)
     MESSAGE (SEND_ERROR "The guild executable was not found, but is required. Please set GUILD_EXECUTABLE.")
   ENDIF (NOT GUILD_EXECUTABLE)
-  MESSAGE(STATUS "Using guile-2.0.x")
+  MESSAGE(STATUS "Using guile-2.2.x")
-  FIND_PROGRAM (GUILE_EXECUTABLE NAMES guile2.0 guile)
+  FIND_PROGRAM (GUILE_EXECUTABLE NAMES guile2.2 guile)
-ELSE()
+ELSE(GUILE22_FOUND)
-  # look for guile 1.8
+  GNC_PKG_CHECK_MODULES (GUILE2 guile-2.0>=2.0.9 QUIET)
-  GNC_PKG_CHECK_MODULES (GUILE1 guile-1.8>=1.8.8 QUIET)
+  IF (GUILE2_FOUND) # found guile-2.0
-  IF (NOT GUILE1_FOUND)
+    ADD_DEFINITIONS (-DHAVE_GUILE20)
-    MESSAGE (FATAL_ERROR "Neither guile 1.8 nor guile 2.0 were found GnuCash can't run without one of them. Ensure that one is installed and can be found with pgk-config.")
+    SET(HAVE_GUILE2 TRUE)
-  ENDIF(NOT GUILE1_FOUND)
+    SET(GUILE_EFFECTIVE_VERSION 2.0)
+    SET(GUILE_INCLUDE_DIRS ${GUILE2_INCLUDE_DIRS})
+    SET(GUILE_LDFLAGS ${GUILE2_LDFLAGS})
 
-  SET(HAVE_GUILE1 TRUE)
+    FIND_PROGRAM (GUILD_EXECUTABLE NAMES guild2.0 guild)
-  SET(GUILE_EFFECTIVE_VERSION 1.8)
+    IF (NOT GUILD_EXECUTABLE)
-  SET(GUILE_INCLUDE_DIRS ${GUILE1_INCLUDE_DIRS})
+      MESSAGE (SEND_ERROR "The guild executable was not found, but is required. Please set GUILD_EXECUTABLE.")
-  SET(GUILE_LDFLAGS ${GUILE1_LDFLAGS})
+    ENDIF (NOT GUILD_EXECUTABLE)
-  MESSAGE(STATUS "Using guile-1.8.x")
+    MESSAGE(STATUS "Using guile-2.0.x")
-  FIND_PROGRAM (GUILE_EXECUTABLE NAMES guile1.8 guile)
+    FIND_PROGRAM (GUILE_EXECUTABLE NAMES guile2.0 guile)
-ENDIF()
+  ELSE(GUILE2_FOUND)
+
+    # look for guile 1.8
+    GNC_PKG_CHECK_MODULES (GUILE1 guile-1.8>=1.8.8 QUIET)
+    IF (NOT GUILE1_FOUND)
+      MESSAGE (FATAL_ERROR "Neither guile 1.8 nor guile 2.0 were found GnuCash can't run without one of them. Ensure that one is installed and can be found with pgk-config.")
+    ENDIF(NOT GUILE1_FOUND)
+
+    SET(HAVE_GUILE1 TRUE)
+    SET(GUILE_EFFECTIVE_VERSION 1.8)
+    SET(GUILE_INCLUDE_DIRS ${GUILE1_INCLUDE_DIRS})
+    SET(GUILE_LDFLAGS ${GUILE1_LDFLAGS})
+    MESSAGE(STATUS "Using guile-1.8.x")
+    FIND_PROGRAM (GUILE_EXECUTABLE NAMES guile1.8 guile)
+  ENDIF(GUILE2_FOUND)
+ENDIF(GUILE22_FOUND)
 
 IF (NOT GUILE_EXECUTABLE)
   MESSAGE (SEND_ERROR "The guile executable was not found, but is required. Please set GUILE_EXECUTABLE.")

common/cmake_modules/GncAddSchemeTargets.cmake

@@ -88,12 +88,12 @@ FUNCTION(GNC_ADD_SCHEME_TARGETS _TARGET _SOURCE_FILES _OUTPUT_DIR _GUILE_DEPENDS
         "${current_bindir}" "${CMAKE_BINARY_DIR}/libgnucash/scm")  # to pick up generated build-config.scm
     SET(_GUILE_LOAD_COMPILED_PATH "${current_bindir}")
 
-    SET(_GUILE_CACHE_DIR ${LIBDIR_BUILD}/gnucash/scm/ccache/2.0)
+    SET(_GUILE_CACHE_DIR ${LIBDIR_BUILD}/gnucash/scm/ccache/${GUILE_EFFECTIVE_VERSION})
     SET(_GUILE_LOAD_PATH "${current_srcdir}")
     IF (MAKE_LINKS)
       LIST(APPEND _GUILE_LOAD_PATH "${build_datadir}/gnucash/scm")
     ENDIF()
-    SET(_GUILE_LOAD_COMPILED_PATH ${build_libdir}/gnucash/scm/ccache/2.0)
+    SET(_GUILE_LOAD_COMPILED_PATH ${build_libdir}/gnucash/scm/ccache/${GUILE_EFFECTIVE_VERSION})
 
     SET(_TARGET_FILES "")
 

common/cmake_modules/GncAddTest.cmake

@@ -25,7 +25,7 @@ FUNCTION(GET_GUILE_ENV)
       set(fpath "${fpath}${dir}:")
     endforeach(dir)
     LIST(APPEND env "PATH=${fpath}")
-    set(compiled_path "${LIBDIR_BUILD}/gnucash/scm/ccache/2.0")
+    set(compiled_path "${LIBDIR_BUILD}/gnucash/scm/ccache/${GUILE_EFFECTIVE_VERSION}")
     string(REGEX REPLACE "^([A-Za-z]):" "/\\1" compiled_path ${compiled_path})
     LIST(APPEND env GUILE_LOAD_COMPILED_PATH=${compiled_path})
   ENDIF(MINGW64)
@@ -33,7 +33,7 @@ FUNCTION(GET_GUILE_ENV)
   LIST(APPEND env "GUILE=${GUILE_EXECUTABLE}")
 
   IF (NOT WIN32)
-    LIST(APPEND env "GUILE_LOAD_COMPILED_PATH=${LIBDIR_BUILD}/gnucash/scm/ccache/2.0")
+    LIST(APPEND env "GUILE_LOAD_COMPILED_PATH=${LIBDIR_BUILD}/gnucash/scm/ccache/${GUILE_EFFECTIVE_VERSION}")
   ENDIF()
   SET(guile_load_paths "")
   LIST(APPEND guile_load_paths ${CMAKE_CURRENT_SOURCE_DIR}/mod-foo)

gnucash/environment.in

@@ -1,7 +1,5 @@
 @-NOTE If you make any changes here, you should probably    -@
-@-NOTE also change the equivalent sections in:              -@
+@-NOTE also verify that modifications performed in          -@
-@-NOTE - src/bin/overrides/gnucash-env.in                   -@
-@-NOTE Check as well that modifications performed in        -@
 @-NOTE - gnucash-on-windows.git:gnucash.iss don't conflict. -@
 # environment
 #
@@ -66,7 +64,7 @@ GUILE_LOAD_PATH={GNC_DATA}/scm;{GUILE_LIBS};{GUILE_LOAD_PATH}
 
 # On Windows {GNC_LIB} points to {GNC_HOME}/bin because that's where the DLLs
 # are. It's not where the compiled scheme files are so we use {SYS_LIB} here.
-GUILE_LOAD_COMPILED_PATH={SYS_LIB}/guile/2.0/ccache;{SYS_LIB}/gnucash/scm/ccache/@-GUILE_EFFECTIVE_VERSION-@;{GUILE_COMPILED_LIBS};{GUILE_LOAD_COMPILED_PATH}
+GUILE_LOAD_COMPILED_PATH={SYS_LIB}/guile/@-GUILE_EFFECTIVE_VERSION-@/ccache;{SYS_LIB}/gnucash/scm/ccache/@-GUILE_EFFECTIVE_VERSION-@;{GUILE_COMPILED_LIBS};{GUILE_LOAD_COMPILED_PATH}
 
 # Tell Guile where to find GnuCash specific shared libraries
 GNC_LIBRARY_PATH={SYS_LIB};{GNC_LIB}

gnucash/import-export/qif-imp/Makefile.am

@@ -100,7 +100,10 @@ endif
 
 if GNC_HAVE_GUILE_2
 GUILE_COMPILE_ENV = \
+  --gnc-module-dir ${top_builddir}/libgnucash/engine \
+  --guile-load-dir ${top_builddir}/libgnucash/app-utils \
   --guile-load-dir ${top_builddir}/libgnucash/core-utils \
+  --guile-load-dir ${top_builddir}/libgnucash/engine \
   --guile-load-dir ${top_builddir}/libgnucash/gnc-module \
   --guile-load-dir ${top_builddir}/libgnucash/scm \
   --library-dir    ${top_builddir}/libgnucash/engine \

gnucash/import-export/qif-imp/qif-import.scm

@@ -26,6 +26,7 @@
 
 (define-module (gnucash import-export qif-import))
 (use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.
+(use-modules (gnucash app-utils))
 
 ;; We do this initialization here because src/gnome isn't a real module.
 ;; Note: Guile 2 needs to find the symbols from the extension at compile time already
@@ -43,7 +44,6 @@
 (use-modules (ice-9 regex))
 (use-modules (srfi srfi-1))
 
-(debug-enable 'debug)
 (debug-enable 'backtrace)
 
 (gnc:module-load "gnucash/engine" 0)

gnucash/report/report-gnome/dialog-report-column-view.c

@@ -432,7 +432,7 @@ gnc_column_view_edit_add_cb(GtkButton * button, gpointer user_data)
                 oldlist = SCM_CDR(oldlist);
             }
             newlist = scm_append
-                      (scm_listify(scm_reverse(scm_cons(SCM_LIST4(new_report,
+                      (scm_list_n (scm_reverse(scm_cons(SCM_LIST4(new_report,
                                                scm_from_int (1),
                                                scm_from_int (1),
                                                SCM_BOOL_F),
@@ -443,7 +443,7 @@ gnc_column_view_edit_add_cb(GtkButton * button, gpointer user_data)
         else
         {
             newlist = scm_append
-                      (scm_listify(oldlist,
+                      (scm_list_n (oldlist,
                                    SCM_LIST1(SCM_LIST4(new_report,
                                              scm_from_int (1),
                                              scm_from_int (1),
@@ -485,7 +485,7 @@ gnc_column_view_edit_remove_cb(GtkButton * button, gpointer user_data)
             }
             if (count <= oldlength)
             {
-                newlist = scm_append(scm_listify(scm_reverse(newlist), SCM_CDR(oldlist), SCM_UNDEFINED));
+                newlist = scm_append(scm_list_n (scm_reverse(newlist), SCM_CDR(oldlist), SCM_UNDEFINED));
             }
         }
 
@@ -528,7 +528,7 @@ gnc_edit_column_view_move_up_cb(GtkButton * button, gpointer user_data)
         temp = SCM_CAR(oldlist);
         oldlist = SCM_CDR(oldlist);
         newlist = scm_cons(temp, scm_cons(SCM_CAR(oldlist), newlist));
-        newlist = scm_append(scm_listify(scm_reverse(newlist), SCM_CDR(oldlist), SCM_UNDEFINED));
+        newlist = scm_append(scm_list_n (scm_reverse(newlist), SCM_CDR(oldlist), SCM_UNDEFINED));
 
         scm_gc_unprotect_object(r->contents_list);
         r->contents_list = newlist;
@@ -566,7 +566,7 @@ gnc_edit_column_view_move_down_cb(GtkButton * button, gpointer user_data)
         temp = SCM_CAR(oldlist);
         oldlist = SCM_CDR(oldlist);
         newlist = scm_cons(temp, scm_cons(SCM_CAR(oldlist), newlist));
-        newlist = scm_append(scm_listify(scm_reverse(newlist), SCM_CDR(oldlist), SCM_UNDEFINED));
+        newlist = scm_append(scm_list_n (scm_reverse(newlist), SCM_CDR(oldlist), SCM_UNDEFINED));
 
         scm_gc_unprotect_object(r->contents_list);
         r->contents_list = newlist;

gnucash/report/report-gnome/test/test-load-report-gnome-module.scm

@@ -2,7 +2,6 @@
 exec ${GUILE} -s "$0"
 !#
 
-(debug-enable 'debug)
 (debug-enable 'backtrace)
 
 (debug-set! stack 500000)
@@ -10,7 +9,11 @@ exec ${GUILE} -s "$0"
     (debug-set! maxdepth 100000))
 
 (display "  testing report module load ... ")
-(use-modules (ice-9 syncase))
+(cond-expand
+  (guile-2 )
+  (else
+    ;; Syncase is deprecated and redundant in guile 2
+    (use-modules (ice-9 syncase))))
 (use-modules (gnucash gnc-module))
 
 (gnc:module-system-init)

gnucash/report/report-system/report.scm

@@ -21,6 +21,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (use-modules (gnucash main))
+(use-modules (gnucash app-utils))
 (use-modules (gnucash printf))
 (use-modules (gnucash gettext))
 (cond-expand

gnucash/report/report-system/test/test-load-report-system-module.scm

@@ -1,4 +1,3 @@
-(debug-enable 'debug)
 (debug-enable 'backtrace)
 
 (debug-set! stack 500000)
@@ -7,7 +6,11 @@
 
 (display "  testing report module load ... ")
 (setenv "GNC_UNINSTALLED" "1")
-(use-modules (ice-9 syncase))
+(cond-expand
+  (guile-2 )
+  (else
+    ;; Syncase is deprecated and redundant in guile 2
+    (use-modules (ice-9 syncase))))
 (use-modules (gnucash gnc-module))
 
 (gnc:module-system-init)

gnucash/report/utility-reports/hello-world.scm

@@ -28,11 +28,6 @@
 (use-modules (gnucash gnc-module))
 (use-modules (gnucash gettext))
 
-;; 'debug is deprecated and unused since guile 2
-(cond-expand
-  (guile-2 )
-  (else
-    (debug-enable 'debug)))
 (debug-enable 'backtrace)
 
 (gnc:module-load "gnucash/report/report-system" 0)

gnucash/report/utility-reports/test-graphing.scm

@@ -27,7 +27,6 @@
 (use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.
 (use-modules (gnucash gnc-module))
 
-(debug-enable 'debug)
 (debug-enable 'backtrace)
 
 (gnc:module-load "gnucash/report/report-system" 0)

gnucash/report/utility-reports/view-column.scm

@@ -28,6 +28,7 @@
 
 (define-module (gnucash report view-column))
 (use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.
+(use-modules (gnucash app-utils))
 (use-modules (gnucash gnc-module))
 (use-modules (gnucash gettext))
 (cond-expand

libgnucash/app-utils/app-utils.scm

@@ -43,7 +43,9 @@
 (re-export N_)
 
 ;; c-interface.scm
-(export gnc:error->string)
+(export gnc:apply-with-error-handling)
+(export gnc:eval-string-with-error-handling)
+(export gnc:backtrace-if-exception)
 (export gnc:make-string-database)
 
 ;; options.scm

libgnucash/app-utils/c-interface.scm

@@ -15,25 +15,67 @@
 ;; 51 Franklin Street, Fifth Floor    Fax:    +1-617-542-2652
 ;; Boston, MA  02110-1301,  USA       gnu@gnu.org
 
-(define (gnc:error->string tag args)
+(define (gnc:call-with-error-handling cmd args)
-  (define (write-error port)
+  (let ((captured-stack #f)
-    (if (and (list? args) (not (null? args)))
+        (captured-error #f)
-        (let ((func (car args)))
+        (result #f))
-          (if func
+    (catch #t
-              (begin
+        (lambda ()
-                (display "Function: " port)
+            ;; Execute the code in which
-                (display func port)
+            ;; you want to catch errors here.
-                (display ", " port)
+            (if (procedure? cmd)
-                (display tag port)
+                (set! result (apply cmd args)))
-                (display "\n\n" port)))))
+            (if (string? cmd)
-    (false-if-exception
+                (set! result (eval-string cmd)))
-     (apply display-error (fluid-ref the-last-stack) port args))
+            )
-    (display-backtrace (fluid-ref the-last-stack) port)
+        (lambda (key . parameters)
-    (force-output port))
+            ;; Put the code which you want
-  
+            ;; to handle an error after the
-  (false-if-exception
+            ;; stack has been unwound here.
-   (call-with-output-string write-error)))
+            (let* ((str-port (open-output-string)))
+                    (display-backtrace captured-stack str-port)
+                    (display "\n" str-port)
+                    (print-exception str-port #f key parameters)
+                    (set! captured-error (get-output-string str-port))))
+        (lambda (key . parameters)
+            ;; Capture the stack here, cut the last 3 frames which are
+            ;; make-stack, this one, and the throw handler.
+                (set! captured-stack (make-stack #t 3))))
 
+    (list result captured-error)
+))
+
+;; gnc:eval-string-with-error-handling will evaluate the input string (cmd)
+;; an captures any exception that would be generated. It returns
+;; a list with 2 elements: the output of the evaluation and a backtrace.
+;; The first may be set if string evaluation did generate
+;; output, the latter is set when an exception was caught.
+;; We'll use this to wrap guile calls in C(++), allowing
+;; the C(++) code to decide how to handle the errors.
+(define (gnc:eval-string-with-error-handling cmd)
+    (gnc:call-with-error-handling cmd '()))
+
+;; gnc:apply-with-error-handling will call guile's apply to run func with args
+;; an captures any exception that would be generated. It returns
+;; a list with 2 elements: the output of the evaluation and a backtrace.
+;; The first may be set if the result of the apply did generate
+;; output, the latter is set when an exception was caught.
+;; We'll use this to wrap guile calls in C(++), allowing
+;; the C(++) code to decide how to handle the errors.
+(define (gnc:apply-with-error-handling func args)
+    (gnc:call-with-error-handling func args))
+
+
+(define (gnc:backtrace-if-exception proc . args)
+  (let* ((apply-result (gnc:apply-with-error-handling proc args))
+         (result (car apply-result))
+         (error (cadr apply-result)))
+        (if error
+            (begin
+                (display error (current-error-port))
+                (if (defined? 'gnc:warn)
+                    (gnc:warn error)))
+            result)))
 
 ;; This database can be used to store and retrieve translatable
 ;; strings. Strings that are returned by the lookup function are
@@ -56,5 +98,5 @@
       (if func
           (apply func args)
           (gnc:warn "string-database: bad message" message "\n"))))
-  
+
   dispatch)

libgnucash/app-utils/gfec.c

@@ -18,134 +18,31 @@
 # define strdup _strdup
 #endif
 
-typedef struct {
-    char **msg;
-    SCM *scm_string;
-} helper_data_t;
-
-static SCM helper_scm_to_string(void *ptr_void)
-{
-    helper_data_t* ptr = ptr_void;
-    g_assert(ptr);
-    *(ptr->msg) = gnc_scm_to_utf8_string(*ptr->scm_string);
-    return SCM_UNDEFINED;
-}
-
-
-static int gfec_catcher_recursion_level = 0;
-
-/* We assume that data is actually a char**. The way we return results
- * from this function is to malloc a fresh string, and store it in
- * this pointer. It is the caller's responsibility to do something
- * smart with this freshly allocated storage. the caller can determine
- * whether there was an error by initializing the char* passed in to
- * NULL. If there is an error, the char string will not be NULL on
- * return.
- *
- * This function might call itself recursively: The conversion of the error
- * object to a string might itself throw an exception, hence the scm_to_string
- * function must be wrapped into a stack_catch block as well. To avoid infinite
- * recursion, we check the recursion level by gfec_catcher_recursion_level.
- */
-static SCM
-gfec_catcher(void *data, SCM tag, SCM throw_args)
-{
-    SCM func;
-    SCM result;
-    char *msg = NULL;
-
-    // To much recursion? Better jump out of here quickly.
-    if (gfec_catcher_recursion_level > 2)
-    {
-        *(char**)data = strdup("Guile error: Too many recursions in error catch handler.");
-        return SCM_UNDEFINED;
-    }
-
-    gfec_catcher_recursion_level++;
-
-    func = scm_c_eval_string("gnc:error->string");
-    if (scm_is_procedure(func))
-    {
-        result = scm_call_2(func, tag, throw_args);
-        if (scm_is_string(result))
-        {
-            char *internal_err_msg = NULL;
-            helper_data_t helper_data;
-
-            helper_data.msg = &msg;
-            helper_data.scm_string = &result;
-
-            // The conversion to string can itself throw as well
-            scm_internal_stack_catch(SCM_BOOL_T,
-                                     helper_scm_to_string,
-                                     (void *) &helper_data,
-                                     gfec_catcher,
-                                     &internal_err_msg);
-            // Previously: msg = gnc_scm_to_utf8_string (result);
-
-            // Did we run into an exception? Then the output argument msg is
-            // not set (due to the exception), but err_msg is set and contains
-            // that error message. We thus pass the err_msg instead of msg to
-            // our caller.
-            if (internal_err_msg)
-            {
-                msg = internal_err_msg;
-            }
-        }
-    }
-
-    if (msg == NULL)
-    {
-        *(char**)data = strdup("Error running guile function.");
-    }
-    else
-    {
-        *(char**)data = strdup(msg);
-        g_free(msg);
-    }
-
-    --gfec_catcher_recursion_level;
-    return SCM_UNDEFINED;
-}
-
-
-/* The arguments to scm_internal_stack_catch:
-   ------------------------------------------
-   SCM tag                     : this should be SCM_BOOL_T to catch all errors.
-   scm_catch_body_t body       : the function to run.
-   void *body_data             : a pointer to pass to body
-   scm_catch_handler_t handler : the hander function
-   void *handler_data          : a pointer to pass to the handler
-*/
-
-static SCM
-gfec_string_helper(void *data)
-{
-    char *string = data;
-
-    return scm_c_eval_string(string);
-}
 
 SCM
 gfec_eval_string(const char *str, gfec_error_handler error_handler)
 {
-    char *err_msg = NULL;
+    SCM result = SCM_UNDEFINED;
-    SCM result;
+    SCM func = scm_c_eval_string("gnc:eval-string-with-error-handling");
-
+    if (scm_is_procedure(func))
-    result = scm_internal_stack_catch(SCM_BOOL_T,
-                                      gfec_string_helper,
-                                      (void *) str,
-                                      gfec_catcher,
-                                      &err_msg);
-
-    if (err_msg != NULL)
     {
-        if (error_handler)
+        char *err_msg = NULL;
-            error_handler(err_msg);
+        SCM call_result, error = SCM_UNDEFINED;
+        call_result = scm_call_1 (func, scm_from_utf8_string (str));
 
-        free(err_msg);
+        error = scm_list_ref (call_result, scm_from_uint (1));
+        if (scm_is_true (error))
+            err_msg = gnc_scm_to_utf8_string (error);
+        else
+            result = scm_list_ref (call_result, scm_from_uint (0));
 
-        return SCM_UNDEFINED;
+        if (err_msg != NULL)
+        {
+            if (error_handler)
+                error_handler (err_msg);
+
+            free(err_msg);
+        }
     }
 
     return result;
@@ -175,44 +72,30 @@ gfec_eval_file(const char *file, gfec_error_handler error_handler)
     return result;
 }
 
-struct gfec_apply_rec
-{
-    SCM proc;
-    SCM arglist;
-};
-
-static SCM
-gfec_apply_helper(void *data)
-{
-    struct gfec_apply_rec *apply_rec = (struct gfec_apply_rec *)data;
-
-    return scm_apply(apply_rec->proc, apply_rec->arglist, SCM_EOL);
-}
-
 SCM
 gfec_apply(SCM proc, SCM arglist, gfec_error_handler error_handler)
 {
-    char *err_msg = NULL;
+    SCM result = SCM_UNDEFINED;
-    struct gfec_apply_rec apply_rec;
+    SCM func = scm_c_eval_string("gnc:apply-with-error-handling");
-    SCM result;
+    if (scm_is_procedure(func))
-
-    apply_rec.proc = proc;
-    apply_rec.arglist = arglist;
-
-    result = scm_internal_stack_catch(SCM_BOOL_T,
-                                      gfec_apply_helper,
-                                      &apply_rec,
-                                      gfec_catcher,
-                                      &err_msg);
-
-    if (err_msg != NULL)
     {
-        if (error_handler)
+        char *err_msg = NULL;
-            error_handler(err_msg);
+        SCM call_result, error;
+        call_result = scm_call_2 (func, proc, arglist);
 
-        free(err_msg);
+        error = scm_list_ref (call_result, scm_from_uint (1));
+        if (scm_is_true (error))
+            err_msg = gnc_scm_to_utf8_string (error);
+        else
+            result = scm_list_ref (call_result, scm_from_uint (0));
 
-        return SCM_UNDEFINED;
+        if (err_msg != NULL)
+        {
+            if (error_handler)
+                error_handler (err_msg);
+
+            free(err_msg);
+        }
     }
 
     return result;

libgnucash/app-utils/gnc-exp-parser.c

@@ -302,7 +302,7 @@ func_op(const char *fname, int argc, void **argv)
         printf( "gnc:\"%s\" is not a scm procedure\n", fname );
         return NULL;
     }
-    scmArgs = scm_listify( SCM_UNDEFINED );
+    scmArgs = scm_list_n (SCM_UNDEFINED);
     for ( i = 0; i < argc; i++ )
     {
         /* cons together back-to-front. */

libgnucash/app-utils/test/test-exp-parser.c

@@ -189,9 +189,9 @@ test_parser (void)
                    "- 42.72 + 13.32 + 15.48 + 23.4 + 115.4",
                    gnc_numeric_create(35897, 100) );
 
-    /* This must be defined for the function-parsing to work. */
+    /* gnc:apply-with-error-handling must be defined because it's used
-    scm_c_eval_string("(define (gnc:error->string tag args)   (define (write-error port)     (if (and (list? args) (not (null? args)))         (let ((func (car args)))           (if func               (begin                 (display \"Function: \" port)                 (display func port)                 (display \", \" port)                 (display tag port)                 (display \"\n\n\" port)))))     (false-if-exception      (apply display-error (fluid-ref the-last-stack) port args))     (display-backtrace (fluid-ref the-last-stack) port)     (force-output port))   (false-if-exception    (call-with-output-string write-error)))");
+     * indirectly through gfec_apply by the expression parser */
-
+    scm_c_eval_string("(define (gnc:apply-with-error-handling cmd args)  (let ((captured-stack #f)  (captured-error #f)  (result #f))  (catch #t  (lambda ()  (if (procedure? cmd)  (set! result (apply cmd args)))  (if (string? cmd)  (set! result (eval-string cmd))))  (lambda (key . parameters)  (let* ((str-port (open-output-string)))  (display-backtrace captured-stack str-port)  (display \"\n\" str-port)  (print-exception str-port #f key parameters)  (set! captured-error (get-output-string str-port))))  (lambda (key . parameters)  (set! captured-stack (make-stack #t 3))))  (list result captured-error)))");
     scm_c_eval_string( "(define (gnc:plus a b) (+ a b))" );
     add_pass_test("plus(2 : 1)", NULL, gnc_numeric_create(3, 1));
     add_fail_test("plus(1:2) plus(3:4)", NULL, 15);

libgnucash/app-utils/test/test-load-app-utils-module.scm

@@ -21,10 +21,10 @@
       (display "Failed - module gnucash/app-utils not loaded successfully\n")
       (set! exit-code -1)))
 
-(if (procedure? gnc:error->string)
+(if (procedure? gnc:apply-with-error-handling)
-    (display "Procedure gnc:error->string found\n")
+    (display "Procedure gnc:apply-with-error-handling found\n")
     (begin
-      (display "Failed - procedure gnc:error->string not found\n")
+      (display "Failed - procedure gnc:apply-with-error-handling not found\n")
       (set! exit-code -1)))
 
 (if (procedure? gnc-default-currency)

libgnucash/app-utils/test/test-scm-query-string.cpp

@@ -135,7 +135,7 @@ main (int argc, char **argv)
 /* When built with clang, guile-1.8.8's scm_c_eval_string truncates all
  * integer values to int32, which causes this test to fail.
  */
-#if !(defined(__clang__)) || defined(HAVE_GUILE20)
+#if !(defined(__clang__)) || defined(HAVE_GUILE20) || defined(HAVE_GUILE22)
     scm_boot_guile (argc, argv, main_helper, NULL);
 #endif
     return 0;

libgnucash/scm/main.scm

@@ -53,7 +53,6 @@
 (export gnc:error)
 (export gnc:msg)
 (export gnc:debug)
-(export gnc:backtrace-if-exception)
 (export gnc:safe-strcmp) ;; only used by aging.scm atm...
 
 ;; Get the Makefile.am/configure.in generated variables.
@@ -64,15 +63,6 @@
 ;; These are needed for a guile 1.3.4 bug
 (debug-enable 'backtrace)
 (read-enable 'positions)
-
-;; These options should only be set for guile < 2.0
-;; 'debug (deprecated and unused since guile 2)
-;; maxdepth (removed since guile 2)
-(cond-expand
-  (guile-2 )
-  (else
-    (debug-enable 'debug)
-    (debug-set! maxdepth 100000)))
 (debug-set! stack    200000)
 
 ;; Initalialize localization, otherwise reports may output
@@ -94,32 +84,6 @@
        (b -1)
        (else 0))))
 
-(define (gnc:backtrace-if-exception proc . args)
-  (define (dumper key . args)
-    (let ((stack (make-stack #t dumper)))
-      ;; Send debugging output to the console.
-      (display-backtrace stack (current-error-port))
-      (apply display-error stack (current-error-port) args)
-
-      ;; Send debugging output to the log.
-      (if (defined? 'gnc:warn)
-          (let ((string-port (open-output-string)))
-            (display-backtrace stack string-port)
-            (apply display-error stack string-port args)
-            (gnc:warn (get-output-string string-port))
-            (close-output-port string-port)))
-
-      (throw 'ignore)))
-  
-  (catch 
-      'ignore
-    (lambda () 
-      (lazy-catch #t 
-                  (lambda () (apply proc args))
-                  dumper))
-    (lambda (key . args)
-      #f)))
-
 ;;;; Status output functions.
 
 (define (strify items)