mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
[html-document] compact functions
This commit is contained in:
@@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user