IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

[html-style-sheet] compact function using ice-9 match

Browse Source
This commit is contained in:
Christopher Lam 2019-10-31 09:07:30 +08:00
parent 5614cbbe42
commit 5688204118
1 changed files with 10 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
gnucash/report/report-system/html-style-sheet.scm
View File

@ -21,6 +21,7 @@
;; Boston, MA 02110-1301, USA gnu@gnu.org ;; Boston, MA 02110-1301, USA gnu@gnu.org
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(use-modules (ice-9 match))
(use-modules (gnucash gettext)) (use-modules (gnucash gettext))
(define *gnc:_style-sheet-templates_* (make-hash-table 23)) (define *gnc:_style-sheet-templates_* (make-hash-table 23))
@ -67,23 +68,15 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (gnc:define-html-style-sheet . args) (define (gnc:define-html-style-sheet . args)
(let ((ss (let loop ((args args)
((record-constructor <html-style-sheet-template>) #f #f #f #f))) (ss ((record-constructor <html-style-sheet-template>) #f #f #f #f)))
(let loop ((left args)) (match args
(if (and (list? left) ((field value . rest)
(not (null? left)) ((record-modifier <html-style-sheet-template> field) ss value)
(not (null? (cdr left)))) (loop rest ss))
(let* ((field (car left)) (else ;; store the style sheet template
(value (cadr left)) (hash-set! *gnc:_style-sheet-templates_*
(mod (record-modifier <html-style-sheet-template> field))) (gnc:html-style-sheet-template-name ss) ss)))))
(mod ss value)
(loop (cddr left)))))
;; store the style sheet template
(hash-set! *gnc:_style-sheet-templates_*
(gnc:html-style-sheet-template-name ss)
ss)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; <html-style-sheet> methods ;; <html-style-sheet> methods