mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
[html-style-info] use srfi-9 records for <html-markup-style-info>
This commit is contained in:
parent
a6ac9b748c
commit
b69d3fe38a
@ -22,6 +22,7 @@
|
|||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(use-modules (ice-9 match))
|
(use-modules (ice-9 match))
|
||||||
|
(use-modules (srfi srfi-9))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; <html-markup-style-info> class
|
;; <html-markup-style-info> class
|
||||||
@ -38,31 +39,36 @@
|
|||||||
;; attribute : single attribute-value pair in a list
|
;; attribute : single attribute-value pair in a list
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(define-record-type <html-markup-style-info>
|
||||||
|
(make-html-markup-style-info-internal tag attributes inheritable?)
|
||||||
|
html-markup-style-info?
|
||||||
|
(tag style-info-tag style-info-set-tag)
|
||||||
|
(attributes style-info-attributes style-info-set-attributes)
|
||||||
|
(inheritable? style-info-inheritable? style-info-set-inheritable?))
|
||||||
|
|
||||||
(define <html-markup-style-info>
|
(define gnc:make-html-markup-style-info-internal make-html-markup-style-info-internal)
|
||||||
(make-record-type "<html-markup-style-info>"
|
(define gnc:html-markup-style-info? html-markup-style-info?)
|
||||||
'(tag
|
(define gnc:html-markup-style-info-tag style-info-tag)
|
||||||
attributes
|
(define gnc:html-markup-style-info-set-tag! style-info-set-tag)
|
||||||
inheritable?)))
|
(define gnc:html-markup-style-info-attributes style-info-attributes)
|
||||||
|
(define gnc:html-markup-style-info-set-attributes! style-info-set-attributes)
|
||||||
(define gnc:html-markup-style-info?
|
(define gnc:html-markup-style-info-inheritable? style-info-inheritable?)
|
||||||
(record-predicate <html-markup-style-info>))
|
(define gnc:html-markup-style-info-set-inheritable?! style-info-set-inheritable?)
|
||||||
|
|
||||||
(define gnc:make-html-markup-style-info-internal
|
|
||||||
(record-constructor <html-markup-style-info>))
|
|
||||||
|
|
||||||
(define (gnc:make-html-markup-style-info . rest)
|
(define (gnc:make-html-markup-style-info . rest)
|
||||||
(let ((retval (gnc:make-html-markup-style-info-internal
|
(let ((retval (gnc:make-html-markup-style-info-internal #f (make-hash-table) #t)))
|
||||||
#f (make-hash-table) #t)))
|
|
||||||
(apply gnc:html-markup-style-info-set! retval rest)
|
(apply gnc:html-markup-style-info-set! retval rest)
|
||||||
retval))
|
retval))
|
||||||
|
|
||||||
(define (gnc:html-markup-style-info-set! style . rest)
|
(define (gnc:html-markup-style-info-set! style . rest)
|
||||||
(let loop ((arglist rest))
|
(let loop ((arglist rest))
|
||||||
(match arglist
|
(match arglist
|
||||||
(('attribute (key . val) . rest)
|
(('attribute (key val) . rest)
|
||||||
(gnc:html-markup-style-info-set-attribute!
|
(gnc:html-markup-style-info-set-attribute! style key val)
|
||||||
style key (and (pair? val) (car val)))
|
(loop rest))
|
||||||
|
|
||||||
|
(('attribute (key) . rest)
|
||||||
|
(gnc:html-markup-style-info-set-attribute! style key #f)
|
||||||
(loop rest))
|
(loop rest))
|
||||||
|
|
||||||
((field value . rest)
|
((field value . rest)
|
||||||
@ -71,24 +77,6 @@
|
|||||||
|
|
||||||
(else style))))
|
(else style))))
|
||||||
|
|
||||||
(define gnc:html-markup-style-info-tag
|
|
||||||
(record-accessor <html-markup-style-info> 'tag))
|
|
||||||
|
|
||||||
(define gnc:html-markup-style-info-set-tag!
|
|
||||||
(record-modifier <html-markup-style-info> 'tag))
|
|
||||||
|
|
||||||
(define gnc:html-markup-style-info-attributes
|
|
||||||
(record-accessor <html-markup-style-info> 'attributes))
|
|
||||||
|
|
||||||
(define gnc:html-markup-style-info-set-attributes!
|
|
||||||
(record-modifier <html-markup-style-info> 'attributes))
|
|
||||||
|
|
||||||
(define gnc:html-markup-style-info-inheritable?
|
|
||||||
(record-accessor <html-markup-style-info> 'inheritable?))
|
|
||||||
|
|
||||||
(define gnc:html-markup-style-info-set-inheritable?!
|
|
||||||
(record-modifier <html-markup-style-info> 'inheritable?))
|
|
||||||
|
|
||||||
(define (gnc:html-markup-style-info-set-attribute! info attr val)
|
(define (gnc:html-markup-style-info-set-attribute! info attr val)
|
||||||
(hash-set! (gnc:html-markup-style-info-attributes info) attr val))
|
(hash-set! (gnc:html-markup-style-info-attributes info) attr val))
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user