mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
[c-interface] compact code, use (ice-9 match)
This commit is contained in:
parent
f23e3b2660
commit
f9dfdb3e6c
@ -15,6 +15,8 @@
|
||||
;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
|
||||
;; Boston, MA 02110-1301, USA gnu@gnu.org
|
||||
|
||||
(use-modules (ice-9 match))
|
||||
|
||||
(define (gnc:call-with-error-handling cmd args)
|
||||
(let ((captured-stack #f)
|
||||
(captured-error #f)
|
||||
@ -61,17 +63,13 @@
|
||||
(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))
|
||||
(captured-error (cadr apply-result)))
|
||||
(cond
|
||||
(captured-error
|
||||
(display captured-error (current-error-port))
|
||||
(set! gnc:last-captured-error (gnc:html-string-sanitize captured-error))
|
||||
(when (defined? 'gnc:warn)
|
||||
(gnc:warn captured-error))
|
||||
#f)
|
||||
(else result))))
|
||||
(match (gnc:apply-with-error-handling proc args)
|
||||
((result #f) result)
|
||||
((_ captured-error)
|
||||
(display captured-error (current-error-port))
|
||||
(set! gnc:last-captured-error (gnc:html-string-sanitize captured-error))
|
||||
(when (defined? 'gnc:warn) (gnc:warn captured-error))
|
||||
#f)))
|
||||
|
||||
(define-public gnc:last-captured-error "")
|
||||
|
||||
@ -80,16 +78,8 @@
|
||||
;; translated with gettext.
|
||||
(define (gnc:make-string-database)
|
||||
(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)
|
||||
((store) store)
|
||||
(else #f))))
|
||||
(if func
|
||||
(apply func args)
|
||||
(gnc:warn "string-database: bad message" message "\n"))))
|
||||
dispatch)
|
||||
(lambda args
|
||||
(match args
|
||||
(('lookup key) (_ (hash-ref string-hash key)))
|
||||
(('store key string) (hash-set! string-hash key string))
|
||||
(_ (gnc:warn "string-database: bad action")))))
|
||||
|
Loading…
Reference in New Issue
Block a user