[html-document] compact functions

This commit is contained in:
Christopher Lam
2019-04-03 21:24:00 +08:00
parent df80796afe
commit f4220c325d

View File

@@ -98,14 +98,12 @@
(record-predicate <html-document>)) (record-predicate <html-document>))
(define (gnc:html-document-set-style! doc tag . rest) (define (gnc:html-document-set-style! doc tag . rest)
(let ((newstyle #f)) (gnc:html-style-table-set!
(gnc:html-document-style doc) tag
(if (and (= (length rest) 2) (if (and (= (length rest) 2)
(procedure? (car rest))) (procedure? (car rest)))
(set! newstyle (apply gnc:make-html-data-style-info rest)
(apply gnc:make-html-data-style-info rest)) (apply gnc:make-html-markup-style-info rest))))
(set! newstyle
(apply gnc:make-html-markup-style-info rest)))
(gnc:html-style-table-set! (gnc:html-document-style doc) tag newstyle)))
(define (gnc:html-document-tree-collapse tree) (define (gnc:html-document-tree-collapse tree)
(let ((retval '())) (let ((retval '()))
@@ -126,9 +124,9 @@
;; returns the html document as a string, I think. ;; returns the html document as a string, I think.
(define (gnc:html-document-render doc . rest) (define (gnc:html-document-render doc . rest)
(let ((stylesheet (gnc:html-document-style-sheet doc)) (let ((stylesheet (gnc:html-document-style-sheet doc))
(headers? (if (null? rest) #t (if (car rest) #t #f))) (headers? (or (null? rest) (car rest)))
(style-text (gnc:html-document-style-text doc)) (style-text (gnc:html-document-style-text doc)))
)
(if stylesheet (if stylesheet
;; if there's a style sheet, let it do the rendering ;; if there's a style sheet, let it do the rendering
(gnc:html-style-sheet-render stylesheet doc headers?) (gnc:html-style-sheet-render stylesheet doc headers?)
@@ -205,33 +203,20 @@
(append (gnc:html-document-objects doc) objects))) (append (gnc:html-document-objects doc) objects)))
(define (gnc:html-document-fetch-markup-style doc markup) (define (gnc:html-document-fetch-markup-style doc markup)
(let ((style-info #f) (let ((style-stack (gnc:html-document-style-stack doc)))
(style-stack (gnc:html-document-style-stack doc))) (or (and (pair? style-stack)
(if (not (null? style-stack))
(set! style-info
(gnc:html-style-table-fetch (gnc:html-style-table-fetch
(car style-stack) (car style-stack) (cdr style-stack) markup))
(cdr style-stack) (gnc:make-html-markup-style-info))))
markup)))
(if (not style-info)
(gnc:make-html-markup-style-info)
style-info)))
(define (gnc:html-document-fetch-data-style doc markup) (define (gnc:html-document-fetch-data-style doc markup)
(let ((style-info #f) (let ((style-stack (gnc:html-document-style-stack doc)))
(style-stack (gnc:html-document-style-stack doc))) (or (and (pair? style-stack)
(if (not (null? (gnc:html-document-style-stack doc)))
(set! style-info
(gnc:html-style-table-fetch (gnc:html-style-table-fetch
(car style-stack) (car style-stack) (cdr style-stack) markup))
(cdr style-stack)
markup)))
(if (not style-info)
(gnc:make-html-data-style-info (gnc:make-html-data-style-info
(lambda (datum parms) (lambda (datum parms) (format #f "~a ~a" markup datum))
(format #f "~a ~a" markup datum)) #f))))
#f)
style-info)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; markup-rendering functions : markup-start and markup-end return ;; markup-rendering functions : markup-start and markup-end return