From 66511f17bb7848c290f5d08e58b52b8fb4eaf061 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sun, 28 Jul 2019 11:22:36 +0800 Subject: [PATCH] [c-interface] compact functions fix whitespace. this module has good coverage in test-c-interface.scm. --- libgnucash/app-utils/c-interface.scm | 67 ++++++++++++---------------- 1 file changed, 28 insertions(+), 39 deletions(-) diff --git a/libgnucash/app-utils/c-interface.scm b/libgnucash/app-utils/c-interface.scm index 559bc32bb9..8dba2b9855 100644 --- a/libgnucash/app-utils/c-interface.scm +++ b/libgnucash/app-utils/c-interface.scm @@ -20,30 +20,25 @@ (captured-error #f) (result #f)) (catch #t - (lambda () - ;; Execute the code in which - ;; you want to catch errors here. - (if (procedure? cmd) - (set! result (apply cmd args))) - (if (string? cmd) - (set! result (eval-string cmd))) - ) - (lambda (key . parameters) - ;; Put the code which you want - ;; to handle an error after the - ;; stack has been unwound here. - (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) -)) + (lambda () + ;; Execute the code in which you want to catch errors here. + (cond + ((procedure? cmd) (set! result (apply cmd args))) + ((string? cmd) (set! result (eval-string cmd))))) + (lambda (key . parameters) + ;; Put the code which you want to handle an error after the + ;; stack has been unwound here. + (set! captured-error + (call-with-output-string + (lambda (port) + (display-backtrace captured-stack port) + (newline port) + (print-exception port #f key parameters))))) + (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 @@ -53,7 +48,7 @@ ;; 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: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 @@ -63,33 +58,28 @@ ;; 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)) - + (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))) + (cond + (error + (display error (current-error-port)) + (when (defined? 'gnc:warn) + (gnc:warn error))) + (else result)))) ;; This database can be used to store and retrieve translatable ;; strings. Strings that are returned by the lookup function are ;; translated with gettext. (define (gnc:make-string-database) - - (define string-hash (make-hash-table 23)) - + (define string-hash (make-hash-table)) (define (lookup key) (_ (hash-ref string-hash key))) - (define (store key string) (hash-set! string-hash key string)) - (define (dispatch message . args) (let ((func (case message ((lookup) lookup) @@ -98,5 +88,4 @@ (if func (apply func args) (gnc:warn "string-database: bad message" message "\n")))) - dispatch)