[html-style-info] use srfi-9 records for <html-markup-style-info>

This commit is contained in:
Christopher Lam 2020-07-12 00:12:44 +08:00
parent a6ac9b748c
commit b69d3fe38a

View File

@ -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))