[modularise] (gnucash utilities)

This commit is contained in:
Christopher Lam 2020-12-02 08:25:03 +08:00
parent 299b9027e3
commit 096be60860

View File

@ -17,39 +17,26 @@
(define-module (gnucash utilities)) (define-module (gnucash utilities))
;; Turn off the scheme compiler's "possibly unbound variable" warnings.
;; In guile 2.0 we get nearly 7500 of them loading the scheme files.
;; This is the default value for auto-compilation-options without "unbound-variable".
;; See module/ice-9/boot-9.scm */
(set! %auto-compilation-options
'(#:warnings (arity-mismatch format duplicate-case-datum bad-case-datum)))
(use-modules (gnucash core-utils)) (use-modules (gnucash core-utils))
(use-modules (gnucash engine)) (use-modules (gnucash engine))
;; Load the srfis (eventually, we should see where these are needed
;; and only have the use-modules statements in those files).
(use-modules (srfi srfi-1)) (use-modules (srfi srfi-1))
(use-modules (srfi srfi-8)) (use-modules (srfi srfi-8))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Exports
;; from utilities.scm
(export gnc:warn) (export gnc:warn)
(export gnc:error) (export gnc:error)
(export gnc:msg) (export gnc:msg)
(export gnc:debug) (export gnc:debug)
(export gnc:gui-warn)
(export gnc:gui-error)
(export gnc:gui-msg)
(export addto!) (export addto!)
(export sort-and-delete-duplicates) (export sort-and-delete-duplicates)
(export gnc:list-flatten) (export gnc:list-flatten)
(export traverse-list->vec)
;; Do this stuff very early -- but other than that, don't add any (export traverse-vec->list)
;; executable code until the end of the file if you can help it. (export gnc:substring-replace-from-to)
;; These are needed for a guile 1.3.4 bug (export gnc:substring-replace)
(debug-enable 'backtrace) (export gnc:html-string-sanitize)
(read-enable 'positions)
(debug-set! stack 200000)
(define (strify items) (define (strify items)
(string-join (map (lambda (x) (format #f "~A" x)) items) "")) (string-join (map (lambda (x) (format #f "~A" x)) items) ""))
@ -72,9 +59,9 @@
;; and will be redefined in UI initialization to display dialog ;; and will be redefined in UI initialization to display dialog
;; messages ;; messages
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-public (gnc:gui-warn str1 str2) (gnc:warn str1)) (define (gnc:gui-warn str1 str2) (gnc:warn str1))
(define-public (gnc:gui-error str1 str2) (gnc:error str1)) (define (gnc:gui-error str1 str2) (gnc:error str1))
(define-public (gnc:gui-msg str1 str2) (gnc:msg str1)) (define (gnc:gui-msg str1 str2) (gnc:msg str1))
(define-syntax-rule (addto! alist element) (define-syntax-rule (addto! alist element)
(set! alist (cons element alist))) (set! alist (cons element alist)))
@ -84,12 +71,12 @@
;; lists converted vectors to save as json arrays. traverse list ;; lists converted vectors to save as json arrays. traverse list
;; converting into vectors, and vice versa. ;; converting into vectors, and vice versa.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-public (traverse-list->vec lst) (define (traverse-list->vec lst)
(cond (cond
((list? lst) (list->vector (map traverse-list->vec lst))) ((list? lst) (list->vector (map traverse-list->vec lst)))
(else lst))) (else lst)))
(define-public (traverse-vec->list vec) (define (traverse-vec->list vec)
(cond (cond
((vector? vec) (map traverse-vec->list (vector->list vec))) ((vector? vec) (map traverse-vec->list (vector->list vec)))
(else vec))) (else vec)))
@ -134,7 +121,7 @@
;; returns "fooxyzfooxyz". ;; returns "fooxyzfooxyz".
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-public (gnc:substring-replace s1 s2 s3) (define (gnc:substring-replace s1 s2 s3)
(string-replace-substring s1 s2 s3)) (string-replace-substring s1 s2 s3))
@ -151,7 +138,7 @@
;; start>1 and end-after<=0 will the replace from "start" until end of file ;; start>1 and end-after<=0 will the replace from "start" until end of file
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-public (gnc:substring-replace-from-to s1 s2 s3 start end-after) (define (gnc:substring-replace-from-to s1 s2 s3 start end-after)
(issue-deprecation-warning "gnc:substring-replace-from-to is deprecated in 4.x.") (issue-deprecation-warning "gnc:substring-replace-from-to is deprecated in 4.x.")
(string-replace-substring (string-replace-substring
s1 s2 s3 0 (string-length s1) (max 0 (1- start)) s1 s2 s3 0 (string-length s1) (max 0 (1- start))
@ -161,7 +148,7 @@
;; function to sanitize strings. the resulting string can be safely ;; function to sanitize strings. the resulting string can be safely
;; added to html. ;; added to html.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-public (gnc:html-string-sanitize str) (define (gnc:html-string-sanitize str)
(with-output-to-string (with-output-to-string
(lambda () (lambda ()
(string-for-each (string-for-each