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] use srfi-9 records for <html-style-sheet-template> and <html-style-sheet>

Browse Source
This commit is contained in:
Christopher Lam 2020-07-12 11:49:16 +08:00
parent 7dfbc436b9
commit ab7e213c30
1 changed files with 39 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

108
gnucash/report/html-style-sheet.scm
View File

@ -21,42 +21,30 @@
;; Boston, MA 02110-1301, USA gnu@gnu.org ;; Boston, MA 02110-1301, USA gnu@gnu.org
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(use-modules (srfi srfi-9))
(use-modules (ice-9 match)) (use-modules (ice-9 match))
(use-modules (gnucash core-utils)) (use-modules (gnucash core-utils))
(define *gnc:_style-sheet-templates_* (make-hash-table 23)) (define *gnc:_style-sheet-templates_* (make-hash-table 23))
(define *gnc:_style-sheets_* (make-hash-table 23)) (define *gnc:_style-sheets_* (make-hash-table 23))
(define <html-style-sheet-template> (define-record-type <html-style-sheet-template>
(make-record-type "<html-style-sheet-template>" (make-ss-template version name options-generator renderer)
'(version name options-generator renderer))) ss-template?
(version ss-template-version ss-template-set-version!)
(name ss-template-name ss-template-set-name!)
(options-generator ss-template-options-generator ss-template-set-options-generator!)
(renderer ss-template-renderer ss-template-set-renderer!))
(define gnc:html-style-sheet-template? (define gnc:html-style-sheet-template? ss-template?)
(record-predicate <html-style-sheet-template>)) (define gnc:html-style-sheet-template-version ss-template-version)
(define gnc:html-style-sheet-template-set-version! ss-template-set-version!)
(define gnc:html-style-sheet-template-version (define gnc:html-style-sheet-template-name ss-template-name)
(record-accessor <html-style-sheet-template> 'version)) (define gnc:html-style-sheet-template-set-name! ss-template-set-name!)
(define gnc:html-style-sheet-template-options-generator ss-template-options-generator)
(define gnc:html-style-sheet-template-set-version! (define gnc:html-style-sheet-template-set-options-generator! ss-template-set-options-generator!)
(record-modifier <html-style-sheet-template> 'version)) (define gnc:html-style-sheet-template-renderer ss-template-renderer)
(define gnc:html-style-sheet-template-set-renderer! ss-template-set-renderer!)
(define gnc:html-style-sheet-template-name
(record-accessor <html-style-sheet-template> 'name))
(define gnc:html-style-sheet-template-set-name!
(record-modifier <html-style-sheet-template> 'name))
(define gnc:html-style-sheet-template-options-generator
(record-accessor <html-style-sheet-template> 'options-generator))
(define gnc:html-style-sheet-template-set-options-generator!
(record-modifier <html-style-sheet-template> 'options-generator))
(define gnc:html-style-sheet-template-renderer
(record-accessor <html-style-sheet-template> 'renderer))
(define gnc:html-style-sheet-template-set-renderer!
(record-modifier <html-style-sheet-template> 'renderer))
(define (gnc:html-style-sheet-template-find tname) (define (gnc:html-style-sheet-template-find tname)
(hash-ref *gnc:_style-sheet-templates_* tname)) (hash-ref *gnc:_style-sheet-templates_* tname))
@ -68,56 +56,38 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (gnc:define-html-style-sheet . args) (define (gnc:define-html-style-sheet . args)
(let loop ((args args) (let loop ((args args) (ss (make-ss-template #f #f #f #f)))
(ss ((record-constructor <html-style-sheet-template>) #f #f #f #f)))
(match args (match args
((field value . rest) ((field value . rest)
((record-modifier <html-style-sheet-template> field) ss value) ((record-modifier <html-style-sheet-template> field) ss value)
(loop rest ss)) (loop rest ss))
(else ;; store the style sheet template (_ (hash-set! *gnc:_style-sheet-templates_*
(hash-set! *gnc:_style-sheet-templates_* (gnc:html-style-sheet-template-name ss) ss)))))
(gnc:html-style-sheet-template-name ss) ss)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; <html-style-sheet> methods ;; <html-style-sheet> methods
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define <html-style-sheet> (define-record-type <html-style-sheet>
(make-record-type "<html-style-sheet>" (make-html-ss name type options renderer style)
'(name type options renderer style))) html-ss?
(name ss-name ss-set-name!)
(type ss-type ss-set-type!)
(options ss-options ss-set-options!)
(renderer ss-renderer ss-set-renderer!)
(style ss-style))
(define gnc:html-style-sheet? (define gnc:make-html-style-sheet-internal make-html-ss)
(record-predicate <html-style-sheet>)) (define gnc:html-style-sheet? html-ss?)
(define gnc:html-style-sheet-name ss-name)
(define gnc:html-style-sheet-name (define gnc:html-style-sheet-set-name! ss-set-name!)
(record-accessor <html-style-sheet> 'name)) (define gnc:html-style-sheet-type ss-type)
(define gnc:html-style-sheet-set-type! ss-set-type!)
(define gnc:html-style-sheet-set-name! (define gnc:html-style-sheet-options ss-options)
(record-modifier <html-style-sheet> 'name)) (define gnc:html-style-sheet-set-options! ss-set-options!)
(define gnc:html-style-sheet-renderer ss-renderer)
(define gnc:html-style-sheet-type (define gnc:html-style-sheet-set-renderer! ss-set-renderer!)
(record-accessor <html-style-sheet> 'type)) (define gnc:html-style-sheet-style ss-style)
(define gnc:html-style-sheet-set-type!
(record-modifier <html-style-sheet> 'type))
(define gnc:html-style-sheet-options
(record-accessor <html-style-sheet> 'options))
(define gnc:html-style-sheet-set-options!
(record-modifier <html-style-sheet> 'options))
(define gnc:html-style-sheet-renderer
(record-accessor <html-style-sheet> 'renderer))
(define gnc:html-style-sheet-set-renderer!
(record-modifier <html-style-sheet> 'renderer))
(define gnc:make-html-style-sheet-internal
(record-constructor <html-style-sheet>))
(define gnc:html-style-sheet-style
(record-accessor <html-style-sheet> 'style))
(define gnc:current-saved-stylesheets (define gnc:current-saved-stylesheets
(gnc-build-userdata-path "stylesheets-2.0")) (gnc-build-userdata-path "stylesheets-2.0"))