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-info] compact functions

Browse Source
This commit is contained in:
Christopher Lam 2019-04-04 08:26:08 +08:00
parent 3923dfa19a
commit 492539e1db
1 changed files with 50 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

108
gnucash/report/report-system/html-style-info.scm
View File

@ -110,10 +110,8 @@
(record-modifier <html-markup-style-info> 'font-face)) (record-modifier <html-markup-style-info> 'font-face))
(define (gnc:html-markup-style-info-set-font-face! record value) (define (gnc:html-markup-style-info-set-font-face! record value)
(begin (gnc:html-markup-style-info-set-closing-font-tag! record value)
(gnc:html-markup-style-info-set-closing-font-tag! (gnc:html-markup-style-info-set-font-face-internal! record value))
record (not (eq? value #f)))
(gnc:html-markup-style-info-set-font-face-internal! record value)))
(define gnc:html-markup-style-info-font-size (define gnc:html-markup-style-info-font-size
(record-accessor <html-markup-style-info> 'font-size)) (record-accessor <html-markup-style-info> 'font-size))
@ -122,10 +120,8 @@
(record-modifier <html-markup-style-info> 'font-size)) (record-modifier <html-markup-style-info> 'font-size))
(define (gnc:html-markup-style-info-set-font-size! record value) (define (gnc:html-markup-style-info-set-font-size! record value)
(begin (gnc:html-markup-style-info-set-closing-font-tag! record value)
(gnc:html-markup-style-info-set-closing-font-tag! (gnc:html-markup-style-info-set-font-size-internal! record value))
record (not (eq? value #f)))
(gnc:html-markup-style-info-set-font-size-internal! record value)))
(define gnc:html-markup-style-info-font-color (define gnc:html-markup-style-info-font-color
(record-accessor <html-markup-style-info> 'font-color)) (record-accessor <html-markup-style-info> 'font-color))
@ -154,53 +150,52 @@
(hash-set! (gnc:html-markup-style-info-attributes info) attr val)) (hash-set! (gnc:html-markup-style-info-attributes info) attr val))
(define (gnc:html-markup-style-info-merge s1 s2) (define (gnc:html-markup-style-info-merge s1 s2)
(if (not (gnc:html-markup-style-info? s1)) (cond
s2 ((not (gnc:html-markup-style-info? s1)) s2)
(if (not (gnc:html-markup-style-info? s2)) ((not (gnc:html-markup-style-info? s2)) s1)
s1 (else
(let* ((tag-1 (gnc:html-markup-style-info-tag s1)) (gnc:make-html-markup-style-info-internal
(face-1 (gnc:html-markup-style-info-font-face s1)) ;; tag
(size-1 (gnc:html-markup-style-info-font-size s1)) (or (gnc:html-markup-style-info-tag s1)
(color-1 (gnc:html-markup-style-info-font-color s1)) (gnc:html-markup-style-info-tag s2))
(closing-font-tag-1 ;; attributes: if the child is overriding the
(gnc:html-markup-style-info-closing-font-tag s1))) ;; parent tag, don't initialize the attribute table
(gnc:make-html-markup-style-info-internal ;; to the parent's attributes. Otherwise, load
;; tag ;; parent attrs then load child attrs over them.
(if tag-1 tag-1 (gnc:html-markup-style-info-tag s2)) (let ((ht (make-hash-table)))
;; attributes: if the child is overriding the (unless (gnc:html-markup-style-info-tag s1)
;; parent tag, don't initialize the attribute table (hash-for-each
;; to the parent's attributes. Otherwise, load (lambda (k v)
;; parent attrs then load child attrs over them. (hash-set! ht k v))
(let ((ht (make-hash-table))) (gnc:html-markup-style-info-attributes s2)))
(if (not tag-1) (hash-for-each
(hash-fold (lambda (k v) (hash-set! ht k v))
(lambda (k v p) (hash-set! ht k v) #f) #f (gnc:html-markup-style-info-attributes s1))
(gnc:html-markup-style-info-attributes s2))) ht)
(hash-fold ;; font face
(lambda (k v p) (hash-set! ht k v) #f) #f (or (gnc:html-markup-style-info-font-face s1)
(gnc:html-markup-style-info-attributes s1)) (gnc:html-markup-style-info-font-face s2))
ht) ;; font size
;; font face (or (gnc:html-markup-style-info-font-size s1)
(if face-1 face-1 (gnc:html-markup-style-info-font-face s2)) (gnc:html-markup-style-info-font-size s2))
;; font size ;; color
(if size-1 size-1 (gnc:html-markup-style-info-font-size s2)) (or (gnc:html-markup-style-info-font-color s1)
;; color (gnc:html-markup-style-info-font-color s2))
(if color-1 color-1 ;; closing font tag
(gnc:html-markup-style-info-font-color s2)) (or (gnc:html-markup-style-info-closing-font-tag s1)
;; closing font tag (gnc:html-markup-style-info-closing-font-tag s2))
(or closing-font-tag-1 ;; inheritable (get this always from child)
(gnc:html-markup-style-info-closing-font-tag s2)) (gnc:html-markup-style-info-inheritable? s1)))))
;; inheritable (get this always from child)
(gnc:html-markup-style-info-inheritable? s1))))))
(define (gnc:html-style-info-merge s1 s2) (define (gnc:html-style-info-merge s1 s2)
(if (or (gnc:html-markup-style-info? s1) (cond
(gnc:html-markup-style-info? s2)) ((or (gnc:html-markup-style-info? s1) (gnc:html-markup-style-info? s2))
(gnc:html-markup-style-info-merge s1 s2) (gnc:html-markup-style-info-merge s1 s2))
(if (or (gnc:html-data-style-info? s1)
(gnc:html-data-style-info? s2)) ((or (gnc:html-data-style-info? s1) (gnc:html-data-style-info? s2))
(gnc:html-data-style-info-merge s1 s2) (gnc:html-data-style-info-merge s1 s2))
#f)))
(else #f)))
(define (gnc:html-data-style-info-merge s1 s2) (define (gnc:html-data-style-info-merge s1 s2)
(if (gnc:html-data-style-info? s1) s1 s2)) (if (gnc:html-data-style-info? s1) s1 s2))
@ -311,8 +306,7 @@
(record-modifier <html-style-table> 'inheritable)) (record-modifier <html-style-table> 'inheritable))
(define (gnc:html-style-table-compiled? table) (define (gnc:html-style-table-compiled? table)
(if (gnc:html-style-table-compiled table) (gnc:html-style-table-compiled table))
#t #f))
(define (gnc:html-style-table-compile table antecedents) (define (gnc:html-style-table-compile table antecedents)
;; merge a key-value pair from an antecedent into the ;; merge a key-value pair from an antecedent into the
@ -387,9 +381,7 @@
(if (and table (gnc:html-style-table-compiled? table)) (if (and table (gnc:html-style-table-compiled? table))
(hash-ref (gnc:html-style-table-compiled table) markup) (hash-ref (gnc:html-style-table-compiled table) markup)
(fetch-worker (fetch-worker
(if table (and table (hash-ref (gnc:html-style-table-primary table) markup))
(hash-ref (gnc:html-style-table-primary table) markup)
#f)
antecedents))) antecedents)))
(define (gnc:html-style-table-set! table markup style-info) (define (gnc:html-style-table-set! table markup style-info)